MODULE Puzzle

MODULE Puzzle;

   IMPORT Iterators, NetIO, Objects, PersistentObjects, Services, Streams;

   CONST boardsize = 7;

   CONST
      player1 = 0; player2 = 1; empty = 2;
   TYPE
      Piece = SHORTINT; (* player1..empty *)
      Player = SHORTINT; (* player1 or player2 *)
      Board = ARRAY boardsize, boardsize OF Piece;

   TYPE
      Move = POINTER TO MoveRec;
      MoveRec =
	 RECORD
	    (PersistentObjects.ObjectRec)
	    fromx, fromy, tox, toy: SHORTINT; (* 0 .. boardsize-1 *)
	 END;

      Situation = POINTER TO SituationRec;
      SituationRec =
	 RECORD
	    (PersistentObjects.ObjectRec)
	    board: Board;
	    onturn: Player;
	    nofpieces: ARRAY 2 OF INTEGER;
	 END;

   VAR
      moveType, situationType: Services.Type;

   PROCEDURE ^CreateMove(VAR move: Move; fromx, fromy, tox, toy: SHORTINT);
   PROCEDURE ^Valid(situation: Situation; move: Move; player: Player): BOOLEAN;

   PROCEDURE InternalCreateMove(VAR object: PersistentObjects.Object);
      VAR
	 move: Move;
   BEGIN
      NEW(move);
      PersistentObjects.Init(move, moveType);
      object := move;
   END InternalCreateMove;

   PROCEDURE ReadMove(s: Streams.Stream;
                      object: PersistentObjects.Object) : BOOLEAN;
   BEGIN
      WITH object: Move DO
	 RETURN NetIO.ReadShortInt(s, object.fromx) &
	        NetIO.ReadShortInt(s, object.fromy) &
	        NetIO.ReadShortInt(s, object.tox) &
	        NetIO.ReadShortInt(s, object.toy)
      END;
   END ReadMove;

   PROCEDURE WriteMove(s: Streams.Stream;
                       object: PersistentObjects.Object) : BOOLEAN;
   BEGIN
      WITH object: Move DO
	 RETURN NetIO.WriteShortInt(s, object.fromx) &
	        NetIO.WriteShortInt(s, object.fromy) &
	        NetIO.WriteShortInt(s, object.tox) &
	        NetIO.WriteShortInt(s, object.toy)
      END;
   END WriteMove;

   PROCEDURE InternalCreateSituation(VAR object: PersistentObjects.Object);
      VAR situation: Situation;
   BEGIN
      NEW(situation); PersistentObjects.Init(situation, situationType);
      object := situation;
   END InternalCreateSituation;

   PROCEDURE ReadSituation(s: Streams.Stream;
                      object: PersistentObjects.Object) : BOOLEAN;
      VAR
	 row, col: INTEGER;
   BEGIN
      WITH object: Situation DO
	 row := 0;
	 WHILE row < boardsize DO
	    col := 0;
	    WHILE col < boardsize DO
	       IF ~NetIO.ReadShortInt(s, object.board[row, col]) THEN
		  RETURN FALSE
	       END;
	       INC(col);
	    END;
	    INC(row);
	 END;
	 RETURN NetIO.ReadShortInt(s, object.onturn) &
	        NetIO.ReadInteger(s, object.nofpieces[player1]) &
	        NetIO.ReadInteger(s, object.nofpieces[player2])
      END;
   END ReadSituation;

   PROCEDURE WriteSituation(s: Streams.Stream;
                            object: PersistentObjects.Object) : BOOLEAN;
      VAR
	 row, col: INTEGER;
   BEGIN
      WITH object: Situation DO
	 row := 0;
	 WHILE row < boardsize DO
	    col := 0;
	    WHILE col < boardsize DO
	       IF ~NetIO.WriteShortInt(s, object.board[row, col]) THEN
		  RETURN FALSE
	       END;
	       INC(col);
	    END;
	    INC(row);
	 END;
	 RETURN NetIO.WriteShortInt(s, object.onturn) &
	        NetIO.WriteInteger(s, object.nofpieces[player1]) &
	        NetIO.WriteInteger(s, object.nofpieces[player2])
      END;
   END WriteSituation;

   PROCEDURE InitBoard(VAR board: Board);
      VAR
	 row, col: SHORTINT;
   BEGIN
      row := 0;
      WHILE row < boardsize DO
	 col := 0;
	 WHILE col < boardsize DO
	    board[row, col] := empty;
	    INC(col);
	 END;
	 INC(row);
      END;
      board[0, 0] := player1;
      board[0, boardsize-1] := player2;
      board[boardsize-1, 0] := player2;
      board[boardsize-1, boardsize-1] := player1;
   END InitBoard;

   PROCEDURE MovePossible(situation: Situation; player: Player): BOOLEAN;
      VAR 
	 move: Move;
	 i, j, k, l: SHORTINT;
   BEGIN
      CreateMove(move, 0, 0, 0, 0);
      i := 0;
      WHILE i < boardsize DO
	 j := 0;
	 WHILE j < boardsize DO
	    IF situation.board[i, j] = player THEN
	       move.fromx := i; move.fromy := j;
	       k := -2;
	       WHILE k < 3 DO
		  l := -2;
		  WHILE l < 3 DO
		     move.tox := move.fromx + k; move.toy := move.fromy + l;
		     IF (move.tox >= 0) & (move.tox < boardsize) &
			   (move.toy >= 0) & (move.toy < boardsize) &
			   (situation.board[move.tox, move.toy] = empty) THEN
			RETURN TRUE
		     END;
		     INC(l);
		  END;
		  INC(k);
	       END;
	    END;
	    INC(j);
	 END;
	 INC(i);
      END;
      RETURN FALSE
   END MovePossible;

   PROCEDURE OtherPlayer(player: Player) : Player;
   BEGIN
      CASE player OF
      | player1:  RETURN player2
      | player2:  RETURN player1
      END;
   END OtherPlayer;

   PROCEDURE NextPlayer(situation: Situation; player: Player) : Player;
   BEGIN
      IF MovePossible(situation, OtherPlayer(player)) THEN
	 RETURN OtherPlayer(player)
      ELSE
	 RETURN player
      END;
   END NextPlayer;

   PROCEDURE Init;
      VAR
	 pif: PersistentObjects.Interface;
   BEGIN
      NEW(pif);
      pif.create := InternalCreateMove;
      pif.read := ReadMove; pif.write := WriteMove;
      pif.createAndRead := NIL;
      PersistentObjects.RegisterType(moveType, "Puzzle.Move", "", pif);
      NEW(pif);
      pif.create := InternalCreateSituation;
      pif.read := ReadSituation; pif.write := WriteSituation;
      pif.createAndRead := NIL;
      PersistentObjects.RegisterType(situationType,
	 "Puzzle.Situation", "", pif);
   END Init;

   (* === exported procedures ============================================== *)

   PROCEDURE CreateMove(VAR move: Move; fromx, fromy, tox, toy: SHORTINT);
   BEGIN
      InternalCreateMove(move);
      move.fromx := fromx; move.fromy := fromy;
      move.tox := tox; move.toy := toy;
   END CreateMove;

   PROCEDURE CreateSituation(VAR situation: Situation);
   BEGIN
      InternalCreateSituation(situation);
      InitBoard(situation.board);
      situation.onturn := player1;
      situation.nofpieces[player1] := 2;
      situation.nofpieces[player2] := 2;
   END CreateSituation;

   PROCEDURE CopySituation(VAR situation: Situation; orig: Situation);
   BEGIN
      InternalCreateSituation(situation);
      situation.board := orig.board;
      situation.onturn := orig.onturn;
      situation.nofpieces := orig.nofpieces;
   END CopySituation;

   PROCEDURE GetBoard(situation: Situation; VAR board: Board);
   BEGIN
      board := situation.board;
   END GetBoard;

   PROCEDURE NumberOfPieces(situation: Situation; player: Player) : INTEGER;
   BEGIN
      RETURN situation.nofpieces[player]
   END NumberOfPieces;

   PROCEDURE Finished(situation: Situation) : BOOLEAN;
   BEGIN
      RETURN (situation.nofpieces[player1] = 0) OR
             (situation.nofpieces[player2] = 0) OR
	     (situation.nofpieces[player1] + situation.nofpieces[player2] =
	     boardsize * boardsize)
   END Finished;

   PROCEDURE Winner(situation: Situation) : Piece;
      (* empty means nobody has won *)
   BEGIN
      ASSERT(Finished(situation));
      IF situation.nofpieces[player1] > situation.nofpieces[player2] THEN
	 RETURN player1
      ELSIF situation.nofpieces[player2] > situation.nofpieces[player1] THEN
	 RETURN player2
      ELSE
	 RETURN empty
      END;
   END Winner;

   PROCEDURE Onturn(situation: Situation) : Player;
   BEGIN
      ASSERT(~Finished(situation));
      RETURN situation.onturn
   END Onturn;

   PROCEDURE Valid(situation: Situation; move: Move; player: Player): BOOLEAN;
   BEGIN
      RETURN ~Finished(situation) & (situation.onturn = player) &
         (move.fromx >=0) & (move.fromx < boardsize) &
	 (move.fromy >=0) & (move.fromy < boardsize) &
	 (move.tox >=0) & (move.tox < boardsize) &
	 (move.toy >=0) & (move.toy < boardsize) &
	 (ABS(move.fromx - move.tox) <= 2) &
	 (ABS(move.fromy - move.toy) <= 2) &
	 (ABS(move.fromx - move.tox) + ABS(move.fromy - move.toy) > 0) &
	 (situation.board[move.fromx, move.fromy] = player) &
	 (situation.board[move.tox, move.toy] = empty);
   END Valid;

   PROCEDURE IterateMoves(it: Iterators.Iterator; situation: Objects.Object;
			  player: Player);
      VAR
	 i, j, k, l: SHORTINT;
	 move: Move;
	 boardcnt: ARRAY boardsize, boardsize OF SHORTINT;

      PROCEDURE Yield;
	 VAR
	    m: Move;
      BEGIN
	 CreateMove(m, move.fromx, move.fromy, move.tox, move.toy);
	 Iterators.Yield(it, m);
      END Yield;

   BEGIN (* IterateMoves *)
      IF situation = NIL THEN RETURN END;
      WITH situation: Situation DO
	 CreateMove(move, 0, 0, 0, 0);
	 i := 0;
	 WHILE i < boardsize DO
	    j := 0;
	    WHILE j < boardsize DO
	       boardcnt[i, j] := 0;
	       INC(j);
	    END;
	    INC(i);
	 END;
	 i := 0;
	 WHILE i < boardsize DO
	    j := 0;
	    WHILE j < boardsize DO
	       IF situation.board[i, j] = player THEN
		  move.fromx := i; move.fromy := j;
		  k := -2;
		  WHILE k < 3 DO
		     l := -2;
		     WHILE l < 3 DO
			move.tox := move.fromx + k; move.toy := move.fromy + l;
			IF Valid(situation, move, player) THEN 
			   IF (ABS(move.tox - move.fromx) <= 1) &
				 (ABS(move.toy - move.fromy) <= 1) THEN
			      INC(boardcnt[move.tox, move.toy]);
			      IF boardcnt[move.tox, move.toy] = 1 THEN
				 Yield;
			      END;
			   ELSE
			      Yield;
			   END;
			END;
			INC(l);
		     END;
		     INC(k);
		  END;
	       END; (* IF *)
	       INC(j);
	    END;
	    INC(i);
	 END;
      END;
   END IterateMoves;

   PROCEDURE CreateIterator(VAR it: Iterators.Iterator; situation: Situation;
			    player: Player);
   BEGIN
      Iterators.Create(it, IterateMoves, situation, player);
   END CreateIterator;

   PROCEDURE MakeMove(situation: Situation; move: Move; player: Player);
      VAR x, y: SHORTINT; ok: BOOLEAN; other: Player;
   BEGIN
      ok := Valid(situation, move, player); ASSERT(ok);
      other := OtherPlayer(player);
      situation.board[move.tox, move.toy] := player;
      INC(situation.nofpieces[player]);
      IF (ABS(move.fromx - move.tox) = 2) OR
	    (ABS(move.fromy - move.toy) = 2) THEN
	 situation.board[move.fromx, move.fromy] := empty;
	 DEC(situation.nofpieces[player]);
      END;
      x := -1;
      WHILE x < 2 DO
	 y := -1;
	 WHILE y < 2 DO
	    IF (move.tox + x >= 0) & (move.tox + x < boardsize) &
		  (move.toy + y >= 0) & (move.toy + y < boardsize) &
		  (situation.board[move.tox + x, move.toy + y] = other) THEN
	       DEC(situation.nofpieces[other]);
	       situation.board[move.tox + x, move.toy + y] := player;
	       INC(situation.nofpieces[player]);
	    END;
	    INC(y);
	 END;
	 INC(x);
      END;
      situation.onturn := NextPlayer(situation, player);
   END MakeMove;

BEGIN
   Init;
END Puzzle.