Turtle in Gtk#

module AST =
   type distance = int
   type degrees = int
   type count = int
   type command =
      | Forward of distance
      | Left of degrees
      | Right of degrees
      | Repeat of count * command list

// Reference Gtk#
#r "atk-sharp.dll"
#r "glib-sharp.dll"
#r "gdk-sharp.dll"
#r "gtk-sharp.dll"

module Interpreter =
   open AST
   open Gtk
   open System

   type Turtle = { X:float; Y:float; A:int }

   let width, height = 500, 500

   let draw commands drawLine =
      let turtle = { X=float width/2.0; Y=float height/2.0; A = -90 }
      let rec perform turtle = function
         | Forward n ->
            let r = float turtle.A * Math.PI / 180.0
            let dx, dy = float n * cos r, float n * sin r
            let x, y =  turtle.X, turtle.Y
            let x',y' = x + dx, y + dy
            drawLine (x,y) (x',y')
            { turtle with X = x'; Y = y' }
         | Left n -> { turtle with A=turtle.A + n }
         | Right n -> { turtle with A=turtle.A - n }
         | Repeat(n,commands) ->
            let rec repeat turtle = function
               | 0 -> turtle
               | n -> repeat (performAll turtle commands) (n-1)
            repeat turtle n
      and performAll = List.fold perform
      performAll turtle commands |> ignore

   let show commands =
      let window = new Window("Turtle")
      window.SetDefaultSize(width, height)
      window.DeleteEvent.Add(fun e -> window.Hide(); Application.Quit(); e.RetVal <- true)
      let drawing = new DrawingArea()
      drawing.ExposeEvent.Add( fun x ->
         let gc = drawing.Style.BaseGC(StateType.Normal)
         let allocColor (r,g,b) =
            let col = ref (Gdk.Color(r,g,b))
            let _ = gc.Colormap.AllocColor(col, true, true)
            !col
         gc.Foreground <- allocColor (255uy,0uy,0uy)
         let drawLine (x1,y1) (x2,y2) =
            drawing.GdkWindow.DrawLine(gc, int x1, int y1, int x2, int y2)
         draw commands drawLine
         )
      window.Add(drawing)
      window.ShowAll()
      window.Show()

   let invoke action =
       Application.Init()
       Application.Invoke(fun _ _ -> action())
       Application.Run()

   let execute commands = invoke (fun () -> show commands)

// Refrence FParsec
#r "./lib/FParsecCS.dll"
#r "./lib/FParsec.dll"

module Parser =
   open AST
   open FParsec

   let pforward =
      (pstring "forward" <|> pstring "fd") >>. spaces1 >>. pfloat
      |>> fun x -> Forward(int x)
   let pleft =
      (pstring "left" <|> pstring "lt") >>. spaces1 >>. pfloat
      |>> fun x -> Left(int x)
   let pright =
      (pstring "right" <|> pstring "rt") >>. spaces1 >>. pfloat
      |>> fun x -> Right(int x)

   let prepeat, prepeatimpl = createParserForwardedToRef ()

   let pcommand = pforward <|> pleft <|> pright <|> prepeat

   let block = between (pstring "[") (pstring "]") (many1 (pcommand .>> spaces))

   prepeatimpl :=
      pstring "repeat" >>. spaces1 >>. pfloat .>> spaces .>>. block
      |>> fun (n,commands) -> Repeat(int n, commands)

   let parse code =
      match run (many pcommand) code with
      | Success(result,_,_) -> result
      | Failure(msg,_,_) -> failwith msg

let code = "repeat 10 [right 36 repeat 5 [forward 54 right 72]]"
let program = Parser.parse code
Interpreter.execute program