From 293a45b57769ac1ef52bdab370ccf32851a8fc4b Mon Sep 17 00:00:00 2001
From: Steven <steven.vasilogianis@gmail.com>
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 +++++++++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 99 insertions(+), 2 deletions(-)

(limited to 'OpenSCAD/Carpentry.hs')

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 <boardCount> number of boards (of the width <boardWidth>) in <span> space
 -- e.g., if you want to have a 20x20 space and want support beams every 16":
 -- spreadEvenly 2 20 (20*12/16)
-- 
cgit v1.2.3