---

Une solution de l'exercice 3 du TP4 d'informatique en DEUG MIAS+MASS S1

---

Une version avec sous-programmes

PROGRAM TP4exc3 ;
(* USES crt ; *)

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.

---