Dependency injection for getCh, putCh, so IO can work in browser.
Chris Pressey
1 year, 10 months ago
3 | 3 | |
4 | 4 | if command -v ghc >/dev/null 2>&1; then |
5 | 5 | echo "building $PROG.exe with ghc" |
6 | (cd src && ghc --make Main.hs -o ../bin/$PROG.exe) | |
6 | (cd src && ghc --make Main.hs -o ../bin/$PROG.exe) || exit 1 | |
7 | 7 | else |
8 | 8 | echo "ghc not found, not building $PROG.exe" |
9 | 9 | fi |
0 | function launch(config) { | |
1 | config.container.innerHTML = ` | |
2 | <textarea id="prog" rows="10" cols="80"></textarea> | |
3 | <div id="control-panel"></div> | |
4 | <div>Input: <input id="prog-input"></input></div> | |
5 | <div>Output: <pre id="prog-output"></pre></div> | |
6 | <div><button id="run-button">Run</button></div> | |
7 | <pre id="result"></pre> | |
8 | `; | |
9 | ||
10 | function makeSelect(container, labelText, optionsArray, fun) { | |
11 | var label = document.createElement('label'); | |
12 | label.innerHTML = labelText; | |
13 | container.appendChild(label); | |
14 | var select = document.createElement("select"); | |
15 | for (var i = 0; i < optionsArray.length; i++) { | |
16 | var op = document.createElement("option"); | |
17 | op.text = optionsArray[i].filename; | |
18 | op.value = optionsArray[i].contents; | |
19 | select.options.add(op); | |
20 | } | |
21 | select.onchange = function(e) { | |
22 | fun(optionsArray[select.selectedIndex]); | |
23 | }; | |
24 | select.selectedIndex = 0; | |
25 | label.appendChild(select); | |
26 | return select; | |
27 | }; | |
28 | ||
29 | function selectOptionByText(selectElem, text) { | |
30 | var optElem; | |
31 | for (var i = 0; optElem = selectElem.options[i]; i++) { | |
32 | if (optElem.text === text) { | |
33 | selectElem.selectedIndex = i; | |
34 | selectElem.dispatchEvent(new Event('change')); | |
35 | return; | |
36 | } | |
37 | } | |
38 | } | |
39 | ||
40 | var controlPanel = document.getElementById('control-panel'); | |
41 | var select = makeSelect(controlPanel, "example program:", examplePrograms, function(option) { | |
42 | document.getElementById('prog').value = option.contents; | |
43 | }); | |
44 | selectOptionByText(select, config.initialOption); | |
45 | } |
11 | 11 | <div id="installation"></div> |
12 | 12 | |
13 | 13 | <script src="../../../eg/index.js"></script> |
14 | <script src="hastec-launcher.js"></script> | |
14 | <script src="hastec-io-launcher.js"></script> | |
15 | 15 | <script src="zowie-hs.js"></script> |
16 | 16 | <script> |
17 | 17 | launch({ |
0 | {-# LANGUAGE OverloadedStrings #-} | |
1 | ||
0 | 2 | module Main where |
1 | 3 | |
2 | 4 | import Haste.DOM (withElems, getValue, setProp) |
3 | 5 | import Haste.Events (onEvent, MouseEvent(Click)) |
6 | import Haste.Foreign (ffi) | |
4 | 7 | |
5 | 8 | import qualified Language.ZOWIE.Parser as Parser |
6 | 9 | import qualified Language.ZOWIE.Machine as Machine |
7 | 10 | |
11 | ||
12 | getCh :: IO Char | |
13 | getCh = ffi "(function() {var i=document.getElementById('prog-input'); var s=i.value; i.value=s.substring(1); return s.charCodeAt(0);})" | |
14 | ||
15 | putCh :: Char -> IO () | |
16 | putCh = ffi "(function(c) {var o=document.getElementById('prog-output'); o.textContent += String.fromCharCode(c);})" | |
17 | ||
18 | clearOutput :: IO () | |
19 | clearOutput = ffi "(function(c) {var o=document.getElementById('prog-output'); o.textContent = '';})" | |
8 | 20 | |
9 | 21 | main = withElems ["prog", "result", "run-button"] driver |
10 | 22 | |
11 | 23 | driver [progElem, resultElem, runButtonElem] = |
12 | 24 | onEvent runButtonElem Click $ \_ -> do |
13 | 25 | Just text <- getValue progElem |
26 | clearOutput | |
14 | 27 | case Parser.parseZOWIE text of |
15 | 28 | Right prog -> do |
16 | result <- Machine.loadAndRun prog | |
17 | setProp resultElem "textContent" $ show result | |
29 | Machine.loadAndRunWithIO (getCh) (putCh) prog | |
30 | setProp resultElem "textContent" $ "ok" | |
18 | 31 | Left error -> |
19 | setProp resultElem "textContent" $ show error | |
32 | setProp resultElem "textContent" $ show error |
53 | 53 | return state |
54 | 54 | |
55 | 55 | loadAndRun prog = run (initState prog) |
56 | ||
57 | loadAndRunWithIO getCh putCh prog = run (initState prog){ getCh=getCh, putCh=putCh } |
0 | 0 | module Language.ZOWIE.Registers where |
1 | 1 | |
2 | import Data.Char (chr) | |
2 | import Data.Char (chr, ord) | |
3 | 3 | |
4 | 4 | import Language.ZOWIE.State |
5 | 5 | |
29 | 29 | readAddr state@State{ mem=mem } addr = |
30 | 30 | case mapRegister addr of |
31 | 31 | TtyRegister -> do |
32 | i <- readLn | |
33 | return i | |
32 | i <- getCh state | |
33 | return $ fromIntegral $ ord i | |
34 | 34 | BeginTransactionRegister -> return 1 |
35 | 35 | CommitRegister -> return 2 |
36 | 36 | CommitAndRepeatRegister -> return 3 |
44 | 44 | writeAddr state@State{ mem=mem } addr payload = |
45 | 45 | case mapRegister addr of |
46 | 46 | TtyRegister -> do |
47 | putChar $ chr $ fromIntegral payload | |
47 | putCh state $ chr $ fromIntegral payload | |
48 | 48 | return state |
49 | 49 | BeginTransactionRegister -> |
50 | 50 | return $ beginTransaction state |
19 | 19 | pc :: Addr, |
20 | 20 | mem :: Memory, |
21 | 21 | prog :: [Instruction], |
22 | saved :: Maybe State | |
23 | } deriving (Show, Ord, Eq) | |
22 | saved :: Maybe State, | |
23 | getCh :: IO Char, | |
24 | putCh :: Char -> IO () | |
25 | } | |
24 | 26 | |
25 | 27 | |
26 | 28 | initState :: [Instruction] -> State |
29 | 31 | pc=0, |
30 | 32 | mem=Map.empty, |
31 | 33 | prog=prog, |
32 | saved=Nothing | |
34 | saved=Nothing, | |
35 | getCh=getChar, | |
36 | putCh=putChar | |
33 | 37 | } |
34 | 38 | |
35 | 39 | readMem mem addr = Map.findWithDefault 0 addr mem |