From be099777f304e5e4991c5a7402857e47a2b2a464 Mon Sep 17 00:00:00 2001
From: Steven <steven.vasilogianis@gmail.com>
Date: Mon, 15 Apr 2019 02:04:51 -0400
Subject: 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

---
 OpenSCAD/Carpentry.hs | 76 ++++++++++++++++++++-------------------------------
 1 file changed, 30 insertions(+), 46 deletions(-)

(limited to 'OpenSCAD/Carpentry.hs')

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 @@
+{-# LANGUAGE FlexibleContexts #-}
 module OpenSCAD.Carpentry
-(  placeL
-,  placeL'
+(
+  place
+, placeAlong
+, v3box
+, v3translate
   ) where
 
-import Graphics.OpenSCAD
-import Linear.V3
-import Control.Lens
+import           Control.Lens
+import           Graphics.OpenSCAD
+import           Linear.V3
 
-placeL ::
-     (Double, Double, Double)
-  -> Char
-  -> [Double]
-  -> Double
-  -> Double
-  -> [Model3d]
-placeL (x, y, z) axis w v u = placeL' x y z axis w v u
-
-placeL' ::
-     Double
-  -> Double
-  -> Double
-  -> Char
-  -> [Double]
-  -> Double
-  -> Double
-  -> [Model3d]
-placeL' bx by bz axis w v u
-  | axis == 'x' = place [(t, v, u) | t <- w]
-  | axis == 'y' = place [(v, t, u) | t <- w]
-  | axis == 'z' = place [(v, u, t) | t <- w]
-  where
-    place coords = map (\y -> translate y $ box bx by bz) coords
+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 ??
 
--- These are some helper functions for modeling carpentry projects w/ Graphics.OpenSCAD
--- If we want to model a deck, the railings will be placed along an x axis:
--- railingBoard = (2, 2, 48) -- 2 by 2 by 42
--- railingPositions = [(w,0,4) | w <- [0,6..12*10]] -- one rail board every 6 inches for 10 feet
--- floorBoard = (2,4,12*10)
--- floorBoardPositions = [(0,w,0) | w <- [0,4..12*10]]
-
--- so the pattern is that in carpentry projects you generally have various sized
--- boards which get placed along some axis. placeL is a my attempt to
--- generalizing this pattern:
--- placeL railingBoard 'x' [0,4..12*10] 0 6
--- placeL floorBoard 'y' [0,4..] 0 0
---
--- It works as intended, but admittedly does not "feel" like a proper haskell
--- solution. I would appreciate any advice towards a more "proper" solution.
--- As well, I get the following compiler warning which I am not sure 
---
+place :: (R3 t1, R3 t2) => t2 Double -> [t1 Double] -> [Model (Double, Double, Double)]
+place board positions = map boardAt positions
+  where
+    boardAt p = translate (p ^. _x, p ^. _y, p ^. _z) $ v3box board
+--    boardAt p = v3translate p $ v3box board
 
+-- 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) -> ((t3 -> Const t3 t3) -> t1 Double -> Const t3 (t1 Double)) -> (t3 -> 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
-- 
cgit v1.2.3