Compucolor.org – Virtual Media

Listing of file='KALAH.BAS;01' on disk='vmedia/sharks-sector.ccvf'

100 REM  ** KALAH - UPDATED JAN 23,80 **
110 REM  **   WRITTEN BY G. WHITTEN   **
120 REM  ** COPYRIGHT (C) 1980 BY COMPUCOLOR CORP **
130 DIM X(13),Y(13),N$(1),SL(1),W(1),SC(1)
140 LP= 0:LV= 10:MX= 1000
150 DIM B(LV,13),L(LV),LB(LV),D(LV),A(LV),MV(LV),LM(LV),M(LV,6)
160 GOSUB 1270
170 PLOT 3,32,16
180 PLOT 6,7,14,3,0,29:PRINT SPC( 24)""
190 PLOT 3,0,29:INPUT "PLAYERS(0-2): ";NP:NP= INT (NP):IF NP< 0OR NP> 2THEN 180
200 PLOT 3,0,31:PRINT SPC( 24)""
210 PLOT 3,0,31:INPUT "STONES PER PIT: ";ST:ST= INT (ST):H= 6* ST:IF ST< 1OR ST> 99THEN 200
220 GOSUB 1550:N$(0)= "COMPUCOLOR":N$(1)= N$(0)
230 FOR I= 0TO 1:PLOT 14,19,30,20- 3* I,29,3,0,31- I- I
240 PRINT "                    ";
250 IF NPAND I< = NP- 1THEN INPUT " NAME: ";A$:N$(I)= MID$ (A$,1,10):SL(I)= 0:GOTO 270
260 INPUT " STRATEGY LEVEL(1-5):   ";L:SL(I)= INT (L):IF SL(I)< 1OR SL(I)> 5THEN 220
270 W(I)= 0:SC(I)= 0:NEXT I
280 FOR I= 0TO 1:PLOT 15,6,39- 24* I,3,32- LEN (N$(I))/ 2,28- 27* I:PRINT N$(I):NEXT I
290 B(0,6)= 0:B(0,13)= 0
300 IF SL(0)> 0AND SL(1)> 0THEN ZQ= 0
310 GOSUB 1550:A$= "":IF ZQ= 3.4THEN PLOT 6,1,3,0,31:INPUT " ANOTHER GAME? ";A$:A$= A$+ " "
320 PLOT 6,1:IF LEFT$ (A$,1)= "N"THEN LOAD "MENU":RUN
330 IF SL(0)= 0OR SL(1)= 0THEN 360
340 IF A1$= "N"THEN A$= "Y":A1$= "Y":GOTO 370
350 IF A1$< > "N"THEN A$= "N":A1$= "N":GOTO 370
360 ZQ= 3.4:PLOT 3,0,31:PRINT SPC( 16)" ":PLOT 3,0,31:INPUT "RED MOVES FIRST ? ";A$
370 CP= LEFT$ (A$,1)< > "N":CP= ABS (CP)
380 GOSUB 1550
390 FOR I= 0TO 13:B(0,I)= ST:NEXT I:B(0,6)= 0:B(0,13)= 0:GOSUB 1500
400 PLOT 14,6,6:FOR I= 0TO 1:PLOT 3,56* I,9
410 IF SL(1- I)> 0THEN PRINT "STRATEGY
"SL(1- I)
420 NEXT I
430 TS= 0:PL= CP:GOSUB 930:IF TTHEN 560
440 IF SL(CP)THEN 500
450 IF CP= 1THEN PLOT 14,3,0,31,6,11:INPUT " MOVE: d ";MV
460 IF CP= 0THEN PLOT 14,3,48,31,6,35:INPUT " MOVE: d ";MV
470 MV= INT (MV):IF MV< 1OR MV> 6THEN 440
480 MV= MV- 1+ 7* CP:IF B(0,MV)= 0THEN 440
490 GOTO 530
500 L= SL(CP):LB= - MX:D= MX:GOSUB 680:MV= BM
510 PLOT 3,0,31,14:PRINT ""SPC( 15):IF CP= 1THEN PLOT 3,0,31,6,11:PRINT " MY MOVE IS"MV+ 1- 7* CP" "
520 PLOT 3,48,31:PRINT ""SPC( 15):IF CP= 0THEN PLOT 3,48,31,6,35:PRINT " MY MOVE IS"MV+ 1- 7* CP" "
530 GOSUB 1460
540 GOSUB 930:IF TTHEN 560
550 CP= 1- CP:GOTO 430
560 GOSUB 890
570 IF B(0,6)> B(0,13)THEN W(0)= W(0)+ 1
580 IF B(0,13)> B(0,6)THEN W(1)= W(1)+ 1
590 FOR I= 0TO 1:SC(I)= SC(I)+ B(0,6+ 7* I):NEXT
600 FOR I= 0TO 1:X= 10:Y= 12:C= 14:IF I= 1THEN X= 35:C= 34
610 PLOT 15,6,C:FOR JJ= 1TO 4:PLOT 3,X,Y+ JJ:PRINT SPC( 19)"":NEXT JJ
620 PLOT 3,X+ 1,Y+ 2:PRINT "TOTAL WINS   ";RIGHT$ ("   "+ STR$ (W(1- I)),4)
630 PLOT 3,X+ 1,Y+ 3:PRINT "TOTAL STONES ";RIGHT$ ("   "+ STR$ (SC(1- I)),4)
640 NEXT I:GOTO 300
650 END
660 REM  ALPHA-BETA PRUNING
670 REM  CREATE ACTIVATION RECORD ON STACK
680 PL= 1- CP:TS= - 1
690 REM  RECURSIVE ENTRY POINT
700 TS= TS+ 1:L(TS)= L:LB(TS)= LB:D(TS)= D:PL= 1- PL
710 IF L(TS)= 0THEN 850
720 GOSUB 930:IF TTHEN 870
730 A(TS)= LB(TS)
740 GOSUB 1030
750 LM= LM(TS):IF LM= 0THEN 840
760 MV= M(TS,LM):LM(TS)= LM- 1
770 GOSUB 1090
780 L= L(TS)- 1:LB= - D(TS):D= - A(TS):GOSUB 700
790 R= - R
800 IF R< = A(TS)THEN 830
810 A(TS)= R
820 IF TS= 0THEN BM= M(0,LM(0)+ 1)
830 IF A(TS)< D(TS)THEN 750
840 R= A(TS):GOTO 870
850 GOSUB 890
860 REM  REMOVE TOP ACTIVATION RECORD
870 TS= TS- 1:PL= 1- PL:RETURN
880 REM  CALCULATE TERMINAL VALUE OF BOARD
890 IF B(TS,6+ 7* PL)> HTHEN R= MX:RETURN
900 IF B(TS,13- 7* PL)> HTHEN R= - MX:RETURN
910 R= B(TS,6+ 7* PL)- B(TS,13- 7* PL):RETURN
920 REM  DETERMINE IF NO MOVES ARE POSSIBLE AND RETURN VALUE
930 RW= 0:FOR I= 7* PLTO 5+ 7* PL:RW= RW+ B(TS,I):NEXT I
940 IF RWTHEN 1000
950 FOR I= 7* PLTO 5+ 7* PL
960 B(TS,13- 7* PL)= B(TS,13- 7* PL)+ B(TS,I):B(TS,I)= 0
970 NEXT I
980 GOSUB 890
990 R= MX* SGN (R):T= 1:RETURN
1000 IF B(TS,6)> HOR B(TS,13)> HTHEN 980
1010 T= 0:RETURN
1020 REM  COMPUTE LEGAL (PLAUSIBLE) MOVES
1030 C= 0:FOR I= 7* PLTO 5+ 7* PL
1040 IF B(TS,I)THEN C= C+ 1:M(TS,C)= I
1050 NEXT I
1060 LM(TS)= C:RETURN
1070 RETURN
1080 REM  MAKE MOVE MV
1090 SK= 13- 7* PL:T= TS+ 1
1100 FOR I= 0TO 13:B(T,I)= B(TS,I):NEXT I
1110 N= B(T,MV):B(T,MV)= 0:M= MV
1120 FOR I= 1TO N:M= M+ 1
1130 IF M= SKTHEN M= M+ 1
1140 IF M= 14THEN M= 0
1150 B(T,M)= B(T,M)+ 1
1160 NEXT I
1170 IF M< 7* PLOR M> 5+ 7* PLTHEN 1200
1180 IF N> 7THEN MV= M:GOTO 1110
1190 RETURN
1200 IF M= 6+ 7* PLTHEN RETURN
1210 IF B(T,M)< 2OR B(T,M)> 3THEN RETURN
1220 B(T,6+ 7* PL)= B(T,6+ 7* PL)+ B(T,M)
1230 B(T,M)= 0
1240 M= M- 1:IF M> = 7* (1- PL)THEN 1210
1250 RETURN
1260 REM  DISPLAY BOARD
1270 PLOT 27,24,15,6,0,12
1280 PLOT 6,24
1290 FOR I= 1TO 3:PRINT SPC( 11);""TAB( 53);"";SPC( 11)"":NEXT I
1300 PLOT 3,1,1:PRINT "K A L A H":PLOT 3,54,1:PRINT "K A L A H"
1310 PLOT 6,15:FOR I= 0TO 2:PLOT 3,26,I:PRINT SPC( 12)"":NEXT I
1320 PLOT 6,39:FOR I= 0TO 2:PLOT 3,26,27+ I:PRINT SPC( 12)"":NEXT I
1330 FOR P= 0TO 1:PLOT 6,15+ P* 24
1340 X= 1+ P* 56:Y= 11:H= 6:V= 8:GOSUB 1440
1350 FOR J= 0TO 5:X= 10+ J* 8:Y= 7+ P* 12:H= 4:V= 4:GOSUB 1440
1360 NEXT J:NEXT P
1370 PLOT 14,6,7:FOR I= 1TO 6
1380 PLOT 3,3+ I* 8,5:PRINT 7- I:PLOT 3,3+ I* 8,25:PRINT I
1390 NEXT I
1400 RESTORE 1400:FOR I= 0TO 13:READ X(I),Y(I):NEXT I
1410 DATA 11,21,19,21,27,21,35,21,43,21,51,21,59,15
1420 DATA 51,9,43,9,35,9,27,9,19,9,11,9,3,15
1430 RETURN
1440 FOR K= 1TO V:PLOT 3,X,Y+ K- 1:PRINT SPC( H)"":NEXT K
1450 RETURN
1460 TS= 0:PL= CP:GOSUB 1090
1470 FOR I= 0TO 13:B(0,I)= B(1,I):NEXT I
1480 GOSUB 1500
1490 RETURN
1500 PLOT 14:FOR P= 0TO 1:PLOT 6,39- P* 24
1510 FOR I= 0TO 6:J= I+ 7* P:PLOT 3,X(J),Y(J)
1520 PRINT RIGHT$ (" "+ STR$ (B(0,J)),2)
1530 NEXT I:NEXT P
1540 RETURN
1550 FOR I= 0TO 1:PLOT 6,0,14,3,0,29+ I+ I:PRINT SPC( 24)"":NEXT I:RETURN