Skip to content

Instantly share code, notes, and snippets.

@bryanedds
Created May 30, 2019 21:39
Show Gist options
  • Save bryanedds/45fbb735fdc8c0589c01666be20b1338 to your computer and use it in GitHub Desktop.
Save bryanedds/45fbb735fdc8c0589c01666be20b1338 to your computer and use it in GitHub Desktop.
[<AutoOpen>]
module GelmDispatcherModule =
type [<NoEquality; NoComparison>] Binding<'m, 's when 's :> Simulant> =
{ Address : Address<obj>
AddressType : Type
MakeMessage : Event<obj, 's> -> 'm option }
type [<NoEquality; NoComparison>] Binding<'m, 'e, 's when 's :> Simulant> =
| Binding of Binding<'m, 's>
| BindingEffect of Binding<'e, 's>
module Binding =
let make<'a, 'm> (address : Address<'a>) (message : 'm) =
{ Address = atooa address
AddressType = typeof<'a>
MakeMessage = fun _ -> Some message }
let makeFun<'a, 's, 'm when 's :> Simulant> (address : Address<'a>) (makeMessage : Event<obj, 's> -> 'm option) =
{ Address = atooa address
AddressType = typeof<'a>
MakeMessage = makeMessage }
let (==>) address message =
Binding (Binding.make address message)
let (=>>) address message =
Binding (Binding.makeFun address message)
let (=!>) address message =
BindingEffect (Binding.make address message)
let (=!>>) address message =
BindingEffect (Binding.makeFun address message)
type ViewPhase =
| Initialize
| Actualize
| Finalize
type [<AbstractClass>]
GelmDispatcher<'model, 'message, 'messageEffect> () =
inherit GameDispatcher ()
override this.Register (game, world) =
let bindings = this.BindModel (game, world)
let world =
List.fold (fun world binding ->
match binding with
| Binding binding ->
World.monitor (fun evt world ->
let model = this.GetModel (game, world)
let messageOpt = binding.MakeMessage evt
match messageOpt with
| Some message ->
let model = this.UpdateModel (message, model, game, world)
this.SetModel (model, game, world)
| None -> world)
binding.Address game world
| BindingEffect binding ->
World.monitor (fun evt world ->
let model = this.GetModel (game, world)
let messageOpt = binding.MakeMessage evt
match messageOpt with
| Some message -> this.EffectModel (message, model, game, world)
| None -> world)
binding.Address game world)
world bindings
let model = this.GetModel (game, world)
let world = this.ViewModel (Initialize, model, game, world)
world
override this.Unregister (game, world) =
let model = this.GetModel (game, world)
let world = this.ViewModel (Finalize, model, game, world)
world
override this.Actualize (game, world) =
let model = this.GetModel (game, world)
this.ViewModel (Actualize, model, game, world)
abstract member GetModel : Game * World -> 'model
abstract member SetModel : 'model * Game * World -> World
abstract member BindModel : Game * World -> Binding<'message, 'messageEffect, Game> list
abstract member UpdateModel : 'message * 'model * Game * World -> 'model
abstract member EffectModel : 'messageEffect * 'model * Game * World -> World
abstract member ViewModel : ViewPhase * 'model * Game * World -> World
type [<NoEquality; NoComparison>] Model =
{ Count : int
Screen : Screen }
type Message =
| Message1
| Message2
type MessageEffect =
| Exit
type Game with
member this.GetSampleModel world : Model = this.Get Property? SampleModel world
member this.SetSampleModel (value : Model) world = this.Set Property? SampleModel value world
member this.SampleModel = PropertyTag.make this Property? SampleModel this.GetSampleModel this.SetSampleModel
type SampleDisaptcher () =
inherit GelmDispatcher<Model, Message, MessageEffect> ()
static member PropertyDefinitions = [Define? SampleModel { Count = 0; Screen = !> "Screen" }]
override this.GetModel (game, world) = game.GetSampleModel world
override this.SetModel (model, game, world) = game.SetSampleModel model world
override this.BindModel (game, world) =
[game.GetChangeEvent Property? EyeCenter ==> Message1
game.GetChangeEvent Property? EyeSize ==> Message2
game.GetChangeEvent Property? Script =!> Exit]
override this.UpdateModel (message, model, game, world) =
match message with
| Message1 -> { model with Count = inc model.Count }
| Message2 -> { model with Count = dec model.Count }
override this.EffectModel (message, model, game, world) =
match message with
| Exit -> World.exit world
override this.ViewModel (phase, model, game, world) =
match phase with
| Initialize -> World.createScreen (Some model.Screen.ScreenName) world |> snd
| Actualize -> world
| Finalize -> world
override this.Update (game, world) =
game.EyeCenter.Update ((+) Vector2.One) world
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment