
open Deck
open Printf

class gtk_gui_signaler cardboxes =
object(self)
    val mutable current_level = 0
    val mutable flipped = false
    val mutable listeners = []

    (* This adds a function to be called whenever the state is changed *)
    method add_listener f = listeners <- f :: listeners
                                
    method private notify level = 
        List.iter (fun f -> f level) listeners
                
    (* Just directly expose the cardboxes to listeners *)
    method boxes = cardboxes

    method level = current_level
    
    method set_level level =
        flipped <- false;
        current_level <- level;
        self # notify current_level
                       
    method flipped = flipped
    
    method flip = 
        flipped <- not flipped;
        self # notify current_level
                       
    method correct =
        if CardBoxes.count cardboxes current_level > 0 then (
            CardBoxes.correct cardboxes current_level;
            flipped <- false;
            self # notify current_level;
            self # notify (current_level + 1)
        )
                
    method incorrect =
        if CardBoxes.count cardboxes current_level > 0 then (
            CardBoxes.incorrect cardboxes current_level;
            flipped <- false;
            self # notify current_level;
            self # notify 0
        )
end

let set_all_to_color widget color =
    List.iter
        (fun state ->
             widget # misc # modify_base [state, `WHITE];
             widget # misc # modify_bg [state, `WHITE])
        [`ACTIVE; `INSENSITIVE; `NORMAL; `PRELIGHT; `SELECTED]
    
(*
let style_all_to_color widget color =
    List.iter
        (fun state ->
             widget # misc # style # set_base [state, `WHITE];
             widget # misc # style # set_bg [state, `WHITE])
        [`ACTIVE; `INSENSITIVE; `NORMAL; `PRELIGHT; `SELECTED]
*)


class level_button_manager cardboxes level_callback =
    let scrolled_window = GBin.scrolled_window 
                              ~hpolicy:`NEVER () in
    let button_vbox = GPack.vbox 
                          ~packing:scrolled_window # add_with_viewport () in
    let make_label level count = sprintf "Level %i: %i" level count in
    
    let make_button ?group level =
        let button = GButton.radio_button 
                         ?group
                         ~packing:(button_vbox#pack ~expand:false ~fill:false)
                         ~label:(make_label
                                     level
                                     (CardBoxes.count cardboxes level))
                         ()
        in
        ignore (button # connect # clicked 
                    ~callback:(fun () -> level_callback level));
        button
    in
    
    let first_button = make_button 0 in
    let group = first_button # group in
    let maximum = CardBoxes.max cardboxes in
object(self)
    val mutable max = maximum
    val mutable radio_buttons = Array.init (maximum+1)
                                    (fun i -> 
                                         if i = 0 
                                         then first_button
                                         else make_button ~group i)
              
        
    (* Precondition: the level is no more than one greater than
       max; we can only go up one cardbox at a time. *)
    method update level =
        assert (level <= max+1);
        if level > max then
            let new_button = make_button ~group level in
            max <- level;
            radio_buttons <- Array.append radio_buttons [| new_button |]
        else
            radio_buttons.(level) # set_label 
                (make_label level
                     (CardBoxes.count cardboxes level))
        
    method widget = scrolled_window

end

let card_view signaler =
    let cardbuffer = GText.buffer ~text:"Insert card here" () in
    let view = 
        GText.view
            ~editable:false
            ~buffer:cardbuffer
            ~justification:`CENTER
            ~wrap_mode:`WORD
            ()
    in
    
    (*set_all_to_color view (frame # misc # style # base `NORMAL);*)
    view # misc # modify_font (Pango.Font.from_string 
                                   (sprintf "Serif %i" !Config.font_size));
    (* should be unneccesary, since the whole window is
       double buffered: view # misc # set_double_buffered true; *)
    
    (* Add a callback to set the contents of the view to be
       correct no matter what just happened *)
    signaler # add_listener 
        (fun _ -> 
             let newtext =
                 try 
                     let card = CardBoxes.next_card 
                                    (signaler # boxes) 
                                    (signaler # level) 
                     in
                     (if signaler # flipped 
                      then card.back
                      else card.front)
                 with
                     | CardBoxes.Empty_level _ -> "(level is empty)"
             in
             cardbuffer # set_text newtext);
    view

let card_control_area signaler =
    
    let vbox = GPack.vbox () in
    let frame = vbox in
    (*let frame = GPack.notebook ~show_tabs:false 
                    ~packing:(vbox#pack ~expand:true ~fill:true) () in
    *)
    (*set_all_to_color frame `WHITE;*)
    (*frame # misc # style # set_base [`NORMAL, `WHITE];*)
    (* frame # misc # set_double_buffered true; *)

      let inner_vbox = GPack.vbox ~packing:frame#add () in
    
    let view = card_view signaler in
  
    inner_vbox # pack ~expand:true ~fill:false (view # coerce);

    let buttonbox = GPack.button_box 
                    `HORIZONTAL 
                        ~layout:`SPREAD
                        ~packing:(vbox # pack) () 
    in
   
    (* And callbacks to switch the text contents, tell the
       cardbox object you got it correct or not, respectively *)
    let make_button label = GButton.button ~label ~packing:(buttonbox # add) () in

    let flip = make_button "Flip" in
    let correct = make_button "Correct" in
    let wrong = make_button "Wrong" in

    ignore [
        flip # connect # clicked ~callback:(fun () -> signaler # flip);
        correct # connect # clicked ~callback:(fun () -> signaler # correct);
        wrong # connect # clicked ~callback:(fun () -> signaler # incorrect);
    ];

    vbox

let cardbox_area signaler =
    let button_manager = new level_button_manager 
                             (signaler # boxes) 
                             (signaler # set_level)
    in

    signaler # add_listener (button_manager # update);
    button_manager # widget
        
let main_window signaler = 
    let window = GWindow.window () in
    let hbox = GPack.hbox ~packing:window#add () in
    
    let cardbox_area = cardbox_area signaler in
    let card_control_area = card_control_area signaler in
    
    hbox # pack (cardbox_area # coerce);
    hbox # pack ~expand:true ~fill:true (card_control_area # coerce);

    window

   
    (* For each level from the min to max, create a button *)
 (*

let flashcard_control_area () = 
    let vbox = GPack.vbox ... in

    (* maximize the card in the area *)
    let flashcard_area = GText.text_something () in
    let button_window = horizontal button window in

    (* connect flip button with flashcard area flippage *)
    let ok_button = GButton.button ... in
    ok_button # connect # clicked
        ~callback:(fun () ->
                       Model.correct (whatever.current_level);
                       tell cardboxes to refresh, and then grab the
                           next card off the current level )
    button#connect#clicked 
        ~callback:(fun () -> printf "Hit buttoanana\n");

    (* connect yes / no button with enqueuing the card into another
       cardbox and moving to the next card *)

    vbox # pack flashcard_area;
    vbox # pack button_window
*)

let main ?(level = 0) cards =
    let locale = GtkMain.Main.init () in
    let boxes = CardBoxes.of_deck cards in

    let signaler = new gtk_gui_signaler boxes in
    
    let window = main_window signaler in
    (* It is ugly, but at least there is no flicker ;_; *)
    set_all_to_color window `WHITE;

    ignore (window # connect # destroy 
                ~callback:(fun () -> 
                               Data.save_data (CardBoxes.to_deck boxes);
                               GMain.Main.quit ()));

    signaler # set_level level;
    window # misc # set_double_buffered true;
      window # show ();
      GMain.Main.main ()
;;

Ui.register_ui "gtk" main;;
