home *** CD-ROM | disk | FTP | other *** search
/ Collection of Hack-Phreak Scene Programs / cleanhpvac.zip / cleanhpvac / PINBSRC.ZIP / GFX / RESORT.PAS < prev   
Pascal/Delphi Source File  |  1996-02-02  |  4KB  |  129 lines
  1. {COLOR RESORTER-> Sorts the colors of a .GFX new}
  2. {   - (c) Ansgar Scherp, Joachim Gelhaus }
  3. uses dos,crt;
  4.  
  5. {$I _NORMVGA}
  6.  
  7. var start_col:byte;
  8.     colors:array[0..255] of byte;
  9.     colora:array[0..255] of boolean;
  10.     x,y,i,b:byte;
  11.     ch:char;
  12.     quellef,zielf,mpaf:file of byte;
  13.     quelle,ziel,pals,mpas:string;
  14.     clipboard:boolean;
  15.     minipalette:boolean;
  16.     palet:array[0..255,1..3] of byte;
  17.  
  18. function FileExists(FileName: String): Boolean;
  19. var
  20.   F: file;
  21. begin
  22.   {$I-}
  23.   Assign(F, FileName);
  24.   Reset(F);
  25.   Close(F);
  26.   {$I+}
  27.   FileExists := (IOResult = 0) and (FileName <> '');
  28. end;  { FileExists }
  29.  
  30. begin
  31.   for i:=0 to 255 do colora[i]:=false;
  32.   writelN;
  33.   writeln('Color Resorter Ver. 20.06.95');
  34.   writeln;
  35.   write('Sourcefile[.GFX]: '); readln(quelle);
  36.      if Pos('.',quelle)=0 then quelle:=quelle+'.GFX';
  37.      if not fileexists(quelle) then begin
  38.        writelN(quelle,' not found...');
  39.        halt(4);
  40.      end;
  41.  
  42.   write('Destfile[.GFX]: '); readln(ziel);
  43.      if ziel='' then ziel:=copy(quelle,1,pos('.',quelle))+'GFX';
  44.      if Pos('.',ziel)=0 then ziel:=ziel+'.GFX';
  45.  
  46.   write('Palette mit remappen [Y]: '); ch:=upcase(readkey);
  47.   if ch=chr(13) then ch:='Y'; writeln(ch);
  48.   if (ch='Y') then begin
  49.     write('Original Palette[.PAL]: '); readln(pals);
  50.     if pals='' then pals:=copy(quelle,1,pos('.',quelle))+'PAL';
  51.     if Pos('.',pals)=0 then begin
  52.       if fileexists(pals+'.PAL') then pals:=pals+'.PAL';
  53.       if fileexists(pals+'.MPA') then pals:=pals+'.MPA';
  54.     end;
  55.     if not fileexists(pals) then begin
  56.       writeln(pals,' nothing found...');
  57.       halt(4);
  58.     end;
  59.     if pos('.PAL',pals)>0 then load_palette_only(pals) else load_mini_palette_only(pals);
  60.     write('Destpalette[.MPA]: '); readln(mpas);
  61.     if mpas='' then mpas:=copy(ziel,1,pos('.',ziel))+'MPA';
  62.     if Pos('.',mpas)=0 then mpas:=mpas+'.MPA';
  63.     assign(mpaf,mpas);
  64.     rewrite(mpaf);
  65.   end;
  66.   for x:=0 to 255 do write(pal[x,1]);
  67.  
  68.   write('Neue Startfarbe[0-255]: '); readln(start_col);
  69.  
  70.   write('Color 0 not resorting? [Y]: '); ch:=upcase(readkey);
  71.   if ch=chr(13) then ch:='Y'; writeln(ch);
  72.   if (ch='Y') then begin
  73.     colors[0]:=0;
  74.     colora[0]:=true;
  75.   end;
  76.  
  77.   clipboard:=false;
  78.   write('Clipboard Format [N]: '); ch:=upcase(readkey);
  79.   if ch=chr(13) then ch:='N'; writeln(ch);
  80.   if (ch='Y') then begin
  81.     Clipboard:=true;
  82.   end;
  83.  
  84.   minipalette:=true;
  85.   write('Create minipalette? [Y]: '); ch:=upcase(readkey);
  86.   if ch=chr(13) then ch:='Y'; writeln(ch);
  87.   if (ch='N') then begin
  88.     minipalette:=false;
  89.   end;
  90.  
  91.   writelN('Convert ',quelle,' to ',ziel);
  92.   if mpas<>'' then writelN('Palette ',pals,' -> ',mpas);
  93.   writeln;
  94.   writeln('Current Status:');
  95.   assign(quellef,quelle);
  96.   reset(quellef);
  97.   assign(zielf,ziel);
  98.   rewrite(zielf);
  99.   repeat
  100.     read(quellef,b);
  101.     if (clipboard=false) or (filepos(quellef)<filesize(quellef)-16) then begin
  102.       if colora[b]=false then begin
  103.         colors[b]:=start_col;
  104.         colora[b]:=true;
  105.         if (mpas<>'') and (minipalette=true) then write(mpaf,start_col,pal[b,1],pal[b,2],pal[b,3]);
  106.         palet[start_col,1]:=pal[b,1];
  107.         palet[start_col,2]:=pal[b,2];
  108.         palet[start_col,3]:=pal[b,3];
  109.         inc(start_col);
  110.        end;
  111.        write(zielf,colors[b]);
  112.     end else write(zielf,b);
  113.     gotoxy(1,wherey); writeln(filepos(quellef),' of ',filesize(quellef),' bytes.');
  114.                       write('Last used color: ',start_col); gotoxy(1,wherey-1);
  115.   until eof(quellef);
  116.  
  117.   close(quellef); close(zielf);
  118.   if mpas<>'' then close(mpaf);
  119.   if minipalette=false then begin
  120.     assign(mpaf,mpas);
  121.     rewrite(mpaf);
  122.     for x:=0 to 255 do begin
  123.       write(mpaf,palet[x,1],palet[x,2],palet[x,3]);
  124.     end;
  125.     close(mpaf);
  126.   end;
  127.   writeln('ready');
  128. end.
  129.