-- 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
-}
-}