/
Export.hs
152 lines (126 loc) · 6.13 KB
/
Export.hs
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
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
-- Released under the GNU GPL, see LICENSE
module Graphics.Implicit.Export where
import Graphics.Implicit.Definitions
--import Graphics.Implicit.Operations (slice)
import Data.Text.Lazy (Text,pack)
import Data.Text.Lazy.IO (writeFile)
import Prelude hiding (writeFile)
import qualified Data.ByteString.Lazy as LBS
-- class DiscreteApproxable
import Graphics.Implicit.Export.Definitions
-- instances of DiscreteApproxable...
import Graphics.Implicit.Export.SymbolicObj2 ()
import Graphics.Implicit.Export.SymbolicObj3 ()
import Graphics.Implicit.Export.RayTrace ()
-- File formats
import qualified Graphics.Implicit.Export.PolylineFormats as PolylineFormats
import qualified Graphics.Implicit.Export.TriangleMeshFormats as TriangleMeshFormats
import qualified Graphics.Implicit.Export.NormedTriangleMeshFormats as NormedTriangleMeshFormats
import qualified Graphics.Implicit.Export.SymbolicFormats as SymbolicFormats
import qualified Codec.Picture as ImageFormatCodecs
-- Write an object in a given formet...
writeObject :: (DiscreteAproxable obj aprox) =>
ℝ -- ^ Resolution
-> (aprox -> Text) -- ^ File Format (Function that formats)
-> FilePath -- ^ File Name
-> obj -- ^ Object to render
-> IO () -- ^ Writing Action!
writeObject res format filename obj = writeFile filename $ formatObject res format obj
writeObject' :: (DiscreteAproxable obj aprox) =>
ℝ -- ^ Resolution
-> (FilePath -> aprox -> IO ()) -- ^ File Format writer
-> FilePath -- ^ File Name
-> obj -- ^ Object to render
-> IO () -- ^ Writing Action!
writeObject' res formatWriter filename obj =
let
aprox = discreteAprox res obj
in
formatWriter filename aprox
formatObject :: (DiscreteAproxable obj aprox) =>
ℝ -- ^ Resolution
-> (aprox -> Text) -- ^ File Format (Function that formats)
-> obj -- ^ Object to render
-> Text -- ^ Resulting lazy ByteString
formatObject res format = format . discreteAprox res
writeSVG res = writeObject res PolylineFormats.svg
writeSTL res = writeObject res TriangleMeshFormats.stl
writeBinSTL res file obj = LBS.writeFile file $ TriangleMeshFormats.binaryStl $ discreteAprox res obj
writeOBJ res = writeObject res NormedTriangleMeshFormats.obj
writeTHREEJS res = writeObject res TriangleMeshFormats.jsTHREE
writeGCodeHacklabLaser res = writeObject res PolylineFormats.hacklabLaserGCode
writeSCAD3 res filename obj = writeFile filename $ SymbolicFormats.scad3 res obj
writeSCAD2 res filename obj = writeFile filename $ SymbolicFormats.scad2 res obj
writePNG res = writeObject' res ImageFormatCodecs.savePngImage
{-
renderRaw :: ℝ3 -> ℝ3 -> ℝ -> String -> Obj3 -> IO()
renderRaw (x1, y1, z1) (x2, y2, z2) res name obj =
-- A hacky way to encode to chars, but it will do
let convert n = if n > 1 then 'a' else if n > 0.5 then 'b' else if n > 0.1 then 'c' else if n == 0 then 'd' else if n > -0.5 then 'e' else 'd' in
do
putStrLn $ show $ length $ [ obj (x,y,z) | x <- [x1, x1+res.. x2], y <- [y1, y1+res.. y2], z <- [z1, z1+res.. z2] ]
out <- openFile name WriteMode
mapM_ ( (hPutChar out) . convert) $
[ obj (x,y,z) | x <- [x1, x1+res.. x2], y <- [y1, y1+res.. y2], z <- [z1, z1+res.. z2] ]
hClose out
renderRaw2D :: ℝ2 -> ℝ2 -> ℝ -> String -> Obj2 -> IO()
renderRaw2D (x1, y1) (x2, y2) res name obj =
-- A hacky way to encode to chars, but it will do
let convert n = if n > 1 then 'a' else if n > 0.5 then 'b' else if n > 0.1 then 'c' else if n == 0 then 'd' else if n > -0.5 then 'e' else 'd' in
do
putStrLn $ show $ length $ [x1, x1+res.. x2]
putStrLn $ show $ length $ [ obj (x,y) | x <- [x1, x1+res.. x2], y <- [y1, y1+res.. y2] ]
out <- openFile name WriteMode
mapM_ (mapM_ ( (hPutChar out) . convert)) $
[[ obj (x,y) | x <- [x1, x1+res.. x2] ] | y <- [y1, y1+res.. y2] ]
hClose out
{-writeGCodeMakerbot ::
ℝ3 -- ^ lower corner of bounding box
-> ℝ3 -- ^ upper corner of bounding box
-> ℝ -- ^ resolution of rendering
-> FilePath -- ^ Filename to write gcode to
-> Obj3 -- ^ 3D object to make gcode for
-> IO () -- ^ Resulting IO action that will write gcode
writeGCodeMakerbot (x1,y1,z1) (x2,y2,z2) d name obj =
let
slices = [slice zheight obj | zheight <- [z1, z1+0.1.. z2] ]
prep obj (x,y) = (obj (x,y), obj (x+d,y), obj (x+d,y+d), obj (x,y+d), obj (x+d/2,y+d/2) , (x,y), d )
layer obj2 = (filter polylineNotNull) $ (map reducePolyline) $ orderLines $ concat $ map getLineSeg [prep obj2 (x,y) | x <- [x1, x1+d.. x2], y <- [y1, y1 +d.. y2] ]
levelmultilines = map layer slices
gcodeHeader =
"(generated by ImplicitCAD, based of skeinforge default makerbot results)\n"
++ "(**** Initialization ****)\n"
++ "M104 S220 T0 (Temperature to 220 celsius)\n"
++ "M109 S110 T0 (set heated-build-platform temperature)\n"
++ "G21 (Metric FTW)\n"
++ "G90 (Absolute Positioning)\n"
++ "G92 X0 Y0 Z0 (You are now at 0,0,0)\n"
++ "M108 S255 (Extruder speed = max; not turning it on yet!)\n"
++ "(**** Prep the extruder... ****)\n"
++ "G0 Z15 (Move up for test extrusion)\n"
++ "M6 T0 (Wait for tool to heat up)\n"
++ "G04 P5000 (Wait 5 seconds)\n"
++ "M101 (Extruder on, forward)\n"
++ "G04 P5000 (Wait 5 seconds)\n"
++ "M103 (Extruder off)\n"
++ "M01 (The heater is warming up and will do a test extrusion. Click yes after you have cleared the nozzle of the extrusion.)\n"
++ "G0 Z0(Go back to zero.)\n"
gcodeFooter =
"M104 S0 (extruder heating off!)\n"
++"G00 X0.0 Y0.0 (move to 0)\n"
++"M2 (end)"
gcodeXYZ :: ℝ3 -> [Char]
gcodeXYZ (x,y,z) = "X"++ show x ++" Y"++ show y ++" Z"++ show z
interpretPolyline (start:others) =
"G00 "++ gcodeXY start ++ "\n"
++ "M101 (extruder forward!)\n"
++ concat (map (\p -> "G01 " ++ (gcodeXY p) ++ "\n") others)
++ "M103 (extruder off)\n\n"
text = gcodeHeader
++ (concat $ map interpretPolyline multilines)
++ gcodeFooter
in do
writeFile name text
-}
-}