diff options
Diffstat (limited to 'GenSCAD.hs')
-rw-r--r-- | GenSCAD.hs | 90 |
1 files changed, 52 insertions, 38 deletions
@@ -1,5 +1,14 @@ | |||
1 | module GenSCAD | 1 | module GenSCAD |
2 | ( placecube | 2 | ( placecube |
3 | , genscad | ||
4 | , printscad | ||
5 | , writetempscad | ||
6 | , opentempscad | ||
7 | , cube | ||
8 | , translate | ||
9 | , cubeat | ||
10 | , color | ||
11 | , colorcubeat | ||
3 | ) where | 12 | ) where |
4 | 13 | ||
5 | import Linear.V3 | 14 | import Linear.V3 |
@@ -8,6 +17,12 @@ import Data.List | |||
8 | import Text.Printf | 17 | import Text.Printf |
9 | import System.IO.Temp | 18 | import System.IO.Temp |
10 | import System.Process | 19 | import System.Process |
20 | import Data.Colour | ||
21 | import Data.Colour.RGBSpace | ||
22 | import Data.Colour.SRGB | ||
23 | import Data.Colour.Names | ||
24 | |||
25 | |||
11 | 26 | ||
12 | _V32l :: R3 c1 => c1 c -> [c] | 27 | _V32l :: R3 c1 => c1 c -> [c] |
13 | _V32l c = [c ^. _x, c ^. _y, c ^. _z] | 28 | _V32l c = [c ^. _x, c ^. _y, c ^. _z] |
@@ -18,6 +33,33 @@ _V32s c = intercalate "," (map show (_V32l c)) | |||
18 | -- placecube: OpenSCAD translate cube described by d to place designated by p | 33 | -- placecube: OpenSCAD translate cube described by d to place designated by p |
19 | -- placecube (V3 1 2 3, V3 10 20 30) -> | 34 | -- placecube (V3 1 2 3, V3 10 20 30) -> |
20 | -- translate([1, 2, 3]) { cube([10, 20, 30]); } | 35 | -- translate([1, 2, 3]) { cube([10, 20, 30]); } |
36 | |||
37 | --crandrgb = intercalate "," | ||
38 | color rgb what = "color ([" ++ rgb ++ "]) {" ++ what ++ "}" | ||
39 | translate to what = "translate([ " ++ to ++ "]) { " ++ what ++ " }" | ||
40 | cube d = "cube([ " ++ d ++ "]);" | ||
41 | cubeat d here = translate here $ (cube d) | ||
42 | colorcubeat rgb d pos = color rgb $ translate pos $ cube d | ||
43 | |||
44 | --place [x] = "ERROR" | ||
45 | place [d, p] = cubeat d p | ||
46 | place [r, d, p] = colorcubeat r d p | ||
47 | |||
48 | --place[o] = scad (fst o) (snd o) | ||
49 | --place o = scad (fst (head o)) (snd (head o)) ++ place (tail o) | ||
50 | --place o = [scad d p| (p,d) <- o] | ||
51 | --place (o) = scad (fst (head o)) (snd (head o)) ++ place (tail o) | ||
52 | |||
53 | |||
54 | --scad [] = [] | ||
55 | --scad obj = (place (head obj)) ++ "\n" ++ scad (tail obj) | ||
56 | scad [(d, p)] = cubeat p d | ||
57 | --scad [(r, d, p)] = colorcubeat r d p | ||
58 | --scad [x] = if (length x == 3) then (colorcubeat (x !! 0) (x !! 1) (x !! 2)) | ||
59 | -- else (cubeat (x !! 0) (x !!1)) | ||
60 | --scad (x:s) = scad [x] ++ scad s | ||
61 | |||
62 | |||
21 | placecube obj = "translate([ " ++ _V32s(fst obj) ++ " ]) { cube([ " ++ _V32s(snd obj) ++ " ]); }" | 63 | placecube obj = "translate([ " ++ _V32s(fst obj) ++ " ]) { cube([ " ++ _V32s(snd obj) ++ " ]); }" |
22 | --placecube (p,d) = printf "translate([%d, %d, %d]) { cube([%d, %d, %d]); }" (_V32l p ++ _V32l d) | 64 | --placecube (p,d) = printf "translate([%d, %d, %d]) { cube([%d, %d, %d]); }" (_V32l p ++ _V32l d) |
23 | 65 | ||
@@ -28,50 +70,22 @@ placecube obj = "translate([ " ++ _V32s(fst obj) ++ " ]) { cube([ " ++ _V32s(sn | |||
28 | -- placecube (V3 0 0 0, V3 10 10 10) -> translate ([...]) { cube([...]);} | 70 | -- placecube (V3 0 0 0, V3 10 10 10) -> translate ([...]) { cube([...]);} |
29 | -- placecube (V3 20 20 20, V3 10 10 10) -> ' | 71 | -- placecube (V3 20 20 20, V3 10 10 10) -> ' |
30 | 72 | ||
31 | td = [(V3 0 1 2, V3 10 20 30), (V3 50 51 52, V3 11 22 33)] | 73 | --td = [(V3 0 1 2, V3 10 20 30), (V3 50 51 52, V3 11 22 33)] |
32 | 74 | ||
33 | --genscad :: [(V3 p, V3 d)] -> [Char] | 75 | --genscad :: [(V3 p, V3 d)] -> [Char] |
34 | --genscad objs = concat $ map (++ "\n") $ map placecube objs | 76 | --genscad objs = concat $ map (++ "\n") $ map placecube objs |
77 | |||
78 | --scad (c, p, d) = colorcubeat c d p | ||
79 | --scad (p,d) = cubeat d p | ||
35 | genscad objs = concat $ map (++ "\n") $ map (placecube) objs | 80 | genscad objs = concat $ map (++ "\n") $ map (placecube) objs |
36 | printscad objs = putStrLn $ genscad objs | 81 | printscad objs = putStrLn $ genscad objs |
37 | --writefilescad objs = withSystemTempFile "genscad" -> fp gsf -> doprintscad objs | 82 | --writefilescad objs = withSystemTempFile "genscad" -> fp gsf -> doprintscad objs |
38 | writetempscad objs = writeSystemTempFile "genscad" (genscad objs) | 83 | writetempscad objs = writeSystemTempFile "genscad.scad" (genscad objs) |
39 | opentempscad objs = runCommand ("openscad " ++ "foo.scad") | 84 | opentempscad objs = do |
40 | --opentempscad objs = | 85 | fp <- writetempscad objs |
86 | runCommand $ "openscad " ++ fp | ||
87 | --opentempscad objs = print $ "openscad " ++ (writetempscad objs) | ||
41 | 88 | ||
42 | -- savegenscad code file -> save generated code file | 89 | -- savegenscad code file -> save generated code file |
43 | -- opensavegenscad code file -> generate scad, save to file, then open in OpenSCAD | 90 | -- opensavegenscad code file -> generate scad, save to file, then open in OpenSCAD |
44 | 91 | ||
45 | -- readEditor :: IO String | ||
46 | -- readEditor = withSystemTempFile "read-editor" readEditor' | ||
47 | |||
48 | -- -- | Opens a file, fills it some content and returns it's contents after it's saved. | ||
49 | -- readEditorWith :: String -> IO String | ||
50 | -- readEditorWith contents = withSystemTempFile "read-editor" $ \fp temph -> do | ||
51 | -- hPutStr temph contents | ||
52 | -- hFlush temph | ||
53 | -- readEditor' fp temph | ||
54 | |||
55 | -- readEditor' :: FilePath -> Handle -> IO String | ||
56 | -- readEditor' fp temph = do | ||
57 | -- openEditor fp | ||
58 | -- hClose temph | ||
59 | -- readFile fp | ||
60 | |||
61 | |||
62 | |||
63 | -- compileRunPrint :: FilePath -> Ident -> IO String | ||
64 | -- compileRunPrint agdap var = | ||
65 | -- withSystemTempFile "module.mlf" $ | ||
66 | -- \mlfp mlfh -> do | ||
67 | -- callProcess "stack" ["exec", "agda-ocaml", "--", "-v0", "--mlf", agdap | ||
68 | -- , "-o", mlfp, "--print-var", var] | ||
69 | -- runModFile' mlfp mlfh | ||
70 | |||
71 | -- compileRun :: FilePath -> IO String | ||
72 | -- compileRun agdap = | ||
73 | -- withSystemTempFile "module.mlf" $ | ||
74 | -- \mlfp mlfh -> do | ||
75 | -- callProcess "stack" ["exec", "agda-ocaml", "--", "-v0", "--mlf", agdap | ||
76 | -- , "-o", mlfp] | ||
77 | -- runModFile' mlfp mlfh | ||