diff options
author | Steven <steven.vasilogianis@gmail.com> | 2019-04-15 02:04:51 -0400 |
---|---|---|
committer | Steven <steven.vasilogianis@gmail.com> | 2019-04-15 02:04:51 -0400 |
commit | be099777f304e5e4991c5a7402857e47a2b2a464 (patch) | |
tree | d8b8decee2510376f1e3218df07fd82400791502 | |
parent | 55ec091d02ae2c4d46ae055a05183218780aac34 (diff) |
added functions:
place board positions
which places a board at positions
placeAlong board initial shiftFunction endCondition conditionTarget
which generates a list of positions from initial by applying shiftFunction on
initial until conditionTaget no longer satisfies endCondition
-rw-r--r-- | OpenSCAD/Carpentry.hs | 76 |
1 files changed, 30 insertions, 46 deletions
diff --git a/OpenSCAD/Carpentry.hs b/OpenSCAD/Carpentry.hs index 995d785..8c0eebe 100644 --- a/OpenSCAD/Carpentry.hs +++ b/OpenSCAD/Carpentry.hs | |||
@@ -1,53 +1,37 @@ | |||
1 | {-# LANGUAGE FlexibleContexts #-} | ||
1 | module OpenSCAD.Carpentry | 2 | module OpenSCAD.Carpentry |
2 | ( placeL | 3 | ( |
3 | , placeL' | 4 | place |
5 | , placeAlong | ||
6 | , v3box | ||
7 | , v3translate | ||
4 | ) where | 8 | ) where |
5 | 9 | ||
6 | import Graphics.OpenSCAD | 10 | import Control.Lens |
7 | import Linear.V3 | 11 | import Graphics.OpenSCAD |
8 | import Control.Lens | 12 | import Linear.V3 |
9 | 13 | ||
10 | placeL :: | 14 | v3box :: R3 t => t Double -> Model3d |
11 | (Double, Double, Double) | 15 | v3box v = box (v ^. _x) (v ^. _y) (v ^. _z) |
12 | -> Char | ||
13 | -> [Double] | ||
14 | -> Double | ||
15 | -> Double | ||
16 | -> [Model3d] | ||
17 | placeL (x, y, z) axis w v u = placeL' x y z axis w v u | ||
18 | |||
19 | placeL' :: | ||
20 | Double | ||
21 | -> Double | ||
22 | -> Double | ||
23 | -> Char | ||
24 | -> [Double] | ||
25 | -> Double | ||
26 | -> Double | ||
27 | -> [Model3d] | ||
28 | placeL' bx by bz axis w v u | ||
29 | | axis == 'x' = place [(t, v, u) | t <- w] | ||
30 | | axis == 'y' = place [(v, t, u) | t <- w] | ||
31 | | axis == 'z' = place [(v, u, t) | t <- w] | ||
32 | where | ||
33 | place coords = map (\y -> translate y $ box bx by bz) coords | ||
34 | 16 | ||
17 | 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 | ||
19 | -- ^ doesn't work ?? | ||
35 | 20 | ||
36 | -- These are some helper functions for modeling carpentry projects w/ Graphics.OpenSCAD | 21 | place :: (R3 t1, R3 t2) => t2 Double -> [t1 Double] -> [Model (Double, Double, Double)] |
37 | -- If we want to model a deck, the railings will be placed along an x axis: | 22 | place board positions = map boardAt positions |
38 | -- railingBoard = (2, 2, 48) -- 2 by 2 by 42 | 23 | where |
39 | -- railingPositions = [(w,0,4) | w <- [0,6..12*10]] -- one rail board every 6 inches for 10 feet | 24 | boardAt p = translate (p ^. _x, p ^. _y, p ^. _z) $ v3box board |
40 | -- floorBoard = (2,4,12*10) | 25 | -- boardAt p = v3translate p $ v3box board |
41 | -- floorBoardPositions = [(0,w,0) | w <- [0,4..12*10]] | ||
42 | |||
43 | -- so the pattern is that in carpentry projects you generally have various sized | ||
44 | -- boards which get placed along some axis. placeL is a my attempt to | ||
45 | -- generalizing this pattern: | ||
46 | -- placeL railingBoard 'x' [0,4..12*10] 0 6 | ||
47 | -- placeL floorBoard 'y' [0,4..] 0 0 | ||
48 | -- | ||
49 | -- It works as intended, but admittedly does not "feel" like a proper haskell | ||
50 | -- solution. I would appreciate any advice towards a more "proper" solution. | ||
51 | -- As well, I get the following compiler warning which I am not sure | ||
52 | -- | ||
53 | 26 | ||
27 | -- 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)] | ||
29 | placeAlong board initial shift targ cond = | ||
30 | place board positions | ||
31 | where positions = | ||
32 | let next x = | ||
33 | let p = x & shift | ||
34 | in if cond (p ^. targ) | ||
35 | then p : next p | ||
36 | else [] | ||
37 | in initial : next initial | ||