1 /* ***********************************************************
 2    *                                                         *
 3    * Copyright, (C) Honeywell Information Systems Inc., 1982 *
 4    *                                                         *
 5    * Copyright (c) 1972 by Massachusetts Institute of        *
 6    * Technology and Honeywell Information Systems, Inc.      *
 7    *                                                         *
 8    *********************************************************** */
 9 
10 
11 labl1: proc;
12 
13 /* Write labels from "projfile" */
14 
15 dcl (hp, pp) ptr,                                           /* pointers */
16     (path, dn) char (168) aligned,                          /* file system names */
17      en char (32) aligned,                                  /* .. */
18      wkp ptr,                                               /* pointer to readin buffer (dn) */
19      nc fixed bin,                                          /* number of chars read in */
20     (i, np, ec) fixed;                                      /* counters */
21 
22 dcl  com_err_ entry options (variable),
23      expand_path_ entry (ptr, fixed bin, ptr, ptr, fixed bin),
24      hcs_$initiate entry (char (*) aligned, char (*) aligned, char (*) aligned,
25      fixed bin (1), fixed bin (2), ptr, fixed bin),
26      hcs_$terminate_noname entry (ptr, fixed bin),
27      ioa_ entry options (variable),
28      ios_$read_ptr entry (ptr, fixed bin, fixed bin);
29 
30 dcl (addr, null, substr) builtin;
31 
32 
33 dcl  x1 char (50) int static aligned init                   /* format statements */
34     ("     xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"),
35      x2 char (20) int static aligned init
36     ("     x   ^32ax");
37 
38 /* - - - - */
39 
40           wkp = addr (dn);                                  /* get ptr to buffer */
41           path = "projfile";                                /* Hunt up project file */
42           call expand_path_ (addr (path), 8, addr (dn), addr (en), ec);
43           if ec ^= 0 then do;
44 err:           call com_err_ (ec, "labl1", path);
45                return;
46           end;
47           call hcs_$initiate (dn, en, "", 0, 1, pp, ec);    /* Get project file. */
48           if pp = null then go to err;
49 
50 test:     call ioa_ (x1);                                   /* Write out test box. */
51           call ioa_ (x2, "");
52           call ioa_ (x2, "Multics billing labels.");
53           call ioa_ (x2, "");
54           call ioa_ (x2, "This box should be centered.");
55           call ioa_ (x2, "Type cr to go, x to repeat");
56           call ioa_ (x1);
57           call ioa_ ("");
58           call ios_$read_ptr (wkp, 12, nc);                 /* Read his answer. */
59           if nc > 1 then go to test;                        /* If he typed anything, repeat */
60 
61           np = pp -> projfile.nproj;                        /* Ready to go. */
62 
63           do i = 1 to np;                                   /* Loop for all projects */
64                call ioa_ ("");                              /* Drop down one line */
65                call ioa_ ("^-^a", projfile.projfiletab.sup (i)); /* Supervisor. */
66                call ioa_ ("");
67                call ioa_ ("^-^a", projfile.projfiletab.sup_addr (i));   /* Address. */
68                call ioa_ ("^/");
69                call ioa_ ("^-Supervisor, ^a", projfile.projfiletab.id (i));     /* Group. */
70                call ioa_ ("^/");
71           end;
72           call hcs_$terminate_noname (pp, ec);
73 %page;
74 %include projfile;
75 
76 
77      end;
78