Commits

Paweł Wieczorek committed 616a8dd Draft

better text drawing

Comments (0)

Files changed (6)

   let img_water = prepare_image "water-32x32"
   let img_rock  = prepare_image "rock-32x32"
 
-  let font_txt18  = prepare_font "speculum" 18
+  let font_txt18  = prepare_font "FreeSans" 18
 
   let resources =
     [ Image img_grass

src/Screens/MainScreen.ml

 let ui_contener = Panel ("Main menu", main_widget)
   where main_widget = HorizontalBox widgets
   where widgets =
-    [ Button "Play game"
-    ; Button "Load saved game"
-    ; Button "Options"
-    ; Button "Exit"
+    [ Button "play game"
+    ; Button "load saved game"
+    ; Button "options"
+    ; Button "exit"
     ]
 
    

src/UI/UI_Button.ml

 
 let draw_button params text (x, y, w, h) surface =
     let fparams = mk_frame_params params in
-    draw_frame fparams (x,y,w,h) surface;
-    draw_text (get_font PAK0.font_txt18.font) (0,0,0) text (x+3,y+3) surface
+    let rc_in = draw_frame fparams (x,y,w,h) surface in
+    draw_text_center (get_font PAK0.font_txt18.font) (0,0,0) text ~rc:rc_in surface
 
 let calculate_height params = 
     let fparams = mk_frame_params params in

src/UI/UI_Panel.ml

     let rc_in   = draw_frame fparams (x,y,w,h) surface in
     let (rc_top, rc_bot) = split_hor rc_in UISettings.text_height in
     Video.draw_rect Color.cadet_grey rc_top surface;
-    draw_text (get_font PAK0.font_txt18.font) (0,0,0) text (x+3,y+3) surface;
+    draw_text_center (get_font PAK0.font_txt18.font) (0,0,0) text ~rc:rc_top surface;
     narrow_rect rc_bot UISettings.panel_padding
 
 let calculate_height params =
 
 
 let create_text_image font color text =
-  _create_image (Sdlttf.render_text font (Sdlttf.SOLID color) text)
+  _create_image (Sdlttf.render_text font (Sdlttf.BLENDED color) text)
 
 let draw_text font color text pos image =
   let txtimg = create_text_image font color text in
         rc
   in let (x,y,w,h) = get_rc rc in
      let (d_x, d_y) = 
-       if iw < w - x or ih < h - y then
+       if (*iw < w - x or ih < h - y*) false then
          (0 , 0)
        else
-         let d_x = (w - x - iw) / 2 in
-         let d_y = (h - y - ih) / 2 in
+         let d_x = (w - iw) / 2 in
+         let d_y = (h - ih) / 2  in
          (d_x, d_y)
      in
-       put_image src surface (d_x, d_y)
+       put_image src surface (x + d_x, y + d_y)
+
+let draw_text_center font color text ?rc surface =
+  let txtimg = create_text_image font color text in
+  match rc with
+    | None -> put_image_center txtimg surface
+    | Some _rc -> put_image_center txtimg ~rc:_rc surface
+
+
+
 val draw_text : Sdlttf.font -> color -> string -> int * int -> image -> unit
 val create_text_image : Sdlttf.font -> color -> string -> image
 val put_image_center: image -> ?rc:rect -> image -> unit
+val draw_text_center : Sdlttf.font -> color -> string -> ?rc:rect -> image -> unit