home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
CP/M
/
CPM_CDROM.iso
/
mbug
/
mbug101.arc
/
CUSTOM.BLK
< prev
next >
Wrap
Text File
|
1979-12-31
|
23KB
|
1 lines
\ 19Feb85bib Additions to Perry and Laxen's FORTH-83 by: Bruce Berryhill Micro Cornucopia P.O. Box 223 Bend, OR 97709 (503)-382-8048 \ Load screen for the custom code 20Feb85bib5 view# c! 2 load cr .( Printer words) 5 load cr .( Full screen editor) 8 load cr .( case statement) 9 load \ EPSON 20Feb85bib vocabulary PRINTER printer definitions : ESC 27 (print) (print) ; -1 CONSTANT ON 0 CONSTANT OFF : RESET 64 esc ; : 6-LINES 50 esc ; : 8-LINES 48 esc ; : 10-LINES 49 esc ; : PAPER-OUT 56 SWAP - esc ; (s flag -- ) : BIT-8 61 SWAP - esc ; (s flag -- ) : TABS 68 esc BEGIN ?DUP WHILE (print) REPEAT ; --> \ EPSON 20Feb85bib: PRINT-TWO ESC (print) ; (s param function -- ) : DOUBLE-WIDTH 87 PRINT-TWO ; (s flag -- ) : UNDERLINE 45 PRINT-TWO ; (s flag -- ) : UNIDIRECTION 85 PRINT-TWO ; (s flag -- ) : SKIP ?DUP IF 78 PRINT-TWO (s lines -- ) ELSE 79 esc then ; : COLUMNS 81 PRINT-TWO ; (s width -- ) : LINES ?DUP IF 67 PRINT-TWO then ; (s length -- ) : INCHES 0 67 PRINT-TWO (print) ; (s length -- ) : /216" 74 PRINT-TWO ; (s line-spacing -- ) : /72" 65 PRINT-TWO ; (s line-spacing -- ) : LO 0 ; : HI 1 ; : RES 75 + esc dup (print) flip (print) ; (s num-bytes f - ) --> \ EPSON 20Feb85bib: ON-OFF + esc ; (s flag function -- ) : COMPRESS 3 * 18 ON-OFF ; (s flag -- ) : EMPHASIZE 70 ON-OFF ; (s flag -- ) : DOUBLE-STRIKE 72 ON-OFF ; (s flag -- ) : ITALIC 53 ON-OFF ; (s flag -- ) : SUPER 1 ; : SUB 2 ; : SCRIPT ?DUP IF 1- 83 PRINT-TWO ( super,sub script) (s f -) ELSE 84 esc then ; ( off script ) FORTH DEFINITIONS \ Full screen action routines 20Feb85bib editor definitions variable INSERTING inserting on : LEFT-CHAR -1 c ; : RIGHT-CHAR 1 c ; : UP-LINE -1 l ; : DOWN-LINE 1 l ; : TAB cursor 3 or 1+ cursor - c ; : BACK-TAB cursor 1- -4 and cursor - c ; : INSRT inserting @ 0= dup inserting ! 40 0 at if ." Insert" else ." " then ; : NEXT-LINE cursor 63 or 1+ cursor - c ; : DEL-CHAR 'c#a 1 delete ; : RUB-OUT -1 c del-char ; : NEXT-SCR n .all ; : BACK-SCR b .all ; --> \ Full screen jump table and help 20Feb85bibcreate ACTION \ Action table for screen editor ] ( @ ) noop noop noop next-scr right-char ( e ) up-line noop del-char noop tab ( j ) down-line noop noop next-line split ( o ) noop noop noop back-scr left-char ( t ) top back-tab insrt w down-line ( y ) x noop noop noop noop ( ~ ) noop noop [ : .ENTRY ascii ^ emit dup ascii @ + emit 3 spaces 2* action + @ >name .id ; : HELP cr ." ESC exits video mode" cr 32 0 do 4 0 do [ forth ] i 20 * #out @ - spaces j i + [ editor ] .entry loop cr 4 +loop ." Strike any key" key ed ; --> \ Full screen extension for the editor 18Feb85bibvariable KEY-PRESS 27 constant ESC : CHR (s - ) key-press 1 'c#a inserting @ if insert else replace then modified ; : SHOW-IT line# redisplay 'start 'video b/buf cmove ; : NEW .all insrt insrt begin edit-at key dup key-press ! dup esc <> while dup bl < if 2* action + perform .scr else 127 = if rub-out show-it else chr show-it 1 c then then repeat drop .all ; forth definitions \ Case statement 20Feb85bibcode (OF) h pop d pop d push l a mov e cmp ' branch @ jnz h a mov d cmp ' branch @ jnz d pop ip inx ip inx next c; 0 constant CASE immediate : OF compile (of) ?>mark ; immediate : ENDOF [compile] else ; immediate : ENDCASE compile drop begin ?dup while ?>resolve repeat ; immediate exit \ Save system as .COM file and add screens to file 19Feb85bib: SAVE \ filename [ editor ] id id-len erase save ; : MAXSCREEN maxrec# @ 1- rec/blk / ; : MORE-SCREENS (S #blocks -- ) 1 ?enough dup >r maxscreen 1+ + maxscreen 1+ r> more ?DO I BUFFER B/BUF BLANK UPDATE LOOP SAVE-BUFFERS [ cp/m ] CLOSE ; \ 12Dec84bib: VOCS (S -- ) VOC-LINK @ BEGIN DUP #THREADS 2* - dup context ! cr cr lmargin @ spaces BODY> >NAME .ID words @ DUP 0= UNTIL DROP ;
