WIP

marlowe-playground-client/entry.js

@@ -1,5 +1,4 @@
-import '@fortawesome/fontawesome-free/css/all.css';
-import './static/main.scss';
+import './static/css/main.scss';
 
 import 'ace-builds/src-min-noconflict/ace.js';
 import 'ace-builds/src-min-noconflict/mode-haskell.js';

marlowe-playground-client/package.json

@@ -21,6 +21,7 @@
     "echarts": "^4.2.0-rc.2",
     "extract-text-webpack-plugin": "^3.0.2",
     "file-loader": "^2.0.0",
+    "google-fonts-plugin": "^5.0.2",
     "html-webpack-plugin": "^3.2.0",
     "jquery": "^3.3.1",
     "moo": "^0.5.1",

marlowe-playground-client/src/Halogen/SVG.purs

@@ -0,0 +1,204 @@
+module Halogen.SVG where
+
+import DOM.HTML.Indexed (Interactive)
+import Data.Array as Array
+import Data.String (joinWith)
+import Halogen.HTML (AttrName(..), ElemName(..), HTML, Namespace(..), Node, elementNS, text)
+import Halogen.HTML as HH
+import Halogen.HTML.Properties (CSSPixel, IProp)
+import Prelude
+
+------------------------------------------------------------
+-- Nodes.
+------------------------------------------------------------
+type SVGNode
+  = SVGStyling
+      ( SVGCore
+          ( viewBox :: Box
+          , xmlns :: Namespace
+          , width :: CSSPixel
+          , height :: CSSPixel
+          )
+      )
+
+type SVGrect
+  = SVGPresentation
+      ( Interactive
+          ( x :: CSSPixel
+          , y :: CSSPixel
+          , width :: CSSPixel
+          , height :: CSSPixel
+          , fill :: RGB
+          , stroke :: RGB
+          , strokeWidth :: CSSPixel
+          )
+      )
+
+type SVGg
+  = SVGPresentation (SVGCore ())
+
+type SVGCore r
+  = ( id :: String | r )
+
+type SVGStyling r
+  = ( style :: String | r )
+
+type SVGPresentation r
+  = ( transform :: Translate | r )
+
+type SVGline
+  = ( x1 :: CSSPixel
+    , y1 :: CSSPixel
+    , x2 :: CSSPixel
+    , y2 :: CSSPixel
+    , stroke :: RGB
+    , strokeWidth :: CSSPixel
+    )
+
+type SVGtext
+  = SVGPresentation
+      ( x :: CSSPixel
+      , y :: CSSPixel
+      , stroke :: RGB
+      , textAnchor :: Anchor
+      , transform :: Translate
+      )
+
+svgNS :: Namespace
+svgNS = Namespace "http://www.w3.org/2000/svg"
+
+svg :: forall p i. Node SVGNode p i
+svg attributes = elementNS svgNS (ElemName "svg") (Array.snoc attributes (xmlns svgNS))
+
+defs :: forall r p i. Node r p i
+defs = elementNS svgNS (ElemName "defs")
+
+rect :: forall p i. Node SVGrect p i
+rect = elementNS svgNS (ElemName "rect")
+
+svgText :: forall r i. Array (IProp SVGtext i) -> String -> HTML r i
+svgText attributes content = elementNS svgNS (ElemName "text") attributes [ text content ]
+
+g :: forall p i. Node SVGg p i
+g = elementNS svgNS (ElemName "g")
+
+line :: forall p i. Node SVGline p i
+line = elementNS svgNS (ElemName "line")
+
+------------------------------------------------------------
+-- Attributes.
+------------------------------------------------------------
+class IsAttr a where
+  toAttrValue :: a -> String
+
+instance isAttrNamespace :: IsAttr Namespace where
+  toAttrValue (Namespace namespace) = namespace
+
+instance isAttrString :: IsAttr String where
+  toAttrValue = identity
+
+instance isAttrInt :: IsAttr Int where
+  toAttrValue = show
+
+attr :: forall i r a. IsAttr a => AttrName -> a -> IProp r i
+attr name = HH.attr name <<< toAttrValue
+
+x :: forall r i. CSSPixel -> IProp ( x :: CSSPixel | r ) i
+x = attr (AttrName "x")
+
+y :: forall r i. CSSPixel -> IProp ( y :: CSSPixel | r ) i
+y = attr (AttrName "y")
+
+x1 :: forall r i. CSSPixel -> IProp ( x1 :: CSSPixel | r ) i
+x1 = attr (AttrName "x1")
+
+y1 :: forall r i. CSSPixel -> IProp ( y1 :: CSSPixel | r ) i
+y1 = attr (AttrName "y1")
+
+x2 :: forall r i. CSSPixel -> IProp ( x2 :: CSSPixel | r ) i
+x2 = attr (AttrName "x2")
+
+y2 :: forall r i. CSSPixel -> IProp ( y2 :: CSSPixel | r ) i
+y2 = attr (AttrName "y2")
+
+height :: forall r i. CSSPixel -> IProp ( height :: CSSPixel | r ) i
+height = attr (AttrName "height")
+
+width :: forall r i. CSSPixel -> IProp ( width :: CSSPixel | r ) i
+width = attr (AttrName "width")
+
+xmlns :: forall r i. Namespace -> IProp ( xmlns :: Namespace | r ) i
+xmlns = attr (AttrName "xmlns")
+
+transform :: forall r i. Translate -> IProp ( transform :: Translate | r ) i
+transform = attr (AttrName "transform")
+
+textAnchor :: forall r i. Anchor -> IProp ( textAnchor :: Anchor | r ) i
+textAnchor = attr (AttrName "text-anchor")
+
+fill :: forall r i. RGB -> IProp ( fill :: RGB | r ) i
+fill = attr (AttrName "fill")
+
+stroke :: forall r i. RGB -> IProp ( stroke :: RGB | r ) i
+stroke = attr (AttrName "stroke")
+
+strokeWidth :: forall r i. CSSPixel -> IProp ( strokeWidth :: CSSPixel | r ) i
+strokeWidth = attr (AttrName "stroke-width")
+
+id_ :: forall r i. String -> IProp ( id :: String | r ) i
+id_ = attr (AttrName "id")
+
+style :: forall r i. String -> IProp ( style :: String | r ) i
+style = attr (AttrName "style")
+
+viewBox :: forall i r. Box -> IProp ( viewBox :: Box | r ) i
+viewBox = attr (AttrName "viewBox")
+
+------------------------------------------------------------
+-- Types
+------------------------------------------------------------
+data Box
+  = Box
+    { x :: Int
+    , y :: Int
+    , width :: Int
+    , height :: Int
+    }
+
+instance isAttrBox :: IsAttr Box where
+  toAttrValue (Box box) = joinWith " " (show <$> [ box.x, box.y, box.width, box.height ])
+
+data Translate
+  = Translate
+    { x :: Int
+    , y :: Int
+    }
+
+instance isAttrTranslate :: IsAttr Translate where
+  toAttrValue (Translate translate) = "translate" <> parens (joinWith "," (show <$> [ translate.x, translate.y ]))
+
+data RGB
+  = RGB
+    { red :: Int
+    , green :: Int
+    , blue :: Int
+    }
+
+instance isAttrRGB :: IsAttr RGB where
+  toAttrValue (RGB { red, green, blue }) = "rgb" <> parens (joinWith "," (show <$> [ red, green, blue ]))
+
+toRGB :: Int -> Int -> Int -> RGB
+toRGB red green blue = RGB { red, green, blue }
+
+data Anchor
+  = Start
+  | Middle
+  | End
+
+instance isAttrAnchor :: IsAttr Anchor where
+  toAttrValue Start = "start"
+  toAttrValue Middle = "middle"
+  toAttrValue End = "end"
+
+parens :: String -> String
+parens str = "(" <> str <> ")"

marlowe-playground-client/src/MainFrame.purs

@@ -39,11 +39,13 @@ import Gists (GistAction(..), gistControls, parseGistUrl)
 import Halogen (Component, ComponentHTML)
 import Halogen as H
 import Halogen.Blockly (BlocklyMessage(..), blockly)
-import Halogen.HTML (ClassName(ClassName), HTML, a, button, code_, div, div_, h1, pre, slot, strong_, text)
+import Halogen.HTML (ClassName(ClassName), HTML, a, button, code_, div, div_, h1, header, pre, slot, strong_, text)
 import Halogen.HTML.Events (onClick)
 import Halogen.HTML.Extra (mapComponent)
 import Halogen.HTML.Properties (class_, classes, disabled, href)
 import Halogen.Query (HalogenM)
+import Halogen.SVG (defs, svg)
+import Halogen.SVG as SVG
 import Language.Haskell.Interpreter (SourceCode(SourceCode), InterpreterError(CompilationErrors, TimeoutError), CompilationError(CompilationError, RawError), InterpreterResult(InterpreterResult), _InterpreterResult)
 import Marlowe (SPParams_)
 import Marlowe.Blockly as MB
@@ -450,12 +452,56 @@ toAnnotation (CompilationError { row, column, text }) =
     , text: String.joinWith "\\n" text
     }
 
+noMargins :: ClassName
+noMargins = ClassName "no-margins"
+
+aHorizontal :: ClassName
+aHorizontal = ClassName "a-horizontal"
+
+marloweLogo :: ClassName
+marloweLogo = ClassName "marlowe-logo"
+
+spaceLeft :: ClassName
+spaceLeft = ClassName "space-left"
+
+uppercase :: ClassName
+uppercase = ClassName "uppercase"
+
+tabLink :: ClassName
+tabLink = ClassName "tab-link"
+
+aCenter :: ClassName
+aCenter = ClassName "a-center"
+
+flexCol :: ClassName
+flexCol = ClassName "flex-col"
+
 render ::
   forall m.
   MonadAff m =>
   FrontendState ->
   ComponentHTML HAction ChildSlots m
 render state =
+  div [ class_ (ClassName "site-wrap") ]
+    [ header [ classes [ noMargins, aHorizontal ] ]
+        [ div [ class_ aHorizontal ]
+            [ div [ class_ (ClassName "marlowe-logo") ]
+                [ svg [ SVG.width 60, SVG.height 42, SVG.viewBox (SVG.Box { x: 0, y: 0, width: 60, height: 42 }) ]
+                    [ defs []
+                        []
+                    ]
+                ]
+            ]
+        ]
+    ]
+
+------------------------------------------------------------ Old Design -------------------------------------------------------
+renderOld ::
+  forall m.
+  MonadAff m =>
+  FrontendState ->
+  ComponentHTML HAction ChildSlots m
+renderOld state =
   let
     stateView = view _view state
 

marlowe-playground-client/static/css/css_var_colors.scss

@@ -0,0 +1,16 @@
+:root {
+  --white: white;
+  --primary-color: #832dc4;
+  --secondary-color: #1746a0;
+  --accent-color: #709cf0;
+  --accent-color-hover: #6288d1;
+  --error-color: #ff0000;
+  --error-color-hover: #d11b1b;
+  --bg-light: #f8f8f8;
+  --bg-dark: #e7e7e9;
+  --text-color: rgba(51, 51, 51, 0.99);
+  --text-color-inactive: rgba(51, 51, 51, 0.4);
+  --layout-accent-color: rgba(51, 51, 51, 0.2);
+  --gradient-bg: linear-gradient(to right, #832dc4, #1746a0);
+  --btn-hover-gradient-bg: linear-gradient(to left, #832dc4, #1746a0);
+}

marlowe-playground-client/static/css/css_var_globals.scss

@@ -0,0 +1,6 @@
+:root {
+  --animate-btn: translateY(1px);
+  --box-shadow: 0 -3px 12px 0 rgba(0, 0, 0, 0.1);
+  --box-shadow-left:  -6px 6px 6px 0px rgba(0,0,0,0.1);
+  --border-radius: 4px;
+}