home *** CD-ROM | disk | FTP | other *** search
/ Mega CD-ROM 1 / megacd_rom_1.zip / megacd_rom_1 / GIFUTL / GIF.ZIP / GIFEGA10.PAS < prev    next >
Pascal/Delphi Source File  |  1988-02-09  |  22KB  |  802 lines
  1. program gifega;
  2.  
  3. {Version 1.0, written 1/18/88-2/7/88 by Jim Griebel. This software is
  4. experimental! USE AT YOUR OWN RISK. In the public domain. 'GIF' and
  5. 'Graphics Interchange Format' are trademarks of Compuserve, Inc., an H&R
  6. Block Company. 'Turbo Pascal' is a trademark of Borland International.}
  7.  
  8. {Includes for external .OBJ files}
  9.  
  10. {$L nlzw}
  11. {$L readrast}
  12. {$L scrsave}
  13. {$L scroll}
  14.  
  15. {Turbo standard UNITS}
  16.  
  17. uses crt,dos;
  18.  
  19. type
  20.  
  21. {Our 64,000-byte array, used for practically everything}
  22.     RasterArray = Array [0..63999] of byte;
  23.     RasterP = ^RasterArray;
  24.  
  25. {Except the EGA bitplanes, which are kept here}
  26.     Bitplane = Array [0..38399] of byte;
  27.     PlaneP = ^BitPlane;
  28.  
  29.     Palarray = Array [0..255] of byte;
  30.     Str12 = String [12];
  31.     Str80 = String [80];
  32.  
  33. var
  34.     GIFFile:File of RasterArray;     {GIF input file}
  35.     ScrFile:File of Byte;            {Output file if desired}
  36.     GifStuff:RasterP;                {Heap array for GIF file}
  37.     Raster:RasterP;                  {Unblocked GIF data stream}
  38.     Raster2:RasterP;                 {More unblocked stream if needed}
  39.     Plane0,Plane2,Plane1,Plane3:PlaneP; {EGA bitplanes, for scroll & save}
  40.     Regs:Registers;                  {Turbo predefined variable}
  41.     DirInfo: SearchRec;              {Turbo predefined variable}
  42.  
  43.     Width,         {Read from GIF header, image width}
  44.     Height,        { ditto, image height}
  45.     LeftOfs,       { ditto, image offset from left}
  46.     TopOfs,        { ditto, image offset from top}
  47.     RWidth,        { ditto, raster width}
  48.     RHeight,       { ditto, raster height}
  49.     ClearCode,     {GIF clear code}
  50.     EOFCode,       {GIF end-of-information code}
  51.     MaxCode,       {Decompressor limiting value for current code size}
  52.     CurCode,       {Decompressor variable}
  53.     OldCode,       {Decompressor variable}
  54.     InCode,        {Decompressor variable}
  55.     FirstFree,     {First free code, generated per GIF spec}
  56.     Codesize,      {Size of code, computed from GIF header}
  57.     GIFPtr,        {Array pointer used during file read}
  58.     FreeCode,      {Next free code, used by decompressor}
  59.     ReadMask,      {Code AND mask for current code size}
  60.     I,J,K,         {Loop counters, what else?}
  61.     Bitmask,       {Used during read from compressed file}
  62.     ColorMapSize,  {Size of the colormap}
  63.     XDir,YDir,     {used for directory write to screen}
  64.     DirSize,       { Ditto }
  65.     FSize          {Size of bitplanes to write to output file}
  66.     :word;
  67.  
  68.  
  69.     Interlace,     {True if interlaced image}
  70.     NextRaster,    {True if file>64000 bytes}
  71.     Clear,         {True during clear}
  72.     ColorMap:      {True if colormap present}
  73.     Boolean;
  74.  
  75.     ch:char;       {Utility}
  76.  
  77.     a,             {Utility}
  78.     Resolution,    {Resolution, read from GIF header}
  79.     BitsPerPixel,  {Bits per pixel, read from GIF header}
  80.     Background,    {Background color, read from GIF header}
  81.     InitCodeSize,  {Starting code size, used during Clear}
  82.     FinChar,       {Decompressor variable}
  83.     Pass,          {Used by video output if interlaced pic}
  84.     R,G,B          {Red,Green,Blue values used during color comps}
  85.     :byte;
  86.  
  87.     Roll:Integer;  {Scroll offset value, an integer so
  88.                      we can tell when it goes <0}
  89.  
  90.     {The color map, read from the GIF header}
  91.     Red,Green,Blue: array [0..255] of word;
  92.  
  93.     {The EGA palette, derived from the color map}
  94.     Palette: PalArray;
  95.  
  96.     {Strings used for various purposes}
  97.     FileString:Str80;
  98.     UString:Str80;
  99.     Homedir:Str80;
  100.  
  101.     {Holds the directory strings}
  102.     NString:Array [0..255] of Str12;
  103.  
  104.     {An array of computed line starting values in EGA RAM, used to
  105.      make the program marginally faster}
  106.     LineStart:Array [0..479] of word;
  107.  
  108. Const
  109.     {MaxCode values for differing code sizes}
  110.     MaxCodes: Array [0..9] of Word = (4,8,16,$20,$40,$80,$100,$200,$400,$800);
  111.  
  112.     {Saves computing these values, Pascal having no exponentiation}
  113.     PowersOf2: Array [0..8] of word=(1,2,4,8,16,32,64,128,256);
  114.  
  115.     Rastersize:Word = 64000;
  116.     PlaneSize:Word = 38400;
  117.     EGAPage:Word = $A000;          {EGA video RAM segment address}
  118.     EGAHeight:Word = 350;            {Height of vanilla EGA screen}
  119.  
  120.     Nicepal: PalArray= (1,4,54,63,63,63,63,54,63,63,63,63,63,63,54,54,60,
  121.                         0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
  122.                         0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
  123.                         0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
  124.                         0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
  125.                         0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
  126.                         0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
  127.                         0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
  128.                         0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
  129.                         0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
  130.                         0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
  131.                         0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
  132.                         0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
  133.                         0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
  134.                         0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
  135.                         0,0,0,0,0,0,0,0,0,0,0,0,0,0,0);
  136.  
  137.  
  138. {Procedure declarations that bring our .OBJ externals into the program}
  139.  
  140. procedure nlzw; external;
  141.  
  142. procedure readrast; external;
  143.  
  144. procedure scrsave; external;
  145.  
  146. procedure Scroll; external;
  147.  
  148.  
  149. {Go to the bottom line and clear same out}
  150.  
  151. Procedure BottomLine;
  152.  
  153. Begin
  154.      GotoXY (2,24);
  155.      DelLine;
  156. End;
  157.  
  158.  
  159. {End the program gracefully, giving the user back a text video mode and
  160. returning him to the directory he started from}
  161.  
  162. Procedure Morgue;
  163.  
  164. Begin
  165.      Textmode (15);
  166.      ChDir (HomeDir);
  167.      Halt;
  168. End;
  169.  
  170. {Display the sorted directory listing}
  171.  
  172. Procedure ShowDir;
  173.  
  174. Var J:Word;
  175.  
  176. Begin
  177.  
  178. {List the filenames on the screen. If there are more than 20 then
  179. display them in two or more columns}
  180.  
  181.      ClrScr;
  182.      If DirSize=0 then Exit;
  183.      XDir:=2;
  184.      YDir:=3;
  185.      For J:=0 to DirSize do
  186.          Begin
  187.               GotoXY (XDir,YDir);
  188.               Writeln (NString [J]);
  189.               YDir:=Succ (YDir);
  190.               If YDir = 22 then
  191.                  Begin
  192.                       XDIR:=XDIR+15;
  193.                       YDIR:=3;
  194.                  End;
  195.          End;
  196.  
  197. End;
  198.  
  199. Procedure DoDir;
  200.  
  201. {Get and put up a sorted directory display of eligible files only; uses
  202. calls specific to Turbo. See the Turbo manual for a description of the
  203. calls used and their results}
  204.  
  205. Var Sortflag: Boolean;
  206.     I: Integer;
  207.  
  208. Begin
  209.  
  210. {Get the current directory}
  211.  
  212.      GetDir (0,UString);
  213.      I:=0;
  214.  
  215. {Find the first matching file, if any}
  216.  
  217.      FindFirst ('*.gif',Anyfile,DirInfo);
  218.      If DosError <> 0 then
  219.      Begin
  220.         Dirsize:=0;
  221.         Exit;
  222.      End;
  223.  
  224. {And subsequent, if any}
  225.  
  226.      NString [I]:=DirInfo.Name;
  227.      I:=Succ (I);
  228.      Repeat
  229.            FindNext (DirInfo);
  230.            If DosError =0 then
  231.            Begin
  232.               Nstring [I]:=DirInfo.Name;
  233.               I:=Succ (I);
  234.            End;
  235.      Until (DosError=18) or (I=256);
  236.  
  237. {Now sort the filenames alphabetically}
  238.  
  239.      Repeat
  240.      Sortflag:=False;
  241.      If I>2 then
  242.            For J:=0 to I-2 do
  243.                Begin
  244.                  If NString [J]>Nstring [J+1] then
  245.                     Begin
  246.                       NString [255]:=Nstring [J];
  247.                       NString [J]:=Nstring [J+1];
  248.                       NString [J+1]:=Nstring [255];
  249.                       Sortflag:=True;
  250.                     End;
  251.                End;
  252.      Until Sortflag=False;
  253.      DirSize:=I-1;
  254.  
  255. End;
  256.  
  257. {Save the currently displayed image as an EGA Paint .SCR file}
  258.  
  259. Procedure SaveScreen;
  260.  
  261. Begin
  262.  
  263. {Convert the input filename to the output filename.}
  264.  
  265.      I:=Pos ('.',Filestring);
  266.      Filestring:=Copy (Filestring,1,I);
  267.      If (Height<480) or (EGAHeight<480) then
  268.         Begin
  269.              Filestring:=Filestring+'SCR';
  270.              FSize:=28000;
  271.         End
  272.         Else
  273.         Begin
  274.             Filestring:=Filestring+'SCP';
  275.             FSize:=38400;
  276.         End;
  277.  
  278. {We let Turbo open the file, since we can grab the handle in the assembly
  279. external}
  280.  
  281.      Assign (Scrfile,FileString);
  282.      Rewrite (Scrfile);
  283.  
  284. {The assembly external handles the actual write}
  285.  
  286.      ScrSave;
  287.  
  288. {Close it, and we're done}
  289.  
  290.      Close (Scrfile);
  291. End;
  292.  
  293. {This procedure checks to be sure we've got enough heap for the array
  294. we're trying to allocate, then allocates same. If there isn't enough
  295. heap available, we exit with an error}
  296.  
  297. Procedure AllocMem (Var P:RasterP);
  298.  
  299. Var ASize:Longint;
  300.  
  301. Begin
  302.      ASize:=MaxAvail;
  303.      If ASize<RasterSize then
  304.         Begin
  305.              Textmode (15);
  306.              Writeln ('Insufficient memory available!');
  307.              Halt;
  308.         End
  309.         Else
  310.         Getmem (P,RasterSize);
  311. End;
  312.  
  313. {Same as AllocMem, but for a bitplane-sized array}
  314.  
  315. Procedure AllocPlane (Var P:PlaneP);
  316.  
  317. Var ASize:LongInt;
  318.  
  319. Begin
  320.      ASize:=Maxavail;
  321.      If ASize<PlaneSize then
  322.         Begin
  323.              Textmode (15);
  324.              Writeln ('Insufficient memory available!');
  325.              Halt;
  326.         End
  327.         Else GetMem (P,PlaneSize);
  328.  
  329. End;
  330.  
  331.  
  332. {Mimics a file read of a single byte, reading from the input record rather
  333. than the file itself. If you wish to change back to a file of byte rather
  334. than using the faster read of the record, you can modify this routine to
  335. read directly from the file. That's simpler but slower}
  336.  
  337. Function Getbyte:Byte;
  338.   Begin
  339.        If GIFPtr=RasterSize then Exit;
  340.        Getbyte:=GIFStuff^[GIFPtr];
  341.        GIFPtr:=Succ(GIFPtr);
  342.   End;
  343.  
  344. {Reads two bytes, to get a word value}
  345.  
  346. Function Getword:Word;
  347.  
  348. Var A,B:Byte;
  349.  
  350. Begin
  351.      A:=Getbyte;
  352.      B:=Getbyte;
  353.      Getword:=A+(256*B);
  354. End;
  355.  
  356. {During READRAST, reach out and get the rest of the file if it is
  357. larger than 64000 bytes}
  358.  
  359. Procedure ReadMore;
  360.  
  361. Var IOR:Integer;
  362.  
  363. Begin
  364.      {$I-}
  365.      Read (GIFFile,GIFStuff^);
  366.      {$I+}
  367.      IOR:=IOResult;
  368. End;
  369.  
  370. {During the file decompress cycle, readjust the RASTER arrays if the
  371. original file read was larger than 64000 bytes.}
  372.  
  373. Procedure MoveUp (var Bitoffset:Longint);
  374.  
  375. Var Byteoffset:Longint;
  376.  
  377.         Begin
  378.              Byteoffset:=Bitoffset div 8;
  379.              Move (Raster^[Byteoffset],Raster^[0],RasterSize-Byteoffset);
  380.              Move (Raster2^[0],Raster^[RasterSize-Byteoffset],63000);
  381.              Bitoffset:=Bitoffset mod 8;
  382.              FreeMem (Raster2,RasterSize);
  383.              Nextraster:=False;
  384.         End;
  385.  
  386.  
  387. Procedure SetPal (Pal:PalArray);
  388.  
  389.  
  390. Begin
  391.      Regs.AX:=$1002;
  392.      Regs.DX:=Ofs (Pal);
  393.      Regs.ES:=Seg (Pal);
  394.      Intr ($10,Regs);
  395. End;
  396.  
  397.  
  398. {Use the BIOS functions to set up the EGA. This avoids dependence on Turbo's
  399. GRAPH package and the necessity to keep .BGI files with the executable}
  400.  
  401. Procedure InitEGA;
  402.  
  403. Var LocPal:PalArray;
  404.  
  405. Begin
  406.  
  407. {Set EGA graphics mode}
  408.  
  409.    Regs.AX:=$0010;
  410.    Intr ($10,Regs);
  411.  
  412. {Set the palette}
  413.  
  414.    LocPal:=Palette;
  415.    LocPal [16]:=Background;
  416.  
  417.    SetPal (LocPal);
  418.  
  419. {Compute line starting values for the assembly-language displayer}
  420.  
  421.     For I:=0 to 479 do
  422.         LineStart [I]:=I*80;
  423.  
  424. {Enable Set/Reset on all the EGA bitplanes}
  425.     Port [$3CE]:=1;
  426.     Port [$3CF]:=15;
  427.  
  428. End;
  429.  
  430.  
  431. {Derive the EGA palette value corresponding to the GIF colormap intensity
  432. value for a given color.}
  433.  
  434. Procedure DetColor (Var PValue:Byte;MapValue:Byte);
  435.  
  436. Begin
  437.         PValue:=MapValue div 64;
  438.         If PValue=1 then PValue:=2 else
  439.            If PValue=2 then PValue:=1;
  440. End;
  441.  
  442. {A crude attempt to deal with 256-color pics. Works. Badly. Dot-dithering,
  443. anyone?}
  444.  
  445. Procedure AdjustBigPal;
  446.  
  447.  
  448. Var ColPtr,Cindex,I,J,X:Word;
  449.  
  450. Begin
  451.  
  452.      For I:=16 to ColorMapSize-1 do
  453.          Begin
  454.               Colptr:=63;
  455.               For J:=0 to 15 do
  456.               Begin
  457.                   If Palette [I]>Palette[J] then
  458.                      X:=Palette [I]-Palette[J] else X:=Palette [J]-Palette[I];
  459.                   If (X< Colptr) then
  460.                      Begin
  461.                           Colptr:=X;
  462.                           Cindex:=J;
  463.                      End;
  464.               End;
  465.               Palette [I]:=Cindex;
  466.          End;
  467.      End;
  468.  
  469.  
  470.  
  471. {Set the key variables to their necessary initial values.}
  472.  
  473.  
  474. Procedure ReInitialize;
  475. Begin
  476.      Pass:=0;        {Interlace pass counter back to 0}
  477.      GIFPtr:=0;      {Mock file read pointer back to 0}
  478.      Nextraster:=False; {Start by claiming file <64000 bytes}
  479. End;
  480.  
  481. {React to GIF clear code by resetting GIF decompression values back to their
  482. initial state.}
  483.  
  484. Procedure DoClear;
  485.  
  486.     Begin
  487.       CodeSize:=InitCodeSize;
  488.       MaxCode:=MaxCodes [CodeSize-2];
  489.       FreeCode:=FirstFree;
  490.       ReadMask:=(1 shl CodeSize)-1;
  491.     End;
  492.  
  493.  
  494. Begin    {the main program}
  495.  
  496. {First get the home directory so that we can reset to it on exit, and get
  497. the eligible files in that directory}
  498.  
  499. Getdir (0,HomeDir);
  500. DoDir;
  501.  
  502. Repeat   {giant loop reruns whole program till user bails}
  503.  
  504. {Initialize a bunch of variables}
  505.  
  506.      ReInitialize;         {Initialize common vars}
  507.  
  508.  
  509. {Get memory for the raster data array, and the input file data array}
  510.  
  511.      AllocMem (Raster);
  512.      AllocMem (GIFStuff);
  513.      SetPal (NicePal);
  514.      Textcolor (2);
  515.  
  516.  Repeat {Get GIF file}
  517.   Repeat {Get good file}
  518.     Repeat {Get good filename}
  519.  
  520.      ShowDir;         {Show eligible files}
  521.  
  522. {Prompt the user for the filename}
  523.  
  524.      Bottomline;
  525.      Write ('Filename (ENTER exits,\ changes dir): ');
  526.      Readln (Filestring);
  527.      If Filestring = '' then Morgue; {bail on null string}
  528.      If FileString ='\' then         {change dir on single '\' char}
  529.         Begin
  530.              Bottomline;
  531.              Write ('New directory name: ');
  532.              Readln (Ustring);
  533.              {$I-}
  534.              Chdir (Ustring);
  535.              {$I+}
  536.              I:=IOResult;
  537.              If I<>0 then
  538.                 Begin
  539.                      Bottomline;
  540.                      Textcolor (1);
  541.                      Writeln ('Error changing to directory ',Ustring);
  542.                      Textcolor (2);
  543.                 End;
  544.              DoDir;                   {Relist directory in new dir}
  545.         End;
  546.     Until FileString <> '\';    {Got good filename}
  547.  
  548.     If Pos ('.',Filestring)=0 then Filestring:=Filestring+'.gif';
  549.  
  550.  
  551.     {Open the file}
  552.  
  553.     {$I-}
  554.      Assign (GIFFile,FileString);
  555.      Reset (GIFFile);
  556.     {$I+}
  557.  
  558.     {Cope with I/O error should one occur}
  559.  
  560.      I:=IOResult;
  561.      If I<>0 then
  562.         Begin
  563.              Textcolor (1);
  564.              Bottomline;
  565.              Write ('Error opening file ',FileString,'. Press any key ');
  566.              Readln;
  567.              Textcolor (2);
  568.         End;
  569.  
  570.   Until I=0;    {Got good file}
  571.  
  572. {Read in the GIF file. Reading it as one big hunk rather than N bytes results
  573. in far faster disk I/O; see user notes. Error checking is turned off in
  574. order to avoid 'attempt to read past EOF' errors. If the file does not exist,
  575. this will be detected at RESET}
  576.  
  577.      BottomLine;
  578.      Write ('Reading . . . ');
  579. {$I-}
  580.      Read (GIFFile,GIFStuff^);
  581. {$I+}
  582.  
  583. {Note that 4.0 requires this assignment, or else if an error results (as it
  584. will if the file is smaller than 64000 bytes) no I/O will be allowed for
  585. the remainder of the run. If the file is >64000 bytes, then the rest
  586. of it will be read during ReadRast}
  587.  
  588. I:=IOResult;
  589.  
  590. {Deal with the GIF header. Start by checking the GIF tag to make sure this
  591. is a GIF file}
  592.  
  593.      UString:='';
  594.      for I:=1 to 6 do
  595.      Begin
  596.          UString:=UString+chr(Getbyte);
  597.      End;
  598.      If UString<>'GIF87a' then
  599.         Begin
  600.              Textcolor (1);
  601.              Bottomline;
  602.              Write (UString);
  603.              Write ('Not a GIF file, or header read error. Press any key ');
  604.              Textcolor (2);
  605.              Readln;
  606.         End;
  607.  
  608.  Until UString = 'GIF87a';  {Get GIF file}
  609.  
  610. {Get variables from the GIF screen descriptor}
  611.  
  612.      RWidth:=Getword;         {The raster width and height}
  613.      RHeight:=Getword;
  614.  
  615.      {Get the packed byte immediately following and decode it}
  616.      B:=Getbyte;
  617.      If B and $80=$80 then Colormap:=True else Colormap:=False;
  618.      Resolution:=(B and $70 shr 5)+1;
  619.      BitsPerPixel:=(B and 7)+1;
  620.      If BitsPerPixel=1 then I:=2 else I:=1 shl BitsPerPixel;
  621.      Bitmask:=(1 shl BitsPerPixel)-1;
  622.  
  623.      Background:=Getbyte;
  624.      B:=Getbyte;         {Skip byte of 0's}
  625.  
  626. {Compute size of colormap, and read in the global one if there. Compute
  627. values to be used when we set up the EGA palette}
  628.  
  629.      ColorMapSize:=1 shl BitsPerPixel;
  630.      If Colormap then
  631.      Begin
  632.      For I:=0 to ColorMapSize-1 do
  633.      Begin
  634.          Red [I]:=Getbyte;
  635.          Green [I]:=Getbyte;
  636.          Blue [I]:=Getbyte;
  637.          DetColor (R,Red[I]);
  638.          DetColor (G,Green [I]);
  639.          DetColor (B,Blue [I]);
  640.          Palette [I]:=B and 1+(2*(G and 1))+(4*(R and 1))+(8*(B div 2))+(16*(G div 2))+(32*(R div 2));
  641.      End;
  642.      If ColorMapSize>16 then AdjustBigPal; {Hack at 256-color pics}
  643.      End;
  644.  
  645. {Now read in values from the image descriptor}
  646.  
  647.      B:=Getbyte;  {skip image seperator}
  648.      Leftofs:=Getword;    {Left offset, not used here}
  649.      Topofs:=Getword;     {Top offset, not used here}
  650.      Width:=Getword;      {Width, not used here}
  651.      Height:=Getword;     {Height, not used here}
  652.      A:=Getbyte;
  653.      If A and $40=$40 then Interlace:=True else Interlace:=False;
  654.  
  655.  
  656. {Note that we ignore the possible existence of a local color map. I've yet
  657. to encounter an image that had one, and the spec says it's defined for
  658. future use. This could lead to an error reading some files}
  659.  
  660. {Start reading the raster data. First we get the intial code size}
  661.  
  662.      Codesize:=Getbyte;
  663.  
  664. {Compute decompressor constant values, based on the code size}
  665.  
  666.      ClearCode:=PowersOf2 [Codesize];
  667.      EOFCode:=ClearCode+1;
  668.      FirstFree:=ClearCode+2;
  669.      FreeCode:=FirstFree;
  670.  
  671. {The GIF spec has it that the code size used to compute the above values is
  672. the code size given in the file, but the code size used in compression/
  673. decompression is the code size given in the file plus one.}
  674.  
  675.      Codesize:=Succ (Codesize);
  676.      InitCodeSize:=Codesize;
  677.      Maxcode:=Maxcodes [Codesize-2];
  678.      ReadMask:=(1 shl Codesize)-1;
  679.  
  680. {Read the raster data. Here we just transpose it from the GIF array to the
  681. Raster array, turning it from a series of blocks into one long data stream,
  682. which makes life much easier for ReadCode. This too is now assembly}
  683.  
  684.      Writeln ('Unblocking . . . ');
  685.      ReadRast;
  686.  
  687. {Get ready to do the actual read/display. Free up the heap used by the
  688. GIF array since we don't need it any more}
  689.  
  690.      FreeMem (GIFStuff,RasterSize);
  691.  
  692. {Set up the EGA}
  693.  
  694.      InitEGA;
  695.  
  696. {Preset the CLEAR flag to off}
  697.  
  698.      Clear:=False;
  699.  
  700. {Decompress and display}
  701.  
  702.      nlzw;
  703.  
  704. {Get rid of the heap used by the Raster array, and close the GIF file}
  705.  
  706.    FreeMem (Raster,RasterSize);
  707.    Close (GIFFile);
  708.  
  709. {Now grab the bitplanes from EGA memory, to be used when scrolling and
  710. saving the file. We take advantage of the fact that although only 28000
  711. bytes of EGA memory can be used for display, the extra memory to store
  712. a 640x480 pic is there and working and will contain the excess scan
  713. lines}
  714.  
  715.    AllocPlane (Plane0);
  716.    AllocPlane (Plane1);
  717.    AllocPlane (Plane2);
  718.    AllocPlane (Plane3);
  719.  
  720. {Set read map select register to the plane to be read, then simply move
  721. the plane to the corresponding array}
  722.  
  723.    Port [$3CE]:=4;
  724.    Port [$3CF]:=0;
  725.    Move (Mem [EGAPage:0],Plane0^,PlaneSize);
  726.    Port [$3CE]:=4;
  727.    Port [$3CF]:=1;
  728.    Move (Mem [EGAPage:0],Plane1^,PlaneSize);
  729.    Port [$3CE]:=4;
  730.    Port [$3CF]:=2;
  731.    Move (Mem [EGAPage:0],Plane2^,PlaneSize);
  732.    Port [$3CE]:=4;
  733.    Port [$3CF]:=3;
  734.    Move (Mem [EGAPage:0],Plane3^,PlaneSize);
  735.  
  736. {If the picture is larger than my el cheapo EGA can handle, scroll it}
  737.  
  738.    If Height>EGAHeight then
  739.    Begin
  740.  
  741.    {Wake up the user}
  742.  
  743.      Write (^G); {signals whole picture decoded}
  744.  
  745.    {Scroll offset value to top of image}
  746.  
  747.      Roll:=0;
  748.  
  749.    {Then get the scrolling keys. HOME and END move to top & bottom of
  750.     pic. Up & Down arrow move picture in smaller increments. The values
  751.     used here are based on the size difference between a 350 and 480 line
  752.     EGA pic, i.e. 130 scan lines.}
  753.  
  754.      Repeat
  755.      Ch:=Readkey;
  756.  
  757.    {We recognize special keys by their being preceded with 0}
  758.  
  759.      If (Ch=#0) and (Keypressed) then
  760.         Begin
  761.            Ch:=Readkey;
  762.            Case Ch of
  763.                 #71: Roll:=0;
  764.                 #72: Begin
  765.                      Roll:=Roll-800;
  766.                      If Roll<0 then Roll:=0;
  767.                      End;
  768.                 #79: Roll:=10400;
  769.                 #80: Begin
  770.                      Roll:=Roll+800;
  771.                      If Roll>10400 then Roll:=10400;
  772.                      End;
  773.            End;
  774.            Scroll;
  775.      End;
  776.    Until (Ch=#27) and (not Keypressed); {ESC gets us out}
  777.    End;
  778.  
  779.        {Get one key, then exit}
  780.  
  781.        If Ch<>#27 then    {Do this only if we didn't scroll}
  782.        Begin
  783.           Write (^G);
  784.           Repeat
  785.            Ch:=Readkey;
  786.           Until Ch=#27;
  787.        End;
  788.  
  789.        Textmode (15);     {Back to text}
  790.        SetPal (NicePal);
  791.        Writeln ('Press space bar to save as a .SCR file, or any other key to continue');
  792.        Ch:=Readkey;
  793.        If Ch=' ' then SaveScreen;
  794.        FreeMem (Plane0,PlaneSize);
  795.        FreeMem (Plane1,PlaneSize);
  796.        FreeMem (Plane2,PlaneSize);
  797.        FreeMem (Plane3,PlaneSize);
  798.  
  799.    Until Ch=#0;
  800.  
  801. End.                      {Finis.}
  802.