diff --git a/layout-lens/spago.lock b/layout-lens/spago.lock index 1b007e6..a7410b6 100644 --- a/layout-lens/spago.lock +++ b/layout-lens/spago.lock @@ -562,7 +562,7 @@ workspace: extra_packages: debugged: git: https://github.com/mateiadrielrafael/purescript-debugged.git - ref: 0d5a4149279129f10c8fe2a3ef280b9fde4d5116 + ref: 70d4b2e19c8831753a62a4527b0c8c40a25b2a4e packages: aff: type: registry @@ -694,7 +694,7 @@ packages: debugged: type: git url: https://github.com/mateiadrielrafael/purescript-debugged.git - rev: 0d5a4149279129f10c8fe2a3ef280b9fde4d5116 + rev: 70d4b2e19c8831753a62a4527b0c8c40a25b2a4e dependencies: - arrays - bifunctors diff --git a/layout-lens/spago.yaml b/layout-lens/spago.yaml index 56b7340..431b4c3 100644 --- a/layout-lens/spago.yaml +++ b/layout-lens/spago.yaml @@ -23,4 +23,5 @@ workspace: extra_packages: debugged: git: https://github.com/mateiadrielrafael/purescript-debugged.git - ref: 0d5a4149279129f10c8fe2a3ef280b9fde4d5116 + ref: 70d4b2e19c8831753a62a4527b0c8c40a25b2a4e + diff --git a/layout-lens/src/Data/Config.purs b/layout-lens/src/Data/Config.purs index 09dbeab..7ac28f3 100644 --- a/layout-lens/src/Data/Config.purs +++ b/layout-lens/src/Data/Config.purs @@ -36,7 +36,7 @@ type PhysicalExecutionStep = { block :: Array PhysicalKey, keys :: Array Physica transformKey :: ScalePreservingTransform -> PhysicalKey -> PhysicalKey transformKey transform (PhysicalKey key) = PhysicalKey { size: key.size - , transform: composeScalePreservingTransforms key.transform transform + , transform: composeScalePreservingTransforms transform key.transform } buildPhysical :: RawPhysical -> PhysicalLayout diff --git a/layout-lens/src/Data/Geometry.purs b/layout-lens/src/Data/Geometry.purs index fcabdfe..c6502a6 100644 --- a/layout-lens/src/Data/Geometry.purs +++ b/layout-lens/src/Data/Geometry.purs @@ -3,19 +3,21 @@ module LayoutLens.Data.Geometry where import LayoutLens.Prelude import Data.Array as Array +import LayoutLens.Data.Vec2 as V import LayoutLens.Data.Vec2 ( AABB(..) , Polygon(..) - , ScalePreservingTransform , Vec2(..) , aabbToPolygon - , applyScalePreservingTransform + , applyTransform + , boundingBox , mapPoints + , tTranslate , vinv , vscale ) -data Attribute = Fill Color | Stroke Color +data Attribute = Fill Color | Stroke Color | StrokeWidth Number type Attributes = Array Attribute type GenericAttributes = Array (String /\ String) @@ -31,28 +33,30 @@ data PathStep | Close data Geometry - = Transform ScalePreservingTransform Geometry + = Transform V.Transform Geometry | Many (Array Geometry) | Text GenericAttributes Attributes String | Rect AABB Attributes | Path (Array PathStep) Attributes + | Invisible Geometry -- Approximate the size of some geometry by fitting a polygon around it -boundingPolygon :: Geometry -> Polygon +boundingPolygon :: Geometry -> Maybe Polygon boundingPolygon = case _ of - Rect aabb _ -> aabbToPolygon aabb - Text _ _ _ -> mempty + Rect aabb _ -> pure $ aabbToPolygon aabb + Text _ _ _ -> Nothing Many array -> foldMap boundingPolygon array - Transform t g -> mapPoints (applyScalePreservingTransform t) $ boundingPolygon g + Invisible g -> boundingPolygon g + Transform t g -> mapPoints (applyTransform t) <$> boundingPolygon g Path steps _ -> foldMap snd $ Array.scanl (points <<< fst) mempty steps where - points :: Vec2 -> PathStep -> Vec2 /\ Polygon + points :: Vec2 -> PathStep -> Vec2 /\ Maybe Polygon points prev = case _ of - Close -> prev /\ Polygon [] - MoveTo a -> a /\ Polygon [ a ] - LineTo a -> a /\ Polygon [ a ] + Close -> prev /\ Nothing + MoveTo a -> a /\ (pure $ Polygon $ pure a) + LineTo a -> a /\ (pure $ Polygon $ pure a) -- This is just an approximation where we fit an AABB around the circle. - Arc arc -> arc.to /\ aabbToPolygon aabb + Arc arc -> arc.to /\ pure (aabbToPolygon aabb) where aabb = AABB { position: center <> vinv diagonal @@ -62,6 +66,21 @@ boundingPolygon = case _ of diagonal = Vec2 arc.radius arc.radius center = vscale 0.5 $ arc.to <> prev +-- | Add padding around some geometry +pad :: Vec2 -> Geometry -> Geometry +pad padding geometry = case boundingBox <$> boundingPolygon geometry of + Just (AABB box) -> Many + [ Transform (tTranslate padding) geometry + , Invisible $ Rect + ( AABB + { position: box.position + , size: box.size <> vscale 2.0 padding + } + ) + [] + ] + Nothing -> geometry + derive instance Eq Attribute derive instance Eq PathStep derive instance Eq Geometry diff --git a/layout-lens/src/Data/Svg.purs b/layout-lens/src/Data/Svg.purs index 3983035..6fe5e4a 100644 --- a/layout-lens/src/Data/Svg.purs +++ b/layout-lens/src/Data/Svg.purs @@ -4,20 +4,24 @@ import LayoutLens.Prelude import Data.Array as Array import Data.String (Pattern(..)) -import LayoutLens.Data.Geometry (Geometry(..), Attribute(..), Attributes, GenericAttributes, PathStep(..)) -import LayoutLens.Data.Vec2 (AABB(..), ScalePreservingTransform(..), Vec2(..), radiansToDegrees, x, y) +import LayoutLens.Data.Geometry (Attribute(..), Attributes, GenericAttributes, Geometry(..), PathStep(..), boundingPolygon) +import LayoutLens.Data.Vec2 (AABB(..), Vec2(..), boundingBox, x, y) +import LayoutLens.Data.Vec2 as V indent :: String -> String indent = split (Pattern "\n") >>> map (" " <> _) >>> unlines +printAttributes :: GenericAttributes -> String +printAttributes attributes = joinWith " " + $ uncurry (\key value -> fold [ key, "=\"", value, "\"" ]) + <$> attributes + tag :: String -> GenericAttributes -> String -> String tag name attributes child = fold [ "<" , name , " " - , joinWith " " - $ uncurry (\key value -> fold [ key, "=\"", value, "\"" ]) - <$> attributes + , printAttributes attributes , ">" , indent child , " GenericAttributes -> String -leaf name attributes = tag name attributes mempty +leaf name attributes = fold + [ "<" + , name + , " " + , printAttributes attributes + , "/>" + ] printGeometryAttributes :: Attributes -> GenericAttributes printGeometryAttributes = map case _ of Fill color -> "fill" /\ toHexString color Stroke color -> "stroke" /\ toHexString color + StrokeWidth number -> "stroke-width" /\ show number px :: Number -> String px n = show n <> "px" @@ -39,6 +50,7 @@ px n = show n <> "px" -- Render a geometry to svg renderGeometry :: Geometry -> String renderGeometry = case _ of + Invisible _ -> "" Many array -> unlines $ renderGeometry <$> array Rect (AABB aabb) proper -> @@ -47,8 +59,8 @@ renderGeometry = case _ of <> [ "x" /\ show (x aabb.position) , "y" /\ show (y aabb.position) - , "width" /\ px (x aabb.size) - , "height" /\ px (y aabb.size) + , "width" /\ show (x aabb.size) + , "height" /\ show (y aabb.size) ] Path steps proper -> @@ -78,12 +90,37 @@ renderGeometry = case _ of (generic <> printGeometryAttributes proper) string - Transform (ScalePreservingTransform transform) g -> + Transform (V.Transform transform) g -> tag "g" - [ "transform" /\ fold - [ "rotate(" - , show $ radiansToDegrees transform.rotation + [ "transform" /\ joinWith " " + [ "matrix(" + , show $ transform.scale * cos (unwrap transform.rotation) + , show $ transform.scale * sin (unwrap transform.rotation) + , show $ transform.scale * -sin (unwrap transform.rotation) + , show $ transform.scale * cos (unwrap transform.rotation) + , show $ x transform.position + , show $ y transform.position , ")" ] ] $ renderGeometry g + +-- | Adds the necessary boilerplate to store svg inside a file +makeSvgDocument :: Geometry -> String +makeSvgDocument geometry = tag "svg" attributes $ renderGeometry geometry + where + attributes = + [ "xmlns" /\ "http://www.w3.org/2000/svg" + , "xmlns:xlink" /\ "http://www.w3.org/1999/xlink" + ] + <> + case boundingBox <$> boundingPolygon geometry of + Nothing -> [] + Just (AABB box) -> pure + $ "viewBox" + /\ joinWith " " + [ show $ x box.position + , show $ y box.position + , show $ x box.size + , show $ y box.size + ] diff --git a/layout-lens/src/Data/Vec2.purs b/layout-lens/src/Data/Vec2.purs index 4e543aa..c68ca16 100644 --- a/layout-lens/src/Data/Vec2.purs +++ b/layout-lens/src/Data/Vec2.purs @@ -2,10 +2,16 @@ module LayoutLens.Data.Vec2 where import LayoutLens.Prelude +import Data.Array.NonEmpty as NEA +import Partial.Unsafe (unsafePartial) + newtype Radians = Radians Number data Vec2 = Vec2 Number Number -- {{{ Base helpers +-- | Multiply by the matrix +-- | cos Θ -sin Θ +-- | sin Θ cos Θ rotateBy :: Radians -> Vec2 -> Vec2 rotateBy (Radians angle) (Vec2 x y) = Vec2 (x * c - y * s) (x * s + y * c) where @@ -30,18 +36,36 @@ x (Vec2 x _) = x y :: Vec2 -> Number y (Vec2 _ y) = y +origin :: Vec2 +origin = Vec2 0.0 0.0 + -- }}} -- {{{ Shapes newtype AABB = AABB { position :: Vec2, size :: Vec2 } -newtype Polygon = Polygon (Array Vec2) +newtype Polygon = Polygon (NonEmptyArray Vec2) aabbToPolygon :: AABB -> Polygon aabbToPolygon (AABB aabb@{ size: Vec2 sx sy }) = Polygon - [ aabb.position - , aabb.position <> Vec2 0.0 sy - , aabb.position <> aabb.size - , aabb.position <> Vec2 sx 0.0 - ] + $ unsafePartial -- Safe because the array always has four elements + $ fromJust + $ NEA.fromArray + [ aabb.position + , aabb.position <> Vec2 0.0 sy + , aabb.position <> aabb.size + , aabb.position <> Vec2 sx 0.0 + ] + +-- | The left-inverse of `aabbToPolygon` +boundingBox :: Polygon -> AABB +boundingBox (Polygon points) = AABB + { position: Vec2 minX minY + , size: Vec2 (maxX - minX) (maxY - minY) + } + where + minX = NEA.foldl1 min $ x <$> points + minY = NEA.foldl1 min $ y <$> points + maxX = NEA.foldl1 max $ x <$> points + maxY = NEA.foldl1 max $ y <$> points mapPoints :: (Vec2 -> Vec2) -> (Polygon -> Polygon) mapPoints f (Polygon points) = Polygon $ f <$> points @@ -49,6 +73,9 @@ mapPoints f (Polygon points) = Polygon $ f <$> points aabbCenter :: AABB -> Vec2 aabbCenter (AABB aabb) = aabb.position <> vscale 0.5 aabb.size +originAabb :: Vec2 -> AABB +originAabb size = AABB { position: origin, size } + -- }}} -- {{{ Transforms newtype RawScalePreservingTransform = RawScalePreservingTransform @@ -62,24 +89,72 @@ newtype ScalePreservingTransform = ScalePreservingTransform , rotation :: Radians } -normalizeScalePreservingTransform - :: RawScalePreservingTransform -> ScalePreservingTransform -normalizeScalePreservingTransform (RawScalePreservingTransform t) = ScalePreservingTransform - { rotation: t.rotateBy - , position: t.rotateAround <> rotateBy t.rotateBy (vsub t.position t.rotateAround) +newtype Transform = Transform + { scale :: Number + , position :: Vec2 + , rotation :: Radians } +-- | Intuitivey, the raw transformation has form +-- | v ↦ r_Θ(v + a) - a + p, +-- | but rotations are linear, so the above can be rewritten as +-- | v ↦ r_Θ(v) + (r_Θ(a) - a + p), +-- | which is what this function does. +-- | +-- | The other case works similarly +normalizeScalePreservingTransform + :: RawScalePreservingTransform -> ScalePreservingTransform +normalizeScalePreservingTransform (RawScalePreservingTransform t) = + ScalePreservingTransform + { rotation: t.rotateBy + , position: t.rotateAround + <> rotateBy t.rotateBy (t.position <> vinv t.rotateAround) + } + +-- | We want to compose +-- | f(v) = r_Θ(v) + p_f +-- | s(v) = r_ϕ(v) + p_s, +-- | which yields +-- | (s ∘ f)(v) = r_ϕ(r_Θ(v) + p_f) + p_s +-- | = r_ϕ(r_Θ(v)) + r_ϕ(p_f) + p_s +-- | = r_(ϕ+Θ)(v) + (r_ϕ(p_f) + p_s) composeScalePreservingTransforms :: ScalePreservingTransform -> ScalePreservingTransform -> ScalePreservingTransform -composeScalePreservingTransforms (ScalePreservingTransform first) (ScalePreservingTransform second) = +composeScalePreservingTransforms (ScalePreservingTransform second) (ScalePreservingTransform first) = ScalePreservingTransform { rotation: first.rotation <> second.rotation , position: second.position <> rotateBy second.rotation first.position } +forgetScalePreservingStructure :: ScalePreservingTransform -> Transform +forgetScalePreservingStructure (ScalePreservingTransform transform) = + Transform + { position: transform.position + , rotation: transform.rotation + , scale: 1.0 + } + applyScalePreservingTransform :: ScalePreservingTransform -> Vec2 -> Vec2 -applyScalePreservingTransform (ScalePreservingTransform transform) v = - rotateBy transform.rotation v <> transform.position +applyScalePreservingTransform = forgetScalePreservingStructure >>> applyTransform + +applyTransform :: Transform -> Vec2 -> Vec2 +applyTransform (Transform transform) v = + -- Rotations are linear, thus they commute with scaling. + vscale transform.scale (rotateBy transform.rotation v) <> transform.position + +tScale :: Number -> Transform +tScale factor = Transform + { scale: factor + , position: origin + , rotation: mempty + } + +tTranslate :: Vec2 -> Transform +tTranslate position = Transform + { scale: 1.0 + , rotation: mempty + , position + } -- }}} @@ -89,12 +164,14 @@ derive instance Eq AABB derive instance Eq Polygon derive instance Eq RawScalePreservingTransform derive instance Eq ScalePreservingTransform +derive instance Eq Transform derive instance Generic Vec2 _ derive instance Generic Radians _ derive instance Generic AABB _ derive instance Generic Polygon _ derive instance Generic RawScalePreservingTransform _ derive instance Generic ScalePreservingTransform _ +derive instance Generic Transform _ instance Debug Vec2 where debug = genericDebug @@ -114,6 +191,9 @@ instance Debug RawScalePreservingTransform where instance Debug ScalePreservingTransform where debug = genericDebug +instance Debug Transform where + debug = genericDebug + instance Semigroup Vec2 where append (Vec2 a b) (Vec2 c d) = Vec2 (a + c) (b + d) @@ -128,4 +208,4 @@ instance Monoid Vec2 where instance Monoid Radians where mempty = Radians 0.0 -derive newtype instance Monoid Polygon +derive instance Newtype Radians _ diff --git a/layout-lens/src/Generate/Svg.purs b/layout-lens/src/Generate/Svg.purs new file mode 100644 index 0000000..3e329ca --- /dev/null +++ b/layout-lens/src/Generate/Svg.purs @@ -0,0 +1,29 @@ +module LayoutLens.Generate.Svg where + +import LayoutLens.Prelude + +import LayoutLens.Data.Config as C +import LayoutLens.Data.Geometry (Attribute(..)) +import LayoutLens.Data.Geometry as G +import LayoutLens.Data.Svg as S +import LayoutLens.Data.Vec2 (forgetScalePreservingStructure, originAabb, tScale, vscale) + +type SvgString = String + +renderPhysicalKey :: C.PhysicalKey -> G.Attributes -> G.Geometry +renderPhysicalKey (C.PhysicalKey key) attributes = do + G.Transform (forgetScalePreservingStructure key.transform) + $ G.Rect (originAabb key.size) attributes + +renderPhysicalLayout :: C.PhysicalLayout -> G.Geometry +renderPhysicalLayout (C.PhysicalLayout layout) = + G.Transform (tScale 100.0) + $ G.Many + $ flip renderPhysicalKey attributes + <$> layout + where + attributes = + [ Fill $ rgb 200 200 50 + , Stroke black + , StrokeWidth 0.1 + ] diff --git a/layout-lens/src/Main.purs b/layout-lens/src/Main.purs index 7476093..989cebd 100644 --- a/layout-lens/src/Main.purs +++ b/layout-lens/src/Main.purs @@ -2,16 +2,28 @@ module Main where import LayoutLens.Prelude -import LayoutLens.Data.Config (PhysicalLayout(..), buildConfig, buildPhysical) -import LayoutLens.Data.RawConfig (RawConfig(..)) +import LayoutLens.Data.Config (LensConfig(..), buildConfig) +import LayoutLens.Data.Geometry (pad) +import LayoutLens.Data.Svg (makeSvgDocument) +import LayoutLens.Data.Vec2 (Vec2(..)) +import LayoutLens.Generate.Svg (renderPhysicalLayout) import LayoutLens.Parser (parseConfig) import Node.Encoding (Encoding(..)) -import Node.FS.Aff (readTextFile) +import Node.FS.Aff (readTextFile, writeTextFile) main :: Effect Unit main = launchAff_ do file <- readTextFile UTF8 "../keyboards/qmk/ferris-sweep/config.lens" + -- file <- readTextFile UTF8 "./input.lens" case parseConfig file of Left err -> log err Right result -> do - logPretty $ buildConfig result + let (LensConfig config) = buildConfig result + logPretty config + -- logPretty $ boundingPolygon $ renderPhysicalLayout config.physical + writeTextFile UTF8 "./output.svg" + $ makeSvgDocument + $ pad (Vec2 30.0 30.0) + $ renderPhysicalLayout + $ config.physical + diff --git a/layout-lens/src/Parser.purs b/layout-lens/src/Parser.purs index 3c3e383..e337bf7 100644 --- a/layout-lens/src/Parser.purs +++ b/layout-lens/src/Parser.purs @@ -90,6 +90,7 @@ name = ows *> P.try do , "section" , "layer" , "block" + , "pre" , "end" , "point" , "place" @@ -151,7 +152,12 @@ physical = do angle <- radians around <- P.option position vec2 pure $ angle /\ around - pure $ Place $ RawScalePreservingTransform { position, rotateBy, rotateAround } + pure $ Place $ + RawScalePreservingTransform + { position + , rotateBy + , rotateAround + } point :: Parser RawPhysicalActionStep point = do @@ -163,7 +169,11 @@ physical = do let rotateAround = position let point a b c d = Point - { transform: RawScalePreservingTransform { position: a, rotateBy: b, rotateAround: c } + { transform: RawScalePreservingTransform + { position: a + , rotateBy: b + , rotateAround: c + } , size: d } case arguments of diff --git a/layout-lens/src/Prelude.purs b/layout-lens/src/Prelude.purs index bdcf083..ee3f302 100644 --- a/layout-lens/src/Prelude.purs +++ b/layout-lens/src/Prelude.purs @@ -26,6 +26,7 @@ module LayoutLens.Prelude , module Data.Monoid.Generic , module Data.String , module Data.List + , module Data.Array.NonEmpty , wrapInto , unimplemented , logPretty @@ -62,6 +63,7 @@ import Effect.Class.Console (clear, group, groupCollapsed, groupEnd, grouped, in import Effect.Exception.Unsafe (unsafeThrow) import Prim.TypeError (class Warn, Text) import Safe.Coerce (class Coercible, coerce) +import Data.Array.NonEmpty (NonEmptyArray) unimplemented :: forall a. Warn (Text "unimplemenet") => a unimplemented = unsafeThrow "unimplemented" diff --git a/layout-lens/vim/ftdetect/lens.vim b/layout-lens/vim/ftdetect/lens.vim new file mode 100644 index 0000000..c3f7060 --- /dev/null +++ b/layout-lens/vim/ftdetect/lens.vim @@ -0,0 +1 @@ +au BufNewFile,BufRead *.lens set filetype=lens diff --git a/layout-lens/vim/syntax/lens.vim b/layout-lens/vim/syntax/lens.vim index 88f046a..d340c4e 100644 --- a/layout-lens/vim/syntax/lens.vim +++ b/layout-lens/vim/syntax/lens.vim @@ -1,12 +1,12 @@ -" if exists("b:current_syntax") -" finish -" endif +if exists("b:current_syntax") + finish +endif set iskeyword+=- syntax keyword lensKeyword physical section layergroup layer chordgroup block end syntax keyword lensAction sticky-switch switch -syntax keyword lensFunction columns place action key +syntax keyword lensFunction columns place action key after before syntax keyword lensLayerName center topleft topright bottomleft bottomright syntax match lensComment "\v--.*$" @@ -21,4 +21,4 @@ highlight link lensOperator Operator highlight link lensHexColor String highlight link lensFunction Function -let b:current_syntax = "lens" +let b:current_syntax = "lens"