! 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
|