home *** CD-ROM | disk | FTP | other *** search
/ The Best of Mecomp Multimedia 1 / Mecomp-CD.iso / amiga / tools / misc / videotext5.41 / src / decode.p < prev    next >
Encoding:
Text File  |  1997-04-27  |  8.6 KB  |  227 lines
  1. UNIT decode; {$project vt}
  2. { Zeichensatzkonvertierung zum Programm VideoText }
  3.  
  4. INTERFACE; FROM vt USES global;
  5.  
  6. PROCEDURE makeascii(source: p_onepage; zeile: Integer; farblos: Boolean;
  7.                     var asciicode: str80);
  8. PROCEDURE decode_line(source: p_onepage; zeile: Integer; verdeckt: Boolean;
  9.           VAR amigacode: bigstring; VAR attrib: str80;
  10.           VAR dblheight,rastergfx: Boolean);
  11. PROCEDURE gettopnum(source: p_onepage; x,y: Integer; VAR pg,sp: Integer);
  12. PROCEDURE make_colperms(cp: Long);
  13. VAR blank40: String[41];           
  14.     topcode: ARRAY[0..255] OF Byte;
  15.     colperms: ARRAY[0..8] OF Char;
  16.  
  17. { ---------------------------------------------------------------------- }
  18.  
  19. IMPLEMENTATION;
  20.  
  21. {$opt q,s+,i+ } { keine Laufzeitprüfungen außer Stack und Feldindizes }
  22.  
  23. VAR notascii: ARRAY[32..127] OF Byte; STATIC;
  24.     vt_to_ascii, vt_to_myfont: ARRAY[0..7] OF String[15]; STATIC;
  25.     j: Integer;
  26.  
  27. PROCEDURE makeascii{(source: p_onepage; zeile: Integer; farblos: Boolean;
  28.                     VAR asciicode: str80)};
  29. { Eine Zeile einer VT-Seite für Drucker- oder Dateiausgabe umwandeln. }
  30. { Für <farblos>=false werden Farbcodes nicht einfach weggeworfen, sondern }
  31. { durch Klartext '\0' .. '\7'  umschrieben. }
  32. VAR thisbyte,group8,group32,country: Byte;
  33.     start, spalte, i: Integer;
  34.     grafik: Boolean;
  35. BEGIN
  36.   IF source=Nil THEN
  37.     asciicode := blank40
  38.   ELSE BEGIN
  39.     country := (source^.cbits SHR 12) AND $07;
  40.     start := zeile*40;
  41.     grafik := false;
  42.     i := 1;
  43.     FOR spalte := 0 TO 39 DO BEGIN
  44.       thisbyte := source^.chars[start+spalte];
  45.       group8 := thisbyte SHR 3;   { 8er-Gruppe }
  46.       group32 := group8 SHR 2;   { 32er-Gruppe }
  47.       IF group8=0 THEN  grafik := False;
  48.       IF group8=2 THEN  grafik := True;
  49.       IF (group32=2) OR (NOT grafik AND (group32 in [1..3])) THEN
  50.         { druckbares Zeichen, über Tabellen decodieren }
  51.         IF notascii[thisbyte]>0 THEN
  52.           asciicode[i] := vt_to_ascii[country][notascii[thisbyte]]
  53.         ELSE
  54.           asciicode[i] := Chr(thisbyte)
  55.       ELSE
  56.         asciicode[i] := ' ';
  57.       IF NOT farblos AND (group8=0) THEN BEGIN    { Farbcode als Klartext }
  58.         asciicode[i] := '\'; Inc(i); asciicode[i] := chr(thisbyte+ord('0'));
  59.       END;
  60.       Inc(i);
  61.     END;
  62.     asciicode[i] := Chr(0);
  63.   END;
  64. END;
  65.  
  66. {$opt i-}
  67. PROCEDURE decode_line{(source: p_onepage; zeile: Integer; verdeckt: Boolean;
  68.           VAR amigacode: bigstring; VAR attrib: str80;
  69.           VAR dblheight,rastergfx: Boolean)};
  70. { Setzt eine Zeile Teletextzeichen (40 Zeichen) in einen String für den }
  71. { Amiga um (bis zu 160 Zeichen, leider), mit ANSI-Steuerzeichen, für meinen }
  72. { videotext.font. <attrib> dient zur Hilfe bei der Darstellung gerasterter }
  73. { Grafikzeichen. }
  74. { Anhand der c't 10/92 komplett überarbeitet (01/96). }
  75. VAR vfarbe, hfarbe, country, thisbyte, lastout, group32: Byte;
  76.     grafik, raster, hold, geheim: Boolean;
  77.     start,spalte,i,x: Integer;
  78. BEGIN
  79.   country := (source^.cbits SHR 12) AND $07;
  80.   vfarbe := 7; hfarbe := 0; lastout := 32;
  81.   grafik := False; raster := False; hold := False; geheim := False;
  82.   dblheight := False; rastergfx := False;
  83.   i := 1;
  84.   start := zeile*40;
  85.   FOR spalte := 0 TO 39 DO BEGIN
  86.     thisbyte := source^.chars[start+spalte] AND $7F;
  87.     IF thisbyte<32 THEN BEGIN     { Steuerzeichen }
  88.       { zunächst nur die sofort wirkenden behandeln }
  89.       CASE thisbyte OF
  90.         13: dblheight := True; { doppelthohe Zeichen }
  91.         24: geheim := True; { verdeckter Text }
  92.         28: BEGIN { schwarzer Hintergrund }
  93.           hfarbe := 0;
  94.           amigacode[i] := #155; Inc(i);
  95.           amigacode[i] := '4';  Inc(i);
  96.           amigacode[i] := colperms[0];  Inc(i);
  97.           amigacode[i] := 'm';  Inc(i);
  98.         END;
  99.         29: BEGIN { Zeichenfarbe als Hintergrund }
  100.           hfarbe := vfarbe;
  101.           amigacode[i] := #155; Inc(i);
  102.           amigacode[i] := '4';  Inc(i);
  103.           amigacode[i] := colperms[hfarbe]; Inc(i);
  104.           amigacode[i] := 'm';  Inc(i);
  105.         END;
  106.         30: hold := True;
  107.         OTHERWISE; { kommt gleich ... }
  108.       END;
  109.       { jetzt ein Leerzeichen ausgeben (bzw. ein Grafikzeichen wiederholen) }
  110.       IF hold THEN amigacode[i] := Chr(lastout) 
  111.         ELSE amigacode[i] := ' '; Inc(i);
  112.       { Rasterattribut notieren: }
  113.       x := Ord(colperms[hfarbe])-Ord('0');
  114.       IF raster AND grafik THEN x := x OR 16;
  115.       attrib[spalte+1] := Chr(x);
  116.       { und noch die verzögert wirkenden Steuerzeichen: }
  117.       CASE thisbyte OF
  118.         0..7: BEGIN { neue Textfarbe }
  119.           geheim := False;
  120.           grafik := False;
  121.           vfarbe := thisbyte;
  122.           amigacode[i] := #155; Inc(i);
  123.           amigacode[i] := '3';  Inc(i);
  124.           amigacode[i] := colperms[vfarbe]; Inc(i);
  125.           amigacode[i] := 'm';  Inc(i);
  126.         END;
  127.         16..23: BEGIN { neue Grafikfarbe }
  128.           geheim := False;
  129.           grafik := True;
  130.           vfarbe := thisbyte-16;
  131.           amigacode[i] := #155; Inc(i);
  132.           amigacode[i] := '3';  Inc(i);
  133.           amigacode[i] := colperms[vfarbe]; Inc(i);
  134.           amigacode[i] := 'm';  Inc(i);
  135.         END;
  136.         25: raster := False; { gerasterte Grafikzeichen }
  137.         26: BEGIN raster := True; rastergfx := True; END;
  138.         31: hold := False;
  139.         OTHERWISE;
  140.       END;
  141.     END ELSE BEGIN { druckbares Zeichen }
  142.       { Rasterattribut? }
  143.       x := Ord(colperms[hfarbe])-Ord('0');
  144.       IF raster AND grafik AND NOT (thisbyte IN [64..95]) THEN x := x OR 16;
  145.       attrib[spalte+1] := Chr(x);
  146.       { Grafikzeichen? }
  147.       IF grafik AND NOT (thisbyte IN [64..95]) THEN
  148.         thisbyte := thisbyte + 128
  149.       ELSE IF notascii[thisbyte]>0 THEN
  150.         thisbyte := Ord(vt_to_myfont[country][notascii[thisbyte]]);
  151.       { verdecktes Zeichen? }
  152.       IF (geheim AND verdeckt) THEN
  153.         amigacode[i] := ' '
  154.       ELSE
  155.         amigacode[i] := Chr(thisbyte); Inc(i);
  156.       { nur echte Grafikzeichen für "hold"-Wiederholung merken: }
  157.       IF thisbyte SHR 5 IN [5,7] THEN
  158.         lastout := thisbyte ELSE lastout := 32;
  159.     END;
  160.   END;
  161.   amigacode[i] := Chr(0);
  162. END;
  163. {$opt i+}
  164.  
  165. PROCEDURE gettopnum{(source: p_onepage; x,y: Integer; VAR pg,sp: Integer)};
  166. { Eine Seitennummer pg/sp aus einer TopText-Seite auslesen }
  167. { Rückgabewert -1 bedeutet, daß unerlaubte Ziffern aufgetreten sind }
  168. VAR i,j,z: Integer;
  169.     illegal: Boolean;
  170. BEGIN
  171.   i := x + 40*y;
  172.   pg := 0; illegal := False;
  173.   FOR j := 0 TO 2 DO BEGIN
  174.     z := topcode[source^.chars[i+j]];
  175.     pg := (pg SHL 4)+z;
  176.     IF z>15 THEN illegal := True;
  177.   END;
  178.   IF illegal THEN pg := -1;
  179.   sp := 0; illegal := False;
  180.   FOR j := 3 TO 6 DO BEGIN
  181.     z := topcode[source^.chars[i+j]];
  182.     sp := (sp SHL 4)+z;
  183.     IF z>15 THEN illegal := True;
  184.   END;
  185.   IF illegal THEN sp := -1;
  186. END;
  187.  
  188. PROCEDURE make_colperms{(cp: Long)};
  189. { colperms-String der tatsächlichen Farbreihenfolge auf dem Screen anpassen }
  190. VAR i: Integer;
  191. BEGIN
  192.   FOR i := 0 TO 7 DO
  193.     colperms[(cp SHR (4*(7-i))) AND $F] := Chr(i+Ord('0'));
  194. END;
  195.  
  196. BEGIN   { Initialisierungsteil }
  197.   { VT-Zeichensatzdekodierung }
  198.   { Welche (druckbaren) Zeichen müssen überhaupt dekodiert werden? }
  199.   FOR j := 32 TO 127 DO notascii[j] := 0;
  200.   FOR j := 0 TO 1 DO notascii[35+j] := 1+j;
  201.   notascii[64] := 3;
  202.   FOR j := 0 TO 5 DO notascii[91+j] := 4+j;
  203.   FOR j := 0 TO 3 DO notascii[123+j] := 10+j;
  204.   { Durch welche Zeichen werden sie ersetzt, a) im Standard-Amiga-Zeichensatz, }
  205.   { b) in meinem videotext.font? }
  206.   { Die Ländernummern (aus den Steuerbits als C12 + 2*C13 + 4*C14 berechnet) }
  207.   { sind: 0=England, 1=Frankreich, 2=Schweden, 3=reserviert, 4=Deutschland, }
  208.   { 5=Spanien, 6=Italien, 7=reserviert. }
  209.   vt_to_ascii[0] := '£$@«½»^#­¼|¾÷'; vt_to_myfont[0] := 'Á$ÀÂÈÄÃ#-ÇÅÉÆ'; { GB }
  210.   vt_to_ascii[1] := 'éïàëêùî#èâôûç'; vt_to_myfont[1] := 'Ô×ÎÔÕÝØ#ÓÐÜßÒ'; { F }
  211.   vt_to_ascii[2] := '#¤ÉÄÖÅÜ_éäöåü'; vt_to_myfont[2] := '#ÌE[\Í]_Ô{|Ñ}'; { S }
  212.   vt_to_ascii[3] := '£$@«½»^#­¼|¾÷'; vt_to_myfont[3] := 'Á$ÀÂÈÄÃ#-ÇÅÉÆ'; { ?? }
  213.   vt_to_ascii[4] := '#$§ÄÖÜ^_°äöüß'; vt_to_myfont[4] := '#$@[\]^_`{|}~'; { D }
  214.   vt_to_ascii[5] := 'ç$¡áéíóú¿üñèà'; vt_to_myfont[5] := 'Ò$ÊÏÔ×ÛÞË}ÙÓÎ'; { E }
  215.   vt_to_ascii[6] := '£$é°ç»^#ùàòèì'; vt_to_myfont[6] := 'Á$Ô`ÒÄÃ#ÝÎÚÓÖ'; { I }
  216.   vt_to_ascii[7] := '£$@«½»^#­¼|¾÷'; vt_to_myfont[7] := 'Á$ÀÂÈÄÃ#-ÇÅÉÆ'; { ?? }
  217.   { Decodierung der TopText-Ziffern 0..F }
  218.   FOR j := 0 TO 255 DO topcode[j] := 16; { unmögliche Ziffer=Fehler }
  219.   topcode[21]  := 0; topcode[2]   := 1; topcode[73] := 2;  topcode[94] := 3;
  220.   topcode[100] := 4; topcode[115] := 5; topcode[56] := 6;  topcode[47] := 7;
  221.   topcode[80]  := 8; topcode[71]  := 9; topcode[12] := 10; topcode[27] := 11;
  222.   topcode[33] := 12; topcode[54] := 13; topcode[125] := 14; topcode[106] := 15;
  223.   FOR j := 1 TO 40 DO blank40[j] := ' '; blank40[41] := #0;
  224.   colperms := '01234567';   { Zuordnung VT-Farben/Screen-Farben }
  225. END.
  226.  
  227.