perm filename SPEC.SIM[SIM,SYS] blob sn#460287 filedate 1979-07-20 generic text, type T, neo UTF8
BEGIN
  EXTERNAL REF (Infile) PROCEDURE findinfile;
  EXTERNAL REF (Outfile) PROCEDURE findoutfile;
  EXTERNAL TEXT PROCEDURE conc,upcase,frontstrip,rest,checkextension;
  EXTERNAL CHARACTER PROCEDURE fetchar,findtrigger;
  EXTERNAL LONG REAL PROCEDURE scanreal;
  EXTERNAL INTEGER PROCEDURE checkreal,checkint,scanint,ilog;
  EXTERNAL BOOLEAN PROCEDURE menu;
  EXTERNAL CLASS safeio;
  EXTERNAL CLASS dbmtxt,dbm;
  dbm("spclog.tmp","english") BEGIN
    BOOLEAN edt,addspec;
    TEXT t,u,key,rname,terms,iterms,rterms,txterms;
    INTEGER adim,keypos,i,j,k,m,n,ncat,nspec,ndata,rsize;
    INTEGER kterm,nterm;
    INTEGER spectop,dataloc,olimit,startloc,posmax1,posmax2;
    TEXT ARRAY termarr,typterms[1:550];
    REF (rspec) r;

    BOOLEAN PROCEDURE getspec;
    BEGIN
      IF rname == NOTEXT THEN getspec:=TRUE ELSE
      BEGIN
	r:-getrecordspec(rname); IF r == NONE THEN addspec:=TRUE;
      END;
    END;

    PROCEDURE safestore(r); REF (rspec) r;
    BEGIN
      r.store;
      IF \defined←←f AND oflowtop >= olimit THEN
      BEGIN ! allocate new space for overflow;
	oflowtop:=dataloc;
	dataloc:=olimit:=dataloc+10;
      END;
    END of safestore;

    PROCEDURE edits;
    BEGIN REF (rspec) rr; TEXT t,v;
      INTEGER k,newtype,nn; TEXT ARRAY namtyp[1:3];
      BOOLEAN PROCEDURE checktype;
      BEGIN
	split(v,namtyp);
	t:-namtyp(1); v:-namtyp(2);
	newtype:=loctext(v,typtext);
	IF newtype = 0 THEN checktype:=TRUE;
      END;
      BOOLEAN PROCEDURE helptype;
      BEGIN
	outline("VALID TYPES:");
	FOR i:=1 STEP 1 UNTIL 6 DO outline(typtext(i));
      END;
      request("New attribute and its type","anew,TEXT",
      textinput(v,\checktype),"?",help(
      "Give field name and type; EXAMPLE:   FIELD1,INTEGER"));
      k:=loctext(t,r.anames); IF k > 0 THEN
      BEGIN
	request("Enter new name and type for redefined attribute",
	"ANEW,TEXT",textinput(v,\checktype),"Invalid type !",helptype);
	r.anames(k):-Copy(t);
	r.atypes(k):=newtype;
	safestore(r);
      END ELSE
      BEGIN
	nn:=r.adim+1;
	BEGIN INTEGER max,k;
	  TEXT ARRAY anew[1:nn+1];
	  INTEGER ARRAY anewtype[1:nn+1];
	  anew(nn):-t; anewtype(nn):=newtype;
	  max:=r.adim;
	  FOR k:=1 STEP 1 UNTIL max DO
	  BEGIN anew(k):-r.anames(k);
	  anewtype(k):=r.atypes(k); END;
	  r.terms:-conc(r.terms,conc(Copy(","),t));
	  rr:-NEW rspec(spec←←spec,noargs,rname,r.terms,r.key,
	  r.base,r.size,r.keypos,nn,anew,anewtype);
	  ! change reference in recordspec array from r to rr;
	  FOR k:=1 STEP 1 UNTIL rsptop DO
	  BEGIN
	    IF recordspec(k) == r THEN recordspec(k):-rr;
	  END;
	  safestore(rr);
	END;
      END;
      fin:
    END;

    PROCEDURE new←spec(sname,sparm,types,loc1);
    NAME sname,sparm,types;
    TEXT sname,sparm,types; INTEGER loc1;
    BEGIN
      INTEGER n,k; TEXT ARRAY ta[1:7];
      REF (rspec) r;
      n:=split(sparm,ta);
      BEGIN TEXT ARRAY nx[1:n+1]; INTEGER ARRAY tx[1:n+1];
	FOR k:=1 STEP 1 UNTIL n DO
	BEGIN
	  nx(k):-ta(k);
	  tx(k):=types.Sub(k,1).Getint;
	END;
	r:-NEW rspec(spec←←spec,noargs,sname,sparm,ta(1),
	loc1,10,1,n,nx,tx);
	r.store;
      END;
    END of new←spec;


    ! START OF MAIN PROGRAM    ←←←←←←←←←←←←←←←←←←←←←←←←←←←←←←←;
    spec←←spec.dirfile:-d←←file;
    IF defined←←f THEN
    BEGIN
      request("Is an old file to be edited ?",
      "no",boolinput(edt),"?",help(
      "If not , please exit and delete this file first"));
      IF edt THEN GOTO r←mod;
    END;
    d←←file.Locate(1); d←←file.Outimage;
    oflowbase:=oflowtop:=10; olimit:=20;
    new←spec("INDEXFILE","NAMN,ANTAL,TYP,COND,REMARK,INDEX","313334",20);
    new←spec("SETSPEC","NAMN,OWNER,MEMBERS,REMARK","3333",30);
    new←spec("TABLE","NAMN,FIELDS,COLUMNS,SUMS,REMARK","33333",40);
    r←mod:
    dataloc:=startloc:=50;
    next:
    request("record (or period to terminate)",NOTEXT,
    textinput(rname,\getspec),"No such record defined !",display←records);
    IF rname.Sub(1,1) = "." THEN GOTO fin;
    IF \addspec THEN
    BEGIN edits; GOTO next; END;
    BEGIN COMMENT build next record specification;
      IF defined←←f THEN dataloc:=oflowtop;
      INSPECT d←←file DO
      BEGIN
	stringrequest("Parameters",NOTEXT,terms,TRUE,"?",help(
	"Give names within delimiters: EXAMPLE  /F1,F2,AAA3,HH5/"));
	adim:=split(terms,termarr);
	BEGIN TEXT ARRAY anames(1:adim+1);
	  INTEGER ARRAY atypes(1:adim+1);
	  split(terms,anames);
	  kterm:=0;
	  FOR j:=1 STEP 1 UNTIL 6 DO
	  BEGIN
	    stringrequest(typtext(j),NOTEXT,iterms,TRUE,"?",help(
	    "Give name sequence within delimiters: EXAMPLE:  /F1,F2,HH5/"));
	    nterm:=split(iterms,typterms);
	    IF nterm > 0 THEN
	    BEGIN ! compute type code for corresponding parameters;
	      FOR k:=1 STEP 1 UNTIL adim DO
	      BEGIN
		m:=loctext(anames(k),typterms);
		IF m > 0 THEN
		BEGIN atypes(k):=j; kterm:=kterm+1; END;
	      END;
	      IF kterm >= adim THEN GOTO l8;
	    END;
	  END;
	  outline("There are unspecified fields ! ");
	  l8:
	  request("Key",NOTEXT,
	  textinput(key,loctext(key,anames) > 0),"Key not a parameter !",help(
	  "Answer with name of key field WITHOUT delimiters around it"));
	  keypos:=loctext(key,anames);
	  request("size","8",intinput(rsize,rsize>=1),"?",help(
	  "Answer with a rough estimate of the number of records of this type"));
	  r:-NEW rspec(spec←←spec,noargs,rname,terms,key,
	  dataloc,rsize,keypos,adim,anames,atypes);
	  IF defined←←f THEN oflowtop:=oflowtop+rsize ELSE
	  dataloc:=dataloc+rsize;
	  safestore(r);
	  GOTO next;
	END;
      END;
    END;
    fin:
    INSPECT d←←file DO
    BEGIN
      IF \defined←←f THEN
      BEGIN
	oflowtop:=oflowbase:=dataloc;
      END;
      Locate(1);
      Setpos(1); Outint(oflowtop,6);
      Outint(gen←key,6);
      Outimage;
    END;
  END;
END;