begin
external routine spec define(string (255) s)
external routine spec clear(string (255) s)
external routine spec imp80(string (255) s)
external routine spec nrstrg(string name s)
external integer fn spec exist(string (255) s)
external routine spec prompt(string (255) s)
integer star hit, k, x
string (255) line, aa, bb, rtname, s
on event 9 start ; ->eof; finish
prompt("Text file to be processed:")
cycle
nrstrg(s)
if exist(s)#0 then exit else start
printstring("File:".s." does not exist or no access")
newline
finish
repeat
printstring("The file may contain lines * routine ident on next line
** end-of-routine
*** end-of-file")
newline
printstring("Or give name of routine (CR if file contains routine-ident(s))")
newline
prompt("Name of routine to be created: ")
nrstrg(rtname)
define("39,".s)
define("40,T#TEXT")
selectinput(39)
selectoutput(40)
if rtname#"" start
printstring("%routine ".rtname)
newline
star hit=1
finish else star hit=0
cycle
nrstrg(line)
if star hit=0 and line#"*" start
select output(0)
newline
printstring( c
"Required %external routine name(s) should be preceeded by ""*"", and the file shoul".c
"d end with ""**""")
newline
stop
finish
star hit=1
! Fix up single quotes to double
if line->aa.("""").bb start
k=1
cycle
exit if k>length(line)
if charno(line, k)='"' start
length(line)=length(line)+1
for x=length(line), -1, k+2 cycle
charno(line, x)=charno(line, x-1)
repeat
charno(line, k+1)='"'
k=k+1
finish
k=k+1
repeat
finish
if line="*" start
nrstrg(line)
rtname=line
printstring("%routine ".line)
newline
continue
finish
if line="**" start
newline
printstring("%end {".rtname."}")
newline
rtname=""
continue
finish
if line="***" start
printstring("%endoffile")
newline
exit
finish
printstring("printstring(""".line."
"");")
repeat
eof:
if rtname#"" start
newline
printstring("%end {".rtname."}")
newline
finish
selectoutput(0)
selectinput(0)
closestream(39)
closestream(40)
clear("39,40")
printstring("IMP routine in file T#TEXT")
newline
stop
printstring("Source: from ".s." IMP in T#TEXT Object: T#TEXTY")
newline
imp80("T#TEXT,T#TEXTY")
end of program