From ef52a8f702952a8398d17ca7e0c895bcdacbb7b1 Mon Sep 17 00:00:00 2001
From: Kiana Sheibani <kiana.a.sheibani@gmail.com>
Date: Wed, 30 Nov 2022 12:56:52 -0500
Subject: [PATCH] Add PPM image exporting

---
 .gitignore                      |  6 ++++++
 src/Render/Object.idr           | 10 +++-------
 src/Render/Object/Interface.idr | 11 +++++++++++
 src/Render/Object/Point.idr     |  5 ++---
 src/Render/Scene.idr            | 28 +++++++++++++++++++++++++++-
 5 files changed, 49 insertions(+), 11 deletions(-)
 create mode 100644 src/Render/Object/Interface.idr

diff --git a/.gitignore b/.gitignore
index 3341ed1..2243e3f 100644
--- a/.gitignore
+++ b/.gitignore
@@ -5,3 +5,9 @@ build/
 *.*~
 
 **/.DS_Store
+
+# Ignore output images
+*.ppm
+*.png
+*.jpg
+*.gif
diff --git a/src/Render/Object.idr b/src/Render/Object.idr
index 59d4652..be6ccc5 100644
--- a/src/Render/Object.idr
+++ b/src/Render/Object.idr
@@ -3,15 +3,11 @@ module Render.Object
 import Data.Vect
 import Render.Camera
 import Render.Color
+import public Render.Object.Interface
+import public Render.Object.Point
 
 %default total
 
-
-public export
-interface Object' obj where
-  draw : obj -> Camera -> List (Integer, Integer, ColorAlpha)
-
-
 public export
 data Object : Type where
-  MkObject : Object' obj => obj -> Object
+  MkObject : IsObject obj => obj -> Object
diff --git a/src/Render/Object/Interface.idr b/src/Render/Object/Interface.idr
new file mode 100644
index 0000000..ee8d7d7
--- /dev/null
+++ b/src/Render/Object/Interface.idr
@@ -0,0 +1,11 @@
+module Render.Object.Interface
+
+import Data.Vect
+import Render.Color
+import Render.Camera
+
+%default total
+
+public export
+interface IsObject obj where
+  draw : obj -> Camera -> List (Integer, Integer, ColorAlpha)
diff --git a/src/Render/Object/Point.idr b/src/Render/Object/Point.idr
index b4355ca..70bab8b 100644
--- a/src/Render/Object/Point.idr
+++ b/src/Render/Object/Point.idr
@@ -4,12 +4,11 @@ import Data.Vect
 import Render.Color
 import Render.Camera
 import Render.Picture
-import Render.Object
+import Render.Object.Interface
 
 %default total
 
 
-
 public export
 record Point where
   constructor MkPoint
@@ -18,7 +17,7 @@ record Point where
 
 
 export
-Object' Point where
+IsObject Point where
   draw (MkPoint pos col) cam =
     let (px,py) = pointToPix cam pos
     in  [(px,py,col)]
diff --git a/src/Render/Scene.idr b/src/Render/Scene.idr
index 63a520f..eaaaa5b 100644
--- a/src/Render/Scene.idr
+++ b/src/Render/Scene.idr
@@ -1,6 +1,9 @@
 module Render.Scene
 
+import Data.DPair
 import Data.Vect
+import Data.Buffer
+import System.File
 import Render.Color
 import Render.Camera
 import Render.Object
@@ -15,7 +18,7 @@ record Scene where
   bgcolor : Color
 
 
-public export
+export
 render : (cam : Camera) -> Scene -> PictureType cam
 render cam sc =
   let blank : PictureType cam = replicate _ (replicate _ sc.bgcolor)
@@ -31,3 +34,26 @@ render cam sc =
     drawObject pic (MkObject obj) =
       let pixs = draw obj cam
       in  foldr drawPixel pic pixs
+
+
+export
+renderToPPM : HasIO io => (dest : String) -> Camera -> Scene -> io (Either FileError ())
+renderToPPM dest cam sc = do
+  let bufsize = cast cam.pixw * cast cam.pixh * 3
+  Just buf <- newBuffer bufsize
+    | Nothing => pure $ Right ()
+
+  let pic = render cam sc
+  for_ (zip (tabulate fst) (concat pic)) $ \(i,[r,g,b]) => do
+        setByte buf (cast i * 3)     (cast $ r * 255)
+        setByte buf (cast i * 3 + 1) (cast $ g * 255)
+        setByte buf (cast i * 3 + 2) (cast $ b * 255)
+
+  _ <- if !(exists dest) then removeFile {io} dest else pure $ Right ()
+  Right h <- openFile dest Append
+    | Left err => pure $ Left err
+  Right () <- fPutStrLn h "P6\n\{show cam.pixw} \{show cam.pixh}\n255"
+    | Left err => pure $ Left err
+  Right () <- writeBufferData h buf 0 bufsize
+    | Left (err,_) => pure $ Left err
+  pure $ Right ()