DECsystem-20 SIMULA %4A(310) 1-FEB-1981 14:50 PAGE 1 DSK:ADRES.SIM 20-FEB-1977 19:00 1 OPTIONS(/l); COMMENT address file handling and printing program; 2 COMMENT written by Jacob Palme, FOA 1, 104 50 Stockholm 80, SWEDEN; 3 COMMENT Version 0A, December 20, 1975; B1 4 BEGIN 5 EXTERNAL TEXT PROCEDURE scanto, from, conc2, front; 6 EXTERNAL INTEGER PROCEDURE search, trmop; 7 EXTERNAL BOOLEAN PROCEDURE frontcompare, puttext, dotypeout; 8 EXTERNAL REF (outfile) PROCEDURE findoutfile; 9 EXTERNAL CHARACTER PROCEDURE findtrigger; 10 EXTERNAL INTEGER PROCEDURE scanint; 11 EXTERNAL LONG REAL PROCEDURE scanreal; 12 EXTERNAL REF (infile) PROCEDURE findinfile; 13 EXTERNAL TEXT PROCEDURE conc,upcase,frontstrip,rest, 14 checkextension; 15 EXTERNAL PROCEDURE split; 16 EXTERNAL CLASS safmin; 17 EXTERNAL BOOLEAN PROCEDURE sqhelp; 18 EXTERNAL CLASS decom; 19 EXTERNAL CLASS select; 20 INTEGER i, max_number_of_lines, lastline, lastlinep1, 21 line_number, sortlength, page_step; 22 INTEGER count_of_input, count_of_output, count_of_error; 23 INTEGER count_of_rejected; 24 INTEGER labels_per_width, left_margin, label_width, label_spacing; 25 INTEGER line1_length, line2_length, line_dimension, in_dimension; 26 BOOLEAN end_of_file, usetabs, select_output, line1_output, 27 label_output, list_output, file_output, presort_output, asort_output; 28 BOOLEAN caseshift; 29 TEXT infilename, outfilename, blanktext, command; 30 TEXT motoron, motoroff, removetabs, settab; 31 TEXT mainline; 32 CHARACTER altmode, formfeed, tab; 33 REF (infile) infileref; REF (outfile) outfileref; DECsystem-20 SIMULA %4A(310) 1-FEB-1981 14:50 PAGE 2 DSK:ADRES.SIM 20-FEB-1977 19:00 34 35 36 select CLASS label_select; B2 37 BEGIN 38 REF (operator) line1_condition, line2_condition; E2 39 END; 40 line_dimension:= 40; 41 outtext("[ADRES is here]"); outimage; 42 outtext("[For HELP type ? followed by one word" 43 " with the subject you want help on]"); outimage; B3 44 decom(14) BEGIN 45 margin:= 0; 46 INSPECT NEW label_select DO B4 47 BEGIN 48 TEXT line1_selector, line2_selector; 49 REF (label_data) first_label, last_label; DECsystem-20 SIMULA %4A(310) 1-FEB-1981 14:50 PAGE 3 DSK:ADRES.SIM 20-FEB-1977 19:00 50 51 PROCEDURE set_dependent_parameters; B5 52 BEGIN 53 count_of_rejected:= count_of_error:= 54 count_of_input:= count_of_output:= 0; 55 end_of_file:= FALSE; 56 IF asort_output OR presort_output OR file_output THEN B6 57 BEGIN 58 labels_per_width:= 1; usetabs:= FALSE; 59 label_width:= line2_length; 60 max_number_of_lines:= line_dimension-2; E6 61 END; 62 lastline:= max_number_of_lines+1; 63 lastlinep1:= lastline+1; 64 in_dimension:= line_dimension - 1 - line2_length//label_width; 65 sysout.image:- blanks(line1_length); 66 IF list_output THEN B7 67 BEGIN page_step:= max_number_of_lines+1; 68 page_step:= 60//page_step-1; 69 page_step:= page_step*labels_per_width; E7 70 END; 71 linecopy_buffer:- blanks( 72 IF select_output THEN 73 (IF line2_condition == NONE THEN 74 (IF caseshift THEN line1_length ELSE 0) 75 ELSE line2_length*10) 76 ELSE 0); 77 IF line1_output THEN B8 78 BEGIN 79 IF line1_length > line2_length THEN line2_length:= line1_length 80 ELSE line1_length:= line2_length; E8 81 END; 82 IF sysout == outfileref AND usetabs THEN B9 83 BEGIN 84 if trmop(8R2005,sysout,1) = 0 then !IF TTY NO TAB; B10 85 begin ! then .SET TTY TAB; 86 outtext("TTY TAB has been set by the ADRES program."); 87 outimage; E10 88 END; E9 89 END; 90 IF usetabs THEN B11 91 BEGIN 92 outtext("Make sure that your terminal really can handle" 93 " tabs in the same way as"); outimage; 94 outtext("GNT, Terminet and similar terminals. If not," 95 " use the /NOTABS switch"); outimage; 96 outtext("to the input for the ADRES program."); 97 outimage; E11 98 end; E5 99 END; DECsystem-20 SIMULA %4A(310) 1-FEB-1981 14:50 PAGE 4 DSK:ADRES.SIM 20-FEB-1977 19:00 100 101 102 PROCEDURE outline(t); NAME t; TEXT t; B12 103 BEGIN 104 sysout.image:= t; outimage; E12 105 END; DECsystem-20 SIMULA %4A(310) 1-FEB-1981 14:50 PAGE 5 DSK:ADRES.SIM 20-FEB-1977 19:00 106 107 BOOLEAN PROCEDURE adres_help(selector); 108 VALUE selector; TEXT selector; B13 109 BEGIN 110 IF selector == NOTEXT AND sysin.image =/= NOTEXT THEN B14 111 BEGIN 112 command:- sysin.image.strip; 113 command.setpos(1); IF command.getchar = '?' THEN 114 selector:- command.sub(2,command.length-1); E14 115 END; 116 sqhelp("ADRES",selector,19,72); E13 117 END; DECsystem-20 SIMULA %4A(310) 1-FEB-1981 14:50 PAGE 6 DSK:ADRES.SIM 20-FEB-1977 19:00 118 119 PROCEDURE interpret_integer_switches; B15 120 BEGIN 121 intswitch("LINES","5",max_number_of_lines, 122 max_number_of_lines > 0 AND max_number_of_lines < 11, 123 "Must be between 0 and 11",adres_help(" /LINES")); 124 intswitch("LABELS","3",labels_per_width, 125 labels_per_width >= 1,"Must be >= 1",adres_help(" /LINES")); 126 intswitch("LEFT","0",left_margin, 127 left_margin >= 0 AND left_margin < 114, 128 "Must be between 0 and 114", 129 adres_help(" /LABELS")); 130 intswitch("WIDTH","36",label_width, 131 label_width > 5 AND 132 label_width < (132-left_margin)//labels_per_width, 133 "Too large or < 6",adres_help(" /WIDTH")); 134 IF boolswitch("SINGLE",TRUE,NOTEXT,adres_help(" /SINGLE")) THEN B16 135 BEGIN 136 labels_per_width:= 1; left_margin:= 1; 137 label_width:= 48; E16 138 END; 139 intswitch("TAB","41",label_spacing, 140 labels_per_width <= 1 OR 141 (label_spacing < (132-left_margin)//labels_per_width AND 142 label_spacing > label_width), 143 "Too large or less than /WIDTH",adres_help(" /TAB")); 144 intswitch("LINE1","300",line1_length, 145 line1_length > 0,"Must be positive",adres_help(" /LINE1")); 146 intswitch("LINE2","80",line2_length, 147 line2_length > 0 AND line2_length >= label_width, 148 "Must be positive and larger than /WIDTH", 149 adres_help(" /LINE2")); E15 150 END of interpret_integer_switches; DECsystem-20 SIMULA %4A(310) 1-FEB-1981 14:50 PAGE 7 DSK:ADRES.SIM 20-FEB-1977 19:00 151 152 153 PROCEDURE interpret_boolean_switches; B17 154 BEGIN 155 usetabs:= NOT boolswitch("NOTABS",TRUE,NOTEXT, 156 adres_help(" /NO")); 157 list_output:= boolswitch("LIST",TRUE,NOTEXT, 158 adres_help(" /LIST")); 159 file_output:= boolswitch("FILE",NOT list_output, 160 "Only one kind of output",adres_help(" /FILE")); 161 presort_output:= boolswitch("PRESORT", 162 NOT list_output AND NOT file_output, 163 "Only one kind of output",adres_help(" /PRESORT")); 164 asort_output:= boolswitch("ASORT", 165 NOT list_output AND NOT file_output 166 AND NOT presort_output, "Only one kind of output", 167 adres_help(" /ASORT")); 168 select_output:= boolswitch("SELECT",NOT asort_output, 169 "/SELECT will not work combined with /ASORT", 170 adres_help(" /SELECT")); 171 caseshift:= NOT boolswitch("NOCASESHIFT",select_output, 172 "/NOCASESHIFT only meaningful combined with /SELECT", 173 adres_help(" /NOCASESHIFT")); 174 label_output:= NOT (list_output OR 175 file_output OR presort_output OR asort_output 176 OR boolswitch("NOLABEL",list_output OR 177 file_output OR presort_output OR asort_output, 178 "No kind of output", 179 adres_help(" /NOLABEL"))); 180 line1_output:= boolswitch("OUT1", 181 label_output OR list_output, 182 "/OUT1 only meaningful with /LIST or /LABEL", 183 adres_help(" /OUT1")); E17 184 END of interpret_boolean_switches; DECsystem-20 SIMULA %4A(310) 1-FEB-1981 14:50 PAGE 8 DSK:ADRES.SIM 20-FEB-1977 19:00 185 186 187 PROCEDURE request_selectors; B18 188 BEGIN 189 displaydefault:= FALSE; 190 outtext("Give Boolean condition on line 1"); 191 outimage; request(":", 192 NOTEXT,textinput(line1_selector, 193 build_condition(line1_condition,line1_selector,caseshift)), 194 select_errmess,adres_help(" /SELECT")); 195 outchar('('); tree_print(line1_condition); 196 outchar(')'); outimage; 197 outtext("Give Boolean condition on lines after line 1"); 198 outimage; request(":", 199 NOTEXT,textinput(line2_selector, 200 build_condition(line2_condition,line2_selector,caseshift)), 201 select_errmess,adres_help(" /SELECT")); 202 outchar('('); tree_print(line2_condition); 203 outchar(')'); outimage; 204 displaydefault:= TRUE; E18 205 END; DECsystem-20 SIMULA %4A(310) 1-FEB-1981 14:50 PAGE 9 DSK:ADRES.SIM 20-FEB-1977 19:00 206 207 BOOLEAN PROCEDURE files_can_be_created; B19 208 BEGIN TEXT oldextension, newextension; 209 IF outfilename = NOTEXT THEN outfilename:-copy("TTY:"); 210 IF infilename = NOTEXT THEN B20 211 BEGIN 212 IF (label_output OR list_output OR presort_output) THEN B21 213 BEGIN 214 infilename:- copy(outfilename); 215 IF findtrigger(infilename,dottext) = '.' THEN 216 infilename:- infilename.sub(1,infilename.pos-2); E21 217 END ELSE B22 218 BEGIN 219 outtext("?ADRES - Both infile and outfile name must"); 220 outimage; 221 outtext("be given when creating .ADR files"); 222 outimage; GOTO out; E22 223 END; E20 224 END; 225 newextension:- copy( 226 IF label_output THEN ".LAB" ELSE IF list_output THEN ".LST" 227 ELSE IF presort_output THEN ".USR" ELSE ".ADR"); 228 oldextension:- copy( 229 IF asort_output THEN ".SRT" ELSE ".ADR"); 230 createfiles(outfilename,infilename, 231 newextension, oldextension, 232 outfileref,infileref,adres_help("file")); 233 files_can_be_created:= TRUE; 234 out: E19 235 END; DECsystem-20 SIMULA %4A(310) 1-FEB-1981 14:50 PAGE 10 DSK:ADRES.SIM 20-FEB-1977 19:00 236 237 BOOLEAN PROCEDURE interpret_legal_command; B23 238 BEGIN 239 IF NOT deccom(upcase(command),outfilename,infilename) 240 THEN GOTO out; 241 displaydefault:= TRUE; 242 interpret_integer_switches; 243 interpret_boolean_switches; 244 IF select_output THEN request_selectors ELSE 245 line1_condition:- line2_condition:- NONE; 246 IF NOT illegalswitch( 247 "Uninterpretable or duplicate switch: /",adres_help("")) 248 THEN interpret_legal_command:= files_can_be_created; 249 out: E23 250 END; DECsystem-20 SIMULA %4A(310) 1-FEB-1981 14:50 PAGE 11 DSK:ADRES.SIM 20-FEB-1977 19:00 251 PROCEDURE adjust_label_form; B24 252 BEGIN 253 BOOLEAN positioned; 254 WHILE NOT positioned DO B25 255 BEGIN 256 request("Is this first line on a label?","NO",boolinput(positioned), 257 NOTEXT,adres_help("inserting label forms")); E25 258 END; E24 259 END; DECsystem-20 SIMULA %4A(310) 1-FEB-1981 14:50 PAGE 12 DSK:ADRES.SIM 20-FEB-1977 19:00 260 261 PROCEDURE read_input_command; B26 262 BEGIN CHARACTER c; 263 prompt: 264 displaydefault:= FALSE; 265 request("*",nodefault,textinput(command, 266 interpret_legal_command), 267 NOTEXT,adres_help("")); 268 set_dependent_parameters; 269 IF label_output AND outfileref == sysout THEN 270 adjust_label_form; E26 271 END of read_input_command; DECsystem-20 SIMULA %4A(310) 1-FEB-1981 14:50 PAGE 13 DSK:ADRES.SIM 20-FEB-1977 19:00 272 273 274 CLASS label_data; B27 275 BEGIN 276 REF (label_data) next; 277 TEXT line_buffer, sort_buffer; 278 TEXT ARRAY line(1:line_dimension), stripline(1:line_dimension); 279 TEXT second_alg_buffer; 280 INTEGER number_of_lines, line_number; 281 BOOLEAN faulty_address, erased_address; 282 IF first_label == NONE THEN first_label:- THIS label_data 283 ELSE last_label.next:- THIS label_data; 284 next:- first_label; 285 last_label:- THIS label_data; 286 line_buffer:- 287 blanks(5+line1_length+(line_dimension-1)*line2_length); 288 sort_buffer:- line_buffer.sub(6,line_buffer.length-5); 289 line(1):- line_buffer.sub(6,line1_length); 290 FOR i:= 2 STEP 1 UNTIL line_dimension DO 291 line(i):- line_buffer.sub 292 (6+line1_length+(i-2)*line2_length,line2_length); 293 second_alg_buffer:- blanks(label_width*max_number_of_lines); E27 294 END of label_data; DECsystem-20 SIMULA %4A(310) 1-FEB-1981 14:50 PAGE 14 DSK:ADRES.SIM 20-FEB-1977 19:00 295 296 297 label_data CLASS label_operations; B28 298 BEGIN DECsystem-20 SIMULA %4A(310) 1-FEB-1981 14:50 PAGE 15 DSK:ADRES.SIM 20-FEB-1977 19:00 299 300 301 PROCEDURE erase_address; B29 302 BEGIN 303 erased_address:= TRUE; 304 line[1]:= stripline[1]:= NOTEXT; 305 FOR number_of_lines:= 2 STEP 1 UNTIL lastline DO B30 306 BEGIN 307 line[number_of_lines]:= 308 IF presort_output THEN NOTEXT ELSE "*****"; 309 stripline[number_of_lines]:- line[number_of_lines].strip; E30 310 END; 311 number_of_lines:= lastline; E29 312 END; DECsystem-20 SIMULA %4A(310) 1-FEB-1981 14:50 PAGE 16 DSK:ADRES.SIM 20-FEB-1977 19:00 313 314 315 PROCEDURE error(errmess); NAME errmess; TEXT errmess; B31 316 BEGIN INTEGER i, addcount; 317 faulty_address:= TRUE; 318 outtext("?ADRES - "); outtext(errmess); 319 outimage; 320 i:= number_of_lines; IF i > 4 THEN i:= 4; 321 FOR line_number:= 1 STEP 1 UNTIL i DO B32 322 BEGIN 323 image:= stripline(line_number); outimage; E32 324 END; 325 outimage; 326 addcount:= 2+i; addcount:= lastline-mod(addcount,lastline); 327 If addcount = lastline then addcount:= 0; 328 for i:= 1 step 1 until addcount do outimage; 329 erase_address; E31 330 END; DECsystem-20 SIMULA %4A(310) 1-FEB-1981 14:50 PAGE 17 DSK:ADRES.SIM 20-FEB-1977 19:00 331 332 333 PROCEDURE divide_line; B33 334 BEGIN 335 line[number_of_lines+1]:= line[number_of_lines]. 336 sub(label_width+1,line2_length-label_width); 337 line[number_of_lines].sub(label_width+1, 338 line2_length-label_width) 339 := NOTEXT; 340 stripline[number_of_lines]:- line[number_of_lines].sub(1, 341 label_width); 342 number_of_lines:= number_of_lines+1; 343 stripline[number_of_lines]:- line[number_of_lines].strip; E33 344 END; DECsystem-20 SIMULA %4A(310) 1-FEB-1981 14:50 PAGE 18 DSK:ADRES.SIM 20-FEB-1977 19:00 345 346 347 PROCEDURE too_many_lines; 348 INSPECT infileref DO B34 349 BEGIN 350 error("Too many lines in input address."); 351 WHILE TRUE DO B35 352 BEGIN 353 inimage; image.setpos(image.strip.length); 354 IF (IF image.more THEN image.getchar ELSE ' ') 355 = formfeed THEN GOTO out; E35 356 END; 357 out: image:= NOTEXT; E34 358 END; DECsystem-20 SIMULA %4A(310) 1-FEB-1981 14:50 PAGE 19 DSK:ADRES.SIM 20-FEB-1977 19:00 359 360 361 BOOLEAN PROCEDURE select_this_address; B36 362 BEGIN 363 BOOLEAN select; 364 IF line_scan(line1_condition,stripline(1)) THEN B37 365 BEGIN 366 IF array_scan(line2_condition, 367 stripline,2,number_of_lines) 368 THEN 369 select:= TRUE; E37 370 END; 371 IF NOT select THEN count_of_rejected:= count_of_rejected+1; 372 select_this_address:= select; E36 373 END; DECsystem-20 SIMULA %4A(310) 1-FEB-1981 14:50 PAGE 20 DSK:ADRES.SIM 20-FEB-1977 19:00 374 375 376 PROCEDURE read_an_address; 377 INSPECT infileref DO B38 378 BEGIN 379 top: number_of_lines:= IF line1_output THEN 2 ELSE 1; 380 IF faulty_address THEN count_of_error:= count_of_error+1; 381 erased_address:= faulty_address:= FALSE; 382 IF endfile THEN B39 383 BEGIN 384 end_of_file:= TRUE; erase_address; E39 385 END ELSE DECsystem-20 SIMULA %4A(310) 1-FEB-1981 14:50 PAGE 21 DSK:ADRES.SIM 20-FEB-1977 19:00 386 387 B40 388 BEGIN 389 count_input; 390 again: 391 WHILE NOT endfile AND number_of_lines <= in_dimension DO B41 392 BEGIN 393 image:- line[number_of_lines]; 394 inimage; IF endfile THEN image:= NOTEXT; 395 stripline[number_of_lines]:- line[number_of_lines].strip; 396 IF stripline[number_of_lines] == NOTEXT AND 397 number_of_lines 398 > 1 THEN GOTO again; 399 stripline[number_of_lines].setpos(stripline[ 400 number_of_lines 401 ].length); 402 IF number_of_lines > 1 THEN 403 WHILE stripline[number_of_lines].length > 404 label_width DO divide_line; 405 IF (IF stripline[number_of_lines] = NOTEXT THEN ' ' ELSE 406 stripline[number_of_lines].getchar) = formfeed THEN B42 407 BEGIN COMMENT end of address; 408 stripline[number_of_lines]:- 409 stripline[number_of_lines].sub(1, 410 stripline[number_of_lines].length-1); 411 IF stripline[number_of_lines] = NOTEXT THEN 412 number_of_lines:= number_of_lines-1; 413 GOTO out; E42 414 END; 415 number_of_lines:= number_of_lines+1; E41 416 END; DECsystem-20 SIMULA %4A(310) 1-FEB-1981 14:50 PAGE 22 DSK:ADRES.SIM 20-FEB-1977 19:00 417 418 419 IF endfile THEN number_of_lines:= number_of_lines-1; 420 IF number_of_lines > in_dimension THEN B43 421 BEGIN 422 too_many_lines; GOTO top; E43 423 END; 424 out: IF number_of_lines <= 1 THEN B44 425 BEGIN IF endfile or count_of_input = 1 THEN 426 count_of_input:= count_of_input-1 ELSE B45 427 BEGIN 428 number_of_lines:= 10; 429 error("No text in address after or at:"); E45 430 END; 431 GOTO top; E44 432 END; 433 IF select_output THEN B46 434 BEGIN IF NOT select_this_address THEN GOTO top; E46 435 END; E40 436 END; E38 437 END of read_an_address; DECsystem-20 SIMULA %4A(310) 1-FEB-1981 14:50 PAGE 23 DSK:ADRES.SIM 20-FEB-1977 19:00 438 439 440 PROCEDURE count_input; B47 441 BEGIN 442 count_of_input:= count_of_input+1; 443 IF mod(count_of_input,10) = 0 AND sysout =/= outfileref THEN B48 444 BEGIN sysout.outchar('.'); sysout.breakoutimage; E48 445 END; E47 446 END; DECsystem-20 SIMULA %4A(310) 1-FEB-1981 14:50 PAGE 24 DSK:ADRES.SIM 20-FEB-1977 19:00 447 448 449 BOOLEAN PROCEDURE reformat_first_algorithm; B49 450 BEGIN 451 INTEGER firstno, secondno; 452 reformat_first_algorithm:= TRUE; 453 WHILE number_of_lines > lastline DO B50 454 BEGIN 455 firstno:= 2; secondno:= 3; 456 FOR line_number:= 3 STEP 1 UNTIL number_of_lines DO B51 457 BEGIN 458 while stripline[secondno] == NOTEXT DO 459 secondno:= secondno+1; 460 IF stripline[firstno].length + 461 stripline[secondno].length + 2 < label_width THEN B52 462 BEGIN 463 mainline:- line[firstno]; 464 mainline.setpos(stripline[firstno].length+1); 465 puttext(mainline,", "); 466 puttext(mainline,stripline[secondno]); 467 stripline[firstno]:- mainline.strip; 468 stripline[secondno]:- NOTEXT; 469 number_of_lines:= number_of_lines-1; 470 GOTO compressmore; E52 471 END; 472 firstno:= secondno; secondno:= firstno+1; E51 473 END; 474 reformat_first_algorithm:= FALSE; GOTO out; 475 compressmore: E50 476 END; 477 out: secondno:= 3; 478 FOR line_number:= 3 STEP 1 UNTIL number_of_lines DO B53 479 BEGIN 480 WHILE stripline[secondno] == NOTEXT 481 DO secondno:= secondno+1; 482 stripline[line_number]:- stripline[secondno]; 483 secondno:= secondno+1; E53 484 END; E49 485 END; DECsystem-20 SIMULA %4A(310) 1-FEB-1981 14:50 PAGE 25 DSK:ADRES.SIM 20-FEB-1977 19:00 486 487 488 BOOLEAN PROCEDURE reformat_second_algorithm; B54 489 BEGIN 490 TEXT rest_of_buffer; 491 rest_of_buffer:- second_alg_buffer; 492 FOR line_number:= 2 STEP 1 UNTIL number_of_lines DO B55 493 BEGIN 494 i:= stripline[line_number].length; 495 IF rest_of_buffer.length <= i THEN GOTO bad; 496 rest_of_buffer:= stripline[line_number]; 497 rest_of_buffer:- rest_of_buffer.sub(i+1, 498 rest_of_buffer.length-i); 499 IF rest_of_buffer.length >= 2 AND i < label_width AND 500 line_number < number_of_lines THEN B56 501 BEGIN 502 rest_of_buffer.sub(1,2):= ", "; 503 rest_of_buffer:- rest_of_buffer.sub(3, 504 rest_of_buffer.length-2); E56 505 END; 506 IF line_number <= max_number_of_lines+1 THEN 507 stripline[line_number]:- second_alg_buffer. 508 sub(1+(line_number-2)*label_width,label_width); E55 509 END; 510 number_of_lines:= max_number_of_lines+1; 511 reformat_second_algorithm:= TRUE; 512 bad: E54 513 END; DECsystem-20 SIMULA %4A(310) 1-FEB-1981 14:50 PAGE 26 DSK:ADRES.SIM 20-FEB-1977 19:00 514 515 516 BOOLEAN PROCEDURE can_be_reformatted; B57 517 BEGIN 518 IF reformat_first_algorithm THEN can_be_reformatted:= TRUE ELSE 519 IF reformat_second_algorithm THEN can_be_reformatted:= TRUE ELSE 520 error("Too much text in this address"); E57 521 END of can_be_reformatted; DECsystem-20 SIMULA %4A(310) 1-FEB-1981 14:50 PAGE 27 DSK:ADRES.SIM 20-FEB-1977 19:00 522 523 524 PROCEDURE write_line(this_line); 525 TEXT this_line; 526 INSPECT outfileref DO B58 527 BEGIN 528 outtext(this_line); 529 IF next == first_label THEN B59 530 BEGIN outimage; IF NOT usetabs THEN setpos(left_margin+1); E59 531 END ELSE IF usetabs THEN outchar(tab) 532 ELSE setpos(pos+label_spacing-this_line.length); E58 533 END of write_line; DECsystem-20 SIMULA %4A(310) 1-FEB-1981 14:50 PAGE 28 DSK:ADRES.SIM 20-FEB-1977 19:00 534 535 536 PROCEDURE output_count; B60 537 BEGIN 538 count_of_output:= count_of_output+1; 539 IF list_output THEN B61 540 BEGIN 541 IF mod(count_of_output,page_step) = 1 542 THEN outfileref.outchar(formfeed); E61 543 END; E60 544 END of output_count; DECsystem-20 SIMULA %4A(310) 1-FEB-1981 14:50 PAGE 29 DSK:ADRES.SIM 20-FEB-1977 19:00 545 546 E28 547 END of label_operations; DECsystem-20 SIMULA %4A(310) 1-FEB-1981 14:50 PAGE 30 DSK:ADRES.SIM 20-FEB-1977 19:00 548 549 550 label_operations CLASS label_address; B62 551 BEGIN 552 detach; WHILE TRUE DO B63 553 BEGIN 554 nextin: read_an_address; 555 IF NOT can_be_reformatted AND NOT end_of_file THEN GOTO nextin; 556 IF THIS label_address == first_label AND end_of_file THEN detach 557 ELSE IF labels_per_width > 1 THEN resume(next); 558 IF NOT erased_address THEN output_count; 559 FOR line_number:= 2 STEP 1 UNTIL lastlinep1 DO B64 560 BEGIN 561 write_line(IF line_number <= number_of_lines THEN 562 stripline[line_number] ELSE NOTEXT); 563 IF labels_per_width > 1 THEN resume(next); E64 564 END of for loop; E63 565 END of while loop; E62 566 END of label_address; DECsystem-20 SIMULA %4A(310) 1-FEB-1981 14:50 PAGE 31 DSK:ADRES.SIM 20-FEB-1977 19:00 567 568 569 label_operations CLASS file_address; B65 570 BEGIN 571 TEXT line1m1; 572 line1m1:- line[1].main.sub(5,line1_length+1); 573 detach; WHILE TRUE DO B66 574 BEGIN 575 nextin: read_an_address; 576 IF end_of_file THEN detach; 577 IF NOT erased_address THEN INSPECT outfileref DO B67 578 BEGIN 579 count_of_output:= count_of_output+1; 580 IF count_of_output = 1 THEN image:- line[1] ELSE B68 581 BEGIN image:- line1m1; image.putchar(formfeed); E68 582 END; 583 outimage; 584 FOR line_number:= 2 STEP 1 UNTIL number_of_lines DO B69 585 BEGIN 586 image:- stripline[line_number]; outimage; E69 587 END of for loop; E67 588 END of inspect; E66 589 END of while loop; E65 590 END of label_address; DECsystem-20 SIMULA %4A(310) 1-FEB-1981 14:50 PAGE 32 DSK:ADRES.SIM 20-FEB-1977 19:00 591 592 593 label_operations CLASS asort_address; B70 594 BEGIN 595 TEXT line1m1; 596 line1m1:- line[1].main.sub(5,line1_length+1); 597 infileref.image:- sort_buffer; 598 detach; WHILE TRUE DO B71 599 BEGIN 600 nextin: infileref.inimage; 601 IF infileref.endfile THEN detach; 602 count_input; 603 IF NOT erased_address THEN INSPECT outfileref DO B72 604 BEGIN 605 count_of_output:= count_of_output+1; 606 IF count_of_output = 1 THEN image:- line[1] ELSE B73 607 BEGIN image:- line1m1; image.putchar(formfeed); E73 608 END; 609 outimage; 610 FOR line_number:= 2 STEP 1 UNTIL line_dimension DO B74 611 BEGIN 612 image:- line[line_number].strip; 613 IF image = NOTEXT THEN GOTO out; 614 outimage; E74 615 END of for loop; 616 out: E72 617 END of inspect; E71 618 END of while loop; E70 619 END of asort_address; DECsystem-20 SIMULA %4A(310) 1-FEB-1981 14:50 PAGE 33 DSK:ADRES.SIM 20-FEB-1977 19:00 620 621 622 label_operations CLASS presort_address; B75 623 BEGIN 624 detach; WHILE TRUE DO B76 625 BEGIN 626 nextin: read_an_address; 627 IF end_of_file THEN detach; 628 IF NOT erased_address THEN INSPECT outfileref DO B77 629 BEGIN 630 count_of_output:= count_of_output+1; 631 image:- sort_buffer.strip; 632 IF image.sub(image.length,1).getchar=formfeed THEN B78 633 BEGIN image.sub(image.length,1).putchar(' '); 634 image:- image.sub(1,image.length-1); E78 635 END; 636 IF sortlength < image.length THEN sortlength:= image.length; 637 outimage; E77 638 END of inspect; E76 639 END of while loop; E75 640 END of label_address; DECsystem-20 SIMULA %4A(310) 1-FEB-1981 14:50 PAGE 34 DSK:ADRES.SIM 20-FEB-1977 19:00 641 642 643 PROCEDURE create_labels; B79 644 BEGIN 645 INTEGER label_no; 646 first_label:- NONE; 647 FOR label_no:= 1 STEP 1 UNTIL labels_per_width DO 648 IF file_output THEN NEW file_address ELSE 649 IF presort_output THEN NEW presort_address ELSE 650 IF asort_output THEN NEW asort_address ELSE 651 NEW label_address; E79 652 END of create_labels; DECsystem-20 SIMULA %4A(310) 1-FEB-1981 14:50 PAGE 35 DSK:ADRES.SIM 20-FEB-1977 19:00 653 654 655 PROCEDURE set_tab_settings_on_the_terminal; 656 INSPECT outfileref DO B80 657 BEGIN 658 outtext(motoron); outtext(removetabs); outimage; 659 setpos(pos+left_margin); outtext(settab); 660 FOR i:= 2 STEP 1 UNTIL labels_per_width DO B81 661 BEGIN 662 setpos(pos+label_spacing); outtext(settab); E81 663 END; E80 664 END; DECsystem-20 SIMULA %4A(310) 1-FEB-1981 14:50 PAGE 36 DSK:ADRES.SIM 20-FEB-1977 19:00 665 666 667 PROCEDURE open_files; B82 668 BEGIN 669 infileref.open(blanks(80)); 670 IF outfileref =/= sysout and label_output then B83 671 BEGIN 672 outtext("You must do .TTY NO CRLF"); 673 if usetabs then 674 outtext(" and perhaps .TTY TABS"); 675 outimage; 676 outtext("on the output terminal"); outimage; 677 outtext("if different from this terminal"); outimage; E83 678 END; 679 IF outfileref =/= sysout THEN outfileref.open(blanks(132)); 680 IF file_output THEN B84 681 BEGIN outfileref.outchar(formfeed); 682 outfileref.breakoutimage; E84 683 END ELSE 684 IF label_output OR list_output THEN B85 685 BEGIN 686 IF usetabs THEN set_tab_settings_on_the_terminal 687 ELSE outfileref.outimage; 688 FOR i:= 2 STEP 1 UNTIL max_number_of_lines DO 689 outfileref.outimage; 690 IF NOT usetabs THEN outfileref.setpos(left_margin+1); E85 691 END; E82 692 END; DECsystem-20 SIMULA %4A(310) 1-FEB-1981 14:50 PAGE 37 DSK:ADRES.SIM 20-FEB-1977 19:00 693 694 695 PROCEDURE close_files; 696 INSPECT outfileref DO B86 697 BEGIN 698 infileref.close; 699 IF label_output THEN B87 700 BEGIN 701 outfileref.outimage; E87 702 END; 703 IF usetabs THEN B88 704 BEGIN outtext(motoroff); outimage; E88 705 END; 706 IF outfileref =/= sysout THEN close; E86 707 END; DECsystem-20 SIMULA %4A(310) 1-FEB-1981 14:50 PAGE 38 DSK:ADRES.SIM 20-FEB-1977 19:00 708 709 710 PROCEDURE initialize_constants; B89 711 BEGIN 712 trmop(8r2010,sysout,1); ! .TTY NO CRLF; 713 blanktext:- blanks(132); 714 altmode:= char(27); formfeed:= char(12); tab:= char(9); 715 motoron:- copy(" h"); motoroff:- copy(" j"); 716 removetabs:- copy(" 2"); settab:- copy(" 1"); 717 motoron.putchar(altmode); motoroff.putchar(altmode); 718 removetabs.putchar(altmode); settab.putchar(altmode); 719 linesperpage(-1); E89 720 END; DECsystem-20 SIMULA %4A(310) 1-FEB-1981 14:50 PAGE 39 DSK:ADRES.SIM 20-FEB-1977 19:00 721 722 723 PROCEDURE countprint(t,count); 724 NAME t; TEXT t; INTEGER count; B90 725 BEGIN 726 outtext(t); outint(count,5); E90 727 END; DECsystem-20 SIMULA %4A(310) 1-FEB-1981 14:50 PAGE 40 DSK:ADRES.SIM 20-FEB-1977 19:00 728 729 730 PROCEDURE message_end_of_processing; B91 731 BEGIN 732 dotypeout(sysout); outimage; 733 outline("[ADRES processing is ready.]"); 734 countprint("LABELS IN: ",count_of_input); 735 countprint(" LABELS OUT: ",count_of_output); 736 IF count_of_error > 0 THEN B92 737 BEGIN 738 countprint(" UNACCEPTABLE LABELS IN: ",count_of_error); E92 739 END; 740 outimage; 741 IF select_output THEN B93 742 BEGIN 743 countprint( 744 "NUMBER OF LABELS REJECTED BECAUSE OF SELECTION CRITERIA: " 745 ,count_of_rejected); outimage; E93 746 END; 747 IF presort_output THEN B94 748 BEGIN 749 countprint("MINIMUM RECORD SIZE FOR SORTING: ",sortlength); 750 outimage; E94 751 END; E91 752 END; DECsystem-20 SIMULA %4A(310) 1-FEB-1981 14:50 PAGE 41 DSK:ADRES.SIM 20-FEB-1977 19:00 753 754 755 initialize_constants; 756 WHILE TRUE DO B95 757 BEGIN 758 read_input_command; 759 open_files; 760 create_labels; 761 resume(first_label); 762 close_files; 763 message_end_of_processing; E95 764 END of input_command_loop; E4 765 END of select block; E3 766 END of decom block; E1 767 quit: END of the whole program; DEFAULT SWITCHES USED NO ERRORS DETECTED