home *** CD-ROM | disk | FTP | other *** search
/ Compute! Gazette 1994 March / 1994-03b.d64 / setz! (.txt) < prev    next >
Encoding:
Commodore BASIC  |  1994-01-01  |  8.2 KB  |  219 lines
  1. 0 print"[147][144]":v=53248:pokev+32,15:pokev+33,12:x=rnd(-ti/100):fori=0to5:pokev+i,0
  2. 1 next:fori=832to852:readd:pokei,d:next:pokev+23,7:pokev+29,7:pokev+21,7
  3. 2 data255,255,255,128,0,1,128,0,1,128,0,1,128,0,1,128,0,1,255,255,255
  4. 3 fori=2040to2042:pokei,13:next:fori=39to41:pokev+i,1:next
  5. 4 p=3:q=1:r=2:co$(1)="[158]":co$(2)="":co$(3)=""
  6. 5 deffna(x)=int(p*rnd(q))+q:dime$(32,10),q$(p,p,p,p)
  7. 6 fori=1to9:readd$(i):next:data123,132,213,231,312,321,111,222,333
  8. 7 yq=9:gosub77:print"    please adjust colors as follows:
  9. 8 [153]"           redsys yellow blue
  10. 9 print"[144]    then press any key to continue.
  11. 10 [161]a$:[139]a$[178]""[167]10
  12. 11 [153]"load":yq[178]9:[141]77:[153]"    please wait for these characters
  13. 12 poke211,11:print"[193] [194] [195] [196] [197] [198] [158][199] [200] [201]
  14. 13 [153]"stop  to change to those used in the sets!
  15. 14 poke56334,0:poke1,51:l=14336:fori=8to472:pokei+l,peek(i+v):next
  16. 15 fori=14856to14927:readd:pokei,d:next
  17. 16 data255,195,195,195,195,195,195,255,255,129,129,255,129,129,129,255,255,255
  18. 17 data255,255,255,255,255,255,60,102,195,195,195,195,102,60,60,102,195,255
  19. 18 data195,195,102,60,60,126,255,255,255,255,126,60,24,24,36,36,66,66,129,255
  20. 19 data24,24,36,36,126,66,129,255,24,24,60,60,126,126,255,255
  21. 20 poke1,55:poke56334,1:poke53272,30
  22. 21 gosub79:gosub109
  23. 22 gosub93
  24. 23 y=6:x=2:fori=1top:forj=1to4:yq=y:xq=x:gosub77:foraa=1to4:y(aa)=fna(x):next
  25. 24 pokev+39,0:gosub30:pokev+39,1:x=x+10:print"":next:x=2:y=y+2:next
  26. 25 fortt=1to4:ii=int(9*rnd(q))+q:dd$(tt)=d$(ii):cb$(tt)=d$(ii):next
  27. 26 fori=1to3:forj=1to4:y(j)=val(mid$(cb$(j),i,1)):next:gosub27:next:goto32
  28. 27 x=(int(4*rnd(1)))*10+2:y=(int(3*rnd(1)))*2+6
  29. 28 a$(i)=str$(x)+str$(y):ifa$(i)=a$(i-1)ora$(3)=a$(1)then27
  30. 29 xq=x:yq=y:xl(i)=x-2:yl(i)=y:gosub77
  31. 30 printq$(y(1),y(2),y(3),y(4))
  32. 31 e$(x,y)=str$(y(1))+str$(y(2))+str$(y(3))+str$(y(4)):return
  33. 32 poke53265,27:fori=144to255step2:pokev+1,i:next:pokev+21,0
  34. 33 g=g+m:ifs=0then36
  35. 34 av=int(g/s*10+.5)/10
  36. 35 yq=20:xq=4:gosub77:print"averaging one set every[159]"av"[157] sec.    "
  37. 36 pokev+16,0:x=0:y=6:ti$="000000":poke198,0
  38. 37 ifu=0thenyq=18:xq=4:gosub77:print"press _ if you can't find a set."
  39. 38 ify>10theny=10
  40. 39 ify<6theny=6
  41. 40 ifx<0thenx=0
  42. 41 ifx>30thenx=30
  43. 42 yq=y:xq=x:gosub77:print"*";
  44. 43 geta$:ifa$="_"andu=0thengosub99:goto22
  45. 44 ifa$=" "thenprint"[157] ":goto51
  46. 45 ifa$="_"thengosub75
  47. 46 ifa$=""thenprint"[157] ":y=y+2
  48. 47 ifa$="[145]"thenprint"[157] ":y=y-2
  49. 48 ifa$="[157]"thenprint"[157] ":x=x-10
  50. 49 ifa$=""thenprint"[157] ":x=x+10
  51. 50 m=int(ti/60+.5):yq=16:xq=18:gosub77:print"[159]"m"[144]":goto37
  52. 51 ifx=aathenify=bbthen43
  53. 52 ifx=ccthenify=ddthen43
  54. 53 xx=x*8+36:x1=int(xx/256):x2=xx-x1*256:yy=y*8+55
  55. 54 onu+1goto55,56,57
  56. 55 aa=x:bb=y:pokev,x2:pokev+1,yy:ifx1thenpokev+16,(peek(v+16)or1):goto58
  57. 56 cc=x:dd=y:pokev+2,x2:pokev+3,yy:ifx1thenpokev+16,(peek(v+16)or2):goto58
  58. 57 pokev+4,x2:pokev+5,yy:ifx1thenpokev+16,(peek(v+16)or4)
  59. 58 n=u^2+u+1:pokev+21,n:u=u+1:ca$(u)=e$(x+2,y)
  60. 59 ifu=1thenyq=18:xq=4:gosub77:print" press _ to erase 1 or 2 boxes.   "
  61. 60 ifu<3then43
  62. 61 fori=1to4:forj=1to3:ch$(i)=ch$(i)+mid$(ca$(j),2*i,1):next:next
  63. 62 fori=1to4:forj=1to9:ifch$(i)=d$(j)thenc=c+1
  64. 63 next:next
  65. 64 ifc=4thenyq=16:xq=3:gosub77:print" you found a set in only[159]"m"sec.! "
  66. 65 ifc=4thens=s+1:goto70
  67. 66 yq=16:xq=11:gosub77:print"sorry, not a set!":ns=1
  68. 67 yq=18:xq=4:gosub77:print"     press _ to see a set.      "
  69. 68 geta$:ifa$<>"_"then68
  70. 69 gosub99:ifns=1then72
  71. 70 yq=18:xq=4:gosub77:print"     press _ for new groups.      "
  72. 71 geta$:ifa$<>"_"then71
  73. 72 pokev+21,0:pokev+16,0:fori=39to41:pokev+i,1:next:gosub73:goto22
  74. 73 poke214,16:print:print"                                      "
  75. 74 gosub75:at=at+1:return
  76. 75 aa=0:bb=0:cc=0:dd=0:c=0:u=0
  77. 76 fori=1to4:ch$(i)="":next:pokev+21,0:pokev+16,0:return
  78. 77 poke214,yq:print:poke211,xq:return
  79. 78 print"----------------------------------------":return
  80. 79 yq=9:gosub77:print"       please wait 4 more seconds      "
  81. 80 print:print:print:print"       for the sets to be created.    "
  82. 81 i=q:forj=193to199stepp:fork=qtop:q$(i,k,q,q)=co$(k)+chr$(j)+" "
  83. 82 q$(i,k,q,r)=q$(i,k,q,q)+q$(i,k,q,q)
  84. 83 q$(i,k,q,p)=q$(i,k,q,r)+q$(i,k,q,q):next:i=i+q:next
  85. 84 i=q:forj=194to200stepp:fork=qtop:q$(i,k,r,q)=co$(k)+chr$(j)+" "
  86. 85 q$(i,k,r,r)=q$(i,k,r,q)+q$(i,k,r,q)
  87. 86 q$(i,k,r,p)=q$(i,k,r,r)+q$(i,k,r,q):next:i=i+q:next
  88. 87 i=q:forj=195to201stepp:fork=qtop:q$(i,k,p,q)=co$(k)+chr$(j)+" "
  89. 88 q$(i,k,p,r)=q$(i,k,p,q)+q$(i,k,p,q)
  90. 89 q$(i,k,p,p)=q$(i,k,p,r)+q$(i,k,p,q):next:i=i+q:next
  91. 90 fori=qtop:forj=qtop:fork=qtop:q$(i,j,k,q)=q$(i,j,k,q)+"    ":next:next:next
  92. 91 fori=qtop:forj=qtop:fork=qtop:q$(i,j,k,r)=q$(i,j,k,r)+"  ":next:next:next
  93. 92 return
  94. 93 pokev,158:pokev+1,255:pokev+16,0:pokev+21,1
  95. 94 fori=255to144step-2:pokev+1,i:next
  96. 95 poke53265,124:print"[147][144]        move *[144] with cursor keys.
  97. 96 [153]"   use space bar to box threestop groups.":[153]:[141]78
  98. 97 [151]214,12:[153]:[141]78:yq[178]14:xq[178]13:[141]77:[153]"secs. elapsed:
  99. 98 xq=3:yq=22:gosub77:print"sets found:"s"        [144]attempts:"at:return
  100. 99 pokev+21,0:pokev+16,0:fori=39to41:pokev+i,15:next
  101. 100 i=1:gosub108:pokev,x2:pokev+1,yy:ifx1thenpokev+16,(peek(v+16)or1)
  102. 101 i=2:gosub108:pokev+2,x2:pokev+3,yy:ifx1thenpokev+16,(peek(v+16)or2)
  103. 102 i=3:gosub108:pokev+4,x2:pokev+5,yy:ifx1thenpokev+16,(peek(v+16)or4)
  104. 103 pokev+21,7
  105. 104 ifns=1thenns=0:yq=16:xq=5:gosub77:print"                         ":return
  106. 105 yq=18:xq=4:gosub77:print"     press _ for new groups.      "
  107. 106 geta$:ifa$<>"_"then106
  108. 107 pokev+21,0:fori=39to41:pokev+i,1:next:return
  109. 108 xx=xl(i)*8+36:x1=int(xx/256):x2=xx-x1*256:yy=yl(i)*8+55:return
  110. 109 print"[147]":yq=10:gosub77:print"      press i[144] for instructions or
  111. 110 [153]"        any other key to begin.
  112. 111 geta$:ifa$=""then111
  113. 112 ifa$="i"then114
  114. 113 return
  115. 114 print"[147] your objective: to find a set[144] from 12
  116. 115 [153]" groups of figures as fast as possible.
  117. 116 print" (my objective: to time[144] your efforts!)
  118. 117 [141]214
  119. 118 [153]" a set always contains threestop groups.
  120. 119 print" each group can have 1[144], 2[144] or 3[144] figures.
  121. 120 [153]" the figures look like this:
  122. 121 print"           [193] [194] [195] [196] [197] [198] [199] [200] [201]
  123. 122 [153]"           atn peek len str$ val asc chr$ left$ right$stop
  124. 123 print"[158]           [193] [194] [195] [196] [197] [198] [199] [200] [201][144]
  125. 124 [141]214
  126. 125 [153]" press any key to continue. . .
  127. 126 geta$:ifa$=""then126
  128. 127 print"[147] each group's figures can have up to
  129. 128 [153]" 4stop characteristics:
  130. 129 print" quantity     color     shape     fill[144]
  131. 130 [153]"stop 1, 2, 3      len len syslen     len asc right$     len peek atnstop
  132. 131 print" here are four sets (read horizontally)
  133. 132 [153]" which illustrate each characteristic:
  134. 133 print" quantity: [195]       [195] [195]       [195] [195] [195]
  135. 134 [153]" color:    len       syslen         len
  136. 135 print" shape:    [195]       [198]         [201]
  137. 136 [153]" fill:     len       peek         atnstop":[141]214
  138. 137 [153]" however. . .(press a key)
  139. 138 geta$:ifa$=""then138
  140. 139 print"[147][144] more than one characteristic can vary!
  141. 140 [153]" a set with varying color & quantity:
  142. 141 print"      [195] [195] [195]       [158][195]           [195] [195][144]
  143. 142 [153]" a set with varying shape & fill:
  144. 143 print"      [158][198] [198]         [194] [194]         [199] [199][144]
  145. 144 [153]" a set with varying shape, fill & color:
  146. 145 print"      [200]           [196]           [158][195][144]
  147. 146 [153]" a set with varying shape, fill, color":[153]" and quantity:
  148. 147 print"      [158][196]           [200] [200] [200]       [195] [195][144]
  149. 148 [141]214:[153]" in other words. . .
  150. 149 geta$:ifa$=""then149
  151. 150 print"[147][144] a set's characteristics must[144] be either
  152. 151 [153]" identicalstop or completely differentstop. for
  153. 152 print" example:
  154. 153 [153]" a set can contain 3 red groups,
  155. 154 print" [198] [198]     [198] [198]     [198] [198]
  156. 155 [153]"stop or 1 group each of red, yellow & blue,
  157. 156 print" [198] [198]     [158][198] [198]     [198] [198][144]
  158. 157 [153]" but it cannotstop contain 1 red group &
  159. 158 print" two blue groups!
  160. 159 [153]" asc asc     asc asc     asc ascstop _ an illegalstop set!
  161. 160 gosub214
  162. 161 print"[144] looking at it another way. . .
  163. 162 [161]a$:[139]a$[178]""[167]162
  164. 163 [153]"load for any 2stop groups there is always only
  165. 164 print" 1[144] group which would complete the set.
  166. 165 [141]214
  167. 166 [153]" for these two groups: len len       len len
  168. 167 print"[144]    only [195] [195] [144]completes the set.
  169. 168 [153]" for these two groups: sysleft$         val
  170. 169 print"[144]    only [194] [144]completes the set.
  171. 170 [153]"stop for these two groups: sysval val       right$
  172. 171 print"[144]    only [193] [193] [193] [144]completes the set.
  173. 172 [141]214
  174. 173 [153]" press a key for some example sets. . .
  175. 174 geta$:ifa$=""then174
  176. 175 print"[147] some legal[144] sets (read horizontally):
  177. 176 [153]" right$         right$         right$
  178. 177 print" [198]         [198] [198] [198]     [158][198] [198]
  179. 178 [153]"sys atn atn       asc asc asc     left$
  180. 179 print" [195] [195] [195]     [197] [197] [197]     [199] [199] [199]
  181. 180 [153]"sys left$ left$       val val       peek peek
  182. 181 print"[144] some illegal[144] sets (read horizontally):
  183. 182 [153]" right$         right$         right$
  184. 183 print"[158] [193] [193]       [198] [198] [198]     [201]
  185. 184 [153]" len len len     val val val     chr$ chr$ chr$
  186. 185 print"[158] [199] [199]       [197] [197]       [194] [194]
  187. 186 [153]"stop press any key to continue. . .
  188. 187 geta$:ifa$=""then187
  189. 188 print"[147] you will be picking groups by pressing
  190. 189 [153]" the space barstop. press it now to box
  191. 190 print" this group:  [198] [198] [198][144]
  192. 191 [161]a$:[139]a$[179][177]" "[167]191
  193. 192 [151]v,132:[151]v[170]1,87:[151]v[170]21,1
  194. 193 [141]214
  195. 194 [153]" after you find a set, the computerstop
  196. 195 print" will decide whether it's legal or not.
  197. 196 [141]214
  198. 197 [153]" press istop to repeat instructions or any
  199. 198 print" other key to continue.
  200. 199 [161]a$:[139]a$[178]""[167]199
  201. 200 [151]v[170]21,0
  202. 201 [139]a$[178]"i"[167]114
  203. 202 [153]"loadstop one last note!
  204. 203 gosub214
  205. 204 print"[144] there will always[144] be at least one set
  206. 205 [153]" on-screen! but if you can not find it
  207. 206 print" soon, press _[144] for new groups because
  208. 207 [153]" you are being timed!stop
  209. 208 print" you should be able, with practice, to
  210. 209 [153]" average about open30stop seconds per set.
  211. 210 gosub214
  212. 211 print" press any key to begin setz!
  213. 212 [161]a$:[139]a$[178]""[167]212
  214. 213 [142]
  215. 214 [153]" --------------------------------------
  216. 215 return
  217. 220 rem copyright 1994 - compute publications intl ltd - all rights reserved
  218. 1000 fort=80to130:poke53265,t:ford=1to100:next:next
  219.