home *** CD-ROM | disk | FTP | other *** search
/ Club Amiga de Montreal - CAM / CAM_CD_1.iso / files / 325.lha / FileIt / fileit.d < prev    next >
Encoding:
Text File  |  1989-12-24  |  33.4 KB  |  1,401 lines
  1. #include:crt.g
  2. #include:util.g
  3.  
  4. uint dwindsize=22;     /* depth of record window */
  5. uint windwidth=77;     /* width of screen        */
  6. uint maxrecs=1000;      /* max no. of records     */
  7. uint maxsels=20;       /* max no. of selections  */
  8. uint maxfields=20;     /* max fields per record  */
  9. uint maxfieldsize=200; /* max size field     */
  10. uint blocksize=256;    /* size of a diskblock    */
  11. uint filenamelen=20;    /* length of a filename   */
  12. uint namesize=80;      /* size of a selection name */
  13. uint fieldnamesize=8;  /* size of a field name    */
  14. uint maxtot=maxfields*maxfieldsize;          /*store for one record */
  15. uint maxmess=maxfieldsize+15          ;      /* maxstringsize          */
  16.  
  17. /*  ************************* NOTE *************************
  18.     
  19.     array declaration [x] type gives an array with x elements
  20.     numbered 0..x-1 ! what is more draco does no range checking
  21.     so if you think there is an xth element and assign to it
  22.     you will succeed but create all sorts of strange side effects
  23.     (corrupted data , crashes, etc)
  24.     YOU HAVE BEEN WARNED .... j.d
  25. */
  26.  
  27. type string=[maxmess+1] char;             /* normal string */
  28.  
  29. type totstore=[maxtot+1] char;   /*storage for one complete record */
  30.  
  31. type indexfield=struct {
  32.         [namesize+1] char indexname;
  33.         [maxrecs+1] bool map;
  34.         uint numonlev;
  35.         };
  36. /* info for one level in index
  37.     name contains op that was performed at that level
  38.     map the selection map that resulted
  39.     numonlev the number recs on that level */
  40.  
  41. type index=struct{    
  42.         [maxsels+1] indexfield level;
  43.         uint curlev;
  44.         uint currecnum;
  45.         uint maxrecnum;
  46.         uint numdeletes;
  47.         };
  48. /* complete index for the database
  49.         level has maps fro each level
  50.         curlev the current level in the database
  51.         currecnum the current record number
  52.         maxrecnum the max record number in use
  53.     level 1 is the global level */
  54.     
  55. type defnfield=struct{
  56.         uint tlx,tly;
  57.         uint brx,bry;
  58.         uint size;
  59.         [fieldnamesize+1] char fieldname;
  60.         };
  61. /* tlx,tly,brx,bry are co-ords of fields on screen box
  62.    size is total size of field
  63.    name the fields name
  64.    a size of 0 means not used
  65. */
  66.  
  67. type definition=struct{
  68.         [maxfields+1] defnfield spec;
  69.         uint totsize;
  70.         uint blkfac;
  71.         };
  72. /* complete definition of database
  73.    spec holds definition info for each field
  74.    totsize the complete size of one record
  75.    blkfac the computed disk blocking factor
  76. */
  77.  
  78. type datafield=string;
  79. /* run time storage for one record */
  80.  
  81. type datarecord=[maxfields+1] datafield;
  82. /* run time store for one record */
  83.  
  84. type diskblock=[blocksize+1] char;
  85. /* disk input output record */
  86.  
  87. /* variable declarations */
  88.  
  89.  
  90. string     filnm;                        /* name for database file */
  91. [windwidth+1,dwindsize+1] char scrbuf; /* screen output buffer */
  92.  
  93. file ()    outfile;                     /* output dump file     */
  94. channel output text outfilout;
  95.  
  96. bool    filopnd;                    /* file opened flag     */
  97. bool    quit;                        /* end flag                */
  98. char    response;                    /* general input         */
  99. string  fnm;                        /* fieldname for searches */
  100. string  ptrn;                        /* pattern for searches */
  101. string    lstr,tstr;                    /* status line display  */
  102. string  rstr,nstr;                    /* status line display  */
  103.  
  104. index    dataindex;                    /* the working index    */
  105. definition    dbasedefn;                /* the working definition */
  106. datarecord  currec;                    /* current record in mem */
  107.  
  108. file ()    curdatfil;                    
  109. channel output binary curdatfilout;
  110. channel input binary curdatfilin;
  111.  
  112. file ()    curdeffil;
  113. channel output binary curdeffilout;
  114. channel input binary curdeffilin;
  115.  
  116. file ()    curindxfil;
  117. channel output binary curindxfilout;
  118. channel input binary curindxfilin;
  119.  
  120. string         rootname;                /* base part of database filename */
  121. totstore      store;                    /* scratch i/o storage              */
  122.  
  123. channel output text crtout;         /* crt access channel */
  124.  
  125. proc initscreen() void:
  126. /* open screen */
  127. /* MACHINE SPECIFIC */
  128. CRT_Initialize("File-it 1.0/ns",dwindsize+3,windwidth);
  129. open(crtout,CRT_PutChar);
  130. CRT_AbortDisable();
  131. corp;
  132.  
  133. proc closescreen() void:
  134. /* close screen */
  135. /* MACHINE  SPECIFIC */
  136. close(crtout);
  137. CRT_Terminate();
  138. corp;
  139.  
  140. proc gotoxy(uint x,y) void:
  141. /* locate cursor at x,y */
  142. /* cursor co-ords 1,1 80,25 */
  143. /*  MACHINE SPECIFIC */
  144. CRT_Move(y-1,x-1);
  145. corp;
  146.  
  147. proc printchr(char c) void:
  148. /* print a char and advance cursor */
  149. /* MACHINE SPECIFIC */
  150. CRT_PutChar(c);
  151. corp;
  152.  
  153. proc getchr() char:
  154. /* gets a character from keyboard .. no echo */
  155. /* MACHINE SPECIFIC */
  156. char tc;
  157. tc:=CRT_ReadChar();
  158. tc
  159. corp;
  160.  
  161. proc clearrecwind() void:
  162. /* clear record display window */
  163. /* MACHINE SPECIFIC */
  164. CRT_ClearLines(0,dwindsize);
  165. corp;
  166.  
  167. proc clearscr() void:
  168. /* clear entire screen */
  169. /* MACHINE SPECIFIC */
  170. CRT_ClearScreen();
  171. corp;
  172.  
  173. proc clearcmdwind() void:
  174. /* clear command window */
  175. /* MACHINE SPECIFIC */
  176. CRT_ClearToEnd(dwindsize+1);
  177. corp;
  178.  
  179. proc clearstatwind() void:
  180. /* clear status window */
  181. /* MACHINE SPECIFIC */
  182. CRT_ClearLine(dwindsize);
  183. corp;
  184.  
  185. proc movecursor(*uint x,y) void:
  186. /* allow user to move cursor around until RET pressed */
  187. /* returns co-ords where ret pressed */
  188. /* co-ords are ranged 1..windwidth 1..dwindsize */
  189. /* MACHINE SPECIFIC */
  190. char c;
  191. uint a,b;
  192. CRT_Move(0,0);
  193. a:=1;
  194. b:=1;
  195. c:=' ';
  196. while c~='\r' do
  197.     c:=CRT_ReadChar();
  198.     if c='\(155)' then
  199.         c:=CRT_ReadChar();
  200.         if c='D' then
  201.             if a>1 then
  202.                 a:=a-1;
  203.                 CRT_Move(b-1,a-1);
  204.                 fi;
  205.         elif c='C' then
  206.             if a<windwidth then
  207.                 a:=a+1;
  208.                 CRT_Move(b-1,a-1);
  209.                 fi;
  210.         elif c='A' then
  211.             if b>1 then
  212.                 b:=b-1;
  213.                 CRT_Move(b-1,a-1);
  214.                 fi;
  215.         elif c='B' then
  216.             if b<dwindsize then
  217.                 b:=b+1;
  218.                 CRT_Move(b-1,a-1);
  219.                 fi;
  220.         fi;
  221.     fi;
  222.     od;
  223. x*:=a;
  224. y*:=b;
  225. corp;
  226.  
  227. proc readstr(*char str;uint maxlen) void:
  228. /* read a string at the current cursor pos */
  229. /* upto size limit of maxlen chars */
  230. /* obey CR & BS only */
  231. /* MACHINE SPECIFIC */
  232.  
  233. char c;
  234. uint a;
  235. string s;
  236. if not CRT_Read(str,maxlen+1,false,false,"",pretend(&s,*char)) then
  237.     CharsCopy(str,"");
  238. fi;
  239. corp;
  240.  
  241. proc printstrbox(uint x1,y1,x2,y2;*char s) void:
  242. /* prints a string in a box on screen */
  243. uint a,b,c;
  244. *char str;
  245.  
  246. gotoxy(x1,y1);
  247. str:=s;
  248. a:=x1;
  249. b:=y1;
  250. c:=0;
  251. while (str* ~= '\e' and b <= y2) do
  252.     if a>x2 then
  253.         a:=x1;
  254.         b:=b+1;
  255.         gotoxy(a,b);
  256.         fi;
  257.     if b<=y2 then
  258.         printchr(str*);
  259.         str:=str+1;
  260.         a:=a+1;
  261.         fi;
  262.     od;
  263. corp;
  264.  
  265. proc editstrbox(uint etlx,etly,ebrx,ebry,skip;* char s) void:
  266. /* edits the string on screen inside box */
  267. /* note indents skip chars on first line */
  268. /*      doesnt do initial display of field */
  269. /* MACHINE SPECIFIC */
  270. char c;
  271. uint i,j;
  272. uint pos;
  273. *char t;
  274.  
  275. pos:=1;
  276. i:=etlx+(skip % (ebrx-etlx+1));
  277. j:=etly+(skip / (ebrx-etlx+1));
  278. gotoxy(i,j);
  279. c:=' ';
  280. while c~='\r' do
  281.     c:=CRT_ReadChar();
  282.         if c='\(155)' then
  283.         c:=CRT_ReadChar();
  284.         if c='D' then
  285.             if pos>1 then
  286.                 pos:=pos-1;
  287.                 i:=i-1;
  288.                 if i<etlx then
  289.                     i:=ebrx;
  290.                     j:=j-1;
  291.                     fi;
  292.                 gotoxy(i,j);
  293.                 fi;
  294.         elif c='C' then
  295.             if (pos<CharsLen(s) and (i<=ebrx) and (j<=ebry)) then
  296.                 pos:=pos+1;
  297.                 i:=i+1;
  298.                 if i>ebrx then
  299.                     i:=etlx;
  300.                     j:=j+1;
  301.                     fi;
  302.                 gotoxy(i,j);
  303.                 fi;
  304.         elif c='A' then
  305.             if (pos>(ebrx-etlx+1)) then
  306.                 pos:=pos-(ebrx-etlx+1);
  307.                 j:=j-1;
  308.                 gotoxy(i,j);
  309.                 fi;
  310.         elif c='B' then 
  311.             if j<ebry then
  312.                 pos:=pos+(ebrx-etlx+1);
  313.                 j:=j+1;
  314.                 gotoxy(i,j);
  315.                 fi;
  316.         fi;
  317.     else if (pos<=CharsLen(s)) and (i<=ebrx) and (j<=ebry) and (c>=' ') and (c<'\(127)') then
  318.         t:=s+pos-1;
  319.         t*:=c;
  320.         gotoxy(i,j);
  321.         printchr(c);
  322.         pos:=pos+1;
  323.         i:=i+1;
  324.         if (i>ebrx) then 
  325.             i:=etlx;
  326.             j:=j+1;
  327.             fi;
  328.         fi;
  329.     fi;
  330. od;
  331.  
  332. corp;
  333.  
  334. proc doerror(* char s) void:
  335. /* write string on error status line and wait */
  336. char d;
  337. clearstatwind();
  338. printstrbox(1,dwindsize+1,windwidth,dwindsize+1,s);
  339. d:=getchr();
  340. clearstatwind();
  341. corp;
  342.  
  343. proc savedefn() void:
  344. /* save definition to disk */
  345. /* MACHINE SPECIFIC */
  346. string sdts;
  347. CharsCopy(pretend(&sdts,*char),pretend(&rootname,*char));
  348. CharsConcat(pretend(&sdts,*char),".def");
  349. pretend(FileCreate(pretend(&sdts,*char)),void);
  350. open(curdeffilout,curdeffil,pretend(&sdts,*char));
  351. write(curdeffilout;dbasedefn);
  352. close(curdeffilout);
  353. corp;
  354.  
  355. proc loaddefn() void:
  356. /*load in definition from disk */
  357. /*MACHINE SPECIFIC */
  358. string ldts;
  359. CharsCopy(pretend(&ldts,*char),pretend(&rootname,*char));
  360. CharsConcat(pretend(&ldts,*char),".def");
  361. open(curdeffilin,curdeffil,pretend(&ldts,*char));
  362. read(curdeffilin;dbasedefn);
  363. close(curdeffilin);
  364. corp;
  365.  
  366. proc saveindx() void:
  367. /* save index to disk */
  368. /* MACHINE SPECIFIC */
  369. string sits;
  370. CharsCopy(pretend(&sits,*char),pretend(&rootname,*char));
  371. CharsConcat(pretend(&sits,*char),".idx");
  372. pretend(FileCreate(pretend(&sits,*char)),void);
  373. open(curindxfilout,curindxfil,pretend(&sits,*char));
  374. write(curindxfilout;dataindex);
  375. close(curindxfilout);
  376. corp;
  377.  
  378. proc loadindx() void:
  379. /* load index from disk */
  380. /* MACHINE SPECIFIC */
  381. string lits;
  382. CharsCopy(pretend(&lits,*char),pretend(&rootname,*char));
  383. CharsConcat(pretend(&lits,*char),".idx");
  384. open(curindxfilin,curindxfil,pretend(&lits,*char));
  385. read(curindxfilin;dataindex);
  386. close(curindxfilin);
  387. corp;
  388.  
  389. proc createdbase() void:
  390. /* create and initialize index and data files */
  391. /* MACHINE SPECIFIC */
  392. uint a;
  393. string crts;
  394. CharsCopy(pretend(&crts,*char),pretend(&rootname,*char));
  395. CharsConcat(pretend(&crts,*char),".dat");
  396.  
  397. pretend(FileCreate(pretend(&crts,*char)),void);
  398. for a from 1 by 1 upto maxrecs do
  399.     dataindex.level[1].map[a]:=false;
  400.     od;
  401. CharsCopy(pretend(&dataindex.level[1].indexname,*char),"top level");
  402. dataindex.level[1].numonlev:=0;
  403. dataindex.currecnum:=1;
  404. dataindex.maxrecnum:=0;
  405. dataindex.curlev:=1;
  406. dataindex.numdeletes:=0;
  407. saveindx();
  408. corp;
  409.  
  410. proc getcoords(* uint gx1,gy1,gx2,gy2) void:
  411. uint tx1,tx2,ty1,ty2,tt;
  412. clearcmdwind();
  413. printstrbox(1,dwindsize+2,windwidth,dwindsize+2,"move cursor to first corner and press enter  ");
  414. printstrbox(1,dwindsize+3,windwidth,dwindsize+3,"Use cursor keys");
  415. movecursor(&tx1,&ty1);
  416. printstrbox(1,dwindsize+2,windwidth,dwindsize+2,"move cursor to second corner and press enter ");
  417. movecursor(&tx2,&ty2);
  418. if (tx2<tx1) then
  419.     tt:=tx1;
  420.     tx1:=tx2;
  421.     tx2:=tt;
  422.     fi;
  423. if (ty2<ty1) then
  424.     tt:=ty1;
  425.     ty1:=ty2;
  426.     ty2:=tt;
  427.     fi;
  428. gx1*:=tx1;
  429. gx2*:=tx2;
  430. gy1*:=ty1;
  431. gy2*:=ty2;
  432. corp;                
  433.  
  434. proc setupdefn () void:
  435. /* allow user to set up record structure */
  436. bool doneflag,errflag;
  437. uint x1,y1,x2,y2,t;
  438. string s,fillstr,clrstr;
  439. uint p;
  440.  
  441. CharsCopy(pretend(&fillstr,*char),"");
  442. CharsCopy(pretend(&clrstr,*char),"");
  443.  
  444. for p from 1 by 1 upto maxfieldsize do
  445.     CharsConcat(pretend(&fillstr,*char),"*");
  446.     CharsConcat(pretend(&clrstr,*char)," ");
  447.     od;
  448.     
  449. doneflag:=false;
  450. errflag:=true;
  451. p:=1;
  452. clearscr();
  453.  
  454. while (p<=maxfields) and (doneflag=false) do
  455.     clearcmdwind();
  456.     printstrbox(1,dwindsize+2,windwidth,dwindsize+2,"Enter name of field or ENTER to finish");
  457.     gotoxy(42,dwindsize+2);
  458.     readstr(pretend(&s,*char),fieldnamesize);
  459.     if CharsLen(pretend(&s,*char))=0 then 
  460.         doneflag:=true;
  461.     else
  462.         CharsConcat(pretend(&s,*char),"             ");
  463.         CharsCopyN(pretend(&dbasedefn.spec[p].fieldname,*char),pretend(&s,*char),fieldnamesize);
  464.         while 
  465.             getcoords(&x1,&y1,&x2,&y2);
  466.             dbasedefn.spec[p].tlx:=x1;
  467.             dbasedefn.spec[p].tly:=y1;
  468.             dbasedefn.spec[p].brx:=x2;
  469.             dbasedefn.spec[p].bry:=y2;
  470.             dbasedefn.spec[p].size:=(x2-x1+1)*(y2-y1+1);
  471.             if (dbasedefn.spec[p].size>maxfieldsize) or
  472.                (dbasedefn.spec[p].size<fieldnamesize+1) then
  473.                 errflag:=true;
  474.             else
  475.                 errflag:=false;
  476.                 fi;
  477.             errflag=true
  478.             do;
  479.             od;
  480.         CharsCopy(pretend(&s,*char),pretend(&dbasedefn.spec[p].fieldname,*char));
  481.         CharsConcat(pretend(&s,*char),pretend(&fillstr,*char));
  482.         CharsCopyN(pretend(&s,*char),pretend(&s,*char),dbasedefn.spec[p].size);
  483.         printstrbox(x1,y1,x2,y2,pretend(&s,*char));
  484.         clearcmdwind();
  485.         printstrbox(1,dwindsize+2,windwidth,dwindsize+2,"is this ok (y/n) : ");
  486.         while 
  487.             gotoxy(22,dwindsize+2);
  488.             readstr(pretend(&s,*char),1);
  489.             s[0]~='y' and s[0]~='Y' and s[0]~='n' and s[0]~='N'
  490.         do
  491.         od;
  492.         if (s[0]='y') or (s[0]='Y') then
  493.             p:=p+1;
  494.         else
  495.             printstrbox(x1,y1,x2,y2,pretend(&clrstr,*char));
  496.         fi;
  497.     fi;
  498. od;
  499.  
  500. for t from p by 1 upto maxfields do
  501.     dbasedefn.spec[t].tlx:=1;
  502.     dbasedefn.spec[t].tly:=1;
  503.     dbasedefn.spec[t].brx:=1;
  504.     dbasedefn.spec[t].bry:=1;
  505.     dbasedefn.spec[t].size:=0;
  506.     CharsCopyN(pretend(&dbasedefn.spec[t].fieldname,*char),"EMPTY          ",8);
  507.     od;
  508.  
  509. dbasedefn.totsize:=0;
  510. for p from 1 by 1 upto maxfields do
  511.     dbasedefn.totsize:=dbasedefn.totsize+dbasedefn.spec[p].size;
  512.     od;
  513. dbasedefn.blkfac:=dbasedefn.totsize/blocksize+1;
  514.  
  515. savedefn();
  516. createdbase();
  517. clearscr();
  518. corp;
  519.  
  520. proc initfiles() void:
  521. /*open all files ready for use */
  522. /*assumes rootname already set */
  523. /* MACHINE  SPECIFIC */
  524. string is;
  525. CharsCopy(pretend(&is,*char),pretend(&rootname,*char));
  526. CharsConcat(pretend(&is,*char),".dat");
  527. loadindx();
  528. loaddefn();
  529. open(curdatfilin,curdatfil,pretend(&is,*char));
  530. ReOpen(curdatfilin,curdatfilout);
  531.  
  532. corp;
  533.  
  534. proc getrecord(uint i) void:
  535. /* getrecord no i from disk and put in currec */
  536. /* MACHINE SPECIFIC */
  537. uint a,b,c;
  538. *char gtp;
  539. diskblock gtemp;
  540.  
  541. pretend(SeekIn(curdatfilin,(i-1)*dbasedefn.blkfac*sizeof(diskblock)),void);
  542. c:=1;
  543. for a from 1 by 1 upto dbasedefn.blkfac do
  544.     read(curdatfilin;gtemp);
  545.     BlockMove(pretend(&store[c-1],*byte),pretend(>emp[0],*byte),blocksize);
  546.     c:=c+blocksize;
  547.     od;
  548. c:=1;
  549. for a from 1 by 1 upto maxfields do 
  550.     if dbasedefn.spec[a].size>0 then
  551.         BlockMove(pretend(&currec[a],*byte),pretend(&store[c-1],*byte),dbasedefn.spec[a].size);
  552.         gtp:=pretend(&currec[a],*char)+dbasedefn.spec[a].size;
  553.         gtp*:='\e';
  554.         c:=c+dbasedefn.spec[a].size;
  555.         fi;
  556.     od;
  557. corp;
  558.  
  559. proc putrecord(uint i) void:
  560. /* put record in currec to disk record i */
  561. /* MACHINE SPECIFIC */
  562. diskblock ptemp;
  563. uint a,b,c;
  564.  
  565. pretend(SeekOut(curdatfilout,(i-1)*dbasedefn.blkfac*sizeof(diskblock)),void);
  566.  
  567. c:=1;
  568. for a from 1 by 1 upto maxfields do
  569.     if dbasedefn.spec[a].size>0 then
  570.         BlockMove(pretend(&store[c-1],*byte),pretend(&currec[a],*byte),dbasedefn.spec[a].size);
  571.         c:=c+dbasedefn.spec[a].size;
  572.         fi;
  573.     od;
  574. c:=1;
  575. for a from 1 by 1 upto dbasedefn.blkfac do
  576.     BlockMove(pretend(&ptemp[0],*byte),pretend(&store[c-1],*byte),blocksize);
  577.     c:=c+blocksize;
  578.     write(curdatfilout;ptemp);
  579.     od;
  580. corp;
  581.  
  582. proc gotonextrecord() void:
  583. /* moves currecnum to the next record on the cur lev and gets it */
  584. if dataindex.level[dataindex.curlev].numonlev=0 then
  585.     doerror("error gotonextrecord ... this level is empty!");
  586. else
  587.     while
  588.         dataindex.currecnum:=dataindex.currecnum+1;
  589.         if dataindex.currecnum>dataindex.maxrecnum then
  590.             dataindex.currecnum:=1;
  591.         fi;
  592.         dataindex.level[dataindex.curlev].map[dataindex.currecnum]=false
  593.         do
  594.         od;
  595.     getrecord(dataindex.currecnum);
  596.     fi;
  597. corp;
  598.  
  599. proc gotoprevrecord() void:
  600. /* moves currecnum to the previous record and gets it */
  601. if dataindex.level[dataindex.curlev].numonlev=0 then
  602.     doerror("error gotoprevrecord ... this level is empty!");
  603. else
  604.     while
  605.         dataindex.currecnum:=dataindex.currecnum-1;
  606.         if dataindex.currecnum=0 then
  607.             dataindex.currecnum:=dataindex.maxrecnum;
  608.             fi;
  609.         dataindex.level[dataindex.curlev].map[dataindex.currecnum]=false
  610.         do
  611.         od;
  612.     getrecord(dataindex.currecnum);
  613.     fi;
  614. corp;
  615.  
  616. proc gotofirst() void:
  617. /* movces currecnum to the first rec on level and gets it */
  618. if dataindex.level[dataindex.curlev].numonlev=0 then
  619.     doerror("error gotofirst ... this level is empty!");
  620. else
  621.     dataindex.currecnum:=1;
  622.     if dataindex.level[dataindex.curlev].map[dataindex.currecnum]=false then
  623.         gotonextrecord();
  624.     else
  625.         getrecord(dataindex.currecnum);
  626.         fi;
  627.     fi;
  628. corp;
  629.  
  630. proc gotolast() void:
  631. /* goto last record on current level and get it */
  632. if dataindex.level[dataindex.curlev].numonlev=0 then
  633.     doerror("error gotolast ... this level is empty");
  634. else
  635.     dataindex.currecnum:=dataindex.maxrecnum;
  636.     if dataindex.level[dataindex.curlev].map[dataindex.currecnum]=false then
  637.         gotoprevrecord();
  638.     else
  639.         getrecord(dataindex.currecnum);
  640.         fi;
  641.     fi;
  642. corp;
  643.  
  644. proc dumpstrbox(uint x1,y1,x2,y2;*char ds) void:
  645. /* dump string into image buffer */
  646. uint gx,gy,a,b,c;
  647. string str;
  648.  
  649. CharsCopy(pretend(&str,*char),ds);
  650. gx:=x1;
  651. gy:=y1;
  652. a:=x1;
  653. b:=y1;
  654. c:=1;
  655. while (c<=CharsLen(pretend(&str,*char))) and (b<=y2) do
  656.     if a>x2 then
  657.         a:=x1;
  658.         b:=b+1;
  659.         gx:=a;
  660.         gy:=b;
  661.         fi;
  662.     if b<=y2 then
  663.         scrbuf[gx,gy]:=str[c-1];
  664.         gx:=gx+1;
  665.         c:=c+1;
  666.         a:=a+1;
  667.         fi;
  668.     od;
  669. corp;
  670.  
  671. proc outlevel(*char fn) void:
  672. /*dump current level to disk file as ascii */
  673. /* MACHINE SPECIFIC */
  674. uint x,y,c;
  675. string dts;
  676.  
  677. if dataindex.level[dataindex.curlev].numonlev=0 then
  678.     doerror("error dumplevel ... this level is empty!");
  679. else
  680.     if not FileCreate(fn) then
  681.         doerror("dump filecreate failed");
  682.     fi;
  683.      if not open(outfilout,outfile,fn) then
  684.         doerror("dump file open failed");
  685.     fi;
  686.     for y from 1 by 1 upto dwindsize do
  687.         for x from 1 by 1 upto windwidth do
  688.             scrbuf[x,y]:=' ';
  689.             od;
  690.         od;
  691.     dataindex.currecnum:=1;
  692.     while dataindex.currecnum<=dataindex.maxrecnum do
  693.         if dataindex.level[dataindex.curlev].map[dataindex.currecnum]=true then
  694.             getrecord(dataindex.currecnum);
  695.             for c from 1 by 1 upto maxfields do
  696.                 if dbasedefn.spec[c].size>0 then
  697.                     CharsCopy(pretend(&dts,*char),pretend(&dbasedefn.spec[c].fieldname,*char));
  698.                     CharsConcat(pretend(&dts,*char),pretend(&currec[c],*char));
  699.                     dumpstrbox(dbasedefn.spec[c].tlx,
  700.                                dbasedefn.spec[c].tly,
  701.                                dbasedefn.spec[c].brx,
  702.                                dbasedefn.spec[c].bry,
  703.                                pretend(&dts,*char)    );
  704.                     fi;
  705.                 od;
  706.             for y from 1 by 1 upto dwindsize do
  707.                 for x from 1 by 1 upto windwidth do
  708.                     write(outfilout;scrbuf[x,y]);
  709.                     od;
  710.                 writeln(outfilout;);
  711.                 od;
  712.             writeln(outfilout;);
  713.             fi;
  714.         dataindex.currecnum:=dataindex.currecnum+1;
  715.         od;
  716.     close(outfilout);
  717.     gotofirst();
  718.     fi;
  719. corp;
  720.  
  721. proc displayrec() void:
  722. /* display currec on screen */
  723. uint za;
  724. string ts;
  725.  
  726. for za from 1 by 1 upto maxfields do
  727.     if dbasedefn.spec[za].size>0 then
  728.         CharsCopy(pretend(&ts,*char),pretend(&dbasedefn.spec[za].fieldname,*char));
  729.         CharsConcat(pretend(&ts,*char),pretend(&currec[za],*char));
  730.         printstrbox(dbasedefn.spec[za].tlx,
  731.                     dbasedefn.spec[za].tly,
  732.                     dbasedefn.spec[za].brx,
  733.                     dbasedefn.spec[za].bry,
  734.                     pretend(&ts,*char));
  735.         fi;
  736.     od;
  737. corp;
  738.  
  739. proc addrecord() void:
  740. /* adds the current memory record to dbase and leaves currecnum pointing to it*/
  741. /* NOTE at present unconditionally adds record to current selection */
  742. uint a,b;
  743. if dataindex.numdeletes>0 then
  744.     a:=1;
  745.     while dataindex.level[1].map[a]=true do
  746.         a:=a+1;
  747.         od;
  748.     dataindex.numdeletes:=dataindex.numdeletes-1;
  749.     putrecord(a);
  750.     dataindex.currecnum:=a;
  751.     for b from 1 by 1 upto maxsels do
  752.         dataindex.level[b].map[a]:=true;
  753.         dataindex.level[b].numonlev:=dataindex.level[b].numonlev+1;
  754.         od;
  755. elif dataindex.maxrecnum=maxrecs then
  756.     doerror("error addrecord ... database is full, unable to add record");
  757.     gotolast();
  758. else
  759.     a:=dataindex.maxrecnum+1;
  760.     putrecord(a);
  761.     dataindex.maxrecnum:=a;
  762.     dataindex.currecnum:=a;
  763.     for b from 1 by 1 upto maxsels do
  764.         dataindex.level[b].map[a]:=true;
  765.         dataindex.level[b].numonlev:=dataindex.level[b].numonlev+1;
  766.         od;
  767.     fi;
  768. corp;
  769.  
  770. proc deleterecord() void:
  771. /* deletes the current record from dbase and moves to next record */
  772. uint a;
  773. if dataindex.currecnum=0 then
  774.     doerror("error delete record ... database is empty");
  775. else
  776.     for a from 1 by 1 upto maxsels do
  777.         dataindex.level[a].map[dataindex.currecnum]:=false;
  778.         dataindex.level[a].numonlev:=dataindex.level[a].numonlev-1;
  779.         od;
  780.     dataindex.numdeletes:=dataindex.numdeletes+1;
  781.     gotonextrecord();
  782.     fi;
  783. corp;
  784.  
  785. proc editrecord() void:
  786. /* display and edit currec on screen */
  787. char c;
  788. uint p,i;
  789. string ts;
  790.  
  791. clearscr();
  792. displayrec();
  793. p:=1;
  794. while
  795.     CharsCopy(pretend(&ts,*char),pretend(&dbasedefn.spec[p].fieldname,*char));
  796.     CharsConcat(pretend(&ts,*char)," Edit Previous Next Done ( E P N D )");
  797.     printstrbox(1,dwindsize+2,windwidth,dwindsize+2,pretend(&ts,*char));
  798.     while
  799.         gotoxy(46,dwindsize+2);
  800.         c:=getchr();
  801.         not ((c='n') or (c='N') or (c='p') or (c='P') or (c='e') or
  802.              (c='E') or (c='d') or (c='D'))
  803.         do
  804.         od;
  805.     if (c='p') or (c='P') then
  806.         p:=p-1;
  807.         if p=0 then
  808.             p:=maxfields;
  809.             while dbasedefn.spec[p].size=0 do
  810.                 p:=p-1;
  811.                 od;
  812.             fi;
  813.         fi;
  814.     if (c='n') or (c='N') then 
  815.         p:=p+1;
  816.         if dbasedefn.spec[p].size=0 then
  817.             p:=1;
  818.             fi;
  819.         fi;
  820.     if (c='e') or (c='E') then
  821.         printstrbox(1,dwindsize+3,windwidth,dwindsize+3,"Cursor keys-move, Enter-finish");
  822.         editstrbox(dbasedefn.spec[p].tlx,
  823.                    dbasedefn.spec[p].tly,
  824.                    dbasedefn.spec[p].brx,
  825.                    dbasedefn.spec[p].bry,
  826.                    fieldnamesize,
  827.                    pretend(&currec[p],*char));
  828.         printstrbox(1,dwindsize+3,windwidth,dwindsize+3,"                                                       ");
  829.         p:=p+1;
  830.         if dbasedefn.spec[p].size=0 then 
  831.             p:=1;
  832.             fi;
  833.         fi;
  834.     not((c='d') or (c='D'))
  835.     do
  836.     od;
  837. clearscr();
  838. corp;
  839.  
  840. proc upper(*char s) void:
  841. /* force string to upper case */
  842. while s*~='\e' do
  843.     s*:=pretend(pretend(s*,byte)|32,char);
  844.     s:=s+1;
  845.     od;
  846. corp;
  847.  
  848. proc getnchar(*char s;uint n) char:
  849. /* return nth char of s n=1.. */
  850. *char t;
  851. t:=s+n-1;
  852. t*
  853. corp;
  854.  
  855. proc match(*char mpat,mss) bool:
  856. /* checks if ss matches on pat using wildcards */
  857. uint i,j;
  858. bool done,matchd;
  859. string t1,t2;
  860. char tc;
  861. string p,s;
  862. *char pat,ss;
  863.  
  864. pat:=pretend(&p,*char);
  865. ss:=pretend(&s,*char);
  866. CharsCopy(pat,mpat);
  867. CharsCopy(ss,mss);
  868.  
  869. if getnchar(pat,1)='*' then
  870.     if CharsLen(pat)=1 then
  871.         matchd:=true;
  872.     else
  873.         i:=2;
  874.         while i<=CharsLen(pat) and getnchar(pat,i)='?' do
  875.             i:=i+1;
  876.             od;
  877.         if i>CharsLen(pat) then
  878.             matchd:=true;
  879.         else
  880.             t1[0]:=getnchar(pat,i);
  881.             t1[1]:='\e';
  882.             j:=CharsIndex(ss,pretend(&t1,*char))+1;
  883.             if j=0 then
  884.                 matchd:=false;
  885.                 done:=true;
  886.             else
  887.                 CharsCopy(pretend(&t1,*char),pat+i-1);
  888.                 CharsCopy(pretend(&t2,*char),ss+j-1);
  889.                 if match(pretend(&t1,*char),pretend(&t2,*char)) then
  890.                     matchd:=true;
  891.                     done:=true;
  892.                 else
  893.                     CharsCopy(ss,ss+j+1-1);
  894.                 fi;
  895.             fi;
  896.         fi;
  897.     fi;
  898. else
  899.     i:=1;
  900.     done:=false;
  901.     matchd:=true;
  902.     while not done do
  903.         if getnchar(pat,i)='*' then
  904.             done:=true;
  905.         elif getnchar(pat,i)~='?' then
  906.             if getnchar(pat,i)~=getnchar(ss,i) then
  907.                 matchd:=false;
  908.                 done:=true;
  909.             fi;
  910.         fi;
  911.         i:=i+1;
  912.         if not done then
  913.             if i>CharsLen(pat) and i>CharsLen(ss) then
  914.                 done:=true;
  915.             elif i>CharsLen(pat) or i>CharsLen(ss) then
  916.                 done:=true;
  917.                 matchd:=false;
  918.             fi;
  919.         fi;
  920.     od;
  921. fi;
  922. matchd
  923. corp;
  924.  
  925. proc find(*char fpattern,fstr) bool:
  926. /* searches fstr for any occurence of pattern, matching on blank separated
  927.    words. Search is non-case-sensitive. In pattern ? means match any single
  928.    char and may occur anywhere in pattern. * means match any run of chars 
  929.    and may only be first or last element of patter */
  930.  
  931. *char pattern,str;
  932. string p,s;
  933. uint i,j;
  934. string ws;
  935. string ts;
  936. bool done,found;
  937.  
  938. pattern:=pretend(&p,*char);
  939. str:=pretend(&s,*char);
  940. CharsCopy(pattern,fpattern);
  941. CharsCopy(str,fstr);
  942. upper(pattern);
  943. upper(str);
  944.  
  945. if CharsIndex(pattern,"*")=-1 and CharsIndex(pattern,"?")=-1 then
  946.     CharsCopy(pretend(&ws,*char)," ");
  947.     CharsConcat(pretend(&ws,*char),pattern);
  948.     CharsConcat(pretend(&ws,*char)," ");
  949.     CharsCopy(pretend(&ts,*char)," ");
  950.     CharsConcat(pretend(&ts,*char),str);
  951.     CharsConcat(pretend(&ts,*char)," ");
  952.     if CharsIndex(pretend(&ts,*char),pretend(&ws,*char))=-1 then
  953.         found:=false;
  954.     else
  955.         found:=true;
  956.     fi;
  957. else
  958.     i:=1;
  959.     j:=1;
  960.     while getnchar(str,j)=' ' and j<=CharsLen(str) do
  961.         j:=j+1;
  962.         od;
  963.     found:=false;
  964.     done:=false;
  965.     while j<=CharsLen(str) and not done do
  966.         ws[i-1]:=getnchar(str,j);
  967.         i:=i+1;
  968.         j:=j+1;
  969.         if getnchar(str,j)=' ' or j>CharsLen(str) then
  970.             ws[i-1]:='\e';
  971.             if match(pattern,pretend(&ws,*char)) then
  972.                 done:=true;
  973.                 found:=true;
  974.             fi;
  975.             while getnchar(str,j)=' ' and j<=CharsLen(str) do
  976.                 j:=j+1;
  977.             od;
  978.             i:=1;
  979.         fi;
  980.     od;
  981. fi;
  982. found
  983. corp;
  984.  
  985. proc select(*char f,p) void:
  986. /* carries out select op on database */
  987. bool err,matchd;
  988. uint i,fieldnum,nummatchd;
  989. string tempstr,sfieldname,pattern;
  990.  
  991. CharsCopy(pretend(&sfieldname,*char),f);
  992. CharsCopy(pretend(&pattern,*char),p);
  993. err:=false;
  994. matchd:=false;
  995. if CharsLen(pretend(&pattern,*char))>1 then
  996.     for i from 2 by 1 upto CharsLen(pretend(&pattern,*char))-1 do
  997.         if pattern[i-1]='*' then
  998.             doerror("illegal pattern specifier");
  999.             err:=true;
  1000.         fi;
  1001.     od;
  1002. fi;
  1003.  
  1004. for i from 1 by 1 upto maxfields do
  1005.     if dbasedefn.spec[i].size>0 then
  1006.         CharsCopy(pretend(&tempstr,*char),pretend(&dbasedefn.spec[i].fieldname,*char));
  1007.         if find(pretend(&sfieldname,*char),pretend(&tempstr,*char)) then
  1008.             matchd:=true;
  1009.             fieldnum:=i;
  1010.         fi;
  1011.     fi;
  1012. od;
  1013.  
  1014. if not matchd then
  1015.     doerror("bad fieldname");
  1016.     err:=true;
  1017. fi;
  1018.  
  1019. if dataindex.curlev=maxsels then
  1020.     doerror("selection levels full, select abandoned");
  1021.     err:=true;
  1022. fi;
  1023.  
  1024. if not err then
  1025.     nummatchd:=0;
  1026.     for i from 1 by 1 upto dataindex.maxrecnum do
  1027.         if dataindex.level[dataindex.curlev].map[i]=false then
  1028.             dataindex.level[dataindex.curlev+1].map[i]:=false;
  1029.         else
  1030.             getrecord(i);
  1031.             CharsCopy(pretend(&tempstr,*char),pretend(&currec[fieldnum],*char));
  1032.             if find(pretend(&pattern,*char),pretend(&tempstr,*char)) then
  1033.                 dataindex.level[dataindex.curlev+1].map[i]:=true;
  1034.                 nummatchd:=nummatchd+1;
  1035.             else
  1036.                 dataindex.level[dataindex.curlev+1].map[i]:=false;
  1037.             fi;
  1038.         fi;
  1039.     od;
  1040.     dataindex.curlev:=dataindex.curlev+1;
  1041.     CharsCopy(pretend(&tempstr,*char),"select ");
  1042.     CharsConcat(pretend(&tempstr,*char),pretend(&pattern,*char));
  1043.     CharsConcat(pretend(&tempstr,*char)," on ");
  1044.     CharsConcat(pretend(&tempstr,*char),pretend(&sfieldname,*char));
  1045.     CharsCopy(pretend(&dataindex.level[dataindex.curlev].indexname,*char),pretend(&tempstr,*char));
  1046.     dataindex.level[dataindex.curlev].numonlev:=nummatchd;
  1047.     if nummatchd=0 then
  1048.         doerror("level empty ... select abandoned");
  1049.         dataindex.curlev:=dataindex.curlev-1;
  1050.     else
  1051.         gotofirst();
  1052.     fi;
  1053. fi;
  1054. corp;
  1055.  
  1056. proc exclude(*char f,p) void:
  1057. /* carries out exclude op on database */
  1058. bool err,matchd;
  1059. uint i,fieldnum,nummatchd;
  1060. string tempstr,sfieldname,pattern;
  1061.  
  1062. CharsCopy(pretend(&sfieldname,*char),f);
  1063. CharsCopy(pretend(&pattern,*char),p);
  1064. err:=false;
  1065. matchd:=false;
  1066. if CharsLen(pretend(&pattern,*char))>1 then
  1067.     for i from 2 by 1 upto CharsLen(pretend(&pattern,*char))-1 do
  1068.         if pattern[i-1]='*' then
  1069.             doerror("illegal pattern specifier");
  1070.             err:=true;
  1071.         fi;
  1072.     od;
  1073. fi;
  1074.  
  1075. for i from 1 by 1 upto maxfields do
  1076.     if dbasedefn.spec[i].size>0 then
  1077.         CharsCopy(pretend(&tempstr,*char),pretend(&dbasedefn.spec[i].fieldname,*char));
  1078.         if find(pretend(&sfieldname,*char),pretend(&tempstr,*char)) then
  1079.             matchd:=true;
  1080.             fieldnum:=i;
  1081.         fi;
  1082.     fi;
  1083. od;
  1084.  
  1085. if not matchd then
  1086.     doerror("bad fieldname");
  1087.     err:=true;
  1088. fi;
  1089.  
  1090. if dataindex.curlev=maxsels then
  1091.     doerror("selection levels full, select abandoned");
  1092.     err:=true;
  1093. fi;
  1094.  
  1095. if not err then
  1096.     nummatchd:=0;
  1097.     for i from 1 by 1 upto dataindex.maxrecnum do
  1098.         if dataindex.level[dataindex.curlev].map[i]=false then
  1099.             dataindex.level[dataindex.curlev+1].map[i]:=false;
  1100.         else
  1101.             getrecord(i);
  1102.             CharsCopy(pretend(&tempstr,*char),pretend(&currec[fieldnum],*char));
  1103.             if not find(pretend(&pattern,*char),pretend(&tempstr,*char)) then
  1104.                 dataindex.level[dataindex.curlev+1].map[i]:=true;
  1105.                 nummatchd:=nummatchd+1;
  1106.             else
  1107.                 dataindex.level[dataindex.curlev+1].map[i]:=false;
  1108.             fi;
  1109.         fi;
  1110.     od;
  1111.     dataindex.curlev:=dataindex.curlev+1;
  1112.     CharsCopy(pretend(&tempstr,*char),"exclude ");
  1113.     CharsConcat(pretend(&tempstr,*char),pretend(&pattern,*char));
  1114.     CharsConcat(pretend(&tempstr,*char)," on ");
  1115.     CharsConcat(pretend(&tempstr,*char),pretend(&sfieldname,*char));
  1116.     CharsCopy(pretend(&dataindex.level[dataindex.curlev].indexname,*char),pretend(&tempstr,*char));
  1117.     dataindex.level[dataindex.curlev].numonlev:=nummatchd;
  1118.     if nummatchd=0 then
  1119.         doerror("level empty ... exclude abandoned");
  1120.         dataindex.curlev:=dataindex.curlev-1;
  1121.     else
  1122.         gotofirst();
  1123.     fi;
  1124. fi;
  1125. corp;
  1126.  
  1127. proc include(*char f,p) void:
  1128. /* carries out include op on database */
  1129. bool err,matchd;
  1130. uint i,fieldnum,nummatchd;
  1131. string tempstr,sfieldname,pattern;
  1132.  
  1133. CharsCopy(pretend(&sfieldname,*char),f);
  1134. CharsCopy(pretend(&pattern,*char),p);
  1135. err:=false;
  1136. matchd:=false;
  1137. if CharsLen(pretend(&pattern,*char))>1 then
  1138.     for i from 2 by 1 upto CharsLen(pretend(&pattern,*char))-1 do
  1139.         if pattern[i-1]='*' then
  1140.             doerror("illegal pattern specifier");
  1141.             err:=true;
  1142.         fi;
  1143.     od;
  1144. fi;
  1145.  
  1146. for i from 1 by 1 upto maxfields do
  1147.     if dbasedefn.spec[i].size>0 then
  1148.         CharsCopy(pretend(&tempstr,*char),pretend(&dbasedefn.spec[i].fieldname,*char));
  1149.         if find(pretend(&sfieldname,*char),pretend(&tempstr,*char)) then
  1150.             matchd:=true;
  1151.             fieldnum:=i;
  1152.         fi;
  1153.     fi;
  1154. od;
  1155.  
  1156. if not matchd then
  1157.     doerror("bad fieldname");
  1158.     err:=true;
  1159. fi;
  1160.  
  1161. if dataindex.curlev=maxsels then
  1162.     doerror("selection levels full, select abandoned");
  1163.     err:=true;
  1164. fi;
  1165.  
  1166. if not err then
  1167.     nummatchd:=0;
  1168.     for i from 1 by 1 upto dataindex.maxrecnum do
  1169.         if dataindex.level[dataindex.curlev].map[i]=true then
  1170.             dataindex.level[dataindex.curlev+1].map[i]:=true;
  1171.             nummatchd:=nummatchd+1;
  1172.         else
  1173.             getrecord(i);
  1174.             CharsCopy(pretend(&tempstr,*char),pretend(&currec[fieldnum],*char));
  1175.             if find(pretend(&pattern,*char),pretend(&tempstr,*char)) then
  1176.                 dataindex.level[dataindex.curlev+1].map[i]:=true;
  1177.                 nummatchd:=nummatchd+1;
  1178.             else
  1179.                 dataindex.level[dataindex.curlev+1].map[i]:=false;
  1180.             fi;
  1181.         fi;
  1182.     od;
  1183.     dataindex.curlev:=dataindex.curlev+1;
  1184.     CharsCopy(pretend(&tempstr,*char),"include ");
  1185.     CharsConcat(pretend(&tempstr,*char),pretend(&pattern,*char));
  1186.     CharsConcat(pretend(&tempstr,*char)," on ");
  1187.     CharsConcat(pretend(&tempstr,*char),pretend(&sfieldname,*char));
  1188.     CharsCopy(pretend(&dataindex.level[dataindex.curlev].indexname,*char),pretend(&tempstr,*char));
  1189.     dataindex.level[dataindex.curlev].numonlev:=nummatchd;
  1190.     if nummatchd=0 then
  1191.         doerror("level empty ... include abandoned");
  1192.         dataindex.curlev:=dataindex.curlev-1;
  1193.     else
  1194.         gotofirst();
  1195.     fi;
  1196. fi;
  1197. corp;
  1198.  
  1199. proc clear() void:
  1200. /*clear selections back to global level*/
  1201. dataindex.curlev:=1;
  1202. gotofirst();
  1203. corp;
  1204.  
  1205. proc back() void:
  1206. /* moves backup one level, cant move past global level */
  1207. if dataindex.curlev>1 then
  1208.     dataindex.curlev:=dataindex.curlev-1;
  1209. fi;
  1210. gotofirst();
  1211. corp;
  1212.  
  1213. proc history() void:
  1214. /* display curreent selection history on screen */
  1215. uint i,j;
  1216. string s;
  1217.  
  1218. clearrecwind();
  1219. i:=1;
  1220. j:=1;
  1221. while i<=dataindex.curlev do
  1222.     gotoxy(1,j);
  1223.     writeln(crtout;"Level ",i," ",dataindex.level[i].indexname);
  1224.     i:=i+1;
  1225.     j:=j+1;
  1226.     if j>dwindsize then
  1227.         doerror("press a key to continue");
  1228.         clearrecwind();
  1229.         j:=1;
  1230.     fi;
  1231. od;
  1232. doerror("press a key to continue");
  1233. clearrecwind();
  1234. corp;
  1235.  
  1236. proc setupdumm(*char s,fill) void:
  1237. /* setup a blank record with s at beginning each field and filler fill*/
  1238. uint a,b;
  1239. string t;
  1240. CharsCopy(pretend(&t,*char),s);
  1241. for a from 1 by 1 upto maxfields do
  1242.     CharsCopy(pretend(&currec[a],*char),pretend(&t,*char));
  1243.     for b from CharsLen(pretend(&currec[a],*char))+1 by 1 upto dbasedefn.spec[a].size do
  1244.         CharsConcat(pretend(&currec[a],*char),fill);
  1245.     od;
  1246. od;
  1247. corp;
  1248.  
  1249. proc main() void:
  1250. /* front end */
  1251.  
  1252. initscreen();
  1253.  
  1254. quit:=false;
  1255. filopnd:=false;
  1256.  
  1257. clearscr();
  1258.  
  1259. printstrbox(27,1,80,1,"     File-It v1.0");
  1260. printstrbox(27,3,80,3,"A personal filing system");
  1261. printstrbox(27,5,80,5,"   Written by J Davis");
  1262. printstrbox(27,7,80,7,"      John Davis");
  1263. printstrbox(27,9,80,9,"        1988");
  1264.  
  1265. while
  1266.     printstrbox(1,dwindsize+2,80,dwindsize+2,"Options --- (Q)uit (C)reate (U)use :");
  1267.     response:=getchr();
  1268.     if response='q' or response='Q' then
  1269.         quit:=true
  1270.     fi;
  1271.     if response='c' or response='C' then
  1272.         clearcmdwind();
  1273.         printstrbox(1,dwindsize+2,80,dwindsize+2,"Enter database name :");
  1274.         readstr(pretend(&rootname,*char),filenamelen);
  1275.         setupdefn();
  1276.         initfiles();
  1277.         filopnd:=true;
  1278.     fi;
  1279.     if response='u' or response='U' then
  1280.         clearcmdwind();
  1281.         printstrbox(1,dwindsize+2,80,dwindsize+2,"Enter database name :");
  1282.         readstr(pretend(&rootname,*char),filenamelen);
  1283.         initfiles();
  1284.         filopnd:=true;
  1285.         gotofirst();
  1286.     fi;
  1287.     not(quit or filopnd)
  1288.     do
  1289. od;
  1290.  
  1291. clearscr();
  1292.  
  1293. while not quit do
  1294.     clearcmdwind();
  1295.     clearstatwind();
  1296.     if dataindex.level[dataindex.curlev].map[dataindex.currecnum] then
  1297.         displayrec();
  1298.     fi;
  1299.     gotoxy(1,dwindsize+1);
  1300.     writeln(crtout;"Record=",dataindex.currecnum," Level=",dataindex.curlev," ",dataindex.level[dataindex.curlev].numonlev," records selected out of ",dataindex.maxrecnum-dataindex.numdeletes);
  1301.     printstrbox(1,dwindsize+2,80,dwindsize+2,"OPTIONS :- (Q)uit (M)odify (D)elete (A)dd (N)ext (P)revious (F)irst (O)utput");
  1302.     printstrbox(1,dwindsize+3,80,dwindsize+3,"           (L)ast (S)elect (I)nclude (E)xclude (H)istory (B)ack (T)oplevel  ");
  1303.     response:=getchr();
  1304.     
  1305.     if response='q' or response='Q' then
  1306.         saveindx();
  1307.         close(curdatfilout);
  1308.         close(curdatfilin);
  1309.         quit:=true;
  1310.     fi;
  1311.     
  1312.     if response='m' or response='M' then
  1313.         if dataindex.level[dataindex.curlev].map[dataindex.currecnum] then
  1314.             editrecord();
  1315.             putrecord(dataindex.currecnum);
  1316.         else
  1317.             doerror("error .. no records selected, cant modify");
  1318.         fi;
  1319.     fi;
  1320.     
  1321.     if response='d' or response='D' then
  1322.         if dataindex.level[dataindex.curlev].map[dataindex.currecnum] then
  1323.             deleterecord();
  1324.         else
  1325.             doerror("error delete ... no records selected");
  1326.         fi;
  1327.     fi;
  1328.     
  1329.     if response='a' or response='A' then
  1330.         setupdumm(""," ");
  1331.         editrecord();
  1332.         addrecord();
  1333.     fi;
  1334.     
  1335.     if response='n' or response='N' then
  1336.         gotonextrecord();
  1337.     fi;
  1338.     
  1339.     if response='p' or response='P' then
  1340.          gotoprevrecord();
  1341.     fi;
  1342.     
  1343.     if response='f' or response='F' then
  1344.         gotofirst();
  1345.     fi;
  1346.     
  1347.     if response='L' or response='l' then
  1348.         gotolast();
  1349.     fi;
  1350.     
  1351.     if response='s' or response='S' then
  1352.         clearcmdwind();
  1353.         printstrbox(1,dwindsize+2,80,dwindsize+2,"SELECT .. enter fieldname : ");
  1354.         readstr(pretend(&fnm,*char),fieldnamesize);
  1355.         printstrbox(1,dwindsize+3,80,dwindsize+3,"          enter pattern   : ");
  1356.         readstr(pretend(&ptrn,*char),40);
  1357.         select(pretend(&fnm,*char),pretend(&ptrn,*char));
  1358.     fi;
  1359.     
  1360.     if response='i' or response='I' then
  1361.         clearcmdwind();
  1362.         printstrbox(1,dwindsize+2,80,dwindsize+2,"INCLUDE .. enter fieldname : ");
  1363.         readstr(pretend(&fnm,*char),fieldnamesize);
  1364.         printstrbox(1,dwindsize+3,80,dwindsize+3,"           enter pattern   : ");
  1365.         readstr(pretend(&ptrn,*char),40);
  1366.         include(pretend(&fnm,*char),pretend(&ptrn,*char));
  1367.     fi;
  1368.     
  1369.     if response='e' or response='E' then
  1370.         clearcmdwind();
  1371.         printstrbox(1,dwindsize+2,80,dwindsize+2,"EXCLUDE .. enter fieldname : ");
  1372.         readstr(pretend(&fnm,*char),fieldnamesize);
  1373.         printstrbox(1,dwindsize+3,80,dwindsize+3,"           enter pattern   : ");
  1374.         readstr(pretend(&ptrn,*char),40);
  1375.         exclude(pretend(&fnm,*char),pretend(&ptrn,*char));
  1376.     fi;
  1377.     
  1378.     if response='h' or response='H' then
  1379.         history();
  1380.     fi;
  1381.     
  1382.     if response='b' or response='B' then
  1383.         back();
  1384.     fi;
  1385.     
  1386.     if response='t' or response='T' then
  1387.         clear();
  1388.     fi;
  1389.     
  1390.     if response='o' or response='O' then
  1391.         clearcmdwind();
  1392.         printstrbox(1,dwindsize+2,80,dwindsize+2,"enter name of output file : ");
  1393.         readstr(pretend(&filnm,*char),filenamelen);
  1394.         outlevel(pretend(&filnm,*char));
  1395.     fi;
  1396.     
  1397. od;
  1398.  
  1399. closescreen();
  1400.  
  1401. corp;