Skip to content

Instantly share code, notes, and snippets.

@TheSeamau5
Last active June 12, 2017 03:23
Show Gist options
  • Star 4 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save TheSeamau5/9f885fe62b2c776cdd26 to your computer and use it in GitHub Desktop.
Save TheSeamau5/9f885fe62b2c776cdd26 to your computer and use it in GitHub Desktop.
Example under the New Record Entity Component System
import List (map, (::))
import Color (Color, rgb)
import Keyboard (arrows)
import Signal (Signal, (<~), foldp)
import Graphics.Collage (square, circle, move, filled, collage, Form)
import Graphics.Element (Element)
type alias Vector = {
x : Float,
y : Float
}
type Shape = Square | Circle
type Controls = ArrowControls
type alias Input = {x : Int, y : Int}
--- THE ENTITY TYPE ---
type alias Entity = {
position : Maybe Vector,
velocity : Maybe Vector,
mass : Maybe Float,
scale : Maybe Float,
color : Maybe Color,
shape : Maybe Shape,
controls : Maybe Controls
}
--- DEFAULT ENTITY ---
-- used to construct other entities
entity : Entity
entity = {
position = Nothing,
velocity = Nothing,
mass = Nothing,
scale = Nothing,
color = Nothing,
shape = Nothing,
controls = Nothing}
--- Some Boilerplate to make things easier ---
position : Float -> Float -> Entity -> Entity
position x y entity =
{ entity | position <- Just (Vector x y)}
velocity : Float -> Float -> Entity -> Entity
velocity x y entity =
{ entity | velocity <- Just (Vector x y)}
mass : Float -> Entity -> Entity
mass m entity =
{ entity | mass <- Just m }
scale : Float -> Entity -> Entity
scale s entity =
{ entity | scale <- Just s }
color : Int -> Int -> Int -> Entity -> Entity
color r g b entity =
{ entity | color <- Just (rgb r g b) }
shape : Shape -> Entity -> Entity
shape s entity =
{ entity | shape <- Just s }
controls : Controls -> Entity -> Entity
controls c entity =
{ entity | controls <- Just c }
(<>) : Entity -> List (Entity -> Entity) -> Entity
(<>) entity updaters =
case updaters of
[] -> entity
f :: fs -> (<>) (f entity) fs
--- End of boilerplate ---
-- red box controllable by player affect by gravity
redBox =
entity <> [
position 0 0,
velocity 10 0,
mass 10,
scale 10,
color 255 0 0,
shape Square,
controls ArrowControls
]
-- blue box affected by gravity
blueBox =
entity <> [
position 30 0,
velocity 0 0,
mass 30,
scale 5,
color 0 0 255,
shape Square
]
-- green circle affected by gravity
greenBall =
entity <> [
position 100 0,
velocity -10 10,
mass 10,
scale 20,
color 0 255 0,
shape Circle
]
-- unmoving black circle unaffected by gravity
blackBall =
entity <> [
position 10 100,
scale 30,
color 0 0 0,
shape Circle
]
entities : List Entity
entities = [
redBox,
blueBox,
greenBall,
blackBall ]
--- Actions
moveEntity : Entity -> Entity
moveEntity entity =
case (entity.position, entity.velocity) of
(Just pos, Just vel) ->
entity |> position (pos.x + vel.x) (pos.y + vel.y)
_ -> entity
applyGravity : Float -> Entity -> Entity
applyGravity gravity entity =
case (entity.velocity, entity.mass) of
(Just vel, Just m) ->
entity |> velocity vel.x (vel.y + gravity / m)
_ -> entity
applyInput : Input -> Entity -> Entity
applyInput {x,y} entity =
case (entity.velocity, entity.controls) of
(Just vel, Just _) ->
entity |> velocity (vel.x + toFloat x) (vel.y + toFloat y)
_ -> entity
renderEntity : Entity -> Maybe Form
renderEntity entity =
case (entity.position, entity.scale, entity.shape, entity.color) of
(Just pos, Just scl, Just shp, Just col) ->
case shp of
Square ->
Just <| move (pos.x, pos.y) <| filled col (square scl)
Circle ->
Just <| move (pos.x, pos.y) <| filled col (circle scl)
_ -> Nothing
render : List Entity -> Element
render entities = collage 400 400
(filterJusts (map renderEntity entities))
updateEntity : Input -> Entity -> Entity
updateEntity input entity =
entity <> [
applyGravity gravity,
applyInput input,
moveEntity
]
update : Input -> List Entity -> List Entity
update input = map (updateEntity input)
input : Signal Input
input = accumulateInput arrows
gravity : Float
gravity = -0.5
main : Signal Element
main = render <~ foldp update entities input
accumulateInput : Signal Input -> Signal Input
accumulateInput =
let add p q = {x = p.x + q.x, y = p.y + q.y}
origin = {x = 0, y = 0}
in foldp add origin
filterJusts : List (Maybe a) -> List a
filterJusts list =
case list of
[] -> []
x :: xs ->
case x of
Nothing -> filterJusts xs
Just just -> just :: filterJusts xs
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment