1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
open System
open System.Drawing
open System.Windows.Forms

type Agent<'a> = MailboxProcessor<'a>

module Utils =
  let doEvents () = Application.DoEvents()

module Model =
  type ('a) Model = { state: 'a; events: 'a list }
  // Add functions here to load/persist state and events

module View =
  // Main form
  let title = @"Time Traveling Debugger"
  let width,height = 1024,768
  let form = 
    new Form(
      Visible=true, TopMost=true, ClientSize=Size(width,height),
      MaximizeBox=false, FormBorderStyle=FormBorderStyle.FixedDialog,Text=title)
  let canvas = new Rectangle(0, 0, width, height)
  form.Paint.Add(fun e -> e.Graphics.FillRectangle(Brushes.Black, canvas))

  // Time Traveling Debugger
  let debug = new TrackBar()
  debug.Location <- Point(0,height - 100)
  debug.TickStyle <- TickStyle.Both
  debug.AutoSize <- false
  debug.Width <- width
  debug.Height <- 100
  debug.Minimum <- 0
  debug.Maximum <- 0
  debug.Value <- 0
  form.Controls.Add(debug)

  // Time Traveling Debugger info text
  let debugText = new Label()
  debugText.Location <- Point(0, 50)
  debugText.Width <- width
  debugText.TextAlign <- ContentAlignment.MiddleCenter
  debug.Controls.Add(debugText)

  // Update functions "hardcoded" to above formular and formular controls
  let updateTitle point = form.Text <- sprintf "%s: %A" title point
  let updateCanvas p1 p2 =
    let prev = new Rectangle(fst p1, snd p1, 30, 30)
    form.Paint.Add(fun e -> e.Graphics.FillRectangle(Brushes.Black, prev))
    let next = new Rectangle(fst p2, snd p2, 30, 30)
    form.Paint.Add(fun e -> e.Graphics.FillRectangle(Brushes.LimeGreen, next))
    form.Invalidate(next)
    form.Invalidate(prev)
  let updateDebug n = 
    debug.Maximum <- n
    debug.Value <- n
  let updateDebugText n s p = 
    debugText.Text <- sprintf "Nr. events: %i\nDebug step: %i %A" (n+1) (s+1) p

module Controller =
  open Model
  open View

  type Action = | Event of Event | Debug of Debug
  and Event = int * int
  and Debug = int

  // By using Agents, the model stays inmutable
  let agent = Agent.Start(fun inbox ->
    let rec loop model = async {
      let! msg = inbox.Receive()
      match msg with
      | Event(point) ->
        let model' = { model with state = point; events = point::model.events }
        let n = (model'.events |> List.length) - 1
        updateTitle model'.state
        updateCanvas model.state model'.state
        updateDebug n
        updateDebugText n n point
        return! loop model'
      | Debug(index) ->
        let n = (model.events |> List.length) - 1
        let point = model.events |> List.skip (n-index) |> List.head
        let model' = { model with state = point }
        updateTitle model'.state
        updateCanvas model.state model'.state
        updateDebugText n index point
        return! loop model' }
    loop { Model.state = (0,0); events = [] })

  // Hook-up model events
  form.MouseClick
  |> Event.add (fun e -> agent.Post (Action.Event(e.X,e.Y)))

  // Hook-up Time Traveling Debugger events
  debug.Scroll
  |> Event.add(fun _ -> agent.Post (Action.Debug(debug.Value)))

// Program event loop, not to use with F# Interactive (FsiAnyCpu)
open Utils
open View

let rec main = function | true -> doEvents(); main form.Created | false -> ()

main form.Created