♕♘♗♘♖♔♖♗

While it is easy to find the position for the corresponding ID number from sheets of paper, the reverse is much more difficult.

Interestingly there seems to be no program out there, to accomplish this.

Because this is a good example to introduce many of the 7th language words – here now the program.

The pieces are added to the position by touching them. The last piece is removed by touching the red ⌫-symbol. Ok – the GUI features are rudimentary, but this part is normaly covered from the hosting Java™ program.

As soon as the row contains 8 pieces, the program terminates. If the position is valid in Chess960, the ID number is shown.

Remember to place the Bishops on two fields of different colors (that means an even number of pieces or no piece betweeen the Bishops) and the King must be placed between two Rooks.

If you are interested in the probability of winning for white, you can download the computer chess rating list from 01/15/2020.

// in memoriam Reinhard Scharnagl
// © 2020 Otmar Klenk
forget ♔table

: ♔table
  0   "♕♘♘♖♔♖" 16  "♘♕♘♖♔♖" 32  "♘♘♕♖♔♖" 48  "♘♘♖♕♔♖" 64  "♘♘♖♔♕♖"
  80  "♘♘♖♔♖♕" 96  "♕♘♖♘♔♖" 112 "♘♕♖♘♔♖" 128 "♘♖♕♘♔♖" 144 "♘♖♘♕♔♖"
  160 "♘♖♘♔♕♖" 176 "♘♖♘♔♖♕" 192 "♕♘♖♔♘♖" 208 "♘♕♖♔♘♖" 224 "♘♖♕♔♘♖"
  240 "♘♖♔♕♘♖" 256 "♘♖♔♘♕♖" 272 "♘♖♔♘♖♕" 288 "♕♘♖♔♖♘" 304 "♘♕♖♔♖♘"
  320 "♘♖♕♔♖♘" 336 "♘♖♔♕♖♘" 352 "♘♖♔♖♕♘" 368 "♘♖♔♖♘♕" 384 "♕♖♘♘♔♖"
  400 "♖♕♘♘♔♖" 416 "♖♘♕♘♔♖" 432 "♖♘♘♕♔♖" 448 "♖♘♘♔♕♖" 464 "♖♘♘♔♖♕"
  480 "♕♖♘♔♘♖" 496 "♖♕♘♔♘♖" 512 "♖♘♕♔♘♖" 528 "♖♘♔♕♘♖" 544 "♖♘♔♘♕♖"
  560 "♖♘♔♘♖♕" 576 "♕♖♘♔♖♘" 592 "♖♕♘♔♖♘" 608 "♖♘♕♔♖♘" 624 "♖♘♔♕♖♘"
  640 "♖♘♔♖♕♘" 656 "♖♘♔♖♘♕" 672 "♕♖♔♘♘♖" 688 "♖♕♔♘♘♖" 704 "♖♔♕♘♘♖"
  720 "♖♔♘♕♘♖" 736 "♖♔♘♘♕♖" 752 "♖♔♘♘♖♕" 768 "♕♖♔♘♖♘" 784 "♖♕♔♘♖♘"
  800 "♖♔♕♘♖♘" 816 "♖♔♘♕♖♘" 832 "♖♔♘♖♕♘" 848 "♖♔♘♖♘♕" 864 "♕♖♔♖♘♘"
  880 "♖♕♔♖♘♘" 896 "♖♔♕♖♘♘" 912 "♖♔♖♕♘♘" 928 "♖♔♖♘♕♘" 944 "♖♔♖♘♘♕"
;

: ♗table
  "♗♗------"  "♗--♗----"  "♗----♗--"  "♗------♗"
  "-♗♗-----"  "--♗♗----"  "--♗--♗--"  "--♗----♗"
  "-♗--♗---"  "---♗♗---"  "----♗♗--"  "----♗--♗"
  "-♗----♗-"  "---♗--♗-"  "-----♗♗-"  "------♗♗"
;

memory::♔map drop
memory::♗map drop
memory::stats drop
string position

: ♔map-onerr
  2drop
  "is not a valid position" println
  quit
;

: ♗map-onerr
  ♔map-onerr
;

: populate
  ♔map fn .clear
  ♗map fn .clear
  ♔table
  60 0 do
    ♔map !
  loop

  ♗table
  0 16 do
    i -rot '♗' indicesof ♗map !
  -1 +loop
;

: rect  ( piece x -- )
  green setcolor
  over '⌫' == if
    red setcolor
    g fn 3 pick 100 60 60 .drawRect
    5 -
  else
    g fn 3 pick 100 60 60 .drawRect
    black setcolor
  then
  10 + g fn 2swap swap str$ rot 145 .drawString
;

: click  ( piece x --  )
  2dup rect
  100 65 65 mouse? if
    paperWhite setcolor
    g fn position @ 60 80 .drawString
    dup '⌫' == if
      position size 0> if
        position position size 1- left$ position !
      then
      drop
    else
      str$ position s>&
      drop
    then
  else
    drop
  then
;

memory::POSmap drop
'K' '♔' POSmap !
'Q' '♕' POSmap !
'R' '♖' POSmap !
'B' '♗' POSmap !
'N' '♘' POSmap !

: merge
  0 value idx
  string rslt
  "" rslt !
  for
    forobj '-' == if
      dup 0 <@ str$
      rslt s>& drop
    else
      forobj str$ rslt s>& drop
    then
  each
  rslt @
;

: pos$  ( id -- pos$ )
  ♔map fn .clear
  ♗map fn .clear
  ♔table
  60 0 do
    rot ♔map !
  loop
  ♗table
  0 16 do
    i ♗map !
  -1 +loop
  16 /mod >int swap >int 16 *
  ♔map @ >carr
  ♗map rot @ >carr
  merge
  rot drop
;

: POS$  ( id -- POS$ )
  string s
  "" s !
  s swap
  pos$ >carr for
    forobj POSmap @ s<&
  each
  @
;

: POS  ( id --  )
  POS$
  2dup println
  stats size 0> if
    stats @ println
  else
    2drop
  then
;

: FEN$  ( id -- FEN$ )
  string s
  "" s !
  POS$ 2dup lower$ s s>&
  "/pppppppp/8/8/8/8/PPPPPPPP/" s<&
  s>&
  bl s<& "w KQkq -" s<&
  @
;

: match
  position @ "♗" strip$ ♔map @
  position @ '♗' indicesof ♗map @
  + dup "\n\n\n\n\n\n\n\nid: " print println
  dup pos$ print space
  POS
;

: id
  cls
  "Dialog" 0 40 setfont
  populate
  position 7 left$ position !
  repeat
    '♔' 50  click '♕' 120 click '♖' 190 click '♗' 260 click '♘' 330 click '⌫' 419 click
    black setcolor
    g fn position @ 60 80 .drawString
    position size 8 >=
  until
  match
  "" position !
;

: score
  stats fn .clear
  "opening_report_by_eco.txt" existsf? if
    "opening_report_by_eco.txt" openf
    begin
      readline$
      eof? not
    while
      split dup dup 3 @ 4 left$ val
      100.0 rot 2 @ 4 left$ val -
      / 10000 * 5+ 10 / >int 10 /
      str$ "%" concat$
      rot 0 @ stats !
    repeat
    2drop
    "opening_report_by_eco.txt" closef
  then
;

: pos  ( id --  )
  cls
  dup
  pos$ type cr
  POS
;

: FEN  ( id --  )
  FEN$ type cr
;

: rpos  (  --  )
  960 random
  pos
;

clear
decimal
score
."enter \"id\", \"‹id› pos\", \"rpos\" or \"‹id› FEN\"" cr