! 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

begin object rectangle wd hi
   ! Draw a rectangle
   ! wd, hi: the width and height of the rectangle
   default wd 1
   default hi 1
   box wd hi fill shape_color_1$
end object

begin object triangle wd hi angle
   ! Draw a rectangle
   ! w, h: the width and height of the rectangle
   default wd 1
   default hi 1
   default angle 0
   begin rotate angle
      amove wd/2 hi
      begin path stroke fill shape_color_1$
         aline wd 0
         aline 0  0
         closepath
      end path
   end rotate
end object

begin object hexagon hi
   ! Draw a named hexagon
   ! x, y: the center point of the hexagon
   ! h: half of the hexagon's height
   default hi 1
   dx=hi/2*cos(torad(30))
   dy=hi/2*sin(torad(30))
   amove x y+hi/4+dy; name "p1"
   begin path stroke fill shape_color_1$
      aline x+dx y+hi/4; name "p2"
      aline x+dx y-hi/4; name "p3"
      aline x y-hi/4-dy; name "p4"
      aline x-dx y-hi/4; name "p5"
      aline x-dx y+hi/4; name "p6"
      closepath
   end path
end object

begin object rhomb wd hi
   ! Draw a rhomb
   ! wd: width of the rhomb
   ! hi: height of the rhomb
   default wd 1
   default hi 1
   amove 0 +hi/2
   begin path stroke fill shape_color_1$
      aline -wd/2 0
      aline 0     -hi/2
      aline +wd/2 0
      closepath
   end path
end object

begin object cross d
   ! Draw a cross "+" at current position
   ! d: the size of the cross
   default d 1
   rmove -d/2  0
   rline  d    0
   rmove -d/2 -d/2
   rline  0    d
end object

begin object updn_arrow wd hi angle
   ! Draw an up/down arrow
   ! wd: width of the arrow
   ! hi: height of the arrow
   ! angle: rotation angle
   default wd 1
   default hi 1
   default angle 0
   begin rotate angle
      amove 0 -hi/2
      begin path stroke fill shape_color_1$
         aline wd/2  -hi/6
         aline wd/4  -hi/6
         aline wd/4  +hi/6
         aline wd/2  +hi/6
         aline 0     +hi/2
         aline -wd/2 +hi/6
         aline -wd/4 +hi/6
         aline -wd/4 -hi/6
         aline -wd/2 -hi/6
         closepath
      end path
   end rotate
end object

begin object left_arrow wd hi angle
   ! Draw a left facing arrow
   ! wd: width of the arrow
   ! hi: height of the arrow
   ! angle: rotation angle
   default wd 1
   default hi 1
   default angle 0
   begin rotate angle
      amove -wd/2 0
      begin path stroke fill shape_color_1$
         aline 0    -hi/2
         aline 0    -hi/4
         aline wd/2 -hi/4
         aline wd/2 +hi/4
         aline 0    +hi/4
         aline 0    +hi/2
         closepath
      end path
   end rotate
end object

begin object disk wd hi eh
   ! Draw a disk
   ! wd: disk width
   ! hi: disk height
   ! eh: height of top ellipse
   default wd 1
   default hi 1
   default eh 0.15
   set join round
   amove 0 hi/2-eh
   begin path stroke fill shape_color_1$
      elliptical_narc wd/2 eh 0 180
      aline -wd/2 -hi/2+eh
      asetpos 0 -hi/2+eh
      elliptical_arc wd/2 eh 180 0
      closepath
   end path
   amove 0 hi/2-eh
   begin path stroke fill shape_color_2$
      elliptical_arc wd/2 eh 0 180
      asetpos 0 hi/2-eh
      elliptical_arc wd/2 eh 180 0
      closepath
   end path
   abound -wd/2 hi/2;  abound +wd/2 hi/2
   abound -wd/2 -hi/2; abound +wd/2 -hi/2
end object

begin object textdisk str$ wd hi eh txtd
   ! Draw a disk
   ! str$: text to write
   ! wd: disk width
   ! hi: disk height
   ! eh: height of top ellipse
   ! txtd: offset for text (normally 0)
   default wd 1
   default hi 1
   default eh 0.15
   default txtd 0
   draw disk wd hi eh
   set just cc
   rmove 0 txtd-eh
   write str$
end object

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$ c1$ c2$ wd hi ydel xdel l1 l2
   amove pointx(par$+".bc")-xdel pointy(par$+".bc")-ydel
   drawnode wd hi c1$ l1
   amove pointx(par$+".bc")+xdel pointy(par$+".bc")-ydel
   drawnode wd hi c2$ l2
   join par$+".bc" - c1$+".tc"
   join par$+".bc" - c2$+".tc"
end sub

begin object 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
   default wd 1
   default hi 1
   default wdfac 0.3
   default hifac 0.2
   local nodewd = wd*wdfac
   local nodehi = hi*hifac
   local yoffs = (hi-3*nodehi)/2
   local xoffs = (wd-nodewd)/3
   rootnode -wd/2+nodewd/2+2*xoffs hi/2 nodewd nodehi "n1"
   binchilds "n1" "n2" "l3" nodewd nodehi yoffs xoffs 0 1
   binchilds "n2" "l1" "l2" nodewd nodehi yoffs xoffs 1 1
end object

begin object 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
   default wd 1
   default hi 1
   default wdfac 0.3
   default hifac 0.2
   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 "n1"
   binchilds "n1" "l1" "n2" nodewd nodehi yoffs xoffs 1 0
   binchilds "n2" "l2" "l3" nodewd nodehi yoffs xoffs 1 1
end object

sub shadow_box obj$ margin shadow
   local xp = xpos()
   local yp = ypos()
   begin box fill white name obj$+"-box"
      draw obj$+".tl"
   end box
   local wd = width(obj$+"-box")
   local hi = height(obj$+"-box")
   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
end sub

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

sub jointo n$
   aline ptx(n$) pty(n$)
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 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
   abound x1 y1
   abound x2 y2
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