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: