Power-Programmierung/CD1.mdf/pascal/library/dos/grafik/gif/giflesen/giflesen.pas

Pascal/Delphi Source File | 1991-02-22 | 10.2 KB | 435 lines

{ ---------------------------------------------------------------------- }
{ Aufruf von GIFLESEN:                                                   }
{ C:\>giflesen.exe <filename>.GIF [RETURN]                               }
{ oder                                                                   }
{ C:\>giflesen.exe [RETURN]                                              }
{ ---------------------------------------------------------------------- }

{$A+,B-,D+,E+,F-,I-,L+,N+,O-,R-,S-,V-}
{$M 64000,0,655360}

{ Programm lädt Gif-Format und stellt dieses auf einer
  VGA-Karte dar.                                                         }



Uses Dos, Crt;

Const  Gif_Kennung           = 'GIF87a';
       MaxTablaenge          = 4096 - 1;
       Modulo_Tabelle        : array [ 1 .. 12 ] of Word
                             = (  $01 ,  $03 ,  $07 ,  $0F ,  $1F ,  $3F ,
                                  $7F ,  $FF , $1FF , $3FF , $7FF , $FFF    );

Var    Datei            : File of char;
       reg              : registers;
       Bildbreite ,
       Bildhoehe ,
       Farbbits ,
       Pixelbits ,
       Hintergrundfarbe ,
       Naechste_Grenze ,
       Zeichen ,
       Altes_Zeichen ,
       Geschehen ,
       X_Kor ,
       X_Min ,
       X_Max ,
       Y_Kor ,
       Y_Min ,
       Y_Max ,
       Kontrollzaehler  : Integer;

       Naechster_Code ,
       Start_Zeiger ,
       Ende_Code ,
       Init_Code        : Word;

       Lese_Buffer      : Longint;

       Buffer_Zeiger ,
       Lese_Bits        : Byte;

       Globale_Farben   : Boolean;
       Interlay         : Boolean;
       Ende_Komp        : Boolean;
       Ende             : Boolean;

       Stack            : array [ 0 .. 4096 ] of Word;

       Tabelle          : array [ 0 .. MaxTablaenge ] of Record
                                                            First  : Word;
                                                            Last   : Word;
                                                            Link   : Integer;
                                                         End;


{ Start initialsisierung aller Variabeln mit festem Startwert.              }
Procedure Start_Init;
Var Zaehler : Word;
begin
   for Zaehler := 0 to 4096 do
      Stack [ Zaehler ]  := 0;

   Buffer_Zeiger   := 0;
   Lese_Buffer     := 0;
   X_Kor           := 0;
   Y_Kor           := 0;
   Kontrollzaehler := 0;
   Interlay        := FALSE;
   Ende_Komp       := FALSE;
   Ende            := FALSE;
end;


Procedure Abbruch ( Grafik : Boolean; Texte : String );
Var Dummy : Integer;
begin
   if Grafik then
      TextMode( Co80 );

   {$I-}
      close   ( Datei );
   {$I+}

   Dummy := IOResult;

   writeln ( Texte , #7 );

   halt( IOResult );
end;



Function Lese_Zeichen : Byte;
Var Zeichen : Char;
begin
    read ( Datei , Zeichen );
    Lese_Zeichen := ord ( Zeichen );
end;


{ Datei mit dem in der Kommandozeile angegebenem Namen öffnen.           }
{ Falls kein Name angegeben ist, diesen vom Benutzer eingeben lassen.    }
Procedure Datei_oeffnen;
Var Datei_Name  : String;
begin
   Writeln;
   Writeln;
   if Paramcount = 0 then
   begin
        repeat
              Write  ( 'Bitte Dateiname eingeben : ');
              readln ( Datei_Name );
        until Datei_Name <> '';
   end
   else
        Datei_Name := Paramstr ( 1 );

   {$I-}
      assign ( Datei , Datei_Name );
      reset  ( Datei );
   {$I+}

   if IOResult <> 0 then
      Abbruch ( FALSE , 'Falscher Dateiname, Datei nicht vorhanden oder Datei kaputt' );
end;


Procedure Tabelle_initialisieren ( Zeiger : Word );
Var Zaehler : Word;
begin
    Lese_Bits       := Pixelbits + 1;
    Naechster_Code  := Zeiger + 2;
    Naechste_Grenze := Zeiger shl 1;

    Zaehler := 0;

    while Zaehler < Zeiger do
    begin
       Tabelle [ Zaehler ].First := Zaehler;
       Tabelle [ Zaehler ].Last  := Zaehler;
       Tabelle [ Zaehler ].Link  := -1;
       inc ( Zaehler );
    end;

    while Zaehler <= MaxTablaenge do
    begin
       Tabelle [ Zaehler ].Link := -2;
       inc ( Zaehler );
    end;
end;


Function Hole_Code ( Bitlaenge : Byte ) : Longint;
begin
   while Buffer_Zeiger < Bitlaenge do
   begin
      if Kontrollzaehler = 0 then
      begin
         Kontrollzaehler := ord ( Lese_Zeichen );

         if Kontrollzaehler = 0 then
         begin
            Ende_Komp := TRUE;
            Exit;
         end;
      end;

      dec ( Kontrollzaehler );
      Lese_Buffer := Lese_Buffer + Longint ( Lese_Zeichen ) shl Buffer_Zeiger;
      inc ( Buffer_Zeiger , 8 );
   end;

   Hole_Code   := Lese_Buffer and Modulo_Tabelle [ Bitlaenge ];
   Lese_Buffer := Lese_Buffer shr Bitlaenge;

   dec ( Buffer_Zeiger , Bitlaenge );
end;


Procedure Fuege_Code_ein ( Code , Alter_Code : Integer;
                           Var Lese_Bits     : Byte      );
begin
   Tabelle [ Naechster_Code ].Link  := Alter_Code;
   Tabelle [ Naechster_Code ].Last  := Tabelle [ Code       ].First;
   Tabelle [ Naechster_Code ].First := Tabelle [ Alter_Code ].First;

   inc ( Naechster_Code );

   if ( Naechster_Code = Naechste_Grenze ) then
   begin
      if Lese_Bits < 12 then
      begin
         inc ( Lese_Bits );
         Naechste_Grenze := Naechste_Grenze shl 1;
      end;
   end;
end;


Procedure Punktausgabe ( Farbe : Byte );
begin
   Mem[$A000:(Y_Kor*320+X_Kor)] := Farbe;

   inc ( X_Kor );

   if X_Kor >= X_Max then
   begin
      X_Kor := X_Min;

      if Interlay then
      begin
         inc ( Y_Kor , 8 );

         if Y_Kor >= Y_Max then
            dec ( Y_Kor , Y_Max - Y_Min - 1 );
      end
      else
         inc ( Y_Kor );
   end;
end;



Procedure Ausgabe ( Code : Integer );
Var Hilfe ,
    Stackzeiger : Integer;
begin
   Stackzeiger := 0;

   repeat
      Stack [ Stackzeiger ] := Tabelle [ Code ].Last;
      inc ( Stackzeiger );

      Code := Tabelle [ Code ].Link;
   until Code = -1;

   repeat
      dec ( Stackzeiger );
      Punktausgabe ( Stack [ Stackzeiger ] );
   until Stackzeiger <= 0;
end;


Procedure Farben_setzen;
Var Zaehler : Byte;
    Farben  : array [ 0 .. 255 ] of Record
                                       Rot ,
                                       Gruen ,
                                       Blau    : Byte;
                                    end;
begin
   for Zaehler := 0 to 1 shl Pixelbits - 1 do
   begin
      Farben[ Zaehler ].Rot   := ord ( Lese_Zeichen ) div 4;
      Farben[ Zaehler ].Gruen := ord ( Lese_Zeichen ) div 4;
      Farben[ Zaehler ].Blau  := ord ( Lese_Zeichen ) div 4;
   end;

     reg.ah := $10;
     reg.al := $12;
     reg.bx := 1;
     reg.cx := 255;
     reg.es := seg( Farben );
     reg.dx := ofs( Farben ) + 3;
     Intr( $10, reg );
end;


Procedure Image_Deskriptor;
begin
   X_Min := Lese_Zeichen;
   X_Min := X_Min + Lese_Zeichen * 256;
   Y_Min := Lese_Zeichen;
   Y_Min := Y_Min + Lese_Zeichen * 256;
   X_Max := Lese_Zeichen;
   X_Max := X_Max + Lese_Zeichen * 256;
   Y_Max := Lese_Zeichen;
   Y_Max := Y_Max + Lese_Zeichen * 256;

   X_Kor := X_Min;
   Y_Kor := Y_Min;

   Zeichen := Lese_Zeichen;
   Zeichen := Lese_Zeichen;
   if ( Zeichen and 64 ) = 64 then
      Interlay := TRUE;

   if ( Zeichen shr 7 = 1 ) and Globale_Farben then
      Farben_setzen;
end;


Procedure Lesen_dekomp;
Var Zaehler ,
    Ende : Integer;
begin
   Image_Deskriptor;

   Lese_Bits := Pixelbits + 1;

   Init_Code := 1 shl Pixelbits;
   Ende_Code := Init_Code + 1;
   Lese_Bits := Pixelbits + 1;
   Tabelle_initialisieren ( Init_Code );
   Altes_Zeichen := -1;
   Ende := 0;
   Geschehen := 0;

   repeat
      Zeichen := Hole_Code ( Lese_Bits );

       if Zeichen = Init_Code then
       begin
           Tabelle_initialisieren ( Init_Code );
           Lese_Bits := Pixelbits + 1;
           Altes_Zeichen := -1;
       end
       else
       begin
          if Zeichen = Ende_Code then
             Ende := -1
          else
          begin
             if Tabelle [ Zeichen ].Link <> -2 then
             begin
                if Altes_Zeichen <> -1 then
                   Fuege_Code_ein ( Zeichen , Altes_Zeichen , Lese_Bits );
             end
             else
             begin
                Fuege_Code_ein ( Altes_Zeichen , Altes_Zeichen , Lese_Bits );
             end;

             Ausgabe ( Zeichen );
             Altes_Zeichen := Zeichen;
          end;
       end;
   until Ende = -1;
end;


Procedure Grafik_initialisieren;
var t : integer;
    tr : boolean;
begin
     reg.ah := $00;
     reg.al := $13;
     Intr($10,reg);
end;


Procedure Screen_Deskriptor_lesen;
Var    Zaehler : Integer;
       Zeichen : Byte;
Const  Test    : String = '';
begin
   for Zaehler := 1 to 6 do
      Test := Test + chr ( Lese_Zeichen );

   if Test <> Gif_Kennung then
      Abbruch ( TRUE , 'Datei hat kein gültiges Gif-Format' );

   Bildbreite := ord ( Lese_Zeichen );
   Bildbreite := Bildbreite + ord ( Lese_Zeichen ) * 256;
   Bildhoehe  := ord ( Lese_Zeichen );
   Bildhoehe  := Bildhoehe + ord ( Lese_Zeichen ) * 256;

   Zeichen := Lese_Zeichen;
   if Zeichen shr 7 = 1 then
      Globale_Farben := TRUE
   else
      Globale_Farben := false;

   Farbbits     := ( Zeichen shr 4 ) mod 8 + 1;
   Pixelbits    :=   Zeichen mod 8 + 1;

   Start_Zeiger := 1 shl Pixelbits + 2;

   Hintergrundfarbe := ord ( Lese_Zeichen );

   Zeichen := Lese_Zeichen;
end;


Procedure Gif_Extendet;
begin
end;


begin
   { Start initialsisierung aller Variabeln mit festem Startwert.           }
   Start_Init;

   { Datei mit dem in der Kommandozeile angegebenem Namen öffnen.           }
   { Falls kein Name angegeben ist, diesen vom Benutzer eingeben lassen.    }
   Datei_oeffnen;

   Grafik_initialisieren;

   Screen_Deskriptor_lesen;

   if Globale_Farben then
      Farben_setzen;

   repeat
      Zeichen := Lese_Zeichen;

      case chr ( Zeichen ) of
         ','   :   Lesen_Dekomp;

         '!'   :   Gif_Extendet;

         ';'   :   Ende := TRUE;
      end;
   until Ende;

   close (  Datei );

   write ( #7 );
   repeat until keypressed;
   write(readkey);

   TextMode( Co80 );
end.