home *** CD-ROM | disk | FTP | other *** search
/ UpTime Volume 2 #5 / utv2n5s1.d64 / locomotion (.txt) < prev    next >
Commodore BASIC  |  2022-08-28  |  14KB  |  557 lines
  1. 10 rem locomotion  by ian adam (c) 1988
  2. 20 rem published by softdisk publishing, inc.
  3. 30 :
  4. 40 if a=950 then 950
  5. 50 if a=1100 then 1100
  6. 60 if peek(2054)>32 then 100
  7. 70 poke 2054,66:if peek(56)=128 then if peek(32768)=76 then poke 2054,85
  8. 90 :
  9. 100 poke 56,67:clr
  10. 110 if peek(18432)=76 then if peek(18433)=172 then 150
  11. 120 df$="loco.code":gosub 1200:if c then 100
  12. 130 sys 65418:poke 808,234:load df$,8,1
  13. 140 :
  14. 150 gosub 500
  15. 160 poke 53280,6:poke 53281,6
  16. 190 :
  17. 198 rem ***  main menu  ***
  18. 199 :
  19. 200 sys vw+6:poke 646,tc:poke fr,tb:poke fr+1,tb
  20. 210 print "[147][158]  >>>>> [204]ocomotion <<<<<   by [201]an [193]dam  "
  21. 220 print "   3-[196] [208]lotting of [215]ire-[205]odel [198]igures"
  22. 230 print "[152] [208]ublished by [211]oftdisk [208]ublishing, [201]nc."
  23. 240 printtab(13)"[158][212]he [205]ain [205]enu:"
  24. 250 printtab(9)"[159]1  [201]nstructions"
  25. 260 printtab(9)"2  [204]oad [198]igure from [196]isk"
  26. 270 printtab(9)"3  [195]reate [206]ew [198]igure"
  27. 280 printtab(9)"4  [197]dit/[193]dd to [198]igure"
  28. 290 printtab(9)"5  [214]iew [195]urrent [198]igure"
  29. 300 printtab(9)"6  [211]ave [198]igure to [196]isk"
  30. 310 printtab(9)"7  [208]rint [198]igure"
  31. 320 printtab(9)"8  [210]eview [211]aved [201]mages"
  32. 330 printtab(9)"9  [195]hange [195]olors"
  33. 340 printtab(9)"0  [197]nd[158]"
  34. 350 if np then print "[198]igure " nf$ " has" np "points":print "and" nl "lines.[158]"
  35. 360 :
  36. 370 print"  ";:gosub 790:c=a:if a=. then if a$<>"0" then print"[145][145]":goto 370
  37. 375 print a$:if a=9 then 420
  38. 380 ifa>3andnp=0thenprinttab(5)"[206]o figure!  [208]ress [211]pacebar *[157]";:gosub1400:goto200
  39. 390 if a=1 or a>3 or np=. then 420
  40. 400 print "[145]  [204]oss of [196]ata: [193]re [217]ou [211]ure ([217]/[206]) ";:gosub 800:if a$<"y" then 200
  41. 410 :
  42. 420 on c+1 gosub 900, 1500, 1000, 2000, 3000, 6000, 7000, 8000, 9000, 10000
  43. 430 goto 200
  44. 440 :
  45. 480 : * define variables *
  46. 490 :
  47. 500 ed=18432:pl=ed+3:vw=ed+6
  48. 510 xs=ed+21:xf=xs+3:xx=xf+3:cb=xx+3
  49. 520 rp=19960:ro=rp+1:ht=ro+1
  50. 530 x1=20992:y1=21248:z1=21504
  51. 540 li=19968:lr=li+1:en=x1-4
  52. 550 for i=rp to lr:poke i,.:next
  53. 560 ra=18647:b=255:rs=218:z$=chr$(0):kb=198:bb=256:sa=5:w=54276
  54. 570 rem poke 808,225
  55. 580 sys xs-3:xm=peek(251)*8
  56. 590 tc=7:tb=6:gc=13:gb=11:poke 18515,219
  57. 600 poke w-3,30:poke w+1,18:poke w+2,.:poke w,.:poke w+7,.:poke w+14,.:poke w+20,15
  58. 610 fr=53280:return
  59. 670 :
  60. 680 : * input routines *
  61. 690 :
  62. 700 n$="":in=.:print">";
  63. 710 print"[164][157]";
  64. 720 get a$:if a$="" then 720
  65. 730 if a$=chr$(13) then print" [157]";:return
  66. 740 if a$=chr$(20) or a$="[157]" then 775
  67. 745 if in=12 then 720
  68. 750 if a$<" " or a$>"[218]" then 720
  69. 755 if a$=chr$(34) then 720
  70. 758 if a$>"z" and a$<"[193]" then 720
  71. 760 print a$;:n$=n$+a$:in=in+1
  72. 765 if in>12 then 720
  73. 770 goto 710
  74. 775 if in then in=in-1:n$=left$(n$,in):print chr$(20);
  75. 780 goto 710
  76. 785 :
  77. 790 print "[217]our [195]hoice ";
  78. 800 poke 207,.:poke 206,32:poke 204,peek(kb)
  79. 810 get a$:if a$="" then 810
  80. 820 poke 204,1:a=val(a$):print " [157]";
  81. 830 :
  82. 850 poke w,33:in=9^9:poke w,32:return
  83. 870 :
  84. 880 : * exit program *
  85. 890 :
  86. 900 poke 808,237:sys vw+6
  87. 910 if peek(2054)=66 then poke 2054,32:poke 56,160:clr:sys 65126:end
  88. 920 :
  89. 930 clr:load"upt.reboot",8
  90. 940 sys 64738
  91. 990 :
  92. 1000 print "[147][204]oad from [196]isk"
  93. 1010 :
  94. 1020 gosub 5400
  95. 1025 if n$="" then return
  96. 1030 gosub 1200
  97. 1040 if c then return
  98. 1050 a=1100:load df$,8,1
  99. 1060 :
  100. 1100 np=peek(rp):nl=-1
  101. 1110 for i=li to x1:if peek(i) then next
  102. 1120 nl=nl+1:if peek(i+1) then next
  103. 1130 lr=i+1:nf$=n$:goto 200
  104. 1140 :
  105. 1180 : * check disk file: *
  106. 1190 :
  107. 1200 open 15,8,15,"i0"
  108. 1210 open 2,8,2,df$
  109. 1220 input#15,a$,b$:c=val(a$)
  110. 1230 close 2:close 15:if c<20 then c=.:return
  111. 1240 print:print "[147][158][208]roblem: "b$
  112. 1250 print:printtab(6)"[208]lease check the disk drive."
  113. 1260 if peek(2054) then printtab(4)"[208]erhaps it's on the other side?";
  114. 1270 gosub 800:print"[147]";:return
  115. 1290 :
  116. 1300 poke 198,0
  117. 1310 get a$:if a$<>" " then 1310
  118. 1320 poke w,33:in=9^9:poke w,32:return
  119. 1400 poke 198,0
  120. 1410 poke 207,.:poke 206,32:poke 204,peek(kb)
  121. 1420 get a$:if a$<>" " then 1410
  122. 1430 poke w,33:in=9^9:poke w,32
  123. 1440 return
  124. 1500 print "[147]"tab(14)"[201]nstructions"
  125. 1510 print tab(8)"[211]creen or [208]rinter [211]/[208] ";
  126. 1515 gosub 800:if a$<>"s" and a$<>"p" then 1515
  127. 1520 p=-(a$="p"):pp=1
  128. 1530 :
  129. 1540 df$="loco.help":gosub 1200:if c then return
  130. 1550 open 1,8,8,df$+",p,r"
  131. 1560 poke 53281,.:if p=. then 1600
  132. 1570 open 4,4,7:poke 781,4:sys 65481
  133. 1580 if st then close 4:gosub 850:print "[208]lease check the printer!":p=.:goto 1850
  134. 1585 print#4:print:printtab(7)"[208]ress and hold [198]7 to quit."
  135. 1590 print#4:print#4, "               [201]nstructions for [204]ocomotion:      [208]age" pp
  136. 1595 print#4:print#4
  137. 1600 if p=. then print "[147][150]  [204]ocomotion   [208]ress [211]pacebar  [198]7 [209]uit  "
  138. 1610 input#1,t$:if t$="p" then 1800
  139. 1620 if left$(t$,1)="_" then poke 646,val(mid$(t$,2)):goto 1610
  140. 1630 if t$="q" then 1850
  141. 1640 if p=. then print t$:goto 1610
  142. 1650 a$="               "
  143. 1660 if left$(t$,1)="[160]" then a$=a$+" ":t$=mid$(t$,2):goto 1660
  144. 1670 print#4, a$ t$:goto 1610
  145. 1790 :
  146. 1800 if p then 1810
  147. 1805 print "":gosub 810:if a$<>" " and a$<>"[136]" then 1805
  148. 1807 goto 1830
  149. 1810 print#4:print#4:get a$:p=p+1
  150. 1820 if p=3 then p=1:pp=pp+1:print#4,chr$(12):if a$<"[136]" then 1590
  151. 1830 if a$<"[136]" then 1600
  152. 1840 :
  153. 1850 if p=. then if a$<>"[136]" then gosub 810
  154. 1855 if p=. then if a$<>" " and a$<>"[136]" then 1850
  155. 1860 if p then print#4,chr$(12):close 4
  156. 1870 close 1:return
  157. 1990 :
  158. 2000 print "[147][195]reate [198]ile"
  159. 2010 :
  160. 2020 np=.:nl=.:lr=li+1:nf$="":x=.:y=.:z=.
  161. 2030 gosub 5380
  162. 2040 print "[147][195]reating [198]ile " nf$
  163. 2050 print "[211]tart by [195]reating [208]oints in [211]pace,"
  164. 2060 print "then [195]onnect with [204]ines."
  165. 2070 gosub 3200
  166. 2990 :
  167. 3000 print "[147]":print tab(10)"[158] >>> [197]dit [205]enu <<< ":print:gosub 850
  168. 3010 printtab(9)"[159]1  [193]dd [208]oints"
  169. 3020 printtab(9)"2  [205]odify [208]oints"
  170. 3030 printtab(9)"3  [193]dd [204]ines"
  171. 3040 printtab(9)"4  [205]odify a [204]ine"
  172. 3050 printtab(9)"5  [211]hift/[211]cale [207]bject"
  173. 3060 printtab(9)"6  [197]rase all [204]ines"
  174. 3070 printtab(9)"7  [195]hange [206]ame"
  175. 3080 printtab(9)"8  [204]ist [208]oints"
  176. 3090 printtab(9)"9  [204]ist [204]ines"
  177. 3100 printtab(9)"0  [205]ain [205]enu[158]"
  178. 3110 print:poke ra,48
  179. 3120 gosub 790:if a$="0" then return
  180. 3122 if a=0 then print:print"[145][145]";:goto 3120
  181. 3125 print a:print:c=a
  182. 3130 if a>7 thensys vw+6:print "[211]creen or [208]rinter [211]/[208] ";:gosub 800:print a$:goto3150
  183. 3140 sys vw+9
  184. 3150 on c gosub 3200, 3600, 3800, 4000, 4200, 4900, 5380, 5000, 5200
  185. 3160 goto 3000
  186. 3170 :
  187. 3200 print:print "[212]here may be up to 255 points,"
  188. 3210 print "[216], [217], & height in the range 0 to 255."
  189. 3220 poke ra,210
  190. 3230 print "[208]ress [210][197][212][213][210][206] to [203]eep [211]ame as [204]ast [208]oint"
  191. 3240 if np>254 then print "[194]uffer [198]ull: [208]ress [193] [203]ey.":goto 800
  192. 3250 :
  193. 3260 p=np+1:print "[208]oint #" p
  194. 3270 gosub 3400
  195. 3280 if x<. or x>b then return
  196. 3290 np=p:poke rp,np
  197. 3300 sys ed:goto 3220
  198. 3310 :
  199. 3400 print:print tab(25) abs(x)
  200. 3410 print"[216] [196]imension (-1 to [209]uit)":gosub 700:if n$="" then 3420
  201. 3415 x=val(n$)
  202. 3420 if x<. or x>b then return
  203. 3430 poke x1+p,x
  204. 3440 :
  205. 3450 print:print tab(18) y
  206. 3460 print"[217] [196]imension":gosub 700:if n$="" then 3470
  207. 3465 y=val(n$)
  208. 3470 poke y1+p,y and b
  209. 3480 :
  210. 3490 print:print tab(10) z
  211. 3500 print"[200]eight":gosub 700:if n$="" then 3510
  212. 3505 z=val(n$)
  213. 3510 poke z1+p,z and b
  214. 3520 :
  215. 3530 print:return
  216. 3540 :
  217. 3600 print "[208]ress [210][197][212][213][210][206] at any [208]rompt to"
  218. 3610 print "[203]eep the [211]ame [214]alue.":print
  219. 3620 poke ra,rs:print"[208]oint # to [197]dit (0 to [209]uit)":gosub 700:p=val(n$)
  220. 3630 if p<1 or p>np then return
  221. 3640 x=peek(x1+p)
  222. 3650 y=peek(y1+p)
  223. 3660 z=peek(z1+p)
  224. 3670 gosub 3400
  225. 3680 sys ed:goto 3620
  226. 3690 :
  227. 3800 print:print "[197]ach line connects several points."
  228. 3810 print "[197]nter point #0 to quit."
  229. 3820 :
  230. 3830 if lr>en then print "[194]uffer [198]ull":goto 800
  231. 3840 n=nl+1
  232. 3850 print "[204]ine #" n
  233. 3860 print "[211]tart at point # ";:gosub 700:p=val(n$)
  234. 3870 if p<1 or p>np then return
  235. 3880 poke lr,p:lr=lr+1
  236. 3890 poke lr,.:poke lr