Completed puzzle
[synacor-challenge.git] / src / Main.hs
index be6e522cf64b1980bab72cb877512a8f37a44f72..101714e0bae87028fab082b2e55f4cbd4ca45f01 100644 (file)
@@ -1,19 +1,19 @@
 import SynacorEngine
 
-import Debug.Trace
+-- import Debug.Trace
 
-import Numeric
+-- import Numeric
 import System.IO
 import Data.Char
 import Data.List
 import qualified Data.Map.Strict as M
-import Data.Map.Strict ((!))
+-- import Data.Map.Strict ((!))
 import Control.Lens -- hiding ((<|), (|>), (:>), (:<), indices)
 
-import Control.Monad.State.Strict
-import Control.Monad.Reader
-import Control.Monad.Writer
-import Control.Monad.RWS.Strict
+import Control.Monad.State.Strict hiding (state)
+-- import Control.Monad.Reader
+-- import Control.Monad.Writer
+-- import Control.Monad.RWS.Strict hiding (state)
 
 -- import Data.Bits
 import Data.Word
@@ -69,6 +69,7 @@ main =
       -- print state1
 
       stateF <- adventureHarness state1
+      print stateF
       return ()
       -- print $ stateF ^. ssInputs
       -- print $ stateF ^. ssOutputs
@@ -98,17 +99,17 @@ adventureHarness state =
   do command <- prompt "> "
      state' <- handleCommand command state
      let traceAndOutput = head $ state' ^. ssOutputs
-     let (newOutput, tracing) = spliceOut traceAndOutput
+     let (newOutput, traces) = spliceOut traceAndOutput
      putStrLn newOutput
      when (state' ^. ssTracing)
-          (appendFile (state' ^. ssDumpFile) $ unlines tracing)
+          (appendFile (state' ^. ssDumpFile) $ unlines traces)
      if (state' ^. ssContinue) 
         then (adventureHarness state')
         else return state'
 
 
 spliceOut :: String -> (String, [String])
-spliceOut s = doingOut s "" []
+spliceOut st = doingOut st "" []
   where doingOut s out traces
           | null s = (reverse out, reverse traces)
           | ">> " `isPrefixOf` s = doingTrace (drop 3 s) out traces ""
@@ -125,7 +126,7 @@ handleCommand ":save" state =
       let inputs = unlines $ tail $ reverse $ state ^. ssInputs
       writeFile filename inputs
       return $ state & ssUnsaved .~ True
-handleCommand ":load" state = 
+handleCommand ":load" _state = 
   do  filename <- prompt "From? "
       machineInput <- readFile filename
       let inputs = lines machineInput
@@ -157,7 +158,11 @@ handleCommand ":untrace" state =
 handleCommand ":poke8"  state =
   do let machines = state ^. ssMachines
      let machine = head machines
-     let machine' = machine & registers . ix 7 .~ 1
+     let machine' = machine & registers . ix 7 .~ 25734
+                            & memory . ix 5489 .~ 21
+                            & memory . ix 5490 .~ 21
+                            & memory . ix 5495 .~ 7
+     -- let machine' = machine & memory . ix 5451 .~ 7
      return $ state & ssMachines .~ (machine' : (tail machines)) 
 handleCommand command state = return $ runOneInput state command
 
@@ -173,6 +178,14 @@ runWithoutInput state = state & ssMachines %~ (machine' :)
         (exState, machine', output) = runMachine [] (machine & inputIndex .~ 0)
 
 runOneInput :: SynacorState -> String -> SynacorState
+runOneInput state ":poke8" = state & ssMachines .~ ssMAchinesNew
+  where machine0 = head $ state ^. ssMachines
+        machine = machine0 & registers . ix 7 .~ 25734
+                           & memory . ix 5489 .~ 21
+                           & memory . ix 5490 .~ 21
+                           & memory . ix 5495 .~ 7
+        ssMAchinesNew = machine : (tail $ state ^. ssMachines)
+
 runOneInput state input = state & ssMachines %~ (machine' :)
                                 & ssInputs %~ (input :)
                                 & ssOutputs %~ ((showOutput output) :)