2000
Subj : more chess
To   : All
From : Jasen Betts
Date : Sat Nov 24 2001 05:14 am

Hi All.

 here's the latest version of that chess batch.
 undo/redo now work (almost)

 to start a fresh game enter restart at the 'move' prompt or delete chess.dat

 there's a bug in that if you don't overwrite all the undos on re-starting
 the batch it restarts at the wrong position and you'll have to undo back
 to the last move.

 I'm looking for a way to truncate a file but I can't find one -
 %@fileseek[%fh,0,1] doesn't do it like it 'should' - 4dos
 treats that a a special case :(


@echo off
:: chessboard prog.
:: 2001 by Jasen Betts
:: fidonet 3:640/531.42   email jasen_betts@yahoo.com.au

if not 4dos == 4DOS goto moreenv
*setlocal
*unalias *

rem set display mode (uncomment as apropriate)

iff %_columns lt 80  .or. %_rows lt 43  then
rem
  stm 80x43x9
rem  mode con: cols=80 lines=43
  do while %_columns lt 80  .or. %_rows lt 43
  input enter command to set screen to 80x43 or larger,%=
 quit to cancel %=n%=> %%c
  %c
  enddo
endiff
cls

setdos /b0
setdos /b1
unset *
loadbtm on
if %_env ge 799 goto enough
:moreenv
c:\4dos\4dos /E:800 /C %0
goto end_of_batch
:enough

alias bad_move=goto get_move


set fh=%@fileopen[chess.dat,append,b]
set fs=%@eval[%@filesize[chess.dat]/80-1]
if %fs ne %@int[%fs] set fs=0
set move=%fs

iff %move gt 0 then
  set x=%@fileseek[%fh,-80,2]
  gosub read_move %move
else
  gosub newboard
endiff

:redraw
for x in (0 1 2 3 4 5 6 7) for y in (0 1 2 3 4 5 6 7) set v%x%y=.
drawbox 0 16 41 73 2 7 on 8

:drawboard
for x in (0 3 6 1 4 7 2 5) do (
  scrput 0 %@eval[%x*7+20] 1 on 14 %@char[%@eval[%x+65]]
  scrput 41 %@eval[%x*7+20] 1 on 14 %@char[%@eval[%x+65]]
  scrput %@eval[%x*5+3] 16 1 on 14 %@eval[8-%x]
  scrput %@eval[%x*5+3] 73 1 on 14 %@eval[8-%x]
)

set x=4  %+ set y=4 %+ set x1=1
do while %y lt 8
    if "%[b%x%%y%]" ne "%[v%x%%y%]" gosub showboard %x %y
    if %x == %y  ( set y1=%@eval[ 0 - %x1 ] %+ set x1=0)
    if %@eval[ (15 + %y1) / 2 - %y ] == %x ( set x1=%y1 %+ set y1=0)
    set x=%@eval[%x+%x1]
    set y=%@eval[%y+%y1]
enddo

:: ***** MAIN LOOP *****
:main_loop

:get_move
set ep=
rem screen 31 0 env:%_env
rem screen 32 0 move %move%/%fs%
rem screen 33 0 fh/fp %fh/???

screen 18 0  %player%'s
screen 19,1 move:
screen 20 0 [  -  ]
screen 20 1
input %%mov

if "%mov" == "" bad_move
switch %mov
case debug
             set debug=%@if[ "%debug" == "1" ,,1]
case quit .or. resign
             goto resign
case restart
             gosub newboard
             goto drawboard
case undo
             if %move lt 1 bad_move
             set move=%@dec[%move]
             gosub read_move %move
             goto drawboard
case redo
             if %move ge %fs bad_move
             set move=%@inc[%move]
             gosub read_move %move
             goto drawboard
case redraw .or. refresh
             goto redraw
endswitch

for x in (x0 y0 x1 y1) set %x=-

set a=0
set b=0
do x = 1 to %@words[%@ascii[%mov]]
  set y=%@word[%x, 0 %@ascii[%mov]]
  set a=%@inc[%a]

  if %a==3 set b=1
  if %a==3 .and. %y == 45 iterate
  if %y lt 49 bad_move
  if %y lt 58 (if %[y%b] ne - bad_move %+set y%b=%@eval[56-%y] %+iterate)
  if %[x%b] ne - bad_move
  if %y lt 65 bad_move
  if %y lt 73 ( set x%b=%@eval[%y-65] %+ iterate )
  if %y lt 97 bad_move
  if %y lt 105 ( set x%b=%@eval[%y-97] %+ iterate )
  bad_move

enddo

for x in (x0 y0 x1 y1) do if %[%x] == - bad_move

:: hands off opponents pieces
set x=%@ascii[%[b%x0%%y0]]
if "%x" == ""  bad_move
if %player == white .XOR. %x lt 95 bad_move

:: can't capture own pieces
set y=%@ascii[%[b%x1%%y1]]
if "%y" ne "" if %player == white .xor. %y gt 95 bad_move

:: move rules.... X's are letters, columns   Y's are numbers, rows.

set x=%@abs[%@eval[%x0-%x1]]
set y=%@abs[%@eval[%y0-%y1]]

if "%debug" ne "" setdos /y1

switch %[b%x0%%y0]

case K
     iff %x gt 1 then
       if "%[m4%y0]" eq ""  bad_move
       if %y ne 0 bad_move
       switch %x1
       case 6
         if %@ascii[%[b7%y0]] ne %@eval[%@ascii[%[b4%y0]]+7] bad_move
         if "%[b5%y0]" ne "" .or. "%[b6%y0]" ne "" bad_move
         gosub move 4 %y0 6 %y0
         set x0=7
         set x1=5
      case 1
         if %@ascii[%[b0%y0]] ne %@eval[%@ascii[%[b%x0%%y0]]+7] bad_move
         if "%[b3%y0]" ne "" .or. "%[b2%y0]" ne "" .or. "%[b1%y0]" ne "" 
bad_move
         gosub move 4 %y0 1 %y0
         set x0=0
         set x1=2
       default 
         bad_move
       endswitch
       for j in (m4%y0 m0%y0 m7%y0) set %j=
     else
       if %@eval[ %x + %y ] ne 1 bad_move
       set m%x%%y=
     endiff
case N
     if %@eval[ %x ** 2 + %y ** 2 ] ne 5 bad_move
case Q
     if %x ne %y goto rook_move
     goto bishop_move
case P
     if %player == white .xor. %y0 gt %y1 bad_move
     switch %y
     case 1
       switch %x
       case 0
         if "%[b%x1%%y1]" ne ""  bad_move
       case 1
         iff "%x1%%y1%" == "%enpassant%" then
           set b%pdx%%pdy=
           gosub showboard %pdx %pdy
         else
           if "%[b%x1%%y1]" == "" bad_move
         endiff
       default
         bad_move
       endswitch
     case 2
       if %x ne 0 bad_move
       if %y0 ne 1 .and. %y0 ne 6 bad_move
       set ep=%x1%%@eval[ (%y1 + %y0)/2 ]
       if "%[b%x1%%y1]" ne "" bad_move
       if "%[b%ep]" ne "" bad_move
       set pdx=%x1
       set pdy=%y1
     default
       bad_move
     endswitch
case R
:rook_move
     if %x0 ne %x1 .xor. %y0 == %y1 bad_move
     set a= %x+%y
     do z=1 to %@eval[ %x + %y - 1 ]
       set x=%@eval[ %x0 + ( %x1 - %x0 ) / ( %a ) * %z]
       set y=%@eval[ %y0 + ( %y1 - %y0 ) / ( %a ) * %z]
       if "%[b%x%%y]" ne "" bad_move
     enddo
      set m%x%%y=
case B
:bishop_move
     if %x ne %y bad_move
     set a=%x
     do z=1 to %@eval[ %x - 1 ]
       set x=%@eval[ %x0 + ( %x1 - %x0 ) / ( %a ) * %z]
       set y=%@eval[ %y0 + ( %y1 - %y0 ) / ( %a ) * %z]
       if "%[b%x%%y]" ne "" bad_move
     enddo
endswitch
:move_ok

gosub move %x0 %y0 %x1 %y1

:: save move
gosub write_move
:: swap sides for opponent play.
set enpassant=%ep
set x=%player
set player=%opponent
set opponent=%x
goto get_move

:move [x0 y0 x1 y1]
set b%x1%%y1=%[b%x0%%y0]
set b%x0%%y0=
gosub showboard %x0 %y0
gosub showboard %x1 %y1
beep 3,3
return

:showboard [ x y ]
set p=%[b%x%%y%]
set v%x%%y=%p
set bg=%@eval[7+ (%x+%y) %% 2] 
set sx=%@eval[17 + %x * 7]
set sy=%@eval[1 + %y * 5]
set fg=%@if[ 0%@ascii[%p%] lt 96,15,0]
switch %p
case p
  scrput %sy %sx %fg on %bg `       `  %+ set sy=%@inc[%sy]
  scrput %sy %sx %fg on %bg `   _   `  %+ set sy=%@inc[%sy]
  scrput %sy %sx %fg on %bg `  (@)  `  %+ set sy=%@inc[%sy]
  scrput %sy %sx %fg on %bg `   X   `  %+ set sy=%@inc[%sy]
  scrput %sy %sx %fg on %bg `  /X\  `
case r 
  scrput %sy %sx %fg on %bg ` ::::: `  %+ set sy=%@inc[%sy]
  scrput %sy %sx %fg on %bg ` \###/ `  %+ set sy=%@inc[%sy]
  scrput %sy %sx %fg on %bg `  |#|  `  %+ set sy=%@inc[%sy]
  scrput %sy %sx %fg on %bg `  |#|  `  %+ set sy=%@inc[%sy]
  scrput %sy %sx %fg on %bg ` /#O#\ ` 
case q 
  scrput %sy %sx %fg on %bg `  .W.  `  %+ set sy=%@inc[%sy]
  scrput %sy %sx %fg on %bg `  (@)  `  %+ set sy=%@inc[%sy]
  scrput %sy %sx %fg on %bg `   X   `  %+ set sy=%@inc[%sy]
  scrput %sy %sx %fg on %bg `   X   `  %+ set sy=%@inc[%sy]
  scrput %sy %sx %fg on %bg `  /X\  ` 
case k
  scrput %sy %sx %fg on %bg `   +   `  %+ set sy=%@inc[%sy]
  scrput %sy %sx %fg on %bg `  (@)  `  %+ set sy=%@inc[%sy]
  scrput %sy %sx %fg on %bg `   H   `  %+ set sy=%@inc[%sy]
  scrput %sy %sx %fg on %bg `   H   `  %+ set sy=%@inc[%sy]
  scrput %sy %sx %fg on %bg `  /H\  ` 
case b
  scrput %sy %sx %fg on %bg `   o,  `  %+ set sy=%@inc[%sy]
  scrput %sy %sx %fg on %bg `  (/)  `  %+ set sy=%@inc[%sy]
  scrput %sy %sx %fg on %bg `  '%   `  %+ set sy=%@inc[%sy]
  scrput %sy %sx %fg on %bg `   %   `  %+ set sy=%@inc[%sy]
  scrput %sy %sx %fg on %bg `  /%\  ` 
case n 
  scrput %sy %sx %fg on %
7fc
bg `   _=  `  %+ set sy=%@inc[%sy]
  scrput %sy %sx %fg on %bg `  /`%=``|  `  %+ set sy=%@inc[%sy]
  scrput %sy %sx %fg on %bg ` :/ |  `  %+ set sy=%@inc[%sy]
  scrput %sy %sx %fg on %bg `  | |  `  %+ set sy=%@inc[%sy]
  scrput %sy %sx %fg on %bg `  /_\  ` 
default 
  scrput %sy %sx 0 on %bg `       `  %+ set sy=%@inc[%sy]
  scrput %sy %sx 0 on %bg `       `  %+ set sy=%@inc[%sy]
  scrput %sy %sx 0 on %bg `       `  %+ set sy=%@inc[%sy]
  scrput %sy %sx 0 on %bg `       `  %+ set sy=%@inc[%sy]
  scrput %sy %sx 0 on %bg `       `
endswitch
return
:newboard
unset b??
set b00=r %+ set b10=n %+ set b20=b %+ set b30=q
set b40=k %+ set b50=b %+ set b60=n %+ set b70=r
set b07=R %+ set b17=N %+ set b27=B %+ set b37=Q
set b47=K %+ set b57=B %+ set b67=N %+ set b77=R
set m00=0 %+ set m07=0 %+ set m70=0 %+ set m77=0 %+ set m47=0 %+ set m40=0
for x in (0 1 2 3 4 5 6 7) do ( set b%x1=p %+ set b%x6=P )
set move=0
set fs=0
set player=white
set x=%@fileseek[%fh,0,0]
set opponent=black
cls
:write_move
if %fh lt 1 return
for y in (0 1 2 3 4 5 6 7) for x in (0 1 2 3 4 5 6 7) (
  set z=%@filewriteb[%fh,1,%[b%x%y]]
  )
for x in (0 4 7) for y in (0 7) (
  set z=%@filewriteb[%fh,1,%[m%x%y]]
  )
set x=%@filewriteb[%fh,1,%player]
set x=%@filewriteb[%fh,7,..........]
set x=%@filewriteb[%fh,1,%@char[13]]
set x=%@filewriteb[%fh,1,%@char[10]]
set move=%@inc[%move]
set fs=%move
return

:read_move [n]
iff "%n" ne "" then
  if %n gt %fs goto newboard
  set move=%n
  set x=%@fileseek[%fh,%@eval[80*%n],0];
endiff
if %fh lt 1 goto newboard
for y in (0 1 2 3 4 5 6 7) for x in (0 1 2 3 4 5 6 7) (
  set b%x%y=%@fileread[%fh,1]
  )
for x in (0 4 7) for y in (0 7) (
  set m%x%y=%@fileread[%fh,1]
  )
iff %@fileread[%fh,1]==w then
 set player=black
 set opponent=white
else
 set player=white
 set opponent=black
endiff

set x=%@fileread[%fh,9]
return

:resign
set fh=%@fileclose[%fh]

:end_of_batch
*---/
 -=> Bye <=-

---
 * Origin: Chicken Little was right. (3:640/531.42)

.

0