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