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
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
|
module GenSCAD
( placecube
, genscad
, printscad
, writetempscad
, opentempscad
, cube
, translate
, cubeat
, color
, colorcubeat
) where
import Control.Lens
import Data.List
import Linear.V3
import System.IO.Temp
import System.Process
v3tolist :: V3 a -> [a]
v3tolist (V3 a b c) = [a,b,c]
_V32l :: R3 c1 => c1 c -> [c]
_V32l = view (_xyz . to v3tolist)
_V32s :: Show a => [a] -> [Char]
_V32s c = intercalate "," (map show c)
-- placecube: OpenSCAD translate cube described by d to place designated by p
-- placecube (V3 1 2 3, V3 10 20 30) ->
-- translate([1, 2, 3]) { cube([10, 20, 30]); }
--crandrgb = intercalate ","
color :: String -> String -> String
color rgb what = "color ([" ++ rgb ++ "]) {" ++ what ++ "}"
translate :: String -> String -> String
translate to what = "translate([ " ++ to ++ "]) { " ++ what ++ " }"
cube :: String -> String
cube d = "cube([ " ++ d ++ "]);"
cubeat :: String -> String -> String
cubeat d here = translate here $ (cube d)
colorcubeat :: String -> String -> String -> String
colorcubeat rgb d pos = color rgb $ translate pos $ cube d
--place [x] = "ERROR"
place :: [String] -> String
place [d, p] = cubeat d p
place [r, d, p] = colorcubeat r d p
--place[o] = scad (fst o) (snd o)
--place o = scad (fst (head o)) (snd (head o)) ++ place (tail o)
--place o = [scad d p| (p,d) <- o]
--place (o) = scad (fst (head o)) (snd (head o)) ++ place (tail o)
--scad [] = []
--scad obj = (place (head obj)) ++ "\n" ++ scad (tail obj)
scad :: [(String, String)] -> String
scad [(d, p)] = cubeat p d
--scad [(r, d, p)] = colorcubeat r d p
--scad [x] = if (length x == 3) then (colorcubeat (x !! 0) (x !! 1) (x !! 2))
-- else (cubeat (x !! 0) (x !!1))
--scad (x:s) = scad [x] ++ scad s
placecube :: (R3 c2, R3 c3, Show a1, Show a2) => (c2 a1, c3 a2) -> String
placecube obj = "translate([ " ++ _V32s(_V32l(fst obj)) ++ " ]) { cube([ " ++ (_V32s._V32l)(snd obj) ++ " ]); }"
--placecube (p,d) = printf "translate([%d, %d, %d]) { cube([%d, %d, %d]); }" (_V32l p ++ _V32l d)
-- take a list of tuples containing positions and dimensions for cubes and
-- generate corresponding code for rendering in OpenSCAD
-- genscad [(V3 0 0 0, V3 10 10 10), (V3 20 20 20, V3 10 10 10)] ->
-- placecube (V3 0 0 0, V3 10 10 10) -> translate ([...]) { cube([...]);}
-- placecube (V3 20 20 20, V3 10 10 10) -> '
--td = [(V3 0 1 2, V3 10 20 30), (V3 50 51 52, V3 11 22 33)]
--genscad :: [(V3 p, V3 d)] -> String
--genscad objs = concat $ map (++ "\n") $ map placecube objs
--scad (c, p, d) = colorcubeat c d p
--scad (p,d) = cubeat d p
genscad :: (R3 c2, R3 c3, Show a1, Show a2) => [(c2 a1, c3 a2)] -> String
genscad objs = concat $ map (++ "\n") $ map (placecube) objs
printscad :: (R3 c2, R3 c3, Show a1, Show a2) => [(c2 a1, c3 a2)] -> IO ()
printscad objs = putStrLn $ genscad objs
--writefilescad objs = withSystemTempFile "genscad" -> fp gsf -> doprintscad objs
writetempscad :: (R3 c2, R3 c3, Show a1, Show a2) => [(c2 a1, c3 a2)] -> IO FilePath
writetempscad objs = writeSystemTempFile "genscad.scad" (genscad objs)
opentempscad :: (R3 c2, R3 c3, Show a1, Show a2) => [(c2 a1, c3 a2)] -> IO ProcessHandle
opentempscad objs = do
fp <- writetempscad objs
runCommand $ "openscad " ++ fp
--opentempscad objs = print $ "openscad " ++ (writetempscad objs)
-- savegenscad code file -> save generated code file
-- opensavegenscad code file -> generate scad, save to file, then open in OpenSCAD
|
