TP3/Resources/DESASS/IUTILITA.PAS

(* programme comment‚ et expliqu‚ dans le livre *)
(* LE DESASSEMBLEUR 8086 COLIBRI, publi‚ par    *)
(*           L'INSTITUT PASCAL:                 *)
(*      26 Rue Lamartine, 75009 PARIS           *)
(*           Tel: (1) 42.85.10.82               *)


  procedure stop;
    begin
      read(kbd, choix1);
    end; 

  procedure affiche_erreur(p_message: string80);
    begin
      writeln;
      write('erreur: ', p_message);
      readln;
    end; 

  function f_octet_hexadecimal(p_octet: byte): string4;
    const kt_hexa: array[0..15] of char= '0123456789ABCDEF';
    begin
      f_octet_hexadecimal:= concat(kt_hexa[p_octet div 16],
                                      kt_hexa[p_octet mod 16]);
    end; 

  function f_entier_hexadecimal(p_entier: integer): string4;
    begin
      f_entier_hexadecimal:= concat(f_octet_hexadecimal(hi(p_entier)),
                                    f_octet_hexadecimal(lo(p_entier)));
    end; 

  function f_lis_commande(p_ensemble_ok: t_set_of_char): char;
    var l_touche: char;
        l_x, l_y: integer;
    begin
      l_x:= wherex; l_y:= wherey;
      repeat
        read(kbd, l_touche);
        l_touche:= upcase(l_touche); write(l_touche);

        if not (l_touche in p_ensemble_ok)
          then gotoxy(l_x, l_y);
      until l_touche in p_ensemble_ok;
      writeln;
      f_lis_commande:= l_touche;
    end; 

  procedure lis_entier(var pv_valeur: integer);
    const k_touche_recul= #8;
          k_touche_return= #13;
    var l_indice: integer;
        l_touche: char;
        l_chaine_numerique: string[5];
    begin
      l_chaine_numerique:= '     ';

      l_indice:= 1;
      repeat
        repeat
          read(kbd, l_touche);
        until (l_touche in ['0'..'9', k_touche_recul, k_touche_return]);

        if (l_touche= k_touche_recul) and (l_indice>1)
          then begin
              l_indice:= l_indice- 1;
              write(l_touche);
            end
          else
            if (l_touche in ['0'..'9'])
                and not (l_touche= k_touche_return)
              then begin
                  write(l_touche);
                  l_chaine_numerique[l_indice]:= l_touche;
                  l_indice:= l_indice+ 1;
                end;
      until (l_touche= k_touche_return) or (l_indice> 5);
      writeln;

      pv_valeur:= 0;
      for l_indice:= 1 to l_indice- 1 do
      begin
        l_touche:= l_chaine_numerique[l_indice];
        pv_valeur:= pv_valeur* 10 + ord(l_touche)- 48;
      end;
    end; 

  procedure lis_entier_hexadecimal(p_colonne, p_ligne: integer;
                                   var pv_valeur: integer);
    const k_touche_recul= #8;
          k_touche_return= #13;
    var l_indice: integer;
        l_touche: char;
        l_chaine_numerique: string[4];
    begin
      l_chaine_numerique:= f_entier_hexadecimal(pv_valeur);

      l_indice:= 1;
      repeat
        gotoxy(p_colonne, p_ligne);
        repeat
          read(kbd, l_touche); l_touche:= upcase(l_touche);
        until (l_touche in ['0'..'9', 'A'..'F', k_touche_recul, ' ', k_touche_return]);

        if (l_touche= k_touche_recul) and (l_indice>1)
          then begin
              l_indice:= l_indice- 1;
              p_colonne:= p_colonne- 1;
            end
          else
            if (l_touche= ' ') and not (l_touche= k_touche_return)
              then begin
                  p_colonne:= p_colonne+ 1;
                  l_indice:= l_indice+ 1;
                end
              else
                if (l_touche in ['0'..'9', 'A'..'F'])
                    and not (l_touche= k_touche_return)
                  then begin
                      write(l_touche);
                      l_chaine_numerique[l_indice]:= l_touche;
                      p_colonne:= p_colonne+ 1;
                      l_indice:= l_indice+ 1;
                    end;
      until (l_touche= k_touche_return) or (l_indice> 4);

      pv_valeur:= 0;
      for l_indice:= 1 to 4 do
      begin
        l_touche:= l_chaine_numerique[l_indice];
        if l_touche<= '9'
          then pv_valeur:= pv_valeur* 16 + ord(l_touche)- 48
          else pv_valeur:= pv_valeur* 16 + ord(l_touche)- 55;
      end;
    end; 

  procedure entre_debut_fin(p_prompte: string80);
    var l_ligne: integer;
    begin
      if adresse_fin- $8000< adresse_debut- $8000
        then adresse_fin:= adresse_debut;

      write('$', f_entier_hexadecimal(adresse_debut_tampon));
      write('-$', f_entier_hexadecimal(adresse_fin_tampon), ' : ');

      l_ligne:= wherey;

      if p_prompte<> ''
        then begin
            gotoxy(29, l_ligne); write(p_prompte);
          end;

      gotoxy(15, l_ligne);
      write('[$', f_entier_hexadecimal(adresse_debut), '-');
      write('$', f_entier_hexadecimal(adresse_fin), ']');

      repeat
        lis_entier_hexadecimal(17, l_ligne, adresse_debut);
      until (adresse_debut- $8000>= adresse_debut_tampon- $8000)
           and
            (adresse_debut- $8000<= adresse_fin_tampon- $8000);
      repeat
        lis_entier_hexadecimal(23, l_ligne, adresse_fin);
      until (adresse_fin- $8000>= adresse_debut_tampon- $8000)
           and
            (adresse_fin- $8000<= adresse_fin_tampon- $8000);

      gotoxy(68, l_ligne);
    end; 

  function f_hexadecimal_octet(p_chaine: string2): byte;

    function f_hexadecimal_quartet(p_caractere: char): byte;
      begin
        if p_caractere<= '9'
          then f_hexadecimal_quartet:= ord(p_caractere)- 48
          else f_hexadecimal_quartet:= ord(p_caractere)- 55;
      end; 

    begin 
      f_hexadecimal_octet:= f_hexadecimal_quartet(p_chaine[1]) shl 4
            + f_hexadecimal_quartet(p_chaine[2]);
    end; 

  procedure lis_booleen(p_message: string80; var pv_booleen: boolean);
    begin
      write(p_message, ' Ok ? ');
      read(kbd, choix1); writeln(choix1);
      pv_booleen:= upcase(choix1)= 'O';
    end; 

  procedure affiche_booleen(p_message: string80; p_booleen: boolean);
    begin
      if p_booleen
        then write('avec ')
        else write('sans ');
      write(p_message);
    end; 

  procedure choisis_sortie;
    begin
      write('nom sortie <a:essai.txt> ? '); readln(nom_sortie);

      writeln(sortie); close(sortie);

      assign(sortie, nom_sortie); rewrite(sortie);
      writeln(sortie);
    end;