codeworld

Run Settings
LanguageHaskell
Language Version
Run Command
-- 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
Editor Settings
Theme
Key bindings
Full width
Lines