{-# LANGUAGE RecordWildCards #-} import Control.Lens import Graphics.OpenSCAD import Linear.V3 genscad :: [(V3 Double, V3 Double)] -> String genscad = render . transBoxes transBoxes :: [(V3 Double, V3 Double)] -> Model Vector3d transBoxes = union . map transBox transBox :: (V3 Double, V3 Double) -> Model3d transBox (V3 x1 y1 z1, V3 x2 y2 z2) = translate (x1,y1,z1) $ box x2 y2 z2 type Inches = Double data Shelf = Shelf { shelfThickness :: Inches, shelfWidth :: Inches, shelfLength :: Inches, shelfHeights :: [Inches], shelfSideDimX :: Inches } modelShelf :: Shelf -> Model3d modelShelf Shelf{..} = transBoxes [(p, V3 shelfLength shelfWidth shelfThickness) | p <- shelvesPos] where shelfHeight = sum shelfHeights + (shelfThickness * (fromIntegral (length shelfHeights) + 1)) shelfSideDim :: V3 Inches shelfSideDim = V3 shelfSideDimX shelfWidth shelfHeight shelfYPos :: [Inches] shelfYPos = scanl (+) 0 [h+shelfThickness| h <- shelfHeights] shelvesPos :: [V3 Double] shelvesPos = [V3 (shelfSideDim ^. _x) 0 y | y <- shelfYPos] myShelf :: Shelf myShelf = Shelf { shelfThickness = 0.5, shelfWidth = 8, shelfLength = 36 * 2, shelfHeights = [12, 10, 8, 8, 8, 8, 8], shelfSideDimX = 0.5 } 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 $ modelBunkBed myBunkBed