1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
|
import Graphics.OpenSCAD
import Linear.V3
import OpenSCAD.Carpentry
import System.Process
-- the minimum paramaters to describe a shelf; the width and depth of a shelf,
-- a list consisting of the height of each shelf (from the bottom up).
-- boardThickness is the thickness of the boards to be used
data Shelf = Shelf {
width :: Double,
depth :: Double,
shelfHeights :: [Double],
boardThickness :: Double
} deriving (Show)
myShelf :: Shelf
myShelf = Shelf { width = 36, depth = 8, boardThickness = 1,
shelfHeights = [12, 12, 10, 10, 6, 6, 6] }
calcShelfHeights :: Shelf -> [Double]
calcShelfHeights s = scanl (+) 0 [h + (boardThickness s)|h <- (shelfHeights s)]
modelShelf :: Shelf -> [Model3d]
modelShelf s =
let sidesPos = [(0,0,0), (boardThickness s + width s, 0, 0)]
shelvesPos = let ys = scanl (+) 0 [h + boardThickness s|h <- shelfHeights s]
in [ (boardThickness s, 0, y) | y <- ys ]
place' board places = map (\p -> translate p board) places
in place' sideBoard sidesPos ++ place' shelfBoard shelvesPos
where shelfHeight = sum (shelfHeights s) + (boardThickness s) *
(fromIntegral (length $ shelfHeights s) + 1)
sideBoard = box (boardThickness s) (depth s) shelfHeight
shelfBoard = box (width s) (depth s) (boardThickness s)
modelShelf' :: Shelf -> [Model3d]
modelShelf' s =
place sideBoard [V3 0 0 0, V3 (boardThickness s + width s) 0 0] ++
place shelfBoard [(V3 (boardThickness s) 0 z) | z <- shelfZs]
where shelfHeight = sum (shelfHeights s) + (boardThickness s) *
(fromIntegral (length $ shelfHeights s) + 1)
sideBoard = V3 (boardThickness s) (depth s) shelfHeight
shelfBoard = V3 (width s) (depth s) (boardThickness s)
shelfZs = scanl (+) 0 [h + boardThickness s|h <- (shelfHeights s)]
modelShelf'' :: Shelf -> [Model3d]
modelShelf'' s =
let sides = placeColored red sideBoard $ at [0, boardThickness s + width s] [0] [0]
shelves = placeColored blue shelfBoard $ at [(boardThickness s)] [0] shelfZs
in sides ++ shelves
where shelfHeight = sum (shelfHeights s) + (boardThickness s) *
(fromIntegral (length $ shelfHeights s) + 1)
sideBoard = V3 (boardThickness s) (depth s) shelfHeight
shelfBoard = V3 (width s) (depth s) (boardThickness s)
shelfZs = scanl (+) 0 [h + (boardThickness s)|h <- (shelfHeights s)]
shelf :: String
shelf = renderL $ modelShelf myShelf
shelf' :: String
shelf' = renderL $ modelShelf' myShelf
shelf'' :: String
shelf'' = renderL $ modelShelf'' myShelf
main :: IO ProcessHandle
main = openTempSCAD $ shelf''
|
