1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
|
{-# LANGUAGE FlexibleContexts #-}
module OpenSCAD.Carpentry
(
place
, placeColored
, placeAlong
, placeTransformed
, at
, spreadEvenly
, v3box
, v3translate
, writeTempSCAD
, openTempSCAD
, assemble
, component
) where
import Control.Applicative
import Control.Lens hiding (at)
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)
v3translate :: (Vector (c, c, c), R3 t) => t c -> Model (c, c, c) -> Model (c, c, c)
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 (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)
at :: Applicative f => f a -> f a -> f a -> f (V3 a)
at = liftA3 V3
--at x y z = V3 <$> x <*> y <*> z -- same as above
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 ::
(R3 t1, R3 t2) =>
t2 Double
-> t1 Double
-> (t1 Double -> t1 Double)
-> ((t -> Const t t) -> t1 Double -> Const t (t1 Double))
-> (t -> Bool)
-> [Model (Double, Double, Double)]
placeAlong board initial shift targ cond =
place board positions
where positions =
let next x =
let p = x & shift
in if cond (p ^. targ)
then p : next p
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)
spreadEvenly boardWidth fillSpace boardCount =
let dist = (fillSpace - boardWidth) / fromIntegral (boardCount - 1)
in take boardCount $ iterate (+dist) 0
writeTempSCAD :: String -> IO FilePath
writeTempSCAD scadstr = writeSystemTempFile "genscad.scad" scadstr
openTempSCAD :: String -> IO ProcessHandle
openTempSCAD scadstr = do
fp <- writeTempSCAD scadstr
runCommand $ "openscad " ++ fp
|
