home *** CD-ROM | disk | FTP | other *** search
/ Run Magazine ReRun 1986 July & August / rerun-1986-07-08.d64 / makechars (.txt) < prev    next >
Commodore BASIC  |  2022-09-20  |  5KB  |  218 lines
  1. 100 d$=""
  2. 110 goto1610:rem go copy chars***********
  3. 120 dima(7):a(7)=128:a(6)=64:a(5)=32:a(4)=16:a(3)=8:a(2)=4:a(1)=2:a(0)=1:p=42
  4. 130 print"[147]":rem get character #*******
  5. 140 printd$spc(14)"prompt mode":print""rl"-"rh;"'q' to quit, or 'h' for help"
  6. 150 input"char #";c$
  7. 160 ifleft$(c$,1)="q"thengosub1750:goto140
  8. 170 ifleft$(c$,1)="h"thengosub1940:goto140
  9. 180 c=val(c$)
  10. 190 ifc<rlorc>rhthen140
  11. 200 ad=12288+8*c
  12. 210 printd$;spc(14)"  edit mode[146]"
  13. 220 fori=0to9:poke1024+4*40+16-i,160:next
  14. 230 fori=0to9:poke1024+13*40+16-i,160:next
  15. 240 fori=0to9:poke1024+(4+i)*40+16,160:next
  16. 250 fori=0to9:poke1024+(4+i)*40+7,160:next
  17. 260 rem decode char to use in matrix****
  18. 270 fori=0to7
  19. 280 x=peek(ad+i)
  20. 290 b(0)=((xand1)=0)+1
  21. 300 b(1)=((xand2)=0)+1
  22. 310 b(2)=((xand4)=0)+1
  23. 320 b(3)=((xand8)=0)+1
  24. 330 b(4)=((xand16)=0)+1
  25. 340 b(5)=((xand32)=0)+1
  26. 350 b(6)=((xand64)=0)+1
  27. 360 b(7)=((xand128)=0)+1
  28. 370 for j=7to0step-1
  29. 380 v=32*(1-b(j))+42*b(j)
  30. 390 poke1024+40*(i+5)+15-j,v
  31. 400 poke55296+40*(i+5)+15-j,14
  32. 410 next
  33. 420 next
  34. 430 printchr$(142+128*(c>255))"":poke1232+40*3+20,c+256*(c>255)
  35. 440 poke55296+8*40+28,14
  36. 450 qn=0:qo=0:pf=0:rem get command*****
  37. 460 p=peek(1232+qo):poke1232+qo,p
  38. 470 getm$:p=(por128)-(pand128):poke1232+qo,p
  39. 480 p=(por128)-(pand128):poke1232+qo,p:fori=1to50:next:ifm$=""goto470
  40. 490 ifm$="[145]"thenqn=qo-40
  41. 500 ifm$=""thenqn=qo+40
  42. 510 ifm$=""thenqn=qo+1
  43. 520 ifm$="[157]"thenqn=qo-1
  44. 530 ifm$="[134]"thengoto140:rem f3 get to prompt
  45. 540 ifm$="[133]"thengosub740:goto450:rem f1 compile shape
  46. 550 ifm$="[135]"thengosub1070:goto140:rem f5 save a file
  47. 560 ifm$="[139]"thengosub860:goto140:rem load a file
  48. 570 ifm$="[136]"thengosub1270:goto140:rem f7 data statements
  49. 580 ifm$="*"thenp=42:pf=1
  50. 590 ifm$=" "thenp=32:pf=1
  51. 600 ifm$=""then450
  52. 610 ifm$="[147]"thengosub690:goto450
  53. 620 ifpeek(197)=32andpeek(653)=4thengosub1510:goto450
  54. 630 ifm$="n"thenc=c+1:goto190
  55. 640 ifm$="p"thenc=c-1:goto190
  56. 650 ifpeek(1232+qn)=160then460
  57. 660 ifpfthenpoke1232+qn,p:pf=0
  58. 670 qo=qn
  59. 680 goto460
  60. 690 fori=0to7:rem clear char box*******
  61. 700 forj=0to7
  62. 710 poke(1024+40*(i+5)+(15-j)),32
  63. 720 next:next
  64. 730 return
  65. 740 rem compile shape******************
  66. 750 fori=0to7
  67. 760 t=0
  68. 770 forj=0to7
  69. 780 x=peek(1024+40*(i+5)+(15-j))
  70. 790 ifx=32then810
  71. 800 t=t+a(j)
  72. 810 next
  73. 820 pokead+i,t
  74. 830 next
  75. 840 return
  76. 850 rem load file***********************
  77. 860 print"[147]load file from t[146]ape or d[146]isk?";
  78. 870 getfd$
  79. 880 iffd$<>"d"andfd$<>"t"then870
  80. 890 iffd$="d"thenfd=8:fw=3:fr$=",s,r":fw$=",s,w":fr=fw
  81. 900 iffd$="t"thenfd=1:fw=1:fr$="":fw$="":fr=0
  82. 910 print:input"name of file to load";nf$:goto930
  83. 920 goto1050
  84. 930 ifnf$=""then910
  85. 940 ifnf$="x"thengoto1050
  86. 950 open1,fd,fr,nf$+fr$
  87. 960 input#1,rl:input#1,rh
  88. 970 ifstthengosub2170:close1:goto910
  89. 980 forc=rltorh
  90. 990 ad=12288+8*c
  91. 1000 fori=adtoad+7
  92. 1010 input#1,xx
  93. 1020 pokei,xx
  94. 1030 next
  95. 1040 next:close1
  96. 1050 print"[147]":poke204,1:return
  97. 1060 rem save a file********************
  98. 1070 print"[147]save file to t[146]ape or d[146]isk?";
  99. 1080 getfd$
  100. 1090 iffd$<>"d"andfd$<>"t"then1080
  101. 1100 iffd$="d"thenfd=8:fw=3:fr$=",s,r":fw$=",s,w":fr=fw
  102. 1110 iffd$="t"thenfd=1:fw=1:fr$="":fw$="":fr=0
  103. 1120 print:input"filename";nf$
  104. 1130 ifnf$=""then1120
  105. 1140 ifnf$="x"thenprint"[147]":return
  106. 1150 open1,fd,fw,nf$+fw$
  107. 1160 print#1,rl:print#1,rh
  108. 1170 ifstthengosub2170:close1:goto1120
  109. 1180 forc=rltorh
  110. 1190 ad=12288+8*c
  111. 1200 fori=adtoad+7
  112. 1210 xx=peek(i)
  113. 1220 print#1,xx
  114. 1230 next
  115. 1240 next
  116. 1250 close1:print"[147]":return
  117. 1260 rem print out data****************
  118. 1270 print"[147]output to s[146]creen or p[146]rinter?";
  119. 1280 getdv$
  120. 1290 if dv$<>"p"anddv$<>"s"then1280
  121. 1300 ifdv$="s"thendv=3
  122. 1310 ifdv$="p"thendv=4
  123. 1320 co=c:print"[147]press any key to      stop the listing[146]":open1,dv:cmd1
  124. 1330 fori=1to1000:next
  125. 1340 forc=rltorh
  126. 1350 print#1,"data";c;
  127. 1360 ad=12288+8*c
  128. 1370 fori=adtoad+7
  129. 1380 xx=peek(i)
  130. 1390 print#1,xx"[157],";
  131. 1400 next
  132. 1410 print#1,"[157] "
  133. 1420 getq$:ifq$<>""then1470
  134. 1430 next
  135. 1440 print"press 'x' to get back to prompt[146]"
  136. 1450 getz$:ifz$<>""thenclose1:print"[147]":return
  137. 1460 goto1450
  138. 1470 print"press 'c' to continue -or-":print"press 'x' to get back to prompt"
  139. 1480 getq$:ifq$="c"then1430
  140. 1490 ifq$="x"thenclose1:c=co:print"[147]":return
  141. 1500 goto1480
  142. 1510 print"":rem rvs character********
  143. 1520 fori=0to7
  144. 1530 t=0
  145. 1540 forj=0to7
  146. 1550 x=peek(1024+40*(i+5)+(15-j))
  147. 1560 ifx=32thenpoke1024+40*(i+5)+(15-j),42:goto1580
  148. 1570 poke1024+40*(i+5)+(15-j),32
  149. 1580 next
  150. 1590 next
  151. 1600 return
  152. 1610 rem copy chars*********************
  153. 1620 ml=12*4096:ck=0:restore:fori=mltoml+46:reada:ck=ck+a:pokei,a:next
  154. 1630 ifck<>7117thenprint"checksum error[146]":stop
  155. 1640 print"[147]-in the process of copying character set":print"please wait."
  156. 1650 sys(ml)
  157. 1660 forxx=1to1000:next
  158. 1670 gosub1750:goto120
  159. 1680 data 120,169,51,133,1
  160. 1690 data 169,0,133,251,169,208,133,252
  161. 1700 data 169,0,133,253,169,48,133,254
  162. 1710 data 162,16,160,0,177,251,145,253
  163. 1720 data 200,192,0,208,247,230,252,230
  164. 1730 data 254,202,208,240
  165. 1740 data 169,55,133,1,88,96
  166. 1750 rem pick character set************
  167. 1760 poke204,0:poke53272,21:print"[147]   1) upper case"
  168. 1770 print"   2) lower case"
  169. 1780 print"   3) graphics chars"
  170. 1790 print"   4) rev upper case"
  171. 1800 print"   5) rev graphics chars"
  172. 1810 print"   6) rev lower case"
  173. 1820 print"enter the number of your choice":print"('x' to exit)?";
  174. 1830 getr$:ifr$=""then1830
  175. 1840 ifr$="x"thenprint"[147]bye now!!!":end
  176. 1850 r=val(r$)
  177. 1860 ifr<1orr>6thengoto1830
  178. 1870 ifr=1thenrl=0:rh=63:goto1930
  179. 1880 ifr=2thenrl=256:rh=319:goto1930
  180. 1890 ifr=3thenrl=64:rh=127:goto1930
  181. 1900 ifr=4thenrl=128:rh=191:goto1930
  182. 1910 ifr=5thenrl=198:rh=255:goto1930
  183. 1920 ifr=6thenrl=385:rh=488:goto1930
  184. 1930 poke204,1:poke53272,29:print"[147]":return
  185. 1940 rem help**************************
  186. 1950 poke53272,21
  187. 1960 print"[147]the following is a list of commands thatcan be called while";
  188. 1970 print" editing a character:"
  189. 1980 print"key     ","function"
  190. 1990 print"[183][183][183]     ","[183][183][183][183][183][183][183][183]"
  191. 2000 print"f1[146]","compile shape"
  192. 2010 print"f3[146]","return to prompt"
  193. 2020 print"f5[146]","save char file"
  194. 2030 print"f6[146]","load char file"
  195. 2040 print"f7[146]","data for char file"
  196. 2050 print" *[146]","put star at current location"
  197. 2060 print"' '","put space at current location"
  198. 2070 print"clr[146]","clear char box"
  199. 2080 print"home[146]","place cursor in upper left              hand corner"
  200. 2090 print"ctrl 9[146]","reverses current char"
  201. 2100 print" n[146]","goes to next char"
  202. 2110 print" p[146]","goes to previous char"
  203. 2120 print">>>>cursor keys move cursor<<<<[146]"
  204. 2130 print"press 'x' to get back to prompt"
  205. 2140 getq$
  206. 2150 ifq$="x"thenprint"[147]":poke54272,29:return
  207. 2160 goto2140
  208. 2170 rem error checking***************
  209. 2180 iffd=8thengoto2220
  210. 2190 print"tape error[146]"
  211. 2200 fori=1to1000:next
  212. 2210 return
  213. 2220 print"disk error[146]"
  214. 2230 open15,8,15:input#15,a1$,b1$,c1$,d1$:printa1$;b1$;c1$;d1$:close15
  215. 2240 open15,8,15,"i0":close15
  216. 2250 fori=1to1000:next
  217. 2260 return
  218.