{*******************************************************************************
*                                                                              *
*  Simulationsprogramm fuer einen extrem redundanzarmen Textcodierer (Teil 5)  *
*                                                                              *
********************************************************************************
*                                                                              *
*  Verfasser : Dipl.-Ing. Jochen Meyer   Adresse : TH Darmstadt                *
*  Telefon   : 0 61 51 / 16 - 36 66                Institut fuer Datentechnik  *
*  Programm  : Deco                                Merckstr. 25                *
*  Datum     : 08.07.1988                          D-6100 Darmstadt            *
*                                                                              *
*******************************************************************************}

program deco(input, output, codefile, decofile) ;

  const
    netzfilename = 'USRDSK2:[D93F]5_NETZ_??.' ;
    textfilename = '   WORK:[D93F]7_DECO_??.' ;

    zelle_max_index = 65535 ; { = (verbindungen_max + 2)^2 - 1 }
    elementmax      =  1279 ; { 20 Bloecke mit elementtyp }

  type
    filenamentyp = packed array[1..24] of char ;

    elementzeiger = ^elementtyp ;

    elementtyp = record
                   zahl   : integer ;
                   zeiger : elementzeiger ;
                 end ;

    zellentyp = record
                  inhalt,
                  verbindung : elementzeiger ;
                end ;

    datentyp = record
                 zellenanzahl,
                 verbindungen_max,
                 zeichen,
                 woerter,
                 codeworte,
                 decoworte,
                 fehlende_verbindungen,
                 fehlende_zellen,
                 zu_lange_codeworte     : integer ;
               end ;

  var
    codefile, decofile : file of integer ;
    zelle              : array[0..zelle_max_index] of zellentyp ;
    daten              : datentyp ;
    start, ziel, ebene : integer ;

  function filename(name : filenamentyp ; ebene : integer) : filenamentyp ;

    begin
      name[22] := chr(ebene div 10 + 48) ;
      name[23] := chr(ebene mod 10 + 48) ;
      filename := name ;
    end ;

  procedure lies_netz(ebene : integer) ;

    var
      freies_element : elementzeiger ;

    procedure loesche_daten ;

      begin
        with daten do
          begin
            zellenanzahl          := 0 ;
            fehlende_verbindungen := 0 ;
            fehlende_zellen       := 0 ;
            zu_lange_codeworte    := 0 ;
          end ;
        freies_element := nil ;
      end ;

    procedure lies_zelle(var zell : zellentyp) ;

      const
        trennsymbol = maxint ;

      var
        zeig : elementzeiger ;
        code : integer ;

      procedure neues_element(var neu : elementzeiger) ;

        type
          elementarray = [volatile] array[1..elementmax] of elementtyp ;

        var
          element : ^elementarray ;
          i       : integer ;

        begin
          if (freies_element = nil)
            then
              begin
                new(element) ;
                freies_element := address(element^[1]) ;
                for i := 1 to (elementmax - 1) do
                  element^[i].zeiger := address(element^[i + 1]) ;
                element^[elementmax].zeiger := nil ;
              end ;
          neu            := freies_element ;
          freies_element := neu^.zeiger ;
        end ;

      begin
        with zell do
          begin
            inhalt     := nil ;
            verbindung := nil ;
            read(codefile, code) ;
            while (code <> trennsymbol) do
              begin
                case (inhalt = nil) of
                  true  : begin
                            neues_element(inhalt) ;
                            zeig := inhalt ;
                          end ;
                  false : begin
                            neues_element(zeig^.zeiger) ;
                            zeig := zeig^.zeiger ;
                          end ;
                end ;
                zeig^.zahl := code ;
                read(codefile, code) ;
              end ;
            if (inhalt <> nil)
              then
                zeig^.zeiger := nil ;
            read(codefile, code) ;
            while (code <> trennsymbol) do
              begin
                case (verbindung = nil) of
                  true  : begin
                            neues_element(verbindung) ;
                            zeig := verbindung ;
                          end ;
                  false : begin
                            neues_element(zeig^.zeiger) ;
                            zeig := zeig^.zeiger ;
                          end ;
                end ;
                zeig^.zahl := code ;
                read(codefile, code) ;
              end ;
            case (verbindung = nil) of
              true  : verbindung   := zelle[0].verbindung ;
              false : zeig^.zeiger := zelle[0].verbindung ;
            end ;
          end ;
      end ;

    begin
      writeln('|') ;
      writeln('+------------------------------------------------------------') ;
      writeln('|') ;
      write('|  Ich lese das Netz der ', ebene: 1) ;
      writeln('-ten Ebene von Platte !') ;
      with daten do
        begin
          loesche_daten ;
          open(codefile, filename(netzfilename, ebene), history := old) ;
          reset(codefile) ;
          read(codefile, verbindungen_max) ;
          repeat
            lies_zelle(zelle[zellenanzahl]) ;
            zellenanzahl := zellenanzahl + 1 ;
          until eof(codefile) ;
          close(codefile) ;
          writeln('|  Groesse des Netzes : ', zellenanzahl: 1, ' Zellen') ;
        end ;
    end ;

  procedure decodiere_text(ebene : integer) ;

    const
      leer      = maxint - 5 ;
      ganz_leer = -leer ;

    var
      codefaktor, codepuffer, nummer, code, i : integer ;

    function lies_code(anzahl : integer) : integer ;

      var
        code1, code2, code, faktor : integer ;

      begin
        case (codepuffer = leer) of
          true  : begin
                    read(codefile, codepuffer) ;
                    code1 := codepuffer mod codefaktor ;
                  end ;
          false : begin
                    code1 := codepuffer div codefaktor ;
                    if (code1 >= codefaktor)
                      then
                        begin
                          code1 := code1 mod codefaktor ;
                          with daten do
                            zu_lange_codeworte := zu_lange_codeworte + 1 ;
                        end ;
                    case eof(codefile) of
                      false : codepuffer := leer ;
                      true  : codepuffer := ganz_leer ;
                    end ;
                    with daten do
                      codeworte := codeworte + 1 ;
                  end ;
        end ;
        case (anzahl = 1) of
          true  : lies_code := code1 ;
          false : begin
                    case (codepuffer = ganz_leer) of
                      false : code2 := lies_code(1) ;
                      true  : code2 := 0 ;
                    end ;
                    code   := 0 ;
                    faktor := 1 ;
                    while (code1 > 0) or (code2 > 0) do
                      begin
                        code   := code + faktor * (code1 mod 2) ;
                        code1  := code1 div 2 ;
                        faktor := 2 * faktor ;
                        code   := code + faktor * (code2 mod 2) ;
                        code2  := code2 div 2 ;
                        faktor := 2 * faktor ;
                      end ;
                    lies_code := code ;
                  end ;
        end ;
      end ;

    procedure schreibe_inhalt(inhalt : elementzeiger) ;

      begin
        while (inhalt <> nil) do
          begin
            write(decofile, inhalt^.zahl) ;
            inhalt := inhalt^.zeiger ;
            with daten do
              decoworte := decoworte + 1 ;
          end ;
      end ;

    procedure decodiere_nachfolger(var nummer : integer ; code : integer) ;

      var
        zeig : elementzeiger ;
        i    : integer ;

      begin
        zeig := zelle[nummer].verbindung ;
        for i := 3 to code do
          zeig := zeig^.zeiger ;
        nummer := zeig^.zahl ;
        schreibe_inhalt(zelle[nummer].inhalt) ;
      end ;

    procedure zeige_statistik ;

      var
        bits : integer ;

      begin
        with daten do
          begin
            bits := 2 * trunc(ln(codefaktor) / ln(2)) * codeworte ;
            writeln('|') ;
            case (zeichen = 0) of
              true  : writeln('|  Codelaenge : ', bits: 1, ' bit') ;
              false : begin
                        write('|  Textlaenge (Klartext) :') ;
                        writeln(zeichen: 8, '   Zeichen') ;
                        write('|  Textlaenge (Klartext) :') ;
                        writeln(woerter: 8, '   Woerter') ;
                        write('|  Codelaenge            :') ;
                        writeln(bits: 8, '   bit') ;
                        write('|  Mittlere Codelaenge   :') ;
                        case (bits > zeichen) of
                          true  : begin
                                    write((bits / zeichen): 10: 1) ;
                                    writeln(' bit pro Zeichen') ;
                                  end ;
                          false : begin
                                    write((1E3 * bits / zeichen): 10: 1) ;
                                    writeln(' Millibit pro Zeichen') ;
                                    write('|  Mittlere Codelaenge   :') ;
                                    write((zeichen / bits): 10: 1) ;
                                    writeln(' Zeichen pro bit') ;
                                  end ;
                        end ;
                        write('|  Mittlere Codelaenge   :') ;
                        case (bits > woerter) of
                          true  : begin
                                    write((bits / woerter): 10: 1) ;
                                    writeln(' bit pro Wort') ;
                                  end ;
                          false : begin
                                    write((1E3 * bits / woerter): 10: 1) ;
                                    writeln(' Millibit pro Wort') ;
                                    write('|  Mittlere Codelaenge   :') ;
                                    write((woerter / bits): 10: 1) ;
                                    writeln(' Woerter pro bit') ;
                                  end ;
                        end ;
                      end ;
            end ;
            writeln('|') ;
            write('|  ', (ebene + 1): 2, '-te Ebene :') ;
            writeln(codeworte: 8, ' Codeworte') ;
            write('|  ', ebene: 2, '-te Ebene :') ;
            writeln(decoworte: 8, ' Codeworte') ;
            if (fehlende_verbindungen > 0) or (fehlende_zellen > 0) or
               (zu_lange_codeworte > 0)
              then
                writeln('|') ;
            if (fehlende_verbindungen > 0)
              then
                begin
                  write('|  Fehlende Verbindungen :') ;
                  writeln(fehlende_verbindungen: 8) ;
                end ;
            if (fehlende_zellen > 0)
              then
                writeln('|  Fehlende Zellen       :', fehlende_zellen: 8) ;
            if (zu_lange_codeworte > 0)
              then
                writeln('|  Zu lange Codeworte    :', zu_lange_codeworte: 8) ;
            if (codeworte >= decoworte)
              then
                begin
                  writeln('|') ;
                  writeln('|  Schlechte Codierung !') ;
                end ;
          end ;
      end ;

    begin
      writeln('|') ;
      write('|  Ich decodiere den Text der ', (ebene + 1): 1) ;
      writeln('-ten Ebene !') ;
      with daten do
        begin
          codefaktor := 2 ** trunc(ln(verbindungen_max + 1.5) / ln(2) + 1) ;
          codepuffer := leer ;
          open(codefile, filename(textfilename, (ebene + 1)), history := old) ;
          open(decofile, filename(textfilename,  ebene),      history := new) ;
          reset(codefile) ;
          rewrite(decofile) ;
          read(codefile,  zeichen, woerter) ;
          write(decofile, zeichen, woerter) ;
          for i := 2 to ebene do
            begin
              read(codefile,  code) ;
              write(decofile, code) ;
            end ;
          codeworte := ebene - 1 ;
          decoworte := ebene - 1 ;
          nummer    := lies_code(2) mod zellenanzahl ;
          schreibe_inhalt(zelle[nummer].inhalt) ;
          while (codepuffer <> ganz_leer) do
            begin
              code := lies_code(1) ;
              case (code = 0) of
                true  : if (codepuffer <> ganz_leer)
                          then
                            begin
                              nummer := lies_code(2) mod zellenanzahl ;
                              schreibe_inhalt(zelle[nummer].inhalt) ;
                              fehlende_verbindungen :=
                                fehlende_verbindungen + 1 ;
                            end ;
                false : case (code = 1) of
                          true  : if (codepuffer <> ganz_leer)
                                    then
                                      begin
                                        nummer := 0 ;
                                        write(decofile, lies_code(2)) ;
                                        decoworte       := decoworte + 1 ;
                                        fehlende_zellen := fehlende_zellen + 1 ;
                                      end ;
                          false : decodiere_nachfolger(nummer, code) ;
                        end ;
              end ;
            end ;
          close(decofile) ;
          close(codefile) ;
          zeige_statistik ;
        end ;
    end ;

  begin
    writeln ;
    writeln('+------------------------------------------------------------') ;
    writeln('|') ;
    writeln('|  Extrem redundanzarmer Textcodierer (Teil 5: DECO)') ;
    writeln('|') ;
    repeat
      write('|  Welche Ebene soll ich zuerst bearbeiten ?  [23..1] ') ;
      readln(start) ;
      writeln ;
    until (start in [1..23]) ;
    repeat
      write('|  Welche Ebene soll ich zuletzt bearbeiten ? [') ;
      write(start: 2, '..1] ') ;
      readln(ziel) ;
      writeln ;
    until (ziel in [1..start]) ;
    for ebene := start downto ziel do
      begin
        lies_netz(ebene) ;
        decodiere_text(ebene) ;
      end ;
    writeln('|') ;
    writeln('+------------------------------------------------------------') ;
    writeln ;
  end .