# swlaschin/13-ways-of-looking-at-a-turtle

Switch branches/tags
Nothing to show
Fetching contributors…
Cannot retrieve contributors at this time
141 lines (110 sloc) 4.09 KB
 (* Common.fsx Part of "Thirteen ways of looking at a turtle" Related blog post: http://fsharpforfunandprofit.com/posts/13-ways-of-looking-at-a-turtle/ *) open System // ====================================== // Common types and helper functions // ====================================== /// An alias for a float type Distance = float /// Use a unit of measure to make it clear that the angle is in degrees, not radians type [] Degrees /// An alias for a float of Degrees type Angle = float /// Enumeration of available pen states type PenState = Up | Down /// Enumeration of available pen colors type PenColor = Black | Red | Blue /// A structure to store the (x,y) coordinates type Position = {x:float; y:float} // ====================================== // Common helper functions // ====================================== // round a float to two places to make it easier to read let round2 (flt:float) = Math.Round(flt,2) /// calculate a new position from the current position given an angle and a distance let calcNewPosition (distance:Distance) (angle:Angle) currentPos = // Convert degrees to radians with 180.0 degrees = 1 pi radian let angleInRads = angle * (Math.PI/180.0) * 1.0<1/Degrees> // current pos let x0 = currentPos.x let y0 = currentPos.y // new pos let x1 = x0 + (distance * cos angleInRads) let y1 = y0 + (distance * sin angleInRads) // return a new Position {x=round2 x1; y=round2 y1} /// Default initial state let initialPosition,initialColor,initialPenState = {x=0.0; y=0.0}, Black, Down /// Emulating a real implementation for drawing a line let dummyDrawLine log oldPos newPos color = // for now just log it log (sprintf "...Draw line from (%0.1f,%0.1f) to (%0.1f,%0.1f) using %A" oldPos.x oldPos.y newPos.x newPos.y color) /// trim a string let trimString (str:string) = str.Trim() // ====================================== // Result type and companion module // ====================================== type Result<'a,'error> = | Success of 'a | Failure of 'error module Result = let returnR x = Success x let bindR f xR = match xR with | Success x -> f x | Failure err -> Failure err // infix version of bind let ( >>= ) xR f = bindR f xR let mapR f = bindR (f >> returnR) // infix version of map let ( ) = mapR let applyR fR xR = fR >>= (fun f -> xR >>= (fun x -> returnR (f x) )) // infix version of apply let ( <*> ) = applyR // lift a one-parameter function to result world (same as mapR) let lift1R f x = f x // lift a two-parameter function to result world let lift2R f x y = f x <*> y /// Computation Expression type ResultBuilder() = member this.Bind(m:Result<'a,'error>,f:'a -> Result<'b,'error>) = bindR f m member this.Return(x) :Result<'a,'error> = returnR x member this.ReturnFrom(m) :Result<'a,'error> = m member this.Zero() :Result = this.Return () member this.Combine(m1, f) = this.Bind(m1, f) member this.Delay(f) = f member this.Run(m) = m() member this.TryWith(m:Result<'a,'error>, h: exn -> Result<'a,'error>) = try this.ReturnFrom(m) with e -> h e member this.TryFinally(m:Result<'a,'error>, compensation) = try this.ReturnFrom(m) finally compensation() member this.Using(res:#IDisposable, body) : Result<'b,'error> = this.TryFinally(body res, (fun () -> match res with null -> () | disp -> disp.Dispose())) member this.While(cond, m) = if not (cond()) then this.Zero() else this.Bind(m(), fun _ -> this.While(cond, m)) member this.For(sequence:seq<_>, body) = this.Using(sequence.GetEnumerator(), (fun enum -> this.While(enum.MoveNext, fun _ -> body enum.Current))) let result = ResultBuilder()