packages feed

waterfall-cad-examples 0.4.0.0 → 0.5.0.0

raw patch · 13 files changed

+158/−26 lines, 13 filesdep +raw-strings-qqdep +svg-treedep +waterfall-cad-svgdep ~opencascade-hsdep ~waterfall-cadPVP ok

version bump matches the API change (PVP)

Dependencies added: raw-strings-qq, svg-tree, waterfall-cad-svg, xml

Dependency ranges changed: opencascade-hs, waterfall-cad

API changes (from Hackage documentation)

+ DarkModeSVG: writeDarkModeSVG :: FilePath -> Diagram -> IO ()
+ SVG.PathExample: pathExample :: String -> Either String Solid
+ SVG.ReadFileExample: readFileExample :: FilePath -> IO Solid

Files

app/Main.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE TupleSections #-} module Main (main) where  import CsgExample (csgExample)@@ -11,23 +12,56 @@ import TextExample (textExample) import BoundingBoxExample (boundingBoxExample) import ReadSolidExpressionExample (readSolidExpressionExample)+import SVG.PathExample (pathExample)+import SVG.ReadFileExample (readFileExample)+import Waterfall.SVG (writeDiagramSVG)+import DarkModeSVG (writeDarkModeSVG) import Waterfall.IO (writeSTL, writeSTEP, writeGLTF, writeGLB, writeOBJ)+import qualified Waterfall.Diagram as Diagram import qualified Waterfall.Solids as Solids+import qualified Waterfall.TwoD.Transforms as TwoD.Transforms import qualified Options.Applicative as OA-import Control.Applicative ((<|>), liftA2)+import Linear (V2 (..), V3 (..), _x, _y)+import Control.Lens ((^.))+import Control.Applicative ((<|>)) import Control.Monad (join) +normalizeSize :: (V2 Double -> Double, Double) -> Diagram.Diagram -> Diagram.Diagram+normalizeSize (getter, target) d = +    case Diagram.diagramBoundingBox d of +        Just (lo, hi) -> +            let s = getter (hi - lo)+            in TwoD.Transforms.uScale2D (target / s) d+        Nothing -> d+ outputOption :: OA.Parser (Solids.Solid -> IO ())  outputOption =     let stlOption = (flip writeSTL) <$> OA.strOption (OA.long "stl" <> OA.metavar "Stl file to write results to")         gltfOption = (flip writeGLTF) <$> OA.strOption (OA.long "gltf" <> OA.metavar "GLTF file to write results to")         glbOption = (flip writeGLB) <$> OA.strOption (OA.long "glb" <> OA.metavar "GLB file to write results to")         objOption = (flip writeOBJ) <$> OA.strOption (OA.long "obj" <> OA.metavar "OBJ file to write results to")+        svgWriterOptions :: OA.Parser (Diagram.Diagram -> IO ())+        svgWriterOptions = +            (writeDiagramSVG <$> OA.strOption (OA.long "svg" <> OA.metavar "SVG file to write results to")) +             <|> (writeDarkModeSVG <$> OA.strOption (OA.long "dark-mode-svg" <> OA.metavar "SVG file to write results to (with the style modified to support dark mode)"))+        imageSizeOptions = +            (((^. _x),) <$> OA.option OA.auto (OA.long "width" <> OA.help "image target width"))+            <|> (((^. _y),) <$> OA.option OA.auto (OA.long "height" <> OA.help "image target height"))+            <|> pure ((^. _x), 800)+        viewDirectionOption = +            (OA.option OA.auto (OA.long "view-direction" <> OA.help "image view direction"))+            <|> pure (V3 2 3 1)+        svgOptions = +            (\writer size direction solid -> writer . normalizeSize size . Diagram.solidDiagram direction $ solid) +                <$> svgWriterOptions+                <*> imageSizeOptions+                <*> viewDirectionOption+         meshOptionsNoResolution = stlOption <|> gltfOption <|> glbOption <|> objOption         meshOptions = meshOptionsNoResolution <*>             (OA.option OA.auto (OA.long "resolution" <> OA.help "linear tolerance for mesh file formats") <|> pure 0.001)         stepOption = writeSTEP <$> OA.strOption (OA.long "step" <> OA.metavar "Stl file to write results to")-     in meshOptions <|> stepOption+     in meshOptions <|> stepOption <|> svgOptions  exampleOption :: OA.Parser (IO Solids.Solid) exampleOption = @@ -60,7 +94,12 @@        (OA.option OA.auto (OA.long "size" <> OA.help "font size") <|> pure 12.0) <*>        (OA.strOption (OA.long "content" <> OA.help "text to render") <|> pure "Waterfall CAD") <*>        (OA.option OA.auto (OA.long "depth" <> OA.help "depth to extrude the text to") <|> pure 10.0) -      )+      ) <|> +      (OA.flag' (either error pure . pathExample) (OA.long "svg-path" <> OA.help "parse an SVG path string and use it to generate a prism") <*> +       (OA.strOption (OA.long "path-string" <> OA.help "the SVG path string"))+      ) <|>  +      (OA.flag' (readFileExample) (OA.long "svg-read" <> OA.help "read an SVG file and use it to generate a prism") <*> +       (OA.strOption (OA.long "svg" <> OA.help "path to the svg")))  main :: IO () main = join (OA.execParser opts)
src/BoundingBoxExample.hs view
@@ -1,5 +1,5 @@ module BoundingBoxExample-(boundingBoxExample+( boundingBoxExample ) where  import Data.Function ((&))
+ src/DarkModeSVG.hs view
@@ -0,0 +1,61 @@+{-# LANGUAGE QuasiQuotes #-}+module DarkModeSVG+( writeDarkModeSVG+) where++import qualified Waterfall.SVG+import qualified Waterfall+import qualified Graphics.Svg as Svg+import qualified Text.XML.Light.Types as XML+import qualified Text.XML.Light.Proc as XML.Proc+import qualified Text.XML.Light.Cursor as XML.Cursor+import qualified Text.XML.Light.Output as XML.Output+import Text.RawString.QQ+import Data.Function ((&))+import Data.Foldable (toList)+import Data.Maybe (listToMaybe, fromMaybe)+import Control.Monad (join)+styles :: String+styles = [r|+.edge {+  fill: None;+}+.edge.visible {+  stroke: #000000;+}+.edge.hidden {+  stroke: #C8C8FF;+}+@media (prefers-color-scheme: dark) {+    .edge.visible {+      stroke: #FFFFFF;+    }+    .edge.hidden {+      stroke: #A00000;+    }+}+|]++writeDarkModeSVG :: FilePath -> Waterfall.Diagram -> IO ()+writeDarkModeSVG path diagram =+    let svgAsXML = +            diagram +                & Waterfall.SVG.diagramToSvg+                & Svg.xmlOfDocument+        nameIsStyle (XML.Elem e) = (== "style") . XML.qName . XML.elName $ e+        nameIsStyle _ = False+    in svgAsXML +            & XML.Cursor.fromElement+            & XML.Cursor.findChild (nameIsStyle . XML.Cursor.current)+            & fmap XML.Cursor.firstChild +            & join+            & fmap (XML.Cursor.setContent (XML.Text (XML.CData XML.CDataText styles Nothing)))+            & fmap (XML.Cursor.root)+            & fmap XML.Cursor.current+            & toList+            & XML.Proc.onlyElems+            & listToMaybe+            & fromMaybe svgAsXML+            & XML.Output.ppTopElement+            & writeFile path+
src/GearExample.hs view
@@ -144,4 +144,4 @@     let segment = genGearToothData moduleLength nGears pressureAngle         path = Path2D.repeatLooping segment         --path = mconcat [rotate2D (-fromIntegral n * pi * 2 / fromIntegral nGears) segment | n <- [0..nGears]]-    in Solids.prism thickness . Shape.fromPath $ path+    in Solids.prism thickness . Shape.makeShape $ path
src/LoftExample.hs view
@@ -1,8 +1,3 @@-{-|-Module: Waterfall.Loft---}- module LoftExample  ( loftExample ) where@@ -26,8 +21,7 @@ -- This example demonstrates the `Loft` module, by generating a boat, with the profile of the boat specified by a series of bezier curves. loftExample :: Solids.Solid loftExample = -    let precision = 1e-6-        paths = +    let paths =            [ let p x z = V3 x 0 z                -- the curve at the rear of the boat is tilted _slightly_ back               in Transforms.rotate (V3 1 0 0) 0.2 $@@ -44,7 +38,6 @@         symetricPaths = makeSymetric <$> paths         body =            Loft.pointedLoft -            precision              Nothing             (Path.closeLoop <$>  symetricPaths)             (Just (V3 0 20 5))
src/OffsetExample.hs view
@@ -11,8 +11,7 @@ offsetExample =    let beam axis = rotate axis (pi/2) (scale (V3 2 2 4) Solids.centeredCube)       cross = foldMap beam [unit _x,  unit _y, unit _z]-      tolerance = 1e-6-      offsetCross amount = offset amount tolerance cross+      offsetCross amount = offset amount cross       offsetCrosses = offsetCross <$> [- 0.5, - 0.25, 0, 0.25, 0.5]        position = (unit _x ^* 5 ^*) <$> [0..]     in mconcat $ zipWith translate position offsetCrosses
src/PrismExample.hs view
@@ -8,7 +8,7 @@ import Linear (V2 (..))  prismExample :: Solids.Solid-prismExample = Solids.prism 1 . Shape.fromPath $+prismExample = Solids.prism 1 . Shape.makeShape $     Path2D.pathFrom (V2 (-1) (-1))          [ Path2D.arcViaTo (V2 (-1.5) 0) (V2 (-1) 1)         , Path2D.lineTo (V2 1 1)
src/ReadSolidExpressionExample.hs view
@@ -5,7 +5,6 @@ import qualified Waterfall.Solids as Solids import qualified Waterfall.Booleans as Booleans import qualified Waterfall.IO-import Control.Applicative (liftA2) import Text.Parsec import Control.Monad.Combinators.Expr
+ src/SVG/PathExample.hs view
@@ -0,0 +1,13 @@+module SVG.PathExample +( pathExample +) where++import qualified Waterfall.SVG+import qualified Waterfall.Solids as Solids+import qualified Waterfall.TwoD.Shape as Shape+import Data.Bifunctor (Bifunctor(bimap))++pathExample :: String -> Either String Solids.Solid+pathExample pathStr =+    let solidify = mconcat . fmap (Solids.prism 1 . Shape.makeShape)+    in bimap show solidify $ Waterfall.SVG.parsePath pathStr
+ src/SVG/ReadFileExample.hs view
@@ -0,0 +1,17 @@+module SVG.ReadFileExample +( readFileExample +) where++import qualified Waterfall.SVG+import qualified Waterfall.Solids as Solids+import qualified Waterfall.TwoD.Shape as Shape+import qualified Waterfall.Transforms as Transforms+import qualified Waterfall.Booleans as Booleans+import Linear (V3 (..))++readFileExample :: FilePath -> IO Solids.Solid+readFileExample filepath =+    let expandVertically = Transforms.translate (V3 0 0 (-0.5)) . Transforms.scale (V3 1 1 2)+        xor a b = (a `Booleans.difference` expandVertically b) <> (b `Booleans.difference` expandVertically a)+        solidify = foldr xor Solids.nowhere . fmap (Solids.prism 1 . Shape.makeShape)+    in either (error . show) solidify <$> Waterfall.SVG.readSVG filepath
src/SweepExample.hs view
@@ -18,7 +18,7 @@             , Path.arcViaRelative (V3 0 1 1) (V3 0 2 0)             , Path.lineTo (V3 0 2 0)              ] -        sweepProfile = Shape.fromPath $+        sweepProfile = Shape.makeShape $                 Path2D.repeatLooping $                 Path2D.bezier (0.25 *^ unit _x) (0.5 *^ unit _x) (0.5 *^ angle (pi/6)) (0.25 *^ angle (pi/6))     in sweep sweepPath sweepProfile
src/TextExample.hs view
@@ -3,8 +3,8 @@ ) where  import qualified Waterfall-+import Linear (unit, _x) textExample :: FilePath -> Double -> String -> Double -> IO Waterfall.Solid textExample fontpath fontSize content depth = do     font <- Waterfall.fontFromPath fontpath fontSize-    return . Waterfall.prism depth $ Waterfall.text font content+    return . Waterfall.rotate (unit _x) (pi/2) . Waterfall.prism depth $ Waterfall.text font content
waterfall-cad-examples.cabal view
@@ -1,11 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.36.0.+-- This file has been generated from package.yaml by hpack version 0.37.0. -- -- see: https://github.com/sol/hpack  name:           waterfall-cad-examples-version:        0.4.0.0+version:        0.5.0.0 synopsis:       Examples for Waterfall CAD, a Declarative CAD/Solid Modeling Library description:    Please see the README on GitHub at <https://github.com/joe-warren/opencascade-hs#readme> category:       Graphics@@ -30,6 +30,7 @@   exposed-modules:       BoundingBoxExample       CsgExample+      DarkModeSVG       FilletExample       GearExample       LoftExample@@ -37,6 +38,8 @@       PrismExample       ReadSolidExpressionExample       RevolutionExample+      SVG.PathExample+      SVG.ReadFileExample       SweepExample       TextExample   other-modules:@@ -48,11 +51,15 @@       base >=4.7 && <5     , lens ==5.*     , linear >=1.21 && <2-    , opencascade-hs >=0.4.0.0 && <0.5+    , opencascade-hs >=0.5.0.0 && <0.6     , optparse-applicative >=0.17 && <0.19     , parsec ==3.1.*     , parser-combinators >=1.2 && <1.4-    , waterfall-cad >=0.4.0.0 && <0.5+    , raw-strings-qq >=1.1 && <2+    , svg-tree >=0.6 && <1.0+    , waterfall-cad >=0.5.0.0 && <0.6+    , waterfall-cad-svg >=0.5.0.0 && <0.6+    , xml ==1.*   default-language: Haskell2010  executable waterfall-cad-examples@@ -66,10 +73,14 @@       base >=4.7 && <5     , lens ==5.*     , linear >=1.21 && <2-    , opencascade-hs >=0.4.0.0 && <0.5+    , opencascade-hs >=0.5.0.0 && <0.6     , optparse-applicative >=0.17 && <0.19     , parsec ==3.1.*     , parser-combinators >=1.2 && <1.4-    , waterfall-cad >=0.4.0.0 && <0.5+    , raw-strings-qq >=1.1 && <2+    , svg-tree >=0.6 && <1.0+    , waterfall-cad >=0.5.0.0 && <0.6     , waterfall-cad-examples+    , waterfall-cad-svg >=0.5.0.0 && <0.6+    , xml ==1.*   default-language: Haskell2010