Guest User

Untitled

a guest
Feb 21st, 2018
75
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 2.42 KB | None | 0 0
  1. #light
  2.  
  3. open System
  4. open Cairo
  5. open Gtk
  6. open Gdk
  7.  
  8. Gtk.Application.Init()
  9.  
  10. let window = new Gtk.Window("Fucull")
  11. let drawingArea = new Gtk.DrawingArea()
  12. drawingArea.AddEvents((int)Gdk.EventMask.ButtonPressMask)
  13. drawingArea.AddEvents((int)EventMask.ButtonReleaseMask)
  14. drawingArea.AddEvents((int)EventMask.KeyPressMask)
  15. drawingArea.AddEvents((int)EventMask.PointerMotionMask)
  16.  
  17. let points = new ResizeArray<Cairo.Point>()
  18.  
  19. let click (x, y) =
  20. let p = new Cairo.Point(x, y)
  21. points.Add(p)
  22. ()
  23.  
  24. let sketchCircle (c:Cairo.Context, xc, yc, r) =
  25. c.Save()
  26. c.Translate (xc, yc)
  27. c.MoveTo (r, 0.)
  28. c.Arc (0., 0., r, 0., (2.*Math.PI))
  29. c.ClosePath()
  30. c.Restore()
  31.  
  32. let drawBackground (c:Cairo.Context, w, h) =
  33. c.Save()
  34. c.Color <- new Cairo.Color(32./255., 74./255., 135./255.) //blue
  35. c.LineWidth <- 1.
  36. c.Rectangle(0.5, 0.5, (float)w - 1., (float)h - 1.)
  37. c.FillPreserve()
  38. c.Color <- new Cairo.Color(0., 0., 0.) //black
  39. c.Stroke()
  40. c.Restore()
  41.  
  42. let drawPoint (c:Context, point:Cairo.Point) =
  43. c.Save()
  44. let x = (float)point.X
  45. let y = (float)point.Y
  46. let radius = 3.5
  47. let lineLength = 11.
  48. let lineThickness = 1.
  49. sketchCircle(c, (Math.Floor(x):float) + 0.5, (Math.Floor(y):float) + 0.5, radius)
  50. c.Color <- new Cairo.Color(1., 1., 1.) //white
  51. c.LineWidth <- lineThickness
  52. c.MoveTo(Math.Floor(x) + 0.5, Math.Floor(y) - 5.)
  53. c.LineTo(Math.Floor(x) + 0.5, Math.Floor(y) + 6.)
  54. c.MoveTo(Math.Floor(x) - 5., Math.Floor(y) + 0.5)
  55. c.LineTo(Math.Floor(x) + 6., Math.Floor(y) + 0.5)
  56. c.Stroke()
  57. c.Restore()
  58.  
  59. let drawPoints (c:Context) =
  60. ResizeArray.iter (fun p -> drawPoint(c, p)) points
  61.  
  62. let draw (c:Context, w, h) =
  63. drawBackground (c, w, h)
  64. drawPoints (c)
  65.  
  66. let doTheVooDoo(da:Gtk.DrawingArea) =
  67. use drawable = da.GdkWindow
  68. let w, h = da.Allocation.Width, da.Allocation.Height
  69. use cairoContext = Gdk.CairoHelper.Create (drawable)
  70. draw(cairoContext, (float)w, (float)h)
  71.  
  72. window.WindowPosition <- Gtk.WindowPosition.Center
  73. window.SetDefaultSize(640, 480)
  74. window.Destroyed.Add (fun _ -> Application.Quit() )
  75.  
  76. drawingArea.ExposeEvent.Add (fun _ -> doTheVooDoo(drawingArea))
  77. drawingArea.ButtonReleaseEvent.Add (fun e ->
  78. click((int)e.Event.X, (int)e.Event.Y)
  79. drawingArea.QueueDraw()
  80. )
  81.  
  82. window.Add(drawingArea)
  83. window.ShowAll()
  84.  
  85. Gtk.Application.Run()
Add Comment
Please, Sign In to add comment