home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / forth / compiler / fpc / source / mousey.seq < prev    next >
Encoding:
Text File  |  1991-04-22  |  13.7 KB  |  369 lines
  1. \ MOUSEY.SEQ    Development level mouse support for F-PC    by Tom Zimmer
  2.  
  3. comment:
  4.  
  5.   This file contains the various mouse button drivers for the F-PC
  6. development environment.  In effect each mode in an application needs a new
  7. button driver if the mouse is to be used effectively in that mode.
  8.  
  9.   These drivers are fairly simple to write, as you can see from the
  10. following examples.  In addition to the following, you need to create an
  11. installer in your mode switch word to cause your driver to take effect when
  12. a particular mode is entered.  Here is an example of a simple mechanism to
  13. install a driver for a particulary mode.
  14.  
  15. : MYMODE        ( --- )
  16.                 VARIOUS INITIALIZATION
  17.  
  18.                 ['] MY-BUTTON SAVE!> DOBUTTON   \ install new and save
  19.                                                 \ current driver
  20.  
  21.                 DO WHATEVER I WANT TO DO IN MY MODE
  22.  
  23.                 RESTORE> DOBUTTON               \ restores previous driver
  24.                 ;                               \ all done leave
  25.  
  26.   try using FLOOK to find occurances of DOBUTTON in the SRC directory, for
  27. actual examples of how the above  works.
  28.  
  29. comment;
  30.  
  31. only forth also hidden definitions also
  32. \unless editor  editor also
  33.  
  34. \ ***************************************************************************
  35. \ Line editor button driver
  36.  
  37. : %ledbutton    ( --- )         \ line edit button handler
  38.                 mousebutton
  39.                 case
  40.               2 of      27 ( ESC )   =: mousechar endof
  41.               1 of      13 ( enter ) =: mousechar endof
  42.                         drop
  43.                 endcase ;
  44.  
  45. ' %ledbutton is ledbutton
  46.  
  47. \ ***************************************************************************
  48. \ Window file selection button driver starts here
  49.  
  50. : ?dir-window   ( --- )
  51.                 mousexy forgy 1- > swap forgx > and
  52.                 mousexy forgy dlen + < swap forgx 15 + < and and
  53.                                                         \ within files box?
  54.                 if      mousexy nip dirrow forgy + - ?dup
  55.                         if      dup abs swap 0<
  56.                                 if      0 ?do pfl loop
  57.                                 else    0 ?do nfl loop
  58.                                 then
  59.                                 hide.ms showdir show.ms
  60.                         else    13 ( Enter ) =: mousechar
  61.                         then
  62.                         track-mouse
  63.                         hide.ms showdir show.ms
  64.                 then    ;
  65.  
  66. : ?dir-down     ( --- )
  67.                 mousexy forgy dlen + = swap forgx 15 + = and
  68.                 if      dlen 2/ 0 do nfl loop
  69.                         hide.ms showdir show.ms
  70.                 then    ;
  71.  
  72. : ?dir-up       ( --- )
  73.                 mousexy forgy = swap forgx 15 + = and
  74.                 if      dlen 2/ 0 do pfl loop
  75.                         hide.ms showdir show.ms
  76.                 then    ;
  77.  
  78. : ?path-window  ( --- )
  79.                 mousexy forgx forgy 26 11 d+ rot = >r 41 over + between
  80.                 r> and
  81.                 if      '\' =: mousechar
  82.                 then    ;
  83.  
  84. : %wflbutton    ( --- )
  85.                 mousebutton
  86.                 case
  87.               2 of      27 ( ESC )   =: mousechar endof
  88.               1 of      ?dir-window
  89.                         ?path-window
  90.                         ?dir-up
  91.                         ?dir-down
  92.                         endof
  93.                         drop
  94.                 endcase ;
  95.  
  96. ' %wflbutton is wflbutton
  97.  
  98. \ ***************************************************************************
  99. \ Menubar button driver starts here
  100.  
  101. : ?select-menu  ( --- )
  102.                 mousexy nip mline - dup mrow <= swap 0> and
  103.                 if      13 ( Enter ) =: mousechar
  104.                 else    27 ( ESC )   =: mousechar
  105.                 then    ;
  106.  
  107. : %mbutton      ( --- )
  108.                 mousebutton
  109.                 case
  110.                 2 of    27 ( ESC )   =: mousechar endof
  111.                 1 of            ?select-menu      endof
  112.                         drop
  113.                 endcase ;
  114.  
  115. ' %mbutton is mbutton
  116.  
  117. defined charline nip
  118. #if
  119.  
  120. \ ***************************************************************************
  121. \ Graphic character insertion tool button driver
  122.  
  123. : %charbutton   ( --- )         \ mousebutton down handler
  124.                 mousebutton
  125.                 case
  126.               2 of      27 ( ESC )   =: mousechar endof
  127.               1 of      mousexy charline extrows over + between
  128.                         swap    charcol dup 1+ swap
  129.                         extcharseg +xseg 0 c@L + between and
  130.                         if      mousexy                 \ if on same char
  131.                                 ty 1+ - swap tx 2+ - 2/ swap 2dup
  132.                                 chrow = swap chcol = and
  133.                                 if      2drop           \ do the char
  134.                                         13 ( Enter ) =: mousechar
  135.                                 else                    \ else move to char
  136.                                         =: chrow =: chcol
  137.                                         tx 1+ ty extrows 1+ + at
  138.                                         extchar@ 4 .r
  139.                                         tx 2+ chcol 2* + ty 1+ chrow + at
  140.                                 then
  141.                         then
  142.                         endof
  143.                         drop
  144.                 endcase ;
  145.  
  146. ' %charbutton is charbutton
  147.  
  148. \ ***************************************************************************
  149. \ The SED editor button driver starts here.
  150.  
  151. : move>mouse    ( --- )                 \ move edit cursor to mouse position
  152.                 mousexy swap 1- 0MAX =: screenchar
  153.                 screenline - dup 0<
  154.                 if      abs 0 ?do suln loop
  155.                 else        0 ?do sdln loop
  156.                 then    ;
  157.  
  158. : track-marks   ( --- )         \ follow cursor and mark some lines for
  159.                                 \ cut or copy.
  160.                 mousexy nip
  161.                 begin   mousebutton             \ while the mouse is pressed
  162.                 while   mousexy nip over <>
  163.                         if      mark-clear
  164.                                 mark-on/off
  165.                                 begin   scrshow
  166.                                         move>mouse
  167.                                         hide.ms showstat show.ms
  168.                                         mousebutton 0=
  169.                                 until
  170.                                 mark-on/off
  171.                                 hide.ms showstat show.ms
  172.                         then
  173.                 repeat  drop ;
  174.  
  175. : ?cursor-move  ( x y --- x y )
  176.                 2dup
  177.                 first.textline last.textline   between swap
  178.                 first.textcol  last.textcol 1- between and
  179.                 if      mousexy
  180.                         swap 1- 0MAX screenchar =       \ on col
  181.                         swap screenline = and           \ on line
  182.                         if      ?altkey
  183.                                 if      163 ( alt-h)    \ MDC see help
  184.                                 else    176 ( Alt-b )   \ MDC see source
  185.                                 then    =: mousechar
  186.                         else
  187.                                 move>mouse              \ else move cursor
  188.                                 hide.ms scrshow
  189.                                 showstat show.ms
  190.                                 track-marks
  191.                         then
  192.                 then
  193.                 showcur
  194.                 ;
  195.  
  196. : ?help-do      ( x y --- x y )
  197.                 2dup last.textline 1+ = swap 2 10 between and
  198.                 if      187 ( F1 ) =: mousechar
  199.                 then    ;
  200.  
  201. : ?menu-do      ( x y --- x y )
  202.                 2dup last.textline 1+ = swap
  203.                 window.right 11 - window.right 2- between and
  204.                 if      27 ( ESC ) =: mousechar
  205.                 then    ;
  206.  
  207. : ?insert-toggle ( x y --- x y )
  208.                 hide.ms
  209.                 2dup statusline = swap 3 10 between and
  210.                 if      ?browse
  211.                         if
  212.                                 220 ( browsetgl ) =: mousechar
  213.                         else    imode 0=
  214.                                 if      on> imode
  215.                                         220 ( browsetgl ) =: mousechar
  216.                                 else
  217.                                         210 ( Ins ) =: mousechar
  218.                                 then
  219.                         then
  220.                 then
  221.                 show.ms
  222.                 ;
  223.  
  224. : ?unlink       ( x y --- x y )         \ Button on F10 in upper right corner
  225.                 2dup statusline = swap 73 77 between and
  226.                 if      196 ( F10 ) =: mousechar
  227.                 then
  228.                 ;
  229.  
  230. : ?scroll-up    ( x y --- x y )
  231.                 ?lastline ?exit
  232.                 2dup last.textline 1+ =
  233.                 swap 11 window.right 12 - between and
  234.                 if      begin   scldn
  235.                                 showstat
  236.                                 mousebutton 0= ?lastline or
  237.                         until
  238.                 then
  239.                 showcur
  240.                 ;
  241.  
  242. : ?scroll-dn    ( x y --- x y )
  243.                 curline 0= ?exit
  244.                 2dup statusline =
  245.                 over 11 window.right between and        \ on top line but not
  246.                                                         \ in INSERT
  247.                 swap 73 77 between 0= and               \ not in F10
  248.                 if      begin   sclup
  249.                                 showstat
  250.                                 mousebutton 0= curline 0= or
  251.                         until
  252.                 then
  253.                 showcur
  254.                 ;
  255.  
  256. : ?scroll-right ( x y --- x y )
  257.                 2dup statusline last.textline 5 - between
  258.                 swap window.right = and
  259.                 if      begin   1 %scrlrt
  260.                                 cursor-off showstat cursor-on
  261.                                 mousebutton 0=
  262.                         until
  263.                 then
  264.                 showcur
  265.                 ;
  266.  
  267. : ?scroll-left  ( x y --- x y )
  268.                 over window.left =
  269.                 if      begin   1 %scrllft
  270.                                 cursor-off showstat cursor-on
  271.                                 mousebutton 0=
  272.                         until
  273.                 then
  274.                 showcur
  275.                 ;
  276.  
  277. : ?page-down    ( x y --- x y )
  278.                 2dup last.textline dup 1- swap between
  279.                 swap window.right = and
  280.                 if      209 ( PgDn ) =: mousechar
  281.                 then    ;
  282.  
  283. : ?page-up      ( x y --- x y )
  284.                 2dup last.textline 4 - dup 1+ between
  285.                 swap window.right = and
  286.                 if      201 ( PgUp ) =: mousechar
  287.                 then    ;
  288.  
  289. : %sbutton      ( --- )
  290.                 mousebutton
  291.                 case
  292.                 2 of    27 ( ESC )   =: mousechar endof
  293.                 1 of    mousexy ?cursor-move
  294.                                 ?insert-toggle
  295.                                 ?help-do
  296.                                 ?menu-do
  297.                                 ?scroll-up
  298.                                 ?scroll-dn
  299.                                 ?scroll-left
  300.                                 ?scroll-right
  301.                                 ?page-down
  302.                                 ?page-up
  303.                                 ?unlink
  304.                                 2drop
  305.                         endof
  306.                         drop
  307.                 endcase ;
  308.  
  309. ' %sbutton is sbutton
  310.  
  311. \ ***************************************************************************
  312. \ The SED PRINTING button driver starts here.
  313.  
  314. : %pbutton      ( --- )
  315.                 mousebutton
  316.                 case
  317.                 2 of    27 ( ESC )   =: mousechar endof
  318. ( printto line) 1 of    mousexy 18 = swap 32 71 between and
  319. ( set device )          mousexy 16 = swap 38 40 between and or
  320.                         if      's' =: mousechar
  321. ( start printing )      else    mousexy 16 = swap 26 28 between and
  322.                           if      'p' =: mousechar
  323. ( ESC, stop printing )    else  mousexy 16 = swap 11 15 between and
  324.                             if      27 ( ESC ) =: mousechar
  325. ( else down arrow )         else
  326.                                 pitem @ 1+ pitems mod pitem ! sc
  327.                                 showpcur pnumval off
  328.                                 begin   mousebutton 0=
  329.                                 until   off> mousewasdown showpcur
  330.                             then
  331.                           then
  332.                         then
  333.                         endof
  334.                         drop
  335.                 endcase ;
  336.  
  337. ' %pbutton is pbutton
  338.  
  339. \ ***************************************************************************
  340. \ The BROWSE button driver starts here.
  341.  
  342. : %browbutton    ( --- )         \ line edit button handler
  343.                 mousebutton
  344.                 case
  345.               2 of      27 ( ESC )   =: mousechar endof
  346.               1 of      mousexy dup 10 =
  347.                         if      drop dup 52 56 between
  348.                                 if      'y' =: mousechar else
  349.                                 dup 58 61 between
  350.                                 if      'n' =: mousechar else
  351.                                 beep
  352.                                 then
  353.                                 then    drop
  354.                         else    11 = swap 27 40 between and
  355.                                 if      27 ( ESC ) =: mousechar
  356.                                 else    beep
  357.                                 then
  358.                         then
  359.                         endof
  360.                         drop
  361.                 endcase ;
  362.  
  363. ' %browbutton is browbutton
  364.  
  365. #endif
  366.  
  367. only forth also definitions
  368.  
  369.