guiserver/mouse-demo.lsp

   1 #!/usr/bin/newlisp
   2 ;;
   3 ;; mouse-demo.lsp - demonstrate mouse handlers and gs:delete-tag
   4
   5 ;;;; initialization
   6 (set-locale "C")
   7 (load (append (env "NEWLISPDIR") "/guiserver.lsp"))
   8
   9 (gs:init)
  10
  11 (set 'colors (list gs:black gs:blue gs:cyan gs:darkGray gs:gray
  12                                 gs:green gs:lightGray gs:magenta gs:orange gs:pink gs:red gs:yellow))
  13
  14 ;;;; describe the GUI
  15 (gs:frame 'MouseDemo 100 100 640 640 "Canvas Demo")
  16 (gs:canvas 'MyCanvas 'MouseDemo)
  17 (gs:add-to 'MouseDemo 'MyCanvas)
  18 (gs:set-background 'MyCanvas gs:white)
  19 (gs:mouse-pressed 'MyCanvas 'mouse-pressed-action true)
  20 (gs:mouse-released 'MyCanvas 'mouse-released-action true)
  21 (gs:mouse-clicked 'MyCanvas 'mouse-clicked-action true)
  22 (gs:mouse-moved 'MyCanvas 'mouse-moved-action)
  23 (gs:mouse-dragged 'MyCanvas 'mouse-dragged-action)
  24 (gs:mouse-wheel 'MyCanvas 'mouse-wheel-action)
  25 (gs:set-anti-aliasing true)
  26 (println (time-of-day))
  27 (for (row 0 620 20)
  28         (for (col 0 620 20)
  29                 (let (r (rand (length colors)))
  30                         (gs:fill-rect (string "R" r) col row 20 20 (colors r))
  31                 )
  32         )
  33 )
  34 (println (time-of-day))
  35 (gs:set-visible 'MouseDemo true)
  36
  37 ;; define actions
  38
  39 (define (mouse-pressed-action x y button modifiers tags)
  40         (gs:set-text 'MouseDemo
  41                 (string "pressed row: " (/ y 20) " col:" (/ x 20) " button: " button " key:" modifiers " tags:" tags))
  42 )
  43
  44 (define (mouse-released-action x y button modifiers tags)
  45         (gs:set-text 'MouseDemo
  46                 (string "released row: " (/ y 20) " col:" (/ x 20) " button: " button " key:" modifiers " tags:" tags))
  47 )
  48
  49 (define (mouse-clicked-action x y button cnt modifiers tags)
  50         (gs:set-text 'MouseDemo
  51                 (string "clicked row: " (/ y 20) " col:" (/ x 20)
  52                         " button: " button " count:" cnt " key:" modifiers " tags:" tags))
  53         (if tags (gs:delete-tag (tags 0)))
  54 )
  55
  56 (define (mouse-moved-action x y)
  57         (gs:set-text 'MouseDemo
  58                 (string "moved row: " (/ y 20) " col:" (/ x 20)))
  59 )
  60
  61 (define (mouse-dragged-action x y button modifiers)
  62         (gs:set-text 'MouseDemo
  63                 (string "dragged row: " (/ y 20) " col:" (/ x 20) " button: " button " key:" modifiers))
  64 )
  65
  66 (define (mouse-wheel-action x y wheel)
  67         (gs:set-text 'MouseDemo
  68                 (string "cursor row: " (/ y 20) " col:" (/ x 20) " wheel: " wheel))
  69 )
  70
  71 ;;;; listen for incoming action requests and dispatch
  72 (gs:listen)
  73
  74 ;; eof
  75