Not a bug, a feature...

by Pete

OK, who's fooling whom - bug! It's a 180-degree turn, btw. I should have dug out a chessboard to see that. Anyway, this code fixes that. I should have remembered, although it has been many years since I've played chess and when I did play, I was always white. (There is no advantage in being black - unrelated comment, not intended to be associated with that dumbass Distractions Forum.)

Wow, Mac wants a mouse driven program??? I guess I got that reversed, too! I would have thought you would have looked at the chess game I posted and thought huh, it would be OK if you could just type to a command line.

OK, I'm rambling. I get more and more like mennuptite every day. So, to the point; making the pieces move with a mouse routine is a piece of cake. The only difficulty comes with the fact that you and Michael worked out a placement code based on arrays and my program uses screen positions. I would have to work out an additional algorithm to pass the screen value to the array. I would have to study your array code before I could comment on the ease or difficulty of that.

Did you try my CALL ABSOLUTE version I posted at the Big Forums? I would like to know if it runs OK on 1.0. It is a shame it is a bit slower than CALL INTERRUPT, but at least it offers 1.0 users a chance to play it.

Pete

-------------------------------------------------------

DECLARE FUNCTION DisplayBoard$ (mode$)
k3$ = "Driver for Kriegspiel Referee DisplayBoard Function"
'=============================================
DIM SHARED board(8, 8) AS INTEGER' column, row
'1=K 2=Q 3=B 4=N 5=R 6=pawn (White)
'7=K 8=R if the piece has moved (re: Castling)
'9=P if the pawn can be taken en passent
'-1=K .... (Black)
'=============================================
DIM zC AS INTEGER, zR AS INTEGER, zP AS INTEGER
zR = 8
FOR zC = 1 TO 8
board(zC, zR) = -VAL(MID$("54321345", zC, 1))
board(zC, zR - 1) = -6
NEXT zC
zR = 1
FOR zC = 1 TO 8
board(zC, zR) = VAL(MID$("54321345", zC, 1))
board(zC, zR + 1) = 6
NEXT zC

TestID$ = "NORMAL (1-6) pieces"
'======
GOSUB NewScreen
PRINT "Testing DisplayBoard with TOTAL BOARD option"
MSG$ = "do test": GOSUB GetKey
Move$ = DisplayBoard("BW")
MSG$ = "continue.": GOSUB GetKey
'======
GOSUB NewScreen
PRINT "Testing DisplayBoard with WHITE option"
MSG$ = "do test": GOSUB GetKey
Move$ = DisplayBoard("W"): GOSUB EditMove
MSG$ = "continue. You returned move [" + Move$ + "]": GOSUB GetKey
'======
GOSUB NewScreen
PRINT "Testing DisplayBoard with BLACK option"
MSG$ = "do test": GOSUB GetKey
Move$ = DisplayBoard("B"): GOSUB EditMove
MSG$ = "continue. You returned move [" + Move$ + "]": GOSUB GetKey

'===================================
FOR zR = 1 TO 8: FOR zC = 1 TO 8: board(zC, zR) = 0: NEXT zC: NEXT zR
board(5, 1) = 7: board(5, 8) = -7' Place kings that have moved
board(1, 1) = 8: board(1, 8) = -8' Place rooks that have moved
board(3, 3) = 9: board(6, 6) = -9' Place pawns subject to en passent

TestID$ = "SPECIAL (7-9) pieces"
'======
GOSUB NewScreen
PRINT "Testing DisplayBoard with TOTAL BOARD option"
MSG$ = "do test": GOSUB GetKey
Move$ = DisplayBoard("BW")
MSG$ = "continue.": GOSUB GetKey
'======
GOSUB NewScreen
PRINT "Testing DisplayBoard with WHITE option"
MSG$ = "do test": GOSUB GetKey
Move$ = DisplayBoard("W"): GOSUB EditMove
MSG$ = "continue. You returned move [" + Move$ + "]": GOSUB GetKey
'======
GOSUB NewScreen
PRINT "Testing DisplayBoard with BLACK option"
MSG$ = "do test": GOSUB GetKey: GOSUB EditMove
Move$ = DisplayBoard("B")
MSG$ = "continue. You returned move [" + Move$ + "]": GOSUB GetKey
'======
CLS
SYSTEM

NewScreen:
CLS : LOCATE 3, 13: PRINT k3$
LOCATE , 13: PRINT STRING$(LEN(k3$), "=")
LOCATE 7, 1: PRINT "You are now going to test "; TestID$
PRINT : PRINT
RETURN

GetKey:
LOCATE 25, 1, 1
PRINT "Press any key to "; MSG$; " ";
SLEEP: k$ = INKEY$
IF k$ = CHR$(27) THEN CLS : SYSTEM
RETURN

EditMove:
IF Move$ = "resign" THEN RETURN
Good1 = 1
IF INSTR("abcdefgh", MID$(Move$, 1, 1)) = 0 THEN Good1 = 0
IF INSTR("12345678", MID$(Move$, 2, 1)) = 0 THEN Good1 = 0
IF MID$(Move$, 3, 1) <> "-" THEN Good1 = 0
IF INSTR("abcdefgh", MID$(Move$, 4, 1)) = 0 THEN Good1 = 0
IF INSTR("12345678", MID$(Move$, 5, 1)) = 0 THEN Good1 = 0
IF Good1 = 0 THEN Move$ = Move$ + "] [*** BUG! ***"
RETURN

FUNCTION DisplayBoard$ (mode$)
DIM zC AS INTEGER, zR AS INTEGER, zP AS INTEGER
COLOR 7, 1: CLS
SELECT CASE mode$
CASE "W": GOSUB board: GOSUB White: GOSUB GetMove
CASE "B": GOSUB board: GOSUB Black: GOSUB GetMove
CASE "BW": GOSUB board: GOSUB Both
END SELECT
EXIT FUNCTION

Both:
COLOR 0, 6
FOR zR = 8 TO 1 STEP -1
FOR zC = 1 TO 8
zP = board(zC, zR)
IF zP < 0 THEN zP = -zP: COLOR 0, 6 ELSE COLOR 7, 1
IF zP = 0 THEN
'''PRINT "-";
ELSE
LOCATE TM% - 1 + (9 * 2) - (zR * 2), LM% - 3 + zC * 5 - 1
PRINT " " + MID$("KQBNRPKRP", zP, 1) + " ";
END IF
'''COLOR 7, 0: PRINT " ";
NEXT zC
''PRINT zR
NEXT zR
'''PRINT : PRINT "a b c d e f g h"
RETURN

White:
COLOR 7, 1
FOR zR = 8 TO 1 STEP -1
FOR zC = 1 TO 8
zP = board(zC, zR)
IF zP < 0 THEN zP = 0
IF zP = 0 THEN
'''PRINT "-";
ELSE
LOCATE TM% - 1 + (9 * 2) - (zR * 2), LM% - 3 + zC * 5 - 1
PRINT " " + MID$("KQBNRPKRP", zP, 1) + " ";
END IF
'''COLOR 7, 0: PRINT " ";
NEXT zC
'''PRINT zR
NEXT zR
''' PRINT : PRINT "a b c d e f g h"
COLOR 7, 1
RETURN

Black:
COLOR 0, 6
FOR zR = 1 TO 8
FOR zC = 8 TO 1 STEP -1
zP = board(zC, zR)
IF zP > 0 THEN zP = 0
IF zP = 0 THEN
'''PRINT "-";
ELSE
LOCATE TM% - 1 + (zR * 2), (LM% + 8 * 5) - (LM% - 3 + zC * 5 - 1), 1
PRINT " " + MID$("KQBNRPKRP", -zP, 1) + " ";
END IF
'''COLOR 7, 0: PRINT " ";
NEXT zC
'''PRINT zR
NEXT zR
'''PRINT : PRINT "h g f e d c b a"
COLOR 7, 1
RETURN

GetMove:
LOCATE 23, 1: LINE INPUT "Move: "; xxx$
DisplayBoard$ = xxx$
RETURN

board:
COLOR 7, 1: CLS
LM% = 3: TM% = 3: LEVEL% = 1
LOCATE TM%, LM%, 0
FOR H = 1 TO 8
FOR J = 1 TO 2
FOR I = 1 TO 8
IF H / 2 = H \ 2 THEN
IF I / 2 = I \ 2 THEN COLOR 0, 7 ELSE COLOR 7, 0
ELSE
IF I / 2 = I \ 2 THEN COLOR 7, 0 ELSE COLOR 0, 7
END IF
PRINT SPACE$(5);
NEXT I
IF H = 8 AND J = 2 THEN ELSE PRINT : LOCATE , LM%
NEXT J
NEXT H

REM BORDER
COLOR 7, 0
LOCATE TM% - 1, LM% - 1
PRINT CHR$(218); STRING$(40, 196); CHR$(191)
LOCATE , LM% - 1
FOR I = 1 TO 17
PRINT CHR$(179)
LOCATE , LM% - 1
NEXT I
LOCATE TM%, LM% - 1
FOR I = 1 TO 17
LOCATE , 40 + LM%
PRINT CHR$(179)
NEXT I
LOCATE TM% - 2 + 18, LM% - 1
PRINT CHR$(192); STRING$(40, 196); CHR$(217)

REM NUMBERING
COLOR 7, 1
LOCATE TM% + 17, LM% + 2

IF mode$ = "W" OR mode$ = "BW" THEN
FOR I% = 1 TO 8
PRINT LCASE$(CHR$(64 + I%)) + SPACE$(4);
NEXT I%
ELSE
FOR I% = 1 TO 8
PRINT LCASE$(CHR$(73 - I%)) + SPACE$(4);
NEXT I%
END IF

LOCATE TM% + 1, 40 + LM% + 2
IF mode$ = "W" OR mode$ = "BW" THEN
FOR I% = 1 TO 8
PRINT CHR$(57 - I%);
LOCATE CSRLIN + 2, 40 + LM% + 2
NEXT I%
ELSE
FOR I% = 1 TO 8
PRINT CHR$(48 + I%);
LOCATE CSRLIN + 2, 40 + LM% + 2
NEXT I%
END IF

RETURN

END FUNCTION

Posted on Dec 30, 2005, 8:45 PM
from IP address 68.6.85.9

Respond to this message   

Return to Index


Response TitleAuthor and Date
Mouse driver added...Pete on Dec 30
 Great! Found one bug on Dec 31
  Not a bug, another feature...Pete on Dec 31
   Good on Dec 31
    If any move is legal - nope...Pete on Dec 31