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