home *** CD-ROM | disk | FTP | other *** search
/ D!Zone (Collector's Edition) / D_ZONE_CD.ISO / programs / editors / ktsdht10 / floors.pas < prev    next >
Pascal/Delphi Source File  |  1994-12-06  |  2KB  |  81 lines
  1. {****************************************************************************
  2. *                      The DOOM Hacker's Tool Kit                           *
  3. *****************************************************************************
  4. * Unit   : FLOORS                                                           *
  5. * Purpose: Loading and Displaying Floor Textures                            *
  6. * Date:    4/28/94                                                          *
  7. * Author:  Joshua Jackson        Internet: joshjackson@delphi.com           *
  8. ****************************************************************************}
  9.  
  10. {$F+,O+}
  11. unit Floors;
  12.  
  13. interface
  14.  
  15. uses Wad,WadDecl,Graph;
  16.  
  17. type    PFloorTexture=^TFloorTexture;
  18.         TFloorTexture=object
  19.             Constructor Init(WDir:PWadDirectory;FloorName:ObjNameStr);
  20.             Procedure Draw(Scale,XOffset,YOffset:word);
  21.             Destructor Done;
  22.          private
  23.             FBuff:PFloorBuff;
  24.         end;
  25.  
  26. implementation
  27.  
  28. uses Crt;
  29.  
  30. Constructor TFloorTexture.Init(WDir:PWadDirectory;FloorName:ObjNameStr);
  31.  
  32.     var l:word;
  33.  
  34.     begin
  35.         l:=WDir^.FindObject(FloorName);
  36.         if l=0 then begin
  37.             TextMode(co80);
  38.             writeln('TFloorTexture_Init: Could not locate Texture ID: ',FloorName);
  39.             WDir^.Done;
  40.             halt;
  41.         end;
  42.         seek(WDir^.WadFile,WDir^.DirEntry^[l].ObjStart);
  43.         New(Fbuff);                                        {Allocate New Floor Descriptor}
  44.         GetMem(FBuff^.Image, 4096);
  45.         BlockRead(WDir^.WadFile,FBuff^.Image^[0],4096);
  46.     end;
  47.  
  48. Procedure TFloorTexture.Draw(Scale,XOffset,YOffset:word);
  49.  
  50.     var     y1,y2,x1,x2:integer;
  51.             xPix,yPix,oxpix,oypix:integer;
  52.             xSize:integer;
  53.  
  54.     begin
  55.         oxpix:=0;
  56.         oypix:=0;
  57.         XSize:=64;
  58.         for y1:=0 to 63 do begin
  59.             yPix:=y1 * Scale div 100;
  60.             for y2:=oypix to ypix do begin
  61.                 oxpix:=0;
  62.                 for x1:=0 to 63 do begin
  63.                     xPix:=x1 * Scale div 100;
  64.                     for x2:=oxpix to xpix do begin
  65.                         PutPixel(x2+Xoffset,y2+YOffset,Fbuff^.Image^[(y1*xSize)+x1]);
  66.                     end;
  67.                     oxpix:=xpix+1;
  68.                 end;
  69.             end;
  70.             oypix:=ypix+1;
  71.         end;
  72.     end;
  73.  
  74. Destructor TFloorTexture.Done;
  75.  
  76.     begin
  77.         FreeMem(FBuff^.Image, 4096);
  78.         Dispose(FBuff);
  79.     end;
  80.  
  81. end.