From 68a401fa1da18c6b3024297882b326fb62f86d74 Mon Sep 17 00:00:00 2001 From: Kiana Sheibani Date: Wed, 30 Nov 2022 22:45:39 -0500 Subject: [PATCH] Add NumIdr as a dependency --- render.ipkg | 9 +++++++++ src/Render/Camera.idr | 16 ++++++++-------- src/Render/Color.idr | 17 +++++------------ src/Render/Object.idr | 2 +- src/Render/Object/Point.idr | 7 ++++--- src/Render/Object/Rectangle.idr | 25 ------------------------- src/Render/Scene.idr | 25 +++++++++++-------------- 7 files changed, 38 insertions(+), 63 deletions(-) delete mode 100644 src/Render/Object/Rectangle.idr diff --git a/render.ipkg b/render.ipkg index afce705..4be97bd 100644 --- a/render.ipkg +++ b/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 diff --git a/src/Render/Camera.idr b/src/Render/Camera.idr index e6f8f65..197138f 100644 --- a/src/Render/Camera.idr +++ b/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 (MkCamera (cx,cy) sw sh pw ph) (x,y) = - let pw' = cast pw - ph' = cast ph - in (cast ((x - cx) / sw * pw' + pw' / 2), - cast ((y - cy) / sh * ph' + ph' / 2)) +pointToPix : Camera -> Point 2 Double -> Point 2 Integer +pointToPix (MkCamera mat sw sh pw ph) p = + let p' = applyInv mat p + in point [cast (p'.x / sw * cast pw), cast (p'.y / sh * cast ph)] diff --git a/src/Render/Color.idr b/src/Render/Color.idr index ad62b74..0e02273 100644 --- a/src/Render/Color.idr +++ b/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 - - -export -withAlpha : Double -> Color -> ColorAlpha -withAlpha a [r,g,b] = [r,g,b,a] +ColorAlpha = (Vector 3 Double, Double) export toAlpha : Color -> ColorAlpha -toAlpha = withAlpha 1 +toAlpha = (,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)] +over (ca,a) cb = lerp a cb ca diff --git a/src/Render/Object.idr b/src/Render/Object.idr index bef533e..9ca55c3 100644 --- a/src/Render/Object.idr +++ b/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 diff --git a/src/Render/Object/Point.idr b/src/Render/Object/Point.idr index fa3a548..2ab7e7f 100644 --- a/src/Render/Object/Point.idr +++ b/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 - in [(px,py,col)] + let p = pointToPix cam pos + in [(p.x,p.y,col)] diff --git a/src/Render/Object/Rectangle.idr b/src/Render/Object/Rectangle.idr deleted file mode 100644 index a7093f1..0000000 --- a/src/Render/Object/Rectangle.idr +++ /dev/null @@ -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] diff --git a/src/Render/Scene.idr b/src/Render/Scene.idr index 4794412..b9e3b81 100644 --- a/src/Render/Scene.idr +++ b/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 = - let blank : PictureType cam = replicate _ (replicate _ sc.bgcolor) - in foldl drawObject blank sc.objects +render cam sc = joinAxes $ foldl drawObject (repeat _ sc.bgcolor) 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 + 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 [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 + 1) (cast $ g * 255) - setByte buf (i + 2) (cast $ b * 255) - modifyIORef ind (+3) + setByte buf i (cast $ x * 255) + modifyIORef ind (+1) _ <- if !(exists dest) then removeFile {io} dest else pure $ Right ()