Has anyone produced a chess engine in forth?
let me know by email also?
mknoiret@aol.com

_______________________________________________________________________________
Posted Via Uncensored-News.Com - Accounts Starting At $6.95 - http://www.uncensored-news.com
               <><><><><><><>   The Worlds Uncensored News Source   <><><><><><><><>
  

Op 24 Dec 2004 01:33:58 GMT schreef Michael Kramer:

> Has anyone produced a chess engine in forth?
Just google for 'forth chess program'
The first link points to ultratechnology with an extensive
description

> let me know by email also?

No, this is usenet, post here, read here

-- 
Coos

Michael Kramer wrote:
> Has anyone produced a chess engine in forth?
> let me know by email also?
> mknoiret@aol.com
>
>
_______________________________________________________________________________
> Posted Via Uncensored-News.Com - Accounts Starting At $6.95 -
http://www.uncensored-news.com
>                <><><><><><><>   The Worlds Uncensored News Source
<><><><><><><><>

Try downloading win32forth from sf.net/projecrs/win32forth, version
6.08; there's a chess engine, courtesy of Ian Osgood, with an OpenGL
interface to display the pieces.

-- 
Regards
Alex McDonald

Michael Kramer wrote:

>let me know by email also?

Why you shouldn't ask for E-mail responses on Usenet
http://www.cs.tut.fi/~jkorpela/usenet/mail-responses.html

Guy Macon wrote:

> Michael Kramer wrote:
> 
> 
>>let me know by email also?
> 
> 
> Why you shouldn't ask for E-mail responses on Usenet
> http://www.cs.tut.fi/~jkorpela/usenet/mail-responses.html

Hogwash. If that's too strong, sheep dip. I dislike email that runs,
"Please, I saw on the newsgroup that you might be able to help me. How
can I ..." Not only do I find such messages intrusive, but I'm nervous
out on a limb by myself with no one to correct my errors or omissions.

The other way round is altogether different. "Reply all" is right
alongside "Reply". The CC to OP alerts him to check his thread and costs
me nothing. If the OP requests a personal reply, it is simply churlish
to refuse. The correct response is to both the user and the group.

Jerry
-- 
Engineering is the art of making what you want from things you can get.
�����������������������������������������������������������������������

Here is a Xiangqi (Chinese Chess) endgame tablebase system, and a way
to access it from a browser:

http://lpforth.forthfreak.net/endgame-en.html

"One hundred percent in Forth including the cgi interface. (Excluding
the Apache server, Linux OS.... etc, of course.)"

Hi Michael Kramer :-)

Here's a smart chess board for gforth/win32forth that i've just
finished.
May work on other forth interpreters. It's intended that an AI will
drive this board, eventually. It's text based and it's at a very early
stage in the development process.
This is intended to be factored to run on RetroForth, then on
retroForthBots in irc chat so we can play games while talkin,
eventually to be added to my collection of chess games that i've been
developing for colorforth.
Currently, you can use it to play other players or to look at masters
games from the web.
Requires that you have a file called "save-game.txt", and it can be
empty on start up.
In any regard you will have to hack the save-game.txt's path in this
file for the
definition of  "what-file" so the game will work. I plan to add
automated file creation and testing for it's presence but that is not a
requirement for my retrobot or colorforth chess, so it's not a high
priority. Easy to add, on your own.

For gforth, I put it in a sub folder of the gforth folder called
fstuf/b18chess/
and start it with a batch file in windows like this....
open a command prompt window
c:\edit cp.bat
echo off
cd c:\progra~1\gforth
gforth-fast fstuf\b18chess\b18text3.fs

Then alt-f x to close the cp.bat file and choose save on exit.
Then I make an icon on the desk top that calls cp.bat so I can start
the game.
In win32forth I open the b18text3.fs in the WinEd editor and run the
file normally.

This is in a draft form and is working completely tho unfinished.
Use an evenly spaced font to view properly :-)

\ b18text2.fs RAS0501021209 999lines exploring the math behind chess
\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
\  Required save file is ( possibly, and not detrimentaly, empty)
\  "save-game.txt" in the word "what-file" below.
\ This is a forth interpreter extention that ...
\  ... that displays a smart chessboard.
\  ...neither uses nor needs any error protection.
\ If you get an error, just re-enter or
\  undo and re-enter the move as needed.
\ If your error is related to the save-file
\  ( it happens very rarely ) and you want to
\  save the moves in it, rename it, restart the game
\  with a new savefile and re-enter the moves.
\ This should not happen very often, if at all.

\ ... provides an instant chess algebra language sub-set.

\   Introducing the namesake, b18 or base 18 numbers.
\  It's used to ...

\  ... be a function for displaying decimal equivelents of
\  base 18 numbers for development of the game. ( disabled )
\ : b18  depth 0<> if decimal . then 18 base ! ;
: b18 18 base ! ; \ normal game function enabled
b18
\ ... set the base to include the chessboard's
\ co-ord letters as numbers on input.
\  This provides an instant input language as a
\   subset of chess algebra. Google chess algebra.

\ The Base 18 Numbers and Moving on the Board

\     b18=18#'s=0-17=0123456789ABCDEFGH
\   (not used 0)  ( 1 2 3 4 5 6 7 8  Ranks )
\   (not used 9)  ( A B C D E F G H  Files )

\ Using letters just like in hexidecimal. Only Base 18.
\  Moves are constructed from 16 of these 18 numbers as
\  board co-ords. The forth interpreter likes numbers.
\ A source or a dest(ination) square of a move is
\  described as a letter followed by a number.
\ The letter represents the file of the square, A thru H, and
\  the number represents the rank of the square, 1 thru 8.
\ A piece starts on a source square and moves to a dest square.

\ So, if the king pawn is moving and using his optional
\  two squares move on the opening move of the game,
\  the source square would be E-file 2nd rank or E2,
\  the  dest  square would be E-file 4th rank or E4.

\ Moves can be constructed and entered like the following ...
\  source\dest E2E4       ( uppercase optional )
\  source dest E2 E4
\  dest only   E4 ( for pawns moving in the same rank only )

\ entry-example: e2e4 s (or also: e2 e4 s )
\  e2 is the source square of the king pawn
\  e4 is the dest and pawn moves here
\     Automatic en passant target square set for pawns moveing 2.
\     Pawns can move in the same file with just dest entered.
\ entry-example: e4 s
\     the king pawn on e2 moves to e4

\ s is the start\save\show command and is defined below.
\  It's used on every entry to read in a save-file and
\  1 display the current board configuration
\    from a list of moves ( the save-file )
\  2 display the last-board
\    a display of the last move made
\  3 display the list area
\    a list display of the moves made so far
\  4 display who's move it is
\    white or black and switch sides between moves
\  5 save a list of the moves to a save file
\    for persistance and to share
\    with another copy of this game to play a player.
\  6 enter moves and update all the above

\ Pawn promotion
\  is the only thing i didn't code in the traditional
\  chess algebra board co-ordinant language, as I saw
\  a cleaner way to do the promotion using base 18.
\  In this game, pawn promotion is handled by
\  the fact that it can only happen on certain squares.
\ entry-example: d0eA
\  d source file of the moving pawn rank white 7 black 2
\  0 is the promotion signal for all promotes.
\    zero is unused in chess algebra board co-ords and
\    takes the place of the normal rank number usually given
\  e the file of the dest white 8 black 1
\    because a pawn could move in one of three squares
\    in this case a pawn moves diagnal while taking and promoting
\  A in this case the value the piece is being promoted to.
\    Possible values  0 1 2 3 4 5 6 7 8 9 A B C.
\    represents piece _ p P n N b B r R q Q k K
\    NOTE a bug! ( that is not really worth fixing )
\    causes the "A" value to be printed as a colon (d0e:)
\    in the list-area and in the save-file but,
\    the board acts correctly. Only affects white queen promotion
\    Chess algegra would have used dxe8Q for the same move.
\ The values for the last digit in
\  the promotion entry number are here, in order of there
\  percieved piece-value. Odds are black and lowercase,
\  and evens are white and uppercase.
\    Numbers are base 18.
\    0 is a blank square.
\    Black         White
\    1 = p         2 = P  pawns
\    3 = n         4 = N  Knights
\    5 = b         6 = B  Bishops
\    7 = r         8 = R  Rooks
\    9 = q         A = Q  Queens ( A prints : )
\ Capital A prints a colon in the list and save-file
\ This only happens on the one white Queen and the Kings
\    B = k         C = K  Kings
\  ( B = ;   and   C = < ) in the list and save-file
\  kings should not be used in promotion

\ Constants, Arrays, Buffers, Variables and Files
\ Remainder of the input language not already handled
\  by base 18 numbers. Only 3 left, don't worry.

1 constant oo     \ castle kingside
2 constant ooo    \ castle queenside
\ entry-example: oo s
\  King moves two squares right and
\  kings rook moves to the square on kings left.
\ entry-example: ooo s
\  King moves two squares left and
\  queens rook moves to the square on kings right.

\ No attempt is made to determine if this is a legal move.
\  You either know how to play chess
\  or you don't, and if you don't,
\  you don't know that a king can't
\  castle out of check, or cross a square
\  that is being attacked. So, no harm done.

3 constant ep     \ en passant. last one.
\ entry-example: ep e s
\  type "ep" then the file letter of the
\  moving pawn before calling 's'
\ With a white pawn on e5 and a black pawn
\  that had just moved 2 squares to d5
\  this example would move the white e pawn
\  to d6 and remove the black d pawn automatically.

\ The board is intentionally unhelpful for versatility.
\ Nothing keeps a person from moving a piece to a wrong square.
\ Pay attention to knights and long rook, bishop, queen moves.
\ It is a gentile persons game. Play nice. Don't Cheat. Use undo.

\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
\ Programmed base 18 chess board
\ Scafolding constants are the crutches I used in development
\  to make this source easier to read and
\  while designing a solution.
\ This whole thing could easily be better factored.
\ An optimization of the program would lose all of these...
-1 constant blacks-move
0 constant whites-move
a constant ten             \ math helper
10 constant margin          \ 10 = 18 in base 18
1e constant thirty-two      \ space character
2c constant fourty-eight    \ convert numbers to ascii
31 constant fifty-five      \ convert letters to ascii
3a constant sixty-four      \ number of squares
120 constant three-sixty     \ list-area/last-board boundary
15g constant four-thirty     \ location of main board in sga
198 constant sga>end         \ 494 size of buffers and arrays
\ after all, they're just numbers.

\ arrays and buffers
\ save-game-array contains 494 locations in memory as follows
\ offset\range   cells  contents   display array
\ 0               1     rank#  easy to reach 8 calls per display
\ 1               1     move#  on a dump of sga this tells
\                              you where the game crashed
\ 2 and 3         2     empty
\ 4 and 5         2     last-move for last-board to display
\ 6   to 365    360     list 20 lines 18 characters
\ 366 to 430     64     last-board
\ 431 to 494     64     main-board
create save-game-array   sga>end   cells allot

\ line-buffer
\  place to translate moves to save in a file or
\  to read in the saved file during execution
create line-buffer       sga>end     2 + allot

\ execution-buffer
\  place to translate moves from
\  ascii in line-buffer to numbers that get executed.
\  accumulate new moves from stack
create execution-buffer  sga>end   cells allot

\ variables tend to get passed between moves executions
\  these might could be put in the save-game-array,,,
variable whites-last-move       0 whites-last-move !
variable blacks-last-move       0 blacks-last-move !

\ ... these can not because of a 'clear array' conflict - i think!
variable current-move 0 current-move !
variable total-moves  0 total-moves !
variable whose-move   0 whose-move !
variable enpas        0 enpas !   \ the en passont target square
variable file#        0 file# !   \ letter of en passont moving pawn
variable prom-flag    0 prom-flag !   \ pawn promotion move value

\ save-game file handling set what-file to "save-game.txt" path
\  what-file should set or get a variable that could be changed
\  on the command line while coming up or during execution
: what-file s" c:\progra~1\gforth\fstuf\b18chess\save-game.txt" ;
: new-save-file        \ <--redifined below as nsf
what-file  w/o create-file throw drop ;
\ input
0 value fd-in
: open-input r/o open-file throw to fd-in ;
: open-sg-input
what-file
open-input ;
: close-input   fd-in close-file throw ;
: read-save-game
line-buffer sga>end fd-in
read-line throw
close-input ;
\ output
0 value fd-out
: open-output  w/o open-file throw to fd-out ;
: open-sg-output
what-file
open-output ;
: close-output fd-out close-file throw ;
: write-save-game
line-buffer sga>end fd-out
write-file throw
close-output ;

\ Useful Words
\  program math
\   unpack and packup move
: unpkm         100 /mod    ; \ makes source dest from destsource
: pkum          100 * +     ; \ makes destsource from source dest
: spltR-F       10  /mod    ; \ split and leave Rank File on stack
: get-file      10  / 10 *  ; \ isolate file# less rank#
: ?even         2    mod 0= ; \ rank math
\   unspeakable words
: s10*+s   swap 10 * + swap ; \ value file# rank# - filerank# value
: 5wm@++ 5 whose-move @ + + ;         \ black 4, white 5
: wm@ia    whose-move @ invert abs ;  \ black 0, white 1
\   </end unspeakable-word-names>
\  convert a base 18 square # to save-game-array offset
: sq#>sqindex   spltR-F ten - swap 8 swap - 8 * + ;

\ Storing and Fetching

\ atoms
: swc+!         swap cells + ! ; \ value count buffer --
: swc+@         swap cells + @ ; \ count buffer -- value

\ these below use them above
\ storing
\ save-game-array
: !sga          save-game-array swc+! ;
: !rank#        0 !sga ;
: !move#        1 !sga ;
: !last-move    4 !sga 5 !sga ;
: !list-area    three-sixty 5 + swap - !sga ;
: !last-board   three-sixty 6 + + !sga ;
: !sq>sga       four-thirty + !sga ;
: !dest         sq#>sqindex !sq>sga ;
\ line-buffer
: !lbuf         line-buffer     swc+! ;
: !lbuf<stack
sga>end 0
do      sga>end 1-
i - !lbuf
loop ;
\ execution-buffer
: !exbuf        execution-buffer swc+! ;
\ last-moves
: !whites-last-move whites-last-move ! ;
: !blacks-last-move blacks-last-move ! ;

\ fetching
\ save-game-array
: @sga          save-game-array swc+@ ;
: @rank#        0 @sga ;
: @move#        1 @sga ;
: @last-move    5 @sga 4 @sga ;
: @list-area    6 + @sga ;
: @list-area>stack
three-sixty 0
do      i @list-area
loop ;
: @last-board   three-sixty 6 + + @sga ;
: @last>stack
sixty-four 1 + 0
do      sixty-four i - @last-board
loop ;
: @sq<sga       four-thirty  +    @sga ;
: @sq           sq#>sqindex @sq<sga ;
\ line-buffer
: @lbuf         line-buffer      swc+@ ;
: @lbuf>stack
sga>end 0
do      i @lbuf
loop ;
\ execution-buffer
: @exbuf        execution-buffer swc+@ ;
: @move         1+ @exbuf ;  \ get move entry
: @exbuf>stack
execution-buffer @ dup
if       0
do      execution-buffer @ dup i <=
if      drop leave
else    i - @exbuf
then
loop
else     drop
then ;

\ last moves
: @whites-last-move whites-last-move @ ;
: @blacks-last-move blacks-last-move @ ;

\ fetch'n'store
\ incrementors
: +move#
@move# 1+ !move# ;
: lbuf-incr
line-buffer @ dup 0=
if      fourty-eight +
then
1+ line-buffer ! ;
: exbuf-incr
execution-buffer @ 1+ execution-buffer ! ;
\ updaters
: update-last-move
whose-move @
if      @whites-last-move
else    @blacks-last-move
then
dup a0 >
if      unpkm swap
else    dup
then
!last-move ;
: update-last-board
sixty-four 0
do      i @sq<sga i !last-board
loop ;
: update-list-top
10 0            \ 10 = 18
do      three-sixty 10 - i + !list-area
loop ;
: update-list-area
three-sixty 0
do      i !list-area
loop ;

\ clearing storage
\ arrays and buffers
: clear-save-game-array
save-game-array  sga>end cells erase ;
clear-save-game-array
: clear-line-buffer
line-buffer      sga>end  2 +  erase ;
clear-line-buffer
: clear-execution-buffer
execution-buffer sga>end cells erase ;
clear-execution-buffer
: clear-move#           0 !move# ;
: clear-last-move       0 dup !last-move ;
: clear-board  \  these two could be replaced with one that
0 sixty-four 0          \ takes the address of the board
do      dup i !sq>sga   \ on the stack and does either board
loop                    \ or any part of the array
drop ;                  \ i guess and clear the list too.
: clear-last-board
0 sixty-four 0
do      dup i !last-board
loop
drop ;
\ clearing the list area
: spaces*three-sixty
thirty-two three-sixty 1- 0
do      dup
loop ;
: space-out-list-area
spaces*three-sixty
update-list-area ;
: clear-exbuf-counter   0 execution-buffer ! ;
: clear-stack
depth dup 0<>
if      0
do      drop
loop
else    drop
then ;
: clear-save-file
new-save-file
@lbuf>stack
clear-line-buffer
open-sg-output
write-save-game
!lbuf<stack ;

\ one more storing using a clear and an incrementer
: !exbuf<stack
depth dup 0=
if      drop
else    clear-exbuf-counter 0
do      i 1+
!exbuf
exbuf-incr
loop
then ;

\ these below manipulate them above.

\ peice starting positions  \ needs a re-write better code here
\ make it easier to put up a pre-set up board.
: load-positions
depth 2 / 0
do      !dest
loop ;
: first-positions
7 a8  3 b8 5 c8  9 d8  b e8  5 f8  3 g8  7 h8
1 a7  1 b7 1 c7  1 d7  1 e7  1 f7  1 g7  1 h7
2 a2  2 b2 2 c2  2 d2  2 e2  2 f2  2 g2  2 h2
8 a1  4 b1 6 c1  a d1  c e1  6 f1  4 g1  8 h1 ;
: start-pos
first-positions \ need a which-pos here that can take
load-positions ; \ interpreter input or load the default
\ bunch of clears and resets that starts things up
: clear-all
clear-move#
0 whose-move !
clear-board
start-pos
clear-last-move
update-last-board
space-out-list-area ;

\ Display

\ displaying the display
: parkcurs   1 14 a + at-xy ; \ where .whose-move prints
\ the list
: .list-area
12 0                            \ 12 = 20 *
do      10 0                    \ 10 = 18 | = 360
do      j 10 *  i +     \ tens+ones offset
@list-area      \ to get char
i j a + at-xy   \ and at this location
emit            \ print it
loop
loop
parkcurs ; \ park cursor where .whose-move prints

\ print the parts of the boards
: .piece
case
1 of ." p" endof        \ Pawns
2 of ." P" endof
3 of ." n" endof        \ Knights
4 of ." N" endof
5 of ." b" endof        \ Bishops
6 of ." B" endof
7 of ." r" endof        \ Rooks
8 of ." R" endof
9 of ." q" endof        \ Queens
ten of ." Q" endof
ten 1 + of ." k" endof  \ Kings
ten 2 + of ." K" endof
.." 0" endcase ; \ empty square white or black
\ the last move board
: .last-move    \ shows current move on undo :-)
@last-move swap sixty-four 7 at-xy . . ;
: .last-board
..last-move
@last>stack ten 6 + 8        \ 16 8 = 8 times
do      8 0                  \ 8 *  = 64
do      sixty-four   \ margin over list and board
i 2 * +      \ every other space 8 chars
j at-xy      \ each lines 8 thru 16
..piece       \ print this stack value
loop
loop
parkcurs drop ; \ where whose-move prints

\ the parts of the main board - bottom
: .whose-move
parkcurs  \ where whose move prints
whose-move @
if      ." Black's move"
else    ." White's move"
then ;
: .letters      \ top and bottom
.." A    B    C    D    E    F    G    H" cr ;
: .bottom-underline ." ----------------------------------------" cr ;
: .margin-sp   margin spaces ;
: .board-bottom
..margin-sp 2 spaces .bottom-underline
..margin-sp 4 spaces .letters .whose-move ;
\ ranks
: .rank#  fourty-eight + emit ; \ print a rank number
: .end-rank
@rank# dup ?even
if      ." |"   \ choose an ending rank boarder
else    space
then
..rank# cr ;
: .bgpcbg       \ <----thats background piece background
swap @rank# + ?even
if      ." | " .piece ."  |"
else    ."   " .piece ."   "
then ;
: .black 5 spaces ;
: .white ." |||||" ;
: .white-or-black
@rank# + ?even
if      .white
else    .black
then ;
: .square
dup 0=
if      drop
..white-or-black \ blank square
else    .bgpcbg         \ occupied square
then ;
: .rank-range
8 * sixty-four swap - dup 8 + swap ;
: .ranksqs
..rank-range
do      i dup
@sq<sga
..square
loop  ;
: .start-rank
@rank# dup dup .rank# ?even
if      space   \ choose a rank boarder
else    ." |"
then ;
: .rank-pieces
..start-rank
..ranksqs
..end-rank ;
: .rankblack
space ." |" 4 0
do      .black .white
loop
cr ;
: .rankwhite
2 spaces 4 0
do      .white .black
loop
.." |" cr ;
: .sqcol
@rank# ?even
if      .rankwhite
else    .rankblack
then ;
: .rank
..margin-sp .sqcol   \ above the piece
..margin-sp .rank-pieces \ rank of blanks and pieces
..margin-sp .sqcol ; \ below the piece
\ top
: .top_underline  ." _________________________________________" cr ;
: .title ." myCHESSboard  by Ray St. Marie" cr ;
: .board-top
..margin-sp 6 spaces .title
..margin-sp 4 spaces .letters
..margin-sp 2 spaces .top_underline ;
: .board
page cr cr
..board-top 8 0
do      8 i -
!rank#
..rank
loop
..board-bottom ;

\ starting of scaffolding for the not yet implimented help system
: .menu-letters ." Apply Brnch Climb Down Edit File Game Help" ;
: .menu-bottom
..margin-sp 2 spaces
..bottom-underline
..margin-sp space
..menu-letters cr ;
: .menu-board
page .board-top 8 0
do      8 i - !rank#
..rank
loop    .menu-bottom ;

\ Calling the display
: display
..board
..last-board
..list-area
..whose-move ;
\ when to display saving execution cycles between reads
: display-last-only          \ on/off switch
execution-buffer @ =
if      display
0 total-moves !
then ;

\ creating what to display
: switch-sides
whose-move @
if      whites-move whose-move !
else    blacks-move whose-move !
then ;
\ the list
: build-list
whose-move @
if      update-list-top  \ just update blacks move
else    @list-area>stack 9 0  \ get the list and
do      2drop    \ clear 18 characters
loop             \ off the bottom and
update-list-area \ recreate the list.
then ;
\ the text printer
: black-....  fourty-eight 2 - dup 2dup ; \   4 " . "
: numbers>letters spltR-F fifty-five + swap fourty-eight + ;
: convert-move
case
1 of    [char] o [char] - [char] o [char] . endof
2 of    [char] o [char] o [char] - [char] o endof
3 of    [char] e [char] p thirty-two
file# @ fifty-five + endof
unpkm                \ unpack move
numbers>letters rot  \ normal moves get converted
numbers>letters      \ to ascii here
0 endcase ;
\ the list format
: black-text
@blacks-last-move dup
if      convert-move  \ blacks move
else    drop
black-....    \ print "...."
then ;
: finish-line thirty-two thirty-two ; \ 2 space characters
: line-no
finish-line
@move# dup ten <                \ single digit?
if      thirty-two swap         \ ad space
else    ten /mod                \ split decimal digits
fourty-eight + swap     \ ascii up ten's digit
then
fourty-eight +                  \ ascii up one's digit
finish-line ;
: move>text
@move#
if      line-no
@whites-last-move \ whites text
convert-move
finish-line
black-text
finish-line
build-list
then ;

\ heart this executes early on startup and every move
: chess
@move#                    \ if there are moves to process
if      move>text         \ create the list text to print
switch-sides
total-moves @     \ set in execute-moves
display-last-only
update-last-move  \ doing these after display means
update-last-board \ displaying the previous move
else    display                 \ default start up
then ;

\ Move Execution

: normal-display exbuf-incr chess ;

\ moves filters all moves
: ?prom-flag
prom-flag @ dup     \  something stored here?
if      swap drop   \ substitute this instead
else    drop
then ;              \  peice value to do-move
: do-move
0 swap unpkm      \ unpack move infront of clear square
dup @sq
?prom-flag        \ are we changing piece values
rot               \ align stack and
load-positions    \ set save-game-array current move
0 prom-flag ! ;   \ reset
\ print filter
: move-piece
whose-move @
if      !blacks-last-move  \ a move for black
else    +move#             \ increment on whites move only
!whites-last-move  \ print this as whites move
0 !blacks-last-move  \ signal to print "...."
then ;

\ normal-moves filter
: set-enpas-sq          \ the target dest of an en passant move
dup unpkm       \ unpack
get-file        \ file#
whose-move @    \ calculate the square behind
negate          \ the 2 square moving pawn
3 * 3 + +       \ square is rank white 6 black 3
enpas ! drop ;
: ?mov2sq
dup spltR-F     \ Rank# FileRankFile#
spltR-F spltR-F \ Srank# Sfile# Drank# Dfile#
drop swap drop  \ drop the file#s
- abs           \ subtract the rank#s correct for side
2 = ;           \ true if moving any 2 ranks
: ?setEnpasSq
?mov2sq               \ pawn 2 move option taken?
if      set-enpas-sq  \ compute and set
else    0 enpas !     \ reset
then ;
: ?pawn
dup unpkm     \ unpack
swap drop     \ discard dest
@sq           \ get it
2 <=          \ pawn value?
if      ?setEnpasSq
then ;

: promote-dest
wm@ia    \ get white 1 or black 0
7 * 1+   \ rank white 8 or black 1
s10*+s ; \ pack into dest and swap
: promote-source
wm@ia    \ get white 1 or black 0
5 * 2 +  \ make rank white 7 or black 2
s10*+s ; \ pack into source and swap
: set-promote-move
promote-source          \ get source ...
spltR-F                 \ split rank# file#
promote-dest            \ ... and dest
prom-flag !     \  do-move to substitute this dest
swap pkum swap ;        \ pack the move print
: ?promote
dup unpkm    \ unpack move
spltR-F      \ split rank# file#
swap         \ rank# is 0 signaling promote?
if      2drop  \ if not then proceed with normal-move
else    set-promote-move \ if so if 0 only
then ;
: normal-move
?promote     \ weird I don't test for pawn first hmmm
?pawn        \ check and set en passont square value
depth 1 =    \ make sure move-piece and do-move
if      dup  \ both get something to do
then
move-piece   \ print this
do-move ;  \ set save-game-array for the boards to print

\ special-moves filter
: take-pawn
dup get-file    \ separate file number
5wm@++          \ rank white 5 black 4
0 swap !dest ;  \ store 0 at square, taking pawn
: enpas-source     \ of mover
10 *       \ position file letter
5wm@++ ;   \ rank white 5 black 4
: enpas-s-d
enpas-source enpas @ ; \ enpas set on last pawns move
: enpass-entry
3 - dup         \ get file# and
file# !         \ store the file# for printing
enpas-s-d       \ get the source and dest on stack
0 enpas !       \ reset
take-pawn       \ remove offending pawn
swap pkum       \ packup move
do-move 3 ;     \ adjust sga and signal move-piece

: oo-o
whose-move @
if      0 a8 b c8 7 d8 0 e8 \ black
else    0 a1 c c1 8 d1 0 e1 \ white
then
load-positions 2 ;        \ signal for move-piece to print
: o-o
whose-move @
if      0 e8 7 f8 b g8 0 h8  \ black
else    0 e1 8 f1 c g1 0 h1  \ white
then
load-positions 1 ;        \ signal for move-piece to print
: ?castle-entry
case
1 of o-o endof  \ king side
2 of oo-o endof \ queen side
endcase ;
: special-entry
dup 2 <=
if      ?castle-entry   \ 1 or 2 on stack
else     enpass-entry   \ 3 on stack
then
move-piece ;    \ store these signals as the move to print

\ digestion muscle
: display\save-loop
clear-all clear-exbuf-counter 0           \ start clear
do      i @move dup a1 <        \ smaller than first square?
if      dup 0=          \ no entry signal?
if      drop display
leave           \ early finish
else    special-entry
then
else    normal-move
then
normal-display
i @move   \ get the move entry again for
convert-move  \ to translation into ascii
4 0                \ and
do      line-buffer      \  will store in here
j 1+ cells +     \ at this offset
3 i - chars + c! \ these four characters
loop
lbuf-incr  \ increment the count in line-buffer
loop ;

\ persistance
: execute-moves
execution-buffer @          \ get count
dup dup total-moves ! 0=    \ total-moves will tell
if      drop display        \ "display-last-only" in
else    display\save-loop   \ "normal-display" in <-this
then                        \ when to display
open-sg-output              \ open a file
write-save-game ;           \ save moves to file

\ brains
: dekode  \ convert ascii to base 18 in chessboard co-ord format
fifty-five - 10 *   swap fourty-eight - + 10 * swap
fifty-five - + 10 * swap fourty-eight - + ;
: ?format-castle  \ count the 'o's
over over 0 swap
[char] o =
if      1+ swap
[char] o =
if      1+
then
else    drop
then ;
: ?format
?format-castle                  \  count any 'o's?
1 over =
if      clear-stack 1           \ king side castle
else    2 over =
if      clear-stack 2   \ queen side
else    drop dekode   \ normal format and promotes
then
then ;
: format-ep  3 +        \ add ep signal and discard the rest
swap drop swap drop swap drop ;
: unconvert-move
over thirty-two =   \ a space in format means ep
if      format-ep
else    ?format     \ else test for other formats
then ;
: transfer-chars
0 dup line-buffer !         \ clear line-buffer counter
do      4 0                   \ for each offset in the
do      line-buffer   \ get the four characters
j 1+ cells +  \ that describe the move
3 i - chars + c@   \ in ascii
loop
unconvert-move  \ and make them base 18 numbers
i 1+ !exbuf     \ and store them for execution
loop ;
: translate<lbuf
line-buffer @                   \ count in ascii
fourty-eight - dup 0 <=         \ now in base 18
if      drop
else    transfer-chars          \ process that many
then ;

\ entry preparation
: prev-moves
translate<lbuf  \ stack the lbuf chars as numbers
current-move @  \ stack this move
@exbuf>stack ;  \ stack any previous moves
: prepare-moves
line-buffer @ 0<>   \ if there's any ascii in line-buffer
if      prev-moves      \ base 18 chars onto stack
else    current-move @  \ including the current move
then                    \ in both cases
!exbuf<stack ;          \ store them to be executed

\ entry handling
: test-file   dup get-file dup whose-move @ 2 + swap ;
: get-source
test-file 8 0         \ for each of 8 ranks in file
do      1+ 2dup       \ test each
@sq =         \  piece value for a pawn
if      swap rot        \ when found fix stack
2drop leave     \ and return
then
loop ;
: ?single\double-entry
dup a0 >=          \ are we on the board?
if      depth 1 =  \ "pawn in same-file dest-only" entry?
if      get-source
then
pkum       \ pack it up
else    dup 3 >=   \ en passont or castle entry?
if      +  \ packs ep doesn't hurt anything else
then
then ;
: combined-entry
dup h8 >        \ larger than special or pawnDest?
if      unpkm           \ unpack move
else    depth 2 =       \ ep and split s d moves
if      swap    \ to match unpacking a move
then
then ;
: resolve-move         \ condition all kinds of input
combined-entry        \ special, sd and s d
?single\double-entry  \ handle each type
current-move ! ;      \ we have a move to process
: entry
resolve-move    \ deal with current move entry
prepare-moves   \ deal with list of moves
execute-moves ; \ ready set go execute and display them

\ starting from several defaults
: count-moves   fourty-eight -  execution-buffer ! ;
: ?buffer-empty
line-buffer @ dup
if      count-moves
translate<lbuf
execute-moves
else    drop
chess        \ default display on startup
then ;
: part-start
b18             \ set the base input language
clear-all       \ :-) blow nose
open-sg-input   \ read in the file
read-save-game  \ ( should check presence )
2drop ;
: start
part-start ?buffer-empty ;     \ this is split for debuging.

\ Game Input ( s, nsf, sn, undo, redo, endchess )

\ play
: s
dup
if      entry   \ parse interpreter entry and execute
else    start   \ default action and start up
then    quit ;  \ squelch interpreter

\ files
: nsf new-save-file ; \ generate a new save file if none exists
: sn clear-save-file start ; \ start new with clear save-file
\ fixing display
: undo  @exbuf>stack    \ fetch all the current moves
depth 0 swap    \ count them and swap 0 under the depth
!exbuf          \ store 0 at depth clearing current move
clear-stack
clear-line-buffer
clear-save-file
execute-moves quit ;
: redo  current-move @ s ;
\ currently only works with the first undo
\ here i need a function to test for a file ( save-file.txt )
\ if there is a file name on the commandline when game starts
\ start and proceed with that file
\ if a save file exitsts just go on with it
\ if not create it. \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
\                                                    \
\                                                  \ \ \
\                                                    \
\      \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
: endchess decimal page
s" You can have your interpreter back." type space
s" BASE is decimal." type cr
s" 's' to restart b18chess, bye to exit." type space
s" b18chess words are still active." type ;
\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
s \ start here read upwards                              \
\
\                                                             \
\ functions below 's' are not "on" \\\\\\\\\\\\\\\\\\\\       \
: sga-d save-game-array sga>end cells dump ;      \
: eb-d execution-buffer sga>end dump ;   \ \
: lb-d line-buffer sga>end dump ;  \\\\|
: scan-stack  depth  dup if 0  do . loop  else drop then ;    \ \
\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\       \
\                                                             \
\                                                           \
\                                                        \
\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\

Just noticed that two definitions got redefined by the web email
client.
Should still work as is.
The definitions that changed are ones that have a fetch ( @ ) character
in the middle of it.
The two definitions are in the program math section.
Spelt out they are the initials of the words in the definition.
For instance the first one is supposed to be
5 whose-move @ + + and the initials are 5 w m @ + + .
with no spaces thats the name of that word.
the other one is
whose-move @ invert abs and the initials are w m @ i a so the name is
with no spaces.
This text conversion changed all instances of these two words to
5...@++ and w...@ia
in the first one the dots get replaced by "wm"
and the secong the dots get replaced by "m".

Still, the this should not effect the playability of the game as is.
A proper factoring of the game will make those program math words
obsolete any way
and they were used during design to make the program readable.
Thanks 
Ray
Ray.stmarie AT gmail.com

"Ray St. Marie" <ray.stmarie@gmail.com> writes:
>Hi Michael Kramer :-)
>
>Here's a smart chess board for gforth/win32forth that i've just
>finished.

I have done some small changes and put it on
http://www.complang.tuwien.ac.at/forth/programs/b18chess.fs

>May work on other forth interpreters. It's intended that an AI will
>drive this board, eventually.

Note that we have at least two chess AIs in the Forth community: fcp
and brainless.

- anton
-- 
M. Anton Ertl  http://www.complang.tuwien.ac.at/anton/home.html
comp.lang.forth FAQs: http://www.complang.tuwien.ac.at/forth/faq/toc.html
New standard: http://www.complang.tuwien.ac.at/forth/ansforth/forth200x.html

Anton Ertl wrote:
> "Ray St. Marie" <ray.stmarie@gmail.com> writes:
> >Hi Michael Kramer :-)
> >
> >Here's a smart chess board for gforth/win32forth that i've just
> >finished.
>
> I have done some small changes and put it on
> http://www.complang.tuwien.ac.at/forth/programs/b18chess.fs
>
> >May work on other forth interpreters. It's intended that an AI will
> >drive this board, eventually.
>
> Note that we have at least two chess AIs in the Forth community: fcp
> and brainless.

> - anton
> --
> M. Anton Ertl  http://www.complang.tuwien.ac.at/anton/home.html
> comp.lang.forth FAQs:
http://www.complang.tuwien.ac.at/forth/faq/toc.html
> New standard:
http://www.complang.tuwien.ac.at/forth/ansforth/forth200x.html

Thank you Anton, :-)

There's a problem with the "undo" feature under win32forth in the above
version. I've fixed that and it's below. Also, I've changed some of the
file handling words, as I work out a way to handle not needing the
savefile on the first execution, and a way to select different save
files, or load pre-set boards. /me novice programmer hobbiest.
Suggestions welcome.

I thank you for pointing out the AI's above. I'm looking over things
like TSCP and the 3d chess that comes with win32forth for ideas to
drive this board.
I'm no math or chess wiz or nothing, so I'll be stealing idea's and
giving credit where credit is due.

This is just a hobby project for anyones amusement. It came about after
reading "Starting Forth" and finding gforth and win32forth all about
the same time a year or two ago. Originally, I was learning forth to
learn colorforth. Now I'm on my 3rd chess for colorforth and working on
a fourth, more like this one.

If you care to, please replace the copy you posted above with this one,
as the claim that it works on win32forth is now a reality regarding
"undo". If you care not to, please tell me how and I will. :-)

Thank you again, Good Forthing,

Ray
<code>
\ b18text3.fs RAS0502011210 999lines exploring the math behind chess
\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
\  Required save file is ( possibly, and not detrimentaly, empty)
\  "save-game.txt" in this directory.
\ This is a forth interpreter extention that ...

\  ... displays a smart chessboard.
\  ... neither uses nor needs any error protection.

\ If you get an error, just re-enter or
\  undo and re-enter the move as needed.
\ If your error is related to the save-file
\  ( it happens very rarely ) and you want to
\  save the moves in it, rename it, restart the game
\  with a new savefile and re-enter the moves.
\ This should not happen very often, if at all.

\ ... provides an instant chess algebra language sub-set.

\   Introducing the namesake, b18 or base 18 numbers.

\  It's used to ...
\  ... be a function for displaying decimal equivelents of
\  base 18 numbers for development of the game. ( disabled )
\ : b-18  depth 0<> if decimal . then 18 base ! ;
: b-18 18 base ! ; \ normal game function enabled
b-18 \ b18 is a number in b18 so b-18 is not :-)
\ ... set the base to include the chessboard's
\ co-ord letters as numbers on input.
\  This provides an instant input language as a
\   subset of chess algebra. Google chess algebra.

\ The Base 18 Numbers and Moving on the Board

\     b18=18#'s=0-17=0123456789ABCDEFGH
\   (not used 0)  ( 1 2 3 4 5 6 7 8  Ranks )
\   (not used 9)  ( A B C D E F G H  Files )

\ Using letters just like in hexidecimal. Only Base 18.
\  Moves are constructed from 16 of these 18 numbers as
\  board co-ords. The forth interpreter likes numbers.
\ A source or a dest(ination) square of a move is
\  described as a letter followed by a number.
\ The letter represents the file of the square, A thru H, and
\  the number represents the rank of the square, 1 thru 8.
\ A piece starts on a source square and moves to a dest square.

\ So, if the king pawn is moving and using his optional
\  two squares move on the opening move of the game,
\  the source square would be E-file 2nd rank or E2,
\  the  dest  square would be E-file 4th rank or E4.
\ Moves can be constructed and entered like the following ...
\  source\dest E2E4       ( uppercase optional )
\  source dest E2 E4
\  dest only   E4 ( for pawns moving in the same rank only )

\ entry-example: e2e4 s (or also: e2 e4 s )
\  e2 is the source square of the king pawn
\  e4 is the dest and pawn moves here
\     Automatic en passant target square set for pawns moveing 2.
\     Pawns can move in the same file with just dest entered.
\ entry-example: e4 s
\     the king pawn on e2 moves to e4

\ s is the start\save\show command and is defined below.
\  It's used on every entry to read in a save-file and
\  1 show the current board configuration
\    from a list of moves ( the save-file )
\  2 show the last-board
\    a display of the last move made
\  3 show the list area
\    a list display of the moves made so far
\  4 show who's move it is
\    white or black and switch sides between moves
\  5 save a list of the moves to a save file
\    for persistance and to share
\    with another copy of this game to play a player.
\  6 enter moves and update all the above

\ Pawn promotion
\  is the only thing i didn't code in the traditional
\  chess algebra board co-ordinant language, as I saw
\  a cleaner way to do the promotion using base 18.
\  In this game, pawn promotion is handled by
\  the fact that it can only happen on certain squares.
\ entry-example: d0eA
\  d source file of the moving pawn rank white 7 black 2
\  0 is the promotion signal for all promotes.
\    zero is unused in chess algebra board co-ords and
\    takes the place of the normal rank number usually given
\  e the file of the dest white 8 black 1
\    because a pawn could move in one of three squares
\    in this case a pawn moves diagnal while taking and promoting
\  A in this case the value the piece is being promoted to.
\    Possible values  0 1 2 3 4 5 6 7 8 9 A B C.
\    represents piece _ p P n N b B r R q Q k K
\    NOTE a bug! ( that is not really worth fixing )
\    causes the "A" value to be printed as a colon (d0e:)
\    in the list-area and in the save-file but,
\    the board acts correctly. Only affects white queen promotion
\    Chess algegra would have used dxe8Q for the same move.
\ The values for the last digit in
\  the promotion entry number are here, in order of there
\  percieved piece-value. Odds are black and lowercase,
\  and evens are white and uppercase.
\    Numbers are base 18.
\    0 is a blank square.
\    Black         White
\    1 = p         2 = P  Pawns
\    3 = n         4 = N  Knights
\    5 = b         6 = B  Bishops
\    7 = r         8 = R  Rooks
\    9 = q         A = Q  Queens ( A prints : )
\ Capital A prints a colon in the list and save-file
\ This only happens on the one white Queen and the Kings
\    B = k         C = K  Kings
\  ( B = ;   and   C = < ) in the list and save-file
\  kings should not be used in promotion

\ Constants, Arrays, Buffers, Variables and Files
\ Remainder of the input language not already handled
\  by base 18 numbers. Only 3 left, don't worry.

1 constant oo     \ castle kingside
2 constant ooo    \ castle queenside
\ entry-example: oo s
\  King moves two squares right and
\  kings rook moves to the square on kings left.
\ entry-example: ooo s
\  King moves two squares left and
\  queens rook moves to the square on kings right.

\ No attempt is made to determine if this is a legal move.
\  You either know how to play chess
\  or you don't, and if you don't,
\  you don't know that a king can't
\  castle out of check, or cross a square
\  that is being attacked. So, no harm done.

3 constant ep     \ en passant. last one.
\ entry-example: ep e s
\  type "ep" then the file letter of the
\  moving pawn before calling 's'
\ With a white pawn on e5 and a black pawn
\  that had just moved 2 squares to d5
\  this example would move the white e pawn
\  to d6 and remove the black d pawn automatically.

\ The board is intentionally unhelpful for versatility.
\ Nothing keeps a person from moving a piece to a wrong square.
\ Pay attention to knights and long rook, bishop, queen moves.
\ It is a gentile persons game. Play nice. Don't Cheat. Use undo.

\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
\ Programmed base 18 chess board
\ Scafolding constants are the crutches I used in development
\  to make this source easier to read and while designing a solution.
\ This whole thing could easily be better factored.
\ An optimization of the program would lose all of these...

-1 constant blacks-move
0 constant whites-move
a constant ten             \ math helper
10 constant margin          \ 10 = 18 in base 18
1e constant thirty-two      \ space character
2c constant fourty-eight    \ convert numbers to ascii
31 constant fifty-five      \ convert letters to ascii
3a constant sixty-four      \ number of squares
120 constant three-sixty     \ list-area/last-board boundary
15g constant four-thirty     \ location of main board in sga
198 constant sga>end         \ 494 size of buffers and arrays
\ after all, they're just numbers.

\ arrays and buffers
\ save-game-array contains 494 locations in memory as follows
\ offset\range   cells  contents   display array
\ 0               1     rank#  easy to reach 8 calls per display
\ 1               1     move#  on a dump of sga this tells
\                              you where the game crashed
\ 2 and 3         2     empty
\ 4 and 5         2     last-move for last-board to display
\ 6   to 365    360     list 20 lines 18 characters
\ 366 to 430     64     last-board
\ 431 to 494     64     main-board
create save-game-array   sga>end   cells allot

\ line-buffer
\  place to translate moves to save in a file or
\  to read in the saved file during execution
create line-buffer       sga>end     2 + allot

\ execution-buffer
\  place to translate moves from
\  ascii in line-buffer to numbers that get executed.
\  accumulate new moves from stack
create execution-buffer  sga>end   cells allot

\ variables tend to get passed between moves executions
\  these might could be put in the save-game-array,,,
variable whites-last-move       0 whites-last-move !
variable blacks-last-move       0 blacks-last-move !

\ ... these can not because of a 'clear array' conflict - i think!
variable current-move 0 current-move !
variable total-moves  0 total-moves !
variable whose-move   0 whose-move !
variable enpas        0 enpas !   \ the en passont target square
variable file#        0 file# !   \ letter of en passont moving pawn
variable prom-flag    0 prom-flag !   \ pawn promotion move value

\ save-game file handling set what-file to "save-game.txt" path
\  what-file should set or get a variable that could be changed
\  on the command line while coming up or during execution
0 value fd-file
: what-file s" c:\progra~1\gforth\fstuf\b18chess\save-game.txt" ;
: new-save-file        \ <--redifined below as nsf
what-file  r/w create-file throw to fd-file ;
\ input
: open-input r/w open-file throw to fd-file ;
: open-sg-input
what-file
open-input ;
: close-input   fd-file close-file throw ;
: read-save-game
line-buffer sga>end fd-file
read-line throw
close-input ;
\ output
: open-output  r/w open-file throw to fd-file ;
: open-sg-output
what-file
open-output ;
: close-output fd-file close-file throw ;
: write-save-game
line-buffer sga>end fd-file
write-file throw
close-output ;

\ Useful Words
\  program math
\   unpack and packup move
: unpkm         100 /mod    ; \ makes source dest from destsource
: pkum          100 * +     ; \ makes destsource from source dest
: spltR-F       10  /mod    ; \ split and leave Rank File on stack
: get-file      10  / 10 *  ; \ isolate file# less rank#
: ?even         2    mod 0= ; \ rank math
\   unspeakable words
: s10*+s   swap 10 * + swap ; \ value file# rank# - filerank# value
: 5wm@++ 5 whose-move @ + + ;         \ black 4, white 5
: wm@ia    whose-move @ invert abs ;  \ black 0, white 1
\   </end unspeakable-word-names>
\  convert a base 18 square # to save-game-array offset
: sq#>sqindex   spltR-F ten - swap 8 swap - 8 * + ;

\ Storing and Fetching

\ atoms
: swc+!         swap cells + ! ; \ value count buffer --
: swc+@         swap cells + @ ; \ count buffer -- value

\ these below use them above
\ storing
\ save-game-array
: !sga          save-game-array swc+! ;
: !rank#        0 !sga ;
: !move#        1 !sga ;
: !last-move    4 !sga 5 !sga ;
: !list-area    three-sixty 5 + swap - !sga ;
: !last-board   three-sixty 6 + + !sga ;
: !sq>sga       four-thirty + !sga ;
: !dest         sq#>sqindex !sq>sga ;
\ line-buffer
: !lbuf         line-buffer     swc+! ;
: !lbuf<stack
sga>end 0
do      sga>end 1-
i - !lbuf
loop ;
\ execution-buffer
: !exbuf        execution-buffer swc+! ;
\ last-moves
: !whites-last-move whites-last-move ! ;
: !blacks-last-move blacks-last-move ! ;

\ fetching
\ save-game-array
: @sga          save-game-array swc+@ ;
: @rank#        0 @sga ;
: @move#        1 @sga ;
: @last-move    5 @sga 4 @sga ;
: @list-area    6 + @sga ;
: @list-area>stack
three-sixty 0
do      i @list-area
loop ;
: @last-board   three-sixty 6 + + @sga ;
: @last>stack
sixty-four 1 + 0
do      sixty-four i - @last-board
loop ;
: @sq<sga       four-thirty  +    @sga ;
: @sq           sq#>sqindex @sq<sga ;
\ line-buffer
: @lbuf         line-buffer      swc+@ ;
: @lbuf>stack
sga>end 0
do      i @lbuf
loop ;
\ execution-buffer
: @exbuf        execution-buffer swc+@ ;
: @move         1+ @exbuf ;  \ get move entry
: @exbuf>stack
execution-buffer @ dup
if       0
do      execution-buffer @ dup i <=
if      drop leave
else    i - @exbuf
then
loop
else     drop
then ;

\ last moves
: @whites-last-move whites-last-move @ ;
: @blacks-last-move blacks-last-move @ ;

\ fetch'n'store
\ incrementors
: +move#
@move# 1+ !move# ;
: lbuf-incr
line-buffer @ dup 0=
if      fourty-eight +
then
1+ line-buffer ! ;
: exbuf-incr
execution-buffer @ 1+ execution-buffer ! ;
\ updaters
: update-last-move
whose-move @
if      @whites-last-move
else    @blacks-last-move
then
dup a0 >
if      unpkm swap
else    dup
then
!last-move ;
: update-last-board
sixty-four 0
do      i @sq<sga i !last-board
loop ;
: update-list-top
10 0            \ 10 = 18
do      three-sixty 10 - i + !list-area
loop ;
: update-list-area
three-sixty 0
do      i !list-area
loop ;

\ clearing storage
\ arrays and buffers
: clear-save-game-array
save-game-array  sga>end cells erase ;
clear-save-game-array
: clear-line-buffer
line-buffer      sga>end  2 +  erase ;
clear-line-buffer
: clear-execution-buffer
execution-buffer sga>end cells erase ;
clear-execution-buffer
: clear-move#           0 !move# ;
: clear-last-move       0 dup !last-move ;
: clear-board  \  these two could be replaced with one that
0 sixty-four 0          \ takes the address of the board
do      dup i !sq>sga   \ on the stack and does either board
loop                    \ or any part of the array
drop ;                  \ i guess and clear the list too.
: clear-last-board
0 sixty-four 0
do      dup i !last-board
loop
drop ;
\ clearing the list area
: spaces*three-sixty
thirty-two three-sixty 1- 0
do      dup
loop ;
: space-out-list-area
spaces*three-sixty
update-list-area ;
: clear-exbuf-counter   0 execution-buffer ! ;
: clear-stack
depth dup 0<>
if      0
do      drop
loop
else    drop
then ;
: clear-save-file
@lbuf>stack
clear-line-buffer
open-sg-output
write-save-game
!lbuf<stack
;
\ one more storing using a clear and an incrementer
: !exbuf<stack
depth dup 0=
if      drop
else    clear-exbuf-counter 0
do      i 1+
!exbuf
exbuf-incr
loop
then ;

\ these below manipulate them above.

\ peice starting positions  \ needs a re-write better code here
\ make it easier to put up a pre-set up board.
: load-positions
depth 2 / 0
do      !dest
loop ;
: first-positions
7 a8  3 b8 5 c8  9 d8  b e8  5 f8  3 g8  7 h8
1 a7  1 b7 1 c7  1 d7  1 e7  1 f7  1 g7  1 h7
2 a2  2 b2 2 c2  2 d2  2 e2  2 f2  2 g2  2 h2
8 a1  4 b1 6 c1  a d1  c e1  6 f1  4 g1  8 h1 ;
: start-pos
first-positions  \ need a which-pos here that can take
load-positions ; \ interpreter input or load the default
\ bunch of clears and resets that starts things up
: clear-all
clear-move#
0 whose-move !
clear-board
start-pos
clear-last-move
update-last-board
space-out-list-area ;

\ Display

\ displaying the display
: parkcurs   1 14 a + at-xy ; \ where .whose-move prints
\ the list
: .list-area
12 0                            \ 12 = 20 *
do      10 0                    \ 10 = 18 | = 360
do      j 10 *  i +     \ tens+ones offset
@list-area      \ to get char
i j ten + at-xy   \ and at this location
emit            \ print it
loop
loop
parkcurs ; \ park cursor where .whose-move prints

\ print the parts of the boards
: .piece
case
1 of ." p" endof        \ Pawns
2 of ." P" endof
3 of ." n" endof        \ Knights
4 of ." N" endof
5 of ." b" endof        \ Bishops
6 of ." B" endof
7 of ." r" endof        \ Rooks
8 of ." R" endof
9 of ." q" endof        \ Queens
ten of ." Q" endof
ten 1 + of ." k" endof  \ Kings
ten 2 + of ." K" endof
.." 0" endcase ; \ empty square white or black
\ the last move board
: .last-move    \ shows current move on undo :-)
@last-move swap sixty-four 7 at-xy . . ;
: .last-board
..last-move
@last>stack ten 6 + 8        \ 16 8 = 8 times
do      8 0                  \ 8 *  = 64
do      sixty-four   \ margin over list and board
i 2 * +      \ every other space 8 chars
j at-xy      \ each lines 8 thru 16
..piece       \ print this stack value
loop
loop
parkcurs drop ; \ where whose-move prints

\ the parts of the main board - bottom
: .whose-move
parkcurs  \ where whose move prints
whose-move @
if      ." Black's move"
else    ." White's move"
then ;
: .letters      \ top and bottom
.." A    B    C    D    E    F    G    H" cr ;
: .bottom-underline ." ----------------------------------------" cr ;
: .margin-sp   margin spaces ;
: .board-bottom
..margin-sp 2 spaces .bottom-underline
..margin-sp 4 spaces .letters .whose-move ;
\ ranks
: .rank#  fourty-eight + emit ; \ print a rank number
: .end-rank
@rank# dup ?even
if      ." |"   \ choose an ending rank boarder
else    space
then
..rank# cr ;
: .black 5 spaces ;
: .white ." |||||" ;
: .white-or-black
@rank# + ?even
if      .white
else    .black
then ;
: .bgpcbg       \ <----thats background piece background
swap @rank# + ?even
if      ." | " .piece ."  |"
else    ."   " .piece ."   "
then ;
: .square
dup
if      .bgpcbg         \ occupied square
else    drop
..white-or-black \ blank square
then ;
: .rank-range
8 * sixty-four swap - dup 8 + swap ;
: .ranksqs
@rank# .rank-range
do      i dup
@sq<sga
..square
loop  ;
: .start-rank
@rank# dup .rank# ?even
if      space   \ choose a rank boarder
else    ." |"
then ;
: .rank-pieces
..start-rank
..ranksqs
..end-rank ;
: .rankblack
space ." |" 4 0
do      .black .white
loop
cr ;
: .rankwhite
2 spaces 4 0
do      .white .black
loop
.." |" cr ;
: .sqcol
@rank# ?even
if      .rankwhite
else    .rankblack
then ;
: .rank
..margin-sp .sqcol   \ above the piece
..margin-sp .rank-pieces \ rank of blanks and pieces
..margin-sp .sqcol ; \ below the piece
\ top
: .top_underline  ." _________________________________________" cr ;
: .title ." b18CHESSboard  by Ray St. Marie" cr ;
: .board-top
..margin-sp 6 spaces .title
..margin-sp 4 spaces .letters
..margin-sp 2 spaces .top_underline ;
: .board
page cr cr
..board-top 8 0
do      8 i -
!rank#
..rank
loop
..board-bottom ;

\ starting of scaffolding for the not yet implimented help system
: .menu-letters ." Apply Brnch Climb Down Edit File Game Help" ;
: .menu-bottom
..margin-sp 2 spaces
..bottom-underline
..margin-sp space
..menu-letters cr ;
: .menu-board
page .board-top 8 0
do      8 i - !rank#
..rank
loop    .menu-bottom ;

\ Calling the display
: display
..board
..last-board
..list-area
..whose-move ;
\ when to display saving execution cycles between reads
: display-last-only          \ on/off switch
execution-buffer @ =    \ incremented by normal-display
if      display         \ what ever the number of total-moves
0 total-moves ! \ display on the last one and reset
then ;

\ creating what to display
: switch-sides
whose-move @
if      whites-move whose-move !
else    blacks-move whose-move !
then ;
\ the list
: build-list
whose-move @
if      update-list-top  \ just update blacks move
else    @list-area>stack 9 0  \ get the list and
do      2drop    \ clear 18 characters
loop             \ off the bottom and
update-list-area \ recreate the list.
then ;
\ the text printer
: black-....  fourty-eight 2 - dup 2dup ; \   4 " . "
: numbers>letters spltR-F fifty-five + swap fourty-eight + ;
: convert-move
case
1 of    [char] o [char] - [char] o [char] . endof
2 of    [char] o [char] o [char] - [char] o endof
3 of    [char] e [char] p thirty-two
file# @ fifty-five + endof
unpkm                \ unpack move
numbers>letters rot  \ normal moves get converted
numbers>letters      \ to ascii here
0 endcase ;
\ the list format
: black-text
@blacks-last-move dup
if      convert-move  \ blacks move
else    drop
black-....    \ print "...."
then ;
: finish-line thirty-two thirty-two ; \ 2 space characters
: line-no
finish-line
@move# dup ten <                \ single digit?
if      thirty-two swap         \ add space
else    ten /mod                \ split decimal digits
fourty-eight + swap     \ ascii up ten's digit
then
fourty-eight +                  \ ascii up one's digit
finish-line ;
: move>text
@move#
if      line-no
@whites-last-move \ whites text
convert-move
finish-line
black-text
finish-line
build-list
then ;

\ heart this executes early on startup and every move
: chess
@move#                    \ if there are moves to process
if      move>text         \ create the list text to print
switch-sides
total-moves @     \ set in execute-moves
display-last-only
update-last-move  \ doing these after display means
update-last-board \ displaying the previous move
else    display                 \ default start up
then ;

\ Move Execution

: normal-display exbuf-incr chess ;

\ moves filters all moves
: ?prom-flag
prom-flag @ dup     \  something stored here?
if      swap drop   \ substitute this instead
else    drop
then ;              \  peice value to do-move
: do-move
0 swap unpkm      \ unpack move infront of clear square
dup @sq
?prom-flag        \ are we changing piece values
rot               \ align stack and
load-positions    \ set save-game-array current move
0 prom-flag ! ;   \ reset
\ print filter
: move-piece
whose-move @
if      !blacks-last-move  \ a move for black
else    +move#             \ increment on whites move only
!whites-last-move  \ print this as whites move
0 !blacks-last-move  \ signal to print "...."
then ;

\ normal-moves filter
: set-enpas-sq          \ the target dest of an en passant move
dup unpkm       \ unpack
get-file        \ file#
whose-move @    \ calculate the square behind
negate          \ the 2 square moving pawn
3 * 3 + +       \ square is rank white 6 black 3
enpas ! drop ;
: ?mov2sq
dup spltR-F     \ Rank# FileRankFile#
spltR-F spltR-F \ Srank# Sfile# Drank# Dfile#
drop swap drop  \ drop the file#s
- abs           \ subtract the rank#s correct for side
2 = ;           \ true if moving any 2 ranks
: ?setEnpasSq
?mov2sq               \ pawn 2 move option taken?
if      set-enpas-sq  \ compute and set
else    0 enpas !     \ reset
then ;
: ?pawn
dup unpkm     \ unpack
swap drop     \ discard dest
@sq           \ get it
2 <=          \ pawn value?
if      ?setEnpasSq
then ;

: promote-dest
wm@ia    \ get white 1 or black 0
7 * 1+   \ rank white 8 or black 1
s10*+s ; \ pack into dest and swap
: promote-source
wm@ia    \ get white 1 or black 0
5 * 2 +  \ make rank white 7 or black 2
s10*+s ; \ pack into source and swap
: set-promote-move
promote-source          \ get source ...
spltR-F                 \ split rank# file#
promote-dest            \ ... and dest
prom-flag !     \  do-move to substitute this dest
swap pkum swap ;        \ pack the move print
: ?promote
dup unpkm    \ unpack move
spltR-F      \ split rank# file#
swap         \ rank# is 0 signaling promote?
if      2drop  \ if not then proceed with normal-move
else    set-promote-move \ if so if 0 only
then ;
: normal-move
?promote     \ weird I don't test for pawn first hmmm
?pawn        \ check and set en passont square value
depth 1 =    \ make sure move-piece and do-move
if      dup  \ both get something to do
then
move-piece   \ print this
do-move ;  \ set save-game-array for the boards to print

\ special-moves filter
: take-pawn
dup get-file    \ separate file number
5wm@++          \ rank white 5 black 4
0 swap !dest ;  \ store 0 at square, taking pawn
: enpas-source     \ of mover
10 *       \ position file letter
5wm@++ ;   \ rank white 5 black 4
: enpas-s-d
enpas-source enpas @ ; \ enpas set on last pawns move
: enpass-entry
3 - dup         \ get file# and
file# !         \ store the file# for printing
enpas-s-d       \ get the source and dest on stack
0 enpas !       \ reset
take-pawn       \ remove offending pawn
swap pkum       \ packup move
do-move 3 ;     \ adjust sga and signal move-piece

: oo-o
whose-move @
if      0 a8 b c8 7 d8 0 e8 \ black
else    0 a1 c c1 8 d1 0 e1 \ white
then
load-positions 2 ;        \ signal for move-piece to print
: o-o
whose-move @
if      0 e8 7 f8 b g8 0 h8  \ black
else    0 e1 8 f1 c g1 0 h1  \ white
then
load-positions 1 ;        \ signal for move-piece to print
: ?castle-entry
case
1 of o-o  endof  \ king side
2 of oo-o endof  \ queen side
endcase ;
: special-entry
dup 2 <=
if      ?castle-entry   \ 1 or 2 on stack
else     enpass-entry   \ 3 on stack
then
move-piece ;    \ store these signals as the move to print

\ digestion muscle
: display\save-loop
clear-all clear-exbuf-counter 0           \ start clear
do      i @move dup a1 <        \ smaller than first square?
if      dup           \ no entry signal?
if      special-entry
else    drop
display leave  \ early finish
then
else    normal-move
then
normal-display
i @move   \ get the move entry again for
convert-move  \ to translation into ascii
4 0                \ and
do      line-buffer      \  will store in here
j 1+ cells +     \ at this offset
3 i - chars + c! \ these four characters
loop
lbuf-incr  \ increment the count in line-buffer
loop ;

\ persistance
: execute-moves
execution-buffer @          \ get count
dup dup total-moves !     \ total-moves will tell
if      display\save-loop   \ "normal-display" in
else    drop display        \ "display-last-only"
then                        \ when to display
open-sg-output              \ open a file
write-save-game ;           \ save moves to file

\ brains
: dekode  \ convert ascii to base 18 in chessboard co-ord format
fifty-five -   10 * swap fourty-eight - + 10 * swap
fifty-five - + 10 * swap fourty-eight - + ;
: ?format-castle  \ count the 'o's
over over 0 swap
[char] o =
if      1+ swap
[char] o =
if      1+
then
else    drop
then ;
: ?format
?format-castle                  \  count any 'o's?
1 over =
if      clear-stack 1           \ king side castle
else    2 over =
if      clear-stack 2   \ queen side
else    drop dekode   \ normal format and promotes
then
then ;
: format-ep  3 +        \ add ep signal and discard the rest
swap drop swap drop swap drop ;
: unconvert-move
over thirty-two =   \ a space in format means ep
if      format-ep
else    ?format     \ else test for other formats
then ;
: transfer-chars
0 dup line-buffer !         \ clear line-buffer counter
do      4 0                   \ for each offset in the
do      line-buffer   \ get the four characters
j 1+ cells +  \ that describe the move
3 i - chars + c@   \ in ascii
loop
unconvert-move  \ and make them base 18 numbers
i 1+ !exbuf     \ and store them for execution
loop ;
\ loading the saved information into the execution-buffer
: translate<lbuf
line-buffer @                   \ count in ascii
fourty-eight - dup 0 <=         \ now in base 18
if      drop
else    transfer-chars          \ process that many
then ;

\ entry preparation
: prev-moves
translate<lbuf  \ stack the lbuf chars as numbers
current-move @  \ stack this move
@exbuf>stack ;  \ stack any previous moves
: prepare-moves
line-buffer @    \ if there's any ascii in line-buffer
if      prev-moves      \ base 18 chars onto stack
else    current-move @  \ including the current move
then                    \ in both cases
!exbuf<stack ;          \ store them to be executed
\ entry handling
: which-pawn  whose-move @ 2 + ; \ black 1 white 2
: test-file   dup get-file dup which-pawn swap ;
: get-source
test-file 8 0         \ for each of 8 ranks in file
do      1+ 2dup       \ test each
@sq =         \  piece value for a pawn
if      swap rot        \ when found fix stack
2drop leave     \ and return
then
loop ;
: ?single\double-entry
dup a0 >=          \ are we on the board?
if      depth 1 =  \ "pawn in same-file dest-only" entry?
if      get-source
then
pkum       \ pack it up
else    dup 3 >=   \ en passont or castle entry?
if      +  \ packs ep doesn't hurt anything else
then
then ;
: combined-entry
dup h8 >        \ larger than special or pawnDest?
if      unpkm           \ unpack move
else    depth 2 =       \ ep and split s d moves
if      swap    \ to match unpacking a move
then            \ pawn-dest-only fall thru
then ;
: resolve-move         \ condition all kinds of input
combined-entry        \ special, sd and s d
?single\double-entry  \ handle each type
current-move ! ;      \ we have a move to process
: entry
resolve-move    \ deal with current move entry
prepare-moves   \ deal with list of moves
execute-moves ; \ ready set go execute and display them

\ starting from several defaults
: count-moves   fourty-eight -  execution-buffer ! ;
: ?buffer-empty                 \ start-up display
line-buffer @ dup       \ save-file not empty?
if      count-moves
translate<lbuf
execute-moves
else    drop            \ default display on startup
chess           \ for empty save file
then ;
: part-start
b-18             \ set the base input language
clear-all       \ :-) blow nose
open-sg-input   \ read in the file
read-save-game  \ ( should check presence )
2drop ;
: start  part-start ?buffer-empty ;     \ this is split for debuging.

\ Game Input ( s, nsf, sn, undo, redo, endchess )

\ play
: s
dup
if      entry   \ parse interpreter entry and execute
else    start   \ default action and start up
then quit ;

\ files
: nsf new-save-file ; \ generate a new save file if none exists
: sn clear-save-file start ; \ start new with clear save-file
\ fixing display
: undo
@exbuf>stack    \ fetch all the current moves
depth 0 swap    \ count them and swap 0 under the depth
!exbuf          \ store 0 at depth clearing current move
clear-stack
clear-line-buffer
clear-save-file
execute-moves ;
: redo  current-move @ s ;
\ currently only works with the first undo
\ here i need a function to test for a file ( save-file.txt )
\ if there is a file name on the commandline when game starts
\ start and proceed with that file
\ if a save file exitsts just go on with it
\ if not create it.

: endchess decimal page
s" You can have your interpreter back." type space
s" BASE is decimal." type cr
s" 's' to restart b18chess, bye to exit." type space
s" b18chess words are still active." type cr ;

s \ start here read upwards\

\ functions below 's' are not "on"
: sga-d save-game-array sga>end cells dump ;
: eb-d execution-buffer sga>end dump ;
: lb-d line-buffer sga>end dump ;
: scan-stack  depth  dup if 0  do . loop  else drop then ;

Ray St. Marie wrote:

> Thank you Anton, :-)
>
> There's a problem with the "undo" feature under win32forth in the
above
> version. I've fixed that and it's below. Also, I've changed some of
the
> file handling words, as I work out a way to handle not needing the
> savefile on the first execution, and a way to select different save
> files, or load pre-set boards. /me novice programmer hobbiest.
> Suggestions welcome.
>

Ray, some questions;

What is the problem with 'the "undo" feature'? Can you be more
explicit?

What version of Win32Forth are you using?

There are several enhanced & bugfixed versions after 4.2, which is what
I suspect most people use; you can find the latest at
www.win32forth.org, on groups.yahoo.com/group/win32forth or sf.net.

The Yahoo group is a good place too for W32F specific disussions.
-- 
Regards
Alex McDonald

Hi Alex,

It was all me. Not a bug. I hope that my last post doesn't read like I
was trying to solve a win32forth deficiency. I was changing the way
that I handled the save file, and broke my 'undo' word in the process.
I was not aware of the fact that the posted version didn't 'undo' a
chess move in win32forth until after I posted b18chess here.

I'm using the newest version of win32forth that I know of. -- 6.08.00
build 17. It's pretty I likey. 

:-) Ray

Hi Alex,

It was all me. Not a bug. I hope that my last post doesn't read like I
was trying to solve a win32forth deficiency. I was changing the way
that I handled the save file, and broke my 'undo' word in the process.
I was not aware of the fact that the posted version didn't 'undo' a
chess move in win32forth until after I posted b18chess here.

I'm using the newest version of win32forth that I know of. -- 6.08.00
build 17. It's pretty I likey. 

:-) Ray

Darn. It's the en passont text in the save file this time.
For instance the command "ok: ep e s"
should record a single digit in the save file and in this case it
should be an 'h' in base 18 because that's the value of e + ep ( ep
being = to 3) .

Currenly, it displays a 707A in the save file.
I'm working on this and will have a solution soon. 

Ray

"Ray St. Marie" <ray.stmarie@gmail.com> writes:
>There's a problem with the "undo" feature under win32forth in the above
>version. I've fixed that and it's below.

Unfortunately this still had the problems I had fixed (discussed
below).  Please fix them, or continue with the version with the fixes
I have applied (you can find it for this version on
http://www.complang.tuwien.ac.at/forth/programs/b18text3.fs).

> Also, I've changed some of the
>file handling words, as I work out a way to handle not needing the
>savefile on the first execution, and a way to select different save
>files, or load pre-set boards. /me novice programmer hobbiest.
>Suggestions welcome.

Just check whether the OPEN-FILE has worked (via the ior); if not, use
CREATE-FILE (or is it better the other way round).  In any case, don't
put absolute file names that make only sense on your system into the
file.  Better use relative file names, and if you want to use a
subdirectory, use "/" as directory separator (works on more OSs).  But
since you cannot create the subdirectory, better not use it.

Some style issues:

Use stack comments!

Don't use DEPTH!  Use words with different names for different stack
effects and different actions.

Don't use QUIT!  Just return normally, or THROW/ABORT.

If you have to start the thing from within the file, either provide
the parameters (i.e., "true 0 s") or mention at the start of the file
what parameters should be passed to the file.  The lack of a stack
comment for S adds insult to injury.

- anton
-- 
M. Anton Ertl  http://www.complang.tuwien.ac.at/anton/home.html
comp.lang.forth FAQs: http://www.complang.tuwien.ac.at/forth/faq/toc.html
New standard: http://www.complang.tuwien.ac.at/forth/ansforth/forth200x.html