home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload / ShartewareOverload.cdr / games / basic-1.zip / RUBIK.BAS < prev    next >
BASIC Source File  |  1984-05-11  |  13KB  |  399 lines
  1. 7 ' Source:  Printed copy offered in
  2. 8 '          PC Magazine, Vol. 1, No. 2, pp. 85-87
  3. 9 ' (all comments omitted)
  4. 10 '                          RUBIK'S CUBE SIMULATOR
  5. 20 '                                 PC MAGAZINE
  6. 30 '                                 march, 1982
  7. 40 '                                 karl koessel
  8. 50 SCREEN 0,1,0,0
  9. 60 COLOR 7,0,1
  10. 70 CLS
  11. 80 KEY OFF
  12. 90 CLEAR,,2000
  13. 100 DEFINT A-Z
  14. 110 DIM HOLD(20)
  15. 120 GOSUB 3240
  16. 130 GOSUB 3620
  17. 140 GOSUB 3680
  18. 150 GOSUB 3770
  19. 160 GOSUB 600
  20. 190 GOSUB 2760
  21. 200 COLOR 23
  22. 210 PRINT "Enter ";
  23. 220 COLOR 7
  24. 230 INPUT "a twist or command: ",TWIST$
  25. 240 IF TWIST$="" THEN 190
  26. 250 GOSUB 1860
  27. 260 REQ$=TWIST$
  28. 270 GOSUB 820
  29. 280 IF D THEN 190
  30. 290 GOSUB 910
  31. 300 GOTO 190
  32. 320 GOSUB 2760
  33. 330 PRINT "Press [RETURN] to twist the ";
  34. 340 IF CLRMON THEN COLOR BR(F) ELSE COLOR 1
  35. 350 PRINT PLACE$(1,F);
  36. 360 COLOR 7
  37. 370 PRINT " face ";
  38. 380 IF CLRMON THEN COLOR BR(F) ELSE COLOR 1
  39. 390 PRINT DIRECTION$(OSO)
  40. 400 COLOR 7
  41. 410 IF CLRMON AND BIG THEN 430
  42. 420 PRINT SPC(13)
  43. 430 PRINT "or enter a new twist or command: ";
  44. 440 INPUT "",GO$
  45. 450 GOSUB 1860
  46. 460 IF GO$="" THEN 530
  47. 470 REQ$=,GO$
  48. 480 GOSUB 820
  49. 490 ON D GOTO 320,320,320,320,510,320,320,320,530
  50. 500 GOSUB 910
  51. 510 RETURN
  52. 530 GOSUB 2360
  53. 540 GOSUB 2520
  54. 550 GOSUB 1900
  55. 560 GOSUB 2000
  56. 570 GOSUB 1590
  57. 580 RETURN
  58. 600 GOSUB 1900
  59. 610 IF CLRMON THEN WIDTH 40:BIG=-1
  60. 620 IF NOT BIG AND D=8 THEN RETURN
  61. 630 GOSUB 2790
  62. 640 IF D<>8 THEN GOSUB 2610
  63. 650 IF NOT BIG THEN 690
  64. 660 GOSUB 3020
  65. 670 CLS
  66. 680 GOSUB 3040
  67. 690 GOSUB 1290
  68. 700 RETURN
  69. 720 RQ$=""
  70. 730 FOR K=1 TO LEN(REQ$)
  71. 740     RK$=MID$(REQ$,K,1)
  72. 750     IF RK$="'" THEN 770
  73. 760     RK$=CHR$((ASC(RK$) AND 95))
  74. 770     RQ$=RQ$+RK$
  75. 780 NEXT
  76. 790 REQ$=RQ$
  77. 800 RETURN
  78. 820 GOSUB 720
  79. 830 D=0
  80. 840 FOR DMI=1 TO 9
  81. 850     IF LEFT$(REQ$,LEN(DM$(DMI)))=DM$(DMI) THEN D=DMI
  82. 860 NEXT
  83. 870 IF D>0 AND D<4 THEN DM=D-1
  84. 880 ON D GOSUB 1590,1590,1590,1380,600,1210,2040,610,1350
  85. 890 RETURN
  86. 910 GOSUB 1900
  87. 930 IF MID$(REQ$,2,1)=""OR MID$(REQ$,2,1)="'"AND LEN(REQ$)<3 THEN 960
  88. 940 GOTO 1020
  89. 960 F=0
  90. 970 FOR W=1 TO LEN(T$)
  91. 980     IF LEFT$(REQ$,1)=MID$(T$,W,1) THEN F=W:TWIST$=REQ$
  92. 990 NEXT
  93. 1000 IF F THEN 1100
  94. 1020 GOSUB 2760
  95. 1030 PRINT "Input ";:COLOR 23:PRINT "NOT";:COLOR 7:PRINT " recognized"
  96. 1040 PRINT "    One moment please..."
  97. 1050 GOSUB 1590
  98. 1060 GOSUB 1860
  99. 1070 RETURN
  100. 1100 IF MID$(REQ$,2,1)="'" THEN OSO=2:OSI=1 ELSE OSO=0:OSI=5
  101. 1120 GOSUB 2200
  102. 1130 GOSUB 2260
  103. 1150 GOSUB 2460
  104. 1170 IF SKIP THEN 530
  105. 1180 GOSUB 1590
  106. 1190 GOTO 320
  107. 1210 IF NOT CLRMON THEN 1330
  108. 1220 BIG=NOT BIG
  109. 1230 IF BIG THEN WIDTH 40:GOTO 1260
  110. 1240 WIDTH 80
  111. 1250 GOSUB 2790
  112. 1260 GOSUB 1290
  113. 1270 RETURN
  114. 1290 IF BIG THEN GOSUB 3060
  115. 1300 GOSUB 1390
  116. 1310 GOSUB 1590
  117. 1320 IF NOT BIG THEN GOSUB 2040
  118. 1330 RETURN
  119. 1350 SKIP=NOT SKIP
  120. 1360 RETURN
  121. 1380 LABEL = NOT LABEL
  122. 1390 FOR FA=1 TO 6
  123. 1400     IF BIG THEN LOCATE XBL(FA),YBL(FA):GOTO 1420
  124. 1410     LOCATE X(FA)+2,Y(FA)-1
  125. 1420     IF NOT LABEL GOTO 1460
  126. 1430     IF CLRMON THEN COLOR BR(FA) ELSE COLOR 1
  127. 1440     PRINT PLACE$(1,FA);
  128. 1450     GOTO 1470
  129. 1460     PRINT SPC(5);
  130. 1470 NEXT
  131. 1480 IF NOT BIG THEN 1570
  132. 1490 FOR XBL=1 TO 2
  133. 1500     LOCATE XBL+4,19-XBL
  134. 1510     IF NOT LABEL THEN GOTO 1540
  135. 1520     COLOR BR(3)
  136. 1530     PRINT "/";
  137. 1540     PRINT " "
  138. 1550 NEXT
  139. 1560 COLOR 7
  140. 1570 RETURN
  141. 1590 DB=1:DUB=0
  142. 1600 IF BIG THEN DB=2
  143. 1610 FOR FA=1 TO 6
  144. 1620 FOR P=0 TO 8
  145. 1630 IF BIG THEN FOR DUB=0 TO 1
  146. 1640     LOCATE X(FA)+XOF(P)*DB+DUB-REL(FA)*BIG,Y(FA)+YOF(P)+RELY(FA)*BIG
  147. 1650     BR=BR(FIX(CUBIE(FA,P,1)\10))
  148. 1660     IF BR THEN COLOR CUBIE(FA,P,2)*-16,BR:GOTO 1680
  149. 1670     IF CUBIE(FA,P,2) THEN COLOR 0,7 ELSE COLOR 7,0
  150. 1680     IF DUB THEN PRINT "  ";:GOTO 1710
  151. 1690     IF DM THEN PRINT USING "\\"; CUBIE$(FA,P,DM);                                         ELSE PRINT USING "**"; CUBIE(FA,P,1);
  152. 1710     ON P+1 GOTO 1730,1720,1720,1800,1800,1800,1740,1740,1730
  153. 1720     ND=1:GOTO 1760
  154. 1730     ND=4:GOTO 1760
  155. 1740     ND=-1:GOTO 1760
  156. 1760     IF BR THEN COLOR BR,BR(FIX(CUBIE(FA,(P+ND) MOD 12,1)\10)) ELSE 1780
  157. 1770     PRINT CHR$(221);:GOTO 1800
  158. 1780     IF CUBIE(FA,P,2)=CUBIE(FA,(P+ND) MOD 12,2) THEN 1790 ELSE COLOR 7,0
  159. 1790     PRINT " ";
  160. 1800 IF BIG THEN NEXT
  161. 1810 NEXT
  162. 1820 NEXT
  163. 1830 COLOR 7,0
  164. 1840 RETURN
  165. 1860 GOSUB 2760
  166. 1870 PRINT "One moment, please..."SPC(79)SPC(39)SPC(21)
  167. 1880 RETURN
  168. 1900 FOR J=1 TO 4
  169. 1910     FOR K=1 TO 3
  170. 1920         CUBIE(FACE(J),((POSITION(J)+K-2) MOD 8)+1,2)=0
  171. 1930     NEXT
  172. 1940 NEXT
  173. 1950 FOR P=1 TO 8
  174. 1960     CUBIE(F,P,2)=0
  175. 1970 NEXT
  176. 1980 RETURN
  177. 2000 TWISTSSOFAR$(AT)=TWISTSSOFAR$(AT)+TWIST$+" "
  178. 2010 IF LEN(TWISTSSOFAR$(AT))>36 THEN AT=AT+1
  179. 2020 IF BIG THEN RETURN
  180. 2040 LOCATE 18,1
  181. 2050 IF BIG THEN PRINT
  182. 2060 COLOR 1
  183. 2070 PRINT TWISTSSOFAR$(0);
  184. 2080 COLOR 7
  185. 2090 PRINT SPC(13)
  186. 2100 FOR K=1 TO AT
  187. 2110     PRINT TWISTSSOFAR$(K);
  188. 2120     IF NOT BIG THEN PRINT TWISTSSOFAR$(K+1);:K=K+1
  189. 2130     PRINT
  190. 2140 NEXT
  191. 2150 IF NOT BIG THEN RETURN
  192. 2160 GOSUB 3020
  193. 2170 GOSUB 1860
  194. 2180 RETURN
  195. 2200 FOR J=1 TO 4
  196. 2210     FACE(J)=VAL(MID$(OC$(F),J*2-1,1))
  197. 2220     POSITION(J)=VAL(MID$(OC$(F),J*2,1))
  198. 2230 NEXT
  199. 2240 RETURN
  200. 2260 FOR J=1 TO 4
  201. 2270     FOR K=1 TO 3
  202. 2290         HOLD((J-1)*3+K)=CUBIE(FACE(J),((POSITION(J)+K-2) MOD 8)+1,1)
  203. 2310         CUBIE(FACE(J),((POSITION(J)+K-2) MOD 8)+1,2)=-1
  204. 2320     NEXT
  205. 2330 NEXT
  206. 2340 RETURN
  207. 2360 FOR J=1 TO 4
  208. 2370     FOR K=1 TO 3
  209. 2380         CUBIE(FACE(((J+OSO) MOD 4)+1),((POSITION(((J+OSO) MOD 4)+1)+K-2)                MOD 8)+1,1)=HOLD((J-1)*3+K)
  210. 2390         FOR DMI=1 TO 2
  211. 2400             CUBIE$(FACE(((J+OSO) MOD 4)+1),((POSITION(((J+OSO) MOD 4)+1)                    +K-2) MOD 8)+1,DMI)=PLACE$(DMI,FIX((HOLD((J-1)*3+K)\10)))
  212. 2410         NEXT
  213. 2420     NEXT
  214. 2430 NEXT
  215. 2440 RETURN
  216. 2460 FOR P=1 TO 8
  217. 2470     HOLD(12+P)=CUBIE(F,P,1)
  218. 2480     CUBIE(F,P,2)=-1
  219. 2490 NEXT
  220. 2500 RETURN
  221. 2520 FOR P=1 TO 8
  222. 2530     CUBIE(F,P,1)=HOLD(13+((P+OSI)MOD 8))
  223. 2540     FOR DMI=1 TO 2
  224. 2550         CUBIE$(F,P,DMI)=PLACE$(DMI,FIX(CUBIE(F,P,1)\10))
  225. 2560     NEXT
  226. 2570 NEXT
  227. 2580 RETURN
  228. 2610 FOR F = 1 TO 6
  229. 2620     FOR P = 0 TO 9
  230. 2630         CUBIE(F,P,1)=F*10+P
  231. 2640         FOR DMI=1 TO 2
  232. 2650             CUBIE$(F,P,DMI)=LEFT$(PLACE$(DMI,F),2)
  233. 2660         NEXT
  234. 2670     NEXT
  235. 2680 NEXT
  236. 2700 FOR K=1 TO AT
  237. 2710     TWISTSSOFAR$(K)=""
  238. 2720 NEXT
  239. 2730 AT=1
  240. 2740 RETURN
  241. 2760 IF BIG THEN LOCATE 19,1 ELSE LOCATE 15,1
  242. 2770 RETURN
  243. 2790 IF BIG THEN COLOR ,4:BG=3 ELSE BG=43
  244. 2800 CLS
  245. 2810 LOCATE 1,1+BG:COLOR 1:PRINT TITLE$
  246. 2820 LOCATE 3,3+BG:COLOR 7:PRINT"Each twist is called by the first"
  247. 2830 LOCATE 4,BG:PRINT"letter of the face you wish to twist:"
  248. 2840 LOCATE 5,BG:COLOR 1:PRINT"U";:COLOR 7:PRINT" for the upper face, ";             :COLOR 1:PRINT"L";:COLOR 7:PRINT" for the left"
  249. 2850 LOCATE 6,BG:PRINT"face, ";:COLOR 1:PRINT"F";:COLOR 7:                           :PRINT" for the front face, ";:COLOR 1:PRINT"R";:COLOR 7:PRINT" for the"
  250. 2860 LOCATE 7,BG:PRINT"right face, ";:COLOR 1:PRINT"B";:COLOR 7                      :PRINT" for the back face and ";:COLOR 1:PRINT"D":COLOR 7
  251. 2870 LOCATE 8,BG:PRINT"for the downward face. The twists will"
  252. 2880 LOCATE 9,BG:PRINT"be clockwise. To make a counterclock-"
  253. 2890 LOCATE 10,BG:PRINT"wise twist, the letter is followed by"
  254. 2900 LOCATE 11,BG:PRINT"a ";:COLOR 1:PRINT"'";:COLOR 7:PRINT" (e.g. ";               :COLOR 1:PRINT"L'";:COLOR 7:PRINT" ). To change the display,"
  255. 2910 LOCATE 12,BG:PRINT"enter either the word ";:COLOR 1:PRINT"Labels";              :COLOR 7:PRINT" or ";:COLOR 1:PRINT"Colors";:COLOR 7
  256. 2920 IF CLRMON THEN LOCATE 12,BG:PRINT"enter the word ";:COLOR 1:PRINT "Big";:                      COLOR 7:PRINT" or ";
  257. 2930 LOCATE 13,BG:PRINT"or ";:COLOR 1:PRINT"Faces";:COLOR 7:PRINT" or ";             :COLOR 1:PRINT"Codes";:COLOR 7:PRINT". Use ";:COLOR 1:PRINT"Skip";:COLOR 7      :PRINT" to resume/"
  258. 2940 LOCATE 14,BG:PRINT"skip verification. Use ";:COLOR 1:PRINT"New";:COLOR 7        :PRINT" to restart."
  259. 2950 IF NOT BIG THEN RETURN
  260. 2960 LOCATE 15,3:PRINT "To accommodate those using television ";
  261. 2970 PRINT "  sets (i.e. confined to WIDTH 40), the ";
  262. 2980 PRINT "  commands ";:COLOR 1:PRINT "List";:COLOR 7:PRINT " & ";:COLOR 1
  263. 2990 PRINT "Help";:COLOR 7:PRINT " have been added."
  264. 3000 RETURN
  265. 3020 LOCATE 25,9:PRINT "Press the spacebar to continue";
  266. 3030 IF INKEY$<>" " THEN 3030
  267. 3040 LOCATE 25,3:COLOR 1,4:PRINT TITLE$;:COLOR 7,0:RETURN
  268. 3060 LOCATE 1,19:COLOR BR(2),,BR(4):PRINT "Twists: ";
  269. 3070 FOR LI=1 TO 2:LOCATE LI,25+LI
  270. 3080     FOR TI=1 TO 3
  271. 3090         FOR DI=0 TO 1
  272. 3100             COLOR BR((LI-1)*3+TI)
  273. 3110             IF DI THEN PU$="!' " ELSE PU$="! "
  274. 3120             PRINT USING PU$;MID$(T$,(LI-1)*3+TI);
  275. 3130         NEXT
  276. 3140     NEXT
  277. 3150 NEXT
  278. 3160 LOCATE 4,31:COLOR BR(6):PRINT "Commands:";
  279. 3170 FOR CM=1 TO 9
  280. 3180     LOCATE 5+CM,35
  281. 3190     COLOR BR(CM MOD 6+1)
  282. 3200     PRINT DM$(CM)
  283. 3210 NEXT
  284. 3220 COLOR 7:RETURN
  285. 3240 FOR FACE=1 TO 6
  286. 3250     READ PLACE$(1,FACE)
  287. 3260 NEXT
  288. 3270 DATA"upper","left","front","right","back","down"
  289. 3280 FOR FACE=1 TO 6
  290. 3290     READ YOURS$(FACE)
  291. 3300 NEXT
  292. 3310 DATA"white","orange","blue","red","green","yellow"
  293. 3320 FOR P=1 TO 8
  294. 3330     READ XOF(P),YOF(P)
  295. 3340 NEXT
  296. 3350 DATA -1,-3,-1,0,-1,3,0,3,1,3,1,0,1,-3,0,-3
  297. 3360 FOR FA=1 TO 6
  298. 3370     READ XBL(FA),YBL(FA)
  299. 3380 NEXT
  300. 3390 DATA 2,4,13,3,4,19,13,19,13,27,17,17
  301. 3400 FOR FA=1 TO 6
  302. 3410     READ REL(FA),RELY(FA)
  303. 3420 NEXT
  304. 3430 DATA 1,2,3,0,3,2,3,4,3,6,5,2
  305. 3440 FOR F=1 TO 6
  306. 3450     READ X(F),Y(F)
  307. 3460 NEXT
  308. 3470 DATA 2,14,6,4,6,14,6,24,6,34,10,14
  309. 3480 FOR F=1 TO 6
  310. 3490     READ OC$(F)
  311. 3500 NEXT
  312. 3510 DATA "21514131","17376753","15476123","13576333","11276543","25354555"
  313. 3520 FOR DMI=1 TO 9
  314. 3530     READ DM$(DMI)
  315. 3540 NEXT
  316. 3550 DATA CODE,FACE,COLOR,LABEL,NEW,BIG,LIST,HELP,SKIP
  317. 3560 DIRECTION$(0)="clockwise":DIRECTION$(2)="counterclockwise"
  318. 3570 T$="ULFRBD"
  319. 3580 TWISTSSOFAR$(0)="The list of twists so far :"
  320. 3590 TITLE$=SPACE$(7)+"RUBIK'S CUBE SIMULATOR"+SPACE$(7)
  321. 3600 RETURN
  322. 3620 DEF SEG=0
  323. 3630 IF (PEEK(&H410) AND &H30)<>&H30 THEN CLRMON=-1
  324. 3640 DM=1
  325. 3650 LABEL=-1
  326. 3660 RETURN
  327. 3680 IF CLRMON THEN COLOR 1,4:WIDTH 40:K=1 ELSE WIDTH 80:K=21
  328. 3690 CLS:LOCATE 3,2+K:PRINT TITLE$
  329. 3700 LOCATE 6,15+K:PRINT"PC MAGAZINE"
  330. 3710 LOCATE ,15+K:COLOR 7:PRINT"march, 1982"
  331. 3720 LOCATE 24,19+K:PRINT"press the spacebar";
  332. 3730 IF INKEY$<>" " THEN 3730
  333. 3740 COLOR 7,0
  334. 3750 RETURN
  335. 3770 CLS
  336. 3780 LOCATE 2,7+K
  337. 3790 K$="*** COLORING THE CUBE ***"
  338. 3810 IF CLRMON THEN 3880
  339. 3830 PRINT K$
  340. 3840 LOCATE 9,K+6
  341. 3850 PRINT"(The name of each color":PRINT SPC(11+K)"should begin with a":
  342. 3860 PRINT SPC(16+K)"different letter.)":GOTO 4080
  343. 3880 FOR L=1 TO 25
  344. 3890     COLOR (L MOD 7)+1
  345. 3900     PRINT MID$(K$,L,1);
  346. 3910 NEXT
  347. 3920 LOCATE 4,4
  348. 3930 FOR C=1 TO 7
  349. 3940     COLOR ,C
  350. 3950     PRINT "     ";
  351. 3960     COLOR C,0
  352. 3970     PRINT "---";C;
  353. 3980     PRINT SPC(10)
  354. 3990 NEXT
  355. 4000 LOCATE 9,1
  356. 4010 COLOR 1,4
  357. 4020 PRINT "Choose each face's color by entering the";
  358. 4030 PRINT "appropriate number from the list above, ";
  359. 4040 COLOR 0,2
  360. 4050 PRINT "or just press [RETURN] for each face and";
  361. 4060 PRINT "the computer will choose the colors.    "
  362. 4080 LOCATE 15,K
  363. 4090 COLOR 23,0:PRINT"Enter";
  364. 4100 COLOR 7:PRINT" a color for each face:"
  365. 4110 PRINT
  366. 4120 FOR FACE = 1 TO 6
  367. 4130     LOCATE FACE+16,15+K:COLOR 0,7:PRINT USING" \    \";PLACE$(1,FACE);
  368. 4140     COLOR 7,0:INPUT;" ";PLACE$(2,FACE)
  369. 4150     IF CLRMON THEN 4190
  370. 4160     IF PLACE$(2,FACE)="" THEN PLACE$(2,FACE)=YOURS$(FACE)
  371. 4170     GOTO 4240
  372. 4190     IF PLACE$(2,FACE)="" THEN BR(FACE)=FACE:GOTO 4220                               ELSE BR(FACE)=VAL(PLACE$(2,FACE))
  373. 4200     IF BR(FACE)<1 OR BR(FACE)>7 THEN LOCATE ,26:PRINT SPC(14):GOTO 4130
  374. 4210     IF ASC(PLACE$(2,FACE))<56 THEN PLACE$(2,FACE)=MID$(PLACE$(2,FACE),2)
  375. 4220     COLOR 7,0:LOCATE ,24:PRINT "= ";
  376. 4230     COLOR 0,BR(FACE):PRINT PLACE$(2,FACE)+"     "
  377. 4240 NEXT
  378. 4260 COLOR 7,0
  379. 4270 LOCATE 15,K:PRINT "*Chosen ";
  380. 4280 LOCATE 9,K
  381. 4290 COLOR 1,4
  382. 4300 PRINT "  Check each face and its chosen color. ";
  383. 4310 COLOR 7,0
  384. 4320 PRINT SPC(79)" ";
  385. 4330 LOCATE 11,K
  386. 4340 COLOR 5,2
  387. 4350 PRINT "Press the spacebar to start over...  or,";
  388. 4360 COLOR ,0
  389. 4370 PRINT SPC(79)" ";
  390. 4380 LOCATE 13,K
  391. 4390 COLOR 4,6
  392. 4400 PRINT "if everything is okay press the `G' key."
  393. 4410 COLOR 7,0
  394. 4420 G$=INKEY$
  395. 4430 IF G$=" " THEN 3770
  396. 4440 IF G$<>"G" AND G$<>"g" THEN 4420
  397. 4450 RETURN
  398. 4460 END
  399.