LSystem written in Fesh

simple_lsystem.fs

#r "C:/Program Files/Rhino 8/System/RhinoCommon.dll"
#r "nuget:Rhino.Scripting.Fsharp, 0.8.1"  

open System
open Rhino.Scripting
open Rhino.Scripting.Fsharp //recommended for F# 
open FsEx // part of Rhino.Scripting

type rs = RhinoScriptSyntax
type Rnd = Rnd of System.Random


type Instruction = 
    | Forward of float
    | Right of float
    | Left of float
    | Nop
    | Push
    | Pop
    
type LSystem = { State  : string;   Rules : Map<char,  string>;  Rng : Rnd }
type Point = { x : float; y: float;  z: float }

type ComputeState = { point: Point;  angle : float;  stack : ComputeState list;  points : Rhino.Geometry.Point3d list list}

let generation (n: int) (sys : LSystem) = 
    let rec gen (currentState : LSystem) (n : int) = 
        if n = 0 then currentState
        else 
            let s = 
                String(currentState.State |> Seq.collect (fun c ->  
                        match Map.tryFind c sys.Rules with
                        | Some newValue -> Seq.toList newValue
                        | None -> [c]
                    ) |> Seq.toArray) 
            
            let nextState = { 
                State = s
                Rules = sys.Rules
                Rng = sys.Rng
            }
            gen nextState (n-1)
    gen sys n
    
let toInstructions (T : Map<char,  Instruction>) (sys: LSystem) : Instruction seq = 
    //print sys.State
    sys.State |> Seq.map (fun c -> T[c])
    
let toCurves (instructions : Instruction seq) = 
    let initialComputeState = { point = { x = 0.; y = 0.; z = 0. } ;  angle = 0.;  stack = [];  points = [[new Rhino.Geometry.Point3d(0, 0, 0) ]] }
    
    let instructionFolder (state: ComputeState)   (instr : Instruction)  = 
        match instr with
        | Forward distance -> 
            let angleRad = state.angle * Math.PI / 180.
            let newX = state.point.x + distance * Math.Cos ( angleRad )
            let newY = state.point.y + distance * Math.Sin ( angleRad )
            let newZ = state.point.z
            let newpt = { x = newX; y = newY; z = newZ }
            let pt3d = new Rhino.Geometry.Point3d(newX,  newY,  newZ)
            let pts = match state.points with
                        | [] -> failwith "points list of list empty"
                        | head :: tail -> (pt3d :: head) :: tail
            { state with
                point = newpt
                points = pts
            }
        | Right angle ->   
            let newAngle = state.angle + angle
            { state with angle = newAngle }
        | Left angle ->  
            let newAngle = state.angle - angle
            { state with angle = newAngle }
        | Nop -> state
        | Push ->  
            { state with 
                stack = state :: state.stack
            }
        | Pop ->  
            match state.stack with
                | [] -> state
                | s :: stack -> { s with
                                    stack = stack
                                    points = [new Rhino.Geometry.Point3d(s.point.x,  s.point.y,  s.point.z) ] :: state.points
                                }
    
    let macroState = List.fold instructionFolder initialComputeState (instructions |> Seq.toList)
    
    macroState.points |> Seq.map (fun pts -> 
                                rs.AddPolyline(pts)
                            ) |> Seq.toList
    
let rng = new System.Random()

(* https://twitter.com/LSystemBot/status/553954473694220288/photo/1 *)
let tweet () =
    let lSystem =
        {
            State = "FFPF"
            Rules = [
                        'F', "PF++F[FF-F+PF+FPP][F]FFPF"
                        'P', "P"
                    ]
                    |> Map.ofList
            Rng = Rnd(new System.Random(3))
        }
    let l = Math.Max(1.,  rng.NextDouble() * 20.)
    let T =
            [
                'F', Forward l
                '+', Right 60.
                '-', Left 60.
                'P', Nop
                '[', Push
                ']', Pop
            ]
            |> Map.ofList
    
    rs.DisableRedraw()
    
    let res = 
        lSystem 
        |> generation 5
        |> toInstructions T
        |> toCurves 
        
    rs.JoinCurves(res,  true) |> ignore
    rs.EnableRedraw()

tweet()