{******************************************************************************* * * * Simulationsprogramm fuer einen extrem redundanzarmen Textcodierer (Teil 4) * * * ******************************************************************************** * * * Verfasser : Dipl.-Ing. Jochen Meyer Adresse : TH Darmstadt * * Telefon : 0 61 51 / 16 - 36 66 Institut fuer Datentechnik * * Programm : Meta Merckstr. 25 * * Datum : 08.07.1988 D-6100 Darmstadt * * * *******************************************************************************} program meta(input, output, codefile, metafile, decofile) ; const codefilename = 'USRDSK2:[D93F]4_CODE_??.' ; netzfilename = 'USRDSK2:[D93F]5_NETZ_??.' ; metafilename = 'USRDSK2:[D93F]6_META_??.' ; decofilename = ' WORK:[D93F]7_DECO_??.' ; type filenamentyp = packed array[1..24] of char ; datentyp = record zeichen, woerter, codeworte, code : integer ; end ; var codefile, metafile, decofile : file of integer ; daten : datentyp ; zufallsvariable, antwort, 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 loesche_daten ; begin writeln('|') ; writeln('+------------------------------------------------------------') ; writeln('|') ; with daten do begin zeichen := 0 ; woerter := 0 ; codeworte := 0 ; end ; zufallsvariable := 0 ; end ; procedure kopiere_code_nach_deco(ebene : integer) ; begin write('| Ich kopiere auf der ', ebene: 1) ; writeln('-ten Ebene CODE nach META und DECO !') ; open(codefile, filename(codefilename, ebene), history := old) ; open(metafile, filename(metafilename, ebene), history := new) ; open(decofile, filename(decofilename, ebene), history := new) ; reset(codefile) ; rewrite(metafile) ; rewrite(decofile) ; with daten do begin read(codefile, zeichen, woerter) ; write(metafile, zeichen, woerter) ; write(decofile, zeichen, woerter) ; repeat read(codefile, code) ; write(metafile, code) ; write(decofile, code) ; codeworte := codeworte + 1 ; until eof(codefile) ; end ; close(decofile) ; close(metafile) ; close(codefile) ; end ; procedure kopiere_meta_nach_deco(ebene : integer) ; begin write('| Ich kopiere auf der ', ebene: 1) ; writeln('-ten Ebene META nach DECO !') ; open(metafile, filename(metafilename, ebene), history := old) ; open(decofile, filename(decofilename, ebene), history := new) ; reset(metafile) ; rewrite(decofile) ; with daten do begin read(metafile, zeichen, woerter) ; write(decofile, zeichen, woerter) ; repeat read(metafile, code) ; write(decofile, code) ; codeworte := codeworte + 1 ; until eof(metafile) ; end ; close(decofile) ; close(metafile) ; end ; procedure erzeuge_zufallstext(ebene : integer) ; var codeteiler : integer ; function zufallszahl : integer ; procedure anfangswert(var z : integer) ; var t : packed array[1..11] of char ; begin with daten do begin open(codefile, filename(netzfilename, 1), history := old) ; reset(codefile) ; read(codefile, code) ; close(codefile) ; codeteiler := 4 ** trunc(ln(code + 1.5) / ln(2) + 1) ; end ; time(t) ; z := 10 * ord(t[1]) + ord(t[2]) - 528 ; z := 10 * ord(t[4]) + ord(t[5]) - 528 + 60 * z ; z := 10 * ord(t[7]) + ord(t[8]) - 528 + 60 * z ; z := 10 * ord(t[10]) + ord(t[11]) - 528 + 100 * z ; z := z mod codeteiler ; end ; begin if (zufallsvariable = 0) then anfangswert(zufallsvariable) ; zufallsvariable := (1193 * zufallsvariable + 1123) mod codeteiler ; zufallszahl := zufallsvariable ; end ; begin write('| Ich erzeuge einen Zufallstext auf der ', ebene: 1) ; writeln('-ten Ebene !') ; open(metafile, filename(metafilename, ebene), history := new) ; open(decofile, filename(decofilename, ebene), history := new) ; rewrite(metafile) ; rewrite(decofile) ; with daten do begin write(metafile, 0, 0) ; write(decofile, 0, 0) ; repeat code := zufallszahl ; write(metafile, code) ; write(decofile, code) ; codeworte := codeworte + 1 ; until (codeworte = (ebene - 1)) ; end ; close(decofile) ; close(metafile) ; end ; procedure zeige_statistik ; begin with daten do begin open(codefile, filename(netzfilename, 1), history := old) ; reset(codefile) ; read(codefile, code) ; close(codefile) ; code := 2 * trunc(ln(code + 1.5) / ln(2) + 1) * codeworte ; writeln('|') ; case (zeichen = 0) of true : begin writeln('| Codelaenge :', code: 8, ' bit') ; writeln('| Codelaenge :', codeworte: 8, ' Codeworte') ; end ; false : begin write('| Textlaenge (Klartext) :') ; writeln(zeichen: 8, ' Zeichen') ; write('| Textlaenge (Klartext) :') ; writeln(woerter: 8, ' Woerter') ; writeln('| Codelaenge :', code: 8, ' bit') ; write('| Codelaenge :') ; writeln(codeworte: 8, ' Codeworte') ; write('| Mittlere Codelaenge :') ; case (code > zeichen) of true : begin write((code / zeichen): 10: 1) ; writeln(' bit pro Zeichen') ; end ; false : begin write((1E3 * code / zeichen): 10: 1) ; writeln(' Millibit pro Zeichen') ; write('| Mittlere Codelaenge :') ; write((zeichen / code): 10: 1) ; writeln(' Zeichen pro bit') ; end ; end ; write('| Mittlere Codelaenge :') ; case (code > woerter) of true : begin write((code / woerter): 10: 1) ; writeln(' bit pro Wort') ; end ; false : begin write((1E3 * code / woerter): 10: 1) ; writeln(' Millibit pro Wort') ; write('| Mittlere Codelaenge :') ; write((woerter / code): 10: 1) ; writeln(' Woerter pro bit') ; end ; end ; end ; end ; end ; end ; begin writeln ; writeln('+------------------------------------------------------------') ; writeln('|') ; writeln('| Extrem redundanzarmer Textcodierer (Teil 4: META)') ; writeln('|') ; writeln('| 1) CODE nach DECO kopieren') ; writeln('| 2) META nach DECO kopieren') ; writeln('| 3) Zufallstext erzeugen') ; writeln('|') ; write('| Was soll ich machen ? [1..3] ') ; readln(antwort) ; writeln ; if (antwort in [1..3]) then begin writeln('|') ; repeat write('| Welche Ebene soll ich bearbeiten ? [2..24] ') ; readln(ebene) ; writeln ; until (ebene in [2..24]) ; loesche_daten ; case antwort of 1 : kopiere_code_nach_deco(ebene) ; 2 : kopiere_meta_nach_deco(ebene) ; 3 : erzeuge_zufallstext(ebene) ; end ; zeige_statistik ; end ; writeln('|') ; writeln('+------------------------------------------------------------') ; writeln ; end .