content: module Rudimentary where
  import Botworld
  import Botworld.Display
  import Control.Monad.Reader (runReader)
  import Data.Map (Map, fromList)
  
  -- Simple programs
  -- Below is a function that allows us to create robots that execute a hardcoded
  -- list of actions using seven registers. (These robots must be run on
  -- a processor that has speed 3 or greater.)
  
  -- Our simple programs use seven registers. These include:
  rPRG = 0  -- Program register (builtin)
  rINP = 1  -- Input register (builtin)
  rOUT = 2  -- Output register (builtin)
  rNIL = 3  -- Nil register (will always be nil)
  rSPN = 4  -- Spin register (holds a program that spins until output is read)
  rCTR = 5  -- Control register (holds the main program while spinning)
  rQUE = 6  -- Queue register (holds the upcoming commands)
  
  -- This helper function that creates a register of exactly the right size for
  -- its contents.
  reg :: Encodable i => i -> Register
  reg i = let t = encode i in R (size t) t
  
  -- This function builds a 7-register machine that hardcodes its commands.
  -- Basically, it holds a list of commands it wants to execute in the QUE
  -- register. The main program deconstructs the QUE register putting the head in
  -- OUT and the rest back in QUE, then loads the SPN program. The SPN program
  -- spins until OUT becomes Nil, then loads the main program back up. Rinse,
  -- repeat.
  hardcode :: [Command] -> Memory
  hardcode [] = []
  hardcode commands = registers where
    registers = [program, input, output, nil, spinner, queuer, queue]
    psize = max (size $ contents queuer) (size $ contents spinner)
    program = R psize (contents spinner)
    spinner = reg [CopyIfNil rOUT rCTR rPRG, CopyIfNil rNIL rSPN rPRG]
    input = R 0 Nil
    outputs = map encode commands
    output = R (maximum $ map size outputs) (head outputs)
    nil = R 0 Nil
    queuer = reg [Deconstruct rQUE rOUT rQUE, CopyIfNil rNIL rSPN rPRG]
    queue = reg $ tail outputs
  
  -- This function is useful when you're debugging a program and want to simulate
  -- that OUT has been read. (Remember that OUT is zeroed after it is read.)
  zeroOUT :: Memory -> Memory
  zeroOUT = alter 2 (forceR Nil)
  
  -- This function runs a memory and assumes that the run succeeds.
  -- (If it fails, the function crashes.)
  unsafeRun :: Int -> Memory -> Memory
  unsafeRun n m = let Right m' = runFor n m in m'
  
  -- This function dumps the contents of a memory IF the memory was created with
  -- the hardcode function above. Otherwise, it crashes.
  unsafeContents :: Memory -> String
  unsafeContents (p:i:o:n:s:c:q:[]) = result where
    result = unlines
      [ "PRG: " ++ show prg
  	, "INP: " ++ show inp
  	, "OUT: " ++ out
  	, "NIL: " ++ show nil
  	, "SPN: " ++ show spn
  	, "CTR: " ++ show ctr
  	, "QUE: " ++ show que
  	]
    Just prg = decode (contents p) :: Maybe [Instruction]
    inp = contents i
    out = maybe (show $ contents o) show (decode (contents o) :: Maybe Command)
    nil = contents n
    Just spn = decode (contents s) :: Maybe [Instruction]
    Just ctr = decode (contents c) :: Maybe [Instruction]
    Just que = decode (contents q) :: Maybe [Command]
  
  -- This function is like the above function, but it prints the contents of the
  -- memory to IO (instead of just turning it into a string).
  unsafeCheck :: Memory -> IO ()
  unsafeCheck = putStr . unsafeContents
  
  -- World building
  
  -- Adds a robot to a square.
  addRobot :: Robot -> Maybe Square -> Maybe Square
  addRobot r = fmap (\(Square rs is) -> Square (r:rs) is)
  
  
  -- Example game:
  
  -- Only cargo is valued.
  simpleValuer :: Item -> Int
  simpleValuer (Cargo v _) = v
  simpleValuer _ = 0
  
  -- There is only one player, Player 1. Their home square is top-left.
  players :: Map String Player
  players = fromList [("Player 1", Player standardValuer (0, 0))]
  
  -- These are the cargos in the initial world.
  sampleCargoes :: [[Item]]
  sampleCargoes =
    [ [Cargo 2 3, Cargo  1 2, Cargo 1 2, Cargo 9 1, Cargo 1 1]
    , [Cargo 3 3, Cargo  3 3, Cargo 9 3, Cargo 6 1, Cargo 5 2]
    , [Cargo 2 2, Cargo 10 1, Cargo 3 3, Cargo 9 3, Cargo 4 2]
    , [Cargo 1 2, Cargo  6 3, Cargo 2 3, Cargo 1 2, Cargo 3 2]
    , [Cargo 5 2, Cargo  6 1, Cargo 6 1, Cargo 8 2, Cargo 1 3]
    ]
  
  uninhabitedWorld :: Botworld
  uninhabitedWorld = generate (5, 5) gen where
    gen (x, y) = Just $ Square [] [sampleCargoes !! y !! x]
  
  -- The lifter robot tries to lift a few boxes and then return to the home
  -- square.
  lifter :: Robot
  lifter = Robot (F Red 10) [] (P 10) $ hardcode
    [Lift 0, Move S, Lift 0, Move E, Move S, Lift 0 , Move N, Move NW, Pass]
  
  -- The aggressor tries to destroy the lifter.
  aggressor :: Robot
  aggressor = Robot (F Green 200) [] (P 10) $ hardcode
    [Pass, Pass, Destroy 1, Build [0..12] $ hardcode [Move W]]
  
  -- The overwriter tries to rebuild the aggressor into a nicer robot (that walks
  -- away).
  overwriter :: Robot
  overwriter = Robot (F Blue 0) [] (P 10) $ hardcode
    [Move N, Destroy 0, Build [1..9] $ hardcode [Move S, Move S]]
  
  -- Here is a world with all three robots.
  populatedWorld :: Botworld
  populatedWorld =
    change (addRobot lifter) (0, 0) $
    change (addRobot aggressor) (0, 1) $
    change (addRobot overwriter) (0, 2)
    uninhabitedWorld
  
  -- This infinite list contains all updates of the initial world. (We'll look at
  -- the first ten or so.)
  evolution :: [Botworld]
  evolution = iterate update populatedWorld
  
  -- When run, this file prints out the initial state, the final state, and
  -- a scoreboard.
  main :: IO ()
  main = do
    let initialWorld = head evolution
    displayBotworld players initialWorld
    mapM_ (displayEventGrid players . runEnvironment) (take 9 evolution)
    let finalWorld = evolution !! 10
    displayBotworld players finalWorld
    putStrLn ""
    displayScoreboard players finalWorld
  