Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

132 lines (110 sloc) 5.537 kB
-- 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)
-- class DiscreteApproxable
import Graphics.Implicit.Export.Definitions
-- instances of DiscreteApproxable...
import Graphics.Implicit.Export.SymbolicObj2
import Graphics.Implicit.Export.SymbolicObj3
-- 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
-- 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
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
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
{-
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
-}
-}
Jump to Line
Something went wrong with that request. Please try again.