functor
import
    System
    Application
    QTk at 'x-oz://system/wp/QTk.ozf'
    Open at 'x-oz://system/Open.ozf'
    OS
define

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Constants

UNIT_DELAY = 1000
INIT_RESOURCES = resources(food:100 wood:100 stone:100 steel:100)
GOAL = resources(food:200 wood:200 stone:200 steel:200)
BAG_LIMIT = 10
PLAYER_DEFAULT_STRENGTH = 1
% A player _with_ a weapon, not the strength of the weapon:
PLAYER_WEAPON_STRENGTH = 3
TOWER_INIT_POINTS = 20
TOWER_VISIBLE_DIST = 4
TOWER_POWER_DIST = 2
COST_WEAPON = resources(food:0 wood:0 stone:0 steel:25)
COST_PLAYER = resources(food:10 wood:0 stone:0 steel:0)
COST_TOWER = resources(food:0 wood:50 stone:50 steel:0)

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Utilities functions

proc {UnitDelay}
   {Delay UNIT_DELAY}
end

% Calculate the sum of the resources
fun {ResourcesSum Res}
   Res.food + Res.wood + Res.stone + Res.steel
end

fun {GetResourceType SquareType}
   case SquareType
   of forest then wood
   [] field then food
   [] quarry then stone
   [] mine then steel
   else none
   end
end

% Wait X and Y. As soon as one of the two variables gets bound,
% return the value, which is 1 if X is bound first, or 2 if Y is bound first.
fun {WaitTwo X Y}
   Ret
in
   thread
      {Wait X}
      if {Not {IsDet Ret}} then Ret = 1 end
   end
   thread
      {Wait Y}
      if {Not {IsDet Ret}} then Ret = 2 end
   end
   Ret
end

% Creates a port object
fun {NewPortObject Behaviour InitState}
   proc {MsgLoop Stream State}
      case Stream
      of nil then skip
      [] Msg|OtherMessages then
	 {MsgLoop OtherMessages {Behaviour Msg State}}
      end
   end
   Stream
in
   thread {MsgLoop Stream InitState} end
   {NewPort Stream}
end

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Port objects: Home, Player and Square

% Creates a home object.
% HomePort: get the port to which we can send messages.
% StateStream: get a stream containing all the states.
% The state contains only the number of resources.
% The purpose of the state stream is to be notified when the number of resources change,
% so we can, for example, update the user interface.
proc {CreateHome ?HomePort ?StateStream}
   StatePort

   fun {HandleMsg Msg State}
      case Msg
      of getNbResources(?Res) then
	 Res = State
	 State

      [] addResources(Res) then
	 NewState = resources(food: Res.food + State.food
			      wood: Res.wood + State.wood
			      stone: Res.stone + State.stone
			      steel: Res.steel + State.steel)
      in
	 {Send StatePort NewState}
	 NewState

      [] removeResources(Res ?OK) then
	 if State.food < Res.food orelse
	    State.wood < Res.wood orelse
	    State.stone < Res.stone orelse
	    State.steel < Res.steel then
	    OK = false
	    State
	 else
	    NewState = resources(food: State.food - Res.food
				 wood: State.wood - Res.wood
				 stone: State.stone - Res.stone
				 steel: State.steel - Res.steel)
	 in
	    OK = true
	    {Send StatePort NewState}
	    NewState
	 end
      end
   end
in
   {NewPort StateStream StatePort}
   {Send StatePort INIT_RESOURCES}
   HomePort = {NewPortObject HandleMsg INIT_RESOURCES}
end

fun {CreatePlayer Team Squares Map StaticEnv}
   InitBag = resources(food:0 wood:0 stone:0 steel:0)
   PlayerPort

   % Move to a surrounding square. Returns the new state.
   fun {Move NewX NewY State}
      CurX = State.pos.x
      CurY = State.pos.y
   in
      {UnitDelay}

      % Same position
      if NewX == CurX andthen NewY == CurY then
	 State

      % Invalid position (out of the map)
      elseif NewX < 1 orelse NewY < 1
	 orelse {Width Squares} < NewY orelse {Width Squares.1} < NewX then
	 State

      % Not one of the 8 surrounding squares
      elseif 1 < {Number.abs CurX - NewX} orelse 1 < {Number.abs CurY - NewY} then
	 State

      % OK, do the move
      else
	 NewState
	 Dead
      in
	 {Send Squares.CurY.CurX playerOut(Team.num PlayerPort)}
	 {Send Squares.NewY.NewX playerIn(Team.num PlayerPort State.weapon ?Dead)}

	 if Dead then
	    NewState = {AdjoinAt State dead true}

	 % If on home, deposit bag resources
	 elseif NewX == Team.homePos.x andthen NewY == Team.homePos.y
	    andthen 0 < {ResourcesSum State.bag} then
	    {Send Team.home addResources(State.bag)}
	    NewState = {AdjoinAt State bag InitBag}
	 else
	    NewState = State
	 end

	 {AdjoinAt NewState pos pos(x:NewX y:NewY)}
      end
   end

   % Exploit a resource
   fun {Exploit State}
      CurX = State.pos.x
      CurY = State.pos.y
      SquareType = Map.CurY.CurX
   in
      % Not on a resource, a unit time is lost...
      % TODO: handle resource stealing on an opponent's home
      if SquareType == normal orelse SquareType == home then
	 {UnitDelay}
	 State

      % The bag is full
      elseif BAG_LIMIT =< {ResourcesSum State.bag} then
	 {UnitDelay}
	 State

      % OK, exploit the resource
      else
	 Dead
	 Finished
      in
	 % Manage fights
	 {Send Squares.CurY.CurX beginExploit(Team.num PlayerPort State.weapon ?Dead)}

	 thread
	    {UnitDelay}
	    Finished = unit
	 end

	 % There is a fight
	 if {WaitTwo Dead Finished} == 1 then
	    % We are dead
	    if Dead then
	       {Send Squares.CurY.CurX playerOut(Team.num PlayerPort)}
	       {AdjoinAt State dead true}

	    % We survived, but we lost the resource
	    else
	       State
	    end

	 % No fight, finished to exploit the resource
	 else
	    ResType = {GetResourceType SquareType}
	    NewBag = {AdjoinAt State.bag ResType State.bag.ResType+1}
	 in
	    {Send Squares.CurY.CurX endExploit(Team.num PlayerPort)}
	    {AdjoinAt State bag NewBag}
	 end
      end
   end

   fun {KillMe State}
      CurX = State.pos.x
      CurY = State.pos.y
   in
      % Send a message to the square to say that we are dead.
      % Only squares can send the kill message, BUT if the player was moving to another
      % square during the kill, this is not the _same_ square.
      {Send Squares.CurY.CurX playerOut(Team.num PlayerPort)}

      {AdjoinAt State dead true}
   end

   fun {BuildWeapon State}
      {UnitDelay}

      % Check that the player has not already a weapon
      if {Not {IsDet State.weapon}} then
	 OK
      in
	 {Send Team.home removeResources(COST_WEAPON ?OK)}
	 if OK then
	    State.weapon = unit
	 end
      end

      State
   end

   fun {BuildPlayer InitPlayerState State}
      OK
   in
      {UnitDelay}
      {Send Team.home removeResources(COST_PLAYER ?OK)}
      if OK then
	 NewPlayer = {CreatePlayer Team Squares Map StaticEnv}
	 NewBrain = {CreateBrain StaticEnv InitPlayerState}
      in
	 {Embody NewPlayer NewBrain InitPlayerState}
      end

      State
   end

   fun {GetBrainEnv State}
      HomeResources
      VisibleTowers
      CurX = State.pos.x
      CurY = State.pos.y
   in
      {Send Team.home getNbResources(?HomeResources)}
      {Send Squares.CurY.CurX getVisibleTowers(?VisibleTowers)}
      {Wait HomeResources}
      {Wait VisibleTowers}

      env(location: State.pos
	  bag: State.bag
	  resources: HomeResources
	  weapon: {IsDet State.weapon}
	  opponentHome: none
	  towers: VisibleTowers)
   end

   fun {HandleMsg Msg State}
      case Msg
      % Message from the brain
      of Action#BrainEnv#Dead then
	 % If the player is already dead, do nothing
	 if State.dead then
	    Dead = true
	    BrainEnv = {GetBrainEnv State}
	    State
	 else
	    NewState
	 in
	    case Action
	    of noop then
	       NewState = State
	    [] move(pos(x:NewX y:NewY)) then
	       NewState = {Move NewX NewY State}
	    [] exploit then
	       NewState = {Exploit State}
	    [] build(weapon) then
	       NewState = {BuildWeapon State}
	    [] build(player(InitPlayerState)) then
	       NewState = {BuildPlayer InitPlayerState State}
	    end

	    Dead = NewState.dead
	    BrainEnv = {GetBrainEnv NewState}
	    NewState
	 end

      [] kill then
	 {KillMe State}
      end
   end

   HomeSquare = Squares.(Team.homePos.y).(Team.homePos.x)

   % Initially, the player is at its home and his bag is empty
   InitState = state(pos: Team.homePos
		     bag: InitBag

		     % To know if the player has a weapon, do {IsDet State.weapon}.
		     % We pass this (initially unbound) variable to the Square object,
		     % so when the square wants to know the strength of a player,
		     % the square doesn't need to ask the player by sending a message,
		     % which can be very slow with the current implementation.
		     weapon: _
		     dead: false)
   State
   Dead
in
   {Send HomeSquare playerIn(Team.num PlayerPort InitState.weapon ?Dead)}

   % Yes, a player can be dead before he gets born, if there is an opponent's tower
   % near or on the player's home.
   if Dead then
      State = {AdjoinAt InitState dead true}
   else
      State = InitState
   end

   PlayerPort = {NewPortObject HandleMsg State}
   PlayerPort
end

% Home is the atom none or a record of the form: home(owner:TeamNum port:Port)
proc {CreateSquare Pos NbTeams Home AllSquares ?SquarePort ?StateStream}
   StatePort

   fun {GetPlayerStrength Weapon}
      if {IsDet Weapon} then
	 PLAYER_WEAPON_STRENGTH
      else
	 PLAYER_DEFAULT_STRENGTH
      end
   end

   fun {GetFirstOpponentTower TeamNum State}
      fun {Step List}
	 case List
	 of nil then
	    none
	 [] Tower|OtherTowers then
	    if Tower.owner \= TeamNum then
	       Tower
	    else
	       {Step OtherTowers}
	    end
	 end
      end
   in
      % Search only in the near towers.
      % If the current square has an opponent tower, it's impossible that the player
      % is still alive, so we omit the current square here.
      {Step State.nearTowers}
   end

   % A new player is on the square
   fun {PlayerIn TeamNum Player Weapon State ?Dead}
      fun {AddPlayer}
	 NewPlayer = player(port:Player weapon:Weapon)
	 NewPlayers = {AdjoinAt State.players TeamNum NewPlayer|State.players.TeamNum}
      in
	 {AdjoinAt State players NewPlayers}
      end

      OpponentTower = {GetFirstOpponentTower TeamNum State}
   in
      if OpponentTower == none then
	 Dead = false
	 {AddPlayer}
      else
	 PlayerStrength = {GetPlayerStrength Weapon}
      in
	 {Send OpponentTower.square weakenTower(PlayerStrength ?Dead)}
	 if Dead then
	    State
	 else
	    {AddPlayer}
	 end
      end
   end

   fun {RemovePlayer Player List}
      case List
      of nil then
	 nil
      [] P|OtherPlayers andthen P.port == Player then
	 OtherPlayers
      [] P|OtherPlayers then
	 P|{RemovePlayer Player OtherPlayers}
      end
   end

   % A player has quit the square
   fun {PlayerOut TeamNum Player State}
      List = {RemovePlayer Player State.players.TeamNum}
      NewPlayers = {AdjoinAt State.players TeamNum List}
   in
      {AdjoinAt State players NewPlayers}
   end

   % A new tower has just been built in this square. Kill opponent's players until
   % there is no more opponent's players or when the tower has lost all its points.
   % The remaining points can be negative.
   proc {NewTowerKillPlayers TowerTeam State ?RemainingPoints ?NewState}
      proc {Step TeamNum PlayersState TowerPoints}
	 if TeamNum == TowerTeam then
	    {Step TeamNum+1 PlayersState TowerPoints}

	 elseif NbTeams < TeamNum orelse TowerPoints =< 0 then
	    RemainingPoints = TowerPoints
	    NewState = {AdjoinAt State players PlayersState}

	 else
	    case PlayersState.TeamNum
	    of nil then
	       {Step TeamNum+1 PlayersState TowerPoints}

	    [] Player|OtherPlayers then
	       PlayerStrength = {GetPlayerStrength Player.weapon}
	       NewPlayersState = {AdjoinAt PlayersState TeamNum OtherPlayers}
	    in
	       {Send Player.port kill}
	       {Step TeamNum NewPlayersState TowerPoints-PlayerStrength}
	    end
	 end
      end
   in
      {Step 1 State.players TOWER_INIT_POINTS}
   end

   % A tower on another square has just been built. Kill opponent's players until
   % there is no more opponent's players or when the tower has lost all its points.
   % Returns the new state.
   proc {TowerKillPlayers TowerTeam TowerSquare State ?TowerIsDestroyed ?NewState}
      proc {Step TeamNum PlayersState}
	 if TeamNum == TowerTeam then
	    {Step TeamNum+1 PlayersState}

	 elseif NbTeams < TeamNum then
	    TowerIsDestroyed = false
	    NewState = {AdjoinAt State players PlayersState}

	 else
	    case PlayersState.TeamNum
	    of nil then
	       {Step TeamNum+1 PlayersState}

	    [] Player|OtherPlayers then
	       PlayerStrength = {GetPlayerStrength Player.weapon}
	       OK
	    in
	       {Send TowerSquare weakenTower(PlayerStrength ?OK)}
	       if OK then
		  NewPlayersState = {AdjoinAt PlayersState TeamNum OtherPlayers}
	       in
		  {Send Player.port kill}
		  {Step TeamNum NewPlayersState}
	       else
		  TowerIsDestroyed = true
		  NewState = {AdjoinAt State players PlayersState}
	       end
	    end
	 end
      end
   in
      {Step 1 State.players}
   end

   % Build a tower on this square
   fun {BuildTower TeamNum State ?OK}
      if State.tower \= none then
	 OK = false
	 State
      else
	 RemainingPoints
	 NewState
      in
	 OK = true
	 {NewTowerKillPlayers TeamNum State ?RemainingPoints ?NewState}
	 if RemainingPoints =< 0 then
	    NewState
	 else
	    {NotifyNeighbourSquares TOWER_VISIBLE_DIST towerBuilt(TeamNum SquarePort Pos)}
	    {AdjoinAt NewState tower tower(owner:TeamNum points:RemainingPoints)}
	 end
      end
   end

   % Weaken the tower of this square
   fun {WeakenTower Strength State ?OK}
      if State.tower == none then
	 OK = false
	 State
      else
	 NewTowerPoints = State.tower.points - Strength
	 NewTowerState
      in
	 OK = true

	 if 0 < NewTowerPoints then
	    NewTowerState = {AdjoinAt State.tower points NewTowerPoints}
	 else
	    NewTowerState = none
	    {NotifyNeighbourSquares TOWER_VISIBLE_DIST towerDestroyed(SquarePort Pos)}
	 end

	 {AdjoinAt State tower NewTowerState}
      end
   end

   % Notify the neighbour squares with a message
   proc {NotifyNeighbourSquares Dist Msg}
      NbRows = {Width AllSquares}
      NbCols = {Width AllSquares.1}
      MinX = {Max 1 Pos.x-Dist} % Minix!
      MaxX = {Min NbCols Pos.x+Dist}
      MinY = {Max 1 Pos.y-Dist}
      MaxY = {Min NbRows Pos.y+Dist}
      StopPos = pos(x:MaxX y:MaxY)

      fun {GetNextPos Pos}
	 if Pos.x < MaxX then
	    pos(x:Pos.x+1 y:Pos.y)
	 else
	    pos(x:MinX y:Pos.y+1)
	 end
      end

      proc {NotifyStep CurPos}
	 if CurPos \= Pos then
	    {Send AllSquares.(CurPos.y).(CurPos.x) Msg}
	 end

	 if CurPos \= StopPos then
	    {NotifyStep {GetNextPos CurPos}}
	 end
      end
   in
      {NotifyStep pos(x:MinX y:MinY)}
   end

   fun {CanKill TowerPos}
      {Number.abs Pos.x-TowerPos.x} =< TOWER_POWER_DIST
      andthen {Number.abs Pos.y-TowerPos.y} =< TOWER_POWER_DIST
   end

   % A tower has been built on an neighbour square
   fun {AddTower TeamNum Square TowerPos State}
      NewTower = tower(location:TowerPos owner:TeamNum square:Square)
      NewState
      TowerIsDestroyed
   in
      if {CanKill TowerPos} then
	 NewPlayersState
      in
	 {TowerKillPlayers TeamNum Square State ?TowerIsDestroyed ?NewPlayersState}
	 if TowerIsDestroyed then
	    NewState = NewPlayersState
	 else
	    NewState = {AdjoinAt NewPlayersState nearTowers NewTower|State.nearTowers}
	 end
      else
	 TowerIsDestroyed = false
	 NewState = State
      end

      if TowerIsDestroyed then
	 NewState
      else
         % If we have received the message to add a tower, then it's at least visible
	 {AdjoinAt NewState visibleTowers NewTower|State.visibleTowers}
      end
   end

   % A tower has been destroyed on an neighbour square
   fun {RemoveTower Square TowerPos State}
      fun {RemoveInList Towers}
	 {Filter Towers fun {$ Tower} Tower.square \= Square end}
      end

      NewNearState
   in
      if {CanKill TowerPos} then
	 NewNearState = {AdjoinAt State nearTowers {RemoveInList State.nearTowers}}
      else
	 NewNearState = State
      end

      {AdjoinAt NewNearState visibleTowers {RemoveInList State.visibleTowers}}
   end

   fun {GetVisibleTowers State}
      % The return value must be suitable for the brain environment.
      % If this square has a tower, add it to the list.
      if State.tower == none then
	 State.visibleTowers
      else
	 tower(location:Pos owner:State.tower.owner) | State.visibleTowers
      end
   end

   % Kill all the opponent's players.
   % Returns the new PlayersState.
   fun {KillAllOpponentPlayers WinnerTeam PlayersState}
      for TeamNum in 1..NbTeams do
	 if TeamNum \= WinnerTeam then
	    for Player in PlayersState.TeamNum do
	       {Send Player.port kill}
	    end
	 end
      end

      {AdjoinAt InitPlayers WinnerTeam PlayersState.WinnerTeam}
   end

   % The player begins to exploit the resource.
   fun {BeginExploit TeamNum Player Weapon State ?Dead}
      % Add the player to the exploitation list of his team.
      NewPlayer = player(port:Player weapon:Weapon dead:Dead)
      NewExpl = {AdjoinAt State.exploitations TeamNum
		 NewPlayer|State.exploitations.TeamNum}

      fun {SearchOtherTeam OtherTeamNum}
	 if NbTeams < OtherTeamNum then
	    none
	 elseif OtherTeamNum \= TeamNum
	    andthen NewExpl.OtherTeamNum \= nil then
	    OtherTeamNum
	 else
	    {SearchOtherTeam OtherTeamNum+1}
	 end
      end

      fun {GetTotalStrength Team}
	 fun {Step List Total}
	    case List
	    of nil then
	       Total
	    [] Player|OtherPlayers then
	       {Step OtherPlayers Total + {GetPlayerStrength Player.weapon}}
	    end
	 end
      in
	 {Step NewExpl.Team 0}
      end

      proc {SetDead Team IsDead}
	 proc {Step List}
	    case List
	    of nil then
	       skip
	    [] Player|OtherPlayers then
	       Player.dead = IsDead
	       {Step OtherPlayers}
	    end
	 end
      in
	 {Step NewExpl.Team}
      end

      OtherTeamNum = {SearchOtherTeam 1}
   in
      % Peace.
      if OtherTeamNum == none then
	 {AdjoinAt State exploitations NewExpl}

      % Fight!
      else
	 NewTeamStrength = {GetTotalStrength TeamNum}
	 OtherTeamStrength = {GetTotalStrength OtherTeamNum}
	 NewTeamIsDead = NewTeamStrength =< OtherTeamStrength
	 OtherTeamIsDead = OtherTeamStrength =< NewTeamStrength
      in
	 {SetDead TeamNum NewTeamIsDead}
	 {SetDead OtherTeamNum OtherTeamIsDead}

	 {AdjoinAt State exploitations InitExploitations}
      end
   end

   % The player has finished to exploit the resource.
   % Remove the player from the exploitation list.
   fun {EndExploit TeamNum Player State}
      fun {RemoveInList Players}
	 {Filter Players fun {$ P} P.port \= Player end}
      end

      NewPlayers = {RemoveInList State.exploitations.TeamNum}
      NewExplState = {AdjoinAt State.exploitations TeamNum NewPlayers}
   in
      {AdjoinAt State exploitations NewExplState}
   end

   fun {HandleMsg Msg State}
      % We send the new state to the StatePort only when the UI should be updated
      case Msg
      of playerIn(TeamNum Player Weapon ?Dead) then
	 NewState = {PlayerIn TeamNum Player Weapon State ?Dead}
      in
	 {Send StatePort NewState}
	 NewState

      [] playerOut(TeamNum Player) then
	 NewState = {PlayerOut TeamNum Player State}
      in
	 {Send StatePort NewState}
	 NewState

      [] buildTower(TeamNum ?OK) then
	 NewState = {BuildTower TeamNum State ?OK}
      in
	 if OK then
	    {Send StatePort NewState}
	 end
	 NewState

      [] weakenTower(Strength ?OK) then
	 NewState = {WeakenTower Strength State ?OK}
      in
	 % destroyed
	 if OK andthen NewState.tower == none then
	    {Send StatePort NewState}
	 end
	 NewState

      [] towerBuilt(TeamNum Square Pos) then
	 {AddTower TeamNum Square Pos State}

      [] towerDestroyed(Square Pos) then
	 {RemoveTower Square Pos State}

      [] getVisibleTowers(?Towers) then
	 Towers = {GetVisibleTowers State}
	 State

      [] beginExploit(TeamNum Player Weapon ?Dead) then
	 {BeginExploit TeamNum Player Weapon State ?Dead}

      [] endExploit(TeamNum Player) then
	 {EndExploit TeamNum Player State}
      end
   end

   InitPlayers = {MakeTuple players NbTeams}
   InitExploitations = {MakeTuple exploitations NbTeams}
   InitState = state(players: InitPlayers
		     % The home is required for the UI
		     home: Home
		     tower: none
		     % A near tower can kill a player
		     nearTowers: nil
		     visibleTowers: nil
		     exploitations: InitExploitations)
in
   for TeamNum in 1..NbTeams do
      InitPlayers.TeamNum = nil
      InitExploitations.TeamNum = nil
   end

   {NewPort StateStream StatePort}
   {Send StatePort InitState}
   SquarePort = {NewPortObject HandleMsg InitState}
end

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Game-specific functions

proc {CreateAllSquares Map Teams ?Squares ?Streams}
   NbRows = {Width Map}
   NbColumns = {Width Map.1}
   NbTeams = {Width Teams}

   fun {GetHomeInfo X Y}
      fun {SearchHome TeamNum}
	 if NbTeams < TeamNum then
	    none
	 elseif Teams.TeamNum.homePos.x == X andthen Teams.TeamNum.homePos.y == Y then
	    home(owner:TeamNum port:Teams.TeamNum.home)
	 else
	    {SearchHome TeamNum+1}
	 end
      end
   in
      if Map.Y.X \= home then
	 none
      else
	 {SearchHome 1}
      end
   end
in
   Squares = {MakeTuple squares NbRows}
   Streams = {MakeTuple streams NbRows}

   for RowNum in 1..NbRows do
      Squares.RowNum = {MakeTuple row NbColumns}
      Streams.RowNum = {MakeTuple row NbColumns}

      for ColNum in 1..NbColumns do
	 Pos = pos(x:ColNum y:RowNum)
	 HomeInfo = {GetHomeInfo ColNum RowNum}
      in
	 {CreateSquare Pos NbTeams HomeInfo Squares
	  ?Squares.RowNum.ColNum
	  ?Streams.RowNum.ColNum}
      end
   end
end

% At the beginning of the game, there is two towers in diagonal of each home.
proc {BuildInitialTowers Squares Team}
   NbRows = {Width Squares}
   NbCols = {Width Squares.1}
in
   if Team.homePos.x < NbCols andthen 1 < Team.homePos.y then
      TowerX = Team.homePos.x + 1
      TowerY = Team.homePos.y - 1
   in
      {Send Squares.TowerY.TowerX buildTower(Team.num _)}
   end

   if 1 < Team.homePos.x andthen Team.homePos.y < NbRows then
      TowerX = Team.homePos.x - 1
      TowerY = Team.homePos.y + 1
   in
      {Send Squares.TowerY.TowerX buildTower(Team.num _)}
   end
end

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% The Brain

proc {Embody Player Brain InitState}
   proc {AskBrain Env State}
      [Action NextState] = {Brain Env State}
      NextEnv
      Dead
   in
      {Send Player Action#?NextEnv#?Dead}
      {Wait NextEnv}
      {Wait Dead}
      if {Not Dead} then
	 {AskBrain NextEnv NextState}
      end
   end
in
   thread
      InitEnv
      Dead
   in
      % "noop" is actually useful
      {Send Player noop#?InitEnv#?Dead}
      {Wait InitEnv}
      {Wait Dead}

      if {Not Dead} then
	 {AskBrain InitEnv InitState}
      end
   end
end

fun {CreateBrain StaticEnv Init}
   fun {$ Env State}
      if State == none then
	 [build(player(none)) noop]
      else
	 [move(Env.location) noop]
      end
   end
end

% We are at CurLoc and we want to go to WantedLoc, what is the next location?
fun {GetNextLoc CurLoc WantedLoc}
   X
   Y
   NextLoc = pos(x:X y:Y)
in
   if WantedLoc.x < CurLoc.x then
      X = CurLoc.x - 1
   elseif CurLoc.x < WantedLoc.x then
      X = CurLoc.x + 1
   else
      X = CurLoc.x
   end

   if WantedLoc.y < CurLoc.y then
      Y = CurLoc.y - 1
   elseif CurLoc.y < WantedLoc.y then
      Y = CurLoc.y + 1
   else
      Y = CurLoc.y
   end

   NextLoc
end

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% GUI

% To be able to call methods asynchronously on an object
fun {NewActive Class Init}
   Obj = {New Class Init}
   Port
in
   thread Stream in
      {NewPort Stream Port}
      for Msg in Stream do {Obj Msg} end
   end
   proc {$ Msg} {Send Port Msg} end
end

% "a", "b", "c", etc.
fun {GetTeamID TeamNum}
   [&a + TeamNum - 1]
end

% "A", "B", "C", etc.
fun {GetTeamIDWeapon TeamNum}
   [&A + TeamNum - 1]
end

class Gui
   attr
      resources
      squares
      grid
      normal
      field
      forest
      quarry
      mine

   % W: width of the map
   meth init(Map NbTeams)
      Grid
      Resources = {MakeTuple resources NbTeams}
      TeamsInfo = {MakeTuple td NbTeams}
      W = {Width Map.1}
      H = {Width Map}
   in
      % Colors
      normal := white
      field := c(255 100 100)
      forest := c(135 75 20)
      quarry := c(180 180 180)
      mine := yellow

      % Show resources of each team
      for TeamNum in 1..NbTeams do
	 TeamsInfo.TeamNum = lr(label(text:"Team " # TeamNum # ": ")
				label(text:"" handle:Resources.TeamNum))
      end

      % Create the window
      {{QTk.build td(
		     grid(handle:Grid bg:white)
		     lr(label(text:" Home " bg:black fg:white)
			label(text:" Food " bg:@field)
			label(text:" Wood " bg:@forest)
			label(text:" Stone " bg:@quarry)
			label(text:" Steel " bg:@mine))
		     TeamsInfo
		     button(text:"Quit" action:proc {$} {Application.exit 0} end)
		     )} show}

      % Configure the grid
      for I in 1..H-1 do
	 {Grid configure(lrline column:1 columnspan:2*W-1 row:I*2 sticky:we)}
      end
      for I in 1..W-1 do
	 {Grid configure(tdline  row:1 rowspan:2*H-1 column:I*2 sticky:ns)}
      end
      for I in 1..W do
	 {Grid columnconfigure(2*I-1 minsize:43)}
      end
      for I in 1..H do
	 {Grid rowconfigure(2*I-1 minsize:43)}
      end

      % Keep a reference to the widgets, so we can modify them later
      grid := Grid
      resources := Resources

      {self createMap(Map)}
   end

   meth createMap(Map)
      Squares = {MakeTuple squares {Width Map}}
   in
      for Y in {Arity Map} do
	 Squares.Y = {MakeTuple row {Width Map.Y}}

	 for X in {Arity Map.Y} do
	    Squares.Y.X = handle(properties:_ players:_)

	    case Map.Y.X
	    of normal then
	       {self addSquare(X Y @normal black Squares.Y.X)}
	    [] field then
	       {self addSquare(X Y @field black Squares.Y.X)}
	    [] forest then
	       {self addSquare(X Y @forest black Squares.Y.X)}
	    [] quarry then
	       {self addSquare(X Y @quarry black Squares.Y.X)}
	    [] mine then
	       {self addSquare(X Y @mine black Squares.Y.X)}
	    [] home then
	       {self addSquare(X Y black white Squares.Y.X)}
	    else
	       raise 'Unknown map element: ' # Map.Y.X end
	    end
	 end
      end

      squares := Squares
   end

   % X: horizontal location (the minimum is 1, the left)
   % Y: vertical location (the minimum is 1, the top)
   % Handle: to be able to modify the label located at (X,Y)
   meth addSquare(X Y Bg Fg ?Handle)
      {@grid configure(td(label(bg: Bg
				fg: Fg
				width: 5
				height: 1
				handle: Handle.properties)
			  label(bg: Bg
				fg: Fg
				width: 5
				height: 2
				wraplength: 38
				handle: Handle.players))
		       row: 2*Y-1
		       column: 2*X-1)}
   end

   meth setResources(TeamNum Res)
      {@resources.TeamNum set("food: " # Res.food #
			      "  wood: " # Res.wood #
			      "  stone: " # Res.stone #
			      "  steel: " # Res.steel)}
   end

   meth setSquareProperties(X Y Home Tower)
      StrHome
      StrTower
   in
      if Home == none then
	 StrHome = ""
      else
	 StrHome = "H" # {GetTeamID Home.owner} # " "
      end

      if Tower == none then
	 StrTower = ""
      else
	 StrTower = "T" # {GetTeamID Tower.owner}
      end

      {@squares.Y.X.properties set(StrHome # StrTower)}
   end

   % 'Players' is a tuple: for each team, the list of the players
   meth setSquarePlayers(X Y Players)
      proc {CountPlayers List ?NbNormals ?NbWithWeapon}
	 proc {Step List NbNormalsAcc NbWithWeaponAcc}
	    case List
	    of nil then
	       NbNormals = NbNormalsAcc
	       NbWithWeapon = NbWithWeaponAcc
	    [] Player|OtherPlayers then
	       if {IsDet Player.weapon} then
		  {Step OtherPlayers NbNormalsAcc NbWithWeaponAcc+1}
	       else
		  {Step OtherPlayers NbNormalsAcc+1 NbWithWeaponAcc}
	       end
	    end
	 end
      in
	 {Step List 0 0}
      end

      fun {AppendString CurStr StrToAppend}
	 Begin
      in
	 if CurStr == "" then
	    Begin = ""
	 else
	    Begin = CurStr # " "
	 end

	 Begin # StrToAppend
      end

      fun {GetString TeamNum Str}
	 if {Width Players} < TeamNum then
	    Str
	 else
	    NbNormals
	    NbWithWeapon
	    StrNormals
	    StrWithWeapon
	    NewStr
	 in
	    {CountPlayers Players.TeamNum ?NbNormals ?NbWithWeapon}

	    if 0 < NbNormals then
	       StrNormals = NbNormals # {GetTeamID TeamNum}
	    else
	       StrNormals = ""
	    end

	    if 0 < NbWithWeapon then
	       StrWithWeapon = NbWithWeapon # {GetTeamIDWeapon TeamNum}
	    else
	       StrWithWeapon = ""
	    end

	    NewStr = {AppendString StrNormals StrWithWeapon}
	    {GetString TeamNum+1 {AppendString Str NewStr}}
	 end
      end
   in
      {@squares.Y.X.players set({GetString 1 ""})}
   end
end

proc {BindHome UI TeamNum ResStream}
   thread
      for Res in ResStream do
	 {UI setResources(TeamNum Res)}
      end
   end
end

proc {BindSquare UI X Y Stream}
   thread
      for Info in Stream do
	 {UI setSquarePlayers(X Y Info.players)}
	 {UI setSquareProperties(X Y Info.home Info.tower)}
      end
   end
end

% Generate the teams according to the number and locations of the homes in the map.
% Returns a tuple of teams, of the form:
% teams(team(num:1 home:Home homePos:pos(x:1 y:2))
fun {GenerateTeams Map UI}
   NbRows = {Width Map}
   NbCols = {Width Map.1}

   fun {GetNextPos Pos}
      if NbCols =< Pos.x then
	 pos(x:1 y:Pos.y+1)
      else
	 pos(x:Pos.x+1 y:Pos.y)
      end
   end

   fun {TraverseMap Pos Teams NbTeams}
      if NbRows < Pos.y then
	 Teams
      else
	 NextPos = {GetNextPos Pos}
      in
	 if Map.(Pos.y).(Pos.x) == home then
	    Home
	    ResStream
	    TeamNum = NbTeams+1
	    NewTeam = team(num:TeamNum home:Home homePos:Pos)
	 in
	    {CreateHome Home ResStream}
	    {BindHome UI TeamNum ResStream}
	    {TraverseMap NextPos {Tuple.append Teams teams(NewTeam)} NbTeams+1}
	 else
	    {TraverseMap NextPos Teams NbTeams}
	 end
      end
   end
in
   {TraverseMap pos(x:1 y:1) teams() 0}
end

% Get a map from a file

fun {GetMap Filename}
   fun {GetSquareType Char}
      case Char
      of &- then normal
      [] &M then mine
      [] &W then forest
      [] &Q then quarry
      [] &H then home
      [] &F then field
      end
   end

   fun {CreateMap CharsList Map CurRow}
      case CharsList

      % End of the current row
      of Char|NextChars andthen Char == &\n then
	 % Add the current row to the map
	 NewMap = {Tuple.append Map board(CurRow)}
      in
	 {CreateMap NextChars NewMap row()}

      % A square
      [] Char|NextChars then
	 SquareType = {GetSquareType Char}
	 NewRow = {Tuple.append CurRow row(SquareType)}
      in
	 {CreateMap NextChars Map NewRow}

      % End of the map
      [] nil then
	 if 0 < {Width CurRow} then
	    {Tuple.append Map board(CurRow)}
	 else
	    Map
	 end
      end
   end

   File = {New Open.file init(name:Filename flags:[read])}
   CharsList
in
   {File read(list:CharsList size:all)}
   {File close}
   {CreateMap CharsList board() row()}
end

WorkingDir Teams UI NbTeams NbRows NbColumns Squares SquareStreams TeamA TeamB PlayerA PlayerB StaticEnvA BrainA StaticEnvB BrainB Map

in
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% The "main function"

% Create the GUI object
WorkingDir = {OS.getCWD}
Map = {GetMap WorkingDir#'/map.txt'}

Teams = {GenerateTeams Map UI}
NbTeams = {Width Teams}
NbRows = {Width Map}
NbColumns = {Width Map.1}
UI = {NewActive Gui init(Map NbTeams)}

% Create the squares objects
{CreateAllSquares Map Teams ?Squares ?SquareStreams}

% Bind the squares
for RowNum in 1..NbRows do
   for ColNum in 1..NbColumns do
      {BindSquare UI ColNum RowNum SquareStreams.RowNum.ColNum}
   end
end

% Initial towers for each team
for TeamNum in 1..{Width Teams} do
   {BuildInitialTowers Squares Teams.TeamNum}
end

% Player Team A
TeamA = Teams.1
PlayerA = {CreatePlayer TeamA Squares Map StaticEnvA}

StaticEnvA = game(board: Map
		  teams: NbTeams
		  team: TeamA.num
		  goal: GOAL
		  home: TeamA.homePos)

BrainA = {CreateBrain StaticEnvA none}
{Embody PlayerA BrainA none}

% Player Team B
TeamB = Teams.2
PlayerB = {CreatePlayer TeamB Squares Map StaticEnvB}

StaticEnvB = game(board: Map
		  teams: NbTeams
		  team: TeamB.num
		  goal: GOAL
		  home: TeamB.homePos)

BrainB = {CreateBrain StaticEnvB none}
{Embody PlayerB BrainB none}
end