From 281425310c5db21f87981eeb9601a71d1974d98d Mon Sep 17 00:00:00 2001
From: Jed Barber <jjbarber@y7mail.com>
Date: Thu, 10 Apr 2014 05:25:03 +1000
Subject: Rearranging files

---
 src/Thue/Interpreter.hs | 77 +++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 77 insertions(+)
 create mode 100644 src/Thue/Interpreter.hs

(limited to 'src/Thue/Interpreter.hs')

diff --git a/src/Thue/Interpreter.hs b/src/Thue/Interpreter.hs
new file mode 100644
index 0000000..c53bff9
--- /dev/null
+++ b/src/Thue/Interpreter.hs
@@ -0,0 +1,77 @@
+module Thue.Interpreter (
+    thue,
+    extractInfix,
+    nextInRange
+    ) where
+
+
+import System.Random
+import Data.Maybe
+import Data.List
+import Thue.Parser
+
+
+
+
+thue :: ThueProgram -> IO ThueState
+thue program =
+    let rules = thueRules program
+        state = thueInitialState program
+        gen = mkStdGen 4 --chosen by fair dice roll, guaranteed to be random
+
+    in interpret state rules gen
+
+
+
+interpret :: ThueState -> [ThueRule] -> StdGen -> IO ThueState
+interpret state rules gen = do
+    let possibleRules = rules `applicableTo` state
+        ruleToApply = if (possibleRules == []) then (ThueRule "" "") else possibleRules !! num
+        -- ^ dummy rule if no possible rules apply
+
+        (num, gen') = nextInRange 0 (length possibleRules - 1) gen
+
+        (before, after) = fromJust (extractInfix (original ruleToApply) state)
+
+    state' <- case (replacement ruleToApply) of
+                ":::" -> getLine >>= (\x -> return (before ++ x ++ after))
+
+                '~':xs -> putStr xs >> return (before ++ after)
+
+                x -> return (before ++ x ++ after)
+
+    if (possibleRules == []) then return state else interpret state' rules gen'
+
+
+
+extractInfix :: Eq a => [a] -> [a] -> Maybe ([a], [a])
+extractInfix subList list =
+    let f = (\pre cur -> case (stripPrefix subList cur) of
+                            Nothing -> f ((head cur):pre) (tail cur)
+                            Just x -> (reverse pre, x))
+
+    in if (subList `isInfixOf` list) then Just (f [] list) else Nothing
+
+
+
+nextInRange :: Int -> Int -> StdGen -> (Int, StdGen)
+nextInRange low high random =
+    let (genLow, genHigh) = genRange random
+        (rawNext, random') = next random
+
+        irawNext = fromIntegral rawNext
+        igenLow = fromIntegral genLow
+        igenHigh = fromIntegral genHigh
+        ilow = fromIntegral low
+        ihigh = fromIntegral high
+
+        n' = ((irawNext - igenLow) / (igenHigh - igenLow)) * (ihigh - ilow) + ilow
+
+    in (round n', random')
+
+
+
+applicableTo :: [ThueRule] -> ThueState -> [ThueRule]
+applicableTo ruleList state =
+    filter (\r -> (original r) `isInfixOf` state) ruleList
+
-- 
cgit