VAR largeur : integer ;
chiffre : char ;

PROCEDURE saisir ;
Begin
repeat
write('Largeur du dessin (3 … 12) ? ') ; readln(largeur) ;
until (largeur>=3) and (largeur<=12) ;
repeat
writeln('Chiffre … dessiner (caractŠre de 0 … 9) ? ') ;
readln(chiffre) ;
until (chiffre>='0') and (chiffre<='9') ;
End ;

PROCEDURE debutligne(c : char ; L : integer) ;
Var i : integer ;
Begin
write(c) ;
for i:=1 to L do write(' ') ;
writeln ;
End ;

PROCEDURE finligne(c : char ; L : integer) ;
Var i : integer ;
Begin
for i:=1 to L-1 do write(' ') ;
writeln(c) ;
End ;

PROCEDURE bordures(c : char ; L : integer) ;
Var i : integer ;
Begin
write(c) ;
for i:=2 to L-1 do write(' ') ;
writeln(c) ;
End ;

PROCEDURE pleineligne(c : char ; L : integer) ;
Var i : integer ;
Begin
for i:=1 to L do write(c) ;
writeln ;
end ;

PROCEDURE dessiner(c : char ; L : integer) ;
Var i : integer ;
Begin
case c of
'0' : begin
pleineligne(c,L) ;
for i:=1 to 2*L-3 do bordures(c,L) ;
pleineligne(c,L) ;
end ;
'1' : for i:=1 to 2*L-1 do debutligne(c,L) ;
'2' : begin
pleineligne(c,L) ;
for i:=1 to L-2 do finligne(c,L) ;
pleineligne(c,L) ;
for i:=1 to L-2 do debutligne(c,L) ;
pleineligne(c,L) ;
end ;
'3' : begin
pleineligne(c,L) ;
for i:=1 to L-2 do finligne(c,L) ;
pleineligne(c,L) ;
for i:=1 to L-2 do finligne(c,L) ;
pleineligne(c,L) ;
end ;
'4' : begin
for i:=1 to L-1 do bordures(c,L) ;
pleineligne(c,L) ;
for i:=1 to L-1 do finligne(c,L) ;
end ;
'5' : begin
pleineligne(c,L) ;
for i:=1 to L-2 do debutligne(c,L) ;
pleineligne(c,L) ;
for i:=1 to L-2 do finligne(c,L) ;
pleineligne(c,L) ;
end ;
'6' : begin
for i:=1 to L-1 do debutligne(c,L) ;
pleineligne(c,L) ;
for i:=1 to L-2 do bordures(c,L) ;
pleineligne(c,L) ;
end ;
'7' : begin
pleineligne(c,L) ;
for i:=1 to 2*L-2 do finligne(c,L) ;
end ;
'8' : begin
pleineligne(c,L) ;
for i:=1 to L-2 do bordures(c,L) ;
pleineligne(c,L) ;
for i:=1 to L-2 do bordures(c,L) ;
pleineligne(c,L) ;
end ;
'9' : begin
pleineligne(c,L) ;
for i:=1 to L-2 do bordures(c,L) ;
pleineligne(c,L) ;
for i:=1 to L-1 do finligne(c,L) ;
end ;
end ;
End ;

FUNCTION terminer : boolean ;
Var s : string ;
Begin
writeln ;
write('on continue ? (oui/non) ') ;
readln(s) ;
terminer:=( (s<>'oui') and (s<>'OUI') and (s<>'o') and (s<>'O') ) ;
End ;

BEGIN
clrscr ;
repeat
saisir ;
clrscr ;
dessiner(chiffre, largeur) ;
until terminer ;
END.

(********************)