'teachess, begun 26-APR-2000
'Written in Teapro which uses the OpenTea technology
'In today's world, we need computer software that actually works.
vari sg_pass1, sg_pass2, sg_pass3, dg_pass1, dg_pass2, dg_pass3
vari sg_makemove, dg_end, dg_good, dg_whiteatbottom
vari dg_badmove, dg_badform
vari sg_game, sg_whitemove, sg_blackmove, sg_number, dg_movenumber
vari dg_wking, dg_bking
vari dg_wincheck, dg_bincheck
vari sg_menwhite, sg_menblack
vari sg_abcdefgh, sg_12345678
vari dg_square, dg_file, dg_rank
vari dg_continuous, dg_debug
vari sg_board0, sg_board1, sg_board2, sg_board3, sg_board4, sg_board5
vari sg_tobywhite, sg_tobyblack
vari sg_chkboard
vari sg_moveman1, sg_moveman2, sg_moveman3, sg_moveman4
vari dg_movefrom1, dg_movefrom2, dg_movefrom3, dg_movefrom4
vari dg_moveto1, dg_moveto2, dg_moveto3, dg_moveto4
vari sg_movefrom1, sg_movefrom2, sg_movefrom3, sg_movefrom4
vari sg_moveto1, sg_moveto2, sg_moveto3, sg_moveto4
vari dg_movefromhold2, dg_movetohold2, sg_movemanhold2
vari dg_value0, dg_value1, dg_value2, dg_value3, dg_value4
vari dg_movecount1, dg_movecount2, dg_movecount3
vari dg_totalmovecount2, dg_totalmovecount3
vari dg_solution, sg_score
vari dg_totalmatescount, dg_matescount
vari sg_movemanm, dg_movefromm, dg_movetom, sg_movefromm, sg_movetom
vari dg_new, sg_boardm
vari dg_binmate
vari sg_promotion1, sg_promotion2, sg_promotion3
vari sg_nothing, sg_build
vari dg_myfileout, sg_myfileout, sg_myreordcout, dg_mywhiteonmove
vari dg_mymovenumber
sub_main
endp
subr sub_main
'updated 2008/02/25, 2008/02/07, 2005/10/07, 2002/11/10
vari s_any, d_any, s_dot, d_dot
vari d_loop, s_pick, d_pick
$trb sg_nothing, " "
sg_build = "Program: teachess.tea, build=24, 2008/02/25"
$out sg_build
$out "Copyright (c) 2000-2008 D La Pierre Ballard"
$out "Written in Teapro which uses the OpenTea technology"
$out "Copyright (c) 1997-2008 D La Pierre Ballard"
$out "This program begun 26-APR-2000"
dsys d_any, 1
dsys d_dot, 2
ded$ s_any, d_any, 0, 0
ded$ s_dot, d_dot, 0, 0
$out "memory=" + s_any + ", lines=" + s_dot
dsec d_any
ded$ s_any, d_any, 0, 0
$out "Seconds = " + s_any
d_loop = 1
dwhi d_loop = 1
sub_speedquick
$out "1 = Play over a game"
$out "2 = Solve a Chess Composition"
$out "99. speed test " + dg_pass1
$inp s_pick, "Choose a number, * to end"
$isd d_any, s_pick
d_pick = 0
dift d_any = 1: $tod d_pick, s_pick
$ift s_pick = "*": dinc d_loop
dift d_pick = 1: sub_overprocess
dift d_pick = 2: sub_compprocess
dift d_pick = 99: sub_speed_test
endw
ends sub_main
subr sub_overprocess
'updated 2002/11/10
vari s_any, d_any, s_dot, d_dot
vari d_loop
dsec d_any
ded$ s_any, d_any, 0, 0
$out "Seconds = " + s_any
$out "1 = Enter moves yourself"
$out "2 = Have computer read in score and play moves"
$inp s_any, "Enter a number, * to end"
$ift s_any = "1": sub_my_move
$ift s_any = "2": sub_examine0
ends sub_overprocess
subr sub_examine0
'updated 2002/11/10
'play over games whose scores are in files
vari s_any, d_any, d_loop
d_loop = 1
dwhi d_loop = 1
sub_examine1
$inp s_any, "1 = go over another one"
$ift s_any <> "1": dinc d_loop
endw
ends sub_examine0
subr sub_examine1
'updated 2002/11/10
'to read in examine and play over a game of chess
vari d_any, s_any, d_dot, s_dot
vari s_inputfile, s_record, d_good
sub_overinitialize
dg_badmove = 0
dg_badform = 0
d_good = 1
$inp s_inputfile, "Enter the game filename, * to end"
$trb s_inputfile, s_inputfile
$ift s_inputfile = "*": dinc d_good
dift d_good = 1
$len d_any, s_inputfile
dift d_any < 5: dinc d_good
endi
dift d_good = 1
dg_whiteatbottom = 1
sub_overboard
$out " "
$out " "
dg_whiteatbottom = 2
sub_overboard
dg_whiteatbottom = 2
$inp s_any, "1 = White at bottom"
$ift s_any = "1": dg_whiteatbottom = 1
dg_continuous = 0
$inp s_any, "1 = one second continuous"
$isd d_any, s_any
dift d_any = 1: $tod dg_continuous, s_any
endi
dift d_good = 1
finp s_record, s_inputfile
$bes s_record, s_record
$trb s_record, s_record
'take out extra spaces
d_dot = 1
dwhi d_dot > 0
$lok d_dot, s_record, 1, " "
dift d_dot > 0: $del s_record, d_dot, 1
endw
$len d_any, s_record
dift d_any < 20
$out s_record
dinc d_good
endi
$cut s_any, s_record, 1, 2
$ift s_any <> "1.": dinc d_good
endi
dift d_good = 1
sg_game = s_record
sub_examine2
endi
dift d_good <> 1
$cut s_any, s_record, 1, 70
$out s_any
$inp s_any, "error, see record above"
endi
$inp s_any, "return"
ends sub_examine1
subr sub_examine2
'updated 2002/11/10
vari d_any, s_any, d_dot, s_dot
vari s_move, s_remaining, d_loop, d_done
s_remaining = sg_game + " "
$trl s_remaining, s_remaining
d_done = 2
d_loop = 1
dwhi d_loop = 1
$lok d_dot, s_remaining, 1, "."
dift d_dot > 0
$cut sg_number, s_remaining, 1, d_dot
dinc d_dot
$cut s_remaining, s_remaining, d_dot, 5000
$trl s_remaining, s_remaining
'get the move number
$len d_any, sg_number
ddec d_any
$cut s_any, sg_number, 1, d_any
$tod dg_movenumber, s_any
'get White's move
$lok d_dot, s_remaining, 1, " "
$cut s_move, s_remaining, 1, d_dot
$cut s_remaining, s_remaining, d_dot, 5000
$trl s_remaining, s_remaining
$trb s_move, s_move
$ift s_move = "0-1": d_done = 1
$ift s_move = "1-0": d_done = 1
$ift s_move = "1/2-1/2": d_done = 1
dift d_done <> 1
sg_whitemove = s_move
sub_make_white_move
'get Black's move
$lok d_dot, s_remaining, 1, " "
$cut s_move, s_remaining, 1, d_dot
$trb s_move, s_move
dinc d_dot
$cut s_remaining, s_remaining, d_dot, 5000
$trl s_remaining, s_remaining
$ift s_move = "0-1": d_done = 1
$ift s_move = "1-0": d_done = 1
$ift s_move = "1/2-1/2": d_done = 1
endi
dift d_done <> 1
sg_blackmove = s_move
sub_make_black_move
else
$out "Over " + s_move
dinc d_loop
endi
else
dinc d_loop
endi
endw
ends sub_examine2
subr sub_make_white_move
'updated 2004/07/21
vari d_any, s_any, d_dot, s_dot, d_good, d_error
vari d_loop, d_long, d_check, d_mate, s_move, d_done
vari d_rank1, d_rank2, d_file1, d_file2, s_piece
vari d_ambiguous, d_ambfile, d_ambrank
vari d_delta, d_index, d_capture
vari s_square2, d_square2, d_square1
vari s_promotion, d_promotion
d_done = 2
d_error = 2
d_good = 2
'do we have a check or mate
s_move = sg_whitemove
$len d_long, s_move
$cut s_any, s_move, d_long, 1
d_check = 2
d_mate = 2
$ift s_any = "+"
d_check = 1
ddec d_long
$cut s_move, s_move, 1, d_long
endi
$ift s_any = "#"
d_mate = 1
ddec d_long
$cut s_move, s_move, 1, d_long
endi
'replace zeros with Os
$ift s_move = "0-0": s_move = "O-O"
'is the move castling
$ift s_move = "O-O"
d_done = 1
$cut s_dot, sg_board0, 151, 1
$ift s_dot <> "K": d_error = 1
$cut s_dot, sg_board0, 161, 1
$ift s_dot <> "-": d_error = 1
$cut s_dot, sg_board0, 171, 1
$ift s_dot <> "-": d_error = 1
$cut s_dot, sg_board0, 181, 1
$ift s_dot <> "R": d_error = 1
dift d_error = 1
$cut s_dot, sg_board0, 151, 1
$out "151=" + s_dot
$cut s_dot, sg_board0, 161, 1
$out "161=" + s_dot
$cut s_dot, sg_board0, 171, 1
$out "171=" + s_dot
$cut s_dot, sg_board0, 181, 1
$out "181=" + s_dot
else
d_good = 1
$rep sg_board0, 151, "-"
$rep sg_board0, 161, "R"
$rep sg_board0, 171, "K"
$rep sg_board0, 181, "-"
endi
endi
$ift s_move = "0-0-0": s_move = "O-O-O"
$ift s_move = "O-O-O"
d_done = 1
$cut s_dot, sg_board0, 111, 1
$ift s_dot <> "R": d_error = 1
$cut s_dot, sg_board0, 121, 1
$ift s_dot <> "-": d_error = 1
$cut s_dot, sg_board0, 131, 1
$ift s_dot <> "-": d_error = 1
$cut s_dot, sg_board0, 141, 1
$ift s_dot <> "-": d_error = 1
$cut s_dot, sg_board0, 151, 1
$ift s_dot <> "K": d_error = 1
dift d_error <> 1
d_good = 1
$rep sg_board0, 111, "-"
$rep sg_board0, 131, "K"
$rep sg_board0, 141, "R"
$rep sg_board0, 151, "-"
endi
endi
dift d_done <> 1
'do we have a capture
$lok d_capture, s_move, 1, "x"
dift d_capture > 0: $del s_move, d_capture, 1
'do we have a Pawn move
$cut s_any, s_move, 1, 1
$lok d_file1, sg_abcdefgh, 1, s_any
dift d_file1 > 0
'we have a Pawn move
d_done = 1
'do we have a Pawn promotion
d_promotion = 2
$swp s_move, "=", ""
$len d_long, s_move
$cut s_promotion, s_move, d_long, 1
$lok d_dot, sg_menwhite, 1, s_promotion
dift d_dot > 0
d_promotion = 1
ddec d_long
$cut s_move, s_move, 1, d_long
$ift s_promotion = "P": d_error = 1
$ift s_promotion = "K": d_error = 1
endi
$len d_long, s_move
dift d_long = 3
dift d_capture = 0
d_capture = 2
dg_badform = dg_movenumber
endi
endi
dift d_capture > 0
'Pawn capture ef6 since x has been taken out
$cut sg_pass1, s_move, 2, 2
sub_e4_to_154
d_square2 = dg_square
d_file2 = dg_file
d_rank2 = dg_rank
'a promotion must be on rank 8
dift d_promotion = 1
dift d_rank2 <> 8: d_error = 1
endi
$cut s_square2, sg_board0, d_square2, 1
dift d_file1 < d_file2
'44 to 55
d_square1 = d_square2 - 11
else
'44 to 35
d_square1 = d_square2 + 9
endi
$cut s_any, sg_board0, d_square1, 1
$ift s_any <> "P": d_error = 1
'is it an en passant capture
$ift s_square2 = "-"
'is d_square2 on the sixth rank
dift d_rank2 = 6
d_any = d_square2 - 1
$cut s_any, sg_board0, d_any, 1
$ift s_any = "p"
'fix so previous Pawn move was one forward
$rep sg_board0, d_any, "-"
$rep sg_board0, d_square2, "p"
s_square2 = "p"
endi
endi
endi
$cut s_square2, sg_board0, d_square2, 1
$lok d_any, sg_menblack, 1, s_square2
dift d_any = 0: d_error = 1
'make the capture move
dift d_error <> 1
d_good = 1
$rep sg_board0, d_square1, "-"
$rep sg_board0, d_square2, "P"
dift d_promotion = 1
$rep sg_board0, d_square2, s_promotion
endi
endi
else
'Pawn move forward
$cut sg_pass1, s_move, 1, 2
sub_e4_to_154
d_square2 = dg_square
d_rank2 = dg_rank
d_file2 = dg_file
'a promotion must be on rank 8
dift d_promotion = 1
dift d_rank2 <> 8: d_error = 1
endi
$cut s_square2, sg_board0, d_square2, 1
$ift s_square2 <> "-": d_error = 1
d_square1 = d_square2 - 1
$cut s_any, sg_board0, d_square1, 1
'is it a 2 square move
$ift s_any <> "P"
$ift s_any <> "-": d_error = 1
ddec d_square1
$cut s_any, sg_board0, d_square1, 1
$ift s_any <> "P": d_error = 1
endi
dift d_error <> 1
d_good = 1
$rep sg_board0, d_square1, "-"
$rep sg_board0, d_square2, "P"
dift d_promotion = 1
$rep sg_board0, d_square2, s_promotion
endi
endi
endi
endi
endi
dift d_done <> 1
$cut s_piece, s_move, 1, 1
'we have taken out the x for capture
'is the move ambiguous
d_ambiguous = 2
$len d_long, s_move
dift d_long = 4
d_ambiguous = 1
$cut s_any, s_move, 2, 1
$lok d_ambfile, sg_abcdefgh, 1, s_any
$lok d_ambrank, sg_12345678, 1, s_any
$del s_move, 2, 1
endi
'get the to square
$cut sg_pass1, s_move, 2, 2
sub_e4_to_154
d_square2 = dg_square
$cut s_square2, sg_board0, d_square2, 1
'if capture is it good
dift d_capture > 0
$lok d_any, sg_menblack, 1, s_square2
dift d_any = 0
d_error = 1
d_done = 1
endi
else
'if not capture
$ift s_square2 <> "-"
$lok d_any, sg_menblack, 1, s_square2
dift d_any > 0
dg_badform = dg_movenumber
else
d_error = 1
d_done = 1
endi
endi
endi
endi
dift d_done <> 1
'moves by other pieces than Pawns
d_square1 = 0
'do we have a Knight move
$ift s_piece = "N"
d_index = 91
dwhi d_index <= 98
itod d_delta, d_index
d_dot = d_square2 + d_delta
$cut s_any, sg_board0, d_dot, 1
$ift s_any = "N"
dift d_ambiguous = 1
d_file1 = d_dot - 100 \ 10
d_rank1 = d_dot - 100 % 10
dift d_rank1 = d_ambrank: d_square1 = d_dot
dift d_file1 = d_ambfile: d_square1 = d_dot
else
d_square1 = d_dot
endi
endi
dinc d_index
endw
endi
'do we have a Bishop move
$ift s_piece = "B"
d_index = 85
dwhi d_index <= 88
d_dot = d_square2
itod d_delta, d_index
d_loop = 1
dwhi d_loop = 1
d_dot = d_dot + d_delta
$cut s_dot, sg_board0, d_dot, 1
$ift s_dot <> "-": dinc d_loop
endw
$cut s_dot, sg_board0, d_dot, 1
$ift s_dot = "B"
dift d_ambiguous = 1
d_file1 = d_dot - 100 \ 10
d_rank1 = d_dot - 100 % 10
dift d_rank1 = d_ambrank: d_square1 = d_dot
dift d_file1 = d_ambfile: d_square1 = d_dot
else
d_square1 = d_dot
endi
endi
dinc d_index
endw
endi
'do we have a Rook move
$ift s_piece = "R"
d_index = 81
dwhi d_index <= 84
d_dot = d_square2
itod d_delta, d_index
d_loop = 1
dwhi d_loop = 1
d_dot = d_dot + d_delta
$cut s_dot, sg_board0, d_dot, 1
$ift s_dot <> "-": dinc d_loop
endw
$cut s_dot, sg_board0, d_dot, 1
$ift s_dot = "R"
dift d_ambiguous = 1
d_file1 = d_dot - 100 \ 10
d_rank1 = d_dot - 100 % 10
dift d_rank1 = d_ambrank: d_square1 = d_dot
dift d_file1 = d_ambfile: d_square1 = d_dot
else
d_square1 = d_dot
endi
endi
dinc d_index
endw
endi
'do we have a Queen move
$ift s_piece = "Q"
d_index = 81
dwhi d_index <= 88
d_dot = d_square2
itod d_delta, d_index
d_loop = 1
dwhi d_loop = 1
d_dot = d_dot + d_delta
$cut s_dot, sg_board0, d_dot, 1
$ift s_dot <> "-": dinc d_loop
endw
$cut s_dot, sg_board0, d_dot, 1
$ift s_dot = "Q"
dift d_ambiguous = 1
d_file1 = d_dot - 100 \ 10
d_rank1 = d_dot - 100 % 10
dift d_rank1 = d_ambrank: d_square1 = d_dot
dift d_file1 = d_ambfile: d_square1 = d_dot
else
d_square1 = d_dot
endi
endi
dinc d_index
endw
endi
'do we have a King move
$ift s_piece = "K"
d_index = 81
dwhi d_index <= 88
itod d_delta, d_index
d_dot = d_square2 + d_delta
$cut s_dot, sg_board0, d_dot, 1
$ift s_dot = "K": d_square1 = d_dot
dinc d_index
endw
endi
'do we have a move to make
dift d_square1 > 0
d_good = 1
'make the move
$cut s_piece, sg_board0, d_square1, 1
$rep sg_board0, d_square1, "-"
$rep sg_board0, d_square2, s_piece
endi
endi
$out " "
sub_overboard
$out " "
$out "White's move = " + sg_number + sg_whitemove
dift d_good <> 1
$inp s_any, "move error=" + s_move
dift dg_badmove = 0: dg_badmove = dg_movenumber
endi
dift dg_badform > 0: $out "move bad form=" + dg_badform
dift dg_continuous > 0
sub_pause
else
$inp s_any, "return"
$ift s_any = "debug": dg_debug = 1
endi
ends sub_make_white_move
subr sub_make_black_move
'updated 2004/07/21
vari d_any, s_any, d_dot, s_dot, d_good, d_error
vari d_loop, d_long, d_check, d_mate, s_move, d_done
vari d_rank1, d_rank2, d_file1, d_file2, s_piece
vari d_ambiguous, d_ambfile, d_ambrank
vari d_delta, d_index, d_capture
vari s_square1, d_square1, s_square2, d_square2
vari d_promotion, s_promotion
d_good = 2
d_done = 2
d_error = 2
'do we have a check
s_move = sg_blackmove
dift dg_debug = 1: $out dg_movenumber + "..." + s_move
$len d_long, s_move
$cut s_any, s_move, d_long, 1
d_check = 2
d_mate = 2
$ift s_any = "+"
d_check = 1
ddec d_long
$cut s_move, s_move, 1, d_long
endi
$ift s_any = "#"
d_mate = 1
ddec d_long
$cut s_move, s_move, 1, d_long
endi
'is the move castling
$ift s_move = "0-0": s_move = "O-O"
$ift s_move = "O-O"
d_done = 1
$cut s_dot, sg_board0, 158, 1
$ift s_dot <> "k": d_error = 1
$cut s_dot, sg_board0, 168, 1
$ift s_dot <> "-": d_error = 1
$cut s_dot, sg_board0, 178, 1
$ift s_dot <> "-": d_error = 1
$cut s_dot, sg_board0, 188, 1
$ift s_dot <> "r": d_error = 1
dift d_error <> 1
d_good = 1
$rep sg_board0, 158, "-"
$rep sg_board0, 168, "r"
$rep sg_board0, 178, "k"
$rep sg_board0, 188, "-"
endi
endi
$ift s_move = "0-0-0": s_move = "O-O-O"
$ift s_move = "O-O-O"
d_done = 1
$cut s_dot, sg_board0, 118, 1
$ift s_dot <> "r": d_error = 1
$cut s_dot, sg_board0, 128, 1
$ift s_dot <> "-": d_error = 1
$cut s_dot, sg_board0, 138, 1
$ift s_dot <> "-": d_error = 1
$cut s_dot, sg_board0, 148, 1
$ift s_dot <> "-": d_error = 1
$cut s_dot, sg_board0, 158, 1
$ift s_dot <> "k": d_error = 1
dift d_error <> 1
d_good = 1
$rep sg_board0, 118, "-"
$rep sg_board0, 138, "k"
$rep sg_board0, 148, "r"
$rep sg_board0, 158, "-"
endi
endi
dift d_done <> 1
'do we have a capture
$lok d_capture, s_move, 1, "x"
dift d_capture > 0: $del s_move, d_capture, 1
'do we have a Pawn move
$cut s_any, s_move, 1, 1
$lok d_file1, sg_abcdefgh, 1, s_any
dift d_file1 > 0
'we have a Pawn move
d_done = 1
'do we have a Pawn promotion
d_promotion = 2
$swp s_move, "=", ""
$len d_long, s_move
$cut s_promotion, s_move, d_long, 1
$clo s_promotion, s_promotion
$lok d_dot, sg_menblack, 1, s_promotion
dift d_dot > 0
d_promotion = 1
ddec d_long
$cut s_move, s_move, 1, d_long
$ift s_promotion = "p": d_error = 1
$ift s_promotion = "k": d_error = 1
endi
$len d_long, s_move
dift d_long = 3
dift d_capture = 0
d_capture = 2
dg_badform = dg_movenumber
endi
endi
dift d_capture > 0
'Pawn capture ef6 since x has been taken out
$cut sg_pass1, s_move, 2, 2
sub_e4_to_154
d_square2 = dg_square
d_file2 = dg_file
d_rank2 = dg_rank
'Pawn promotion must be to rank 1
dift d_promotion = 1
dift d_rank2 <> 1: d_error = 1
endi
$cut s_square2, sg_board0, d_square2, 1
dift d_file1 < d_file2
'45 to 54
d_square1 = d_square2 - 9
else
'45 to 34
d_square1 = d_square2 + 11
endi
dift dg_debug = 1: $out d_square1 + " x " + d_square2
'is it an en passant capture
$ift s_square2 = "-"
'is d_square2 on the third rank
dift d_rank2 = 3
d_any = d_square2 + 1
$cut s_any, sg_board0, d_any, 1
$ift s_any = "P"
$rep sg_board0, d_any, "-"
$rep sg_board0, d_square2, "P"
s_square2 = "P"
endi
endi
endi
$cut s_square1, sg_board0, d_square1, 1
$ift s_square1 <> "p": d_error = 1
$lok d_any, sg_menwhite, 1, s_square2
dift d_any = 0: d_error = 1
dift dg_debug = 1: $out s_square1 + " x " + s_square2
dift d_error <> 1
'make the move
d_good = 1
$rep sg_board0, d_square1, "-"
$rep sg_board0, d_square2, "p"
dift d_promotion = 1
$rep sg_board0, d_square2, s_promotion
endi
endi
else
'Pawn move forward
$cut sg_pass1, s_move, 1, 2
sub_e4_to_154
d_square2 = dg_square
d_rank2 = dg_rank
d_file2 = dg_file
'Pawn promotion must be to rank 1
dift d_promotion = 1
dift d_rank2 <> 1: d_error = 1
endi
$cut s_square2, sg_board0, d_square2, 1
d_square1 = d_square2 + 1
$cut s_square1, sg_board0, d_square1, 1
$ift s_square1 <> "p"
'do we have a double first move
$ift s_square1 <> "-": d_error = 1
dinc d_square1
$cut s_square1, sg_board0, d_square1, 1
$ift s_square1 <> "p": d_error = 1
endi
$cut s_square2, sg_board0, d_square2, 1
$ift s_square2 <> "-": d_error = 1
dift d_error <> 1
'make the move
d_good = 1
$rep sg_board0, d_square1, "-"
$rep sg_board0, d_square2, "p"
dift d_promotion = 1
$rep sg_board0, d_square2, s_promotion
endi
endi
endi
endi
endi
dift d_done <> 1
$cut s_piece, s_move, 1, 1
'we have taken out the x for capture
'is the move ambiguous
d_ambiguous = 2
$len d_long, s_move
dift d_long = 4
d_ambiguous = 1
$cut s_any, s_move, 2, 1
$lok d_ambfile, sg_abcdefgh, 1, s_any
$lok d_ambrank, sg_12345678, 1, s_any
$del s_move, 2, 1
endi
'get the to square
$cut sg_pass1, s_move, 2, 2
sub_e4_to_154
d_square2 = dg_square
$cut s_square2, sg_board0, d_square2, 1
'if capture is it good
dift d_capture > 1
$lok d_any, sg_menwhite, 1, s_square2
dift d_any = 0
d_error = 1
d_done = 1
endi
else
$ift s_square2 <> "-"
$lok d_any, sg_menwhite, 1, s_square2
dift d_any > 0
dg_badform = dg_movenumber
else
d_error = 1
d_done = 1
endi
endi
endi
endi
dift d_done <> 1
d_square1 = 0
'do we have a Knight move for Black
$ift s_piece = "N"
d_index = 91
dwhi d_index <= 98
itod d_delta, d_index
d_dot = d_square2 + d_delta
$cut s_any, sg_board0, d_dot, 1
$ift s_any = "n"
dift d_ambiguous = 1
d_file1 = d_dot - 100 \ 10
d_rank1 = d_dot - 100 % 10
dift d_rank1 = d_ambrank: d_square1 = d_dot
dift d_file1 = d_ambfile: d_square1 = d_dot
else
d_square1 = d_dot
endi
endi
dinc d_index
endw
endi
'do we have a Bishop move for Black
$ift s_piece = "B"
d_index = 85
dwhi d_index <= 88
d_dot = d_square2
itod d_delta, d_index
d_loop = 1
dwhi d_loop = 1
d_dot = d_dot + d_delta
$cut s_dot, sg_board0, d_dot, 1
$ift s_dot <> "-": dinc d_loop
endw
$cut s_dot, sg_board0, d_dot, 1
$ift s_dot = "b"
dift d_ambiguous = 1
d_file1 = d_dot - 100 \ 10
d_rank1 = d_dot - 100 % 10
dift d_rank1 = d_ambrank: d_square1 = d_dot
dift d_file1 = d_ambfile: d_square1 = d_dot
else
d_square1 = d_dot
endi
endi
dinc d_index
endw
endi
'do we have a Rook move for Black
$ift s_piece = "R"
d_index = 81
dwhi d_index <= 84
d_dot = d_square2
itod d_delta, d_index
d_loop = 1
dwhi d_loop = 1
d_dot = d_dot + d_delta
$cut s_dot, sg_board0, d_dot, 1
$ift s_dot <> "-": dinc d_loop
endw
$cut s_dot, sg_board0, d_dot, 1
$ift s_dot = "r"
dift d_ambiguous = 1
d_file1 = d_dot - 100 \ 10
d_rank1 = d_dot - 100 % 10
dift d_rank1 = d_ambrank: d_square1 = d_dot
dift d_file1 = d_ambfile: d_square1 = d_dot
else
d_square1 = d_dot
endi
endi
dinc d_index
endw
endi
'do we have a Queen move for Black
$ift s_piece = "Q"
d_index = 81
dwhi d_index <= 88
d_dot = d_square2
itod d_delta, d_index
d_loop = 1
dwhi d_loop = 1
d_dot = d_dot + d_delta
$cut s_dot, sg_board0, d_dot, 1
$ift s_dot <> "-": dinc d_loop
endw
$cut s_dot, sg_board0, d_dot, 1
$ift s_dot = "q"
dift d_ambiguous = 1
d_file1 = d_dot - 100 \ 10
d_rank1 = d_dot - 100 % 10
dift d_rank1 = d_ambrank: d_square1 = d_dot
dift d_file1 = d_ambfile: d_square1 = d_dot
else
d_square1 = d_dot
endi
endi
dinc d_index
endw
endi
'do we have a King move for Black
$ift s_piece = "K"
d_index = 81
dwhi d_index <= 88
itod d_delta, d_index
d_dot = d_square2 + d_delta
$cut s_dot, sg_board0, d_dot, 1
$ift s_dot = "k": d_square1 = d_dot
dinc d_index
endw
endi
'do we have a move to make
dift d_square1 > 0
d_good = 1
'make the move
$cut s_piece, sg_board0, d_square1, 1
$rep sg_board0, d_square1, "-"
$rep sg_board0, d_square2, s_piece
endi
endi
$out " "
sub_overboard
$out " "
$out "Black's move = " + sg_number + "..." + sg_blackmove
dift d_good <> 1
$inp s_any, "move error=" + s_move
dift dg_badmove = 0: dg_badmove = dg_movenumber
endi
dift dg_badform > 0: $out "move bad form=" + dg_badform
dift dg_continuous > 0
sub_pause
else
$inp s_any, "return"
$ift s_any = "debug": dg_debug = 1
endi
ends sub_make_black_move
subr sub_overinitialize
'updated 2002/11/10
vari s_any, d_any
'the board starts with 110 spaces
dch$ sg_board0, 32, 110
sg_board0 = sg_board0 + "RP----pr "
sg_board0 = sg_board0 + "NP----pn "
sg_board0 = sg_board0 + "BP----pb "
sg_board0 = sg_board0 + "QP----pq "
sg_board0 = sg_board0 + "KP----pk "
sg_board0 = sg_board0 + "BP----pb "
sg_board0 = sg_board0 + "NP----pn "
sg_board0 = sg_board0 + "RP----pr "
'the board ends with 100 spaces
dch$ s_any, 32, 100
sg_board0 = sg_board0 + s_any
dtoi 81, 1
dtoi 82, -1
dtoi 83, 10
dtoi 84, -10
dtoi 85, 11
dtoi 86, -11
dtoi 87, 9
dtoi 88, -9
dtoi 91, 12
dtoi 92, -12
dtoi 93, 21
dtoi 94, -21
dtoi 95, 19
dtoi 96, -19
dtoi 97, 8
dtoi 98, -8
sg_abcdefgh = "abcdefgh"
sg_menwhite = "PNBRQK"
sg_menblack = "pnbrqk"
sg_12345678 = "12345678"
sg_tobyblack = "-PNBRQK"
sg_tobywhite = "-pnbrqk"
dg_debug = 2
ends sub_overinitialize
subr sub_overboard
'updated 2002/11/10
vari d_any, s_any, d_dot, s_dot
vari s_rank, d_rank, d_file, s_left
dch$ s_left, 32, 10
dift dg_whiteatbottom = 1
'from White's side
d_rank = 8
dwhi d_rank >= 1
s_rank = s_left
d_file = 1
dwhi d_file <= 8
d_dot = d_file * 10 + d_rank + 100
$cut s_dot, sg_board0, d_dot, 1
$app s_rank, s_dot + " "
dinc d_file
endw
$out s_rank
ddec d_rank
endw
else
'from Black's side
d_rank = 1
dwhi d_rank <= 8
s_rank = s_left
d_file = 8
dwhi d_file >= 1
d_dot = d_file * 10 + d_rank + 100
$cut s_dot, sg_board0, d_dot, 1
$app s_rank, s_dot + " "
ddec d_file
endw
$out s_rank
dinc d_rank
endw
endi
ends sub_overboard
subr sub_find_kings
'updated 2002/11/10
vari d_any, s_any, d_dot, s_dot
vari d_loop, d_from
vari d_delta, d_index, d_count
dg_wking = 0
dg_bking = 0
d_dot = 111
dwhi d_dot <= 188
$cut s_dot, sg_board0, d_dot, 1
$ift s_dot = "K": dg_wking = d_dot
$ift s_dot = "k": dg_bking = d_dot
dinc d_dot
endw
'is either king in check
dg_wincheck = 2
dg_bincheck = 2
'check by knight
d_index = 91
dwhi d_index <= 98
itod d_delta, d_index
d_dot = dg_wking + d_delta
$cut s_dot, sg_board0, d_dot, 1
$ift s_dot = "n": dg_wincheck = 1
d_dot = dg_bking + d_delta
$cut s_dot, sg_board0, d_dot, 1
$ift s_dot = "N": dg_bincheck = 1
dinc d_index
endw
'check by Pawn, bishop, rook, queen or king
d_index = 81
dwhi d_index <= 88
itod d_delta, d_index
'is white in check
d_from = dg_wking
d_count = 0
d_loop = 1
dwhi d_loop = 1
dinc d_count
d_from = d_from + d_delta
$cut s_dot, sg_board0, d_from, 1
$ift s_dot <> "-": dinc d_loop
endw
dift d_count = 1
$ift s_dot = "k": dg_wincheck = 1
'how about a Pawn
$ift s_dot = "p"
dift d_delta = 9: dg_wincheck = 1
dift d_delta = 11: dg_wincheck = 1
endi
endi
$ift s_dot = "q": dg_wincheck = 1
$ift s_dot = "r"
dift d_index <= 84: dg_wincheck = 1
endi
$ift s_dot = "b"
dift d_index >= 85: dg_wincheck = 1
endi
'is black in check
d_from = dg_bking
d_count = 0
d_loop = 1
dwhi d_loop = 1
dinc d_count
d_from = d_from + d_delta
$cut s_dot, sg_board0, d_from, 1
$ift s_dot <> "-": dinc d_loop
endw
dift d_count = 1
$ift s_dot = "K": dg_bincheck = 1
'how about a Pawn
$ift s_dot = "P"
dift d_delta = -9: dg_bincheck = 1
dift d_delta = -11: dg_bincheck = 1
endi
endi
$ift s_dot = "Q": dg_bincheck = 1
$ift s_dot = "R"
dift d_index <= 84: dg_bincheck = 1
endi
$ift s_dot = "B"
dift d_index >= 85: dg_bincheck = 1
endi
dinc d_index
endw
ends sub_find_kings
subr sub_my_move
'updated 2008/02/18, 2008/02/17, 2008/02/09, 2008/02/07, 2002/11/10
vari d_any, s_any
vari d_good
d_good = 1
dift d_good = 1
sub_overinitialize
dg_mymovenumber = 0
dg_mywhiteonmove = 1
dg_myfileout = 2
$inp s_any, "1=output game score"
$ift s_any = "*": dinc d_good
$ift s_any = "1"
dg_myfileout = 1
$inp sg_myfileout, "enter filename"
$ift sg_myfileout = "*": dinc d_good
flen d_any, sg_myfileout
dift d_any > 0
$inp s_any, "1=purge old file=" + sg_myfileout
$ift s_any = "*": dinc d_good
$ift s_any = "1": fdel d_any, sg_myfileout
endi
endi
endi
dift d_good = 1
dg_whiteatbottom = 2
$inp s_any, "1 = White at bottom"
$ift s_any = "1": dg_whiteatbottom = 1
$ift s_any = "*": dinc d_good
endi
dg_end = 2
dift d_good <> 1: dinc dg_end
dwhi dg_end = 2
sub_overboard
sub_my_move_get_move
endw
dift dg_myfileout = 1: fapp d_any, sg_myfileout, sg_myreordcout
ends sub_my_move
subr sub_my_move_get_move
'updated 2008/02/18, 2008/02/17, 2008/02/07, 2005/10/08, 2002/11/10
vari d_any, s_any, d_dot, s_dot
dg_good = 2
dwhi dg_good <> 1
'ask for a move
s_any = "enter move,ie. g1-f3 * = end "
$app s_any, "'put pe4' or 'put -e4' "
$app s_any, "'e1-g1'='O-O' show new"
$inp sg_makemove, s_any
$ift sg_makemove = "*"
dg_end = 1
dg_good = 1
else
sub_my_move_validate_move
dift dg_good = 1
sub_my_move_make_move
else
$ift sg_makemove = "show": sub_overboard
$ift sg_makemove = "new"
sub_overinitialize
dg_mymovenumber = 0
dg_mywhiteonmove = 1
dg_whiteatbottom = 2
$inp s_any, "1 = White at bottom"
$ift s_any = "1": dg_whiteatbottom = 1
endi
$ift sg_makemove = sg_nothing
d_any = 1
dwhi d_any < 30
$dat s_any
dsec d_dot
$out s_any + " " + d_dot
dinc d_any
endw
endi
endi
endi
endw
ends sub_my_move_get_move
subr sub_my_move_validate_move
'updated 2008/02/18, 2008/02/17, 2008/02/08, 2008/02/07, 2002/11/10
vari d_any, s_any, d_dot, s_dot
vari d_file1, d_rank1, d_file2, d_rank2
vari d_move1, d_move2, s_square1, s_square2
'sg_abcdefgh = "abcdefgh"
'sg_12345678 = "12345678"
'sg_menwhite = "PNBRQK"
'sg_menblack = "pnbrqk"
'sg_tobyblack = "-PNBRQK"
'sg_tobywhite = "-pnbrqk"
dg_good = 1
dift dg_good = 1
$trb sg_makemove, sg_makemove
$len d_any, sg_makemove
dift d_any <> 5: dinc dg_good
endi
dift dg_good = 1
'e2-e4
'byte1
$cut s_any, sg_makemove, 1, 1
$lok d_file1, sg_abcdefgh, 1, s_any
dift d_file1 = 0: dinc dg_good
'byte2
$cut s_any, sg_makemove, 2, 1
$lok d_rank1, sg_12345678, 1, s_any
dift d_rank1 = 0: dinc dg_good
'byte3 must have - or x between
$cut s_any, sg_makemove, 3, 1
$ift s_any <> "-"
$ift s_any <> "x"
dinc dg_good
endi
endi
'byte4
$cut s_any, sg_makemove, 4, 1
$lok d_file2, sg_abcdefgh, 1, s_any
dift d_file2 = 0: dinc dg_good
'byte5
$cut s_any, sg_makemove, 5, 1
$lok d_rank2, sg_12345678, 1, s_any
dift d_rank2 = 0: dinc dg_good
endi
'sg_menwhite = "PNBRQK"
'sg_menblack = "pnbrqk"
'sg_tobyblack = "-PNBRQK"
'sg_tobywhite = "-pnbrqk"
dift dg_good = 1
d_move1 = d_file1 * 10 + d_rank1 + 100
d_move2 = d_file2 * 10 + d_rank2 + 100
$cut s_square1, sg_board0, d_move1, 1
$cut s_square2, sg_board0, d_move2, 1
s_any = "move=" + s_square1 + "," + d_move1
$app s_any, "," + s_square2 + "," + d_move2
$out s_any
dift dg_mywhiteonmove = 1
$lok d_any, sg_menwhite, 1, s_square1
dift d_any = 0: dinc dg_good
$lok d_any, sg_tobywhite, 1, s_square2
dift d_any = 0: dinc dg_good
else
$lok d_any, sg_menblack, 1, s_square1
dift d_any = 0: dinc dg_good
$lok d_any, sg_tobyblack, 1, s_square2
dift d_any = 0: dinc dg_good
endi
endi
dift dg_good <> 1
'try putting a piece on a square ie. Pe4
sub_my_move_put_man
endi
dift dg_good <> 1: $out "illegal move"
ends sub_my_move_validate_move
subr sub_my_move_make_move
'updated 2008/02/09, 2008/02/08, 2008/02/07, 2002/11/10
vari d_any, s_any, d_dot, s_dot, s_out
vari d_rank1, d_file1, d_rank2, d_file2
vari s_square1, s_square2, s_man, s_prev
vari d_move1, d_move2
'e2-e4
$cut s_any, sg_makemove, 1, 1
$lok d_file1, sg_abcdefgh, 1, s_any
$cut s_any, sg_makemove, 2, 1
$tod d_rank1, s_any
d_move1 = d_file1 * 10 + d_rank1 + 100
'e2-e4
$cut s_any, sg_makemove, 4, 1
$lok d_file2, sg_abcdefgh, 1, s_any
$cut s_any, sg_makemove, 5, 1
$tod d_rank2, s_any
d_move2 = d_file2 * 10 + d_rank2 + 100
'make the move
$cut s_man, sg_board0, d_move1, 1
$rep sg_board0, d_move1, "-"
$cut s_prev, sg_board0, d_move2, 1
$rep sg_board0, d_move2, s_man
'if capture put in "x" else "-"
$ift s_prev = "-"
$rep sg_makemove, 3, "-"
else
$rep sg_makemove, 3, "x"
endi
$cut s_square1, sg_makemove, 1, 2
$cut s_square2, sg_makemove, 4, 2
$ift s_man = "K"
'White castling
$ift s_square1 = "e1"
$ift s_square2 = "g1"
$rep sg_board0, 161, "R"
$rep sg_board0, 181, "-"
sg_makemove = "0-0"
endi
$ift s_square2 = "c1"
$rep sg_board0, 141, "R"
$rep sg_board0, 111, "-"
sg_makemove = "0-0-0"
endi
endi
endi
$ift s_man = "k"
'Black castling
$ift s_square1 = "e8"
$ift s_square2 = "g8"
$rep sg_board0, 168, "r"
$rep sg_board0, 188, "-"
sg_makemove = "0-0"
endi
$ift s_square2 = "c8"
$rep sg_board0, 148, "r"
$rep sg_board0, 118, "-"
sg_makemove = "0-0-0"
endi
endi
endi
'put chessman in front of sg_makemove
$cut s_any, sg_makemove, 1, 1
$ift s_any <> "0"
'e2-e4 to Pe2-e4
$cup s_man, s_man
sg_makemove = s_man + sg_makemove
endi
s_out = "move = " + d_file1 + d_rank1 + "-"
$app s_out, d_file2 + d_rank2 + " " + sg_makemove
$out s_out
dift dg_myfileout = 1
dift dg_mywhiteonmove = 1
'build sg_myrecordout of the move
dinc dg_mymovenumber
$app sg_myreordcout, " " + dg_mymovenumber
$app sg_myreordcout, ". " + sg_makemove
else
$app sg_myreordcout, " " + sg_makemove
endi
dift dg_mywhiteonmove <> 1
d_any = dg_mymovenumber % 3
dift d_any = 1
$out sg_myreordcout
fapp d_any, sg_myfileout, sg_myreordcout
dbad d_any = 0
sg_myreordcout = sg_nothing
endi
endi
endi
dift dg_mywhiteonmove = 1
dinc dg_mywhiteonmove
$out "Black to move"
else
dg_mywhiteonmove = 1
$out "White to move"
endi
ends sub_my_move_make_move
subr sub_my_move_put_man
'updated 2008/02/07, 2005/09/25, 2002/04/20
vari d_any, s_any, d_dot, s_dot, s_lok
vari d_good, d_rank, d_file, d_move, s_man
'"put pe4" or "put -e4"
d_good = 1
$len d_any, sg_makemove
dift d_any <> 7: dinc d_good
dift d_good = 1
$cut s_any, sg_makemove, 1, 4
$ift s_any <> "put ": dinc d_good
'put pe4
$cut s_man, sg_makemove, 5, 1
s_lok = "KQRBNPkqrbnp-"
$lok d_any, s_lok, 1, s_man
dift d_any = 0: dinc d_good
$cut s_any, sg_makemove, 6, 1
$lok d_file, sg_abcdefgh, 1, s_any
dift d_file = 0: dinc d_good
$cut s_any, sg_makemove, 7, 1
s_lok = "12345678"
$lok d_rank, s_lok, 1, s_any
dift d_rank = 0: dinc d_good
endi
dift d_good = 1
'put pe4
d_move = d_file * 10 + d_rank + 100
$rep sg_board0, d_move, s_man
sub_overboard
endi
ends sub_my_move_put_man
subr sub_e4_to_154
'updated 2002/04/20
'change e4 in sg_pass1 to 154 in dg_square
'and 5 in dg_file, 4 in dg_rank
vari s_square, d_any, s_any
s_square = sg_pass1
$cut s_any, s_square, 1, 1
$lok dg_file, sg_abcdefgh, 1, s_any
$cut s_any, s_square, 2, 1
$lok dg_rank, sg_12345678, 1, s_any
dg_square = dg_file * 10 + dg_rank + 100
dift dg_debug = 1
$out "square = " + s_square + " or " + dg_file + dg_rank
endi
ends sub_e4_to_154
subr sub_pause
'updated 2002/04/20
vari d_seconds, d_any
dsec d_seconds
d_any = 0
dwhi d_any < dg_continuous
dsec d_any
d_any = d_any - d_seconds
endw
ends sub_pause
'COMPOSITION BELOW
subr sub_compprocess
'updated 2002/04/20
vari s_any, d_any, s_dot, d_dot
vari d_seconds, d_loop
d_loop = 1
dwhi d_loop = 1
$inp s_any, "1 = old way, 2 = new way"
dg_new = 1
$ift s_any = "1": dg_new = 2
sub_compinitialize
sg_pass1 = sg_board0
sub_compboard
dsec d_seconds
sg_board1 = sg_board0
sub_move1
dsec d_any
d_seconds = d_any - d_seconds
s_any = "New"
dift dg_new <> 1: s_any = "Old"
$out s_any + " method, The solution follows:"
'output all of the solutions
d_dot = 1
dwhi d_dot <= dg_solution
ito$ s_dot, d_dot
$out "Solution=" + s_dot
dinc d_dot
endw
$inp s_any, "return, seconds = " + d_seconds
$inp s_any, "1 = do another"
$ift s_any <> "1": dinc d_loop
endw
ends sub_compprocess
subr sub_compinitialize
'updated 2002/04/20
vari s_any, d_any
vari s_pick, d_rotate
$out "1 = simplest"
$out "2 = Morphy's problem"
$out "3 = Alain C. White, A7"
$out "4 = A. Hesselgren, A6"
$out "5 = A. Kempe, 1855, A1"
$out "6 = Lev Loshinski, 1933"
$out "7 = Comins Mansfield, 1953"
$out "8 = Frederick Gamage, 1944"
$out "9 = Swaminatha Subrahmanyam, 1929"
$out "10 = Ottavio Stocchi, 1933"
$out "11 = Konstantin Gavrilov, 1931"
$out "12 = Sam Loyd, 1860, #157"
$out "13 = Sam Loyd, 1878, #158"
$out "14 = Sam Loyd, 1866, #160"
$out "15 = Sam Loyd, 1880, #161"
$out "16 = Sam Loyd, 1892, #163"
$inp s_pick, "Enter a number: 1 to 7"
'the board starts with 110 spaces
dch$ sg_board0, 32, 110
$ift s_pick = "1"
sg_board0 = sg_board0 + "----K--- "
sg_board0 = sg_board0 + "-------k "
sg_board0 = sg_board0 + "------R- "
sg_board0 = sg_board0 + "------R- "
sg_board0 = sg_board0 + "-------- "
sg_board0 = sg_board0 + "-------- "
sg_board0 = sg_board0 + "-------- "
sg_board0 = sg_board0 + "-------- "
d_rotate = 1
endi
$ift s_pick = "2"
$out "Paul Morphy"
sg_board0 = sg_board0 + "R-----pk "
sg_board0 = sg_board0 + "-----Ppb "
sg_board0 = sg_board0 + "-------K "
sg_board0 = sg_board0 + "-------- "
sg_board0 = sg_board0 + "-------- "
sg_board0 = sg_board0 + "-------- "
sg_board0 = sg_board0 + "-------- "
sg_board0 = sg_board0 + "-------- "
d_rotate = 2
endi
$ift s_pick = "3"
$out "by Alain C. White, A7"
sg_board0 = sg_board0 + "-------- "
sg_board0 = sg_board0 + "q-B----- "
sg_board0 = sg_board0 + "bP------ "
sg_board0 = sg_board0 + "kB-----R "
sg_board0 = sg_board0 + "-------- "
sg_board0 = sg_board0 + "---N-Q-- "
sg_board0 = sg_board0 + "-------- "
sg_board0 = sg_board0 + "-------K "
d_rotate = 2
endi
$ift s_pick = "4"
$out "A. Hesselgren, A6"
sg_board0 = sg_board0 + "---R---B "
sg_board0 = sg_board0 + "---b---- "
sg_board0 = sg_board0 + "-PPbpn-- "
sg_board0 = sg_board0 + "----n-N- "
sg_board0 = sg_board0 + "Q-pkrr-R "
sg_board0 = sg_board0 + "-Pp---N- "
sg_board0 = sg_board0 + "--KP---- "
sg_board0 = sg_board0 + "-------- "
d_rotate = 2
endi
$ift s_pick = "5"
$out "A. Kempe, A1, 1855"
sg_board0 = sg_board0 + "----B--- "
sg_board0 = sg_board0 + "---K---- "
sg_board0 = sg_board0 + "-B----N- "
sg_board0 = sg_board0 + "---krr-- "
sg_board0 = sg_board0 + "--R--p-- "
sg_board0 = sg_board0 + "-P---N-R "
sg_board0 = sg_board0 + "--n----- "
sg_board0 = sg_board0 + "-------- "
d_rotate = 2
endi
$ift s_pick = "6"
$out "Lev Loshinski, 1933"
sg_board0 = sg_board0 + "--p----- "
sg_board0 = sg_board0 + "-N-R-K-- "
sg_board0 = sg_board0 + "Q-----B- "
sg_board0 = sg_board0 + "-r-N---- "
sg_board0 = sg_board0 + "b-q-PP-- "
sg_board0 = sg_board0 + "RP-k---- "
sg_board0 = sg_board0 + "-P-ppB-- "
sg_board0 = sg_board0 + "--r----- "
d_rotate = 2
endi
$ift s_pick = "7"
$out "Comins Mansfield, 1953"
sg_board0 = sg_board0 + "-------- "
sg_board0 = sg_board0 + "K---Pp-- "
sg_board0 = sg_board0 + "-------- "
sg_board0 = sg_board0 + "----R-r- "
sg_board0 = sg_board0 + "-Q-NNk-- "
sg_board0 = sg_board0 + "--Bpr-R- "
sg_board0 = sg_board0 + "------P- "
sg_board0 = sg_board0 + "------P- "
d_rotate = 2
endi
$ift s_pick = "8"
$out "Frederick Gamage, 1944"
sg_board0 = sg_board0 + "--B--r-- "
sg_board0 = sg_board0 + "--BqP-R- "
sg_board0 = sg_board0 + "--R----- "
sg_board0 = sg_board0 + "-N---k-- "
sg_board0 = sg_board0 + "K-P----- "
sg_board0 = sg_board0 + "---N--n- "
sg_board0 = sg_board0 + "---p---- "
sg_board0 = sg_board0 + "-Q-rp--- "
d_rotate = 2
endi
$ift s_pick = "9"
$out "Swaminatha Subrahmanyam"
$out "1st Pr. British Chess Pr. S. 1929"
$out "FIDE Album 1914/1944/1 #697"
sg_board0 = sg_board0 + "---NN-b- "
sg_board0 = sg_board0 + "K-PnpPP- "
sg_board0 = sg_board0 + "pp---b-Q "
sg_board0 = sg_board0 + "--pk--r- "
sg_board0 = sg_board0 + "qPR---n- "
sg_board0 = sg_board0 + "-P---PBB "
sg_board0 = sg_board0 + "-------- "
sg_board0 = sg_board0 + "--R-r--- "
d_rotate = 1
endi
$ift s_pick = "10"
$out "Ottavio Stocchi"
$out "1st Pr. Illustrazione Italiana 1929"
$out "FIDE Album 1914/1944/1 #690"
sg_board0 = sg_board0 + "-------- "
sg_board0 = sg_board0 + "ppbBpr-p "
sg_board0 = sg_board0 + "-P--P--- "
sg_board0 = sg_board0 + "rn---n-- "
sg_board0 = sg_board0 + "-PPpk-P- "
sg_board0 = sg_board0 + "q--N---K "
sg_board0 = sg_board0 + "--P-P-NQ "
sg_board0 = sg_board0 + "-------- "
d_rotate = 1
endi
$ift s_pick = "11"
$out "Konstantin Gavrilov"
$out "Revista de Sah 1931"
$out "FIDE Album 1914/1944/1 #725"
sg_board0 = sg_board0 + "b-----n- "
sg_board0 = sg_board0 + "K-p----- "
sg_board0 = sg_board0 + "-pk-PPp- "
sg_board0 = sg_board0 + "p-B--NR- "
sg_board0 = sg_board0 + "rr-pNP-- "
sg_board0 = sg_board0 + "-P-p--P- "
sg_board0 = sg_board0 + "--q--P-- "
sg_board0 = sg_board0 + "--R--B-Q "
d_rotate = 1
endi
$ift s_pick = "12"
$out "Sam Loyd"
$out "V. 123, Musical World, 02-JUN-1860"
$out "Sam Loyd and His Chess Problems, #157"
sg_board0 = sg_board0 + "---B-n-- "
sg_board0 = sg_board0 + "KPpq-nN- "
sg_board0 = sg_board0 + "---p---- "
sg_board0 = sg_board0 + "-B-p---- "
sg_board0 = sg_board0 + "--pkp--- "
sg_board0 = sg_board0 + "-R-NpR-- "
sg_board0 = sg_board0 + "--PP---Q "
sg_board0 = sg_board0 + "--b--b-- "
d_rotate = 1
endi
$ift s_pick = "13"
$out "Sam Loyd"
$out "Huddersfield College Magazine, NOV-1878"
$out "Sam Loyd and His Chess Problems, #158"
sg_board0 = sg_board0 + "---b---- "
sg_board0 = sg_board0 + "--p--K-- "
sg_board0 = sg_board0 + "----N--- "
sg_board0 = sg_board0 + "--Pk-p-- "
sg_board0 = sg_board0 + "Q---p--- "
sg_board0 = sg_board0 + "---NR--- "
sg_board0 = sg_board0 + "b--p--n- "
sg_board0 = sg_board0 + "---B---- "
d_rotate = 1
endi
$ift s_pick = "14"
$out "Sam Loyd"
$out "V. 119 Le Sphinx, 01-OCT-1866"
$out "Sam Loyd and His Chess Problems, #160"
sg_board0 = sg_board0 + "---K---- "
sg_board0 = sg_board0 + "-----N-- "
sg_board0 = sg_board0 + "--B--p-- "
sg_board0 = sg_board0 + "---R---- "
sg_board0 = sg_board0 + "----kP-- "
sg_board0 = sg_board0 + "----P--- "
sg_board0 = sg_board0 + "-B-q---- "
sg_board0 = sg_board0 + "-----Q-- "
d_rotate = 1
endi
$ift s_pick = "15"
$out "Sam Loyd"
$out "Buffalo Commercial Advertizer, 1880"
$out "Sam Loyd and His Chess Problems, #161"
sg_board0 = sg_board0 + "--R----- "
sg_board0 = sg_board0 + "-------- "
sg_board0 = sg_board0 + "---k---- "
sg_board0 = sg_board0 + "---N--p- "
sg_board0 = sg_board0 + "----K-Q- "
sg_board0 = sg_board0 + "-------- "
sg_board0 = sg_board0 + "-------- "
sg_board0 = sg_board0 + "-------- "
d_rotate = 1
endi
$ift s_pick = "16"
$out "Sam Loyd"
$out "N.Y. State Chess Association, 22-FEB-1892"
$out "Sam Loyd and His Chess Problems, #163"
sg_board0 = sg_board0 + "------r- "
sg_board0 = sg_board0 + "------p- "
sg_board0 = sg_board0 + "----N--B "
sg_board0 = sg_board0 + "----N-R- "
sg_board0 = sg_board0 + "-------- "
sg_board0 = sg_board0 + "----k--K "
sg_board0 = sg_board0 + "-Q------ "
sg_board0 = sg_board0 + "-------- "
d_rotate = 1
endi
'the board ends with 100 spaces
dch$ s_any, 32, 100
sg_board0 = sg_board0 + s_any
'rotate if needed
dift d_rotate = 1
sg_pass1 = sg_board0
sub_rotate_right
sg_board0 = sg_pass1
$out "After rotating"
sub_compboard
endi
'initialize the string array
dg_solution = 1
dwhi dg_solution <= 1000
$toi dg_solution, ""
dinc dg_solution
endw
dg_solution = 0
dtoi 81, 1
dtoi 82, -1
dtoi 83, 10
dtoi 84, -10
dtoi 85, 11
dtoi 86, -11
dtoi 87, 9
dtoi 88, -9
dtoi 91, 12
dtoi 92, -12
dtoi 93, 21
dtoi 94, -21
dtoi 95, 19
dtoi 96, -19
dtoi 97, 8
dtoi 98, -8
sg_abcdefgh = "abcdefgh"
sg_12345678 = "12345678"
sg_menwhite = "PNBRQK"
sg_menblack = "pnbrqk"
sg_tobyblack = "-PNBRQK"
sg_tobywhite = "-pnbrqk"
dg_movecount1 = 0
dg_totalmovecount2 = 0
dg_totalmovecount3 = 0
dg_totalmatescount = 0
sg_score = ""
ends sub_compinitialize
subr sub_compboard
'updated 2002/04/20
vari d_any, s_any, d_dot, s_dot
vari s_rank, d_rank, d_file, s_left, s_dashes
vari s_board
s_board = sg_pass1
$ch$ s_dashes, "-", 50
dch$ s_left, 32, 10
$out s_dashes
'from White's side
d_rank = 8
dwhi d_rank >= 1
s_rank = s_left
d_file = 1
dwhi d_file <= 8
d_dot = d_file * 10 + d_rank + 100
$cut s_dot, s_board, d_dot, 1
$app s_rank, s_dot + " "
dinc d_file
endw
$out s_rank
ddec d_rank
endw
$out s_dashes
$inp s_any, "return"
ends sub_compboard
subr sub_move1
'updated 2002/04/20
'board is sg_board1
vari d_any, s_any, d_dot, s_dot
dg_movefrom1 = 111
dwhi dg_movefrom1 <= 188
$cut sg_moveman1, sg_board1, dg_movefrom1, 1
$lok d_any, sg_menwhite, 1, sg_moveman1
dift d_any > 0
sg_promotion1 = ""
$ift sg_moveman1 = "P": sub_pawn1
$ift sg_moveman1 = "N": sub_knight1
$ift sg_moveman1 = "B": sub_bishop1
$ift sg_moveman1 = "R": sub_rook1
$ift sg_moveman1 = "Q": sub_queen1
$ift sg_moveman1 = "K": sub_king1
endi
dinc dg_movefrom1
endw
'output results
$out "total 1-ply positions = " + dg_movecount1
$out "total 2-ply positions = " + dg_totalmovecount2
$out "total 3-ply positions = " + dg_totalmovecount3
$out "total 3-ply mates = " + dg_totalmatescount
ends sub_move1
subr sub_pawn1
'updated 2002/04/20
'board is in sg_board1, dg_movefrom1
vari d_any, s_any, d_dot, s_dot
vari d_index, d_delta, d_torank
'one move forward
dg_moveto1 = dg_movefrom1 + 1
d_torank = dg_moveto1 % 10
$cut sg_moveto1, sg_board1, dg_moveto1, 1
$ift sg_moveto1 = "-"
dift d_torank = 8
sg_promotion1 = "N"
sg_board2 = sg_board1
$rep sg_board2, dg_moveto1, "N"
$rep sg_board2, dg_movefrom1, "-"
sub_test_move1
sg_promotion1 = "B"
sg_board2 = sg_board1
$rep sg_board2, dg_moveto1, "B"
$rep sg_board2, dg_movefrom1, "-"
sub_test_move1
sg_promotion1 = "R"
sg_board2 = sg_board1
$rep sg_board2, dg_moveto1, "R"
$rep sg_board2, dg_movefrom1, "-"
sub_test_move1
sg_promotion1 = "Q"
sg_board2 = sg_board1
$rep sg_board2, dg_moveto1, "Q"
$rep sg_board2, dg_movefrom1, "-"
sub_test_move1
else
sg_board2 = sg_board1
$rep sg_board2, dg_moveto1, "P"
$rep sg_board2, dg_movefrom1, "-"
sub_test_move1
endi
'two moves forward
d_any = dg_movefrom1 % 10
dift d_any = 2
dg_moveto1 = dg_movefrom1 + 2
$cut sg_moveto1, sg_board1, dg_moveto1, 1
$ift sg_moveto1 = "-"
sg_board2 = sg_board1
$rep sg_board2, dg_moveto1, "P"
$rep sg_board2, dg_movefrom1, "-"
sub_test_move1
endi
endi
endi
'capture 44 to 35
dg_moveto1 = dg_movefrom1 - 9
$cut sg_moveto1, sg_board1, dg_moveto1, 1
$lok d_any, sg_menblack, 1, sg_moveto1
dift d_any > 0
dift d_torank = 8
sg_promotion1 = "N"
sg_board2 = sg_board1
$rep sg_board2, dg_moveto1, "N"
$rep sg_board2, dg_movefrom1, "-"
sub_test_move1
sg_promotion1 = "B"
sg_board2 = sg_board1
$rep sg_board2, dg_moveto1, "B"
$rep sg_board2, dg_movefrom1, "-"
sub_test_move1
sg_promotion1 = "R"
sg_board2 = sg_board1
$rep sg_board2, dg_moveto1, "R"
$rep sg_board2, dg_movefrom1, "-"
sub_test_move1
sg_promotion1 = "Q"
sg_board2 = sg_board1
$rep sg_board2, dg_moveto1, "Q"
$rep sg_board2, dg_movefrom1, "-"
sub_test_move1
else
sg_board2 = sg_board1
$rep sg_board2, dg_moveto1, "P"
$rep sg_board2, dg_movefrom1, "-"
sub_test_move1
endi
endi
'capture 44 to 55
dg_moveto1 = dg_movefrom1 + 11
$cut sg_moveto1, sg_board1, dg_moveto1, 1
$lok d_any, sg_menblack, 1, sg_moveto1
dift d_any > 0
dift d_torank = 8
sg_promotion1 = "N"
sg_board2 = sg_board1
$rep sg_board2, dg_moveto1, "N"
$rep sg_board2, dg_movefrom1, "-"
sub_test_move1
sg_promotion1 = "B"
sg_board2 = sg_board1
$rep sg_board2, dg_moveto1, "B"
$rep sg_board2, dg_movefrom1, "-"
sub_test_move1
sg_promotion1 = "R"
sg_board2 = sg_board1
$rep sg_board2, dg_moveto1, "R"
$rep sg_board2, dg_movefrom1, "-"
sub_test_move1
sg_promotion1 = "Q"
sg_board2 = sg_board1
$rep sg_board2, dg_moveto1, "Q"
$rep sg_board2, dg_movefrom1, "-"
sub_test_move1
else
sg_board2 = sg_board1
$rep sg_board2, dg_moveto1, "P"
$rep sg_board2, dg_movefrom1, "-"
sub_test_move1
endi
endi
ends sub_pawn1
subr sub_knight1
'updated 2002/04/20
'board is in sg_board1, dg_movefrom1
vari d_any, s_any, d_dot, s_dot
vari d_index, d_delta
d_index = 91
dwhi d_index <= 98
itod d_delta, d_index
dg_moveto1 = dg_movefrom1 + d_delta
$cut sg_moveto1, sg_board1, dg_moveto1, 1
$lok d_any, sg_tobywhite, 1, sg_moveto1
dift d_any > 0
sg_board2 = sg_board1
$rep sg_board2, dg_moveto1, "N"
$rep sg_board2, dg_movefrom1, "-"
sub_test_move1
endi
dinc d_index
endw
ends sub_knight1
subr sub_bishop1
'updated 2002/04/20
'board is in sg_board1, dg_movefrom1
vari d_any, s_any, d_dot, s_dot
vari d_index, d_delta, d_loop
d_index = 85
dwhi d_index <= 88
itod d_delta, d_index
dg_moveto1 = dg_movefrom1
d_loop = 1
dwhi d_loop = 1
dg_moveto1 = dg_moveto1 + d_delta
$cut sg_moveto1, sg_board1, dg_moveto1, 1
$lok d_any, sg_tobywhite, 1, sg_moveto1
dift d_any > 1: dinc d_loop
dift d_any > 0
sg_board2 = sg_board1
$rep sg_board2, dg_moveto1, "B"
$rep sg_board2, dg_movefrom1, "-"
sub_test_move1
else
dinc d_loop
endi
endw
dinc d_index
endw
ends sub_bishop1
subr sub_rook1
'updated 2002/04/20
'board is in sg_board1, dg_movefrom1
vari d_any, s_any, d_dot, s_dot
vari d_index, d_delta, d_loop
d_index = 81
dwhi d_index <= 84
itod d_delta, d_index
dg_moveto1 = dg_movefrom1
d_loop = 1
dwhi d_loop = 1
dg_moveto1 = dg_moveto1 + d_delta
$cut sg_moveto1, sg_board1, dg_moveto1, 1
$lok d_any, sg_tobywhite, 1, sg_moveto1
dift d_any > 1: dinc d_loop
dift d_any > 0
sg_board2 = sg_board1
$rep sg_board2, dg_moveto1, "R"
$rep sg_board2, dg_movefrom1, "-"
sub_test_move1
else
dinc d_loop
endi
endw
dinc d_index
endw
ends sub_rook1
subr sub_queen1
'updated 2002/04/20
'board is in sg_board1, dg_movefrom1
vari d_any, s_any, d_dot, s_dot
vari d_index, d_delta, d_loop
d_index = 81
dwhi d_index <= 88
itod d_delta, d_index
dg_moveto1 = dg_movefrom1
d_loop = 1
dwhi d_loop = 1
dg_moveto1 = dg_moveto1 + d_delta
$cut sg_moveto1, sg_board1, dg_moveto1, 1
$lok d_any, sg_tobywhite, 1, sg_moveto1
dift d_any > 1: dinc d_loop
dift d_any > 0
sg_board2 = sg_board1
$rep sg_board2, dg_moveto1, "Q"
$rep sg_board2, dg_movefrom1, "-"
sub_test_move1
else
dinc d_loop
endi
endw
dinc d_index
endw
ends sub_queen1
subr sub_king1
'updated 2002/04/20
'board is in sg_board1, dg_movefrom1
vari d_any, s_any, d_dot, s_dot
vari d_index, d_delta
d_index = 81
dwhi d_index <= 88
itod d_delta, d_index
dg_moveto1 = dg_movefrom1 + d_delta
$cut sg_moveto1, sg_board1, dg_moveto1, 1
$lok d_any, sg_tobywhite, 1, sg_moveto1
dift d_any > 0
sg_board2 = sg_board1
$rep sg_board2, dg_moveto1, "K"
$rep sg_board2, dg_movefrom1, "-"
sub_test_move1
endi
dinc d_index
endw
ends sub_king1
subr sub_test_move1
'updated 2002/04/20
vari d_any, s_any, d_dot, s_dot
sg_chkboard = sg_board2
sub_wincheck
dift dg_wincheck <> 1
dinc dg_movecount1
dg_movecount2 = 0
dg_movecount3 = 0
dg_matescount = 0
'value = 1 is good value = 2 is bad
dg_value2 = 2
sub_move2
sub_show_score1
dift dg_movecount2 > 0
dift dg_value2 = 2
$out "wins"
dinc dg_solution
$toi dg_solution, sg_score
endi
endi
dg_totalmovecount2 = dg_totalmovecount2 + dg_movecount2
dg_totalmovecount3 = dg_totalmovecount3 + dg_movecount3
dg_totalmatescount = dg_totalmatescount + dg_matescount
endi
ends sub_test_move1
subr sub_move2
'updated 2002/04/20
'board is sg_board2
vari d_any, s_any, d_dot, s_dot
dg_movefrom2 = 111
dwhi dg_movefrom2 <= 188
$cut sg_moveman2, sg_board2, dg_movefrom2, 1
$lok d_any, sg_menblack, 1, sg_moveman2
dift d_any > 0
$ift sg_moveman2 = "p": sub_pawn2
$ift sg_moveman2 = "n": sub_knight2
$ift sg_moveman2 = "b": sub_bishop2
$ift sg_moveman2 = "r": sub_rook2
$ift sg_moveman2 = "q": sub_queen2
$ift sg_moveman2 = "k": sub_king2
endi
dinc dg_movefrom2
endw
ends sub_move2
subr sub_pawn2
'updated 2002/04/20
'board is in sg_board2, dg_movefrom2
vari d_any, s_any, d_dot, s_dot
vari d_index, d_delta, d_torank
'one move forward
dg_moveto2 = dg_movefrom2 - 1
d_torank = dg_moveto2 % 10
$cut sg_moveto2, sg_board2, dg_moveto2, 1
$ift sg_moveto2 = "-"
dift d_torank = 1
sg_board3 = sg_board2
$rep sg_board3, dg_moveto2, "n"
$rep sg_board3, dg_movefrom2, "-"
sub_test_move2
sg_board3 = sg_board2
$rep sg_board3, dg_moveto2, "b"
$rep sg_board3, dg_movefrom2, "-"
sub_test_move2
sg_board3 = sg_board2
$rep sg_board3, dg_moveto2, "r"
$rep sg_board3, dg_movefrom2, "-"
sub_test_move2
sg_board3 = sg_board2
$rep sg_board3, dg_moveto2, "q"
$rep sg_board3, dg_movefrom2, "-"
sub_test_move2
else
sg_board3 = sg_board2
$rep sg_board3, dg_moveto2, "p"
$rep sg_board3, dg_movefrom2, "-"
sub_test_move2
endi
'two moves forward
d_any = dg_movefrom2 % 10
dift d_any = 7
dg_moveto2 = dg_movefrom2 - 2
$cut sg_moveto2, sg_board2, dg_moveto2, 1
$ift sg_moveto2 = "-"
sg_board3 = sg_board2
$rep sg_board3, dg_moveto2, "p"
$rep sg_board3, dg_movefrom2, "-"
sub_test_move2
endi
endi
endi
'capture 45 to 34
dg_moveto2 = dg_movefrom2 - 11
$cut sg_moveto2, sg_board2, dg_moveto2, 1
$lok d_any, sg_menwhite, 1, sg_moveto2
dift d_any > 0
dift d_torank = 1
sg_board3 = sg_board2
$rep sg_board3, dg_moveto2, "n"
$rep sg_board3, dg_movefrom2, "-"
sub_test_move2
sg_board3 = sg_board2
$rep sg_board3, dg_moveto2, "b"
$rep sg_board3, dg_movefrom2, "-"
sub_test_move2
sg_board3 = sg_board2
$rep sg_board3, dg_moveto2, "r"
$rep sg_board3, dg_movefrom2, "-"
sub_test_move2
sg_board3 = sg_board2
$rep sg_board3, dg_moveto2, "q"
$rep sg_board3, dg_movefrom2, "-"
sub_test_move2
else
sg_board3 = sg_board2
$rep sg_board3, dg_moveto2, "p"
$rep sg_board3, dg_movefrom2, "-"
sub_test_move2
endi
endi
'capture 45 to 54
dg_moveto2 = dg_movefrom2 + 9
$cut sg_moveto2, sg_board2, dg_moveto2, 1
$lok d_any, sg_menwhite, 1, sg_moveto2
dift d_any > 0
dift d_torank = 1
sg_board3 = sg_board2
$rep sg_board3, dg_moveto2, "n"
$rep sg_board3, dg_movefrom2, "-"
sub_test_move2
sg_board3 = sg_board2
$rep sg_board3, dg_moveto2, "b"
$rep sg_board3, dg_movefrom2, "-"
sub_test_move2
sg_board3 = sg_board2
$rep sg_board3, dg_moveto2, "r"
$rep sg_board3, dg_movefrom2, "-"
sub_test_move2
sg_board3 = sg_board2
$rep sg_board3, dg_moveto2, "q"
$rep sg_board3, dg_movefrom2, "-"
sub_test_move2
else
sg_board3 = sg_board2
$rep sg_board3, dg_moveto2, "p"
$rep sg_board3, dg_movefrom2, "-"
sub_test_move2
endi
endi
ends sub_pawn2
subr sub_knight2
'updated 2002/04/20
'board is in sg_board2, dg_movefrom2
vari d_any, s_any, d_dot, s_dot
vari d_index, d_delta
d_index = 91
dwhi d_index <= 98
itod d_delta, d_index
dg_moveto2 = dg_movefrom2 + d_delta
$cut sg_moveto2, sg_board2, dg_moveto2, 1
$lok d_any, sg_tobyblack, 1, sg_moveto2
dift d_any > 0
sg_board3 = sg_board2
$rep sg_board3, dg_moveto2, "n"
$rep sg_board3, dg_movefrom2, "-"
sub_test_move2
endi
dinc d_index
endw
ends sub_knight2
subr sub_bishop2
'updated 2002/04/20
'board is in sg_board2, dg_movefrom2
vari d_any, s_any, d_dot, s_dot
vari d_index, d_delta, d_loop
d_index = 85
dwhi d_index <= 88
itod d_delta, d_index
dg_moveto2 = dg_movefrom2
d_loop = 1
dwhi d_loop = 1
dg_moveto2 = dg_moveto2 + d_delta
$cut sg_moveto2, sg_board2, dg_moveto2, 1
$lok d_any, sg_tobyblack, 1, sg_moveto2
dift d_any > 1: dinc d_loop
dift d_any > 0
sg_board3 = sg_board2
$rep sg_board3, dg_moveto2, "b"
$rep sg_board3, dg_movefrom2, "-"
sub_test_move2
else
dinc d_loop
endi
endw
dinc d_index
endw
ends sub_bishop2
subr sub_rook2
'updated 2002/04/20
'board is in sg_board2, dg_movefrom2
vari d_any, s_any, d_dot, s_dot
vari d_index, d_delta, d_loop
d_index = 81
dwhi d_index <= 84
itod d_delta, d_index
dg_moveto2 = dg_movefrom2
d_loop = 1
dwhi d_loop = 1
dg_moveto2 = dg_moveto2 + d_delta
$cut sg_moveto2, sg_board2, dg_moveto2, 1
$lok d_any, sg_tobyblack, 1, sg_moveto2
dift d_any > 1: dinc d_loop
dift d_any > 0
sg_board3 = sg_board2
$rep sg_board3, dg_moveto2, "r"
$rep sg_board3, dg_movefrom2, "-"
sub_test_move2
else
dinc d_loop
endi
endw
dinc d_index
endw
ends sub_rook2
subr sub_queen2
'updated 2002/04/20
'board is in sg_board2, dg_movefrom2
vari d_any, s_any, d_dot, s_dot
vari d_index, d_delta, d_loop
d_index = 81
dwhi d_index <= 88
itod d_delta, d_index
dg_moveto2 = dg_movefrom2
d_loop = 1
dwhi d_loop = 1
dg_moveto2 = dg_moveto2 + d_delta
$cut sg_moveto2, sg_board2, dg_moveto2, 1
$lok d_any, sg_tobyblack, 1, sg_moveto2
dift d_any > 1: dinc d_loop
dift d_any > 0
sg_board3 = sg_board2
$rep sg_board3, dg_moveto2, "q"
$rep sg_board3, dg_movefrom2, "-"
sub_test_move2
else
dinc d_loop
endi
endw
dinc d_index
endw
ends sub_queen2
subr sub_king2
'updated 2002/04/20
'board is in sg_board2, dg_movefrom2
vari d_any, s_any, d_dot, s_dot
vari d_index, d_delta
d_index = 81
dwhi d_index <= 88
itod d_delta, d_index
dg_moveto2 = dg_movefrom2 + d_delta
$cut sg_moveto2, sg_board2, dg_moveto2, 1
$lok d_any, sg_tobyblack, 1, sg_moveto2
dift d_any > 0
sg_board3 = sg_board2
$rep sg_board3, dg_moveto2, "k"
$rep sg_board3, dg_movefrom2, "-"
sub_test_move2
endi
dinc d_index
endw
ends sub_king2
subr sub_test_move2
'updated 2002/04/20
vari d_any, s_any, d_dot, s_dot
sg_chkboard = sg_board3
sub_bincheck
dift dg_bincheck <> 1
dinc dg_movecount2
dg_value3 = 2
sub_move3
dift dg_value3 = 2
'if no good move3
dg_value2 = 1
dg_movefromhold2 = dg_movefrom2
dg_movetohold2 = dg_moveto2
sg_movemanhold2 = sg_moveman2
else
'if good move3
dinc dg_matescount
endi
endi
ends sub_test_move2
subr sub_move3
'updated 2002/04/20
'board is sg_board3
vari d_any, s_any, d_dot, s_dot
dg_movefrom3 = 111
dwhi dg_movefrom3 <= 188
$cut sg_moveman3, sg_board3, dg_movefrom3, 1
$lok d_any, sg_menwhite, 1, sg_moveman3
dift d_any > 0
$ift sg_moveman3 = "P": sub_pawn3
$ift sg_moveman3 = "N": sub_knight3
$ift sg_moveman3 = "B": sub_bishop3
$ift sg_moveman3 = "R": sub_rook3
$ift sg_moveman3 = "Q": sub_queen3
$ift sg_moveman3 = "K": sub_king3
endi
dinc dg_movefrom3
endw
ends sub_move3
subr sub_pawn3
'updated 2002/04/20
'board is in sg_board3, dg_movefrom3
vari d_any, s_any, d_dot, s_dot
vari d_index, d_delta, d_torank
'one move forward
dg_moveto3 = dg_movefrom3 + 1
d_torank = dg_moveto3 % 10
$cut sg_moveto3, sg_board3, dg_moveto3, 1
$ift sg_moveto3 = "-"
dift d_torank = 8
sg_board4 = sg_board3
$rep sg_board4, dg_moveto3, "N"
$rep sg_board4, dg_movefrom3, "-"
sub_test_move3
sg_board4 = sg_board3
$rep sg_board4, dg_moveto3, "B"
$rep sg_board4, dg_movefrom3, "-"
sub_test_move3
sg_board4 = sg_board3
$rep sg_board4, dg_moveto3, "R"
$rep sg_board4, dg_movefrom3, "-"
sub_test_move3
sg_board4 = sg_board3
$rep sg_board4, dg_moveto3, "Q"
$rep sg_board4, dg_movefrom3, "-"
sub_test_move3
else
sg_board4 = sg_board3
$rep sg_board4, dg_moveto3, "P"
$rep sg_board4, dg_movefrom3, "-"
sub_test_move3
endi
'two moves forward
d_any = dg_movefrom3 % 10
dift d_any = 2
dg_moveto3 = dg_movefrom3 + 2
$cut sg_moveto3, sg_board3, dg_moveto3, 1
$ift sg_moveto3 = "-"
sg_board4 = sg_board3
$rep sg_board4, dg_moveto3, "P"
$rep sg_board4, dg_movefrom3, "-"
sub_test_move3
endi
endi
endi
'capture 44 to 35
dg_moveto3 = dg_movefrom3 - 9
$cut sg_moveto3, sg_board3, dg_moveto3, 1
$lok d_any, sg_menblack, 1, sg_moveto3
dift d_any > 0
dift d_torank = 8
sg_board4 = sg_board3
$rep sg_board4, dg_moveto3, "N"
$rep sg_board4, dg_movefrom3, "-"
sub_test_move3
sg_board4 = sg_board3
$rep sg_board4, dg_moveto3, "B"
$rep sg_board4, dg_movefrom3, "-"
sub_test_move3
sg_board4 = sg_board3
$rep sg_board4, dg_moveto3, "R"
$rep sg_board4, dg_movefrom3, "-"
sub_test_move3
sg_board4 = sg_board3
$rep sg_board4, dg_moveto3, "Q"
$rep sg_board4, dg_movefrom3, "-"
sub_test_move3
else
sg_board4 = sg_board3
$rep sg_board4, dg_moveto3, "P"
$rep sg_board4, dg_movefrom3, "-"
sub_test_move3
endi
endi
'capture 44 to 55
dg_moveto3 = dg_movefrom3 + 11
$cut sg_moveto3, sg_board3, dg_moveto3, 1
$lok d_any, sg_menblack, 1, sg_moveto3
dift d_any > 0
dift d_torank = 8
sg_board4 = sg_board3
$rep sg_board4, dg_moveto3, "N"
$rep sg_board4, dg_movefrom3, "-"
sub_test_move3
sg_board4 = sg_board3
$rep sg_board4, dg_moveto3, "B"
$rep sg_board4, dg_movefrom3, "-"
sub_test_move3
sg_board4 = sg_board3
$rep sg_board4, dg_moveto3, "R"
$rep sg_board4, dg_movefrom3, "-"
sub_test_move3
sg_board4 = sg_board3
$rep sg_board4, dg_moveto3, "Q"
$rep sg_board4, dg_movefrom3, "-"
sub_test_move3
else
sg_board4 = sg_board3
$rep sg_board4, dg_moveto3, "P"
$rep sg_board4, dg_movefrom3, "-"
sub_test_move3
endi
endi
ends sub_pawn3
subr sub_knight3
'updated 2002/04/20
'board is in sg_board3, dg_movefrom3
vari d_any, s_any, d_dot, s_dot
vari d_index, d_delta
d_index = 91
dwhi d_index <= 98
itod d_delta, d_index
dg_moveto3 = dg_movefrom3 + d_delta
$cut sg_moveto3, sg_board3, dg_moveto3, 1
$lok d_any, sg_tobywhite, 1, sg_moveto3
dift d_any > 0
sg_board4 = sg_board3
$rep sg_board4, dg_moveto3, "N"
$rep sg_board4, dg_movefrom3, "-"
sub_test_move3
endi
dinc d_index
endw
ends sub_knight3
subr sub_bishop3
'updated 2002/04/20
'board is in sg_board3, dg_movefrom3
vari d_any, s_any, d_dot, s_dot
vari d_index, d_delta, d_loop
d_index = 85
dwhi d_index <= 88
itod d_delta, d_index
dg_moveto3 = dg_movefrom3
d_loop = 1
dwhi d_loop = 1
dg_moveto3 = dg_moveto3 + d_delta
$cut sg_moveto3, sg_board3, dg_moveto3, 1
$lok d_any, sg_tobywhite, 1, sg_moveto3
dift d_any > 1: dinc d_loop
dift d_any > 0
sg_board4 = sg_board3
$rep sg_board4, dg_moveto3, "B"
$rep sg_board4, dg_movefrom3, "-"
sub_test_move3
else
dinc d_loop
endi
endw
dinc d_index
endw
ends sub_bishop3
subr sub_rook3
'updated 2002/04/20
'board is in sg_board3, dg_movefrom3
vari d_any, s_any, d_dot, s_dot
vari d_index, d_delta, d_loop
d_index = 81
dwhi d_index <= 84
itod d_delta, d_index
dg_moveto3 = dg_movefrom3
d_loop = 1
dwhi d_loop = 1
dg_moveto3 = dg_moveto3 + d_delta
$cut sg_moveto3, sg_board3, dg_moveto3, 1
$lok d_any, sg_tobywhite, 1, sg_moveto3
dift d_any > 1: dinc d_loop
dift d_any > 0
sg_board4 = sg_board3
$rep sg_board4, dg_moveto3, "R"
$rep sg_board4, dg_movefrom3, "-"
sub_test_move3
else
dinc d_loop
endi
endw
dinc d_index
endw
ends sub_rook3
subr sub_queen3
'updated 2002/04/20
'board is in sg_board3, dg_movefrom3
vari d_any, s_any, d_dot, s_dot
vari d_index, d_delta, d_loop
d_index = 81
dwhi d_index <= 88
itod d_delta, d_index
dg_moveto3 = dg_movefrom3
d_loop = 1
dwhi d_loop = 1
dg_moveto3 = dg_moveto3 + d_delta
$cut sg_moveto3, sg_board3, dg_moveto3, 1
$lok d_any, sg_tobywhite, 1, sg_moveto3
dift d_any > 1: dinc d_loop
dift d_any > 0
sg_board4 = sg_board3
$rep sg_board4, dg_moveto3, "Q"
$rep sg_board4, dg_movefrom3, "-"
sub_test_move3
else
dinc d_loop
endi
endw
dinc d_index
endw
ends sub_queen3
subr sub_king3
'updated 2002/04/20
'board is in sg_board3, dg_movefrom3
vari d_any, s_any, d_dot, s_dot
vari d_index, d_delta
d_index = 81
dwhi d_index <= 88
itod d_delta, d_index
dg_moveto3 = dg_movefrom3 + d_delta
$cut sg_moveto3, sg_board3, dg_moveto3, 1
$lok d_any, sg_tobywhite, 1, sg_moveto3
dift d_any > 0
sg_board4 = sg_board3
$rep sg_board4, dg_moveto3, "K"
$rep sg_board4, dg_movefrom3, "-"
sub_test_move3
endi
dinc d_index
endw
ends sub_king3
subr sub_test_move3
'updated 2002/04/20
vari d_any, s_any, d_dot, s_dot
sg_chkboard = sg_board4
sub_wincheck
dift dg_wincheck <> 1
dinc dg_movecount3
dift dg_new = 1
sg_boardm = sg_board4
sub_binmate
dift dg_binmate = 1
dg_value3 = 1
endi
else
sg_chkboard = sg_board4
sub_bincheck
dift dg_bincheck = 1
dg_value4 = 2
sub_move4
dift dg_value4 = 2
dg_value3 = 1
endi
endi
endi
endi
ends sub_test_move3
subr sub_move4
'updated 2002/04/20
'board is sg_board4
vari d_any, s_any, d_dot, s_dot
dg_movefrom4 = 111
dwhi dg_movefrom4 <= 188
$cut sg_moveman4, sg_board4, dg_movefrom4, 1
$lok d_any, sg_menblack, 1, sg_moveman4
dift d_any > 0
$ift sg_moveman4 = "p": sub_pawn4
$ift sg_moveman4 = "n": sub_knight4
$ift sg_moveman4 = "b": sub_bishop4
$ift sg_moveman4 = "r": sub_rook4
$ift sg_moveman4 = "q": sub_queen4
$ift sg_moveman4 = "k": sub_king4
endi
dinc dg_movefrom4
endw
ends sub_move4
subr sub_pawn4
'updated 2002/04/20
'board is in sg_board4, dg_movefrom4
vari d_any, s_any, d_dot, s_dot
vari d_index, d_delta
'one move forward
dg_moveto4 = dg_movefrom4 - 1
$cut sg_moveto4, sg_board4, dg_moveto4, 1
$ift sg_moveto4 = "-"
sg_board5 = sg_board4
$rep sg_board5, dg_moveto4, "p"
$rep sg_board5, dg_movefrom4, "-"
sub_test_move4
'two moves forward
d_any = dg_movefrom4 % 10
dift d_any = 7
dg_moveto4 = dg_movefrom4 - 2
$cut sg_moveto4, sg_board4, dg_moveto4, 1
$ift sg_moveto4 = "-"
sg_board5 = sg_board4
$rep sg_board5, dg_moveto4, "p"
$rep sg_board5, dg_movefrom4, "-"
sub_test_move4
endi
endi
endi
'capture 45 to 34
dg_moveto4 = dg_movefrom4 - 11
$cut sg_moveto4, sg_board4, dg_moveto4, 1
$lok d_any, sg_menwhite, 1, sg_moveto4
dift d_any > 0
sg_board5 = sg_board4
$rep sg_board5, dg_moveto4, "p"
$rep sg_board5, dg_movefrom4, "-"
sub_test_move4
endi
'capture 45 to 54
dg_moveto4 = dg_movefrom4 + 9
$cut sg_moveto4, sg_board4, dg_moveto4, 1
$lok d_any, sg_menwhite, 1, sg_moveto4
dift d_any > 0
sg_board5 = sg_board4
$rep sg_board5, dg_moveto4, "p"
$rep sg_board5, dg_movefrom4, "-"
sub_test_move4
endi
ends sub_pawn4
subr sub_knight4
'updated 2002/04/20
'board is in sg_board4, dg_movefrom4
vari d_any, s_any, d_dot, s_dot
vari d_index, d_delta
d_index = 91
dwhi d_index <= 98
itod d_delta, d_index
dg_moveto4 = dg_movefrom4 + d_delta
$cut sg_moveto4, sg_board4, dg_moveto4, 1
$lok d_any, sg_tobyblack, 1, sg_moveto4
dift d_any > 0
sg_board5 = sg_board4
$rep sg_board5, dg_moveto4, "n"
$rep sg_board5, dg_movefrom4, "-"
sub_test_move4
endi
dinc d_index
endw
ends sub_knight4
subr sub_bishop4
'updated 2002/04/20
'board is in sg_board4, dg_movefrom4
vari d_any, s_any, d_dot, s_dot
vari d_index, d_delta, d_loop
d_index = 85
dwhi d_index <= 88
itod d_delta, d_index
dg_moveto4 = dg_movefrom4
d_loop = 1
dwhi d_loop = 1
dg_moveto4 = dg_moveto4 + d_delta
$cut sg_moveto4, sg_board4, dg_moveto4, 1
$lok d_any, sg_tobyblack, 1, sg_moveto4
dift d_any > 1: dinc d_loop
dift d_any > 0
sg_board5 = sg_board4
$rep sg_board5, dg_moveto4, "b"
$rep sg_board5, dg_movefrom4, "-"
sub_test_move4
else
dinc d_loop
endi
endw
dinc d_index
endw
ends sub_bishop4
subr sub_rook4
'updated 2002/04/20
'board is in sg_board4, dg_movefrom4
vari d_any, s_any, d_dot, s_dot
vari d_index, d_delta, d_loop
d_index = 81
dwhi d_index <= 84
itod d_delta, d_index
dg_moveto4 = dg_movefrom4
d_loop = 1
dwhi d_loop = 1
dg_moveto4 = dg_moveto4 + d_delta
$cut sg_moveto4, sg_board4, dg_moveto4, 1
$lok d_any, sg_tobyblack, 1, sg_moveto4
dift d_any > 1: dinc d_loop
dift d_any > 0
sg_board5 = sg_board4
$rep sg_board5, dg_moveto4, "r"
$rep sg_board5, dg_movefrom4, "-"
sub_test_move4
else
dinc d_loop
endi
endw
dinc d_index
endw
ends sub_rook4
subr sub_queen4
'updated 2002/04/20
'board is in sg_board4, dg_movefrom4
vari d_any, s_any, d_dot, s_dot
vari d_index, d_delta, d_loop
d_index = 81
dwhi d_index <= 88
itod d_delta, d_index
dg_moveto4 = dg_movefrom4
d_loop = 1
dwhi d_loop = 1
dg_moveto4 = dg_moveto4 + d_delta
$cut sg_moveto4, sg_board4, dg_moveto4, 1
$lok d_any, sg_tobyblack, 1, sg_moveto4
dift d_any > 1: dinc d_loop
dift d_any > 0
sg_board5 = sg_board4
$rep sg_board5, dg_moveto4, "q"
$rep sg_board5, dg_movefrom4, "-"
sub_test_move4
else
dinc d_loop
endi
endw
dinc d_index
endw
ends sub_queen4
subr sub_king4
'updated 2002/04/20
'board is in sg_board4, dg_movefrom4
vari d_any, s_any, d_dot, s_dot
vari d_index, d_delta
d_index = 81
dwhi d_index <= 88
itod d_delta, d_index
dg_moveto4 = dg_movefrom4 + d_delta
$cut sg_moveto4, sg_board4, dg_moveto4, 1
$lok d_any, sg_tobyblack, 1, sg_moveto4
dift d_any > 0
sg_board5 = sg_board4
$rep sg_board5, dg_moveto4, "k"
$rep sg_board5, dg_movefrom4, "-"
sub_test_move4
endi
dinc d_index
endw
ends sub_king4
subr sub_test_move4
'updated 2002/04/20
vari d_any, s_any, d_dot, s_dot
sg_chkboard = sg_board5
sub_bincheck
dift dg_bincheck <> 1
dg_value4 = 1
endi
ends sub_test_move4
subr sub_wincheck
'updated 2002/04/20
vari d_any, s_any, d_dot, s_dot
vari d_loop, d_count
vari d_index, d_delta, d_wking
vari d_square, s_square
dg_wincheck = 2
$lok d_wking, sg_chkboard, 111, "K"
'check by knight
d_index = 91
dwhi d_index <= 98
itod d_delta, d_index
d_square = d_wking + d_delta
$cut s_square, sg_chkboard, d_square, 1
$ift s_square = "n": dg_wincheck = 1
dinc d_index
endw
'check by Pawn, bishop, rook, queen or king
d_index = 81
dwhi d_index <= 88
itod d_delta, d_index
'is white in check
d_square = d_wking
d_count = 0
d_loop = 1
dwhi d_loop = 1
dinc d_count
d_square = d_square + d_delta
$cut s_square, sg_chkboard, d_square, 1
$ift s_square <> "-": dinc d_loop
endw
dift d_count = 1
'Black Pawn or Black King
$ift s_square = "k": dg_wincheck = 1
'how about a Pawn
$ift s_square = "p"
'54 by 45 or 65
dift d_delta = -9: dg_wincheck = 1
dift d_delta = 11: dg_wincheck = 1
endi
endi
$ift s_square = "q": dg_wincheck = 1
$ift s_square = "r"
dift d_index <= 84: dg_wincheck = 1
endi
$ift s_square = "b"
dift d_index >= 85: dg_wincheck = 1
endi
dinc d_index
endw
ends sub_wincheck
subr sub_bincheck
'updated 2002/04/20
vari d_any, s_any, d_dot, s_dot
vari d_loop, d_count
vari d_index, d_delta, d_bking
vari d_square, s_square
dg_bincheck = 2
$lok d_bking, sg_chkboard, 111, "k"
'check by knight
d_index = 91
dwhi d_index <= 98
itod d_delta, d_index
d_square = d_bking + d_delta
$cut s_square, sg_chkboard, d_square, 1
$ift s_square = "N": dg_bincheck = 1
dinc d_index
endw
'check by Pawn, bishop, rook, queen or king
d_index = 81
dwhi d_index <= 88
itod d_delta, d_index
'is Black in check
d_square = d_bking
d_count = 0
d_loop = 1
dwhi d_loop = 1
dinc d_count
d_square = d_square + d_delta
$cut s_square, sg_chkboard, d_square, 1
$ift s_square <> "-": dinc d_loop
endw
dift d_count = 1
'White Pawn or White King
$ift s_square = "K": dg_bincheck = 1
'how about a Pawn, 45 by 34, 45 by 54
$ift s_square = "P"
'55 by 44 or 64
dift d_delta = -11: dg_bincheck = 1
dift d_delta = 9: dg_bincheck = 1
endi
endi
$ift s_square = "Q": dg_bincheck = 1
$ift s_square = "R"
dift d_index <= 84: dg_bincheck = 1
endi
$ift s_square = "B"
dift d_index >= 85: dg_bincheck = 1
endi
dinc d_index
endw
ends sub_bincheck
subr sub_binmate
'updated 2002/04/20
'board is sg_boardm
vari d_any, s_any, d_dot, s_dot
sg_chkboard = sg_boardm
sub_bincheck
dift dg_bincheck <> 1
dg_binmate = 2
else
dg_binmate = 1
dg_movefromm = 111
dwhi dg_movefromm <= 188
$cut sg_movemanm, sg_boardm, dg_movefromm, 1
$lok d_any, sg_menblack, 1, sg_movemanm
dift d_any > 0
$ift sg_movemanm = "p": sub_pawnm
$ift sg_movemanm = "n": sub_knightm
$ift sg_movemanm = "b": sub_bishopm
$ift sg_movemanm = "r": sub_rookm
$ift sg_movemanm = "q": sub_queenm
$ift sg_movemanm = "k": sub_kingm
endi
dift dg_binmate = 2: dg_movefromm = 200
dinc dg_movefromm
endw
endi
ends sub_binmate
subr sub_pawnm
'updated 2002/04/20
'board is in sg_boardm, dg_movefromm
vari d_any, s_any, d_dot, s_dot
vari d_index, d_delta
'one move forward
dg_movetom = dg_movefromm - 1
$cut sg_movetom, sg_boardm, dg_movetom, 1
$ift sg_movetom = "-"
sg_chkboard = sg_boardm
$rep sg_chkboard, dg_movetom, "p"
$rep sg_chkboard, dg_movefromm, "-"
sub_bincheck
dift dg_bincheck <> 1: dinc dg_binmate
'two moves forward
d_any = dg_movefromm % 10
dift d_any = 7
dg_movetom = dg_movefromm - 2
$cut sg_movetom, sg_boardm, dg_movetom, 1
$ift sg_movetom = "-"
sg_chkboard = sg_boardm
$rep sg_chkboard, dg_movetom, "p"
$rep sg_chkboard, dg_movefromm, "-"
sub_bincheck
dift dg_bincheck <> 1: dinc dg_binmate
endi
endi
endi
'capture 45 to 34
dg_movetom = dg_movefromm - 11
$cut sg_movetom, sg_boardm, dg_movetom, 1
$lok d_any, sg_menwhite, 1, sg_movetom
dift d_any > 0
sg_chkboard = sg_boardm
$rep sg_chkboard, dg_movetom, "p"
$rep sg_chkboard, dg_movefromm, "-"
sub_bincheck
dift dg_bincheck <> 1: dinc dg_binmate
endi
'capture 45 to 54
dg_movetom = dg_movefromm + 9
$cut sg_movetom, sg_boardm, dg_movetom, 1
$lok d_any, sg_menwhite, 1, sg_movetom
dift d_any > 0
sg_chkboard = sg_boardm
$rep sg_chkboard, dg_movetom, "p"
$rep sg_chkboard, dg_movefromm, "-"
sub_bincheck
dift dg_bincheck <> 1: dinc dg_binmate
endi
ends sub_pawnm
subr sub_knightm
'updated 2002/04/20
'board is in sg_boardm, dg_movefromm
vari d_any, s_any, d_dot, s_dot
vari d_index, d_delta
d_index = 91
dwhi d_index <= 98
itod d_delta, d_index
dg_movetom = dg_movefromm + d_delta
$cut sg_movetom, sg_boardm, dg_movetom, 1
$lok d_any, sg_tobyblack, 1, sg_movetom
dift d_any > 0
sg_chkboard = sg_boardm
$rep sg_chkboard, dg_movetom, "n"
$rep sg_chkboard, dg_movefromm, "-"
sub_bincheck
dift dg_bincheck <> 1: dinc dg_binmate
endi
dinc d_index
endw
ends sub_knightm
subr sub_bishopm
'updated 2002/04/20
'board is in sg_boardm, dg_movefromm
vari d_any, s_any, d_dot, s_dot
vari d_index, d_delta, d_loop
d_index = 85
dwhi d_index <= 88
itod d_delta, d_index
dg_movetom = dg_movefromm
d_loop = 1
dwhi d_loop = 1
dg_movetom = dg_movetom + d_delta
$cut sg_movetom, sg_boardm, dg_movetom, 1
$lok d_any, sg_tobyblack, 1, sg_movetom
dift d_any > 1: dinc d_loop
dift d_any > 0
sg_chkboard = sg_boardm
$rep sg_chkboard, dg_movetom, "b"
$rep sg_chkboard, dg_movefromm, "-"
sub_bincheck
dift dg_bincheck <> 1: dinc dg_binmate
else
dinc d_loop
endi
endw
dinc d_index
endw
ends sub_bishopm
subr sub_rookm
'updated 2002/04/20
'board is in sg_boardm, dg_movefromm
vari d_any, s_any, d_dot, s_dot
vari d_index, d_delta, d_loop
d_index = 81
dwhi d_index <= 84
itod d_delta, d_index
dg_movetom = dg_movefromm
d_loop = 1
dwhi d_loop = 1
dg_movetom = dg_movetom + d_delta
$cut sg_movetom, sg_boardm, dg_movetom, 1
$lok d_any, sg_tobyblack, 1, sg_movetom
dift d_any > 1: dinc d_loop
dift d_any > 0
sg_chkboard = sg_boardm
$rep sg_chkboard, dg_movetom, "r"
$rep sg_chkboard, dg_movefromm, "-"
sub_bincheck
dift dg_bincheck <> 1: dinc dg_binmate
else
dinc d_loop
endi
endw
dinc d_index
endw
ends sub_rookm
subr sub_queenm
'updated 2002/04/20
'board is in sg_boardm, dg_movefromm
vari d_any, s_any, d_dot, s_dot
vari d_index, d_delta, d_loop
d_index = 81
dwhi d_index <= 88
itod d_delta, d_index
dg_movetom = dg_movefromm
d_loop = 1
dwhi d_loop = 1
dg_movetom = dg_movetom + d_delta
$cut sg_movetom, sg_boardm, dg_movetom, 1
$lok d_any, sg_tobyblack, 1, sg_movetom
dift d_any > 1: dinc d_loop
dift d_any > 0
sg_chkboard = sg_boardm
$rep sg_chkboard, dg_movetom, "q"
$rep sg_chkboard, dg_movefromm, "-"
sub_bincheck
dift dg_bincheck <> 1: dinc dg_binmate
else
dinc d_loop
endi
endw
dinc d_index
endw
ends sub_queenm
subr sub_kingm
'updated 2002/04/20
'board is in sg_boardm, dg_movefromm
vari d_any, s_any, d_dot, s_dot
vari d_index, d_delta
d_index = 81
dwhi d_index <= 88
itod d_delta, d_index
dg_movetom = dg_movefromm + d_delta
$cut sg_movetom, sg_boardm, dg_movetom, 1
$lok d_any, sg_tobyblack, 1, sg_movetom
dift d_any > 0
sg_chkboard = sg_boardm
$rep sg_chkboard, dg_movetom, "k"
$rep sg_chkboard, dg_movefromm, "-"
sub_bincheck
dift dg_bincheck <> 1: dinc dg_binmate
endi
dinc d_index
endw
ends sub_kingm
subr sub_show_score1
'updated 2002/04/20
vari d_any, s_any, d_dot, s_dot
vari s_out, s_algebra1, s_algebra2
dg_pass1 = dg_movefrom1
sub_to_algebra
s_algebra1 = sg_pass1
dg_pass1 = dg_moveto1
sub_to_algebra
s_algebra2 = sg_pass1
s_out = dg_movecount1 + ". " + sg_moveman1
$app s_out, s_algebra1 + "-" + s_algebra2
$app s_out, sg_promotion1
dg_pass1 = dg_movefromhold2
sub_to_algebra
s_algebra1 = sg_pass1
dg_pass1 = dg_movetohold2
sub_to_algebra
s_algebra2 = sg_pass1
$cup s_any, sg_movemanhold2
$app s_out, " " + s_any + s_algebra1 + "-" + s_algebra2
$app s_out, ", moves2=" + dg_movecount2
$app s_out, ", mates3=" + dg_matescount
$app s_out, ", moves3=" + dg_movecount3
sg_score = s_out
$out sg_score
ends sub_show_score1
subr sub_show_score3
'updated 2002/04/20
vari d_any, s_any, d_dot, s_dot
vari s_algebra1, s_algebra2
dg_pass1 = dg_movefrom1
sub_to_algebra
s_algebra1 = sg_pass1
dg_pass1 = dg_moveto1
sub_to_algebra
s_algebra2 = sg_pass1
$out "1." + sg_moveman1 + s_algebra1 + "-" + s_algebra2
dg_pass1 = dg_movefrom2
sub_to_algebra
s_algebra1 = sg_pass1
dg_pass1 = dg_moveto2
sub_to_algebra
s_algebra2 = sg_pass1
$cup s_any, sg_moveman2
$out "1...." + s_any + s_algebra1 + "-" + s_algebra2
dg_pass1 = dg_movefrom3
sub_to_algebra
s_algebra1 = sg_pass1
dg_pass1 = dg_moveto3
sub_to_algebra
s_algebra2 = sg_pass1
$out "2." + sg_moveman3 + s_algebra1 + "-" + s_algebra2
ends sub_show_score3
subr sub_to_algebra
'updated 2002/04/20
vari d_any, s_any, d_dot, s_dot
vari d_square, s_file, d_rank
d_square = dg_pass1 % 100
d_rank = d_square % 10
d_any = d_square \ 10
$cut s_file, sg_abcdefgh, d_any, 1
sg_pass1 = s_file + d_rank
ends sub_to_algebra
subr sub_rotate_right
'updated 2002/04/20
'rotate the board to the right
vari d_any, s_any, d_dot, s_dot
vari d_loop
vari s_board1, s_board2, d_file1, d_rank1, d_file2, d_rank2
s_board1 = sg_pass1
dch$ s_board2, 32, 222
d_file1 = 1
dwhi d_file1 <= 8
d_rank1 = 1
dwhi d_rank1 <= 8
'file 1 becomes rank 8
'file 2 becomes rank 7
'file 8 becomes rank 1
d_rank2 = 9 - d_file1
d_file2 = d_rank1
d_dot = 10 * d_file1 + d_rank1 + 100
$cut s_dot, s_board1, d_dot, 1
d_dot = 10 * d_file2 + d_rank2 + 100
$rep s_board2, d_dot, s_dot
dinc d_rank1
endw
dinc d_file1
endw
sg_pass1 = s_board2
ends sub_rotate_right
subr sub_path_prog_memory
'updated 2007/12/19
'2007/11/20, 2007/11/18, 2007/11/14, 2007/11/12
'2006/09/25, 2006/09/04, 2006/08/29, 2006/04/23, 2005/10/08
vari s_out, s_path, d_memory, s_memory
vari s_date, s_version, d_lines, s_lines
$sys s_version, 3
$out s_version
$out sg_build
$sys s_path, 1
$out "Path: " + s_path
$dat s_date
$cut s_date, s_date, 1, 20
dsys d_memory, 1
ded$ s_memory, d_memory, 0, 0
dsys d_lines, 2
ded$ s_lines, d_lines, 0, 0
s_out = "memory=" + s_memory
$app s_out, ", lines=" + s_lines
$app s_out, ", date=" + s_date
$out s_out
ends sub_path_prog_memory
subr sub_speedquick
'updated 2008/02/23
vari d_any, d_dot, d_time
dsec d_time
d_dot = 10 ^ 6 * 2
d_any = 0
dwhi d_any < d_dot
dinc d_any
endw
dsec d_any
dg_pass1 = d_any - d_time
ends sub_speedquick
subr sub_speed_test
'updated 2008/02/02, 2008/01/25, 2007/12/22, 2007/12/14
'2007/12/09, 2007/12/08, 2007/12/07, 2007/12/01, 2007/11/23
'2007/11/21, 2007/11/20, 2007/11/18, 2007/11/16, 2007/11/12
'2007/11/04, 2007/09/15, 2007/07/11, 2007/04/16, 2007/04/11
'2005/11/30, 2005/11/20, 2005/03/31, 2005/02/26, 2004/12/03
'speed test
vari d_any, s_any, d_dot, s_dot, s_out
vari d_count, d_max, d_index, d_time1, d_time2
vari s_dashes, d_tseconds
vari d_teaquadpart, d_teaquadmult
$sys s_any, 2
$out s_any
$ch$ s_dashes, "-", 70
$out s_dashes
sub_path_prog_memory
d_tseconds = 0
d_max = 10 ^ 6 * 100
'dwhi dinc loop
$out s_dashes
d_count = 0
dsec d_time1
dwhi d_count < d_max
dinc d_count
endw
dsec d_any
d_time1 = d_any - d_time1
d_tseconds = d_tseconds + d_time1
ded$ s_any, d_max, 0, 0
$out s_any + " dinc loop, seconds=" + d_time1
'dwhi +1 loop
$out s_dashes
d_count = 0
dsec d_time2
dwhi d_count < d_max
d_count = d_count + 1
endw
dsec d_any
d_time2 = d_any - d_time2
d_tseconds = d_tseconds + d_time2
ded$ s_any, d_max, 0, 0
$out s_any + " +1 loop, seconds=" + d_time2
$out s_dashes
$out "total time=" + d_tseconds
$out s_dashes
sub_path_prog_memory
$out s_dashes
$inp s_any, "done"
ends sub_speed_test