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" sourcedir = "src"
readme = "README.md" 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 module Render.Camera
import Data.Vect import Data.Vect
import Data.NumIdr
import Render.Color import Render.Color
%default total %default total
@ -8,7 +9,8 @@ import Render.Color
public export public export
record Camera where record Camera where
constructor MkCamera constructor MkCamera
center : (Double, Double) matrix : Rigid 2 Double
scenew, sceneh : Double scenew, sceneh : Double
pixw, pixh : Nat pixw, pixh : Nat
@ -16,13 +18,11 @@ record Camera where
public export public export
PictureType : Camera -> Type PictureType : Camera -> Type
PictureType cam = Vect cam.pixh (Vect cam.pixw Color) PictureType cam = Array [cam.pixh, cam.pixw, 3] Double
export 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))

View file

@ -1,31 +1,24 @@
module Render.Color module Render.Color
import Data.Vect import Data.Vect
import Data.NumIdr
%default total %default total
public export public export
Color : Type Color : Type
Color = Vect 3 Double Color = Vector 3 Double
public export public export
ColorAlpha : Type 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 export
toAlpha : Color -> ColorAlpha toAlpha : Color -> ColorAlpha
toAlpha = withAlpha 1 toAlpha = (,1)
export export
over : ColorAlpha -> Color -> Color 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)]

View file

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

View file

@ -1,6 +1,7 @@
module Render.Object.Point module Render.Object.Point
import Data.Vect import Data.Vect
import Data.NumIdr
import Render.Color import Render.Color
import Render.Camera import Render.Camera
import Render.Object.Interface import Render.Object.Interface
@ -11,12 +12,12 @@ import Render.Object.Interface
public export public export
record Point where record Point where
constructor MkPoint constructor MkPoint
pos : (Double, Double) pos : Point 2 Double
color : ColorAlpha color : ColorAlpha
export export
IsObject Point where IsObject Point where
draw (MkPoint pos col) cam = 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)]

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.IORef
import Data.Buffer import Data.Buffer
import System.File import System.File
import Data.NumIdr
import Render.Color import Render.Color
import Render.Camera import Render.Camera
import Render.Object import Render.Object
@ -21,17 +22,15 @@ record Scene where
export export
render : (cam : Camera) -> Scene -> PictureType cam 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 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) = drawObject pic (MkObject obj) =
let pixs = draw obj cam let pixs = draw obj cam
in foldr drawPixel pic pixs in foldr drawPixel pic pixs
@ -46,12 +45,10 @@ renderToPPM dest cam sc = do
let pic = render cam sc let pic = render cam sc
ind <- newIORef 0 ind <- newIORef 0
for_ pic $ traverse_ $ \[r,g,b] => do for_ pic $ \x => do
i <- readIORef ind 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 () _ <- if !(exists dest) then removeFile {io} dest else pure $ Right ()