'=========================================================================== ' Subject: CHECKERS Date: 12-22-96 (13:00) ' Author: James Prevatt Code: QB, QBasic, PDS ' Origin: comp.lang.basic.misc Packet: GAMES.ABC '=========================================================================== DECLARE FUNCTION CheckRWin% () DECLARE FUNCTION CheckBWin% () DECLARE SUB Board () DECLARE SUB InitStat () DECLARE FUNCTION AdjY% (Y%) DECLARE FUNCTION AdjX% (X%) DECLARE SUB DrawBrd () ' Checkers ' by James Prevatt DEFINT A-Z WIDTH 40 COLOR 15 DIM SHARED Status(1 TO 8, 1 TO 8) AS INTEGER DATA 1,5,1,5,1,5,1,5 DATA 5,1,5,1,5,1,5,1 DATA 1,5,1,5,1,5,1,5 DATA 5,0,5,0,5,0,5,0 DATA 0,5,0,5,0,5,0,5 DATA 5,3,5,3,5,3,5,3 DATA 3,5,3,5,3,5,3,5 DATA 5,3,5,3,5,3,5,3 ON ERROR GOTO ErrMan 0 FOR X = 1 TO 25: PRINT : NEXT PRINT SPC(15); "Let's Play" PRINT SPC(15); "Checkers!" PRINT PRINT PRINT InitStat Board DrawBrd 2 LOCATE 8: PRINT " " LOCATE 4: PRINT " " PRINT " " LOCATE 4: COLOR 12: INPUT "Red from Row:", FR IF FR = -1 THEN COLOR 15 LOCATE 24 FOR X = 1 TO 25: PRINT : NEXT PRINT SPC(15); "Let's Play" PRINT SPC(15); "Checkers!" PRINT PRINT PRINT Board DrawBrd GOTO 2 END IF INPUT " Col:", FC LOCATE 8: PRINT FR; ","; FC IF FR < 1 OR FR > 8 THEN GOTO 2 IF FC < 1 OR FC > 8 THEN GOTO 2 IF Status(FR, FC) < 1 OR Status(FR, FC) > 2 THEN GOTO 2 3 LOCATE 4: PRINT " " PRINT " " LOCATE 4: INPUT "Red to Row:", TR IF TR = -1 THEN GOTO 2 INPUT " Col:", TC IF TR < 1 OR TR > 8 THEN GOTO 3 IF TC < 1 OR TC > 8 THEN GOTO 3 IF TR = FR OR TC = FC THEN GOTO 3 IF ABS(TC - FC) <> ABS(TR - FR) THEN GOTO 3 IF ABS(TC - FC) > 2 THEN GOTO 3 IF SGN(TC - FC) = -1 AND Status(FR, FC) <> 2 THEN GOTO 3 IF ABS(TC - FC) = 2 THEN IF SGN(TC - FC) = 1 THEN IF SGN(TR - FR) = -1 THEN IF Status(FR - 1, FC + 1) < 3 OR Status(FR - 1, FC + 1) > 4 THEN GOTO 3 Status(FR - 1, FC + 1) = 0 END IF IF SGN(TR - FR) = 1 THEN IF Status(FR + 1, FC + 1) < 3 OR Status(FR + 1, FC + 1) > 4 THEN GOTO 3 Status(FR + 1, FC + 1) = 0 END IF END IF IF SGN(TC - FC) = -1 THEN IF SGN(TR - FR) = -1 THEN IF Status(FR - 1, FC - 1) < 3 OR Status(FR - 1, FC - 1) > 4 THEN GOTO 3 Status(FR - 1, FC - 1) = 0 END IF IF SGN(TR - FR) = 1 THEN IF Status(FR + 1, FC - 1) < 3 OR Status(FR + 1, FC - 1) > 4 THEN GOTO 3 Status(FR + 1, FC - 1) = 0 END IF END IF END IF IF Status(TR, TC) <> 0 THEN GOTO 3 IF TC = 8 THEN Status(FR, FC) = 2 Status(TR, TC) = Status(FR, FC) Status(FR, FC) = 0 DrawBrd IF CheckRWin = -1 THEN GOTO 8 4 LOCATE 8: PRINT " " LOCATE 4: PRINT " " PRINT " " LOCATE 4: COLOR 9: INPUT "Blue from Row:", FR INPUT " Col:", FC IF FR = -1 THEN COLOR 15 LOCATE 24 FOR t = 1 TO 25 PRINT NEXT PRINT SPC(15); "Let's Play" PRINT SPC(15); "Checkers!" PRINT PRINT PRINT Board DrawBrd GOTO 4 END IF IF FR < 1 OR FR > 8 THEN GOTO 4 IF FC < 1 OR FC > 8 THEN GOTO 4 LOCATE 8: PRINT FR; ","; FC IF Status(FR, FC) < 3 OR Status(FR, FC) > 4 THEN GOTO 4 5 LOCATE 4: PRINT " " PRINT " " LOCATE 4: INPUT "Blue to Row:", TR IF TR = -1 THEN GOTO 4 INPUT " Col:", TC IF FR < 1 OR FR > 8 THEN GOTO 5 IF FC < 1 OR FC > 8 THEN GOTO 5 IF TR = FR OR TC = FC THEN GOTO 5 IF ABS(TC - FC) <> ABS(TR - FR) THEN GOTO 5 IF ABS(TC - FC) > 2 THEN GOTO 5 IF SGN(TC - FC) = 1 AND Status(FR, FC) <> 4 THEN GOTO 5 IF ABS(TC - FC) = 2 THEN IF SGN(TC - FC) = 1 THEN IF SGN(TR - FR) = -1 THEN IF Status(FR - 1, FC + 1) < 1 OR Status(FR - 1, FC + 1) > 2 THEN GOTO 5 Status(FR - 1, FC + 1) = 0 END IF IF SGN(TR - FR) = 1 THEN IF Status(FR + 1, FC + 1) < 1 OR Status(FR + 1, FC + 1) > 2 THEN GOTO 5 Status(FR + 1, FC + 1) = 0 END IF END IF IF SGN(TC - FC) = -1 THEN IF SGN(TR - FR) = -1 THEN IF Status(FR - 1, FC - 1) < 1 OR Status(FR - 1, FC - 1) > 2 THEN GOTO 5 Status(FR - 1, FC - 1) = 0 END IF IF SGN(TR - FR) = 1 THEN IF Status(FR + 1, FC - 1) < 1 OR Status(FR + 1, FC - 1) > 2 THEN GOTO 5 Status(FR + 1, FC - 1) = 0 END IF END IF END IF IF Status(TR, TC) <> 0 THEN GOTO 5 IF TC = 1 THEN Status(FR, FC) = 4 Status(TR, TC) = Status(FR, FC) Status(FR, FC) = 0 DrawBrd IF CheckBWin THEN GOTO 9 GOTO 2 8 LOCATE 12 COLOR 12 PRINT SPC(15); "Red Wins!!" GOTO 10 9 LOCATE 12 COLOR 9 PRINT SPC(15); "Blue Wins!" 10 COLOR 15 PRINT SPC(13); "Press a key...." WHILE INKEY$ = "": WEND LOCATE 24 FOR t = 1 TO 25 PRINT NEXT LOCATE 12 INPUT "Play again"; o$ IF UCASE$(LEFT$(o$, 1)) = "Y" THEN RESTORE: GOTO 0 END ErrMan: PRINT ERR RESUME NEXT FUNCTION AdjX (X) AdjX = 2 * X + 12 END FUNCTION FUNCTION AdjY (Y) AdjY = -2 * Y + 23 END FUNCTION DEFSNG A-Z SUB Board PRINT SPC(11); " ΙΝΡΝΡΝΡΝΡΝΡΝΡΝΡΝ»" PRINT SPC(11); "8Ί ³ ³ ³ ³ ³ ³ ³ Ί" PRINT SPC(11); " ΗΔΕΔΕΔΕΔΕΔΕΔΕΔΕΔΆ" PRINT SPC(11); "7Ί ³ ³ ³ ³ ³ ³ ³ Ί" PRINT SPC(11); " ΗΔΕΔΕΔΕΔΕΔΕΔΕΔΕΔΆ" PRINT SPC(11); "6Ί ³ ³ ³ ³ ³ ³ ³ Ί" PRINT SPC(11); " ΗΔΕΔΕΔΕΔΕΔΕΔΕΔΕΔΆ" PRINT SPC(11); "5Ί ³ ³ ³ ³ ³ ³ ³ Ί" PRINT SPC(11); " ΗΔΕΔΕΔΕΔΕΔΕΔΕΔΕΔΆ" PRINT SPC(11); "4Ί ³ ³ ³ ³ ³ ³ ³ Ί" PRINT SPC(11); " ΗΔΕΔΕΔΕΔΕΔΕΔΕΔΕΔΆ" PRINT SPC(11); "3Ί ³ ³ ³ ³ ³ ³ ³ Ί" PRINT SPC(11); " ΗΔΕΔΕΔΕΔΕΔΕΔΕΔΕΔΆ" PRINT SPC(11); "2Ί ³ ³ ³ ³ ³ ³ ³ Ί" PRINT SPC(11); " ΗΔΕΔΕΔΕΔΕΔΕΔΕΔΕΔΆ" PRINT SPC(11); "1Ί ³ ³ ³ ³ ³ ³ ³ Ί" PRINT SPC(11); " ΘΝΟΝΟΝΟΝΟΝΟΝΟΝΟΝΌ" PRINT SPC(11); " 1 2 3 4 5 6 7 8" END SUB DEFINT A-Z FUNCTION CheckBWin FOR Y = 1 TO 8 FOR X = 1 TO 8 IF Status(X, Y) = 1 OR Status(X, Y) = 2 THEN CheckBWin = 0: GOTO 7 NEXT NEXT CheckBWin = -1 7 END FUNCTION FUNCTION CheckRWin FOR Y = 1 TO 8 FOR X = 1 TO 8 IF Status(X, Y) = 3 OR Status(X, Y) = 4 THEN CheckRWin = 0: GOTO 6 NEXT NEXT CheckRWin = -1 6 END FUNCTION SUB DrawBrd FOR Y% = 1 TO 8 FOR X% = 1 TO 8 X0 = AdjX(X) Y0 = AdjY(Y) LOCATE Y0, X0 IF Status(X, Y) = 0 THEN PRINT " " IF Status(X, Y) = 1 THEN COLOR 12: PRINT CHR$(240): COLOR 15 IF Status(X, Y) = 2 THEN COLOR 12: PRINT CHR$(254): COLOR 15 IF Status(X, Y) = 3 THEN COLOR 9: PRINT CHR$(240): COLOR 15 IF Status(X, Y) = 4 THEN COLOR 9: PRINT CHR$(254): COLOR 15 IF Status(X, Y) = 5 THEN COLOR 8: PRINT CHR$(178): COLOR 15 NEXT NEXT END SUB SUB InitStat FOR Y = 1 TO 8 FOR X = 1 TO 8 READ C Status(X, Y) = C NEXT NEXT END SUB