Fix rendering bugs
This commit is contained in:
parent
68a401fa1d
commit
2628b42a54
|
@ -24,5 +24,7 @@ PictureType cam = Array [cam.pixh, cam.pixw, 3] Double
|
||||||
export
|
export
|
||||||
pointToPix : Camera -> Point 2 Double -> Point 2 Integer
|
pointToPix : Camera -> Point 2 Double -> Point 2 Integer
|
||||||
pointToPix (MkCamera mat sw sh pw ph) p =
|
pointToPix (MkCamera mat sw sh pw ph) p =
|
||||||
let p' = applyInv mat p
|
let pw' = cast pw
|
||||||
in point [cast (p'.x / sw * cast pw), cast (p'.y / sh * cast ph)]
|
ph' = cast ph
|
||||||
|
p' = applyInv mat p
|
||||||
|
in point [cast (p'.x / sw * pw' + pw' / 2), cast (p'.y / sh * ph' + ph' / 2)]
|
||||||
|
|
|
@ -28,7 +28,7 @@ render cam sc = joinAxes $ foldl drawObject (repeat _ sc.bgcolor) sc.objects
|
||||||
drawPixel (x, y, col) arr = fromMaybe arr $ do
|
drawPixel (x, y, col) arr = fromMaybe arr $ do
|
||||||
x' <- integerToFin x _
|
x' <- integerToFin x _
|
||||||
y' <- integerToFin y _
|
y' <- integerToFin y _
|
||||||
pure $ indexUpdate [x',y'] (over col) arr
|
pure $ indexUpdate [y',x'] (over col) arr
|
||||||
|
|
||||||
drawObject : Array [cam.pixh, cam.pixw] Color -> Object -> Array [cam.pixh, cam.pixw] Color
|
drawObject : Array [cam.pixh, cam.pixw] Color -> Object -> Array [cam.pixh, cam.pixw] Color
|
||||||
drawObject pic (MkObject obj) =
|
drawObject pic (MkObject obj) =
|
||||||
|
@ -50,7 +50,6 @@ renderToPPM dest cam sc = do
|
||||||
setByte buf i (cast $ x * 255)
|
setByte buf i (cast $ x * 255)
|
||||||
modifyIORef ind (+1)
|
modifyIORef ind (+1)
|
||||||
|
|
||||||
|
|
||||||
_ <- if !(exists dest) then removeFile {io} dest else pure $ Right ()
|
_ <- if !(exists dest) then removeFile {io} dest else pure $ Right ()
|
||||||
Right h <- openFile dest Append
|
Right h <- openFile dest Append
|
||||||
| Left err => pure $ Left err
|
| Left err => pure $ Left err
|
||||||
|
|
Loading…
Reference in a new issue