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 bigletter_: proc (inchar, writer); 12 13 /* BIGLETTER_ - Create "big letters" for printing. 14 Used by IO Daemon subroutine "head_sheet_" and routine "make_tape_labels", and others. 15 16 This routine can make two sizes of letters: 9x8 large letters, and 5x5 small ones. 17 The letters are printed according to a format matrix which shows where a mark should be made. 18 Each input letter is looked up in a "translation alphabet" -- if not found, the letter is skipped. 19 Only 132 characters will be put out on a line - this is 13 9x8 letters or 22 5x5 letters. 20 21 An entry point is provided for the user who insists on making his own alphabet and 22 format matrix, for the 8x9 case only. the $init entry sets this up, and the $var is used to write. 23 24 THVV */ 25 26 dcl inchar char (*); /* Input character string to be written. */ 27 28 dcl writer entry (ptr, fixed bin); /* Input user program to write one line. */ 29 30 dcl 1 letters (0:128) based (bigp) aligned, /* The matrix to be used. Subscript 0 is not used. */ 31 2 bits bit (item) aligned; /* 36 or 72 bit elements. */ 32 33 dcl 1 letter based (letp) aligned, /* A single letter in the array. */ 34 2 bitrow (high) bit (wide) unal; /* .. consists of a matrix of bits */ 35 36 dcl 1 letters9 (0: 128) based (bigp) aligned, /* Special for 9x8 */ 37 2 bits bit (72) aligned; 38 39 dcl 1 letter9 based (letp) aligned, 40 2 bitrow9 bit (72); 41 42 dcl 1 letters5 (0: 128) based (bigp) aligned, /* Special for 5x5 */ 43 2 bits bit (36) aligned; 44 45 dcl 1 letter5 based (letp) aligned, 46 2 bitrow5 bit (36); 47 48 dcl cx fixed bin (8) unal based (addr (c)); /* For convert char to number in fast case. */ 49 50 dcl i fixed bin, /* index in input string */ 51 ii fixed bin, /* horizontal index in output char */ 52 m fixed bin, /* Constant part of above */ 53 row fixed bin, /* vertical index in output */ 54 inch char (22), /* Copy of input. */ 55 incl fixed bin, /* Length of input. */ 56 x fixed bin, /* horizontal index in output buffer */ 57 k fixed bin, /* index of character in alphabet. */ 58 c char (1) aligned, /* temp for one char of inchar */ 59 big_letterp ptr int static init (null), /* pointer to user-supplied format matrix */ 60 alpha char (128) aligned, /* actual lookup alphabet used. */ 61 item fixed bin, /* width of element in "letters" -- 36 or 72 */ 62 high fixed bin, /* letter height */ 63 wide fixed bin, /* letter width */ 64 bigp ptr, /* pointer to actual alphabet format matrix */ 65 letp ptr; /* pointer to current letter format matrix */ 66 67 dcl alphabet char (128) aligned int static init (""); /* user-supplied lookup alphabet */ 68 dcl fill char (1) aligned int static init ("*"); /* user-supplied fill character */ 69 70 dcl (letseg_$letseg, letseg_$littles) fixed bin ext; /* System alphabet format matrices */ 71 72 dcl (null, length, substr, index) builtin; 73 74 dcl linebuf char (132) aligned; /* Output buffer for one line. */ 75 76 /* ===================================================== */ 77 78 regular: bigp = addr (letseg_$letseg); /* Regular 9 x 8 big letters, upper and lower case. */ 79 inch = inchar; /* Copy input for speed. */ 80 incl = length (inchar) + 1 - verify (reverse (inchar), " "); 81 m = 0; 82 do row = 1 to 9; /* Will put out nine lines. */ 83 linebuf = ""; /* Clean out line buffer. */ 84 x = 1; /* Reset to left margin. */ 85 86 do i = 1 to incl; /* Loop over the input string. */ 87 c = substr (inch, i, 1); /* Get one character. */ 88 if unspec (c) = "000001000"b then do; /* handle backpsace */ 89 if x > 10 then x = x - 10; /* .. overstriking will work */ 90 go to skip0; 91 end; 92 if x > 125 then go to skip0; /* write max of 132 */ 93 k = cx - 31; 94 if k <= 0 then go to skip0; 95 if k = 1 then do; /* Special-case blanks. */ 96 x = x +10; 97 go to skip0; 98 end; 99 100 if fill ^= " " then c = fill; /* Default makes all *'s - user can change. */ 101 letp = addr (letters9 (k)); /* Find format matrix for the "K"th letter */ 102 do ii = 1 to 8; /* Minor loop is over the letter width. */ 103 if substr (bitrow9, m+ii, 1) then 104 substr (linebuf, x, 1) = c; 105 x = x + 1; /* Go to next column */ 106 end; 107 x = x + 2; /* Make room between letters. */ 108 109 skip0: end; 110 111 call writer (addr (linebuf), 132); /* Give the line to the user procedure. */ 112 m = m + 8; /* Increment array index. */ 113 end; 114 return; /* Finished. */ 115 116 /* Entry point to make 5 x 5 characters. */ 117 118 five: entry (inchar, writer); 119 120 bigp = addr (letseg_$littles); /* Find 5x5 letters. */ 121 inch = inchar; /* Copy input for speed. */ 122 incl = length (inchar) + 1 - verify (reverse (inchar), " "); 123 m = 0; 124 do row = 1 to 5; /* Will put out five lines. */ 125 linebuf = ""; /* Clean out line buffer. */ 126 x = 1; /* Reset to left margin. */ 127 128 do i = 1 to incl; /* Loop over the input string. */ 129 c = substr (inch, i, 1); /* Get one character. */ 130 if unspec (c) = "000001000"b then do; /* handle backpsace */ 131 if x > 7 then x = x - 7; /* .. overstriking will work */ 132 go to skip1; 133 end; 134 if x > 128 then go to skip1; /* write max of 132 */ 135 k = cx - 31; 136 if k <= 0 then go to skip1; 137 if k = 1 then do; /* Special-case blanks. */ 138 x = x + 7; 139 go to skip1; 140 end; 141 142 if fill ^= " " then c = fill; /* Default makes all *'s - user can change. */ 143 letp = addr (letters5 (k)); /* Find format matrix for the "K"th letter */ 144 do ii = 1 to 5; /* Minor loop is over the letter width. */ 145 if substr (bitrow5, m+ii, 1) then 146 substr (linebuf, x, 1) = c; 147 x = x + 1; /* Go to next column */ 148 end; 149 x = x + 2; /* Make room between letters. */ 150 151 skip1: end; 152 153 call writer (addr (linebuf), 132); /* Give the line to the user procedure. */ 154 m = m + 5; /* Increment array index. */ 155 end; 156 return; /* Finished. */ 157 158 /* Entry to use user-specified alphabel for 9 x 8 characters */ 159 160 var: entry (inchar, writer); 161 162 if big_letterp = null then go to regular; /* If user never init'ed, use regular big letters */ 163 bigp = big_letterp; /* Retrieve saved matrix pointer */ 164 alpha = alphabet; /* .. and saved lookup alphabet */ 165 166 wide = 8; /* Set sizes */ 167 high = 9; /* ... */ 168 item = 72; /* ... */ 169 170 /* The main loop is on the height of the letters. */ 171 172 inch = inchar; /* Copy input for speed. */ 173 incl = length (inchar) + 1 - verify (reverse (inchar), " "); 174 do row = 1 to high; /* Will put out "high" lines. */ 175 linebuf = ""; /* Clean out line buffer. */ 176 x = 1; /* Reset to left margin. */ 177 178 do i = 1 to incl; /* Loop over the input string. */ 179 c = substr (inch, i, 1); /* Get one character. */ 180 if unspec (c) = "000001000"b then do; /* handle backpsace */ 181 if x > (wide+2) then x = x-wide-2; /* .. overstriking will work */ 182 go to skip; 183 end; 184 if x+wide > 133 then go to skip; /* write max of 132 */ 185 k = index (alpha, c); /* Look up input character in lookup alphabet */ 186 if k = 0 then go to skip; /* If not found, ignore character. */ 187 188 if fill ^= " " then c = fill; /* Default makes all *'s - user can change. */ 189 letp = addr (letters (k)); /* Find format matrix for the "K"th letter */ 190 do ii = 1 to wide; /* Minor loop is over the letter width. */ 191 if substr (bitrow (row), ii, 1) then 192 substr (linebuf, x, 1) = c; 193 x = x + 1; /* Go to next column */ 194 end; 195 x = x + 2; /* Make room between letters. */ 196 197 skip: end; 198 199 call writer (addr (linebuf), 132); /* Give the line to the user procedure. */ 200 201 end; 202 return; /* Finished. */ 203 204 /* --------------------------------------------- */ 205 206 init: entry (xp, a, f); /* Entry for the user who wants to play. */ 207 208 dcl xp ptr, (a, f) char (*); 209 210 fill = f; 211 alphabet = a; 212 big_letterp = xp; 213 214 return; 215 216 end bigletter_;