(* A SimpleWidget knows how to paint itself relative to a Gctxt.t. *) (* It also has a size *) type widget = { repaint : Gctx.gctx -> unit; size : Gctx.gctx -> int * int } (* A simple widget that puts some text on the screen *) let label (s:string) : widget = { repaint = (fun (g:Gctx.gctx) -> Gctx.draw_string g (0,0) s); size = (fun (g:Gctx.gctx) -> Gctx.text_size g s) } (* A "blank" area widget -- it just takes up space *) let space ((x,y):int*int) : widget = { repaint = (fun (_:Gctx.gctx) -> ()); size = (fun (_:Gctx.gctx) -> (x,y)) } (* Adds a one-pixel wide border around an existing widget, with one pixel of space *) (* between the border and the child. *) (* Note that we have to translate the Gctx to place the *) (* child in the appropriate spot. *) let border (w:widget):widget = { repaint = (fun (g:Gctx.gctx) -> let (width,height) = w.size g in let x = width + 3 in (* not + 4 because we start at 0 *) let y = height + 3 in Gctx.draw_line g (0,0) (x,0); Gctx.draw_line g (0,0) (0,y); Gctx.draw_line g (x,0) (x,y); Gctx.draw_line g (0,y) (x,y); let g = Gctx.translate g (2,2) in w.repaint g); size = (fun (g:Gctx.gctx) -> let (width,height) = w.size g in (width+4, height+4)) } (* Create a composite widget from two widgets. They are laid out horizontally *) (* so that their top edges are aligned and they are immediately adjacent. *) (* Note that the Gctx for the left child widget w1 is the same as that of the *) (* hpair parent, but we have to translate the Gctx by the width of w1 to get *) (* the appropriate graphics context for w2. *) let hpair (w1:widget) (w2:widget) : widget = { repaint = (fun (g:Gctx.gctx) -> let (x1,_) = w1.size g in begin w1.repaint g; w2.repaint (Gctx.translate g (x1,0)) (* Note translation of the Gctx *) end); size = (fun (g:Gctx.gctx) -> let (x1,y1) = w1.size g in let (x2,y2) = w2.size g in (x1 + x2, max y1 y2)) } (* A canvas widget is just a region of the screen that can be drawn upon using *) (* the usual Gctx routines. *) (* It is a widget parameterized by the repaint method. *) let canvas ((w,h):int*int) (repaint: Gctx.gctx -> unit) : widget = { repaint = repaint; size = (fun (_:Gctx.gctx) -> (w,h)) }