\ PRINTING.SEQ Export & Import for SED. by 1987 Tom Zimmer only forth also hidden also editor also definitions variable dolst dolst off : ptype ( a1 n1 --- ) \ type a string to the printer prnhndl hwrite #out +! ; : pcr ( --- ) 13 pemit 10 pemit #out off ; : .p## ( N1 --- ) \ Print two low digits of n1. 0 <# # # #> ptype ; : <.ptime> base @ >r decimal swap 0 256 um/mod .p## " :" ptype .p## " :" ptype 0 256 um/mod .p## drop \ " ." ptype .p## R> BASE ! ; : <.pdate> ( d1 --- ) base @ >r decimal 0 256 um/mod .p## " /" ptype .p## " /" ptype 1900 - .p## r> base ! blnks 3 ptype ; : pdate/time getdate <.pdate> gettime <.ptime> ; variable controlines \ number of control line encountered. : skipto ( a1 --- a2 ) \ skips all but one leading bl 1+ begin dup c@ bl = while 1+ repeat 1- ; : ?escprint ( --- f1 ) linebuf 1+ dup c@ ascii . = swap 1+ c@ ascii # = and dup if linebuf 3 + controlines incr begin skipto dup 1+ c@ ascii 0 ascii 9 between while 0.0 rot convert nip swap 255 min pemit repeat drop then ; : .noprinter ( --- ) dolst @ 0= if 0 statusline at blnks 18 type else cr then " *** Printer OFF LINE, or NOT connected. ***" type eeol beep dolst @ 0= if showcur 2 seconds emptykbd scrshow then ; : printline ( --- ) ?escprint ?exit blnks lmargin @ ptype stripbl's linebuf count ptype pcr getline ; variable pagenumber 1 pagenumber ! variable firstpage 1 firstpage ! variable lastpage 99 lastpage ! : .underline ( --- ) \ underline current line. 13 pemit #out off 78 0 do ascii _ pemit loop pcr pcr ; : .pg# ( --- ) pagenumber @ if .underline " Page " ptype pagenumber @ 0 <# #s #> ptype " of " ptype pagenumber incr lastpage @ 0 <# #s #> ptype " Pages" ptype blnks 10 ptype pdate/time blnks 78 shndl @ c@ - #out @ - ptype shndl @ count ptype then ; : newpage ( --- ) formfeed pemit ; : setpage firstpage @ pagenumber ! ; : linesleft ( --- ) \ lines left to print on page curline controlines @ 1- 0 max - 0 max prtlines mod ; : .header ( --- ) \ print first line of the current file pcr pcr 0 #lineinfo ?cs: pad rot dup >r cmovel blnks lmargin @ ptype pad r> ptype .underline ; : ?newpage ( --- ) linesleft 0= if .pg# newpage .header then ; variable copies 1 copies ! variable pgtoprint 1 pgtoprint ! : todocpage ( --- ) pgtoprint @ 1- 0 max 199 min prtlines * to.line first.textline =: screenline dolst @ 0= if scrshow then ; variable lsttoprint 99 lsttoprint ! : ?lastppg ( --- f1 ) lsttoprint @ 199 min prtlines * 2- curline < ; : setlastpg ( --- ) lastline @ prtlines /mod swap if 1+ then dup lsttoprint ! lastpage ! ; : doprint ( --- ) ?printer.ready 0= if .noprinter exit then copies @ 0 ?do dolst @ 0= if scrshow then .header todocpage setpage controlines off begin curline 0= if pcr else printline then ?lastline 0= key? 0= and ?lastppg 0= and while dolst @ 0= if dnln else then ?newpage repeat prtlines linesleft - 1- 0 max 0 ?do pcr loop .pg# newpage key? ?leave loop dolst @ 0= if scrshow emptykbd then ; : insertaline ( a1 --- ) ?showfull ?exit linebuf over c@ 1+ 2- cmove linebuf c@ dup =: linelen =: screenchar ch/l linebuf c! changed on lchng on nodisp-nln ; : imp/exp.init ( --- ) " TEMP.SEQ" ">$ shndl+ $>handle ; : getinpfile ( --- f1 ) imp/exp.init 0 statusline 2dup at eeol at ?shiftkey dup if drop ['] femit is emit getfile 0= showstat ['] (emit) is emit if true exit then shndl+ $>handle false else >rev ." Importing from " shndl+ count type eeol >norm 3 tenths \ a small delay then ; : ?getexpfile ( --- f1 ) \ get a filename, and test to see if it \ already exists before overwriting it. imp/exp.init ?shiftkey dup if drop " Export Filename -->" first.textline inputline ! input$ dup c@ 0= escflg @ or 0= if shndl+ $>handle shndl+ pathset " Can't read path" ?terror already_exists? \ prompt for replace \ if already exists. else drop true then scrshow then ; : export ( --- ) markline @ dup 0< swap curline > or if beep exit then ?getexpfile ?exit 0 statusline 2dup at eeol at ." Copying text to " shndl+ count type ." ..." sdln \ move down a line in file shndl+ dup >r hcreate 0= if 0.0 r@ movepointer markline @ #lineinfo drop nip curline 1- #lineinfo + nip over - r@ over >r tsegb @ exhwrite r> = if r@ hclose drop ." ..Done " 4 tenths else ." Failed, Disk FULL " beep 2 seconds then -1 markline ! else ." Failed, Couldn't CREATE file. " beep 2 seconds then r>drop eeol suln ; ' export is exportx \ patch into smaller editor : excut ( --- ) \ Cut out marked text markline @ dup 0< swap curline > or if beep exit then ?getexpfile ?exit 0 statusline 2dup at eeol at ." Cutting text to " shndl+ count type ." ..." sdln \ move down a line in file shndl+ dup >r hcreate 0= if 0.0 r@ movepointer markline @ #lineinfo drop nip curline 1- #lineinfo + nip over - r@ over >r tsegb @ exhwrite r> = if r@ hclose drop ." ..Done " 3 tenths curline markline @ - 0 statusline 2dup at eeol at ." Cutting text from memory..." markline @ backto.line #deletelines ." ..Done " 4 tenths clipdown scrshow else ." Failed, Disk FULL " beep 2 seconds then -1 markline ! else ." Failed, Couldn't CREATE file. " beep 2 seconds then r>drop eeol suln sdln ; ' excut is excutx \ patch into smaller editor : import ( --- ) ?showfull ?exit getinpfile ?exit imode dup @ >r on shndl+ dup >r hopen 0= if 0.0 r@ movepointer loadline off ibreset errorline off shndl @ >r shndl+ shndl ! shoml nln suln 10 10 .box" Inserting lines... Press ESC to Abort " 54 11 at .time cursor-off begin lineread dup c@ 0<> ?full 0= and key? if key 27 <> and then while errorline @ 3 and 0= if 30 11 at errorline @ 4 .r errorline @ 15 and 0= if 54 11 at .time then then insertaline repeat drop r> shndl ! r@ hclose drop then sdln scrshow cursor-on ?cursor r>drop r> imode ! emptykbd ?showfull drop ; ' import is importx \ patch into smaller editor defer escattrib ' >rev is escattrib : torev ['] >rev is escattrib ; : toblnk ['] >revblnk is escattrib ; 5 constant pitems create prtmenu pitems c, 28 , 8 , ," First Page to print" pgtoprint , 28 , 10 , ," Last Page to print" lsttoprint , 28 , 12 , ," Left margin indent" lmargin , 65 , 8 , ," Start numbering pages at" firstpage , 65 , 10 , ," Copies to print" copies , : showpdata ( --- ) >rev prtmenu count 0 do dup 2@ swap at 4 + count + dup @ @ 5 .l 2+ loop drop >norm ; : showcmds ( --- ) 14 16 at >bold ." Press " escattrib ." ESC " >bold ." to cancel, or " escattrib ." P " >bold ." to start printing" >norm ; : showpform ( --- ) dark 25 1 at >rev ." Printing Setup Menu " >norm 15 3 at >bold ." Use Enter or Arrows to move between fields" 22 5 at ." Use + or - to change values" >norm prtmenu count 0 do dup 2@ 2 pick 4 + c@ - 1- swap at 4 + count 2dup type + 2+ loop drop 64 7 at ." 0=no #'s" showcmds ; : sc ( --- ) torev showcmds ; variable pitem variable pnumval : >pitem ( --- a1 ) prtmenu 1+ pitem @ 0 ?do 4 + count + 2+ loop ; : showpcur ( --- ) >pitem 2@ 6 + swap at ; : ptohome pitem off pnumval off torev showpcur ; : penter ( c1 --- c1 ) dup 13 = \ Enter key over 208 = or \ down arrow if pitem @ 1+ pitems mod pitem ! sc showpcur pnumval off drop 0 then ; : pincr ( c1 --- c1 ) dup 43 = \ plus "+" sign if >pitem 4 + count + @ pitem @ pitems 1- = if dup @ 0= swap ! else incr then showpdata sc showpcur drop 0 then ; : pdecr ( c1 --- c1 ) dup 45 = \ minus "-" sign if >pitem 4 + count + @ dup @ 1- 0 max swap ! showpdata sc showpcur drop 0 then ; : prright ( c1 --- c1 ) dup 203 = \ left arrow over 205 = or \ right arrow if pitem @ 3 + pitems mod pitem ! sc showpcur pnumval off drop 0 then ; : prup ( c1 --- c1 ) dup 200 = \ up arrow if pitem @ 4 + pitems mod pitem ! sc showpcur pnumval off drop 0 then ; : pbkspace ( c1 --- c1 ) dup 8 = \ back space if pnumval off >pitem 4 + count + @ off showpdata sc showpcur drop 0 then ; : pnum ( c1 --- c1 ) \ number between 0 and 9 dup ascii 0 >= over ascii 9 <= and if dup ascii 0 - pnumval @ 10 * + 199 min dup pnumval ! >pitem 4 + count + @ ! showpdata sc showpcur drop 0 then ; : pmenu ( --- ) \ print menu setlastpg showpform showpdata ptohome begin key dup 27 <> over ( Alt-P ) 153 <> and over bl or ascii p <> and while penter pincr pdecr pnum pbkspace prright prup if toblnk showcmds torev beep showpcur then repeat showscreen bl or ascii p = if doprint then ; ' pmenu is pmenux \ IDS printer initialization, sets printer for \ black & while printer ribbon. : elisting ( --- ) [ editor ] read.openfile sinit setlastpg cr ." Printing..." #out @ #line @ >r >r dolst on doprint dolst off r> r> at ; only forth definitions