guiserver/textrot-demo.lsp

   1 #!/usr/bin/newlisp
   2 ;;
   3 ;; textrot-demo.lsp - demonstrate gs:rotate-tag on text
   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 400 300 "Rotate text and widgets on a canvas")
  15 (gs:set-resizable 'RotationDemo nil)
  16 (gs:canvas 'MyCanvas 'RotationDemo)
  17 (gs:button 'TheButton 'button-action "Exit")
  18 (gs:set-background 'TheButton gs:white)
  19 (gs:add-to 'MyCanvas 'TheButton)
  20 (gs:set-stroke 3.0)
  21 (gs:set-background 'MyCanvas gs:white)
  22 (gs:mouse-wheel 'MyCanvas 'mouse-wheel-action)
  23 (gs:add-to 'RotationDemo 'MyCanvas)
  24
  25 (gs:set-font 'MyCanvas "Lucida Sans Oblique" 36 "plain")
  26 (gs:fill-rect 'R 200 100 60 60 gs:lightGray 0.1)
  27 (gs:draw-text 'T "turn mouse wheel" 50 130 gs:red -15)
  28 (gs:fill-rect 'R 100 100 60 60 gs:lightGray 0.1)
  29
  30 (gs:set-visible 'RotationDemo true)
  31
  32 (define (mouse-wheel-action x y wheel)
  33         (gs:rotate-tag 'T wheel 50 130)
  34 )
  35
  36 (define (button-action)
  37         (exit 0))
  38
  39 (gs:listen)
  40
  41 ;; eof
  42