Skip to content

Instantly share code, notes, and snippets.

@fumieval
Last active August 29, 2015 14:14
Show Gist options
  • Save fumieval/c00a25102bca2abd708f to your computer and use it in GitHub Desktop.
Save fumieval/c00a25102bca2abd708f to your computer and use it in GitHub Desktop.
-- (a, b, c ...) represents a sum of effects a, b, c...
-- They do not occur simultaneously
-- f ~> g is the type of objects that handles f, works on g
-- the player handles key events and external events to produce motion, sound effects, outgoing events, and death
player :: (Control, Event) ~> (Motion, SoundEffect, Event, Death)
player = \(sp, ev) ~> hideContext $ do
-- | Create new context
hp <- newContext
dmg <- case ev of
Struck damage -> do
motionOuch
soundHit
hp -= damage
Heal v -> do
soundHeal
hp += v
-- Regeneration of health
regen <- hp += 1
death <- when (hp <= 0) die
case sp of
MouseL -> motionAttack >>= eventAttack
MouseR -> do
soundMagical
motionSpell >>= eventSpell
KeyW -> motionWalk
KeyS -> motionRetreat
KeyA -> motionSidestepL
KeyD -> motionSidestepR
variable 100 -< regen ⊕ dmg ⊕ death
actor :: (Event, Time, Control, Graphic, Audio) ~> (Event, Environment, Death)
actor = \(event, time, control, graphic, audio) ~> do
-- Motion and the force varies by external events and the user control.
(pmot, pse, pout, pdeath) <- player -< control ⊕ event
-- Translate motions to concrete states.
(mpos, mpose, mforce) <- motion -< pmot
-- Rendering depends on the current pose and the position.
(rpose, rpos) <- render -< graphic
-- Physics based on time evolution.
(ppos, pvel, fetchEnv) <- physics playerWeight actorShape -< time ⊕ mforce
-- Play sound effects.
sampler -< pse ⊕ audio
-- Initially it is standing. It accepts motion changes and does not depend on anything.
variable Stand -< mpose ⊕ rpose
variable initialPosition -< ppos ⊕ rpos
variable zero -< pvel
-- Outgoing events (e.g. firing a magic)
fetchEnv ⊕ pout ⊕ pdeath
motion :: Motion ~> (State Vec, State Pose, Force)
sampler :: Monad e => (SoundEffect, Audio) ~> e
variable :: Monad e => s -> State s ~> e
physics :: Float -> Shape -> (Time, Force) ~> (State Vec, State Vec, Environment)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment