(* Types *) type Vector = { X:single; Y:single } with static member ( + ) ({X=x;Y=y}, {X=x';Y=y'}) = {X=x+x';Y=y+y'} static member ( - ) ({X=x;Y=y}, {X=x';Y=y'}) = {X=x-x';Y=y-y'} static member ( * ) ({X=x;Y=y}, s) = {X=s*x;Y=s*y} static member ( * ) (s, {X=x;Y=y}) = {X=s*x;Y=s*y} type Frame = { Origin:Vector; First:Vector; Second:Vector } type Pict = Frame -> unit let coordMap f = fun v -> f.Origin + (v.X * f.First + v.Y * f.Second) (* Picture transformations and combinators *) let transform o c1 c2 (p:Pict) : Pict = let p' f = let map = coordMap f let o' = map o p { Origin=o'; First=(map c1) - o'; Second=(map c2) - o' } p' let flipVert p = transform {X=0.f;Y=1.f} {X=1.f;Y=1.f} {X=0.f;Y=0.f} p let flipHoriz p = transform {X=1.f;Y=0.f} {X=0.f;Y=0.f} {X=1.f;Y=1.f} p let shrink p percent = let d = (single percent)/200.f transform {X=d;Y=d} {X=1.f-d;Y=d} {X=d;Y=1.f-d} p let beside p1 p2 : Pict = let left = transform {X=0.f;Y=0.f} {X=0.5f;Y=0.f} {X=0.f;Y=1.f} p1 let right = transform {X=0.5f;Y=0.f} {X=1.f;Y=0.f} {X=0.5f;Y=1.f} p2 fun f -> left f; right f let above p1 p2 : Pict = let low = transform {X=0.f;Y=0.f} {X=1.f;Y=0.f} {X=0.f;Y=0.5f} p1 let high = transform {X=0.f;Y=0.5f} {X=1.f;Y=0.5f} {X=0.f;Y=1.f} p2 fun f -> low f; high f let rec rightSplit p n = if n = 0 then p else let smaller = rightSplit p (n-1) beside p (above smaller smaller) let rec upSplit p n = if n = 0 then p else let smaller = upSplit p (n-1) above p (beside smaller smaller) let rec cornerSplit p n = if n = 0 then p else let up = upSplit p (n-1) let right = rightSplit p (n-1) let topLeft = beside up up let bottomRight = above right right let corner = cornerSplit p (n-1) beside (above p topLeft) (above bottomRight corner) let four p = let top = (beside (flipHoriz p) p) in above (flipVert top) top let escher p n = four (cornerSplit p n) (* Output *) open System.Windows.Forms open System.Drawing let mutable form:Form = null let drawLine (v1,v2) = form.CreateGraphics().DrawLine(Pens.Red, v1.X, v1.Y, v2.X, v2.Y) let paint p = form.Refresh() (flipVert p) { Origin={X=0.f;Y=0.f}; First={X=500.f;Y=0.f}; Second={X=0.f;Y=500.f} } let setup() = form <- new Form(Size=Size(517,539)) form.Show() (* Primitive figures *) let makePict segs : Pict = fun f -> let map = coordMap f let transform (x1,y1,x2,y2) = map {X=x1;Y=y1}, map {X=x2;Y=y2} List.iter (drawLine << transform) segs let xFig = [ (0.f, 0.f, 1.f, 1.f) (1.f, 0.f, 0.f, 1.f)] let yFig = [ (0.5f, 0.f, 0.5f, 0.5f) (0.5f, 0.5f, 1.f, 1.f) (0.5f, 0.5f, 0.f, 1.f)] let zFig = [ (0.f, 1.f, 1.f, 1.f) (1.f, 1.f, 0.f, 0.f) (0.f, 0.f, 1.f, 0.f)] (* Some test pictures *) let xPict = makePict xFig let yPict = makePict yFig let zPict = makePict zFig (* Usage: > setup();; > paint (four (shrink zPict 10));; > let tile = (above (flipVert yPict) yPict);; > paint (escher tile 4);; etc. *)