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
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
|
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 = 12*4, depth = 12, boardThickness = 1,
shelfHeights = [15, 8, 8, 8] }
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)]
data ModeledShelf = ModeledShelf {
shelfDimensions :: V3 Double,
shelfPositions :: [V3 Double],
sideDimensions :: V3 Double,
sidePositions :: [V3 Double],
rendered :: [Model3d],
cutlist :: String
} deriving (Show)
modelShelf''' :: Shelf -> ModeledShelf
modelShelf''' s =
ModeledShelf { shelfDimensions = shelfB,
shelfPositions = shelfP,
sideDimensions = sideB,
sidePositions = sideP,
rendered = placeColored red sideB sideP ++
placeColored blue shelfB shelfP,
cutlist = cutlist
}
where shelfHeight = sum (shelfHeights s) + (boardThickness s) *
(fromIntegral (length $ shelfHeights s) + 1)
sideB = V3 (boardThickness s) (depth s) shelfHeight
sideP = at [0, boardThickness s + width s] [0] [0]
shelfB = V3 (width s) (depth s) (boardThickness s)
shelfP = at [(boardThickness s)] [0] $ scanl (+) 0 [h + (boardThickness s)|h <- (shelfHeights s)]
cutlist = "Shelves: (" ++ (show (length shelfP)) ++ ") @ "
++ (show shelfB) ++
"\nSides: (2) @ " ++ (show sideB)
assembleShelf s = assemble [shelves, sides]
where
shelfHeight =
sum (shelfHeights s) +
(boardThickness s) * (fromIntegral (length $ shelfHeights s) + 1)
sides =
let sideB = V3 (boardThickness s) (depth s) shelfHeight
sideP = at [0, boardThickness s + width s] [0] [0]
in component "sides" "blue" sideB _xyz sideP
shelves =
let shelfB = V3 (width s) (depth s) (boardThickness s)
shelfP =
let pz =
scanl (+) 0 [h + (boardThickness s) | h <- (shelfHeights s)]
in at [(boardThickness s)] [0] pz
in component "shelves" "red" shelfB _xyz shelfP
shelf :: String
shelf = renderL $ modelShelf myShelf
shelf' :: String
shelf' = renderL $ modelShelf' myShelf
shelf'' :: String
shelf'' = renderL $ modelShelf'' myShelf
mesh = assembleShelf myShelf
main :: IO ProcessHandle
main = let (cuts, model) = assembleShelf myShelf
in do putStrLn cuts
openTempSCAD $ renderL model
|