To: lablgtk at kaba.or.jp
Subject: clipping regions
From: Michael Welsh Duggan <md5i at cs.cmu.edu>
Date: 23 Mar 2001 12:22:50 -0500
Message-ID: <v1tpuf84cyd.fsf at maru.rem.cs.cmu.edu>
Lines: 22
MIME-Version: 1.0
Content-Type: multipart/mixed; boundary="=-=-="

--=-=-=

This may end up being more of a GDK question than a lablgtk one, but
since I am programming in lablgtk (and am subscibed to this list), I
am hoping somebody here can help me.

My understanding was that I could set a clipping region, and then draw
anything and it would be clipped by the region.  Indeed, it does do
that, but it also appears to zap the underlying clipped region
beforehand.

The attatched file contains the problem.  If you comment out the
set-clip-region line, you will see what should be drawn (sans
clipping).

A secondary problem is that it doesn't appear to redraw properly when
the window is resized.  What event am I incorrectly handling which
causes this?


--=-=-=
Content-Disposition: attachment; filename=drawboard.ml

open Gdk
open GDraw
open GMain

let normalize (x, y) = 
  (int_of_float x, int_of_float y)

let normalize_points points =
  List.rev_map ~f:normalize points

let shift (px, py) ~x ~y =
  (px + x, py + y)

let shift_points points ~x ~y =
  List.rev_map ~f:(shift ~x ~y) points

let factor = sqrt (0.3 /. 0.4)
let smallhex_factor = 1.0 /. 2.25
let line_factor = 0.95

let points r =
  let h = r /. 2.0
  and f = factor *. r in
  [(-.r, 0.0); (-.h, f);
   (h, f); (r, 0.0);
   (h, -.f); (-.h, -.f)]

type mask = {region: region; 
	     points: (int * int) list;
	     mutable location: (int * int)}
type t = {radius: int; 
	  height: int;
	  hex: mask;
	  smallhex: mask;
	  tech_streams: mask list;
	  time_streams: mask list}

let poly_mask pts = 
  {region = Region.polygon pts `WINDING_RULE; location = (0, 0); points = pts}

let create radius =
  let small_radius = radius *. smallhex_factor 
  and r = truncate (radius) in
  let pts = normalize_points (points radius) 
  and small_pts = normalize_points (points small_radius)
  and height = truncate (factor *. radius) in
  let hex_mask = poly_mask pts
  and smallhex_mask = poly_mask small_pts 
  and stream_diag_offset = truncate (factor *. small_radius *. line_factor)
  and stream_vert_offset = truncate (small_radius *. line_factor)
  and other_center = (r * 3 / 2, height)
  and make_diag (x2, y2) factor =
    [(0, factor); (0, -factor); 
     (x2, y2 - factor); (x2, y2 + factor)] 
  and make_vert y2 factor =
    [(- factor, 0); (factor, 0); 
     (factor, y2); (-factor, y2)] 
  and mirror x y l = 
    List.rev_map ~f:(fun (xx, yy) -> (x * xx, y * yy)) l in
  let diag offset = make_diag other_center offset
  and vert offset = make_vert height offset
  and make_streams d v = [mirror 1 (-1) d; d; v; mirror (-1) 1 d; 
			  mirror (-1) (-1) d; mirror 1 (-1) v] in
  let tech_streams = make_streams 
      (diag (stream_diag_offset / 2)) (vert (stream_vert_offset / 2)) 
  and time_streams = make_streams
      (diag (stream_diag_offset / 6)) (vert (stream_diag_offset / 6)) in
  let tech_poly_streams = List.rev_map ~f:poly_mask tech_streams 
  and time_poly_streams = List.rev_map ~f:poly_mask time_streams 
  and cut x = {points = x.points;
	       location = x.location;
	       region = (Region.subtract 
			   (Region.union x.region hex_mask.region)
			   smallhex_mask.region)} in
  {radius = r;
   height = height;
   hex = hex_mask;
   smallhex = smallhex_mask;
   tech_streams = List.rev_map ~f:cut tech_poly_streams;
   time_streams = List.rev_map ~f:cut time_poly_streams}

let shift_region ~x ~y mask =
  let (cx, cy) = mask.location in
  let (dx, dy) = (x - cx, y - cy) in
  begin
    Region.offset mask.region ~x:dx ~y:dy;
    mask.location <- (x, y);
    mask.region
  end
   
let draw_hex ~(dst:_ drawable) ~x ~y hex_param ~hex =
  let pts = shift_points ~x ~y hex_param.hex.points 
  and small_pts = shift_points ~x ~y hex_param.smallhex.points
  and mask = shift_region ~x ~y hex_param.hex 
  and smallmask = shift_region ~x ~y hex_param.smallhex in
  let donut = Region.subtract mask smallmask
  and draw_mask mask =
    dst#polygon ~filled:false (shift_points ~x ~y mask.points) in
  begin
    dst#set_foreground `WHITE;
    dst#polygon ~filled:true pts;
    dst#set_foreground `BLACK;
    dst#polygon ~filled:false pts;
    dst#polygon ~filled:false small_pts;
    dst#set_clip_region donut;
    List.iter ~f:draw_mask hex_param.tech_streams;
    List.iter ~f:draw_mask hex_param.time_streams;
  end

let redraw x t =
  function _ ->
    let (x1, y1) as p1 = (t.radius + 5, t.radius + 5) in
    let f1 = truncate (float t.radius *. factor) 
    and f2 = truncate (float t.radius *. factor *. 2.0) in
    let (x2, y2) = shift p1 ~x:(t.radius * 3 / 2) ~y:f1
    and (x3, y3) = shift p1 ~x:0 ~y:f2 in
    begin
      draw_hex ~dst:x ~x:x1 ~y:y1 t ~hex:();
      draw_hex ~dst:x ~x:x2 ~y:y2 t ~hex:();
      draw_hex ~dst:x ~x:x3 ~y:y3 t ~hex:();
      false
    end

let echoEvents (obj: GWindow.window) =
  let echo x = fun _ -> print_endline x; flush stdout; false in
  obj#event#connect#button_press ~callback:(echo "Button_Press");
  obj#event#connect#button_release ~callback:(echo "Button_Release");
  obj#event#connect#configure ~callback:(echo "Configure");
  obj#event#connect#delete ~callback:(echo "Delete");
  obj#event#connect#destroy ~callback:(echo "Destroy");
  obj#event#connect#enter_notify ~callback:(echo "Enter_Notify");
  obj#event#connect#expose ~callback:(echo "Expose");
  obj#event#connect#focus_in ~callback:(echo "Focus_In");
  obj#event#connect#focus_out ~callback:(echo "Focus_Out");
  obj#event#connect#key_press ~callback:(echo "Key_Press");
  obj#event#connect#key_release ~callback:(echo "Key_Release");
  obj#event#connect#leave_notify ~callback:(echo "Leave_Notify");
  obj#event#connect#motion_notify ~callback:(echo "Motion_Notify");
  obj#event#connect#property_notify ~callback:(echo "Property_Notify");
  obj#event#connect#proximity_in ~callback:(echo "Proximity_In");
  obj#event#connect#proximity_out ~callback:(echo "Proximity_Out");
  obj#event#connect#selection_clear ~callback:(echo "Selection_Clear");
  obj#event#connect#selection_notify ~callback:(echo "Selection_Notify");
  obj#event#connect#selection_request ~callback:(echo "Selection_Request");
  obj#event#connect#unmap ~callback:(echo "Unmap")


let main () =
  let window = GWindow.window ~show:true ~allow_grow:true () in
  let w = window#misc#window in
  let drawing = new GDraw.drawable w in
  let hexes = create 50.0 in
  let my_redraw () = redraw drawing hexes in
  begin
    ignore (echoEvents window);
    ignore (window#connect#destroy ~callback:Main.quit);
    ignore (window#event#connect#after#expose ~callback:(my_redraw ()));
    ignore (window#event#connect#after#configure ~callback:(my_redraw ()));
    Main.main ()
  end

let _ = main ()

--=-=-=

-- 
Michael Duggan
(md5i@cs.cmu.edu)

--=-=-=--