home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / forth / compiler / fpc / source / macros.seq < prev    next >
Text File  |  1991-02-05  |  9KB  |  245 lines

  1. \ MACROS.SEQ    Keyboard macros for F-PC                  by Tom Zimmer
  2.  
  3. \ anew macros
  4.  
  5. comment:
  6.                         Keyboard macros for F-PC.
  7. To DEFINE a macro;
  8.         Press Alt-M             \ starts defining, waits for next key
  9.         Press Alt-1             \ tells it which macro to make, can be
  10.                                 \ Alt-1 through Alt-5, waits for first
  11.                                 \ key of macro
  12.         Start entering keys.    \ keys are passed on to program and saved too
  13.         Press Alt-M             \ Ends definition of the new macro
  14.         Thats all there is to MAKING macros.
  15.  
  16. To PERFORM a macro;
  17.         Press Alt-1             \ Macro processor passes back all keys
  18.                                 \ one for each call to key until empty
  19.         Thats all there is to DOING macros.
  20.  
  21. To REPEAT a macro;
  22.         Press Alt-R             \ We will be repeating a macro key
  23.         Enter a # between 0-999 \ The number of times to repeat the macro
  24.         Press Alt-1             \ the macro to repeat.
  25. comment;
  26.  
  27. only forth also hidden also definitions
  28.  
  29. headerless
  30.  
  31. 248 constant macbase            \ Alt-1
  32.   8 constant #macros            \ Through Alt-0
  33. 128 constant macsiz
  34.  
  35. #macros macsiz *D pointer macseg
  36.  
  37. headers
  38.  
  39. handle macfile                  \ make the macro file handle
  40.  
  41. macfile !hcb F-PC.MAC           \ initialize macro file name
  42.  
  43. : %macinit      ( -- )
  44.                 macseg 0= abort" Couldn't allocate MACRO buffer!"
  45.                 macseg 0 #macros macsiz * 0 lfill ;
  46.  
  47. %macinit                \ initialize macros for use
  48.  
  49. : macinit       ( --- )
  50.                 defers initstuff
  51.                 %macinit ;
  52.  
  53. ' macinit is initstuff
  54.  
  55. headerless
  56.  
  57. : ms:           ( n1 --- seg n1 )
  58.                 macseg swap ;
  59.  
  60. variable curmac
  61. \ 0 value ?doingmac     \ moved down to UTILS.SEQ to make it available
  62.                         \ to test if we are currently doing a macro.
  63.                         \ useful in the editor to reduce the screen updates
  64.                         \ while performing macros.
  65. variable makingmac
  66.  
  67. : savemacs      ( --- )
  68.                 macfile hcreate
  69.                 if      37 7 at
  70.                         ." \r Could not make Macro file! " beep
  71.                 else    0 #macros macsiz * dup>r macfile macseg exhwrite
  72.                         r> -    37 5 at >rev
  73.                         if      ."  Write error to Macro file! " beep
  74.                         else    ."  Macros Saved.\s14"
  75.                         then    >norm macfile hclose drop
  76.                 then    1 seconds ;
  77.  
  78. : loadmacs      ( --- )
  79.                 macfile hopen dup 0=
  80.                 if      drop
  81.                         #macros macsiz *       \ length of read
  82.                         0 over macfile macseg exhread - dup
  83.                         \ clear out the buffer on read length wrong!
  84.                         if      macseg 0 #macros macsiz * 0 lfill
  85.                         then    macfile hclose drop
  86.                 then    ( --- f1 )      \ true if failed
  87.                 37 5 at >rev
  88.                 if      ."  No Macros to load.\s05\b"
  89.                 else    ."  Macros Loaded.\s13"
  90.                 then    >norm 1 seconds ;
  91.  
  92. : viewmacs      ( --- )
  93.                 savescr
  94.                 6 2 74 over #macros 2* + 3 + box&fill
  95.                 ." Press \r ESC \0 when done viewing macros."
  96.                 bcr bcr macsiz 2/
  97.                 #macros 0
  98.                 do      i 1+ 1 .r ." "
  99.                         macseg macsiz i * 2 pick          typeL bcr
  100.                         ."   "
  101.                         macseg macsiz i * 2 pick + 2 pick typeL bcr
  102.                 loop    drop
  103.                 defers key drop
  104.                 restscr ;
  105.  
  106. : .askmacro     ( --- )
  107.                 savecursor
  108.                 cursor-off savescr
  109.                 ['] noop save!> dobutton
  110.                 10  4 70 19 box&fill
  111.                 ."  \r Making a MACRO... "
  112.                 bcr bcr
  113.         ."  First press \r Alt-1 \0 through \r Alt-8 \0 to specify the macro"
  114.                 bcr
  115.         ."  you are making, then; enter the keys of your macro,"
  116.                 bcr
  117.         ."  finally; press Alt-M again to finish making a macro."
  118.                 bcr
  119.         ."  ────────────────────────────────────────────────────────"
  120.                 bcr
  121.         ."  To CANCEL making a macro press \r ESC \0 now."
  122.                 bcr bcr
  123.         ."  To PERFORM a macro press \r Alt-1 \0 through \r Alt-8 \0 when "
  124.                 bcr
  125.         ."  you are \r NOT \0 looking at this window."
  126.                 bcr bcr
  127.                 ."  Press \r V \0 to VIEW the currently defined macros."
  128.                 bcr bcr
  129.                 ."  Press \r L \0 to load macros, or \r S \0 to save macros."
  130.                 defers key
  131.                      27 over       = if drop 178            then
  132.                 'v' over bl or = if drop 178 viewmacs   then
  133.                 'l' over bl or = if drop 178 loadmacs   then
  134.                 's' over bl or = if drop 178 savemacs   then
  135.                 restore> dobutton
  136.                 restscr
  137.                 restcursor ;
  138.  
  139. : .repmac       ( --- )
  140. 25 07 .box" Repeating a MACRO."
  141. 01 10 .box" Enter a # between 000 and 999 for the number of times to repeat the macro."
  142. 30 13 .box"         "
  143. 17 16 .box" Enter the macro key Alt-1 to Alt-8"
  144. 32 14 at ;
  145.  
  146. : setmac        ( n1 --- )      \ set the current macro pointer.
  147.                 macsiz * curmac ! ;
  148.  
  149. : ?domac        ( --- <c1> )    \ Are we doing a macro, if so return a key.
  150.                 ?doingmac
  151.                 if      curmac @ ms: c@l curmac @ 1+ ms: c@l 0=
  152.                         if      off> ?doingmac
  153.                         then    curmac incr 2r> 2drop
  154.                 then    ;
  155.  
  156. : ?domac1       ( c1 --- c2 )   \ If a macro key, start macro and return
  157.                                  \ the first macro key if its good.
  158.                 dup macbase dup #macros 1- + BETWEEN
  159.         if      on> ?doingmac macbase - setmac
  160.                 curmac @ ms: c@l curmac incr ?dup 0=
  161.                 if      off> ?doingmac
  162.                         curmac @ 1- macsiz / macbase +
  163.                 then
  164.         then    ;
  165.  
  166. variable mactimes       \ number of times to perform a macro
  167. variable repkey         \ macro key we are repeating
  168.  
  169. : ?repmac       ( --- <c1> )
  170.                 mactimes @
  171.                 if      mactimes decr
  172.                         repkey @ ?domac1 2r> 2drop
  173.                 then    ;
  174.  
  175. : ?repmac1      ( c1 --- c1 )
  176.                 dup 147 = makingmac @ 0= and    \ Alt-R = repeating
  177.                 if      drop
  178.                         savecursor
  179.                         savescr cursor-on .repmac
  180.                         0
  181.                         begin   defers key dup '0' '9' between
  182.                         while   dup emit '0' - swap 10 * + 999 min
  183.                         repeat
  184.                         restscr
  185.                         restcursor
  186.                         swap 1- 0MAX 999 min mactimes !
  187.                         dup repkey !
  188.                 then    ;
  189.  
  190. : ?addmac       ( c1 --- c1 )   \ conditionally add a key to current macro.
  191.                 makingmac @
  192.                 if      dup curmac @ ms: c!l
  193.                         curmac incr
  194.                         0 curmac @ ms: !l
  195.                 then    ;
  196.  
  197. : ?start/stopmac ( --- c1 )     \ Conditionally start of stop making a macro.
  198.                 begin   defers key
  199.                         dup 178 = makingmac @ 0= and    \ Alt-M = Make macro
  200.                         if      drop .askmacro
  201.                                                         \ Alt-1 to Alt-5
  202.                                 dup macbase dup #macros 1- +
  203.                                 BETWEEN 0=              \ macro key number
  204.                                 if      exit
  205.                                 then
  206.                                 macbase - setmac
  207.                                 savecursor
  208.                                 savescr cursor-off
  209.                                 20  6 60 10 box&fill
  210.                                 bcr
  211.                                 ." \s04\r Enter the keys of your macro \:03"
  212.                                 restscr
  213.                                 restcursor
  214.                                 curmac @ ms: macsiz 0 lfill
  215.                                 makingmac on
  216.                                 defers key
  217.                         then    dup 178 = makingmac @ and \ Alt-M and making
  218.                 while   drop makingmac off
  219.                         savecursor
  220.                         savescr cursor-off
  221.                         20  6 60 10 box&fill
  222.                         bcr ."     \r *** Make Macro Completed *** \:10"
  223.                         restscr
  224.                         restcursor
  225.                 repeat  ;
  226.  
  227. headers
  228.  
  229. : mackey        ( --- c1 )      \ This definition looks more like PASCAL
  230.                 macseg 0=
  231.                 if      defers key
  232.                 else    ?domac  ?repmac  ?start/stopmac
  233.                         ?addmac ?repmac1 ?domac1
  234.                 then    ;
  235.  
  236.  
  237. \ Alt-1 = 248, to Alt-5 = 252
  238.  
  239. ' mackey is key
  240.  
  241. behead
  242.  
  243. only forth also definitions
  244.  
  245.