// Set some variables to reuse some subroutines for different games.
set wpr 2; // White's Pawn Rank
set bpr 7; // Black's Pawn Rank
set fps 2; // How many spaces a Pawn may move on its first turn
set pzs 1; // Number of ranks in promotion zone
set wcastle c1 g1;
set bcastle c8 g8;


// This uses the piecekeys variable to determine what a Pawn may promote to.
// wprom and bprom are global variables used in the P and p subroutines.

do;
  local x;
  for x piecekeys;
    if match #x P K p k;
      continue;
    elseif isupper #x;
      push wprom #x;
    elseif islower #x;
      push bprom #x;
    endif;
  next;
loop never;

setsystem maxmove 2;
ban commands allmoves;
allow moves 1 captures 1 promotions 2;

// These functions are used for checking the legality of a piece's move. Their names match
// the piece labels so that the piece moved quickly identifies which function to call. Two
// sets are given in uppercase and lowercase for efficiency and to distinguish Black and
// White Pawns. The #0 and #1 placeholders are for the origin and destination spaces of a move.

def N checkleap #0 #1 1 2;
def B checkride #0 #1 1 1;
def R checkride #0 #1 1 0;
def Q fn B #0 #1 or fn R #0 #1;
def K checkleap #0 #1 1 1 or checkleap #0 #1 1 0;
def M fn N #0 #1 or fn R #0 #1;
def A fn N #0 #1 or fn B #0 #1;


def n checkleap #0 #1 1 2;
def b checkride #0 #1 1 1;
def r checkride #0 #1 1 0;
def q fn b #0 #1 or fn r #0 #1;
def k checkleap #0 #1 1 1 or checkleap #0 #1 1 0;
def m fn n #0 #1 or fn r #0 #1;
def a fn n #0 #1 or fn b #0 #1;

// These are for checking the legality of possible Pawn moves.
// Subroutines by the same name are used for actual moves.

def P 
remove var ep
and checkleap #0 #1 1 1
and == var ep join filename #1 rankname #0
or and checkride #0 #1 0 1 == rankname #0 var wpr 
or checkleap #0 #1 0 1 
and empty #1 
or and islower space #1 checkleap #0 #1 1 1
and <= distance #0 #1 var fps
and > rank #1 rank #0;

def p
remove var ep
and checkleap #0 #1 1 1
and == var ep join filename #1 rankname #0
or and checkride #0 #1 0 1 == rankname #0 var bpr 
or checkleap #0 #1 0 1 
and empty #1 
or and isupper space #1 checkleap #0 #1 1 1
and <= distance #0 #1 var fps
and < rank #1 rank #0;

// Captures piece. For use in function to capture Pawn by en passant.
sub capturep p:
  empty #p;
  return true;
endsub;


// The following subroutine creates an associative array of all checking pieces.
// It presumes that functions have been created for checking the movement of each piece,
// and that each function bears the capitalized piece label as its name.
// For efficiency's sake, there are separate subroutines for white and black.

// Finds checks against a player's King. Used only after a player moves.
// Assumes prior legal play and checks only for a check from the last piece moved
// by the opponent and for revealed checks.

sub checks king;
  if not dest:
    return false;
  endif;
  my checks c;
  set checks ();
  if fn space dest dest #king:
    setelem checks dest space dest;
  endif;
  set c sub checkedthru #king origin;
  if #c:
    setelem checks #c space #c;
  elseif #epc:
    set c sub checkedthru #king #epc;
    if #c:
      setelem checks #c space #c;
    endif;
  endif;
  return var checks;  
endsub;

// Checks whether a player is checkmated and stores list of all legal moves.
// Should be passed array of pieces checking King and position of King.
// This array should be generated by checks subroutine.
// Although checkmate could be checked for by checking for check plus stalemate,
// this is more efficient. This subroutine avoids checking on the possibilities
// that can be eliminated by knowing that the King is in check.

sub checkmated king checks;
  local from piece to key legalmove piece nopawn;
  
  store;
  
  if isupper space #king:
    def friends onlyupper;
    def friend isupper #0;
    set attacked ATTACKEDBYB;
  else:
    def friends onlylower;
    def friend islower #0;
    set attacked ATTACKEDBYW;
  endif;

  // Find Legal King Moves
  set kingmoves fn KL #king;
  for to #kingmoves:
    if not fn friend space #to and onboard #to:
      move #king #to;
      set incheck fn var attacked #to;
	  restore;
	  if not #incheck:
	    setlegal #king #to;
	  endif;
	endif;
  next;

  // Is there only one checking piece?
  // Two checking pieces cannot both be blocked or captured.
  if == count var checks 1:
 
    // Can the check be captured or blocked without revealing another check?
    // Loops once through single element of array. key is coordinate, val is piece.
    for (key enemy) var checks:

      set possible path #king #key;
      push possible #key;
      
      // Is the checking piece a Pawn that may be captured by en passant?
      // If so, push the space it passed over onto the possible array.
      if == #key #ep:
        push possible cond isupper space #ep where #ep 0 -1 where #ep 0 1;
      endif;
	  
      for (from piece) fn friends:
        if == #from #king:
          continue;
        endif;
        for to #possible:
          if fn #piece #from #to:
			move #from #to;
			set incheck fn var attacked #king;
			if not #incheck:
			  setlegal #from #to;
			endif;
		  endif;
		  restore;
		next;
	  next;

	next;
  endif;
  // At this point, all legal moves have been found.
  return cond count system legalmoves false true and checks;
endsub;

// Since this include file has been rewritten to store all legal moves,
// these functions now cover all legal moves, not just the shortest possible moves.

def PL array where #0 0 2 where #0 0 1 where #0 -1 1 where #0 1 1;
def pL array where #0 0 -2 where #0 0 -1 where #0 -1 -1 where #0 1 -1;

def NL leaps #0 1 2;
def BL rays #0 1 1;
def RL rays #0 1 0;
def VL rays #0 1 1;
def CL rays #0 1 0;
def QL merge rays #0 1 0 rays #0 1 1;
def KL merge leaps #0 1 0 leaps #0 1 1;
def AL merge leaps #0 1 2 rays #0 1 1;
def ML merge rays #0 1 0 leaps #0 1 2;

def nL leaps #0 1 2;
def bL rays #0 1 1;
def rL rays #0 1 0;
def vL rays #0 1 1;
def cL rays #0 1 0;
def qL merge rays #0 1 0 rays #0 1 1;
def kL merge leaps #0 1 0 leaps #0 1 1;
def aL merge leaps #0 1 2 rays #0 1 1;
def mL merge rays #0 1 0 leaps #0 1 2;

sub castlepos from to:
  local c RPOS RDEST xdir safe;
  verify flag #from;
  verify empty #to;
   if isupper space #king:
    def friend isupper #0;
    def friends onlyupper;
	set attacked ATTACKEDBYB;
  else:
    def friend islower #0;
    def friends onlylower;
	set attacked ATTACKEDBYW;
  endif;
  set xdir sign minus file #to file #from;
  verify checkaride #from #to #xdir 0;
  verify not fn var attacked #from;
  set c #to;
  do:
    set c where #c #xdir 0;
    if flag #c:
      break;
	endif;
	verify onboard #c;
    verify empty #c;
  loop;
  verify flag #c;
  set RPOS #c;
  store;
  for c path #from #to:
    move #from #c;
    set safe not fn var attacked #c;
    restore;
	verify #safe;
  next;
  move #from #to; // Redo King move
  set RDEST where #to neg #xdir 0;
  move #RPOS #RDEST;
  return true;
endsub;

// Checks whether player is stalemated and stores list of all legal moves

sub stalemated king;
  local legalmove temp from piece to attacked ra;
  if isupper space #king:
    def friend isupper #0;
    def friends onlyupper;
	set attacked ATTACKEDBYB;
	set cspaces var wcastle;
  else:
    def friend islower #0;
    def friends onlylower;
	set attacked ATTACKEDBYW;
	set cspaces var bcastle;
  endif;
  store;
 
  // Find Legal King Moves
  set kingmoves fn KL #king;
  for to #kingmoves:
    if not fn friend space #to and onboard #to:
      move #king #to;
      set incheck fn var attacked #to;
	  restore;
	  if not #incheck:
	    setlegal #king #to;
	  endif;
	endif;
  next;

  for to var cspaces:
    if sub castlepos #king #to:
      set incheck fn var attacked #to;
	  restore;
	  if not #incheck:
	    setlegal #king #to;
	  endif;
    endif;
  next;
  
   // Can another piece legally move?
  restore;
  for (from piece) fn friends:
    if == #from #king:
      continue;
    endif;
    for to fn join #piece L #from:
      if fn #piece #from #to and not fn friend space #to and onboard #to:
        move #from #to;
	    set incheck fn var attacked #king;
	    if not #incheck:
		  setlegal #from #to;
	    endif;
	  endif;
	  restore;
    next;
  next;

  // All done. Set $legalmoves and return;
   return cond count system legalmoves false true;
endsub;

// The following functions are used to check for attacks by certain pieces on a certain position.
// In every one of these functions, #0 is the position and #1 is for pieces. Multiple pieces should
// be entered as an array.

def WPAWN match P what #0 1 -1 what #0 -1 -1;

def BPAWN match p what #0 1 1 what #0 -1 1;

def KNIGHT check what #0 1 2 check what #0 -1 2 check what #0 1 -2 check what #0 -1 -2 check what #0 2 1 check what #0 -2 1 check what #0 2 -1 check what #0 -2 -1 target #1;

def WAZIR check what #0 0 -1 check what #0 -1 0 check what #0 0 1 check what #0 1 0 target #1;

def FERZ check what #0 -1 -1 check what #0 -1 1 check what #0 1 -1 check what #0 1 1 target #1;

def KING fn WAZIR #0 #1 or fn FERZ #0 #1;

def ROOK check insight #0 0 -1 check insight #0 -1 0 check insight #0 0 1 check insight #0 1 0 target #1;

def BISHOP check insight #0 -1 -1 check insight #0 -1 1 check insight #0 1 -1 check insight #0 1 1 target #1;

// These two functions are the culmination of the previous functions.;
// They are used to test whether a given space is attacked by pieces from the other side.;

def ATTACKEDBYB fn KING #0 k or fn BPAWN #0 or fn KNIGHT #0 (n a m) or fn ROOK #0 (r q m) or fn BISHOP #0 (b q a);
def ATTACKEDBYW fn KING #0 K or fn WPAWN #0 or fn KNIGHT #0 (N A M) or fn ROOK #0 (R Q M) or fn BISHOP #0 (B Q A);

// These two subroutines are for actual Pawn moves. They are unsuitable for evaluating
// possible Pawn moves, because they exit the whole program with an error message on
// finding an illegal move, and they concern themselves with promotion, which does not
// affect the legality of a possible move.

sub P from to;
  local ydir;
  if == file #from file #to and not capture:
    set legal checkaleap #from #to 0 1;
    if var legal:
      set ep false;
    else;
      set legal checkaride #from #to 0 1 and <= distance #from #to #fps and or == rankname #from #wpr < #wpr 0;
      set ep #to;
    endif;
    set epc false;
  elseif capture or #ep:
    set legal checkaleap #from #to -1 1 or checkaleap #from #to 1 1;
    set epc false;
    if not capture and var legal:
      set legal > rank #to rank #ep and < rankname #to #bpr and == file #to file #ep;;
      if var legal:
      	capture #ep;
        set epc #ep;
      endif;
    endif;
    set ep false;
  endif;
  if != space #to moved and onboard where #to 0 #pzs:
    die "You may not promote a Pawn until it reaches the promotion zone.";
  endif;
  if not onboard where #to 0 1:
    if == P space #to:
      askpromote #wprom;
    elseif not match space #to var wprom:
      set np space #to;
      die "You may not promote your Pawn to a" #np;
    endif;
  endif;
endsub;

sub p from to;
  if == file #from file #to and not capture:
    set legal checkaleap #from #to 0 -1;
    if var legal:
      set ep false;
    else:
      set legal checkaride #from #to 0 -1 and <= distance #from #to #fps and or == rankname #from #bpr > #bpr lastrank;
      set ep #to;
    endif;
    set epc false;
  elseif capture or #ep:
    set legal checkaleap #from #to -1 -1 or checkaleap #from #to 1 -1;
    set epc false;
    if not capture and var legal:
      set legal < rank #to rank #ep and > rankname #to #wpr and == file #to file #ep;
      if var legal:
      	capture #ep;
        set epc #ep;
      endif;
    endif;
    set ep false;
  endif;
  if != space #to moved and onboard where #to 0 neg #pzs:
    die You may not promote a Pawn until it reaches the promotion zone.;
  endif;
  if not onboard where #to 0 -1:
    if == p space #to:
      askpromote #bprom;
    elseif not match space #to var bprom:
      set np space #to;
      die You may not promote your Pawn to a #np;
    endif;
  endif;
endsub;

// This subroutine is for evaluating actual moves by the White King.

sub K from to;
  if match #to var wcastle and flag #from:
    set legal sub castle;
  else:
    set legal fn K #from #to;
  endif;
  set K #to;
  unsetflag e1;
endsub;

// This subroutine is for evaluating actual moves by the Black King.

sub k from to;
  if match #to var bcastle and flag #from:
    set legal sub castle;
  else:
    set legal fn k #from #to;
  endif;
  set k #to;
  unsetflag e8;
endsub;


// This is a generic castling subroutine that handles both regular castling and free castling.
// Castling is handled as a King's move, and the only argument that ever needs to be passed
// to the subroutine is an alternate destination for the piece the King is castling with.
// As long as the piece is just leaping to a space adjacent to the King on the other side,
// no arguments need to be given. The subroutine will find the piece the King may castle
// with and move it to the appropriate location if castling proves legal.

// This subroutine presumes that the positions of the King and any piece it may castle
// with are flagged at the beginning of the game, that they will be unflagged when the
// piece moves, that castling involves movement only along a rank, that functions
// by the names of ATTACKEDBYB and ATTACKEDBYW have been created for telling when a
// space is attacked, that it is not used for castling to spaces it is never legal
// for a King to castle to, and that #from and #to were set in a previous function.

sub castle;
  local ATTACKED c RPOS RDEST xdir;

  if not flag #from:
    die A King may not castle after it moves.;
  endif;
  if capture:
    die A King may not castle to an occupied space.;
  endif;
  set xdir sign minus file #to file #from;
  if not checkaride #from #to #xdir 0:
    die A King may not castle across any occupied space.;
  endif;
  set c #to;
  do:
    set c where #c #xdir 0;
    if flag #c:
      break;
    elseif not onboard #c:
      die No piece was found to castle with.;
    elseif not empty #c:
      die The King cannot castle with the piece at #c;
    endif;
  loop;
  set RPOS #c;
  set ATTACKED ATTACKEDBYW unless isupper moved ATTACKEDBYB; 
  if fn var ATTACKED #from:
    die A King may not castle out of check.;
  endif;
  for c path #from #to:
    if fn var ATTACKED #c:
      die A King may not castle through check.;
    endif;
  next;
  if == count var subargs 0:
    set RDEST where #to neg #xdir 0;
  else:
    set RDEST elem 0 subarg;
  endif;
  unsetflag #RPOS;
  move #RPOS #RDEST;
  return true;
endsub;

// LEGACY CODE
// The following code might be in use by presets or include files that include this one,
// but they are no longer used for Chess

// The following subroutine checks whether the piece at #king, presumably a King, is
// checked by a rider along the line that connects it to the space at #loc. Its purpose
// is to check for revealed checks caused by moving a piece from #loc. When a check
// is found, it returns the location of the checking piece. It otherwise returns false.
// It is used in various places by the checkmated and stalemated subroutines.

sub checkedthru king loc;
  my dir c;
  set c revealed #king #loc;
  verify fn space #c #c #king and not samecase space #king space #c and onboard #c and #c;
  return #c;
endsub;

// This function tests whether a king is checked from a specific location.
// Useful for testing whether a piece that has just moved checks the King.
// The King's location and the other location must both be passed as arguments.

def fn checkedfrom fn space #1 #0 and xor isupper space #0 isupper space #1 and not empty #1;

// Checks whether a possible one-space Pawn move is legal. Intended only 
// for evaluating possible moves with the stalemated subroutine. Assumed to
// check only spaces Pawn could move to. Works for both black and white Pawns.

sub P1 from to;
  if == file #from file #to:
    return not capture;
  elseif capture:
    return true;
  elseif == file #to file #ep and == rank #from rank #ep and #ep:
    capture #ep;
    return true;
  endif;
  return false;
endsub;

// These two subroutines return whether a Pawn move is legal without reporting
// any illegal move messages, and without bothering with promotion. They are
// intended only for evaluating possible moves with the checkmated subroutine.
// PP is for white and pp for black.

sub PP from to;
  if checkatwostep #from #to 0 1 0 1 or checkaleap #from #to 0 1:
    return empty #to;
  elseif not checkaleap #from #to 1 1 and not checkaleap #from #to -1 1:
    return false;
  elseif not empty #to:
    return true;
  elseif == file #to file #ep and == rank #from rank #ep and #ep:
    capture #ep;
    return true;
  endif;
  return false;
endsub;

sub pp from to;
  if checkatwostep #from #to 0 -1 0 -1 or checkaleap #from #to 0 -1:
    return empty #to;
  elseif not checkaleap #from #to 1 -1 and not checkaleap #from #to -1 -1:
    return false;
  elseif not empty #to:
    return true;
  elseif == file #to file #ep and == rank #from rank #ep and #ep:
    capture #ep;
    return true;
  endif;
  return false;
endsub;