(* This file was generated by SableCC (http://www.sablecc.org/). *)

open Expression

open Tokens
open Lexer
open Nodes
open Analysis

open Gobject.Data
open StdLabels

module GtkPrinter = 
  struct
    type t = {
        mutable stack : Gtk.tree_iter Stack.t;
        mutable model : GTree.tree_store;
        mutable node : string GTree.column;
        mutable at_top : bool;
      }

    let col = new GTree.column_list
    let state = { stack = Stack.create(); node = col#add string; 
                model = GTree.tree_store col; at_top = true}

    let gtk_printing_enter parent child = 
      match child with 
      | P node ->
          let row = if (state.at_top) then
            state.model#append () else
            state.model#append ~parent:(Stack.top state.stack) () in
          state.at_top <- false;
          state.model#set ~row ~column:state.node (Nodes.getType child);
          Stack.push row state.stack
      | Nodes.T t ->
          let row = Stack.top state.stack in
          let token_row = state.model#append ~parent:row () in
          let set column = state.model#set ~row:token_row ~column in
          set state.node (String.escaped (Tokens.getText t))
      | _ -> ()

    let add_columns ~(view:GTree.view) ~model =
      let renderer = GTree.cell_renderer_text [`XALIGN 0.] in
      view#append_column
        (GTree.view_column ~renderer:(renderer, ["text", state.node]) ())

      let gtk_printing_leave parent old_child child visitor = 
      match child with
      | Start (_,_) ->
          let window = GWindow.window ~title:"Parse Tree" () in
          window#connect#destroy ~callback:GMain.quit;
          let scrolled_win = GBin.scrolled_window
              ~shadow_type:`ETCHED_IN
              ~vpolicy: `AUTOMATIC
              ~hpolicy: `AUTOMATIC
              ~packing: window#add () in
          let treeview = GTree.view ~model:state.model ~packing:scrolled_win#add () in
          add_columns ~view:treeview ~model:state.model;
          treeview#misc#connect#realize ~callback:treeview#expand_all;
          window#set_default_size 650 400;
          window#show ();
          GMain.main (); child
      | Nodes.P _ ->
          ignore (Stack.pop state.stack); child
      | _ -> child

    let rec gtk_printing_visitor = {
      override = (fun parent n -> n);
      enter = (fun x y -> (gtk_printing_enter x y; gtk_printing_visitor));
      leave = gtk_printing_leave;
      finish = (fun n -> ());
      start = (fun () -> gtk_printing_visitor);
    }

  end;;

module TextPrinter =
  struct
    type t = 
      {
       mutable indent : string;
       mutable output : string;
       mutable last : bool;
       mutable indentchar : string Stack.t;
       mutable colour : bool;
     }

    let shave_off_l s i = String.sub s i (String.length s - i)
    let shave_off_r s i = String.sub s 0 (String.length s - i)

    let state = { indent = ""; output = ""; last = false; indentchar = Stack.create(); colour = false; }

    let esc = "\027"

    type style = NORMAL | BOLD | UNDERSCORE | BLINK | CONCEALED
    let get_style_code x = match x with
    | NORMAL -> 0
    | BOLD -> 1
    | UNDERSCORE -> 4
    | BLINK -> 5
    | CONCEALED -> 8

    type fg_colour = FG_BLACK | FG_RED | FG_GREEN | FG_YELLOW | FG_BLUE |
                    FG_MAGENTA | FG_CYAN | FG_WHITE
    let get_fg_code x = match x with
    | FG_BLACK -> 30
    | FG_RED -> 31
    | FG_GREEN -> 32
    | FG_YELLOW -> 33
    | FG_BLUE -> 34
    | FG_MAGENTA -> 35
    | FG_CYAN -> 36
    | FG_WHITE -> 37

    type bg_colour = BG_BLACK | BG_RED | BG_GREEN | BG_YELLOW | BG_BLUE |
                    BG_MAGENTA | BG_CYAN | BG_WHITE
    let get_bg_code x = match x with
    | BG_BLACK -> 40
    | BG_RED -> 41
    | BG_GREEN -> 42
    | BG_YELLOW -> 43
    | BG_BLUE -> 44
    | BG_MAGENTA -> 45
    | BG_CYAN -> 46
    | BG_WHITE -> 47

    let reset_colour () = 
      if state.colour then (esc ^ "[0m") else ""

    let set_colour style fgc bgc =
      if state.colour then (esc ^ "[" ^ 
        (string_of_int (get_style_code style)) ^ ";" ^
        (string_of_int (get_fg_code fgc))) ^ "m" else ""

    let tree_colour () =
      set_colour NORMAL FG_BLACK BG_BLACK

    let text_printing_leave parent old_child child visitor = 
      match child with
      | Start (_, _) -> print_string ((tree_colour ()) ^ "\n" ^ shave_off_l state.output 3 ^ "\n" ^ (reset_colour ())); child
      | P p -> 
          state.indent <- (shave_off_r state.indent 4) ^ (Stack.pop state.indentchar);
          state.output <- state.indent ^ "- " ^ (set_colour NORMAL FG_GREEN BG_BLACK) ^ (Nodes.getType child) ^ (tree_colour ()) ^ "\n" ^ state.output;
          state.indent <- (shave_off_r state.indent 1) ^ "|";
          child
      | Nodes.T (Tokens.T (_, Tokens.EOF)) -> state.last <- false; child
      | Nodes.T t ->
          if (state.last) then state.indent <- ((shave_off_r state.indent 1) ^ "`");
          state.output <- state.indent ^ "- " ^ (set_colour NORMAL FG_RED BG_BLACK) ^ 
            (String.escaped (Tokens.getText t)) ^ (tree_colour ()) ^ "\n" ^ state.output;
          state.indent <- (shave_off_r state.indent 1) ^ "|";
          state.last <- false;
          child
      | _ -> child

    let text_printing_enter parent child = 
      match child with 
      | Start (_,_) -> 
          state.indent <- " ";
      | P _ -> 
          if state.last then 
            (Stack.push "`" state.indentchar)
          else (Stack.push "|" state.indentchar);
          state.indent <- state.indent ^ "   ";
          state.last <- true
      | _ -> ()

    let rec text_printing_visitor = {
      override = (fun parent n -> n);
      enter = (fun x y -> (text_printing_enter x y; text_printing_visitor));
      leave = text_printing_leave;
      finish = (fun n -> ());
      start = (fun () -> text_printing_visitor);
    }
end;;