9 people like it.

Turtle

Turtle graphics library implemented as an internal DSL, providing a very similar syntax to Logo, it is runnable inside TryFSharp.org.

  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: 
105: 
106: 
107: 
108: 
109: 
110: 
111: 
112: 
113: 
114: 
115: 
116: 
117: 
118: 
119: 
120: 
121: 
122: 
123: 
124: 
125: 
126: 
127: 
128: 
129: 
130: 
131: 
132: 
133: 
134: 
135: 
136: 
137: 
138: 
139: 
140: 
141: 
142: 
143: 
144: 
145: 
146: 
147: 
148: 
149: 
150: 
151: 
152: 
153: 
154: 
155: 
156: 
Skip namespace definition on TryFSharp.org

open System
open System.Windows
open System.Windows.Controls
open System.Windows.Media
open System.Windows.Shapes
    
[<AutoOpen>]
module AST =    
    type reference = string
    type distance = int
    type degrees = int
    type instruction =
        | Forward of distance
        | Left of degrees
        | Right of degrees
        | Repeat of int * instruction list    
        | PenDown 
        | PenUp
        | PenColor of Color
        | PenWidth of distance
        | ClearScreen
        | ShowTurtle
        | HideTurtle
    
[<AutoOpen>]
module Lang =
    let forward n = Forward n
    let fd = forward
    let left n = Left n
    let lt = left
    let right n = Right n
    let rt = right
    let repeat n (instructions:instruction list) =
        Repeat(n,instructions)
    let once (instructions:instruction list) =
        Repeat(1,instructions)
    let run = once
    let output x = x
    let pencolor color = PenColor color
    let penup = PenUp
    let pendown = PenDown
    let penwidth n = PenWidth n
    let clearscreen = ClearScreen
    let cs = clearscreen
    let hideturtle = HideTurtle
    let ht = hideturtle
    let showturtle = ShowTurtle
    let st = showturtle
   
[<AutoOpen>]
module Colors =
    let red = Colors.Red
    let green = Colors.Green
    let blue = Colors.Blue
    let white = Colors.White
    let black = Colors.Black
    let gray = Colors.Gray
    let yellow = Colors.Yellow
    let orange = Colors.Orange
    let brown = Colors.Brown
    let cyan = Colors.Cyan
    let magenta = Colors.Magenta
    let purple = Colors.Purple

type Turtle private () =
    inherit UserControl(Width = 400.0, Height = 300.0)    
    let screen = Canvas(Background = SolidColorBrush Colors.Black)
    do  base.Content <- screen
    let mutable penColor = white
    let mutable penWidth = 1.0
    let mutable isPenDown = true
    let mutable x, y = 0.0, 0.0
    let mutable a = 270
    let addLine (canvas:Canvas) x' y' =
        let line = Line(X1=x,Y1=y,X2=x',Y2=y')
        line.StrokeThickness <- penWidth
        line.Stroke <- SolidColorBrush penColor 
        canvas.Children.Add line
    let clearLines () = screen.Children.Clear()
    let turtle = Canvas()
    let rotation = RotateTransform(Angle=float a)
    do  turtle.RenderTransform <- rotation    
    do  screen.Children.Add turtle
    let rec execute canvas = function
        | Forward n ->
            let n = float n
            let r = float a * Math.PI / 180.0
            let dx, dy = float n * cos(r), float n * sin(r)
            let x', y' = x + dx, y + dy
            if isPenDown then addLine canvas x' y'
            x <- x'
            y <- y'
        | Left n -> 
            a <- a - n
            rotation.Angle <- float a
        | Right n -> 
            a <- a + n
            rotation.Angle <- float a
        | Repeat(n,instructions) ->
            for i = 1 to n do
                instructions |> List.iter (execute canvas)
        | PenDown -> isPenDown <- true
        | PenUp -> isPenDown <- false
        | PenColor color -> penColor <- color
        | PenWidth width -> penWidth <- float width
        | ClearScreen -> clearLines ()
        | ShowTurtle ->
            turtle.Visibility <- Visibility.Visible
        | HideTurtle ->
            turtle.Visibility <- Visibility.Collapsed
    let drawTurtle () =
        [penup; forward 5; pendown; 
         right 150;  forward 10; 
         right 120; forward 10; 
         right 120; forward 10; 
         right 150; penup; forward 5; right 180; pendown]
        |> List.iter (execute turtle)    
    do  drawTurtle ()
        x <- base.Width/2.0
        y <- base.Height/2.0
    do  Canvas.SetLeft(turtle,x)
        Canvas.SetTop(turtle,y)
    static let control = lazy(Turtle ())    
    member private this.Execute instruction = 
        execute screen instruction
    /// Turtle screen
    static member Screen = control.Force()    
    /// Runs turtle instruction
    static member Run (instruction:instruction) =
        let run () = control.Force().Execute instruction
#if INTERACTIVE
        App.Dispatch(fun () -> run ()) |> ignore
#else
        run ()
#endif
    /// Runs sequence of turtle instructions
    static member Run (instructions:instruction seq) =
        let run () = instructions |> Seq.iter (control.Force().Execute)
#if INTERACTIVE
        App.Dispatch(fun () -> run ()) |> ignore
#else
        run ()
#endif
        
    
Run script on TryFSharp.org

module Test =
   
    do  pencolor red
        |> Turtle.Run 
    
    do  [for a = 0 to 1000 do yield! [fd 6; rt (a*7)]]
        |> Turtle.Run
#if INTERACTIVE
open Microsoft.TryFSharp
#else
namespace Turtle
#endif
namespace System
namespace System.Windows
namespace System.Media
Multiple items
type AutoOpenAttribute =
  inherit Attribute
  new : unit -> AutoOpenAttribute
  new : path:string -> AutoOpenAttribute
  member Path : string

Full name: Microsoft.FSharp.Core.AutoOpenAttribute

--------------------
new : unit -> AutoOpenAttribute
new : path:string -> AutoOpenAttribute
type reference = string

Full name: Script.AST.reference
Multiple items
val string : value:'T -> string

Full name: Microsoft.FSharp.Core.Operators.string

--------------------
type string = String

Full name: Microsoft.FSharp.Core.string
type distance = int

Full name: Script.AST.distance
Multiple items
val int : value:'T -> int (requires member op_Explicit)

Full name: Microsoft.FSharp.Core.Operators.int

--------------------
type int = int32

Full name: Microsoft.FSharp.Core.int

--------------------
type int<'Measure> = int

Full name: Microsoft.FSharp.Core.int<_>
type degrees = int

Full name: Script.AST.degrees
type instruction =
  | Forward of distance
  | Left of degrees
  | Right of degrees
  | Repeat of int * instruction list
  | PenDown
  | PenUp
  | PenColor of obj
  | PenWidth of distance
  | ClearScreen
  | ShowTurtle
  ...

Full name: Script.AST.instruction
union case instruction.Forward: distance -> instruction
union case instruction.Left: degrees -> instruction
union case instruction.Right: degrees -> instruction
union case instruction.Repeat: int * instruction list -> instruction
type 'T list = List<'T>

Full name: Microsoft.FSharp.Collections.list<_>
union case instruction.PenDown: instruction
union case instruction.PenUp: instruction
union case instruction.PenColor: obj -> instruction
union case instruction.PenWidth: distance -> instruction
union case instruction.ClearScreen: instruction
union case instruction.ShowTurtle: instruction
union case instruction.HideTurtle: instruction
val forward : n:distance -> instruction

Full name: Script.Lang.forward
val n : distance
val fd : (distance -> instruction)

Full name: Script.Lang.fd
val left : n:degrees -> instruction

Full name: Script.Lang.left
val n : degrees
val lt : (degrees -> instruction)

Full name: Script.Lang.lt
val right : n:degrees -> instruction

Full name: Script.Lang.right
val rt : (degrees -> instruction)

Full name: Script.Lang.rt
val repeat : n:int -> instructions:instruction list -> instruction

Full name: Script.Lang.repeat
val n : int
val instructions : instruction list
val once : instructions:instruction list -> instruction

Full name: Script.Lang.once
val run : (instruction list -> instruction)

Full name: Script.Lang.run
val output : x:'a -> 'a

Full name: Script.Lang.output
val x : 'a
val pencolor : color:'a -> instruction

Full name: Script.Lang.pencolor
val color : 'a
val penup : instruction

Full name: Script.Lang.penup
val pendown : instruction

Full name: Script.Lang.pendown
val penwidth : n:distance -> instruction

Full name: Script.Lang.penwidth
val clearscreen : instruction

Full name: Script.Lang.clearscreen
val cs : instruction

Full name: Script.Lang.cs
val hideturtle : instruction

Full name: Script.Lang.hideturtle
val ht : instruction

Full name: Script.Lang.ht
val showturtle : instruction

Full name: Script.Lang.showturtle
val st : instruction

Full name: Script.Lang.st
val red : obj

Full name: Script.Colors.red
val green : obj

Full name: Script.Colors.green
val blue : obj

Full name: Script.Colors.blue
val white : obj

Full name: Script.Colors.white
val black : obj

Full name: Script.Colors.black
val gray : obj

Full name: Script.Colors.gray
val yellow : obj

Full name: Script.Colors.yellow
val orange : obj

Full name: Script.Colors.orange
val brown : obj

Full name: Script.Colors.brown
val cyan : obj

Full name: Script.Colors.cyan
val magenta : obj

Full name: Script.Colors.magenta
val purple : obj

Full name: Script.Colors.purple
Multiple items
type Turtle =
  inherit obj
  private new : unit -> Turtle
  member private Execute : instruction:'a -> 'b
  static member Run : instruction:instruction -> unit
  static member Run : instructions:seq<instruction> -> unit
  static member Screen : 'a

Full name: Script.Turtle

--------------------
private new : unit -> Turtle
module Colors

from Script
Multiple items
val float : value:'T -> float (requires member op_Explicit)

Full name: Microsoft.FSharp.Core.Operators.float

--------------------
type float = Double

Full name: Microsoft.FSharp.Core.float

--------------------
type float<'Measure> = float

Full name: Microsoft.FSharp.Core.float<_>
type Math =
  static val PI : float
  static val E : float
  static member Abs : value:sbyte -> sbyte + 6 overloads
  static member Acos : d:float -> float
  static member Asin : d:float -> float
  static member Atan : d:float -> float
  static member Atan2 : y:float * x:float -> float
  static member BigMul : a:int * b:int -> int64
  static member Ceiling : d:decimal -> decimal + 1 overload
  static member Cos : d:float -> float
  ...

Full name: System.Math
field Math.PI = 3.14159265359
val cos : value:'T -> 'T (requires member Cos)

Full name: Microsoft.FSharp.Core.Operators.cos
val sin : value:'T -> 'T (requires member Sin)

Full name: Microsoft.FSharp.Core.Operators.sin
Multiple items
module List

from Microsoft.FSharp.Collections

--------------------
type List<'T> =
  | ( [] )
  | ( :: ) of Head: 'T * Tail: 'T list
  interface IEnumerable
  interface IEnumerable<'T>
  member Head : 'T
  member IsEmpty : bool
  member Item : index:int -> 'T with get
  member Length : int
  member Tail : 'T list
  static member Cons : head:'T * tail:'T list -> 'T list
  static member Empty : 'T list

Full name: Microsoft.FSharp.Collections.List<_>
val iter : action:('T -> unit) -> list:'T list -> unit

Full name: Microsoft.FSharp.Collections.List.iter
member private Turtle.Execute : instruction:'a -> 'b

Full name: Script.Turtle.Execute
static member Turtle.Screen : 'a

Full name: Script.Turtle.Screen


 Turtle screen
static member Turtle.Run : instruction:instruction -> unit

Full name: Script.Turtle.Run


 Runs turtle instruction
static member Turtle.Run : instructions:seq<instruction> -> unit

Full name: Script.Turtle.Run


 Runs sequence of turtle instructions
Multiple items
val seq : sequence:seq<'T> -> seq<'T>

Full name: Microsoft.FSharp.Core.Operators.seq

--------------------
type seq<'T> = Collections.Generic.IEnumerable<'T>

Full name: Microsoft.FSharp.Collections.seq<_>
module Seq

from Microsoft.FSharp.Collections
val iter : action:('T -> unit) -> source:seq<'T> -> unit

Full name: Microsoft.FSharp.Collections.Seq.iter
#if INTERACTIVE
App.Dispatch (fun() ->
    App.Console.ClearCanvas()
    let canvas = App.Console.Canvas
    let control = Turtle.Screen
    control |> canvas.Children.Add
    App.Console.CanvasPosition <- CanvasPosition.Right
    control.Focus() |> ignore
)
#else
type App() as app =
  inherit System.Windows.Application()
  do app.Startup.Add(fun _ -> app.RootVisual <- Turtle.Screen)
#endif
type Turtle =
  inherit obj
  private new : unit -> Turtle
  member private Execute : instruction:'a -> 'b
  static member Run : instruction:instruction -> unit
  static member Run : instructions:seq<instruction> -> unit
  static member Screen : 'a

Full name: Script.Turtle
static member Turtle.Run : instruction:instruction -> unit


 Runs turtle instruction

static member Turtle.Run : instructions:seq<instruction> -> unit


 Runs sequence of turtle instructions
val a : int
Raw view New version

More information

Link:http://fssnip.net/6y
Posted:4 years ago
Author:Phillip Trelford
Tags: DSL