home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / CPM / PROGRAMS / LIST / FONT-FOG.LBR / FONTSY.BZS / FONTSY.BAS
BASIC Source File  |  2000-06-30  |  8KB  |  232 lines
  1. 10 ' FONTSY.BAS Version 1.0  (C) Copyright 1985 by Merlin R. Null
  2. 20 ' Banner printing program.  Requires external fonts encoded with
  3. 30 ' FONTCODE.  This program may not be sold separately or as part of any
  4. 40 ' collection of programs or used as an inducement to buy any other
  5. 50 ' product or program without the written permission of the author:
  6. 60 ' Merlin R. Null, P.O. Box 9422, N. Hollywood, CA 91609, (818) 762-1429
  7. 70 DEFINT A-Z
  8. 80 DIM FONTCHAR$(95)
  9. 90 ON ERROR GOTO 1920
  10. 100 BL$=CHR$(7)
  11. 110 OPEN "I",#1,"CLS.DAT"
  12. 120 WHILE NOT EOF(1)
  13. 130   LINE INPUT #1, A$
  14. 140   CLS$=CLS$+CHR$(VAL(A$))
  15. 150 WEND
  16. 160 CLOSE #1
  17. 170    ' Read CP/M Command Tail for Font.  Compiled Version Only.
  18. 180 CTLEN=PEEK(128)
  19. 190 IF CTLEN<2 THEN 240
  20. 200 FOR I=2 TO CTLEN
  21. 210   FONT$=FONT$+CHR$(PEEK(128+I))
  22. 220 NEXT I
  23. 230 GOTO 520
  24. 240 OPT=0
  25. 250        ' Enter Font Screen
  26. 260 PRINT CLS$
  27. 270 PRINT"FONTSY      Version 1.0     9/15/85     (C) 1985  Merlin R. Null"
  28. 280 PRINT STRING$(64,45)
  29. 290 PRINT TAB(8)"Prints banners using fonts created by FONTCODE"
  30. 300 PRINT STRING$(3,10)
  31. 310 PRINT"Enter the name of the font you wish to use."
  32. 320 PRINT STRING$(3,10)
  33. 330 PRINT"Examples:    KIWI    Use the font named KIWI.FNT"
  34. 340 PRINT"        A:    List of fonts on drive A:"
  35. 350 PRINT STRING$(4,10)
  36. 360 PRINT        ' Here after directory call or error
  37. 370 LINE INPUT"Font name or Drive ? ";FONT$
  38. 380 IF FONT$="" THEN 260
  39. 390 FONTLEN$=""
  40. 400 FOR I=1 TO LEN(FONT$)        ' Case and ";" conversion
  41. 410   BYTE=ASC(MID$(FONT$,I,1))
  42. 420   IF BYTE>96 AND BYTE<123 THEN MID$(FONT$,I,1)=CHR$(BYTE-32)
  43. 430   IF BYTE=59 THEN MID$(FONT$,I,1)=":"
  44. 440 NEXT I
  45. 450 IF LEN(FONT$)=2 AND MID$(FONT$,2,1)=":" THEN PRINT CLS$ ELSE 520
  46. 460   DIR$=FONT$+"*.FNT"
  47. 470   PRINT"Available fonts on drive ";FONT$;" are:"
  48. 480   PRINT
  49. 490   FILES DIR$
  50. 500   PRINT
  51. 510   GOTO 360
  52. 520 IF INSTR(FONT$,".")=0 THEN FONT$=FONT$+".FNT"
  53. 530 GOSUB 1730        'Load font
  54. 540        'Enter Banner Text Screen
  55. 550 PRINT CLS$
  56. 560 PRINT"FONTSY      Version 1.0     9/15/85     (C) 1985  Merlin R. Null"
  57. 570 PRINT STRING$(64,45)
  58. 580 PRINT:PRINT
  59. 590 PRINT TITLE$
  60. 600 PRINT COMMENT$
  61. 610 PRINT:PRINT
  62. 620 PRINT"Characters available in ";FONT$;" are:"
  63. 630 PRINT
  64. 640 FOR I=1 TO 293 STEP 64
  65. 650   IF LEN(FONTLEN$)>I THEN PRINT MID$(FONTLEN$,I,63) ELSE PRINT
  66. 660 NEXT I
  67. 670 PRINT:PRINT
  68. 680 PRINT"Enter <RETURN> to change font defaults, ^C to exit."
  69. 690 PRINT:PRINT
  70. 700 LINE INPUT"Banner text? ";TXT$
  71. 710 IF TXT$<>"" THEN 1490
  72. 720 OPT=0
  73. 730        ' Option 2. Set Left Margin
  74. 740 IF OPT<>2 THEN 940
  75. 750 PRINT CLS$
  76. 760 PRINT TAB(15)"Set Left Margin"
  77. 770 PRINT STRING$(56,45)
  78. 780 PRINT STRING$(3,10)
  79. 790 PRINT"Printing now starts at column";MARGIN
  80. 800 PRINT STRING$(4,10)
  81. 810 PRINT"Reset the left margin to center a banner or to allow two"
  82. 820 PRINT"lines of a smaller font.  Allow room for descenders."
  83. 830 PRINT"Enter a bare <RETURN> for the default of column 1."
  84. 840 PRINT STRING$(4,10)
  85. 850 INPUT"Column to start printing";MARGIN$
  86. 860 FOR I=1 TO LEN(MARGIN$)
  87. 870   BYTE=ASC(MID$(MARGIN$,I,1))
  88. 880   IF BYTE<48 OR BYTE>57 THEN PRINT BL$;:GOTO 750
  89. 890 NEXT I
  90. 900 MARGIN=VAL(MARGIN$)
  91. 910 IF MARGIN>255 THEN PRINT BL$;:GOTO 750
  92. 920 IF MARGIN<1 THEN MARGIN=1
  93. 930        ' Option 3. Set Print Character
  94. 940 IF OPT<>3 THEN 1150
  95. 950 PRINT CLS$
  96. 960 PRINT TAB(17)"Set Print Character"
  97. 970 PRINT STRING$(63,45)
  98. 980 PRINT STRING$(4,10)
  99. 990 PRINT"The single character used by  FONTSY to print all large letters"
  100. 1000 PRINT"can be set to any printable character or to a printer character"
  101. 1010 PRINT"in the  upper 128 characters.   Just use a single  keystroke to"
  102. 1020 PRINT"enter it or enter a minimum of two decimal numbers to  use  the"
  103. 1030 PRINT"ASCII value.   Example:  The  Gemini-10X  has a  6 by 6 graphic"
  104. 1040 PRINT"square with an ASCII decimal value of 239.  Enter <RETURN> only"
  105. 1050 PRINT"for each large character to be printed with its own character."
  106. 1060 PRINT STRING$(5,10)
  107. 1070 LINE INPUT"Character, decimal value or <RETURN>? ";PRNCHAR$
  108. 1080 IF LEN(PRNCHAR$)<2 THEN 1150
  109. 1090 FOR I=1 TO LEN(PRNCHAR$)
  110. 1100   IF ASC(MID$(PRNCHAR$,I,1))<48 OR ASC(MID$(PRNCHAR$,I,1))>57 THEN 950
  111. 1110 NEXT I
  112. 1120 IF VAL(PRNCHAR$)>255 THEN 950
  113. 1130 PRNCHAR$=CHR$(VAL(PRNCHAR$))
  114. 1140        ' Option 4. Set Rows Between Characters
  115. 1150 IF OPT<>4 THEN 1270
  116. 1160 PRINT CLS$
  117. 1170 PRINT TAB(15)"Set Rows Between Characters"
  118. 1180 PRINT STRING$(61,45)
  119. 1190 PRINT STRING$(6,10)
  120. 1200 PRINT"The number of rows between large characters in the banner may"
  121. 1210 PRINT"be reset from the value contained in the font.  Enter a bare"
  122. 1220 PRINT"<RETURN> for the default value of 3."
  123. 1230 PRINT STRING$(7,10)
  124. 1240 INPUT"Number of rows";SPACING
  125. 1250 IF SPACING<1 THEN SPACING=3
  126. 1260        ' Option Menu Screen
  127. 1270 PRINT CLS$
  128. 1280 IF PRNCHAR$=""THEN PC$=" variable"ELSE PC$=STR$(ASC(PRNCHAR$))+" decimal"
  129. 1290 PRINT TAB(15)"Set Font Defaults"
  130. 1300 PRINT STRING$(48,45)
  131. 1310 PRINT STRING$(3,10)
  132. 1320 PRINT"1. Change fonts             is: ";FONT$
  133. 1330 PRINT
  134. 1340 PRINT"2. Set column to start printing     is: Column";MARGIN
  135. 1350 PRINT
  136. 1360 PRINT"3. Set print character         is:";PC$
  137. 1370 PRINT
  138. 1380 PRINT"4. Set banner spacing         is:";SPACING;"rows"
  139. 1390 PRINT
  140. 1400 PRINT"<RETURN> Enter banner text."
  141. 1410 PRINT STRING$(4,10)
  142. 1420 PRINT"Option or <RETURN> ? ";
  143. 1430 OPT$=INPUT$(1)
  144. 1440 IF OPT$=CHR$(13) THEN 550
  145. 1450 IF ASC(OPT$)<49 OR ASC(OPT$)>52 THEN PRINT BL$;:GOTO 1270
  146. 1460 OPT=VAL(OPT$)
  147. 1470 ON OPT GOTO 260,750,950,1160
  148. 1480 GOTO 550
  149. 1490 PRINT"Printing ==> ";
  150. 1500 FOR I=1 TO LEN(TXT$)
  151. 1510   CHAR=ASC(MID$(TXT$,I,1))-31
  152. 1520   IF CHAR<1 THEN 1700
  153. 1530   PRINT MID$(TXT$,I,1);
  154. 1540   IF PRNCHAR$="" THEN PCHAR$=CHR$(31+CHAR) ELSE PCHAR$=PRNCHAR$
  155. 1550   ARRLEN=LEN(FONTCHAR$(CHAR))
  156. 1560   IF ARRLEN=0 THEN 1700
  157. 1570   FOR BYTE=1 TO ARRLEN STEP 2
  158. 1580     LINEFLAG=0
  159. 1590     IF MID$(FONTCHAR$(CHAR),BYTE,1)=CHR$(255) THEN LPRINT ELSE 1620
  160. 1600       BYTE=BYTE-1
  161. 1610       GOTO 1680
  162. 1620     COLUMN=ASC(MID$(FONTCHAR$(CHAR),BYTE,1))+MARGIN-32
  163. 1630     LENGTH=ASC(MID$(FONTCHAR$(CHAR),BYTE+1,1))-32
  164. 1640     IF LENGTH>95 THEN LENGTH=LENGTH-128:LINEFLAG=-1
  165. 1650     LPRINT TAB(COLUMN) STRING$(LENGTH,PCHAR$);
  166. 1660     IF LINEFLAG THEN LPRINT
  167. 1670     IF INKEY$=CHR$(3) THEN 550
  168. 1680   NEXT BYTE
  169. 1690   LPRINT STRING$(SPACING-1,10)
  170. 1700 NEXT I
  171. 1710 GOTO 550
  172. 1720 END
  173. 1730 OPEN "I",#1,FONT$
  174. 1740 LINE INPUT #1,TITLE$
  175. 1750 LINE INPUT #1,COMMENT$
  176. 1760 LINE INPUT #1,PRNCHAR$
  177. 1770 LINE INPUT #1,MARGIN$
  178. 1780 MARGIN=VAL(MARGIN$)
  179. 1790 LINE INPUT #1,SPACING$
  180. 1800 SPACING=VAL(SPACING$)
  181. 1810 FOR J=1 TO 95
  182. 1820   LINE INPUT #1,FONTCHAR$(J)
  183. 1830   IF FONTCHAR$(J)<>"" THEN 1850
  184. 1840   IF J>65 AND J<92 THEN FONTCHAR$(J)=FONTCHAR$(J-32):GOTO 1890
  185. 1850   IF FONTCHAR$(J)="" THEN 1890
  186. 1860   IF J=1 THEN FONTLEN$="space ":GOTO 1890
  187. 1870   IF J=95 THEN FONTLEN$=FONTLEN$+"tilde":GOTO 1890
  188. 1880   FONTLEN$=FONTLEN$+CHR$(J+31)+" "
  189. 1890 NEXT J
  190. 1900 CLOSE #1
  191. 1910 RETURN
  192. 1920 IF ERR=53 AND ERL=1730 THEN CLOSE #1 ELSE 1960
  193. 1930   PRINT CLS$;STRING$(5,10)
  194. 1940   PRINT FONT$;" not found - try again.";BL$
  195. 1950   RESUME 360
  196. 1960 IF ERR=53 AND ERL=490 THEN PRINT ELSE 2000
  197. 1970   PRINT"No fonts found on ";FONT$
  198. 1980   PRINT
  199. 1990   RESUME 360
  200. 2000 IF ERR=53 AND ERL=110 THEN CLOSE #1 ELSE 2240
  201. 2010   PRINT STRING$(18,10)
  202. 2020   PRINT BL$;"CLS.DAT, the clear screen data file, not found."
  203. 2030   PRINT"Please enter your clear screen sequence"
  204. 2040   PRINT"one byte at a time in Decimal numbers.  End your"
  205. 2050   PRINT"entries with a <RETURN> to generate CLS.DAT"
  206. 2060   PRINT
  207. 2070   FOR I=1 TO 9
  208. 2080     PRINT"Clear Screen character";I;
  209. 2090     LINE INPUT C$
  210. 2100     IF C$="" AND I>1 THEN 2190
  211. 2110     IF C$="" THEN 2080
  212. 2120     IF LEN(C$)>3 THEN 2080
  213. 2130     FOR J=1 TO LEN(C$)
  214. 2140       IF ASC(MID$(C$,J,1))<48 OR ASC(MID$(C$,J,1))>57 THEN PRINT BL$;
  215.            "Whole decimal numbers only.":GOTO 2080
  216. 2150     NEXT J
  217. 2160     IF I>1 THEN CLR$=CLR$+CHR$(13)+CHR$(10)
  218. 2170     CLR$=CLR$+C$
  219. 2180   NEXT I
  220. 2190   PRINT"Writing CLS.DAT";
  221. 2200   OPEN "O",#1,"CLS.DAT"
  222. 2210   PRINT #1,CLR$
  223. 2220   CLOSE #1
  224. 2230   RESUME 110
  225. 2240 IF ERR=64 THEN CLOSE ELSE 2290
  226. 2250   PRINT CLS$;STRING$(5,10)
  227. 2260   PRINT BL$;CHR$(34);FONT$;CHR$(34);" is a bad file name or drive - ";
  228. 2270   PRINT"try again."
  229. 2280   RESUME 360
  230. 2290 ON ERROR GOTO 0
  231. S.DAT, the clear screen data file, not found."
  232. 2030   PRINT"Please enter your clear screen seque