guiserver/rotation-demo.lsp

   1 #!/usr/bin/newlisp
   2 ;;
   3 ;; rotationn-demo.lsp - demonstrate gs:rotate-tag, gs:translate-tag and  gs:scale-tag
   4 ;; and the mouse-wheel rotating an object
   5
   6 ;;;; initialization
   7 (set-locale "C")
   8 (load (append (env "NEWLISPDIR") "/guiserver.lsp"))
   9
  10 (gs:init)
  11 ;(gs:set-trace true)
  12
  13 ;;;; describe the GUI
  14 (gs:frame 'RotationDemo  100 100 600 600 "Image demo")
  15 (gs:set-border-layout 'RotationDemo)
  16 ;(gs:set-resizable 'RotationDemo nil)
  17 (gs:canvas 'MyCanvas)
  18 (gs:set-background 'MyCanvas gs:white)
  19 (gs:panel 'Select)
  20 (gs:radio-button 'ZoomButton 'zoom-action "zoom")
  21 (gs:radio-button 'TurnButton 'turn-action "turn")
  22 (gs:set-selected 'TurnButton true)
  23 (set 'turn-flag true)
  24 (gs:add-to 'Select 'ZoomButton 'TurnButton)
  25 (gs:add-to 'RotationDemo 'MyCanvas "center" 'Select "south")
  26 (gs:mouse-wheel 'MyCanvas 'mouse-wheel-action)
  27
  28 ;(gs:set-scale 0.5 0.5) ; only for testing
  29
  30 (gs:set-font 'MyCanvas "Lucida Sans Oblique" 14 "plain")
  31 (gs:draw-text 'T "turn mouse wheel to turn or zoom image" 20 50 gs:darkGray)
  32 (gs:fill-circle 'C 0 0 50 gs:red)
  33 (gs:fill-circle 'C -40 -40 30 gs:black)
  34 (gs:fill-circle 'C 40 -40 30 gs:black)
  35 (gs:fill-circle 'C 0 10 8 gs:yellow)
  36 (gs:translate-tag 'C 300 300)
  37
  38 (gs:set-visible 'RotationDemo true)
  39
  40 ;; actions
  41
  42 (define (zoom-action id flag)
  43         (gs:set-selected 'TurnButton (not flag))
  44         (set 'turn-flag (not flag))
  45 )
  46
  47 (define (turn-action id flag)
  48         (gs:set-selected 'ZoomButton (not flag))
  49         (set 'turn-flag flag)
  50 )
  51
  52 (define (mouse-wheel-action x y wheel)
  53         (if turn-flag
  54                 (gs:rotate-tag 'C wheel 0 0)
  55                 (if (< wheel 0)
  56                                 (gs:scale-tag 'C 0.9 0.9)
  57                                 (gs:scale-tag 'C 1.1 1.1)
  58                 )
  59         )
  60 )
  61
  62
  63 (gs:listen)
  64
  65 ;; eof
  66