1 //                  Roff for Multics
 2 //
 3 //  Last modified on 05/30/74 at 18:45:47 by R F Mabee.
 4 //
 5 //  This file contains the routines needed to create the ".chars" file
 6 //  that contains lines unprintable with the device being used:
 7 //
 8 //        WrChInit            Initializes things-called from mr1.
 9 //        WrCh                Called from Write to process a character.
10 //        Wrline              Write a complete line.
11 //        Store               Store a character.
12 //  The first two are external, the others not.
13 
14 //  Copyright (c) 1974 by Massachusetts Institute of Technology and Honeywell Information Systems, Inc.
15 
16 //  General permission is granted to copy and use this program, but not to sell it, provided that the above
17 //  copyright statement is given.  Contact Information Processing Services, MIT, for further information.
18 //  Please contact R F Mabee at MIT for information on this program and versions for other machines.
19 
20 get "runoff_head"   //  Declarations for Mulrof.
21 
22 
23 global                        //  The following are used by all of these routines:
24 {         LineC     : 330     //  Line counter on page.
25           LineP     : 331     //  Character position on line.
26           FF        : 332     //  Unprintable character on line so far?
27           LPW       : 333     //  Last page number written on.
28           Buff      : 334     //  Buffer for the line.
29           Red       : 335     //  Was the last character stored red?
30 }
31 
32 let WrChInit () be            //  Initialize the static quantities
33 {         Buff := Newvec (Maxline)      //  Storage for the line
34           LPW := -1
35           LineC := 1
36           LineP := 0
37           FF := false
38           Red := false
39 
40           for i = 0 to 127 do CharsTable!i := '*s'
41           let T1 = table '[', ']', '{', '}', '~', '`'
42           and T2 = table '<', '>', '(', ')', 't', '*''
43           for i = 0 to 5 do CharsTable!(T1!i) := T2!i
44 }
45 and WrCh (c) be     // Write out character c.
46      $(   test CharsTable!c = '*s'
47           then $(   if Red do
48                          $(   Store ('*k')
49                               Red := false
50                          $)
51                     Store (c)
52                $)
53           or   $(   unless Red do
54                          $(   Store ('*d')
55                               Red := true
56                          $)
57                     Store (CharsTable!c)
58                     FF := true
59                $)
60           if c = '*n' do
61                $(   if FF do Wrline ()
62                     LineP, FF, Red := 0, false, false
63                $)
64      $)
65 and Wrline () be
66      $(   if Red do Store ('*k')
67           if LPW ne Np do               // First line printed on this page.
68                $(   WriteS (ChStream, "*n*n*nPage ")
69                     WriteN (ChStream, Np)
70                     WriteS (ChStream, "*n*n*n")
71                     LPW := Np
72                $)
73           if Nl < 10 do Writech (ChStream, '*s')
74           WriteN (ChStream, Nl)
75           Writech (ChStream, '*t')
76           for i = 1 to LineP do Writech (ChStream, Buff[i])
77      $)
78 and Store (c) be
79      $(   LineP := LineP + 1
80           Buff[LineP] := c
81      $)