/* REXX */

/*
-----------------------------------------------------------------
  unpacker (v0.1) = public domain : free for any use

  AUTHOR: rugxulo _AT_ gmail

  TESTED: Regina 3.7, BRexx 2.1.9, r4 4.00, ooREXX 4.1.3

  BUG:    Can't use literal '*'+'/' pair in embedded data files.
-----------------------------------------------------------------
*/

/* --- UNPACKER BEGINS --- */

if arg() \= 0 then parse arg onlyfile . ; else onlyfile=''
parse source . . srcfile . ; lineno=0 ; writeln=0

bar = '===' ; prefix='/*' bar ; postfix = bar '*/'
headpost=' begins' postfix ; footpost=' ends' postfix
headlen=length(headpost) ; footlen=length(footpost)

if lines(srcfile)=1 then do while lines(srcfile) \= 0
  call grab
end
else do lines(srcfile)
  call grab
end

exit

grab:
  line=linein(srcfile) ; lineno=lineno+1
  if pos(headpost,line) \= 0 then do
    parse var line ' ' (bar) ' ' outfile (headpost) .
    if onlyfile='' then say outfile
    writeln=1
  end
  else if pos(footpost,line) \= 0 then writeln=0
  if pos(headpost,line)=0 & pos(footpost,line)=0 & writeln then ,
    if onlyfile='' | onlyfile=outfile then ,
      call lineout outfile, line
return

/* --- UNPACKER ENDS --- */

/*
------------------------------------------------------------
*** DATA BEGINS DATA BEGINS DATA BEGINS DATA BEGINS ***

/* these data files = public domain : free for any use */
------------------------------------------------------------

/* === fixme.pas begins === */
program fixme(output,myfix,filein,fileout);(*public domain, free for any use*)

const maxlinelen=100; maxfixes=75;

type
  tline=record
    data:packed array [1..maxlinelen] of char;
    len,num:integer
  end;

var fixes:array [1..maxfixes] of tline; line:tline; lastfix:integer;
    myfix,filein,fileout:text;

procedure readline(var infile:text);
begin
  with line do begin
    len := 0;
    while not eoln(infile) do begin
      len := len + 1;
      read(infile,data[len])
    end;
    readln(infile)
  end
end;

function readfixes:boolean;
var done:boolean;

  function fixident:boolean;
  const msg='@fixes@'; msglen=7;
  var s:packed array [1..msglen] of char; i:integer;
  begin
    fixident := false;
    with line do
      if len >= msglen then begin
        for i := 1 to msglen do s[i] := data[i];
        fixident := s = msg
      end
  end;

  procedure addfix;
  var i,n:integer;
  begin
    lastfix := lastfix + 1; n := 0;
    with line do
      for i := 1 to len do
        n := n * 10 + ord(data[i])-ord('0');
    readline(myfix);
    fixes[lastfix] := line;
    fixes[lastfix].num := n
  end;

begin
  lastfix := 0; done := false; readfixes := true;
  readline(myfix);
  if fixident then begin
    while (not eof(myfix)) and (not done) do begin
      readline(myfix);
      if fixident then done := true
      else addfix
    end
  end
  else begin
    writeln('bad');
    readfixes := false
  end
end;

procedure mainfile;
var found:integer;

  function foundfix:integer;
  var i:integer; done:boolean;
  begin
    foundfix := 0; done := false;
    i := 1;
    while (i <= lastfix) and (not done) do begin
      if fixes[i].num = line.num then begin
        foundfix := i;
        done := true
      end;
      i := i + 1
    end
  end;

  procedure writefix;
  var n:integer;
  begin
    (* with fixes[found] do writeln(data:len) *)
    with fixes[found] do
      for n := 1 to len do write(fileout,data[n]);
    writeln(fileout)
  end;

  procedure writeline;
  var n:integer;
  begin
    (* with line do if len > 0 then writeln(data:len) else writeln *)
    with line do
      for n := 1 to len do write(fileout,data[n]);
    writeln(fileout)
  end;

begin
  line.num := 0;
  while not eof(filein) do begin
    line.num := line.num + 1;
    readline(filein);
    found := foundfix;
    if found > 0 then writefix else writeline
  end
end;

begin
  if paramcount=0 then begin writeln('Usage: FIXME myfix filein fileout'); halt(255) end;
  assign(myfix,paramstr(1)); assign(filein,paramstr(2)); assign(fileout,paramstr(3));
  reset(myfix); reset(filein); rewrite(fileout);
  if readfixes then mainfile
  ;close(myfix); close(filein); close(fileout)
end.
/* === fixme.pas ends === */

/* === bytename.iri begins === */
@fixes@ BYTENAME.PAS (Irie)
33
//
16
//
13
//
11
//
10
//
5
var bytenum:integer;
3
//
@fixes@
/* === bytename.iri ends === */

/* === loadfile.iri begins === */
@fixes@ LOADFILE.PAS (Irie)
105
//
104
//
102
//
97
//
85
procedure doall(procedure doit(var line:pstring));
82
//
76
//
65
//
23
//
21
//
19
//
17
//
16
//
15
//
14
//
13
//
12
//
9
//
7
const maxlines=2276; maxlinelen=72; maxoldlinelen=131; var linesread:integer;
5
//
3
//
@fixes@
/* === loadfile.iri ends === */

/* === invturbo.iri begins === */
@fixes@ INVTURBO.PAS (Irie)
147
begin {main} bytenum:=1;linesread:=0;jumpnum:=0;cseg:=false;
144
begin {writeln}
141
//
106
//
97
//
8
//
6
{$I bytename.ip}{$I loadfile.ip} var jumpnum:integer;cseg:boolean;
3
//
@fixes@
/* === invturbo.iri ends === */

/* === bytename.tp3 begins === */
@fixes@ BYTENAME.PAS (TP3)
33
{}
23
function isbytename(name:str):boolean;
15
procedure getbytenames(s:str);
13
{}
11
procedure inc(var i:integer); begin i:=i+1 end;
10
procedure dec(var i:integer); begin i:=i-1 end;
5
type str=string[150];
3
{}
2
{}
1
{}
@fixes@
/* === bytename.tp3 ends === */

/* === loadfile.tp3 begins === */
@fixes@ LOADFILE.PAS (TP3)
105
{}
104
{}
102
{}
99
{}
98
{}
97
freemem(src[i],length(src[i]^)+strlensize)
93
*)
84
(*
82
freemem(older,length(older^)+strlensize)
76
getmem(older,length(newer)+strlensize);
67
{}
66
{}
65
getmem(src[linesread],length(line)+strlensize);
21
{}
19
{}
17
{}
16
{}
15
{}
14
{}
13
{}
12
{}
9
{}
5
{}
3
{}
2
{}
1
{}
@fixes@
/* === loadfile.tp3 ends === */

/* === invturbo.tp3 begins === */
@fixes@ INVTURBO.PAS (TP3)
159
  writeln('written'); close(newasm); cleanup;
158
  if length(src[idx]^) > 0 then writeln(newasm,src[idx]^);
157
  assign(newasm,'inv.asm'); rewrite(newasm); for idx:=1 to linesread do
154
  for idx := 1 to linesread do adjust(src[idx]); writeln('adjusted');
144
begin {writeln}
141
var idx:integer;
26
  procedure replace(no,yes:str);
21
  procedure finddel(s:str);
17
  function found(s:str):boolean;
13
  function find(s:str):integer;
8
{$I loadfile.pas}
6
{$I bytename.pas}
3
{}
2
{}
1
{}
@fixes@
/* === invturbo.tp3 ends === */

/* === fixturbo.bat begins === */
@echo off
if not exist INVADERS.ASM goto end
set F1=bytename loadfile invturbo
if exist fixme.com goto tp3
:irie
ipc fixme
if not exist fixme.ivm goto end
for %%a in (%F1%) do ivm fixme %%a.iri %%a.pas %%a.ip
ipc invturbo.ip
ivm invturbo
if not exist inv.asm goto end
echo.
echo inv.asm 490BBAA0
crc32 inv.asm
echo.
goto end
:tp3
for %%a in (%F1%) do if not exist %%a.pa~ ren %%a.pas *.pa~
for %%a in (%F1%) do fixme.com %%a.tp3 %%a.pa~ %%a.pas
echo.
echo Compile/Run INVTURBO.PAS
echo.
:end
set F1=
/* === fixturbo.bat ends === */


# --- extract.awk begins ---
#!/usr/bin/awk -f

/[b]egins ===/{
  fname=$3 ; print fname
  while (getline > 0) {
    if ($0 !~ / [e]nds ===/) {
      print > fname
    }
    else {
      close(fname)
      break
    }
  }
}
# --- extract.awk ends ---

------------------------------------------------------------
*** DATA ENDS DATA ENDS DATA ENDS DATA ENDS ***
------------------------------------------------------------
*/

/* EOF */
