feat(client): a text input which allows you to type in expressions yo…

…u want to render

.vscode/settings.json

@@ -2,15 +2,18 @@
   "cSpell.words": [
     "Lunarflow",
     "codegen",
+    "compat",
     "corefn",
     "dhall",
     "esbuild",
     "hacky",
+    "idrc",
     "outdir",
     "pcss",
     "peaceiris",
     "pnpm",
     "postbuild",
+    "preact",
     "purescript",
     "purs",
     "spago",

jsconfig.json

@@ -0,0 +1,11 @@
+{
+  "compilerOptions": {
+    "baseUrl": ".",
+    "paths": {
+      "react": ["node_modules/preact/compat"],
+      "react-dom": ["node_modules/preact/compat"],
+      // NOTE: this doesn't work, but I don't use it anyways so idrc
+      "react-dom/server": ["node_modules/preact/compat"]
+    }
+  }
+}

package.json

@@ -7,7 +7,7 @@
     "dev": "pnpm run prepare-build && concurrently -k -c cyan nodemon \"nodemon --config nodemon.css.json\" \"pnpm run watch\"",
     "build": "pnpm run prepare-build && pnpm run bundle:purescript && pnpm run dce && pnpm run bundle:js && cross-env NODE_ENV='production' pnpm run build:css",
     "postbuild": "cp dist/index.html dist/404.html",
-    "build:js": "esbuild --outdir=dist public/entry.js --bundle",
+    "build:js": "esbuild --outdir=dist public/entry.js --bundle --loader:.js=jsx",
     "bundle:js": "pnpm run build:js -- --minify --define:production=true",
     "build:css": "postcss public/styles/index.pcss -o dist/index.css",
     "bundle:purescript": "spago build --purs-args '--codegen corefn'",
@@ -37,7 +37,8 @@
   "dependencies": {
     "@thi.ng/geom": "^1.13.0",
     "@thi.ng/hiccup-canvas": "^1.1.10",
-    "@thi.ng/vectors": "^4.7.0"
+    "@thi.ng/vectors": "^4.7.0",
+    "preact": "^10.5.5"
   },
   "sideEffects": false
 }

packages/client/spago.dhall

@@ -23,6 +23,8 @@
   , "matryoshka"
   , "undefined-is-not-a-problem"
   , "refs"
+  , "concur-core"
+  , "concur-react"
   , "lunarflow-utils"
   , "lunarflow-core"
   , "lunarflow-geometry"

packages/client/src/Main.purs

@@ -1,23 +1,38 @@
 module Main where
 
-import Prelude
+import Concur.Core (Widget)
+import Concur.React (HTML)
+import Concur.React.DOM as D
+import Concur.React.Props as P
+import Concur.React.Run (runWidgetInDom)
+import Concur.React.Widgets (textInputWithButton)
+import Control.MultiAlternative (orr)
+import Control.Plus (empty)
+import Data.Bifunctor (lmap)
 import Data.Either (Either(..))
+import Data.Generic.Rep (class Generic)
+import Data.Generic.Rep.Show (genericShow)
 import Data.Maybe (Maybe(..))
 import Data.Nullable as Nullable
 import Effect (Effect)
+import Effect.Class (liftEffect)
 import Effect.Console as Console
 import Effect.Ref as Ref
-import Graphics.Canvas (CanvasElement, Context2D, getCanvasElementById, getContext2D)
+import Graphics.Canvas (CanvasElement, Context2D, getCanvasElementById, getContext2D, restore, save)
 import Lunarflow.Ast (call, withDebrujinIndices)
 import Lunarflow.Ast.Grouped (groupExpression)
 import Lunarflow.Examples (exp, mult, n, plus', zero')
 import Lunarflow.Geometry.Foreign (Geometry, boundsImpl, fromShape, renderGeometry)
-import Lunarflow.Layout (addIndices, runLayoutM, unscopeLayout)
+import Lunarflow.Layout (LayoutError, addIndices, runLayoutM, unscopeLayout)
+import Lunarflow.Parser (parseLambdaCalculus)
+import Lunarflow.Pipe ((|>))
 import Lunarflow.Profile (profileApplication)
 import Lunarflow.Render (render, runRenderM)
 import Lunarflow.Renderer.Canvas (fillScreen, fitIntoBounds, onResize)
 import Lunarflow.Renderer.WithHeight (withHeights)
 import Partial.Unsafe (unsafeCrashWith)
+import Prelude (class Show, Unit, bind, discard, map, pure, show, unit, ($), (<<<))
+import Text.Parsing.Parser (ParseError)
 
 geometryBenchmarks :: Effect Geometry
 geometryBenchmarks =
@@ -37,19 +52,7 @@ geometryBenchmarks =
             <<< addIndices
         )
     $ profileApplication "Grouping expression" groupExpression
-    -- $ map
-
-    --     ( \a ->
-
-    --         trace (printDeBrujin a) \_ ->
-
-    --           a
-
-    --     )
-
     $ profileApplication "Adding de-brujin indices" withDebrujinIndices
-    -- $ profileApplication "Parsing" unsafeParseLambdaCalculus """\f .(\x. x x)  (\x. f (x x))"""
-
     -- $ profileApplication "Parsing" unsafeParseLambdaCalculus """\n s z. n (\g h. h (g s)) (\u. z) (\u. u)"""
 
     $ call unit (call unit plus' (n 3))
@@ -59,14 +62,72 @@ geometryBenchmarks =
             )
         )
 
+data Error
+  = ParsingError ParseError
+  | LayoutCreationError LayoutError
+
+derive instance genericError :: Generic Error _
+
+instance showError :: Show Error where
+  show = genericShow
+
+mkGeometry :: String -> Either Error Geometry
+mkGeometry text = do
+  rawExpression <- lmap ParsingError $ parseLambdaCalculus text
+  layout <-
+    rawExpression
+      |> withDebrujinIndices
+      |> groupExpression
+      |> addIndices
+      |> unscopeLayout
+      |> runLayoutM
+      |> lmap LayoutCreationError
+  layout
+    |> withHeights
+    |> render
+    |> runRenderM
+    |> fromShape
+    |> pure
+
 app :: Ref.Ref Geometry -> CanvasElement -> Context2D -> Effect Unit
 app ref canvas ctx = do
   fillScreen canvas
+  save ctx
   geometry <- Ref.read ref
   case Nullable.toMaybe (boundsImpl geometry) of
     Just bounds -> fitIntoBounds bounds ctx
     Nothing -> pure unit
   renderGeometry geometry ctx
+  restore ctx
+
+type State
+  = { error :: Maybe String
+    , value :: String
+    }
+
+type Input
+  = { ref :: Ref.Ref Geometry
+    , render :: Effect Unit
+    }
+
+textBox :: forall a. Input -> State -> Widget HTML a
+textBox input { value, error } = do
+  text <-
+    orr
+      [ textInputWithButton value "Render" [ P._id "input" ] []
+      , case error of
+          Just error' -> D.p [ P._id "error" ] [ D.text error' ]
+          Nothing -> empty
+      ]
+  let
+    geometry = mkGeometry text
+  state <- case geometry of
+    Left error' -> pure { error: Just $ show error', value: text }
+    Right geometry' -> do
+      liftEffect $ Ref.write geometry' input.ref
+      liftEffect input.render
+      pure { error: Nothing, value: text }
+  textBox input state
 
 main :: Effect Unit
 main = do
@@ -81,3 +142,8 @@ main = do
         runApp = app ref canvas ctx
       onResize runApp
       runApp
+      runWidgetInDom "root"
+        $ textBox { ref, render: runApp }
+            { value: """\f a b. f b a"""
+            , error: Nothing
+            }

packages/client/src/Render.purs

@@ -61,7 +61,6 @@ render (Tuple layout rootMeasures) =
     |> cata algebra
     |> local (_ { slices = [ rootMeasures ] })
     |> map ((\{ shapes, overlays } -> shapes <> overlays) >>> Shape.fromFoldable)
-    |> map (Shape.Translate (vec2 5 10))
   where
   algebra :: Algebra YLayoutF (RenderM RenderList)
   algebra (Lambda data'@{ args, heights, position } body) = do

packages/client/src/Renderer/Canvas.js

@@ -8,22 +8,23 @@ exports.onResize = (e) => () => {
 }
 
 exports.fitIntoBounds = (bounds) => (ctx) => () => {
-  ctx.translate(bounds.x, bounds.y)
+  // ctx.translate(-bounds.x, -bounds.y)
 
-  const xScale = bounds.width / ctx.canvas.width
-  const yScale = bounds.height / ctx.canvas.height
+  const diff = 50
+  const xScale = (bounds.width + diff) / ctx.canvas.width
+  const yScale = (bounds.height + diff) / ctx.canvas.height
   const max = Math.max(xScale, yScale)
 
   const scale = 1 / max
 
   ctx.scale(scale, scale)
 
   if (xScale > yScale) {
-    const extra = ctx.canvas.height * max - bounds.height
+    const extra = ctx.canvas.height * max - bounds.height - diff
 
-    ctx.translate(0, extra / 2)
+    // ctx.translate(0, extra / 2)
   } else {
-    const extra = ctx.canvas.width * max - bounds.width
+    const extra = ctx.canvas.width * max - bounds.width - diff
 
     ctx.translate(extra / 2, 0)
   }

public/index.html

@@ -8,5 +8,6 @@
   </head>
   <body>
     <canvas height="2000" width="10000" id="canvas"></canvas>
+    <div id="root"></div>
   </body>
 </html>

public/styles/index.pcss

@@ -1,4 +1,5 @@
 $bg: #262335;
+$bg-darker: #241b2f;
 
 html,
 body {
@@ -13,5 +14,20 @@ body {
 
 canvas {
   background: $bg;
-  width: 100%;
+}
+
+#root {
+  position: absolute;
+  bottom: 0;
+  left: 0;
+  background: $bg-darker;
+}
+
+#root > #error {
+  color: #ff4444;
+}
+
+#root #input,
+#root button {
+  font-size: 2rem;
 }