Le langage Pascal

PROGRAM puissances (input, output);
VAR 
  n, max : integer;
BEGIN
  writeln('Nombre maxi ? ');
  readln(max);
  n := 2;
  while n <= max do begin
    writeln(n);
    n := n * 2
  end;
  writeln('C''est fini')
END.

PROGRAM jeu (input, output);
VAR
  choix, rep, nb : integer;
BEGIN
  nb := 0;
  choix := random(11);
  repeat
    nb := nb + 1;
    writeln('Choix ndeg. ',nb,' ? ');
    readln(rep)
  until rep = choix;
  writeln('Trouvé en ',nb,' coups')
END.

PROGRAM moyenne (input, output);
VAR
  n, i : integer;
  note, total, moyenne : real;
BEGIN
  writeln('Nombre notes à entrer ?');
  readln(n);
  total := 0;
  for i := 1 to n do begin
    writeln(i,'ième note ? ');
    readln(note);
    total := total + note
  end;
  moyenne := total / n;
  writeln('La moyenne est : ',moyenne)
END.

PROGRAM jeu_ameliore (input, output);
VAR
  choix, rep, nb : integer;
BEGIN
  nb := 0;
  choix := random(11);
  repeat
    nb := nb + 1;
    writeln('Choix ndeg. ',nb,' ? ');
    readln(rep);
    if rep < choix then
      writeln('c''est plus')
    else if rep > choix then
      writeln('c''est moins')
  { le 2ème if empêche d'écrire si juste }
  until rep = choix;
  writeln('Juste en ',nb,' coups')
END.

PROGRAM calculatrice (input, output);
VAR
  val1, val2, resultat : real;
  operation : char;
BEGIN
  writeln('Première valeur ?');
  readln(val1);
  writeln('Opération (+ - * /) ? ');
  readln(operation)
  writeln('Deuxième valeur ? ');
  readln(val2);
  case operation of
    '+' : resultat := val1 + val2;
    '-' : resultat := val1 - val2;
    '*' : resultat := val1 * val2;
    '/' : resultat :=v al1 / val2
  end;
  writeln('Résultat : ',resultat)
END.

PROGRAM moyenne (input,output);
VAR
  n, compteur : integer;
  somme, moy, ecart : real;
  note : array [1..100] of real;
BEGIN
  repeat
    writeln('nb notes (100 maxi)?');
    readln(n)
  until (n > 0) and (n <= 100);
  {entrée notes et calcul de la somme}
  somme := 0;
  for compteur := 1 to n do
    begin
      writeln(compteur,'è note ?');
      readln(note[compteur]);
      somme := somme + note[compteur]
    end;
  {calcul et affichage de la moyenne}
  moy := somme / n;
  writeln('Moyenne : ',moy);
  {calcul et affichage des écarts}
  writeln('Ecarts :');
  for compteur := 1 to n do
    begin
      ecart := note[compteur] - moy;
      writeln(compteur,'ième note (',note[compteur],') : écart : ',ecart)
    end
END.

PROGRAM rotation (input,output);
VAR
  index, n : integer;
  prem : real;
  tableau : array [1..100] of real;
BEGIN
  repeat
    writeln('Nb valeurs (100 maxi) ?');
    readln(n)
  until (n > 0) and (n <= 100);
  { entrée des valeurs }
  for index := 1 to n do
    begin
      writeln(index,'ième valeur ?');
      readln(tableau[index]);
    end;
  writeln('On décale vers le haut');
  prem := tableau[1]; { ne pas écraser ! }
  for index := 2 to n do
    tableau[index - 1] := tableau[index];
  tableau[n] := prem;
  for index := 1 to n do
    writeln(tableau[index]);
  writeln('on re-décale vers le bas');
  prem := tableau[n];
  for index := n downto 2 do
    tableau[index] := tableau[index - 1];
  tableau[1] := prem;
  for index := 1 to n do
    writeln(tableau[index])
END.

PROGRAM classer (input,output);
VAR
  n, i, index, petit, indexpetit : integer;
  avant, apres : array [1..100] of integer;
  pris : array [1..100] of boolean; 
     { pour noter ceux déjà pris }
BEGIN
  repeat
    writeln('Nb valeurs (100 maxi) ?');
    readln(n)
  until (n > 0) and (n <= 100);
  { entrée valeurs - initialisation de pris }
  for index := 1 to n do 
    begin
      writeln(index,'ième valeur ? ');
      readln(avant[index]);
      pris[index] := false
    end;
  { ordre croissant,on cherche N valeurs }
  for i := 1 to n do
    begin
      petit := maxint; { plus grand possible }
      { recherche du plus petit non pris }
      for index := 1 to n do
        if (not pris[index]) and (avant[index] <= petit) then
          begin
            petit := avant[index];
            indexpetit := index
          end;
      { sauvegarde dans le tableau APRES et mise à jour de PRIS }
      apres[i] := petit;
      pris[indexpetit] := true
    end; { passage au prochain i }
  { affichage du tableau APRES }
  writeln('Par ordre croissant : ');
  for i := 1 to N do writeln(apres[i]);
  { classement par ordre décroissant }
  writeln('Par ordre décroissant : ');
  for i := n downto 1 do writeln(apres[i])
  { n'auriez-vous pas tout refait ? }
END.

PROGRAM position (input,output);
VAR
  ch, sch : string [255];
  i, j, n, l, ls : integer;
BEGIN
  writeln('Chaîne à tester ? ');
  readln(ch);
  writeln('Sous-chaîne à trouver ?');
  readln(sch);
  l := length(ch);
  ls := length(sch);
  n := 0;
  for i := 1 to l - ls do
    begin
      j := 1;
      while (j <= l) and (ch[i + j - 1] = sch[j]) do
        j := j + 1;
      if j > ls then
        begin
          writeln('Trouvé position ',i);
          n := n + 1
        end
    end;
  writeln(n,' fois ',sch,' dans ',ch)
END.

PROGRAM produit_mat (input,output);
VAR
  m1, m2, m3 : array [1..10,1..10] of real;
  l, m, n, jl, jm, jn : integer;
BEGIN
  writeln('Nb lignes 1ère matrice ?');
  readln(m);
  writeln('Nb colonnes 1è matrice ?');
  readln(l);
  writeln('Nb colonnes 2è matrice ?');
  readln(n);
  { entrée de m1 }
  writeln('Première matrice');
  for jm := 1 to m do
    for jl := 1 to l do
      begin
        writeln('lig',jm,', col',jl,'?');
        readln(m1[jm,jl])
      end;
  { entrée de m2 }
  writeln('2ième matrice');
  for jl := 1 to l do
    for jn := 1 to n do
      begin
        writeln('lig',jl,', col',jn,'?');
        readln(m2[jl,jn])
      end;
  { calcul du produit }
  for jm := 1 to m do
    for jn := 1 to n do
      begin {calcul composante m,n de m2}
        m3[jm,jn] := 0;
        for jl := 1 to l do
          m3[jm,jn] := m3[jm,jn] + (m1[jm,jl] * m2[jl,jn]);
      end;
  { affichage du résultat }
  writeln('Résultat');
  for jm := 1 to m do
    for jn := 1 to n do
      writeln('m[',jm,',',jn,']=',m3[jm,jn])
END.

PROGRAM annuaire (input,output);
{ version simplifiée }
TYPE
  ligne = string [40];
  typepersonne = record
                   nom : ligne;
                   num_tel : ligne
                   { integer malheureusement < 32635 }
                 end;
VAR
  pers : array [1..100] of typepersonne;
  nb, i : 1..100;
  rep : char;
  imprimer : boolean;
  texte : ligne;
BEGIN
  { on suppose avoir ici les instructions permettant de lire sur fichier disque NB et le tableau PERS }
  repeat
    writeln('Recherche suivant : ');
    writeln(' N : nom');
    writeln(' T : numéro téléphone');
    writeln(' Q : quitter le prog');
    writeln('Quel est votre choix ?');
    readln(rep);
    if rep <> 'Q' then begin
      writeln('Texte à chercher ? ');
      readln(texte)
      for i := 1 to nb do with pers[i] do
        begin
          case rep of
            'N' : imprimer := nom = texte;
            'T' : imprimer := num_tel = texte;
          end;
          if imprimer then begin
            writeln('Nom  : ',nom);
            writeln('Tel  : ',num_tel)
          end
        end
    end
  until rep = 'Q'
END.

PROGRAM determ (input,output);
{ on se limite à 10x10, ce qui fait 7h de calcul et 6.235.314 appels à DETN }

TYPE
  tmat = array [1..10,1..10] of real;

VAR
  dim : integer; { dimension matrice à calculer }
  det : real;    { résultat désiré }
  mat : tmat;    { matrice à calculer }
  appel : real;  { nb d'appels }

procedure entree;
var lig, col : integer;
begin
  writeln('Dimension de la matrice ?');
  readln(dim); { DIM variable globale }
  writeln('Entrez les composantes :');
  for lig := 1 to dim do begin
    writeln('pour la ligne ndeg. ',lig);
    for col := 1 to dim do begin
      writeln('colonne  ',col,' ?');
      readln(mat[lig,col])
    end
  end
end;

procedure sous_mat (mdeb : tmat; var mfin : tmat; ind, dim : integer);
{ on supprime la colonne 1 et la ligne ind pour avoir la s/mat de dim-1 }
var col, lig, l : integer;
begin
  l := 0;
  for lig := 1 to dim do begin
    if lig <> ind then begin
       l := l + 1;
       for col := 2 to dim do
         mfin[l,col - 1] := mdeb[lig,col]
    end
  end
end;

function detn (m : tmat; d : integer) : real;
{ dét ordre d en fonction ordre d-1 }
var result : real;
    mprim : tmat; { matrice intermédiaire }
    lig, signe : integer;
begin
  appel := appel + 1;
  if d = 1 then detn := m[1,1]
     { fin de récursivité }
  else begin
    result := 0;
    signe := -1;
    for lig := 1 to d do begin
      sous_mat(m,mprim,lig,d);
      signe := -signe;
      { changer de signe à chaque ligne }
      result := result + (signe * m[lig,1] * detn(mprim,d - 1))
    end;
    detn := result
  end
end;

BEGIN { programme principal }
  entree;
  appel := 0;
  det := detn(mat,dim);
  writeln('résultat : ',det);
  writeln('nb appels DETN : ',appel)
END.

procedure lirefic;
var i : 1..100;
    f : file of typepersonne;
{ variables globales : NB et le tableau PERS }
begin
  assign(f,'annuaire'); {non standard}
  reset(f);
  nb := 0;
  while not EOF(f) do begin
    nb := nb+1;
    read(f,pers[nb)
  end;
  close(f)
end;
{à vous de faire la suite}

PROGRAM liste(input,output);

TYPE
  tpoint = ^tval;
  tval = record
           valeur : integer;
           suivant : tpoint
         end;
VAR
  prem : tpoint; { variable globale }
  n:integer;
  c:char;

procedure lire;
{ modifie N et PREM }
var precedent, point : tpoint;
    i : integer;
begin
  write('Combien d''éléments?');
  readln(n);
  new(prem);
  write('1ère valeur ? ');
  readln(prem^.valeur);
  precedent := prem;
  for i := 2 to n do begin
    new(point);
    write(i,'ième valeur ? ');
    readln(point^.valeur);
    precedent^.suivant := point;
    precedent := point
  end;
  precedent^.suivant := NIL
  { le dernier ne pointe sur rien }
end;

procedure afficher;
var point : tpoint;
    i : integer;
begin
  point := prem;
  for i := 1 to n do begin
    writeln(point^.valeur);
    point := point^.suivant
  end
end;

procedure supprimer;
var point, prec : tpoint;
    rep : char;
begin
  point := prem;
  repeat
    write(point^.valeur,' à ôter ?');
    readln(rep);
    if rep = 'O' then begin
      n := n-1;
      if point <> prem then begin
        prec^.suivant := point^.suivant;
        dispose(point);
        point := prec^.suivant
        { se préparer pour la suite }
      end
      else begin
        prem := prem^.suivant;
        dispose(point);
        { ancien premier }
        point := prem
      end
    end
    else begin
      { pointer sur le suivant }
      prec := point;
      point := point^.suivant
    end
  until point = nil
end;

procedure rajouter;
var p1, p2, prec : tpoint;
    rep : char;
begin
  p1 := prem;
  repeat
    write(p1^.valeur,'Rajouter un élément avant (O/N) ? ');
    readln(rep);
    if rep = 'O' then begin
      n := n + 1;
      if p1 <> prem then begin
        new(p2);
        write('Valeur ? ');
        readln(p2^.valeur);
        prec^.suivant := p2;
        p2^.suivant := p1;
        prec := p2;
      end
      else begin
        new(p1);
        write('Valeur ? ');
        readln(p1^.valeur);
        p1^.suivant := prem;
        prem := p1
      end
    end
    else begin
      { pointer sur le suivant }
      prec := p1;
      p1 := p1^.suivant
    end
  until p1=nil;
  p1 := prec;
  repeat
    write('Ajouter un élément en fin de liste (O/N) ? ');
    readln(rep);
    if rep = 'O' then begin
      n := n + 1;
      new(p2);
      write('Valeur ? ');
      readln(p2^.valeur);
      p1^.suivant := p2;
      p2^.suivant := nil;
      p1 := p2
    end
    until rep<>'O'
  end;

BEGIN { programme principal }
  lire;
  repeat
    writeln('A:afficher, S:supprimer R:rajouter, F:fin');
    write('Votre choix ? ');
    readln(c);
    case c of
      'A' : afficher;
      'S' : supprimer;
      'R' : rajouter
    end
  until c = 'F'
END.