home *** CD-ROM | disk | FTP | other *** search
/ Run Magazine ReRun 1986 July & August / rerun-1986-07-08.d64 / needlegraph (.txt) < prev    next >
Commodore BASIC  |  2022-09-20  |  5KB  |  170 lines
  1. 10 dimpl$(16),pc$(16):ford=0to15:readpl$(d),pc$(d):next:ak$="***************"
  2. 20 p=55629:cm=p:ec=cm+(560):cc(1)=3:cc(2)=4:cc(3)=5:cc(4)=6
  3. 30 cd=54272:n=1:n1=1:n2=2:ty=31:sp=32:as=42:sb=60:rs=160
  4. 40 fr=14:ft=15:fy=40:fs=560:sh=600:s1=55483:s2=55494:dl$="":ml$=dl$+""
  5. 50 poke53280,2:poke53281,0:poke808,225
  6. 60 print"[147][159] [146] press '1' for color 1 (f1 to change)":x(1)=55297:pokex(1),3
  7. 70 print"[150][209] press '2' for color 2 (f3 to change)":x(2)=x(1)+40:pokex(2),4
  8. 80 print"[153][209] press '3' for color 3 (f5 to change)":x(3)=x(2)+40:pokex(3),5
  9. 90 print"[154][209] press '4' for color 4 (f7 to change)":x(4)=x(3)+40:pokex(4),6
  10. 100 print"[156]* shift 'x' for all color 1[146] to color 2[146]":pokes1,3:pokes2,4
  11. 110 print"[155]* shift 'p' prints design on printer":print:print
  12. 120 print" shift clr"
  13. 130 print" to clear"
  14. 140 print" shift m"
  15. 150 print" to move"
  16. 160 print" shift l"
  17. 170 print" to load"
  18. 180 print"[158] shift s"
  19. 190 print" to save"
  20. 200 print"[156] shift q"
  21. 210 print" to quit[155]"
  22. 220 print"           [172][175][185][162][158]needlegraph[146][162][185][175][187]"
  23. 230 print"":forv=1to17:printtab(11)"[182]"tab(29)"[181]":next
  24. 240 print"           [188][184][158]doug[184][158]&[184][158]deb[184][158]1985[184][190]";
  25. 250 print"":forv=1to15:printtab(13)ak$:next:print"[155]"
  26. 270 cc=cc(n):iffc=0thenfc=cc-((cc=0)*11):goto290
  27. 280 iffc>0thenfc=0
  28. 290 ifpeek(p-cd)=asthenpokep,fc
  29. 300 ifpeek(p-cd)=rsthenpokep-cd,sp:goto270
  30. 310 ifpeek(p-cd)=spthenpokep-cd,rs
  31. 320 getk$:ch=peek(p-cd)
  32. 330 ifk$=""then390
  33. 340 ifk$="[157]"then430
  34. 350 ifk$=""then470
  35. 360 ifk$="[145]"then510
  36. 370 ifk$=" "then550
  37. 380 goto630
  38. 390 ifch=asthenpokep,n1
  39. 400 p=p+n1:ifpeek(p-cd)=spthenp=p-ft
  40. 410 m$="[157]":ifpeek(203)=sbthench=peek(p-cd):goto550
  41. 420 goto270
  42. 430 ifch=asthenpokep,n1
  43. 440 p=p-n1:ifpeek(p-cd)=spthenp=p+ft
  44. 450 m$="":ifpeek(203)=sbthench=peek(p-cd):goto550
  45. 460 goto270
  46. 470 ifch=asthenpokep,n1
  47. 480 p=p+fy:ifpeek(p-cd)=spthenp=p-sh
  48. 490 m$="[145]":ifpeek(203)=sbthench=peek(p-cd):goto550
  49. 500 goto270
  50. 510 ifch=asthenpokep,n1
  51. 520 p=p-fy:ifpeek(p-cd)=spthenp=p+sh
  52. 530 m$="":ifpeek(203)=sbthench=peek(p-cd):goto550
  53. 540 goto270
  54. 550 pokep-cd,rs:pokep,cc(n)
  55. 560 fortt=1to100:next
  56. 570 ch=peek(p-cd):ifpeek(203)<>sbthen270
  57. 580 ifm$="[145]"thenm$="":goto470
  58. 590 ifm$=""thenm$="":goto510
  59. 600 ifm$=""thenm$="":goto430
  60. 610 ifm$="[157]"thenm$="":goto390
  61. 620 goto270
  62. 630 fk=abs(asc(k$+chr$(0))-132):on(k$>"[129]"andk$<"[137]")+1goto680
  63. 640 cc(fk)=cc(fk)+1:ifcc(fk)=16thencc(fk)=0
  64. 650 pokex(fk),cc(fk)
  65. 660 iffk=1thenpokes1,cc(fk)
  66. 670 iffk=2thenpokes2,cc(fk)
  67. 680 ifk$>"0"andk$<"5"thenpokex(n)-cd,81:n=val(k$):cc=cc(n):fc=0:pokex(n)-cd,rs
  68. 690 ifk$="[216]"thengosub1000
  69. 700 ifk$="[208]"thengosub2000
  70. 710 ifk$=""thengosub3000
  71. 720 ifk$="[147]"thengosub5000
  72. 730 ifk$="[211]"thengosub6000
  73. 740 ifk$="[204]"thengosub7000
  74. 750 ifk$="[205]"thengosub8000
  75. 760 ifk$="[209]"thenpoke808,237:end
  76. 770 goto270
  77. 1000 forvv=cmtoecstepfy:forhh=0tofr:cp=vv+hh
  78. 1010 if(peek(cp)andft)=cc(n1)thenpokecp,cc(n2)
  79. 1020 next:next:return
  80. 2000 nn=1:printml$;:input"    title ";pt$:pt$=left$(pt$,16)
  81. 2010 open4,4:print#4,chr$(27)chr$(66)chr$(2)
  82. 2020 print#4,chr$(27)chr$(87)chr$(1)
  83. 2030 print#4,chr$(27)chr$(51)chr$(23)
  84. 2040 print#4,pt$:print#4,"                    "pl$(0)"-"pc$(0)
  85. 2050 forml=cmtoecstep40:forby=mltoml+fr
  86. 2060 print#4,pl$(peek(by)andft);:next:print#4,"     ";pl$(nn)"-"pc$(nn)
  87. 2070 nn=nn+n1:next
  88. 2080 print#4,chr$(27)chr$(64)
  89. 2090 print#4:close4
  90. 2100 print"                          [181][155]"
  91. 2110 return
  92. 3000 ifpeek(p-cd)=asthenpokep,n1:
  93. 3010 p=cm:return
  94. 4000 s=1:open2,8,2,"#"
  95. 4010 print#15,"u1:"2;0;18;s:input#15,e:ife>0thenclose2:return
  96. 4020 printdl$:foren=1to8
  97. 4030 get#2,tt$,ss$,pt$,l1$,l2$:ifen=1thentl=asc(tt$+chr$(0)):s=asc(ss$+chr$(0))
  98. 4040 ifasc(pt$+chr$(0))<>129thenforby=1to27:get#2,ch$:next:goto4120
  99. 4050 get#2,i1$,i2$:id$=i1$+i2$
  100. 4060 ifid$<>"n."thenforby=1to25:get#2,ch$:next:goto4120
  101. 4070 forby=1to8:get#2,ch$:printtab(30)ch$;:next
  102. 4080 ifasc(ch$+chr$(0))<>32thenprint"-"
  103. 4090 ifasc(ch$+chr$(0))=32thenforby=1to6:get#2,ch$:next:print:print:goto4110
  104. 4100 forby=1to6:get#2,ch$:printtab(30)ch$;:next:print
  105. 4110 forby=1to11:get#2,ch$:next
  106. 4120 next
  107. 4130 printtab(30)"hit a key[155]";:wait198,1:poke198,0:gosub4200
  108. 4140 iftl>0thengoto4010
  109. 4150 close2:close15:return
  110. 4200 printdl$:forer=1to17:printtab(30)"         ":next:return
  111. 5000 printml$"             erase? (y/n)[155]"
  112. 5010 wait198,1:getan$:ifan$<>"y"then5040
  113. 5020 forml=cmtoecstepfy:forer=mltoml+fr
  114. 5030 pokeer,n1:pokeer-cd,as:next:next:p=cm
  115. 5040 print"                          [181][155]"
  116. 5050 return
  117. 6000 input"filename";sf$:sf$=left$(sf$,14):sf$="n."+sf$
  118. 6010 pokep-cd,160:open15,8,15,"i"
  119. 6020 open8,8,8,sf$+",s,w":input#15,e
  120. 6030 ife=63thenclose8:gosub6100:on(rf+1)goto6020,6080
  121. 6040 ife<>0thenprintml$tab(12)"   disk error   [155]":fortt=1to3000:next:goto6080
  122. 6050 forml=cmtoecstepfy:forby=mltoml+fr:by$=str$(peek(by)andft)
  123. 6060 fc$=right$(by$,len(by$)-1)
  124. 6070 print#8,fc$:next:next
  125. 6080 close8:close15:print"                          [181][155]"
  126. 6090 return
  127. 6100 rf=0:printml$"            replace? (y/n)[155]"
  128. 6110 getan$:ifan$<>"y"andan$<>"n"then6110
  129. 6120 ifan$="n"thenrf=1:return
  130. 6130 printml$" o.k., replacing [155]"
  131. 6135 print#15,"s0:"+sf$
  132. 6140 return
  133. 7000 input"filename";sf$:sf$=left$(sf$,14):sf$="n."+sf$
  134. 7010 open15,8,15,"i":ifmid$(sf$,3,1)="$"thengosub4000:one+1goto7060:goto7030
  135. 7020 open8,8,8,sf$+"*,s,r":input#15,e
  136. 7030 ife<>0thenprintml$tab(12)"   disk error   [155]":fortt=1to2999:next:goto7060
  137. 7040 forml=cmtoecstepfy:forby=mltoml+fr:input#8,fc$:fc=val(fc$)
  138. 7050 pokeby-cd,rs:pokeby,fc:next:next
  139. 7060 close8:close15:print"                          [181][155]"
  140. 7070 return
  141. 8000 getsh$:ifsh$=""then8000
  142. 8010 ifsh$<>""andsh$<>"[157]"andsh$<>""andsh$<>"[145]"thenreturn
  143. 8020 ifsh$=""thengosub8100:goto8000
  144. 8030 ifsh$="[157]"thengosub8200:goto8000
  145. 8040 ifsh$=""thengosub8300:goto8000
  146. 8050 ifsh$="[145]"thengosub8400:goto8000
  147. 8100 forvv=cmtoecstepfy:forhh=vv+frtovvstep-n1
  148. 8110 ifhh=vv+frthenpp=peek(hh)andft
  149. 8120 ifhh=vvthenpokehh,pp:goto8140
  150. 8130 pokehh,peek(hh-n1)andft
  151. 8140 next:next:return
  152. 8200 forvv=cmtoecstepfy:forhh=vvtovv+fr
  153. 8210 ifhh=vvthenpp=peek(hh)andft
  154. 8220 ifhh=vv+frthenpokehh,pp:goto8140
  155. 8230 pokehh,peek(hh+n1)andft
  156. 8240 next:next:return
  157. 8300 forhh=cmtocm+fr:forvv=hh+fstohhstep-fy
  158. 8310 ifvv=hh+fsthenpp=peek(vv)andft
  159. 8320 ifvv=hhthenpokevv,pp:goto8340
  160. 8330 pokevv,peek(vv-fy)andft
  161. 8340 next:next:return
  162. 8400 forhh=cmtocm+fr:forvv=hhtohh+fsstepfy
  163. 8410 ifvv=hhthenpp=peek(vv)andft
  164. 8420 ifvv=hh+fsthenpokevv,pp:goto8340
  165. 8430 pokevv,peek(vv+fy)andft
  166. 8440 next:next:return
  167. 9000 data k,black,w,white,r,red,c,cyan,v,violet,g,green,b,blue,y,yellow
  168. 9010 data o,orange,t,tan,p,pink,1,dk. gray,2,med. gray,l,lime,s,sky blue
  169. 9020 data 3,lt. gray
  170.