From be099777f304e5e4991c5a7402857e47a2b2a464 Mon Sep 17 00:00:00 2001 From: Steven 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(-) 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