From c12c5ffd2478a3363012ff693e1237a6a2c3b7c1 Mon Sep 17 00:00:00 2001 From: Piotr Justyna Date: Tue, 27 Feb 2024 16:49:12 +0000 Subject: [PATCH] automatic connections between steps --- HelloWorld.hs | 42 ++++++++++++++++++++++++++++++++++++++++++ HelloWorld.lhs | 28 ---------------------------- README.md | 3 +-- hello-world.svg | 2 +- 4 files changed, 44 insertions(+), 31 deletions(-) create mode 100644 HelloWorld.hs delete mode 100644 HelloWorld.lhs diff --git a/HelloWorld.hs b/HelloWorld.hs new file mode 100644 index 0000000..5a4d37b --- /dev/null +++ b/HelloWorld.hs @@ -0,0 +1,42 @@ +{-# LANGUAGE NoMonomorphismRestriction #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE TypeFamilies #-} + +import Diagrams.Prelude +import Diagrams.Backend.SVG.CmdLine + +data Step = Step { + originCoordinates :: Point V2 Double, + name :: Double } + +stepName :: Step -> Double +stepName Step { originCoordinates = x, name = y } = y + +stepShape :: Double -> Diagram B +stepShape x = fromOffsets + [V2 0 0, + V2 0 0.5, + V2 0.75 0, + V2 0 (-0.5), + V2 (-0.75) 0] + # showOrigin + # named x + +steps :: [Step] +steps = [ + Step { + originCoordinates = p2 (x, y), + name = x * 10 + y } + | x <- [0 .. 1], + y <- [0 .. 2]] + +connections :: [Step] -> [QDiagram B V2 Double Any -> QDiagram B V2 Double Any] +connections (x1: x2: xn) = + connectOutside (stepName x1) (stepName x2): connections (x2: xn) +connections (x1: []) = [] +connections [] = [] + +main = mainWith $ + position [(x, (stepShape y)) | Step { originCoordinates = x, name = y } <- steps] + # applyAll (connections steps) + # lw veryThin diff --git a/HelloWorld.lhs b/HelloWorld.lhs deleted file mode 100644 index 5dfcb8c..0000000 --- a/HelloWorld.lhs +++ /dev/null @@ -1,28 +0,0 @@ -> {-# LANGUAGE NoMonomorphismRestriction #-} -> {-# LANGUAGE FlexibleContexts #-} -> {-# LANGUAGE TypeFamilies #-} -> -> import Diagrams.Prelude -> import Diagrams.Backend.SVG.CmdLine -> -> stepsOrigins :: [Point V2 Double] -> stepsOrigins = map p2 $ [(x, y) | x <- [0..1], y <- [0, (-1), (-2)]] -> -> step :: Int -> Diagram B -> step x = fromOffsets -> [V2 0 0, -> V2 0 0.5, -> V2 0.75 0, -> V2 0 (-0.5), -> V2 (-0.75) 0] -> # showOrigin -> # lw veryThin -> # named x -> -> numberOfSteps :: Int -> numberOfSteps = length stepsOrigins -> -> main = -> mainWith $ -> atPoints stepsOrigins [step x | x <- [0 .. ]] -> # applyAll [lw veryThin . connectOutside x (x + 1) | x <- [0 .. numberOfSteps - 2]] diff --git a/README.md b/README.md index 94991f6..bcb9692 100644 --- a/README.md +++ b/README.md @@ -12,13 +12,12 @@ * `cabal install --lib diagrams-lib` * `cabal install --lib diagrams-svg` * `cabal install --lib base` -* `ghc HelloWorld.lhs` +* `ghc HelloWorld.hs` * `./HelloWorld -o hello-world.svg -w 400` ![hello-world](./hello-world.svg) ## resources -* [literate programming](https://wiki.haskell.org/Literate_programming) * [drakon](https://drakonhub.com/read/docs) * [diagrams](https://archives.haskell.org/projects.haskell.org/diagrams/doc/quickstart.html#introduction) diff --git a/hello-world.svg b/hello-world.svg index f873bf5..2c90b67 100644 --- a/hello-world.svg +++ b/hello-world.svg @@ -1,3 +1,3 @@ \ No newline at end of file + "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd"> \ No newline at end of file