home *** CD-ROM | disk | FTP | other *** search
/ Amiga Elysian Archive / AmigaElysianArchive.iso / games / classic / klondike.lzh / Canfield.bas < prev    next >
BASIC Source File  |  1986-09-15  |  15KB  |  326 lines
  1. 1     ' CANFIELD SOLITAIR by David Addison  ©1986
  2. 2     ' This program is in the Public Domain
  3. 3     '
  4. 4     '
  5. 5     clr:SCREEN 1,3:scnclr:graphic 1
  6. 8     PRINT :PRINT  SPC(23);"******  CANFIELD  SOLITAIR  ******":PRINT :PRINT  SPC(23);"        by   David Addison"
  7. 10    PRINT :PRINT :PRINT :PRINT  SPC(8);"   Click directly on card to put in Foundation, above or below"
  8. 11    PRINT  SPC(8);"will pick cards up.  If card can't be played on Foundation the"
  9. 12    PRINT  SPC(8);"cards will be picked up."
  10. 13    PRINT :PRINT  SPC(8);"   Click on back of card in lower left corner to draw from deck."
  11. 14    ?:? spc(8);"   Cards in the foundations wraparound. EX:(J,Q,K,A,2,3,etc.)"
  12. 15    ?:? spc(8);"   Holes will be filled by the stock.  When stock is gone then":? spc(8);"you may fill holes with any card from the talon."
  13. 16    ?:? spc(8);"   You may play the cards in the stock, just as you would from":? spc(8);"the talon."
  14. 17    ?:?:? spc(24);"******  PLEASE   STANDBY  ******":gosub 28000
  15. 18    sleep(5*10^6):RESTORE:GOTO 1110
  16. 20    WAVE 256,timbre1%():FOR az=0 TO 64 STEP 20:qq=SOUND(1,1,1,az,800):qq=SOUND(2,1,1,az,500):NEXT az:REM **** DRAW CARD ****
  17. 23    c=va:ON su GOTO 36,46,24,28
  18. 24    gshape(x,y),diamond%():pena 6:GOTO 56
  19. 28    gshape(x,y),heart%():pena 6:GOTO 56
  20. 36    gshape(x,y),spade%():pena 4:GOTO 56
  21. 46    gshape(x,y),club%():pena 4
  22. 56    PRINT  at(x+2,y+9);MID$(c$,c,1):PRINT  at(x+51,y+45);MID$(c$,c,1):GOSUB 15000:RETURN
  23. 70    su=INT(num/100)
  24. 80    va=num-100*su
  25. 90    RETURN
  26. 100   IF hf=1 THEN GOSUB 1480:RETURN
  27. 110   IF left=0 THEN RETURN  
  28. 111   IF in>51 THEN GOSUB 1490:GOSUB 130
  29. 112   FOR i=1 TO 3
  30. 114   IF in>51 AND i>1 THEN 122
  31. 115   IF in>51 AND i=1 THEN GOSUB 1490:GOSUB 130:GOTO 112
  32. 116   IF d(in)=0 THEN in=in+1:GOTO 114
  33. 118   od(in(1),0)=d(in):od(in(1),1)=in:in(1)=in(1)+1:in=in+1
  34. 119   x=x(1):y=(in(1)*4)-2:let num=od(in(1)-1,0):gosub 70:gosub 20
  35. 120   NEXT i
  36. 122   if i<3 then x=x(1):y=(in(1)*4)-2:LET num=od(in(1)-1,0):GOSUB 70:GOSUB 20
  37. 123   if i<4 or (in=4 and in=52) then pena 0:peno 5:x=x(0):y=141:box(x,y;x+60,y+44),1
  38. 124   RETURN
  39. 130   gshape(x(0),139),back%()
  40. 135   FOR j=0 TO 33:FOR az=0 TO 1:od(j,az)=0:NEXT az:NEXT j:in=17:in(1)=0:RETURN
  41. 150   '
  42. 188   REM
  43. 189   REM if cu<7 then ? at(13,17);chr$(left(cu));
  44. 190   RETURN
  45. 280   IF hf=1 THEN GOSUB 1480:RETURN
  46. 290   st=cu
  47. 300   IF in(cu)=0 THEN GOSUB 1510:RETURN
  48. 310   IF cu=1 THEN LET num=od(in(1)-1,0):GOTO 330
  49. 320   LET num=c(cu,0)
  50. 330   hf=1
  51. 335   if cu=8 then j=44:goto 350
  52. 340   IF cu=1 THEN 390
  53. 341   j=y(in(cu)-1)+52
  54. 350   FOR i=y(0)+j TO y(0) STEP -4:gshape(x(cu),i),blank%():NEXT i:GOSUB 150
  55. 390   IF cu=1 THEN FOR i=(in(1)*4)+56 TO (in(1)*4)-4 STEP -4:gshape(x(1),i),blank%():NEXT i
  56. 391   IF cu=8 THEN gosub 27500:GOTO 394
  57. 392   j=0:IF cu=1 THEN IF in(1)-1>0 THEN LET num=od(in(1)-2,0):GOSUB 70:x=x(1):y=((in(1)-1)*4)-2:GOSUB 20:GOTO 400
  58. 394   IF cu=8 THEN sleep(.2*10^6):LET num=c(8,in(8)-2):GOSUB 70:x=x(8):y=y(2):GOSUB 20:GOTO 400
  59. 395   FOR i=y(j)+52 TO y(j) STEP -4:gshape(x(cu),i),blank%():NEXT i:GOTO 399
  60. 399   '
  61. 400   GOSUB 14000:RETURN
  62. 410   IF hf=0 THEN GOSUB 1520:RETURN
  63. 420   IF cu=1 THEN GOSUB 590:RETURN
  64. 425   IF cu=8 THEN GOSUB 625:RETURN
  65. 430   IF st=cu THEN GOSUB 750:RETURN
  66. 440   IF in(cu)=0 THEN GOSUB 630:RETURN
  67. 450   LET num=c(cu,in(cu)-1)
  68. 460   GOSUB 70:ts=su:tv=va
  69. 470   IF st=1 THEN LET num=od(in(1)-1,0):GOTO 490
  70. 475   IF st=8 THEN LET num=c(st,in(st)-1):GOTO 490
  71. 480   LET num=c(st,0)
  72. 490   GOSUB 70:IF ((ts=1) OR (ts=2)) AND ((su=1) OR (su=2)) THEN GOSUB 1530:RETURN
  73. 500   IF ((ts=3) OR (ts=4)) AND ((su=3) OR (su=4)) THEN GOSUB 1540:RETURN
  74. 510   IF tv<>va+1 THEN GOSUB 1550:RETURN
  75. 520   IF st=1 THEN GOSUB 700:RETURN
  76. 525   IF st=8 THEN GOSUB 712:RETURN
  77. 530   GOSUB 25100:FOR i=0 TO in(st)-1:LET num=c(st,i):c(cu,in(cu))=num:GOSUB 70:x=x(cu):y=y(in(cu))+y(left(cu))+2
  78. 535   in(cu)=in(cu)+1:GOSUB 150:GOSUB 20
  79. 540   c(st,i)=0:NEXT i:in(st)=0:hf=0
  80. 550   IF in(8)=0 THEN RETURN
  81. 555   IF in(8)-2<0 THEN FOR i=y(2)+44 TO y(2) STEP -4:gshape(x(8),i),blank%():NEXT i:GOTO 565
  82. 560   LET num=c(8,in(8)-2):GOSUB 70:x=x(8):y=y(2):GOSUB 20
  83. 565   LET num=c(8,in(8)-1):GOSUB 70:x=x(st):y=y(0):GOSUB 20:in(st)=0:c(st,in(st))=num:in(st)=1
  84. 570   in(8)=in(8)-1:c(8,in(8))=0:IF in(8)=0 THEN lcu=1
  85. 575   RETURN
  86. 580   IF left=0 THEN RETURN
  87. 581   IF in(1)-2<0 THEN GOSUB 1490:GOSUB 130
  88. 582   IF in(1)-2>0 THEN LET num=od(in(0)-2,0):GOSUB 70:x=x(0):y=(in(1)*4)-2:GOSUB 20
  89. 583   LET num=od(in(1)-1,0):GOSUB 70:x=x(st):y=y(st):GOSUB 20:in(st)=0:c(st,in(st))=num:in(st)=1
  90. 584   in(1)=in(1)-1:d(od(in(1),1))=0:od(in(1),0)=0:od(in(1),1)=0:left=left-1:RETURN      
  91. 590   IF st<>1 THEN GOSUB 1560:RETURN
  92. 600   GOSUB 25100:LET num=od(in(1)-1,0):GOSUB 70:x=x(cu):y=((in(1))*4)-2:GOSUB 20
  93. 610   flag=1:hf=0
  94. 620   RETURN
  95. 625   IF st<>8 THEN GOSUB 1560:RETURN
  96. 628   LET num=c(8,in(8)-1):GOSUB 70:x=x(8):y=y(2):GOSUB 20:hf=0:RETURN  
  97. 630   IF in(8)>0 THEN GOSUB 1560:RETURN
  98. 640   LET num=od(in(1)-1,0)
  99. 650   GOSUB 70
  100. 680   GOSUB 700
  101. 690   RETURN
  102. 700   x=x(cu):y=y(in(cu)):c(cu,in(cu))=num:in(cu)=in(cu)+1:GOSUB 150:GOSUB 20
  103. 710   in(1)=in(1)-1:d(od(in(1),1))=0:od(in(1),0)=0:od(in(1),1)=0:hf=0:left=left-1:RETURN
  104. 712   x=x(cu):y=y(in(cu)):c(cu,in(cu))=num:in(cu)=in(cu)+1:GOSUB 150:GOSUB 20
  105. 714   in(8)=in(8)-1:c(8,in(8))=0:hf=0:IF in(8)=0 THEN lcu=1
  106. 716   RETURN  
  107. 720   IF in>51 THEN x=x(0):y=139:FOR i=y+44 TO y STEP -4:gshape(x,i),blank%():NEXT i:RETURN
  108. 730   IF in(1)>0 THEN LET num=od(in(1)-1,0):GOSUB 70:x=x(1):y=((in(1)-1)*4)-2:GOSUB 20
  109. 740   RETURN
  110. 750   GOSUB 25100:FOR i=0 TO in(cu)-1:LET num=c(cu,i):GOSUB 70:x=x(cu):y=y(i):GOSUB 20:NEXT i
  111. 760   hf=0
  112. 770   RETURN
  113. 780   LET num=od(in(1)-1,0):GOSUB 70:fl=1
  114. 785   IF (fva<>va) AND (f(su,0)=0) THEN RETURN
  115. 786   IF f(su,0)=13 AND va<>1 THEN tv=f(su,0):RETURN
  116. 790   IF f(su,0)<>va-1 AND f(su,0)<>13 AND f(su,0)<>0 THEN tv=f(su,0):RETURN
  117. 795   FOR i=(in(1)*4)+44 TO (in(1)*4)-4 STEP -4:gshape(x(1),i),blank%():NEXT i
  118. 800   GOSUB 980
  119. 810   d(od(in(cu),1))=0:od(in(cu),0)=0:od(in(cu),1)=0:left=left-1
  120. 820   IF in(cu)=0 THEN GOSUB 720:RETURN
  121. 830   if in(1)>0 then let num=od(in(1)-1,0):gosub 70:x=x(1):y=((in(1))*4)-2:gosub 20
  122. 835   GOSUB 150
  123. 840   RETURN
  124. 850   FOR i=y(0)+52 TO y(0) STEP -4:gshape(x(cu),i),blank%():NEXT i:GOTO 875
  125. 855   j=52:FOR i=y(0)+j TO y(0) STEP -4:gshape(x(cu),i),blank%():NEXT i
  126. 860   FOR i=y(2)+54 TO y(2) STEP -4:gshape(x(8),i),blank%():NEXT i
  127. 875   GOSUB 14000
  128. 880   RETURN
  129. 930   IF hf=1 THEN RETURN
  130. 935   fl=0
  131. 940   IF in(cu)=0 AND in(8)>0 THEN GOSUB 1510:RETURN
  132. 950   IF cu=1 THEN GOSUB 780:RETURN
  133. 960   LET num=c(cu,in(cu)-1):GOSUB 70
  134. 965   IF (fva<>va) AND (f(su,0)=0) THEN RETURN
  135. 966   IF f(su,0)=13 AND va<>1 THEN tv=f(su,0):RETURN  
  136. 970   IF f(su,0)<>va-1 AND f(su,0)<>13 AND f(su,0)<>0 THEN tv=f(su,0):RETURN
  137. 980   x=x(2)
  138. 990   IF su=1 THEN y=y1
  139. 1000  IF su=2 THEN y=y2
  140. 1010  IF su=3 THEN y=y3
  141. 1020  IF su=4 THEN y=y4
  142. 1030  GOSUB 20:f(su,0)=va:fdation=1:f(su,1)=f(su,1)+1
  143. 1040  in(cu)=in(cu)-1:IF fl=1 THEN RETURN
  144. 1045  GOSUB 18000
  145. 1050  c(cu,in(cu))=0
  146. 1055  IF cu=8 AND in(cu)=0 THEN GOSUB 860:RETURN 
  147. 1060  IF in(cu)=0 THEN GOSUB 850:RETURN
  148. 1065  IF cu=8 THEN x=x(cu):y=y(2):LET num=c(cu,in(cu)-1):GOSUB 70:GOSUB 20:GOTO 1100
  149. 1070  REM
  150. 1072  FOR i=y(in(cu))+64 TO y(in(cu)) STEP -4:gshape(x(cu),i),blank%()
  151. 1075  NEXT i
  152. 1090  x=x(cu):y=y(in(cu)-1):LET num=c(cu,in(cu)-1):GOSUB 70:GOSUB 20
  153. 1100  RETURN
  154. 1110  DIM c(8,12),p(12),d(51),od(33,1),f(4,1),x(8),y(13),in(8)
  155. 1115  DIM back%(400),spade%(400),club%(400),diamond%(400),heart%(400),blank%(100),box%(1000),tempbox%(1000),left(8):what=4
  156. 1116  DIM quit%(200),regsave%(100),tx$(13):c$="A23456789TJQK"
  157. 1117  RESTORE 1590:FOR i=1 TO 13:READ tx$(i):NEXT i
  158. 1120  GOSUB 20000:GOSUB 20100
  159. 1150  FOR i=0 TO 6:FOR j=0 TO 5:c(i,j)=0:NEXT j:FOR j=6 TO 12:c(i,j)=0:NEXT j:NEXT i
  160. 1160  FOR i=0 TO 33:FOR j=0 TO 1:od(i,j)=0:NEXT j:NEXT i
  161. 1170  FOR i=0 TO 4:FOR j=0 TO 1:f(i,j)=0:NEXT j:NEXT i
  162. 1180  FOR i=0 TO 8:x(i)=i*69:y(i)=(i*10)-2:NEXT i
  163. 1190  FOR i=9 TO 12:y(i)=(i*10)-2:NEXT i
  164. 1200  y1=-2:y2=45:y3=92:y4=139:y(13)=0
  165. 1220  in=0:FOR i=1 TO 4:FOR j=1 TO 13:d(in)=100*i+j:in=in+1:NEXT j:NEXT i
  166. 1230  RANDOMIZE -1:FOR i=51 TO 0 STEP -1:x=int(RND(1)*i)+1:t=d(x):d(x)=d(i):d(i)=t:NEXT i
  167. 1240  in=0:FOR i=0 TO 12:c(8,i)=d(in):d(in)=0:in=in+1:NEXT i:in(8)=13
  168. 1245  found=d(in):LET num=found:GOSUB 70:fva=va:d(in)=0:in=in+1:f(su,1)=1
  169. 1250  FOR i=3 TO 6:c(i,0)=d(in):d(in)=0:in=in+1:NEXT i
  170. 1260  graphic 1
  171. 1290  scnclr:GOSUB 30000
  172. 1300  FOR i=3 TO 6:in(i)=1:NEXT i:in(1)=0:in(8)=13:left=34
  173. 1310  GOSUB 100:lcu=0
  174. 1320  cu=0:oc=0:x=x(cu):hf=0:fdation=0
  175. 1330  IF hf=1 THEN ask MOUSE xpos%,ypos%,b%:GOSUB 25000
  176. 1331  drawmode 1:penb 0:pena 5:locate(576,y2+42):? using "##";in(8):drawmode 0
  177. 1332  IF in(8)=0 THEN lcu=1
  178. 1335  ask MOUSE xpos%,ypos%,b%:IF b%<>4 THEN 1330
  179. 1336  IF xpos%<0 OR ypos%<0 OR xpos%>617 OR ypos%>186 THEN 1330
  180. 1337  cu=INT(xpos%/69):GOSUB 27000
  181. 1338  IF cu=2 OR cu=7 THEN 1330
  182. 1339  if cu=0 and ypos%<139 then 1330
  183. 1340  IF xpos%>207 AND xpos%<262 AND ypos%>168 AND ypos%<185 THEN 1420
  184. 1345  IF hf=1 THEN what=5:GOTO 1400
  185. 1350  IF cu=0 AND ypos%>139 THEN what=3:GOTO 1400
  186. 1352  IF cu<>1 THEN 1360
  187. 1353  IF ypos%>(in(cu)*4) AND ypos%<(in(cu)*4)+44 THEN what=2:GOTO 1400
  188. 1355  IF ypos%<(in(cu)*4) OR ypos%>(in(cu)*4)+44 THEN what=4:GOTO 1400
  189. 1357  GOTO 1330
  190. 1360  if cu<>8 then 1369
  191. 1365  if ypos%>y(2) and ypos%<y(2)+44 then what=2:goto 1400
  192. 1367  if ypos%<y(2) or ypos%>y(2)+44 then what=4:goto 1400
  193. 1368  goto 1330
  194. 1369  if ypos%>y(in(cu)) and ypos%<y(in(cu))+44 then what=2:goto 1400
  195. 1370  IF ypos%<y(in(cu)) OR ypos%>y(in(cu))+44 THEN what=4:GOTO 1400
  196. 1390  GOTO 1330
  197. 1400  IF what=3 THEN GOSUB 100:GOTO 1330
  198. 1402  IF what=4 THEN GOSUB 280:GOTO 1330
  199. 1403  IF what=5 THEN GOSUB 410:GOTO 1330
  200. 1404  IF what=2 THEN GOSUB 930:IF fdation=1 THEN 1620 ELSE what=4:GOTO 1400
  201. 1410  GOTO 1330
  202. 1420  sshape(138,168;618,187),tempbox%():gshape(138,168),box%()
  203. 1425  a$="Do you want to end this hand?  (Y or N)":long=LEN(a$):long=INT(long/2):pena 4:PRINT  at(377-(long*8),180);a$
  204. 1430  GET a$:IF a$="" THEN 1430
  205. 1432  IF INSTR("Yy",a$)>=1 THEN 1440
  206. 1435  IF INSTR("Nn",a$)>=1 THEN 1438
  207. 1436  GOTO 1430
  208. 1438  gshape(138,168),tempbox%():GOTO 1335
  209. 1440  gshape(138,168),box%():a$="Play another Hand?  (Y or N)":long=LEN(a$):long=INT(long/2):pena 4:PRINT  at(377-(long*8),180);a$
  210. 1442  GET a$:IF a$="" THEN 1442
  211. 1444  IF INSTR("Yy",a$)>=1 THEN scnclr:GOTO 1150
  212. 1446  IF INSTR("Nn",a$)>=1 THEN SYSTEM
  213. 1448  GOTO 1442
  214. 1450  END
  215. 1460  GOSUB 150
  216. 1470  RETURN
  217. 1480  a$="YOU'VE ALREADY PICKED UP A CARD":GOSUB 16000:GOTO 1610
  218. 1490  a$="I AM TURNING THE TALON OVER !":pena 0:peno 5:x=x(0):y=141:box(x,y;x+60,y+44),1:GOSUB 16000
  219. 1495  for i=139+46 to y(0) step -4:gshape(x(1),i),blank%():next i:goto 1610
  220. 1510  a$="THERE ARE NO CARDS HERE TO PICK UP":GOSUB 16000:GOTO 1610
  221. 1520  a$="YOU DO NOT HAVE ANY CARDS TO DROP":GOSUB 16000:GOTO 1610
  222. 1530  a$="YOU CAN'T PLAY BLACK ON BLACK":GOSUB 16000:GOTO 1610
  223. 1540  a$="YOU CAN'T PLAY RED ON RED":GOSUB 16000:GOTO 1610
  224. 1550  a$="YOU CAN'T DROP A"+tx$(va)+" ON A"+tx$(tv):GOSUB 16000:GOTO 1610
  225. 1560  a$="YOU CAN'T DROP CARDS HERE":GOSUB 16000:GOTO 1610
  226. 1570  a$="YOU CAN ONLY DROP A KING HERE":GOSUB 16000:GOTO 1610
  227. 1580  a$="START YOUR FOUNDATION WITH A"+tx$(fva):GOSUB 16000:GOTO 1610
  228. 1590  DATA "N  ACE"," TWO"," THREE"," FOUR"," FIVE"," SIX"," SEVEN","N EIGHT"," NINE"," TEN"," JACK"," QUEEN"," KING"
  229. 1610  REM
  230. 1615  RETURN
  231. 1620  IF f(1,1)<13 OR f(2,1)<13 OR f(3,1)<13 OR f(4,1)<13 THEN fdation=0:GOTO 1330
  232. 1630  sshape(138,168;618,187),tempbox%():gshape(138,168),box%()
  233. 1640  a$="***  YOU WIN !!  Care to play again? (Y/N)  ***":long=LEN(a$):long=INT(long/2):pena 4:PRINT  at(377-(long*8),180);a$
  234. 1650  GET a$:IF a$="" THEN 1650
  235. 1655  IF INSTR("Yy",a$)>0 THEN 1700
  236. 1660  IF INSTR("Nn",a$)>0 THEN 1800
  237. 1670  GOTO 1650
  238. 1700  scnclr:GOTO 1150
  239. 1800  SYSTEM
  240. 11000 RETURN
  241. 13000 TIME=40000
  242. 13005 SLEEP(TIME)
  243. 13010 RETURN
  244. 14000 TIME=90000:GOTO 13005
  245. 15000 TIME=70000:GOTO 13005
  246. 16000 long=LEN(a$):long=INT(long/2)
  247. 16010 sshape(138,168;618,187),tempbox%()
  248. 16020 gshape(138,168),box%()
  249. 16030 pena 4:PRINT at(377-(long*8),180);a$
  250. 16040 SLEEP(2*10^6)
  251. 16050 gshape(138,168),tempbox%()
  252. 16090 RETURN
  253. 18000 IF in(cu)<>0 THEN RETURN
  254. 18010 in(cu)=0
  255. 18050 IF in(8)=0 THEN RETURN
  256. 18055 IF in(8)-2<0 THEN FOR i=y(2)+44 TO y(2) STEP -4:gshape(x(8),i),blank%():NEXT i:GOTO 18065
  257. 18060 LET num=c(8,in(8)-2):GOSUB 70:x=x(8):y=y(2):GOSUB 20
  258. 18065 LET num=c(8,in(8)-1):c(cu,in(cu))=num:in(cu)=1
  259. 18070 in(8)=in(8)-1:c(8,in(8))=0:IF in(8)=0 THEN lcu=1
  260. 18075 RETURN
  261. 18080 IF left=0 THEN RETURN
  262. 18081 IF in(0)-2=0 THEN GOSUB 1490:GOSUB 130
  263. 18082 IF in(0)-2>0 THEN LET num=od(in(0)-2,0):GOSUB 70:x=x(0):y=(in(0)*4)-2:GOSUB 20
  264. 18083 LET num=od(in(0)-1,0):c(cu,in(cu))=num:in(cu)=1
  265. 18084 in(0)=in(0)-1:d(od(in(0),1))=0:od(in(0),0)=0:od(in(0),1)=0:left=left-1:RETURN
  266. 20000 bload "heart_dat",VARPTR(regsave%(0))
  267. 20010 ct=0:FOR i%=0 TO 31
  268. 20020 rgb i%,regsave%(ct),regsave%(ct+1),regsave%(ct+2)
  269. 20030 ct=ct+3:NEXT i%
  270. 20040 RETURN
  271. 20100 bload "heart",VARPTR(heart%(0))
  272. 20110 bload "diamond",VARPTR(diamond%(0))
  273. 20120 bload "club",VARPTR(club%(0))
  274. 20130 bload "spade",VARPTR(spade%(0))
  275. 20140 bload "blank",VARPTR(blank%(0))
  276. 20150 bload "back",VARPTR(back%(0))
  277. 20160 bload "box",VARPTR(box%(0))
  278. 20170 bload "quit",VARPTR(quit%(0))
  279. 20190 RETURN
  280. 25000 REM *** shadow box ***
  281. 25010 drawmode 2
  282. 25020 x2%=xpos%:y2%=ypos%
  283. 25030 box(x2%-30,y2%;x2%+30,y2%+44)
  284. 25040 ask MOUSE x%,y%,b%
  285. 25050 IF b%<>0 THEN box(x2%-30,y2%;x2%+30,y2%+44):xpos%=x2%:ypos%=y2%:drawmode 0:RETURN
  286. 25060 IF x%=x2% AND y%=y2% THEN 25040
  287. 25070 box(x2%-30,y2%;x2%+30,y2%+44)
  288. 25080 x2%=x%:y2%=y%
  289. 25090 box(x2%-30,y2%;x2%+30,y2%+44)
  290. 25095 GOTO 25040
  291. 25100 RETURN:drawmode 2:box(oldxpos%,oldypos%;oldxpos%+43,oldypos%+59)
  292. 25110 drawmode 0:RETURN
  293. 27000 RETURN
  294. 27500 wave 256,timbre%()
  295. 27510 for i=3 to 0 step -1:gshape(x(8),y(2)),back%():qq=sound(1,1,1,64,(i+1)*1000):qq=sound(2,1,1,64,(i+1)*1000):next i
  296. 27520 return
  297. 28000 DIM timbre%(255),timbre1%(255):k#=2*3.14159265#/256
  298. 28010 FOR i=0 TO 255
  299. 28020 timbre%(i)=31*(SIN(i*k#)+SIN(2*i*k#)+SIN(4*i*k#)+SIN(4*i*k#))
  300. 28030 NEXT i
  301. 28040 FOR i=0 TO 255
  302. 28050 timbre1%(i)=-127+(RND(1)*255)
  303. 28060 NEXT i
  304. 28070 WAVE 256,timbre1%()
  305. 28080 audio 15,1
  306. 28090 RETURN
  307. 30000 gshape(0,139),back%():peno 5:box(x(2),0;x(2)+59,0+44),0:box(x(2),47;x(2)+59,47+44),0:box(x(2),94;x(2)+59,94+44),0
  308. 30010 box(x(2),141;x(2)+59,141+44),0
  309. 30020 FOR i=3 TO 6
  310. 30030 xx%=x(i):yy%=y(0)+2:GOSUB 32000
  311. 30070 LET num=c(i,0):GOSUB 70:x=x(i):y=y(0):GOSUB 20
  312. 30080 NEXT i
  313. 30082 xx%=x(8):yy%=y(2)+2:GOSUB 32000
  314. 30084 LET num=c(8,in(8)-1):GOSUB 70:x=x(8):y=y(2):GOSUB 20
  315. 30085 pena 6:PRINT  at(560,y2+32);"STOCK"
  316. 30090 pena 7:FOR i=0 TO 3:PRINT  at(x(2)+27,24+(i*47));MID$(c$,fva,1):NEXT i
  317. 30100 LET num=found:GOSUB 70:fl=1:GOSUB 980:fl=0
  318. 30200 gshape(207,168),quit%():RETURN
  319. 32000 peno 4:drawmode 2:ystep=139-yy%:xstep=xx%/10
  320. 32010 ystep=INT(ystep/xstep)+2:y=139
  321. 32020 FOR x=5 TO xx% STEP 20:y=y-ystep
  322. 32030 box(x,y;x+59,y+43),0
  323. 32050 box(x,y;x+59,y+43),0
  324. 32060 NEXT x
  325. 32090 drawmode 0:RETURN
  326.