Power-Programmierung/CD1.mdf/pascal/library/dos/grafik/vgakit/gif/source/gifmini.pas

Pascal/Delphi Source File | 1991-08-20 | 14.0 KB | 501 lines

PROGRAM GIFMINI;
{
  LESEN VON GIF- FILES   MINIMALPROGRAMM

  NUR VIDEOMODUS 13H ( 320 * 200 / 256 )
  KEIN ABFANGEN VON IO- FEHLERN
  KEINE FILESELEKTORBOX USW.

  Paul Schubert, Rottweiler Str. 8, D6000 Frankfurt /M 1, 069 / 231145

  DER GIF- LESEALGORITHMUS WURDE ENTNOMMEN AUS DEM ARTIKEL
  'Heiße Pixel', Zeitschrift mc, Mai 1991, S. 106
  Autor Dietmar Bückart
}
{$R-}
{$S-}

USES  CRT,DOS,TPERSATZ;


CONST GIFHDLEN = 13;    { LÄNGE GIF HEADER - NICHT VERÄNDERN !!! }
      GIFPDLEN = 10;    { LÄNGE GIF PICTURE DESCRIPTOR - NICHT VERÄNDERN !!! }
      LINLEN   = 1024;  { MAXIMALE LÄNGE EINER BILDZEILE IN PIXELN }


CONST POWERSOF2 : ARRAY[0..8] OF WORD = (1,2,4,8,16,32,64,128,256);
      MAXCODES  : ARRAY[0..9] OF WORD = (4,8,$10,$20,$40,$80,$100,$200,$400,$800);
      CODEMASK  : ARRAY[1..8] OF BYTE = (1,3,7,$F,$1F,$3F,$7F,$FF);
      MASKS     : ARRAY[0..9] OF WORD = (7,$F,$1F,$3F,$7F,$FF,$1FF,$3FF,$7FF,$FFF);


TYPE  HDRTYP = RECORD { GIF FILEHEADER }
        SIGNUM   : ARRAY[0..5] OF CHAR;
        SCRWID   : WORD;
        SCRHIG   : WORD;
        INFO     : BYTE;
        BKCOL    : BYTE;
        TERM     : BYTE;
        GLOBPAL  : BOOLEAN;
        BPP      : BYTE;
        RGBBITS  : BYTE;
        CMAPSIZ  : WORD;
      END;

      PICDESCTYP = RECORD { GIF PICTURE DESCRIPTOR }
        SIGNUM1  : CHAR;
        LEFT     : WORD;
        TOP      : WORD;
        WID      : WORD;
        HIG      : WORD;
        FLAGS    : BYTE;
        INTERL   : BOOLEAN;
        LOCMAP   : BOOLEAN;
        PIXSIZ   : BYTE;
      END;

TYPE  COLORVALUE = RECORD R,G,B : BYTE END;
      VGAPALETTE = ARRAY[0..255] OF COLORVALUE;
      CMAPTYP    = ARRAY[0..256,0..2] OF BYTE;

TYPE  BATYP      = ARRAY[0..2] OF BYTE;
      PBATYP     = ^BATYP;


VAR   I                    : INTEGER;
      FN                   : STRING;
      F                    : FILE;
      HDR                  : HDRTYP;
      GCMAP,LCMAP          : CMAPTYP;
      PAL                  : VGAPALETTE ABSOLUTE GCMAP;
      PICDESC              : PICDESCTYP;

      CLEARCODE,EOFCODE,
      FIRSTFREE,FREECODE,
      INICODSIZ,MAXCODE,
      READMASK,OUTCOUNT,
      CURCODE,
      OLDCODE,XP,YP        : WORD;
      CODESIZE,BITMASK,
      FINCHAR,PASS         : BYTE;

      BITOFFSET,BITSIZ     : WORD;
      BITBUF               : LONGINT;
      BITBF                : BATYP ABSOLUTE BITBUF;
      CODE                 : WORD  ABSOLUTE BITBUF;
      B                    : WORD;

      PREFIX               : ARRAY[0..4095] OF WORD;
      SUFFIX               : ARRAY[0..4095] OF BYTE;
      OUTCODE              : ARRAY[0..LINLEN] OF BYTE;
      VLINE                : ARRAY[0..LINLEN] OF BYTE;
      BUF                  : ARRAY[0.. 260] OF BYTE;


{ FÜR VGA- INITIALISIERUNG }
VAR   VMOD                 : BYTE;
      XWID,YWID,MAXX,MAXY  : WORD;


{#####################################################################}
{ HIER IST DER HARDWARE- ABHÄNGIGE TEIL DES PROGRAMMS }

PROCEDURE SET320X200;
BEGIN
  VMOD := $13;   { DIESEN VIDEO- MODUS KENNT JEDE VGA- KARTE }
  XWID := 320;
  YWID := 200;
  MAXX := PRED(XWID);
  MAXY := PRED(YWID);
END; { SET320X200 }

{ EINSTELLEN DES 64k SEGMENTS FÜR SUPER- VGA- MODI }
PROCEDURE SETSEG(SEGMENT:BYTE);
BEGIN
END; { SETSEG }

{ ENDE HARDWARE- ABHÄNGIGER PROGRAMMTEIL }
{#####################################################################}

{---------------------------------------------------------------------}
{ DIESER PROGRAMMTEIL IST FÜR VGA / SUPER- VGA }

PROCEDURE RAMTOVGA(VON:POINTER;BIS:LONGINT;WID:WORD);
TYPE  SOF    = RECORD O,S : WORD; END;
TYPE  VADDR  = RECORD
        A    : WORD; { ADRESSE IM 64K- SEGMENT }
        S    : BYTE; { SEGMENT- NUMMER }
        DUM  : BYTE; { FÜLLBYTE }
      END;
VAR   J,K,AWID  : WORD;
      B2        : LONGINT;
      V2        : POINTER;
BEGIN
{ NICHT MEHR PIXEL ALS BILDSCHIRMBREITE AUSGEBEN }
  IF WID > XWID THEN AWID := XWID ELSE AWID := WID;

  B2 := BIS + LONGINT(AWID);
  SETSEG(VADDR(BIS).S);
  IF VADDR(BIS).S = VADDR(B2).S THEN BEGIN
    MOVE(VON^,MEM[$A000:BIS],AWID);
  END ELSE BEGIN
    J := VADDR(B2).A;
    K := AWID - J;
    MOVE(VON^,MEM[$A000:BIS],K);
    SETSEG(VADDR(B2).S);
    V2 := VON; INC(SOF(V2).O,K);
    MOVE(V2^,MEM[$A000:0],J);
  END;
END; { RAMTOVGA }


PROCEDURE VGASETPALETTE(VON,BIS:BYTE;VAR P : VGAPALETTE);
VAR   R  : REGISTERS;
BEGIN
  R.AX := $1012;
  R.BX := VON;
  R.CX := SUCC(BIS - VON);
  R.ES := SEG(P);
  R.DX := OFS(P[VON]);
  INTR($10,R);
END; { VGASETPALETTE }


PROCEDURE OVERSCAN(FARBE:BYTE);
VAR   R  : REGISTERS;
BEGIN
  R.AX := $1001;
  R.BH := FARBE;
  INTR($10,R);
END;


PROCEDURE SETMODUS(MODE:BYTE);
VAR   R  : REGISTERS;
BEGIN
  R.AH := 0;
  R.AL := VMOD;
  INTR($10,R);
END; { SETMODUS }

{---------------------------------------------------------------------}


{ ES IST SCHNELLER, ZUERST ALLE PIXEL EINER ZEILE AUFZUSAMMELN UND DANN DIE
  ZEILE AUF VIDEO AUSZUGEBEN, ALS EINZELNE PIXEL AUF DEN BILDSCHIRM ZU
  SCHREIBEN
}
PROCEDURE PUTPIXEL(B:BYTE);
VAR   I  : INTEGER;
BEGIN
  VLINE[XP] := B;
  INC(XP);
  IF XP >= PICDESC.WID THEN BEGIN

{ NICHT MEHR ZEILEN AUSGEBEN ALS DIE BILDSCHIRMHÖHE }
    IF YP < YWID THEN
      RAMTOVGA(@VLINE,LONGINT(YP)*LONGINT(XWID),PICDESC.WID);

{ HIER FINDET DAS HANDLING VON INTERLACED- GIF STATT }
    CASE PASS OF
      0 : INC(YP);
      1 : INC(YP,8);
      2 : INC(YP,8);
      3 : INC(YP,4);
      4 : INC(YP,2);
    END; { CASE PASS }
    XP := 0;
    IF YP >= PICDESC.HIG THEN BEGIN
      IF PASS > 0 THEN INC(PASS);
      CASE PASS OF
        2 : YP := 4;
        3 : YP := 2;
        4 : YP := 1;
      END; { CASE PASS }
    END;
  END;
END; { PUTPIXEL }


PROCEDURE AUS;
BEGIN
  TEXTMODE(CO80);
  HALT;
END; { AUS }


PROCEDURE GRAPHEIN;
BEGIN
{ HIER SOLLTE NATÜRLICH EIGENTLICH NACH ART UND GRÖßE DES BILDES DER
  PASSENDE VIDEO- MODUS EINGESTELLT WERDEN
}
  SET320X200;                             { GRAPHIK- MODUS AUSWÄHLEN }
  SETMODUS(VMOD);                         { GRAPHIK- MODUS EINSTELLEN }
  VGASETPALETTE(0,PRED(HDR.CMAPSIZ),PAL); { PALETTE EINSTELLE }
  OVERSCAN(HDR.BKCOL);                    { HINTERGRUNDFARBE SETZEN }
  DIRECTVIDEO := FALSE;                   { FALLS MIT 'WRITE' AUF'S BILD
                                            GESCHRIEBEN WERDEN SOLL }
END; { GRAPHEIN }


{ PROCEDURE ZEIGEHDR DIENT NUR ZUM DEBUGGEN UND FÜR NEUGIERIGE }
PROCEDURE ZEIGEHDR;
BEGIN
  TEXTMODE(CO80);
  WRITELN;
  WRITELN;
  WRITELN(FN);
  WITH HDR DO BEGIN
    WRITELN('>',SIGNUM,'<   ',SCRWID,' * ',SCRHIG,' * ',POWERSOF2[BPP]);
    WRITELN('INFO : ',HEXB(INFO),'   BACKGROUND :',BKCOL:4,'  TERMINATOR :',TERM:3,' >',CHAR(TERM),'<');
    WRITELN('GLOBALE PALETTE : ',GLOBPAL,'   BITS PER PIXEL :',BPP:4);
    WRITELN('RGBSIZE :',RGBBITS:4,'   CMAPSIZE :',CMAPSIZ:6);
    WITH PICDESC DO BEGIN
      WRITELN('XOFF  = ',LEFT:4,'      YOFF = ',TOP:4);
      WRITELN('WIDTH = ',WID:4, '    HEIGTH = ',HIG:4);
      WRITELN('FLAGS : ',HEXB(FLAGS),'   PIXEL- SIZE = ',PIXSIZ);
      WRITELN('INTERLACE : ',INTERL,'   LOCAL COLORMAP : ',LOCMAP);
      WRITELN;
      WRITE  ('Filegröße : ',FILESIZE(F),',   ');
      WRITELN(LONGINT(LONGINT(WID)*LONGINT(HIG)*LONGINT(BPP))SHR 3,' Bytes Bilddaten');
    END; { WITH PICDESC }
  END; { WITH HDR }
  IF READKEY = ^[ THEN;
END; { ZEIGEHDR }


{---------------------------------------------------------------------}
{ HIER FOLGT DER KERN DES GIF- DECODERS }


FUNCTION LIESHDR:INTEGER;
VAR   I,J  : INTEGER;
BEGIN
  LIESHDR := -1;

  FILLCHAR(HDR,SIZEOF(HDR),#0);
  BLOCKREAD(F,HDR,GIFHDLEN,I);
  J := IORESULT;
  IF (J <> 0) OR (I <> GIFHDLEN) THEN EXIT;
  WITH HDR DO BEGIN
    LIESHDR := -2;
    IF (SIGNUM[0] <> 'G') OR
       (SIGNUM[1] <> 'I') OR
       (SIGNUM[2] <> 'F') THEN EXIT;
{ HIER KANN NOCH AUF 'GIF87a' UND 'GIF89a' GETESTET WERDEN }
    GLOBPAL  := (INFO AND $80) <> 0;
    BPP      := SUCC(INFO AND 7);
    RGBBITS  := SUCC( (INFO SHR 4) AND 7);
    CMAPSIZ  := 1 SHL BPP;
    IF GLOBPAL THEN BEGIN
      LIESHDR := -3;
      BLOCKREAD(F,GCMAP,3 * CMAPSIZ,I);
      J := IORESULT;
      IF (J <> 0) OR (I <> 3 * CMAPSIZ) THEN EXIT;
      FOR I := 0 TO PRED(HDR.CMAPSIZ) DO BEGIN
        FOR J := 0 TO 2 DO GCMAP[I][J] := GCMAP[I][J] SHR 2;
      END;
    END;
  END; { WITH HDR }
  LIESHDR := -4;
  BLOCKREAD(F,PICDESC,GIFPDLEN,I);
  J := IORESULT;
  IF (J <> 0) OR (I <> GIFPDLEN) THEN EXIT;
  WITH PICDESC DO BEGIN
    LIESHDR := -5;
    IF SIGNUM1 <> ',' THEN EXIT;
    INTERL := (FLAGS AND $40) <> 0;
    LOCMAP := (FLAGS AND $80) <> 0;
    PIXSIZ := SUCC(FLAGS AND 7);

    IF LOCMAP THEN BEGIN
      LIESHDR := -5;
      BLOCKREAD(F,LCMAP,3 * HDR.CMAPSIZ,I);
      J := IORESULT;
      IF (J <> 0) OR (I <> 3 * HDR.CMAPSIZ) THEN EXIT;
      FOR I := 0 TO PRED(HDR.CMAPSIZ) DO BEGIN
        FOR J := 0 TO 2 DO LCMAP[I][J] := LCMAP[I][J] SHR 2;
      END;
    END;
  END; { WITH PICDESC }
  LIESHDR := 0;
END; { LIESHDR }


PROCEDURE GIFDOCLEAR;
BEGIN
  CODESIZE  := INICODSIZ;
  MAXCODE   := MAXCODES[CODESIZE - 2];
  FREECODE  := FIRSTFREE;
  READMASK  := MASKS[CODESIZE - 3];
END; { GIFDOCLEAR }


{ ICH HOFFE, DIE FUNCTION READCODE MÖGLICHST SCHNELLGÄNGIG PROGRAMMIERT
  ZU HABEN
}
{ MAN KANN NATÜRLICH GRÖßERE 'BROCKEN' ALS DIE GIF- BLÖCKE AUF EINMAL
  EINLESEN, DAS WIRD VERMUTLICH SOGAR SICHTBAR SCHNELLER, ABER ES WIDERSTREBT
  MIR, WIE IM PROGRAMM VON HERRN BÜCKART GANZE 64k BYTES FILEBUFFER ZU
  VERSCHWENDEN.
  WENN BILDER VON 1024 * 768 IN 256 FARBEN IM HINTERGRUND EINGELESEN WERDEN
  SOLLEN, REICHT DER ARBEITSSPEICHER SOWIESO NICHT - DANN BRAUCHT'S EBEN EMS.
}
FUNCTION READCODE:BOOLEAN;
VAR   I  : WORD;
BEGIN
  IF (BITOFFSET+CODESIZE) > BITSIZ THEN BEGIN
    I := BITSIZ - BITOFFSET;
    IF (I AND 7) <> 0 THEN I := SUCC(I SHR 3) ELSE I := I SHR 3;
    IF I > 0 THEN MOVE(BUF[(BITSIZ SHR 3)-I],BUF[0],I);
    BITOFFSET := BITOFFSET AND 7;
    BLOCKREAD(F,B,1);
    BITSIZ := (B + I) SHL 3;
    IF B > 0 THEN BLOCKREAD(F,BUF[I],B)
             ELSE WRITE(#7);
    IF EOF(F) THEN BEGIN
      READCODE := FALSE;
      EXIT;
    END;
  END;
  MOVE(BUF[BITOFFSET SHR 3],BITBUF,3);
  CODE := WORD( BITBUF SHR (BITOFFSET AND 7) ) AND READMASK;
  INC(BITOFFSET,CODESIZE);
  READCODE := (CODE <> EOFCODE);
END; { READCODE }


{ ES HEIßT DESHALB 'LADEBILD', WEIL IM KOMPLETTEN PROGRAMM EIN UNTERSCHIED
  ZWISCHEN LADEN UND ANZEIGEN DES BILDES BESTEHT
}
{ MEINE OPTIMIERUNGSVERSUCHE AN DIESER PROZEDUR SIND KLÄGLICH GESCHEITERT.
  LEDIGLICH DAS WEGLASSEN DER EOF- PRÜFUNG NACH JEDEM READCODE HAT EINE
  SICHTBARE VERSCHNELLERUNG ERGEBEN.
  UM AUF LADEGESCHWINDIGKEITEN ZU KOMMEN, WIE SIE Z.B. VPIC.EXE ERREICHT,
  IST ES VERMUTLICH UNUMGÄNGLICH, IN ASSEMBLER ZU PROGRAMMIEREN
}
PROCEDURE LADEBILD;
BEGIN
  BLOCKREAD(F,CODESIZE,1);
  CLEARCODE := POWERSOF2[CODESIZE];
  EOFCODE   := SUCC(CLEARCODE);
  FIRSTFREE := SUCC(EOFCODE);

  INC(CODESIZE);
  INICODSIZ := CODESIZE;
  BITMASK   := CODEMASK[HDR.BPP];

  GIFDOCLEAR;
  B         := 0;
  BITSIZ    := 0;
  BITOFFSET := 0;
  OUTCOUNT  := 0;

  XP        := 0; {PICDESC.LEFT}
  YP        := 0; {PICDESC.TOP}
  IF PICDESC.INTERL THEN PASS := 1 ELSE PASS := 0;

  WHILE READCODE DO BEGIN
    IF CODE = CLEARCODE THEN BEGIN
      GIFDOCLEAR;
      IF READCODE THEN;
      OLDCODE := CODE;
      FINCHAR := BYTE(CODE);
      OUTCODE[OUTCOUNT] := CODE;
      INC(OUTCOUNT);
    END ELSE BEGIN
      CURCODE := CODE;
      IF CODE >= FREECODE THEN BEGIN
        CURCODE := OLDCODE;
        OUTCODE[OUTCOUNT] := FINCHAR;
        INC(OUTCOUNT);
      END;

      IF CURCODE > EOFCODE THEN REPEAT
    OUTCODE[OUTCOUNT] := SUFFIX[CURCODE];
    INC(OUTCOUNT);
        CURCODE := PREFIX[CURCODE];
      UNTIL CURCODE < EOFCODE;

      FINCHAR := BYTE(CURCODE);
      OUTCODE[OUTCOUNT] := CURCODE;
      FOR I := OUTCOUNT DOWNTO 0 DO PUTPIXEL(OUTCODE[I]);
      OUTCOUNT := 0;

      PREFIX[FREECODE] := OLDCODE;
      SUFFIX[FREECODE] := FINCHAR;
      OLDCODE          := CODE;
      INC(FREECODE);
      IF FREECODE >= MAXCODE THEN BEGIN
        IF CODESIZE < 12 THEN BEGIN
          INC(CODESIZE);
          MAXCODE := MAXCODE SHL 1;
          READMASK := MASKS[CODESIZE-3];
        END;
      END;
    END;
(*
{ HIERDURCH WIRD'S ETWAS LANGSAMER, ABER DER LADEVORGANG KANN JEDERZEIT
  ABGEBROCHEN WERDEN
}
    IF KEYPRESSED THEN IF READKEY = ^[ THEN AUS;
*)
  END; { WHILE READCODE }
  IF CODE = EOFCODE THEN BEGIN
    SOUND(3000);
    DELAY(100);
    NOSOUND;
  END ELSE WRITE(#7);
END; { LADEBILD }

{ ENDE DES KERNS DES GIF- DECODERS }
{---------------------------------------------------------------------}


BEGIN { MAIN }
  IF PARAMCOUNT = 0 THEN BEGIN
    WRITELN('Eingabe : GIFMINI Filename[.GIF]');
    HALT;
  END;

  FN := PARAMSTR(1);
  IF POS('.',FN) = 0 THEN FN := FN + '.GIF';

  ASSIGN(F,FN);
{ MIT FILEMODE := 0 KÖNNEN AUCH READ- ONLY- FILES GELESEN WERDEN ! }
  FILEMODE := 0; { FILE F ÖFFNEN NUR LESEN }
  RESET(F,1);
  I := LIESHDR;
  IF I >= 0 THEN BEGIN
    ZEIGEHDR; { KANN NATÜRLICH ENTFALLEN }
    GRAPHEIN;
    LADEBILD;
    CLOSE(F); { NUR NÖTIG, WENN MEHRERE BILDER NACHEINANDER GELESEN WERDEN }
  END ELSE BEGIN
    WRITELN('Fehler ',I,' im GIF- Header');
    HALT;
  END;

  IF READKEY = ^[ THEN;
  AUS;
END.
{
  WENN SIE DAS PROGRAMM GUT FINDEN, KÖNNEN SIE AUCH DAS KOMPLETTE PROGRAMM
  KOSTENLOS BEKOMMEN.
  DIES VERFÜGT ÜBER EINE FILESELECTOR- BOX,
  EINE MÖGLICHKEIT, SLIDESHOWS ZU MACHEN,
  MIT DEM ADLIB- SYNTHESIZER LIEDER ZU SPIELEN, ES LÄDT SOGAR BEI BEDARF
  DEN ADLIB- TREIBER AUTOMATISCH ( SOUND.COM UND PLAYROL.EXE WERDEN ALS
  EXTERNE PROGRAMME BENÖTIGT ),
  AUCH EINE ZUFALLSGESTEUERTE AUSWAHL VON BILDERN UND LIEDERN IST MÖGLICH.

  ----- A B E R -----

  DAS KOMPLETTE PROGRAMM FUNKTIONERT NUR MIT VGA'S, DIE MIT DEM TSENG- LABS
  CHIP ET 3000 ODER ET 4000 BESTÜCKT SIND, UND SIE BRAUCHEN ZUM COMPILIEREN
  DES PROGRAMMS DIE TOOLBOX TURBO PROFESSIONAL
}