'===========================================================================
' 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