diff --git a/.gitignore b/.gitignore index 26223c6..2243e3f 100644 --- a/.gitignore +++ b/.gitignore @@ -3,3 +3,11 @@ build/ *.*~ + +**/.DS_Store + +# Ignore output images +*.ppm +*.png +*.jpg +*.gif 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 new file mode 100644 index 0000000..c1627d7 --- /dev/null +++ b/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)] diff --git a/src/Render/Color.idr b/src/Render/Color.idr new file mode 100644 index 0000000..0e02273 --- /dev/null +++ b/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 diff --git a/src/Render/Object.idr b/src/Render/Object.idr new file mode 100644 index 0000000..9ca55c3 --- /dev/null +++ b/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 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 new file mode 100644 index 0000000..2ab7e7f --- /dev/null +++ b/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)] diff --git a/src/Render/Scene.idr b/src/Render/Scene.idr new file mode 100644 index 0000000..cd9a9d1 --- /dev/null +++ b/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 ()