home *** CD-ROM | disk | FTP | other *** search
/ Amiga MA Magazine 1998 #6 / amigamamagazinepolishissue1998.iso / coders / jËzyki_programowania / oberon / system / amigaiff.mod (.txt) < prev    next >
Oberon Text  |  1977-12-31  |  12KB  |  345 lines
  1. Syntax20b.Scn.Fnt
  2. ParcElems
  3. Alloc
  4. Syntax24b.Scn.Fnt
  5. Syntax10.Scn.Fnt
  6. Syntax10b.Scn.Fnt
  7. FoldElems
  8. (* AMIGA *)
  9. MODULE AmigaIFF; (* Ralf Degner 04.08.1995 *)
  10. IMPORT
  11.     SYSTEM, i:=AmigaIFFParse, Amiga, G:=AmigaGraphics, AmigaIntuition, Display, Pictures, PictureFrames, Log;
  12. CONST
  13.     FORM*=0464F524DH; FTXT*=046545854H; CHRS*=043485253H; OBRO*=04F42524FH;
  14.     ILBM*=0494C424DH; BMHD*=424D4844H; CMAP*=434D4150H; CAMG*=43414D47H; BODY*=0424F4459H;
  15.     mskNone*=0; mskHasMask*=1; cmpNone*=0; cmpByteRun1*=1; (* for Bitmapheader *)
  16.     WindowPtr = POINTER TO AmigaIntuition.Window;
  17.     ScreenPtr = POINTER TO AmigaIntuition.Screen;
  18.     BitmapPtr=POINTER TO G.BitMap;
  19.     RPPtr=POINTER TO G.RastPort;
  20.     BitmapHeaderPtr*= POINTER TO BitmapHeader;
  21.     BitmapHeader*= RECORD
  22.         w*, h*, x*, y*: INTEGER;
  23.         nPlanes*: CHAR;
  24.         masking*, compression*, pad1*: SHORTINT;
  25.         transparentColor*: INTEGER;
  26.         xAspect*, yAspect*: SHORTINT;
  27.         pageWidth*, pageHeight*: INTEGER
  28.     END;
  29. (* Test Color of a Picture, if there is only black, use Colors of Display *)
  30. PROCEDURE TestSetPictColor(P: Pictures.Picture);
  31.         i, k, r, g, b: INTEGER;
  32.         status: BOOLEAN;
  33. BEGIN
  34.     status:=FALSE;k:=SHORT(ASH(1, P.depth));i:=0;
  35.     REPEAT
  36.         Pictures.GetColor(P, i, r, g, b);
  37.         status:=status OR (r#0) OR (g#0) OR (b#0);
  38.         INC(i)
  39.     UNTIL status OR (i=k);
  40.     IF ~status THEN
  41.         FOR i:=0 TO SHORT(ASH(1, P.depth)-1) DO
  42.             Display.GetColor(i,r,g,b);
  43.             Pictures.SetColor(P,i,r,g,b)
  44.         END
  45. END TestSetPictColor;
  46. (* Procedures for working with ILBMs *)
  47. PROCEDURE StoreBMHD*(iff: i.IFFHandlePtr; w, h, planes: INTEGER; compr: SHORTINT);
  48.         b: BitmapHeader;
  49.         error: LONGINT;
  50. BEGIN
  51.     b.w:=w; b.h:=h; b.x:=0; b.y:=0; b.nPlanes:=CHR(planes);
  52.     b.masking:=mskNone; b.compression:=compr; b.pad1:=0;
  53.     b.transparentColor:=0; b.xAspect:=1; b.yAspect:=1;
  54.     b.pageWidth:=w; b.pageHeight:=h;
  55.     IF i.PushChunk(iff, 0, BMHD, i.sizeUnknown)=0 THEN
  56.         error:=i.WriteChunkBytes(iff, SYSTEM.ADR(b), SIZE(BitmapHeader));
  57.         error:=i.PopChunk(iff)
  58. END StoreBMHD;
  59. PROCEDURE LoadDisplayColors*(iff: i.IFFHandlePtr);
  60.         buffer: ARRAY 768 OF CHAR;
  61.         n, anz: LONGINT;
  62.         Count: INTEGER;
  63.         cn: i.ContextNodePtr;
  64. BEGIN
  65.     IF i.StopChunk(iff, ILBM, CMAP)=0 THEN
  66.         IF i.ParseIFF(iff, i.parseScan)=0 THEN
  67.             cn:=i.CurrentChunk(iff);
  68.             IF cn#NIL THEN
  69.                 anz:=(i.ReadChunkBytes(iff, SYSTEM.ADR(buffer), 768)) DIV 3;
  70.                 n:=ASH(1, Amiga.Depth);
  71.                 IF anz<n THEN n:=anz END;
  72.                 FOR Count:=0 TO SHORT(n)-1 DO
  73.                     Display.SetColor(Count, ORD(buffer[Count*3]), ORD(buffer[Count*3+1]), ORD(buffer[Count*3+2]))
  74.                 END
  75.             END
  76.         END
  77. END LoadDisplayColors;
  78. PROCEDURE StoreDisplayColors*(iff: i.IFFHandlePtr);
  79.         buffer: ARRAY 768 OF CHAR;
  80.         n, error: LONGINT;
  81.         Count, r, g, b: INTEGER;
  82. BEGIN
  83.     IF i.PushChunk(iff, 0, CMAP, i.sizeUnknown)=0 THEN
  84.         n:=ASH(1, Amiga.Depth);
  85.         FOR Count:=0 TO SHORT(n)-1 DO
  86.             Display.GetColor(Count, r, g, b);
  87.             buffer[Count*3]:=CHR(r);
  88.             buffer[Count*3+1]:=CHR(g);
  89.             buffer[Count*3+2]:=CHR(b)
  90.         END;
  91.         error:=i.WriteChunkBytes(iff, SYSTEM.ADR(buffer), n*3);
  92.         error:=i.PopChunk(iff)
  93. END StoreDisplayColors;
  94. PROCEDURE StorePictureColors*(iff: i.IFFHandlePtr; pict: Pictures.Picture);
  95.         buffer: ARRAY 768 OF CHAR;
  96.         n, error: LONGINT;
  97.         Count, r, g, b: INTEGER;
  98. BEGIN
  99.     IF i.PushChunk(iff, 0, CMAP, i.sizeUnknown)=0 THEN
  100.         TestSetPictColor(pict);
  101.         n:=ASH(1, pict.depth);
  102.         FOR Count:=0 TO SHORT(n)-1 DO
  103.             Pictures.GetColor(pict, Count, r, g, b);
  104.             buffer[Count*3]:=CHR(r);
  105.             buffer[Count*3+1]:=CHR(g);
  106.             buffer[Count*3+2]:=CHR(b)
  107.         END;
  108.         error:=i.WriteChunkBytes(iff, SYSTEM.ADR(buffer), n*3);
  109.         error:=i.PopChunk(iff)
  110. END StorePictureColors;
  111. PROCEDURE StoreILBMBody*(iff: i.IFFHandlePtr; rastport: LONGINT; w, h, d: INTEGER);
  112.         maps: ARRAY 8 OF LONGINT;
  113.         error, plane, line: LONGINT;
  114.         wb, bpr: LONGINT;
  115.         bm: G.BitMapPointer;
  116.         rp: G.RastPortPointer;
  117. BEGIN
  118.     IF i.PushChunk(iff, 0, BODY, i.sizeUnknown)=0 THEN
  119.         rp:=SYSTEM.VAL(G.RastPortPointer, rastport);
  120.         bm:=SYSTEM.VAL(G.BitMapPointer, rp.bitMap);
  121.         wb:=((w+15)DIV 16)*2;
  122.         bpr:=bm.bytesPerRow;
  123.         FOR plane:=0 TO d-1 DO
  124.             maps[plane]:=bm.planes[plane]
  125.         END;
  126.         FOR line:=0 TO h-1 DO
  127.             FOR plane:=0 TO d-1 DO
  128.                 error:=i.WriteChunkBytes(iff, maps[plane], wb);
  129.                 INC(maps[plane], bpr)
  130.             END
  131.         END;
  132.         error:=i.PopChunk(iff)
  133. END StoreILBMBody;
  134. PROCEDURE StoreDisplayAsILBM*(iff: i.IFFHandlePtr);
  135.         error: LONGINT;
  136.         win: WindowPtr;
  137.         scr: ScreenPtr;
  138. BEGIN
  139.     IF i.PushChunk(iff, ILBM, FORM, i.sizeUnknown)=0 THEN
  140.         win:=SYSTEM.VAL(WindowPtr, Amiga.window);
  141.         scr:=SYSTEM.VAL(ScreenPtr, win.wScreen);
  142.         StoreBMHD(iff, scr.width, scr.height, Amiga.Depth, cmpNone);
  143.         StoreDisplayColors(iff);
  144.         StoreILBMBody(iff, SYSTEM.ADR(scr.rastPort), scr.width, scr.height, Amiga.Depth);
  145.         error:=i.PopChunk(iff)
  146. END StoreDisplayAsILBM;
  147. PROCEDURE StorePictAsILBM*(iff: i.IFFHandlePtr; p: Pictures.Picture);
  148.     VAR error: LONGINT;
  149. BEGIN
  150.     IF p#NIL THEN
  151.         IF i.PushChunk(iff, ILBM, FORM, i.sizeUnknown)=0 THEN
  152.             StoreBMHD(iff, p.width, p.height, p.depth, cmpNone);
  153.             StorePictureColors(iff, p);
  154.             StoreILBMBody(iff, p.rp, p.width, p.height, p.depth);
  155.             error:=i.PopChunk(iff)
  156.         END
  157. END StorePictAsILBM;
  158. PROCEDURE LoadPictBitmap(iff: i.IFFHandlePtr; p: Pictures.Picture; w, h, d, iffd, comp: INTEGER);
  159.         maps: ARRAY 8 OF LONGINT;
  160.         error, plane, line, len, ptr: LONGINT;
  161.         wb, bpr, restb: LONGINT;
  162.         bm: G.BitMapPointer;
  163.         rp: G.RastPortPointer;
  164.         DumBuf, DumBuf2: ARRAY 4096 OF CHAR;
  165.         DumAdr: LONGINT;
  166.     PROCEDURE GetByte(): CHAR;
  167.     BEGIN
  168.         INC(ptr);
  169.         IF ptr>=len THEN
  170.             len:=i.ReadChunkBytes(iff, DumAdr, 4096);
  171.             ptr:=0
  172.         END;
  173.         RETURN DumBuf[ptr]
  174.     END GetByte;
  175.     PROCEDURE ReadPackedLine(Dest: LONGINT);
  176.         VAR
  177.             Nr: LONGINT;
  178.             Wert: SHORTINT;
  179.             Count: INTEGER;
  180.             ch: CHAR;
  181.     BEGIN
  182.         Nr:=0;
  183.         REPEAT
  184.             Wert:=SYSTEM.VAL(SHORTINT, GetByte());
  185.             IF Wert>=0 THEN
  186.                 FOR Count:=0 TO Wert DO
  187.                     ch:=GetByte();
  188.                     IF Nr<bpr THEN SYSTEM.PUT(Nr+Dest, ch) END;
  189.                     INC(Nr)
  190.                 END
  191.             ELSIF Wert#-128 THEN
  192.                 ch:=GetByte();
  193.                 FOR Count:=0 TO ABS(Wert) DO
  194.                     IF Nr<bpr THEN SYSTEM.PUT(Nr+Dest, ch) END;
  195.                     INC(Nr)
  196.                 END
  197.             END
  198.         UNTIL Nr=wb
  199.     END ReadPackedLine;
  200.     PROCEDURE SkipPackedLine();
  201.         VAR
  202.             Nr: LONGINT;
  203.             Wert: SHORTINT;
  204.             Count: INTEGER;
  205.             ch: CHAR;
  206.     BEGIN
  207.         Nr:=0;
  208.         REPEAT
  209.             Wert:=SYSTEM.VAL(SHORTINT, GetByte());
  210.             IF Wert>=0 THEN
  211.                 FOR Count:=0 TO Wert DO
  212.                     ch:=GetByte();
  213.                     INC(Nr)
  214.                 END
  215.             ELSIF Wert#-128 THEN
  216.                 ch:=GetByte();
  217.                 FOR Count:=0 TO ABS(Wert) DO
  218.                     INC(Nr)
  219.                 END
  220.             END
  221.         UNTIL Nr=wb
  222.     END SkipPackedLine;
  223. BEGIN
  224.     rp:=SYSTEM.VAL(G.RastPortPointer, p.rp);
  225.     bm:=SYSTEM.VAL(G.BitMapPointer, rp.bitMap);
  226.     bpr:=bm.bytesPerRow;
  227.     wb:=((w+15) DIV 16)*2;
  228.     restb:=wb-bpr; IF restb<0 THEN restb:=0 END;
  229.     DumAdr:=SYSTEM.ADR(DumBuf);
  230.     FOR plane:=0 TO d-1 DO
  231.         maps[plane]:=bm.planes[plane]
  232.     END;
  233.     IF comp=0 THEN                            (* No Compression *)
  234.         FOR line:=0 TO h-1 DO
  235.             FOR plane:=0 TO iffd-1 DO
  236.                 IF plane<d THEN
  237.                     error:=i.ReadChunkBytes(iff, maps[plane], bpr);
  238.                     INC(maps[plane], bpr);
  239.                     IF restb#0 THEN
  240.                         error:=i.ReadChunkBytes(iff, DumAdr, restb)
  241.                     END
  242.                 ELSE
  243.                     error:=i.ReadChunkBytes(iff, DumAdr, wb)
  244.                 END
  245.             END
  246.         END
  247.     ELSIF comp=cmpByteRun1 THEN        (* ByteRun1 Copression *)
  248.         len:=0; ptr:=0;
  249.         FOR line:=0 TO h-1 DO
  250.             FOR plane:=0 TO iffd-1 DO
  251.                 IF plane<d THEN
  252.                     ReadPackedLine(maps[plane]);
  253.                     INC(maps[plane], bpr)
  254.                 ELSE
  255.                     ReadPackedLine(SYSTEM.ADR(DumBuf2))
  256.                 END
  257.             END
  258.         END
  259. END LoadPictBitmap;
  260. PROCEDURE LoadILBMToPict*(iff: i.IFFHandlePtr): Pictures.Picture;
  261.         len, colors: LONGINT;
  262.         cn: i.ContextNodePtr;
  263.         bh: BitmapHeader;
  264.         CB: ARRAY 768 OF CHAR;
  265.         bhLoaded: BOOLEAN;
  266.         P: Pictures.Picture;
  267.         Planes, Count, OriPlanes: INTEGER;
  268. BEGIN
  269.     colors:=0; bhLoaded:=FALSE;
  270.     IF (i.StopChunk(iff, ILBM, BMHD)=0)
  271.     & (i.StopChunk(iff, ILBM, CMAP)=0)
  272.     & (i.StopChunk(iff, ILBM, BODY)=0) THEN
  273.         WHILE i.ParseIFF(iff, i.parseScan)=0 DO
  274.             cn:=i.CurrentChunk(iff);
  275.             IF cn.id=BMHD THEN
  276.                 IF bhLoaded THEN RETURN NIL END;
  277.                 len:=i.ReadChunkBytes(iff, SYSTEM.ADR(bh), SIZE(BitmapHeader));
  278.                 IF len=SIZE(BitmapHeader) THEN bhLoaded:=TRUE; Planes:=ORD(bh.nPlanes) END
  279.             ELSIF cn.id=CMAP THEN
  280.                 len:=i.ReadChunkBytes(iff, SYSTEM.ADR(CB), 768);
  281.                 colors:=len DIV 3
  282.             ELSIF cn.id=BODY THEN
  283.                 IF bhLoaded THEN
  284.                     OriPlanes:=ORD(bh.nPlanes);
  285.                     IF bh.masking=mskHasMask THEN INC(OriPlanes) END;
  286.                     IF colors#ASH(1, OriPlanes) THEN
  287.                         Log.Str("Can not load HAM or EHB pictures !"); Log.Ln;
  288.                         RETURN NIL
  289.                     END;
  290.                     IF (bh.compression#0) & (bh.compression#cmpByteRun1) THEN
  291.                         Log.Str("Unknown compression !");Log.Ln; RETURN NIL
  292.                     END;
  293.                     NEW(P); P.notify:=PictureFrames.NotifyDisplay;
  294.                     IF Planes>Amiga.Depth THEN Planes:=Amiga.Depth END;
  295.                     Pictures.Create(P, bh.w, bh.h, Planes);
  296.                     IF P=NIL THEN RETURN NIL END;
  297.                     P.notify := PictureFrames.NotifyDisplay;
  298.                     LoadPictBitmap(iff, P, bh.w, bh.h, Planes, OriPlanes, bh.compression);
  299.                     IF colors#0 THEN
  300.                         FOR Count:=0 TO SHORT(colors)-1 DO
  301.                             Pictures.SetColor(P, Count, ORD(CB[Count*3]), ORD(CB[Count*3+1]), ORD(CB[Count*3+2]))
  302.                         END
  303.                     END;
  304.                     RETURN P
  305.                 END
  306.             END
  307.         END
  308. END LoadILBMToPict;
  309. PROCEDURE FitColors*(P: Pictures.Picture);
  310.         Map, dr, dg, db: ARRAY 256 OF INTEGER;
  311.         CountP, CountD: INTEGER;
  312.         r, g, b, Col, x, y: INTEGER;
  313.         sr, sg, sb, n, l: LONGINT;
  314. BEGIN
  315.     Log.Str("Saerching for new colors ..."); Log.Ln;
  316.     FOR CountD:=0 TO 255 DO
  317.         Display.GetColor(CountD, dr[CountD], dg[CountD], db[CountD])
  318.     END;
  319.     FOR CountP:=0 TO SHORT(ASH(1, P.depth))-1 DO
  320.         Pictures.GetColor(P, CountP, r, g, b);
  321.         l:=256*256*3;
  322.         FOR CountD:=0 TO SHORT(ASH(1, Amiga.Depth))-1 DO
  323.             sr:=dr[CountD]-r; sg:=dg[CountD]-g; sb:=db[CountD]-b;
  324.             n:=sr*sr+sg*sg+sb*sb;
  325.             IF n<l THEN l:=n; Col:=CountD END
  326.         END;
  327.         Map[CountP]:=Col
  328.     END;
  329.     Log.Str("Converting picture ");
  330.     FOR x:=0 TO P.width-1 DO
  331.         IF (x MOD 16)=0 THEN Log.Ch(".") END;
  332.         FOR y:=0 TO P.height-1 DO
  333.             Pictures.Dot(P, Map[Pictures.Get(P, x, y)], x, y, Display.replace)
  334.         END
  335.     END;
  336.     P.depth:=Amiga.Depth;
  337.     FOR CountD:=0 TO SHORT(ASH(1, P.depth))-1 DO
  338.         Pictures.SetColor(P, CountD, dr[CountD], dg[CountD], db[CountD])
  339.     END;
  340.     Log.Ln;
  341.     Pictures.Update(P, 0, 0, P.width, P.height)
  342. END FitColors;
  343. END AmigaIFF.
  344. System.Free AmigaIFF ~
  345.