Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- #light
- open System
- open Cairo
- open Gtk
- open Gdk
- Gtk.Application.Init()
- let window = new Gtk.Window("Fucull")
- let drawingArea = new Gtk.DrawingArea()
- drawingArea.AddEvents((int)Gdk.EventMask.ButtonPressMask)
- drawingArea.AddEvents((int)EventMask.ButtonReleaseMask)
- drawingArea.AddEvents((int)EventMask.KeyPressMask)
- drawingArea.AddEvents((int)EventMask.PointerMotionMask)
- let points = new ResizeArray<Cairo.Point>()
- let click (x, y) =
- let p = new Cairo.Point(x, y)
- points.Add(p)
- ()
- let sketchCircle (c:Cairo.Context, xc, yc, r) =
- c.Save()
- c.Translate (xc, yc)
- c.MoveTo (r, 0.)
- c.Arc (0., 0., r, 0., (2.*Math.PI))
- c.ClosePath()
- c.Restore()
- let drawBackground (c:Cairo.Context, w, h) =
- c.Save()
- c.Color <- new Cairo.Color(32./255., 74./255., 135./255.) //blue
- c.LineWidth <- 1.
- c.Rectangle(0.5, 0.5, (float)w - 1., (float)h - 1.)
- c.FillPreserve()
- c.Color <- new Cairo.Color(0., 0., 0.) //black
- c.Stroke()
- c.Restore()
- let drawPoint (c:Context, point:Cairo.Point) =
- c.Save()
- let x = (float)point.X
- let y = (float)point.Y
- let radius = 3.5
- let lineLength = 11.
- let lineThickness = 1.
- sketchCircle(c, (Math.Floor(x):float) + 0.5, (Math.Floor(y):float) + 0.5, radius)
- c.Color <- new Cairo.Color(1., 1., 1.) //white
- c.LineWidth <- lineThickness
- c.MoveTo(Math.Floor(x) + 0.5, Math.Floor(y) - 5.)
- c.LineTo(Math.Floor(x) + 0.5, Math.Floor(y) + 6.)
- c.MoveTo(Math.Floor(x) - 5., Math.Floor(y) + 0.5)
- c.LineTo(Math.Floor(x) + 6., Math.Floor(y) + 0.5)
- c.Stroke()
- c.Restore()
- let drawPoints (c:Context) =
- ResizeArray.iter (fun p -> drawPoint(c, p)) points
- let draw (c:Context, w, h) =
- drawBackground (c, w, h)
- drawPoints (c)
- let doTheVooDoo(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(640, 480)
- window.Destroyed.Add (fun _ -> Application.Quit() )
- drawingArea.ExposeEvent.Add (fun _ -> doTheVooDoo(drawingArea))
- drawingArea.ButtonReleaseEvent.Add (fun e ->
- click((int)e.Event.X, (int)e.Event.Y)
- drawingArea.QueueDraw()
- )
- window.Add(drawingArea)
- window.ShowAll()
- Gtk.Application.Run()
Add Comment
Please, Sign In to add comment