add & switch to bunk bed

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 {
 modelShelf :: Shelf -> Model3d
 modelShelf = transBoxes . shelves'
 
+data BunkBed = BunkBed {
+  bunkBedWidth :: Inches,
+  bunkBedLength :: Inches,
+  bunkBedPostThickness :: Inches,
+  bunkBedPostRise :: Inches,
+  bunkBedShelfThickness :: Inches,
+  bunkBedBottomShelfHeight :: Inches,
+  bunkBedTopShelfHeight :: Inches
+}
+
+myBunkBed :: BunkBed
+myBunkBed = BunkBed {
+  bunkBedWidth = 54,
+  bunkBedLength = 75,
+  bunkBedPostThickness = 3,
+  bunkBedPostRise = 2,
+  bunkBedShelfThickness = 8,
+  bunkBedBottomShelfHeight = 18,
+  bunkBedTopShelfHeight = 50
+}
+
+modelBunkBed :: BunkBed -> Model3d
+modelBunkBed BunkBed{..} = union $ posts ++ topBed ++ bottomBed
+  where
+    bunkBedPostHeight = bunkBedPostRise + bunkBedTopShelfHeight + bunkBedShelfThickness
+    post = box bunkBedPostThickness bunkBedPostThickness bunkBedPostHeight
+    posts = [post,
+             translate (bunkBedWidth - bunkBedPostThickness, 0, 0) post,
+             translate (0, bunkBedLength - bunkBedPostThickness, 0) post,
+             translate (bunkBedWidth - bunkBedPostThickness, bunkBedLength - bunkBedPostThickness, 0) post]
+    bedShelf = box bunkBedWidth bunkBedLength bunkBedShelfThickness
+    topBed = [translate (0, 0, bunkBedBottomShelfHeight) bedShelf]
+    bottomBed = [translate (0, 0, bunkBedTopShelfHeight) bedShelf]
+
 main :: IO ()
-main = draw $ modelShelf myShelf
+-- main = draw $ modelShelf myShelf
+main = draw $ modelBunkBed myBunkBed