diff options
Diffstat (limited to 'GenSCAD.hs')
-rw-r--r-- | GenSCAD.hs | 22 |
1 files changed, 11 insertions, 11 deletions
@@ -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 "," |
33 | color :: [Char] -> [Char] -> [Char] | 33 | color :: String -> String -> String |
34 | color rgb what = "color ([" ++ rgb ++ "]) {" ++ what ++ "}" | 34 | color rgb what = "color ([" ++ rgb ++ "]) {" ++ what ++ "}" |
35 | translate :: [Char] -> [Char] -> [Char] | 35 | translate :: String -> String -> String |
36 | translate to what = "translate([ " ++ to ++ "]) { " ++ what ++ " }" | 36 | translate to what = "translate([ " ++ to ++ "]) { " ++ what ++ " }" |
37 | cube :: [Char] -> [Char] | 37 | cube :: String -> String |
38 | cube d = "cube([ " ++ d ++ "]);" | 38 | cube d = "cube([ " ++ d ++ "]);" |
39 | cubeat :: [Char] -> [Char] -> [Char] | 39 | cubeat :: String -> String -> String |
40 | cubeat d here = translate here $ (cube d) | 40 | cubeat d here = translate here $ (cube d) |
41 | colorcubeat :: [Char] -> [Char] -> [Char] -> [Char] | 41 | colorcubeat :: String -> String -> String -> String |
42 | colorcubeat rgb d pos = color rgb $ translate pos $ cube d | 42 | colorcubeat rgb d pos = color rgb $ translate pos $ cube d |
43 | 43 | ||
44 | --place [x] = "ERROR" | 44 | --place [x] = "ERROR" |
45 | place :: [[Char]] -> [Char] | 45 | place :: [String] -> String |
46 | place [d, p] = cubeat d p | 46 | place [d, p] = cubeat d p |
47 | place [r, d, p] = colorcubeat r d p | 47 | place [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) |
57 | scad :: [([Char], [Char])] -> [Char] | 57 | scad :: [(String, String)] -> String |
58 | scad [(d, p)] = cubeat p d | 58 | scad [(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 | ||
65 | placecube :: (R3 c2, R3 c3, Show a1, Show a2) => (c2 a1, c3 a2) -> [Char] | 65 | placecube :: (R3 c2, R3 c3, Show a1, Show a2) => (c2 a1, c3 a2) -> String |
66 | placecube obj = "translate([ " ++ _V32s(fst obj) ++ " ]) { cube([ " ++ _V32s(snd obj) ++ " ]); }" | 66 | placecube 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 |
83 | genscad :: (R3 c2, R3 c3, Show a1, Show a2) => [(c2 a1, c3 a2)] -> [Char] | 83 | genscad :: (R3 c2, R3 c3, Show a1, Show a2) => [(c2 a1, c3 a2)] -> String |
84 | genscad objs = concat $ map (++ "\n") $ map (placecube) objs | 84 | genscad objs = concat $ map (++ "\n") $ map (placecube) objs |
85 | printscad :: (R3 c2, R3 c3, Show a1, Show a2) => [(c2 a1, c3 a2)] -> IO () | 85 | printscad :: (R3 c2, R3 c3, Show a1, Show a2) => [(c2 a1, c3 a2)] -> IO () |
86 | printscad objs = putStrLn $ genscad objs | 86 | printscad objs = putStrLn $ genscad objs |