Message-ID: <44EF8171.3040405 at tin.it>
Date: Sat, 26 Aug 2006 01:02:09 +0200
From: Stalkern 2 <stalkern2 at tin.it>
MIME-Version: 1.0
To: lablgtk at math.nagoya-u.ac.jp
Subject: Re: how to put text in a drawing_area ?
References: <44EE235F.2050809 at tin.it>	<44EE9E1A.9050409 at tin.it>	<44EED402.6010006 at tin.it> <20060825.203217.06629593.garrigue at math.nagoya-u.ac.jp> <44EEEAFB.8000204 at tin.it> <44EEF5B2.7030701 at tin.it>
In-Reply-To: <44EEF5B2.7030701 at tin.it>
Content-Transfer-Encoding: 8bit
Content-Type: text/plain; charset=ISO-8859-1
Content-Length: 9328

Stalkern 2 wrote:
> Stalkern 2 wrote:
[...]

Here is some reviewed code, just for the record and in case somebody
needs such a hack now.
It contains also a crude way to set the size of string, bypassing font
metrics and the Pango equivalent of Gdk.Font.string_width and
Gdk.Font.string_height.

There still is the Gdk-WARNING **: No colormap in gc_get_background... =-((


---->8---->8---->8---->8---->8---->8---->8---->8---->8---->8---->8----

(* textRotator *)
(* ------------------------------------------------------------- *)
(* Use with lablgtk 2.6.x *)
(* As usual, simply launch
   lablgtk2 <this file>
from a console *)
(* ------------------------------------------------------------- *)

(*sizes*)
let (windowWidth,windowHeight) = (300,300);;

(*can't see what an exposed area looks like?
 * set to "true" to mark exposed areas so that you can't miss them :-)
 *)
let advertiseExposedAreaFlag = false;;

(* ------------------------------------------------------------- *)
open GMain;;

let window = GWindow.window ~width:windowWidth ~height:windowHeight ();;
let dwArea = GMisc.drawing_area ~packing:window#add ();;

(*realize drawing areas as soon as possible*)
let (w:Gdk.window) =
  (dwArea#misc#realize ();
   dwArea#misc#window);;

let (dwb:GDraw.drawable) = new GDraw.drawable w;;

let () =
  (* (http://developer.gnome.org/doc/GGAD/z132.html)
   * GDK's GdkRGB module allows you to copy a client-side buffer of
image data to a drawable.
   * If you need to manipulate images extensively, or copy image data to
the server,
   * this is the correct way to do it. You can't directly manipulate a
GdkPixmap
   * because a pixmap is a server-side object. Copying image data to the
server with
   * gdk_draw_point() would be unbelievably slow, since each point would
require a server request
   * (probably more than one, since you will need to change the GC for
each point).
   * Internally, GdkRGB uses an object called GdkImage to rapidly copy
image data to the server
   * in a single request. This is still somewhat slow---sizeable data
does have to be copied---
   * but GdkRGB is highly tuned and uses shared memory if the client and
server happen to be
   * on the same machine. So it's the fastest way to perform this task,
given the X architecture.
   * It will also handle some tricky issues for you (such as adapting to
the colormaps and
   * visuals available on a given X server).
   * The GdkRGB functions are in a separate header, gdk/gdkrgb.h. Before
using any
   * GdkRGB functions, you must initialize the module with
gdk_rgb_init() (Figure 24);
   * this sets up the visual and colormap GdkRGB will use, and some
internal data structures.
   *)
  Gdk.Rgb.init ()
;;

let backingPxm:(GDraw.pixmap) =
  (
    GDraw.pixmap
     ~width:windowWidth
     ~height:windowHeight
     ~mask:false
     ~colormap:(Gdk.Rgb.get_cmap ())(*Gdk.Color.get_system_colormap ()*)
     ()
  )
;;

let () =
  backingPxm#set_foreground (`NAME "orange");
  backingPxm#rectangle ~filled:true ~x:0 ~y:0 ~width:windowWidth
~height:windowHeight ()
;;


(* ------------------------------------------------------------- *)
let max_of_list l = if (l <> []) then (List.fold_left (fun a b -> if (a
> b) then a else b) (List.hd l) l) else (failwith "max_of_list");;

(* ------------------------------------------------------------- *)
(* background restoration callback *)
let redraw_on_exposure ?(simulate = false) (aDrawing:GDraw.drawable)
aExposedArea =

  (*TEST*)
  (*let () = Printf.printf "EXPOSURE!\n%!" in*)
  (*the first one happens when showing!*)

  (

    let exposedAreaX = (Gdk.Rectangle.x aExposedArea) in
    let exposedAreaY = (Gdk.Rectangle.y aExposedArea) in
    let exposedAreaWidth = (Gdk.Rectangle.width aExposedArea) in
    let exposedAreaHeight = (Gdk.Rectangle.height aExposedArea) in

       (* Hint given by Claude Marché;
        * book area to redraw with respect to the clipping area
        * that will be used by the animation function,
        * otherwise the clipping mask for the moving image would
        * only take care of the moving image *)
    let () = aDrawing#set_clip_rectangle aExposedArea in

    (*paste exposed areas back from the background pixmap*)
    (*use ~xsrc:0 ~ysrc:0 for checking the behaviour*)
       let () = aDrawing#put_pixmap
		  ~x:exposedAreaX
		  ~y:exposedAreaY
		  ~xsrc:exposedAreaX
		  ~ysrc:exposedAreaY
		  ~width:exposedAreaWidth
		  ~height:exposedAreaHeight
		  backingPxm#pixmap
       in
	
       let () =
         if ((advertiseExposedAreaFlag) && (not simulate)) then
           (
             let () = aDrawing#set_foreground (`NAME "yellow") in
             let () = aDrawing#set_line_attributes ~width:5 () in
             let () =
	       aDrawing#lines
		 [
		   (exposedAreaX,exposedAreaY);
		   ((exposedAreaX + exposedAreaWidth),(exposedAreaY));
		   ((exposedAreaX + exposedAreaWidth),(exposedAreaY + exposedAreaHeight));
		   ((exposedAreaX),(exposedAreaY + exposedAreaHeight));
		   ((exposedAreaX + exposedAreaWidth),(exposedAreaY));
		   (exposedAreaX,exposedAreaY);
		   ((exposedAreaX + exposedAreaWidth),(exposedAreaY + exposedAreaHeight))
		 ]
	     in
	       ()
	   )
         else
	   ()
       in
       (*
        * in GTK, a callback returning false means:
        * "Continue until some signal handler returns TRUE,
        * or until the top-level widget is reached"
        *)
       false
  )
;;


(* ------------------------------------------------------------- *)

let draw_orientedString ~(orientation:GtkEnums.orientation) ~bkgcolor
~textcolor ~destcenterx ~destcentery ~destmaxh ~destmaxw ~dwarea
~(destpixmap:GDraw.pixmap) s =
  (
    let startfontsize = 30 in

    let pc = dwarea#misc#create_pango_context in
    let () = pc#set_font_by_name ("sans "^(string_of_int startfontsize)
) in
    let pl = pc#create_layout in
    let () = Pango.Layout.set_text pl s in
    let plw,plh = Pango.Layout.get_pixel_size pl in

    let (horizratio, vertratio) =
      (
	match orientation with
	  |  `VERTICAL ->
	       ( ((float plw) /. (float destmaxh)), ((float plh) /. (float
destmaxw)) )
	  | `HORIZONTAL ->
	      ( ((float plw) /. (float destmaxw)), ((float plh) /. (float
destmaxh)) )
      )
    in
    let goodfontsize = truncate ((float startfontsize) /. (max_of_list
[horizratio; vertratio]) ) in

    let () = pc#set_font_by_name ("sans "^(string_of_int goodfontsize) )
in
    let pl = pc#create_layout in
    let () = Pango.Layout.set_text pl s in
    let plw,plh = Pango.Layout.get_pixel_size pl in

    (*<TEST>*)
    (*let () = Printf.printf  "horizratio =%f, vertratio=%f\n%!"
horizratio vertratio
    in*)
      (*</TEST>*)

    let tmpPxm =
      (
	GDraw.pixmap
	 ~width:plw
	 ~height:plh
	 ~mask:true
	 ~colormap:(*Gdk.Rgb.get_cmap ()*)(Gdk.Color.get_system_colormap ())
	 ()
      )
    in

    let () = tmpPxm#set_foreground bkgcolor in
    let () = tmpPxm#rectangle ~filled:true ~x:0 ~y:0 ~width:plw
~height:plh () in

    let () =
      tmpPxm#put_layout ~x:0 ~y:0 ~fore:textcolor pl
    in


    let () =
      (
	match orientation with
	  |  `VERTICAL ->
	       (
		 let img_1 =
		   Gdk.Image.get
		     tmpPxm#pixmap
		     ~x:0
		     ~y:0
		     ~width:plw
		     ~height:plh
		 in
		
		 let img_2 =
		   Gdk.Image.create
		     ~kind:`NORMAL
		     ~visual:(Gdk.Rgb.get_visual () )
		     ~width:plh
		     ~height:plw
		 in
		
		 (* ROTATE *)
		 let () =
		   for i=0 to (plw -1) do
		     (
		       for j=0 to (plh -1) do
			 (Gdk.Image.put_pixel img_2 ~x:j ~y:i ~pixel:(Gdk.Image.get_pixel
img_1 ~x:(plw - i -1) ~y:j) )
		       done
		     )
		   done
		 in
		
		 (* COPY TO DEST *)
		 let () =
		   destpixmap#put_image
		     ~x:(destcenterx - (plh / 2))
		     ~y:(destcentery - (plw / 2))
		     ~xsrc:0
		     ~ysrc:0
		     ~width:plh
		     ~height:plw
		     img_2
		 in
		   (**)
		
		 (*CLEANUP tmp images *)
		 let () =
		   (
		     Gdk.Pixmap.destroy (tmpPxm#pixmap);
		     Gdk.Image.destroy img_1;
		     Gdk.Image.destroy img_2
		   )
		 in
		
		   ()
	       )
	  | `HORIZONTAL ->
	      (
		(* COPY TO DEST *)
		let () =
		  destpixmap#put_pixmap
		    ~x:(destcenterx - (plw / 2))
		    ~y:(destcentery - (plh / 2))
		    ~xsrc:0
		     ~ysrc:0
		    ~width:plw
		    ~height:plh
		    (tmpPxm#pixmap)
		 in
		  ()
	      )
      )
    in
      ()
  )
;;

(* ------------------------------------------------------------- *)

let gui () =
  let () = ignore (window#connect#destroy ~callback:Main.quit) in
  let () = ignore
      (dwArea#event#connect#expose
         ~callback:
         (fun event -> redraw_on_exposure dwb (GdkEvent.Expose.area
event))) in

  (*CHANGE AS DESIRED TO MODIFY THE SIZE OF THE STRING DRAWN*)
  let maxSizeA, maxSizeB = (100,270) in

  let () =
    draw_orientedString (*CHANGE ORIENTATION AS YOU WISH*)
      ~orientation:(**)`VERTICAL(**) (*`HORIZONTAL*)
      ~bkgcolor:`BLACK
      ~textcolor:`WHITE
      ~destcenterx:((windowWidth)/2)
      ~destcentery:((windowHeight)/2)
      ~destmaxh:maxSizeB
      ~destmaxw:maxSizeA
      ~dwarea:dwArea
      ~destpixmap:backingPxm
      "COUCOU"
  in



  let () = window#show () in

    Main.main ()
;;

(* ------------------------------------------------------------- *)
(* Go! *)
let _ = gui ();;

(*EOF*)

----8<----8<----8<----8<----8<----8<----8<----8<----8<----8<----8<----


Ernesto