diff options
-rw-r--r-- | OpenSCAD/Carpentry.hs | 51 |
1 files changed, 47 insertions, 4 deletions
diff --git a/OpenSCAD/Carpentry.hs b/OpenSCAD/Carpentry.hs index 8c0eebe..7191781 100644 --- a/OpenSCAD/Carpentry.hs +++ b/OpenSCAD/Carpentry.hs | |||
@@ -2,30 +2,58 @@ | |||
2 | module OpenSCAD.Carpentry | 2 | module OpenSCAD.Carpentry |
3 | ( | 3 | ( |
4 | place | 4 | place |
5 | , placeColored | ||
5 | , placeAlong | 6 | , placeAlong |
7 | , at | ||
8 | , spreadEvenly | ||
6 | , v3box | 9 | , v3box |
7 | , v3translate | 10 | , v3translate |
11 | , writeTempSCAD | ||
12 | , openTempSCAD | ||
8 | ) where | 13 | ) where |
9 | 14 | ||
10 | import Control.Lens | 15 | import Control.Applicative |
16 | import Control.Lens hiding (at) | ||
11 | import Graphics.OpenSCAD | 17 | import Graphics.OpenSCAD |
12 | import Linear.V3 | 18 | import Linear.V3 |
19 | import System.IO.Temp | ||
20 | import System.Process | ||
13 | 21 | ||
14 | v3box :: R3 t => t Double -> Model3d | 22 | v3box :: R3 t => t Double -> Model3d |
15 | v3box v = box (v ^. _x) (v ^. _y) (v ^. _z) | 23 | v3box v = box (v ^. _x) (v ^. _y) (v ^. _z) |
16 | 24 | ||
17 | v3translate :: (Vector (c, c, c), R3 t) => t c -> Model (c, c, c) -> Model (c, c, c) | 25 | v3translate :: (Vector (c, c, c), R3 t) => t c -> Model (c, c, c) -> Model (c, c, c) |
18 | v3translate v m = translate (v ^. _x, v ^. _y, v ^. _z) $ m | 26 | v3translate v m = translate (v ^. _x, v ^. _y, v ^. _z) m |
19 | -- ^ doesn't work ?? | 27 | -- ^ doesn't work ?? |
20 | 28 | ||
21 | place :: (R3 t1, R3 t2) => t2 Double -> [t1 Double] -> [Model (Double, Double, Double)] | 29 | place :: (R3 t1, R3 t2) => t2 Double -> [t1 Double] -> [Model (Double, Double, Double)] |
22 | place board positions = map boardAt positions | 30 | place board coords = map boardAt coords |
23 | where | 31 | where |
24 | boardAt p = translate (p ^. _x, p ^. _y, p ^. _z) $ v3box board | 32 | boardAt p = translate (p ^. _x, p ^. _y, p ^. _z) $ v3box board |
25 | -- boardAt p = v3translate p $ v3box board | 33 | -- boardAt p = v3translate p $ v3box board |
26 | 34 | ||
35 | |||
36 | -- 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) | ||
38 | at :: Applicative f => f a -> f a -> f a -> f (V3 a) | ||
39 | at = liftA3 V3 | ||
40 | --at x y z = V3 <$> x <*> y <*> z -- same as above | ||
41 | |||
42 | placeColored rgb board coords = map boardAt coords | ||
43 | where | ||
44 | boardAt p = color rgb $ translate (p ^. _x, p ^. _y, p ^. _z) $ v3box board | ||
45 | |||
46 | |||
47 | -- deprecated due to the superiority of using place in conjunction with at | ||
27 | -- placeAlong (V3 2 4 16) (V3 0 0 0) (_x +~ 4) _x (<= 20) | 48 | -- placeAlong (V3 2 4 16) (V3 0 0 0) (_x +~ 4) _x (<= 20) |
28 | placeAlong :: (R3 t1, R3 t2) => t2 Double -> t1 Double -> (t1 Double -> t1 Double) -> ((t3 -> Const t3 t3) -> t1 Double -> Const t3 (t1 Double)) -> (t3 -> Bool) -> [Model (Double, Double, Double)] | 49 | placeAlong :: |
50 | (R3 t1, R3 t2) => | ||
51 | t2 Double | ||
52 | -> t1 Double | ||
53 | -> (t1 Double -> t1 Double) | ||
54 | -> ((t -> Const t t) -> t1 Double -> Const t (t1 Double)) | ||
55 | -> (t -> Bool) | ||
56 | -> [Model (Double, Double, Double)] | ||
29 | placeAlong board initial shift targ cond = | 57 | placeAlong board initial shift targ cond = |
30 | place board positions | 58 | place board positions |
31 | where positions = | 59 | where positions = |
@@ -35,3 +63,18 @@ placeAlong board initial shift targ cond = | |||
35 | then p : next p | 63 | then p : next p |
36 | else [] | 64 | else [] |
37 | in initial : next initial | 65 | in initial : next initial |
66 | |||
67 | -- 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": | ||
69 | -- spreadEvenly 2 20 (20*12/16) | ||
70 | spreadEvenly boardWidth fillSpace boardCount = | ||
71 | let dist = (fillSpace - boardWidth) / fromIntegral (boardCount - 1) | ||
72 | in take boardCount $ iterate (+dist) 0 | ||
73 | |||
74 | writeTempSCAD :: String -> IO FilePath | ||
75 | writeTempSCAD scadstr = writeSystemTempFile "genscad.scad" scadstr | ||
76 | |||
77 | openTempSCAD :: String -> IO ProcessHandle | ||
78 | openTempSCAD scadstr = do | ||
79 | fp <- writeTempSCAD scadstr | ||
80 | runCommand $ "openscad " ++ fp | ||