Add NumIdr as a dependency

This commit is contained in:
Kiana Sheibani 2022-11-30 22:45:39 -05:00
parent f5edad4b66
commit 68a401fa1d
Signed by: toki
GPG key ID: 6CB106C25E86A9F7
7 changed files with 38 additions and 63 deletions

View file

@ -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

View file

@ -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)]

View file

@ -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

View file

@ -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

View file

@ -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)]

View file

@ -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]

View file

@ -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 ()