home *** CD-ROM | disk | FTP | other *** search
/ Computer Club Elmshorn Atari PD / CCE_PD.iso / mac / 0300 / CCE_0385.ZIP / CCE_0385.PD / SAVE_IMG / GEMIMAGE.I < prev    next >
Text File  |  1991-06-29  |  7KB  |  214 lines
  1. IMPLEMENTATION MODULE GemImage;
  2.  
  3.   (* Modul zur Erzeugung von gepackten GEM-Image-Files 
  4.      Version 1.0, vom 29.6.1991, (c) by JauTeam
  5.      Erstellt von: Peter Oleski und Christian Felsch
  6.      mit         : MegaMax Modula 2, Vers. 4.1
  7.      
  8.      Anfragen    : E-Mail Christian Felsch @HH (Maus Hamburg)
  9.   *)
  10.  
  11.  
  12.  FROM Binary      IMPORT WriteBlock, WriteByte;
  13.  FROM Files       IMPORT File, Close, Access, Create, ReplaceMode;
  14.  FROM SYSTEM      IMPORT CAST, ADDRESS;
  15.  
  16.  
  17.  TYPE   bits       = SET OF [0..7];
  18.         DatenForm  = (schwarz,weiss,muster,bitstr,nix);
  19.         IMGHeader  = RECORD                             (* der IMG-Header 
  20.                       version,                             gemäß DRI      *)
  21.                       kopflaenge,
  22.                       farbebenen,
  23.                       musterlaenge,
  24.                       pixelbreite,
  25.                       pixelhoehe,
  26.                       bildbreite,
  27.                       bildhoehe   :CARDINAL;
  28.                      END(*RECORD*);
  29.                      
  30.  CONST  Weiss      = bits{};
  31.         Schwarz    = bits{0..7};
  32.  
  33.  
  34.  VAR Image         : File;
  35.      bild          : POINTER TO ARRAY [0..MaxLCard] OF bits; (* Zeiger auf das Bild  *) 
  36.      Zeile,        
  37.      GleicheZeilen,
  38.      ModeAnzahl,   
  39.      BytesProZeile, 
  40.      LastBildByte  : LONGCARD;
  41.      LastMode      : DatenForm;
  42.  
  43.  
  44.  PROCEDURE ZeilenGleich(zeile:LONGCARD): BOOLEAN; (* vergleicht zwei auf-     *)
  45.   VAR pos,start,ende: LONGCARD;                   (* einander folgende Zeilen *)
  46.                                                   (* auf Gleiheit             *)
  47.   BEGIN
  48.    start:=zeile * BytesProZeile;
  49.    ende:=start + BytesProZeile-1;
  50.    pos:=start;
  51.    WHILE (pos+BytesProZeile <= LastBildByte) AND (pos<ende)
  52.                   AND (bild^[pos] = bild^[pos+BytesProZeile]) DO
  53.     INC(pos);
  54.    END(*FOR*);
  55.    RETURN (pos=ende);
  56.   END ZeilenGleich;
  57.  
  58.  
  59.  PROCEDURE Solid(farbe: bits; byte: LONGCARD):BOOLEAN; (* testet byte auf weiss *)
  60.                                                        (* oder schwarz *)
  61.   BEGIN
  62.    RETURN (bild^[byte]=farbe);
  63.   END Solid;
  64.  
  65.  
  66.  PROCEDURE IstMuster(last,byte: LONGCARD):BOOLEAN;     (* testet 4 byte auf  *)
  67.                                                        (* muster *)
  68.   BEGIN
  69.    IF byte+3 <= last THEN
  70.     RETURN ((bild^[byte] = bild^[byte+2]) AND (bild^[byte+1] = bild^[byte+3]));
  71.    ELSE
  72.     RETURN FALSE;
  73.    END(*IF*);
  74.   END IstMuster;
  75.  
  76.  
  77.  PROCEDURE Speichern(mode:DatenForm; byte:LONGCARD);  (* zählt wie oft ein      *)
  78.   VAR daten: bits;                                    (* gleicher Mode vorkommt *)
  79.       p    : LONGCARD;                                (* und speichert diesen   *)
  80.   
  81.   BEGIN
  82.    IF (mode = LastMode) THEN
  83.     INC(ModeAnzahl);
  84.    ELSE
  85.     IF ModeAnzahl > 0 THEN
  86.      CASE LastMode OF
  87.       schwarz:WHILE ModeAnzahl > 127 DO
  88.                 WriteByte(Image,$FF);                  (* 127 schwarze Bytes *)
  89.                 DEC(ModeAnzahl,127);
  90.               END(* WHILE *);
  91.               daten:=CAST(bits,ModeAnzahl);
  92.               INCL(daten,7);
  93.               WriteByte(Image,daten);|
  94.       weiss  :WHILE ModeAnzahl > 127 DO
  95.                WriteByte(Image,$7F);                       (* 127 weiße Bytes *)
  96.                DEC(ModeAnzahl,127);
  97.               END(* WHILE *);
  98.               daten:=CAST(bits,ModeAnzahl);
  99.               EXCL(daten,7);
  100.               WriteByte(Image,daten);|
  101.       muster :WriteByte(Image,$0);                (* Muster geht bis max 4080 *) 
  102.               WriteByte(Image,CHR(ModeAnzahl));   (* Punkte breit             *)
  103.               WriteByte(Image,bild^[byte-2]);
  104.               WriteByte(Image,bild^[byte-1]);|
  105.       bitstr :WHILE ModeAnzahl > 255 DO                (* ungepackt speichern *)
  106.                WriteByte(Image,$80);
  107.                WriteByte(Image,$FF);
  108.                FOR p:=0 TO 254 DO
  109.                 WriteByte(Image,bild^[byte-ModeAnzahl+p]);
  110.                END(*FOR*);
  111.                DEC(ModeAnzahl,255);
  112.                INC(byte,256);
  113.               END;(* while *)   
  114.               WriteByte(Image,$80);
  115.               WriteByte(Image,CHR(ModeAnzahl));
  116.               FOR p:=0 TO ModeAnzahl-1 DO
  117.                WriteByte(Image,bild^[byte-ModeAnzahl+p]);
  118.               END(*FOR*);|
  119.      END(*CASE*);
  120.      LastMode:=mode;
  121.      ModeAnzahl:=1;
  122.     ELSE
  123.      LastMode:=mode;
  124.      INC(ModeAnzahl);
  125.     END(*IF*);
  126.    END(*IF*);
  127.   END Speichern;
  128.  
  129.  
  130.  PROCEDURE ScanZeileZerlegen(zeile: LONGCARD);        (* zerlegt eine Zeile *)
  131.   VAR start,ende,pos: LONGCARD;                       (* in Modes           *)
  132.  
  133.   BEGIN
  134.    ModeAnzahl:=0;
  135.    LastMode:=nix;
  136.    start:=zeile * BytesProZeile;
  137.    ende:=start + BytesProZeile - 1;
  138.    pos:=start;
  139.    WHILE pos <= ende DO
  140.     IF Solid(Schwarz,pos) THEN
  141.      Speichern(schwarz,pos);
  142.     ELSIF Solid(Weiss,pos) THEN
  143.      Speichern(weiss,pos);
  144.     ELSIF IstMuster(ende,pos) THEN
  145.      Speichern(muster,pos);
  146.      INC(pos);
  147.     ELSE
  148.      Speichern(bitstr,pos);
  149.     END(*IF*);
  150.     INC(pos);
  151.    END(*WHILE*);
  152.    Speichern(nix,pos);
  153.   END ScanZeileZerlegen;
  154.  
  155.  
  156.  PROCEDURE MakeHeader(hdr: SmallHeader; name: ARRAY OF CHAR):BOOLEAN;
  157.   VAR bigHdr: IMGHeader;                            (* speichert den kompletten *)
  158.                                                     (* Header ab                *)
  159.   BEGIN
  160.    WITH bigHdr DO
  161.     version     :=hdr.version;
  162.     kopflaenge  :=8;
  163.     farbebenen  :=1;
  164.     musterlaenge:=2;
  165.     pixelbreite :=hdr.pixelbreite;
  166.     pixelhoehe  :=hdr.pixelhoehe;
  167.     bildbreite  :=hdr.bildbreite;
  168.     bildhoehe   :=hdr.bildhoehe;
  169.    END(*WITH*);
  170.    IF bigHdr.bildbreite > 4080 THEN
  171.     RETURN FALSE;
  172.    ELSE;
  173.     Create(Image,name,writeOnly,replaceOld);
  174.     WriteBlock(Image,bigHdr);
  175.     RETURN TRUE;
  176.    END(*IF*);
  177.   END MakeHeader;
  178.     
  179.         
  180.  PROCEDURE BitImageSpeichern(data:ADDRESS; header: SmallHeader; 
  181.                                         filename: ARRAY OF CHAR):BOOLEAN;
  182.   BEGIN
  183.    bild:=data;
  184.    IF MakeHeader(header,filename) THEN
  185.    
  186.     BytesProZeile:= header.bildbreite DIV 8;
  187.     LastBildByte:=(LONG(header.bildbreite) * LONG(header.bildhoehe) DIV 8)-1;
  188.    
  189.     Zeile:=0;
  190.     GleicheZeilen:=1;
  191.     WHILE Zeile < LONG( header.bildhoehe) DO
  192.      IF (ZeilenGleich(Zeile)) AND (GleicheZeilen < 255) THEN
  193.       INC(GleicheZeilen);                                     (* test auf VRC *)
  194.      ELSIF GleicheZeilen<>1 THEN
  195.          WriteByte(Image,$0);
  196.          WriteByte(Image,$0);
  197.          WriteByte(Image,$FF);
  198.          WriteByte(Image,CHR(GleicheZeilen));
  199.          ScanZeileZerlegen(Zeile);
  200.          GleicheZeilen:=1;
  201.         ELSE
  202.          ScanZeileZerlegen(Zeile);
  203.       END(*IF*);
  204.      INC(Zeile);
  205.     END(*WHILE*);
  206.     Close(Image);
  207.     RETURN TRUE;
  208.    ELSE
  209.     RETURN FALSE;
  210.    END(*IF*);
  211.   END BitImageSpeichern;
  212.   
  213. END GemImage.
  214.