diff --git a/index.html b/index.html
index cbbd272..dbf6964 100644
--- a/index.html
+++ b/index.html
@@ -21,7 +21,7 @@ define nix(x, y, width, height) {
call line (x, y, x + width, y + height);
call line (x + width, y, x, y + height);
};
-call nix(0, 0, 5, 10);
+call nix(0, 0, 20, 20);
`
var container = document.getElementById("elm-container");
var app = Elm.Main.init({
diff --git a/minilogo.scss b/minilogo.scss
index c958757..eeee771 100644
--- a/minilogo.scss
+++ b/minilogo.scss
@@ -31,8 +31,22 @@ textarea {
font-family: "Source Code Pro", monospace;
}
-textarea, canvas {
+.centered {
+ max-width: 500px;
display: block;
margin: auto;
+}
+
+.shadow {
box-shadow: $default-shadow;
}
+
+.error {
+ padding: 10px;
+ color: white;
+ background-color: tomato;
+ border-radius: 2px;
+ box-sizing: border-box;
+ margin-top: 10px;
+ margin-bottom: 10px;
+}
diff --git a/src/Main.elm b/src/Main.elm
index 0fcda08..f1d45df 100644
--- a/src/Main.elm
+++ b/src/Main.elm
@@ -1,10 +1,10 @@
-import Html exposing (Html, div, text, textarea, h1, h2)
-import Html.Attributes exposing (class)
+import Html exposing (Html, div, text, textarea, h1, h2, p)
+import Html.Attributes exposing (class, classList)
import Html.Events exposing (onInput)
import Browser exposing (element)
import Canvas exposing (Shape)
import Dict exposing (Dict)
-import Parser exposing (Parser, (|.), (|=), variable, succeed, symbol, int, spaces, map, oneOf, lazy, sequence, Trailing(..), keyword, run, backtrackable)
+import Parser exposing (Parser, Problem(..), DeadEnd, (|.), (|=), variable, succeed, symbol, int, spaces, map, oneOf, lazy, sequence, Trailing(..), keyword, run, backtrackable)
import Color
import Canvas exposing (Point, path, lineTo, circle, shapes, stroke, lineWidth, fill, rect)
import Set
@@ -36,6 +36,7 @@ type alias State =
{ penMode : LogoPenMode
, pos : Coord
, scope : Scope
+ , board : Board
}
type alias Step a = State -> Result String (a, State)
@@ -195,6 +196,7 @@ initialState =
{ penMode = Up
, pos = (0, 0)
, scope = initialScope
+ , board = []
}
unit : a -> Step a
@@ -208,14 +210,14 @@ bind sa f state = case sa state of
rbind : (a -> Step b) -> Step a -> Step b
rbind f sa = bind sa f
-updatePosition : Coord -> Board -> Step Board
-updatePosition c b state =
+updatePosition : Coord -> Step ()
+updatePosition c state =
let
newBoard = case state.penMode of
- Up -> b
- Down -> (state.pos, c)::b
+ Up -> state.board
+ Down -> (state.pos, c)::state.board
in
- Ok (newBoard, { state | pos = c })
+ Ok ((), { state | pos = c, board = newBoard })
registerFunction : String -> Function -> Step ()
registerFunction s f state = Ok ((), { state | scope = setScopeFunction s f state.scope })
@@ -265,21 +267,20 @@ zip la lb = case (la, lb) of
(a::lat, b::lbt) -> (a, b)::zip lat lbt
_ -> []
-evaluateCmd : LogoCmd -> Board -> Step Board
-evaluateCmd c b = case c of
- Move l r -> evaluateExp l |> rbind (\x -> evaluateExp r |> rbind (\y -> updatePosition (x, y) b))
- Define n xs prg -> registerFunction n (xs, prg) |> rbind (\_ -> unit b)
- Pen mode -> setPenMode mode |> rbind (\_ -> unit b)
+evaluateCmd : LogoCmd -> Step ()
+evaluateCmd c = case c of
+ Move l r -> evaluateExp l |> rbind (\x -> evaluateExp r |> rbind (\y -> updatePosition (x, y)))
+ Define n xs prg -> registerFunction n (xs, prg)
+ Pen mode -> setPenMode mode
Call n args -> lookupFunction n
|> rbind (\(ns, prg) -> evaluateAllExps args
|> rbind (\vs -> upScope
|> rbind (\_ -> registerAllVariables (zip ns vs)
- |> rbind (\_ -> evaluateAll prg b
- |> rbind (\nb -> downScope
- |> rbind (\_ -> unit nb))))))
+ |> rbind (\_ -> evaluateAll prg
+ |> rbind (\_ -> downScope)))))
-evaluateAll : LogoProg -> Board -> Step Board
-evaluateAll prg board = List.foldl rbind (unit board) <| List.map evaluateCmd prg
+evaluateAll : LogoProg -> Step ()
+evaluateAll prg = List.foldl rbind (unit ()) <| List.map (\c _ -> evaluateCmd c) prg
{-
======= Drawing Stuff =====
@@ -293,15 +294,45 @@ lineShape (c1, c2) = path (transformCoord c1) [ lineTo (transformCoord c2) ]
pointerShape : Coord -> Shape
pointerShape c = circle (transformCoord c) 5
-allShapes : (Board, State) -> List Shape
-allShapes (b, s) = pointerShape s.pos :: List.map lineShape b
+allShapes : State -> List Shape
+allShapes s = pointerShape s.pos :: List.map lineShape s.board
-canvas : (Board, State) -> Html Msg
-canvas dat = Canvas.toHtml (500, 500) []
+canvas : State -> Html Msg
+canvas state = Canvas.toHtml (500, 500) [ classList [ ("centered", True), ("shadow", True) ] ]
[ shapes [ fill Color.white ] [ rect (0, 0) 500 500 ]
- , shapes [ stroke Color.blue, lineWidth 5] (allShapes dat)
+ , shapes [ stroke Color.blue, lineWidth 5] (allShapes state)
]
+{-
+===== Rendering Stuff
+-}
+
+humanProblemString : Problem -> String
+humanProblemString p = case p of
+ Expecting s -> "Expecting " ++ s
+ ExpectingInt -> "Expecting decimal integer"
+ ExpectingHex -> "Expecting hexadecimal integer"
+ ExpectingOctal -> "Expecting octal integer"
+ ExpectingBinary -> "Expecting binary integer"
+ ExpectingFloat -> "Expecting a floating pointer number"
+ ExpectingNumber -> "Expecting a number"
+ ExpectingVariable -> "Expected variable name"
+ ExpectingSymbol s -> "Expected symbol \"" ++ s ++ "\""
+ ExpectingKeyword s -> "Expecting keyword " ++ s
+ ExpectingEnd -> "Expecting end of string"
+ UnexpectedChar -> "Unexpected character"
+ Problem s -> s
+ BadRepeat -> "Bad repetition"
+
+humanDeadEndString : DeadEnd -> String
+humanDeadEndString { row, col, problem } =
+ "An parse error occured on line "
+ ++ String.fromInt row
+ ++ ": " ++ humanProblemString problem
+
+humanParseError : List DeadEnd -> String
+humanParseError = Maybe.withDefault "" << Maybe.map humanDeadEndString << List.head
+
{-
======= Elm Architecture =======
-}
@@ -319,15 +350,22 @@ init fs =
view : Model -> Html Msg
view m =
let
- dat = Result.withDefault ([], initialState)
- <| Result.withDefault (Err "Couldn't parse program")
- <| Result.map (\prg -> evaluateAll prg [] initialState) (run parseProg m.programText)
+ evalResult = Result.map (\(_, s) -> s)
+ <| Result.andThen (\prg -> evaluateAll prg initialState)
+ <| Result.mapError humanParseError (run parseProg m.programText)
+ toRender = Result.withDefault initialState evalResult
+ error = case evalResult of
+ Err e -> [ p [ classList [ ("centered", True), ("error", True), ("shadow", True) ] ] [ text e ] ]
+ Ok _ -> []
in
div []
[ h1 [] [ text "MiniLogo Functional Evaluator" ]
, div [ class "logo-container" ]
- [ div [ class "logo-pane" ] [ h2 [] [ text "MiniLogo" ], textarea [ onInput UpdateText ] [ text m.programText ] ]
- , div [ class "logo-pane" ] [ h2 [] [ text "Output" ], canvas dat ]
+ [ div [ class "logo-pane" ] <|
+ [ h2 [] [ text "MiniLogo" ]
+ , textarea [ onInput UpdateText, classList [ ("centered", True), ("shadow", True) ] ] [ text m.programText ]
+ ] ++ error
+ , div [ class "logo-pane" ] [ h2 [] [ text "Output" ], canvas toRender ]
]
]