code deduplication

This commit is contained in:
nek0 2018-07-02 18:18:27 +02:00
parent 850e9d7a07
commit 6dc6074a5a
2 changed files with 2 additions and 82 deletions

View file

@ -1,4 +1,4 @@
{ nixpkgs ? import <nixpkgs> {}, compiler ? "default", doBenchmark ? false }: { nixpkgs ? import <nixpkgs> {}, compiler ? "ghc843", doBenchmark ? false }:
let let

View file

@ -24,7 +24,7 @@ import Foreign.C.Types
import Types import Types
import MainGame.WorldMap (checkBoundsCollision2) import MainGame.WorldMap (checkBoundsCollision2, drawTile)
updateMind :: Double -> Affection UserData () updateMind :: Double -> Affection UserData ()
updateMind dt = do updateMind dt = do
@ -242,83 +242,3 @@ drawMind = do
textAlign ctx (S.fromList [AlignCenter,AlignTop]) textAlign ctx (S.fromList [AlignCenter,AlignTop])
fillColor ctx (rgb 255 128 0) fillColor ctx (rgb 255 128 0)
textBox ctx 0 0 200 ("FPS: " `T.append` T.pack (Prelude.take 5 $ show (1/dt))) textBox ctx 0 0 200 ("FPS: " `T.append` T.pack (Prelude.take 5 $ show (1/dt)))
drawTile
:: UserData
-> Context
-> [(V2 Double, AnimState)]
-> Double
-> Double
-> Int
-> Int
-> Maybe ImgId
-> IO ()
drawTile ud ctx posanims pr pc row col img =
when ((realToFrac x > -tileWidth && realToFrac y > -tileHeight) &&
((realToFrac x :: Double) < 1280 &&
(realToFrac (y - (74 - (realToFrac tileHeight :: CFloat))) :: Double) < 720)) $
do
let (bef, beh) = L.partition delimiter sorted
save ctx
mapM_ drawAnim beh
when (isJust img) drawImage
mapM_ drawAnim bef
restore ctx
where
delimiter (V2 nr nc, _) =
all delimit mb
where
delimit b
| nnr > fst (matmin b) && nnr < fst (matmax b) =
nnc < snd (matmin b)
| nnc > snd (matmin b) && nnc < snd (matmax b) =
nnr > fst (matmax b)
| otherwise =
True
nnr = nr - fromIntegral (floor nr)
nnc = nc - fromIntegral (floor nc)
-- any (\m -> nr < fromIntegral (floor nr :: Int) + m) maxrs &&
-- any (\m -> nc > fromIntegral (floor nc :: Int) + m) mincs
ai = assetImages ud
anims = assetAnimations ud
tileWidth = 64 :: Double
tileHeight = 32 :: Double
sorted = sortOn (\(V2 sr sc, _) -> sc + sr * fromIntegral col) posanims
minrs = Prelude.map (fst . matmin) mb
maxrs = Prelude.map (fst . matmax) mb
mincs = Prelude.map (snd . matmin) mb
maxcs = Prelude.map (snd . matmax) mb
x = realToFrac $ 640 + ((fromIntegral col - pc) +
(fromIntegral row - pr)) * (tileWidth / 2) :: CFloat
y = realToFrac $ 360 - (tileHeight / 2) + ((fromIntegral row - pr) -
(fromIntegral col - pc)) * (tileHeight / 2) :: CFloat
dist = distance (V2 (fromIntegral row) (fromIntegral col))
(V2 (realToFrac pr - 1) (realToFrac pc)) / 4
fact =
if (pr <= fromIntegral row + minimum maxrs &&
pc >= fromIntegral col + maximum mincs) &&
isWall (fromJust img)
then min 1 dist
else 1
mb = imgObstacle img
drawAnim (V2 nr nc, as) = do
let ax = realToFrac $ 640 + ((nc - pc) + (nr - pr)) * 32
ay = realToFrac $ 360 + ((nr - pr) - (nc - pc)) * 16
a = anims Map.! asId as
beginPath ctx
paint <- imagePattern ctx (ax - 32) (ay - 58) 64 74 0
(animSprites a !! asCurrentFrame as) 1
rect ctx (ax - 32) (ay - 58) 64 74
fillPaint ctx paint
fill ctx
drawImage = do
beginPath ctx
paint <- imagePattern
ctx x (y - (74 - realToFrac tileHeight))
(realToFrac tileWidth) 74
0
(ai Map.! fromJust img)
fact
rect ctx x (y - (74 - realToFrac tileHeight)) (realToFrac tileWidth) 74
fillPaint ctx paint
fill ctx