home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PROGRAMS / UTILS / LASER / FPC35_5.ZIP / FPCSRC.ZIP / MOUSEY.SEQ < prev    next >
Encoding:
Text File  |  1989-09-26  |  15.1 KB  |  394 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      mousexy ey = swap ex lenlimit @ over + between and
  42.                         if      mousexy drop ex - 0MAX
  43.                                 editbuf c@ min COLS 1- min =: ecursor
  44.                                 off> autoclear  \ no auto clear now
  45.                                 .ecursor
  46.                         else    27 ( ESC ) =: mousechar
  47.                         then
  48.                         endof
  49.                         drop
  50.                 endcase ;
  51.  
  52. ' %ledbutton is ledbutton
  53.  
  54. \ ***************************************************************************
  55. \ Window file selection button driver starts here
  56.  
  57. : ?dir-window   ( --- )
  58.                 mousexy forgy 1- > swap forgx > and
  59.                 mousexy forgy dlen + < swap forgx 15 + < and and
  60.                                                         \ within files box?
  61.                 if      mousexy nip dirrow forgy + - ?dup
  62.                         if      dup abs swap 0<
  63.                                 if      0 ?do pfl loop
  64.                                 else    0 ?do nfl loop
  65.                                 then
  66.                                 cursor-off showdir cursor-on
  67.                                 mousexy ibm-at
  68.                         else    13 ( Enter ) =: mousechar
  69.                         then
  70.                         track-mouse
  71.                         cursor-off showdir cursor-on
  72.                 then    ;
  73.  
  74. : ?dir-down     ( --- )
  75.                 mousexy forgy dlen + = swap forgx 15 + = and
  76.                 if      dlen 2/ 0 do nfl loop
  77.                         cursor-off showdir cursor-on
  78.                         mousexy ibm-at
  79.                 then    ;
  80.  
  81. : ?dir-up       ( --- )
  82.                 mousexy forgy = swap forgx 15 + = and
  83.                 if      dlen 2/ 0 do pfl loop
  84.                         cursor-off showdir cursor-on
  85.                         mousexy ibm-at
  86.                 then    ;
  87.  
  88. : ?path-window  ( --- )
  89.                 mousexy forgx forgy 26 11 d+ rot = >r 41 over + between
  90.                 r> and
  91.                 if      '\' =: mousechar
  92.                 then    ;
  93.  
  94. : %wflbutton    ( --- )
  95.                 mousebutton
  96.                 case
  97.               2 of      27 ( ESC )   =: mousechar endof
  98.               1 of      ?dir-window
  99.                         ?path-window
  100.                         ?dir-up
  101.                         ?dir-down
  102.                         endof
  103.                         drop
  104.                 endcase ;
  105.  
  106. ' %wflbutton is wflbutton
  107.  
  108. \ ***************************************************************************
  109. \ Menubar button driver starts here
  110.  
  111. : ?menubar#     ( --- n1 )
  112.                 0
  113.                 mcolumn
  114.                 menubar  count  0
  115.                 do      swap over c@ + 1+
  116.                         mousexy drop ( x ) over <       \ lessthan next menu#
  117.                         if      rot drop i -rot leave
  118.                         then    swap count +            \ next bar
  119.                 loop    2drop ;
  120.  
  121. : track-menu    ( --- )         \ track menu with mouse
  122.                 mcol >r ?menubar# =: mcol
  123.                 r> mcol -
  124.                 if      recoverscr
  125.                 then
  126.                 mousexy nip mline - 1 max
  127.                 mcol  2* menulist + @ 2+ c@ min =: mrow
  128.                 cursor-off
  129.                 showmenus
  130.                 cursor-on
  131.                 mousexy 2dup =: lasty =: lastx ibm-at
  132.                 ?set-cursor
  133.                 begin   mousexy lastx lasty d- or       \ has mouse moved?
  134.                         mousebutton 0= or
  135.                 until   ;
  136.  
  137. : ?select-menu  ( --- )
  138.                 mousexy nip mline - dup mrow <= swap 0> and
  139.                 if      13 ( Enter ) =: mousechar
  140.                 else    27 ( ESC )   =: mousechar
  141.                 then    ;
  142.  
  143. : %mbutton      ( --- )
  144.                 mousebutton
  145.                 case
  146.                 2 of    27 ( ESC )   =: mousechar endof
  147.                 1 of    begin   mousebutton 1 and
  148.                         while   track-mouse track-menu
  149.                         repeat  ?select-menu
  150.                         endof
  151.                         drop
  152.                 endcase ;
  153.  
  154. ' %mbutton is mbutton
  155.  
  156. defined charline nip
  157. #if
  158.  
  159. \ ***************************************************************************
  160. \ Graphic character insertion tool button driver
  161.  
  162. : %charbutton   ( --- )         \ mousebutton down handler
  163.                 mousebutton
  164.                 case
  165.               2 of      27 ( ESC )   =: mousechar endof
  166.               1 of      mousexy charline extrows over + between
  167.                         swap    charcol dup 1+ swap
  168.                         extcharseg +xseg 0 c@L + between and
  169.                         if      mousexy                 \ if on same char
  170.                                 ty 1+ - swap tx 2+ - 2/ swap 2dup
  171.                                 chrow = swap chcol = and
  172.                                 if      2drop           \ do the char
  173.                                         13 ( Enter ) =: mousechar
  174.                                 else                    \ else move to char
  175.                                         =: chrow =: chcol
  176.                                         tx 1+ ty extrows 1+ + at
  177.                                         extchar@ 4 .r
  178.                                         tx 2+ chcol 2* + ty 1+ chrow + at
  179.                                 then
  180.                         then
  181.                         endof
  182.                         drop
  183.                 endcase ;
  184.  
  185. ' %charbutton is charbutton
  186.  
  187. \ ***************************************************************************
  188. \ The SED editor button driver starts here.
  189.  
  190. : move>mouse    ( --- )                 \ move edit cursor to mouse position
  191.                 mousexy swap 1- 0MAX =: screenchar
  192.                 screenline - dup 0<
  193.                 if      abs 0 ?do suln loop
  194.                 else        0 ?do sdln loop
  195.                 then    ;
  196.  
  197. : track-marks   ( --- )         \ follow cursor and mark some lines for
  198.                                 \ cut or copy.
  199.                 mousexy nip
  200.                 begin   mousebutton             \ while the mouse is pressed
  201.                 while   mousexy nip over <>
  202.                         if      mark-clear
  203.                                 mark-on/off
  204.                                 begin   scrshow
  205.                                         move>mouse
  206.                                         cursor-off showstat cursor-on
  207.                                         ?fix-cursor
  208.                                         showcur 25 ms
  209.                                         mousebutton 0=
  210.                                 until
  211.                                 mark-on/off
  212.                                 showstat
  213.                         then
  214.                 repeat  drop ;
  215.  
  216. : ?cursor-move  ( x y --- x y )
  217.                 2dup
  218.                 first.textline last.textline   between swap
  219.                 first.textcol  last.textcol 1- between and
  220.                 if      mousexy
  221.                         swap 1- 0MAX screenchar =      \ on col
  222.                         swap screenline = and           \ on line
  223.                         if      ?altkey
  224.                                 if      163 ( Alt-H )   \ HELP
  225.                                 else    195 ( F9 )      \ BROWSE
  226.                                 then    =: mousechar
  227.                         else    move>mouse              \ else move cursor
  228.                                 scrshow ?fix-cursor
  229.                                 showstat showcur
  230.                                 track-marks
  231.                         then
  232.                 then    ;
  233.  
  234. : ?help-do      ( x y --- x y )
  235.                 2dup last.textline 1+ = swap 2 10 between and
  236.                 if      187 ( F1 ) =: mousechar
  237.                 then    ;
  238.  
  239. : ?menu-do      ( x y --- x y )
  240.                 2dup last.textline 1+ = swap
  241.                 window.right 11 - window.right 2- between and
  242.                 if      27 ( ESC ) =: mousechar
  243.                 then    ;
  244.  
  245. : ?insert-toggle ( x y --- x y )
  246.                 2dup statusline = swap 3 10 between and
  247.                 if      ?browse
  248.                         if      browsetgl
  249.                         else    imode 0=
  250.                                 if      on> imode
  251.                                         browsetgl
  252.                                 else    210 ( Ins ) =: mousechar
  253.                                 then
  254.                         then
  255.                 then    ;
  256.  
  257. : ?unlink       ( x y --- x y )         \ Button on F10 in upper right corner
  258.                 2dup statusline = swap 73 77 between and
  259.                 if      196 ( F10 ) =: mousechar
  260.                 then    ;
  261.  
  262. : ?scroll-up    ( x y --- x y )
  263.                 ?lastline ?exit
  264.                 2dup last.textline 1+ =
  265.                 swap 11 window.right 12 - between and
  266.                 if      begin   scldn
  267.                                 cursor-off showstat cursor-on
  268.                                 mousebutton 0= ?lastline or
  269.                         until
  270.                 then    ;
  271.  
  272. : ?scroll-dn    ( x y --- x y )
  273.                 curline 0= ?exit
  274.                 2dup statusline =
  275.                 over 11 window.right between and        \ on top line but not
  276.                                                         \ in INSERT
  277.                 swap 73 77 between 0= and               \ not in F10
  278.                 if      begin   sclup
  279.                                 cursor-off showstat cursor-on
  280.                                 mousebutton 0= curline 0= or
  281.                         until
  282.                 then    ;
  283.  
  284. : ?scroll-right ( x y --- x y )
  285.                 2dup statusline last.textline 5 - between
  286.                 swap window.right = and
  287.                 if      begin   1 %scrlrt
  288.                                 cursor-off showstat cursor-on
  289.                                 mousebutton 0=
  290.                         until
  291.                 then    ;
  292.  
  293. : ?scroll-left  ( x y --- x y )
  294.                 over window.left =
  295.                 if      begin   1 %scrllft
  296.                                 cursor-off showstat cursor-on
  297.                                 mousebutton 0=
  298.                         until
  299.                 then    ;
  300.  
  301. : ?page-down    ( x y --- x y )
  302.                 2dup last.textline dup 1- swap between
  303.                 swap window.right = and
  304.                 if      209 ( PgDn ) =: mousechar
  305.                 then    ;
  306.  
  307. : ?page-up      ( x y --- x y )
  308.                 2dup last.textline 4 - dup 1+ between
  309.                 swap window.right = and
  310.                 if      201 ( PgUp ) =: mousechar
  311.                 then    ;
  312.  
  313. : %sbutton      ( --- )
  314.                 mousebutton
  315.                 case
  316.                 2 of    27 ( ESC )   =: mousechar endof
  317.                 1 of    mousexy ?cursor-move
  318.                                 ?insert-toggle
  319.                                 ?help-do
  320.                                 ?menu-do
  321.                                 ?scroll-up
  322.                                 ?scroll-dn
  323.                                 ?scroll-left
  324.                                 ?scroll-right
  325.                                 ?page-down
  326.                                 ?page-up
  327.                                 ?unlink
  328.                                 2drop
  329.                         endof
  330.                         drop
  331.                 endcase ;
  332.  
  333. ' %sbutton is sbutton
  334.  
  335. \ ***************************************************************************
  336. \ The SED PRINTING button driver starts here.
  337.  
  338. : %pbutton      ( --- )
  339.                 mousebutton
  340.                 case
  341.                 2 of    27 ( ESC )   =: mousechar endof
  342. ( printto line) 1 of    mousexy 18 = swap 32 71 between and
  343. ( set device )          mousexy 16 = swap 38 40 between and or
  344.                         if      's' =: mousechar
  345. ( start printing )      else    mousexy 16 = swap 26 28 between and
  346.                           if      'p' =: mousechar
  347. ( ESC, stop printing )    else  mousexy 16 = swap 11 15 between and
  348.                             if      27 ( ESC ) =: mousechar
  349. ( else down arrow )         else
  350.                                 ?fix-cursor
  351.                                 pitem @ 1+ pitems mod pitem ! sc
  352.                                 showpcur pnumval off
  353.                                 begin   mousebutton 0=
  354.                                 until   off> mousewasdown showpcur
  355.                             then
  356.                           then
  357.                         then
  358.                         endof
  359.                         drop
  360.                 endcase ;
  361.  
  362. ' %pbutton is pbutton
  363.  
  364. \ ***************************************************************************
  365. \ The BROWSE button driver starts here.
  366.  
  367. : %browbutton    ( --- )         \ line edit button handler
  368.                 mousebutton
  369.                 case
  370.               2 of      27 ( ESC )   =: mousechar endof
  371.               1 of      mousexy dup 10 =
  372.                         if      drop dup 52 56 between
  373.                                 if      'y' =: mousechar else
  374.                                 dup 58 61 between
  375.                                 if      'n' =: mousechar else
  376.                                 beep
  377.                                 then
  378.                                 then    drop
  379.                         else    11 = swap 27 40 between and
  380.                                 if      27 ( ESC ) =: mousechar
  381.                                 else    beep
  382.                                 then
  383.                         then
  384.                         endof
  385.                         drop
  386.                 endcase ;
  387.  
  388. ' %browbutton is browbutton
  389.  
  390. #endif
  391.  
  392. only forth also definitions
  393.  
  394.