Quick actions

cmd+k|ctrl+k

Navigation

Languages

codeworld

Snippet info

Language

Haskell

Visibility

public

Author

danielmg17

Created

2019-10-14T17:44:54Z

Updated

2019-10-17T03:15:22Z

-- 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
INFO