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 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 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 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 ? ";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" 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" Enter banner text." 1410 PRINT STRING$(4,10) 1420 PRINT"Option or ? "; 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 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