-
Notifications
You must be signed in to change notification settings - Fork 2
/
EDITOR.BLK
executable file
·1 lines (1 loc) · 48 KB
/
EDITOR.BLK
1
\ One/Forth Editor for the Atari ST \ 11Dec89 b0b Based on the works of Henry Laxon Ray Duncan Pat Mullarky John Dunn Customized for the ST by b0b Lee. In the public domain. \ load screen \ 21:27 1Nov87 b0b WARNING ON CR .( Loading VT-52 commands. ) 2 LOAD CR .( Loading CapsLock sensor. ) 43 44 THRU CR .( Loading EDITOR ) 3 38 THRU CR .( Loading QX. ) 39 LOAD 1 SCR ! \ vt52 words \ 4Mar87 bl : ESC+ ( c -- ) 27 EMIT EMIT ; : VXY ( y x -- ) ASCII Y ESC+ BL + EMIT BL + EMIT ; : CLS ASCII E ESC+ ; : C-EOL ASCII K ESC+ ; : REVERSE ASCII p ESC+ ; : NORMVID ASCII q ESC+ ; : CURON ASCII e ESC+ ; : CUROFF ASCII f ESC+ ; : SAVXY ASCII j ESC+ ; : OLDXY ASCII k ESC+ ; \ GET-TIME GET-DATE \ 21:52 11Dec89 b0b HEX \ : GET-TIME ( -- min hr ) \ returns 24 hour time \ t_gettime \ DOS gives us coded time \ DUP 20 / 3F AND \ shift and mask minute \ SWAP 800 / 1F AND ; \ shift and mask hour : GET-DATE ( -- yr mo day ) \ returns date from GEMDOS t_getdate >R \ coded date on r-stack R@ 200 / 50 + \ shift & add 80 for year R@ 20 / 0F AND \ shift & mask for month R> 1F AND ; \ mask off day bits DECIMAL \ WITHIN from je \ 19:34 22Nov87 b0b : WITHIN (S n min max -- f ) \ TRUE if min<=n<=max ) >R OVER > SWAP R> > OR NOT ; \ INPUT# \ 19:34 22Nov87 b0b HEX : INPUT# ( -- n ) \ Get a decimal number from the user PAD 10 20 FILL 30 PAD 1+ C! \ start with a zero 1 BEGIN KEY DUP 30 39 WITHIN \ get digits WHILE DUP EMIT OVER PAD + C! 1+ \ and stash them REPEAT DROP \ drop illegal key PAD C! \ stash count PAD NUMBER DROP ; \ convert string to 16bit # DECIMAL \ EDITOR variables and constants, -TIDY \ 9Oct87 b0b ONLY FORTH ALSO VOCABULARY EDITOR EDITOR DEFINITIONS ALSO VARIABLE &MODE \ insert mode flag VARIABLE &CURSOR \ cursor pointer in buffer VARIABLE &UPDATE \ update flag VARIABLE &BUF-ADR \ start of current buffer 8 CONSTANT %X-OFF \ video x and y offset 3 CONSTANT %Y-OFF DEFER .STATUS \ vector to status display : -TIDY ( adr count -- ) \ removes countrol chars BOUNDS DO I C@ BL < \ BOUNDS is OVER + SWAP IF BL I C! THEN LOOP ; \ PACK.STAMP \ 21:58 11Dec89 b0b CREATE ID ," \ dMmm87 b0b " \ ID stamp CREATE MONTHS ," JanFebMarAprMayJunJulAugSepOctNovDec" : ID! ( b n -- ) SWAP ASCII 0 + SWAP ID + C! ; : PACK.STAMP ( -- ) \ packs date and time into ID stamp \ GET-TIME 10 /MOD ?DUP \ IF 4 ID! \ tens digit of hour \ ELSE BL ID 4 + C! THEN 5 ID! \ ones digit of hour \ 10 /MOD 7 ID! 8 ID! \ minute digits GET-DATE 10 /MOD ?DUP IF 5 ID! \ tens digit of day THEN 6 ID! \ ones digit of day 1- 3* MONTHS 1+ + ID 7 + 3 CMOVE \ month string 10 /MOD 10 ID! 11 ID! ; \ year digits \ CURPOS MOVE-CURSOR \ 22:42 22Nov87 b0b : CURPOS ( -- n ) &CURSOR @ ; \ returns buffer pointer : 0CURPOS ( -- ) &CURSOR OFF ; \ zeros buffer pointer : +CURPOS ( n -- ) \ moves buffer pointer n bytes CURPOS + 0 MAX B/BUF 1- MIN &CURSOR ! ; : VIDCUR ( -- ) \ position video cursor CURPOS C/L /MOD %Y-OFF + SWAP %X-OFF + SWAP VXY SAVXY ; : MOVE-CURSOR ( n -- ) \ add n to pointer and move +CURPOS CURPOS VIDCUR ; \ cursor on the video display : BUF-ADR ( n -- adr ) &BUF-ADR @ + ; : BUFPOS ( -- adr ) CURPOS BUF-ADR ; \ >LINE# DISP>EOL \ 25Feb87 bl : >LINE# ( pos -- line ) C/L / ; : LINE#> ( line -- pos ) C/L * ; : BUF-MOVE ( n1 n2 count -- ) \ Move count bytes from ROT BUF-ADR ROT BUF-ADR \ position n1 to position n2 ROT MOVE &UPDATE ON ; : CHARS-EOL C/L MOD C/L SWAP - ; : DISP>EOL ( pos -- ) \ display chars from cursor to line end SAVXY DUP BUF-ADR SWAP CHARS-EOL TYPE OLDXY ; : CUR>EOL CUROFF CURPOS DISP>EOL CURON ; \ DISPLAY-TO-EOS EXPAND SHRINK \ 20:45 23Nov87 b0b : ?EMPTY-LINE LINE#> BUF-ADR C/L -TRAILING SWAP DROP 0= ; : DISPLAY-TO-EOS ( line# -- ) CUROFF CURPOS L/SCR ROT DO I LINE#> DUP &CURSOR ! VIDCUR DISP>EOL LOOP &CURSOR ! VIDCUR CURON ; : EXPAND DUPDUP C/L + B/BUF OVER - BUF-MOVE BUF-ADR C/L BLANK ; : SHRINK DUP C/L + SWAP OVER B/BUF SWAP - BUF-MOVE [ L/SCR 1- LINE#> ] LITERAL BUF-ADR C/L BLANK CURPOS >LINE# DISPLAY-TO-EOS ; \ I-LINE INS-CHAR DEL-CHAR ARROWS \ 20:46 23Nov87 b0b : EOS [ 15 LINE#> ] LITERAL &CURSOR ! VIDCUR ; : I-LINE ( -- ) CURPOS L/SCR 1- ?EMPTY-LINE IF DUP EXPAND >LINE# DISPLAY-TO-EOS ELSE BEEP THEN ; : INS-CHAR DUPDUP 1+ OVER CHARS-EOL 1- BUF-MOVE BUF-ADR C! &UPDATE ON ; : DEL-CHAR DUPDUP 1+ SWAP OVER CHARS-EOL BUF-MOVE DUP CHARS-EOL + 1- BUF-ADR BL SWAP C! ; : U-ARROW C/L NEGATE +CURPOS ; : D-ARROW C/L +CURPOS ; : R-ARROW 1 +CURPOS ; : L-ARROW -1 +CURPOS ; \ D-CHAR D-LINE I-MODE RETURN E-TAB REDISP \ 22:37 22Nov87 b0b : D-CHAR CURPOS DEL-CHAR CUR>EOL ; : D-LINE CURPOS >LINE# LINE#> SHRINK ; : EAT64 CURPOS SHRINK ; : I-MODE &MODE @ 1 XOR &MODE ! .STATUS ; : RETURN CURPOS >LINE# 1+ L/SCR 1- MIN LINE#> &CURSOR ! ; : E-TAB 4 CURPOS 4 MOD - +CURPOS ; : REDISP 0 DISPLAY-TO-EOS ; \ STAMP EXIT words \ 21:58 11Dec89 b0b : STAMP ( -- ) \ move n chars from ID to top line of buffer PACK.STAMP ID COUNT >R C/L R@ - &BUF-ADR @ + R> CMOVE CURPOS 0CURPOS VIDCUR CUR>EOL &CURSOR ! ; : EXIT-EDIT ( -- ) 0 21 VXY C-EOL FORTH QUIT ; : .SCR. ( -- ) 0 20 VXY C-EOL %X-OFF SPACES SCR ? ; : EXIT-UPDATE ( -- ) .SCR. &UPDATE @ IF ." Modified " STAMP UPDATE FLUSH ELSE ." Unmodified " THEN EXIT-EDIT ; : EXIT-SCRATCH ( -- ) .SCR. ." Abandoned " EMPTY-BUFFERS EXIT-EDIT ; \ SCAN words \ 21:37 1Nov87 b0b : SCAN+= 2DUP = IF 3DROP 0 ELSE 0 -ROT DO OVER I C@ = IF LEAVE ELSE 1+ THEN LOOP NIP THEN ; : SCAN+<> 2DUP = IF 3DROP 0 ELSE 0 -ROT DO OVER I C@ <> IF LEAVE ELSE 1+ THEN LOOP NIP THEN ; : SCAN-= 2DUP = IF 3DROP 0 ELSE 0 -ROT DO OVER I C@ = IF LEAVE ELSE 1- THEN -1 +LOOP NIP THEN ; : SCAN-<> 2DUP = IF 3DROP 0 ELSE 0 -ROT DO OVER I C@ <> IF LEAVE ELSE 1- THEN -1 +LOOP NIP THEN ; \ R-WORD L-WORD DEL-CHARS \ 22:37 22Nov87 b0b : MOVE-L-WORD BL 0 BUF-ADR BUFPOS SCAN-= >R BL 0 BUF-ADR BUFPOS R@ + SCAN-<> R> + >R BL 0 BUF-ADR BUFPOS R@ + SCAN-= R> + DUP BUFPOS + C@ BL = ABS + ; : MOVE-R-WORD BL B/BUF 1- BUF-ADR BUFPOS SCAN+= >R BL B/BUF 1- BUF-ADR BUFPOS R@ + SCAN+<> R> + ; : R-WORD MOVE-R-WORD +CURPOS ; : L-WORD MOVE-L-WORD +CURPOS ; : DEL-CHARS 2DUP + OVER DUP CHARS-EOL BUF-MOVE DUP CHARS-EOL + OVER - BUF-ADR SWAP BLANK ; \ D-WORD U-TAB D-TAB CLRSCR L-DEL \ 22:43 22Nov87 b0b : D-WORD MOVE-R-WORD CURPOS BUF-ADR CURPOS CHARS-EOL -TRAILING NIP MIN CURPOS DEL-CHARS CUR>EOL ; : U-TAB [ C/L -4 * ] LITERAL +CURPOS ; : D-TAB [ C/L 4 * ] LITERAL +CURPOS ; : CLRSCR 0CURPOS 0 BUF-ADR B/BUF BLANK REDISP &UPDATE ON ; : L-DEL L-ARROW CURPOS DEL-CHAR VIDCUR CUR>EOL ; \ CLR-LINE RENEW GSCR \ 22:38 22Nov87 b0b : CLR-LINE CURPOS DUP >LINE# LINE#> &CURSOR ! CURPOS BUF-ADR C/L BLANK &UPDATE ON VIDCUR CURPOS C-EOL CUR>EOL &CURSOR ! ; : RENEW SCR @ BLOCK &BUF-ADR ! REDISP ; : CLR1 ( -- ) \ clear prompt line %X-OFF %Y-OFF 2 - VXY C-EOL ; : GSCR CLR1 ." Jump to Screen: " INPUT# ; \ ED-NEXT ED-BACK ED-FWD JUMP \ 21:06 1Nov87 b0b : ED-NEXT .STATUS &UPDATE @ IF STAMP UPDATE FLUSH &UPDATE OFF THEN RENEW ; : ED-BACK SCR DEC ED-NEXT ; : ED-FWD SCR INC ED-NEXT ; : JUMP GSCR SCR ! ED-NEXT ; : RESTOR EMPTY-BUFFERS RENEW &UPDATE OFF ; \ Line and Word buffers defined \ 21:06 1Nov87 b0b CREATE LBUF 1024 ALLOT \ the line buffer VARIABLE LBPTR LBUF LBPTR ! \ line buffer pointer VARIABLE LCNT 0 LCNT ! \ line count CREATE WBUF 1024 ALLOT \ the "word" buffer VARIABLE WBPTR WBUF WBPTR ! \ word buffer pointer VARIABLE WCNT 0 WCNT ! \ word count : 0LINE CURPOS >LINE# LINE#> &CURSOR ! ; : LPUSH ( -- ) LCNT @ L/SCR < IF 0LINE LCNT INC BUFPOS LBPTR @ C/L CMOVE C/L LBPTR +! .STATUS ELSE BEEP THEN ; \ LPOP GETLINE CPYLINE \ 21:08 1Nov87 b0b : LPOP LCNT @ IF LCNT DEC 0LINE I-LINE -64 LBPTR +! LBPTR @ BUFPOS 64 CMOVE CUR>EOL .STATUS ELSE BEEP THEN ; : GETLINE LPUSH D-LINE ; : CPYLINE LPUSH D-ARROW ; VARIABLE BUFPTR : !CHAR WBPTR @ C! WBPTR INC ; : @CHAR BUFPTR @ C@ BUFPTR INC ; \ WPUSH \ 21:22 1Nov87 b0b : WPUSH ( -- ) WBPTR @ WBUF 1000 + U> CURPOS >LINE# ?EMPTY-LINE OR IF BEEP ELSE BEGIN BUFPOS C@ BL = WHILE CURPOS DEL-CHAR REPEAT BUFPOS BUFPTR ! 0 !CHAR 0 BEGIN 1+ @CHAR DUP !CHAR BL = UNTIL CURPOS DEL-CHARS CUR>EOL WCNT INC .STATUS THEN ; \ WPOP \ 21:09 1Nov87 b0b : WPOP WCNT @ IF CURPOS BEGIN WBPTR DEC WBPTR @ C@ ?DUP WHILE CURPOS INS-CHAR REPEAT WCNT DEC DISP>EOL .STATUS ELSE BEEP THEN ; \ .FUNCS BOXTOP BOXBOT \ 20:41 23Nov87 b0b : .FUNCS ( -- ) \ prints the function key legend 4 [ %Y-OFF L/SCR + 1+ ] LITERAL VXY REVERSE ." F1: Search F2: Insert F3: -Search " ." F4: +Search F5: End Line " 4 [ %Y-OFF L/SCR + 2+ ] LITERAL VXY ." F6: Buf Word F7: Get Word F8: Del Line " ." F9: Back Scr F10: Fwd Scr " NORMVID ; : DSHLINE REVERSE C/L 0 SPACE DO 45 EMIT LOOP SPACE NORMVID ; : BOXTOP ( -- ) %X-OFF 1- %Y-OFF 1- VXY DSHLINE ; : BOXBOT ( -- ) %X-OFF 1- %Y-OFF L/SCR + VXY DSHLINE ; \ COMP \ 18:47 10Oct87 b0b CODE COMP (S addr1 addr2 len -- f ) SP )+ D0 MOVE 1 D0 ADDQ SP )+ D6 MOVE 0 D6.L BASE DI) A0 LEA WORD SP )+ D6 MOVE 0 D6.L BASE DI) A1 LEA WORD BEGIN 1 D0 SUBQ 0<> WHILE BYTE A1 )+ A0 )+ CMPM WORD 0<> IF SP -) CLR NEXT THEN REPEAT TRUE # SP -) MOVE NEXT END-CODE \ SEARCH \ 18:44 10Oct87 b0b VARIABLE $LEN : SEARCH ( adr1 adr2 len2 -- n f ) \ Search for the string at adr1 within the larger string \ at adr2. If found, n is the offset from the beginning \ of adr2, otherwise n is adr1. $LEN holds length of \ the string at adr1. 0 DO 2DUP I + $LEN @ ( COMPARE 0= ) COMP IF 2DROP I FALSE LEAVE THEN LOOP 0= ; \ 2Nov86 bl \ GETSRCH BUFSRCH \ 4Mar87 bl CREATE SBUF 32 ALLOT VARIABLE SDIRECTION 1 SDIRECTION ! VARIABLE OLDSCR : GETSRCH ( -- ) \ get search info from user CLR1 ." Search for: " SBUF 32 EXPECT SPAN @ $LEN ! ; : BUFSRCH CUROFF 17 0 VXY SCR @ 3 .R 1 +CURPOS SBUF BUFPOS B/BUF CURPOS - SEARCH CURON ; \ SCRSRCH SRCH \ 19:44 22Nov87 b0b : SCRSRCH CLR1 ." Searching for: " SBUF $LEN @ TYPE SCR @ OLDSCR ! BUFSRCH 0= \ search the current scr IF DROP &UPDATE @ \ no luck, start loop IF STAMP UPDATE FLUSH THEN \ don't lose current scr BEGIN SDIRECTION @ SCR +! \ bump scr # SCR @ 0 CAPACITY 1- WITHIN NOT \ out of range? KEY? IF KEY OR THEN \ or user abort? IF BEEP OLDSCR @ DUP SCR ! \ back to old scr BLOCK &BUF-ADR ! \ fresh copy .STATUS EXIT THEN \ and abort SCR @ BLOCK &BUF-ADR ! \ read next scr 0CURPOS BUFSRCH 0= \ found string? WHILE DROP REPEAT \ no, loop de loop THEN +CURPOS SCR @ OLDSCR @ <> IF RENEW THEN .STATUS ; \ string found, happy ending!! \ (CURSORS) \ 22Sep87 b0b : SRCH GETSRCH SCRSRCH ; : +SRCH 1 SDIRECTION ! SCRSRCH ; : -SRCH -1 SDIRECTION ! SCRSRCH ; : HOME 0CURPOS VIDCUR ; : INSERT BL CURPOS INS-CHAR CUR>EOL ; : END-LINE RETURN BL 0 BUF-ADR BUFPOS 1- SCAN-<> 1+ +CURPOS ; CREATE (CURSORS) ] SRCH I-MODE -SRCH +SRCH END-LINE ( F1-F5 ) WPUSH WPOP D-LINE ED-BACK ED-FWD ( F6-F10 ) BEEP BEEP HOME U-ARROW U-TAB BEEP L-ARROW BEEP R-ARROW BEEP BEEP D-ARROW D-TAB INSERT D-CHAR BEEP [ CREATE ESCKEYS \ 22:41 22Nov87 b0b ] BEEP ED-BACK BEEP BEEP ( A-D) BEEP FLUSH BEEP BEEP BEEP ( E-I) BEEP BEEP BEEP BEEP ED-FWD ( J-N) BEEP BEEP EXIT-SCRATCH BEEP SCRSRCH ( O-S) BEEP BEEP BEEP SRCH EXIT-UPDATE ( T-X) CLRSCR BEEP EXIT-UPDATE [ ( Y Z ESC ) : ESCFUNC ( -- ) %X-OFF %Y-OFF 2 - 2DUP VXY REVERSE ." esc " NORMVID KEY \ prompt, get key >R VXY 5 SPACES R> \ erase prompt DUP ASCII A >= IF 31 AND THEN \ letters index array DUP 1 27 WITHIN IF 1- 2* ESCKEYS + @ EXECUTE ELSE BEEP DROP .STATUS THEN ; CREATE (CONTROL-CHAR) \ 19:45 22Nov87 b0b ] BEEP L-WORD LPOP EOS R-ARROW ( nul-D) U-ARROW R-WORD D-CHAR L-DEL E-TAB ( E-I) JUMP BEEP CPYLINE RETURN I-LINE ( J-N) BEEP GETLINE BEEP HOME L-ARROW ( O-S) D-WORD BEEP I-MODE U-TAB D-ARROW ( T-X) EAT64 D-TAB ESCFUNC STAMP BEEP ( Y Z Esc \ ]) BEEP BEEP [ ( ^ - ) HEX : ?CURSORS DUP 3B00 5500 WITHIN IF 100 / 3B - 2* (CURSORS) + @ EXECUTE ELSE DROP BEEP THEN ; DECIMAL \ ScrEdit \ 25Feb87 bl : HELPCTRL CR 8 SPACES ." Cursor controls:" CR CR ." Left: ^S Right: ^D Up: ^E Down: ^X" CR ." Home: ^R End: ^C Utab: ^W Dtab: ^Z" CR ." EndLn: F5 Lword: ^A Tab: ^I Rword: ^F" CR CR ." Del Line: ^Y Ins Line: ^N Del word: ^T" CR CR ." Jump to Another Screen : ^J" CR CR 8 SPACES ." Line Buffer Commands:" CR CR ." Copy Line: ^L Restore Line: ^B Pull Line: ^P" CR CR ; \ .FRAME HELPESC \ 22:41 22Nov87 b0b : HELPESC ." Escape Functions:" CR CR ." Esc-B Back one scr Esc-F Flush" CR ." Esc-N Forward 1 scr Esc-Q Quit (Abandon Edit)" CR ." Esc-Y Wipe screen Esc-Esc Flush & Quit" CR ; : .FRAME CUROFF BOXTOP CR L/SCR 0 DO 3 SPACES I 3 .R SPACE REVERSE ASCII | EMIT %X-OFF C/L + I %Y-OFF + VXY ASCII | EMIT NORMVID CR LOOP BOXBOT .FUNCS REDISP ; \ DOHELP CONTROL-CHAR \ 21:24 22Nov87 b0b : DOHELP CLS HELPCTRL HELPESC KEY DROP CLS .FRAME .STATUS ; : CONTROL-CHAR [ HEX ] DUP 2000 = IF DROP D-LINE ELSE \ alt D DUP 7300 = IF DROP L-WORD ELSE \ ctrl <- DUP 7400 = IF DROP R-WORD ELSE \ ctrl -> DUP 6200 = IF DROP DOHELP ELSE \ help DUP 6100 = IF DROP RESTOR ELSE \ undo DUP 07F = IF DROP D-CHAR ELSE \ del DUP BL < IF 2* (CONTROL-CHAR) + @ EXECUTE ELSE ?CURSORS THEN THEN THEN THEN THEN THEN THEN ; DECIMAL \ .STAT E-INIT \ 22:41 22Nov87 b0b : .STAT ( -- ) CUROFF \ update the status line CLR1 [ %X-OFF C/L + 9 - ] LITERAL 1 VXY &MODE @ IF REVERSE ." insert " NORMVID ELSE C-EOL THEN 10 0 VXY ." Screen " SCR @ 3 .R 31 0 VXY ." Buffered lines:" LCNT @ 2 .R 52 0 VXY ." Buffered words:" WCNT @ 2 .R OLDXY .CAPSTAT CURON ; ' .STAT IS .STATUS : E-INIT DEPTH IF SCR ! THEN SCR @ BLOCK &BUF-ADR ! 0CURPOS &UPDATE OFF CAPS_LOCK? 0= CAPS-FLG ! CLS .STATUS .FRAME ; \ E-OVERSTRIKE E-INSERT \ 19:35 22Nov87 b0b : E-OVERSTRIKE ( -- ) .CAPSTAT KEY DUP BL 126 WITHIN IF DUP EMIT BUFPOS C! &UPDATE ON 1 +CURPOS ELSE CONTROL-CHAR THEN ; : E-INSERT ( -- ) .CAPSTAT KEY DUP BL 126 WITHIN IF CURPOS INS-CHAR CUR>EOL 1 +CURPOS ELSE CONTROL-CHAR THEN ; ONLY FORTH ALSO DEFINITIONS \ 22Sep87 b0b : EDIT EDITOR [ EDITOR ] E-INIT BEGIN VIDCUR &MODE @ IF E-INSERT ELSE E-OVERSTRIKE THEN AGAIN ; : CLEAR BUFFER B/BUF BLANK UPDATE FLUSH ; : E EDIT ; : ED EDIT ; ONLY FORTH ALSO \ bl \ QX quick index \ 19:50 9Nov87 b0b : QX ( -- ) CUROFF FILE? \ print file name CAPACITY 0 \ for all screens DO I 3 MOD 0= \ 3 indexes per line IF CR THEN I 2 .R SPACE \ print screen # I BLOCK \ load block 2+ 20 TYPE \ show short index 2 SPACES LOOP CURON ; \ .QX for TRS-80 fp-215 flatbed plotter \ 19:50 9Nov87 b0b : .QX ( -- ) PRINTING ON [ DOS ] CR FILE? CR \ print file name 0 2 0 FILE @ FSEEK \ start at 3rd byte in file CAPACITY 0 \ for all screens DO SPACE 3 0 \ 3 indexes per line DO PAD ADD-BASE 16. HA@ READ \ read 16 bytes 0 <> SWAP 16 <> OR IF LEAVE THEN \ trap error J I + 2 .R SPACE \ print screen # PAD 16 TYPE 2 SPACES \ show short index 1 1008 0 FILE @ FSEEK \ advance file pointer LOOP PRINTING OFF CR PRINTING ON 3 \ printer wraps, no CR needed +LOOP 0 B/BUF 0 FILE @ FSEEK PRINTING OFF ; \ .TRIAD for TRS-80 fp-215 flatbed plotter \ 4Mar87 bl : .TYPE ( adr n -- ) \ print n bytes from adr 0 DO DUP C@ (PRINT) 1+ LOOP DROP ; : .TRIAD ( n -- ) CR PRINTING ON #OUT OFF 3 / 3 * DUP 3 + SWAP DO ." Screen # " I . 38 SPACES FILE? 64 #OUT @ - SPACES I BLOCK 1024 .TYPE CR #OUT OFF LOOP PRINTING OFF ; \ WORDS from CP/M source \ 2Nov86 bl : LARGEST ( adr n -- adr' val ) OVER 0 SWAP ROT 0 DO 2DUP @ U< IF -ROT 2DROP DUP @ OVER THEN 2+ LOOP DROP ; : WORDS ( -- ) CR CONTEXT @ HERE #THREADS 2* CMOVE BEGIN HERE #THREADS LARGEST DUP WHILE DUP 2+ DUP C@ 31 AND #OUT @ + 69 > IF CR ELSE 11 #OUT @ 12 MOD - SPACES THEN .ID @ SWAP ! KEY? IF CR EXIT THEN REPEAT 2DROP CR ; \ CAPS_LOCK? \ 29Mar87 bl CODE kbshift ( -- b ) \ b contains keyboard status bits -1 # SP -) MOVE 11 # SP -) MOVE 13 TRAP LONG 4 SP ADDQ WORD D0 SP -) MOVE NEXT END-CODE HEX : CAPS_LOCK? ( -- f ) \ returns true if CapsLock is engaged kbshift 10 AND 0= 0= ; DECIMAL \ .CAPSTAT \ 29Mar87 bl VARIABLE CAPS-FLG : .CAPSTAT ( -- ) CAPS_LOCK? DUP CAPS-FLG @ <> IF SAVXY 74 11 VXY IF CAPS-FLG ON REVERSE ." CAPS!" NORMVID ELSE CAPS-FLG OFF 5 SPACES THEN OLDXY ELSE DROP THEN ; \ 29Mar87 bl