// This file shows an example of what a full GAME Code program looks like. This one enforces the 
// rules of Chess and plays a few moves.
   
// This is the pregame code
echo I've changed this preset to use new features in GAME Code. Let me know of any problems with it.
 setflag a1 a8 h1 h8 e1 e8
 set k e8
 set K e1
 set ep false
 include chess
   
// Here is the post-move code for White.
// It will be called as a subroutine after each White move. 
 sub postauto1
   if isupper old
     die You may not capture your own pieces.
   endif
   if not equal moved P
     set ep false
     if unequal space dest moved
       die You may not change the type of this piece.
     endif
   endif
   set legal false
   if match moved P K
     gosub moved origin dest
     if equal moved K
       set K dest
     endif
   elseif match moved Q R B N
     set legal fn moved origin dest
     if equal moved R
       unsetflag origin
     endif
   endif
   if not var legal
     die You may not move a moved from origin to dest
   endif
   if fn ATTACKEDBYB #K
     die You may not move into check.
   endif
 endsub
  
// Here is the post-move code for Black.
// It will be called as a subroutine after each Black move.
 sub postauto2
   if islower old
     die You may not capture your own pieces.
   endif
   if not equal moved p
     set ep false
     if unequal space dest moved
       die You may not change the type of this piece.
     endif
   endif
   set legal false
   if match moved p k
     gosub moved origin dest
     if equal moved k
       set k dest
     endif
   elseif match moved q r b n
     set legal fn toupper moved origin dest
     if equal moved r
       unsetflag origin
     endif
   endif
   if not var legal
     die You may not move a moved from origin to dest
   endif
   if fn ATTACKEDBYW #k
     die You may not move into check.
   endif
 endsub
  
// This code is for the actual game.
// Game Courier writes this portion of the program, 
// using moves entered by the players.
 moveindex 3 // Updates the index for retrieving the current move from an internal array.
 e2-e4		// White's first move, entered by the player
 postauto1	// The subroutine that gets called after each move by White, called without the use of gosub.
 moveindex 4
 d7-d5
 postauto2
 moveindex 5
 f1-b5
 postauto1
 moveindex 6
 c8-d7
 postauto2
 moveindex 7
 P a2-a4
 postauto1
 moveindex 8
 p c7-c6
 postauto2
 moveindex 9
 B b5-e2
 postauto1
 moveindex 10
 n g8-f6
 postauto2
 moveindex 11
 P d2-d3
 postauto1
 moveindex 12
 p e7-e5
 postauto2
  
  // The game has ended, last move by Black.
  // This is post-game code for checking whether Black has checked, checkmated or stalemated White.
 set checks sub checks #K
 if var checks
   if sub checkmated #K #checks
     say Checkmate! Black has won!
     won
   else
     say Check!
   endif
 elseif sub stalemated #K
   say Stalemate! The game is drawn.
   drawn
 endif
 end

// The program has now ended. The following code was included and run by the include command in the pre-game code.
// It mainly consists of functions and subroutines.

// 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;

// 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 Pawn functions are used only to check for checks. 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 P checkaleap #0 #1 1 1 or checkaleap #0 #1 -1 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;
def p checkaleap #0 #1 1 -1 or checkaleap #0 #1 -1 -1;

// 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.
// 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;
  // Is the King in check at all?
  verify var checks;

  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;

  // 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:
          move #from #to;
          if cond == toupper #piece P (sub join #piece #piece #from #to) (fn #piece #from #to):
            set unsafe sub checkedthru #king #from;
            if not #unsafe and empty #ep and #ep:
              set unsafe sub checkedthru #king #ep;
            endif;
            restore;
            verify #unsafe;
          else:
            restore;
          endif;
        next;
      next;
    next;
  else:
    set enemy untrue;
    def untrue == #0 #1 and false;
  endif;
  // setglobal debug true;
  // Can the King move out of Check?
  restore;
  set kleaps fn KL #king;
  for pos fn KL #king:
    if not fn friend space #pos:
      move #king #pos;
      // First checks whether King has escaped current check and then checks for new check.
      set checked fn #attacked #pos or fn #enemy #key #pos;
      restore;
      verify #checked;
    endif;
  next;
  // setglobal debug false;
  // At this point, all tests are positive: It is checkmate.
  return true;
endsub;

// When the King is not in check, and a game has only riders and leapers, a rider
// can ride 2 or more spaces only when it can also ride 1 space. So, to determine
// whether a player can move when the King is not checked, all that is required is
// to check whether each piece can move at least 1 space. That's what the stalemated
// subroutine checks for, and these functions are used to return an array of the spaces 
// each piece may make a one-space leap to.

def PL array where #0 0 1 where #0 -1 1 where #0 1 1;
def pl array where #0 0 -1 where #0 -1 -1 where #0 1 -1;
def NL leaps #0 1 2;
def BL leaps #0 1 1;
def RL leaps #0 1 0;
def QL merge leaps #0 1 0 leaps #0 1 1;
def KL merge leaps #0 1 0 leaps #0 1 1;
def AL merge leaps #0 1 2 leaps #0 1 1;
def ML merge leaps #0 1 0 leaps #0 1 2;

// Checks whether player is stalemated. It is optimized for the assumption that 
// the King is not in check. Stalemate under check is handled by the checkmated
// subroutine. The stalemated subroutine limits its checking to possible moves that 
// do not require other possible moves. It should be passed the position of the King.
// It breaks out with a value of false as soon as it finds a piece that can move.
// It otherwise goes through all tests and returns a value of true.

sub stalemated king;
  local o legal temp from piece to ra;
  if isupper space #king:
    def friend isupper #0;
    def friends onlyupper;
  else:
    def friend islower #0;
    def friends onlylower;
  endif;
  store;
  for (from piece) fn friends:
    set fnc join #piece cond islower #piece l L;
    if not isfunc #fnc:
      set fnc flipcase #fnc;
    endif;
  	// set fnc cond == #piece p pl (join toupper #piece L);
    for to fn #fnc #from:
      if not onboard #to or fn friend space #to:
        continue;
      endif;
      move #from #to;
      switch #piece:
        case K:
          set unsafe fn ATTACKEDBYB #to;
          break;
        case k:
          set unsafe fn ATTACKEDBYW #to;
          break;
        case P p:
          if sub P1 #from #to:
            if empty #ep and #ep;
              set unsafe sub checkedthru #king #ep or sub checkedthru #king #from;
            else:
              set unsafe sub checkedthru #king #from;
            endif;
          else:
            set unsafe false;
          endif;
          break;
        default:
          set unsafe sub checkedthru #king #from;
      endswitch;
      restore;
      verify #unsafe;
    next;
  next;
  // At this point, no safe legal moves were found.
  return true;
endsub;

// 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;

// 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 or fn ROOK #0 (r q) or fn BISHOP #0 (b q);
def ATTACKEDBYW fn KING #0 K or fn WPAWN #0 or fn KNIGHT #0 N or fn ROOK #0 (R Q) or fn BISHOP #0 (B Q);

// 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 checkatwostep #from #to 0 1 0 1 and == rankname #from 2;
      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 == #ep where #to 0 -1;
      if var legal:
      	capture #ep;
        set epc #ep;
      endif;
    endif;
    set ep false;
  endif;
  if != space #to moved and onboard where #to 0 1:
    die "You may not promote a Pawn that can still move forward.";
  endif;
  if not onboard where #to 0 1:
    if == P space #to:
      die "You must promote a Pawn when it can no longer move forward.";
    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 checkatwostep #from #to 0 -1 0 -1 and == rankname #from 7;
      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 == #ep where #to 0 1;
      if var legal:
      	capture #ep;
        set epc #ep;
      endif;
    endif;
    set ep false;
  endif;
  if != space #to moved and onboard where #to 0 -1:
    die You may not promote a Pawn that can still move forward.;
  endif;
  if not onboard where #to 0 -1:
    if == p space #to:
      die You must promote a Pawn when it can no longer move forward.;
    elseif not match space #to var bprom:
      set np space #to;
      die You may not promote your Pawn to a #np;
    endif;
  endif;
endsub;

// 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;

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

sub K from to;
  set legal fn K #from #to;
  if match #to where #from 2 0 where #from -2 0:
    set legal sub castle;
  endif;
  set K #to;
  unsetflag #from;
endsub;

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

sub k from to;
  set legal fn K #from #to;
  if match #to where #from 2 0 where #from -2 0:
    set legal sub castle;
  endif;
  set k #to;
  unsetflag #from;
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;