From 8660bde83f3f78487fc9a7c6fb0f2c1e9a30bbd1 Mon Sep 17 00:00:00 2001
From: Kiana Sheibani <kiana.a.sheibani@gmail.com>
Date: Wed, 30 Nov 2022 09:51:24 -0500
Subject: [PATCH] Implement core renderer

---
 src/Render/Camera.idr |  8 +++++++-
 src/Render/Color.idr  |  7 +++++++
 src/Render/Scene.idr  | 18 ++++++++++++++----
 3 files changed, 28 insertions(+), 5 deletions(-)

diff --git a/src/Render/Camera.idr b/src/Render/Camera.idr
index d2e0ff7..e6f8f65 100644
--- a/src/Render/Camera.idr
+++ b/src/Render/Camera.idr
@@ -1,6 +1,6 @@
 module Render.Camera
 
-import Data.Nat
+import Data.Vect
 import Render.Color
 
 %default total
@@ -13,6 +13,12 @@ record Camera where
   pixw, pixh : Nat
 
 
+
+public export
+PictureType : Camera -> Type
+PictureType cam = Vect cam.pixh (Vect cam.pixw Color)
+
+
 export
 pointToPix : Camera -> (Double, Double) -> (Integer, Integer)
 pointToPix (MkCamera (cx,cy) sw sh pw ph) (x,y) =
diff --git a/src/Render/Color.idr b/src/Render/Color.idr
index 2ad4f5b..030a3d3 100644
--- a/src/Render/Color.idr
+++ b/src/Render/Color.idr
@@ -21,3 +21,10 @@ export
 toAlpha : Color -> ColorAlpha
 toAlpha = withAlpha 1
 
+
+export
+over : ColorAlpha -> Color -> Color
+over [r,g,b,a] [r',g',b'] =
+  [r * a + r' * (1 - a),
+   g * a + g' * (1 - a),
+   b * a + b' * (1 - a)]
diff --git a/src/Render/Scene.idr b/src/Render/Scene.idr
index 87a9451..63a520f 100644
--- a/src/Render/Scene.idr
+++ b/src/Render/Scene.idr
@@ -16,8 +16,18 @@ record Scene where
 
 
 public export
-PictureType : Scene -> Type
-PictureType sc = Vect sc.camera.pixh (Vect sc.camera.pixw (Vect 3 Bits8))
-
-
+render : (cam : Camera) -> Scene -> PictureType cam
+render cam sc =
+  let blank : PictureType cam = replicate _ (replicate _ sc.bgcolor)
+  in  foldl drawObject blank sc.objects
+  where
+    drawPixel : (Integer, Integer, ColorAlpha) -> PictureType cam -> PictureType cam
+    drawPixel (x, y, col) pic = fromMaybe pic $ do
+      x' <- integerToFin x cam.pixw
+      y' <- integerToFin y cam.pixh
+      pure $ updateAt y' (updateAt x' (over col)) pic
 
+    drawObject : PictureType cam -> Object -> PictureType cam
+    drawObject pic (MkObject obj) =
+      let pixs = draw obj cam
+      in  foldr drawPixel pic pixs