10 ' FONTCODE.BAS Version 1.1 (C) Copyright 1985 by Merlin R. Null
20 ' Creates encoded data files for use with the FONTSY banner
30 ' printer from multiple source files created with a word processor.
40 ' This program may not be sold separately or as part of any
50 ' collection of programs or used as an inducement to buy any other
60 ' product or program without the written permission of the author:
70 ' Merlin R. Null, P.O. Box 9422, N. Hollywood, CA 91609, (818) 762-1429
80 DEFINT A-Z
90 DIM CHARCODE$(95)
100 ON ERROR GOTO 3730
110 BL$=CHR$(7)
120 OPEN "I",#1,"CLS.DAT"
130 WHILE NOT EOF(1)
140   LINE INPUT #1, A$
150   CLS$=CLS$+CHR$(VAL(A$))
160 WEND
170 CLOSE #1
180 FONT$="<none>"
190		' Read font name in CP/M command tail.  Compiled version only
200 CTLEN=PEEK(128)
210 IF CTLEN<2 THEN 260
220 FOR I=2 TO CTLEN
230   NEWFONT$=NEWFONT$+CHR$(PEEK(128+I))
240 NEXT I
250 GOTO 590
260 PRINT CLS$
270 PRINT"FONTCODE  version 1.1	  9/16/85  (C) 1985  Merlin R. Null"
280 PRINT
290 PRINT"Encodes or decodes font data files used with the"
300 PRINT"FONTSY banner printer."
310 PRINT:PRINT
320 PRINT"The current font is:  ";FONT$
330 IF FONT$<>"<none>" THEN PRINT"Title:	";TITLE$ ELSE PRINT
340 PRINT"	";COMMENT$
350 PRINT:PRINT
360 PRINT"1. Load an existing font (encoded)"
370 PRINT"2. Load a single font character (text)"
380 PRINT"3. Load a full set of font characters (text)"
390 PRINT"4. Open a new font"
400 PRINT"5. Unload a single character from the current font"
410 PRINT"6. Unload all of the current font to text files"
420 PRINT"7. Save the current font"
430 PRINT"8. Change font defaults"
440 PRINT"9. EXIT"
450 PRINT
460 PRINT"Option (1-9)? ";
470 OPT$=INPUT$(1)
480 PRINT OPT$
490 IF ASC(OPT$)<49 OR ASC(OPT$)>57 THEN PRINT BL$;:GOTO 260
500 PRINT CLS$
510 PRINT:PRINT
520 OPT=VAL(OPT$)
530 NOTUSED=0
540 ON OPT GOTO 560,720,910,1160,1300,1460,1690,1960,2010
550		' Option 1. Load an existing font (encoded)
560 PRINT TAB(15)"Load an Existing Encoded Font (Encoded)"
570 PRINT STRING$(3,10)
580 LINE INPUT"Encoded font to load? ";NEWFONT$
590 GOSUB 2420		' Case conversion & font name check
600 OPEN "I",#1,FONT$
610 LINE INPUT #1,TITLE$
620 LINE INPUT #1,COMMENT$
630 LINE INPUT #1,PRNCHAR$
640 LINE INPUT #1,MARGIN$
650 LINE INPUT #1,SPACING$
660 FOR I=1 TO 95
670   LINE INPUT #1,CHARCODE$(I)
680 NEXT I
690 CLOSE
700 GOTO 260		' Return to main menu
710		' Option 2.
720 IF FONT$="<none>" THEN ERROR 201
730 PRINT TAB(15)"Load a single font character (text)"
740 PRINT STRING$(3,10)
750 PRINT"Enter a single keystroke followed by <RETURN> to load a character"
760 PRINT"file.  A bare <RETURN> to exits to the main menu."
770 PRINT:PRINT
780 PRINT"Enter the character you wish to add to ";FONT$;" ";
790 LINE INPUT CHAR$
800 IF CHAR$="" THEN 260	' Exit to menu if no input
810 IF ASC(CHAR$)<32 OR ASC(CHAR$)>126 OR LEN(CHAR$)>1 THEN PRINT BL$:GOTO 780
820 CHARS=ASC(CHAR$)
830 PRINT"Adding ";FONT$;" character #";CHARS
840 GOSUB 2120		' Encode character
850 IF NOTUSED>0 THEN PRINT BL$;"Source file ";CHARIN$;" not found"
860 PRINT
870 NOTUSED=0
880 NOTSAVED=-1
890 GOTO 780		' Again?
900		' Option 3. Load a full set of font characters (text)
910 PRINT TAB(15)"Load a full set of font characters (text)"
920 PRINT STRING$(3,10)
930 LINE INPUT"Font to load? ";NEWFONT$
940 GOSUB 2420		' Case conversion & font name check
950 GOSUB 2970		' Set font defaults
960 PRINT CLS$
970 PRINT"Loading a full set of font characters (text)"
980 PRINT:PRINT
990 PRINT"Go take a break, this will take a while."
1000 PRINT:PRINT
1010 PRINT TAB(7)"^S to Pause ^C to Abort"
1020 PRINT STRING$(4,10)
1030 PRINT"Working on ";FONT$;" character #    ";
1040 FOR CHARS=32 TO 126
1050   N=LEN(STR$(CHARS-1))+1
1060   PRINT STRING$(N,8);SPC(N);STRING$(N,8);CHARS;
1070   GOSUB 2120	' Encode single font character
1080 NEXT CHARS
1090 PRINT:PRINT
1100 PRINT 95-NOTUSED;"characters included in the font ";FONTOUT$
1110 PRINT
1120 NOTSAVED=-1
1130 GOSUB 2070 ' hold
1140 GOTO 260		' Return to main menu
1150		' Option 4. Open a new font
1160 PRINT TAB(20)"Open a New Font"
1170 PRINT:PRINT:PRINT
1180 PRINT"Enter the file name of your font.  If no extension is specified"
1190 PRINT"the default of FNT will be used.  A drive for the font may be"
1200 PRINT"included.  A bare <RETURN> exits to the main menu."
1210 PRINT
1220 PRINT"Example:  B:BRILLIG.FNT"
1230 PRINT:PRINT:PRINT
1240 LINE INPUT"Font Name? ";NEWFONT$
1250 GOSUB 2420		' Case conversion & font name check
1260 GOSUB 2970		' Set new font defaults
1270 NOTSAVED=-1
1280 GOTO 260		' Return to main menu
1290		' Option 5. Unload a single character to a text file
1300 IF FONT$="<none>" THEN ERROR 201
1310 PRINT"To unload a single character to a text file from ";FONT$;","
1320 PRINT"enter with a single keystroke, the character you want sent"
1330 PRINT"to a file.  Enter <RETURN> to return to the main menu."
1340 PRINT
1350 LINE INPUT"Character to unload: ";CHAR$
1360 IF LEN(CHAR$)>1 THEN PRINT BL$:GOTO 1300
1370 IF CHAR$="" THEN 260
1380 CHAR=ASC(CHAR$)
1390 IF CHAR<32 OR CHAR>126 THEN 260
1400 CH=CHAR-31
1410 PRINT
1420 PRINT"Unloading ";FONT$;" character: ";CHAR
1430 GOSUB 2750		' Write large character text file
1440 GOTO 1340		' Another character to unload?
1450		' Option 6. Unload all of an current font to text files
1460 IF FONT$="<none>" THEN ERROR 201
1470 PRINT TAB(5)"Unload all of ";FONT$;" to text files."
1480 PRINT:PRINT
1490 PRINT"This will take a while and use a lot of disk space.  For a full"
1500 PRINT"font you will need from 100k to over 200k of free disk space"
1510 PRINT"and a free directory entry for each character of the font."
1520 PRINT
1530 INPUT"Do you wish to continue (Y/N)";ANS$
1540 IF LEFT$(ANS$,1)="Y" OR LEFT$(ANS$,1)="y" THEN PRINT ELSE 260
1550 PRINT
1560 PRINT"Unloading all of ";FONT$;" to text files (Characters 32-126)."
1570 PRINT:PRINT
1580 PRINT"Unloading character:     ";
1590 FOR CH=1 TO 95
1600   IF CHARCODE$(CH)="" THEN 1650
1610   CHAR=CH+31
1620   N=LEN(STR$(CHAR))
1630   PRINT STRING$(N+1,8);SPC(N);STRING$(N,8);CHAR;
1640   GOSUB 2750	' Write large character text file
1650 NEXT CH
1660 PRINT
1670 GOTO 260		' Return to main menu
1680		' Option 7. Save current font
1690 IF FONT$="<none>" THEN ERROR 201
1700 PRINT TAB(15)"Save the current font."
1710 PRINT
1720 FONTBAK$=LEFT$(FONT$,INSTR(FONT$,"."))+"BAK"
1730 OPEN "I",#1,FONT$		'See if output font already exists
1740 CLOSE #1			'Close, if found, else error trap gets it
1750 RENAMEFONT=-1
1760 OPEN "I",#1,FONTBAK$	'See if <fontname>.BAK exists.
1770 CLOSE #1			'Close, if found, else error trap gets it
1780 PRINT"Erasing  ";FONTBAK$
1790 KILL FONTBAK$
1800 IF RENAMEFONT THEN PRINT"Changing ";FONT$;" to ";FONTBAK$ ELSE 1820
1810   NAME FONT$ AS FONTBAK$
1820 PRINT"Writing  ";FONT$
1830 OPEN "O",#1,FONT$
1840 PRINT #1,TITLE$
1850 PRINT #1,COMMENT$
1860 PRINT #1,PRNCHAR$
1870 PRINT #1,MARGIN$
1880 PRINT #1,SPACING$
1890 FOR J=1 TO 95
1900   PRINT #1,CHARCODE$(J)
1910 NEXT J
1920 CLOSE
1930 NOTSAVED=0
1940 GOTO 260		' Return to main menu
1950		' Option 8. Change font defaults"
1960 IF FONT$="<none>" THEN ERROR 201
1970 GOSUB 2970		' Set font defaults
1980 NOTSAVED=-1
1990 GOTO 260		' Return to main menu
2000		' Option 9. EXIT
2010 IF NOT NOTSAVED THEN 2050
2020 PRINT"Abandon modified font: ";FONT$;" (Y/N)?";
2030 ANS$=INPUT$(1)
2040 IF ANS$<>"Y" AND ANS$<>"y" THEN 260
2050 END
2060		' Hold before return to menu subroutine
2070 PRINT
2080 PRINT"<Press any key to return to main menu> ";
2090 WHILE INKEY$="":WEND
2100 RETURN
2110		' Encode character text file subroutine
2120 TMP$=""
2130 EXTENSION$=MID$(STR$(CHARS),2)
2140 IF LEN(EXTENSION$)<3 THEN EXTENSION$="0"+EXTENSION$
2150 CHARIN$=LEFT$(FONT$,INSTR(FONT$,"."))+EXTENSION$
2160 OPEN "I",#2,CHARIN$
2170 FOR LINES=1 TO 200
2180   LINE INPUT #2,TXT$
2190   COL=0:SEGLEN=0
2200   FOR CHAR=LEN(TXT$) TO 1 STEP -1
2210     IF MID$(TXT$,CHAR,1)<>" "AND MID$(TXT$,CHAR,1)<>CHR$(9) THEN 2240
2220   NEXT CHAR
2230   TMP$=TMP$+CHR$(255):GOTO 2360
2240   FOR BYTE=1 TO CHAR
2250     IF SEGLEN=95 THEN TMP$=TMP$+CHR$(127):SEGLEN=0
2260     BYTE$=MID$(TXT$,BYTE,1)
2270     IF BYTE$=CHR$(9) THEN COL=COL+8-(COL MOD 8) ELSE COL=COL+1
2280     IF SEGLEN THEN 2300
2290     IF BYTE$<>" " AND BYTE$<>CHR$(9) THEN TMP$=TMP$+CHR$(COL+31)
2300     IF BYTE$<>" " AND BYTE$<>CHR$(9) THEN SEGLEN=SEGLEN+1
2310     IF SEGLEN=0 THEN 2340
2320     IF BYTE$=" " OR BYTE$=CHR$(9) THEN TMP$=TMP$+CHR$(SEGLEN+32)

           :SEGLEN=0
2330     IF INKEY$<>"" THEN GOSUB 2670
2340   NEXT BYTE
2350   TMP$=TMP$+CHR$(SEGLEN+160)
2360   IF EOF(2) THEN 2380
2370 NEXT LINES
2380 CHARCODE$(CHARS-31)=TMP$
2390 CLOSE #2
2400 RETURN
2410		' New font subroutine
2420 IF NEWFONT$="" THEN 260
2430 IF NOT NOTSAVED THEN 2480
2440 PRINT
2450 PRINT"Abandon ";FONT$;" (Y/N) ";
2460 INPUT ANS$
2470 IF LEFT$(ANS$,1)<>"Y" AND LEFT$(ANS$,1)<>"y" THEN 260
2480 FOR I=1 TO LEN(NEWFONT$)
2490   BYTE=ASC(MID$(NEWFONT$,I,1))
2500   IF BYTE>96 AND BYTE<123 THEN MID$(NEWFONT$,I,1)=CHR$(BYTE-32)
2510   IF BYTE=59 THEN MID$(NEWFONT$,I,1)=":"
2520 NEXT I
2530 IF INSTR(NEWFONT$,".")=0 THEN NEWFONT$=NEWFONT$+".FNT"
2540 IF INSTR(NEWFONT$,".")-INSTR(NEWFONT$,":")>9 THEN ERROR 64
2550 FONT$=""
2560 TITLE$=""
2570 COMMENT$=""
2580 PRNCHAR$=""
2590 MARGIN$=""
2600 SPACING$=""
2610 FOR I=1 TO 95
2620   CHARCODE$(I)=""
2630 NEXT I
2640 FONT$=NEWFONT$
2650 RETURN
2660		' Quit or hold subroutine for compiler only
2670 IF QUIT$=CHR$(3) THEN CLOSE ELSE 2720
2680   PRINT:PRINT
2690   PRINT BL$;"*** ABORTING *** ^C Entered from Keyboard"
2700   GOSUB 2060	' Hold before return
2710   GOTO 260		' Return to main menu
2720 IF QUIT$<>CHR$(19) THEN WHILE INKEY$="":WEND
2730 RETURN
2740		' Write large character text file subroutine
2750 CODELEN=LEN(CHARCODE$(CH))
2760 IF CODELEN=0 THEN 2950
2770 EXT$=MID$(STR$(CHAR),2)
2780 IF LEN(EXT$)=2 THEN EXT$="0"+EXT$
2790 CHAROUT$=LEFT$(FONT$,INSTR(FONT$,"."))+EXT$
2800 OPEN "O",#1,CHAROUT$
2810 FOR BYTE=1 TO CODELEN STEP 2
2820   LINEFLAG=0
2830   IF MID$(CHARCODE$(CH),BYTE,1)=CHR$(255) THEN PRINT #1,"" ELSE 2860
2840     BYTE=BYTE-1
2850     GOTO 2930
2860   COLUMN=ASC(MID$(CHARCODE$(CH),BYTE,1))-31
2870   LENGTH=ASC(MID$(CHARCODE$(CH),BYTE+1,1))
2880   IF LENGTH>127 THEN LENGTH=LENGTH-128:LINEFLAG=-1
2890   LENGTH=LENGTH-32
2900   PRINT #1,TAB(COLUMN) STRING$(LENGTH,PRNCHAR$);
2910   IF LINEFLAG THEN PRINT #1,""
2920   IF INKEY$<>"" THEN GOSUB 2670
2930 NEXT BYTE
2940 CLOSE #1
2950 RETURN
2960		' Set font defaults subroutine
2970 PRINT CLS$
2980 PRINT:PRINT
2990 PRINT TAB(20)"Enter Title"
3000 PRINT:PRINT
3010 PRINT"You may enter a title or copyright notice for the font."
3020 PRINT"It must not exceed 70 characters.  Enter <RETURN> to"
3030 PRINT"keep the existing title.  Example:"
3040 PRINT
3050 PRINT"Heron version 1.0 (C) 1985 Merlin R. Null"
3060 PRINT STRING$(3,10)
3070 LINE INPUT"Title? ";TEMP$
3080 IF TEMP$="" AND TITLE$="" THEN 260
3090 IF LEN(TEMP$)>70 THEN PRINT BL$;:GOTO 2970
3100 IF TEMP$<>"" THEN TITLE$=TEMP$
3110 PRINT CLS$
3120 PRINT:PRINT
3130 PRINT TAB(20)"Enter Comments or Subtitle"
3140 PRINT:PRINT
3150 PRINT"One additional line of comments or a font subtitle may be"
3160 PRINT"entered.  Enter <RETURN> to retain existing comment line"
3170 PRINT"or, if none is wanted, to leave it blank."
3180 PRINT STRING$(3,10)
3190 LINE INPUT"Comment line text? ";TEMP$
3200 IF LEN(TEMP$)>70 THEN PRINT BL$;:GOTO 3110
3210 IF TEMP$<>"" THEN COMMENT$=TEMP$
3220 PRINT CLS$
3230 PRINT:PRINT
3240 PRINT TAB(20)"Set Default Print Character"
3250 PRINT:PRINT
3260 PRINT"The default character used to print banners may be set to any"
3270 PRINT"printable character including those with the 8th bit set."
3280 PRINT"Just enter it with a single keystroke or the decimal value."
3290 PRINT
3300 PRINT"Example:  The Gemini-10X has a 6 by 6 graphic block with an"
3310 PRINT"ASCII decimal value of 239.  Enter <RETURN> for default of '@'."
3320 PRINT:PRINT:PRINT
3330 INPUT"Character or decimal value";PRNCHAR$
3340 IF LEN(PRNCHAR$)<2 THEN 3400
3350 FOR I=1 TO LEN(PRNCHAR$)
3360   IF ASC(MID$(PRNCHAR$,I,1))<48 OR ASC(MID$(PRNCHAR$,I,1))>57 THEN

       PRINT BL$;:GOTO 2970
3370 NEXT I
3380 IF VAL(PRNCHAR$)>255 THEN PRINT BL$;:GOTO 2970
3390 PRNCHAR$=CHR$(VAL(PRNCHAR$))
3400 IF PRNCHAR$="" THEN PRNCHAR$="@"
3410 PRINT CLS$
3420 PRINT:PRINT
3430 PRINT TAB(23)"Set Margin"
3440 PRINT:PRINT:PRINT
3450 PRINT"The margin is the number of columns below the descenders,"
3460 PRINT"if the font being used has descenders.  Enter <RETURN>, if"
3470 PRINT"you want to start printing at column 1 or the column number"
3480 PRINT"to start printing."
3490 PRINT STRING$(3,10)
3500 INPUT"Column to start printing";MARGIN$
3510 IF MARGIN$="" THEN MARGIN$="1"
3520 FOR I=1 TO LEN(MARGIN$)
3530   IF ASC(MID$(MARGIN$,I,1))<48 OR ASC(MID$(MARGIN$,I,1))>57 THEN

       PRINT BL$;:GOTO 3410
3540 NEXT I
3550 IF VAL(MARGIN$)>200 THEN PRINT BL$;:GOTO 3410
3560 PRINT CLS$
3570 PRINT:PRINT
3580 PRINT TAB(20)"Set Rows Between Characters"
3590 PRINT:PRINT:PRINT
3600 PRINT"The number of rows between large characters in the font may be set"
3610 PRINT"to any value between 0 and 99.  A <RETURN> accepts the default"
3620 PRINT"value of 3.  Use 0 only if each large character file has blank"
3630 PRINT"lines included for spacing."
3640 PRINT STRING$(3,10)
3650 INPUT"Row(s) between characters";SPACING$
3660 IF SPACING$="" THEN SPACING$="3"
3670 IF LEN(SPACING$)>2 THEN PRINT BL$;:GOTO 3560
3680 FOR I=1 TO LEN(SPACING$)
3690   IF ASC(MID$(SPACING$,I,1))<48 OR ASC(MID$(SPACING$,I,1))>57 THEN

       PRINT BL$;:GOTO 3560
3700 NEXT I
3710 RETURN
3720		' Error handling
3730 IF ERR=53 AND ERL=2160 THEN NOTUSED=NOTUSED+1 ELSE 3850
3740   IF NOTUSED=95 THEN PRINT BL$ ELSE 3840
3750     PRINT:PRINT
3760     PRINT"No files found for ";FONT$;"!";BL$
3770     PRINT
3780     PRINT"Filenames to be included should have the format:"
3790     PRINT"Fontname + decimal number of the character to include."
3800     PRINT"Example:  HERON.065 = the letter 'A' for the font"
3810     PRINT"Heron.  This is followed by HERON.066, HERON.067 etc."
3820     GOSUB 2070		' Hold before return
3830     RESUME 260		' Return to main menu
3840   RESUME 2390		' Encode character subroutine
3850 IF ERR=53 AND ERL=600 THEN CLOSE ELSE 3910
3860   PRINT
3870   PRINT BL$;"Encoded font ";FONT$;" not found."
3880   FONT$="<none>"
3890   GOSUB 2070		' Hold before return
3900   RESUME 260		' Return to main menu
3910 IF ERR=53 AND ERL=1730 THEN CLOSE #1 ELSE 3930
3920   RESUME 1760
3930 IF ERR=53 AND ERL=1760 THEN CLOSE #1 ELSE 3950
3940   RESUME 1800
3950 IF ERR=53 AND ERL=120 THEN CLOSE #1 ELSE 4190
3960   PRINT STRING$(18,10)
3970   PRINT BL$;"CLS.DAT, the clear screen data file, not found."
3980   PRINT"Please enter your clear screen sequence"
3990   PRINT"one byte at a time in Decimal numbers.  End your"
4000   PRINT"entries with a <RETURN> to generate CLS.DAT"
4010   PRINT
4020   FOR I=1 TO 9
4030     PRINT"Clear Screen character";I;
4040     LINE INPUT C$
4050     IF C$="" AND I>1 THEN 4140
4060     IF C$="" THEN 4030
4070     IF LEN(C$)>3 THEN 4030
4080     FOR J=1 TO LEN(C$)
4090       IF ASC(MID$(C$,J,1))<48 OR ASC(MID$(C$,J,1))>57 THEN PRINT BL$;

           "Whole decimal numbers only.":GOTO 4030
4100     NEXT J
4110     IF I>1 THEN CLR$=CLR$+CHR$(13)+CHR$(10)
4120     CLR$=CLR$+C$
4130   NEXT I
4140   PRINT"Writing CLS.DAT";
4150   OPEN "O",#1,"CLS.DAT"
4160   PRINT #1,CLR$
4170   CLOSE #1
4180   RESUME 120
4190 IF ERR=64 THEN PRINT BL$ ELSE 4240
4200   FONT$="<none>"
4210   PRINT"Bad font name - try again."
4220   GOSUB 2070		' Hold before return
4230   RESUME 260		' Return to main menu
4240 IF ERR=201 THEN PRINT BL$ ELSE 4290
4250   PRINT"A font must be loaded or a new one opened to add a character,"
4260   PRINT"unload a character, unload a font or save a font."
4270   GOSUB 2070		' Hold before return
4280   RESUME 260		' Return to main menu
4290 ON ERROR GOTO 0		' Quit, unexpected error