home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / forth / compiler / fpc / source / mouse.seq < prev    next >
Encoding:
Text File  |  1991-04-23  |  10.5 KB  |  280 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. **************  UPDATE *********************
  37. I changed from the forth generated (cursor) mouse cursor to the mouse
  38. interupts HARDWARE mouse cursor.  Mainly to provide a separate text
  39. cursor and a separate mouse cursor while in the editor. MDC  26/08/90
  40.  
  41. *************** UPDATE by Tom Zimmer 03/30/91 13:25:13.45 **************
  42. Integrated this file and MOUSEY2.SEQ into F-PC. Made a minor change to
  43. prevent the mouse cursor from showing up on the screen until it is actually
  44. moved.  Some people may have a mouse driver installed, but not a mouse. It
  45. would be pretty irritating to have a mouse cursor in the middle of your
  46. screen and not be able to get rid of it.  Thank you Mike Christopher for
  47. this nice mouse driver enhancement.
  48.  
  49. comment;
  50.  
  51. prefix                  \ use prefix assembler syntax
  52.  
  53. decimal
  54.  
  55. only forth also hidden definitions also
  56.  
  57.  
  58. 0 value havemouse       \ was a good mouse driver present at boot?
  59. 0 value mousechar       \ character to return from mouse key press
  60. 0 value mousewasdown    \ was mouse button down last time we saw it
  61. 0 value badmouse        \ non-zero if bad  driver present
  62. 0 value lastx           \ previous location of mouse X and Y
  63. 0 value lasty
  64. 0 value last-cursor     \ cursor shape before we moved the mouse
  65. 0 value fixcur?         \ do we need to reset cursor position & size?
  66.  
  67. \ defer dobutton          ' noop is dobutton    \ moved to UTILS
  68.  
  69. code show.ms    ( -- )          \ turn On the hardware mouse cursor
  70.                 mov ax, # 1     \ we are using hardware cursor
  71.                 int  51
  72.                 next
  73.                 end-code
  74.  
  75. code hide.ms    ( -- )          \ turn OFF the hardware mouse cursor
  76.                 mov ax, # 2     \ use this to hide mouse before screen updates
  77.                 int  51
  78.                 next
  79.                 end-code
  80.  
  81. code init.mouse ( --- )         \ initialize mouse if good driver present
  82.                 mov ax, # 0     \ mouse driver init.mouse function code
  83.                 int  51         \ call mouse driver
  84.                 cmp ax, # 0
  85.              0= if      mov ' badmouse >body # true word
  86.                         next
  87.                 then
  88.                 mov ' badmouse >body # false word
  89.                 mov ax, # 14            \ function code to disable light pen
  90.                                         \ emulation.  mouse driver turned
  91.                                         \ this on as default in
  92.                                         \ function 1, done in init.mouse1
  93.                 int  51                 \ call mouse driver.
  94.                 mov ' mouseflg  >body # true word
  95.                 mov ' havemouse >body # true word
  96.  
  97. \                mov ax, # $0a           \ function code to set cursor type
  98. \                mov bx, # $01           \ hardware mouse driver cursor
  99. \                mov cx, # 0             \ start scan  (screen mask)
  100. \                mov dx, # 0             \ end scan    (cursor mask)
  101. \                int  51                 \ call mouse driver.
  102.  
  103.                 next
  104.                 end-code
  105.  
  106. code getmous    ( --dx dy buttons.status )      \ get mouse information
  107.                 mov ax, # 03
  108.                 int  51
  109.                 push cx
  110.                 push dx
  111.                 and bx, # 3
  112.                 push bx
  113.                 next
  114.                 end-code
  115.  
  116. : nomouse       ( --- )                 \ mark us as not having a mouse
  117.                 off> mouseflg
  118.                 off> havemouse ;
  119.  
  120. code mouse.scale ( --- )                \ adjust mouse scaling for display
  121.                 mov cx, # 0
  122.                 mov dx, ' rows >body
  123.                 dec dx
  124.                 shl dx, # 1
  125.                 shl dx, # 1
  126.                 shl dx, # 1
  127.                 mov ax, # 08            \ set max Y
  128.                 int  51
  129.                 mov cx, # 0
  130.                 mov dx, ' cols >body
  131.                 dec dx
  132.                 shl dx, # 1
  133.                 shl dx, # 1
  134.                 shl dx, # 1
  135.                 mov ax, # 07            \ set max x
  136.                 int  51
  137.                 next
  138.                 end-code
  139.  
  140. forth definitions
  141.  
  142. : mousexy       ( --- x1/y1 )   \ x=0-79, y=0-24
  143.                 mouseflg 0= if 0 0 exit then
  144.                 getmous
  145.                 drop u8/ rows 1- min
  146.                 swap u8/ cols 1- min swap ;
  147.  
  148. : mousebutton   ( --- n1 )              \ n1=0,1,2,4 or a combination
  149.                 mouseflg 0= if false exit then
  150.                 getmous nip nip 3 and ;
  151.  
  152. : hide.mouse    ( --- )                 \ turn off the mouse cursor
  153.                 hide.ms                 \ mdc
  154.                 off> mouseflg
  155.                 ;
  156.  
  157. : show.mouse    ( --- )                 \ enable display of mouse cursor
  158.                 show.ms                 \ mdc
  159.                 havemouse =: mouseflg
  160.                 ;
  161.  
  162.  
  163. : ?menubar#     ( --- n1 )
  164.                 -1
  165.                 mcolumn
  166.                 menubar  count 0
  167.                 do      swap over c@ + 1+
  168.                         mousexy drop ( x ) over <       \ lessthan next menu#
  169.                         if      rot drop i -rot leave
  170.                         then    swap count +            \ next bar
  171.                 loop    2drop
  172.                 dup 0< if drop menubar c@ 1- then
  173.                 ;
  174.  
  175. : track-menu    ( --- )         \ track menu with mouse
  176.  
  177.                 mcol >r ?menubar# =: mcol
  178.                 r> mcol -
  179.                 if      hide.ms recoverscr show.ms
  180.                 then
  181.                 mousexy nip mline - 0max
  182.                 mcol  2* menulist + @ 2+ c@ min =: mrow
  183.                 hide.ms  showmenus  show.ms
  184.                 ;
  185.  
  186. : track-mouse   ( --- )                 \ follow the mouse on screen
  187.                 mousexy lastx lasty d- or       \ has mouse moved?
  188.                 if  show.ms
  189.                     mousexy =: lasty =: lastx
  190.                     ['] dobutton >body @ ['] mbutton = if  \ a MENU is active
  191.                         track-menu
  192.                     then
  193.                 then
  194.                 ;
  195.  
  196. hidden definitions
  197.  
  198. : defbutton     ( --- )                 \ default button handler
  199.                 mousebutton
  200.                 case
  201.                 2 of    27 ( ESC )   =: mousechar   endof
  202.                 1 of    13 ( Enter ) =: mousechar   endof
  203.                         drop
  204.                 endcase ;
  205.  
  206. : initmouse     ( --- )                 \ initialize the mose if present
  207.                 nomouse
  208.                 0 204 @L 0<>            \ interupt vector may be 51 ok
  209.                                         \ if it is <>0
  210.                 if      init.mouse
  211.                         badmouse ?exit
  212.                         mouse.scale     \ adjust mouse scaling to screen
  213.                         off> mousechar
  214.                         off> mousewasdown
  215.                         ['] defbutton is dobutton       \ default button
  216.                         mousexy =: lasty =: lastx
  217.                         hide.ms hide.ms
  218.                 then                                    \ handler
  219.                 ;
  220.  
  221. initmouse                       \ initialize the mouse now so we can test it
  222.  
  223. : ?mouseinit    ( --- )         \ initialize mouse if present at boot time
  224.                 initmouse
  225.                 defers initstuff
  226.                 ;
  227.  
  228. ' ?mouseinit is initstuff
  229.  
  230. forth definitions
  231. : tracker ( - )  \ tracks the mouse on the screen OR a menu
  232.        track-mouse
  233.        ;
  234.  
  235. : mousekey?     ( --- f1 )      \ new mouseable version of KEY?
  236.                 defers key?
  237.                 dup 0=
  238.  
  239.          if      mouseflg 0= ?exit
  240.                         mousewasdown
  241.                         if
  242.                                 begin   mousebutton 0=
  243.                                       tracker
  244.                                 until
  245.                         then    off> mousewasdown
  246.                         off> mousechar
  247.                         tracker
  248.                         mousebutton             \ if button pressed then
  249.                         if      dobutton        \ handle it
  250.                                 on> mousewasdown
  251.                         then
  252.                 then
  253.                 ;
  254.  
  255. ' mousekey? is key?
  256.  
  257. : mousekey      ( -- CHAR )             \ allow mouse press to return key
  258.                 show.ms
  259.                 begin   pause
  260.                         key?
  261.                         mousechar or
  262.                 until   mousechar ?dup
  263.                 hide.ms
  264.                 if      off> mousechar
  265.                         on> mousewasdown
  266.                 else    bioskey dup 127 and 0=
  267.                         if      flip dup 3 =
  268.                                 if      drop 0
  269.                                 else    127 and 128 or
  270.                                 then
  271.                         else    255 and
  272.                         then
  273.                 then    keyfilter
  274.                 ;
  275.  
  276. ' mousekey is key
  277.  
  278. only forth also definitions
  279.  
  280.