hyterm.compdv 04/23/85 1257.6rew 04/23/85 0911.8 249966 /* *********************************************************** * * * * * Copyright, (C) Honeywell Information Systems Inc., 1981 * * Copyright, (C) Honeywell Information Systems Inc., 1980 * * * * * *********************************************************** */ Wordspace: 3,6,9,SP; Letterspace: 1; MediaChars: 010 SELF, HT 011, FF 014, 016 SELF, 017 SELF, STROKE 030, 030 SELF, ESC 033, 033 SELF, PLOT 033 "3", UNPLOT 033 "4", "!":"~" SELF, 177 SELF, NIL "", 277 "", /* blind escape */ /* The font change strings expected by hyterm_writer_ are of the form: ooo "h" "w" where ooo is the octal representation of the wheel needed. "h" is the character to give to the device "w" is the decimal digit representing the width of a WSP */ Pwheel 001, HMI6 015, W6 "6", Awheel 002, HMI5 013, W5 "5", Ewheel 003, HMI4 011, W4 "4", /* definitions to move all 8 directions */ RHLF 033 "D", /* may NOT be used in PLOT mode */ BSPRLF 010 033 012, RLF 033 012, SPRLF 040 033 012, BSP 010, SP 040, BSPLF 010 012, LF 012, SPLF 040 012, HLF 033 "U", /* may NOT be used in PLOT mode */ /* These are needed by Cleanup: */ 037 SELF, 015 SELF, 036 SELF, 011 SELF; Strokes: 6; Media: mASC10, mASC12, mASC15, mAPL10; NIL 0, 0, 0, 0; BSP -6, -5, -4, -6; 010 -6, -5, -4, -6; HT 0, 0, 0, 0; 011 0, 0, 0, 0; FF 0, 0, 0, 0; 015 0, 0, 0, 0; 016 0, =, =, 0; 017 0, =, =, =; STROKE 1, =, =, =; 030 1, =, =, =; ESC -6, -5, -4, -6; 033 -6, -5, -4, -6; 036 0, 0, 0, 0; 037 0, 0, 0, 0; SP 6, 5, 4, 6; "!":"~" 6, 5, 4, 6; 177 0, =, =, 0; Pwheel 0, =, =, 0; Awheel 0, =, =, 0; Ewheel 0, =, =, 0; HMI6 0, =, =, 0; HMI5 0, =, =, 0; HMI4 0, =, =, 0; W6 0, =, =, 0; W5 0, =, =, 0; W4 0, =, =, 0; PLOT 0, =, =, 0; UNPLOT 0, =, =, 0; RLF 0, =, =, 0; RHLF 0, =, =, 0; BSPRLF -1, =, =, -1; SPRLF 1, =, =, =; BSPLF -1, =, =, -1; SPLF 1, =, =, 1; LF 0, =, =, 0; View: vASC10 mASC10; View: vASC12 mASC12; View: vASC15 mASC15; View: vAPL10 mAPL10; Def: ascii; "!":"~" SELF; 010 SELF; Def: ascii_; /* all overstrikes will have underscore last to optimize daisy */ /* wheel motion. hyterm_writer_ will separate underscored parts */ /* into three strings with all BSP together. By placing _ last */ /* in overstrike, all _ will then be together in the third string. */ /* This prints faster. */ "!":"~" SELF BSP "_"; 375 "Z" BSP "N"; EM- (PLOT "_" 4(RLF) UNPLOT 2("_") BSP PLOT 4(LF) UNPLOT "_")=12; EN- (PLOT 4(RLF) "_" 4(LF) UNPLOT "_")=6; 240 /* "printing" \040 */ (PLOT BSP "[" 2(SP) "]" BSP UNPLOT SP)=6; '' /*, 6,*/ """" BSP "_"; `` /*, 6,*/ """" BSP "_"; Def: etc; STROKE 030; 177 SELF; 277 ""; 377 SP; /* punctuation space */ 375 "Z" BSP "N"; /* square */ 417 "(" "T" "M" ")"; /* trademark */ EN SP; EM 2(SP); EM_ "_" "_"; EN_ "_"; THIN (SP)=3; DEVIT (SP)=1; Def: art; /* MATH SYMBOLS 1 - [ left square bracket | In the plot which follows each string 2 - ] right square bracket | you will see these characters in use: 3 - { left curly bracket | . a position in the "character space" 4 - } right curly bracket | o where a "dit" will appear 5 - ( left paren | X initial position of print head 6 - ) right paren | + final position of print head 7 - | Boolean OR 8 - || concatenate */ art [tp /* top parts */ (PLOT 8(RLF) 4(SP) "." 4(BSP ".") 8(LF ".") UNPLOT SP)=6; art ]tp (PLOT "." 8(RLF ".") 4(BSP ".") 4(SP) 8(LF) UNPLOT SP)=6; art {tp (PLOT "." 6(RLF ".") 2(SPRLF ".") 2(SP ".") 2(SP) 8(LF) UNPLOT)=6; art }tp (PLOT "." 6(RLF ".") 2(BSPRLF ".") 2(BSP ".") 4(SP) 8(LF) UNPLOT SP)=6; art lptp (PLOT "." 6(RLF ".") 2(SPRLF ".") 2(SP ".") 2(SP) 8(LF) UNPLOT)=6; art rptp (PLOT "." 6(RLF ".") 2(BSPRLF ".") 2(BSP ".") 4(SP) 8(LF) UNPLOT SP)=6; art |tp (PLOT "." 8(RLF ".") 8(LF) UNPLOT SP)=6; art ||tp (PLOT 2(BSP) "." 8(RLF ".") 3(SP) "." 8(LF ".") BSP UNPLOT SP)=6; art [ht /* half-top parts */ (PLOT "." 4(RLF ".") 4(SP ".") 2(SPLF) 2(LF) UNPLOT)=6; art ]ht (PLOT "." 4(RLF ".") 4(BSP ".") 4(SPLF) UNPLOT SP)=6; art {ht (PLOT "." 2(RLF ".") 2(SPRLF ".") 2(SP ".") 2(SPLF) 2(LF) UNPLOT)=6; art }ht (PLOT "." 2(RLF ".") 2(BSPRLF ".") 2(BSP ".") 4(SPLF) UNPLOT SP)=6; art lpht (PLOT "." 2(RLF ".") 2(SPRLF ".") 2(SP ".") 2(SPLF) 2(LF) UNPLOT)=6; art rpht (PLOT "." 2(RLF ".") 2(BSPRLF ".") 2(BSP ".") 4(SPLF) UNPLOT SP)=6; art |ht (PLOT "." 4(RLF ".") 4(LF) UNPLOT SP)=6; art ||ht (PLOT 2(BSP) "." 4(RLF ".") 3(SP) "." 4(LF ".") BSP UNPLOT SP)=6; art [md /* middle parts */ (PLOT "." 8(RLF ".") 8(LF) UNPLOT SP)=6; art ]md (PLOT "." 8(RLF ".") 8(LF) UNPLOT SP)=6; art {md (PLOT "." 2(RLF ".") 2(BSPRLF ".") 2(SPRLF ".") 2(RLF ".") 8(LF) UNPLOT SP)=6; art }md (PLOT "." 2(RLF ".") 2(SPRLF ".") 2(BSPRLF ".") 2(RLF ".") 8(LF) UNPLOT SP)=6; art lpmd (PLOT "." 8(RLF ".") 8(LF) UNPLOT SP)=6; art rpmd (PLOT "." 8(RLF ".") 8(LF) UNPLOT SP)=6; art |md (PLOT "." 8(RLF ".") 8(LF) UNPLOT SP)=6; art ||md (PLOT 2(BSP) "." 8(RLF ".") 3(SP) "." 8(LF ".") 5(SP) UNPLOT)=6; art [hb /* half-bottom parts */ (PLOT 4(SPLF) "." 4(BSP ".") 4(RLF ".") UNPLOT)=0; art ]hb (PLOT 4(BSPLF) "." 4(SP ".") 4(RLF ".") UNPLOT)=0; art {hb (PLOT 4(SPLF) "." 2(BSP ".") 2(BSPRLF ".") 2(RLF ".") UNPLOT)=0; art }hb (PLOT 4(BSPLF) "." 2(SP ".") 2(SPRLF ".") 2(RLF ".") UNPLOT)=0; art lphb (PLOT 4(SPLF) "." 2(BSP ".") 2(BSPRLF ".") 2(RLF ".") UNPLOT)=0; art rphb (PLOT 4(BSPLF) "." 2(SP ".") 2(SPRLF ".") 2(RLF ".") UNPLOT)=0; art |hb (PLOT 4(LF) "." 4(RLF ".") UNPLOT)=0; art ||hb (PLOT 2(BSPLF) 2(LF) "." 4(RLF ".") 3(SP) "." 4(LF ".") BSPRLF 3(RLF) UNPLOT)=0; art [bt /* bottom parts */ (PLOT 4(SP) "." 4(BSP ".") 8(RLF ".") 8(LF) UNPLOT SP)=6; art ]bt (PLOT 4(BSP) "." 4(SP ".") 8(RLF ".") 8(LF) UNPLOT SP)=6; art {bt (PLOT 4(SP) "." 2(BSP ".") 2(BSPRLF ".") 6(RLF ".") 8(LF) UNPLOT SP)=6; art }bt (PLOT 4(BSP) "." 2(SP ".") 2(SPRLF ".") 6(RLF ".") 8(LF) UNPLOT SP)=6; art lpbt (PLOT 4(SP) "." 2(BSP ".") 2(BSPRLF ".") 6(RLF ".") 8(LF) UNPLOT SP)=6; art rpbt (PLOT 4(BSP) "." 2(SP ".") 2(SPRLF ".") 6(RLF ".") 8(LF) UNPLOT SP)=6; art |bt (PLOT "." 8(RLF ".") 8(LF) UNPLOT SP)=6; art ||bt (PLOT 2(BSP) "." 8(RLF ".") 3(SP) "." 8(LF ".") 5(SP) UNPLOT)=6; art [fl /* filler parts */ (PLOT "." 8(RLF ".") 8(LF) UNPLOT SP)=6; art ]fl (PLOT "." 8(RLF ".") 8(LF) UNPLOT SP)=6; art {fl (PLOT "." 8(RLF ".") 8(LF) UNPLOT SP)=6; art }fl (PLOT "." 8(RLF ".") 8(LF) UNPLOT SP)=6; art lpfl (PLOT "." 8(RLF ".") 8(LF) UNPLOT SP)=6; art rpfl (PLOT "." 8(RLF ".") 8(LF) UNPLOT SP)=6; art |fl (PLOT "." 8(RLF ".") 8(LF) UNPLOT SP)=6; art ||fl (PLOT 2(BSP) "." 8(RLF ".") 3(SP) "." 8(LF ".") 5(SP) UNPLOT)=6; art [ /* one-highs */ (PLOT 4(SPLF) "." 4(BSP ".") 12(RLF ".") 4(SP ".") 6(LF) 2(SPLF) UNPLOT)=6; art ] (PLOT 4(BSPLF) "." 4(SP ".") 12(RLF ".") 4(BSP ".") 8(SPLF) 2(SP) UNPLOT)=6; art { (PLOT 4(SPLF) "." 2(BSP ".") 2(BSPRLF ".") 2(RLF ".") 2(BSPRLF ".") 2(SPRLF ".") 2(RLF ".") 2(SPRLF ".") 2(SP ".") 4(LF) 2(SPLF) 2(LF) UNPLOT)=6; art } (PLOT 4(BSPLF) "." 2(SP ".") 2(SPRLF ".") 2(RLF ".") 2(SPRLF ".") 2(BSPRLF ".") 2(RLF ".") 2(BSPRLF ".") 2(BSP ".") 4(LF) 4(SPLF) 6(SP) UNPLOT)=6; art ( (PLOT 4(SPLF) "." 2(BSP ".") 2(BSPRLF ".") 8(RLF ".") 2(SPRLF ".") 2(SP ".") 4(LF) 2(SPLF) 2(LF) UNPLOT)=6; art ) (PLOT 4(BSPLF) "." 2(SP ".") 2(SPRLF ".") 8(RLF ".") 2(BSPRLF ".") 2(BSP ".") 4(LF) 4(SPLF) 6(SP) UNPLOT)=6; art | (PLOT 4(LF) "." 12(RLF ".") 4(LF) 4(SPLF) 2(SP) UNPLOT)=6; art || (PLOT 2(BSPLF) 2(LF) "." 12(RLF ".") 3(SP) "." 12(LF ".") 4(SPRLF) SP UNPLOT)=6; art o (PLOT BSP "." 2(SP ".") SPRLF "." 4(BSP ".") RLF "." 4(SP ".") BSPRLF "." 2(BSP ".") 3(SPLF) 4(SP) UNPLOT)=6; art / (PLOT BSPLF 2(BSP) "." 9(SPRLF ".") 4(LF) 4(LF) UNPLOT)=6; art X (PLOT 2(BSP) "." 6(SPRLF ".") 6(BSP) "." 6(SPLF ".") 2(SP) UNPLOT)=6; art d (PLOT BSP "." 4(SPRLF ".") 4(LF) "." 4(BSPRLF ".") BSPLF LF "." 6(SP ".") 2(SPLF) UNPLOT)=6; art m (PLOT 2(LF) "." 8(RLF ".") SP "." 8(LF ".") 2(SPRLF) 3(SP) UNPLOT)=6; art |rul (PLOT 6(RLF) "." 8(LF ".") 2(RLF) UNPLOT)=0; art v (PLOT 2(LF) "." BSPRLF "." 2(SP ".") SPRLF "." 4(BSP ".") BSPRLF "." 6(SP ".") BSPLF 2(BSP) UNPLOT)=0; art ^ (PLOT 3(BSPRLF) "." 6(SP ".") BSPRLF "." 4(BSP ".") SPRLF "." 2(SP ".") BSPRLF "." 6(LF) UNPLOT)=0; art -str (PLOT 2(LF) UNPLOT)=0; art -rul (PLOT 5("." SP ".") UNPLOT)=6; art -stp (PLOT 2(RLF) UNPLOT)=0; art <- (PLOT 5(LF) "." 6(RLF ".") BSPLF "." 4(LF ".") BSPRLF "." 2(RLF ".") BSPLF "." 2(SPRLF) SP UNPLOT)=0; /* ...... */ /* ...... */ /* ...... */ /* ...... */ /* ...... */ /* ...... */ /* ...o.. */ /* X..oo..+ */ /* ooo */ /* oooo */ /* ooo */ /* oo */ /* o */ art -> (PLOT 4(LF) BSPLF 2(BSP) "." 6(RLF ".") SPLF "." 4(LF ".") SPRLF "." 2(RLF ".") SPLF "." 2(SPRLF) 4(SP) UNPLOT)=6; /* ...... */ /* ...... */ /* ...... */ /* ...... */ /* ...... */ /* ...... */ /* o ...... */ /* oo X......+ */ /* ooo */ /* oooo */ /* ooo */ /* oo */ /* o */ art D^ (PLOT 2(LF) "." 3(SPRLF ".") 3(SPLF ".") 2(RLF) UNPLOT)=6; art D< (SP PLOT 2(LF) "." 4(BSPRLF ".") 4(SPRLF ".") 6(LF) UNPLOT)=6; art D> (PLOT 2(LF) "." 4(SPRLF ".") 4(BSPRLF ".") 6(LF) UNPLOT SP)=6; art Dv (PLOT 6(RLF) "." 3(SPLF ".") 3(SPRLF ".") 6(LF) UNPLOT)=6; art \rul (PLOT 4(RLF) 2(BSPRLF) "." 8(SPLF ".") 2(RLF) UNPLOT)=6; /* ...... */ /* o ...... */ /* o...... */ /* o..... */ /* .o.... */ /* ..o... */ /* ...o.. */ /* X....o.+ */ /* o */ /* o */ art /rul (PLOT BSPLF LF "." 8(SPRLF ".") 4(LF) BSPLF LF UNPLOT)=6; /* ...... */ /* ...... o */ /* ......o */ /* .....o */ /* ....o. */ /* ...o.. */ /* ..o... */ /* X.o....+ */ /* o */ /* o */ art Clf (PLOT 4(LF) 4(LF) 2(SPLF) 4(SP) "." 3(BSP ".") BSPRLF "." 2(BSP ".") 3(BSPRLF ".") RLF "." BSPRLF "." 2(RLF ".") 2(RLF ".") SPRLF "." RLF "." 3(SPRLF ".") 2(SP ".") SPRLF "." 3(SP ".") 4(LF) 2(LF) UNPLOT)=6; /* ...... */ /* ...oooo */ /* ooo... */ /* o...... */ /* o ...... */ /* o ...... */ /* o ...... */ /* o X......+ */ /* o */ /* o */ /* o */ /* o */ /* o */ /* o */ /* o */ /* o */ /* ooo */ /* oooo */ art Crt (PLOT 4(LF) 4(LF) 2(BSPLF) 4(BSP) "." 3(SP ".") SPRLF "." 2(SP ".") 3(SPRLF ".") RLF "." SPRLF "." 2(RLF ".") 2(RLF ".") BSPRLF "." RLF "." 3(BSPRLF ".") 2(BSP ".") BSPRLF "." 3(BSP ".") 4(LF) 2(SPLF) 10(SP) UNPLOT)=6; /* ...... */ /* oooo ...... */ /* ooo..... */ /* .o.... */ /* ..o... */ /* ...o.. */ /* ...o.. */ /* X....o.+ */ /* o */ /* o */ /* o */ /* o */ /* o */ /* o */ /* o */ /* o */ /* ooo */ /* oooo */ art c (PLOT SPRLF 2(SP) UNPLOT "c" PLOT BSP "." 2(RLF ".") 2(BSPRLF ".") BSP "." BSPRLF "." 2(BSP ".") BSPLF "." BSP "." 2(BSPLF ".") 2(LF ".") 2(SPLF ".") SP "." SPLF "." 2(SP ".") SPRLF "." SP "." SPRLF "." 5(SP) UNPLOT)=12; /* ...... */ /* ..ooo. */ /* oo...oo */ /* o...... o */ /* o ...... o */ /* o ...... o */ /* o ...... o */ /* oX...... o + */ /* oo oo */ /* ooo */ art t /* trademark */ (PLOT 3(SP) 5("." RLF) 3(BSP) "." 6(SP ".") 5(LF ".") 2(RLF) SPRLF "." 2(SPLF ".") 3(SPRLF ".") 4(LF ".") 3(SP) UNPLOT)=12; /* ............... */ /* ............... */ /* ooooooo........ */ /* ...o..o.....o.. */ /* ...o..oo...oo.. */ /* ...o..o.o.o.o.. */ /* ...o..o..o..o.. */ /* +..o..o.....o..+ */ /* daggar */ 261 (PLOT "|" RLF "|" 2(RLF) "-" 3(SPLF) 3(SP) UNPLOT)=6; /* ...... */ /* ...... */ /* ...... */ /* ...... */ /* o..... */ /* ...... */ /* o..... */ /* o......+ */ /* double daggar */ 301 (PLOT "|" RLF "|" 2(RLF) "-" 4(LF) "-" SPRLF 5(SP) UNPLOT)=6; /* ...... */ /* ...... */ /* ...... */ /* ...... */ /* o..... */ /* ...... */ /* o..... */ /* o......+ */ /* o */ /* del */ 304 (PLOT "/" SPRLF RLF "_" SP "_" SPLF LF "\" 6(SP) UNPLOT)=9; /* ...... */ /* ...... */ /* ...... */ /* ...... */ /* ...... */ /* .oo... */ /* ...... */ /* o...o.. + */ /* nabla */ 254 (PLOT "\" 4(RLF) 2(SPRLF) RLF "_" SP "_" 4(LF) 2(SPLF) LF "/" 5(SP) UNPLOT)=10; /* ..oo.. */ /* ...... */ /* ...... */ /* ...... */ /* ...... */ /* ...... */ /* ...... */ /* o.....o + */ art bxtl (PLOT 2(LF) "." 6(SP ".") UNPLOT)=6; art bxt SP; art bxtr (PLOT 2(RLF) UNPLOT)=0; art bxl (PLOT 6(RLF) "." 8(LF ".") 6(SP ".") UNPLOT)=6; art bxx (PLOT 6(RLF) "." 8(LF ".") 2(RLF) UNPLOT SP)=6; art bxr (PLOT 8(RLF) "." 8(LF ".") 2(RLF) UNPLOT)=0; art bxbl (PLOT 6(RLF) "." 8(LF ".") 6(SP ".") UNPLOT)=6; art bxb (PLOT 6(RLF) "." 8(LF ".") 2(RLF) UNPLOT SP)=6; art bxbr (RLF PLOT "." 8(LF ".") 2(RLF) UNPLOT)=0; art lztl (PLOT 2(LF) "." 6(SP ".") UNPLOT)=6; art lztr (PLOT 6(SP ".") 4(BSP) 2(BSPRLF) UNPLOT)=0; art lzl (PLOT BSPLF LF "." 8(SPRLF ".") 5(LF) BSPLF UNPLOT)=6; art lzr (PLOT 4(RLF) 2(BSPRLF) "." 8(SPLF ".") 2(RLF) UNPLOT)=6; art lzbl (PLOT 2(BSP) 6(BSPRLF) "." 8(SPLF ".") 6(SP ".") UNPLOT)=6; art lzbr (PLOT 6(SP ".") 8(SPRLF ".") 8(BSP) 6(BSPLF) UNPLOT)=0; '' /*, 6,*/ """"; `` /*, 6,*/ """"; Def: UCbold; "a" "A"; "b" "B"; "c" "C"; "d" "D"; "e" "E"; "f" "F"; "g" "G"; "h" "H"; "i" "I"; "j" "J"; "k" "K"; "l" "L"; "m" "M"; "n" "N"; "o" "O"; "p" "P"; "q" "Q"; "r" "R"; "s" "S"; "t" "T"; "u" "U"; "v" "V"; "w" "W"; "x" "X"; "y" "Y"; "z" "Z"; Def: OSbold; "!":"~" SELF BSP SELF BSP SELF; Def: OSboldital; "!":"^" SELF BSP SELF BSP SELF BSP "_"; "_" SELF BSP SELF BSP SELF; "`":"~" SELF BSP SELF BSP SELF BSP "_"; Font: asc10 vASC10; ref: ascii; ref: etc; ref: art; EN- "-"; EM- (PLOT 3("-" 4(SP)) UNPLOT)=12; EM_ (PLOT RLF RLF 2("_" 5(SP)) LF LF UNPLOT )=12; EN_ (PLOT RLF RLF "_" LF LF UNPLOT SP)=6; 422 """"; 421 """"; '' /**/ """"; `` /**/ """"; 240 /* "printing" \040 */ (PLOT BSP "[" 2(SP) "]" 5(SP) UNPLOT)=6; Font: apl vAPL10; ref: ascii; ref: etc; ref: art; Font: ASC10 vASC10; ref: ascii; ref: etc; ref: art; ref: UCbold; Font: ASC10OS vASC10; ref: etc; ref: art; ref: OSbold; Font: asc10_ vASC10; /* pick all the artwork */ ref: etc; ref: art; /* all overstrikes will have underscore last to optimize daisy */ /* wheel motion. hyterm_writer_ will separate underscored parts */ /* into three strings with all BSP together. By placing _ last */ /* in overstrike, all _ will then be together in the third string. */ /* This prints faster. */ "!":"~" /*, 6,*/ SELF BSP "_"; 375 /*, 6,*/ "Z" BSP "N"; EM- (PLOT 3("-" 4(SP)) UNPLOT 2(BSP) PLOT 2("_" 5(SP)) UNPLOT)=12; /* ...... */ /* ...... */ /* ...... */ /* ...... */ /* ...... */ /* ...... */ /* ...... */ /* X...... + */ EN- "-" BSP "_"; 240 /* "printing" \040 */ (PLOT BSP "[" 2(SP) "]" 5(SP) UNPLOT)=6; /* ...... */ /* ...... */ /* ...... */ /* ...... */ /* ...... */ /* ...... */ /* ...... */ /* oX.o....+ */ '' /*, 6,*/ """" BSP "_"; `` /*, 6,*/ """" BSP "_"; Font: ASC10_ vASC10; ref: etc; ref: art; ref: ascii_; "a" 101 BSP "_"; "b" "B" BSP "_"; "c" "C" BSP "_"; "d" "D" BSP "_"; "e" "E" BSP "_"; "f" "F" BSP "_"; "g" "G" BSP "_"; "h" "H" BSP "_"; "i" "I" BSP "_"; "j" "J" BSP "_"; "k" "K" BSP "_"; "l" "L" BSP "_"; "m" "M" BSP "_"; "n" "N" BSP "_"; "o" "O" BSP "_"; "p" "P" BSP "_"; "q" "Q" BSP "_"; "r" "R" BSP "_"; "s" "S" BSP "_"; "t" "T" BSP "_"; "u" "U" BSP "_"; "v" "V" BSP "_"; "w" "W" BSP "_"; "x" "X" BSP "_"; "y" "Y" BSP "_"; "z" "Z" BSP "_"; Font: ASC10_OS vASC10; ref: etc; ref: art; ref: OSboldital; Font: asc12 vASC12; ref: ascii; ref: etc; ref: art; EN- "-"; EM- (PLOT 3("-" 3(SP)) SP UNPLOT)=10; 240 /* "printing" \040 */ (PLOT BSP "[" 2(SP) "]" 5(SP) UNPLOT)=6; Font: ASC12 vASC12; ref: etc; ref: art; ref: UCbold; Font: asc12_ vASC12; /* pick all the artwork */ ref: etc; ref: art; "!":"~" SELF BSP "_"; 375 "Z" BSP "N"; EM- (PLOT 3("-" 3(SP)) SP UNPLOT 2(BSP) 2("_"))=10; EN- "-" BSP "_"; 240 /* "printing" \040 */ (PLOT BSP "[" 2(SP) "]" 4(SP) UNPLOT)=5; /* ...... */ /* ...... */ /* ...... */ /* ...... */ /* ...... */ /* ...... */ /* ...... */ /* oX.o...._. */ '' """" BSP "_"; `` """" BSP "_"; Font: ASC12_ vASC12; ref: etc; ref: art; "a" "A" BSP "_"; "b" "B" BSP "_"; "c" "C" BSP "_"; "d" "D" BSP "_"; "e" "E" BSP "_"; "f" "F" BSP "_"; "g" "G" BSP "_"; "h" "H" BSP "_"; "i" "I" BSP "_"; "j" "J" BSP "_"; "k" "K" BSP "_"; "l" "L" BSP "_"; "m" "M" BSP "_"; "n" "N" BSP "_"; "o" "O" BSP "_"; "p" "P" BSP "_"; "q" "Q" BSP "_"; "r" "R" BSP "_"; "s" "S" BSP "_"; "t" "T" BSP "_"; "u" "U" BSP "_"; "v" "V" BSP "_"; "w" "W" BSP "_"; "x" "X" BSP "_"; "y" "Y" BSP "_"; "z" "Z" BSP "_"; Font: asc15 vASC15; ref: ascii; ref: etc; ref: art; `` (PLOT BSP "`" 3(SP) "`" 2(SP) UNPLOT)=4; '' (PLOT BSP "'" 3(SP) "'" 2(SP) UNPLOT)=4; EM- (PLOT 2("-" 4(SP)) UNPLOT)=8; EN- "-"; 240 /* "printing" \040 */ (PLOT BSP "[" 2(SP) "]" 3(SP) UNPLOT)=4; /* ...... */ /* ...... */ /* ...... */ /* ...... */ /* ...... */ /* ...... */ /* ...... */ /* oX.o..._.. */ Font: ASC15 vASC15; ref: etc; ref: art; ref: UCbold; Font: asc15_ vASC15; /* pick all the artwork */ ref: etc; ref: art; "!":"~" SELF BSP "_"; '' """" BSP "_"; EM_ 2("_"); EN_ "_"; 375 "Z" BSP "N"; EM- (PLOT 2("-" 4(SP)) UNPLOT 2(BSP) 2("_"))=8; EN- "-" BSP "_"; 240 /* "printing" \040 */ (PLOT BSP "[" 2(SP) "]" 3(SP) UNPLOT)=4; /* ...... */ /* ...... */ /* ...... */ /* ...... */ /* ...... */ /* ...... */ /* ...... */ /* oX.o..._.. */ `` """" BSP "_"; Font: ASC15_ vASC15; "a" 101 BSP "_"; "b" "B" BSP "_"; "c" "C" BSP "_"; "d" "D" BSP "_"; "e" "E" BSP "_"; "f" "F" BSP "_"; "g" "G" BSP "_"; "h" "H" BSP "_"; "i" "I" BSP "_"; "j" "J" BSP "_"; "k" "K" BSP "_"; "l" "L" BSP "_"; "m" "M" BSP "_"; "n" "N" BSP "_"; "o" "O" BSP "_"; "p" "P" BSP "_"; "q" "Q" BSP "_"; "r" "R" BSP "_"; "s" "S" BSP "_"; "t" "T" BSP "_"; "u" "U" BSP "_"; "v" "V" BSP "_"; "w" "W" BSP "_"; "x" "X" BSP "_"; "y" "Y" BSP "_"; "z" "Z" BSP "_"; Font: ASC15OS vASC15; wordspace: 2,4,8,SP; ref: etc; ref: art; ref: OSbold; Font: ASC15_OS vASC15; wordspace: 2,4,8,SP; ref: etc; ref: art; ref: OSboldital; Font: elite vASC12; Font: elite_ vASC12; Font: ELITE vASC12; Font: ELITE_ vASC12; Font: elite15 vASC15; Font: elite15_ vASC15; Font: ELITE15 vASC15; Font: ELITE15_ vASC15; Size: onesize, 7.2; MinLead: 1.5; MinSpace: 1.2; MaxPageWidth: 950.4; Outproc: hyterm_writer_; DefaultMargs: 48,24,24,48; Cleanup: UNPLOT 033 037 015 033 036 011; Comment: " Type Wheel Identification 1 - 38101-01 PICA 10 2 - 38510 APL 10 3 - 38102-01 ELITE 12 DB: hyterm_writer_$display "; DevName: "hyterm"; DevClass: "diablo"; Interleave: on; Device: hyterm, HYTERM, diablo1620; init: text 7.2; viewselect: vASC10 Pwheel HMI6 W6, vASC12 Ewheel HMI5 W5, vASC15 Pwheel HMI4 W4, vAPL10 Awheel HMI6 W6; attach: "syn_ user_output"; family: centuryschoolbook, cs, helvetica, h; member: /medium, /m, /, /roman, /r asc10; member: /italic, /i, /mediumitalic, /mi asc10_; member: /bold, /b, /boldroman, /br ASC10OS; member: /bolditalic, /bi ASC10_OS; family: pica10; member: /medium, /m, /, /roman, /r asc10; member: /italic, /i, /mediumitalic, /mi asc10_; member: /bold, /b, /boldroman, /br ASC10OS; member: /bolditalic, /bi ASC10_OS; member: /caps ASC10; member: /caps_ ASC10_; bachelor: ascii, l4font, l3exact, l4exact, text, footnote, footref asc10; bachelor: l0exact, CSR, HR, typ, small_typ, ascii9 asc10; bachelor: l0font, l3font, ASCII ASC10; bachelor: bold, CSBR, HBR, HBBl ASC10OS; bachelor: italic, l2font, l1exact, l2exact, CSI, HmI, ascii_ asc10_; bachelor: l1font, ASCII_ ASC10_; bachelor: CSBI, HBI, bolditalic ASC10_OS; bachelor: apl, APL apl; family: pica_12; member: /medium, /m, /, /roman, /r asc12; member: /italic, /i, /mediumitalic, /mi asc12_; member: /bold, /b, /boldroman, /br ASC12; member: /bolditalic, /bi ASC12_; member: /caps ASC12; member: /caps_ ASC12_; bachelor: pica12 asc12; bachelor: pica12_ asc12_; bachelor: PICA12 ASC12; bachelor: PICA12_ ASC12_; Device: hyterm_draft; init: text 7.2; viewselect: vASC10 Pwheel HMI6 W6, vASC12 Ewheel HMI5 W5, vASC15 Pwheel HMI4 W4, vAPL10 Awheel HMI6 W6; attach: "syn_ user_output"; family: centuryschoolbook, cs, helvetica, h; member: /medium, /m, /, /roman, /r asc10; member: /italic, /i, /mediumitalic, /mi asc10_; member: /b ,/bold, /boldroman, /br ASC10OS; member: /bi,/bolditalic ASC10_OS; family: pica10, pica; member: /medium, /m, /, /roman, /r asc10; member: /italic, /i, /mediumitalic, /mi asc10_; member: /bold, /b, /boldroman, /br ASC10OS; member: /bolditalic, /bi ASC10_OS; member: /caps ASC10; member: /caps_ ASC10_; bachelor: text, footnote, footref, CSR, HR, ascii, typ, small_typ, ascii9 asc10; bachelor: l0exact asc10; bachelor: l0font, ASCII ASC10; bachelor: bold, CSBR, HBR, HBBl, l4font, l3exact, l4exact ASC10OS; bachelor: italic, l2font, l1exact, l2exact, CSI, HmI, ascii_ asc10_; bachelor: l1font, ASCII_ ASC10_; bachelor: CSBI, HBI, l3font, bolditalic ASC10_OS; bachelor: apl, APL apl; family: pica_12; member: /medium, /m, /, /roman, /r asc12; member: /italic, /i, /mediumitalic, /mi asc12_; member: /bold, /b, /boldroman, /br ASC12; member: /bolditalic, /bi ASC12_; member: /caps ASC12; member: /caps_ ASC12_; bachelor: pica12 asc12; bachelor: pica12_ asc12_; bachelor: PICA12 ASC12; bachelor: PICA12_ ASC12_; Device: vhyt; init: text 7.2; viewselect: vASC12 Ewheel HMI5 W5, vASC15 Pwheel HMI4 W4; devname: "vhyt"; devclass: "photocomp"; attach: "syn_ user_output"; family: centuryschoolbook, cs; member: /medium, /m, /, /roman, /r asc15; member: /italic, /i, /mediumitalic, /mi asc15_; member: /bold, /b, /boldroman, /br ASC15; member: /bolditalic, /bi ASC15_; bachelor: CSR, HR, text, l4font, footnote, footref, l0exact asc15; bachelor: l3font, bold, CSBR, HBR, HBBl ASC15OS; bachelor: italic, l2font, CSI, HmI asc15_; bachelor: l0font, l1font, CSBI, HBI, bolditalic ASC15_OS; family: pica; member: /medium, /m, /, /roman, /r asc12; member: /italic, /i, /mediumitalic, /mi asc12_; member: /bold, /b, /boldroman, /br ASC12; member: /bolditalic, /bi ASC12_; member: /caps ASC12; member: /caps_ ASC12_; bachelor: pica12, ascii asc12; bachelor: pica12_, ascii_ asc12_; bachelor: PICA12, ASCII ASC12; bachelor: PICA12_, ASCII_ ASC12_; Device: nec5525, spinwriter like hyterm; devname: "nec5525";  hyterm_writer_.pl1 04/23/85 1257.6r w 04/23/85 1123.2 528750 /* *********************************************************** * * * * * Copyright, (C) Honeywell Information Systems Inc., 1981 * * Copyright, (C) Honeywell Information Systems Inc., 1980 * * * * * *********************************************************** */ /* compose support routine to write output to hyterm terminals (class diablo) */ /* PREFACE /* This program handles length and distance values in "picture elements" /* (pixels). These are the native units in the machine and, sooner or later, /* all internal length and distance values have to be converted to pixels to /* actually get device output. In some cases the vertical and horizontal /* pixels are not of the same size, i.e. a Diablo-type typewriter has /* 60/inch horizontally and 48/inch vertically. /* All values which are fixed bin (31) are in millipoints. /* Debugging tools--- /* There are several switches that control debugging output from a writer-- /* shared.bug_mode db_sw dt_sw lg_sw /* debug_sw detail_sw long_sw /* shared.bug_mode is set via the family of -db arguments. It means that all /* of compose is being debugged. /* db_sw, dt_sw, lg_sw (static) are set by the entries dbn, dtn, and lgn */ /* respectively. They are reset by the entries dbf, dtf, and lgf. */ /* These switches interact with each other. In order to reduce the amount of */ /* code executed when not debugging, these interactions are distilled into */ /* automatic switches, debug_sw, detail_sw, and long_sw with this logic. */ /* debug_sw = (shared.bug_mode | db_sw); */ /* detail_sw = debug_sw & dt_sw; */ /* long_sw = debug_sw & lg_sw; */ /* debug_sw controls these outputs-- */ /* -- entry and exit notification */ /* -- an interpretation of each line of the input structure before it is */ /* acted upon. */ /* -- gap count error notification */ /* detail_sw controls these outputs-- */ /* -- (preface) indication */ /* -- justification calculations */ /* -- device control (DCxx) display */ /* -- plot trace */ /* -- put_ trace */ /* -- set_font trace */ /* -- set_media trace */ /* -- overstrike processing notification */ /* long_sw controls these outputs-- */ /* -- shows the justified text line */ /* -- shows detailed Multics/device translation (simple) */ /* This is a 60x48 Diablo type device. It supports plot mode and adjustable */ /* HMI values. Most artwork is done via plot mode. Horizontal lines are */ /* implemented with HMI=2/120 then "."'s. */ /* format: style2,ind2,ll79,dclind4,idind15,comcol41,linecom */ hyterm_writer_: proc (func, code); /* PARAMETERS */ dcl func fixed bin; /* function code */ /* 0 = build a page */ /* 1 = initialize a page */ /* 2 = initialize a file */ /* 3 = clean up */ /* 4 = prepare epilogue */ dcl code fixed bin (35); /* error code */ /* LOCAL STORAGE */ dcl auto_lead fixed bin (31); /* automatic baseline advance */ dcl BAD_CHAR char (1) static options (constant) init ("ÿ"); /* list of bad font chars */ dcl bad_chrs char (128) var static; dcl char_ndx fixed bin; /* index into font table */ dcl col_width fixed bin (31); /* calculated column width */ dcl debug_str char (1020) var; dcl debug_sw bit (1); dcl detail_sw bit (1); dcl dev_stat_ptr ptr static init (null ()); dcl EM_width fixed bin (31); /* width of EM */ dcl EN_width fixed bin (31); /* width of EN */ dcl fcdevfnt fixed bin; /* device font needed by a char */ dcl fcwidth fixed bin (31); /* font char width */ dcl first_line bit (1) static; dcl first_page bit (1) aligned static init ("0"b); dcl font_in fixed bin; /* current font */ dcl font_size fixed bin (31); /* point size in current font */ dcl fonts_done bit (36); /* which fonts have been processed */ dcl fonts_needed bit (36); /* which fonts have been requested */ dcl hot_chars char (35) static options (constant) init (" þÿ"); dcl (i, j, jj, k, ll) fixed bin; dcl ichr fixed bin; /* index to current text character */ dcl ilin fixed bin static;/* page image line counter */ dcl just_line char (1020) var; /* the justified line */ dcl lineinfoptr ptr; /* -> info structure for image line */ dcl line_window_size /* # of window lines per output line */ fixed bin; dcl Lmarg fixed bin (31); /* left margin */ dcl loctxt char (1020) var; /* max rev leading allowed */ dcl long_sw bit (1); dcl max_level fixed bin; dcl max_revlead fixed bin (31) static; dcl font_media (36) fixed bin; /* media needed by the fonts */ dcl media_size fixed bin (31); /* point size in media */ dcl medselstr char (32) var; /* emitted medsel string */ dcl need_font fixed bin; /* needed font */ dcl need_devfnt fixed bin; /* device font for needed font */ dcl need_size fixed bin (31); /* needed size */ dcl NULs char (4) var static options (constant) init (""); dcl pref_sw bit (1); /* effective preface switch */ dcl quad bit (6); /* alignment flags */ dcl runout fixed bin; /* # NLs for page runout */ dcl SHIFT_OP bit (1) static options (constant) init ("0"b); /* device status info */ dcl stat_blk (100) fixed bin (35) static init ((100) 0); /* The developer of a device writer */ /* may use this block (by defining a */ /* based overlay) to hold any */ /* necessary device status info. */ /* Note that the first word is */ /* initialized to -1 for each page, */ /* thus any overlay should keep it */ /* fixed bin (35) and assure that */ /* all special device modes are */ /* reset at the end of each page. */ dcl text_sw bit (1); dcl text_width fixed bin (31); /* local text width */ dcl tchr char (1); /* local text char */ dcl THIN_width fixed bin (31); /* width of THIN */ dcl tstr_ptr ptr; /* text string */ dcl 1 tstr aligned based (tstr_ptr), 2 open bit (1) unal, /* line has something */ 2 white bit (1) unal, /* line is white */ 2 MBZ bit (16) unal, 2 devfnt fixed bin unal, /* starting device font for line */ 2 last_cr fixed bin unal, /* position of last CR or NL */ 2 font fixed bin unal, /* font being processed */ 2 xpos fixed bin (31), /* X position */ 2 ypos fixed bin (31), /* Y position */ 2 w fixed bin (31), /* width of str */ 2 str_ptr ptr; dcl tstr_line char (2048) var based (tstr.str_ptr); dcl txtlen fixed bin; /* length of txtstr */ dcl unstart fixed bin (31); /* start of underscore */ dcl unstring bit (1) static; /* underscoring is active */ dcl VECTOR_OP bit (1) static options (constant) init ("1"b); dcl window_area_ptr /* points to current window area seg */ ptr static init (null); dcl window_bottom fixed bin static init (0); dcl window_level fixed bin; dcl window_ptr ptr static init (null); dcl 1 window (window_top:window_bottom) aligned like tstr based (window_ptr); dcl window_top fixed bin static init (0); dcl word char (4090) var; /* word accumulator */ dcl wrdwidth fixed bin (31); /* word width in MPTS */ dcl Xmov fixed bin (31); /* horizontal CTL movement */ dcl Xmptstrk fixed bin (31); /* horizontal mpt -> stroke conv */ dcl Xpixel fixed bin (31); /* horizontal pixel size */ dcl Xpos fixed bin (31); /* current horizontal position */ dcl Xspc fixed bin (31); /* horizontal movement */ dcl Xmpts fixed bin (31); /* temp horiz value */ dcl Yinit fixed bin (31); /* initial page depth */ dcl Ymov fixed bin (31); /* vertical CTL movement */ dcl Ypixel fixed bin (31); /* vertical pixel size */ dcl Ypos fixed bin (31); /* current vertical position */ dcl Yspc fixed bin (31); /* vertical movement */ dcl Ympts fixed bin (31); /* temp vert value */ dcl (addr, bin, divide, fixed, index, length, max, min, mod, null, pointer, size, string, substr, unspec) builtin; dcl (cleanup, comp_abort, null_font_char, overlength_line, zero_font_index) condition; dcl error_table_$fatal_error fixed bin (35) ext static; dcl error_table_$unimplemented_version fixed bin (35) ext static; dcl comp_error_table_$limitation fixed bin (35) ext static; dcl comp_error_table_$program_error fixed bin (35) ext static; dcl ioa_$rs entry options (variable); dcl ioa_$rsnnl entry options (variable); dcl translator_temp_$get_segment entry (char (*) aligned, ptr, fixed bin (35)); dcl translator_temp_$release_all_segments entry (ptr, fixed bin (35)); /**** &dcls FOR hyterm */ dcl ( ABS_TAB char (2) init (" "), DT1 char (3) init (" "), PENDOWN char (1) init ("."), PENUP char (1) init (" "), PLOT char (2) init ("3"), PLOTlen fixed bin init (2), RLF char (2) init (" "), RLFlen fixed bin init (2), SET_HMI char (2) init (""), unPLOT char (4) var init ("4"), unPLOTlen fixed bin init (2), /* 10pitch hmi value */ HMI10 fixed bin init (12) ) aligned static options (constant); dcl BELc char (17) var; /* BEL||HT||PADs for wheel change */ dcl 1 dev_stat based (dev_stat_ptr), 2 inited fixed bin (35), 2 sw, 3 plotting bit (1) unal, /* 1- in regular plot mode */ 3 MBZ bit (35) unal, 2 hmi_code char (1), /* current device HM character */ 2 hmi_value fixed bin; /* current device HM value */ dcl err_ct fixed bin; dcl err_sw bit (1); dcl font_wheel (36) fixed bin; /* wheels needed for fonts */ dcl mounted_wheel /* print wheel on machine */ fixed bin static init (0); dcl need_wheel fixed bin; /* print wheel needed */ dcl 1 preface aligned like page_record based (page_record_ptr); dcl iplt fixed bin; /* number of *c's to emit */ dcl MAX_STR fixed bin static options (constant) init (2048); dcl plot_str (40) char (8) var static options (constant) init /**/ (" .", "rd.", "  .", "ru.", " .", "r.", " .", "ld.", " .", "lu.", ".", "l.", " .", "d.", " .", "u.", ".", ".", " ", "rd", "  ", "ru", " ", "r", " ", "ld", " ", "lu", "", "l", " ", "d", " ", "u", " ", "HT", "U", "d/2", "D", "u/2" ); dcl rst char (8) var; /* replacement string */ dcl VMI char (4) var static options (constant) init (""); dcl tabcol fixed bin; /* target for direct tabbing */ dcl xc char (2) var; /* horizontal plot character(s) */ dcl xcmax fixed bin; dcl xyc char (6) var; /* common plot character(s) */ dcl xiyi fixed bin; /* amount of common movement */ dcl xycmax fixed bin; dcl yc char (3) var; /* vertical plot character(s) */ dcl ycmax fixed bin; dcl (abs, char, collate9, copy, dec, ltrim, round, rtrim, search, sign, verify) builtin; /**** END hyterm */ %page; code = 0; /* clear error code */ if func = 3 /* clean up */ then do; /**** &cleanup FOR hyterm */ /**** NO CODE *//**** END hyterm */ return; end; if func = 1 /* new page */ then do; init: entry; /* called by pco */ stat_blk (*) = 0; stat_blk (1) = -1; dev_stat_ptr = addr (stat_blk); return; end; if func = 2 /* new input file */ then do; myself: /* check structure versions */ const.outproc_ptr = codeptr (myself); if shared.version ^= shared_version | option.version ^= option_version | page.version ^= page_version | comp_dvid.version ^= comp_dvid_version then do; code = error_table_$unimplemented_version; if db_sw then do; call ioa_ (" shared.version=^i", shared.version); call ioa_ (" shared_version=^i", shared_version); call ioa_ (" option.version=^i", option.version); call ioa_ (" option_version=^i", option_version); call ioa_ (" page.version=^i", page.version); call ioa_ (" page_version=^i", page_version); call ioa_ (" dvid.version=^i", comp_dvid.version); call ioa_ (" dvid_version=^i", comp_dvid_version); end; return; end; bad_chrs = ""; unstring = "0"b; first_page = "1"b; /**** &file_init FOR hyterm */ max_revlead = -12000; /* dont back up more than 1 line */ if option.nobell_opt then BELc = " "; else BELc = " "; mounted_wheel = 1; /* assume ASCII wheel is mounted */ /**** END hyterm */ return; end; /**/ /* set debug switches */ debug_sw, detail_sw, long_sw, pref_sw, text_sw = "0"b; debug_sw = (shared.bug_mode | db_sw); detail_sw = debug_sw & dt_sw; long_sw = debug_sw & lg_sw; text_sw = debug_sw & tx_sw; pref_sw = debug_sw & pf_sw; if func = 4 /* prepare epilogue */ then do; page_record_ptr = addr (page_image.text_ptr -> record.page_record); unspec (page_record) = "0"b; /**** &epilogue FOR hyterm */ /**** NO CODE *//**** END hyterm */ return; end; /* func = 0 build page */ line_window_size = divide (12000, comp_dvt.min_lead, 17, 0); window_top = -line_window_size; window_bottom = divide (page.parms.length, comp_dvt.min_lead, 17, 0); if debug_sw then call ioa_ ("hyterm_writer_(^a): (pag=^a lct=^d lvl=^d:^d)", option.device, page.hdr.pageno, page_image.count, window_top, window_bottom); if page_image.count = 0 then do; call comp_report_ (4, 0, "No output lines on page " || page.hdr.pageno, addr (ctl.info), ""); return; end; on cleanup call release_window; /**/ /* preset local stuff */ auto_lead, font_in, need_devfnt, media_size, font_size, Xpos, Ypos, Yinit, font_media (*) = 0; Xpixel = comp_dvt.min_WS; Ypixel = comp_dvt.min_lead; page_record_ptr = addr (page_image.text_ptr -> record.page_record); /**** &page_init FOR hyterm */ need_wheel = mounted_wheel; /* last one mounted */ font_wheel (*) = 0; /**** END DEVICE hyterm */ rescan_page: /* (re)starting page */ /* get storage for output image */ call translator_temp_$get_segment ("compose", window_area_ptr, ercd); if ercd ^= 0 then do; call com_err_ (ercd, "compose", "Defining an output window area."); signal cleanup; return; end; Xspc, Yspc = 0; window_ptr = allocate (window_area_ptr, (window_bottom - window_top + 1) * size (tstr)); unspec (window) = "0"b; window.str_ptr = null; unspec (page_record) = "0"b; first_line = "1"b; window_level, max_level = 0; tstr_ptr = addr (window (0)); if tstr.str_ptr = null then tstr.str_ptr = allocate (window_area_ptr, 1024); tstr_line = ""; tstr.devfnt = 0; if pref_sw then call ioa_ ("^5x(preface)"); /**** &image_init FOR hyterm */ preface.in_use, preface.preface, preface.rawo = "1"b; if need_wheel ^= mounted_wheel /* need a wheel change? */ then do; preface.halt, preface.halt2 = "1"b; mounted_wheel = need_wheel; /* show wheel changed */ end; preface.nextref = "0"b; page_record_ptr = addr (preface.nextref); page_record.leng = 0; unspec (page_record.sws) = "0"b; page_record.in_use = "1"b; page_record.sws.rawo = "1"b; page_record.pwheel = mounted_wheel; hmi_value = HMI10; if first_page then do; /* emit HMI */ window_level, max_level = window_top; tstr_ptr = addr (window (window_top)); if tstr.str_ptr = null then tstr.str_ptr = allocate (window_area_ptr, 1024); medselstr, tstr_line = ""; call put_str (SET_HMI || byte (HMI10 + 1), 0); call put_; unspec (tstr) = "0"b; tstr.str_ptr = allocate (window_area_ptr, 1024); tstr_ptr = addr (window (0)); window_level, max_level = 0; first_page = "0"b; end; /**** END hyterm */ if debug_sw then call ioa_ (":iln fn/ln ch/gp lmarg rmarg width depth" || " lead s med fnt sz"); %page; image_loop: do ilin = 1 to page_image.count; /* for all given image lines */ debug_sw, detail_sw, long_sw, text_sw = "0"b; fonts_done, fonts_needed ="0"b; Lmarg, col_width, text_width = 0; if (shared.bug_mode | db_sw) then if ilin >= db_line then do; debug_sw = "1"b; if dt_sw then detail_sw = "1"b; else detail_sw = "0"b; if lg_sw then long_sw = "1"b; else long_sw = "0"b; if tx_sw then text_sw = "1"b; else text_sw = "0"b; end; /**/ /* set text pointer */ txtstrptr = page_image.line (ilin).ptr; loctxt = txtstr; /* copy txtstr */ txtlen = length (txtstr); /* and record length */ trim_font: /* trim trailing font change */ if txtlen > 7 then if substr (loctxt, txtlen - 7, 2) = "À" then do; txtlen = txtlen - 8; goto trim_font; end; lineinfoptr = addr (page_image.line (ilin).info); quad = page_image.line (ilin).quad; if debug_sw then call blat; Yspc = divide (page_image.line (ilin).depth, Ypixel, 31, 0) - Ypos - Yinit; if ilin > 1 then Yspc = Yspc - auto_lead; /* account for the "free" amount */ need_font = page_image.line (ilin).lfnt; need_size = page_image.line (ilin).lsize; if txtlen > 0 then do; if font_in ^= need_font then call set_font (need_font, need_size); if page_image.line (ilin).lmarg > 0 then Lmarg = divide (page_image.line (ilin).lmarg, Xmptstrk, 31, 0); if page_image.line (ilin).net > 0 then col_width = divide (page_image.line (ilin).net, Xmptstrk, 31, 0); if page_image.line (ilin).width > 0 then text_width = divide (page_image.line (ilin).width, Xmptstrk, 31, 0); /**** &line_init FOR hyterm */ /**** NO CODE *//**** END hyterm */ if quad = quadr | quad = quadc then /* if setting right */ do; /* or center */ Xspc = col_width - text_width; if quad = quadc /* if centering, take half */ then Xspc = round (divide (max (Xspc, 0), 2, 31, 1), 0); Lmarg = Lmarg + Xspc; end; /**/ /* if justifying and device doesnt */ if quad = just & ^comp_dvt.justifying /* and there are some gaps */ & page_image.line (ilin).gaps > 0 then call pad_block; rescan_line: if detail_sw then call ioa_ ("^5x(rescan_line: Lmarg=^f lvl=^d)", show (Lmarg * Xmptstrk, 12000), window_level); word = ""; /* clear word accumulator */ wrdwidth = 0; if Yspc ^= 0 then call plot (SHIFT_OP, 0, Ypos + Yspc); Yspc = 0; /* initial movement */ Xspc = Lmarg - Xpos; if font_in ^= page_image.line (ilin).lfnt | font_size ^= page_image.line (ilin).lsize then call set_font (page_image.line (ilin).lfnt, page_image.line (ilin).lsize); char_loop: /* process each character */ do ichr = 1 to txtlen; tchr = substr (loctxt, ichr, 1); if tchr ^= DC1 /* do any font chars */ then font_char: do; char_ndx = rank (tchr); /* fnttbl index for text char */ /* -> replacement */ repl_str_ptr = fnttbl.replptr (char_ndx); /* if there's no replacement */ if repl_str_ptr = null () then do; /* if not already reported */ if index (bad_chrs, tchr) = 0 then do; /* add to bad chars and report */ bad_chrs = bad_chrs || tchr; call comp_report_$ctlstr (2, comp_error_table_$program_error, lineinfoptr, loctxt, "Font ^a, no replacement for ""^a"" (\^.3b)", fnttbl.entry.name, tchr, unspec (tchr)); if abrt_sw /* abort if desired */ then signal null_font_char; end; goto end_chars; /* skip rest of line */ end; /**/ /* copy fnttbl data */ fcdevfnt = fnttbl.devfnt (char_ndx); /* white space? */ if fnttbl.white (char_ndx) then do; if word ^= "" /* flush current word */ then do; call put_str (word, wrdwidth); wrdwidth = 0; tstr.white = "0"b; end; fcwidth = fnttbl.units (char_ndx); Xspc = Xspc + fcwidth; if text_sw & ^pref_sw then call ioa_ ("^5x(text: ^d ^i ^f ^f ""^1a"" WS)", fcdevfnt, fcwidth, show (fcwidth * Xmptstrk, 12000), show ((Xpos + Xspc) * Xmptstrk, 12000), comp_util_$display ((tchr), 0, "0"b)); end; /**/ /* if cant put char */ else if fcdevfnt ^= tstr.devfnt & tstr.devfnt ^= 0 then do; if word ^= "" /* flush current word */ then do; call put_str (word, wrdwidth); wrdwidth = 0; tstr.white = "0"b; end; /**/ /* ..treat like whitespace */ fcwidth = fnttbl.units (char_ndx); Xspc = Xspc + fcwidth; if text_sw & ^pref_sw then call ioa_ ("^5x(text: ^d ^i ^f ^f ""^a"" ^^font)", fcdevfnt, fcwidth, show (fcwidth * Xmptstrk, 12000), show ((Xpos + Xspc + wrdwidth) * Xmptstrk, 12000), comp_util_$display ((tchr), 0, "0"b)); end; else /* not white space */ do; /* emit any accumulated motion */ if Yspc ^= 0 | (Xspc ^= 0 & txtlen ^= 0) then call plot (SHIFT_OP, Xpos + Xspc, Ypos + Yspc); Xspc, Yspc = 0; /* any PLOTs or unPLOTs? */ if index (replstr, PLOT) > 0 | index (replstr, unPLOT) > 0 then do; i = 1; /* beginning of repl string */ /* if it doesnt start with unPLOT */ /* if index (replstr, unPLOT) ^= 1 /* then if dev_stat.plotting /* then /* do; /* call put_str ((unPLOT), 0); /* dev_stat.plotting = "0"b; /* end; /* else; /**/ /* /* scan the replstr */ do while (i <= repl_str.len); j = index (substr (replstr, i), PLOT); if j > 0 /* found a PLOT */ then do; /* enter PLOT mode */ dev_stat.plotting = "1"b; i = i + j + PLOTlen - 1; j = 0; end; else /* no PLOT, look for unPLOT */ do; j = index (substr (replstr, i), unPLOT); if j > 0 /* found an unPLOT */ then do; /* leave PLOT mode */ dev_stat.plotting = "0"b; i = i + j + unPLOTlen - 1; j = 0; end; /**/ /* neither, exit loop */ else i = repl_str.len + 1; end; end; end; if tstr.devfnt = 0 then call set_media (font_in, fcdevfnt); /**** &process_text FOR hyterm */ /**** NO CODE */ /**** END hyterm */ word = word || replstr; fcwidth = fnttbl.units (char_ndx); wrdwidth = wrdwidth + fcwidth; if text_sw & ^pref_sw then call ioa_ ("^5x(text: ^d ^i ^f ^f ""^a"" -> ""^a^va"")", fcdevfnt, fcwidth, show (fcwidth * Xmptstrk, 12000), show ((Xpos + Xspc + wrdwidth) * Xmptstrk, 12000), comp_util_$display ((tchr), 0, "0"b), comp_util_$display (replstr, 0, "0"b), repl_str.len - length (rtrim (replstr)), " "); end; end font_char; else ctl_char: do; /* its a DC1 control string */ if word ^= "" /* flush current word */ then do; call put_str (word, wrdwidth); wrdwidth = 0; tstr.white = "0"b; end; DCxx_p = /* set control string overlay ptr */ addr (substr (loctxt, ichr, 1)); /* for device/writer controls */ if dcxx.ctl.type = "000"b then do; (nostrg): if long_sw then call ioa_ ("^5x(CTL: ^[wait^]^[unstrt^]^[unstop^]" || " ^a^[ Xpos=^f^;^s^])", (dcfs.type = type_wait), (dcfs.type = type_unstart), (dcfs.type = type_unstop), comp_util_$display ((substr (loctxt, ichr, dcxx.leng + 3)), 0, "0"b), (dcfs.type = type_unstart) | (dcfs.type = type_unstop), show ((Xpos + Xspc) * Xmptstrk, 12000)); /* a midpage wait? */ if dcfs.type = type_wait then do; /* any accumulated motion? */ if Xspc ^= 0 then call plot (SHIFT_OP, Xpos + Xspc, Ypos); Xspc = 0; /**/ /* user will give NL */ Yspc = Yspc - divide (12000, Ypixel, 31, 0); page_record.halt4 = "1"b; page_record.nextref = "0"b; page_record_ptr = addr (page_record.nextref); page_record.leng, tstr.last_cr = 0; unspec (page_record.sws) = "0"b; page_record.in_use = "1"b; page_record.pwheel = need_wheel; end; /**/ /* start underscore? */ if dcfs.type = type_unstart then do; unstart = max (Xpos + Xspc, Lmarg); unstring = "1"b; end; /**/ /* stop underscore? */ if dcfs.type = type_unstop then do; /* underscoring active? */ if unstring & tstr_line ^= "" & ^(page_image.line (ilin).cbar | page_image.line (ilin).mrgtxt) then do; call put_uns; unstring = "0"b; end; end; end; /**/ /* a font change? */ else if dcfs.type = type_font then do; if long_sw then do; (nostrg): debug_str = substr (loctxt, ichr, dcxx.leng + 3); call ioa_ ("^5x(CTL: font ^a)", comp_util_$display (debug_str, 0, "0"b)); end; need_font = dcfs.f; need_size = dcfs.p; call set_font (need_font, need_size); end; /**/ /* a literal? */ else if dcfs.type = type_lit then do; call put_str (substr (loctxt, ichr + 3, dcxx.leng), 0); if long_sw then do; (nostrg): debug_str = substr (loctxt, ichr, dcxx.leng + 3); call ioa_ ("^5x(CTL: literal ^a)", comp_util_$display (debug_str, 0, "0"b)); end; end; else /* its either a shift or a vector */ do; /* fetch a short X */ if (dcxx.Xctl = "01"b) then Xmpts = dcshort_val.v1; /* fetch a long X */ else if (dcxx.Xctl = "10"b) then Xmpts = dclong_val.v1; else Xmpts = 0; /* no X movement */ if (dcxx.Xctl ^= "00"b) then /* if X is given */ do; /* then Y is in v2 */ /* fetch a short Y */ if (dcxx.Yctl = "01"b) then Ympts = dcshort_val.v2; /* fetch a long Y */ else if (dcxx.Yctl = "10"b) then Ympts = dclong_val.v2; else Ympts = 0; end; else /* no X was given */ do; /* fetch a short Y */ if (dcxx.Yctl = "01"b) then Ympts = dcshort_val.v1; /* fetch a long Y */ else if (dcxx.Yctl = "10"b) then Ympts = dclong_val.v1; else Ympts = 0; end; /**/ /* shift */ if dcxx.type = "100"b then do; if font_in = 0 then call set_font (need_font, need_size); Xmov = sign (Xmpts) * round (divide (abs (Xmpts) - 4, Xmptstrk, 31, 1), 0); Xspc = Xspc + Xmov; Ymov = sign (Ympts) * divide (abs (Ympts), Ypixel, 17, 0); Yspc = Yspc + Ymov; if long_sw then do; (nostrg): debug_str = substr (loctxt, ichr, dcxx.leng + 3); call ioa_ ("^5x(CTL: shift ^f ^f (^f ^f) ^a)", show (Xmpts, 12000), show (Ympts, 12000), show (Xspc * Xmptstrk, 12000), show (Yspc,12000), comp_util_$display (debug_str, 0, "0"b)); end; end; else do; /* not shift, it must be vector */ if Xspc ^= 0 | Xmpts > 0 then if font_in ^= need_font | font_size ^= need_size then call set_font (need_font, need_size); /* need to position first? */ if Xspc ^= 0 | Yspc ^= 0 then call plot (SHIFT_OP, Xpos + Xspc, Ypos + Yspc); Xspc, Yspc = 0; Xspc = divide (Xmpts, Xmptstrk, 31, 0); Yspc = divide (Ympts, Ypixel, 31, 0); if long_sw then do; (nostrg): debug_str = substr (loctxt, ichr, dcxx.leng + 3); call ioa_ ("^5x(CTL: vector ^f ^f ^a)", show (Xmpts, 12000), show (Ympts, 12000), comp_util_$display (debug_str, 0, "0"b)); end; call plot (VECTOR_OP, Xpos + Xspc, Ypos + Yspc); Xspc, Yspc = 0; end; end; /**/ /* move to last ctl char */ ichr = ichr + dcxx.leng + 2; end ctl_char; /* end of control sequence loop */ end_chars: end char_loop; if word ^= "" /* flush last word */ then do; call put_str (word, wrdwidth); wrdwidth = 0; tstr.white = "0"b; end; if unstring /* underscoring active? */ & ^(page_image.line (ilin).cbar | page_image.line (ilin).mrgtxt) then call put_uns; /**** &line_finish FOR hyterm */ /**** NO CODE */ /**** END hyterm */ if detail_sw then do; call ioa_ ("^5x(line_finish: tstr lvl=^d ^[^^^]opn Y=^f X=^f ln=^d)", window_level, ^(tstr.open), show (Ypos * Ypixel, 12000), show (Xpos * Xmptstrk, 12000), length (tstr_line)); if tstr.open then call ioa_ ("""^a^va""", comp_util_$display (rtrim (tstr_line), 0, "0"b), length (tstr_line) - length (rtrim (tstr_line)), " "); end; end; end image_loop; finish_page: if detail_sw then call ioa_ ("^5x(finish_page:)"); /* add any trailing lead */ if page_image.line (page_image.count).white then call plot (SHIFT_OP, 0, Ypos + divide (page_image.line (page_image.count).lead, Ypixel, 31, 0)); call put_; /* flush output image */ call release_window; /* discard image just put */ if ^option.galley_opt then do; if comp_dvt.endpage ^= "0"b /* if FF is defined, then */ then /* replace last NL with it */ substr (page_record.text, page_record.leng, 1) = byte (bin (comp_dvt.endpage)); /* else run out the page with NLs */ else if Ypos < divide (page.parms.length, Ypixel, 31, 0) then do; runout = divide (page.parms.length, 12000, 31, 0) - 1 - divide (Ypos, line_window_size, 31, 0) - bin (option.stop_opt); page_record.leng = page_record.leng + runout; substr (page_record.text, page_record.leng - runout + 1, runout) = copy (NL, runout); end; /**/ /**** &page_finish FOR hyterm */ /* show this font output complete */ substr (fonts_done, font_in, 1) = "1"b; /* look for another font */ need_font = index (fonts_needed & ^fonts_done, "1"b); if need_font ^= 0 /* if another wheel is needed */ & font_wheel (need_font) ^= font_wheel (font_in) then do; page_record.nextref = "0"b; page_record_ptr = addr (page_record.nextref); font_in, tstr.devfnt = 0; /* erase current font, devfnt */ call set_font (need_font, font_size); call set_media (need_font, font_media (need_font)); goto rescan_page; end; /**** END hyterm */ end; page_record.nextref = "0"b; /* show nothing follows */ return_: if debug_sw then call ioa_ (" (hyterm_writer_)"); return; %page; footproc: entry (footref, ptr); /* PARAMETERS */ /* actual reference string */ dcl footref (3) char (*) var; dcl ptr ptr; /* -> comp_dvt */ /* &foot_proc for hyterm */ dcl 1 super like dcshort_val; dcl 1 sub like dcshort_val; dcl sschar char (5) based; super.mark, sub.mark = DC1; super.type, sub.type = type_sy; super.leng, sub.leng = dcshort1_len; super.v1 = -4500; sub.v1 = 4500; footref (1) = addr (super) -> sschar; footref (3) = addr (sub) -> sschar; if (shared.bug_mode | db_sw) then do; call ioa_ ("hyterm_writer_$footproc: ^a", comp_util_$display (footref (1) || footref (2) || footref (3), 0, "0"b)); end; return; %page; /* This routine returns a printable interpretation of a native device string */ dcl hyterm_writer_$display entry (char (*) var, fixed bin (24), bit (1)) returns (char (*) var); display: entry (dtext, dlen, noerr) returns (char (*) var); /* PARAMETERS */ dcl dtext char (*) var; /* string to be displayed */ dcl dlen fixed bin (24); /* chars scanned by this call */ dcl noerr bit (1); /* 1= dont print error messages */ /* LOCAL STORAGE */ dcl ch char (1); /* extracted text char */ dcl ct fixed bin; /* number of duplicate chars */ dcl dstr char (1020) var; /* working string */ dcl rtn_str char (16384) var;/* return string */ if dev_stat_ptr = null () then dev_stat_ptr = addr (stat_blk); if stat_blk (1) ^= -1 /* check status block */ then do; stat_blk (*) = 0; stat_blk (1) = -1; end; rtn_str = ""; /* clear return string */ ct = 0; if dev_stat.plotting then goto device_display; ch = substr (dtext, 1, 1); /* extract a char */ if ch = THIN then do; ct = verify (dtext, THIN); /* how many? */ if ct = 0 /* all the rest */ then ct = length (dtext); else ct = ct - 1; if ct > 1 /* if more than one */ then call ioa_$rsnnl ("<THN*^d>", dstr, 0, ct); else dstr = "<THN>"; rtn_str = rtn_str || dstr; end; else if ch = DEVIT then do; ct = verify (dtext, DEVIT); /* how many? */ if ct = 0 /* all the rest */ then ct = length (dtext); else ct = ct - 1; if ct > 1 /* if more than one */ then call ioa_$rsnnl ("<DVT*^d>", dstr, 0, ct); else dstr = "<DVT>"; rtn_str = rtn_str || dstr; end; else do; device_display: /* &display FOR DEVICE hyterm */ if ch = ESC then do; if index (dtext, SET_HMI) = 1 then do; ch = substr (dtext, 3, 1); call ioa_$rsnnl ("<HMI^d/120>", rtn_str, 0, rank (ch) - 1); ct = 3; end; else if index (dtext, ABS_TAB) = 1 then do; if length (dtext) < 3 then goto disp_ret; /* no column byte */ ch = substr (dtext, 3, 1); call ioa_$rsnnl ("<DT-^d>", rtn_str, 0, rank (ch)); ct = 3; end; else if index (dtext, RLF) = 1 then do; ct = verify (dtext, RLF); if ct = 0 then ct = divide (length (dtext), RLFlen, 17, 0); else ct = divide (ct - 1, RLFlen, 17, 0); if ct > 1 then call ioa_$rsnnl ("<RLF*^d>", dstr, 0, ct); else dstr = "<RLF>"; rtn_str = rtn_str || dstr; ct = ct * RLFlen; end; else if index (dtext, PLOT) = 1 then if index (dtext, unPLOT) ^= 0 then do; rtn_str = rtn_str || "<PLT["; ct = 2; i = 3; unplot: do i = i by 0 while (i <= length (dtext)); if index (substr (dtext, i), unPLOT) = 1 | index (substr (dtext, i), CR) = 1 then do; rtn_str = rtn_str || "]>"; ct = ct + 2; goto disp_ret; end; else if index (substr (dtext, i), PLOT) = 1 then do; rtn_str = rtn_str || "<PLT>"; ct = ct + 2; i = i + 2; end; else /* look for motion strings */ do; do j = 1 to dimension (plot_str, 1) by 2 while (index (substr (dtext, i), plot_str (j)) ^= 1); end; /**/ /* a stranger? */ if j > dimension (plot_str, 1) then do; ch = substr (dtext, i, 1); call ioa_$rsnnl ("<^.3b>", dstr, 0, unspec (ch)); rtn_str = rtn_str || dstr; ct = ct + 1; i = i + 1; end; else do; do k = 0 by length (plot_str (j)) while (index (substr (dtext, i + k), plot_str (j)) = 1); end; call ioa_$rsnnl ("^[(^d*^;^s^]^a^[)^]", dstr, 0, (k > length (plot_str (j))), divide (k, length (plot_str (j)), 17, 0), plot_str (j + 1), (k > length (plot_str (j)))); rtn_str = rtn_str || dstr; ct = ct + k; i = i + k; end; end; end; end; else ct = -1; end; else if ch = RLF then do; ct = verify (dtext, RLF); /* how many? */ if ct = 0 /* all the rest */ then ct = divide (length (dtext), length (RLF), 17, 0); else ct = divide (ct - 1, 2, 17, 0); if ct > 1 /* if more than one */ then call ioa_$rsnnl ("<RLF*^d>", dstr, 0, ct); else dstr = "<RLF>"; rtn_str = rtn_str || dstr; ct = (ct + bin (ct = 0)) * length (RLF); end; else if ch = VMI then do; i = i + 3; rtn_str = rtn_str || "<VMI"; rtn_str = rtn_str || ltrim( char (rank (substr (dtext, i-1, 1)) -1)); rtn_str = rtn_str || "/48>"; end; else if ch = unPLOT then do; rtn_str = rtn_str || "]>"; i = i + unPLOTlen; end; else ct = 0; /**/ /* END DEVICE hyterm */ end; disp_ret: dlen = ct; return (rtn_str); /* end of display */ %page; artproc: entry (); /**/ /* &art_proc for hyterm */ /**** NO CODE */return; %page; blat: proc; dcl blatstr char (1020) var; call ioa_$nnl (":^3d^3d/^d^12t^4d/^i^18t^5(^8f^)" || " ^[I^]^[O^]^[L^]^[C^]^[R^]^[J^]^[L^]^60t^3i ^6a ^f^/^4x", ilin, page_image.line (ilin).fileno, page_image.line (ilin).lineno, txtlen, page_image.line (ilin).gaps, show (page_image.line (ilin).lmarg, 12000), show (page_image.line (ilin).rmarg, 12000), show (page_image.line (ilin).width, 12000), show (page_image.line (ilin).depth, 12000), show (page_image.line (ilin).lead, 12000), quad & quadi, quad & quado, quad & quadl, quad & quadc, quad & quadr, quad & just, (quad = "0"b), page_image.line (ilin).lfnt, fnttbldata.ptr (page_image.line (ilin).lfnt) -> fnttbl.entry.name, show (fnttbldata.ptr (page_image.line (ilin).lfnt) -> fnttbl.entry.size, 1000), txtlen); blatstr = comp_util_$display (substr (loctxt, 1, txtlen), 0, "0"b); call ioa_ ("""^a^va""", blatstr, length (blatstr) - length (rtrim (blatstr)), " "); end blat; %page; release_window: proc; call translator_temp_$release_all_segments (window_area_ptr, 0); end release_window; %page; move_tstr: /* move tstr ptr to new window level */ proc (incr); /* PARAMETERS */ dcl incr fixed bin (31); /* amount to move */ if detail_sw then call ioa_ ("^-(move_tstr: ^d -> ^d)", window_level, window_level + incr); window_level = window_level + incr; max_level = max (max_level, window_level); tstr_ptr = addr (window (window_level)); tstr.ypos, Ypos = Ypos + incr; Xpos = tstr.xpos; tstr.open = "1"b; if tstr.str_ptr = null then tstr.str_ptr = allocate (window_area_ptr, 1024); end move_tstr; %page; show: proc (datum, scale) returns (fixed dec (11, 3)); dcl datum fixed bin (31); dcl scale fixed bin (31); return (round (dec (round (divide (datum, scale, 31, 11), 10), 11, 4), 3)); end show; %page; plot: proc (PLOT_OP, new_xpos, new_ypos); /* This routine moves the current position to (new_xpos,new_ypos), */ /* plotting or shifting according to the value of PLOT_OP. */ /* PARAMETERS */ dcl PLOT_OP bit (1); /* 0-shift; 1-vector */ dcl new_xpos fixed bin (31); /* needed horizontal position */ dcl new_ypos fixed bin (31); /* needed vertical position */ /* LOCAL STORAGE */ dcl copystr char (2048) var; dcl exit_str char (32) var; dcl old_xpos fixed bin (31); dcl old_ypos fixed bin (31); dcl penctl char (6) var; /* pen control string */ dcl pltstr char (4090) var; dcl pltwidth fixed bin (31); dcl xii fixed bin; /* working value */ dcl xmove fixed bin (31); /* X movement */ dcl ymove fixed bin (31); /* Y movement */ if new_xpos = Xpos & new_ypos = Ypos then return; xmove, ymove, pltwidth = 0; pltstr = ""; old_xpos = Xpos; /* case a VSFT changes Xpos */ old_ypos = Ypos; xmove = new_xpos - Xpos; ymove = new_ypos - Ypos; if detail_sw then call ioa_ ("^5xplot: (^[V^;S^] ^f/^f -> ^f/^f = ^f/^f)", PLOT_OP, show (Xpos * Xmptstrk, 12000), show (Ypos * Ypixel, 12000), show (new_xpos * Xmptstrk, 12000), show (new_ypos * Ypixel, 12000), show (xmove * Xmptstrk, 12000), show (ymove * Ypixel, 12000)); if ^PLOT_OP /* if a SHIFT is wanted */ then do; if ymove ^= 0 /* any Y movement? */ then do; if window_level + ymove < window_top | window_level + ymove > window_bottom then do; call comp_report_$ctlstr (2, comp_error_table_$program_error, lineinfoptr, loctxt, "Attempt to place a line off page ^a at line ^d.", page.hdr.pageno, window_level); signal comp_abort; end; call move_tstr (ymove); ymove = 0; xmove = new_xpos - Xpos; end; penctl = PENUP; /* init for pen up */ end; /**/ /* else a VECTOR is wanted */ else penctl = PENDOWN; /* init for pen down */ /**** &plot FOR hyterm */ if ^PLOT_OP then do; if xmove ^= 0 /* any X movement? */ then do; if tstr.font = 0 then tstr.font = font_in; /**/ /* any full columns? */ xii = divide (xmove * Xpixel, EN_width, 17, 0); if abs (xii) >= 1 /* if moving at least 1 SP or BSP */ then do; /**/ /* if not more than 3 SPs */ if abs (xii) <= 3 & xii > 0 & new_ypos = old_ypos /* and on the same line */ & tstr_line ^= DT1 /* and not left margin */ then do; if length (pltstr) + xii >= MAX_STR then call put_str (pltstr, 0); pltstr = pltstr || copy (" ", xii); pltwidth = pltwidth + divide (xii * EN_width, Xpixel, 31, 0); xmove = xmove - divide (xii * EN_width, Xpixel, 31, 0); end; else /* >3, direct tab to column */ do; tabcol = /* must account for current HMI */ divide (new_xpos * Xpixel * HMI10, EN_width * hmi_value, 17, 0); if tabcol > 125 /* can direct tab to only the */ then tabcol = 125; /* ..first 126 print positions */ else if tabcol < 0 then do; call comp_report_$ctlstr (3, comp_error_table_$program_error, lineinfoptr, loctxt, "A carriage column to the left of the left margin" || " stop has been encountered."); tabcol = 0; end; pltstr = pltstr || ABS_TAB || byte (tabcol + 1); pltwidth = pltwidth - Xpos + divide (tabcol * EN_width, Xpixel, 31, 0); /* overwrite ABS_TAB-only line */ if length (tstr_line) = 3 & index (tstr_line, ABS_TAB) = 1 then tstr_line = ""; xmove = new_xpos - /* how much is left? */ tabcol * divide (EN_width, Xpixel, 31, 0); end; end; end; else if tstr_line = "" & loctxt ^= "" then do; if tstr.font = 0 then tstr.font = font_in; pltstr = ABS_TAB || byte (1); pltwidth = pltwidth - Xpos; end; end; if xmove ^= 0 | ymove ^= 0 /* any movement at all? */ then do; if xmove < 0 /* leftward movement? */ then xc = BSP; /* set BS as plot char */ else xc = " "; /* set SP as plot char */ xmove = abs (xmove); if PLOT_OP then xc = xc || penctl; xcmax = divide (MAX_STR, length (xc), 17, 0); if ymove < 0 /* upward movement? */ then yc = RLF; /* set reverse LF as plot char */ else yc = LF; /* set LF as plot char */ ymove =abs (ymove); if PLOT_OP then yc = yc || penctl; ycmax = divide (MAX_STR, length (yc), 17, 0); xyc = xc || yc; xycmax = divide (MAX_STR, length (xyc), 17, 0); xiyi = min (xmove, ymove); /* amount of common movment */ xmove = max (xmove - xiyi, 0); /* remaining x movement */ ymove = max (ymove - xiyi, 0); /* remaining y movement */ if length (pltstr) + PLOTlen > MAX_STR then call put_str (pltstr, pltwidth); pltstr = pltstr || PLOT; do while (xiyi > 0); iplt = min (xiyi, xycmax); if length (pltstr) + iplt * length (xyc) > MAX_STR then call put_str (pltstr, pltwidth); pltstr = pltstr || copy (xyc, iplt); pltwidth = pltwidth + sign (xmove) * iplt; xiyi = xiyi - iplt; end; do while (xmove > 0); iplt = min (xmove, xcmax); if length (pltstr) + iplt * length (xc) > MAX_STR then call put_str (pltstr, pltwidth); pltstr = pltstr || copy (xc, iplt); pltwidth = pltwidth + sign (xmove) * iplt; xmove = xmove - iplt; end; do while (ymove > 0); iplt = min (ymove, ycmax); if length (pltstr) + iplt * length (yc) > MAX_STR then call put_str (pltstr, pltwidth); pltstr = pltstr || copy (yc, iplt); ymove = ymove - iplt; end; pltstr = pltstr || unPLOT; end; /**** END hyterm */ plot_return: if length (pltstr) > 0 then call put_str (pltstr, pltwidth); /* Xpos, tstr.xpos = new_xpos;*/ if detail_sw then call ioa_ ("^-(plot: ^f/^f lvl=^d ^[^^^]opn^[ W^])", show (Xpos * Xmptstrk, 12000), show (Ypos * Ypixel, 12000), window_level, ^tstr.open, tstr.white); /* Xplt, Yplt = 0; /* motion used */ end plot; %page; pad_block: proc; /**/ /* these two values in fixed dec so round off doesnt affect pad placement. */ /* dcl /* ( igap, /* gap counter for padding */ /* padeach /* padding interval */ /* ) fixed dec (11, 3);*/ dcl ( igap, /* gap counter for padding */ padeach /* padding interval */ ) fixed bin; dcl gaps fixed bin; /* gap count for line */ dcl jl_ptr ptr; /* pointer to the justified line */ dcl just_line char (1020) var; /* pads per gap */ dcl pads (page_image.line (ilin).gaps) fixed bin; dcl padsize fixed bin; /* pad space in pixels */ dcl 1 pad_ctl like dclong_val; /* for inserting pads */ dcl pad_ctl_ptr ptr; dcl pad_string char (7) based (pad_ctl_ptr); dcl SP_DC1 char (2) int static options (constant) init (" "); just_line = ""; /* clear the justified line */ jl_ptr = addr (just_line); /* and set pointer for the overlay */ if font_in ^= need_font then call set_font (need_font, need_size); if col_width < 0 then col_width = divide (page_image.line (ilin).net, Xmptstrk, 31, 0); if text_width > 0 then text_width = divide (page_image.line (ilin).width, Xmptstrk, 31, 0); if Xpixel ^= EN_width /* set up pad_ctl string */ then do; pad_ctl.mark = DC1; pad_ctl.type = type_slx; pad_ctl.leng = dclong1_len; pad_ctl.v2 = 0; pad_ctl_ptr = addr (pad_ctl); end; gaps = page_image.line (ilin).gaps; padsize = max (0, col_width - text_width); /* fill in common amount */ pads = fnttbl.units (rank (STROKE)) * divide ( divide (padsize, gaps, 17, 0), fnttbl.units (rank (STROKE)), 17, 0); /* then get the leftover amount */ padsize = padsize - pads (1) * gaps; if long_sw then call ioa_$nnl ("^5x(pad_block: l/w/r=^f/^f/^f gp=^i pd=^i+^i", show (Lmarg * Xmptstrk, 12000), show (text_width * Xmptstrk, 12000), show (page_image.line (ilin).rmarg, 12000), gaps, pads (1), padsize); do while (padsize > 0); /* use up any leftovers */ padeach = /* pad interval */ max (round (divide (gaps * fnttbl.units (rank (STROKE)), padsize, 17, 1), 0), 1); igap = max (round (divide (gaps * fnttbl.units (rank (STROKE)), 2 * padsize, 17, 1), 0), 1); do igap = igap to gaps by padeach while (padsize > 0); pads (igap) = pads (igap) + fnttbl.units (rank (STROKE)); padsize = padsize - fnttbl.units (rank (STROKE)); end; end; if long_sw then call ioa_ ("^(,^i^))", pads); ichr = verify (loctxt, " "); /* start at front of text */ if ichr > 1 then just_line = just_line || copy (EN, ichr - 1); do j = 1 to gaps; try_again: /* find word boundary */ k = search (substr (loctxt, ichr, txtlen - ichr + 1), SP_DC1) - 1; if k < 0 /* MGOD! gap count is too large */ then do; if detail_sw then do; call ioa_$nnl ("gap=^i ", gaps); call blat; end; goto gap_exit; end; /**/ /* copy word */ just_line = just_line || substr (loctxt, ichr, k); ichr = ichr + k; /* step over "word" */ /* did we find a control? */ if substr (loctxt, ichr, 1) = DC1 then do; /* set pointer */ DCxx_p = addr (substr (loctxt, ichr)); k = dcxx.leng + 3; /* and control string length */ /* copy ctl str */ just_line = just_line || substr (loctxt, ichr, k); ichr = ichr + k; goto try_again; end; ichr = ichr + 1; /* skip the wordspace */ if Xpixel = EN_width /* now, any excess count */ then just_line = just_line || copy (" ", pads (j)); else do; pad_ctl.v1 = pads (j) * Xmptstrk; just_line = just_line || pad_string; end; end; gap_exit: k = txtlen - ichr + 1; /* length of the last word */ /* move the last word */ just_line = just_line || substr (loctxt, ichr, k); loctxt = just_line; /* switch to the justified line */ txtlen = length (just_line); if long_sw then call ioa_ ("^a", comp_util_$display (just_line, 0, "0"b)); end pad_block; %page; put_: proc; dcl level fixed bin; dcl level_skip fixed bin; if detail_sw then call ioa_ ("^5x(put: maxlvl=^d)", max_level); level_skip = 0; if first_line then do level = window_top to -1 /* discard leading null lines */ while (^window (level).open); end; else level = window_top; dev_stat.plotting = "0"b; do level = level to max_level; tstr_ptr = addr (window (level)); /**/ if tstr.str_ptr = null then do; tstr.str_ptr = allocate (window_area_ptr, 1024); tstr_line = ""; end; /**/ /* &put FOR DEVICE hyterm */ /* for full/partial lines */ do level_skip = 0 to line_window_size - 1 while (^window (level + level_skip + 1).open); end; /**/ /* need a FNL? */ if level_skip >= line_window_size - 1 | level = max_level then do; if ^first_page then tstr_line = tstr_line || NL; level_skip = line_window_size - 1; end; else /* need a incr NL */ do; if tstr_line = DT1 then tstr_line = PLOT; else tstr_line = tstr_line || PLOT; tstr_line = tstr_line || copy (NL, level_skip +1); tstr_line = tstr_line || unPLOT; end; /**/ /* END DEVICE hyterm */ if detail_sw then call ioa_ ("^7x(lvl=^d ^d+^d=^d ""^a"")", level, page_record.leng, length (tstr_line), page_record.leng + length (tstr_line), comp_util_$display (tstr_line, 0, "0"b)); level = level + level_skip; tstr.last_cr = 0; page_record.leng = page_record.leng + length (tstr_line); substr (page_record.text, page_record.leng - length (tstr_line) + 1, length (tstr_line)) = tstr_line; end; if page_record.leng > 0 then page_record.in_use = "1"b; Ypos = tstr.ypos; end put_; %page; put_str: proc (string, width); dcl string char (4090) var; /* string to put */ dcl width fixed bin (31); /* string width */ dcl (i, j) fixed bin; dcl new_len fixed bin; dcl old_len fixed bin; dcl pos fixed bin (31); /* current position */ if tstr.devfnt ^= need_devfnt then call set_media (font_in, need_devfnt); old_len = length (tstr_line) - tstr.last_cr; new_len = old_len + length (string); if new_len > MAX_STR then do; end; if detail_sw then do; debug_str = comp_util_$display (string, 0, "0"b); call ioa_ ( "^5x(put_str: lvl=^d X=^f+^f=^f ^d+^d=^d^[(^d)^;^s^] ""^a^va"")", window_level, show (Xpos * Xmptstrk, 12000), show (width * Xmptstrk, 12000), show ((Xpos + width) * Xmptstrk, 12000), old_len, length (string), new_len, (tstr.last_cr > 0), length (tstr_line) + length (string), debug_str, length (debug_str) - length (rtrim (debug_str)), " "); end; tstr_line = tstr_line || string; Xpos, tstr.xpos = Xpos + width; string = ""; width = 0; tstr.open = "1"b; end put_str; %page; put_uns: proc; dcl Y_offs fixed bin (31); /* baseline offset */ dcl unslen fixed bin (31);/* length of underscore */ Y_offs = 0; unslen = Xpos + Xspc - unstart; if unslen > 0 then do; if detail_sw then call ioa_ ("^5x(put_uns: ^f)", show (unslen * Xmptstrk, 12000)); Xspc = Xspc - unslen; /* go to start */ Xspc = max (Xspc - 3, -(Xpos + Xspc)); Y_offs = 3; call plot (SHIFT_OP, Xpos + Xspc, Ypos + Y_offs); Xspc, Yspc = 0; /**/ /* put the underscore */ call plot (VECTOR_OP, Xpos + unslen, Ypos); call plot (SHIFT_OP, Xpos + 3600, Ypos - 3000); unstart = Lmarg; if detail_sw then call ioa_ ("^-(put_uns)"); end; end put_uns; %page; set_font: proc (new_font, new_size); /* PARAMETERS */ dcl new_font fixed bin; /* desired font index */ dcl new_size fixed bin (31); /* desired pointsize */ dcl chng bit (1); chng = (font_in ^= new_font | font_size ^= new_size); if chng then do; if detail_sw then do; if font_in = 0 then call ioa_$nnl ("^5x(set_font: 0 - 0. -->"); else call ioa_$nnl ("^5x(set_font: ^i ^a ^f -->", font_in, fnttbldata.ptr (font_in) -> fnttbl.entry.name, show (font_size, 1000)); end; font_in = new_font; end; fnttbl_ptr = fnttbldata.ptr (font_in); substr (fonts_needed, font_in, 1) = "1"b; need_devfnt = fnttbl.devfnt (32); /**** &set_font FOR hyterm */ font_media (font_in) = need_devfnt; need_wheel, font_wheel (font_in) = /* needed wheel */ bin (unspec (substr (medsel (need_devfnt), 1, 1))); /**** END hyterm */ if siztbl.ct = 1 then font_size, new_size = siztbl.size (1); else font_size = new_size; Xmptstrk = divide (font_size, fnttbl.rel_units, 31, 0); EM_width = divide (font_size * fnttbl.units (rank (EM)), fnttbl.rel_units, 31, 10); EN_width = divide (font_size * fnttbl.units (rank (EN)), fnttbl.rel_units, 31, 10); THIN_width = divide (font_size * fnttbl.units (rank (THIN)), fnttbl.rel_units, 31, 10); if (detail_sw | long_sw) & chng then do; call ioa_ (" ^i ^a ^f Xscl=^d)", new_font, fnttbldata.ptr (new_font) -> fnttbl.entry.name, show (font_size, 1000), Xmptstrk); if long_sw then call ioa_ ("^-(HUGE=^d EM=^d EN=^d THK=^d MED=^d " || "THN=^d HAIR=^d STRK=^d)", fnttbl.units (rank (HUGE)), fnttbl.units (rank (EM)),fnttbl.units (rank (EN)), fnttbl.units (rank (THICK)),fnttbl.units (rank (MEDIUM)), fnttbl.units (rank (THIN)),fnttbl.units (rank (DEVIT)), fnttbl.units (rank (STROKE))); end; end set_font; %page; set_media: proc (media_font, new_devfnt); /* PARAMETERS */ dcl media_font fixed bin; /* font needing the media */ dcl new_devfnt fixed bin; /* wanted device font */ /* LOCAL STORAGE */ dcl chng bit (1); /* 1= media or size has to change */ dcl med_chng bit (1); /* 1= media has to change */ dcl size_chng bit (1); /* 1= size has to change */ dcl temp_r bit (18); med_chng = tstr.devfnt ^= new_devfnt; size_chng = media_size ^= font_size; chng = med_chng | size_chng; if detail_sw & chng then call ioa_$nnl ("^5x(set_media: siz=^f med=^d --> siz=^f med=^d ", show (media_size, 1000), tstr.devfnt, show (font_size, 1000), new_devfnt); /**** &set_media FOR hyterm */ mounted_wheel = need_wheel; /* needed wheel now mounted */ if hmi_code ^= substr (medsel (new_devfnt), 2, 1) then do; hmi_code = substr (medsel (new_devfnt), 2, 1); medselstr = SET_HMI || hmi_code; hmi_value = rank (hmi_code) - 1; end; /**** END hyterm */ /**** &set_ps FOR hyterm */ media_size = 7200; /**** END hyterm */ if detail_sw & chng then call ioa_ ("sel=""^a"")", comp_util_$display ((medsel (new_devfnt)), 0, "0"b)); /* if not in media needed */ if med_chng /* ...change to it */ then do; tstr.devfnt = new_devfnt; tstr.font = media_font; end; end set_media; /* device hyterm "other_procs" */ /**** NO CODE */dcl db_sw bit (1) aligned static init ("0"b); dbn: entry;db_sw = "1"b;goto db_join; dbf: entry;db_sw = "0"b;return; dcl tx_sw bit (1) aligned static init ("0"b); txn: entry; tx_sw = "1"b; goto db_join; txf: entry; tx_sw = "0"b; return; dcl lg_sw bit (1) aligned static init ("0"b); lgn: entry; lg_sw = "1"b; goto db_join; lgf: entry; lg_sw = "0"b; return; dcl pf_sw bit (1) aligned static init ("0"b); pfn: entry; pf_sw = "1"b; return; pff: entry; pf_sw = "0"b; return; dcl abrt_sw bit (1) aligned static init ("0"b); abrtn: entry; abrt_sw = "1"b; return; abrtf: entry; abrt_sw = "0"b; return; dcl dt_sw bit (1) aligned static init ("0"b); dtn: entry;dt_sw = "1"b;goto db_join; dtf: entry;dt_sw = "0"b;return; alln: entry; db_sw, dt_sw, lg_sw = "1"b; db_join: dcl db_line fixed bin static init (0); dcl com_err_ entry options (variable); dcl cu_$arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin (35)); dcl arg char (argl) based (argp); dcl argl fixed bin; dcl argp ptr; dcl ercd fixed bin (35); dcl error_table_$noarg fixed bin (35) ext static; db_line = 0; call cu_$arg_ptr (1, argp, argl, ercd); if ercd ^= 0 then do; if ercd ^= error_table_$noarg then call com_err_ (ercd, "hyterm_writer_"); return; end; db_line = convert (db_line, arg); return; allf: entry; db_sw, lg_sw, tx_sw, pf_sw, dt_sw, abrt_sw = "0"b; return; %page; /* This one include file contains all the compose includes necessary for an */ /* output writer */ % include comp_outproc; end hyterm_writer_;  hyterm_writer_.pl1.xdw 04/23/85 1257.6rew 04/23/85 0911.9 135963 /* *********************************************************** * * * * * Copyright, (C) Honeywell Information Systems Inc., 1981 * * Copyright, (C) Honeywell Information Systems Inc., 1980 * * * * * *********************************************************** */ &ext device=hyterm&; &ext devclass=diablo&; &ext notes= /* This is a 60x48 Diablo type device. It supports plot mode and adjustable */ /* HMI values. Most artwork is done via plot mode. Horizontal lines are */ /* implemented with HMI=2/120 then "."'s. */ &; &ext BSP=&.&; &ext FSP=&. &; &ext HLF=U&; &ext HRLF=D&; &ext LF=&. &; &ext RLF=&. &; &ext unPLTcr=1&; &ext VMI=&; &ext VMIn=<ESC>036&; &ext dcls=&+ dcl ( ABS_TAB char (2) init (" "), DT1 char (3) init (" "), PENDOWN char (1) init ("."), PENUP char (1) init (" "), PLOT char (2) init ("3"), PLOTlen fixed bin init (2), RLF char (2) init (" "), RLFlen fixed bin init (2), SET_HMI char (2) init (""), unPLOT char (4) var init ("4"), unPLOTlen fixed bin init (2), /* 10pitch hmi value */ HMI10 fixed bin init (12) ) aligned static options (constant); dcl BELc char (17) var; /* BEL||HT||PADs for wheel change */ dcl 1 dev_stat based (dev_stat_ptr), 2 inited fixed bin (35), 2 sw, 3 plotting bit (1) unal, /* 1- in regular plot mode */ 3 MBZ bit (35) unal, 2 hmi_code char (1), /* current device HM character */ 2 hmi_value fixed bin; /* current device HM value */ dcl err_ct fixed bin; dcl err_sw bit (1); dcl font_wheel (36) fixed bin; /* wheels needed for fonts */ dcl mounted_wheel /* print wheel on machine */ fixed bin static init (0); dcl need_wheel fixed bin; /* print wheel needed */ dcl 1 preface aligned like page_record based (page_record_ptr); dcl iplt fixed bin; /* number of *c's to emit */ dcl MAX_STR fixed bin static options (constant) init (2048); dcl plot_str (40) char (8) var static options (constant) init /**/ ("&FSP&LF.", "rd.", "&FSP&RLF.", "ru.", "&FSP.", "r.", "&BSP&LF.", "ld.", "&BSP&RLF.", "lu.", "&BSP.", "l.", "&LF.", "d.", "&RLF.", "u.", ".", ".", "&FSP&LF", "rd", "&FSP&RLF", "ru", "&FSP", "r", "&BSP&LF", "ld", "&BSP&RLF", "lu", "&BSP", "l", "&LF", "d", "&RLF", "u", " ", "HT", "&HLF", "d/2", "&HRLF", "u/2" ); dcl rst char (8) var; /* replacement string */ dcl VMI char (4) var static options (constant) init ("&VMI"); dcl tabcol fixed bin; /* target for direct tabbing */ dcl xc char (2) var; /* horizontal plot character(s) */ dcl xcmax fixed bin; dcl xyc char (6) var; /* common plot character(s) */ dcl xiyi fixed bin; /* amount of common movement */ dcl xycmax fixed bin; dcl yc char (3) var; /* vertical plot character(s) */ dcl ycmax fixed bin; dcl (abs, char, collate9, copy, dec, ltrim, round, rtrim, search, sign, verify) builtin; &; &ext file_init= &. max_revlead = -12000; /* dont back up more than 1 line */ if option.nobell_opt then BELc = " "; else BELc = " "; mounted_wheel = 1; /* assume ASCII wheel is mounted */ &; &+ &ext page_init=&+ need_wheel = mounted_wheel; /* last one mounted */ font_wheel (*) = 0; &;&+ &ext image_init=&+ preface.in_use, preface.preface, preface.rawo = "1"b; if need_wheel ^= mounted_wheel /* need a wheel change? */ then do; preface.halt, preface.halt2 = "1"b; mounted_wheel = need_wheel; /* show wheel changed */ end; preface.nextref = "0"b; page_record_ptr = addr (preface.nextref); page_record.leng = 0; unspec (page_record.sws) = "0"b; page_record.in_use = "1"b; page_record.sws.rawo = "1"b; page_record.pwheel = mounted_wheel; hmi_value = HMI10; if first_page then do; /* emit HMI */ window_level, max_level = window_top; tstr_ptr = addr (window (window_top)); if tstr.str_ptr = null then tstr.str_ptr = allocate (window_area_ptr, 1024); medselstr, tstr_line = ""; call put_str (SET_HMI || byte (HMI10 + 1), 0); call put_; unspec (tstr) = "0"b; tstr.str_ptr = allocate (window_area_ptr, 1024); tstr_ptr = addr (window (0)); window_level, max_level = 0; first_page = "0"b; end; &;&+ &ext set_font= font_media (font_in) = need_devfnt; need_wheel, font_wheel (font_in) = /* needed wheel */ bin (unspec (substr (medsel (need_devfnt), 1, 1))); &;&+ &ext set_media=&+ mounted_wheel = need_wheel; /* needed wheel now mounted */ if hmi_code ^= substr (medsel (new_devfnt), 2, 1) then do; hmi_code = substr (medsel (new_devfnt), 2, 1); medselstr = SET_HMI || hmi_code; hmi_value = rank (hmi_code) - 1; end; &; &ext set_ps=&. media_size = 7200; &;&+ &ext preput=&. if dev_stat.plotting /* if already plotting */ then do; /* does repl start with PLOT? */ if index (repl.str, PLOT) = 1 then do; /* strip it off */ substr (repl.str, 1, repl.len - PLOTlen) = substr (repl.str, PLOTlen) + 1, repl.len - PLOTlen); repl.len = repl.len - PLOTlen); end; else do; substr (tstr_line, tnxt, unPLOTlen) = unPLOT; tstr.len = tstr.len + unPLOTlen; tnxt = tstr.len + 1; dev_stat.plotting = "0"b; if long_sw then call ioa_ ("^5x(unplot: X=0. Y=0. ""]>"""); end; end; else if index (repl.str, PLOT) = 1 && substr (repl.str, repl.len - unPLOTlen) ^= unPLOT then dev_stat.plotting = "1"b; &; &ext page_finish=&. /* show this font output complete */ substr (fonts_done, font_in, 1) = "1"b; /* look for another font */ need_font = index (fonts_needed && ^fonts_done, "1"b); if need_font ^= 0 /* if another wheel is needed */ && font_wheel (need_font) ^= font_wheel (font_in) then do; page_record.nextref = "0"b; page_record_ptr = addr (page_record.nextref); font_in, tstr.devfnt = 0; /* erase current font, devfnt */ call set_font (need_font, font_size); call set_media (need_font, font_media (need_font)); goto rescan_page; end; &; &ext put=&+ /* for full/partial lines */ do level_skip = 0 to line_window_size - 1 while (^window (level + level_skip + 1).open); end; /**/ /* need a FNL? */ if level_skip >= line_window_size - 1 | level = max_level then do; if ^first_page then tstr_line = tstr_line || NL; level_skip = line_window_size - 1; end; else /* need a incr NL */ do; if tstr_line = DT1 then tstr_line = PLOT; else tstr_line = tstr_line || PLOT; tstr_line = tstr_line || copy (NL, level_skip +1); tstr_line = tstr_line || unPLOT; end; &;&+ &ext put_str= /* changing HMI? */ if index (str, SET_HMI) = 1 /* change pitch if needed */ then if hmi_code ^= substr (str, 3, 1) then hmi_code = substr (str, 3, 1); record_body.leng = record_body.leng + length (str); substr (record_body.text, record_body.leng - length (str) + 1, length (str)) = str; &;&+ &ext display= if ch = ESC then do; if index (dtext, SET_HMI) = 1 then do; ch = substr (dtext, 3, 1); call ioa_$rsnnl ("<HMI^d/120>", rtn_str, 0, rank (ch) - 1); ct = 3; end; else if index (dtext, ABS_TAB) = 1 then do; if length (dtext) < 3 then goto disp_ret; /* no column byte */ ch = substr (dtext, 3, 1); call ioa_$rsnnl ("<DT-^d>", rtn_str, 0, rank (ch)); ct = 3; end; else if index (dtext, RLF) = 1 then do; ct = verify (dtext, RLF); if ct = 0 then ct = divide (length (dtext), RLFlen, 17, 0); else ct = divide (ct - 1, RLFlen, 17, 0); if ct > 1 then call ioa_$rsnnl ("<RLF*^d>", dstr, 0, ct); else dstr = "<RLF>"; rtn_str = rtn_str || dstr; ct = ct * RLFlen; end; else if index (dtext, PLOT) = 1 then if index (dtext, unPLOT) ^= 0 then do; rtn_str = rtn_str || "<PLT["; ct = 2; i = 3; unplot: do i = i by 0 while (i <= length (dtext)); if index (substr (dtext, i), unPLOT) = 1 | index (substr (dtext, i), CR) = 1 then do; rtn_str = rtn_str || "]>"; ct = ct + 2; goto disp_ret; end; else if index (substr (dtext, i), PLOT) = 1 then do; rtn_str = rtn_str || "<PLT>"; ct = ct + 2; i = i + 2; end; else /* look for motion strings */ do; do j = 1 to dimension (plot_str, 1) by 2 while (index (substr (dtext, i), plot_str (j)) ^= 1); end; /**/ /* a stranger? */ if j > dimension (plot_str, 1) then do; ch = substr (dtext, i, 1); call ioa_$rsnnl ("<^.3b>", dstr, 0, unspec (ch)); rtn_str = rtn_str || dstr; ct = ct + 1; i = i + 1; end; else do; do k = 0 by length (plot_str (j)) while (index (substr (dtext, i + k), plot_str (j)) = 1); end; call ioa_$rsnnl ("^[(^d*^;^s^]^a^[)^]", dstr, 0, (k > length (plot_str (j))), divide (k, length (plot_str (j)), 17, 0), plot_str (j + 1), (k > length (plot_str (j)))); rtn_str = rtn_str || dstr; ct = ct + k; i = i + k; end; end; end; end; else ct = -1; end; else if ch = RLF then do; ct = verify (dtext, RLF); /* how many? */ if ct = 0 /* all the rest */ then ct = divide (length (dtext), length (RLF), 17, 0); else ct = divide (ct - 1, 2, 17, 0); if ct > 1 /* if more than one */ then call ioa_$rsnnl ("<RLF*^d>", dstr, 0, ct); else dstr = "<RLF>"; rtn_str = rtn_str || dstr; ct = (ct + bin (ct = 0)) * length (RLF); end; else if ch = VMI then do; i = i + 3; rtn_str = rtn_str || "<VMI"; rtn_str = rtn_str || ltrim( char (rank (substr (dtext, i-1, 1)) -1)); rtn_str = rtn_str || "/48>"; end; else if ch = unPLOT then do; rtn_str = rtn_str || "]>"; i = i + unPLOTlen&.; end; else ct = 0; &; &ext foot_proc= dcl 1 super like dcshort_val; dcl 1 sub like dcshort_val; dcl sschar char (5) based; super.mark, sub.mark = DC1; super.type, sub.type = type_sy; super.leng, sub.leng = dcshort1_len; super.v1 = -4500; sub.v1 = 4500; footref (1) = addr (super) -> sschar; footref (3) = addr (sub) -> sschar; &; &ext plot= if ^PLOT_OP then do; if xmove ^= 0 /* any X movement? */ then do; if tstr.font = 0 then tstr.font = font_in; /**/ /* any full columns? */ xii = divide (xmove * Xpixel, EN_width, 17, 0); if abs (xii) >= 1 /* if moving at least 1 SP or BSP */ then do; /**/ /* if not more than 3 SPs */ if abs (xii) <= 3 && xii > 0 && new_ypos = old_ypos /* and on the same line */ && tstr_line ^= DT1 /* and not left margin */ then do; if length (pltstr) + xii >= MAX_STR then call put_str (pltstr, 0); pltstr = pltstr || copy (" ", xii); pltwidth = pltwidth + divide (xii * EN_width, Xpixel, 31, 0); xmove = xmove - divide (xii * EN_width, Xpixel, 31, 0); end; else /* >3, direct tab to column */ do; tabcol = /* must account for current HMI */ divide (new_xpos * Xpixel * HMI10, EN_width * hmi_value, 17, 0); if tabcol > 125 /* can direct tab to only the */ then tabcol = 125; /* ..first 126 print positions */ else if tabcol < 0 then do; call comp_report_$ctlstr (3, comp_error_table_$program_error, lineinfoptr, loctxt, "A carriage column to the left of the left margin" || " stop has been encountered."); tabcol = 0; end; pltstr = pltstr || ABS_TAB || byte (tabcol + 1); pltwidth = pltwidth - Xpos + divide (tabcol * EN_width, Xpixel, 31, 0); /* overwrite ABS_TAB-only line */ if length (tstr_line) = 3 && index (tstr_line, ABS_TAB) = 1 then tstr_line = ""; xmove = new_xpos - /* how much is left? */ tabcol * divide (EN_width, Xpixel, 31, 0); end; end; end; else if tstr_line = "" && loctxt ^= "" then do; if tstr.font = 0 then tstr.font = font_in; pltstr = ABS_TAB || byte (1); pltwidth = pltwidth - Xpos; end; end; if xmove ^= 0 | ymove ^= 0 /* any movement at all? */ then do; if xmove < 0 /* leftward movement? */ then xc = BSP; /* set BS as plot char */ else xc = " "; /* set SP as plot char */ xmove = abs (xmove); if PLOT_OP then xc = xc || penctl; xcmax = divide (MAX_STR, length (xc), 17, 0); if ymove < 0 /* upward movement? */ then yc = RLF; /* set reverse LF as plot char */ else yc = LF; /* set LF as plot char */ ymove =abs (ymove); if PLOT_OP then yc = yc || penctl; ycmax = divide (MAX_STR, length (yc), 17, 0); xyc = xc || yc; xycmax = divide (MAX_STR, length (xyc), 17, 0); xiyi = min (xmove, ymove); /* amount of common movment */ xmove = max (xmove - xiyi, 0); /* remaining x movement */ ymove = max (ymove - xiyi, 0); /* remaining y movement */ if length (pltstr) + PLOTlen > MAX_STR then call put_str (pltstr, pltwidth); pltstr = pltstr || PLOT; do while (xiyi > 0); iplt = min (xiyi, xycmax); if length (pltstr) + iplt * length (xyc) > MAX_STR then call put_str (pltstr, pltwidth); pltstr = pltstr || copy (xyc, iplt); pltwidth = pltwidth + sign (xmove) * iplt; xiyi = xiyi - iplt; end; do while (xmove > 0); iplt = min (xmove, xcmax); if length (pltstr) + iplt * length (xc) > MAX_STR then call put_str (pltstr, pltwidth); pltstr = pltstr || copy (xc, iplt); pltwidth = pltwidth + sign (xmove) * iplt; xmove = xmove - iplt; end; do while (ymove > 0); iplt = min (ymove, ycmax); if length (pltstr) + iplt * length (yc) > MAX_STR then call put_str (pltstr, pltwidth); pltstr = pltstr || copy (yc, iplt); ymove = ymove - iplt; end; pltstr = pltstr || unPLOT; end; &; &comp_dev_writer()