home *** CD-ROM | disk | FTP | other *** search
/ Compute! Gazette 1992 December / 1992-12.d64 / lodraw (.txt) < prev    next >
Encoding:
Commodore BASIC  |  1992-01-01  |  20.0 KB  |  592 lines
  1. 100 ifll=1thenrp=0:gosub1550:poke53281,peek(51177):poke53280,peek(51176):goto2230
  2. 110 ifll=3then2230
  3. 120 rem---------------------------------
  4. 130 rem l o d r a w 1991 by robert quinn
  5. 140 rem---------------------------------
  6. 150 poke55,255:poke56,95:clr:gosub2720:goto190
  7. 160 iff9<0theniff3=0then360
  8. 170 ifzw=0or(f3<0andzw<0)thengosub1200:goto190
  9. 180 dx=0:bb=asc(b$):goto1030
  10. 190 dx=0:iff6=0thenpokepp+vm,qr
  11. 200 js=peek(56320):ifjs<127thenifjs>118thendx=pt(js-119)
  12. 210 iff6=0thenpokepp+vm,qr:pokepp+vn,dq:pokepp+vn,dp
  13. 220 getb$:ifb$>chr$(48)andb$<chr$(57)then160
  14. 230 ifb$=chr$(95)thenf3=notf3:poked6,33:poked6,16:pokevm+961,(f3or61)+1:goto190
  15. 240 ifb$=chr$(187)orb$=chr$(174)orb$=chr$(180)thendx=0:goto360
  16. 250 ifb$=""thenifjs=111thenbb=136:goto510
  17. 260 ifb$=chr$(145)thendx=114
  18. 270 iff9=0andzw=0thenifb$=chr$(46)thendx=114
  19. 280 ifb$=chr$(17)thendx=113:js=127
  20. 290 ifb$=chr$(157)thendx=107
  21. 300 iff9=0andzw=0thenifb$=chr$(44)thendx=107
  22. 310 ifb$=chr$(29)thendx=115
  23. 320 iff3<0thenifdx>0then1610
  24. 330 ifdx>0then1230
  25. 340 iff6=0thenpokepp+vn,dp:pokepp+vn,dq
  26. 350 ifb$=""then200
  27. 360 bb=asc(b$):iff9<0then1380
  28. 370 ifbb<96then620
  29. 380 iff3=0then430
  30. 390 ifbb>132andbb<137thenrp=0:gosub1530:gosub2320:goto200
  31. 400 ifbb=140thenll=2:b$="disk save char ":a$="@":goto2030
  32. 410 ifbb=139thenll=3:b$="disk load char ":a$="@":goto2030
  33. 420 ifbb=196thenll=8:b$="erase file":a$="":goto2030
  34. 430 ifbb=148thenzx=zx-15-16*sgn(zx-15):poke53280,zx
  35. 435 ifbb=131thenpoke788,49:end
  36. 440 ifbb=137thenrp=abs(f4):gosub1550:zy=peek(51177):gosub2950:poke53281,zy
  37. 450 ifbb<>138then470
  38. 460 poke51177,zy:rp=abs(f4):gosub1520:printchr$(147);:gosub1550:gosub2950
  39. 470 ifbb>148thenifbb<156thenkq=bb-140:gosub1210
  40. 480 ifbb=160thenqq=qp
  41. 490 ifbb=129thenkq=8:gosub1210
  42. 500 ifbb=147thenrp=0:gosub1530:printchr$(147);:gosub2950
  43. 510 ifbb=136theniff8=6thenzv=notzv
  44. 520 ifbb=136thenzv=notzv:sys49677,32,24:printgg$(abs(zv)+2);:f8=0
  45. 530 ifbb=140thenll=0:b$="disk save video":a$="_":goto2030
  46. 540 ifbb=139thenll=1:b$="disk load video":a$="_":goto2030
  47. 550 ifbb=135thenzz=notzz:sys49677,23,24:printgg$(abs(zz));
  48. 560 ifbb=141thenf8=6:sys49677,32,24:print"paint ";
  49. 570 ifbb=133thenzw=notzw:sys49677,0,24:printgg$(abs(zw)+4);
  50. 580 ifbb=134thenzr=notzr:sys49677,7,24:printgg$(abs(zr)+6);
  51. 590 ifbb>160thenifbb<192thenqq=bb-64-zr*n9
  52. 600 ifbb>191thenqq=bb-n9-zr*n9
  53. 610 poked6,33:poked6,16:f3=0:goto1190
  54. 620 iff3=0orbb<>20then650
  55. 630 rp=0:poke51177,zy:gosub1530:gosub3200:gosub1570:zy=peek(51177):poke53281,zy
  56. 640 f3=0:gosub2950:goto190
  57. 650 ifbb=20thenzy=zy-15-16*sgn(zy-15):poke53281,zy:gosub2940
  58. 660 ifbb=19thenf4=notf4:gosub2950
  59. 665 ifbb=3thenll=-1:gosub6000
  60. 670 ifbb=13thenpokepp+vn,kp:pokepp+vm,qp:pp=int(pp/p1)*p1:dx=113:goto1510
  61. 680 ifbb<p4thenf3=0:goto1190
  62. 690 iff3=0then1020
  63. 700 ifbb=72thenf6=notf6:iff6<0thenpokepp+vn,kp:pokepp+vm,qp
  64. 710 ifbb=64thengosub5100
  65. 720 ifbb<>61then750
  66. 730 sys49677,0,23:print"screen character code? ";:gosub3560:gosub2940
  67. 740 ifval(b$)<256thenqq=val(b$)
  68. 750 ifbb=77thenmx=3030:gosub1700
  69. 760 ifbb=42thendv=notdv:mx=3020:gosub1700:pokevm+943,abs(dv)+48
  70. 770 ifbb=66thenrp=0:gosub1530:gosub1840:goto1640
  71. 780 ifbb=57then1880
  72. 790 ifbb=67thenll=0:gosub2410
  73. 800 ifbb=47orbb=58orbb=59orbb=63thenf3=0:goto1060
  74. 810 ifbb=90thenll=1:gosub2410
  75. 820 ifbb=83thenll=2:gosub2410
  76. 830 ifbb=70thenll=3:gosub2410
  77. 840 ifbb=88thenll=4:gosub2410
  78. 850 ifbb=68then1930
  79. 860 ifbb=48thenf3=0:goto1140
  80. 870 ifbb=86thenll=5:gosub2410
  81. 880 ifbb=71thenll=6:gosub2410
  82. 890 ifbb=94thengosub1570:qp=peek(pp+vm):kp=peek(pp+vn):gosub2950
  83. 900 ifbb=80thenf5=0:gosub2950
  84. 910 ifbb=81thenf5=1:gosub2950
  85. 920 ifbb=87thenf5=2:gosub2950
  86. 930 ifbb=69thenf5=3:gosub2950
  87. 940 ifbb=82thenf5=4:gosub2950
  88. 950 ifbb=84thenf5=5:gosub2950
  89. 960 ifbb=89thenf5=6:gosub2950
  90. 970 ifbb=85thenf5=7:gosub2950
  91. 980 ifbb=73thenf5=8:gosub2950
  92. 990 ifbb=79thenf5=9:gosub2950
  93. 1000 ifbb=65thenf9=notf9:qr=0:iff9<0thenqr=31
  94. 1010 poked6,33:poked6,16:f3=0:goto1190
  95. 1020 ifzw=0then1050
  96. 1030 ifbb<64then1180
  97. 1040 qq=bb-64-zr*n9:goto1190
  98. 1050 ifbb=45thenqq=93+zz-zr*n9:goto1190
  99. 1060 ifbb=47thendx=113:goto1310
  100. 1070 ifbb=58thendx=107:goto1310
  101. 1080 ifbb=59thendx=115:goto1310
  102. 1090 ifbb=63thendx=114:goto1310
  103. 1100 ifbb=43thenqq=91-zz*11-zr*n9:goto1190
  104. 1110 ifbb=92thenqq=105+zz-zr*n9:goto1190
  105. 1120 ifbb=42thenqq=67-zz*28-zr*n9:goto1190
  106. 1130 ifbb=64thenqq=122+zz*22-zr*n9:goto1190
  107. 1140 ifbb=48thenf5=f5+10:f5=f5+40*(f5>39):gosub2950:goto1190
  108. 1150 ifbb=57then1880
  109. 1160 ifbb<64then1180
  110. 1170 ifzz<0thenqq=cz(bb-64)-zr*n9:goto1190
  111. 1180 qq=bb-zr*n9
  112. 1190 pokevm+981,qq:pokevm+961,62+abs(zw)*n9:goto200
  113. 1200 kq=asc(b$)-49
  114. 1210 f3=0:poke49651,kq:sys49650:sys49677,16,23:printf5chr$(157)" "
  115. 1220 pokevm+961,62+abs(zw)*n9:return
  116. 1230 py=pp:ifdx=114thenpp=pp-p1:ifpp<0thenpp=pp+p2
  117. 1240 ifdx=113thenpp=pp+p1:ifpp>=p2thenpp=pp-p2
  118. 1250 ifdx=107thenpp=pp-1:if(pp+1)/p1=int((pp+1)/p1)thenpp=pp+p1
  119. 1260 ifdx=115thenpp=pp+1:ifpp/p1=int(pp/p1)thenpp=pp-p1
  120. 1270 qy=qp:ky=kp:qp=peek(pp+vm):kp=peek(pp+vn)and15:sys49677,2,23
  121. 1280 printqp;chr$(157)"  ";:iff8=6thenpokepy+vn,kq:pokepy+vm,qy:goto190
  122. 1290 ifzv<0thenpokepy+vn,ky:pokepy+vm,qy:goto190
  123. 1300 pokepy+vn,kq:pokepy+vm,fnfx(qq):goto190
  124. 1310 rm=pp:rx=qp:rq=kp:rp=rm+f5-1:iff5=0then1350
  125. 1320 ifdx=113ordx=114theniff5>24thenrp=rm+23
  126. 1330 forr=rmtorp:px=rm:gosub1650:pokepx+vm,rx:pokepx+vn,rq:rx=qx:rq=kx:rm=px:next
  127. 1340 dx=0:qp=p4:f3=0:goto1190
  128. 1350 rp=rm+38:ifdx=113ordx=114thenrp=rm+23
  129. 1360 forr=rmtorp:px=rm:gosub1650:ifqx=p4thenr=rp
  130. 1370 pokepx+vm,rx:pokepx+vn,rq:rx=qx:rq=kx:rm=px:next:goto1340
  131. 1380 if(bb>127andbb<142)or(bb>146andbb<161)then380
  132. 1390 ifbb=19orbb=20orbb=13orbb=3then620
  133. 1400 ifbb<p4then190
  134. 1410 iff3=0then1460
  135. 1420 ifbb=58orbb=59orbb=47orbb=63then1060
  136. 1430 ifbb<96then700
  137. 1440 ifbb=48then860
  138. 1450 ifbb=196then420
  139. 1460 ifbb<64then1490
  140. 1470 ifbb<192thenbb=bb-64:goto1490
  141. 1480 bb=bb-128
  142. 1490 ifzw<0thenqq=bb-zr*n9
  143. 1500 dx=115:pokepp+vn,kq:pokepp+vm,fnfx(bb)
  144. 1510 px=pp:gosub1650:pp=px:qp=qx:kp=kx:dx=0:f3=0:goto1190
  145. 1520 pokepp+vn,kp:pokepp+vm,qp
  146. 1530 rm=50176:rx=53248:rq=36864-rp*4096:gosub2290
  147. 1540 rm=55296:rx=56319:rq=33791-rp*4096:gosub2290:return
  148. 1550 rm=33792-rp*4096:rx=36864-rp*4096:rq=53248:gosub2290
  149. 1560 rm=32768-rp*4096:rx=33791-rp*4096:rq=56319:gosub2290:return
  150. 1570 rm=33792:rx=34815:rq=51199:gosub2290:rm=32768:rx=33791:rq=56319:gosub2290
  151. 1580 return
  152. 1590 sys57812 a$,abs(dv):poke173,rm/256:poke172,rm-peek(173)*256:poke780,172
  153. 1600 poke782,rx/256:poke781,rx-peek(782)*256:sys65496:return
  154. 1610 iff5=0then1640
  155. 1620 px=pp:gosub1650
  156. 1630 forr=1tof5:pokepx+vn,kq:pokepx+vm,fnfx(qq):gosub1650:next
  157. 1640 f3=0:pokevm+961,62+abs(zw)*n9::goto190
  158. 1650 ifdx=114thenpx=px-p1:ifpx<0thenpx=px+p2
  159. 1660 ifdx=113thenpx=px+p1:ifpx>=p2thenpx=px-p2
  160. 1670 ifdx=107thenpx=px-1:if(px+1)/p1=int((px+1)/p1)thenpx=px+p1
  161. 1680 ifdx=115thenpx=px+1:ifpx/p1=int(px/p1)thenpx=px-p1
  162. 1690 qx=peek(px+vm):kx=peek(px+vn)and15:return
  163. 1700 r=int(mx/256):poke904,r:poke903,mx-r*256:sys49700
  164. 1710 rm=peek(905)+peek(906)*256+5:gosub1730
  165. 1720 mx=3030:forr=1to222:next:return
  166. 1730 rx=1:forr=923tor+20:poker+vn,1+rp*14:poker+vm,0:next
  167. 1740 forr=vm+924tor+18:poker-1,peek(r):next
  168. 1750 rq=peek(rm):ifrq=0thenrm=rm+6:goto1750
  169. 1760 getb$:js=peek(56320)
  170. 1770 ifb$=" "thenpoker-1,p4:forrq=1to222:next:goto1750
  171. 1780 ifb$=chr$(136)orjs=111thenpoker-1,p4:return
  172. 1790 ifb$="x"thenifrx=99thenrx=1:forrq=1to99:next:goto1750
  173. 1800 ifb$="x"thenifrx=1thenrx=99:forrq=1to99:next:goto1750
  174. 1810 ifrq>64thenrq=rq-64
  175. 1820 poker,32:ifrq=64thenpoker-1,p4:return
  176. 1830 poker-1,rq:forrq=1torx:next:rm=rm+1:goto1740
  177. 1840 iff5<2thenreturn
  178. 1850 px=pp:dx=115:gosub1870:dx=114:gosub1870:dx=107:gosub1870:dx=113:gosub1870
  179. 1860 qp=qq:kp=kq:return
  180. 1870 forr=1tof5-1:gosub1650:pokepx+vn,kq:pokepx+vm,fnfx(qq):next:return
  181. 1880 px=pp:dx=115
  182. 1890 forr=0to3:ifr=2thenpx=pp:dx=113:gosub1650:dx=115
  183. 1900 gosub1650:qx=qq+r:ifqx>255thenqx=qx-256
  184. 1910 pokepx+vn,kq:pokepx+vm,qx:next:dx=0:f3=0:goto1190
  185. 1920 :
  186. 1930 ll=9:b$="load directory ":goto2030
  187. 1940 :
  188. 1950 printchr$(147);:open8,abs(dv),0,"$":get#8,a$,a$,a$,a$
  189. 1960 get#8,a$,b$:rm=asc(a$+chr$(0)):rx=asc(b$+chr$(0))
  190. 1970 printmid$(str$(rm+rx*256),2)" ";
  191. 1980 get#8,a$:rm=asc(a$+chr$(0)):ifrm<>0thenprinta$;:goto1980
  192. 1990 print:get#8,a$,a$:ifasc(a$+chr$(0))<>0then1960
  193. 2000 close8:sys49677,3,24:print"   press space bar when ready   ";
  194. 2010 getb$:ifb$=""then2010
  195. 2020 gosub1570:gosub2950:goto610
  196. 2030 gosub2950:sys49677,0,24
  197. 2040 print" "b$"   *    f7 key to quit";:poke51177,zy:poke51176,zx
  198. 2050 pokepp+vn,kp:pokepp+vm,qp
  199. 2060 mx=rp:rp=0:gosub1530:rp=mx:ifll=9then2140
  200. 2070 mx=2240:gosub1700:sys49677,24,23:printa$" ";:r=1:ifll=8thenr=0
  201. 2080 getb$:rm=len(a$):ifb$=chr$(136)thensys49677,0,23:print" ";:goto2230
  202. 2090 ifb$=chr$(29)thenifrm>rthena$=left$(a$,rm-1):goto2130
  203. 2100 ifb$=chr$(13)andrm>1then2140
  204. 2110 ifrm=16orb$<" "orb$>chr$(95)or(b$=" "andrm=r)orb$=""then2080
  205. 2120 a$=a$+b$
  206. 2130 sys49677,24,23:printa$" ";:goto2080
  207. 2140 mx=2250:gosub1700
  208. 2150 getb$:ifb$=""then2150
  209. 2160 ifb$<>" "then2230
  210. 2170 ifll=9then1950
  211. 2180 ifll=8thenmx=2280:gosub1700:open15,abs(dv),15
  212. 2190 ifll=8thenprint#15,"s0:"a$:close15:goto2230
  213. 2200 mx=2270:ifll/2<>int(ll/2)thengosub1700:loada$,abs(dv),1:goto2230
  214. 2210 mx=2260:gosub1700:rm=32768:rx=36864:ifll=2thenrm=51200:rx=53248
  215. 2220 gosub1590
  216. 2230 gosub2950:goto610
  217. 2240 rementer file name & press return:   @
  218. 2250 reminsert disk * press space bar @
  219. 2260 remsaving: @
  220. 2270 remloading: @
  221. 2280 remerasing @
  222. 2290 r=int(rm/256):poke49725,rm-r*256:poke49729,r
  223. 2300 r=int((rx+1)/256):poke49733,rx+1-r*256:poke49737,r
  224. 2310 r=int((rq+1)/256):poke49741,rq+1-r*256:poke49745,r:sys49724:return
  225. 2320 iff5=0then2400
  226. 2330 r=0:rm=pp:rx=40:ifbb=133orbb=134thenrx=-40
  227. 2340 rm=rm+rx:ifrm<0orrm>919then2400
  228. 2350 ifbb=134orbb=136then2380
  229. 2360 ifrm/p1=int(rm/p1)then2400
  230. 2370 rm=rm-1:goto2390
  231. 2380 rm=rm+1:ifrm/p1=int(rm/p1)then2400
  232. 2390 r=r+1:pokerm+vn,kq:pokerm+vm,fnfx(qq):ifr<f5then2340
  233. 2400 f3=0:pokevm+961,62+abs(zw)*n9:return
  234. 2410 pokepp+vn,kp:pokepp+vm,qp:rp=0:gosub1530:rq=5120
  235. 2420 ifll=1then2540
  236. 2430 ifll=2then2510
  237. 2440 ifll=3then2570
  238. 2450 ifll=4then2600
  239. 2460 ifll=5then2640
  240. 2470 ifll=6then2680
  241. 2480 forr=50176to51095:ifpeek(r)=qpthenpoker,qq
  242. 2490 next:qp=qq:return
  243. 2500 :
  244. 2510 forr=55296to56215:ifpeek(r-rq)=qpthenif(peek(r)and15)=kpthenpoker,kq
  245. 2520 next:kp=kq:return
  246. 2530 :
  247. 2540 forr=55296to56215:ifpeek(r-rq)=qpthenpoker,kq
  248. 2550 next:kp=kq:return
  249. 2560 :
  250. 2570 forr=50176to51095:ifpeek(r)=qpthenif(peek(r+rq)and15)=kpthenpoker,qq
  251. 2580 next:qp=qq:return
  252. 2590 :
  253. 2600 rm=qp-n9:ifqp<n9thenrm=qp+n9
  254. 2610 forr=50176to51095:ifpeek(r)=qpthenpoker,rm
  255. 2620 next:qp=rm:return
  256. 2630 :
  257. 2640 forr=50176to51095:rm=peek(r):ifrm<n9thenpoker,rm+n9:goto2660
  258. 2650 poker,rm-n9
  259. 2660 next:qp=peek(pp+vm):return
  260. 2670 :
  261. 2680 forr=50176to51095:rm=peek(r):ifrm=p4then2710
  262. 2690 ifrm<n9thenpoker,rm+n9:goto2710
  263. 2700 poker,rm-n9
  264. 2710 next:qp=peek(pp+vm):return
  265. 2720 forr=49600to49751:readrx:poker,rx:next:sys49600
  266. 2730 poke56578,peek(56578)or3:poke56576,(peek(56576)and252)or0
  267. 2740 poke53272,18:poke648,196:poke788,52
  268. 2750 poke650,128:poke53281,0:poke53280,14:printchr$(8)chr$(155)chr$(147)
  269. 2760 forr=54272to54296:poker,0:next
  270. 2770 poke54296,15:poke54278,136:poke54277,255:poke54273,25:poke54272,177
  271. 2780 b$="":vm=50176:vn=55296:pp=500:np=57:p1=40:p2=920
  272. 2790 qp=32:kp=12:qy=32:py=pp:kq=15:js=127:vp=51192:dq=1
  273. 2800 dimdx,px,qx,kx,dp,qr,qq,f8,f9,rq,rm,zy,zz,zv,zw,zr,f3,f5,rp
  274. 2810 n9=128:d6=54276:zx=14:f4=1:p4=32:dv=8
  275. 2820 deffnfx(r)=r-zr*n9+(randn9)*zr*2:mx=3030
  276. 2830 p3=320:a$="":ca=51200:dimxm,qa,sw,zp,ll,hp,pk,cx,bp,cy,ry,wf,pb,qd
  277. 2840 pt(0)=115:pt(2)=107:pt(3)=114:pt(4)=107:pt(5)=115:pt(6)=113:pt(7)=114
  278. 2850 dimcz(30):forr=0to30:readrx:cz(r)=rx:next
  279. 2860 dimgg$(9):gg$(0)="5>shift":gg$(1)=chr$(18)+"5>cmdre"+chr$(146)
  280. 2870 gg$(2)="7>draw ":gg$(3)=chr$(18)+"7>keep"+chr$(146)+" ":gg$(4)="1>graf"
  281. 2880 gg$(5)=chr$(18)+"1>alfa"+chr$(146)
  282. 2890 gg$(6)="3>reverse off":gg$(7)=chr$(18)+"3>reverse on "+chr$(146)
  283. 2900 gg$(8)="paint ":gg$(9)="paint "
  284. 2910 dimby(7):dimbx(7)
  285. 2920 gosub3000:ifpeek(828)=1andpeek(829)=2andpeek(830)=3then2940
  286. 2930 poke828,1:poke829,2:poke830,3:rp=1:gosub1530:rp=2:gosub1530
  287. 2940 poke51177,zy:dq=sgn(zy):dp=0:ifdq=0thendp=1
  288. 2950 rp=0:printchr$(144);:ifzy<3orzy=6orzy=9orzy=11thenprintchr$(155);:rp=1
  289. 2960 sys49650:sys49677,16,23:printf5chr$(157)" ";:sys49677,0,24
  290. 2970 printgg$(abs(zw)+4)" "gg$(abs(zr)+6)"   "gg$(abs(zz))"  "gg$(abs(zv)+2+f8);
  291. 2980 pokevn+981,rp*15:pokevm+981,qq
  292. 2990 pokevn+999,rp*15:pokevm+999,abs(f4)+48:return
  293. 3000 poke51200,0:poke51201,0:poke51206,0:poke51207,0
  294. 3010 forr=51202to51205:poker,255:next:printchr$(146);:return
  295. 3020 remnew device number@
  296. 3030 remwelcome to lodraw *
  297. 3040 rem press f7 key anytime to quit messages * hold down space bar to pause
  298. 3050 rem scrolling of a message * use joystick in port 2@
  299. 3060 data206,14,220,165,1,41,251,133,1,169,208,133,32,169,200,133,34,169,0,133
  300. 3070 data31,133,33,168,162,8,177,31,145,33,200,208,249,230,32,230,34,202,208
  301. 3080 data242,165,1,9,4,133,1,238,14,220,96
  302. 3090 data169,15,162,0,160,40,157,152,219,232,136,208,249,169,0,162,0,160,40
  303. 3100 data157,152,199,232,136,208,249,96
  304. 3110 data32,253,174,32,158,183,142,87,3,32,253,174,32,158,183,172,87,3,24
  305. 3120 data32,240,255,96
  306. 3130 data173,135,3,133,20,173,136,3,133,21,32,19,166,165,95,141,137,3,165,96
  307. 3140 data141,138,3,96
  308. 3150 :
  309. 3160 data169,0,133,95,169,0,133,96,169,0,133,90,169,0,133,91,169,0,133,88
  310. 3170 data169,0,133,89,32,191,163,96
  311. 3180 data100,112,127,124,108,113,123,101,116,98,117,97,118,103,106,121,111,107
  312. 3190 data114,110,99,120,126,115,125,119,109,102,104,92,105
  313. 3200 poke51200,255:poke51207,255:forr=51201to51206:poker,129:next
  314. 3210 xm=0:cy=0:poke53281,0:poke53280,14:printchr$(152);chr$(147):wf=0
  315. 3220 wf=notwf:ifwf<0thengosub3270:ifb$=chr$(20)thengosub3000:return
  316. 3230 ifwf<>0then3260
  317. 3240 pb=180:qa=peek(pb+vm):zp=0:hp=7:poke50448,rx:ifxm=0thenpoke2024,rx
  318. 3250 bb=-1:gosub4340:bb=0:gosub3440:sw=0
  319. 3260 forr=1to99:next:goto3220
  320. 3270 printchr$(147);"view character: press f7 key & code or:-";:print
  321. 3280 printchr$(158)"character  key ? ";chr$(152);
  322. 3290 ifxm>0thenb$=str$(xm):goto3330
  323. 3300 getb$:ifb$=""then3300
  324. 3310 ifb$=chr$(20)thenreturn
  325. 3320 ifb$<>chr$(136)then3360
  326. 3330 pokevm+96,163:ry=peek(211):ifxm=0thengosub3560
  327. 3340 rx=val(b$):ifrx>255thenxm=0:printchr$(146);:goto3270
  328. 3350 poke211,ry:print" ";:goto3410
  329. 3360 rx=asc(b$):if(rx>63andrx<96)or(rx>159andrx<192)thenrx=rx-64:goto3400
  330. 3370 ifrx>191andrx<224thenrx=rx-n9:goto3400
  331. 3380 ifrx>31andrx<64then3400
  332. 3390 goto3300
  333. 3400 printb$;
  334. 3410 printchr$(154)chr$(146)"  @@@@@@@@   ";chr$(152);rx:print
  335. 3420 bb=0:forr=ca+rx*8tor+7:bb=bb+1:pk=peek(r):print"byte";bb;r;pk,:by(bb-1)=pk
  336. 3430 gosub3660:next:forr=vmtor+39:poker,32:next:return
  337. 3440 ifcy<0thensw=1:xm=0:goto3700
  338. 3450 print:printchr$(158)"edit character";rx;"?"chr$(152):print
  339. 3460 sw=2:gosub3560:sw=1
  340. 3470 ifa$=chr$(136)thenforr=1to299:next:goto3700
  341. 3480 ifa$=chr$(20)orxm<>0thenreturn
  342. 3490 forr=ca+rx*8tor+7:bb=bb+1:pk=peek(r):print"byte";bb;r;"?";
  343. 3500 poke211,peek(211)-1:ifsw=4then3530
  344. 3510 gosub3560:ifb$<>""andval(b$)<256thenpk=val(b$)
  345. 3520 ifa$=chr$(136)thensw=4
  346. 3530 poker,pk:poke211,rq:printpk;:ifpk<10thenpoke211,peek(211)-1:print" ";
  347. 3540 print,:gosub3660:next:forr=1to40:print"-";:next
  348. 3550 print" press <f7>/fire button or <f5> or <f3>";:sw=2
  349. 3560 b$="":ll=0:rm=peek(214):rq=peek(211)
  350. 3570 geta$:ifsw>1then3600
  351. 3580 ifa$>"/"anda$<":"thenb$=b$+a$:ll=len(b$):poke214,rm:poke211,rq:printb$;
  352. 3590 ifll=3thenpoked6,33:poked6,16
  353. 3600 ifa$=chr$(13)orll=3ora$=chr$(20)thenxm=0:return
  354. 3610 ifa$=chr$(136)orpeek(56320)=111thenifsw>0thena$=chr$(136):xm=0:return
  355. 3620 ifsw<2then3570
  356. 3630 ifa$=chr$(134)thenxm=rx+1:return
  357. 3640 ifa$=chr$(135)thenxm=rx-1:return
  358. 3650 goto3570
  359. 3660 bp=n9:forrp=1to8:t=int(pk/bp)
  360. 3670 ift=1thenprintchr$(64);:pk=pk-bp
  361. 3680 ift=0thenprint" ";
  362. 3690 bp=bp/2:next:print:return
  363. 3700 gosub4370
  364. 3710 js=peek(56320):ifjs<127thenifjs>118thendx=pt(js-119)
  365. 3720 getb$:ifb$>"c"andb$<"m"thendx=114
  366. 3730 ifb$=" "thendx=113:js=127
  367. 3740 ifb$=","thendx=107
  368. 3750 ifb$="."thendx=115
  369. 3760 ifb$="y"thenifrx<253thenqd=notqd:poked6,33:poked6,16:gosub4750
  370. 3770 ifqd=0then3810
  371. 3780 ifdx>0thenpokepb+vm,qa:gosub4830:dx=0
  372. 3790 ifb$=chr$(13)orjs=111thengosub4980
  373. 3800 goto4010
  374. 3810 ifdx>0thenpokepb+vm,qa:gosub4050:dx=0:goto4010
  375. 3820 ifb$=chr$(13)orjs=111thengosub4100
  376. 3830 ifb$="n"thengosub4270:gosub4370
  377. 3840 ifb$="w"thenry=0:kx=p4:gosub4240
  378. 3850 ifb$="q"thenry=1:kx=0:gosub4240
  379. 3860 ifb$="r"thengosub4600
  380. 3870 ifb$="[210]"thengosub4680
  381. 3880 ifb$="c"thenb$="":r=11:sys49677,0,2:print"character code?    ";:gosub4510
  382. 3890 ifb$="[195]"thengosub4650
  383. 3900 ifb$="p"thenifrx<253thengosub5030
  384. 3910 ifb$="b"thengosub4170
  385. 3920 ifb$="z"thengosub4200
  386. 3930 ifb$="a"thenby(zp)=0:qa=p4:gosub4260
  387. 3940 ifb$="s"thenby(zp)=255:qa=0:gosub4260
  388. 3950 ifb$="x"thengosub4210
  389. 3960 ifb$="v"thengosub4220
  390. 3970 ifb$="m"thency=notcy:poked6,33:poked6,16
  391. 3980 ifb$=chr$(136)thenreturn
  392. 3990 ifb$=chr$(134)thenxm=rx+1:return
  393. 4000 ifb$=chr$(135)thenxm=rx-1:return
  394. 4010 ifcx=0thenpokepb+vm,qa
  395. 4020 ifcx=3thenpokepb+vm,42
  396. 4030 cx=cx+1:ifcx=6thencx=0
  397. 4040 goto3710
  398. 4050 ifdx=114thenpb=pb-p1:zp=zp-1:ifpb<180thenpb=pb+p3:zp=7
  399. 4060 ifdx=113thenpb=pb+p1:zp=zp+1:ifpb>467thenpb=pb-p3:zp=0
  400. 4070 ifdx=107thenpb=pb-1:hp=hp+1:if(pb+1)/20=int((pb+1)/20)thenpb=pb+8:hp=0
  401. 4080 ifdx=115thenpb=pb+1:hp=hp-1:if(pb+12)/p1=int((pb+12)/p1)thenpb=pb-8:hp=7
  402. 4090 qa=peek(pb+vm):pokepb+vm,42:forr=1to99:next:cx=0:return
  403. 4100 ifqa=p4thenqa=0:by(zp)=by(zp)+(2^hp):goto4120
  404. 4110 ifqa=0thenqa=p4:by(zp)=by(zp)-(2^hp)
  405. 4120 b$=str$(by(zp)):ll=len(b$):pokeca+rx*8+zp,by(zp):poke50448,rx
  406. 4130 forr=1toll:a$=mid$(b$,r,1):px=(zp+4)*p1+13+r+vm:pokepx,asc(a$):next
  407. 4140 ifll<4thenpokepx+1,p4
  408. 4150 ifll<3thenpokepx+2,p4
  409. 4160 forr=1to99:next:cx=0:return
  410. 4170 forr=0to3:px=6-r+1:qx=by(r):by(r)=by(px):by(px)=qx:next
  411. 4180 forr=ca+rx*8tor+7:poker,by(r-ca-rx*8):next:gosub4330:return
  412. 4190 :
  413. 4200 forr=ca+rx*8tor+7:poker,0:by(r-ca-rx*8)=0:next:gosub4330:return
  414. 4210 forr=ca+rx*8tor+7:poker,255:by(r-ca-rx*8)=255:next:gosub4330:return
  415. 4220 forr=ca+rx*8tor+7:bb=255-peek(r):poker,bb:by(r-ca-rx*8)=bb:next:gosub4330
  416. 4230 return
  417. 4240 qx=zp:forzp=0to7:ifsgn((by(zp)and(2^hp)))=rythenqa=kx:gosub4100
  418. 4250 pk=by(zp):sys49677,20,zp+4:gosub3660:next:zp=qx:qa=peek(pb+vm):return
  419. 4260 gosub4120:pk=by(zp):sys49677,20,zp+4:gosub3660:b$="":return
  420. 4270 kx=ca+rx*8:forpx=0to7:qx=0:forr=7to0step-1:bb=sgn(by(px)-2^r)
  421. 4280 ifbb>-1thenby(px)=by(px)-2^r:qx=qx+2^(7-r)
  422. 4290 next:by(px)=qx:pokekx+px,by(px)
  423. 4300 sys49677,14,px+4:pk=by(px)
  424. 4310 print"    "chr$(157)chr$(157)chr$(157)chr$(157)pk,
  425. 4320 gosub3660:next:qa=peek(pb+vm):pokevm+97,rx:return
  426. 4330 printchr$(147);:sys49677,18,2:gosub3410:pokevm+97,rx
  427. 4340 r=peek(2024)
  428. 4350 ifr<253thenpoke50452,r:poke50453,r+1:poke50492,r+2:poke50493,r+3
  429. 4360 qa=peek(pb+vm):ifbb<0thenreturn
  430. 4370 sys49677,10,0:printchr$(158)"<y> edit quade"
  431. 4380 sys49677,3,1:print"<return> or fire button to edit"
  432. 4390 sys49677,0,12:print"joystick to move or:-"
  433. 4400 print" <comma> move left   <dot> move right"
  434. 4410 print" <space> move down   <d> -> <l> move up"
  435. 4420 print" <z> blank character <x> fill character"
  436. 4430 print" <a> blank row       <s> fill row"
  437. 4440 print" <q> blank column    <w> fill column"
  438. 4450 print" <c> copy character  <r> rotate char."
  439. 4460 print" <v> reverse character"
  440. 4470 print" <b> vert. inverse   <n> horiz. inverse"
  441. 4480 print" <m> auto edit       <p> quade expand"
  442. 4490 print" <shift> <c> copy quade":print" <shift> <r> rotate quade"chr$(152)
  443. 4500 print"press <f7> or <f5> or <f3> to quit edit";:return
  444. 4510 geta$:r=r+1:ifr=12thenr=0:forll=80+vntoll+15:pokell,1:next
  445. 4520 ifr=6thenforll=80+vntoll+15:pokell,7:next
  446. 4530 ifa$>"/"anda$<":"thenb$=b$+a$:sys49677,16,2:printb$;
  447. 4540 iflen(b$)=3ora$=chr$(13)thenpoked6,33:poked6,16:goto4570
  448. 4550 ifa$=chr$(136)thenreturn
  449. 4560 goto4510
  450. 4570 ll=val(b$):ifll=0orll>255thensys49677,15,2:print"    ";:return
  451. 4580 ifbb<0thenreturn
  452. 4590 forr=0to7:pokeca+r+ll*8,peek(ca+r+rx*8):next:b$="":return
  453. 4600 ry=ca+rx*8:forr=0to7:bb=0:fort=0to7:if(by(t)and(2^(7-r)))>0thenbb=bb+2^t
  454. 4610 next:pokery+r,bb:next
  455. 4620 forr=0to7:by(r)=peek(ry+r):sys49677,14,r+4:pk=by(r)
  456. 4630 print"    "chr$(157)chr$(157)chr$(157)chr$(157)pk,
  457. 4640 gosub3660:next:qa=peek(pb+vm):pokevm+97,rx:return
  458. 4650 b$="":r=11:sys49677,0,2:print"character code?    ";
  459. 4660 bb=-1:ll=0:gosub4510:bb=0:ifll=0orll>252or(ll>=rxandll<rx+4)thenreturn
  460. 4670 kx=ca+ll*8:rq=ca+rx*8:forr=0to31:pokekx+r,peek(rq+r):next:return
  461. 4680 kx=1-n9:rq=rx:gosub4720:kx=3-n9:rq=rx+1:gosub4720
  462. 4690 kx=-n9:rq=rx+2:gosub4720:kx=2-n9:rq=rx+3:gosub4720:ry=ca+rx*8
  463. 4700 forr=0to31:pokery+r,peek(vm+r):pokevm+r,32:next:gosub4620
  464. 4710 sys49677,10,0:print"<y> edit quade":return
  465. 4720 ry=ca+kx*8:forr=0to7:bx(r)=peek(ca+r+rq*8):pokery+r,bx(r):next
  466. 4730 forr=0to7:bb=0:fort=0to7:if(bx(t)and(2^(7-r)))>0thenbb=bb+2^t
  467. 4740 next:pokery+r,bb:next:return
  468. 4750 ifqd=0thenrx=peek(2025):pb=180:gosub4330:zp=0:hp=7:return
  469. 4760 printchr$(147);:forr=10to25:poker+vn,6:poker+vm,0:next:rq=ca+rx*8
  470. 4770 forkx=0to3:px=10:ifkx<2thenpx=2
  471. 4780 qx=18:ifkx=0orkx=2thenqx=10
  472. 4790 bb=0:forr=rqtor+7:sys49677,qx,px+bb:pk=peek(r):gosub3660:bb=bb+1:next
  473. 4800 rq=rq+8:next:bb=-1:pb=90:gosub4340:bb=0:zp=0:hp=7:poke2025,rx
  474. 4810 sys49677,7,20:print"<y> to quit quade edit"
  475. 4820 print:print"    <return>/fire button to edit":return
  476. 4830 ifdx<>114then4860
  477. 4840 pb=pb-p1:zp=zp-1:ifpb<90thenpb=pb+640:zp=7:rx=rx+2:goto5010
  478. 4850 ifpb+p1>385thenifpb<410thenzp=7:rx=rx-2:goto5010
  479. 4860 ifdx<>113then4890
  480. 4870 pb=pb+p1:zp=zp+1:ifpb>705thenpb=pb-640:zp=0:rx=rx-2:goto5010
  481. 4880 ifpb-p1<386thenifpb>385thenzp=0:rx=rx+2:goto5010
  482. 4890 ifdx<>107then4930
  483. 4900 pb=pb-1:hp=hp+1
  484. 4910 if(pb-9)/40=int((pb-9)/40)thenpb=pb+16:hp=0:rx=rx+1:goto5010
  485. 4920 if(pb-17)/40=int((pb-17)/40)thenhp=0:rx=rx-1:goto5010
  486. 4930 ifdx<>115then4970
  487. 4940 pb=pb+1:hp=hp-1
  488. 4950 if(pb+14)/p1=int((pb+14)/p1)thenpb=pb-16:hp=7:rx=rx-1:goto5010
  489. 4960 if(pb+22)/p1=int((pb+22)/p1)thenhp=7:rx=rx+1:goto5010
  490. 4970 qa=peek(pb+vm):pokepb+vm,42:forr=1to99:next:cx=0:return
  491. 4980 ifqa=p4thenqa=0:by(zp)=by(zp)+(2^hp):goto5000
  492. 4990 ifqa=0thenqa=p4:by(zp)=by(zp)-(2^hp)
  493. 5000 pokeca+rx*8+zp,by(zp):return
  494. 5010 forr=0to7:by(r)=peek(ca+r+rx*8):next:goto4970
  495. 5020 :
  496. 5030 forr=0to31:poker+vm,0:next
  497. 5040 fort=0to7:forr=0to7:bb=2^randby(t):ifbb=0then5090
  498. 5050 rq=t*2+vm-8*(t>3):ifr>3then5080
  499. 5060 bb=2^(r*2)+2^(r*2+1):pokerq+8,peek(rq+8)orbb:pokerq+9,peek(rq+9)orbb
  500. 5070 goto5090
  501. 5080 bb=2^((r-4)*2)+2^((r-4)*2+1):pokerq,peek(rq)orbb:pokerq+1,peek(rq+1)orbb
  502. 5090 next:next:ry=ca+rx*8:gosub4700:return
  503. 5100 rx=ca+qq*8:forr=ca+qp*8tor+7:rm=peek(r):poker,peek(rx):pokerx,rm:rx=rx+1
  504. 5110 next:return
  505. 6000 getb$:ifb$=""then6000
  506. 6010 r=asc(b$):ifr=95thenll=99:goto6000
  507. 6020 ifll=99then6350
  508. 6030 ifr=86thenll=5
  509. 6040 ifr=71thenll=6
  510. 6050 ifr=83thenll=2
  511. 6060 ifr=90thenll=1
  512. 6070 ifr=67thenll=0
  513. 6080 ifr=70thenll=3
  514. 6090 ifr=88thenll=4
  515. 6100 ifr=94thenll=10
  516. 6110 ifr=66thenll=9
  517. 6120 ifr=65thenll=8
  518. 6130 ifr=138thenll=12
  519. 6140 ifr=137thenll=13
  520. 6150 ifr=140thenll=18
  521. 6160 ifr=139thenll=19
  522. 6170 ifr=141thenll=24
  523. 6180 ifr=19thenll=14
  524. 6190 ifr=57thenll=15
  525. 6200 ifr=48thenll=16
  526. 6210 ifr=58thenll=25
  527. 6220 ifr=59thenll=26
  528. 6230 ifr=47thenll=27
  529. 6240 ifr=63thenll=28
  530. 6250 ifr=64thenll=29
  531. 6260 ifr=68thenll=22
  532. 6270 ifr=196thenll=23
  533. 6280 ifr=72thenll=17
  534. 6290 ifr=160thenll=30
  535. 6300 ifr=20thenll=31
  536. 6310 ifr=147thenll=32
  537. 6320 ifr=61thenll=33
  538. 6330 ifll>-1thenmx=55100+ll*100:gosub1700
  539. 6340 return
  540. 6350 ll=-1:ifr=20thenll=11
  541. 6360 ifr=140thenll=20
  542. 6370 ifr=139thenll=21
  543. 6380 goto6330
  544. 55100 remreplace all pad characters that match character under pen, with pen
  545. 55110 rem character@
  546. 55200 remreplace color of all pad characters that match character under pen,
  547. 55210 rem with pen color@
  548. 55300 remreplace color of all pad characters that match both character and
  549. 55310 rem color under pen, with pen color@
  550. 55400 remreplace all pad characters that match both character and color under
  551. 55410 rem pen, with pen character@
  552. 55500 remreplace all pad characters that match the normal/reverse character
  553. 55510 rem under pen, with the reverse/normal form of that character@
  554. 55600 remreplace every normal/reverse character on pad (including spaces) with
  555. 55610 rem the reverse/normal form of that character@
  556. 55700 remreplace every normal/reverse character on pad (excluding normal spaces)
  557. 55710 rem with the reverse/normal form of that character@
  558. 55900 remedit on/off switch: in edit on mode, lodraw can be used like a typewrit
  559. 55910 remer@
  560. 56000 remdraws a square from pen with side length equal to projection number@
  561. 56100 remundo: changes made by a projection, replace, get or clear pad operation
  562. 56110 rem can be undone, restoring your original design@
  563. 56200 remcharacter editor: for designing your own characters and quades@
  564. 56300 remput: for storing on-screen design, color and character set in current
  565. 56310 rem user buffer@
  566. 56400 remget: for retrieving design, color and character set from current
  567. 56410 rem user buffer@
  568. 56500 remuser buffer switch: switches between buffer 1 and buffer 2, to/from
  569. 56510 rem which screen/color/character set can be stored/retrieved@
  570. 56600 remquades: four characters with successive screen character codes are
  571. 56610 rem drawn in a square to right of pen  *  first character is pen character@
  572. 56700 remadds 10 to the projection number@
  573. 56800 remhide/see pen switch@
  574. 56900 remdisk save screen/color/character set@
  575. 57000 remdisk load screen/color/character set@
  576. 57100 remdisk save character set@
  577. 57200 remdisk load character set@
  578. 57300 remdisplay disk directory@
  579. 57400 remerase file from disk@
  580. 57500 rempaint: pen will paint characters it passes over with pen color  *
  581. 57510 rem  <f7> quits paint@
  582. 57600 remshift row left from pen@
  583. 57700 remshift row right from pen@
  584. 57800 remshift column down from pen@
  585. 57900 remshift column up from pen@
  586. 58000 remswap: transposes pen character with pad character under pen without
  587. 58010 rem swapping their screen character codes@
  588. 58100 remdefines pen character as the character on the pad under the pen@
  589. 58200 remswitches character editor on/off@
  590. 58300 remclear pad: <select> <^> will restore pattern if you made a mistake@
  591. 58400 remallows you to define pen character by screen character code@
  592.