10 ' FONTSY.BAS Version 1.0  (C) Copyright 1985 by Merlin R. Null
20 ' Banner printing program.  Requires external fonts encoded with
30 ' FONTCODE.  This program may not be sold separately or as part of any
40 ' collection of programs or used as an inducement to buy any other
50 ' product or program without the written permission of the author:
60 ' Merlin R. Null, P.O. Box 9422, N. Hollywood, CA 91609, (818) 762-1429
70 DEFINT A-Z
80 DIM FONTCHAR$(95)
90 ON ERROR GOTO 1920
100 BL$=CHR$(7)
110 OPEN "I",#1,"CLS.DAT"
120 WHILE NOT EOF(1)
130   LINE INPUT #1, A$
140   CLS$=CLS$+CHR$(VAL(A$))
150 WEND
160 CLOSE #1
170	' Read CP/M Command Tail for Font.  Compiled Version Only.
180 CTLEN=PEEK(128)
190 IF CTLEN<2 THEN 240
200 FOR I=2 TO CTLEN
210   FONT$=FONT$+CHR$(PEEK(128+I))
220 NEXT I
230 GOTO 520
240 OPT=0
250		' Enter Font Screen
260 PRINT CLS$
270 PRINT"FONTSY      Version 1.0     9/15/85     (C) 1985  Merlin R. Null"
280 PRINT STRING$(64,45)
290 PRINT TAB(8)"Prints banners using fonts created by FONTCODE"
300 PRINT STRING$(3,10)
310 PRINT"Enter the name of the font you wish to use."
320 PRINT STRING$(3,10)
330 PRINT"Examples:	KIWI	Use the font named KIWI.FNT"
340 PRINT"		A:	List of fonts on drive A:"
350 PRINT STRING$(4,10)
360 PRINT		' Here after directory call or error
370 LINE INPUT"Font name or Drive ? ";FONT$
380 IF FONT$="" THEN 260
390 FONTLEN$=""
400 FOR I=1 TO LEN(FONT$)		' Case and ";" conversion
410   BYTE=ASC(MID$(FONT$,I,1))
420   IF BYTE>96 AND BYTE<123 THEN MID$(FONT$,I,1)=CHR$(BYTE-32)
430   IF BYTE=59 THEN MID$(FONT$,I,1)=":"
440 NEXT I
450 IF LEN(FONT$)=2 AND MID$(FONT$,2,1)=":" THEN PRINT CLS$ ELSE 520
460   DIR$=FONT$+"*.FNT"
470   PRINT"Available fonts on drive ";FONT$;" are:"
480   PRINT
490   FILES DIR$
500   PRINT
510   GOTO 360
520 IF INSTR(FONT$,".")=0 THEN FONT$=FONT$+".FNT"
530 GOSUB 1730		'Load font
540		'Enter Banner Text Screen
550 PRINT CLS$
560 PRINT"FONTSY      Version 1.0     9/15/85     (C) 1985  Merlin R. Null"
570 PRINT STRING$(64,45)
580 PRINT:PRINT
590 PRINT TITLE$
600 PRINT COMMENT$
610 PRINT:PRINT
620 PRINT"Characters available in ";FONT$;" are:"
630 PRINT
640 FOR I=1 TO 293 STEP 64
650   IF LEN(FONTLEN$)>I THEN PRINT MID$(FONTLEN$,I,63) ELSE PRINT
660 NEXT I
670 PRINT:PRINT
680 PRINT"Enter <RETURN> to change font defaults, ^C to exit."
690 PRINT:PRINT
700 LINE INPUT"Banner text? ";TXT$
710 IF TXT$<>"" THEN 1490
720 OPT=0
730		' Option 2. Set Left Margin
740 IF OPT<>2 THEN 940
750 PRINT CLS$
760 PRINT TAB(15)"Set Left Margin"
770 PRINT STRING$(56,45)
780 PRINT STRING$(3,10)
790 PRINT"Printing now starts at column";MARGIN
800 PRINT STRING$(4,10)
810 PRINT"Reset the left margin to center a banner or to allow two"
820 PRINT"lines of a smaller font.  Allow room for descenders."
830 PRINT"Enter a bare <RETURN> for the default of column 1."
840 PRINT STRING$(4,10)
850 INPUT"Column to start printing";MARGIN$
860 FOR I=1 TO LEN(MARGIN$)
870   BYTE=ASC(MID$(MARGIN$,I,1))
880   IF BYTE<48 OR BYTE>57 THEN PRINT BL$;:GOTO 750
890 NEXT I
900 MARGIN=VAL(MARGIN$)
910 IF MARGIN>255 THEN PRINT BL$;:GOTO 750
920 IF MARGIN<1 THEN MARGIN=1
930		' Option 3. Set Print Character
940 IF OPT<>3 THEN 1150
950 PRINT CLS$
960 PRINT TAB(17)"Set Print Character"
970 PRINT STRING$(63,45)
980 PRINT STRING$(4,10)
990 PRINT"The single character used by  FONTSY to print all large letters"
1000 PRINT"can be set to any printable character or to a printer character"
1010 PRINT"in the  upper 128 characters.   Just use a single  keystroke to"
1020 PRINT"enter it or enter a minimum of two decimal numbers to  use  the"
1030 PRINT"ASCII value.   Example:  The  Gemini-10X  has a  6 by 6 graphic"
1040 PRINT"square with an ASCII decimal value of 239.  Enter <RETURN> only"
1050 PRINT"for each large character to be printed with its own character."
1060 PRINT STRING$(5,10)
1070 LINE INPUT"Character, decimal value or <RETURN>? ";PRNCHAR$
1080 IF LEN(PRNCHAR$)<2 THEN 1150
1090 FOR I=1 TO LEN(PRNCHAR$)
1100   IF ASC(MID$(PRNCHAR$,I,1))<48 OR ASC(MID$(PRNCHAR$,I,1))>57 THEN 950
1110 NEXT I
1120 IF VAL(PRNCHAR$)>255 THEN 950
1130 PRNCHAR$=CHR$(VAL(PRNCHAR$))
1140		' Option 4. Set Rows Between Characters
1150 IF OPT<>4 THEN 1270
1160 PRINT CLS$
1170 PRINT TAB(15)"Set Rows Between Characters"
1180 PRINT STRING$(61,45)
1190 PRINT STRING$(6,10)
1200 PRINT"The number of rows between large characters in the banner may"
1210 PRINT"be reset from the value contained in the font.  Enter a bare"
1220 PRINT"<RETURN> for the default value of 3."
1230 PRINT STRING$(7,10)
1240 INPUT"Number of rows";SPACING
1250 IF SPACING<1 THEN SPACING=3
1260		' Option Menu Screen
1270 PRINT CLS$
1280 IF PRNCHAR$=""THEN PC$=" variable"ELSE PC$=STR$(ASC(PRNCHAR$))+" decimal"
1290 PRINT TAB(15)"Set Font Defaults"
1300 PRINT STRING$(48,45)
1310 PRINT STRING$(3,10)
1320 PRINT"1. Change fonts			 is: ";FONT$
1330 PRINT
1340 PRINT"2. Set column to start printing	 is: Column";MARGIN
1350 PRINT
1360 PRINT"3. Set print character		 is:";PC$
1370 PRINT
1380 PRINT"4. Set banner spacing		 is:";SPACING;"rows"
1390 PRINT
1400 PRINT"<RETURN> Enter banner text."
1410 PRINT STRING$(4,10)
1420 PRINT"Option or <RETURN> ? ";
1430 OPT$=INPUT$(1)
1440 IF OPT$=CHR$(13) THEN 550
1450 IF ASC(OPT$)<49 OR ASC(OPT$)>52 THEN PRINT BL$;:GOTO 1270
1460 OPT=VAL(OPT$)
1470 ON OPT GOTO 260,750,950,1160
1480 GOTO 550
1490 PRINT"Printing ==> ";
1500 FOR I=1 TO LEN(TXT$)
1510   CHAR=ASC(MID$(TXT$,I,1))-31
1520   IF CHAR<1 THEN 1700
1530   PRINT MID$(TXT$,I,1);
1540   IF PRNCHAR$="" THEN PCHAR$=CHR$(31+CHAR) ELSE PCHAR$=PRNCHAR$
1550   ARRLEN=LEN(FONTCHAR$(CHAR))
1560   IF ARRLEN=0 THEN 1700
1570   FOR BYTE=1 TO ARRLEN STEP 2
1580     LINEFLAG=0
1590     IF MID$(FONTCHAR$(CHAR),BYTE,1)=CHR$(255) THEN LPRINT ELSE 1620
1600       BYTE=BYTE-1
1610       GOTO 1680
1620     COLUMN=ASC(MID$(FONTCHAR$(CHAR),BYTE,1))+MARGIN-32
1630     LENGTH=ASC(MID$(FONTCHAR$(CHAR),BYTE+1,1))-32
1640     IF LENGTH>95 THEN LENGTH=LENGTH-128:LINEFLAG=-1
1650     LPRINT TAB(COLUMN) STRING$(LENGTH,PCHAR$);
1660     IF LINEFLAG THEN LPRINT
1670     IF INKEY$=CHR$(3) THEN 550
1680   NEXT BYTE
1690   LPRINT STRING$(SPACING-1,10)
1700 NEXT I
1710 GOTO 550
1720 END
1730 OPEN "I",#1,FONT$
1740 LINE INPUT #1,TITLE$
1750 LINE INPUT #1,COMMENT$
1760 LINE INPUT #1,PRNCHAR$
1770 LINE INPUT #1,MARGIN$
1780 MARGIN=VAL(MARGIN$)
1790 LINE INPUT #1,SPACING$
1800 SPACING=VAL(SPACING$)
1810 FOR J=1 TO 95
1820   LINE INPUT #1,FONTCHAR$(J)
1830   IF FONTCHAR$(J)<>"" THEN 1850
1840   IF J>65 AND J<92 THEN FONTCHAR$(J)=FONTCHAR$(J-32):GOTO 1890
1850   IF FONTCHAR$(J)="" THEN 1890
1860   IF J=1 THEN FONTLEN$="space ":GOTO 1890
1870   IF J=95 THEN FONTLEN$=FONTLEN$+"tilde":GOTO 1890
1880   FONTLEN$=FONTLEN$+CHR$(J+31)+" "
1890 NEXT J
1900 CLOSE #1
1910 RETURN
1920 IF ERR=53 AND ERL=1730 THEN CLOSE #1 ELSE 1960
1930   PRINT CLS$;STRING$(5,10)
1940   PRINT FONT$;" not found - try again.";BL$
1950   RESUME 360
1960 IF ERR=53 AND ERL=490 THEN PRINT ELSE 2000
1970   PRINT"No fonts found on ";FONT$
1980   PRINT
1990   RESUME 360
2000 IF ERR=53 AND ERL=110 THEN CLOSE #1 ELSE 2240
2010   PRINT STRING$(18,10)
2020   PRINT BL$;"CLS.DAT, the clear screen data file, not found."
2030   PRINT"Please enter your clear screen sequence"
2040   PRINT"one byte at a time in Decimal numbers.  End your"
2050   PRINT"entries with a <RETURN> to generate CLS.DAT"
2060   PRINT
2070   FOR I=1 TO 9
2080     PRINT"Clear Screen character";I;
2090     LINE INPUT C$
2100     IF C$="" AND I>1 THEN 2190
2110     IF C$="" THEN 2080
2120     IF LEN(C$)>3 THEN 2080
2130     FOR J=1 TO LEN(C$)
2140       IF ASC(MID$(C$,J,1))<48 OR ASC(MID$(C$,J,1))>57 THEN PRINT BL$;

           "Whole decimal numbers only.":GOTO 2080
2150     NEXT J
2160     IF I>1 THEN CLR$=CLR$+CHR$(13)+CHR$(10)
2170     CLR$=CLR$+C$
2180   NEXT I
2190   PRINT"Writing CLS.DAT";
2200   OPEN "O",#1,"CLS.DAT"
2210   PRINT #1,CLR$
2220   CLOSE #1
2230   RESUME 110
2240 IF ERR=64 THEN CLOSE ELSE 2290
2250   PRINT CLS$;STRING$(5,10)
2260   PRINT BL$;CHR$(34);FONT$;CHR$(34);" is a bad file name or drive - ";
2270   PRINT"try again."
2280   RESUME 360
2290 ON ERROR GOTO 0
S.DAT, the clear screen data file, not found."
2030   PRINT"Please enter your clear screen seque