home *** CD-ROM | disk | FTP | other *** search
/ Compute! Gazette 1986 June / 1986-06.d64 / fontmaker (.txt) < prev    next >
Encoding:
Commodore BASIC  |  1986-01-01  |  4.4 KB  |  163 lines
  1. 100 if xx=1 then 630
  2. 110 poke 56,123:clr:xx=1:ft=1
  3. 120 dim t(29,2),r(7,7):open 15,8,15
  4. 130 for x=0 to 29:t(x,0)=33+x:next
  5. 140 for x=0 to 25:t(x,1)=65+x:next
  6. 150 t(26,1)=31:t(27,1)=32:t(28,1)=0:t(29,1)=122
  7. 160 for x=0 to 29:t(x,2)=x+1:next
  8. 170 hh$=""
  9. 180 gg$="                                       "
  10. 190 poke 53280,6:print chr$(8)chr$(14)"[147][154]       [198]ont[205]aker for [198]ont[208]rinter"
  11. 200 gosub 1710:print"     12345678":print"    [176][192][192][192][192][192][192][192][192][174]      f1 pixel on"
  12. 210 print"   1[221]        [221]      f2 pixel off"
  13. 220 print"   2[221]        [221]      f3 add column"
  14. 230 print"   3[221]        [221]      f4 delete column"
  15. 240 print"   4[221]        [221]"
  16. 250 print"   5[221]        [221]      f5 keyboard choice"
  17. 260 print"   6[221]        [221]      f6 new font number"
  18. 270 print"   7[221]        [221]      f7 load a font set"
  19. 280 print"    [173][192][192][192][192][192][192][192][192][189]      f8 save a font set"
  20. 290 print"    abcdefghijklmnopqrstuvwxyz[\]^"
  21. 300 print"    [193][194][195][196][197][198][199][200][201][202][203][204][205][206][207][208][209][210][211][212][213][214][215][216][217][218]?@[164][186]"
  22. 310 print"    !"+chr$(34)+"#$%&'()*+,-./0123456789:;<=>"
  23. 320 x1=4:y1=17
  24. 330 poke 55296+40*y1+x1,0:gosub 1680
  25. 340 get a$:if a$="" then 340
  26. 350 poke 55296+40*y1+x1,14
  27. 360 if a$<>"" then 390
  28. 370 if x1>32 then x1=3
  29. 380 x1=x1+1:goto 330
  30. 390 if a$<>"[157]" then 420
  31. 400 if x1<5 then x1=34
  32. 410 x1=x1-1:goto 330
  33. 420 if a$<>"" then 450
  34. 430 if y1>18 then y1=16
  35. 440 y1=y1+1:goto 330
  36. 450 if a$<>"[145]" then480
  37. 460 if y1<18 then y1=20
  38. 470 y1=y1-1:goto 330
  39. 480 if a$<>"[139]" then 520
  40. 490 gosub 1680:print"[211]witch to which font?"
  41. 500 get b$:if b$<"1" or b$>"9" then 500
  42. 510 ft=asc(b$)-48:gosub 1710:goto 330
  43. 520 if a$<>"[136]" then 570
  44. 530 gosub 1680:print"[204]oad file[144]";
  45. 540 s$="":input s$:s$=left$(s$,16):if s$="" then 330
  46. 550 open 1,8,8,s$+",p,r":input#15,a,e$,b$,b$:close 1:if a then 640
  47. 560 load s$,8,1
  48. 570 if a$<>"[140]" then 670
  49. 580 gosub 1680:print"[211]ave as[144]";
  50. 590 poke 2,peek(45):poke 3,peek(46):poke 43,0:poke 44,123:poke 45,0:poke 46,159
  51. 600 s$="":input s$:s$=left$(s$,16):if s$="" then 620
  52. 610 save s$,8
  53. 620 poke 43,1:poke 44,8:poke 45,peek(2):poke 46,peek(3)
  54. 630 input#15,a,e$,b$,b$:if a=0 then 330
  55. 640 gosub 1690:print"[196]isk [197]rror:"a;e$
  56. 650 get a$:if a$="" then 650
  57. 660 gosub 1690:goto 330
  58. 670 if a$<>"[135]" then 780
  59. 680 open 3,3:cmd 3:gosub 1690
  60. 690 print"choice: [144]";:input a$
  61. 700 print#3:close 3
  62. 710 if len(a$)=1 then a=asc(a$):goto740
  63. 720 if left$(a$,1)<>"/" then a=0:goto 740
  64. 730 a=val(right$(a$,len(a$)-1))
  65. 740 x2=5:y2=7:gosub 1600:if sc=1 then 1420
  66. 750 poke 55296+40*y1+x1,0
  67. 760 get a$:if a$="" then 760
  68. 770 gosub 1690:goto 350
  69. 780 if a$=chr$(13) then poke 55296+40*y1+x1,1:goto 820
  70. 790 a=asc(a$+chr$(0)):gosub 1600:if sc=0 then 750
  71. 800 gosub 1690:print"choice:[144] "a$
  72. 810 x2=5:y2=7:goto 1420
  73. 820 x2=5:y2=7:goto 1410
  74. 830 print left$(hh$,y2+1)tab(x2)"[154]";
  75. 840 poke 55296+40*y2+x2,0
  76. 850 get a$:if a$="" then 850
  77. 860 poke 55296+40*y2+x2,14
  78. 870 if a$<>"" then 910
  79. 880 if wd=0 then 850
  80. 890 if x2>3+wd then x2=5:goto 830
  81. 900 x2=x2+1:print"";:goto 840
  82. 910 if a$<>"[157]" then 940
  83. 920 if x2<6thenx2=4+wd:goto 830
  84. 930 x2=x2-1:print"[157]";:goto 840
  85. 940 if a$<>"" then 970
  86. 950 if y2>12 then y2=6:print"[145][145][145][145][145][145][145]";
  87. 960 y2=y2+1:print"";:goto 840
  88. 970 if a$<>"[145]" then1000
  89. 980 if y2<8 then y2=14:print"";
  90. 990 y2=y2-1:print"[145]";:goto 840
  91. 1000 ifa$=chr$(13) then 1570
  92. 1010 if a$<>chr$(141) then 1040
  93. 1020 gosub 1690:print""left$(hh$,8)tab(5);
  94. 1030 for k=0 to 7:print" [157] [157] [157] [157] [157] [157] [145][145][145][145][145][145][145]";:next:goto 330
  95. 1040 if a$<>"[147]" then 1080
  96. 1050 print left$(hh$,8);
  97. 1060 for i=0 to 6:print tab(5)""left$(gg$,wd)
  98. 1070 for r=0 to 7:r(r,i)=0:next:next:goto 830
  99. 1080 if a$<>"" then 1110
  100. 1090 if wd then x2=5
  101. 1100 y2=7:goto 850
  102. 1110 if a$<>"[137]" and a$<>chr$(32) then 1140
  103. 1120 if wd=0 then 850
  104. 1130 print" [157]";:r(x2-5,y2-7)=0:goto 890
  105. 1140 if a$<>"[134]" then 1190
  106. 1150 if wd<8 then wd=wd+1:r(wd-1,7)=128
  107. 1160 for k=7 to 13:poke 55300+40*k+wd,14:next
  108. 1170 if wd=1 then 890
  109. 1180 goto 830
  110. 1190 if a$<>"[138]" then 1240
  111. 1200 if wd=0 then 830
  112. 1210 for k=7 to 13:poke55300+40*k+wd,6:next
  113. 1220 r(wd-1,7)=0:wd=wd-1:if x2>wd+4 then x2=wd+4
  114. 1230 goto 830
  115. 1240 if a$<>"[139]" then 1280
  116. 1250 gosub 1690:print"[211]witch to which font?"
  117. 1260 get b$:if b$<"1" or b$>"9" then 1260
  118. 1270 ft=asc(b$)-48:gosub 1710:gosub 1690:goto 830
  119. 1280 if a$<>"[135]" then 1380
  120. 1290 open 3,3:cmd 3:gosub 1690
  121. 1300 print"choice: [144]";:input a$
  122. 1310 print#3:close 3
  123. 1320 if len(a$)=1 then a=asc(a$):goto 1340
  124. 1330 a=val(right$(a$,len(a$)-1))
  125. 1340 gosub 1600:poke 55296+40*y2+x2,0
  126. 1350 if sc=1 then poke 55296+40*y1+x1,14:goto 830
  127. 1360 get a$:if a$="" then 1360
  128. 1370 gosub 1690:print left$(hh$,y2+1)tab(x2)"";:goto 870
  129. 1380 if a$="[136]" or a$="[140]" then 830
  130. 1390 if wd=0 then 850
  131. 1400 print"*[157]";:r(x2-5,y2-7)=2^(y2-7):goto 890
  132. 1410 tt=8*t(x1-4,y1-17)+30464
  133. 1420 ss=tt+ft*1024
  134. 1430 if a$=chr$(13) then gosub 1690
  135. 1440 print"[154]"tab(5);:r=0
  136. 1450 rr=peek(ss+r):if rr<128 then 1520
  137. 1460 for i=0 to 6:r(r,i)=rr and 2^i
  138. 1470 if r(r,i) then print"*[157]";:goto 1490
  139. 1480 print" [157]";
  140. 1490 next:r(r,7)=128:print"[145][145][145][145][145][145][145]";
  141. 1500 r=r+1:if r<8 then 1450
  142. 1510 wd=r:goto 830
  143. 1520 if r=0 then x2=4
  144. 1530 for rr=r to 7:for i=0 to 6
  145. 1540 r(rr,i)=0:print" [157]";:next
  146. 1550 r(r,7)=0:print"[145][145][145][145][145][145][145]";
  147. 1560 next:wd=r:goto 830
  148. 1570 gosub 1690:ss=tt+ft*1024:print""tab(5);
  149. 1580 for r=0 to 7:k=0:for i=0 to 7:k=k+r(r,i):next
  150. 1590 poke ss+r,k:print" [157] [157] [157] [157] [157] [157] [145][145][145][145][145][145][145]";:next:goto 330
  151. 1600 sc=1:if a>255 then 1670
  152. 1610 if a=255 then tt=8*94+30464:return
  153. 1620 if a>127 then 1650
  154. 1630 if a<32 then 1670
  155. 1640 tt=8*(a-32)+30464:return
  156. 1650 if a<160 then 1670
  157. 1660 tt=8*(a and 127 or64)+30464:return
  158. 1670 gosub 1690:print"[144]-invalid character":sc=0:return
  159. 1680 print hh$gg$:goto 1700
  160. 1690 print "[146]"left$(hh$,16)gg$
  161. 1700 print"[145]";:return
  162. 1710 print""tab(12)"[154][195]urrent font:"ft:return
  163.