10 REM >DefChar 2.06
   20 REM Character defining program
   30 REM By J.G.Harston
   40 MODE&84:g128=0:oflg%=0:REM VDU23;10,96;0;0;0
   50 REM Preserves char 128 during grid
   60 *K.10O.|MRUN|M
   70 er%=TRUE:ON ERROR PROCget128:PROC_ERROR:er%=TRUE:IF ERR<>17 ANDoflg%=0 GOTO190 ELSE IFoflg% CLS:GOTO190 ELSE GOTO480
   80 OSWORD=&FFF1:DIM cblk% 20:IF((INKEY-256)AND&F0)=&A0:*POINTER 1
   90 char=64:mx%=0:my%=0:ms%=0:mL%=0:mM%=0:mR%=0:DIMb% 7
  100 xo%=320:yo%=478
  110 *FX225,1
  120 *FX226,128
  130 *K.11|!J
  140 *K.12|!L
  150 *K.13|!M
  160 *K.14|!N
  170 *K.15|!O
  180 IFoflg% CLS
  190 PRINTTAB(0,30);SPC5;:*FX4,2
  200 PROC_CSET:oflg%=0
  210 RESTORE:Q=8:REPEAT:READ A$:PRINTTAB(18,Q);A$:Q=Q+1:UNTIL A$=""
  220 Q=8:REPEAT:READ A$:PRINTTAB(28,Q);A$:Q=Q+1:UNTIL A$=""
  230 DATA Get,Put,Load,Save,Quit," "," ",Cursors,to move,& scroll,
  240 DATA I Invert,H Rotate ^v,V Rotate <>,+ Rotate +90,- Rotate -90,\ Reflect,/ Reflect,T Reflect ^v,M Reflect <>,X Check set,
  250 PRINTTAB(13,19)"DefChar 2.06";TAB(4,20)"Copyright 1985,1993 J.G.Harston":GOTO470
  260 DEFPROC_CSET:LOCAL A,B:VDU30:FOR A=32 TO 255STEP32:PRINTSPC(4);:FOR B=A TO A+31:VDUB:NEXT:PRINT:NEXT:VDU31,34,2,126:PRINT'''':ENDPROC
  270 DEFPROC_EXPAND(C%):PRINTTAB(0,17);"Character ";CHR$C%;" (";C%;") ":PROC_BIGGER:ENDPROC
  280 DEFPROCsave128:LOCAL A%,X%,Y%:?cblk%=128:X%=cblk%:Y%=X%DIV256:A%=10:CALL OSWORD:g128=TRUE:VDU23,128,255,129,129,129,129,129,129,255:ENDPROC
  290 DEFPROCget128:IFNOTg128 ENDPROC
  300 LOCAL X:VDU23,128:FORX=1TO8:VDUcblk%?X:NEXT:g128=0:ENDPROC
  310 DEFFNd(A%):=STRING$(3-LENSTR$A%,"0")+STR$A%
  320 DEFPROC_BIGGER:LOCAL X,Y,A
  330 PROCsave128
  340 FOR Y=0 TO 7:PRINTTAB(1,8+Y);:A=0:FOR X=0 TO 7
  350 A=A*2:IF POINT(xo%+X*4,yo%-Y*4) COLOUR135:VDU32:COLOUR128:A=A+1 ELSE VDU128
  360 NEXT:PRINT"  ";FNd(A):b%?Y=A:NEXT:PROCget128:ENDPROC
  370 DEFPROCwait:PROCmse:IFms% GCOL4,0:MOVEmx%-12,my%:DRAWmx%+12,my%:MOVEmx%,my%-12:DRAWmx%,my%+12
  380 A$=INKEY$(5):IFms% MOVEmx%-12,my%:DRAWmx%+12,my%:MOVEmx%,my%-12:DRAWmx%,my%+12
  390 ENDPROC
  400 DEFPROC_ERROR:IFoflg%=0 PRINTTAB(0,30);SPC(38);
  410 IFer% er%=0:CLOSE#0
  420 PRINTTAB(0,31);SPC38;TAB(0,30);:IF ERR<>17 GOTO460
  430 IF INKEY-1 ANDINKEY-2 OSCLI"FX4":PRINTTAB(0,29)':END
  440 *FX4,2
  450 PRINTTAB(0,29)SPC38;:ENDPROC
  460 REPORT:IF ERR<128 ANDINKEY-1 PRINT" at line ";ERL:OSCLI"FX4":END ELSE A$=GET$:PRINTTAB(0,31);SPC(38);:ENDPROC
  470 X=0:Y=0:PROC_EXPAND(char)
  480 VDU31,X+1,Y+8
  490 REPEAT:PROCwait
  500 IFmx%>12 ANDmx%<308 ANDmy%>490 ANDmy%<788 PROCmsKlk
  510 IFmx%>124 ANDmx%<1152 ANDmy%>799 PROCmsChr
  520 IFmy%<768 AND((mx%>576 ANDmy%>608)OR(mx%>899 ANDmy%>444))ANDmL% PROCklik2
  530 UNTILA$<>"":GCOL0,7
  540 IFA$>"`" AND A$<"{" A$=CHR$(ASCA$-32)
  550 IF A$=CHR$204 X=(X-1) AND7
  560 IF A$=CHR$205 X=(X+1) AND7
  570 IF A$=CHR$206 Y=(Y+1) AND7
  580 IF A$=CHR$207 Y=(Y-1) AND7
  590 IF A$>CHR$139 AND A$<CHR$144 PROC_SCROLL((ASCA$)-140)
  600 IF A$=CHR$13 OR A$="P" GOTO840
  610 IF A$="*" GOTO870
  620 IF A$="S" GOTO900
  630 IF A$="L" GOTO1030
  640 IF (A$=CHR$202 OR A$=CHR$9) AND POINT(xo%+X*4,yo%-Y*4)=0 A$="1"
  650 IF (A$=CHR$202 OR A$=CHR$9) A$="0"
  660 IF A$="1" PLOT 69,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:GOTO490
  670 IF A$="0" PLOT 71,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,128,8:PROCget128:GOTO490
  680 IF A$="G" OR A$="C" PRINTTAB(0,29)"Get which":char=FN_CHAR:PRINTTAB(0,29)SPC(10):GOTO470
  690 IF A$="I" PROCinv:GOTO480
  700 IF A$="H" PROCrotH:GOTO480
  710 IF A$="V" PROCrotV:GOTO480
  720 IF A$="+" OR A$=";" PROCrotP:GOTO480
  730 IF A$="-" OR A$="=" PROCrotM:GOTO480
  740 IF A$="/" OR A$="?" PROCrefD1:GOTO480
  750 IF A$="\" OR A$="|" PROCrefD2:GOTO480
  760 IF A$="T" PROCtip:GOTO480
  770 IF A$="M" PROCmirr:GOTO480
  780 IF A$="Q" PROCquit:GOTO480
  790 IF A$="X" PROCchk:GOTO480
  800 GOTO480
  810 DEFFN_CHAR:LOCAL A$:*FX4
  820 PRINTTAB(0,30);"Character:    ";:INPUT LINE TAB(11,30);""A$:IF LEN A$=1 PRINTTAB(0,30);SPC(70);:OSCLI"FX4,2":=ASC A$
  830 IF VAL A$<32 OR VAL A$>255 PRINT"Invalid code";:GOTO820 ELSE PRINTTAB(0,30);SPC(70);:OSCLI"FX4,2":=VAL A$
  840 PRINTTAB(0,29)"Enter onto":ch=FN_CHAR:PRINTTAB(0,29)SPC(10):VDU 23,ch
  850 FOR A=0 TO 7:Q=0:FOR B=0 TO 7:Q=Q*2:IF POINT(xo%+B*4,yo%-A*4) Q=Q+1
  860 NEXT:VDUQ:NEXT:PRINTTAB(4+ch MOD32,ch DIV32-1);CHR$ch;:GOTO480
  870 PRINTTAB(0,19)SPC(80);TAB(0,19);"*";
  880 OSCLI"FX4":oflg%=TRUE:REPEAT:INPUT LINE""A$:OSCLI A$:PRINT":";:REPEATA$=GET$:UNTILINSTR(CHR$13+"LlSs*",A$):IFA$="*" VDU127,42
  890 UNTIL A$<>"*":PRINT':IF A$="L" OR A$="l" GOTO 1030 ELSE IF A$=CHR$13 oflg%=0:CLS:GOTO190
  900 oflg%=TRUE:PRINTTAB(0,30);:OSCLI"FX4":INPUT"Filename to save by: "F$:PRINTTAB(0,30);SPC(38)
  910 PRINTTAB(0,29);"Start at":start=FN_CHAR
  920 PRINTTAB(0,29);"End at  ":end=FN_CHAR
  930 PRINTTAB(0,29);"      ":INPUT"Arch format? "ar$:IFar$<>"Y"ANDar$<>"y" ar$=""
  940 OSCLI"FX4,2":LOOP=0:LOOP1=0:DIM B%-1:X%=cblk%:Y%=X%DIV256:A%=&A:IFHIMEM-B%-200<10*(end-start) GOTO 980
  950 C%=B%:FOR LOOP=start TO end:IFar$<>"" ?C%=23:C%?1=LOOP:C%=C%+2
  960 VDULOOP,9,13:?cblk%=LOOP:CALL OSWORD:FOR LOOP1=1TO8:?C%=cblk%?LOOP1:C%=C%+1:NEXT:NEXT
  970 OSCLI"SAVE "+F$+" "+STR$~B%+" "+STR$~C%+" "+STR$~(TRUE+65535*(ar$=""))+" FFFFF"+STR$~(13+6*(ar$<>""))+"00":CLS:GOTO190
  980 ch=OPENOUT(A$):PRINTTAB(0,29);:IFch=0 PRINT"Can't open file":ch=GET:CLS:GOTO190
  990 CLOSE#ch:OSCLI"SAVE "+F$+" 0+"+STR$~(10*(end-start))+" FFFFFFFF FFFFF"+STR$~(13+6*(ar$<>""))+"00":ch=OPENUP(A$)
 1000 FOR LOOP=start TO end:VDULOOP,9,13:IFar$<>"" BPUT#ch,23:BPUT#ch,LOOP
 1010 ?cblk%=LOOP:CALL OSWORD:FOR LOOP1=1 TO 8:BPUT#ch,cblk%?LOOP1:NEXT:NEXT
 1020 CLOSE#ch:CLS:GOTO190
 1030 oflg%=TRUE:OSCLI"FX4":INPUTTAB(0,30);"Filename to load: "A$:PRINTTAB(0,30);SPC(38)
 1040 ch=OPENIN(A$):IFch=0 PRINT"File not found";:ch=GET:PRINTTAB(0,31)SPC(15);:GOTO180
 1050 rx%=EXT#ch:IF((rx%/10)<>(rx%DIV10)AND(rx%/8)<>(rx%DIV8))OR rx%>&FFF OR rx%<8:CLOSE#ch:PRINT"Not a proper font file";:ch=GET:PRINTTAB(0,31)SPC(25);:GOTO180
 1060 ra%=0:in%=0:rb%=0:rc%=0:DIM B%-1:B%=B%+80:IFHIMEM-B%-200<&1000 GOTO 1100
 1070 CLOSE#ch:OSCLI"LOAD "+A$+" "+STR$~B%:IF?B%=23 AND(rx%/10)=(rx%DIV10):FORra%=B% TO B%+rx%-1:VDU?ra%:NEXT:GOTO1160
 1080 PRINTTAB(0,29);"Start at":ra%=FN_CHAR:PRINTTAB(0,29);SPC(38)
 1090 REPEAT:VDU23,ra%:FOR rb%=0 TO 7:VDUB%?rb%:NEXT:VDUra%,9,13:B%=B%+8:rx%=rx%-8:ra%=ra%+1:UNTILra%>255 OR rx%<1:GOTO1160
 1100 ra%=BGET#ch:IFra%=23 AND(EXT#ch/10)=(EXT#ch DIV10) ra%=BGET#ch:in%=TRUE ELSE in%=FALSE:PRINTTAB(0,29);"Start at":ra%=FN_CHAR:PRINTTAB(0,29);SPC(38)
 1110 PTR#ch=0:REPEAT:rb%=BGET#ch:IF(in%ANDrb%<>23)OR 4+PTR#ch>EXT#ch ra%=256:GOTO1150
 1120 IFin% rch%=BGET#ch
 1130 VDU23:IFin%VDUrch%,BGET#ch ELSE VDUra%,rb%
 1140 rc%=0:REPEAT:VDUBGET#ch:rc%=rc%+1:UNTILrc%=7 OR EOF#ch:IFin% VDUrch%,9,13 ELSE VDUra%,9,13
 1150 ra%=ra%+1:UNTILra%>255 OREOF#ch:CLOSE#ch
 1160 PRINTTAB(0,31);SPC5;:GOTO180
 1170 DEFPROC_SCROLL(A):LOCAL X,Y,xs,xe,xst,ys,ye,yst,temp
 1180 ON A+1 GOSUB 1210,1200,1250,1260
 1190 PROC_BIGGER:GCOL0,7:ENDPROC
 1200 xs=7:xe=1:xst=-1:GOTO1220
 1210 xs=0:xe=6:xst=1
 1220 FOR Y=0 TO 7:temp=POINT(xo%+xs*4,yo%-Y*4):FOR X=xs TO xe STEP xst
 1230 GCOL 0,POINT(xo%+(X+xst)*4,yo%-Y*4):PLOT 69,xo%+X*4,yo%-Y*4:NEXT
 1240 GCOL 0,temp:PLOT 69,xo%+(xe+xst)*4,yo%-Y*4:NEXT:RETURN
 1250 ys=7:ye=1:yst=-1:GOTO1270
 1260 ys=0:ye=6:yst=1
 1270 FOR X=0 TO 7
 1280 temp=POINT(xo%+X*4,yo%-ys*4):FOR Y=ys TO ye STEP yst
 1290 GCOL 0,POINT(xo%+X*4,yo%-(Y+yst)*4):PLOT 69,xo%+X*4,yo%-Y*4:NEXT
 1300 GCOL 0,temp:PLOT 69,xo%+X*4,yo%-(ye+yst)*4:NEXT
 1310 RETURN
 1320 IFar$<>"" BPUT#ch,23:BPUT#ch,LOOP
 1330 DEFPROCmsKlk:IFmL%+mM%+mR%=0 ENDPROC
 1340 IFmx%<32 A$=CHR$140:ENDPROC
 1350 IFmx%>288 A$=CHR$141:ENDPROC
 1360 IFmy%<512 A$=CHR$142:ENDPROC
 1370 IFmy%>767 A$=CHR$143:ENDPROC
 1380 IFmL% A$="1"
 1390 IFmM% A$=CHR$9
 1400 IFmR% A$="0"
 1410 X=mx%DIV32-1:Y=23-my%DIV32:VDU31,X+1,Y+8
 1420 IFmM% REPEATPROCmse:UNTILNOTmM%
 1430 ENDPROC
 1440 DEFPROCmsChr:IFmL%+mR%=0 ENDPROC
 1450 ch%=mx%DIV32+28+32*(31-my%DIV32)
 1460 IFmL% A$="C"
 1470 IFmR% A$=CHR$13
 1480 OSCLI"FX138,0,"+STR$(48+ch%DIV100):ch%=ch%MOD100
 1490 OSCLI"FX138,0,"+STR$(48+ch%DIV10):ch%=ch%MOD10
 1500 OSCLI"FX138,0,"+STR$(48+ch%):OSCLI"FX138,0,13"
 1510 ENDPROC
 1520 DEFPROCklik2:LOCAL x%:x%=mx%DIV32:IFx%>27 x%=28 ELSE x%=18
 1530 VDU31,x%,31-my%DIV32:A%=135:ch%=(USR&FFF4 AND&FF00)DIV256:A$=CHR$ch%:VDU31,X+1,Y+8:ENDPROC
 1540 DEFPROCmse:LOCALX%,Y%,A%
 1550 IF((INKEY-256)AND&F0)=&A0 mx%=ADVAL(7):my%=ADVAL(8):mL%=INKEY-10:mM%=INKEY-11:mR%=INKEY-12:ENDPROC
 1560 X%=cblk%:Y%=X%DIV256:A%=64:!X%=-1:CALL&FFF1:ms%=!X%<>-1:IFNOTms% ENDPROC
 1570 mx%=!X%AND&FFFF:my%=X%!2 AND&FFFF
 1580 mL%=(X%?6 AND32)=0:mM%=(X%?6 AND64)=0:mR%=(X%?6 AND128)=0:ENDPROC
 1590 DEFPROCinv:LOCAL A,X,Y
 1600 GCOL 4,0:FOR X=0 TO 7:FOR Y=0 TO 7:PLOT 69,xo%+X*4,yo%-Y*4:NEXT:NEXT:PROC_BIGGER:ENDPROC
 1610 DEFPROCrotH:LOCAL A,X,Y
 1620 FOR X=0 TO 7:FOR Y=0 TO 3:A=POINT(xo%+X*4,yo%-Y*4):GCOL 0,POINT(xo%+X*4,yo%-28+Y*4):PLOT 69,xo%+X*4,yo%-Y*4:GCOL 0,A:PLOT 69,xo%+X*4,yo%-28+Y*4:NEXT:NEXT:PROC_BIGGER:ENDPROC
 1630 DEFPROCrotV:LOCAL A,X,Y
 1640 FOR Y=0 TO 7:FOR X=0 TO 3:A=POINT(xo%+X*4,yo%-Y*4):GCOL 0,POINT(xo%+28-X*4,yo%-Y*4):PLOT 69,xo%+X*4,yo%-Y*4:GCOL 0,A:PLOT 69,xo%+28-X*4,yo%-Y*4:NEXT:NEXT:PROC_BIGGER:ENDPROC
 1650 DEFPROCrefD2:LOCAL A,X,Y
 1660 PRINTTAB(0,30)"Copy Topright or Bottomleft?";:A=FNupDn("TB"):PRINTTAB(0,30)SPC30;
 1670 FOR X=0 TO 7:FOR Y=X TO 7:IF A GCOL 0,POINT(xo%+4*X,yo%-4*Y):PLOT 69,xo%+4*Y,yo%-4*X ELSE GCOL 0,POINT(xo%+4*Y,yo%-4*X):PLOT 69,xo%+4*X,yo%-4*Y
 1680 NEXT:NEXT:PROC_BIGGER:ENDPROC
 1690 DEFPROCrefD1:LOCAL A,X,Y
 1700 PRINTTAB(0,30)"Copy Topleft or Bottomright?";:A=FNupDn("TB"):PRINTTAB(0,30)SPC30;
 1710 FOR Y=0 TO 7:FOR X=Y TO 7:IF A GCOL 0,POINT(xo%+28-4*Y,yo%-4*X):PLOT 69,xo%+28-4*X,yo%-4*Y ELSE GCOL 0,POINT(xo%+28-4*X,yo%-4*Y):PLOT 69,xo%+28-4*Y,yo%-4*X
 1720 NEXT:NEXT:PROC_BIGGER:ENDPROC
 1730 ENDPROC
 1740 DEFFNupDn(B$):LOCAL x%:x%=POS*32:REPEAT:PROCwait:UNTILmL%+mM%+mR%=0:REPEAT:PROCwait:IFA$>"`" A$=CHR$(ASCA$-32)
 1750 IFmR% AND B$="NY" A$="N"
 1760 IFmL% AND my%<64 AND mx%<x% THEN A$=MID$(B$,1+2*mx%DIVx%,1):IFB$="NY" A$="Y"
 1770 UNTILINSTR(B$,A$) AND A$<>"":PRINTA$;:=INSTR(B$,A$)=2
 1780 DEFPROCrotP:PROCrotD2:PROCrotV:ENDPROC
 1790 ENDPROC
 1800 DEFPROCrotM:PROCrotD1:PROCrotH:ENDPROC
 1810 ENDPROC
 1820 DEFPROCrotD1:LOCAL A,X,Y:FOR X=0 TO 7:FOR Y=X TO 7:A=POINT(xo%+4*X,yo%-4*Y):GCOL 0,POINT(xo%+4*Y,yo%-4*X):PLOT 69,xo%+4*X,yo%-4*Y:GCOL 0,A:PLOT 69,xo%+4*Y,yo%-4*X:NEXT:NEXT:ENDPROC
 1830 DEFPROCrotD2:LOCAL A,X,Y
 1840 FOR Y=0 TO 7:FOR X=Y TO 7
 1850 A=POINT(xo%+4*X,yo%-4*Y):GCOL 0,POINT(xo%+4*Y,yo%-4*X):PLOT 69,xo%+4*X,yo%-4*Y:GCOL 0,A:PLOT 69,xo%+4*Y,yo%-4*X:NEXT:NEXT:ENDPROC
 1860 DEFPROCtip:LOCAL A,X,Y
 1870 PRINTTAB(0,30);"Copy Top or Bottom?";:A=NOTFNupDn("TB"):PRINTTAB(0,30)SPC20;
 1880 FOR X=0 TO 7:FOR Y=0 TO 3:IF A GCOL 0,POINT(xo%+4*X,yo%-4*Y):PLOT 69,xo%+X*4,yo%-28+Y*4 ELSE GCOL 0,POINT(xo%+4*X,yo%-28+4*Y):PLOT 69,xo%+X*4,yo%-Y*4
 1890 NEXT:NEXT:PROC_BIGGER:ENDPROC
 1900 DEFPROCmirr:LOCAL A,X,Y
 1910 PRINTTAB(0,30);"Copy Left or Right?";:A=NOTFNupDn("LR"):PRINTTAB(0,30)SPC20;
 1920 FOR Y=0 TO 7:FOR X=0 TO 3:IF A GCOL 0,POINT(xo%+4*X,yo%-4*Y):PLOT 69,xo%+28-X*4,yo%-Y*4 ELSE GCOL 0,POINT(xo%+28-4*X,yo%-4*Y):PLOT 69,xo%+X*4,yo%-Y*4
 1930 NEXT:NEXT:PROC_BIGGER:ENDPROC
 1940 DEFPROCquit:PRINTTAB(0,30);"Quit program? ";:A=FNupDn("NY"):PRINTTAB(0,30)SPC20;TAB(0,29);:IF A OSCLI"FX4":END ELSE ENDPROC
 1950 DEFPROCchk:LOCAL A%,x%,y%:x%=32
 1960 PRINTTAB(0,29);"Checking character set"
 1970 PRINTTAB(4,0);:A%=135:REPEAT:IFx%<>127 y%=(USR&FFF4 AND&FF00)DIV256:IFx%<>y% PRINTTAB(0,29);"Character ";CHR$x%;" (";x%;") decoded as ";CHR$y%;" (";y%;")    ":y%=INKEY(50):PRINTTAB(4+x%MOD32,x%DIV32-1);
 1980 x%=x%+1:VDU9:IF(x%AND31)=0 PRINT'SPC4;
 1990 UNTILx%>255:PRINTTAB(0,29)SPC38:ENDPROC