summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSteven <steven.vasilogianis@gmail.com>2019-04-25 19:08:19 -0400
committerSteven <steven.vasilogianis@gmail.com>2019-04-25 19:08:19 -0400
commit10966b90b18022b895c04c38e728067a57218ee2 (patch)
tree89f145e02972f0f4d7d5eed4d95dd08e5498de59
parentcf8ffed2dce0ca9bba3faad6e9607badffb0aae0 (diff)
added support for new interface of OpenSCAD/Carpentry
-rw-r--r--shelves.hs55
1 files changed, 47 insertions, 8 deletions
diff --git a/shelves.hs b/shelves.hs
index 73551f2..c560cf4 100644
--- a/shelves.hs
+++ b/shelves.hs
@@ -1,27 +1,66 @@
1import Graphics.OpenSCAD 1import Graphics.OpenSCAD
2import Linear.V3
3import OpenSCAD.Carpentry
4import System.Process
2 5
6-- the minimum paramaters to describe a shelf; the width and depth of a shelf,
7-- a list consisting of the height of each shelf (from the bottom up).
8-- boardThickness is the thickness of the boards to be used
3data Shelf = Shelf { 9data Shelf = Shelf {
4 width :: Double, 10 width :: Double,
5 depth :: Double, 11 depth :: Double,
6 boardThickness :: Double, 12 shelfHeights :: [Double],
7 shelfHeights :: [Double] 13 boardThickness :: Double
8} deriving (Show) 14} deriving (Show)
9 15
10myShelf :: Shelf 16myShelf :: Shelf
11myShelf = Shelf { width = 36, depth = 8, boardThickness = 1, 17myShelf = Shelf { width = 36, depth = 8, boardThickness = 1,
12 shelfHeights = [12, 12, 10, 10, 6, 6, 6] } 18 shelfHeights = [12, 12, 10, 10, 6, 6, 6] }
13 19
20
21calcShelfHeights :: Shelf -> [Double]
22calcShelfHeights s = scanl (+) 0 [h + (boardThickness s)|h <- (shelfHeights s)]
23
14modelShelf :: Shelf -> [Model3d] 24modelShelf :: Shelf -> [Model3d]
15modelShelf s = 25modelShelf s =
16 let sidesPos = [(0,0,0), (boardThickness s + width s, 0, 0)] 26 let sidesPos = [(0,0,0), (boardThickness s + width s, 0, 0)]
17 shelvesPos = let ys = scanl (+) 0 [h + boardThickness s|h <- shelfHeights s] 27 shelvesPos = let ys = scanl (+) 0 [h + boardThickness s|h <- shelfHeights s]
18 in [ (boardThickness s, 0, y) | y <- ys ] 28 in [ (boardThickness s, 0, y) | y <- ys ]
19 place board places = map (\p -> translate p board) places 29 place' board places = map (\p -> translate p board) places
20 in place sideBoard sidesPos ++ place shelfBoard shelvesPos 30 in place' sideBoard sidesPos ++ place' shelfBoard shelvesPos
21 where shelfHeight = sum (shelfHeights s) + (boardThickness s) * 31 where shelfHeight = sum (shelfHeights s) + (boardThickness s) *
22 (fromIntegral (length $ shelfHeights s) + 1) 32 (fromIntegral (length $ shelfHeights s) + 1)
23 sideBoard = box (boardThickness s) (depth s) shelfHeight 33 sideBoard = box (boardThickness s) (depth s) shelfHeight
24 shelfBoard = box (width s) (depth s) (boardThickness s) 34 shelfBoard = box (width s) (depth s) (boardThickness s)
25 35
26main :: IO () 36modelShelf' :: Shelf -> [Model3d]
27main = drawL $ modelShelf myShelf 37modelShelf' s =
38 place sideBoard [V3 0 0 0, V3 (boardThickness s + width s) 0 0] ++
39 place shelfBoard [(V3 (boardThickness s) 0 z) | z <- shelfZs]
40 where shelfHeight = sum (shelfHeights s) + (boardThickness s) *
41 (fromIntegral (length $ shelfHeights s) + 1)
42 sideBoard = V3 (boardThickness s) (depth s) shelfHeight
43 shelfBoard = V3 (width s) (depth s) (boardThickness s)
44 shelfZs = scanl (+) 0 [h + boardThickness s|h <- (shelfHeights s)]
45
46modelShelf'' :: Shelf -> [Model3d]
47modelShelf'' s =
48 let sides = placeColored red sideBoard $ at [0, boardThickness s + width s] [0] [0]
49 shelves = placeColored blue shelfBoard $ at [(boardThickness s)] [0] shelfZs
50 in sides ++ shelves
51 where shelfHeight = sum (shelfHeights s) + (boardThickness s) *
52 (fromIntegral (length $ shelfHeights s) + 1)
53 sideBoard = V3 (boardThickness s) (depth s) shelfHeight
54 shelfBoard = V3 (width s) (depth s) (boardThickness s)
55 shelfZs = scanl (+) 0 [h + (boardThickness s)|h <- (shelfHeights s)]
56
57
58shelf :: String
59shelf = renderL $ modelShelf myShelf
60shelf' :: String
61shelf' = renderL $ modelShelf' myShelf
62shelf'' :: String
63shelf'' = renderL $ modelShelf'' myShelf
64
65main :: IO ProcessHandle
66main = openTempSCAD $ shelf''