1 /* ******************************************************
  2    *                                                    *
  3    *                                                    *
  4    * Copyright (c) 1972 by Massachusetts Institute of   *
  5    * Technology and Honeywell Information Systems, Inc. *
  6    *                                                    *
  7    *                                                    *
  8    ****************************************************** */
  9 
 10 /* REPEAT --- program to test console output functions.
 11 
 12    Usage: repeat_line # string
 13 
 14           # = number of repetitions (default is 10, or previous value in process)
 15           string = initial test string (default is QBF, or previous stored value)
 16 
 17    Coded by C Garman.
 18    Edited 15 Sept 1970 for different handling of @ in new TTY DIM
 19 
 20    */
 21 
 22 repeat_line: rpl: repeat: rpt: proc;
 23 
 24 dcl (savec char(300) aligned,
 25      (n init(0), nwrite init(10)) fixed bin(17)) static;
 26 
 27 dcl (pstr, pline) ptr,
 28     nstr fixed bin(17),
 29     ((str char(nstr), str1 char(1)) based(pstr)) unaligned,
 30     (i, saven, run init(0), cu_err) fixed bin(17),
 31     line char(300) aligned;
 32 
 33 dcl cu_$arg_ptr entry(fixed bin, ptr, fixed bin, fixed bin),
 34     (ios_$read_ptr, ios_$write_ptr) entry(ptr, fixed bin, fixed bin),
 35     cv_dec_check_ entry(char(*), fixed bin, fixed bin),
 36     (ioa_, ioa_$rs) entry options(variable);
 37 
 38 dcl (addr, char) builtin;
 39 
 40 /* ^L
 41    */
 42           if n = 0
 43           then call ioa_$rs(
 44      "The ^Rquick^B brown ^Rfox^B jumps ^Rover^B the ^Rlazy^B dog^R.^B^/^-^a^/^-^a^/^-^a", savec, n,
 45                     " !""#$%&'()*+,-./0123456789:;<=>?",
 46                     "@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_",
 47                     "`abcdefghijklmnopqrstuvwxyz{|}~");
 48 
 49           pline = addr(line);
 50 
 51           call cu_$arg_ptr(1, pstr, nstr, cu_err);
 52 
 53           if cu_err = 0
 54           then do;
 55 
 56                call cv_dec_check_(str, cu_err, i);
 57 
 58                if cu_err = 0
 59                then if i > 0
 60                     then nwrite = i;
 61 
 62                call cu_$arg_ptr(2, pstr, nstr, cu_err);
 63 
 64                if cu_err = 0
 65                then do;
 66 
 67                     if nstr = 1
 68                     then if str1 = "*"
 69                          then go to copy_saved_line;
 70 
 71                     call ioa_$rs("^a", savec, n, str);
 72 
 73                     go to copy_saved_line;
 74 
 75                     end;
 76 
 77                end;
 78 
 79           do while (run = 0);
 80 
 81           call ioa_("Type line (or _^Hq or <NL>):");
 82 
 83           saven = n;                              /* Save # of chars in saved buffer */
 84           call ios_$read_ptr(pline, 300, n);
 85 
 86           if n > 2
 87           then do;
 88 
 89 save_line:     savec = line;
 90 
 91 print_it:      saven = n;                         /* May be redundant, but who cares */
 92 
 93                do i = 1 to nwrite;
 94 
 95                call ios_$write_ptr(pline, 0, saven);
 96 
 97                end;
 98 
 99                end;
100 
101           else if n = 1
102                then do;
103 
104                     n = saven;                              /* Restore char count */
105 
106 copy_saved_line:
107                     line = savec;
108                     go to print_it;
109 
110                     end;
111 
112                else if char(line, 1) ^= "q"
113                     then go to save_line;
114                     else run = run + 1;
115 
116           end;
117 
118 /* If we got a "q", restore count */
119 
120           n = saven;
121 
122 end repeat_line;