5 PRINT"Font editing program for TYPESET.BAS.  ¤ 1990, by Keith M. Simons.
10 DIM note$(24):GOSUB 190
20 DIM a%(12,24):WIDTH 255
30 PRINT "Please type in character to edit, or [EXIT] to finish.":aa=ASC(STRIP$(INPUT$(1)))-32
35 IF aa<=0 THEN IF aa=-5 THEN PRINT"Finish using?  Are you sure (press Y or N)? ":abc$=UPPER$(INPUT$(1)):IF abc$="Y" THEN PRINT x$"e";:GOSUB 390:GOTO 25000
36 IF aa<=0 THEN IF aa<>-5 THEN PRINT "Character invalid.":GOTO 30 ELSE 30
40 x$=CHR$(27):z1$=x$+"Y9 ":PRINT x$"f"x$"E"x$"H";
41 PRINT:PRINT:PRINT TAB(50)"Press [ENTER] when finished."
42 PRINT:PRINT TAB(50)"Use cursor keys to move up or down"
43 PRINT:PRINT TAB(50)"Use the [1],[2],[3],[4],[5],[6],[7]
44 PRINT TAB(50)"[8],[9],[0],[-], and [=] keys to
45 PRINT TAB(50)"set or unset particular pixels."
46 PRINT:PRINT TAB(50)"Press [PASTE] to type a note on screen."
47 PRINT TAB(50)"(then [ENTER] to finish typing the note).":PRINT
48 PRINT TAB(50)"Current character: "CHR$(aa+32)
49 PRINT:PRINT TAB(50)"Old file: "fontfile1$:PRINT:PRINT TAB(50)"New file: "fontfile2$:PRINT x$"H";
50 DEF FNa$=x$+"Y"+CHR$(y+31)+CHR$(31+(x*2))
60 DEF FNb$(a$)=x$+"Y"+CHR$(y+31)+CHR$(32)+a$+x$+"Y"+CHR$(y+31)+CHR$(57)+a$
70 FOR a=1 TO 24:PRINT SPACE$(28);note$(a):NEXT:PRINT" .1.2.3.4.5.6.7.8.9.0.-.="
80 PRINT"Current character width ="d%(aa)
90 GOSUB 220:FOR x=1 TO 12:FOR y =1 TO 24:GOSUB 290:NEXT y,x:y=1:x=0:PRINT FNb$("*")
100 z$=INPUT$(1)
110 'IF z$=CHR$(27) THEN PRINT x$"e":GOSUB 390:END
120 IF z$=CHR$(23) THEN PRINT FNb$("*");:PRINT"    "x$"e";:LINE INPUT note$(y):PRINT x$"f";:GOTO 100
130 IF z$=CHR$(13) THEN GOSUB 300:ERASE a%:GOTO 20
140 IF z$=CHR$(30) THEN PRINT FNb$(" "):y=MIN(y+1,24):PRINT FNb$("*")
150 IF z$=CHR$(31) THEN PRINT FNb$(" "):y=MAX(y-1,1):PRINT FNb$("*")
160 a=INSTR("1234567890-=",z$):IF a=0 THEN 100
170 x=a:IF a%(x,y) THEN a%(x,y)=0:PRINT FNa$;"  ":ELSE a%(x,y)=-1:PRINT FNa$;x$"p  "x$"q"
180 GOTO 100
190 FILES "*.FT":PRINT:PRINT:GOSUB 500:GOTO 360:OPEN "r",2,"normal.f",16:FIELD 2,8 AS d1$,8 AS d2$
200 DIM d$(3,97),d%(97):FOR cc=32 TO 128:GET 2:d$(1,cc-32)=CHR$(0)+d1$:d$(2,cc-32)=CHR$(0)+d2$:d$(3,cc-32)=STRING$(8,CHR$(0)):NEXT:CLOSE
210 RETURN
220 PRINT z1$:FOR ccc%=1 TO 3:FOR cc%=1 TO 12
230 b%=ASC(MID$(d$(ccc%,aa),cc%)):IF b%=0 THEN 280
240 FOR a%=1 TO 8
250 IF b% MOD 2=1 THEN a%(cc%,24-((a%*3)-ccc%))=-1:PRINT ".";
260 b%=b%\2
270 NEXT a%
280 NEXT cc%:NEXT ccc%:RETURN
290 IF a%(x,y) THEN PRINT FNa$;x$;"p  ";x$"q";:RETURN ELSE RETURN
300 PRINT z1$:FOR ccc%=1 TO 3:FOR cc%=1 TO 12
310 b%=0
320 FOR a%=1 TO 8
330 IF a%(cc%,24-((a%*3)-ccc%))=-1 THEN b%=b%+(2^(a%-1)):PRINT "²";
340 NEXT a%:MID$(d$(ccc%,aa),cc%)=CHR$(b%):b%=0
350 NEXT cc%:NEXT ccc%:PRINT z1$
355 INPUT "Character width?  ",d%(aa):IF d%(aa)<0 OR d%(aa)>12 THEN 355:ELSE RETURN
360 PRINT"Loading file...":OPEN "r",2,fontfile1$,37:FIELD 2,12 AS d1$,12 AS d2$,12 AS d3$,1 AS dd$
370 DIM d$(3,97),d%(97):FOR cc=32 TO 128:GET 2:d$(1,cc-32)=d1$:d$(2,cc-32)=d2$:d$(3,cc-32)=d3$:d%(cc-32)=ASC(dd$):NEXT:CLOSE
380 RETURN
390 PRINT"Saving file...":OPEN "r",2,fontfile2$,37:FIELD 2,12 AS d1$,12 AS d2$,12 AS d3$,1 AS dd$
400 FOR cc=0 TO 97:LSET d1$=d$(1,cc):LSET d2$=d$(2,cc):LSET d3$=d$(3,cc):LSET dd$=CHR$(d%(cc)):PUT 2,cc+1:NEXT:CLOSE
410 RETURN
500 PRINT "Please type in the font filename to edit:  ";:q=15:l$="":GOSUB 2020:IF FIND$(l$)<>"" THEN fontfile1$=l$ ELSE 500
510 PRINT "Please amend to the new font filename:     ";:GOSUB 2020:IF l$=fontfile1$ THEN fontfile2$=l$ ELSE IF FIND$(l$)="" THEN fontfile2$=l$ ELSE l$=fontfile1$:GOTO 510
520 RETURN
2000 q=60:WHILE 1:l$="":GOSUB 2020:LPRINT SPC(8);l$:WEND
2010 'New Line Input Subroutine by Keith M. Simons:
2020 p=0:x$=CHR$(27):WIDTH 255:PRINT x$"j"l$x$"k";:y$=CHR$(1)+CHR$(6)+CHR$(127)+CHR$(7)
2030 z$=INPUT$(1):ON INSTR(y$,z$) GOSUB 2070,2080,2090,2100:IF INSTR(y$,z$) GOTO 2030
2040 IF z$<" " THEN PRINT:RETURN
2050 IF LEN(l$)>=q THEN PRINT CHR$(7);:GOTO 2030
2060 l$=LEFT$(l$,p)+z$+MID$(l$,p+1):PRINT x$"j"MID$(l$,p+1)x$"k"x$"C";:p=p+1:GOTO 2030
2070 IF p>0 THEN p=p-1:PRINT x$"D";:RETURN ELSE PRINT CHR$(7);:RETURN
2080 IF p<LEN(l$) THEN p=p+1:PRINT x$"C";:RETURN ELSE PRINT CHR$(7);:RETURN
2090 IF p>0 THEN p=p-1:PRINT x$"D";:ELSE PRINT CHR$(7);:RETURN
2100 l$=LEFT$(l$,p)+MID$(l$,p+2):PRINT x$"N";:RETURN
25000 IF FIND$("M:$$$$$$$$.&&&")<>"" THEN OPTION STOP:PRINT "[Press any key to return to main menu or press (STOP) to stop]":z$=INPUT$(1):RUN "M:$$$$$$$$.&&&":ELSE END
OPTION ST