Trailing-Edge
-
PDP-10 Archives
-
decuslib10-05
-
43,50337/21/load.sim
There is 1 other file named load.sim in the archive. Click here to see a list.
BEGIN
EXTERNAL TEXT PROCEDURE conc,front,scanto,upcase,
frontstrip,rest,getitem,request;
EXTERNAL LONG REAL PROCEDURE scanreal;
EXTERNAL PROCEDURE split,arrtxt;
EXTERNAL INTEGER PROCEDURE checkreal,checkint,scanint,
maxint,search,splita,hash,arrlgd;
EXTERNAL CLASS dbmmin;
dbmmin ("",68,TRUE) BEGIN
INTEGER k,n,l,max,smax,npost,typen;
TEXT t,u,xx,ltt,tzero;
BOOLEAN typ2;
REF (record) r; REF (rspec) rtyp;
REF (Infile) inf;
TEXT ARRAY opa[0:6],fixtext[0:30];
REF (fspec) ARRAY specif[0:140];
TEXT PROCEDURE intput(n); INTEGER n;
BEGIN xx.Putint(n); intput:-frontstrip(xx); END;
CLASS fspec(anummer,fieldpos,fieldlength,fieldtype,special);
INTEGER anummer,fieldpos,fieldlength,fieldtype,special;;
PROCEDURE outline(t); VALUE t; TEXT t;
BEGIN Outtext(t); Outimage; END;
TEXT PROCEDURE help2;
BEGIN
outline("Specify data fields.");
outline("Format of specification:"); Outimage;
outline("pos,length"); Outimage;
outline("pos = start position for field on input");
outline("length = length of field on input");
END;
! START OF MAIN ________________________________________;
xx:-Blanks(15); tzero:-Copy("0");
top:
request("Data base: ","",t,TRUE,"","");
openbase(t,imsize);
IF \defined__f THEN
BEGIN outline("Undefined base !"); GOTO top; END;
request("input file: ","",t,TRUE,"","");
inf:- NEW Infile(t.Strip);
request("image size: ","80",ltt,TRUE,"","");
l:=ltt.Getint;
inf.Open(Blanks(l));
getrect: request("record type: ","",t,TRUE,"","");
rtyp:-getrecordspec(t.Strip);
IF rtyp == NONE THEN
BEGIN
outline("Record type not in data base !");
GOTO getrect;
END;
current_spec:-rtyp;
nextspec:
outline("Give STARTPOS,LENGTH for each field !");
n:=rtyp.adim;
FOR k:=1 STEP 1 UNTIL n DO
BEGIN
u:-conc(rtyp.anames(k)," :");
omt:
request(u,"",t,TRUE,"",help2);
l:=splita(t,komma,opa,3);
IF l<2 THEN
BEGIN outline("too few arguments."); GOTO omt; END;
smax:=smax+1;
specif(smax):-NEW fspec(k,opa(1).Getint,
opa(2).Getint,rtyp.atypes(k),0);
END;
endspec:
nextrec:
inf.Inimage; IF inf.Endfile THEN GOTO finish;
BEGIN TEXT ARRAY rval[1:rtyp.adim];
n:=rtyp.adim;
FOR k:=1 STEP 1 UNTIL n DO
IF rtyp.atypes(k) = 1 THEN rval(k):-tzero ELSE
rval(k):-Copy(" ");
npost:=npost+1;
IF Mod(npost,50) = 0 THEN
BEGIN
Outtext("Antal lagrade poster = ");
Outint(npost,4); Outimage;
END;
r:-NEW record(rtyp,rval);
FOR k:=1 STEP 1 UNTIL smax DO
BEGIN
INSPECT specif(k) DO
BEGIN
IF fieldpos = 0 THEN t:-tzero ELSE
IF fieldpos = -1 THEN t:-intput(npost) ELSE
BEGIN
IF inf.Image.Sub(fieldpos,fieldlength) = " "
THEN t:-NOTEXT ELSE
t:-inf.Image.Sub(fieldpos,fieldlength).Strip;
IF fieldtype = 1 THEN
BEGIN ! check that it really is numeric field;
t:-frontstrip(t);
IF checkint(t) < 0 THEN
BEGIN
outline("Illegal numeric field !");
outline(inf.Image);
Outtext("Field nr: "); Outint(k,3); Outimage; GOTO nextrec;
END ELSE IF t == NOTEXT THEN t:-tzero
ELSE t:-intput(t.Getint);
END;
IF t == NOTEXT THEN
BEGIN IF fieldtype = 3 THEN t:-Copy(" ") ELSE t:-tzero; END;
END;
rval(anummer):-Copy(t);
END;
END;
r.store;
GOTO nextrec;
END;
finish:
Outtext("Antal poster = "); Outint(npost,5);
Outimage;
inf.Close;
END;
END;