home *** CD-ROM | disk | FTP | other *** search
/ Compute! Gazette 1992 December / 1992-12.d64 / lodraw (.txt) < prev    next >
Commodore BASIC  |  2022-09-20  |  20KB  |  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