You can use your web browser to copy this program to the clipboard. Then paste it into any text editor (like Windows Notepad), and save it in a file called "chess.bas". Then use DOS QBASIC to open the file and run it.
Instructions to Run
' Copyright @ 2001 by Robert M. Kuczewski ' Right to copy is granted to all provided all Copyright notices are maintained DECLARE FUNCTION encodeCmd$ (fromX AS INTEGER, fromY AS INTEGER, toX AS INTEGER, toY AS INTEGER) DECLARE FUNCTION DoCmd (command AS STRING, fromRow AS INTEGER, fromCol AS INTEGER, toRow AS INTEGER, toCol AS INTEGER) DECLARE SUB NewBoard () DECLARE SUB RotateBoard () DECLARE SUB DrawBoard () DECLARE SUB DrawFig (x AS INTEGER, y AS INTEGER, w AS INTEGER, h AS INTEGER, c AS INTEGER, s AS STRING) DIM SHARED board(8, 8) AS STRING * 1 'Pawn Rook, kNight, Bishop, Queen, King (caps are white, lower are black) DIM SHARED blackPieces AS STRING: blackPieces = "rnbqkbnr" DIM SHARED whitePieces AS STRING: whitePieces = "RNBQKBNR" DIM SHARED whitelabels AS STRING: whitelabels = " QR QN QB Q K KB KN KR" DIM SHARED blacklabels AS STRING: blacklabels = " KR KN KB K Q QB QN QR" DIM SHARED labels AS STRING: labels = whitelabels DIM SHARED gameMode AS STRING DIM SHARED gameView AS STRING DIM SHARED gameTurn AS STRING DIM SHARED command AS STRING DIM SHARED boardw AS INTEGER, boardh AS INTEGER, boardx AS INTEGER, boardy AS INTEGER DIM SHARED squarew AS INTEGER, squareh AS INTEGER DIM fromRow AS INTEGER, fromCol AS INTEGER, toRow AS INTEGER, toCol AS INTEGER DIM moveCode AS INTEGER CONST fileClosed = 0, fileReading = 1, fileWriting = 2 DIM fileMode AS INTEGER: fileMode = fileClosed DIM fileName AS STRING: fileName = "chessmov.txt" DIM fileFound AS INTEGER: fileFound = 0 DIM newGame AS INTEGER: newGame = 1 CONST moveHistLen = 1000 DIM SHARED moveHistory(moveHistLen) AS STRING * 7 DIM inputRow AS INTEGER: inputRow = 24 DIM fileVersion AS INTEGER: fileVersion = 0 ' Set up the mouse variables and call interface DIM fromX AS INTEGER, fromY AS INTEGER, toX AS INTEGER, toY AS INTEGER DIM mouseg AS INTEGER, mouse AS INTEGER, mouseExists AS INTEGER DIM Buttons AS INTEGER ON ERROR GOTO Handler SCREEN 12 CLS PRINT "" PRINT "Opening ["; fileName; "]" fileFound = 1 OPEN fileName FOR INPUT AS #1 IF fileFound = 0 THEN OPEN fileName FOR OUTPUT AS #1 PRINT #1, fileVersion fileMode = fileWriting ELSE INPUT #1, fileVersion fileMode = fileReading END IF DO IF newGame <> 0 THEN FOR i = 1 TO moveHistLen moveHistory(i) = " " NEXT i CLS LOCATE 1, 1 mouseExists = 1 INPUT "Use the mouse (0 or 1)"; mouseExists IF mouseExists THEN DEF SEG = 0 mouseg = 256 * PEEK(207) + PEEK(206) mouse = 256 * PEEK(205) + PEEK(204) + 2 DEF SEG = mouseg IF ((mouseg OR (mouse - 2)) AND (PEEK(mouse - 2) <> 207)) = 0 THEN mouseExists = 0 END IF DEF SEG END IF IF mouseExists THEN 'Reset the mouse and get its status m1% = 0: DEF SEG = mouseg: CALL absolute(m1%, m2%, m3%, m4%, mouse): DEF SEG IF m1% <> -1 THEN mouseExists = 0 END IF END IF IF mouseExists THEN 'Turn on the mouse cursor m1% = 1: DEF SEG = mouseg: CALL absolute(m1%, m2%, m3%, m4%, mouse): DEF SEG 'Turn off the mouse cursor m1% = 2: DEF SEG = mouseg: CALL absolute(m1%, m2%, m3%, m4%, mouse): DEF SEG END IF CLS 'Ask for the initial mode INPUT "White? Black? Rotate"; gameMode gameMode = UCASE$(MID$(gameMode, 1, 1)) gameView = gameMode IF gameView = "R" THEN gameView = "W" END IF gameTurn = "W" CLS 'Create a new board NewBoard newGame = 0 END IF IF (gameMode = "B") OR ((gameMode = "R") AND (gameTurn = "B")) THEN RotateBoard DrawBoard RotateBoard ELSE DrawBoard END IF IF fileMode = fileReading THEN ' Reading from file IF EOF(1) THEN fileMode = fileWriting CLOSE #1 fileFound = 1 OPEN fileName FOR APPEND AS #1 IF fileFound = 0 THEN OPEN fileName FOR OUTPUT AS #1 END IF command = "" ELSE LINE INPUT #1, command END IF ELSE FOR i = 1 TO inputRow - 1 LOCATE i, 1 PRINT moveHistory(inputRow - i); " "; NEXT i LOCATE inputRow, 1 PRINT " "; LOCATE inputRow, 1 PRINT gameTurn; "> "; IF mouseExists THEN 'Turn on the mouse cursor m1% = 1: DEF SEG = mouseg: CALL absolute(m1%, m2%, m3%, m4%, mouse): DEF SEG Buttons = 0 DO ' Read the Mouse Button Status and Position m1% = 3: DEF SEG = mouseg: CALL absolute(m1%, m2%, m3%, m4%, mouse): DEF SEG Buttons = m2% IF Buttons <> 0 THEN IF (m3% < boardx) OR (m3% > (boardx + boardw)) OR (m4% < boardy) OR (m4% > (boardy + boardh)) THEN Buttons = -1 END IF END IF LOOP WHILE ABS(Buttons) <> 1 fromX = m3%: fromY = m4%: toX = m3%: toY = m4% IF Buttons < 0 THEN command = "Keybrd" ELSE Buttons = 0 DO ' Read the Mouse Button Status and Position m1% = 3: DEF SEG = mouseg: CALL absolute(m1%, m2%, m3%, m4%, mouse): DEF SEG Buttons = m2% IF Buttons = 1 THEN ' LOCATE inputRow, 1 fromX = m3%: fromY = m4% ' PRINT "From "; fromX; fromY END IF LOOP WHILE Buttons <> 2 toX = m3%: toY = m4% command = encodeCmd$(fromX, fromY, toX, toY) END IF IF command = "Keybrd" THEN LOCATE inputRow, 1 PRINT gameTurn; "> "; INPUT ; "", command END IF 'Turn off the mouse cursor m1% = 2: DEF SEG = mouseg: CALL absolute(m1%, m2%, m3%, m4%, mouse): DEF SEG ELSE LINE INPUT command END IF END IF moveCode = 0 IF (command = "?") OR (LCASE$(command) = "help") THEN CLS PRINT "Help:" PRINT " 'new' starts a new game" PRINT " 'open filename' runs old game" PRINT " 'quit' exits (game in chessmov.txt)" PRINT " All regular moves use ColRowColRow:" PRINT " Where Col is QR QN QB Q K KB KN KR" PRINT " and Row is a number from 1 to 8" PRINT " For example: k2k4 or qn1qb3" PRINT " oo is castling on the King's side" PRINT " ooo is castling on the Queen's side" PRINT " Left Mouse Button selects 'From'" PRINT " Right Mouse Button moves 'To'" PRINT " " PRINT "Press any key to continue..."; LINE INPUT command command = "" CLS ELSEIF LCASE$(MID$(command, 1, 3)) = "new" THEN newGame = 1 CLOSE #1 fileName = LTRIM$(RTRIM$(MID$(command, 4))) PRINT "" PRINT "Opening ["; fileName; "]" fileFound = 1 OPEN fileName FOR OUTPUT AS #1 IF fileFound = 0 THEN fileMode = fileClosed ELSE PRINT #1, fileVersion fileMode = fileWriting END IF ELSEIF LCASE$(MID$(command, 1, 4)) = "open" THEN newGame = 1 CLOSE #1 fileName = LTRIM$(RTRIM$(MID$(command, 5))) PRINT "" PRINT "Opening ["; fileName; "]" fileFound = 1 OPEN fileName FOR INPUT AS #1 IF fileFound = 0 THEN OPEN fileName FOR OUTPUT AS #1 PRINT #1, fileVersion fileMode = fileWriting ELSE INPUT #1, fileVersion fileMode = fileReading END IF ELSEIF LCASE$(MID$(command, 1, 4)) = "quit" THEN END ELSE IF (UCASE$(MID$(command, 1, 1)) <> "B") AND (UCASE$(MID$(command, 1, 1)) <> "W") THEN command = gameTurn + command END IF moveCode = DoCmd(command, fromRow, fromCol, toRow, toCol) IF moveCode > 0 THEN IF fileMode = fileWriting THEN PRINT #1, command END IF FOR i = moveHistLen TO 2 STEP -1 moveHistory(i) = moveHistory(i - 1) NEXT i moveHistory(1) = command IF gameTurn = "W" THEN gameTurn = "B" ELSE gameTurn = "W" END IF END IF CLS END IF LOOP Handler: SELECT CASE ERR CASE 52 fileFound = 0 RESUME NEXT CASE 53 fileFound = 0 RESUME NEXT CASE 71 PRINT PRINT "Error "; ERR; " on line "; ERL PRINT "Using device "; ERDEV$; " device error code = "; ERDEV RESUME NEXT CASE 11 PRINT PRINT "Error "; ERR; " on line "; ERL INPUT "What value do you want to divide by"; y% RESUME 'Retry line 30 with new value of y%. CASE ELSE PRINT PRINT "Error "; ERR; " on line "; ERL PRINT "Unexpected error, ending program." END END SELECT FUNCTION DoCmd (command AS STRING, fromRow AS INTEGER, fromCol AS INTEGER, toRow AS INTEGER, toCol AS INTEGER) DIM result AS INTEGER DIM nxt AS INTEGER DIM side AS INTEGER DIM col AS INTEGER DIM row AS INTEGER DIM temps AS STRING nxt = 1 IF (UCASE$(MID$(command, nxt, 1)) = "B") OR (UCASE$(MID$(command, nxt, 1)) = "W") THEN nxt = nxt + 1 END IF IF (1 = 0) AND (UCASE$(MID$(command, nxt, 1)) <> gameTurn) THEN PRINT "Command Error: "; command; " <> "; gameTurn result = 0 DoCmd = 0 EXIT FUNCTION ELSE nxt = nxt + 1 nxt = nxt - 1 IF UCASE$(MID$(command, nxt, 3)) = "OOO" THEN 'Castle on Queen's Side (move King first) fromRow = 1 ' King's row IF (gameTurn = "W") THEN fromRow = 9 - fromRow END IF toRow = fromRow 'Now Move the King (remembering board is a zero-based array) board(toRow - 1, 2) = board(fromRow - 1, 4) board(fromRow - 1, 4) = " " 'Now Move the Rook (remembering board is a zero-based array) board(toRow - 1, 3) = board(fromRow - 1, 0) board(fromRow - 1, 0) = " " result = 9000 ELSEIF UCASE$(MID$(command, nxt, 2)) = "OO" THEN 'Castle on King's Side (move King first) fromRow = 1 ' King's row IF (gameTurn = "W") THEN fromRow = 9 - fromRow END IF toRow = fromRow 'Now Move the King (remembering board is a zero-based array) board(toRow - 1, 6) = board(fromRow - 1, 4) board(fromRow - 1, 4) = " " 'Now Move the Rook (remembering board is a zero-based array) board(toRow - 1, 5) = board(fromRow - 1, 7) board(fromRow - 1, 7) = " " result = 9900 ELSE 'This is a non-castling move that must have a "from" and a "to" FOR location = 1 TO 2 IF UCASE$(MID$(command, nxt, 2)) = "QR" THEN col = 1: nxt = nxt + 2 ELSEIF UCASE$(MID$(command, nxt, 2)) = "QN" THEN col = 2: nxt = nxt + 2 ELSEIF UCASE$(MID$(command, nxt, 2)) = "QB" THEN col = 3: nxt = nxt + 2 ELSEIF UCASE$(MID$(command, nxt, 2)) = "KR" THEN col = 8: nxt = nxt + 2 ELSEIF UCASE$(MID$(command, nxt, 2)) = "KN" THEN col = 7: nxt = nxt + 2 ELSEIF UCASE$(MID$(command, nxt, 2)) = "KB" THEN col = 6: nxt = nxt + 2 ELSEIF UCASE$(MID$(command, nxt, 1)) = "Q" THEN col = 4: nxt = nxt + 1 ELSEIF UCASE$(MID$(command, nxt, 1)) = "K" THEN col = 5: nxt = nxt + 1 ELSE PRINT "Command Error: "; command; " <> "; gameTurn result = 0 DoCmd = 0 EXIT FUNCTION END IF row = VAL(MID$(command, nxt, 1)) nxt = nxt + 1 IF (row < 1) OR (row > 8) THEN PRINT "Command Error: "; command; " <> "; gameTurn result = 0 DoCmd = 0 EXIT FUNCTION END IF IF location = 1 THEN fromRow = row fromCol = col ELSE toRow = row toCol = col END IF NEXT location ' Invert the rows for white since white looks "up" into the board array IF (gameTurn = "W") THEN fromRow = 9 - fromRow toRow = 9 - toRow END IF result = (((((fromRow * 10) + fromCol) * 10) + toRow) * 10) + toCol IF result > 0 THEN 'Make the actual move remembering that the board is 0-based board(toRow - 1, toCol - 1) = board(fromRow - 1, fromCol - 1) board(fromRow - 1, fromCol - 1) = " " END IF END IF END IF DoCmd = result END FUNCTION SUB DrawBoard DIM pieceName AS STRING * 1 DIM x AS INTEGER, y AS INTEGER, c AS INTEGER boardw = 370 boardh = 370 boardx = 638 - boardw boardy = 1 squarew = boardw / 8 squareh = boardh / 8 ' First draw the board LINE (boardx - 1, boardy - 1)-(boardx + boardw + 1, boardy + boardh + 1), 15, BF FOR row = 0 TO 7 y = boardy + (row * squareh) FOR col = 0 TO 7 x = boardx + (col * squarew) IF (row + col) MOD 2 <> 0 THEN LINE (x, y)-(x + squarew, y + squareh), 8, BF ELSE LINE (x, y)-(x + squarew, y + squareh), 7, BF END IF NEXT col NEXT row ' Now draw the pieces FOR row = 0 TO 7 y = boardy + (row * squareh) FOR col = 0 TO 7 x = boardx + (col * squarew) pieceName = board(row, col) IF pieceName >= "a" THEN c = 0 ELSE c = 15 END IF pieceName = LCASE$(pieceName) IF pieceName = "p" THEN CIRCLE (x + (squarew / 2), y + (squareh / 2)), squareh / 6, c PAINT (x + (squarew / 2), y + (squareh / 2)), c, c ELSEIF pieceName = "r" THEN CALL DrawFig(x, y, squarew, squareh, c, ".65 +3 -3 +7+0 -1-1 +0-1 -1-1 +0-4 +1+0 +0-2 -1+0 +0+1 -1+0 +0-1 -1+0 +0+1 -1+0 +0-1 -1+0 +0+2 +1+0 +0+4 -1+1 +0+1 -1+1") ELSEIF pieceName = "n" THEN CALL DrawFig(x, y, squarew, squareh, c, ".75 +4 -4 +5+0 +1-3 +0-4 -1-2 -2-1 -1-2 -1+2 -3+2 +0+1 +4+0 -2+2 -1+2 +0+2 +1+1") ELSEIF pieceName = "b" THEN CALL DrawFig(x, y, squarew, squareh, c, ".8 +3 -2 +7+0 -1-1 +0-1 -1-1 +0-5 +1+0 -1-1 +1-2 -1-2 -1-1 +0-1 -1+0 +0+1 +0+3 -1-2 -1+2 +1+2 -1+1 +1+0 +0+5 -1+1 +0+1 -1+1") ELSEIF pieceName = "q" THEN CALL DrawFig(x, y, squarew, squareh, c, ".85 +0 -3 +10+0 -1-2 -2-10 +0-4 +2+0 -1-1 +0-2 +1-4 -2+2 -1-2 -1+2 -1-2 -1+2 -2-2 +1+4 +0+2 -1+1 +2+0 +0+4 -2+10 -1+2 +5+0") ELSEIF pieceName = "k" THEN CALL DrawFig(x, y, squarew, squareh, c, ".9 +0 -3 +7+0 -1-2 -1-6 +1+0 -1-1 +2-2 +0-1 -1-1 -2+0 +0-1 +1+0 +0-1 -1+0 +0-1 -1+0 +0+1 -1+0 +0+1 +1+0 +0+1 -2+0 -1+1 +0+1 +2+2 -1+1 +1+0 -1+6 -1+2 +3+0") ELSEIF board(row, col) <> " " THEN CIRCLE (x + (squarew / 2), y + (squareh / 2)), squareh / 4, c PAINT (x + (squarew / 2), y + (squareh / 2)), c, c END IF NEXT col NEXT row 'Finally Draw the labels LOCATE 25, 35 PRINT labels; FOR row = 1 TO 8 LOCATE (3 * row) - 1, 30 IF gameTurn <> gameView THEN PRINT row ELSE PRINT 9 - row END IF NEXT row END SUB SUB DrawFig (x AS INTEGER, y AS INTEGER, w AS INTEGER, h AS INTEGER, c AS INTEGER, drawString AS STRING) DIM s AS STRING DIM pass AS INTEGER DIM p, m, i AS INTEGER DIM minx AS INTEGER, maxx AS INTEGER, miny AS INTEGER, maxy AS INTEGER DIM curx AS INTEGER, cury AS INTEGER minx = 0: maxx = 0: miny = 0: maxy = 0 xoffset = 5 xscale = 3 yoffset = 2 yscale = 3 FOR pass = 1 TO 2 s = drawString scale = VAL(s): i = INSTR(1, s, " "): s = MID$(s, i + 1) filldx = VAL(s): i = INSTR(1, s, " "): s = MID$(s, i + 1) filldy = VAL(s): i = INSTR(1, s, " "): s = MID$(s, i + 1) curx = 0: cury = 0 IF pass = 2 THEN xscale = w / (maxx - minx) yscale = h / (maxy - miny) IF xscale < yscale THEN yscale = xscale ELSE xscale = yscale END IF xscale = scale * xscale yscale = scale * yscale xoffset = (w - (xscale * (maxx - minx))) / 2 yoffset = 2 LINE (x + xoffset, y + h - yoffset)-(x + xoffset, y + h - yoffset) END IF DO WHILE LEN(s) > 0 dx = VAL(s) p = INSTR(2, s, "+") m = INSTR(2, s, "-") i = p IF (m > 0) AND (m < p) THEN i = m IF i > 0 THEN s = MID$(s, i) ELSE EXIT DO END IF dy = VAL(s) p = INSTR(2, s, "+") m = INSTR(2, s, "-") i = p IF (m > 0) AND (m < p) THEN i = m IF i > 0 THEN s = MID$(s, i) END IF curx = curx + dx cury = cury + dy IF pass = 1 THEN IF curx > maxx THEN maxx = curx IF cury > maxy THEN maxy = cury IF curx < minx THEN minx = curx IF cury < miny THEN miny = cury ELSE ' PRINT dx; dy LINE -STEP(xscale * dx, yscale * dy), c END IF LOOP IF pass > 1 THEN PAINT STEP(xscale * filldx, yscale * filldy), c END IF NEXT pass END SUB FUNCTION encodeCmd$ (fromX AS INTEGER, fromY AS INTEGER, toX AS INTEGER, toY AS INTEGER) DIM fr AS INTEGER, fc AS INTEGER, tr AS INTEGER, tc AS INTEGER DIM colCodes(8) AS STRING colCodes(1) = "qr" colCodes(2) = "qn" colCodes(3) = "qb" colCodes(4) = "q" colCodes(5) = "k" colCodes(6) = "kb" colCodes(7) = "kn" colCodes(8) = "kr" fc = 1 + ((fromX - boardx) \ squarew) tc = 1 + ((toX - boardx) \ squarew) fr = 8 - ((fromY - boardy) \ squareh) tr = 8 - ((toY - boardy) \ squareh) IF (LCASE$(gameMode) <> "r") AND (LCASE$(gameMode) <> LCASE$(gameTurn)) THEN fr = 9 - fr tr = 9 - tr END IF IF LCASE$(gameMode) <> "w" THEN fc = 9 - fc tc = 9 - tc END IF IF (LCASE$(gameMode) = "r") AND (LCASE$(gameTurn) = "w") THEN fc = 9 - fc tc = 9 - tc END IF IF (fr < 1) OR (fc < 1) OR (tr < 1) OR (tc < 1) OR (fr > 8) OR (fc > 8) OR (tr > 8) OR (tc > 8) THEN encodeCmd$ = "Keybrd" ELSE encodeCmd$ = colCodes(fc) + HEX$(fr) + colCodes(tc) + HEX$(tr) ' + gameMode + gameView + gameTurn END IF END FUNCTION SUB NewBoard DIM row AS INTEGER, col AS INTEGER ' First clear the board FOR row = 0 TO 7 FOR col = 0 TO 7 board(row, col) = " " NEXT col NEXT row ' Then set up all the pieces with White as the default FOR col = 0 TO 7 board(0, col) = MID$(blackPieces, col + 1, 1) board(7, col) = MID$(whitePieces, col + 1, 1) board(1, col) = "p" board(6, col) = "P" NEXT col END SUB SUB RotateBoard FOR row = 0 TO 3 FOR col = 0 TO 7 temp$ = board(row, col) board(row, col) = board(7 - row, 7 - col) board(7 - row, 7 - col) = temp$ NEXT col NEXT row IF labels = whitelabels THEN labels = blacklabels gameView = "B" ELSE labels = whitelabels gameView = "W" END IF END SUB