Turing drawing Cloud Tsunami script based on https://github.com/maximecb/Turing-Drawings

TuringDrawing.fsx

[<AutoOpen>]
module Utils =
    /// Generate a random integer within [a, b]
    let randomInt =
        let rand = System.Random()
        fun (a,b) -> a + rand.Next(b-a+1)

type Action = Left = 0 | Right = 1 | Up = 2 | Down = 3

type Program(numStates, numSymbols, mapWidth, mapHeight) =
    do if numStates < 1 then invalidArg "numStates" "must have at least 1 state"
    do if numSymbols < 2 then invalidArg "numSymbols" "must have at least 2 symbols"

    let NUM_ACTIONS = Action.GetValues(typeof<Action>).Length

    /// Transition table
    let table = Array.zeroCreate (numStates * numSymbols * 3)
    /// Map (2D tape)
    let map = Array.zeroCreate (mapWidth * mapHeight) 

    let setTrans (st0, sy0, st1, sy1, ac1) =
        let idx = (numStates * sy0 + st0) * 3
        table.[idx+0] <- st1
        table.[idx+1] <- sy1
        table.[idx+2] <- ac1

    // Generate random transitions
    do for st = 0 to numStates-1 do
        for sy = 0 to numSymbols-1 do
            setTrans(
                st,
                sy,
                randomInt(0, numStates - 1),
                randomInt(1, numSymbols - 1),
                randomInt(0, NUM_ACTIONS - 1))

    let mutable state = 0
    let mutable xPos = 0
    let mutable yPos = 0
    let mutable itrCount = 0

    let reset () =
        // Start state
        state <- 0
        // Top-left corner
        xPos <- 0;
        yPos <- 0;
        // Iteration count
        itrCount <- 0;
        // Initialize the image
        Array.fill map 0 map.Length 0

    // Initialize the state
    do reset()

    let iteration () = 
        let sy = map.[mapWidth * yPos + xPos]
        let st = state

        let idx = (numStates * sy + st) * 3
        let st = table.[idx + 0]
        let sy = table.[idx + 1]
        let ac = table.[idx + 2]

        // Update the current state
        state <- st

        // Write the new symbol
        map.[mapWidth * yPos + xPos] <- sy

        // Perform the transition action
        match enum<Action>(ac) with
        | Action.Left ->
            xPos <- xPos + 1
            if xPos >= mapWidth
            then xPos <- xPos - mapWidth
        | Action.Right ->
            xPos <- xPos - 1
            if (xPos < 0)
            then xPos <- xPos + mapWidth     
        | Action.Up ->
            yPos <- yPos - 1
            if (yPos < 0)
            then yPos <- yPos + mapHeight    
        | Action.Down ->
            yPos <- yPos + 1
            if yPos >= mapHeight
            then yPos <- yPos - mapHeight   
        | _ ->
            failwith (sprintf "invalid action: %d" ac)

    let update (numItrs) =
        for i = 0 to numItrs-1 do iteration ()
        itrCount <- itrCount + numItrs

    member program.Reset() = reset ()
    member program.Update(n) = update n
    member program.Map = map

#r "System.Windows.dll"
#r "Tsunami.IDESilverlight.dll"
#r "Telerik.Windows.Controls.dll"
#r "Telerik.Windows.Controls.Docking.dll"
#r "Telerik.Windows.Controls.Navigation.dll"

open System
open System.Windows
open System.Windows.Controls
open System.Windows.Media
open System.Windows.Media.Imaging
open Telerik.Windows.Controls
open Telerik.Windows.Controls.Docking

let dispatch f = Deployment.Current.Dispatcher.BeginInvoke(fun () -> f())
    
let pane content =
    // Find panes group
    let window = Application.Current.RootVisual :?> Tsunami.IDESilverlight.MainWindow
    let grid = window.Content :?> Grid
    let docking = grid.Children |> Seq.pick (function :? RadDocking as x -> Some x | _ -> None) 
    let container = docking.Items |> Seq.pick (function :? RadSplitContainer as x -> Some x | _ -> None)
    let group = container.Items |> Seq.pick (function :? RadPaneGroup as x -> Some x | _ -> None)
    // Add pane
    let pane = RadPane(Header="Drawing")
    pane.MakeFloatingDockable()
    group.Items.Add(pane)
    // Set content
    pane.Content <- content
   
module Color =
    open System.Windows.Media
    let fromRgb(r,g,b) =
        Color.FromArgb(255uy, byte r, byte g, byte b)
    let toInt (color:Color) = 
        (int color.A <<< 24) ||| 
        (int color.R <<< 16) ||| 
        (int color.G <<< 8)  ||| 
        int color.B

[<AutoOpen>]
module Symbol =
    ///Map of symbols (numbers) to colors
    let colorMap = 
        [|
        255,0  ,0      // Initial symbol color
        0  ,0  ,0      // Black
        255,255,255    // White
        0  ,255,0      // Green
        0, 0, 255      // Blue
        255,255,0  
        0  ,255,255
        255,0  ,255
        |]
        |> Array.map (Color.fromRgb >> Color.toInt)

let width, height = 512, 512

type ViewControl (program:Program) as control =
    inherit UserControl()

    let bitmap = WriteableBitmap(width,height)
    let image = Image(Source=bitmap,Stretch=Stretch.Fill,Width=float width,Height=float height) 
    do  control.Content <- image

    do  async {            
        while true do
            let pixels = bitmap.Pixels
            program.Map |> Array.iteri (fun i sy -> pixels.[i] <- colorMap.[sy])
            bitmap.Invalidate()
            do! Async.Sleep(10)
            program.Update(5000)
        } |> Async.StartImmediate 

let drawing = 
    Program(numStates=4, numSymbols=3, mapWidth=width, mapHeight=height)

dispatch <| fun () -> pane (ViewControl(drawing))