1000 REMark INITIALISING VARIABLES
1005 INIT: UNLOAD miniprop: START
1010 DEFine PROCedure INIT
1015  scr%=4
1020  lwid%=0: cwid%=0: sp%=-1:file_end%=0: lpp%=66: im%=5
1025  exten$="": necst$="": orn$="ON": off$="OFF"
1030  one$=CHR$(27)&"\"&CHR$(3)&CHR$(0)
1035  minusone$=CHR$(27)&"\"&CHR$(253)&CHR$(255)
1040  font$="[]{}!',.:;il()fjt "
1045  x$='"': font$=font$ & x$
1050  font$=font$ & '#$*+-/0123456789<=>?\^_£aceorsxz|~%&@bdghknpquvymw'
1055  capfont$="IJZABCDEFGHKLNOPQRSTVXYMUW"
1060  punc$=".!?,;:-"
1065  tran$="[]£{|}"
1070  FOR g=128 TO 191:tran$=tran$&CHR$(g)
1075  DIM wend%(20)
1080 END DEFine INIT
1100 DEFine PROCedure VARIABLES
1105  CLS: CENPRINT 1,7,"Input the following Details:-"
1110  INPUT TO 20,"Left hand margin width (in characters)  :  "; lm%
1115  INPUT TO 20,"Right hand margin width                 :  "; rh%
1120  rm%=80-rh%
1125  IF exten$="doc": INPUT TO 20,"Indent margin width                     :  "; im%
1130  INPUT TO 20,"Top margin depth                        :  "; tm%
1135  INPUT TO 20,"Bottom margin depth                     :  "; bm%
1140  page%=0: INPUT TO 20,"Page Numbering required?   (y/n)        :  "; pg$
1145  IF pg$=="y": INPUT TO 20,"Starting with page number?              :  "; page%
1150  numlines%=lpp%-bm%-2*(page%>0)
1155  REMark continued . . .
1200 REMark VARIABLES cont'd . . .
1205  CENPRINT 1,18,"Press C to make changes; press any other key to continue."
1210  z$=INKEY$(-1)
1215  IF z$=="C": VARIABLES
1220  lenline%=(rm%-lm%+1):linelen%=lenline%*6: lwid%=0: cwid%=0: sp%=-1: file_end%=0: REMark 'ROMAN' font works in units of 6. Character width in Function CALC_WIDTH uses these units.
1225  line$=" ": oldtail$="": newtail$="": prop$=orn$
1230 END DEFine VARIABLES
1300 REMark PROC START & FUNc CHOOSE
1305 DEFine PROCedure START
1310  SCN 3: AT #0,1,15
1315  INPUT #0,"ENTER name of device holding QUILL files - ";dev$
1320  IF NOT "_" INSTR dev$: dev$=dev$&"_"
1325  NEW_FILENAME
1330  SIGN_OFF
1335 END DEFine START
1340 :
1350 DEFine FuNction CHOOSE (a$)
1355  REPeat choice
1360   b$=INKEY$(-1)
1365   IF b$ INSTR a$: EXIT choice
1370   BEEP 2500,50
1375  END REPeat choice
1380  RETurn CODE(LOWER$(b$))
1385 END DEFine CHOOSE
1400 DEFine PROCedure NEW_FILENAME
1405  CLS #0: AT #0,1,10
1410  INPUT #0,"ENTER name of file to scan ('_doc' assumed) - ";fl$
1415  IF NOT "_" INSTR fl$: fl$=fl$&"_doc"
1420  exten$=fl$(LEN(fl$)-2 TO)
1425  file$=dev$ & fl$
1430  VARIABLES
1435  j%=ANYOPEN% (file$,1)
1440  SET_POS #j%,0
1445  AT #0,1,10: CLS #0, 3: PRINT #0,"To file, screen or printer (f/s/p)?"
1450  path=CHOOSE ("fps")
1455  CLS#0, 3: CLS
1460  SELect ON path
1465    =102: FILE_EXPORT fl$,file$
1470    =112: PRINTER
1475    =115: DATA_READ 1
1480  END SELect 
1485 END DEFine NEW_FILENAME
1490 :
1500 DEFine PROCedure DATA_READ (q%)
1505  k%=q%: necst$=""
1510  IF exten$="doc": SKIP_DATA
1515  REPeat page_loop
1520   IF NOT LEN(necst$): necst$=GET_NECST$(lenline%)
1525   count%=tm%
1530   IF tm%: FOR x=1 TO tm%: PRINT#k%
1535   MAIN_LOOP
1540   FOR x=count%+1 TO numlines%: PRINT#k%
1545   IF page%
1550    foot$="page " & page%
1555    PRINT#k%: PRINT#k%, FILL$(" ",linelen%/10-LEN(foot$)/2)&foot$
1560    PRINT#k%: page%=page%+1
1565   END IF 
1570   IF file_end%: EXIT page_loop
1575   IF path>102: PAUSE: REMark for paper turnover
1580  END REPeat page_loop
1585  CLOSE #j%
1590 END DEFine DATA_READ
1600 DEFine PROCedure MAIN_LOOP
1605  REPeat loop
1610   IF file_end% OR count%=numlines%: EXIT loop
1615   lwid%=0: sp%=-1: jus%=1
1620   FOR y=1 TO 20: wend%(y)=0
1625   line$=necst$
1630   sp%=COUNT_GAPS%(line$,"l")
1635   line$=SCAN_LINE$(line$)
1640   necst$=GET_NECST$(lenline%)
1645   necst$=NECST_SCAN$(necst$)
1650   nsp%=COUNT_GAPS%(necst$,"n")
1655   IF sp%=-1 OR line$="Õ"
1660    PRINT#k%: count%=count%+1: NEXT loop
1665    ELSE 
1670    lwid%=CALC_WIDTH% (line$)
1675    diff%=linelen%-lwid%
1680   END IF 
1685  REMark continued ...
1700 REMark MAIN_LOOP continued ...
1705   IF indent% OR mispak% OR line$(1)="É" OR nsp%=-1 OR necst$="Õ" OR line$(LEN(line$))="Õ"
1707    IF diff%<0: line$=JUSTIFY$(line$,diff%,sp%)
1710    line$=TRANSLATE$(line$)
1715    PRINT#k%, line$: count%=count%+1: NEXT loop
1720   END IF 
1725   REPeat pack
1730    z%=" " INSTR necst$
1735    IF NOT z%
1740     wwid%=CALC_WIDTH%(necst$&" ")
1745     ELSE 
1750     IF z%=LEN(necst$): necst$=necst$(1 TO z%-1): NEXT pack
1755     IF z%=1 AND LEN(necst$)>1 AND necst$(2)=" ": EXIT pack
1760     wwid%=CALC_WIDTH% (necst$(1 TO z%))
1765    END IF 
1770   REMark continued ...
1800 REMark MAIN_LOOP continued ...
1805    IF diff%>=wwid% OR ((diff%-wwid%)<0 AND (wwid%-diff%)<=sp%)
1810     sp%=sp%+1: wend%(sp%)=LEN(line$): diff%=diff%-wwid%
1815     IF z%
1820      line$=line$ & " " & necst$(1 TO z%-1)
1825      necst$=necst$(z%+1 TO)
1830      ELSE 
1835      line$=line$ & " " & necst$
1840      necst$=GET_NECST$(lenline%)
1845      necst$=NECST_SCAN$(necst$)
1850      IF indent% OR necst$="Õ" OR line$(LEN(line$))="Õ": jus%=0: EXIT pack
1855      IF file_end%: EXIT pack
1860     END IF 
1865     ELSE 
1870     EXIT pack
1875    END IF 
1880   END REPeat pack
1885  REMark continued ...
1900 REMark MAIN_LOOP cont'd
1905   IF jus% OR (NOT jus% AND diff%<0): line$=JUSTIFY$(line$,diff%,sp%)
1910   line$=TRANSLATE$(line$)
1915   IF LEN(line$): PRINT#k%, line$: count%=count%+1
1920  END REPeat loop
1925 END DEFine MAIN_LOOP
2000 DEFine FuNction GET_NECST$(x%)
2005  IF exten$="lis"
2010   INPUT#j%,nxt$
2015   IF NOT LEN(nxt$): nxt$="Õ"
2020   RETurn nxt$
2025   ELSE 
2030   nxt$=""
2035   FOR n=1 TO x%
2040    t$=INKEY$(#j%):t=CODE(t$)
2045    SELect ON t
2050      =0: t$="Õ": REMark t$==CHR$(10)
2055      =9: t$="¿"
2060      =10: t$=""
2065    END SELect 
2070    nxt$=nxt$ & t$
2075    IF t=0: EXIT n
2080   END FOR n
2085   nxt$=oldtail$&nxt$:oldtail$=""
2090 REMark continued ...
2100 REMark GET_NECST$ cont'd
2105   IF LEN(nxt$)>x%*3 DIV 4 AND (line$="Õ" OR line$(LEN(line$))="Õ" OR line$=""): nxt$=FILL$(" ",im%) & nxt$: REMark paragraph indent
2110   IF t=0 OR LEN(nxt$)<x%: newtail$="": RETurn nxt$
2115   FOR a=LEN(nxt$) TO 1 STEP -1
2120    IF nxt$(a)=" "
2125     IF a=LEN(nxt$): newtail$="": ELSE newtail$=nxt$(a+1 TO)
2130     nxt$=nxt$(1 TO a-1): EXIT a
2135    END IF 
2140   END FOR a
2145   oldtail$=newtail$
2150   RETurn nxt$
2155  END IF 
2160 END DEFine GET_NECST$
2165 :
2300 DEFine FuNction SCAN_LINE$(z$)
2305   mispak%=0
2310   IF z$="Õ" OR NOT LEN(z$): jus%=0
2315   IF exten$="lis"
2320    IF prop$=orn$ AND ((FILL$(" ",im%+1) INSTR z$)=1 OR (FILL$(" ",5) INSTR z$)>1): z$=STRETCH$(z$,sp%): mispak%=1
2325    IF LEN(z$) AND z$(LEN(z$))="Õ": mispak%=1
2330   END IF 
2335   IF "¿" INSTR z$: mispak%=1
2340   IF "Ø" INSTR z$: file_end%=1
2345   RETurn z$
2350 END DEFine SCAN_LINE$
2355 :
2400 DEFine FuNction NECST_SCAN$(nx$)
2405   indent%=0
2410   IF nx$(1)=" " AND LEN(nx$)>1: indent%=1
2415   IF exten$="lis" AND LEN(nx$) AND LEN(nx$)<lenline%*3/4: nx$=nx$&"Õ"
2420   RETurn nx$
2425 END DEFine NECST_SCAN$
2430 :
2600 DEFine FuNction COUNT_GAPS% (n$,flag$)
2605   gap%=-1: state=1
2610   FOR x=1 TO LEN(n$)
2615     SELect ON state
2620       =0: IF n$(x)=" ": state=1
2625       =1: IF NOT n$(x)=" "
2630            state=0: gap%=gap%+1
2635            IF flag$="l": wend%(gap%)=x-2
2640            IF flag$="n" AND gap%=0: EXIT x
2645           END IF 
2650     END SELect 
2655   END FOR x
2660   RETurn gap%
2665  END DEFine COUNT_GAPS%
2670 :
2700 DEFine FuNction CALC_WIDTH% (q$)
2705   LOCal q,r,x
2710   wid%=0
2715   FOR x=1 TO LEN(q$)
2720    r=CODE(q$(x))
2725    SELect ON r
2730     =65 TO 90
2735       q= q$(x) INSTR capfont$
2740       SELect ON q
2745         = 1: cwid%=4
2750         = 2,3: cwid%=5
2755         = 4 TO 23: cwid%=6
2760         = 24 TO 26: cwid%=7
2765       END SELect 
2770  REMark continued ...
2800 REMark CALC_WIDTH cont'd
2805     =32 TO 64,91 TO 126
2810       q= q$(x) INSTR font$
2815       SELect ON q
2820         =1 TO 4: cwid%=0
2825         =5 TO 12: cwid%=3
2830         =13 TO 17: cwid%=4
2835         =18 TO 53: cwid%=5
2840         =54 TO 67: cwid%=6
2845         =68,69: cwid%=7
2850       END SELect 
2855     = REMAINDER : cwid%=0
2860    END SELect 
2865    wid%=wid%+cwid%
2870  END FOR x
2875  RETurn wid%
2880 END DEFine CALC_WIDTH%
2885 :
3000 DEFine PROCedure SKIP_DATA
3005   LOCal n%
3010   FOR n=1 TO 20: y$=INKEY$(#j%)
3015   n%=1
3020   REPeat quest
3025    y$=INKEY$(#j%)
3030    IF y$=CHR$(0): n%=n%+1
3035    IF n%=3: EXIT quest
3040    NEXT quest
3045   END REPeat quest
3050 END DEFine SKIP_DATA
3055 :
3100 DEFine FuNction JUSTIFY$ (ln$,f%,s%)
3105  LOCal all%,part%,awl$,sign%,p%
3110  IF f%>0: sign%=1: ELSE sign%=0
3115  f%=ABS(f%)
3120  all%=f% DIV s%: p%=0
3125  part%=f% MOD s%
3130  IF all%
3135   IF sign%: awl$=CHR$(27)&"\"&CHR$(all%*3)&CHR$(0): ELSE awl$=CHR$(27)&"\"&CHR$(256-(all%*3))&CHR$(255)
3140   FOR x=1 TO s%
3145    ln$=ln$(1 TO wend%(x))&awl$&ln$((wend%(x)+1) TO)
3150    FOR y=x+1 TO s%: wend%(y)=wend%(y)+4
3155   END FOR x
3160   f%=f%-(all%*s%)
3165  END IF 
3170 REMark FuNc continued ..
3200 REMark FuNc JUSTIFY$ cont'd ..
3205  IF part%
3210   IF sign%: pa$=one$: ELSE pa$=minusone$
3215   IF sign%
3220    FOR x=1 TO s%
3225     IF ln$(wend%(x)) INSTR punc$(1 TO 3)
3230      ln$=ln$(1 TO wend%(x)) & pa$& ln$(wend%(x)+1 TO)
3235      FOR y=x+1 TO s%: wend%(y)=wend%(y)+4
3240      f%=f%-1: IF f%=0:RETurn ln$
3245     END IF 
3250    END FOR x
3255   END IF 
3260 REMark continued .....
3300 REMark FuNction JUSTIFY$ cont'd
3305   FOR z=1 TO s%
3310    p%=p%+2*f%
3315    IF p%>s%
3320     ln$=ln$(1 TO wend%(z))&pa$&ln$(wend%(z)+1 TO)
3325     p%=p%-2*s%
3330     FOR q=z TO s%-1: wend%(q+1)=wend%(q+1)+4
3335    END IF 
3340   END FOR z
3345  END IF 
3350  IF NOT sign%: f%=-f%
3355  RETurn ln$
3360 END DEFine JUSTIFY$
3365 :
3400 DEFine FuNction TRANSLATE$(tl$)
3405  LOCal a,x,y,z,c$,t%
3410  t%=0
3415  FOR z=1 TO LEN(tl$)
3420   a=CODE(tl$(z))
3425   SELect ON a=91,93,96,123 TO 191: t%=1: EXIT z
3430  END FOR z
3435  IF NOT t%: RETurn tl$
3440  FOR x=LEN(tl$) TO 1 STEP -1
3445   IF tl$(x) INSTR tran$
3450    y=CODE(tl$(x))
3455    SELect ON y
3460     =91: c$=CHR$(27)&"-"&CHR$(1)
3465     =93: c$=CHR$(27)&"-"&CHR$(0)
3470     =96: c$=CHR$(156)
3475     =124: c$=" "
3480     =163: c$=FILL$(" ",INT(diff%/10))
3485     =165: c$="": REMark line end
3490     =166: c$="": file_end%=1
3500 REMark TRANSLATE$ cont'd...
3505     =176: IF prop$=orn$: c$=CHR$(27)&"p"&CHR$(0): prop$=off$: ELSE c$=CHR$(27)&"p"&CHR$(1): prop$=orn$
3510     =180: c$=CHR$(9)
3515  REMark Plenty of room for more translates!
3585     =REMAINDER : NEXT x: REMark to trap chr(255) in ESC \ n1 n2
3590    END SELect 
3595  REMark continued ...
3600 REMark TRANSLATE$ cont'd...
3605    IF x=1
3610     IF LEN(tl$)=1: tl$=c$: ELSE tl$=c$&tl$(2 TO)
3615     ELSE 
3620     IF x=LEN(tl$)
3625      tl$=tl$(1 TO x-1)&c$
3630      ELSE 
3635      tl$=tl$(1 TO x-1)&c$&tl$(x+1 TO)
3640     END IF 
3645    END IF 
3650   END IF 
3655  END FOR x
3660  RETurn tl$
3665 END DEFine TRANSLATE
3670 :
3800 DEFine FuNction STRETCH$(ls$,s%)
3805  LOCal g,h%,j$,k
3810  FOR g=1 TO s%
3815   IF ls$(wend%(g))<>" ": IF g=s%: EXIT g: ELSE NEXT g
3820   h%=1: j$=""
3825   REPeat look
3830    IF (wend%(g)-h%) AND ls$(wend%(g)-h%)=" ": h%=h%+1: ELSE EXIT look
3835   END REPeat look
3840   j$=FILL$(" ",INT((h%+1)*6/5))
3845   IF (wend%(g)-h%)=1
3850    ls$=j$&ls$(wend%(g)+2 TO)
3855    ELSE 
3860    ls$=ls$(1 TO (wend%(g)-h%))&j$&ls$((wend%(g)+2) TO)
3865   END IF 
3870   FOR k=g TO s%: wend%(k)=wend%(k)+INT((h%+1)/5)
3875  END FOR g
3880  RETurn ls$
3885 END DEFine STRETCH$
4000 DEFine PROCedure PRINTER
4005  PAR_USE "lpt": PRT_USE "par","lpt"
4010  k%=ANYOPEN%("par",0)
4015 REMark  Initialise and set left margin on Epson-type printer
4020 PRINT #k%,CHR$(27)&"@";CHR$(27)&"P";CHR$(27)&"l"&CHR$(lm%);CHR$(27)&"C"&"B";CHR$(27)&"p"&CHR$(1);
4025  DATA_READ k%
4030  CLOSE#k%
4035 END DEFine PRINTER
4040 :
4100 DEFine PROCedure FILE_EXPORT (q$)
4105    f$=q$(1 TO ("_" INSTR q$))&"exp"
4110    ram$="ram8_"
4115    k%=ANYOPEN%(ram$&f$,3)
4120    g$="Printing to Ram8_"&f$
4125    AT 10,(80-LEN(g$))/2: PRINT g$
4130    DATA_READ k%
4135    CLOSE#k%
4140    AT 10,0: CLS 3: PRINT TO 38,"DONE!"
4145 END DEFine FILE_EXPORT
4150 :
4200 DEFine PROCedure SIGN_OFF
4205  AT #0,1,10: CLS#0, 3
4210  PRINT #0,"Another file? (y/n)"
4215  IF INKEY$(-1)=="y"
4220   CLS: NEW_FILENAME: SIGN_OFF
4225  END IF 
4230  SCN 4
4235 END DEFine SIGN_OFF
4240 :
4300 DEFine PROCedure TEST_PRINT
4305  REMark for bug-tracing if required!
4310  PRINT#k%, line$
4315  PRINT#k%, sp%;" / ";diff%;" /  ";
4320  FOR x=1 TO sp%: PRINT#k%, wend%(x)&"  ";: END FOR x: PRINT#k%
4325  quit$=INKEY$(-1)
4330  IF CODE(quit$)=27: C
4335 END DEFine 
4340 :
4400 DEFine PROCedure FS
4405   SAVE_O flp1_miniprop_bas
4410   RESAVE miniprop
4415 END DEFine FS
4420 :
4500 DEFine PROCedure C
4505   CLOSE#j%: IF k%>1: CLOSE#k%
4510   SCN 4
4515 END DEFine 
4520 :
7000 DEFine PROCedure SCN(screen)
7005   SELect ON screen
7010    =0: REMark Defining SCN 0
7015     IF scr%=0: RETurn 
7020     MODE 4
7025     WINDOW#0, 284, 115, 228, 126
7030     BORDER#0, 2, 0: PAPER#0, 4: INK#0, 0
7035     OPEN#1,con_284x126a228x0_128
7040     BORDER#1, 2, 0: PAPER#1, 2: INK#1, 7
7045     OPEN #2,con_232x256a0x0_128
7050     BORDER#2, 2, 0: PAPER#2, 7: INK#2, 2
7055     CLS: CLS#0: CLS#2
7060     scr%=0
7100 REMark Defining SCN 3
7105    =3
7110     IF scr%=3: RETurn 
7115     MODE 4
7120     WINDOW#0, 512,  33,   0, 221
7125     BORDER#0, 1, 246: PAPER#0, 5: INK#0, 0
7130     OPEN #1,con_512x222a0x0_128
7135     BORDER#1, 1, 246: PAPER#1, 2: INK#1, 7
7140     CLS: CLS#0
7145     scr%=3
7200 REMark Defining SCN 4
7205    =4
7210     IF scr%=4: RETurn 
7215     MODE 4
7220     WINDOW #0, 512, 50, 0, 206
7225     BORDER #0,    0: PAPER #0,0: INK #0,4
7230     OPEN #1,con_256x202a256x0_128
7235     BORDER #1,1,255: PAPER #1,2: INK #1,7
7240     OPEN #2,con_256x202a0x0_128
7245     BORDER #2,1,255: PAPER #2,7: INK #2,2
7250     CLS: CLS#0: CLS#2
7255     scr%=4
7260    END SELect 
7265 END DEFine SCN
7500 DEFine PROCedure CENPRINT (windo%,row%,text$)
7505   LOCal a$,b$,t%
7510   a$="": b$=""
7515   wide%=(CHAN_W%(#windo%,28) DIV CHAN_W%(#windo%,38))
7520   IF LEN(text$)>wide%
7525     a$=text$(1 TO LEN(text$)/2)
7530     b$=text$(LEN(a$)+1 TO )
7535     t%=" " INSTR b$
7540     a$=a$ & b$(1 TO t%-1)
7545     b$=b$(t%+1 TO )
7550   END IF 
7555  REMark cont'd ....
7600 REMark CENPRINT cont'd ....
7605   IF NOT LEN(a$)
7610     AT #windo%,row%,((wide%-LEN(text$)) DIV 2): CLS#windo%,3: PRINT#windo%,text$ & CHR$(10)
7615     ELSE 
7620     AT #windo%,row%,((wide%-LEN(a$)) DIV 2): CLS#windo%,3: PRINT #windo%,a$ & CHR$(10);
7625     AT #windo%,row%+2,((wide%-LEN(b$)) DIV 2):CLS#windo%,3: PRINT#windo%,b$ & CHR$(10);
7630   END IF 
7635 END DEFine CENPRINT
7700 DEFine PROCedure CLEAR_BUFFER
7705  LOCal dummy
7710  dummy=KEYROW(0)
7715 END DEFine CLEAR_BUFFER
7800 DEFine FuNction UPPER(case$)
7805  RETurn CODE(case$)-32*(CODE(case$)>96 AND CODE(case$)<123)
7810 END DEFine UPPER
8100 DEFine PROCedure L(x)
8110   SCN 0
8120   CLS#2
8130   PRINT#2,"SEGMENT" !x \\
8140   LIST x*100+(x=0) TO x*100+99
8150   GO TO 32767
8160 END DEFine L
8200 DEFine PROCedure LP
8210   startlist=10: endlist=29
8220   SCN 0
8230   DISPLAY_PAGE
8240 END DEFine LP
8300 DEFine PROCedure DISPLAY_PAGE
8310   LOCal x
8320   CLS#2
8330   PRINT#2; "PROGRAM SEGMENTS"\\
8340   FOR x=startlist TO endlist
8350     LIST x*100
8360   END FOR x
8370   CONTROL
8380   DISPLAY_PAGE
8390 END DEFine DISPLAY_PAGE
8400 DEFine PROCedure CONTROL
8405   LOCal k,diff
8410   CLEAR_BUFFER
8415   k=UPPER(INKEY$(-1))
8420   SELect ON k
8425     =78: diff=20
8430     =66: diff=-20
8435     =REMAINDER : GO TO 32767
8440   END SELect 
8445   startlist=startlist+diff
8450   endlist=endlist+diff
8455 END DEFine CONTROL
32767 STOP