home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PROGRAMS / UTILS / LASER / FPC35_5.ZIP / FPCSRC.ZIP / MOUSE.SEQ < prev    next >
Encoding:
Text File  |  1989-09-26  |  8.7 KB  |  235 lines
  1. \ MOUSE.SEQ     Mouse driver software, requires MOUSE.SYS       by Ray Isaac
  2.  
  3. comment:
  4.  
  5.   Mouse support for Forth.  Adding mouse support to a program is if you
  6. have looked at this file not a trivial problem.  The technique chosen here
  7. is to install a driver at the level of KEY? which monitors the movement of
  8. the mouse and turns on its cursor if it is moved. A press of a key restores
  9. the normal terminal cursor.
  10.  
  11.   In this system only the outside buttons of a three button mouse are used.
  12. The left button is used to select or trigger an operation, while the right
  13. button always is equivelant to the ESC key, which will usually cancel an
  14. operation.
  15.  
  16.   This generic mouse driver is enhanced at each application level that wants
  17. to use the mouse with an application specific button driver.  The application
  18. level button drivers are installed into the defered word DOBUTTON.  The
  19. button driver is expected to interpret the button presses, and perform the
  20. appropriate function.  Several button drivers are already present in F-PC,
  21. which can be used as examples for how to make button drivers.  See the
  22. files MENUBUT.SEQ, SEDBUT.SEQ, SEDCHARS.SEQ and LEDIT.SEQ for further
  23. information.
  24.  
  25.   The mouse is automatically initialized at program boot time, if you want
  26. to disable or re-enable the mouse after program boot time, you can use the
  27. following words:
  28.  
  29.         HIDE.MOUSE      disables mouse operation
  30.         SHOW.MOUSE      enables mouse operation if a mosue driver present
  31.  
  32.   This code was originally written by Ray Isaac at Calos Systems.
  33.  
  34.   This code has been extensively modified and extended by Tom Zimmer at
  35. Maxtor.
  36.  
  37. comment;
  38.  
  39. prefix                  \ use prefix assembler syntax
  40.  
  41. decimal
  42.  
  43. only forth also hidden definitions also
  44.  
  45.  
  46. 0 value havemouse       \ was a good mouse driver present at boot?
  47. 0 value mousechar       \ character to return from mouse key press
  48. 0 value mousewasdown    \ was mouse button down last time we saw it
  49. 0 value badmouse        \ non-zero if bad  driver present
  50. 0 value lastx           \ previous location of mouse X and Y
  51. 0 value lasty
  52. 0 value last-cursor     \ cursor shape before we moved the mouse
  53. 0 value fixcur?         \ do we need to reset cursor position & size?
  54.  
  55. \ defer dobutton          ' noop is dobutton    \ moved to UTILS
  56.  
  57. code hide.ms    ( -- )          \ turn OFF the hardware mouse cursor
  58.                 mov ax, # 2     \ we are not using hardware cursor
  59.                 int  51
  60.                 next
  61.                 end-code
  62.  
  63. code init.mouse ( --- )         \ initialize mouse if good driver present
  64.                 mov ax, # 0     \ mouse driver init.mouse function code
  65.                 int  51         \ call mouse driver
  66.                 cmp ax, # 0
  67.              0= if      mov ' badmouse >body # true word
  68.                         next
  69.                 then
  70.                 mov ax, # 14            \ function code to disable light pen
  71.                                         \ emulation.  mouse driver turned
  72.                                         \ this on as default in
  73.                                         \ function 1, done in init.mouse1
  74.                 int  51                 \ call mouse driver.
  75.                 mov ' mouseflg  >body # true word
  76.                 mov ' havemouse >body # true word
  77.                 next
  78.                 end-code
  79.  
  80. code getmous    ( --dx dy buttons.status )      \ get mouse information
  81.                 mov ax, # 03
  82.                 int  51
  83.                 push cx
  84.                 push dx
  85.                 and bx, # 3
  86.                 push bx
  87.                 next
  88.                 end-code
  89.  
  90. : nomouse       ( --- )                 \ mark us as not having a mouse
  91.                 off> mouseflg
  92.                 off> havemouse ;
  93.  
  94. code mouse.scale ( --- )                \ adjust mouse scaling for display
  95.                 mov cx, # 0
  96.                 mov dx, ' rows >body
  97.                 shl dx, # 1
  98.                 shl dx, # 1
  99.                 shl dx, # 1
  100.                 mov ax, # 08            \ set max Y
  101.                 int  51
  102.                 mov cx, # 0
  103.                 mov dx, ' cols >body
  104.                 shl dx, # 1
  105.                 shl dx, # 1
  106.                 shl dx, # 1
  107.                 mov ax, # 07            \ set max x
  108.                 int  51
  109.                 next
  110.                 end-code
  111.  
  112. forth definitions
  113.  
  114. : mousexy       ( --- x1/y1 )   \ x=0-79, y=0-24
  115.                 mouseflg 0= if 0 0 exit then
  116.                 getmous
  117.                 drop u8/ rows 1- min
  118.                 swap u8/ cols 1- min swap ;
  119.  
  120. : mousebutton   ( --- n1 )              \ n1=0,1,2,4 or a combination
  121.                 mouseflg 0= if false exit then
  122.                 getmous nip nip 3 and ;
  123.  
  124. : hide.mouse    ( --- )                 \ turn off the mouse cursor
  125.                 off> mouseflg ;
  126.  
  127. : show.mouse    ( --- )                 \ enable display of mouse cursor
  128.                 havemouse =: mouseflg ;
  129.  
  130. : ?set-cursor   ( --- )
  131.                 fixcur? 0=
  132.                 if      get-cursor =: last-cursor
  133.                         big-cursor
  134.                         cursor-on
  135.                         on> fixcur?
  136.                 then    ;
  137.  
  138. : ?fix-cursor   ( --- )
  139.                 fixcur?
  140.                 if      #out @ #line @ at
  141.                         last-cursor set-cursor
  142.                         off> fixcur?
  143.                 then    ;
  144.  
  145. : track-mouse   ( --- )                 \ follow the mouse on screen
  146.                 mouseflg 0=
  147.                 if      ?fix-cursor exit
  148.                 then
  149.                 mousexy lastx lasty d- or       \ has mouse moved?
  150.                 if      mousexy 2dup =: lasty =: lastx
  151.                         ibm-at
  152.                         ?set-cursor
  153.                 then    ;
  154.  
  155. hidden definitions
  156.  
  157. : defbutton     ( --- )                 \ default button handler
  158.                 mousebutton
  159.                 case
  160.                 2 of    27 ( ESC )   =: mousechar               endof
  161.                 1 of    13 ( Enter ) =: mousechar ?fix-cursor   endof
  162.                         drop
  163.                 endcase ;
  164.  
  165. : initmouse     ( --- )                 \ initialize the mose if present
  166.                 nomouse
  167.                 0 204 @L 0<>            \ interupt vector may be 51 ok
  168.                                         \ if it is <>0
  169.                 if      init.mouse
  170.                         badmouse ?exit
  171.                         hide.ms         \ we won't use hardware mouse cursor
  172.                         mouse.scale     \ adjust mouse scaling to screen
  173.                         get-cursor =: last-cursor
  174.                         off> mousechar
  175.                         off> mousewasdown
  176.                         ['] defbutton is dobutton       \ default button
  177.                         mousexy =: lasty =: lastx
  178.                         ?fix-cursor
  179.                 then    ;                               \ handler
  180.  
  181. initmouse                       \ initialize the mouse now so we can test it
  182.  
  183. : ?mouseinit    ( --- )         \ initialize mouse if present at boot time
  184.                 initmouse
  185.                 defers initstuff ;
  186.  
  187. ' ?mouseinit is initstuff
  188.  
  189. forth definitions
  190.  
  191. : mousekey?     ( --- f1 )      \ new mouseable version of KEY?
  192.                 defers key?
  193.                 dup 0=
  194.                 if      mouseflg 0= ?exit
  195.                         mousewasdown
  196.                         if      fixcur?
  197.                                 if      cursor-on
  198.                                 then    mousexy ibm-at
  199.                                 begin   mousebutton 0=
  200.                                         track-mouse
  201.                                 until
  202.                         then    off> mousewasdown
  203.                         off> mousechar
  204.                         track-mouse
  205.                         mousebutton             \ if button pressed then
  206.                         if      dobutton        \ handle it
  207.                                 on> mousewasdown
  208.                         then
  209.                 else    ?fix-cursor
  210.                 then    ;
  211.  
  212. ' mousekey? is key?
  213.  
  214. : mousekey      ( -- CHAR )             \ allow mouse press to return key
  215.                 begin   pause
  216.                         key?
  217.                         mousechar or
  218.                 until   mousechar ?dup
  219.                 if      off> mousechar
  220.                         on> mousewasdown
  221.                         ?fix-cursor
  222.                 else    bioskey dup 127 and 0=
  223.                         if      flip dup 3 =
  224.                                 if      drop 0
  225.                                 else    127 and 128 or
  226.                                 then
  227.                         else    255 and
  228.                         then
  229.                 then    keyfilter ;
  230.  
  231. ' mousekey is key
  232.  
  233. only forth also definitions
  234.  
  235.