Add NumIdr as a dependency

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

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

src/Render/Color.idr

@@ -1,31 +1,24 @@
 module Render.Color
 
 import Data.Vect
+import Data.NumIdr
 
 %default total
 
 
 public export
 Color : Type
-Color = Vect 3 Double
+Color = Vector 3 Double
 
 public export
 ColorAlpha : Type
-ColorAlpha = Vect 4 Double
+ColorAlpha = (Vector 3 Double, Double)
-
-
-export
-withAlpha : Double -> Color -> ColorAlpha
-withAlpha a [r,g,b] = [r,g,b,a]
 
 export
 toAlpha : Color -> ColorAlpha
-toAlpha = withAlpha 1
+toAlpha = (,1)
 
 
 export
 over : ColorAlpha -> Color -> Color
-over [r,g,b,a] [r',g',b'] =
+over (ca,a) cb = lerp a cb ca
-  [r * a + r' * (1 - a),
-   g * a + g' * (1 - a),
-   b * a + b' * (1 - a)]

src/Render/Object.idr

@@ -5,10 +5,10 @@ import Render.Camera
 import Render.Color
 import public Render.Object.Interface
 import public Render.Object.Point
-import public Render.Object.Rectangle
 
 %default total
 
+
 public export
 data Object : Type where
   MkObject : IsObject obj => obj -> Object

src/Render/Object/Point.idr

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

src/Render/Object/Rectangle.idr

@@ -1,25 +0,0 @@
-module Render.Object.Rectangle
-
-import Data.Vect
-import Render.Color
-import Render.Camera
-import Render.Object.Interface
-
-%default total
-
-
-public export
-record Rectangle where
-  constructor MkRect
-  pos : (Double, Double)
-  width, height : Double
-  color : ColorAlpha
-
-
-export
-IsObject Rectangle where
-  draw (MkRect pos w h col) cam =
-    let (px,py) = pointToPix cam pos
-        pw = cast (w / cam.scenew * cast cam.pixw)
-        ph = cast (h / cam.sceneh * cast cam.pixh)
-    in  (,,col) <$> [px..px+pw-1] <*> [py..py+ph-1]

src/Render/Scene.idr

@@ -5,6 +5,7 @@ import Data.Vect
 import Data.IORef
 import Data.Buffer
 import System.File
+import Data.NumIdr
 import Render.Color
 import Render.Camera
 import Render.Object
@@ -21,17 +22,15 @@ record Scene where
 
 export
 render : (cam : Camera) -> Scene -> PictureType cam
-render cam sc =
+render cam sc = joinAxes $ foldl drawObject (repeat _ sc.bgcolor) sc.objects
-  let blank : PictureType cam = replicate _ (replicate _ sc.bgcolor)
-  in  foldl drawObject blank sc.objects
   where
-    drawPixel : (Integer, Integer, ColorAlpha) -> PictureType cam -> PictureType cam
+    drawPixel : (Integer, Integer, ColorAlpha) -> Array [cam.pixh, cam.pixw] Color -> Array [cam.pixh, cam.pixw] Color
-    drawPixel (x, y, col) pic = fromMaybe pic $ do
+    drawPixel (x, y, col) arr = fromMaybe arr $ do
-      x' <- integerToFin x cam.pixw
+      x' <- integerToFin x _
-      y' <- integerToFin y cam.pixh
+      y' <- integerToFin y _
-      pure $ updateAt y' (updateAt x' (over col)) pic
+      pure $ indexUpdate [x',y'] (over col) arr
 
-    drawObject : PictureType cam -> Object -> PictureType cam
+    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
@@ -46,12 +45,10 @@ renderToPPM dest cam sc = do
 
   let pic = render cam sc
   ind <- newIORef 0
-  for_ pic $ traverse_ $ \[r,g,b] => do
+  for_ pic $ \x => do
         i <- readIORef ind
-        setByte buf (i)     (cast $ r * 255)
+        setByte buf i (cast $ x * 255)
-        setByte buf (i + 1) (cast $ g * 255)
+        modifyIORef ind (+1)
-        setByte buf (i + 2) (cast $ b * 255)
-        modifyIORef ind (+3)
 
 
   _ <- if !(exists dest) then removeFile {io} dest else pure $ Right ()