home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / CPM / PARASOL / VIDEOSTO.ARK / MENU-TAP.LIB < prev    next >
Text File  |  1986-10-11  |  7KB  |  227 lines
  1. {----------------------------------------------------------------
  2.     {---- tape record ----}
  3.                                 redefine screen.data;
  4.     record tape.rec;
  5.         field   tape.stock.num  4;
  6.         field   tape.title      45;
  7.         field   tape.star.1     20;
  8.         field   tape.star.2     20;
  9.         field   tape.rating     2;
  10.         field   tape.category   7;
  11.         field   tape.purchase.price 6;
  12.         field   tape.retail.price   6;
  13.         field   tape.purchased.from 20;
  14.         field   tape.date.in.stock  8;
  15.         field   tape.date.out.stock 8;
  16.         record  tape.chk.rec;
  17.             field   tape.member.num     4;
  18.             field   tape.out.date       8;
  19.             field   tape.due.date       8;
  20.             endrec;
  21.         field   tape.count          3;
  22.         endrec;
  23.                                 endredef;
  24.  
  25. procedure   add.tape:
  26. begin
  27.  
  28.     {---- set up defaults ----}
  29.     fill tape.rec with ' ';
  30.     move s.date to tape.date.in.stock;
  31.     move '0' to tape.count;
  32. tape.add.start:
  33.     move 'tape' to screen.name;
  34.     call get.screen.data;
  35.     move ' ' to status.line;
  36.     call status.line.display;
  37.  
  38.     {---- test for end or error ----}
  39.     move tape.stock.num to wk.str;
  40.     call trunc.wk.str;
  41.     if wk.str = 'END' then
  42.         exit
  43.         fi;
  44.     if wk.str = '' then 
  45.         move 'ERROR- stock number missing.' to status.line;
  46.         call status.line.display;
  47.         goto tape.add.start;
  48.         fi;
  49.  
  50.  
  51.     move 0 to sys.key;
  52.     read sys error standard;
  53.     move wk.str to load.t.num;
  54.     call load.t.rec;
  55.     if load.t.key <> 0 then
  56.         move 'ERROR- Duplicate stock number.' to status.line;
  57.         call status.line.display;
  58.         goto tape.add.start;
  59.         fi;
  60.  
  61.     read sys lock error standard;
  62.     move s.t.nxt to t.key;
  63.     move s.t.nxt to tscan.key;
  64.     add 1 to s.t.nxt;
  65.     write sys unlock error standard;
  66.     move tape.rec to t.rec;
  67.     write tape lock unlock error standard;
  68.     move tape.stock.num to tscan.stock.num;
  69.     fill tscan.member.num with ' ';
  70.     write tapescan lock unlock error standard;
  71.     close tape partial error standard;
  72.     close tapescan partial error standard;
  73.  
  74. end;
  75.  
  76. {----------------------------------------------------------------
  77.  
  78. procedure   change.tape:
  79. begin
  80.  
  81.     move 0 to sys.key;
  82.     read sys error standard;
  83.  
  84. sch.get.data:
  85.     call find.tape.num;
  86.     call trunc.wk.str;
  87.     if wk.str = '' then
  88.         exit;
  89.         fi;
  90.     if wk.str = 'END' then
  91.         exit;
  92.         fi;
  93.     move wk.str to load.t.num;
  94.     call load.t.rec;
  95.     if load.t.key = 0 then
  96.         move 'ERROR- Tape number not found- Enter END or number.'
  97.                     to status.line;
  98.         call status.line.display;
  99.         goto sch.get.data;
  100.         fi;
  101.     move load.t.key to t.key;
  102.     read tape error standard;
  103.     move t.rec to tape.rec;
  104.     move 'tape' to screen.name;
  105.     call get.screen.data;
  106.     move tape.rec to t.rec;
  107.     move t.stock.num to wk.str;
  108.     call trunc.wk.str;
  109.     if wk.str = 'END' then
  110.         exit;
  111.         fi;
  112.     write tape error standard;
  113.     move t.stock.num to tscan.stock.num;
  114.     write tapescan lock unlock error standard;
  115. end;
  116.  
  117. {----------------------------------------------------------------}
  118.  
  119. procedure   find.tape.num:
  120. begin
  121.                                 redefine screen.data;
  122.     record tsearch.rec;
  123.  
  124.         field   sch.tape.num    4;
  125.         field   sch.pattern     30;
  126.         record  sch.reply.area;
  127.             record sch.found.pat;
  128.                 field   sch.pat.tape.num    4;
  129.                 field   sch.pat.title   45;
  130.                 endrec;
  131.             string (##sch.found.pat * 14 );
  132.             endrec;
  133.         endrec;
  134.                                     endredef;
  135.  
  136.  
  137.     do
  138.         move #sch.pat.tape.num to wk.sp;
  139.         move 0 to wk.count;
  140.  
  141.         move 0 to sys.key;
  142.         read sys error standard;
  143.  
  144.  
  145. sch.get.data:
  146.         fill tsearch.rec with ' ';
  147.         move 'tsearch' to screen.name;
  148.         call get.screen.data;
  149. retry.tape.entry:
  150.         fill sch.reply.area with ' ';
  151.         move ' ' to status.line;
  152.         call status.line.display;
  153.  
  154.         move sch.pattern to wk.str;
  155.         call trunc.wk.str;
  156.         move wk.str to wk.str.2;
  157.         move sch.tape.num to wk.str;
  158.         call trunc.wk.str;
  159.  
  160.         if wk.str = '' and wk.str.2 = '' then
  161.             move 'ERROR- Enter tape number or title. (? for all)'
  162.                         to status.line;
  163.             call status.line.display;
  164.             goto sch.get.data;
  165.             fi;
  166.  
  167.         move ' ' to status.line;
  168.         call status.line.display;
  169.         if wk.str = 'END' then
  170.             exit;
  171.             fi;
  172.         if wk.str <> '' then    {-- exit if tapr # entered --}
  173.             exit;
  174.             fi;
  175.  
  176.         move wk.str.2 to cur.pattern;
  177.         convert cur.pattern to upper case;
  178.         move 1 to wk.key;
  179.  
  180.         while wk.key < s.t.nxt do
  181.             move wk.key to t.key;
  182.             read tape  error standard;
  183.  
  184.             move t.title to wk.str;
  185.             call trunc.wk.str;
  186.             convert wk.str to upper case;
  187.             if cur.pattern = '?' then
  188.                 move '?' to wk.str;
  189.                 fi;
  190.             scan wk.str for cur.pattern true
  191.             begin
  192.                 move t.stock.num to wk.str.edit[field, length ##sch.pat.tape.num];
  193.                 move wk.str.edit to @wk.sp length ##sch.pat.tape.num;
  194.                 add ##sch.pat.tape.num to wk.sp;
  195.  
  196.                 move t.title to wk.str.edit[field, length ##sch.pat.title];
  197.                 move wk.str.edit to @wk.sp length ##sch.pat.title;
  198.                 add ##sch.pat.title to wk.sp;
  199.  
  200.                 add 1 to wk.count;
  201.                 end;
  202.             add 1 to wk.key;
  203.             if wk.count >= 15 or wk.key >= s.t.nxt then
  204.                 if wk.key >= s.t.nxt then
  205.                     move '>>> Search complete- Enter END or tape number or ?'
  206.                                                             to status.line;
  207.                 else
  208.                     move '>>> Search not complete- Exit screen to continue.'
  209.                                                             to status.line;
  210.                     fi;
  211.                 call status.line.display;
  212.                 call get.screen.data;
  213.                 if sch.tape.num <> " "
  214.                 or sch.pattern <> " " then
  215.                     move 0 to wk.count;
  216.                     move #sch.pat.tape.num to wk.sp;
  217.                     goto retry.tape.entry;
  218.                     fi;
  219.                 move #sch.pat.tape.num to wk.sp;
  220.                 move 0 to wk.count;
  221.                 fill tsearch.rec with ' ';
  222.                 fi;
  223.             od;
  224.         od;
  225. end;
  226. {---------------------------------------------------------------}
  227.