summaryrefslogtreecommitdiff
path: root/GenSCAD.hs
diff options
context:
space:
mode:
Diffstat (limited to 'GenSCAD.hs')
-rw-r--r--GenSCAD.hs22
1 files changed, 11 insertions, 11 deletions
diff --git a/GenSCAD.hs b/GenSCAD.hs
index 5989c65..e9343da 100644
--- a/GenSCAD.hs
+++ b/GenSCAD.hs
@@ -22,7 +22,7 @@ import System.Process
22_V32l :: R3 c1 => c1 c -> [c] 22_V32l :: R3 c1 => c1 c -> [c]
23_V32l c = [c ^. _x, c ^. _y, c ^. _z] 23_V32l c = [c ^. _x, c ^. _y, c ^. _z]
24 24
25_V32s :: (R3 c1, Show a) => c1 a -> [Char] 25_V32s :: (R3 c1, Show a) => c1 a -> String
26_V32s c = intercalate "," (map show (_V32l c)) 26_V32s c = intercalate "," (map show (_V32l c))
27 27
28-- placecube: OpenSCAD translate cube described by d to place designated by p 28-- placecube: OpenSCAD translate cube described by d to place designated by p
@@ -30,19 +30,19 @@ _V32s c = intercalate "," (map show (_V32l c))
30-- translate([1, 2, 3]) { cube([10, 20, 30]); } 30-- translate([1, 2, 3]) { cube([10, 20, 30]); }
31 31
32--crandrgb = intercalate "," 32--crandrgb = intercalate ","
33color :: [Char] -> [Char] -> [Char] 33color :: String -> String -> String
34color rgb what = "color ([" ++ rgb ++ "]) {" ++ what ++ "}" 34color rgb what = "color ([" ++ rgb ++ "]) {" ++ what ++ "}"
35translate :: [Char] -> [Char] -> [Char] 35translate :: String -> String -> String
36translate to what = "translate([ " ++ to ++ "]) { " ++ what ++ " }" 36translate to what = "translate([ " ++ to ++ "]) { " ++ what ++ " }"
37cube :: [Char] -> [Char] 37cube :: String -> String
38cube d = "cube([ " ++ d ++ "]);" 38cube d = "cube([ " ++ d ++ "]);"
39cubeat :: [Char] -> [Char] -> [Char] 39cubeat :: String -> String -> String
40cubeat d here = translate here $ (cube d) 40cubeat d here = translate here $ (cube d)
41colorcubeat :: [Char] -> [Char] -> [Char] -> [Char] 41colorcubeat :: String -> String -> String -> String
42colorcubeat rgb d pos = color rgb $ translate pos $ cube d 42colorcubeat rgb d pos = color rgb $ translate pos $ cube d
43 43
44--place [x] = "ERROR" 44--place [x] = "ERROR"
45place :: [[Char]] -> [Char] 45place :: [String] -> String
46place [d, p] = cubeat d p 46place [d, p] = cubeat d p
47place [r, d, p] = colorcubeat r d p 47place [r, d, p] = colorcubeat r d p
48 48
@@ -54,7 +54,7 @@ place [r, d, p] = colorcubeat r d p
54 54
55--scad [] = [] 55--scad [] = []
56--scad obj = (place (head obj)) ++ "\n" ++ scad (tail obj) 56--scad obj = (place (head obj)) ++ "\n" ++ scad (tail obj)
57scad :: [([Char], [Char])] -> [Char] 57scad :: [(String, String)] -> String
58scad [(d, p)] = cubeat p d 58scad [(d, p)] = cubeat p d
59--scad [(r, d, p)] = colorcubeat r d p 59--scad [(r, d, p)] = colorcubeat r d p
60--scad [x] = if (length x == 3) then (colorcubeat (x !! 0) (x !! 1) (x !! 2)) 60--scad [x] = if (length x == 3) then (colorcubeat (x !! 0) (x !! 1) (x !! 2))
@@ -62,7 +62,7 @@ scad [(d, p)] = cubeat p d
62--scad (x:s) = scad [x] ++ scad s 62--scad (x:s) = scad [x] ++ scad s
63 63
64 64
65placecube :: (R3 c2, R3 c3, Show a1, Show a2) => (c2 a1, c3 a2) -> [Char] 65placecube :: (R3 c2, R3 c3, Show a1, Show a2) => (c2 a1, c3 a2) -> String
66placecube obj = "translate([ " ++ _V32s(fst obj) ++ " ]) { cube([ " ++ _V32s(snd obj) ++ " ]); }" 66placecube obj = "translate([ " ++ _V32s(fst obj) ++ " ]) { cube([ " ++ _V32s(snd obj) ++ " ]); }"
67--placecube (p,d) = printf "translate([%d, %d, %d]) { cube([%d, %d, %d]); }" (_V32l p ++ _V32l d) 67--placecube (p,d) = printf "translate([%d, %d, %d]) { cube([%d, %d, %d]); }" (_V32l p ++ _V32l d)
68 68
@@ -75,12 +75,12 @@ placecube obj = "translate([ " ++ _V32s(fst obj) ++ " ]) { cube([ " ++ _V32s(sn
75 75
76--td = [(V3 0 1 2, V3 10 20 30), (V3 50 51 52, V3 11 22 33)] 76--td = [(V3 0 1 2, V3 10 20 30), (V3 50 51 52, V3 11 22 33)]
77 77
78--genscad :: [(V3 p, V3 d)] -> [Char] 78--genscad :: [(V3 p, V3 d)] -> String
79--genscad objs = concat $ map (++ "\n") $ map placecube objs 79--genscad objs = concat $ map (++ "\n") $ map placecube objs
80 80
81--scad (c, p, d) = colorcubeat c d p 81--scad (c, p, d) = colorcubeat c d p
82--scad (p,d) = cubeat d p 82--scad (p,d) = cubeat d p
83genscad :: (R3 c2, R3 c3, Show a1, Show a2) => [(c2 a1, c3 a2)] -> [Char] 83genscad :: (R3 c2, R3 c3, Show a1, Show a2) => [(c2 a1, c3 a2)] -> String
84genscad objs = concat $ map (++ "\n") $ map (placecube) objs 84genscad objs = concat $ map (++ "\n") $ map (placecube) objs
85printscad :: (R3 c2, R3 c3, Show a1, Show a2) => [(c2 a1, c3 a2)] -> IO () 85printscad :: (R3 c2, R3 c3, Show a1, Show a2) => [(c2 a1, c3 a2)] -> IO ()
86printscad objs = putStrLn $ genscad objs 86printscad objs = putStrLn $ genscad objs