guiserver/animation-demo.lsp

   1 #!/usr/bin/newlisp
   2 ;;
   3 ;; animation-demo.lsp - demonstrate gs:move-tag for making animations
   4 ;; and the mouse-wheel moving a text object
   5
   6 ;;;; initialization
   7 (set-locale "C")
   8 (load (append (env "NEWLISPDIR") "/guiserver.lsp"))
   9
  10 (gs:init)
  11
  12 ;;;; describe the GUI
  13 (gs:frame 'AnimationDemo 100 100 400 300 "Animation ~ 30 frames/sec, 5  pixel/step")
  14 (gs:set-resizable 'AnimationDemo nil)
  15 (gs:canvas 'MyCanvas)
  16 (gs:set-background 'MyCanvas gs:white)
  17 (gs:mouse-wheel 'MyCanvas 'mouse-wheel-action)
  18 (gs:add-to 'AnimationDemo 'MyCanvas)
  19
  20 (set 'Ty 140)
  21 (gs:set-font 'MyCanvas "Lucida Sans Oblique" 16 "plain")
  22 (gs:draw-text 'T "turn the mouse wheel to move this text" 20 Ty)
  23 (gs:fill-circle 'C 50 40 25 gs:red)
  24 (gs:fill-circle 'C 30 20 15 gs:black)
  25 (gs:fill-circle 'C 70 20 15 gs:black)
  26 (gs:fill-circle 'C 50 48 6 gs:yellow)
  27
  28 (gs:set-visible 'AnimationDemo true)
  29
  30
  31 (define (mouse-wheel-action x y wheel)
  32         (if (= ostype "OSX")
  33                 (gs:move-tag 'T 0 (* wheel wheel (sgn wheel)))
  34                 (gs:move-tag 'T 0 (* 5 wheel)))
  35 )
  36
  37 (set 'delay 33000) ;;
  38
  39 (while (gs:check-event delay)
  40         (dotimes (x 60)
  41                 (gs:check-event delay)
  42                 (gs:move-tag 'C 5 0))
  43         (dotimes (x 40)
  44                 (gs:check-event delay)
  45                 (gs:move-tag 'C 0 5))
  46         (dotimes (x 60)
  47                 (gs:check-event delay)
  48                 (gs:move-tag 'C -5 0))
  49         (dotimes (x 40)
  50                 (gs:check-event delay)
  51                 (gs:move-tag 'C 0 -5))
  52 )
  53
  54 (exit)
  55
  56 ;; eof
  57