! Subroutines to draw various shapes

shape_use_tex  = 0
shape_color_1$ = clear
shape_color_2$ = clear
shadow_color$  = "gray10"

shape_dx = 0.1
shape_dy = 0.1

sub set_shape_use_tex use
   shape_use_tex = use
end sub

sub set_shape_color color$
   ! Set the primary filling color for the shapes
   shape_color_1$ = color$
end sub

sub set_shape_color_2 color$
   ! Set the secondary filling color for the shapes
   shape_color_2$ = color$
end sub

sub set_shadow_color color$
   ! Set the color of the shadow
   shadow_color$ = color$
end sub

sub set_shape_dxdy dx dy
   ! Set the internal gap of a shape (for shapes containing text)
   shape_dx = dx
   shape_dy = dy
end sub

sub line_label x1 y1 x2 y2 str$ dist
   ! Draw a label at the center of an imaginary line from (x1,y1) to (x2,y2)
   ! (x1,y1): starting point of the line
   ! (x2,y2): ending point of the line
   ! str$: label to draw
   ! dist: distance between label and line
   if dist > 0 then set just bc
   else set just tc
   amove (x1+x2)/2 (y1+y2)/2
   begin rotate xy2angle(x2-x1,y2-y1)
      rmove 0 dist
      write str$
   end rotate
end sub

sub accolade x1 y1 x2 y2 r
   ! Draw an accolade from (x1,y1) to (x2,y2) with radius r
   ! To draw the accolade on the "other side" of the line, swap (x1,y1) and (x2,y2)
   local xm = (x1+x2)/2
   local ym = (y1+y2)/2
   wd = sqrt((xm-x1)^2+(ym-y1)^2)
   amove xm ym
   begin rotate xy2angle(x2-x1,y2-y1)
      rmove -wd+r 0
      begin path stroke
         arc r 90 180
         rmove 0 r
         rline wd-2*r 0
         rsetpos 0 r
         arc r 270 0
         rsetpos 2*r 0
         arc r 180 270
         rmove 0 -r
         rline wd-2*r 0
         rsetpos 0 -r
         narc r 90 0
      end path
   end rotate
end sub

sub named_hexagon x y h n1$ n2$
   ! Draw a named hexagon
   ! x, y: the center point of the hexagon
   ! h: half of the hexagon's height
   ! n1$ name for the surrounding box
   ! n2$ name for the internal box 
   dx=h*cos(torad(30))
   dy=h*sin(torad(30))
   amove x-dx y+h/2
   begin path stroke fill shape_color_1$
      aline x-dx y-h/2
      aline x y-h/2-dy
      aline x+dx y-h/2
      aline x+dx y+h/2
      aline x y+h/2+dy
      aline x-dx y+h/2
      closepath
   end path
   amove x-dx y-h/2-dy
   box 2*dx h+2*dy nobox name n1$
   amove x-dx y-h/2
   box 2*dx h nobox name n2$
end sub

sub hexagon x y h
   ! Draw a hexagon
   ! x, y: the center point of the hexagon
   ! h: half of the hexagon's height
   named_hexagon x y h "none" "none"
end sub

sub disk wd hi ellh
   ! Draw a disk
   ! wd: disk width
   ! hi: disk height
   ! ellh: height of top ellipse
   set join round
   local crx = xpos()
   local cry = ypos()
   amove crx cry+hi/2-ellh
   begin path stroke fill shape_color_1$
      elliptical_narc wd/2 ellh 0 180
      aline crx-wd/2 cry-hi/2+ellh
      asetpos crx cry-hi/2+ellh
      elliptical_arc wd/2 ellh 180 0
      closepath
   end path
   amove crx cry+hi/2-ellh
   begin path stroke fill shape_color_2$
      elliptical_arc wd/2 ellh 0 180
      asetpos crx cry+hi/2-ellh
      elliptical_arc wd/2 ellh 180 0
      closepath
   end path
   amove crx cry
end sub

sub textdisk str$ wd hi ellh txtd
   ! Draw a disk
   ! str$: text to write
   ! wd: disk width
   ! hi: disk height
   ! ellh: height of top ellipse
   ! txtd: offset for text (normally 0)
   disk wd hi ellh
   set just cc
   rmove 0 txtd-ellh
   write str$
end sub

sub updn_arrow wd hi angle
   ! Draw an up/down arrow
   ! wd: width of the arrow
   ! hi: height of the arrow
   ! angle: rotation angle
   local xp = xpos()
   local yp = ypos()
   begin rotate angle
      amove xp yp-hi/2
      begin path stroke fill shape_color_1$
         aline wd/2+xp yp-hi/6
         aline wd/4+xp yp-hi/6
         aline wd/4+xp yp+hi/6
         aline wd/2+xp yp+hi/6
         aline xp      yp+hi/2
         aline xp-wd/2 yp+hi/6
         aline xp-wd/4 yp+hi/6
         aline xp-wd/4 yp-hi/6
         aline xp-wd/2 yp-hi/6
         closepath
      end path
   end rotate
end sub

sub left_arrow wd hi angle
   ! Draw a left facing arrow
   ! wd: width of the arrow
   ! hi: height of the arrow
   ! angle: rotation angle
   local xp = xpos()
   local yp = ypos()
   begin rotate angle
      amove xp-wd/2 yp   
      begin path stroke fill shape_color_1$
         aline xp      yp-hi/2
         aline xp      yp-hi/4
         aline xp+wd/2 yp-hi/4
         aline xp+wd/2 yp+hi/4
         aline xp      yp+hi/4
         aline xp      yp+hi/2
         closepath
      end path
   end rotate
end sub

sub rhomb wd hi
   ! Draw a rhomb
   ! wd: width of the rhomb
   ! hi: height of the rhomb
   local xp = xpos()
   local yp = ypos()
   amove xp yp+hi/2
   begin path stroke fill shape_color_1$
      aline xp-wd/2 yp
      aline xp      yp-hi/2
      aline xp+wd/2 yp
      closepath
   end path
end sub

sub rootnode xp yp wd hi name$
   amove xp-wd/2 yp-hi
   box wd hi name name$ fill shape_color_1$
end sub

sub drawnode wd hi name$ type
   if type = 0 then
      amove xpos()-wd/2 ypos()-hi
      box wd hi name name$ fill shape_color_1$
   else
      amove xpos()-wd/2 ypos()-hi
      box wd hi name name$ nobox
      rmove wd/2 hi/2
      ellipse wd/2 hi/2 fill shape_color_2$
   end if
end sub

sub binchilds par$ wd hi ydel xdel l1 l2
   amove pointx(par$+".bc")-xdel pointy(par$+".bc")-ydel
   drawnode wd hi par$+"1" l1
   amove pointx(par$+".bc")+xdel pointy(par$+".bc")-ydel
   drawnode wd hi par$+"2" l2
   join par$+".bc" - par$+"1.tc"
   join par$+".bc" - par$+"2.tc"
end sub

sub r_tree wd hi wdfac hifac
   ! Draw a small tree (with right subtree)
   ! wd: width of the tree
   ! hi: height of the tree
   ! wdfac: proportion of width = width of node
   ! hifac: proportion of height = height of node
   local nodewd = wd*wdfac
   local nodehi = hi*hifac
   local yoffs = (hi-3*nodehi)/2
   local xoffs = (wd-nodewd)/3
   rootnode xpos()-wd/2+nodewd/2+xoffs ypos()+hi/2 nodewd nodehi "t"
   binchilds "t" nodewd nodehi yoffs xoffs 1 0
   binchilds "t2" nodewd nodehi yoffs xoffs 1 1
end sub

sub l_tree wd hi wdfac hifac
   ! Draw a small tree (with left subtree)
   ! wd: width of the tree
   ! hi: height of the tree
   ! wdfac: proportion of width = width of node
   ! hifac: proportion of height = height of node
   local nodewd = wd*wdfac
   local nodehi = hi*hifac
   local yoffs = (hi-3*nodehi)/2
   local xoffs = (wd-nodewd)/3
   rootnode xpos()-wd/2+nodewd/2+2*xoffs ypos()+hi/2 nodewd nodehi "t"
   binchilds "t" nodewd nodehi yoffs xoffs 0 1
   binchilds "t1" nodewd nodehi yoffs xoffs 1 1
end sub

sub cross d
   ! Draw a cross "+" at current position
   ! d: the size of the cross
   gsave
   set color red
   rmove -d/2  0
   rline  d    0
   rmove -d/2 -d/2
   rline  0    d
   grestore
end sub

sub shadow_box obj$ margin shadow
   local xp = xpos()
   local yp = ypos()
   local wd = width("o_"+obj$)
   local hi = height("o_"+obj$)
   begin path fill shadow_color$
      amove xp+shadow-margin yp-hi
      aline xp+wd yp-hi
      aline xp+wd yp+margin-shadow
      aline xp+wd+margin+shadow yp+margin-shadow
      aline xp+wd+margin+shadow yp-hi-margin-shadow
      aline xp+shadow-margin yp-hi-margin-shadow
      closepath
   end path
   amove xp-margin yp-hi-margin
   box wd+2*margin hi+2*margin fill white
   amove xp yp
   draw obj$+".tl"
end sub

sub pmove d a
   amove xpos()+d*cos(torad(a)) ypos()+d*sin(torad(a))
end sub

sub set_angle_just angle
   if angle = 0 then
      set just lc
   else if angle = 90 then
      set just bc
   else if angle = 180 then
      set just rc
   else if angle = -90 then
      set just tc
   else if (angle > 0) and (angle < 90) then
      set just bl
   else if (angle > 90) and (angle < 180) then
      set just br
   else if (angle > -90) and (angle < 0) then
      set just tl
   else
      set just tr
   end if
end sub

sub labeled_circle label$ radius lradius langle name$ lcolor$
   default lradius 0.1
   default langle  90
   default name    "n"
   default lcolor  black
   gsave
   begin name name$
      circle radius
   end name
   set color lcolor$	
   pmove radius+lradius langle
   set_angle_just langle
   tex label$	
   grestore
end sub