GLE Library: tree.gle

! Subroutines for drawing trees

include "shape.gle"
include "ellipse.gle"

! these constants are final (don't change these)
! the defaults can be modified with the functions below
tree_edge_label_hei = 0.25
tree_node_hei = 0.3;        tree_leaf_hei = 0.25
tree_node_dx = 0.6;         tree_node_dy = 0.9
tree_node_x_fill = 0.2;     tree_node_y_fill = 0.12
tree_node_min_sx = 0;       tree_node_min_sx = 0
tree_edge_label_add = 0.05; tree_edge_label_dy = 0.1

sub set_tree_node_dxdy dx dy
   tree_node_dx = dx
   tree_node_dy = dy
end sub

sub set_tree_node_fill dx dy
   tree_node_x_fill = dx
   tree_node_y_fill = dy
end sub

sub set_tree_node_min_size sx sy
   tree_node_min_sx = sx
   tree_node_min_sy = sy
end sub

sub set_tree_hei nodehei leafhei labelhei
   tree_edge_label_hei = labelhei
   tree_node_hei = nodehei
   tree_leaf_hei = leafhei
end sub

sub set_tree_edge_label_add_dy add dy
   tree_edge_label_add = add
   tree_edge_label_dy = dy
end sub

sub set_leaf_ellipse_size_str str$
   set hei tree_leaf_hei
   set_ellipse_size_str str$
end sub

sub texortext str$ name$ delta hi
   set hei hi
   if name$ = "" then
      if shape_use_tex = 0 then
          write str$
      else
          tex str$
      end if
   else
      if shape_use_tex = 0 then
          begin box name name$ add delta nobox
             write str$
          end box
      else
          tex str$ name name$ add delta
      end if
   end if
end sub

sub drawcliparc x0l x1l y0l x0b x1b
   begin clip
      begin path clip
         amove x0b y0l-tree_node_dy
         box x1b-x0b tree_node_dy fill clear
!         amove x0b pointy(ch.bl)
!         box x1b-x0b height(ch) fill clear reverse
         amove pointx(ch.bl) pointy(ch.bl)
         box width(ch) height(ch) fill clear reverse
      end path
      amove x0l y0l
      aline x1l y0l-tree_node_dy
   end clip
end sub

sub draw_edge_label x1 y1 x2 y2 label$
   amove (x1+x2)/2-tree_edge_label_dy*(x2-x1)/(y2-y1) (y1+y2)/2-tree_edge_label_dy
   texortext label$ "ch" tree_edge_label_add tree_edge_label_hei
end sub

sub def_binary_node label$ llab$ rlab$ ltree$ rtree$ name$
   begin object name$
      set just tc hei tree_node_hei
      local nodehi = theight(label$)+2*tree_node_y_fill
      if nodehi < tree_node_min_sy then
         nodehi = tree_node_min_sy
      end if
      amove 0 -tree_node_y_fill
      local xleft = -twidth(label$)/2-tree_node_x_fill
      local xright = twidth(label$)/2+tree_node_x_fill
      local addx = tree_node_min_sx-(xright-xleft)
      if addx > 0 then
         xleft = xleft - addx/2
         xright = xright + addx/2
      end if
      amove xleft 0
      box xright-xleft nodehi
      set just cc
      amove 0 nodehi/2
      texortext label$ "lab" 0 tree_node_hei
      local wd1 = width("o_"+ltree$)
      local wd2 = width("o_"+rtree$)
      local totwd = wd1/2+wd2/2+tree_node_dx
      set just center
      draw_edge_label -totwd/2 -tree_node_dy 0 0 llab$
      drawcliparc 0 -totwd/2 0 -totwd/2 0
      draw_edge_label totwd/2 -tree_node_dy 0 0 rlab$
      drawcliparc 0 totwd/2 0 0 totwd/2
      amove -totwd/2 -tree_node_dy
      draw ltree$+".tc"
      amove +totwd/2 -tree_node_dy
      draw rtree$+".tc"
   end object
end sub

sub def_tertiary_node label$ llab$ mlab$ rlab$ ltree$ mtree$ rtree$ name$
   begin object name$
      set just tc hei tree_node_hei
      local nodehi = theight(label$)+2*tree_node_y_fill
      if nodehi < tree_node_min_sy then
         nodehi = tree_node_min_sy
      end if
      amove 0 -tree_node_y_fill
      local xleft = -twidth(label$)/2-tree_node_x_fill
      local xright = twidth(label$)/2+tree_node_x_fill
      local addx = tree_node_min_sx-(xright-xleft)
      if addx > 0 then
         xleft = xleft - addx/2
         xright = xright + addx/2
      end if
      amove xleft 0
      box xright-xleft nodehi
      set just cc
      amove 0 nodehi/2
      texortext label$ "lab" 0 tree_node_hei
      local wd1 = width("o_"+ltree$)
      local wdm = width("o_"+mtree$)
      local wd2 = width("o_"+rtree$)
      set just center
      draw_edge_label -(wd1+wdm)/2-tree_node_dx -tree_node_dy 0 0 llab$
      drawcliparc 0 -(wd1+wdm)/2-tree_node_dx ybot -(wd1+wdm)/2-tree_node_dx 0
      draw_edge_label 0 -tree_node_dy 0 0 mlab$
      drawcliparc 0 0 ybot -tree_node_dx/2 tree_node_dx/2
      draw_edge_label (wd2+wdm)/2+tree_node_dx -tree_node_dy 0 0 rlab$
      drawcliparc 0 (wd2+wdm)/2+tree_node_dx ybot 0 (wd2+wdm)/2+tree_node_dx
      amove -(wd1+wdm)/2-tree_node_dx ybot-tree_node_dy
      draw ltree$+".tc"
      amove (wd1+wdm)/2+tree_node_dx ybot-tree_node_dy
      draw rtree$+".tc"
      amove 0 ybot-tree_node_dy
      draw mtree$+".tc"
   end object
end sub

sub def_leaf_ellipse str$ name$
   local c = ellipse_c
   begin object name$
      set_ellipse_c c
      set hei tree_leaf_hei
      ellipse_text 0 0 str$ name$
   end object
end sub