summaryrefslogtreecommitdiff
path: root/OpenSCAD/Carpentry.hs
blob: 7191781a4936304fa2354e2f4c377e97372cf57e (plain)
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
{-# LANGUAGE FlexibleContexts #-}
module OpenSCAD.Carpentry
(
  place
, placeColored
, placeAlong
, at
, spreadEvenly
, v3box
, v3translate
, writeTempSCAD
, openTempSCAD
  ) where

import           Control.Applicative
import           Control.Lens        hiding (at)
import           Graphics.OpenSCAD
import           Linear.V3
import           System.IO.Temp
import           System.Process

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 boardAt coords
  where
    boardAt p = translate (p ^. _x, p ^. _y, p ^. _z) $ v3box board
--    boardAt p = v3translate p $ v3box board


-- 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

-- 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