home *** CD-ROM | disk | FTP | other *** search
/ Prima Shareware 3 / DuCom_Prima-Shareware-3_cd1.bin / PROGRAMO / PASCAL / PASEX / PIC2OBJ.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-03-15  |  2.9 KB  |  134 lines
  1. { PIC to OBJ converter by Paradise / Fate }
  2. { paradise@bachus.umcs.lublin.pl          }
  3. {$I-,M 4000,0,0}
  4.  
  5. uses dos;
  6. var
  7.  scanlines         : array [0..49,0..639] of byte;
  8.  pfile,bfile       : file;
  9.  palette           : array [0..767] of byte;
  10.  t                 : text;
  11.  name,inn,
  12.  n1,n2,n3,n4       : string;
  13.  
  14. procedure Save_scanlines(fname: String; once: Boolean);
  15. begin
  16.  if once then
  17.  begin
  18.    assign(bfile,fname);
  19.    rewrite(bfile,1);
  20.  end;
  21.  blockwrite(bfile,scanlines,50*640);
  22.  if not(once) then close(bfile);
  23. end;
  24.  
  25. procedure Save_palette;
  26. begin
  27.  assign(bfile,name+'.ooo');
  28.  rewrite(bfile,1);
  29.  blockwrite(bfile,palette,768);
  30.  close(bfile);
  31. end;
  32.  
  33. procedure Convert;
  34. begin
  35.  assign(pfile,inn);
  36.  reset(pfile,1);
  37.  blockread(pfile,palette,768);
  38.  blockread(pfile,scanlines,50*640);
  39.  Save_scanlines(n1+'.ooo',True);
  40.  blockread(pfile,scanlines,50*640);
  41.  Save_scanlines(n1+'.ooo',False);
  42.  blockread(pfile,scanlines,50*640);
  43.  Save_scanlines(n2+'.ooo',True);
  44.  blockread(pfile,scanlines,50*640);
  45.  Save_scanlines(n2+'.ooo',False);
  46.  blockread(pfile,scanlines,50*640);
  47.  Save_scanlines(n3+'.ooo',True);
  48.  blockread(pfile,scanlines,50*640);
  49.  Save_scanlines(n3+'.ooo',False);
  50.  blockread(pfile,scanlines,50*640);
  51.  Save_scanlines(n4+'.ooo',True);
  52.  blockread(pfile,scanlines,50*640);
  53.  Save_scanlines(n4+'.ooo',False);
  54.  Save_palette;
  55.  close(pfile);
  56. end;
  57.  
  58. procedure ObjMake(srcname, dataname: String);
  59. begin
  60.  swapvectors;
  61.  exec('BINOBJ.EXE',srcname+'.ooo '+srcname+' '+dataname);
  62.  swapvectors;
  63. end;
  64.  
  65. procedure MakeObjs;
  66. begin
  67.  ObjMake(name,'_Pal');
  68.  ObjMake(n1,'_Scr1');
  69.  ObjMake(n2,'_Scr2');
  70.  ObjMake(n3,'_Scr3');
  71.  ObjMake(n4,'_Scr4');
  72. end;
  73.  
  74. procedure Del(fname: string);
  75. begin
  76.  assign(pfile,fname+'.ooo');
  77.  erase(pfile);
  78. end;
  79.  
  80. procedure DeleteOOOs;
  81. begin
  82.  Del(name);
  83.  Del(n1);
  84.  Del(n2);
  85.  Del(n3);
  86.  Del(n4);
  87. end;
  88.  
  89. procedure MakeTpu(uname,oname: String);
  90. begin
  91.  assign(t,uname+'.pas');
  92.  rewrite(t);
  93.  writeln(t,'{ PIC2OBJ data file                                      (C) by Paradise / Fate } ');
  94.  writeln(t,'{ data from : '+oname+'.obj } ');
  95.  writeln(t,'unit '+uname+';');
  96.  writeln(t,'interface');
  97.  writeln(t,' procedure _'+uname+';');
  98.  writeln(t,'implementation');
  99.  writeln(t,'{$l '+oname+'.obj}');
  100.  writeln(t,'procedure _'+uname+'; external;');
  101.  writeln(t,'end.');
  102.  close(t);
  103. end;
  104.  
  105. procedure MakeTpus;
  106. begin
  107.  MakeTpu('Pal',name);
  108.  MakeTpu('Scr1',n1);
  109.  MakeTpu('Scr2',n2);
  110.  MakeTpu('Scr3',n3);
  111.  MakeTpu('Scr4',n4);
  112. end;
  113.  
  114.  
  115.  
  116. begin
  117.  writeln;
  118.  writeln('PIC2OBJ converter (C) 1995 by Paradise / Fate ');
  119.  if paramcount<>1 then
  120.  begin
  121.    writeln('Usage: PIC2OBJ.EXE <file.pic>');
  122.    halt;
  123.  end;
  124.  inn:=paramstr(1);
  125.  name:=copy(inn,1,pos('.',inn)-1);
  126.  if length(name)>=8 then delete(name,8,length(name)-7);
  127.  n1:=name+'1'; n2:=name+'2'; n3:=name+'3'; n4:=name+'4'; name:=name+'0';
  128.  Convert;
  129.  MakeObjs;
  130.  DeleteOOOs;
  131.  MakeTpus;
  132.  writeln('That''s all folks!');
  133. end.
  134.