home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 18 / CD_ASCQ_18_111294_W.iso / dos / prg / pas / gfxfx / makeinc.pas < prev    next >
Pascal/Delphi Source File  |  1994-04-20  |  2KB  |  65 lines
  1.  
  2. {$i-,v-}
  3. program makepicincludefile;
  4. { Makes include-file from raw-picture format (pal at 0, data at $300),
  5.   by Bas van Gaalen, Holland, PD }
  6. uses dos;
  7. type str10 = string[10];
  8. var
  9.   infile : file;
  10.   outfile : text;
  11.   buffer : array[0..1023] of byte;
  12.   infname,outfname : pathstr;
  13.   tmpstr : string;
  14.   nofread,i : word;
  15.  
  16. function tostr(src : byte) : str10; var tmp : str10; begin
  17.   str(src,tmp); tostr := tmp; end;
  18.  
  19. begin
  20.   { file i/o }
  21.   if paramstr(1) = '' then begin
  22.     write(' infile: '); readln(infname); end else infname := paramstr(1);
  23.   assign(infile,infname);
  24.   reset(infile,1);
  25.   if ioresult <> 0 then begin
  26.     writeln('error opening ',infname); halt; end;
  27.   if paramstr(2) = '' then begin
  28.     write('outfile: '); readln(outfname); end else outfname := paramstr(2);
  29.   assign(outfile,outfname);
  30.   rewrite(outfile);
  31.   if ioresult <> 0 then begin
  32.     writeln('error creating ',outfname); halt; end;
  33.  
  34.   writeln(outfile,'  pal : array[0..767] of byte = (');
  35.   tmpstr := '    ';
  36.   blockread(infile,buffer,768);
  37.   for i := 0 to 767 do begin
  38.     tmpstr := tmpstr+tostr(buffer[i])+',';
  39.     if length(tmpstr) > 70 then begin
  40.       writeln(outfile,tmpstr);
  41.       tmpstr := '    ';
  42.     end;
  43.   end;
  44.   delete(tmpstr,length(tmpstr),1);
  45.   writeln(outfile,tmpstr,');');
  46.   writeln(outfile);
  47.  
  48.   writeln(outfile,'  pic : array[0..',filesize(infile)-769,'] of byte = (');
  49.   tmpstr := '    ';
  50.   repeat
  51.     blockread(infile,buffer,sizeof(buffer),nofread);
  52.     for i := 0 to nofread-1 do begin
  53.       tmpstr := tmpstr+tostr(buffer[i])+',';
  54.       if length(tmpstr) > 70 then begin
  55.         writeln(outfile,tmpstr);
  56.         tmpstr := '    ';
  57.       end;
  58.     end;
  59.   until nofread < sizeof(buffer);
  60.   delete(tmpstr,length(tmpstr),1);
  61.   writeln(outfile,tmpstr,');');
  62.   close(infile);
  63.   close(outfile);
  64. end.
  65.