From 293a45b57769ac1ef52bdab370ccf32851a8fc4b Mon Sep 17 00:00:00 2001 From: Steven Date: Fri, 24 May 2019 18:40:20 -0400 Subject: Added new interface `assemble` and `component` to OpenSCAD.Carpentry; reimplemented shelves.hs with above interface. (This interface broke the ability to change board colors; a fix is coming up) --- OpenSCAD/Carpentry.hs | 101 +++++++++++++++++++++++++++++++++++++++++++++++++- shelves.hs | 52 +++++++++++++++++++++++++- 2 files changed, 149 insertions(+), 4 deletions(-) diff --git a/OpenSCAD/Carpentry.hs b/OpenSCAD/Carpentry.hs index 7191781..060754d 100644 --- a/OpenSCAD/Carpentry.hs +++ b/OpenSCAD/Carpentry.hs @@ -4,12 +4,15 @@ module OpenSCAD.Carpentry place , placeColored , placeAlong +, placeTransformed , at , spreadEvenly , v3box , v3translate , writeTempSCAD , openTempSCAD +, assemble +, component ) where import Control.Applicative @@ -18,6 +21,10 @@ import Graphics.OpenSCAD import Linear.V3 import System.IO.Temp import System.Process +import Data.List +import Data.Functor +import Data.Maybe +import Data.Either v3box :: R3 t => t Double -> Model3d v3box v = box (v ^. _x) (v ^. _y) (v ^. _z) @@ -27,11 +34,14 @@ v3translate v m = translate (v ^. _x, v ^. _y, v ^. _z) m -- ^ doesn't work ?? place :: (R3 t1, R3 t2) => t2 Double -> [t1 Double] -> [Model (Double, Double, Double)] -place board coords = map boardAt coords +place board coords = map (placeOne board) coords where boardAt p = translate (p ^. _x, p ^. _y, p ^. _z) $ v3box board -- boardAt p = v3translate p $ v3box board +placeOne b c = translate (c ^. _x, c ^. _y, c ^. _z) $ v3box b + +placeTransformed t r = t $ place r -- intended usage: place (V3 2 4 16) $ at [0] [0,4..(20*12)] [0] -- (which would, e.g., place 2x4 planks next to each other for 20 feet (e.g., floor boards) @@ -43,7 +53,6 @@ placeColored rgb board coords = map boardAt coords where boardAt p = color rgb $ translate (p ^. _x, p ^. _y, p ^. _z) $ v3box board - -- deprecated due to the superiority of using place in conjunction with at -- placeAlong (V3 2 4 16) (V3 0 0 0) (_x +~ 4) _x (<= 20) placeAlong :: @@ -64,6 +73,94 @@ placeAlong board initial shift targ cond = else [] in initial : next initial + + +-- data CarpentryProject = CarpentryProject +-- { dimensions :: V3 Double +-- , components :: [ProjectCompnent] +-- } deriving (Show) + +-- data Component = Component { +-- name :: String, +-- , dim :: V3 Double +-- , orient :: +-- } +-- assemble +-- assemble [ component "shelves" (V3 1 8 36) _xyz $ at [0] [0,12,24,36] [0] +-- , component "sides" (V3 1 8 40) _xyz $ at [0] [0,36] [0] ] + +assemble c = (cutlist, model) + where + model = concatMap (\(_, b, o, p) -> place (b ^. o) p) c + cutlist = putStrLn $ intercalate "\n" $ map tocut c + tocut (n, b, _, p) = n ++ " (" ++ (show $ length p) ++ ") @ " ++ v3toStr b + v3toStr c = show (c ^. _x) ++ " x " ++ show (c ^. _y) ++ " x " ++ show (c ^. _z) + +-- assemble' c = (cutlist, model) +-- where +-- model = let placeBoard b p = translate (p ^. _x, p ^. _y, p ^. _z) $ v3box b +-- in concatMap (\(_, b, o, p, tf) placeBoard +-- boardAt p = +component name dim orient pos = (name, dim, orient, pos) + +-- ass :: +-- ass v = show v + +-- maybeMore :: Either a [a] +-- maybeMore x = either [x] x x + +-- count :: Either a0 [a1] -> Int +-- count (Left a) = length [a] +-- count (Right b) = length b + +-- maybeMore :: Maybe [a] -> [a] +-- maybeMore x = [x] +-- maybeMore [x] = [x] + +-- maybeMore :: Maybe [a] -> [a] +-- maybeMore x = fromMaybe + + + +-- data Many = Left [a] | Right b +-- maybeMany :: Many -> Int +-- maybeMany Left x = x +-- maybeMany Right x = [x] + +-- data AlwaysMany = FromOne a | AlreadyMany [a] +-- alwaysMany (FromOne x) = [x] +-- alwaysMany (AlreadyMany x) = x + +-- data AlwaysMany a b = Left a | Right b +-- data Many a = Either [a] + +-- alwaysMany :: Many a -> Int +-- alwaysMany (Right x) = x + +-- type OnceOne a = [a] +-- type AlreadyMany a = [a] +-- data AlwaysMany a = OnceOne a | AlreadyMany a deriving (Foldable, Eq, Ord) + +-- alwaysMany :: AlwaysMany a -> Int +-- alwaysMany x = length x + + +-- data AlwaysMany a = Maybe [a] | Just [a] +-- alwaysMany :: AlwaysMany a -> [a] +-- alwaysMany x = x + + +-- count x +-- -- where y = if isLeft x then [x] else x +-- | isLeft x = length [x] +-- | otherwise = length x + +-- which :: Either String Int -> String +-- which x = either show show x +-- which Left x = "string" +-- which Right x = "int" + + -- evenly spread number of boards (of the width ) in space -- e.g., if you want to have a 20x20 space and want support beams every 16": -- spreadEvenly 2 20 (20*12/16) diff --git a/shelves.hs b/shelves.hs index c560cf4..16f029f 100644 --- a/shelves.hs +++ b/shelves.hs @@ -14,8 +14,8 @@ data Shelf = Shelf { } deriving (Show) myShelf :: Shelf -myShelf = Shelf { width = 36, depth = 8, boardThickness = 1, - shelfHeights = [12, 12, 10, 10, 6, 6, 6] } +myShelf = Shelf { width = 12*4, depth = 12, boardThickness = 1, + shelfHeights = [15, 8, 8, 8] } calcShelfHeights :: Shelf -> [Double] @@ -54,6 +54,52 @@ modelShelf'' s = 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" 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" shelfB _xyz shelfP + shelf :: String shelf = renderL $ modelShelf myShelf @@ -62,5 +108,7 @@ shelf' = renderL $ modelShelf' myShelf shelf'' :: String shelf'' = renderL $ modelShelf'' myShelf +(cuts, model) = assembleShelf myShelf + main :: IO ProcessHandle main = openTempSCAD $ shelf'' -- cgit v1.2.3