Commits

Anonymous committed fe33fdf

Minor changes

Comments (0)

Files changed (5)

 	((BView*)v_self)->SetLayout((BLayout*)v_layout);
 	CAMLreturn(Val_unit);
 }
+CAMLprim value bview_SetViewColor_1(value v_self, value v_color)
+{
+	CAMLparam2(v_self, v_color);
+	((BView*)v_self)->SetViewColor(*(rgb_color*)v_color);
+	CAMLreturn(Val_unit);
 }
+CAMLprim value bview_SetViewColor_2(value v_self, value v_r, value v_g, value v_b, value v_a)
+{
+	CAMLparam5(v_self, v_r, v_g, v_b, v_a);
+	((BView*)v_self)->SetViewColor(Int_val(v_r), Int_val(v_g), Int_val(v_b), Int_val(v_a));
+	CAMLreturn(Val_unit);
+}
+}
 external btextview_FindWord :
 	Beapi.btextview -> int -> int32 -> int32 -> unit =
 	"btextview_FindWord"
-external btextview_GetDragParameters :
+(*external btextview_GetDragParameters :
 	Beapi.btextview -> Beapi.bmessage -> Beapi.bbitmap -> Beapi.bpoint -> Beapi.bhandler -> unit =
-	"btextview_GetDragParameters"
+	"btextview_GetDragParameters"*)
 external btextview_GetSelection :
 	Beapi.btextview -> int32 -> int32 -> unit =
 	"btextview_GetSelection"
 external btextview_Delete_2 :
 	Beapi.btextview -> int -> int -> unit =
 	"btextview_Delete_2"
-external btextview_InsertText :
+(*external btextview_InsertText :
 	Beapi.btextview -> string -> int -> int -> Beapi.text_run_array -> unit =
 	"btextview_InsertText"
 external btextview_DeleteText :
 	Beapi.btextview -> int -> int -> unit =
-	"btextview_DeleteText"
+	"btextview_DeleteText"*)
 external btextview_LineAt_1 :
 	Beapi.btextview -> int -> int =
 	"btextview_LineAt_1"
 	let find_word ~self ~offset ~start ~finish () =
 		btextview_FindWord self offset start finish
 
-	let get_drag_parameters ~self ~drag ~bitmap ~point ~handler () =
-		btextview_GetDragParameters self drag bitmap point handler
+(*	let get_drag_parameters ~self ~drag ~bitmap ~point ~handler () =
+		btextview_GetDragParameters self drag bitmap point handler*)
 
 	let get_selection ~self ~start ~finish () =
 		btextview_GetSelection self start finish
 		| _, _-> invalid_arg "Wrong arg in BTextView.Delete"
 
 
-	let insert_text ~self ~text ~length ~offset ~runs () =
+	(*let insert_text ~self ~text ~length ~offset ~runs () =
 		btextview_InsertText self text length offset runs
 
 	let delete_text ~self ~start ~finish () =
-		btextview_DeleteText self start finish
+		btextview_DeleteText self start finish*)
 
 	let line_at ~self ?point ?offset () =
 		match point, offset with
     method find_word ~offset ~start ~finish =
       btextview_FindWord pointer offset start finish
 
-    method get_drag_parameters ~drag ~bitmap ~point ~handler =
-      btextview_GetDragParameters pointer drag bitmap point handler
+(*    method get_drag_parameters ~drag ~bitmap ~point ~handler =
+      btextview_GetDragParameters pointer drag bitmap point handler *)
 
     method get_selection ~start ~finish =
       btextview_GetSelection pointer start finish
       | _, _-> invalid_arg "Wrong arg in BTextView.Delete"
 
 
-    method insert_text ~text ~length ~offset ~runs =
+(*    method insert_text ~text ~length ~offset ~runs =
       btextview_InsertText pointer text length offset runs
 
     method delete_text ~start ~finish =
-      btextview_DeleteText pointer start finish
+      btextview_DeleteText pointer start finish*)
 
     method line_at ?point ?offset () =
       match point, offset with
 external bview_SetLayout :
 	Beapi.bview -> Beapi.blayout -> unit =
 	"bview_SetLayout"
+external bview_SetViewColor_1 :
+	Beapi.bview -> Beapi.rgb_color -> unit =
+	"bview_SetViewColor_1"
+external bview_SetViewColor_2 :
+	Beapi.bview -> int -> int -> int -> int -> unit =
+	"bview_SetViewColor_2"
 
 
 
 let add_child ~self ~aView ~sibling () = bview_AddChild self aView sibling
 
 let set_layout ~self ~layout () = bview_SetLayout self layout 
+
+let set_view_color ~self ?color ?red ?green ?blue ?alpha () =
+	match color, red, green, blue, alpha with
+	| Some color, None, None, None, None -> bview_SetViewColor_1 self color
+	| None, Some r, Some g, Some b, Some a -> bview_SetViewColor_2 self r g b a
+	| _, _, _, _, _ -> invalid_arg "Wrong arg in BView.set_view_color"
 external blayout_of_bgrouplayout :
 	bgrouplayout -> blayout =
 	"blayout_of_bgrouplayout"
+
+let default_bview_color = 216
 let hello_haiku = "Hello"
 
+class home_tab =
+  object (self)
+    val layout =
+      new BGroupLayout.bgrouplayout ~orientation:Beapi.B_HORIZONTAL
+                                    ~spacing:0.0 ()
+    val mutable view =  BView.null ()
+    method set_view = view <-
+      BView.bview
+        ~layout:(Beapi.blayout_of_bgrouplayout layout#get_pointer)
+        ~name:"Home" ~flags:Beapi.b_WILL_DRAW () 
+    method get_view = view
+    initializer
+      self#set_view ;
+      BView.set_view_color ~self:view ~red:Beapi.default_bview_color
+                           ~green:Beapi.default_bview_color
+                           ~blue:Beapi.default_bview_color ~alpha:255 () ;
+      let button =
+        BButton.bbutton ~message:(BMessage.bmessage ~command:1 ())
+                        ~label:"Hello" () in
+      ignore
+        (layout#add_view ~child:(Beapi.bview_of_bbutton button) ())
+end
+
 class ribbon_tabs =
   object (self)
     inherit BTabView.btabview ~name:"Ribbon Tabs"
                                 (Beapi.b_WILL_DRAW +
                                    Beapi.b_FULL_UPDATE_ON_RESIZE) ()
     initializer
-      let home_tab_layout =
-        new BGroupLayout.bgrouplayout ~orientation:Beapi.B_HORIZONTAL
-                                      ~spacing:0.0 () in
-      let home_tab_view =
-        BView.bview
-          ~layout:(Beapi.blayout_of_bgrouplayout home_tab_layout#get_pointer)
-          ~name:"Home" ~flags:Beapi.b_WILL_DRAW () in
-      self#add_tab ~target:home_tab_view ~tab:(BTab.null ()) () ;
+      let home_tab = new home_tab in
+      self#add_tab ~target:home_tab#get_view ~tab:(BTab.null ()) () ;
       let file_tab_layout =
         new BGroupLayout.bgrouplayout ~orientation:Beapi.B_HORIZONTAL
                                       ~spacing:1.0 () in
           ~layout:(Beapi.blayout_of_bgrouplayout insert_tab_layout#get_pointer)
           ~name:"Insert" ~flags:Beapi.b_WILL_DRAW () in
       self#add_tab ~target:insert_tab_view ~tab:(BTab.null ()) () ;
-      let button =
-        BButton.bbutton ~label:"Hello"
-                        ~message:(BMessage.bmessage ~command:1 ())
-                        () in
-
-      ignore
-        (home_tab_layout#add_view ~child:(Beapi.bview_of_bbutton button) ())
 end
 
 class hello_window ~frame =
                                       ~spacing:0.0 () in
       self#set_layout
         ~layout:(Beapi.blayout_of_bgrouplayout window_layout#get_pointer) ;
+      BView.set_view_color ~self:window_layout#owner
+                           ~red:Beapi.default_bview_color
+                           ~green:Beapi.default_bview_color
+                           ~blue:Beapi.default_bview_color ~alpha:255 () ;
       let tabs = new ribbon_tabs in
       window_layout#add_view
         ~child:(Beapi.bview_of_btabview tabs#get_pointer) () ;
         BView.bview ~name:"secondary"
           ~layout:(Beapi.blayout_of_bgrouplayout secondary_layout#get_pointer)
           ~flags:Beapi.b_WILL_DRAW () in
+      BView.set_view_color ~self:secondary_view ~red:Beapi.default_bview_color
+                           ~green:Beapi.default_bview_color
+                           ~blue:Beapi.default_bview_color ~alpha:255 () ;
       let secondary_button =
         BButton.bbutton ~label:"Secondary"
                         ~message:(BMessage.bmessage ~command:1 ())