10
20
30
40 MODE&84:ver$="2.11":g128=0:oflg%=0:DIMctrl%31,b%7:os%=FNbyte(0,1,0):VDU23;10,96AND(os%<>32);0;0;0:IFos%=6:*POINTER 1
50 PRINT'CHR$8;:wd%=POS>32:REPEATA%=VPOS:PRINT:B%=VPOS:UNTILA%=B%:ht%=VPOS:CLS:IFht%>127:ht%=23:wd%=0
60 xo%=10*32:yo%=(ht%-16)*32-2:char=64:mx%=0:my%=0:ms%=0:mL%=0:mM%=0:mR%=0:X%=ctrl%:Y%=X%DIV256:IFos%=32:PROCreset(1)
70 A%=1:ONERRORA%=0
80 IFA%:OSCLI"FX219,9":OSCLI"FX225,1":OSCLI"FX226,128":OSCLI"KEY11|!K":OSCLI"KEY12|!L":OSCLI"KEY13|!M":OSCLI"KEY14|!N":OSCLI"KEY15|!O":*KEY10O.|MRUN|M
90 ONERRORPROCget128:PROC_ERROR:IFoflg%=0:GOTO170
100 X%=ctrl%:Y%=X%DIV256:IFoflg%:CLS
110 PROC_CSET:oflg%=0:RESTORE:Q=8:REPEAT:READA$:PRINTTAB(15-3*wd%,Q);A$:Q=Q+1:UNTILA$=""ORA$=" "ANDwd%=0:IFwd%=0:READA$,A$,A$,A$,A$
120 Q=8:REPEAT:READA$:PRINTTAB(20-7*wd%,Q);A$:Q=Q+1:UNTILA$=""
130 DATA Get,Put,Load,Save,Quit," "," ",Cursors,to move,& scroll,
140 DATA I Invert,M Mirror <>,T Tip ^v,+ Rotate +90,- Rotate -90,\ Reflect,/ Reflect,V Reflect ^v,H Reflect <>,X Check font,R Reset font,
150 PRINTTAB(10-3*wd%,20)"DefChar "ver$TAB(1-3*wd%,21)"Copyright 1985-2019 J.G.Harston"
160 x%=0:y%=0:PROC_EXPAND(char):*FX4,2
170 VDU31,x%+1,y%+8
180 REPEAT:X%=ctrl%:Y%=X%DIV256:PROCwait:ch=TRUE
190 IFmx%>124ANDmx%<1152ANDmy%>799ANDmy%<1024:PROCmsChr
200 IFmx%>12ANDmx%<308ANDmy%>490ANDmy%<788:PROCmsKlk
210 IFmy%<768AND((mx%>576ANDmy%>608)OR(mx%>867ANDmy%>420))ANDmL%:PROCklik2
220 UNTILA$<>"":GCOL0,7:IFA$>"`"ANDA$<"{":A$=CHR$(ASCA$-32)
230 A%=ch>TRUE:IFA%:IFA$="C":char=ch:GOTO160ELSEIFA%:GOTO770
240 A%=ASCA$AND&CF:IFA%>&CB:A$=CHR$(A%+64*INKEY-1)
250 A%=INSTR("5867",A$):IFA%:A$=CHR$(&CB+A%)
260 IFA$=CHR$&CC:x%=(x%-1)AND7
270 IFA$=CHR$&CD:x%=(x%+1)AND7
280 IFA$=CHR$&CE:y%=(y%+1)AND7
290 IFA$=CHR$&CF:y%=(y%-1)AND7
300 IFA$>CHR$139ANDA$<CHR$144:PROC_SCROLL((ASCA$)-140)
310 IFA$="*":GOTO790
320 IFA$="S":PROCinp:GOTO820
330 IFA$="L":PROCinp:GOTO970
340 IF(A$=CHR$203ORA$=CHR$9)ANDPOINT(xo%+x%*4,yo%-y%*4)=0:A$="1"
350 IF(A$=CHR$203ORA$=CHR$9):A$="0"
360 IFA$="1":PLOT69,xo%+x%*4,yo%-y%*4:b%?y%=b%?y%OR(2^(7-x%)):PRINTTAB(11,y%+8);FNd(b%?y%);:COLOUR135:VDU31,x%+1,y%+8,32,8:COLOUR128:GOTO180
370 IFA$="0":PLOT71,xo%+x%*4,yo%-y%*4:b%?y%=b%?y%AND(255-2^(7-x%)):PRINTTAB(11,y%+8);FNd(b%?y%);:PROCsave128:VDU31,x%+1,y%+8,159,8:PROCget128:GOTO180
380 IFA$="G"ORA$="C":PRINTFNbot;"Get which";:char=FN_CHAR:PRINTFNbot;FNclr'FNclr;:GOTO160
390 IFA$=CHR$13ORA$="P":GOTO760
400 IFA$="I":PROCinv:GOTO170
410 IFA$="T":PROCtip:GOTO170
420 IFA$="M":PROCmir:GOTO170
430 IFA$="+"ORA$=";":PROCrotP:GOTO170
440 IFA$="-"ORA$="=":PROCrotM:GOTO170
450 IFA$="/"ORA$="?":PROCrefD1:GOTO170
460 IFA$="\"ORA$="|":PROCrefD2:GOTO170
470 IFA$="V":PROCrefV:GOTO170
480 IFA$="H":PROCrefH:GOTO170
490 IFA$="Q":PROCquit:GOTO170
500 IFA$="X":PROCchk:GOTO170
510 IFA$="R":PRINTFNbot"Reset character set? ";:A=FNupDn("NY"):PROCclr:IFA:PROCreset(0):GOTO100
520 GOTO170
530 DEFPROC_ERROR:IFms%=-1:PROCp
540 IFNOToflg%:PRINTFNbot;FNclr'FNclr;
550 CLOSE#0:IFERR<>17:GOTO580
560 IF?(TOP-3):IFINKEY-1ANDINKEY-2:OSCLI"FX4":PRINTFNbot:END
570 OSCLI"FX4,2":ENDPROC
580 REPORT:IFERR<128ANDINKEY-1:PRINT" at line ";ERL:OSCLI"FX4":END ELSE A$=GET$:PRINTFNbot;FNclr;:ENDPROC
590 DEFPROC_CSET:VDU30:FORA%=32TO255STEP32:PRINTTAB(4ANDwd%,A%DIV32-1);:FORB=A%TOA%+31:VDUB:NEXT:NEXT:VDU31,30-4*wd%,2,126:PRINTFNc(127)'''':ENDPROC
600 DEFPROC_EXPAND(C%):PRINTTAB(0,17)"Character "FNc(C%)" (";C%;") ":PROC_BIGGER:ENDPROC
610 DEFFNc(A%):IFA%<>127:VDUA%:=""
620 ?X%=159:A%=10:CALL&FFF1:X%!9=&9F179F:X%!12=X%!1:X%!16=X%!5:?X%=127:CALL&FFF1:VDU23,159:FORA%=1TO19:VDUX%?A%:NEXT:=""
630 DEFPROCsave128:?X%=159:A%=10:CALL&FFF1:g128=TRUE:VDU&9F17;&81FF;&8181;&8181;&FF81;:ENDPROC
640 DEFPROCget128:IFNOTg128:ENDPROC
650 VDU23,159:FORA%=1TO8:VDUX%?A%:NEXT:g128=0:ENDPROC
660 DEFFNd(A%):=RIGHT$("00"+STR$A%,3)
670 DEFPROC_BIGGER:PROCsave128:FORY=0TO7:PRINTTAB(1,8+Y);:A=0:FORX=0TO7
680 A=A*2:IFPOINT(xo%+X*4,yo%-Y*4):COLOUR135:VDU32:COLOUR128:A=A+1 ELSE VDU159
690 NEXT:PRINT" "FNd(A):b%?Y=A:NEXT:PROCget128:ENDPROC
700 DEFPROCwait:REPEATPROCmse:UNTILmL%+mM%+mR%=0:IFms%=0:A$=INKEY$(50):ENDPROC
710 ox%=mx%:oy%=my%:PROCp:REPEATPROCmse:A$=INKEY$(5):UNTILLENA$OR(mL%ORmM%ORmR%)OR(mx%<>ox%)OR(oy%<>my%):PROCp:ENDPROC
720 DEFPROCp:GCOL4,0:MOVEox%-12,oy%:DRAWox%+12,oy%:MOVEox%,oy%-12:DRAWox%,oy%+12:ms%=ms%EOR1:ENDPROC
730 DEFFN_CHAR:LOCALA$:P%=POS:*FX4
740 PRINT" character: ";:INPUTLINE""A$:OSCLI"FX4,2":IFLENA$=1:=ASCA$
750 IFVALA$<32ORVALA$>255:PRINT" Invalid code"TAB(P%,VPOS-1);:GOTO740 ELSE =VALA$
760 PRINTFNbot;"Enter onto";:ch=FN_CHAR:PRINTFNbot;FNclr'FNclr;
770 VDU23,ch:FORA=0TO7:Q=0:FORB=0TO7:Q=Q*2:IFPOINT(xo%+B*4,yo%-A*4):Q=Q+1
780 NEXT:VDUQ:NEXT:PRINTTAB(-4*wd%+ch MOD32,ch DIV32-1)FNc(ch);:GOTO170
790 PRINTTAB(0,20)SPC(80)TAB(0,19)"*";
800 OSCLI"FX4":oflg%=TRUE:REPEAT:INPUTLINE""A$:OSCLI A$:PRINT":";:REPEATA$=GET$:UNTILINSTR(CHR$13+"LlSs*",A$):IFA$="*":VDU127,42
810 UNTILA$<>"*":VDU127:IFA$="L"ORA$="l":GOTO970 ELSE IFA$=CHR$13:GOTO100
820 F$=FNfn("save"):IFF$="":GOTO100
830 PRINT"Start at";:start=FN_CHAR:PRINT" End at";:end=FN_CHAR
840 PRINT"Binary or VDU format? ";:A=FNupDn("BV"):PRINT:ar$="":IFA:ar$="Y"
850 IFos%=32:IFINSTR(F$,".")=0:F$=F$+"."
860 lp=0:DIMB%-1:A%=&A:IFHIMEM-B%-200<10*(end-start)ORos%=32:GOTO900
870 C%=B%:FORlp=start TO end:IFar$<>"":?C%=23:C%?1=lp:C%=C%+2
880 VDUlp,9,13:?X%=lp:CALL&FFF1:!C%=X%!1:C%!4=X%!5:C%=C%+8:NEXT:VDU11
890 OSCLI"SAVE "+F$+" "+STR$~B%+" "+STR$~C%+" "+STR$~(TRUE+65535*(ar$=""))+" FFFFF"+STR$~(13+6*(ar$<>""))+"00":GOTO100
900 ch=OPENOUT(F$):PRINTFNbot;:IFch=0:PRINT"Can't open file":A=GET:GOTO100
910 IFos%<>32:CLOSE#ch:ch=0:OSCLI"SAVE "+F$+" 0+"+STR$~(10*(end-start+1))+" FFFFFFFF FFFFF"+STR$~(13+6*(ar$<>""))+"00":ch=OPENUP(F$)
920 FORlp=start TO end:VDUlp,9,13:IFar$<>"":BPUT#ch,23:BPUT#ch,lp
930 ?X%=lp:CALL&FFF1:FORlp1=1TO8:BPUT#ch,X%?lp1:NEXT:NEXT
940 CLOSE#ch:ch=0:GOTO100
950 DEFFNfn(A$):LOCALA%,Y%,E%:fs=29:IFPAGE<&FFFF:fs=(USR&FFDA)AND&FF
960 oflg%=TRUE:OSCLI"FX4":PRINT"Filename to ";A$;:INPUTLINE": "A$:=A$
970 F$=FNfn("load"):IFF$="":GOTO100
980 IFfs<4:rx%=&700:ch=0:GOTO1000 ELSE ch=OPENIN(F$):IFch=0:IFos%=32:F$=F$+".":ch=OPENIN(F$)
990 IFch:rx%=EXT#ch:IF((rx%/10)<>(rx%DIV10)AND(rx%/8)<>(rx%DIV8))ORrx%>&FFFORrx%<8:CLOSE#ch:ch=0:PRINT"Not a proper font file";:A=GET:GOTO100
1000 ra%=0:in%=0:rb%=0:rc%=0:DIMB%-1:B%=B%+80:IFHIMEM-B%-200<&1000ORos%=32:GOTO1040
1010 CLOSE#ch:ch=0:OSCLI"LOAD "+F$+" "+STR$~B%:IF?B%=23AND(rx%/10)=(rx%DIV10):FORra%=B%TOB%+rx%-1:VDU?ra%:NEXT:GOTO100
1020 PRINT"Start at";:ra%=FN_CHAR
1030 REPEAT:VDU23,ra%:FORrb%=0TO7:VDUB%?rb%:NEXT:VDUra%,9,13:B%=B%+8:rx%=rx%-8:ra%=ra%+1:UNTILra%>255ORrx%<1:GOTO100
1040 IFch=0:PRINT"File not found";:A=GET:GOTO100
1050 ra%=BGET#ch:IFra%=23AND(EXT#ch/10)=(EXT#ch DIV10):ra%=BGET#ch:in%=TRUE ELSE in%=FALSE:PRINT"Start at";:ra%=FN_CHAR:PROCclr
1060 PTR#ch=0:REPEAT:rb%=BGET#ch:IF(in%ANDrb%<>23)OR4+PTR#ch>EXT#ch:ra%=256:GOTO1100
1070 IFin%:rch%=BGET#ch
1080 VDU23:IFin%VDUrch%,BGET#ch ELSE VDUra%,rb%
1090 rc%=0:REPEAT:VDUBGET#ch:rc%=rc%+1:UNTILrc%=7ORPTR#ch>=EXT#ch:IFin%VDUrch%,9,13 ELSE VDUra%,9,13
1100 ra%=ra%+1:UNTILra%>255ORPTR#ch>=EXT#ch:CLOSE#ch:ch=0:GOTO100
1110 DEFPROC_SCROLL(A):LOCALX,Y,xs,xe,xst,ys,ye,yst,tmp
1120 ON A+1 GOSUB 1140,1130,1180,1190:PROC_BIGGER:GCOL0,7:ENDPROC
1130 xs=7:xe=1:xst=-1:GOTO1150
1140 xs=0:xe=6:xst=1
1150 FORY=0TO7:tmp=POINT(xo%+xs*4,yo%-Y*4):FORX=xs TO xe STEP xst
1160 GCOL0,POINT(xo%+(X+xst)*4,yo%-Y*4):PLOT69,xo%+X*4,yo%-Y*4:NEXT
1170 GCOL0,tmp:PLOT69,xo%+(xe+xst)*4,yo%-Y*4:NEXT:RETURN
1180 ys=7:ye=1:yst=-1:GOTO1200
1190 ys=0:ye=6:yst=1
1200 FORX=0TO7:tmp=POINT(xo%+X*4,yo%-ys*4):FORY=ys TO ye STEP yst
1210 GCOL0,POINT(xo%+X*4,yo%-(Y+yst)*4):PLOT69,xo%+X*4,yo%-Y*4:NEXT
1220 GCOL0,tmp:PLOT69,xo%+X*4,yo%-(ye+yst)*4:NEXT:RETURN
1230 DEFPROCmsKlk:IFmL%+mM%+mR%=0:ENDPROC
1240 IFmx%<32:A$=CHR$140:ENDPROC
1250 IFmx%>288:A$=CHR$141:ENDPROC
1260 IFmy%<512:A$=CHR$142:ENDPROC
1270 IFmy%>767:A$=CHR$143:ENDPROC
1280 IFmL%:A$="1"
1290 IFmM%:A$=CHR$9
1300 IFmR%:A$="0"
1310 x%=mx%DIV32-1:y%=23-my%DIV32:VDU31,x%+1,y%+8
1320 IFmM%:REPEATPROCmse:UNTILNOTmM%
1330 ENDPROC
1340 DEFPROCmsChr:IFmL%+mR%=0:ENDPROC
1350 ch=(mx%DIV32+28+32*(31-my%DIV32)):IFmL%:A$="C"ELSEA$=CHR$13
1360 ENDPROC
1370 DEFPROCklik2:x0%=mx%DIV32:IFx0%>26:x0%=27ELSEx0%=18
1380 VDU31,x0%,31-my%DIV32:A$=CHR$FNbyte(135,0,0):VDU31,x%+1,y%+8:ENDPROC
1390 DEFPROCmse:IFPAGE>&FFFFF:MOUSEmx%,my%,A% ELSE mx%=ADVAL(7):my%=ADVAL(8)
1400 ms%=mx%<&FFF:IFms%:mL%=INKEY-10:mM%=INKEY-11:mR%=INKEY-12
1410 ENDPROC
1420 DEFPROCinv:GCOL4,0:FORX=0TO7:FORY=0TO7:PLOT69,xo%+X*4,yo%-Y*4:NEXT:NEXT:PROC_BIGGER:ENDPROC
1430 DEFPROCtip:FORX=0TO7:FORY=0TO3:A=POINT(xo%+X*4,yo%-Y*4):GCOL0,POINT(xo%+X*4,yo%-28+Y*4):PLOT69,xo%+X*4,yo%-Y*4:GCOL0,A:PLOT69,xo%+X*4,yo%-28+Y*4:NEXT:NEXT:PROC_BIGGER:ENDPROC
1440 DEFPROCmir:FORY=0TO7:FORX=0TO3:A=POINT(xo%+X*4,yo%-Y*4):GCOL0,POINT(xo%+28-X*4,yo%-Y*4):PLOT69,xo%+X*4,yo%-Y*4:GCOL0,A:PLOT69,xo%+28-X*4,yo%-Y*4:NEXT:NEXT:PROC_BIGGER:ENDPROC
1450 DEFPROCrefD1:PRINTFNbot"Copy Topleft or Bottomright? ";:A=FNupDn("TB"):PROCclr
1460 FORY=0TO7:FORX=Y TO7:IFA:GCOL0,POINT(xo%+28-4*Y,yo%-4*X):PLOT69,xo%+28-4*X,yo%-4*Y ELSE GCOL0,POINT(xo%+28-4*X,yo%-4*Y):PLOT69,xo%+28-4*Y,yo%-4*X
1470 NEXT:NEXT:PROC_BIGGER:ENDPROC
1480 DEFPROCrefD2:PRINTFNbot"Copy Topright or Bottomleft? ";:A=FNupDn("TB"):PROCclr
1490 FORX=0TO7:FORY=X TO7:IFA:GCOL0,POINT(xo%+4*X,yo%-4*Y):PLOT69,xo%+4*Y,yo%-4*X ELSE GCOL0,POINT(xo%+4*Y,yo%-4*X):PLOT69,xo%+4*X,yo%-4*Y
1500 NEXT:NEXT:PROC_BIGGER:ENDPROC
1510 DEFFNupDn(B$):x0%=POS*32:REPEAT:PROCmse:UNTILmL%+mM%+mR%=0:REPEAT:PROCwait:IFA$>"`":A$=CHR$(ASCA$-32)
1520 IFmR%ANDB$="NY":A$="N"
1530 IFmL%ANDmy%<292ANDmx%<x0%:A$=MID$(B$,1+(mx%DIV(x0%DIV2)),1):IFB$="NY":A$="Y"
1540 UNTILINSTR(B$,A$)ANDA$<>"":PRINTA$;:=INSTR(B$,A$)=2
1550 DEFPROCrotP:PROCrotD2:PROCmir:ENDPROC
1560 DEFPROCrotM:PROCrotD1:PROCtip:ENDPROC
1570 DEFPROCrotD1:FORX=0TO7:FORY=X TO7:A=POINT(xo%+4*X,yo%-4*Y):GCOL0,POINT(xo%+4*Y,yo%-4*X):PLOT69,xo%+4*X,yo%-4*Y:GCOL0,A:PLOT69,xo%+4*Y,yo%-4*X:NEXT:NEXT:ENDPROC
1580 DEFPROCrotD2:FORY=0TO7:FORX=Y TO7:A=POINT(xo%+4*X,yo%-4*Y):GCOL0,POINT(xo%+4*Y,yo%-4*X):PLOT69,xo%+4*X,yo%-4*Y:GCOL0,A:PLOT69,xo%+4*Y,yo%-4*X:NEXT:NEXT:ENDPROC
1590 DEFPROCrefV:PRINTFNbot"Copy Top or Bottom? ";:A=NOTFNupDn("TB"):PROCclr
1600 FORX=0TO7:FORY=0TO3:IFA:GCOL0,POINT(xo%+4*X,yo%-4*Y):PLOT69,xo%+X*4,yo%-28+Y*4 ELSE GCOL0,POINT(xo%+4*X,yo%-28+4*Y):PLOT69,xo%+X*4,yo%-Y*4
1610 NEXT:NEXT:PROC_BIGGER:ENDPROC
1620 DEFPROCrefH:PRINTFNbot"Copy Left or Right? ";:A=NOTFNupDn("LR"):PROCclr
1630 FORY=0TO7:FORX=0TO3:IFA:GCOL0,POINT(xo%+4*X,yo%-4*Y):PLOT69,xo%+28-X*4,yo%-Y*4 ELSE GCOL0,POINT(xo%+28-4*X,yo%-4*Y):PLOT69,xo%+X*4,yo%-Y*4
1640 NEXT:NEXT:PROC_BIGGER:ENDPROC
1650 DEFPROCquit:PRINTFNbot"Quit program? ";:A=FNupDn("NY"):PROCclr:IFA:OSCLI"FX4":PROCend ELSE ENDPROC
1660 DEFPROCend:VDU23;10,103;0;0;0:ok%=TRUE:ONERRORok%=FALSE
1670 IFok%:IFPAGE>&8000:*QUIT
1680 END:ENDPROC
1690 DEFPROCchk:C%=32:PRINTFNbot;"Checking character set"
1700 PRINTTAB(-4*wd%,0);:REPEAT:IFC%<>127:B%=FNbyte(135,0,0):IFC%<>B%:PRINTFNbot'LEFT$(" Character",wd%)" "CHR$C%" (";C%;") decoded as "CHR$B%" (";B%;")";:B%=INKEY(50):PRINTTAB(C%MOD32-4*wd%,C%DIV32-1);
1710 C%=C%+1:VDU9:IF(C%AND31)=0:IFwd%:PRINT'SPC4;
1720 UNTILC%>255:PRINTFNbot;SPC(62-14*wd%):ENDPROC
1730 DEFPROCinp:PRINTTAB(0,23+3*(ht%<25));SPC(80);CHR$13;CHR$11;CHR$11;:ENDPROC
1740 DEFFNbot:PRINTTAB(1,22-(ht%>23));:=""
1750 DEFPROCclr:PRINTFNclr;:ENDPROC
1760 DEFFNclr:PRINTCHR$13;SPC(31-7*wd%);STRING$(31-7*wd%,CHR$8);:=""
1770 DEFFNbyte(A%,X%,Y%):=((USR&FFF4)AND&FF00)DIV256
1780 DEFPROCreset(C%):A%=FNbyte(25,0,0):IFFNbyte(20,FNbyte(182,0,255),0)<>32:ENDPROC
1790 IFC%:A%=10:FORB%=32TO255:?X%=B%:CALL&FFF1:VDU23,B%:FORC%=1TO8:VDUX%?C%DIV(2+(B%=95)-B%DIV128):NEXT:NEXT
1800 ENDPROC