X-Git-Url: https://git.njae.me.uk/?a=blobdiff_plain;f=src%2FMain.hs;h=101714e0bae87028fab082b2e55f4cbd4ca45f01;hb=3836f842a8794a2d25cc5f8558d70becae8b7396;hp=0c9ceea89dc24a1b597f6cc964f8eacbe9d86a43;hpb=133559acebf7fdefd20a0653833311ea1a6f8811;p=synacor-challenge.git

diff --git a/src/Main.hs b/src/Main.hs
index 0c9ceea..101714e 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -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
@@ -28,6 +28,8 @@ data SynacorState = SynacorState
   , _ssContinue :: Bool
   , _ssUnsaved :: Bool
   , _ssState :: [ExecutionState]
+  , _ssTracing :: Bool
+  , _ssDumpFile :: String
   } deriving (Ord, Eq)
 makeLenses ''SynacorState
 
@@ -42,6 +44,8 @@ instance Show SynacorState
             , "conts " ++ (show $ state ^. ssContinue)
             , "unsaved " ++ (show $ state ^. ssUnsaved)
             , "states " ++ (show $ state ^. ssState)
+            , "tracing " ++ (show $ state ^. ssTracing) 
+            , "dumping to " ++ (state ^. ssDumpFile)
             ]
 
 main :: IO ()
@@ -65,6 +69,7 @@ main =
       -- print state1
 
       stateF <- adventureHarness state1
+      print stateF
       return ()
       -- print $ stateF ^. ssInputs
       -- print $ stateF ^. ssOutputs
@@ -77,19 +82,43 @@ emptyState :: IO SynacorState
 emptyState = 
   do  mem <- getMemory
       let machine = makeMachine mem
-      return $ SynacorState [machine] [] [] True False [Runnable]
+      return $ SynacorState 
+                { _ssMachines = [machine]
+                , _ssInputs = []
+                , _ssOutputs = []
+                , _ssContinue = True
+                , _ssUnsaved = False
+                , _ssState = [Runnable]
+                , _ssTracing = False
+                , _ssDumpFile = ""
+              }
+     -- [machine] [] [] True False [Runnable]
 
 adventureHarness :: SynacorState -> IO SynacorState
 adventureHarness state =
   do command <- prompt "> "
      state' <- handleCommand command state
-     let newOutput = head $ state' ^. ssOutputs
+     let traceAndOutput = head $ state' ^. ssOutputs
+     let (newOutput, traces) = spliceOut traceAndOutput
      putStrLn newOutput
+     when (state' ^. ssTracing)
+          (appendFile (state' ^. ssDumpFile) $ unlines traces)
      if (state' ^. ssContinue) 
         then (adventureHarness state')
         else return state'
 
 
+spliceOut :: String -> (String, [String])
+spliceOut st = doingOut st "" []
+  where doingOut s out traces
+          | null s = (reverse out, reverse traces)
+          | ">> " `isPrefixOf` s = doingTrace (drop 3 s) out traces ""
+          | otherwise = doingOut (tail s) (head s : out) traces
+        doingTrace s out traces tr
+          | "<<" `isPrefixOf` s = doingOut (drop 2 s) out (reverse tr : traces)
+          | otherwise = doingTrace (tail s) out traces (head s : tr)
+
+
 handleCommand :: String -> SynacorState -> IO SynacorState
 handleCommand ":quit" state = return $ state & ssContinue .~ False
 handleCommand ":save" state = 
@@ -97,12 +126,12 @@ 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
       initialState <- emptyState
-      let nonComments = filter (\i -> head i == '#') inputs
+      let nonComments = filter (\i -> head i /= '#') inputs
       let state = foldl' runOneInput initialState ("" : nonComments)
       return $ state & ssUnsaved .~ False
 handleCommand ":undo" state =
@@ -121,6 +150,20 @@ handleCommand ":recap" state =
            putStrLn o
         )
      return state
+handleCommand ":trace" state = 
+  do  filename <- prompt "Dump to? "
+      return $ state & ssTracing .~ True & ssDumpFile .~ filename
+handleCommand ":untrace" state = 
+  return $ state & ssTracing .~ False & ssDumpFile .~ ""
+handleCommand ":poke8"  state =
+  do let machines = state ^. ssMachines
+     let machine = head machines
+     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
 
 
@@ -135,13 +178,24 @@ 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) :)
                                 & ssContinue .~ True
                                 & ssUnsaved .~ True
                                 & ssState %~ (exState :)
-  where machine = head $ state ^. ssMachines
+  where machine0 = head $ state ^. ssMachines
+        machine = if (state ^. ssTracing)
+                     then machine0 & tracing .~ True
+                     else machine0 & tracing .~ False
         inputW = wordify (input ++ "\n")
         (exState, machine', output) = runMachine inputW (machine & inputIndex .~ 0)
         -- output' = trace ("runone " ++ (show (machine == machine')) ++ " " ++ (show exState) ++ " " ++ (showOutput output)) output