Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Merge branch 'master' of github.com:colah/ImplicitCAD

  • Loading branch information...
commit 2f5c834933e197d0f701ad28dd45411e20889ec2 2 parents 104d106 + 3562552
@colah authored
View
31 Graphics/Implicit/Export.hs
@@ -6,7 +6,9 @@ module Graphics.Implicit.Export where
import Graphics.Implicit.Definitions
--import Graphics.Implicit.Operations (slice)
-import System.IO (writeFile)
+import Data.Text.Lazy (Text,pack)
+import Data.Text.Lazy.IO (writeFile)
+import Prelude hiding (writeFile)
-- class DiscreteApproxable
import Graphics.Implicit.Export.Definitions
@@ -24,18 +26,21 @@ import qualified Graphics.Implicit.Export.SymbolicFormats as SymbolicFormats
-- Write an object in a given formet...
writeObject :: (DiscreteAproxable obj aprox) =>
- -- ^ Resolution
- -> (aprox -> String) -- ^ File Format (Function that formats)
- -> FilePath -- ^ File Name
- -> obj -- ^ Object to render
- -> IO() -- ^ Writing Action!
+ -- ^ Resolution
+ -> (aprox -> Text) -- ^ File Format (Function that formats)
+ -> FilePath -- ^ File Name
+ -> obj -- ^ Object to render
+ -> IO () -- ^ Writing Action!
-writeObject res format filename obj = writeFile filename text
- where
- aprox = discreteAprox res obj
- text = format aprox
+writeObject res format filename obj = writeFile filename $ formatObject res format obj
--- Now functions to write it in specific formats
+formatObject :: (DiscreteAproxable obj aprox) =>
+ ℝ -- ^ Resolution
+ -> (aprox -> Text) -- ^ File Format (Function that formats)
+ -> obj -- ^ Object to render
+ -> Text -- ^ Resulting lazy ByteString
+
+formatObject res format = format . discreteAprox res
writeSVG res = writeObject res PolylineFormats.svg
@@ -45,8 +50,8 @@ writeTHREEJS res = writeObject res TriangleMeshFormats.jsTHREE
writeGCodeHacklabLaser res = writeObject res PolylineFormats.hacklabLaserGCode
-writeSCAD3 res filename obj = writeFile filename (SymbolicFormats.scad3 res obj)
-writeSCAD2 res filename obj = writeFile filename (SymbolicFormats.scad2 res obj)
+writeSCAD3 res filename obj = writeFile filename $ SymbolicFormats.scad3 res obj
+writeSCAD2 res filename obj = writeFile filename $ SymbolicFormats.scad2 res obj
{-
View
32 Graphics/Implicit/Export/NormedTriangleMeshFormats.hs
@@ -1,18 +1,22 @@
+{-# LANGUAGE OverloadedStrings #-}
+
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
-- Released under the GNU GPL, see LICENSE
module Graphics.Implicit.Export.NormedTriangleMeshFormats where
import Graphics.Implicit.Definitions
+import Graphics.Implicit.Export.TextBuilderUtils
+
-obj normedtriangles = text
+obj normedtriangles = toLazyText $ vertcode <> normcode <> trianglecode
where
-- A vertex line; v (0.0, 0.0, 1.0) = "v 0.0 0.0 1.0\n"
- v :: ℝ3 -> String
- v (x,y,z) = "v " ++ show x ++ " " ++ show y ++ " " ++ show z ++ "\n"
+ v :: ℝ3 -> Builder
+ v (x,y,z) = "v " <> bf x <> " " <> bf y <> " " <> bf z <> "\n"
-- A normal line; n (0.0, 0.0, 1.0) = "vn 0.0 0.0 1.0\n"
- n :: ℝ3 -> String
- n (x,y,z) = "vn " ++ show x ++ " " ++ show y ++ " " ++ show z ++ "\n"
+ n :: ℝ3 -> Builder
+ n (x,y,z) = "vn " <> bf x <> " " <> bf y <> " " <> bf z <> "\n"
verts = do
-- extract the vertices for each triangle
-- recall that a normed triangle is of the form ((vert, norm), ...)
@@ -24,17 +28,13 @@ obj normedtriangles = text
((_,a),(_,b),(_,c)) <- normedtriangles
-- The normals from each triangle take up 3 position in the resulting list
[a,b,c]
- vertcode = concat $ map v verts
- normcode = concat $ map n norms
- trianglecode = concat $ do
+ vertcode = mconcat $ map v verts
+ normcode = mconcat $ map n norms
+ trianglecode = mconcat $ do
n <- map ((+1).(*3)) [0,1 .. length normedtriangles -1]
let
- vta = show n -- ++ "//" ++ show n
- vtb = show (n+1)-- ++ "//" ++ show (n+1)
- vtc = show (n+2)-- ++ "//" ++ show (n+2)
- return $ "f " ++ vta ++ " " ++ vtb ++ " " ++ vtc ++ " " ++ "\n"
- text = vertcode ++ normcode ++ trianglecode
-
-
-
+ vta = buildInt n
+ vtb = buildInt (n+1)
+ vtc = buildInt (n+2)
+ return $ "f " <> vta <> " " <> vtb <> " " <> vtc <> " " <> "\n"
View
99 Graphics/Implicit/Export/PolylineFormats.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE OverloadedStrings #-}
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
-- Released under the GNU GPL, see LICENSE
@@ -6,49 +7,57 @@ module Graphics.Implicit.Export.PolylineFormats where
import Graphics.Implicit.Definitions
-import Text.Printf (printf)
-
-svg :: [Polyline] -> String
-svg polylines = text
- where
- -- SVG is stupidly laid out... (0,0) is the top left corner
- (xs, ys) = unzip (concat polylines)
- (minx, maxy) = (minimum xs, maximum ys)
- transform (x,y) = (x-minx, maxy - y)
- polylines2 = map (map transform) polylines
- svglines = concat $ map (\line ->
- " <polyline points=\""
- ++ concat (map (\(x,y) -> " " ++ show x ++ "," ++ show y) line)
- ++ "\" style=\"stroke:rgb(0,0,255);stroke-width:1;fill:none;\"/> \n" )
- polylines2
- text = "<svg xmlns=\"http://www.w3.org/2000/svg\" version=\"1.1\"> \n"
- ++ svglines
- ++ "</svg> "
-
-hacklabLaserGCode :: [Polyline] -> String
-hacklabLaserGCode polylines = text
- where
- gcodeHeader =
- "(generated by ImplicitCAD, based of hacklab wiki example)\n"
- ++"M63 P0 (laser off)\n"
- ++"G0 Z0.002 (laser off)\n"
- ++"G21 (units=mm)\n"
- ++"F400 (set feedrate)\n"
- ++"M3 S1 (enable laser)\n"
- ++"\n"
- gcodeFooter =
- "M5 (disable laser)\n"
- ++"G00 X0.0 Y0.0 (move to 0)\n"
- ++"M2 (end)"
- showF n = printf "%.4f" n
- gcodeXY :: ℝ2 -> [Char]
- gcodeXY (x,y) = "X"++ showF x ++" Y"++ showF y
- interpretPolyline (start:others) =
- "G00 "++ gcodeXY start ++ "\n"
- ++ "M62 P0 (laser on)\n"
- ++ concat (map (\p -> "G01 " ++ (gcodeXY p) ++ "\n") others)
- ++ "M63 P0 (laser off)\n\n"
- text = gcodeHeader
- ++ (concat $ map interpretPolyline polylines)
- ++ gcodeFooter
+import Graphics.Implicit.Export.TextBuilderUtils
+import Text.Blaze.Svg.Renderer.Text (renderSvg)
+import Text.Blaze.Svg
+import Text.Blaze.Svg11 ((!),docTypeSvg,g,polyline,toValue)
+import qualified Text.Blaze.Svg11.Attributes as A
+
+import Data.List (foldl')
+
+svg :: [Polyline] -> Text
+svg = renderSvg . svg11 . svg'
+ where
+ svg11 content = docTypeSvg ! A.version "1.1" $ content
+ -- The reason this isn't totally straightforwards is that svg has different coordinate system
+ -- and we need to compute the requisite translation.
+ svg' [] = mempty
+ -- When we have a known point, we can compute said transformation:
+ svg' polylines@((start:_):_) = let (xmin, ymax) = foldl' (foldl' minmax) start polylines
+ in thinBlueGroup $ mapM_ (poly xmin ymax) polylines
+ -- Otherwise, if we don't have a point to start out with, skip this polyline:
+ svg' ([]:rest) = svg' rest
+
+ minmax (xa,ya) (xb,yb) = (min xa xb, max ya yb)
+
+ poly xmin ymax line = polyline ! A.points pointList
+ where pointList = toValue $ toLazyText $ mconcat [bf (x-xmin) <> "," <> bf (ymax - y) <> " " | (x,y) <- line]
+
+ -- Instead of setting styles on every polyline, we wrap the lines in a group element and set the styles on it:
+ thinBlueGroup = g ! A.stroke "rgb(0,0,255)" ! A.strokeWidth "1" ! A.fill "none" -- $ obj
+
+hacklabLaserGCode :: [Polyline] -> Text
+hacklabLaserGCode polylines = toLazyText $ gcodeHeader <> mconcat (map interpretPolyline polylines) <> gcodeFooter
+ where
+ gcodeHeader = mconcat [
+ "(generated by ImplicitCAD, based of hacklab wiki example)\n"
+ ,"M63 P0 (laser off)\n"
+ ,"G0 Z0.002 (laser off)\n"
+ ,"G21 (units=mm)\n"
+ ,"F400 (set feedrate)\n"
+ ,"M3 S1 (enable laser)\n\n"]
+ gcodeFooter = mconcat [
+ "M5 (disable laser)\n"
+ ,"G00 X0.0 Y0.0 (move to 0)\n"
+ ,"M2 (end)"]
+ gcodeXY :: ℝ2 -> Builder
+ gcodeXY (x,y) = mconcat ["X", buildTruncFloat x, " Y", buildTruncFloat y]
+
+ interpretPolyline (start:others) = mconcat [
+ "G00 ", gcodeXY start
+ ,"\nM62 P0 (laser on)\n"
+ ,mconcat [ "G01 " <> gcodeXY point <> "\n" | point <- others]
+ ,"M63 P0 (laser off)\n\n"
+ ]
+ interpretPolyline [] = mempty
View
160 Graphics/Implicit/Export/SymbolicFormats.hs
@@ -1,81 +1,97 @@
+{-# LANGUAGE OverloadedStrings #-}
+
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
-- Released under the GNU GPL, see LICENSE
module Graphics.Implicit.Export.SymbolicFormats where
import Graphics.Implicit.Definitions
-import Data.List as List
-
-scad3 ::-> SymbolicObj3 -> String
-
-scad3 res (UnionR3 0 objs) =
- "union() {\n"
- ++ concat (map ((++"\n") . scad3 res) objs)
- ++ "}\n"
-scad3 res (DifferenceR3 0 objs) =
- "difference() {\n"
- ++ concat (map ((++"\n") . scad3 res) objs)
- ++ "}\n"
-scad3 res (IntersectR3 0 objs) =
- "intersection() {\n"
- ++ concat (map ((++"\n") . scad3 res) objs)
- ++ "}\n"
-scad3 res (Translate3 (x,y,z) obj) =
- "translate ([" ++ show x ++ "," ++ show y ++ "," ++ show z ++ "]) "
- ++ scad3 res obj
-scad3 res (Scale3 (x,y,z) obj) =
- "scale ([" ++ show x ++ "," ++ show y ++ "," ++ show z ++ "]) "
- ++ scad3 res obj
-scad3 _ (Rect3R 0 (x1,y1,z1) (x2,y2,z2)) =
- "translate ([" ++ show x1 ++ "," ++ show y1 ++ "," ++ show z1 ++ "]) "
- ++ "cube ([" ++ show (x2-x1) ++ "," ++ show (y2-y1) ++ "," ++ show (z2-z1) ++ "]);"
-scad3 _ (Cylinder h r1 r2) =
- "cylinder(r1 = " ++ show r1 ++ ", r2 = " ++ show r2 ++ ", " ++ show h ++ ");"
-scad3 _ (Sphere r) =
- "sphere(r = " ++ show r ++");"
-scad3 res (ExtrudeR 0 obj h) =
- "linear_extrude(" ++ show h ++ ")"
- ++ scad2 res obj
-scad3 res (ExtrudeRotateR 0 twist obj h) =
- "linear_extrude(" ++ show h ++ ", twist = " ++ show twist ++ " )"
- ++ scad2 res obj
-scad3 res (ExtrudeRM 0 (Just twist) Nothing Nothing obj (Left height)) =
- let
- for a b = map b a
- a ++! b = a ++ show b
- in (\pieces -> "union(){" ++ concat pieces ++ "}") . for (init [0, res.. height]) $ \h ->
- "rotate ([0,0," ++! twist h ++ "]) "
- ++ "linear_extrude(" ++! res ++ ", twist = " ++! (twist (h+res) - twist h) ++ " )"
- ++ scad2 res obj
-
-scad2 res (UnionR2 0 objs) =
- "union() {\n"
- ++ concat (map ((++"\n") . scad2 res) objs)
- ++ "}\n"
-scad2 res (DifferenceR2 0 objs) =
- "difference() {\n"
- ++ concat (map ((++"\n") . scad2 res) objs)
- ++ "}\n"
-scad2 res (IntersectR2 0 objs) =
- "intersection() {\n"
- ++ concat (map ((++"\n") . scad2 res) objs)
- ++ "}\n"
-scad2 res (Translate2 (x,y) obj) =
- "translate ([" ++ show x ++ "," ++ show y ++ "," ++ "]) "
- ++ scad2 res obj
-scad2 res (Scale2 (x,y) obj) =
- "scale ([" ++ show x ++ "," ++ show y ++ "]) "
- ++ scad2 res obj
-scad2 _ (RectR 0 (x1,y1) (x2,y2)) =
- "translate ([" ++ show x1 ++ "," ++ show y1 ++ "]) "
- ++ "cube ([" ++ show (x2-x1) ++ "," ++ show (y2-y1) ++ "]);"
-scad2 _ (Circle r) = "circle(" ++ show r ++ ");"
-scad2 _ (PolygonR 0 points) =
- "polygon("
- ++ "["
- ++ (concat. List.intersperse "," . map (\(a,b) -> "["++show a++","++show b++"]" ) $ points)
- ++ "]"
- ++ ");"
+import Graphics.Implicit.Export.TextBuilderUtils
+
+import Control.Monad.Reader
+import Control.Monad (sequence)
+
+import Data.List (intersperse)
+
+
+scad2 ::-> SymbolicObj2 -> Text
+scad2 res obj = toLazyText $ runReader (buildS2 obj) res
+
+scad3 ::-> SymbolicObj3 -> Text
+scad3 res obj = toLazyText $ runReader (buildS3 obj) res
+
+
+
+-- Format an openscad call given that all the modified objects are in the Reader monad...
+
+call :: Builder -> [Builder] -> [Reader a Builder] -> Reader a Builder
+call name args [] = return $ name <> buildArgs args <> ";"
+call name args [obj] = fmap ((name <> buildArgs args) <>) obj
+call name args objs = do
+ objs' <- fmap (mconcat . map (<> "\n")) $ sequence objs
+ return $! name <> buildArgs args <> "{\n" <> objs' <> "}\n"
+
+buildArgs [] = "()"
+buildArgs args = "([" <> mconcat (intersperse "," args) <> "])"
+
+
+buildS3 :: SymbolicObj3 -> ReaderBuilder
+
+buildS3 (UnionR3 0 objs) = call "union" [] $ map buildS3 objs
+
+buildS3 (DifferenceR3 0 objs) = call "difference" [] $ map buildS3 objs
+
+buildS3 (IntersectR3 0 objs) = call " intersection" [] $ map buildS3 objs
+
+buildS3 (Translate3 (x,y,z) obj) = call "translate" [bf x, bf y, bf z] [buildS3 obj]
+
+buildS3 (Scale3 (x,y,z) obj) = call "scale" [bf x, bf y, bf x] [buildS3 obj]
+
+buildS3 (Rect3R 0 (x1,y1,z1) (x2,y2,z2)) = call "translate" [bf x1, bf y1, bf z1] [
+ call "cube" [bf $ x2 - x1, bf $ y2 - y1, bf $ z2 - z1] []
+ ]
+buildS3 (Cylinder h r1 r2) = call "cylinder" [
+ "r1 = " <> bf r1
+ ,"r2 = " <> bf r2
+ , bf h
+ ] []
+
+buildS3 (Sphere r) = call "sphere" ["r = " <> bf r] []
+
+buildS3 (ExtrudeR 0 obj h) = call "linear_extrude" [bf h] [buildS2 obj]
+
+buildS3 (ExtrudeRotateR 0 twist obj h) =
+ call "linear_extrude" [bf h, "twist = " <> bf twist] [buildS2 obj]
+
+buildS3 (ExtrudeRM 0 (Just twist) Nothing Nothing obj (Left height)) = do
+ res <- ask
+ call "union" [] [
+ call "rotate" ["0","0", bf $ twist h] [
+ call "linear_extrude" [bf res, "twist = " <> bf (twist (h+res) - twist h)][
+ buildS2 obj
+ ]
+ ] | h <- init [0, res .. height]
+ ]
+
+buildS2 :: SymbolicObj2 -> ReaderBuilder
+
+buildS2 (UnionR2 0 objs) = call "union" [] $ map buildS2 objs
+
+buildS2 (DifferenceR2 0 objs) = call "difference" [] $ map buildS2 objs
+
+buildS2 (IntersectR2 0 objs) = call "intersection" [] $ map buildS2 objs
+
+buildS2 (Translate2 (x,y) obj) = call "translate" [bf x, bf y] $ [buildS2 obj]
+
+buildS2 (Scale2 (x,y) obj) = call "scale" [bf x, bf y] $ [buildS2 obj]
+
+buildS2 (RectR 0 (x1,y1) (x2,y2)) = call "translate" [bf x1, bf y1] [
+ call "cube" [bf $ x2 - x1, bf $ y2 - y1] []
+ ]
+
+buildS2 (Circle r) = call "circle" [bf r] []
+buildS2 (PolygonR 0 points) = call "polygon" [buildVector [x,y] | (x,y) <- points] []
+ where buildVector comps = "[" <> mconcat (intersperse "," $ map bf comps) <> "]"
View
61 Graphics/Implicit/Export/TextBuilderUtils.hs
@@ -0,0 +1,61 @@
+-- This module exists to re-export a coherent set of functions to define
+-- Data.Text.Lazy builders with.
+
+
+module Graphics.Implicit.Export.TextBuilderUtils
+ (
+ -- Values from Data.Text.Lazy
+ Text
+ ,pack
+ ,replicate
+ -- Values from Data.Text.Lazy.Builder, as well as some special builders
+ ,Builder
+ ,toLazyText
+ ,fromLazyText
+ ,buildInt
+ -- Serialize a float in full precision
+ ,bf
+ -- Serialize a float with four decimal places
+ ,buildTruncFloat
+ -- Values from Data.Monoid
+ ,(<>)
+ ,mconcat
+ ,mempty
+
+ ) where
+import Data.Text.Lazy
+-- We manually redefine this operator to avoid a dependency on base >= 4.5
+-- This will become unnecessary later.
+import Data.Monoid hiding ((<>))
+
+import Data.Text.Lazy
+import Data.Text.Lazy.Internal (defaultChunkSize)
+import Data.Text.Lazy.Builder hiding (toLazyText)
+import Data.Text.Lazy.Builder.RealFloat
+import Data.Text.Lazy.Builder.Int
+
+import Graphics.Implicit.Definitions
+
+import Prelude hiding (replicate)
+
+
+-- The chunk size for toLazyText is very small (128 bytes), so we export
+-- a version with a much larger size (~16 K)
+toLazyText :: Builder -> Text
+toLazyText = toLazyTextWith defaultChunkSize
+
+bf, buildTruncFloat ::-> Builder
+
+bf = formatRealFloat Exponent Nothing
+{-# INLINE bf #-}
+
+buildTruncFloat = formatRealFloat Fixed $ Just 4
+
+buildInt :: Int -> Builder
+buildInt = decimal
+
+-- This is directly copied from base 4.5.1.0
+infixr 6 <>
+(<>) :: Monoid m => m -> m -> m
+(<>) = mappend
+{-# INLINE (<>) #-}
View
107 Graphics/Implicit/Export/TriangleMeshFormats.hs
@@ -1,65 +1,64 @@
+{-# LANGUAGE OverloadedStrings #-}
+
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
-- Released under the GNU GPL, see LICENSE
module Graphics.Implicit.Export.TriangleMeshFormats where
import Graphics.Implicit.Definitions
+import Graphics.Implicit.Export.TextBuilderUtils
-stl triangles = text
+stl triangles = toLazyText $ stlHeader <> mconcat (map triangle triangles) <> stlFooter
where
stlHeader = "solid ImplictCADExport\n"
stlFooter = "endsolid ImplictCADExport\n"
- vertex :: ℝ3 -> String
- vertex (x,y,z) = "vertex " ++ show x ++ " " ++ show y ++ " " ++ show z
- stlTriangle :: (ℝ3, ℝ3, ℝ3) -> String
- stlTriangle (a,b,c) =
- "facet normal 0 0 0\n"
- ++ "outer loop\n"
- ++ vertex a ++ "\n"
- ++ vertex b ++ "\n"
- ++ vertex c ++ "\n"
- ++ "endloop\n"
- ++ "endfacet\n"
- text = stlHeader
- ++ (concat $ map stlTriangle triangles)
- ++ stlFooter
-
-
-jsTHREE :: TriangleMesh -> String
-jsTHREE triangles = text
- where
- -- some dense JS. Let's make helper functions so that we don't repeat code each line
- header =
- "var Shape = function(){\n"
- ++ "var s = this;\n"
- ++ "THREE.Geometry.call(this);\n"
- ++ "function vec(x,y,z){return new THREE.Vector3(x,y,z);}\n"
- ++ "function v(x,y,z){s.vertices.push(vec(x,y,z));}\n"
- ++ "function f(a,b,c){"
- ++ "s.faces.push(new THREE.Face3(a,b,c));"
- ++ "}\n"
- footer =
- "}\n"
- ++ "Shape.prototype = new THREE.Geometry();\n"
- ++ "Shape.prototype.constructor = Shape;\n"
- -- A vertex line; v (0.0, 0.0, 1.0) = "v(0.0,0.0,1.0);\n"
- v :: ℝ3 -> String
- v (x,y,z) = "v(" ++ show x ++ "," ++ show y ++ "," ++ show z ++ ");\n"
- -- A face line
- f :: Int -> Int -> Int -> String
- f posa posb posc =
- "f(" ++ show posa ++ "," ++ show posb ++ "," ++ show posc ++ ");"
- verts = do
- -- extract the vertices for each triangle
- -- recall that a normed triangle is of the form ((vert, norm), ...)
- (a,b,c) <- triangles
- -- The vertices from each triangle take up 3 position in the resulting list
- [a,b,c]
- vertcode = concat $ map v verts
- facecode = concat $ do
- (n,_) <- zip [0, 3 ..] triangles
- let
- (posa, posb, posc) = (n, n+1, n+2)
- return $ f posa posb posc
- text = header ++ vertcode ++ facecode ++ footer
+ vertex :: ℝ3 -> Builder
+ vertex (x,y,z) = mconcat ["vertex "
+ ,bf x , " "
+ ,bf y , " "
+ ,bf z]
+ triangle :: (ℝ3, ℝ3, ℝ3) -> Builder
+ triangle (a,b,c) =
+ "facet normal 0 0 0\n"
+ <> "outer loop\n"
+ <> vertex a <> "\n"
+ <> vertex b <> "\n"
+ <> vertex c
+ <> "\nendloop\nendfacet\n"
+jsTHREE :: TriangleMesh -> Text
+jsTHREE triangles = toLazyText $ header <> vertcode <> facecode <> footer
+ where
+ -- some dense JS. Let's make helper functions so that we don't repeat code each line
+ header = mconcat [
+ "var Shape = function(){\n"
+ ,"var s = this;\n"
+ ,"THREE.Geometry.call(this);\n"
+ ,"function vec(x,y,z){return new THREE.Vector3(x,y,z);}\n"
+ ,"function v(x,y,z){s.vertices.push(vec(x,y,z));}\n"
+ ,"function f(a,b,c){"
+ ,"s.faces.push(new THREE.Face3(a,b,c));"
+ ,"}\n" ]
+ footer = mconcat [
+ "}\n"
+ ,"Shape.prototype = new THREE.Geometry();\n"
+ ,"Shape.prototype.constructor = Shape;\n" ]
+ -- A vertex line; v (0.0, 0.0, 1.0) = "v(0.0,0.0,1.0);\n"
+ v :: ℝ3 -> Builder
+ v (x,y,z) = "v(" <> bf x <> "," <> bf y <> "," <> bf z <> ");\n"
+ -- A face line
+ f :: Int -> Int -> Int -> Builder
+ f posa posb posc =
+ "f(" <> buildInt posa <> "," <> buildInt posb <> "," <> buildInt posc <> ");"
+ verts = do
+ -- extract the vertices for each triangle
+ -- recall that a normed triangle is of the form ((vert, norm), ...)
+ (a,b,c) <- triangles
+ -- The vertices from each triangle take up 3 position in the resulting list
+ [a,b,c]
+ vertcode = mconcat $ map v verts
+ facecode = mconcat $ do
+ (n,_) <- zip [0, 3 ..] triangles
+ let
+ (posa, posb, posc) = (n, n+1, n+2)
+ return $ f posa posb posc
View
10 implicit.cabal
@@ -23,8 +23,11 @@ Library
parallel,
containers,
plugins,
- deepseq
-
+ deepseq,
+ text,
+ blaze-svg,
+ mtl
+
ghc-options:
-O2 -optc-O3
-threaded
@@ -47,7 +50,8 @@ Library
ScopedTypeVariables,
TypeSynonymInstances,
UndecidableInstances,
- ViewPatterns
+ ViewPatterns,
+ OverloadedStrings
Exposed-Modules:
Graphics.Implicit
Please sign in to comment.
Something went wrong with that request. Please try again.