-- http://hackage.haskell.org/package/base-4.12.0.0/docs/Data-Dynamic.html
-- https://wiki.haskell.org/Heterogenous_collections
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
import CodeWorld
import Data.Map (Map)
import Data.List
import Data.Ord
sortReverse :: Ord a => [a] -> [a]
sortReverse = sortBy (comparing Down)
fconcat :: (Foldable f, Monoid a) => f a -> a
fconcat = foldr mappend mempty
data Window = Window -- contains window + resolution info
newtype TimeScale = TimeScale Double -- default to 1 (how many updates per frame, if <1 then skip frames for slo-mo effect)
newtype FrameRate = FrameRate Int -- desired frame rate, in frames per second, default to 60
data Context = Context
{ contextWindow :: Window
, contextTimeScale :: TimeScale
, contextFrameRate :: FrameRate
}
type Vec2 = (Double, Double)
type Vec3 = (Double, Double, Double)
v3tov2 (x,y,_) = (x,y)
data Value = Int Int | String String | Double Double | Bool Bool | Vec2 Vec2 | Vec3 Vec3 | Frame Picture | List [Value] | Table (Map String Value)
class Stateful s where
load :: s -> s
update :: Event -> s -> s -- Event -> [s] -> s -> s ???
draw :: s -> Picture
data Collider = Rectangle Double Double | Circle Double
class Collidable c where -- WIP
checkCollision :: c -> c -> Bool
onCollision :: c -> c -> c
data Entity = Entity -- maybe convert entity and state into typeclasses ???
{ -- id :: String
img :: Picture
, pos :: Vec3
, scale :: Vec2
, rotation :: Double
, offset :: Vec2
, stats :: Maybe Value
--, collider :: Maybe Collider
, entityUpdate :: Event -> Entity -> Entity
}
instance Eq Entity where
(==) e1 e2 = (pos e1) == (pos e2)
instance Ord Entity where
(<) e1 e2 = (thrd $ pos e1) < (thrd $ pos e2)
where
thrd = \(_,_,z) -> z
(<=) e1 e2 = (e1 < e2) || e1 == e2
--data State = Main | Options | Game ...
data State = State
{ entities :: [Entity] -- replace with map
, suspendedState :: Maybe State
-- , context :: Context
}
instance Stateful Entity where
load e = e
update event e = entityUpdate e event e -- (-x,-y) in sdl
draw e@Entity{..} = (uncurry translated $ v3tov2 pos) $ rotated rotation $ (uncurry translated $ (\(x,y) -> (-x,y) ) offset) $ (uncurry scaled scale) $ img
instance Stateful State where
load s = s
update event state = defaultStateUpdate event state
draw state = fconcat $ fmap (\entity -> draw entity) $ entities state
defaultStateUpdate :: Event -> State -> State
defaultStateUpdate event state = state {entities = sortReverse $ fmap (\entity -> update event entity) $ entities state }
gameLoop :: Stateful s => s -> (Event -> s -> s) -> (s -> Picture) -> IO ()
gameLoop = activityOf
-- put in "Player.hs"
initPlayer = Entity (colored red $ solidRectangle 2 1) (0,0,0) (1,1) (pi/2) (5,5) Nothing updatePlayer
initobj = Entity (solidCircle 3) (0,0,1) (1,1) 0 (0,0) Nothing constupdate
updatePlayer (KeyPress key) = case key of
"A" -> translate (-0.2) 0
--"Left" -> translate (-0.2) 0
"D" -> translate 0.2 0
--"Right" -> translate 0.2 0
"W" -> translate 0 0.2
"S" -> translate 0 (-0.2)
_ -> id
updatePlayer other = id
constupdate = const id
translate dx dy entity@Entity{..} = entity {pos = (\(x,y,z) -> (x+dx, y+dy, z)) $ pos}
--
main = gameLoop (load $ State [initPlayer, initobj] Nothing) update draw
-- http://hackage.haskell.org/package/base-4.12.0.0/docs/Data-Dynamic.html
-- https://wiki.haskell.org/Heterogenous_collections
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
import CodeWorld
import Data.Map (Map)
import Data.List
import Data.Ord
sortD :: Ord a => [a] -> [a]
sortD = sortBy (comparing Down)
fconcat :: (Foldable f, Monoid a) => f a -> a
fconcat = foldr mappend mempty
data Window = Window -- contains window + resolution info
newtype TimeScale = TimeScale Double -- default to 1 (how many updates per frame, if <1 then skip frames for slo-mo effect)
newtype FrameRate = FrameRate Int -- desired frame rate, in frames per second, default to 60
data Context = Context
{ contextWindow :: Window
, contextTimeScale :: TimeScale
, contextFrameRate :: FrameRate
}
type Vec2 = (Double, Double)
type Vec3 = (Double, Double, Double)
v3tov2 (x,y,_) = (x,y)
data Value = Int Int | String String | Double Double | Bool Bool | Vec2 Vec2 | Vec3 Vec3 | Frame Picture | List [Value] | Table (Map String Value)
data Event' = Event Event | Collision Entity Entity -- how to check for collisions?
class Stateful s where
load :: s -> s
update :: Event -> s -> s
draw :: s -> Picture
data Collider = Rectangle Double Double | Circle Double -- Events should include collisions
data Entity = Entity -- add collider (or collider typeclass)
{ img :: Picture
, pos :: Vec3
, scale :: Vec2
, rotation :: Double
, offset :: Vec2
, stats :: Maybe Value
, collider :: Maybe Collider
, entityUpdate :: Event -> Entity -> Entity
}
instance Eq Entity where
(==) e1 e2 = (pos e1) == (pos e2)
instance Ord Entity where
(<) e1 e2 = (thrd $ pos e1) < (thrd $ pos e2)
where
thrd = \(_,_,z) -> z
(<=) e1 e2 = (e1 < e2) || e1 == e2
--data State = Main | Options | Game ...
data Collection = Collection
{ entities :: [Entity] -- replace with map
, suspendedCollection :: Maybe Collection
-- , context :: Context
}
instance Stateful Entity where
load e = e
update event e = entityUpdate e event e -- (-x,-y) in sdl
draw e@Entity{..} = (uncurry translated $ v3tov2 pos) $ rotated rotation $ (uncurry translated $ (\(x,y) -> (-x,y) ) offset) $ (uncurry scaled scale) $ img
instance Stateful Collection where
load s = s
update event state = state {entities = sortD $ fmap (\entity -> update event $ entity) $ entities state }
draw state = fconcat $ fmap (\entity -> draw entity) $ entities state
gameLoop :: Stateful s => s -> (Event -> s -> s) -> (s -> Picture) -> IO ()
gameLoop = activityOf
-- put in "Player.hs"
initPlayer = Entity (colored red $ solidRectangle 2 1) (0,0,0) (1,1) (pi/2) (5,5) Nothing Nothing updatePlayer
initobj = Entity (solidCircle 3) (0,0,1) (1,1) 0 (0,0) Nothing Nothing constupdate
updatePlayer (KeyPress key) = case key of
"A" -> translate (-0.2) 0
--"Left" -> translate (-0.2) 0
"D" -> translate 0.2 0
--"Right" -> translate 0.2 0
"W" -> translate 0 0.2
"S" -> translate 0 (-0.2)
_ -> id
updatePlayer other = id
constupdate = const id
translate dx dy entity@Entity{..} = entity {pos = (\(x,y,z) -> (x+dx, y+dy, z)) $ pos}
--
main = gameLoop (load $ Collection [initPlayer, initobj] Nothing) update draw