FsCairo.fs

#light

open System
open Cairo
open Gtk

Gtk.Application.Init()

let window = new Gtk.Window("F# Cairo")
let vBox = new Gtk.VBox()
let drawingArea = new Gtk.DrawingArea()
let buttonHBox = new Gtk.HBox()
let closeButton = new Gtk.Button()

let SketchCircle (cc:Cairo.Context, xc, yc, xr, yr) =
    cc.Save()
    let m = cc.Matrix
    cc.Translate(xc, yc)
    cc.Scale(1., yr/xr)
    cc.MoveTo(xr, 0.)
    cc.Arc(0., 0., xr, 0., 2.*Math.PI)
    cc.ClosePath()
    cc.Matrix <- m
    cc.Restore()

let FillChecks (cc:Cairo.Context, x, y, w, h) =
    let checkSize = 32
    cc.Save()
    use check = cc.Target.CreateSimilar(Cairo.Content.Color, 2*checkSize, 2*checkSize)
    use cr2 = new Cairo.Context(check)
    cr2.Operator <- Cairo.Operator.Source
    cr2.Color <- new Cairo.Color(0.4, 0.4, 0.4)
    cr2.Rectangle(0., 0., 2.*(float)checkSize, 2.*(float)checkSize)
    cr2.Fill()

    cr2.Color <- new Cairo.Color(0.7, 0.7, 0.7)
    cr2.Rectangle(x, y, (float)checkSize, (float)checkSize)
    cr2.Fill()

    cr2.Rectangle(x + (float)checkSize, y + (float)checkSize, (float)checkSize, (float)checkSize)
    cr2.Fill()

    use checkPattern = new Cairo.SurfacePattern(check)
    checkPattern.Extend <- Cairo.Extend.Repeat
    cc.Source <- checkPattern
    cc.Rectangle(0., 0., w, h)
    cc.Fill()

    cc.Restore()

let Draw3Circles (cc:Cairo.Context, xc, yc, radius, alfa) =
    cc.Save()
    let subradius = radius * (2./3. - 0.1)

    cc.Color <- new Cairo.Color(1., 0., 0., alfa)
    SketchCircle(cc, xc + radius / 3. * Math.Cos(Math.PI * 0.5), yc - radius / 3. * Math.Sin (Math.PI * 0.5), subradius, subradius)
    cc.Fill()

    cc.Color <- new Cairo.Color(0., 1., 0., alfa)
    SketchCircle(cc, xc + radius / 3. * Math.Cos(Math.PI * (0.5 + 2. / 0.3)), yc - radius / 3. * Math.Sin (Math.PI * (0.5 + 2. / 0.3)), subradius, subradius)
    cc.Fill()

    cc.Color <- new Cairo.Color(0., 0., 1., alfa)
    SketchCircle(cc, xc + radius / 3. * Math.Cos(Math.PI * (0.5 + 4. / 0.3)), yc - radius / 3. * Math.Sin (Math.PI * (0.5 + 4. / 0.3)), subradius, subradius)
    cc.Fill()
    cc.Restore()

let Draw (cc:Cairo.Context, w, h) =
    let radius = 0.5 * Math.Min(w, h) - 10.
    let xc = w / 2.
    let yc = h / 2.

    use overlay = cc.Target.CreateSimilar (Cairo.Content.ColorAlpha, (int)w , (int)h)
    use punch = cc.Target.CreateSimilar (Cairo.Content.Alpha, (int)w , (int)h)
    use circles = cc.Target.CreateSimilar (Cairo.Content.ColorAlpha, (int)w , (int)h)

    FillChecks(cc, 0., 0., w, h)
    cc.Save()

    use cr_overlay = new Cairo.Context(overlay)
    cr_overlay.Color <- new Cairo.Color(0., 0., 0.)
    SketchCircle(cr_overlay, xc, yc, radius, radius)
    cr_overlay.Fill()

    use cr_temp = new Cairo.Context(punch)
    Draw3Circles(cr_temp, xc, yc, radius, 1.)

    cr_overlay.Operator <- Cairo.Operator.DestOut
    cr_overlay.SetSourceSurface (punch, 0, 0)
    cr_overlay.Paint()

    use cr_circles = new Cairo.Context(circles)
    cr_circles.Operator <- Cairo.Operator.Over
    Draw3Circles(cr_circles, xc, yc, radius, 0.5)

    cr_overlay.Operator <- Cairo.Operator.Add
    cr_overlay.SetSourceSurface(circles, 0, 0)
    cr_overlay.Paint()

    cc.SetSourceSurface(overlay, 0, 0)
    cc.Paint()
    cc.Restore()

let Knockout(da:Gtk.DrawingArea) =
    use drawable = da.GdkWindow
    let w,h = da.Allocation.Width, da.Allocation.Height
    use cairoContext = Gdk.CairoHelper.Create (drawable)
    Draw(cairoContext, (float)w, (float)h)

window.WindowPosition <- Gtk.WindowPosition.Center
window.SetDefaultSize(400, 400)
window.Destroyed.Add(fun _ -> Application.Quit() )

drawingArea.ExposeEvent.Add(fun _ -> Knockout(drawingArea))
drawingArea.ButtonReleaseEvent.Add(fun _ -> () )

closeButton.Label <- "   Close   "
closeButton.Clicked.Add(fun _ -> Application.Quit() )

vBox.BorderWidth <- (uint32) 12
vBox.Spacing <- 12
vBox.PackStart(drawingArea, true, true, (uint32) 0)
buttonHBox.PackEnd(closeButton, false, false, (uint32) 0)
vBox.PackStart(buttonHBox, false, false, (uint32) 0)

window.Add(vBox)
window.ShowAll()

Gtk.Application.Run()