World.hs

   1 module World where
   2
   3 import Prelude hiding (lookup)
   4 import Data.IntMap (IntMap)
   5 import qualified Data.IntMap as IM
   6 import qualified Data.Set as Set
   7 import Data.Complex
   8 import Data.Maybe
   9 import Control.Monad.State
  10
  11 import Piece
  12 import Input
  13 import Output
  14 import Video
  15 import Coord
  16 import Image
  17 import Path
  18 import Control
  19 import Spatial
  20
  21 import Debug.Trace
  22
  23 data World = World {
  24   worldSpace :: Spatial,
  25   camera :: Coord,
  26   images :: IntMap Image
  27 }
  28
  29 runWorld :: [Input] -> World -> (World, [Output])
  30 runWorld ins (World s cam img) = (World s' cam' img', outs) where
  31   cam' = cam
  32   img' = img
  33   (over,diver,s1) = internalInteractions s
  34   cols =
  35     concat [
  36       wakeUps (allPieces s),
  37       [],
  38       map (\(a,b) -> (a, Overlap (self b) b)) over,
  39       map (\(b,a) -> (a, Overlap (self b) b)) over,
  40       map (\(a,b) -> (a, Diverge (self b) b)) diver,
  41       map (\(b,a) -> (a, Diverge (self b) b)) diver
  42     ]
  43   f (sv,rvs) (p,c) = let (sv',r) = pokePiece p c sv in (sv',r:rvs)
  44   (s2,rvs) = foldl f (s1,[]) cols
  45   --(outs,spawns) = separateReactions (concat rvs)
  46   (outs,spawns) = ([],[])
  47   s3 = spawnPieces spawns s2
  48   s' = moveEverything s3
  49
  50
  51
  52 wprint :: (Show a) => a -> b
  53 wprint x = trace (show x) undefined
  54
  55 wakeUps :: [Piece] -> [(Piece, Collision)]
  56 wakeUps ps = []
  57
  58
  59
  60 renderWorld :: Video -> World -> IO ()
  61 renderWorld video w = seeBelow where
  62   draws = snapShotPieces (worldSpace w)
  63   cxy = camera w
  64   seeBelow = do
  65     clear video
  66     forM_ draws (\(img,xy) -> imgApply img (xy+cxy))
  67     finalize video
  68     return ()
  69
  70
  71 loadWorld :: Video -> IO World
  72 loadWorld video = do
  73   img <- loadImage video "image.bmp"
  74   let
  75     pm = IM.fromList [
  76         (7, testPiece img (100:+0) (0:+10) 2 7),
  77         (5, testPiece img (100:+200) (0:+(-10)) 1 5)
  78       ]
  79   return $ World {
  80     worldSpace = Spatial pm (Set.empty),
  81     camera = 0,
  82     images = IM.fromList [(3,img)]
  83   }
  84
  85