-- 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.Tracing
import System.IO


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

-- | Write an SVG of a 2D object
writeSVG :: 
	ℝ2         -- ^ lower corner of bounding box
	-> ℝ2      -- ^ upper corner of bounding box
	-> ℝ       -- ^ resolution of rendering
	-> String  -- ^ Filename to write SVG to
	-> Obj2    -- ^ 2D object to render as SVG
	-> IO ()   -- ^ Resulting IO action that will write SVG

writeSVG (x1,y1) (x2,y2) d name obj = 
	let 
		-- Note that 0,0 is the upper right hand corner and that positive is down
		grid = [(obj (x,-y), obj (x+d,-y), obj (x+d,-(y+d)), obj (x,-(y+d)), obj (x+d/2,-(y+d/2)) , (x-x1,y-y1), d ) | x <- [x1, x1+d.. x2], y <- [y1, y1 +d.. y2] ]
		multilines = (filter polylineNotNull) $ (map reducePolyline) $ orderLines $ concat $ map getLineSeg grid
		svglines = concat $ map (\line -> 
				"  <polyline points=\"" 
				++ concat (map (\(x,y) -> " " ++ show x ++ "," ++ show y) line)
				++ "\" style=\"stroke:rgb(0,0,255);stroke-width:1;fill:none;\"/> \n" ) 
				multilines	
		text = "<svg xmlns=\"http://www.w3.org/2000/svg\" version=\"1.1\"> \n" 
			++ svglines			
			++ "</svg> "
	in do 
		writeFile name text

-- | Write an SVG of a 2D object (uses parallel algorithms)
writeSVG2 :: 
	ℝ2         -- ^ lower corner of bounding box
	-> ℝ2      -- ^ upper corner of bounding box
	-> ℝ       -- ^ resolution of rendering
	-> String  -- ^ Filename to write SVG to
	-> Obj2    -- ^ 2D object to render as SVG
	-> IO ()   -- ^ Resulting IO action that will write SVG

writeSVG2 (x1,y1) (x2,y2) d name obj = 
	let 
		grid = [[getLineSeg (obj (x,-y), obj (x+d,-y), obj (x+d,-(y+d)), obj (x,-(y+d)), obj (x+d/2,-(y+d/2)) , (x-x1,y-y1), d ) | x <- [x1, x1+d.. x2]] | y <- [y1, y1 +d.. y2] ]
		multilines = (filter polylineNotNull) $ (map reducePolyline) $ orderLinesP grid
		svglines = concat $ map (\line -> 
				"  <polyline points=\"" 
				++ concat (map (\(x,y) -> " " ++ show x ++ "," ++ show y) line)
				++ "\" style=\"stroke:rgb(0,0,255);stroke-width:1;fill:none;\"/> \n" ) 
				multilines	
		text = "<svg xmlns=\"http://www.w3.org/2000/svg\" version=\"1.1\"> \n" 
			++ svglines			
			++ "</svg> "
	in do 
		writeFile name text



writeGCode :: 
	ℝ2          -- ^ lower corner of bounding box
	-> ℝ2       -- ^ upper corner of bounding box
	-> ℝ        -- ^ resolution of rendering
	-> FilePath -- ^ Filename to write gcode to
	-> Obj2     -- ^ 2D object to make gcode for
	-> IO ()    -- ^ Resulting IO action that will write gcode

writeGCode (x1,y1) (x2,y2) d name obj = 
	let 
		multilines = (filter polylineNotNull) $ (map reducePolyline) $ orderLines $ concat $ map getLineSeg [(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 ) | x <- [x1, x1+d.. x2], y <- [y1, y1 +d.. y2] ]
		gcodeHeader = "(generated by ImplicitCAD)\nM3\nG21 (units=mm)\nG00 Z5.0 (tool is off)\n\n"
		gcodeFooter = "\n%\n"
		gcodeXY :: ℝ2 -> [Char]
		gcodeXY (x,y) = "X"++ show x ++" Y"++ show y 
		interpretPolyline (start:next:others) = 
			"G00 "++ gcodeXY start ++ "\n"
			++ "G01 Z-1.0 F100.0\n"
			++ "G01 " ++ gcodeXY next ++ " Z-1.0 F400.0\n"
			++ concat (map (\p -> "G01 " ++ (gcodeXY p) ++ " Z-1.0\n") others)
			++ "G00 Z5.0\n\n"
		text = gcodeHeader
			++ (concat $ map interpretPolyline multilines)
			++ gcodeFooter
	in do 
		writeFile name text

writeGCodeHacklabLaser :: 
	ℝ2          -- ^ lower corner of bounding box
	-> ℝ2       -- ^ upper corner of bounding box
	-> ℝ        -- ^ resolution of rendering
	-> FilePath -- ^ Filename to write gcode to
	-> Obj2     -- ^ 2D object to make gcode for
	-> IO ()    -- ^ Resulting IO action that will write gcode

writeGCodeHacklabLaser (x1,y1) (x2,y2) d name obj = 
	let 
		multilines = (filter polylineNotNull) $ (map reducePolyline) $ orderLines $ concat $ map getLineSeg [(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 ) | x <- [x1, x1+d.. x2], y <- [y1, y1 +d.. y2] ]
		gcodeHeader = 
			"(generated by ImplicitCAD, based of hacklab wiki example)\n"
			++"M63 P0 (laser off)\n"
			++"G0 Z0.002 (laser off)\n"
			++"G21 (units=mm)\n"
			++"F400 (set feedrate)\n"
			++"M3 S1 (enable laser)\n"
			++"\n"
		gcodeFooter = 
			"M5 (disable laser)\n"
			++"G00 X0.0 Y0.0 (move to 0)\n"
			++"M2 (end)"
		gcodeXY :: ℝ2 -> [Char]
		gcodeXY (x,y) = "X"++ show x ++" Y"++ show y 
		interpretPolyline (start:others) = 
			"G00 "++ gcodeXY start ++ "\n"
			++ "M62 P0 (laser on)\n"
			++ concat (map (\p -> "G01 " ++ (gcodeXY p) ++ "\n") others)
			++ "M63 P0 (laser off)\n\n"
		text = gcodeHeader
			++ (concat $ map interpretPolyline multilines)
			++ gcodeFooter
	in do 
		writeFile name text


writeSTL :: 
	ℝ3           -- ^ Lower corner of (3D) bounding box
	-> ℝ3        -- ^ Upper corner of bounding box
	-> ℝ         -- ^ resolution of rendering
	-> FilePath  -- ^ Name of file to write STL to
	-> Obj3      -- ^ 3D object to make STL for
	-> IO()      -- ^ Resulting IO action that will write STL
writeSTL (x1,y1,z1) (x2,y2,z2) d name obj =
	let
		grid3d = [((obj(x,y,z), obj(x+d,y,z), obj(x,y+d,z), obj(x+d,y+d,z), obj(x,y,z+d), obj(x+d,y,z+d), obj(x,y+d,z+d), obj(x+d,y+d,z+d)), (x,y,z), d )| x <- [x1, x1+d.. x2], y <- [y1, y1 +d.. y2], z <- [z1, z1+d.. z2] ]
		triangles = concat $ map getTriangles grid3d
		stlHeader = "solid ImplictCADExport\n"
		stlFooter = "endsolid ImplictCADExport\n"
		vertex :: ℝ3 -> String
		vertex (x,y,z) = "vertex " ++ show x ++ " " ++ show y ++ " " ++ show z
		stlTriangle :: (ℝ3, ℝ3, ℝ3) -> String
		stlTriangle (a,b,c) =
			"facet normal 0 0 0\n"
			++ "outer loop\n"
			++ vertex a ++ "\n"
			++ vertex b ++ "\n"
			++ vertex c ++ "\n"
			++ "endloop\n"
			++ "endfacet\n"
		text = stlHeader
			++ (concat $ map stlTriangle triangles)
			++ stlFooter
	in do 
		writeFile name text