home *** CD-ROM | disk | FTP | other *** search
/ Merciful 5 / Merciful - Disc 5.iso / software / p / pcqpascalv1.2d.lha / Examples / EasyIFF.p < prev    next >
Encoding:
Text File  |  1992-02-17  |  3.4 KB  |  150 lines
  1. Program EasyIFF;
  2.  
  3. {
  4.     EasyExample - A simple ILBM file viewer by Christian A. Weber
  5.     This program is in the public domain, use at your own risk.
  6.     Requires the iff.library in the LIBS: dircetory.
  7.  
  8.     This Pascal program is Weber's C program EasyExample.c re-written
  9.     in PCQ Pascal.
  10.  
  11. }
  12.  
  13. {$I "Include:Graphics/GFXBase.i"}
  14. {$I "Include:Intuition/Intuition.i"}
  15. {$I "Include:Libraries/IFF.i"}
  16. {$I "Include:Exec/Libraries.i"}
  17. {$I "Include:Graphics/View.i"}
  18. {$I "Include:Libraries/DOS.i"}
  19. {$I "Include:Utils/StringLib.i"}
  20. {$I "Include:Utils/Parameters.i"}
  21.  
  22. Const
  23.     GfxBase    : GfxBasePtr = Nil;
  24.     IFile    : IFFFILE = Nil;
  25.     MyScreen    : ScreenPtr = Nil;
  26.  
  27. Const
  28.     NS    : NewScreen = (0,0,0,0,0,0,0,0, CUSTOMSCREEN_f or SCREENQUIET_f,
  29.             Nil, "Simple ILBM viewer by Christian A. Weber",
  30.             Nil,Nil);
  31.  
  32.  
  33.  
  34. Procedure SetOverscan(Screen : ScreenPtr);
  35. { Adjust the screen position for overscan }
  36. var
  37.     cols,rows    : Short;
  38.     x,y        : Short;
  39.  
  40.     vp        : ViewPortPtr;
  41.  
  42. begin
  43.     x := Screen^.Width;
  44.     y := Screen^.Height;
  45.  
  46.     vp := @Screen^.SViewPort;
  47.  
  48.     cols := GfxBase^.NormalDisplayColumns div 2;
  49.     rows := GfxBase^.NormalDisplayRows;
  50.     if rows > 300 then
  51.     rows := rows div 2;
  52.     x := x - cols;
  53.     if (vp^.Modes and HIRES) <> 0 then
  54.     x := x - cols;
  55.     y := y - rows;
  56.     if (vp^.Modes and LACE) <> 0 then
  57.     y := y - rows;
  58.     x := x div 2;
  59.     if x < 0 then
  60.     x := 0;
  61.     y := y div 2;
  62.     if y < 0 then
  63.     y := 0;
  64.     if y > 32 then
  65.     y := 32;
  66.  
  67.     { Correct overscan HAM color distortions }
  68.  
  69.     if (vp^.Modes and HAM) <> 0 then begin
  70.     if ViewPtr(GfxBase^.ActiView)^.DxOffset-x < 96 then
  71.         x := View(GfxBase^.ActiView^).DxOffset-96;
  72.     end;
  73.     vp^.DxOffset := -x;
  74.     vp^.DyOffset := -y;
  75.     MakeScreen(Screen);
  76.     RethinkDisplay();
  77. end;
  78.  
  79.  
  80. Procedure Fail(Error : String);    { Print error message, free resources and exit }
  81. begin
  82.     Writeln(Error, ', IFFError = ', IFFError);
  83.  
  84.     if IFile <> Nil then
  85.     CloseIFF(IFile);
  86.     if MyScreen <> Nil then
  87.     CloseScreen(MyScreen);
  88.  
  89.     if IFFBase <> Nil then
  90.     CloseLibrary(IFFBase);    { MUST ALWAYS BE CLOSED !! }
  91.     CloseLibrary(LibraryPtr(GfxBase));
  92.     Exit(0);
  93. end;
  94.  
  95. var
  96.     Count,i    : Short;
  97.     BMHD    : BitMapHeaderPtr;
  98.     ColorTable    : Array [0..127] of Short;
  99.     FileName    : String;
  100. begin
  101.     FileName := AllocString(256);
  102.     GetParam(1,FileName);
  103.  
  104.     if (strlen(FileName) = 0) or streq(FileName,"?") then begin
  105.     Writeln("Format: EasyIFF filename");
  106.     exit(10);
  107.     end;
  108.  
  109.     GfxBase := GfxBasePtr(OpenLibrary("graphics.library",0));
  110.  
  111.     IFFBase := OpenLibrary(IFFNAME, IFFVERSION);
  112.     if IFFBase = Nil then begin
  113.     Writeln('Copy the iff.library to your LIBS: directory!');
  114.     Exit(10);
  115.     end;
  116.  
  117.     Write('Loading file ', FileName, ' ...');
  118.  
  119.     IFile := OpenIFF(FileName);
  120.     if IFile = Nil then
  121.     Fail("Error opening file");
  122.     BMHD := GetBMHD(IFile);
  123.     if BMHD = Nil then
  124.     Fail("BitMapHeader not found");
  125.  
  126.     with NS do begin
  127.     Width      := BMHD^.w;
  128.     Height     := BMHD^.h;
  129.     Depth      := BMHD^.nPlanes;
  130.     ViewModes  := GetViewModes(IFile);
  131.     end;
  132.  
  133.     MyScreen := OpenScreen(@NS);
  134.     if MyScreen = Nil then
  135.     Fail("Can't open screen!");
  136.     SetOverscan(MyScreen);
  137.  
  138.     Count := GetColorTab(IFile, @ColorTable);
  139.     if count > 32 then
  140.     count := 32;    { Some HAM pictures have 64 colors ?! }
  141.     LoadRGB4(@MyScreen^.SViewPort,@ColorTable,Count);
  142.  
  143.     if not DecodePic(IFile,@MyScreen^.SBitMap) then
  144.     Fail("Can't decode picture");
  145.  
  146.     Delay(200);
  147.     Fail("done");     { Normal termination }
  148. end.
  149.  
  150.