home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / box / pak.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-08-26  |  2.4 KB  |  79 lines
  1. {======================================================================}
  2. PROGRAM LOAD_FILES;
  3.  
  4. USES CRT;
  5.  
  6. TYPE
  7.    Map         = Record
  8.                   ScrCh : Char;
  9.                   ScrAt : Byte;
  10.                   End;
  11.  
  12.    Screen      = Array[1..25,1..80] of Map;
  13.    AnyStr      = String[80];
  14.  
  15. VAR
  16.     CS         : Screen absolute $B800:0000;
  17.     MS         : Screen absolute $B000:0000;
  18.     Filenm     : AnyStr;
  19.     TempStr    : AnyStr;
  20.     Color      : Boolean;
  21.  
  22.  
  23. {======================================================================}
  24. PROCEDURE Load_PAK(PFile:AnyStr);
  25. {                                                     }
  26. { This procedure loads a Packed Format screen created }
  27. { by BOX.  The Packed format utilizes a run-length    }
  28. { encoding scheme that must be unpacked.  Each record }
  29. { in a Packed Format file is three bytes long. Byte 1 }
  30. { is the run length, i.e. the number of characters to }
  31. { repeat.  Byte 2 is the character to repeat and      }
  32. { byte 3 is the attribute of the character.           }
  33. {                                                     }
  34. TYPE
  35.    Pack        = Record
  36.                   PackNm : Byte;  {run length}
  37.                   PackCh : Char;  {repeated character}
  38.                   PackAt : Byte;  {repeated attribute}
  39.                  End;
  40.  
  41. VAR
  42.     FilevarM   : File;
  43.     LoadScr    : Screen;
  44.     Packbuf    : Array[1..2000] of Pack;
  45.     II,JJ,Sloc,SX,SY,NumRec  : Integer;
  46.  
  47. BEGIN
  48.    Sloc := 1;              {SLoc is location on screen}
  49.    Assign(FilevarM,PFile);
  50.    {$I-} Reset(FilevarM); {$I+}
  51.    If IOresult = 0 then          {found good file name}
  52.      Begin
  53.         BlockRead(FilevarM,PackBuf,48,NumRec);
  54.         JJ := 0;
  55.         While Sloc < 2001 do
  56.         Begin
  57.           JJ := JJ + 1;
  58.           For II := 1 to Packbuf[JJ].PackNm do
  59.            Begin
  60.             SY := (SLoc-1) div 80 + 1;       {row}
  61.             SX := (SLoc-1) mod 80 + 1;       {column}
  62.             LoadScr[SY,SX].ScrCh := Packbuf[JJ].PackCh;
  63.             LoadScr[SY,SX].ScrAt := Packbuf[JJ].PackAt;
  64.             SLoc := SLoc + 1;
  65.            End;
  66.         End;
  67.         If Color then CS := LoadScr
  68.                  else MS := LoadScr;
  69.         Close(FilevarM);
  70.    End
  71.    Else                            {couldn't find file}
  72.      Begin
  73.        GoToXY(1,24);
  74.        Write('ERROR - Could not find file');
  75.      End;
  76. END;
  77.  
  78. {======================================================================}
  79.