Fix rendering bugs

I don't know why I thought it was a good idea to use `concat`,
but I'm not making that mistake again.

.gitignore

@@ -3,3 +3,11 @@
 
 build/
 *.*~
+
+**/.DS_Store
+
+# Ignore output images
+*.ppm
+*.png
+*.jpg
+*.gif

render.ipkg

@@ -8,3 +8,12 @@ langversion >= 0.5.1
 
 sourcedir = "src"
 readme = "README.md"
+
+depends = numidr >= 0.2.1
+
+modules = Render.Color,
+          Render.Camera,
+          Render.Object,
+          Render.Scene,
+          Render.Object.Interface,
+          Render.Object.Point

src/Render/Camera.idr

@@ -0,0 +1,30 @@
+module Render.Camera
+
+import Data.Vect
+import Data.NumIdr
+import Render.Color
+
+%default total
+
+public export
+record Camera where
+  constructor MkCamera
+  matrix : Rigid 2 Double
+
+  scenew, sceneh : Double
+  pixw, pixh : Nat
+
+
+
+public export
+PictureType : Camera -> Type
+PictureType cam = Array [cam.pixh, cam.pixw, 3] Double
+
+
+export
+pointToPix : Camera -> Point 2 Double -> Point 2 Integer
+pointToPix (MkCamera mat sw sh pw ph) p =
+  let pw' = cast pw
+      ph' = cast ph
+      p' = applyInv mat p
+  in  point [cast (p'.x / sw * pw' + pw' / 2), cast (p'.y / sh * ph' + ph' / 2)]

src/Render/Color.idr

@@ -0,0 +1,24 @@
+module Render.Color
+
+import Data.Vect
+import Data.NumIdr
+
+%default total
+
+
+public export
+Color : Type
+Color = Vector 3 Double
+
+public export
+ColorAlpha : Type
+ColorAlpha = (Vector 3 Double, Double)
+
+export
+toAlpha : Color -> ColorAlpha
+toAlpha = (,1)
+
+
+export
+over : ColorAlpha -> Color -> Color
+over (ca,a) cb = lerp a cb ca

src/Render/Object.idr

@@ -0,0 +1,14 @@
+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
+data Object : Type where
+  MkObject : IsObject obj => obj -> Object

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)

src/Render/Object/Point.idr

@@ -0,0 +1,23 @@
+module Render.Object.Point
+
+import Data.Vect
+import Data.NumIdr
+import Render.Color
+import Render.Camera
+import Render.Object.Interface
+
+%default total
+
+
+public export
+record Point where
+  constructor MkPoint
+  pos : Point 2 Double
+  color : ColorAlpha
+
+
+export
+IsObject Point where
+  draw (MkPoint pos col) cam =
+    let p = pointToPix cam pos
+    in  [(p.x,p.y,col)]

src/Render/Scene.idr

@@ -0,0 +1,60 @@
+module Render.Scene
+
+import Data.DPair
+import Data.Vect
+import Data.IORef
+import Data.Buffer
+import System.File
+import Data.NumIdr
+import Render.Color
+import Render.Camera
+import Render.Object
+
+%default total
+
+
+public export
+record Scene where
+  constructor MkScene
+  objects : List Object
+  bgcolor : Color
+
+
+export
+render : (cam : Camera) -> Scene -> PictureType cam
+render cam sc = joinAxes $ foldl drawObject (repeat _ sc.bgcolor) sc.objects
+  where
+    drawPixel : (Integer, Integer, ColorAlpha) -> Array [cam.pixh, cam.pixw] Color -> Array [cam.pixh, cam.pixw] Color
+    drawPixel (x, y, col) arr = fromMaybe arr $ do
+      x' <- integerToFin x _
+      y' <- integerToFin y _
+      pure $ indexUpdate [y',x'] (over col) arr
+
+    drawObject : Array [cam.pixh, cam.pixw] Color -> Object -> Array [cam.pixh, cam.pixw] Color
+    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
+  ind <- newIORef 0
+  for_ pic $ \x => do
+        i <- readIORef ind
+        setByte buf i (cast $ x * 255)
+        modifyIORef ind (+1)
+
+  _ <- 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 ()