Gury's Atari 8-bit Forever Portal - Site dedicated to Atari 8-bit home computers by Bostjan Gorisek (Gury)

Entry name:
Electronic Cubist
Listing 1
5 REM
6 REM
7 REM
10 DIM C(7),F(54),H(54),A$(11),B$(2),BH$(2),M$(28),CHO$(36),TEST$(50),TARGET(3)
20 GRAPHICS 2:SETCOLOR 2,3,2:SETCOLOR 4,3,2:? #6:? #6:? #6;" ELECTRONIC CUBIST":? #6:? #6:? #6;" by"
21 ? #6;" fred coffey"
30 ? "DO YOU WANT INSTRUCTIONS?":? " Using a joystick in port #1, push":? " button for yes, move stick for no:"
40 IF STRIG(0)=0 THEN GOSUB 8000:GOTO 70
42 IF STICK(0)=15 THEN 40
70 CHO$="LDCDRDADLUCURUAUTRCRBRARF+TLCLBLALF-"
110 FOR J=1 TO 54:F(J)=1+INT(J/9.1):NEXT J
130 DATA 8,14,53,102,29,183,41,0
140 FOR J=0 TO 7:READ K:C(J)=K:NEXT J
999 REM
1000 GRAPHICS 10:FOR J=0 TO 7:POKE 704+J,C(J):NEXT J
1005 COUNT=0
1010 FOR FACE=1 TO 54:X=23+(FACE-3*INT(FACE/3-0.1)-1)*5:Y=2+20*INT(FACE/3.0001)+4*INT(FACE/9.0001)
1015 SOUND 0,3*FACE,10,8
1020 IF FACE>27 THEN X=X-17:Y=Y-128
1030 IF FACE>36 THEN X=X+34:Y=Y-64
1040 IF FACE>45 THEN X=X+17:Y=Y-64
1045 COLOR 7
1050 PLOT X,Y:DRAWTO X,Y+16:PLOT X+1,Y:DRAWTO X+1,Y+16:PLOT X+2,Y:DRAWTO X+2,Y+16:PLOT X+3,Y:DRAWTO X+3,Y+16
1060 SOUND 0,0,0,0:NEXT FACE
1110 FOR FACE=1 TO 54:X=23+(FACE-3*INT(FACE/3-0.1)-1)*5:Y=2+20*INT(FACE/3.0001)+4*INT(FACE/9.0001)
1120 IF FACE>27 THEN X=X-17:Y=Y-128
1130 IF FACE>36 THEN X=X+34:Y=Y-64
1140 IF FACE>45 THEN X=X+17:Y=Y-64
1145 J=F(FACE)
1147 COLOR J
1150 PLOT X,Y:DRAWTO X,Y+16:PLOT X+1,Y:DRAWTO X+1,Y+16:PLOT X+2,Y:DRAWTO X+2,Y+16:PLOT X+3,Y:DRAWTO X+3,Y+16
1160 IF STRIG(0)=0 THEN F(FACE)=J:COUNT=COUNT+J:SOUND 0,40,12,15:FOR W=1 TO 30:NEXT W:SOUND 0,0,0,0:GOTO 1190
1170 IF STICK(0)=15 THEN 1160
1180 J=J+1:IF J>6 THEN J=1
1185 GOTO 1147
1190 NEXT FACE
1200 IF COUNT=189 THEN 1210
1202 GRAPHICS 18:? #6:? #6:? #6;"IMPROPER COLOR MIX--":? #6;"MUST HAVE 9 FACES OF EACH COLOR"
1204 FOR COUNT=1 TO 1000:NEXT COUNT:RUN
1210 REM
1230 GOTO 5000
2499 REM
2500 CHOICE=CHOICE+1
2505 SOUND 0,60,12,15:FOR W=1 TO 30:NEXT W:SOUND 0,0,0,0
2510 IF STKVAL<>7 THEN 2600
2520 IF CHOICE<9 OR CHOICE>13 THEN CHOICE=9
2530 GOTO 2900
2600 IF STKVAL<>11 THEN 2700
2610 IF CHOICE<14 OR CHOICE>18 THEN CHOICE=14
2620 GOTO 2900
2700 IF STKVAL<>13 THEN 2800
2710 IF CHOICE>4 THEN CHOICE=1
2720 GOTO 2900
2800 IF CHOICE<5 OR CHOICE>8 THEN CHOICE=5
2900 B$=CHO$(2*CHOICE-1,2*CHOICE)
2910 GOTO 3020
2999 REM
3000 PLRS=0:BH$=B$:CHOICE=0:POKE 77,0
3020 FOR J=1 TO 18:RESTORE 9000+10*J:READ A$:IF A$(1,2)=B$ THEN 3035
3030 NEXT J:? "INVALID COMMAND!":STOP
3035 FOR J=1 TO 9:K=VAL(A$(J+2,J+2)):X=19+5*(K-3*INT((K-1)/3)):Y=72+20*INT((K-1)/3)
3039 SOUND 0,18*(K+1),10,8
3040 COLOR 7:GOSUB 3060:IF STRIG(0)=0 THEN SOUND 0,40,12,15:FOR W=1 TO 30:NEXT W:SOUND 0,0,0,0:GOTO 3105
3041 SOUND 0,0,0,0
3045 COLOR F(K+9):GOSUB 3060:STKVAL=STICK(0):IF STKVAL=14 OR STKVAL=7 OR STKVAL=13 OR STKVAL=11 THEN 2500
3050 NEXT J:GOTO 3035
3060 IF K=0 THEN COLOR F(9)
3061 PLOT X,Y:DRAWTO X+1,Y:DRAWTO X+1,Y+2:DRAWTO X,Y+2:DRAWTO X,Y:RETURN
3105 COUNT=COUNT+1
3110 FOR J=1 TO 54:H(J)=F(J):NEXT J
3120 FOR J=1 TO 54
3125 SOUND 0,3*J,10,8
3130 READ K:IF K<100 THEN F(J)=H(K):PLRS=PLRS+K:GOTO 3200
3140 S=1:K=K-100:IF K>100 THEN K=K-100:S=-1
3150 FOR L=0 TO 8:F(J+L)=H(K+S*L):PLRS=PLRS+K+S*L:NEXT L:J=J+8
3200 NEXT J:SOUND 0,0,0,0
3205 IF PLRS<>1485 THEN ? "BAD DATA FOR ";A$:STOP
3250 FOR FACE=1 TO 54:IF F(FACE)=H(FACE) THEN 3330
3260 X=23+(FACE-3*INT(FACE/3-0.1)-1)*5:Y=2+20*INT(FACE/3.0001)+4*INT(FACE/9.0001)
3270 IF FACE>27 THEN X=X-17:Y=Y-128
3280 IF FACE>36 THEN X=X+34:Y=Y-64
3290 IF FACE>45 THEN X=X+17:Y=Y-64
3300 J=F(FACE)
3310 COLOR J
3320 PLOT X,Y:DRAWTO X,Y+16:PLOT X+1,Y:DRAWTO X+1,Y+16:PLOT X+2,Y:DRAWTO X+2,Y+16:PLOT X+3,Y:DRAWTO X+3,Y+16
3330 NEXT FACE
3340 IF B$=BH$ THEN RETURN
3350 POP:POP
4999 REM
5000 REM
5010 COUNT=0
5030 FOR SIDE=1 TO 4:IF SIDE>1 THEN M$="AL":GOSUB 6000
5031 REM
5040 IF F(30)=F(32) AND F(5)=F(7) AND F(10)=F(14) THEN 5099
5045 M$=""
5050 TEST$="143205.301007.5089.LDBRLU":GOSUB 7000
5060 TEST$="143205.120937.5089.RDBLRUBR":GOSUB 7000
5070 TEST$="143205.012848.5089.LUBLLDBL":GOSUB 7000
5080 TEST$="143205.033946.5089.RUBRRDBLBL":GOSUB 7000
5085 TEST$="143205.163619.5089.BR":GOSUB 7000
5086 TEST$="143205.342554.5089.BLBL":GOSUB 7000
5087 TEST$="143205.455227.5089.BL":GOSUB 7000
5089 IF M$<>"" THEN GOSUB 6000
5090 IF F(18)=F(5) THEN M$="BLLDBRLU":GOTO 5098
5092 IF F(43)=F(5) THEN M$="LDBLLU":GOTO 5098
5094 M$="BLLDBLBLLUBLLDBRLU"
5098 GOSUB 6000
5099 NEXT SIDE
5100 REM
5110 FOR SIDE=1 TO 4:IF SIDE>1 THEN M$="AL":GOSUB 6000
5120 IF F(5)=F(8) AND F(11)=F(10) THEN 5199
5125 M$=""
5130 TEST$="000510.000811.5166.CDBRCU":GOSUB 7000
5135 TEST$="000510.002904.5166.ARCDBRCUALBR":GOSUB 7000
5140 TEST$="000510.000247.5166.CUBLCD":GOSUB 7000
5150 TEST$="000510.000638.5166.ALCDBLCUARBR":GOSUB 7000
5152 TEST$="000510.001333.5166.CRCR":GOSUB 7000
5154 TEST$="000510.003151.5166.CL":GOSUB 7000
5156 TEST$="000510.001540.5166.CR":GOSUB 7000
5160 TEST$="000510.001720.5166.BR":GOSUB 7000
5162 TEST$="000510.003522.5166.BRBR":GOSUB 7000
5164 TEST$="000510.002653.5166.BL":GOSUB 7000
5166 IF M$<>"" THEN GOSUB 6000
5168 TEST$="000510.004249.5170.BL":GOSUB 7000
5169 GOTO 5180
5170 M$="F-CLCLF+":IF F(42)=F(10) THEN M$="F+CLF-"
5175 GOTO 5198
5180 M$="BLCDBLBLCU":IF F(24)=F(10) THEN M$="CDBLCU"
5198 GOSUB 6000
5199 NEXT SIDE
5200 REM
5205 M$="AU"
5210 GOSUB 6000:SIDE=0:TEST$="103007.051432.5215.AU":GOSUB 7000:GOTO 5220
5215 SIDE=1
5220 TEST$="120937.051441.5225.AU":GOSUB 7000:GOTO 5230
5225 SIDE=SIDE+1
5230 TEST$="361619.143223.5235.AU":GOSUB 7000:GOTO 5240
5235 SIDE=SIDE+1
5240 TEST$="184321.144123.5242.AU":GOSUB 7000:GOTO 5245
5242 SIDE=SIDE+1
5245 IF SIDE<2 THEN M$="F+":GOTO 5210
5250 IF SIDE=4 THEN 5300
5260 TEST$="361619.321423.5261..":GOSUB 7000:GOTO 5262
5261 TEST$="091237.051441.5268..":GOSUB 7000
5262 TEST$="300710.320514.5263..":GOSUB 7000:GOTO 5264
5263 TEST$="184321.144123.5268..":GOSUB 7000
5264 GOTO 5270
5268 M$="TRF+TLLUTLLDTRF+F+":GOTO 5210
5270 TEST$="361619.321423.5272..":GOSUB 7000
5271 TEST$="184321.144123.5272..":GOSUB 7000:GOTO 5275
5272 M$="ADARAU":GOSUB 6000:GOTO 5270
5275 M$="TRF+TLLUTLLDTRF+F+":GOTO 5210
5300 REM
5310 SIDE=0:IF F(10)=F(14) THEN SIDE=1
5315 IF F(12)=F(14) THEN SIDE=SIDE+1
5320 IF F(16)=F(14) THEN SIDE=SIDE+1
5325 IF F(18)=F(14) THEN SIDE=SIDE+1
5330 IF SIDE=4 THEN 5400
5335 IF SIDE=0 THEN 5360
5340 IF SIDE=1 THEN 5350
5345 IF F(12)=F(14) OR F(10)<>F(14) THEN M$="F+":GOSUB 6000:GOTO 5345
5348 GOTO 5360
5350 IF F(12)<>F(14) THEN M$="F+":GOSUB 6000:GOTO 5350
5360 M$="TRF+F+TLF+TRF+TL":GOSUB 6000:GOTO 5310
5400 REM
5410 M$="AD":GOSUB 6000
5420 FOR SIDE=1 TO 4:IF SIDE>1 THEN M$="BL":GOSUB 6000
5422 IF F(17)=F(16) AND F(20)=F(19) THEN 5482
5425 TEST$="001619.001108.5426..":GOSUB 7000:GOTO 5430
5426 M$="F+CLF-":IF F(11)=F(16) THEN M$="F+CRF-F-CLF+"
5427 GOTO 5481
5430 M$="":TEST$="001619.003151.5442.CL":GOSUB 7000
5435 TEST$="001619.001333.5442.CRCR":GOSUB 7000
5440 TEST$="001619.001540.5442.CR":GOSUB 7000
5442 IF M$<>"" THEN GOSUB 6000
5445 TEST$="001619.004249.5450..":GOSUB 7000:GOTO 5460
5450 M$="F+CLCLF-":IF F(42)=F(16) THEN M$="F-CLF+"
5455 GOTO 5481
5460 TEST$="001619.001720.5465.F-CRF+":GOSUB 7000:GOTO 5470
5465 GOSUB 6000:GOTO 5450
5470 TEST$="001619.004424.5465.BLF-CRF+BR":GOSUB 7000
5475 TEST$="001619.005326.5465.BLBLF-CRF+BRBR":GOSUB 7000
5480 M$="BRF-CRF+BL":GOSUB 6000:GOTO 5450
5481 GOSUB 6000
5482 NEXT SIDE
5485 REM
5487 IF F(10)=F(11) AND F(7)=F(8) THEN 5491
5488 TEST$="001007.001108.5490..":GOSUB 7000
5489 TEST$="001007.001540.5490..":GOSUB 7000:M$="CR":GOSUB 6000:GOTO 5489
5490 M$="F-CLF+CRF+CLF-":GOSUB 6000:GOTO 5487
5491 IF F(14)<>F(10) THEN M$="CR":GOSUB 6000:GOTO 5491
5492 IF F(14)<>F(16) THEN M$="BR":GOSUB 6000:GOTO 5492
5500 REM
5505 IF F(14)<>F(11) THEN M$="CL":GOSUB 6000:GOTO 5505
5510 IF F(17)<>F(11) THEN M$="BL":GOSUB 6000:GOTO 5510
5515 M$="ADAL":GOSUB 6000
5520 SIDE=0:TEST$="001108.000514.5521..":GOSUB 7000:GOTO 5525
5521 SIDE=1
5525 TEST$="000247.000550.5526..":GOSUB 7000:GOTO 5530
5526 SIDE=SIDE+1
5530 TEST$="005326.005023.5531..":GOSUB 7000:GOTO 5535
5531 SIDE=SIDE+1
5535 TEST$="002017.002314.5536..":GOSUB 7000:GOTO 5540
5536 SIDE=SIDE+1
5540 IF SIDE=0 THEN M$="CUTRTRCDTRTR":GOSUB 6000:GOTO 5520
5545 IF SIDE<>1 THEN 5560
5550 TEST$="005326.002350.5552..":GOSUB 7000:M$="AU":GOSUB 6000:GOTO 5550
5552 TEST$="000247.000710.5555..":GOSUB 7000:M$="AUALAL":GOSUB 6000
5555 M$="CUTRTRCDTRTR":GOSUB 6000:GOTO 5520
5560 IF F(8)=F(5) AND F(17)=F(14) AND F(26)=F(23) AND F(2)=F(5) THEN 5599
5562 IF (F(2)=F(5) AND F(17)=F(14)) OR (F(5)=F(8) AND F(23)=F(26)) THEN 5570
5565 IF F(2)=F(5) OR F(8)=F(5) THEN M$="AU":GOSUB 6000:GOTO 5565
5570 M$="CUTRCUTRCUTRTRCDTRCDTRCDTRTR":GOSUB 6000:GOTO 5520
5599 GRAPHICS 2:? #6:? #6:? #6;"I'VE DONE IT!!":? #6:? #6;"IN ";COUNT;" MOVES!":STOP
5900 RETURN
5999 REM
6000 MOV=0
6010 MOV=MOV+1
6020 IF LEN(M$)<2*MOV THEN RETURN
6025 B$=M$(2*MOV-1,2*MOV)
6060 GOSUB 3000
6065 GOTO 6010
6999 REM
7000 FOR TF=1 TO 3:TARGET(TF)=F(VAL(TEST$(2*TF-1,2*TF))):NEXT TF
7010 FOR TF=1 TO 3:VF=F(VAL(TEST$(2*TF+6,2*TF+7)))
7020 IF VF<>TARGET(1) AND VF<>TARGET(2) AND VF<>TARGET(3) THEN RETURN
7030 NEXT TF:POP:M$=TEST$(20):GOTO VAL(TEST$(15,18))
8000 GRAPHICS 0:? "In a moment I will put on the screen in front of you a representation of a 'Rubik's Cube'."
8010 ?:? "It will look as if the Cube had been split at its seams and spread flat."
8020 ? "The face in the center represents the face closest to you."
8030 ?:? "The Cube will at first be black, and your first task is to assign the"
8040 ? "colors. I will 'suggest' a color for each face, and if you like it just"
8050 ? "push the button. If you continue to hold the button down I will complete the Cube."
8060 ?:? "If you move the joystick I will":? "change the colors. Just keep trying"
8070 ? "until you see the color you want, thenpress the button to lock in color.":GOSUB 8900
8080 ? "If you choose the colors for the cube,please take them from a real cube and"
8090 ? "don't just make them up. I get very confused if you give me an impossible"
8100 ? "color combination!":?
8110 ? "Once the cube is complete on the screen we can start to work on it."
8120 ? "I will start flashing my 'directional turn signal' to indicate what I think"
8130 ? "we should do. All moves are indicat- ed on the 'control face', which is"
8140 ? "the one closet to you.":?
8150 ? "If you want to accept my suggestion, just press the button. Give me enuf"
8160 ? "time and I'll solve the thing for you (you may want to follow along on your"
8170 ? "real cube).":GOSUB 8900
8180 ? "If you want me to solve it, however, don't interfere! Everytime you over-"
8190 ? "ride my move with one of your own I have to start over!":?
8200 ? "You can control the movements of the cube yourself, however, by moving the"
8210 ? "joystick. Just decide which row or column on the 'control face' you want"
8220 ? "to move and in what direction. Then just move the joystick in that"
8230 ? "direction. I'll change my 'turn signal' to match.":?
8240 ? "If I indicate the wrong column or row move, just move the stick again in"
8250 ? "the same direction. I'll keep trying until I get it right!":GOSUB 8900
8260 ? "The fourth time you move the stick I'll indicate a rotation of the whole"
8270 ? "cube. The fifth time you move the stick right or left I'll indicate a"
8280 ? "rotation of the face clockwise or counter-clockwise.":?
8290 ? "Once you're satisfied, just push the button and I'll make the move.":?
8300 ? "I'll keep making suggestions after each of your moves--just ignore me"
8310 ? "until you're ready for me to take over!":?
8320 ?:? "OK. I'm ready when you are!":GOSUB 8900
8330 ? "Oh--one more thing--I can't work unless you have an Atari with a 'GTIA'";
8340 ? "color chip. As soon as you press the button next time I'll put a 'rainbow'"
8350 ? "on your screen before going on. If you don't see 15 colors, take your"
8360 ? "Atari back to your friendly dealer formodification!":GOSUB 8900
8400 GRAPHICS 11:FOR J=1 TO 15:COLOR J:FOR K=0 TO 4:PLOT J*5+K,0:DRAWTO J*5+K,190:NEXT K:NEXT J
8410 RETURN
8900 J=INT(RND(0)*16):SETCOLOR 2,J,2:SETCOLOR 4,J,2:?:?:? "PRESS BUTTON WHEN READY TO GO ON:";
8910 FOR J=10000 TO 0 STEP -3:SOUND 0,0,10,J:POKE 708,INT(RND(0)*222):IF STRIG(0)<>0 THEN 8920
8915 SOUND 0,0,0,0:GRAPHICS 10:RETURN
8920 NEXT J:GOTO 8910
9010 DATA LU741000000,10,2,3,13,5,6,16,8,9, 19,11,12,22,14,15,25,17,18, 54,20,21,51,23,24,48,26,27
9011 DATA 30,33,36,29,32,35,28,31,34, 137, 46,47,7,49,50,4,52,53,1
9020 DATA LD147000000,54,2,3,51,5,6,48,8,9, 1,11,12,4,14,15,7,17,18, 10,20,21,13,23,24,16,26,27
9021 DATA 34,31,28,35,32,29,36,33,30, 137, 46,47,25,49,50,22,52,53,19
9030 DATA RU963000000,1,2,12,4,5,15,7,8,18, 10,11,21,13,14,24,16,17,27, 19,20,52,22,23,49,25,26,46
9031 DATA 128, 43,40,37,44,41,38,45,42,39, 9,47,48,6,50,51,3,53,54
9040 DATA RD369000000,1,2,52,4,5,49,7,8,46, 10,11,3,13,14,6,16,17,9, 19,20,12,22,23,15,25,26,18
9041 DATA 128, 39,42,45,38,41,44,37,40,43, 27,47,48,24,50,51,21,53,54
9050 DATA CU852000000,1,11,3,4,14,6,7,17,9, 10,20,12,13,23,15,16,26,18, 19,53,21,22,50,24,25,47,27
9051 DATA 128, 137, 46,8,48,49,5,51,52,2,54
9060 DATA CD258000000,1,53,3,4,50,6,7,47,9, 10,2,12,13,5,15,16,8,18, 19,11,21,22,14,24,25,17,27
9061 DATA 128, 137, 46,26,48,49,23,51,52,20,54
9070 DATA CL654000000,101, 10,11,12,40,41,42,16,17,18, 119
9071 DATA 28,29,30,13,14,15,34,35,36, 37,38,39,49,50,51,43,44,45, 46,47,48,31,32,33,52,53,54
9080 DATA CR456000000,101, 10,11,12,31,32,33,16,17,18, 119
9081 DATA 28,29,30,49,50,51,34,35,36, 37,38,39,13,14,15,43,44,45, 46,47,48,40,41,42,52,53,54
9090 DATA AU740850960,110,119,254
9091 DATA 30,33,36,29,32,35,28,31,34, 43,40,37,44,41,38,45,42,39, 209
9100 DATA AD140250360,254,101,110
9101 DATA 34,31,28,35,32,29,36,33,30, 39,42,45,38,41,44,37,40,43, 227
9110 DATA AL320650980,7,4,1,8,5,2,9,6,3, 137, 21,24,27,20,23,26,19,22,25
9111 DATA 110,146,128
9120 DATA AR120450780,3,6,9,2,5,8,1,4,7, 128, 25,22,19,26,23,20,27,24,21
9121 DATA 146, 110, 137
9130 DATA TL321000000,7,4,1,8,5,2,9,6,3, 37,38,39,13,14,15,16,17,18, 119
9131 DATA 10,11,12,31,32,33,34,35,36, 46,47,48,40,41,42,43,44,45, 28,29,30,49,50,51,52,53,54
9140 DATA TR123000000,3,6,9,2,5,8,1,4,7, 28,29,30,13,14,15,16,17,18, 119
9141 DATA 46,47,48,31,32,33,34,35,36, 10,11,12,40,41,42,43,44,45, 37,38,39,49,50,51,52,53,54
9150 DATA BL987000000,101, 10,11,12,13,14,15,43,44,45, 21,24,27,20,23,26,19,22,25
9151 DATA 28,29,30,31,32,33,16,17,18, 37,38,39,40,41,42,52,53,54, 46,47,48,49,50,51,34,35,36
9160 DATA BR789000000,101, 10,11,12,13,14,15,34,35,36, 25,22,19,26,23,20,27,24,21
9161 DATA 28,29,30,31,32,33,52,53,54, 37,38,39,40,41,42,16,17,18, 46,47,48,49,50,51,43,44,45
9170 DATA F+123698000,1,2,3,4,5,6,36,33,30, 16,13,10,17,14,11,18,15,12, 43,40,37,22,23,24,25,26,27
9171 DATA 28,29,19,31,32,20,34,35,21, 7,38,39,8,41,42,9,44,45, 146
9180 DATA F-789632000,1,2,3,4,5,6,37,40,43, 12,15,18,11,14,17,10,13,16, 30,33,36,22,23,24,25,26,27
9181 DATA 28,29,9,31,32,8,34,35,7, 21,38,39,20,41,42,19,44,45,146
References
https://ftp.pigwa.net/stuff/collections/holmes%20cd/Holmes%203/BELLCOM/index.html
https://forums.atariage.com/topic/125131-bellcom-pd-catalog-disk/
https://archive.org/details/BELLCOMPublicDomainSoftwareAtari8Bit
Listing downloads
Download link 1
Downloads
Download link 1
Atari 8-bit Source code
