summaryrefslogtreecommitdiff
path: root/shelves.hs
diff options
context:
space:
mode:
Diffstat (limited to 'shelves.hs')
-rw-r--r--shelves.hs37
1 files changed, 36 insertions, 1 deletions
diff --git a/shelves.hs b/shelves.hs
index c6364e1..2428015 100644
--- a/shelves.hs
+++ b/shelves.hs
@@ -48,6 +48,41 @@ myShelf = Shelf {
48modelShelf :: Shelf -> Model3d 48modelShelf :: Shelf -> Model3d
49modelShelf = transBoxes . shelves' 49modelShelf = transBoxes . shelves'
50 50
51data BunkBed = BunkBed {
52 bunkBedWidth :: Inches,
53 bunkBedLength :: Inches,
54 bunkBedPostThickness :: Inches,
55 bunkBedPostRise :: Inches,
56 bunkBedShelfThickness :: Inches,
57 bunkBedBottomShelfHeight :: Inches,
58 bunkBedTopShelfHeight :: Inches
59}
60
61myBunkBed :: BunkBed
62myBunkBed = BunkBed {
63 bunkBedWidth = 54,
64 bunkBedLength = 75,
65 bunkBedPostThickness = 3,
66 bunkBedPostRise = 2,
67 bunkBedShelfThickness = 8,
68 bunkBedBottomShelfHeight = 18,
69 bunkBedTopShelfHeight = 50
70}
71
72modelBunkBed :: BunkBed -> Model3d
73modelBunkBed BunkBed{..} = union $ posts ++ topBed ++ bottomBed
74 where
75 bunkBedPostHeight = bunkBedPostRise + bunkBedTopShelfHeight + bunkBedShelfThickness
76 post = box bunkBedPostThickness bunkBedPostThickness bunkBedPostHeight
77 posts = [post,
78 translate (bunkBedWidth - bunkBedPostThickness, 0, 0) post,
79 translate (0, bunkBedLength - bunkBedPostThickness, 0) post,
80 translate (bunkBedWidth - bunkBedPostThickness, bunkBedLength - bunkBedPostThickness, 0) post]
81 bedShelf = box bunkBedWidth bunkBedLength bunkBedShelfThickness
82 topBed = [translate (0, 0, bunkBedBottomShelfHeight) bedShelf]
83 bottomBed = [translate (0, 0, bunkBedTopShelfHeight) bedShelf]
84
51main :: IO () 85main :: IO ()
52main = draw $ modelShelf myShelf 86-- main = draw $ modelShelf myShelf
87main = draw $ modelBunkBed myBunkBed
53 88