diff options
Diffstat (limited to 'OpenSCAD/Carpentry.hs')
-rw-r--r-- | OpenSCAD/Carpentry.hs | 101 |
1 files changed, 99 insertions, 2 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 | |||
4 | place | 4 | place |
5 | , placeColored | 5 | , placeColored |
6 | , placeAlong | 6 | , placeAlong |
7 | , placeTransformed | ||
7 | , at | 8 | , at |
8 | , spreadEvenly | 9 | , spreadEvenly |
9 | , v3box | 10 | , v3box |
10 | , v3translate | 11 | , v3translate |
11 | , writeTempSCAD | 12 | , writeTempSCAD |
12 | , openTempSCAD | 13 | , openTempSCAD |
14 | , assemble | ||
15 | , component | ||
13 | ) where | 16 | ) where |
14 | 17 | ||
15 | import Control.Applicative | 18 | import Control.Applicative |
@@ -18,6 +21,10 @@ import Graphics.OpenSCAD | |||
18 | import Linear.V3 | 21 | import Linear.V3 |
19 | import System.IO.Temp | 22 | import System.IO.Temp |
20 | import System.Process | 23 | import System.Process |
24 | import Data.List | ||
25 | import Data.Functor | ||
26 | import Data.Maybe | ||
27 | import Data.Either | ||
21 | 28 | ||
22 | v3box :: R3 t => t Double -> Model3d | 29 | v3box :: R3 t => t Double -> Model3d |
23 | v3box v = box (v ^. _x) (v ^. _y) (v ^. _z) | 30 | v3box v = box (v ^. _x) (v ^. _y) (v ^. _z) |
@@ -27,11 +34,14 @@ v3translate v m = translate (v ^. _x, v ^. _y, v ^. _z) m | |||
27 | -- ^ doesn't work ?? | 34 | -- ^ doesn't work ?? |
28 | 35 | ||
29 | place :: (R3 t1, R3 t2) => t2 Double -> [t1 Double] -> [Model (Double, Double, Double)] | 36 | place :: (R3 t1, R3 t2) => t2 Double -> [t1 Double] -> [Model (Double, Double, Double)] |
30 | place board coords = map boardAt coords | 37 | place board coords = map (placeOne board) coords |
31 | where | 38 | where |
32 | boardAt p = translate (p ^. _x, p ^. _y, p ^. _z) $ v3box board | 39 | boardAt p = translate (p ^. _x, p ^. _y, p ^. _z) $ v3box board |
33 | -- boardAt p = v3translate p $ v3box board | 40 | -- boardAt p = v3translate p $ v3box board |
34 | 41 | ||
42 | placeOne b c = translate (c ^. _x, c ^. _y, c ^. _z) $ v3box b | ||
43 | |||
44 | placeTransformed t r = t $ place r | ||
35 | 45 | ||
36 | -- intended usage: place (V3 2 4 16) $ at [0] [0,4..(20*12)] [0] | 46 | -- intended usage: place (V3 2 4 16) $ at [0] [0,4..(20*12)] [0] |
37 | -- (which would, e.g., place 2x4 planks next to each other for 20 feet (e.g., floor boards) | 47 | -- (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 | |||
43 | where | 53 | where |
44 | boardAt p = color rgb $ translate (p ^. _x, p ^. _y, p ^. _z) $ v3box board | 54 | boardAt p = color rgb $ translate (p ^. _x, p ^. _y, p ^. _z) $ v3box board |
45 | 55 | ||
46 | |||
47 | -- deprecated due to the superiority of using place in conjunction with at | 56 | -- deprecated due to the superiority of using place in conjunction with at |
48 | -- placeAlong (V3 2 4 16) (V3 0 0 0) (_x +~ 4) _x (<= 20) | 57 | -- placeAlong (V3 2 4 16) (V3 0 0 0) (_x +~ 4) _x (<= 20) |
49 | placeAlong :: | 58 | placeAlong :: |
@@ -64,6 +73,94 @@ placeAlong board initial shift targ cond = | |||
64 | else [] | 73 | else [] |
65 | in initial : next initial | 74 | in initial : next initial |
66 | 75 | ||
76 | |||
77 | |||
78 | -- data CarpentryProject = CarpentryProject | ||
79 | -- { dimensions :: V3 Double | ||
80 | -- , components :: [ProjectCompnent] | ||
81 | -- } deriving (Show) | ||
82 | |||
83 | -- data Component = Component { | ||
84 | -- name :: String, | ||
85 | -- , dim :: V3 Double | ||
86 | -- , orient :: | ||
87 | -- } | ||
88 | -- assemble | ||
89 | -- assemble [ component "shelves" (V3 1 8 36) _xyz $ at [0] [0,12,24,36] [0] | ||
90 | -- , component "sides" (V3 1 8 40) _xyz $ at [0] [0,36] [0] ] | ||
91 | |||
92 | assemble c = (cutlist, model) | ||
93 | where | ||
94 | model = concatMap (\(_, b, o, p) -> place (b ^. o) p) c | ||
95 | cutlist = putStrLn $ intercalate "\n" $ map tocut c | ||
96 | tocut (n, b, _, p) = n ++ " (" ++ (show $ length p) ++ ") @ " ++ v3toStr b | ||
97 | v3toStr c = show (c ^. _x) ++ " x " ++ show (c ^. _y) ++ " x " ++ show (c ^. _z) | ||
98 | |||
99 | -- assemble' c = (cutlist, model) | ||
100 | -- where | ||
101 | -- model = let placeBoard b p = translate (p ^. _x, p ^. _y, p ^. _z) $ v3box b | ||
102 | -- in concatMap (\(_, b, o, p, tf) placeBoard | ||
103 | -- boardAt p = | ||
104 | component name dim orient pos = (name, dim, orient, pos) | ||
105 | |||
106 | -- ass :: | ||
107 | -- ass v = show v | ||
108 | |||
109 | -- maybeMore :: Either a [a] | ||
110 | -- maybeMore x = either [x] x x | ||
111 | |||
112 | -- count :: Either a0 [a1] -> Int | ||
113 | -- count (Left a) = length [a] | ||
114 | -- count (Right b) = length b | ||
115 | |||
116 | -- maybeMore :: Maybe [a] -> [a] | ||
117 | -- maybeMore x = [x] | ||
118 | -- maybeMore [x] = [x] | ||
119 | |||
120 | -- maybeMore :: Maybe [a] -> [a] | ||
121 | -- maybeMore x = fromMaybe | ||
122 | |||
123 | |||
124 | |||
125 | -- data Many = Left [a] | Right b | ||
126 | -- maybeMany :: Many -> Int | ||
127 | -- maybeMany Left x = x | ||
128 | -- maybeMany Right x = [x] | ||
129 | |||
130 | -- data AlwaysMany = FromOne a | AlreadyMany [a] | ||
131 | -- alwaysMany (FromOne x) = [x] | ||
132 | -- alwaysMany (AlreadyMany x) = x | ||
133 | |||
134 | -- data AlwaysMany a b = Left a | Right b | ||
135 | -- data Many a = Either [a] | ||
136 | |||
137 | -- alwaysMany :: Many a -> Int | ||
138 | -- alwaysMany (Right x) = x | ||
139 | |||
140 | -- type OnceOne a = [a] | ||
141 | -- type AlreadyMany a = [a] | ||
142 | -- data AlwaysMany a = OnceOne a | AlreadyMany a deriving (Foldable, Eq, Ord) | ||
143 | |||
144 | -- alwaysMany :: AlwaysMany a -> Int | ||
145 | -- alwaysMany x = length x | ||
146 | |||
147 | |||
148 | -- data AlwaysMany a = Maybe [a] | Just [a] | ||
149 | -- alwaysMany :: AlwaysMany a -> [a] | ||
150 | -- alwaysMany x = x | ||
151 | |||
152 | |||
153 | -- count x | ||
154 | -- -- where y = if isLeft x then [x] else x | ||
155 | -- | isLeft x = length [x] | ||
156 | -- | otherwise = length x | ||
157 | |||
158 | -- which :: Either String Int -> String | ||
159 | -- which x = either show show x | ||
160 | -- which Left x = "string" | ||
161 | -- which Right x = "int" | ||
162 | |||
163 | |||
67 | -- evenly spread <boardCount> number of boards (of the width <boardWidth>) in <span> space | 164 | -- evenly spread <boardCount> number of boards (of the width <boardWidth>) in <span> space |
68 | -- e.g., if you want to have a 20x20 space and want support beams every 16": | 165 | -- e.g., if you want to have a 20x20 space and want support beams every 16": |
69 | -- spreadEvenly 2 20 (20*12/16) | 166 | -- spreadEvenly 2 20 (20*12/16) |