home *** CD-ROM | disk | FTP | other *** search
/ Loadstar 107 / 107.d81 / quilt (.txt) < prev    next >
Commodore BASIC  |  2022-08-26  |  11KB  |  299 lines
  1. 100 rem copyright maurice jones 1992
  2. 110 poke56,56:poke51,0:clr:dv=peek(186):ifdv<8thendv=8
  3. 120 dimi,x,y,j,k,m,mt,dv,e,j1,k1
  4. 130 sys52480,chr$(13)+"[145][157]",20,20,20,20
  5. 140 printchr$(14);chr$(8):mt=36864:box=mt+15:ce=mt+27:cm=mt:me=cm+48
  6. 150 goto1510
  7. 160 rem choice*
  8. 170 gosub220
  9. 180 fori=1tolen(ch$):ifa$=mid$(ch$,i,1)thenreturn
  10. 190 next:goto170
  11. 200 rem any key-get a$*
  12. 210 x=0:y=24:gosub240:print"[146][159]           please press a key         [145][145][145]"
  13. 220 geta$:ifa$=""then220:return
  14. 230 rem print at*
  15. 240 poke211,x:poke214,y:sys58732:return
  16. 250 rem select squares
  17. 260 x=5:y=3:gosub240:print"[158][146]^":k=1:j=0
  18. 270 ch$=chr$(13)+"[145][157]":gosub170:onigoto280,290,310,330,350
  19. 280 q(m)=4*j+k:print"  ":return
  20. 290 ifj=0then270
  21. 300 print"  ":y=y-3:gosub240:print"[146][158]^":j=j-1:goto270
  22. 310 ifj=6then270
  23. 320 print"  ":y=y+3:gosub240:print"[146][158]^":j=j+1:goto270
  24. 330 ifk=1then270
  25. 340 print"  ":x=x-2:gosub240:print"[146][158]^":k=k-1:goto270
  26. 350 ifk=4then270
  27. 360 print"  ":x=x+2:gosub240:print"[146][158]^":k=k+1:goto270
  28. 370 rem start up
  29. 380 dimq1$(7,4),cl(14),q(16),b$(7,4),x(16),y(16),cc(14)
  30. 390 q1$(2,1)="[163]":q1$(2,2)="[164]":q1$(2,3)="[165]":q1$(2,4)="[166]"
  31. 400 q1$(3,1)="#":q1$(3,2)="$":q1$(3,3)="%":q1$(3,4)="&"
  32. 410 q1$(5,1)="[163]":q1$(5,2)="[164]":q1$(5,3)="[165]":q1$(5,4)="[166]"
  33. 420 q1$(1,1)="'":q1$(1,2)="[146][160]":q1$(1,3)=" ":q1$(1,4)="[160]"
  34. 430 b$(2,1)="[163]'[157][157][160][163]":b$(2,2)="[164][160][157][157]'[164]":b$(2,3)="[160][165][157][157][165]'":b$(2,4)="'[166][157][157][166][160]"
  35. 440 b$(3,1)="#'[157][157] #":b$(3,2)="$ [157][157]'$":b$(3,3)=" %[157][157]%'":b$(3,4)="'&[157][157]& "
  36. 450 b$(5,1)="[163]'[157][157][160][163]":b$(5,2)="[164][160][157][157]'[164]":b$(5,3)="[160][165][157][157][165]'":b$(5,4)="'[166][157][157][166][160]"
  37. 460 b$(1,1)="''[157][157]''":b$(1,2)="[160][160][157][157][160][160]":b$(1,3)="  [157][157]  ":b$(1,4)="[160][160][157][157][160][160]"
  38. 470 fori=1to12:cl(i)=i-1:next:cl(13)=13:cl(14)=14
  39. 480 b $(4,1)=b $(3,1):b $(4,2)=b $(3,2):b $(4,3)=b$(3,3):b $(4,4)=b $(3,4)
  40. 490 b$(6,1)=b$(5,1):b$(6,2)=b$(5,2):b$(6,3)=b$(5,3):b$(6,4)=b$(5,4)
  41. 500 b$(7,1)=b$(5,1):b$(7,2)=b$(5,2):b$(7,3)=b$(5,3):b$(7,4)=b$(5,4)
  42. 510 k=23:fori=1to4:x(i)=k:x(i+4)=k:x(i+8)=k:x(i+12)=k:k=k+2:next
  43. 520 fori=1to4:y(i)=5:next:fori=5to8:y(i)=7:next:    fori=9to12:y(i)=9:next
  44. 530 fori=13to16:y(i)=11:next
  45. 540 deffnj(x)=int((x-1)/4):deffnk(x)=x-4*(int((x-1)/4))
  46. 550 q1$(4,1)=q1$(3,1):q1$(4,2)=q1$(3,2):q1$(4,3)=q1$(3,3):q1$(4,4)=q1$(3,4)
  47. 560 q1$(6,1)=q1$(5,1):q1$(6,2)=q1$(5,2):q1$(6,3)=q1$(5,3):q1$(6,4)=q1$(5,4)
  48. 570 q1$(7,1)=q1$(5,1):q1$(7,2)=q1$(5,2):q1$(7,3)=q1$(5,3):q1$(7,4)=q1$(5,4)
  49. 580 nr(2)=1:nr(3)=3:nr(4)=6
  50. 590 fori=1to14:readcc(i):next
  51. 600 data144,5,28,159,156,30,31,158,129,149,150,151,153,154
  52. 610 rem next 3 lines define a quilt
  53. 620 data4,3,14,14,3,6,2,3,2,9,11,8,7,12,10,2,3,2,5,3,3
  54. 630 fori=1to4:readco(i):next:   fori=1to16:readq(i):next:readnc
  55. 640 forj=0to2:po(j)=co(1):next:po(3)=co(2):po(4)=co(1):po(5)=co(2):po(6)=co(3)
  56. 650 return
  57. 660 rem print possible squares
  58. 670 sysbox,4,12,2,22,32,15:x=4:y=2:gosub240
  59. 680 forj=1tonr(nc)+1:poke646,po(j-1):print""; :fori=1to4:printq1$(j,i);"[146]";
  60. 690 next
  61. 700 y=y+3:gosub240:next
  62. 710 return
  63. 720 rem  colors-move cursor
  64. 730 x=6:y=4:gosub240:print"[158]^":k=1:j=0
  65. 740 ch$=chr$(13)+"[145][157]d"   :gosub170:onigoto750,760,780,800,820,1100
  66. 750 co(m)=cl(2*j+k):print"  ":return
  67. 760 ifj=0then740
  68. 770 print"  ":y=y-3:gosub240:print"^":j=j-1:goto740
  69. 780 ifj=6then740
  70. 790 print"  ":y=y+3:gosub240:print"^":j=j+1:goto740
  71. 800 ifk=1then740
  72. 810 print"  ":x=x-4:gosub240:print"^":k=1:goto740
  73. 820 ifk=2then740
  74. 830 print"  ":x=x+4:gosub240:print"^":k=2:goto740
  75. 840 rem screen
  76. 850 print"[147]":poke53272,31:poke198,0
  77. 860 poke53265,peek(53265)or64:poke53281,15:poke53280,09
  78. 870 sysbox,0,39,0,24,0,08:sysbox,3,13,1,23,32,15:sysbox,3,3,1,23,63,08
  79. 880 sysbox,13,13,1,23,61,08:sysbox,21,32,3,14,32,15:sysbox,21,21,3,14,63,08
  80. 890 sysbox,32,32,3,14,61,08:sysbox,18,35,17,21,32,15:sysbox,18,35,17,17,60,08
  81. 900 sysbox,18,35,21,21,62,08:
  82. 910 poke646,8:x=18:y=17:gosub240:print"[[157]?[157]?[157]?[157]*"
  83. 920 poke646,8:x=35:y=17:gosub240:print"][157]=[157]=[157]=[157]+"
  84. 930 x=03:y=23:gosub240:print"*>>>>>>>>>+"
  85. 940 x=03:y=1:gosub240:poke646,08:print"[<<<<<<<<<]
  86. 950 x[178]21:y[178]3:[141]240:[151]646,08:[153]"[<<<<<<<<<<]
  87. 960 x=21:y=14:gosub240:print"*>>>>>>>>>>+"
  88. 970 return
  89. 980 rem print color squares
  90. 990 x=6:y=3:gosub240:forj=0to 6:fori=1to2:poke646,cl(2*j+i):print"'";:next
  91. 1000 y=y+3:gosub240:next:return
  92. 1010 rem print a block
  93. 1020 poke646,co(1):poke53282,co(2):poke53283,co(3):poke53284,co(4)
  94. 1030 w=0:form1=0to3:forn=0to3:w=w+1:j=fnj(q(w)):k=fnk(q(w))
  95. 1040 ifj<0then1060
  96. 1050 poke646,po(j):print"[146]"  b$(j+1,k);"[146][145]";
  97. 1060 next
  98. 1070 print"[157][157][157][157][157][157][157][157]";:next:print"[145][145]";
  99. 1080 return
  100. 1090 rem a patch on sub250!
  101. 1100 onmgoto740,740,1110,1120
  102. 1110 co(3)=co(2):co(4)=co(2):nc=2:return
  103. 1120 co(4)=co(3):nc=3: m=4:return
  104. 1130 rem draw grid
  105. 1140 poke646,00
  106. 1150 x=23:y=5:gosub240:print"\][][][][157][157][157][157][157][157][157][157]*+*+*+*+[157][157][157][157][157][157][157][157][][][][][157][157][157][157][157][157][157][157]";
  107. 1160 print"*+*+*+*+[157][157][157][157][157][157][157][157][][][][][157][157][157][157][157][157][157][157]";
  108. 1170 print"*+*+*+*+[157][157][157][157][157][157][157][157][][][][][157][157][157][157][157][157][157][157]";
  109. 1180 print"*+*+*+*+[157][157][157][157][157][157][157][157]"; :return
  110. 1190 rem disk directory
  111. 1200 poke53272,21
  112. 1210 print"[158][147]":sysmt+51,"$:"+"q.*",dv:open15,8,15:   gosub1970:ife<20then1230
  113. 1220 print"[158]      drive error":print:print:print"";e;e$;t;s
  114. 1230 close15:gosub210:goto1520
  115. 1240 remsave
  116. 1250 print"[147]":poke53272,23:fori=1to16:ifq(i)<1orq(i)>28then 1330:next
  117. 1260 close15:close3:iff$=""then1262
  118. 1261 print"[147]save as "f$"? (y/n)":sysmt+45,"yn":iff%=1then1268
  119. 1262 print:print"filename: ";:syscm+66,1,13,20:ifw$=""then1520
  120. 1264 f$=w$
  121. 1268 ifleft$(f$,2)<>"q."thenf$="q."+f$
  122. 1269 q9$=f$:close15:open15,dv,15,"s:"+f$:open2,dv,2,q9$+",p,w"
  123. 1270 fori=1to4:print#2,co(i):next:fori=1to16:print#2,q(i):next:print#2,nc
  124. 1280 gosub1970:print"[146][159]
  125. 1290 [139]e[179]20[167]1310:[153]"waitopen"
  126. 1300 [153]:[153]"save failed":[153]:[153]e;e$;t;s:[137]1320
  127. 1310 [153]:[153]"sys     "q9$" saved"
  128. 1320 [160]2:[160]15: [141]210:[137]1520
  129. 1330 [160]2:[160]15:[137]1520
  130. 1340 [143] load
  131. 1350 [158]box,0,39,3,21,102,10:[151]53272,23:[141]3050
  132. 1355 [158]cm[170]42,"i0",dv:[139][197](e$)[167]1359
  133. 1357 ms$[178]"chr$etting directory...":[141]3000:[158]mt[170]6,"$:q.*",dv,53248
  134. 1358 [139]f%[178]0[167]ms$[178]"(NULL)o quilts on this disk":[141]3030:[137]1520
  135. 1359 [139][197](e$)[167]ms$[178]e$:[141]3030:[137]1520
  136. 1360 ms$[178]"(NULL)lease select quilt":[141]3000:[158]cm[170]72,10,29,5,19
  137. 1362 [158]cm[170]3,11,4,11,3,1:[139]f$[178]""[167]1530
  138. 1369 q9$[178]f$:[160]3:[159]3,dv,3,q9$[170]",p,r"
  139. 1370 [129]i[178]1[164]4:[132]3,co(i):[130]:[129]i[178]1[164]16:[132]3,q(i):[130]:[132]3,nc
  140. 1380 [160]3:[158]cm[170]42,"",dv:[139][197](e$)[167]ms$[178]e$:[141]3030:[137]1520
  141. 1410 [137]1450
  142. 1420 [151]53265,[194](53265)[176]64:[151]53281,15:[151]53280,09
  143. 1430 [129]j[178]0[164]2:po(j)[178]co(1):[130]:po(3)[178]co(2):po(4)[178]co(1):po(5)[178]co(2):po(6)[178]co(3)
  144. 1440 [141]850:[137]1860
  145. 1450 [129]i[178]1[164]16:[139]q(i)[179]1[176]q(i)[177]28[167]1470
  146. 1460 [130]: [137]1420
  147. 1470 [153]"     sys    this is not a quilt":[141]210:[137]1520
  148. 1480 [143] instructions
  149. 1490 [151]53272,21:[153][199](14):[158]mt[170]51,"t.instructions",dv
  150. 1500 [151]53272,31:[137]1520
  151. 1510 [141]380
  152. 1520 [151]53265,[194](53265)[175]191:[151]53280,0:[151]53281,0:[151]646,3:[151]198,0
  153. 1530 [153]"load":[151]53272,31:y[178]7:[158]box,0,39,3,21,0,10:[158]box,0,39,0,0,121,8
  154. 1532 [158]box,0,39,1,1,160,10:[158]box,0,39,2,2,120,2
  155. 1534 [153]"def";:[158]ce,1,"(NULL)closeatn (NULL) len left$ (NULL) (NULL) (NULL) (NULL)   (NULL) (NULL) right$ (NULL) (NULL)"
  156. 1536 [158]box,0,39,23,23,160,10:[158]box,0,39,24,24,120,2:[158]box,0,39,22,22,121,8
  157. 1538 [158]ce,23,"len(NULL)(NULL)(NULL)/(NULL)val(NULL)(NULL)(NULL)(NULL) (NULL)(NULL)closemid$(N