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
, _ssContinue :: Bool
, _ssUnsaved :: Bool
, _ssState :: [ExecutionState]
+ , _ssTracing :: Bool
+ , _ssDumpFile :: String
} deriving (Ord, Eq)
makeLenses ''SynacorState
, "conts " ++ (show $ state ^. ssContinue)
, "unsaved " ++ (show $ state ^. ssUnsaved)
, "states " ++ (show $ state ^. ssState)
+ , "tracing " ++ (show $ state ^. ssTracing)
+ , "dumping to " ++ (state ^. ssDumpFile)
]
main :: IO ()
-- print state1
stateF <- adventureHarness state1
+ print stateF
return ()
-- print $ stateF ^. ssInputs
-- print $ stateF ^. ssOutputs
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 =
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 =
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
(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