Commits

Paweł Wieczorek committed 6dddd0b Draft

added font14

  • Participants
  • Parent commits 616a8dd

Comments (0)

Files changed (6)

   let img_rock  = prepare_image "rock-32x32"
 
   let font_txt18  = prepare_font "FreeSans" 18
+  let font_txt14  = prepare_font "FreeSans" 14
 
   let resources =
     [ Image img_grass
     ; Image img_water
     ; Image img_rock
     ; Font  font_txt18
+    ; Font  font_txt14
     ]
 
 end
 
   | Font f ->
       let path = to_ustring (List.rev [ "res" ; "ttf" ; f.nameFont ^ ".ttf" ]) in
-      Printf.printf " - loading font %s\n%!" path;
+      Printf.printf " - loading font %s size %u\n%!" path f.sizeFont;
       let font = Sdlttf.open_font path f.sizeFont in
       f.font <- Some font
 
     val img_rock  : resourceImage
 
     val font_txt18 : resourceFont
+    val font_txt14 : resourceFont
+
   end
 

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 "Start Game"
+    ; Button "Load Game"
+    ; Button "Options"
+    ; Button "Exit"
     ]
 
    
 
 module UISettings = struct
   let border_size       = 1
-  let text_height       = 30
+  let text_height18     = 30
+  let text_height14     = 20
   let padding           = 5
   let panel_padding     = 10
   let panel_border_size = 3

src/UI/UI_Button.ml

 let draw_button params text (x, y, w, h) surface =
     let fparams = mk_frame_params params in
     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
+    draw_text_center (get_font PAK0.font_txt14.font) (0,0,0) text ~rc:rc_in surface
 
 let calculate_height params = 
     let fparams = mk_frame_params params in
     let height  = UI_Frame.calculate_height fparams in
-    height + UISettings.text_height + UISettings.padding
+    height + UISettings.text_height14 + UISettings.padding
 

src/UI/UI_Panel.ml

 let draw_panel params text (x, y, w, h) surface =
     let fparams = mk_frame_params params in
     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
+    let (rc_top, rc_bot) = split_hor rc_in UISettings.text_height18 in
     Video.draw_rect Color.cadet_grey rc_top 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 fparams = mk_frame_params params in
   let height  = UI_Frame.calculate_height fparams in
-  height + UISettings.text_height + 2*UISettings.panel_padding
+  height + UISettings.text_height18 + 2*UISettings.panel_padding