Le code qui suit est écrit en Maple V.4. Il n'est aucunement garanti.
height:=proc(expr)
local i;
option remember;
if type(expr,{table,procedure}) then
1+max(seq(height(i),i=convert(eval(expr),set)))
elif type(expr,{name,integer})
then 0
else 1+max(seq(height(i),i=convert(expr,set)))
fi
end:
# Renvoie la largeur de l'expression.
# L'id\'ee est que l'on ins\`ere un espace d'une unit\'e entre les
# op\'erandes et sur les bords.
width:=proc(expr)
local i;
option remember;
if type(expr,{name,integer})
then length(expr)
else
max(length(op(0,expr))
,nops(expr)+1+add(width(i),i=convert(expr,set)))
fi
end:
draw_expr:=proc()
local i;
if nargs<1 then ERROR(`expected some arguments, but received nothing`)
elif nargs=1 then
draw_expr_aux1(args,'origin'=[0,0])
else
if convert([seq(type(i,string=anything),i=args[2..-1])],`and`) then
draw_expr_aux1(args)
else
ERROR(`bad specification of options, received `,args)
fi
fi
end:
draw_expr_aux1:=proc()
local expr,useroptions,nber,text,
localfont,localfontcolor,locallinecolor,localscale,localaxes,
localtree,localtextset,locallineset,localrootpoint,
rootpoint,picture;
# global LS,RP,eps;
expr:=args[1];
# traitement des options
useroptions:=[args[2..-1]];
if hasoption(useroptions,font,'localfont','useroptions') then
nber:=select(xx->type(xx,posint),localfont);
text:=select(xx->type(xx,string),localfont);
if nber=[] then
nber:=15;
if text=[] then
localfont:=[HELVETICA,BOLD,nber]
elif member(text,[[TIMES,ROMAN],
[TIMES,BOLD],
[TIMES,ITALIC],
[TIMES,BOLDITALIC],
[HELVETICA],
[HELVETICA,BOLD],
[HELVETICA,OBLIQUE],
[HELVETICA,BOLDOBLIQUE],
[COURIER],
[COURIER,BOLD],
[COURIER,OBLIQUE],
[COURIER,BOLDOBLIQUE]])
then localfont:=[op(text),nber]
else ERROR(`bad specification of font `,localfont)
fi;
else nber:=op(1,nber);
if text=[] then
localfont:=[HELVETICA,BOLD,nber]
elif member(text,[[TIMES,ROMAN],
[TIMES,BOLD],
[TIMES,ITALIC],
[TIMES,BOLDITALIC],
[HELVETICA],
[HELVETICA,BOLD],
[HELVETICA,OBLIQUE],
[HELVETICA,BOLDOBLIQUE],
[COURIER],
[COURIER,BOLD],
[COURIER,OBLIQUE],
[COURIER,BOLDOBLIQUE]])
then localfont:=[op(text),nber]
else ERROR(`bad specification of font `,localfont)
fi;
fi;
else
nber:=15;
localfont:=[HELVETICA,BOLD,nber]
fi;
if hasoption(useroptions,color,'localcolor','useroptions') then
localfontcolor:=localcolor; locallinecolor:=localcolor;
else
if not hasoption(useroptions,fontcolor,'localfontcolor','useroptions') then
localfontcolor:=BLACK
fi;
if not hasoption(useroptions,linecolor,'locallinecolor','useroptions') then
locallinecolor:=BLACK
fi;
fi;
if not hasoption(useroptions,`scale`,'localscale','useroptions') then
localscale:=[height(expr),width(expr)];
fi;
if not hasoption(useroptions,axes,'localaxes','useroptions') then
localaxes:='NONE'
fi;
if hasoption(useroptions,origin,localrootpoint,'useroptions') then
rootpoint:=localrootpoint
else
rootpoint:=[0,0]
fi;
if hasoption(useroptions,coords,localcoords,'useroptions') and
localcoords<>cartesian then
lprint(`Warning, option coords = `,localcoords,` not implemented`);
lprint(`default used, coords = cartesian`);
fi;
useroptions:=op(useroptions);
# fin du traitement des options
# construction de l'arbre associe a l'expression
if type(expr,procedure) then lprint(`procedure`) fi;
localtree:=draw_expr_aux2(rootpoint,expr);
# dessin pour les etiquettes des noeuds
localtextset:={draw_expr_aux3(localtree)};
localtextset:=map(subs(LS=localscale,RP=rootpoint,
L->[(1-LS[1])*RP[1]+LS[1]*L[1],
(1-LS[2])*RP[2]+LS[2]*L[2],
L[3]]),localtextset);
picture[text]:=plots[textplot](localtextset,
font=localfont,color=localfontcolor,
axes=localaxes,
useroptions);
# dessin des aretes de l'arbre
locallineset:={draw_expr_aux4(localtree)};
# on enleve 10% a chaque bout d'arete
locallineset:=map(subs(eps=0.9,
L->[[(1-eps)*L[1][1]+eps*L[2][1],
(1-eps)*L[1][2]+eps*L[2][2]],
[eps*L[1][1]+(1-eps)*L[2][1],
eps*L[1][2]+(1-eps)*L[2][2]]]),
locallineset);
# on tient compte de l'origine choisie et des
# echelles horizontale et verticale.
locallineset:=map(subs(LS=localscale,RP=rootpoint,
L->[[(1-LS[1])*RP[1]+LS[1]*L[1][1],
(1-LS[2])*RP[2]+LS[2]*L[1][2]],
[(1-LS[1])*RP[1]+LS[1]*L[2][1],
(1-LS[2])*RP[2]+LS[2]*L[2][2]]]),
locallineset);
picture[line]:=plot(locallineset,
color=locallinecolor,
axes=localaxes,
useroptions);
# assemblage des deux dessins
plots[display]({picture[text],picture[line]})
end:
# pour les procedures et les tables appeler des procedures particulieres
# draw_expr_aux2 prend en entr\'ee un point, c'est-\`a-dire un couple
# de numeric [x,y], et une expression expr. Il renvoie une liste L dont
# le premier \'el\'ement est [x,y,e0] o\`u e0 est l'\'etiquette de la
# racine de expr et \'eventuellement des listes de m\^eme type que L
# associ\'ees aux op\'erandes de expr.
draw_expr_aux2:=proc(point,expr)
local w,s,sw,n,i;
if nargs<2 then
RETURN([[op(1,point),op(2,point),convert('NULL',string)]]) fi;
if type(expr,{name,integer})
then
if type(expr,procedure) then
RETURN([[op(1,point),op(2,point),convert('expr',string)],
op(draw_expr_aux2(eval(expr)))])
else
RETURN([[op(1,point),op(2,point),convert(expr,string)]])
fi;
fi;
n:=nops(expr);
if n=0 then
RETURN([[op(1,point),op(2,point),convert(op(0,expr),string)],
[op(1,point),op(2,point)-1,convert('NULL',string)]])
else
w[0]:=0;
for i to n do
w[i]:=width(op(i,expr));
od;
sw:=add(w[i],i=1..n)+n+1;
# if sw>length(op(0,expr)) then #
# s[0]:=-width(expr)/2 #
# else #
s[0]:=-sw/2; #
# fi; #
for i to n do s[i]:=s[i-1]+1+(w[i-1]+w[i])/2 od;
[[op(1,point),op(2,point),convert(op(0,expr),string)],
seq(draw_expr_aux2([op(1,point)+s[i],op(2,point)-1],op(i,expr)),i=1..n)]
fi
end:
# draw_expr_aux3 prend en entree un arbre representant une expression.
# L'arbre est vu comme une liste [racine, sequence des sous-arbres].
# draw_expr_aux3 renvoie la sequence des triplets [x,y,e] ou [x,y]
# est un point et e l'etiquette a ecrire en ce point. Autrement dit
# cette procedure met simplement a plat l'arbre associe a une expression.
draw_expr_aux3:=proc(L)
local i;
if type(L,[constant,constant,string]) then L
else
[L[1][1],L[1][2],L[1][3]],
seq(op(map(draw_expr_aux3,L[i])),i=2..nops(L))
fi
end:
# draw_expr_aux4 prend en entree un arbre representant une expression.
# L'arbre est vu comme une liste [racine, sequence des sous-arbres].
# draw_expr_aux4 renvoie la sequence des aretes de l'arbre. Une arete
# est une liste de deux points [[x1,y1],[x2,y2]].
draw_expr_aux4:=proc(L)
local i;
if type(L,[constant,constant,string]) then NULL
else
seq([[L[1][1],L[1][2]],
[L[i][1][1],L[i][1][2]]],i=2..nops(L))
,seq(draw_expr_aux4(L[i]),i=2..nops(L))
fi
end: