_TITLE "Checkers Force Jump 2020-02-15" 'b+ start from checkers.bas 2020-02-03 ' 2020-02-06 Checkers Force Jump.bas modify to enforce Forced jumps
' add sub MoveList:
' modify legalMove and legalJump to input start x, y and end x, y and whose turn it is and copy of board?
' for turn set constants Red and Black, oops content to just know Black's turn when = 0, Red's turn = 1.
' move sub << yes legalMove and one for jumping legalJump, if no jump then check move.
' copyArray sub - done << oops nope the mem copy works only with lists, 1 dim arrays. May not need it anyway.
' 2020-02-13 create 2 types may only use MOVE type, the other is std XY type.
' Added moveList sub to create list of moves available and to begin forced jump enforcement.
' Now using that to determine a winner when no moves are available. The win function and it's use commented out.
' So far the only way to get the new sub moveList to work is to copy the board array b() before using it and then
' copy the saved copy back to board array after calling because something(s) in b() are getting lost but I don't see
' how??? Because nothing in the new sub or the subs it calls alters the b(). << wrong! 2020-02-14 I still had
' legalJump removing the piece! Dang! should have doubled checked on 2/13.
' 2020-02-14 alter moveList sub to copy the board array, then check the board array after certain stages of
' it's code to see if can find what is causing the change in the b(). Aha! LegalJump WAS changing the b()!!!
' Reworked legalJump and legalMove to more efficient code? certainly much less lines and seem to still work.
' Test new legalXXX subs with moveList. Cleanup mess of finding bug. Only MOVE Type left.
' 2020-02-15 OK I think I have an idea to eliminate having to click the piece to signal the end of a move (if jumping has occurred).
' I will create a jumpAvailable function that takes a X, Y position and turn and just sees if a legal Jump can be found.
' Should be a piece of cake, just copy paste a little piece from the listMoves sub. I've been considering breaking that sub into
' pieces for using as needed for AI. So far my future thinking for AI has been to avoid having to keep and pass copies
' of the boards in various states, using the board array and one copy hopefully will be all that will be needed when evaluating
' moves for the future AI. More checks and beeps with clicks.
CONST xmax
= 500, ymax
= 500, SQ
= 50 'for checkers
CONST WHITE
= &HFFFFFFFF, GOLD
= &HFFFF9900, BLACK
= &HFF000000, GRAY
= &HFF444444, GRAY2
= &HFF999999, RED
= &HFFFF0000 CONST dRed
= &HFFDD0000, dGray
= &HFF222222 restart:
turn = 0
loadB
showB
listMoves turn, mList(), forceJump 'analyse board with listMoves and call win or force jump for next player up
'see the how list is coming, it looks great
'FOR i = LBOUND(mList) TO UBOUND(mList)
' PRINT i, mList(i).SX; ","; mList(i).SY; ","; mList(i).EX; ","; mList(i).EY
'NEXT
'INPUT "OK ..."; w$
'CLS
showB
yCP 1, "Red has no move, Black Wins!"
yCP 1, "Black has no move, Red Wins!"
IF turn
THEN yCP
1, "Red's turn and must jump." ELSE yCP
1, "Black's turn and must jump." IF turn
THEN yCP
1, "Red's turn" ELSE yCP
1, "Black's turn"
bx = -1: by = -1: bx2 = -1: by2 = -1: turnF = 0
IF bx
<> -1 THEN CIRCLE (bx
* SQ
+ 23, by
* SQ
+ 23), 23, &HFFFFFF00 'highlite IF forceJump
THEN 'ONLY highlite a piece that can jump IF jumpAvailable
(mx
, my
, turn
) THEN bx
= mx: by
= my
ELSE 'could check to see that bx, by has a piece whose color matches turn END IF 'force Jump or not 'LOCATE 1, 1: PRINT SPACE$(50) 'check our mouse position to borad
'LOCATE 1, 1: PRINT bx, by, bx2, by2
WHILE legalJump
(bx
, by
, bx2
, by2
, turn
) 'if legal jump allow for more jumps MovePiece bx, by, bx2, by2, turn
turnF = -1
IF jumpAvailable
(bx2
, by2
, turn
) THEN 'forceJump still in effect bx = bx2: by = by2: bx2 = -1: by2 = -1
yCP 25, "Another jump to do..."
showB
CIRCLE (bx
* SQ
+ 23, by
* SQ
+ 23), 23, &HFFFFFF00 showB
forceJump = 0 'set flags that a jump move has been made
EXIT WHILE 'bx2 is not -1 so will exit next while loop after END IF 'mouse click inside b() bounds IF legalMove
(bx
, by
, bx2
, by2
, turn
) = 0 THEN BEEP ELSE MovePiece bx
, by
, bx2
, by2
, turn: turn
= 1 - turn
turn = 1 - turn
SUB MovePiece
(bbx
, bby
, newX
, newY
, turn
) 'This is supposed to be the only routine that changes the b() array assume all has been prechecked! IF legalJump
(bbx
, bby
, newX
, newY
, turn
) THEN 'jump remove piece in between mx = (bbx + newX) / 2: my = (bby + newY) / 2
b(mx, my) = 0
b(newX, newY) = b(bbx, bby): b(bbx, bby) = 0
IF turn
= 0 AND newY
= 1 THEN b
(newX
, newY
) = -2 'Black King IF turn
AND newY
= 8 THEN b
(newX
, newY
) = 2 'Red King
SUB listMoves
(turn
, L
() AS MOVE
, jF
) 'stop making list if jumps are found jF = 0 'jump Flag, reset in case set previously and reuse variable is jump Flag
REDIM L
(0) AS MOVE
'also reset in case used previously
FOR y
= 1 TO 8 'scan board for legal jumps and list all found and set JF IF legalJump
(x
, y
, x2
, y2
, turn
) THEN jF = -1
li = li + 1
L(li).SX = x
L(li).SY = y
L(li).EX = x2
L(li).EY = y2
IF legalJump
(x
, y
, x2
, y2
, turn
) THEN jF = -1
li = li + 1
L(li).SX = x
L(li).SY = y
L(li).EX = x2
L(li).EY = y2
IF jF
= 0 THEN 'no moves to force so go over board again for regular moves IF turn
THEN ' potential piece to move IF legalMove
(x
, y
, x2
, y2
, turn
) THEN li = li + 1
L(li).SX = x
L(li).SY = y
L(li).EX = x2
L(li).EY = y2
IF turn
= 0 THEN ' potential piece to move IF legalMove
(x
, y
, x2
, y2
, turn
) THEN li = li + 1
L(li).SX = x
L(li).SY = y
L(li).EX = x2
L(li).EY = y2
FUNCTION jumpAvailable
(x
, y
, turn
) ' 0 or -1 a jump is possoble or not IF b
(x
, y
) > 0 AND turn
THEN 'red piece and red's turn
FUNCTION legalMove
(bx
, by
, bx2
, by2
, turn
) 'this is just a move no jumping IF b
(bx2
, by2
) = 0 THEN 'must be empty IF by
- 1 = by2
AND (bx
- 1 = bx2
OR bx
+ 1 = bx2
) THEN legalMove
= -1 IF (by
- 1 = by2
OR by
+ 1 = by2
) AND (bx
- 1 = bx2
OR bx
+ 1 = bx2
) THEN legalMove
= -1 IF by
+ 1 = by2
AND (bx
- 1 = bx2
OR bx
+ 1 = bx2
) THEN legalMove
= -1 IF (by
- 1 = by2
OR by
+ 1 = by2
) AND (bx
- 1 = bx2
OR bx
+ 1 = bx2
) THEN legalMove
= -1
FUNCTION legalJump
(bx
, by
, bx2
, by2
, turn
) 'this checks only one jump IF b
(bx2
, by2
) = 0 THEN 'must be empty IF turn
= 0 THEN 'black's move IF b
(bx
, by
) = -1 THEN 'Black pean IF by
- 2 = by2
AND bx
- 2 = bx2
THEN 'must jump red player IF b
(bx
- 1, by
- 1) > 0 THEN legalJump
= -1 IF b
(bx
+ 1, by
- 1) > 0 THEN legalJump
= -1 IF b
(bx
- 1, by
- 1) > 0 THEN legalJump
= -1 IF b
(bx
+ 1, by
- 1) > 0 THEN legalJump
= -1 IF b
(bx
- 1, by
+ 1) > 0 THEN legalJump
= -1 IF b
(bx
+ 1, by
+ 1) > 0 THEN legalJump
= -1 IF b
(bx
, by
) = 1 THEN 'Red pean IF b
(bx
- 1, by
+ 1) < 0 THEN legalJump
= -1 IF b
(bx
+ 1, by
+ 1) < 0 THEN legalJump
= -1 IF b
(bx
- 1, by
- 1) < 0 THEN legalJump
= -1 IF b
(bx
+ 1, by
- 1) < 0 THEN legalJump
= -1 IF b
(bx
- 1, by
+ 1) < 0 THEN legalJump
= -1 IF b
(bx
+ 1, by
+ 1) < 0 THEN legalJump
= -1
n = 0
LINE (46, 46)-STEP(400 + 4, 400 + 4), GOLD
, BF
LINE (x
* SQ
, y
* SQ
)-STEP(SQ
- 4, SQ
- 4), colore~&
, BF
IF b
(x
, y
) > 0 THEN fcirc x
* SQ
+ 23, y
* SQ
+ 23, 20, RED: fcirc x
* SQ
+ 23, y
* SQ
+ 23, 15, dRed:
CIRCLE (x
* SQ
+ 23, y
* SQ
+ 23), 15, GRAY2
IF b
(x
, y
) < 0 THEN fcirc x
* SQ
+ 23, y
* SQ
+ 23, 20, GRAY: fcirc x
* SQ
+ 23, y
* SQ
+ 23, 15, dGray:
CIRCLE (x
* SQ
+ 23, y
* SQ
+ 23), 15, GRAY2
b(x, y) = 1: b(9 - x, 9 - y) = -1
i = i + 1
Radius
= ABS(R
): RadiusError
= -Radius: X
= Radius: Y
= 0 LINE (CX
- X
, CY
)-(CX
+ X
, CY
), C
, BF
RadiusError = RadiusError + Y * 2 + 1
LINE (CX
- Y
, CY
- X
)-(CX
+ Y
, CY
- X
), C
, BF
LINE (CX
- Y
, CY
+ X
)-(CX
+ Y
, CY
+ X
), C
, BF
X = X - 1
RadiusError = RadiusError - X * 2
Y = Y + 1
LINE (CX
- X
, CY
- Y
)-(CX
+ X
, CY
- Y
), C
, BF
LINE (CX
- X
, CY
+ Y
)-(CX
+ X
, CY
+ Y
), C
, BF
SUB yCP
(y
, s$
) 'Center Print at pixel y row
