code deduplication

shell.nix

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

src/MainGame/MindMap.hs

@@ -24,7 +24,7 @@ import Foreign.C.Types
 
 import Types
 
-import MainGame.WorldMap (checkBoundsCollision2)
+import MainGame.WorldMap (checkBoundsCollision2, drawTile)
 
 updateMind :: Double -> Affection UserData ()
 updateMind dt = do
@@ -242,83 +242,3 @@ drawMind = do
     textAlign ctx (S.fromList [AlignCenter,AlignTop])
     fillColor ctx (rgb 255 128 0)
     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