$include "info.icn"

$define Win_Size    2000
$define BG          "white"
$define FG          "black"
$define START       15

# set the default for DrawTree_Square_R
procedure drawtree_square_default(fg, bg)

   local draw_record

   draw_record := DrawTree_Square_R()

   draw_record.win_width := Win_Size
   draw_record.win_height := Win_Size
   if /fg then draw_record.fg := FG else draw_record.fg := fg
   if /bg then draw_record.bg  := BG else draw_record.bg := bg
   draw_record.color_list := [1, 2, 3, 4]
   draw_record.color_list_u := 
       ["red", "blue", "green", "orange", "yellow", "brown", "purple"]
   draw_record.num_color := 4
   draw_record.win :=
      WOpen("canvas=hidden", "size=" || Win_Size || "," || Win_Size + 100,
            "bg=" || draw_record.bg, "fg=" || draw_record.fg)
   draw_record.linewidth   := 10
   draw_record.gridwidth   := 2
   draw_record.line_pos    := VER
   draw_record.justification := MIDDLE
   draw_record.length      := 580
   draw_record.space       := 2
   draw_record.move        := 15
   draw_record.under       := &null
   draw_record.population  := &null
   draw_record.x           := START
   draw_record.y           := START
   draw_record.num_children_code := &null
   draw_record.tree        := &null
   draw_record.bar         := 1

   draw_record.menu := ["background", format_square_cb, "color list", 
                        format_square_cb, "linewidth", format_square_cb, 
                        "space", format_square_cb, "length", format_square_cb,
                        "index", format_square_cb, 
                        "justification", format_square_cb,
                        "snapshot", format_square_cb, "grid", format_square_cb,
                        "line pos", format_square_cb, 
                        "grid format", format_square_cb,
                        "population", format_square_cb,
                        "color format", format_square_cb,
                        "tree", format_square_cb,
                        "bar", format_square_cb]

   return draw_record

end


# draw the tree with grids
procedure drawtree_square(draw_record)

   \draw_record.num_children_code &
    draw_record.num_children_code  :=  children.num_children / (*draw_record.color_list)

   draw_grid(draw_record)
   drawtree_square_rec(draw_record, children, 0, draw_record.x,
                   draw_record.y, draw_record.linewidth,
                   draw_record.length)
   \draw_record.tree & drawtree_square_line(draw_record, children, 0, draw_record.x, 
                                            draw_record.y, draw_record.length)

   return

end


# draw a grid
procedure draw_grid_blue(draw_record)

   local win, row
  
   win := Clone(draw_record.win)
   Fg(win, "light-blue")

   every row := draw_record.move 
         to draw_record.window_size by draw_record.move do 
     DrawLine(win, row, 0, row, draw_record.window_size) 

end


# draw a grid by using color
procedure draw_grid(draw_record)

   local win, row, id, length
 
   EraseArea(draw_record.win)

   if draw_record.gridwidth = 0 then return

   win := Clone(draw_record.win, "linewidth=" || draw_record.gridwidth)
   id := 1
   length := 2 * START + draw_record.length 

   every row := START to draw_record.length/2  by draw_record.move do  {

     Fg(win, draw_record.color_list_u[draw_record.color_list[id]])    
     if draw_record.line_pos === VER then 
        draw_ver(win, draw_record, row, length) 
     else 
        draw_hoz(win, draw_record, row, length) 

     if id >= *draw_record.color_list then id := 1 else id +:= 1

   }

end


# draw the grid line vertical
procedure draw_ver(win, draw_record, row, length)

   case draw_record.justification of {

      LEFT   : {
           DrawLine(win, length - row * 2 + START, START, 
                    length - row * 2 + START, draw_record.win_height)  
                 }
      MIDDLE : {
           DrawLine(win, row, START, row, draw_record.win_height) 
           DrawLine(win, length - row, START, length - row, 
                    draw_record.win_height)  }
      RIGHT  : {
           DrawLine(win, row * 2, START, 
                    row * 2, draw_record.win_height)  
                 }
   }
 
   return

end



# draw the grid line horizontal
procedure draw_hoz(win, draw_record, row, length)

   case draw_record.justification of {

      LEFT : {
          DrawLine(win, START, row * 2,
                   draw_record.win_width, row * 2)
             }
      MIDDLE : {
          DrawLine(win, START, row, draw_record.win_width, row) 
          DrawLine(win, START, length - row, draw_record.win_width, 
           length - row) 
         }
      RIGHT : {
          DrawLine(win, START, length - row * 2 + START, 
                   draw_record.win_width, length - row * 2 + START)
            }


   }
   return

end



# draw the tree seperated with line between each node
procedure drawtree_square_rec(draw_record, children, id, x, y, width, length)

    local gen, new_id, win, x_new, y_new, new_length, x_o, tmp, angle

    win := Clone(draw_record.win)

    if draw_record.num_children_code === &null then {
       Fg(win, draw_record.color_list_u[draw_record.color_list[
              (children.all[id].generation) % 
              draw_record.num_color + 1]])   }
    else {
       tmp := integer(children.all[id].children_num  /  draw_record.num_children_code)
       if tmp > *draw_record.color_list then  tmp := *draw_record.color_list
       else if tmp < *draw_record.color_list then tmp +:= 1
       Fg(win, draw_record.color_list_u[draw_record.color_list[tmp]])
    }
                  
    draw_record.line_pos === HOR & draw_record.justification == LEFT & 
       y == START & y +:= START
    draw_record.line_pos === VER & draw_record.justification == RIGHT &
       x == START & x +:= START

    if draw_record.line_pos === VER then  {
       \draw_record.under & EraseArea(win, x - draw_record.space, 
                 y - draw_record.space, 
                 length + ( 2 * draw_record.space), draw_record.space)
       \draw_record.bar & FillRectangle(win, x, y, length, width - draw_record.space)
       \draw_record.population &
          new_length := (draw_record.length * children.all[id].children_num) /
                     (children.all[0].children_num) &
          (if draw_record.justification == MIDDLE then
                x_o := (draw_record.length - new_length)/2 + START
           else x_o := x) &
          WAttrib(win, "fg=gray") &
          if draw_record.population == "Bar" then
             FillRectangle(win, x_o, y, new_length, width - draw_record.space)
          else {
             angle := (children.all[id].children_num * 2 * &pi) / children.num_children 
             FillCircle(win, x_o + START, y + width/2, (width -  draw_record.space) / 2, 0, angle)
          }
    }
    else {

      \draw_record.under & EraseArea(win, x - draw_record.space, 
                 y - draw_record.space,
                 draw_record.space, length)
       \draw_record.bar & FillRectangle(win, x, y,  width - draw_record.space, length)       
       \draw_record.population &   
          new_length := (draw_record.length * children.all[id].children_num) /
                     (children.all[0].children_num) &
          WAttrib(win, "fg=gray") &
          if draw_record.population == "Bar" then
             FillRectangle(win, x, y + length - new_length, 
                        width - draw_record.space, 
                        new_length)
          else {
             angle := (children.all[id].children_num * 2 * &pi) / children.num_children 
             FillCircle(win, x + draw_record.linewidth/2, y + length - START, 
                     (width -  draw_record.space) / 2, 0, angle)          
          }
    }

    gen := 1
    every new_id := !children.all[id].children_id do
    {

       if (length) < (2 * draw_record.move) then
          return
   
       #gen +:= .1 * deep_children(new_id, children)

       if draw_record.line_pos === VER then {

          case draw_record.justification of {
             LEFT : {  y_new := y + (gen * draw_record.linewidth)
                       x_new := x }
             MIDDLE: { y_new := y + (gen * draw_record.linewidth)
                       x_new := x + draw_record.move }
             RIGHT:  { y_new := y + (gen * draw_record.linewidth)
                       x_new := draw_record.length - length +  4 * START
                     }
          }

          drawtree_square_rec(draw_record, children, new_id,
                       x_new, y_new, draw_record.linewidth,                
                       length - (2 * draw_record.move))
        }
       else  {

         case draw_record.justification of {
             LEFT : {  y_new := draw_record.length - length + 4 * START
                       x_new := x + (gen * draw_record.linewidth) }
             MIDDLE: { y_new := y + draw_record.move  
                       x_new := x + (gen * draw_record.linewidth) }
             RIGHT:  { y_new := y
                       x_new := x + (gen * draw_record.linewidth) }
          }

          drawtree_square_rec(draw_record, children, new_id,
                       x_new, #(x + (gen * draw_record.linewidth)),
                       y_new, # (y + draw_record.move), 
                       (draw_record.linewidth),
                       (length - (2 * draw_record.move)))
       }
  
       gen := children.all[new_id].children_num + gen + 1 
    }

end



procedure drawtree_square_line(draw_record, children, id, x, y, length)

   local gen, new_id, y_new, x_new, win

   win := Clone(draw_record.win)

   if draw_record.line_pos === VER  then {

      gen := 1   
      every new_id := !children.all[id].children_id do {

         case draw_record.justification of {
            LEFT : {  y_new := y + (gen * draw_record.linewidth)
                      x_new := x }
            MIDDLE: { y_new := y + (gen * draw_record.linewidth)
                      x_new := x + draw_record.move }
            RIGHT:  { y_new := y + (gen * draw_record.linewidth)
                      x_new := draw_record.length - length +  4 * START
                    }
          }

       DrawLine(win, x, y, x_new, y_new)
       FillCircle(win, x, y, 2)
       drawtree_square_line(draw_record, children, new_id, x_new, y_new, length - (2 * draw_record.move))
       gen := children.all[new_id].children_num + gen + 1
    }       
   }
   else  {  

      gen := 1
      every new_id := !children.all[id].children_id do {
   
         case draw_record.justification of {
             LEFT : {  y_new := draw_record.length - length + 4 * START
                       x_new := x + (gen * draw_record.linewidth) }
             MIDDLE: { y_new := y + draw_record.move  
                       x_new := x + (gen * draw_record.linewidth) }
             RIGHT:  { y_new := y
                       x_new := x + (gen * draw_record.linewidth) }
          }         

       DrawLine(win, x, y, x_new, y_new)
       FillCircle(win, x, y, 2)
       drawtree_square_line(draw_record, children, new_id, x_new, y_new, length - (2 * draw_record.move))
       gen := children.all[new_id].children_num + gen + 1
       }
   }

end
