Implement core renderer
This commit is contained in:
parent
f3bda5d40c
commit
8660bde83f
|
@ -1,6 +1,6 @@
|
||||||
module Render.Camera
|
module Render.Camera
|
||||||
|
|
||||||
import Data.Nat
|
import Data.Vect
|
||||||
import Render.Color
|
import Render.Color
|
||||||
|
|
||||||
%default total
|
%default total
|
||||||
|
@ -13,6 +13,12 @@ record Camera where
|
||||||
pixw, pixh : Nat
|
pixw, pixh : Nat
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
public export
|
||||||
|
PictureType : Camera -> Type
|
||||||
|
PictureType cam = Vect cam.pixh (Vect cam.pixw Color)
|
||||||
|
|
||||||
|
|
||||||
export
|
export
|
||||||
pointToPix : Camera -> (Double, Double) -> (Integer, Integer)
|
pointToPix : Camera -> (Double, Double) -> (Integer, Integer)
|
||||||
pointToPix (MkCamera (cx,cy) sw sh pw ph) (x,y) =
|
pointToPix (MkCamera (cx,cy) sw sh pw ph) (x,y) =
|
||||||
|
|
|
@ -21,3 +21,10 @@ export
|
||||||
toAlpha : Color -> ColorAlpha
|
toAlpha : Color -> ColorAlpha
|
||||||
toAlpha = withAlpha 1
|
toAlpha = withAlpha 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)]
|
||||||
|
|
|
@ -16,8 +16,18 @@ record Scene where
|
||||||
|
|
||||||
|
|
||||||
public export
|
public export
|
||||||
PictureType : Scene -> Type
|
render : (cam : Camera) -> Scene -> PictureType cam
|
||||||
PictureType sc = Vect sc.camera.pixh (Vect sc.camera.pixw (Vect 3 Bits8))
|
render cam sc =
|
||||||
|
let blank : PictureType cam = replicate _ (replicate _ sc.bgcolor)
|
||||||
|
in foldl drawObject blank 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
|
||||||
|
|
||||||
|
drawObject : PictureType cam -> Object -> PictureType cam
|
||||||
|
drawObject pic (MkObject obj) =
|
||||||
|
let pixs = draw obj cam
|
||||||
|
in foldr drawPixel pic pixs
|
||||||
|
|
Loading…
Reference in a new issue