home *** CD-ROM | disk | FTP | other *** search
/ The Datafile PD-CD 5 / DATAFILE_PDCD5.iso / utilities / f / forthmac / !Forthmacs / lib / arm / mouseactio < prev    next >
Encoding:
Text File  |  1997-05-23  |  2.2 KB  |  79 lines
  1. \ mouse server action
  2. \ the whole screen is devided into 16x16 pixel sections. When pressing one
  3. \ of the mouse keys, the apprpriate action is taken.
  4. terminals also
  5. create mouse-indexes here 64 128 * chars dup allot erase
  6. create mouse-actions here 256 cells dup allot erase
  7. : action>index        \ ( action -- i )
  8.     false locals| index action |
  9.     256 1 do mouse-actions i cells+ token@ action = if i is index leave then loop
  10.     index if index exit then
  11.     256 1 do mouse-actions i cells+ @ 0=
  12.         if action  mouse-actions i cells+ token!  i is index leave then
  13.           loop
  14.     index 0= abort" No mouse action available"
  15.     index ;
  16.  
  17. 0 constant mouse-x
  18. 0 constant mouse-y
  19. 0 constant mouse-button
  20. 0 constant mouse-field
  21.  
  22. code get-mouse-position    ( -- )
  23.     h# 1c            swix
  24.     r0    r0    1 #asr    mov
  25.     r0    'body mouse-x pcr str
  26.     r2    'body mouse-button pcr str
  27.     r1    r1    1 #asr    mov
  28.     r3    'body (lines)    adr
  29.     r3    r3 )        ldr
  30.     r1    r3    r1    sub
  31.     r1    1        decr
  32.     r1    'body mouse-y pcr str
  33.     r0    r0    4 #asr    mov
  34.     r1    r1    4 #asr    mov
  35.     r0    r0    r1 7 #asl add
  36.     r1    h# 1fff    #    mov
  37.     r0    r0    r1    and
  38.     r1    'body mouse-indexes adr
  39.     r0    r0 r1 ib byte    ldr
  40.     r1    'body mouse-actions adr
  41.     r0    r1    r0 2 #asl add
  42.     r0    'body mouse-field pcr str c;
  43.  
  44. create mouse-par 64 allot
  45. code set-mouse-speed    ( buffer -- )
  46.     r0    d# 21 #        mov
  47.     r1    mouse-par    adr
  48.         7        swix c;
  49. : slow-mouse    2 mouse-par c!  1 mouse-par 1+ c!  1 mouse-par 2+ c!  set-mouse-speed ;
  50. : fast-mouse    2 mouse-par c!  3 mouse-par 1+ c!  3 mouse-par 2+ c!  set-mouse-speed ;
  51.  
  52. : mouse-action-cell    ( action x y -- )
  53.     2>r action>index 2r> 7 lshift + mouse-indexes + c! ;
  54. : mouse-action-field    ( action upper-x upper-y width height )
  55.     locals| height width upper-y upper-x action |
  56.     upper-y height bounds
  57.     do    upper-x width bounds
  58.         do action i j mouse-action-cell loop
  59.     loop ;
  60. : mouse-action-p-field
  61.     locals| height width upper-y upper-x action |
  62.     upper-y 4 rshift height 4 rshift bounds
  63.     do    upper-x 4 rshift width 4 rshift bounds
  64.         do action i j mouse-action-cell loop
  65.     loop ;
  66. : r-butt?        ( -- f)    mouse-button 1 = ;
  67. : m-butt?        ( -- f)    mouse-button 2 = ;
  68. : l-butt?        ( -- f)    mouse-button 4 = ;
  69.  
  70. task: mouse-server
  71. : do-mouse-action
  72.     multi mouse-server activate
  73.     1 set-mouse
  74.     begin    100 ms get-mouse-position  mouse-button
  75.         if mouse-field @ single ?execute multi slow-mouse
  76.         else fast-mouse
  77.         then
  78.     again ;
  79.