home *** CD-ROM | disk | FTP | other *** search
/ GRIPS 2: Government Rast…rocessing Software & Data / GRIPS_2.cdr / dos / adrg / source / pcolors.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-04-09  |  2.4 KB  |  60 lines
  1. procedure procolor(zdr_name :string;max_row_tiles, max_col_tiles :byte;
  2.                     no_of_cols_tiles: integer; start_tile:longint );
  3. var
  4.   fv                                     : file;
  5.   ro, col, grdrv,grmod,n                 : integer;
  6.   ch                                     : char;
  7.   buf                                    : array[0..49151] of byte;
  8.   pos ,tile, columna, fila,
  9.   col_of_tiles, row_of_tiles             : longint;
  10.   r1, g1, b1, color                      : byte;
  11.  
  12. {$I mvtopos.pas}
  13. {$I pro4bit.pas}
  14.  
  15. begin         {procedure}
  16.   grdrv := EGA;grmod := EGAHi;
  17.   InitGraph(grdrv,grmod,'');
  18.   assign(fv,zdr_name);reset(fv,1);
  19.   for row_of_tiles := 1 to max_row_tiles do
  20.  
  21.    for col_of_tiles := 1 to max_col_tiles do
  22.    begin
  23.  
  24.      tile :=  (row_of_tiles-1)*no_of_cols_tiles
  25.             + col_of_tiles + start_tile;
  26.  
  27.      pos :=  (tile-1) *49152 +2048;     {128*128*3=49152}
  28.      move_to_position(fv,pos);
  29.      blockread(fv,buf,49152);           { read all 3 bands of a tile
  30.                                        to the buffer}
  31.  
  32.      for ro := 0 to 127 do
  33.        for col := 0 to 127 do
  34.        begin     {for ro and  col loops}
  35.            r1 :=buf[ ro*128 + col ];                 { locate the R,G,and B }
  36.            g1 :=buf[ (ro+127)*128 + col + 128 ];     { value for a pixel    }
  37.            b1 :=buf[ (ro+254)*128 + col + 256 ];
  38.       { return the cluster closest to this R-G-B combination }
  39.            bit4(r1,g1,b1,color);
  40.            columna := col+(col_of_tiles-1)*128;   { transform tile coords. }
  41.            fila    := ro+(row_of_tiles-1)*128;    { to screen coords.      }
  42.  
  43.     { assign the EGA color to the pixel from the ones available to Turbo P
  44.       this set works ~OK for some of the Germany Maps-TLMs. }
  45.  
  46.            case color of
  47.            0        : putpixel(columna,fila,15);       {white}
  48.            4        : putpixel(columna,fila,0);       {brown, black}
  49.            5        : putpixel(columna,fila,10);       {l. green}
  50.            9        : putpixel(columna,fila,8);        {gray}
  51.            12       : putpixel(columna,fila,9);        {blue}
  52.            13,14       : putpixel(columna,fila,0);       {black}
  53.            1,2,3,6,7  :putpixel(columna,fila,15); {l. gray, white}
  54.            8,10,11,15 :putpixel(columna,fila,7); {l. gray}
  55.            end;     {case}
  56.  
  57.          end;     {for ro and col loops}
  58.        end;     {for col_of_tiles and row_of_tiles loops}
  59.  end;     {procedure}
  60.