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
|
||||
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)]
|
||||
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)]
|
||||
|
|
|
@ -28,7 +28,7 @@ render cam sc = joinAxes $ foldl drawObject (repeat _ sc.bgcolor) sc.objects
|
|||
drawPixel (x, y, col) arr = fromMaybe arr $ do
|
||||
x' <- integerToFin x _
|
||||
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 pic (MkObject obj) =
|
||||
|
@ -50,7 +50,6 @@ renderToPPM dest cam sc = do
|
|||
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
|
||||
|
|
Loading…
Reference in a new issue