COMPILATION LISTING OF SEGMENT calcomp_compatible_subrs_ Compiled by: Multics PL/I Compiler, Release 27d, of October 11, 1982 Compiled at: Honeywell LISD Phoenix, System M Compiled on: 11/18/82 1634.4 mst Thu Options: optimize map 1 /* *********************************************************** 2* * * 3* * * 4* * Copyright, (C) Honeywell Information Systems Inc., 1981 * 5* * * 6* * * 7* *********************************************************** */ 8 9 /* ****************************************************** 10* * * 11* * * 12* * Copyright (c) 1972 by Massachusetts Institute of * 13* * Technology and Honeywell Information Systems, Inc. * 14* * * 15* * * 16* ****************************************************** */ 17 18 calcomp_compatible_subrs_: ccs_: proc; 19 20 return; 21 22 /* calcomp_compatible_subrs_ has the same entries and calling sequences as routines 23* written by CalComp for other machines. It uses the Multics Graphics System 24* to perform much the same actions as the original calls performed. */ 25 /* Note that we do our own scaling as opposed to having the graphic system 26* do it for us. The combination of a large screen_size_factor and a small 27* user-supplied movement or height factor works, just as long as the user-supplied 28* movement or height factor is not too small to be represented in 29* 6 fractional bits of precision, which is all Graphics Code allows. Too many 30* things were being pure lost due to this screen_size hackery. */ 31 /* Written 10/24/74 by C. D. Tavares */ 32 /* Modified 03/03/75 by CDT to use multilevel list strategy, for users with LONG calling patterns 33* for creating BIG pictures. */ 34 /* Modified 04/15/75 by CDT to fix undersized allocation, and make the allocation a call to 35* cu_$grow_stack_frame instead. */ 36 /* Modified 10/20/75 by CDT to rename calcomp_compatible_subrs_.pgs to ccs_special_symbols_.pgs */ 37 /* Modified 04/12/77 by CDT to fix entrypoint symbol from "remembering" old symbol nodes without 38* regard to whether the size was the same or not */ 39 /* Modified 03/26/80 by CDT to fix bug whereby origin was not getting reset if 40* the pen happened to already be there-- also changed com_err_ calls to sub_err_ */ 41 /* Last modified 02/25/81 by Steve Carlock to use a "new" chaining method which */ 42 /* eliminates the need to remember active modes from one sublist to another */ 43 1 1 /* *************** BEGIN INCLUDE FILE gm_entry_dcls.incl.pl1 *************** */ 1 2 1 3 dcl (graphic_manipulator_$init, 1 4 gm_$init) entry (fixed bin (35)); 1 5 1 6 dcl (graphic_manipulator_$segp, 1 7 gm_$segp) entry (pointer, fixed bin (35)); 1 8 1 9 dcl (graphic_manipulator_$create_position, 1 10 gm_$create_position, 1 11 graphic_manipulator_$cpos, 1 12 gm_$cpos) entry (fixed bin, float bin (27), float bin (27), float bin (27), fixed bin (35)) returns (fixed bin (18)); 1 13 1 14 dcl (graphic_manipulator_$create_mode, 1 15 gm_$create_mode, 1 16 graphic_manipulator_$cmode, 1 17 gm_$cmode) entry (fixed bin, fixed bin, fixed bin (35)) returns (fixed bin (18)); 1 18 1 19 dcl (graphic_manipulator_$create_scale, 1 20 gm_$create_scale, 1 21 graphic_manipulator_$cscale, 1 22 gm_$cscale) entry (float bin (27), float bin (27), float bin (27), fixed bin (35)) returns (fixed bin (18)); 1 23 1 24 dcl (graphic_manipulator_$create_rotation, 1 25 gm_$create_rotation, 1 26 graphic_manipulator_$crot, 1 27 gm_$crot) entry (float bin (27), float bin (27), float bin (27), fixed bin (35)) returns (fixed bin (18)); 1 28 1 29 dcl (graphic_manipulator_$create_clip, 1 30 gm_$create_clip, 1 31 graphic_manipulator_$cclip, 1 32 gm_$cclip) entry (float bin (27), float bin (27), float bin (27), float bin (27), float bin (27), float bin (27), 1 33 fixed bin (35)) returns (fixed bin (18)); 1 34 1 35 dcl (graphic_manipulator_$create_color, 1 36 gm_$create_color, 1 37 graphic_manipulator_$ccolor, 1 38 gm_$ccolor) entry (fixed bin, fixed bin, fixed bin, fixed bin (35)) returns (fixed bin (18)); 1 39 1 40 dcl (graphic_manipulator_$create_text, 1 41 gm_$create_text, 1 42 graphic_manipulator_$ctext, 1 43 gm_$ctext) entry (fixed bin, fixed bin, char (*), fixed bin (35)) returns (fixed bin (18)); 1 44 1 45 dcl (graphic_manipulator_$create_data, 1 46 gm_$create_data, 1 47 graphic_manipulator_$cdata, 1 48 gm_$cdata) entry (fixed bin, bit (*), fixed bin (35)) returns (fixed bin (18)); 1 49 1 50 dcl (graphic_manipulator_$create_list, 1 51 gm_$create_list, 1 52 graphic_manipulator_$clist, 1 53 gm_$clist) entry (fixed bin (18) dimension (*), fixed bin, fixed bin (35)) returns (fixed bin (18)); 1 54 1 55 dcl (graphic_manipulator_$create_array, 1 56 gm_$create_array, 1 57 graphic_manipulator_$carray, 1 58 gm_$carray) entry (fixed bin (18) dimension (*), fixed bin, fixed bin (35)) returns (fixed bin (18)); 1 59 1 60 dcl (graphic_manipulator_$assign_name, 1 61 gm_$assign_name) entry (char (*), fixed bin (18), fixed bin (35)) returns (fixed bin (18)); 1 62 1 63 dcl (graphic_manipulator_$find_structure, 1 64 gm_$find_structure, 1 65 graphic_manipulator_$fstruc, 1 66 gm_$fstruc) entry (char (*), fixed bin (18), fixed bin (35)) returns (fixed bin (18)); 1 67 1 68 dcl (graphic_manipulator_$add_element, 1 69 gm_$add_element) entry (fixed bin (18), fixed bin, fixed bin (18), fixed bin (35)); 1 70 1 71 dcl (graphic_manipulator_$replace_element, 1 72 gm_$replace_element) entry (fixed bin (18), fixed bin, fixed bin (18), fixed bin (35)) returns (fixed bin (18)); 1 73 1 74 dcl (graphic_manipulator_$replace_node, 1 75 gm_$replace_node) entry (fixed bin (18), fixed bin (18), fixed bin (35)); 1 76 1 77 dcl (graphic_manipulator_$remove_symbol, 1 78 gm_$remove_symbol) entry (char (*), fixed bin (35)); 1 79 1 80 dcl (graphic_manipulator_$replicate, 1 81 gm_$replicate) entry (fixed bin (18), fixed bin (35)) returns (fixed bin (18)); 1 82 1 83 dcl (graphic_manipulator_$examine_type, 1 84 gm_$examine_type) entry (fixed bin (18), bit (1) aligned, fixed bin, fixed bin (35)); 1 85 1 86 dcl (graphic_manipulator_$examine_position, 1 87 gm_$examine_position, 1 88 graphic_manipulator_$epos, 1 89 gm_$epos) entry (fixed bin (18), fixed bin, float bin, float bin, float bin, fixed bin (35)); 1 90 1 91 dcl (graphic_manipulator_$examine_mode, 1 92 gm_$examine_mode, 1 93 graphic_manipulator_$emode, 1 94 gm_$emode) entry (fixed bin (18), fixed bin, fixed bin, fixed bin (35)); 1 95 1 96 dcl (graphic_manipulator_$examine_color, 1 97 gm_$examine_color, 1 98 graphic_manipulator_$ecolor, 1 99 gm_$ecolor) entry (fixed bin (18), fixed bin, fixed bin, fixed bin, fixed bin (35)); 1 100 1 101 dcl (graphic_manipulator_$examine_mapping, 1 102 gm_$examine_mapping, 1 103 graphic_manipulator_$emap, 1 104 gm_$emap) entry (fixed bin (18), fixed bin, float bin dimension (*), fixed bin, fixed bin (35)); 1 105 1 106 dcl (graphic_manipulator_$examine_contents, 1 107 gm_$examine_contents) entry (fixed bin (18), fixed bin (18) dimension (*), fixed bin, fixed bin (35)); 1 108 1 109 dcl (graphic_manipulator_$examine_list, 1 110 gm_$examine_list, 1 111 graphic_manipulator_$elist, 1 112 gm_$elist) entry (fixed bin (18), dimension (*) fixed bin (18), fixed bin, fixed bin (35)); 1 113 1 114 dcl (graphic_manipulator_$examine_symtab, 1 115 graphic_manipulator_$esymtab, 1 116 gm_$examine_symtab, 1 117 gm_$esymtab) entry (fixed bin (18) dimension (*), fixed bin, fixed bin (35)); 1 118 1 119 dcl (graphic_manipulator_$examine_symbol, 1 120 gm_$examine_symbol, 1 121 graphic_manipulator_$esymbol, 1 122 gm_$esymbol) entry (fixed bin (18), fixed bin (18), fixed bin, char (*), fixed bin (35)); 1 123 1 124 dcl (graphic_manipulator_$examine_text, 1 125 gm_$examine_text, 1 126 graphic_manipulator_$etext, 1 127 gm_$etext) entry (fixed bin (18), fixed bin, fixed bin, char (*), fixed bin (35)); 1 128 1 129 dcl (graphic_manipulator_$examine_data, 1 130 gm_$examine_data, 1 131 graphic_manipulator_$edata, 1 132 gm_$edata) entry (fixed bin (18), fixed bin, bit (*), fixed bin (35)); 1 133 1 134 dcl (graphic_manipulator_$get_struc, 1 135 gm_$get_struc, 1 136 graphic_manipulator_$gstruc, 1 137 gm_$gstruc) entry (char (*), char (*), char (*), fixed bin, fixed bin (35)); 1 138 1 139 dcl (graphic_manipulator_$put_struc, 1 140 gm_$put_struc, 1 141 graphic_manipulator_$pstruc, 1 142 gm_$pstruc) entry (char (*), char (*), char (*), fixed bin, fixed bin (35)); 1 143 1 144 dcl (graphic_manipulator_$save_file, 1 145 gm_$save_file) entry (char (*), char (*), fixed bin (35)); 1 146 1 147 dcl (graphic_manipulator_$use_file, 1 148 gm_$use_file) entry (char (*), char (*), fixed bin (35)); 1 149 1 150 /* **************** END INCLUDE FILE gm_entry_dcls.incl.pl1 **************** */ 44 45 2 1 /* *************** BEGIN INCLUDE FILE gc_entry_dcls.incl.pl1 *************** */ 2 2 2 3 dcl (graphic_compiler_$tree_ptr, 2 4 gc_$tree_ptr) entry returns (pointer); 2 5 2 6 dcl (graphic_compiler_$return_string, 2 7 gc_$return_string, 2 8 graphic_compiler_$rs, 2 9 gc_$rs) entry (fixed bin (18), pointer, fixed bin, fixed bin (35)); 2 10 2 11 dcl (graphic_compiler_$display_append, 2 12 gc_$display_append, 2 13 graphic_compiler_$da, 2 14 gc_$da) entry (fixed bin (18), fixed bin (35)); 2 15 2 16 dcl (graphic_compiler_$display_append_switch, 2 17 gc_$display_append_switch, 2 18 graphic_compiler_$da_switch, 2 19 gc_$da_switch) entry (fixed bin (18), fixed bin (35), pointer); 2 20 2 21 dcl (graphic_compiler_$display, 2 22 gc_$display, 2 23 graphic_compiler_$d, 2 24 gc_$d) entry (fixed bin (18), fixed bin (35)); 2 25 2 26 dcl (graphic_compiler_$display_switch, 2 27 gc_$display_switch, 2 28 graphic_compiler_$d_switch, 2 29 gc_$d_switch) entry (fixed bin (18), fixed bin (35), pointer); 2 30 2 31 dcl (graphic_compiler_$load, 2 32 gc_$load, 2 33 graphic_compiler_$l, 2 34 gc_$l) entry (fixed bin (18), fixed bin (35)); 2 35 2 36 dcl (graphic_compiler_$load_switch, 2 37 gc_$load_switch, 2 38 graphic_compiler_$l_switch, 2 39 gc_$l_switch) entry (fixed bin (18), fixed bin (35), pointer); 2 40 2 41 dcl (graphic_compiler_$display_name_append, 2 42 gc_$display_name_append, 2 43 graphic_compiler_$dna, 2 44 gc_$dna) entry (char (*), fixed bin (35)); 2 45 2 46 dcl (graphic_compiler_$display_name_append_switch, 2 47 gc_$display_name_append_switch, 2 48 graphic_compiler_$dna_switch, 2 49 gc_$dna_switch) entry (char (*), fixed bin (35), pointer); 2 50 2 51 dcl (graphic_compiler_$display_name, 2 52 gc_$display_name, 2 53 graphic_compiler_$dn, 2 54 gc_$dn) entry (char (*), fixed bin (35)); 2 55 2 56 dcl (graphic_compiler_$display_name_switch, 2 57 gc_$display_name_switch, 2 58 graphic_compiler_$dn_switch, 2 59 gc_$dn_switch) entry (char (*), fixed bin (35), pointer); 2 60 2 61 dcl (graphic_compiler_$load_name, 2 62 gc_$load_name, 2 63 graphic_compiler_$ln, 2 64 gc_$ln) entry (char (*), fixed bin (35)); 2 65 2 66 dcl (graphic_compiler_$load_name_switch, 2 67 gc_$load_name_switch, 2 68 graphic_compiler_$ln_switch, 2 69 gc_$ln_switch) entry (char (*), fixed bin (35), pointer); 2 70 2 71 dcl (graphic_compiler_$prune_tree, 2 72 gc_$prune_tree) entry (fixed bin (35)); 2 73 2 74 /* **************** END INCLUDE FILE gc_entry_dcls.incl.pl1 **************** */ 46 47 3 1 /* --------------- BEGIN include file graphic_etypes.incl.pl1 --------------- */ 3 2 3 3 /* Types of position, mode, and other effectors for the 3 4* Multics General Graphic System */ 3 5 3 6 3 7 /* Null code */ 3 8 3 9 dcl (Null initial (-1), 3 10 3 11 /* Position codes */ 3 12 3 13 Setposition initial (0), 3 14 Setpoint initial (1), 3 15 Vector initial (2), 3 16 Shift initial (3), 3 17 Point initial (4), 3 18 3 19 /* Mode codes, with values where appropriate */ 3 20 3 21 Scaling initial (8), 3 22 Rotation initial (9), 3 23 Clipping initial (10), 3 24 3 25 Intensity initial (16), 3 26 Full_intensity initial (7), 3 27 Half_intensity initial (3), 3 28 Invisible initial (0), 3 29 3 30 Linetype initial (17), 3 31 Solid initial (0), 3 32 Dashed initial (1), 3 33 Dotted initial (2), 3 34 Dash_dotted initial (3), 3 35 Long_dashed initial (4), 3 36 3 37 Sensitivity initial (18), 3 38 Sensitive initial (1), 3 39 Insensitive initial (0), 3 40 3 41 Blink initial (19), 3 42 Steady initial (0), 3 43 Blinking initial (1), 3 44 3 45 Color initial (20), 3 46 3 47 Symbol initial (24), 3 48 3 49 /* Text code, with legal alignments */ 3 50 3 51 Text initial (25), 3 52 Upper_left initial (1), 3 53 Upper_center initial (2), 3 54 Upper_right initial (3), 3 55 Left initial (4), 3 56 Center initial (5), 3 57 Right initial (6), 3 58 Lower_left initial (7), 3 59 Lower_center initial (8), 3 60 Lower_right initial (9), 3 61 3 62 /* Datablock code */ 3 63 3 64 Datablock initial (26), 3 65 3 66 /* Structural effector codes */ 3 67 3 68 List initial (32), 3 69 Array initial (33), 3 70 3 71 /* Merge codes for gm_$get_struc and gm_$put_struc */ 3 72 3 73 On_dup_error initial (0), /* allow no name duplications */ 3 74 On_dup_source initial (1), /* on name dup, force move (use source copy) */ 3 75 On_dup_target_then_nulls initial (2), /* on name dup, use target copy, for nondup symbols create null ones */ 3 76 On_dup_target_then_source initial (3), /* on name dup, use target copy, for nondup symbols, use source copy */ 3 77 3 78 /* Device codes for graphic input devices */ 3 79 3 80 Terminal_program initial (0), 3 81 Keyboard initial (1), 3 82 Mouse initial (2), 3 83 Joystick initial (3), 3 84 Tablet_and_pen initial (4), 3 85 Light_pen initial (5), 3 86 Trackball initial (6), 3 87 Any_device initial (63)) /* 63 is equivalent to -1 in SPI */ 3 88 3 89 fixed bin internal static options (constant); 3 90 3 91 /* ---------------- END include file graphic_etypes.incl.pl1 ---------------- */ 48 49 50 plots: entry; /* initializes the world */ 51 52 dcl 1 static_info aligned static, /* current positions, scalings, etc. */ 53 2 cur_position (2) float bin initial (0, 0), 54 2 cur_factors (2) float bin initial (1, 1), 55 2 rel_positions (2) float bin initial (0, 0), 56 2 cur_offsets (2) float bin initial (0, 0), 57 2 cur_offs_factors (2) float bin initial (1, 1), 58 2 cumulative_rels (2) float bin initial (0, 0), 59 2 last_string_ended (2) float bin initial (0, 0), 60 2 last_height float bin initial (1), 61 2 screen_size_factor float bin initial (1), 62 2 current_sublist fixed bin (18), 63 2 display_list fixed bin (18), 64 2 named_display_list fixed bin (18), 65 2 initialized bit (1) aligned initial (""b); 66 67 dcl 1 based_static_info aligned based (addr (static_info)), 68 2 (cur_x, cur_y) float bin, 69 2 (x_factor, y_factor) float bin, 70 2 (x_rel, y_rel) float bin, 71 2 (x_offset, y_offset) float bin, 72 2 (x_offs_factor, y_offs_factor) float bin, 73 2 (cumulative_x_rel, cumulative_y_rel) float bin, 74 2 (x_string_ended, y_string_ended) float bin; 75 76 dcl pgs_ptr pointer, 77 cur_color (3) fixed bin, 78 first_time bit (1) aligned static initial ("1"b), 79 hcs_$make_ptr ext entry (pointer, char (*), char (*), pointer, fixed bin (35)), 80 hcs_$fs_get_path_name ext entry (pointer, char (*), fixed bin, char (*), fixed bin (35)); 81 82 dcl temp (100) fixed bin (18), /* node temps */ 83 node_fake (1) fixed bin (18), 84 (i, j) fixed bin, /* temps */ 85 node fixed bin (18); 86 87 dcl graphic_chars_$init ext entry; 88 89 saved_special_symbols, cur_position, cur_offsets, last_string_ended, 90 saved_special_symbol_heights = 0; /* initialize everything */ 91 cur_factors, cur_offs_factors, last_height = 1; 92 cur_color (*) = 63; 93 94 call graphic_manipulator_$init (code); /* create/reinit WGS */ 95 if code ^= 0 then /* oops */ 96 init_err: call sub_err_ (code, "calcomp_compatible_subrs_$plots", "s", null, 0, "Initializing display list."); 97 98 call graphic_chars_$init; /* clear the char memory */ 99 100 node = graphic_manipulator_$create_position (Setposition, -512, -512, 0, code); /* initial origin */ 101 if code ^= 0 then goto init_err; 102 103 node_fake = node; /* %&$!#@! compiler simfaults on ((node)) in its place */ 104 current_sublist = graphic_manipulator_$create_array (node_fake, 1, code); 105 if code ^= 0 then goto init_err; 106 107 display_list = current_sublist; /* the main honcho */ 108 109 named_display_list = graphic_manipulator_$assign_name ("ccs_display_list_", display_list, code); 110 /* just to keep things clean */ 111 if code ^= 0 then goto init_err; 112 113 initialized = "1"b; 114 115 return; 116 117 118 plot: entry (abs_x, abs_y, indicator); /* draws a line at a time */ 119 120 dcl indicator fixed bin parameter, 121 (abs_x, abs_y) float bin parameter; 122 123 dcl switch fixed bin, 124 sub_err_ ext entry options (variable), 125 error_table_$badcall ext fixed bin (35), 126 abs builtin, 127 code fixed bin (35), 128 movement fixed bin; 129 130 call check_init; /* have we been plotsed? */ 131 132 133 134 check_init: proc; /* to check that calls occur in correct order */ 135 136 if ^initialized then 137 call sub_err_ (error_table_$out_of_sequence, "calcomp_compatible_subrs_", "s", null, 0, 138 "A call to calcomp_compatible_subrs_$plots must be made before any further work is allowed."); 139 140 end check_init; 141 142 143 144 call internal_plot (abs_x, abs_y, indicator, "calcomp_compatible_subrs_$plot"); /* pass buck */ 145 146 147 148 internal_plot: proc (abs_x, abs_y, indicator, whoami); 149 150 dcl (abs_x, abs_y) float bin, 151 indicator fixed bin, 152 whoami char (*); 153 154 dcl rel_motion (2) float bin; 155 156 rel_motion (1) = abs_x - cur_x; 157 rel_motion (2) = abs_y - cur_y; 158 159 if indicator < 0 then cur_position = 0; /* reset origin-- we never reference these */ 160 else do; /* after this point anyhow */ 161 cur_x = abs_x; /* note we got where we were going */ 162 cur_y = abs_y; /* this may throw us off if we DO get some error */ 163 end; /* later while creating or inserting the new element */ 164 165 switch = abs (indicator); /* switchon switch */ 166 167 if switch > 30 then goto close_picture; 168 169 i = mod (switch, 10); /* see what the magic digit is */ 170 171 if i > 3 then goto indicator_out_of_bounds; 172 if i < 2 then goto indicator_out_of_bounds; 173 174 if rel_motion (1) = 0 then if rel_motion (2) = 0 then return; /* no-op */ 175 176 goto plot_label (switch); 177 178 plot_label (2): 179 plot_label (22): 180 movement = Vector; 181 goto plot_common; 182 183 plot_label (3): 184 plot_label (23): 185 movement = Shift; 186 goto plot_common; 187 188 plot_label (12): 189 movement = Vector; 190 goto apply_offsets; 191 192 plot_label (13): 193 movement = Shift; 194 apply_offsets: 195 rel_motion = (rel_motion - cur_offsets) / cur_offs_factors; 196 plot_common: 197 node = graphic_manipulator_$create_position 198 (movement, rel_motion (1) * screen_size_factor, rel_motion (2) * screen_size_factor, 0, code); 199 if code ^= 0 then do; /* zounds. */ 200 call sub_err_ (code, whoami, "h", null, 0, "Creating ^[vector^;shift^].", (movement = Vector)); 201 goto error_return; 202 end; 203 204 call append_element (node, code); /* tack it on */ 205 if code ^= 0 then do; 206 call sub_err_ (code, whoami, "h", null, 0, "Appending ^[vector^;shift^] to display list.", (movement = Vector)); 207 goto error_return; 208 end; 209 210 return; 211 212 indicator_out_of_bounds: /* foo on you */ 213 call sub_err_ (error_table_$badcall, whoami, "h", null, 0, "Indicator ^d not recognized.", indicator); 214 goto error_return; 215 216 close_picture: 217 call graphic_compiler_$display (named_display_list, code); /* push it out */ 218 if code ^= 0 then do; /* shucks */ 219 call sub_err_ (code, whoami, "h", null, 0, "Attempting to display and close completed picture."); 220 goto error_return; 221 end; 222 223 initialized = ""b; /* better call plots next thing */ 224 return; 225 226 end internal_plot; 227 228 append_element: proc (item, code); 229 230 231 dcl item fixed bin (18), 232 code fixed bin (35); 233 234 dcl temp fixed bin (18); 235 dcl fudge (2) fixed bin (18); 236 237 dcl graphic_error_table_$lsm_blk_len ext fixed bin (35); 238 239 call graphic_manipulator_$add_element (current_sublist, -1, item, code); 240 if code ^= graphic_error_table_$lsm_blk_len then return; /* it worked or was error we can't fix. */ 241 242 fudge (1) = 0; /* save a spot for the last element on the current sublist */ 243 fudge (2) = item; 244 245 temp = graphic_manipulator_$create_array (fudge, 2, code); /* create the "new" current sublist */ 246 247 if code ^= 0 then return; 248 249 /* now chain the new list onto the end of the old list. By doing things this 250* way, we do not have to worry about copying active modes from list to list. 251* */ 252 253 fudge (1) = graphic_manipulator_$replace_element (current_sublist, -1, temp, code); 254 255 if (code ^= 0) 256 then return; 257 258 current_sublist = temp; /* the new list is now the current list */ 259 260 /* save the item we took out of the old list in the proper position in the new 261* list */ 262 263 temp = graphic_manipulator_$replace_element (current_sublist, 1, fudge (1), code); 264 265 return; /* with whatever code resulted. */ 266 267 end append_element; 268 269 270 error_return: return; 271 272 factor: entry (scaling); /* user's own scaling factor */ 273 274 dcl scaling float bin parameter; 275 dcl whoami char (64); 276 277 whoami = "calcomp_compatible_subrs_$factor"; 278 279 call check_init; 280 281 cur_factors = scaling; /* simple? */ 282 goto append_scales; 283 284 dfact: entry (x_scaling, y_scaling); /* to set two factors */ 285 286 dcl (x_scaling, 287 y_scaling) float bin parameter; 288 289 whoami = "calcomp_compatible_subrs_$dfact"; 290 291 call check_init; 292 293 x_factor = x_scaling; /* also simple */ 294 y_factor = y_scaling; 295 296 append_scales: 297 node = graphic_manipulator_$create_scale (x_factor, y_factor, 1, code); /* make scaling element */ 298 if code ^= 0 then do; 299 call sub_err_ (code, whoami, "h", null, 0, "Attempting to create scale factor."); 300 return; 301 end; 302 303 call append_element (node, code); /* tack it on */ 304 if code ^= 0 then call sub_err_ (code, whoami, "h", null, 0, "Appending scale factor to display list."); 305 306 return; 307 308 309 where: entry (x_position, y_position, scaling); /* to find out where we are, and scales */ 310 311 dcl (x_position, 312 y_position) float bin parameter; 313 314 call check_init; 315 316 x_position = cur_x; /* simple. */ 317 y_position = cur_y; 318 319 if x_factor = y_factor then scaling = x_factor; /* this is the way it should be */ 320 321 else do; /* poor loser. */ 322 call sub_err_ (error_table_$badcall, "calcomp_compatible_subrs_$where", "h", null, 0, 323 "Type ""start"" to return the larger scale factor."); /* whatever help it is. */ 324 scaling = max (x_factor, y_factor); /* they better not be negative. */ 325 end; 326 327 return; 328 329 dwhr: entry (x_position, y_position, x_scaling, y_scaling); 330 331 call check_init; 332 333 x_position = cur_x; /* as simple. */ 334 y_position = cur_y; 335 x_scaling = x_factor; 336 y_scaling = y_factor; 337 return; 338 339 offset: entry (x_zero, x_scaling, y_zero, y_scaling); /* for arcane hackers */ 340 341 dcl (x_zero, 342 y_zero) float bin parameter; 343 344 call check_init; 345 346 x_offset = x_zero; 347 y_offset = y_zero; /* copy them all in */ 348 x_offs_factor = x_scaling; 349 y_offs_factor = y_scaling; 350 351 return; 352 353 wofst: entry (x_zero, x_scaling, y_zero, y_scaling); /* for absent-minded arcane hackers */ 354 355 call check_init; 356 357 x_zero = x_offset; /* copy them back out */ 358 y_zero = y_offset; 359 x_scaling = x_offs_factor; 360 y_scaling = y_offs_factor; 361 return; 362 363 newpen: entry (color); /* for color hackery */ 364 365 dcl color fixed bin parameter; 366 367 dcl red_color fixed bin defined (cur_color (3)); 368 dcl green_color fixed bin defined (cur_color (2)); 369 dcl blue_color fixed bin defined (cur_color (1)); 370 371 /* we assume pens are 1 = blue; 2 = green; 3 = red. */ 372 373 call check_init; 374 375 if color < 1 then goto bad_color; 376 if color > 3 then goto bad_color; 377 378 cur_color (*) = 0; 379 cur_color (color) = 63; /* full intensity */ 380 381 node = graphic_manipulator_$create_color (red_color, green_color, blue_color, code); 382 if code ^= 0 then do; 383 call sub_err_ (code, "calcomp_compatible_subrs_$newpen", "h", null, 0, "While creating color element."); 384 return; 385 end; 386 387 call append_element (node, code); /* tack it on */ 388 if code ^= 0 then do; 389 call sub_err_ (code, "calcomp_compatible_subrs_$newpen", "h", null, 0, "While appending color element to display list."); 390 return; 391 end; 392 393 return; 394 395 bad_color: call sub_err_ (error_table_$badcall, "calcomp_compatible_subrs_$newpen", "h", null, 0, 396 "Pen number ^d unrecognized.", color); 397 return; 398 399 set_dimension: entry (screen_size); /* for immigrants */ 400 401 dcl screen_size float bin parameter; 402 dcl error_table_$out_of_sequence ext fixed bin (35); 403 404 screen_size_factor = 1024/screen_size; /* that's it */ 405 return; 406 407 symbol: entry (abs_x, abs_y, height, string, angle, string_len); /* for strings and funnies */ 408 409 dcl (height, 410 angle) float bin parameter, 411 string char (*) parameter, 412 string_len fixed bin parameter; 413 414 dcl (x_string_ended_temp, y_string_ended_temp) float bin; 415 416 dcl graphic_chars_$long_tb ext entry 417 (char (*), fixed bin, float bin, float bin, float bin, float bin, fixed bin (35)) returns (fixed bin (18)), 418 graphic_chars_ ext entry (char (*), fixed bin, float bin, float bin, fixed bin (35)) returns (fixed bin (18)); 419 420 dcl fixed_bin_based fixed bin based; 421 422 dcl (real_x, real_y, real_height) float bin; 423 424 dcl symbol_name char (32), 425 ioa_$rsnnl ext entry options (variable); 426 427 dcl dirname char (168) static initial (""), 428 ename char (32) static initial ("ccs_special_symbols_.pgs"); 429 430 dcl saved_special_symbols (2, 0:199) static fixed bin (18) initial ((400)0), 431 /* first is scaled node, second is unscaled */ 432 saved_special_symbol_heights (0:199) static float bin initial ((200) 0e0); 433 /* so we don't seek symbols more than once per invocation */ 434 435 call check_init; 436 437 call internal_symbol (abs_x, abs_y, height, string, angle, string_len, "calcomp_compatible_subrs_$symbol"); 438 439 return; 440 441 internal_symbol: proc (abs_x, abs_y, height, string, angle, string_len, whoami); 442 443 dcl (abs_x, abs_y) float bin, 444 (height, angle) float bin, 445 string char (*), 446 string_len fixed bin, 447 (save_cur_x, save_cur_y) float bin, 448 whoami char (*); 449 450 if abs_x = 999 then do; /* wants it started where last left off */ 451 save_cur_x = cur_x; 452 real_x = cur_x + x_string_ended; 453 end; 454 else do; /* gave an explicit location */ 455 save_cur_x, real_x = abs_x; 456 x_string_ended = 0; 457 end; 458 459 if abs_y = 999 then do; /* check same cruft for y */ 460 save_cur_y = cur_y; 461 real_y = cur_y + y_string_ended; 462 end; 463 else do; 464 save_cur_y, real_y = abs_y; 465 y_string_ended = 0; 466 end; 467 468 if string_len = -2 then call internal_plot (real_x, real_y, 2, whoami); 469 /* wants to go there trailing ink */ 470 else call internal_plot (real_x, real_y, 3, whoami); /* will go quietly, officer */ 471 472 if height = 999 then real_height = last_height; 473 else real_height, last_height = height; 474 475 if string_len <= 0 /* isn't a string, it's a symbol number */ 476 then call get_special_symbol (addr (string) -> fixed_bin_based, temp (2), real_height, whoami); 477 478 else do; /* was really a string */ 479 temp (2) = graphic_chars_$long_tb (substr (string, 1, string_len), Lower_left, 480 real_height * screen_size_factor, real_height * screen_size_factor, 481 x_string_ended_temp, y_string_ended_temp, code); /* make it into vectors */ 482 if code ^= 0 then do; 483 call sub_err_ (code, whoami, "h", null, 0, "Creating vectors from ^a.", substr (string, 1, string_len)); 484 goto error_return; 485 end; 486 487 x_string_ended_temp = x_string_ended_temp / screen_size_factor; /* un-scale our indicators */ 488 y_string_ended_temp = y_string_ended_temp / screen_size_factor; 489 490 x_string_ended = x_string_ended + cosd (angle) * x_string_ended_temp /* do rotation */ 491 - sind (angle) * y_string_ended_temp; /* to keep track of where */ 492 y_string_ended = y_string_ended + sind (angle) * x_string_ended_temp /* we left off */ 493 + cosd (angle) * y_string_ended_temp; /* so we can go back */ 494 end; 495 496 temp (1) = graphic_manipulator_$create_rotation (0, 0, angle, code); /* rotate it */ 497 if code ^= 0 then do; 498 call sub_err_ (code, whoami, "h", null, 0, "Creating angle element."); 499 goto error_return; 500 end; 501 502 node = graphic_manipulator_$create_array (temp, 2, code); /* bind them together */ 503 if code ^= 0 then do; 504 call sub_err_ (code, whoami, "h", null, 0, "Creating array from angle and string."); 505 goto error_return; 506 end; 507 508 call append_element (node, code); /* tack it on */ 509 if code ^= 0 then do; 510 call sub_err_ (code, whoami, "h", null, 0, "Appending symbol element to display list."); 511 goto error_return; 512 end; 513 514 515 if string_len > 0 then call internal_plot (save_cur_x, save_cur_y, 3, whoami); /* go back there */ 516 517 end internal_symbol; 518 519 get_special_symbol: proc (symbol_no, return_node, real_height, whoami); /* to get funnies */ 520 521 dcl symbol_no fixed bin parameter, 522 return_node fixed bin (18) parameter, 523 temp (2) fixed bin (18), 524 real_height float bin, 525 whoami char (*) parameter; 526 527 if first_time then do; /* find the calcomp symbol PGS */ 528 529 call hcs_$make_ptr (null, (ename), "", pgs_ptr, code); /* use search rules */ 530 if pgs_ptr = null then do; /* can't find one */ 531 pgs_err: call sub_err_ (code, "calcomp_compatible_subrs_$plots", "h", null, 0, 532 "Attempting to locate ^a.^/ Please notify the system maintenance staff.", ename); /* Horrors. */ 533 goto error_return; 534 end; 535 536 call hcs_$fs_get_path_name (pgs_ptr, dirname, 0, "", code); /* find out dirname */ 537 if code ^= 0 then goto pgs_err; 538 539 first_time = ""b; 540 end; 541 542 if symbol_no < lbound (saved_special_symbols, 2) then goto sym_unknown; 543 if symbol_no > hbound (saved_special_symbols, 2) then goto sym_unknown; 544 545 if saved_special_symbol_heights (symbol_no) = real_height then do; 546 return_node = saved_special_symbols (1, symbol_no); 547 return; 548 end; 549 550 if saved_special_symbol_heights (symbol_no) ^= 0 then /* already have sym, but not right size */ 551 temp (2) = saved_special_symbols (2, symbol_no); 552 553 else do; /* don't have sym, must fetch */ 554 sym_unknown: 555 call ioa_$rsnnl ("calcomp_symbol_^d", symbol_name, 0, symbol_no); /* construct name */ 556 557 call graphic_manipulator_$get_struc (dirname, ename, symbol_name, 1, code); /* get from PGS */ 558 if code ^= 0 then do; 559 call sub_err_ (code, whoami, "c", null, 0, "^a not found; using ""*""", symbol_name); /* hm. */ 560 return_node = graphic_chars_ ("*", Center, real_height * screen_size_factor, 561 real_height * screen_size_factor, code); 562 if code ^= 0 then do; 563 call sub_err_ (code, whoami, "h", null, 0, "Creating vectors from ""*"""); 564 goto error_return; 565 end; 566 567 return; 568 569 end; 570 571 temp (2) = graphic_manipulator_$find_structure (symbol_name, 0, code); /* get desired one */ 572 if code ^= 0 then do; 573 call sub_err_ (code, whoami, "h", null, 0, "Locating ^a in working graphic segment.", symbol_name); 574 goto error_return; /* something's dead wrong. */ 575 end; 576 end; 577 578 temp (1) = graphic_manipulator_$create_scale (real_height * screen_size_factor / 10, 579 real_height * screen_size_factor / 10, /* calcomp symbols are 10 X 10 */ 580 1, code); /* scale to desired size */ 581 if code ^= 0 then do; 582 call sub_err_ (code, whoami, "h", null, 0, "Creating height element."); 583 goto error_return; 584 end; 585 586 587 return_node = graphic_manipulator_$create_array (temp, 2, code); /* bind them together */ 588 if code ^= 0 then do; 589 call sub_err_ (code, whoami, "h", null, 0, "Assembling ^a", symbol_name); 590 goto error_return; 591 end; 592 593 if symbol_no >= lbound (saved_special_symbols, 2) then 594 if symbol_no <= hbound (saved_special_symbols, 2) then do; 595 /* remember this symbol even if previously known, because 596* perhaps size has changed. We always remember LAST size, banking on user 597* not "thrashing" w.r.t. different sizes for same symbol */ 598 saved_special_symbol_heights (symbol_no) = real_height; 599 saved_special_symbols (1, symbol_no) = return_node; 600 saved_special_symbols (2, symbol_no) = temp (2); 601 end; 602 603 return; 604 605 end get_special_symbol; 606 607 number: entry (abs_x, abs_y, height, float_num, angle, precision); /* like symbol, for float numbers */ 608 609 dcl float_num float bin parameter, 610 precision fixed bin parameter; 611 612 dcl char_number char (24), 613 char_len fixed bin, 614 fixed_num fixed bin; 615 616 if precision < 0 then do; 617 if float_num > 0 then fixed_num = (float_num * 1010b ** (precision+1)) + .5e0; /* round it */ 618 else fixed_num = (float_num * 1010b ** (precision+1)) - .5e0; 619 620 call ioa_$rsnnl ("^d", char_number, char_len, fixed_num); /* put it out as integer */ 621 end; 622 623 else call ioa_$rsnnl ("^.vf", char_number, char_len, precision, float_num); 624 /* ioa_ rounds these. Cute. */ 625 626 call internal_symbol (abs_x, abs_y, height, char_number, angle, char_len, "calcomp_compatible_subrs_$number"); 627 return; /* not much to it */ 628 629 scale: entry (array, axis_len, n_points, step_size); /* Picks nice scale factors for data arrays */ 630 631 dcl array float bin dimension (*) parameter, 632 axis_len float bin parameter, 633 n_points fixed bin parameter, 634 step_size fixed bin parameter; 635 636 dcl default_screen_size_factor static float bin initial (1); 637 638 dcl (minel, maxel) float bin, 639 spread float bin, 640 logno float bin, 641 exponent fixed bin, 642 n_tics fixed bin, 643 nondimensional float bin, 644 (min, 645 max, 646 addr, 647 binary, 648 fixed, 649 log10, 650 sign, 651 cosd, 652 sind, 653 substr) builtin, 654 compensation float bin, 655 steps fixed bin, 656 raw_dv float bin, 657 (delta_value, first_value) float bin; 658 659 call check_init; 660 661 /* Special hack: The original axis entry wants to plot one tic mark per inch. Inches really 662* mean nothing to us here, and inches may be equivalent to points if we are running in native mode. 663* So we check for native mode and enforce our own standard; 1 inch = 100 points. If we are not in native mode, 664* then we assume the guy knows what he wants. */ 665 666 if screen_size_factor = default_screen_size_factor then n_tics = axis_len / 100; /* Ours */ 667 else n_tics = axis_len; /* Theirs */ 668 669 minel, maxel = array (1); /* have to start somewhere */ 670 671 steps = abs (step_size); /* compute length of tread */ 672 673 do i = steps + 1 by steps to (steps * (n_points - 1)) + 1; /* clomp up array */ 674 minel = min (minel, array (i)); 675 maxel = max (maxel, array (i)); 676 end; 677 678 spread = maxel - minel; 679 if spread = 0 then if minel = 0 then do; /* clever. all zeroes. */ 680 minel = -1e-2; /* fudge */ 681 maxel = 1e-2; 682 spread = maxel - minel; 683 end; 684 685 else do; /* all constants */ 686 minel = .9e0 * minel; /* center on constants */ 687 maxel = 1.11e0 * maxel; 688 spread = maxel - minel; 689 end; 690 691 logno = log10 (spread / n_tics); /* normalize number */ 692 exponent = binary (logno); 693 raw_dv = binary (10) ** exponent; 694 695 nondimensional = (spread / n_tics) / raw_dv; 696 697 if nondimensional < 1.1e0 then delta_value = raw_dv; /* The following cute values are CalComp defined. */ 698 699 else if nondimensional <= 2 then delta_value = 2 * raw_dv; 700 701 else if nondimensional <= 4 then delta_value = 4 * raw_dv; 702 703 else if nondimensional <= 5 then delta_value = 5 * raw_dv; 704 705 else if nondimensional <= 8 then delta_value = 8 * raw_dv; 706 707 else delta_value = raw_dv * binary (10); 708 709 if step_size > 0 then do; /* first = min, delta = positive */ 710 if minel < 0 then compensation = -.9999999; 711 else compensation = 0; 712 first_value = fixed (binary (minel / delta_value) + compensation) * delta_value; 713 end; 714 715 else do; /* first = max, delta = negative */ 716 if maxel < 0 then compensation = 0; 717 else compensation = .9999999; 718 first_value = fixed (binary (maxel / delta_value) + compensation) * delta_value; 719 delta_value = -delta_value; 720 end; 721 722 array ((n_points) * steps + 1) = first_value; /* plug them in */ 723 array ((n_points+1) * steps + 1) = delta_value; 724 725 return; 726 727 axis: entry (abs_x, abs_y, title, control, axis_len, angle, first_val, delta_val); 728 729 dcl title char (*) parameter, 730 control fixed bin parameter, 731 first_val float bin parameter, 732 delta_val float bin parameter; 733 734 dcl (adj_axis_len, x_between_tics) float bin, 735 (tic_mark, a (10)) fixed bin (18), 736 tic_vect float bin, 737 title_len fixed bin, 738 alignment fixed bin; 739 740 dcl underflow condition; 741 742 call check_init; 743 744 delta_value = delta_val; 745 first_value = first_val; 746 747 call internal_plot (abs_x, abs_y, 3, "calcomp_compatible_subrs_$axis"); /* go to begin point */ 748 749 if screen_size_factor = default_screen_size_factor then do; /* Ours */ 750 adj_axis_len = fixed (binary (axis_len)) / 100; /* 1 inch = 100 points */ 751 x_between_tics = 100; 752 end; 753 else do; /* Theirs */ 754 adj_axis_len = fixed (binary (axis_len)); /* 1 inch = screen_size_factor points */ 755 x_between_tics = screen_size_factor; 756 end; 757 758 tic_vect = 10 * sign (control); /* screen_size does not matter here. 10 is invariant. */ 759 760 if control < 0 then alignment = Lower_center; /* counterclockwise labels */ 761 else alignment = Upper_center; /* clockwise labels */ 762 763 a (1) = graphic_manipulator_$create_position (Shift, 0, tic_vect, 0, code); 764 if code ^= 0 then goto tic_err; 765 766 a (2) = graphic_manipulator_$create_position (Vector, 0, tic_vect, 0, code); 767 if code ^= 0 then goto tic_err; 768 769 a (3) = graphic_manipulator_$create_position (Vector, x_between_tics, 0, 0, code); 770 if code ^= 0 then goto tic_err; 771 772 a (4) = graphic_manipulator_$create_position (Shift, 0, -2 * tic_vect, 0, code); 773 if code ^= 0 then do; /* nervous tic */ 774 tic_err: call sub_err_ (code, "calcomp_compatible_subrs_$axis", "h", null, 0, "Creating tic components."); 775 return; 776 end; 777 778 tic_mark = graphic_manipulator_$create_array (a, 4, code); /* make array */ 779 if code ^= 0 then do; 780 call sub_err_ (code, "calcomp_compatible_subrs_$axis", "h", null, 0, "Creating array for tic_mark."); 781 return; 782 end; 783 784 785 temp (1) = graphic_manipulator_$create_rotation (0, 0, angle, code); /* rotate the axis */ 786 if code ^= 0 then do; 787 call sub_err_ (code, "calcomp_compatible_subrs_$axis", "h", null, 0, "Creating axis rotation"); 788 return; 789 end; 790 791 temp (2) = graphic_manipulator_$create_position (Shift, 0, -2 * tic_vect, 0, code); 792 /* to start in right place */ 793 if code ^= 0 then goto axis_err; 794 795 on underflow; 796 797 do i = 1 to adj_axis_len + 1; /* make right number of tics */ 798 call ioa_$rsnnl ("^3e", char_number, j, first_value + (i-1) * delta_value); 799 strip_blanks: if substr (char_number, 1, 1) = " " then do; /* ioa_ sometimes does this */ 800 char_number = substr (char_number, 2); 801 j = j - 1; 802 goto strip_blanks; 803 end; 804 temp (2*i+1) = graphic_chars_ (substr (char_number, 1, j), alignment, 10, 10, code); 805 if i <= adj_axis_len then temp (2*i+2) = tic_mark; /* don't need extra tic mark */ 806 end; 807 808 revert underflow; 809 810 i = (adj_axis_len + 1) * 2 + 1; 811 812 temp (1+i) = a (1); /* create last tic */ 813 temp (2+i) = a (2); 814 temp (3+i) = graphic_manipulator_$create_position 815 (Shift, fixed (binary (-axis_len)) * screen_size_factor/2, -4 * tic_vect, 0, code); 816 /* return halfway, for title */ 817 if code ^= 0 then goto axis_err; 818 819 title_len = abs (control); 820 821 temp (4+i) = graphic_chars_ (substr (title, 1, title_len), alignment, 25, 25, code); 822 if code ^= 0 then do; 823 call sub_err_ (code, "calcomp_compatible_subrs_$axis", "h", null, 0, "Creating vectors from title"); 824 return; 825 end; 826 827 temp (5+i) = graphic_manipulator_$create_position /* return all the way */ 828 (Shift, fixed (binary (-axis_len)) * screen_size_factor/2, 4*tic_vect, 0, code); 829 if code ^= 0 then do; 830 axis_err: call sub_err_ (code, "calcomp_compatible_subrs_$axis", "h", null, 0, "Creating elements of axis."); 831 return; 832 end; 833 834 node = graphic_manipulator_$create_array (temp, 5+i, code); /* put it all together */ 835 if code ^= 0 then do; 836 call sub_err_ (code, "calcomp_compatible_subrs_$axis", "h", null, 0, "Creating array from axis", "h", null, 0); 837 return; 838 end; 839 840 call append_element (node, code); /* tack it on */ 841 if code ^= 0 then call sub_err_ (code, "calcomp_compatible_subrs_$axis", "h", null, 0, 842 "Appending axis to display list."); 843 844 return; 845 846 line: entry (x_array, y_array, n_points, step_size, line_type, symbol_no); /* to plot data elements */ 847 848 dcl (x_array (*), y_array (*)) float bin parameter, 849 symbol_no fixed bin parameter, 850 line_type fixed bin parameter; 851 852 dcl (delta_value_x, 853 delta_value_y, 854 first_value_x, 855 first_value_y, 856 temp_scale) float bin; 857 858 dcl alloc_temp (alloc_temp_length) based (atp) fixed bin (18) based, 859 alloc_temp_length fixed bin, 860 atp pointer initial (null); 861 862 dcl cu_$grow_stack_frame ext entry (fixed bin, pointer, fixed bin (35)); 863 864 dcl do_symbols bit (1) aligned, 865 cleanup condition, 866 every_n fixed bin, 867 counter fixed bin, 868 (x_scale, y_scale) float bin, 869 (mod, null) builtin; 870 871 call check_init; 872 873 first_value_x = x_array ((n_points) * step_size + 1); /* grab scaling factors off end */ 874 first_value_y = y_array ((n_points) * step_size + 1); 875 876 delta_value_x = x_array ((n_points + 1) * step_size + 1); 877 delta_value_y = y_array ((n_points + 1) * step_size + 1); 878 879 if screen_size_factor = default_screen_size_factor then temp_scale = 100; /* Ours */ 880 else temp_scale = 1; /* Theirs */ 881 882 x_scale = temp_scale * screen_size_factor / delta_value_x; 883 y_scale = temp_scale * screen_size_factor / delta_value_y; 884 885 do_symbols = line_type ^= 0; /* if want symbols plotted */ 886 call internal_plot (0, 0, 3, "calcomp_compatible_subrs_$line"); /* get back to origin */ 887 if do_symbols 888 then call get_special_symbol (symbol_no, node, 10/screen_size_factor, "calcomp_compatible_subrs_$line"); 889 890 every_n = abs (line_type); 891 cumulative_rels = 0; 892 893 if every_n = 0 then alloc_temp_length = n_points + 10; /* the "10" is for good luck */ 894 else alloc_temp_length = n_points + n_points/every_n + 10; 895 896 call cu_$grow_stack_frame (alloc_temp_length, atp, code); 897 if code ^= 0 then goto bad_line; 898 899 x_rel = (x_array (1) - first_value_x) * x_scale; /* compute initial shift */ 900 y_rel = (y_array (1) - first_value_y) * y_scale; 901 902 alloc_temp (1) = graphic_manipulator_$create_position (Shift, x_rel, y_rel, 0, code); 903 if code ^= 0 then do; 904 bad_line: call sub_err_ (code, "calcomp_compatible_subrs_$line", "h", null, 0, "Constructing elements of line array."); 905 return; 906 end; 907 908 if do_symbols then alloc_temp (2) = node; 909 else alloc_temp (2) = 0; 910 911 cumulative_rels = cumulative_rels + rel_positions; /* keep track of position */ 912 913 if line_type < 0 then movement = Shift; /* wants no lines plotted */ 914 else movement = Vector; /* wants lines plotted */ 915 counter = 1; /* allow for symbol at initial point */ 916 j = 1; 917 918 do i = 3 by 1 while (j <= (n_points * step_size) - 1); /* clomp up array */ 919 j = j + step_size; 920 counter = counter + 1; 921 922 x_rel = (x_array (j) - x_array (j - step_size)) * x_scale; 923 y_rel = (y_array (j) - y_array (j - step_size)) * y_scale; 924 925 alloc_temp (i) = graphic_manipulator_$create_position (movement, x_rel, y_rel, 0, code); 926 if code ^= 0 then goto bad_line; 927 928 cumulative_rels = cumulative_rels + rel_positions; 929 930 if do_symbols then if mod (counter, every_n) = 0 then do; /* put out a symbol here */ 931 i = i + 1; 932 alloc_temp (i) = node; 933 end; 934 end; 935 936 node = graphic_manipulator_$create_array (alloc_temp, i-1, code); /* put it together */ 937 if code ^= 0 then do; 938 call sub_err_ (code, "calcomp_compatible_subrs_$line", "h", null, 0, "Assembling data points into array."); 939 return; 940 end; 941 942 call append_element (node, code); /* tack it on */ 943 if code ^= 0 then call sub_err_ (code, "calcomp_compatible_subrs_$line", "h", null, 0, 944 "Adding line array to display list."); 945 946 cur_position = cur_position + cumulative_rels / screen_size_factor; /* set cur pos to end of line */ 947 948 return; 949 end ccs_; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 11/18/82 1625.3 calcomp_compatible_subrs_.pl1 >dumps>old>recomp>calcomp_compatible_subrs_.pl1 44 1 08/27/75 1700.7 gm_entry_dcls.incl.pl1 >ldd>include>gm_entry_dcls.incl.pl1 46 2 08/13/81 2035.4 gc_entry_dcls.incl.pl1 >ldd>include>gc_entry_dcls.incl.pl1 48 3 03/27/82 0439.2 graphic_etypes.incl.pl1 >ldd>include>graphic_etypes.incl.pl1 NAMES DECLARED IN THIS COMPILATION. IDENTIFIER OFFSET LOC STORAGE CLASS DATA TYPE ATTRIBUTES AND REFERENCES (* indicates a set context) NAMES DECLARED BY DECLARE STATEMENT. Center 000105 constant fixed bin(17,0) initial dcl 3-9 set ref 560* Lower_center constant fixed bin(17,0) initial dcl 3-9 ref 760 Lower_left 000106 constant fixed bin(17,0) initial dcl 3-9 set ref 479* Setposition 000104 constant fixed bin(17,0) initial dcl 3-9 set ref 100* Shift 000112 constant fixed bin(17,0) initial dcl 3-9 set ref 183 192 763* 772* 791* 814* 827* 902* 913 Upper_center constant fixed bin(17,0) initial dcl 3-9 ref 761 Vector 000110 constant fixed bin(17,0) initial dcl 3-9 set ref 178 188 200 206 766* 769* 914 a 000344 automatic fixed bin(18,0) array dcl 734 set ref 763* 766* 769* 772* 778* 812 813 abs builtin function dcl 123 ref 165 671 819 890 abs_x parameter float bin(27) dcl 150 in procedure "internal_plot" ref 148 156 161 abs_x parameter float bin(27) dcl 443 in procedure "internal_symbol" ref 441 450 455 abs_x parameter float bin(27) dcl 120 in procedure "ccs_" set ref 118 144* 407 437* 607 626* 727 747* abs_y parameter float bin(27) dcl 443 in procedure "internal_symbol" ref 441 459 464 abs_y parameter float bin(27) dcl 150 in procedure "internal_plot" ref 148 157 162 abs_y parameter float bin(27) dcl 120 in procedure "ccs_" set ref 118 144* 407 437* 607 626* 727 747* addr builtin function dcl 638 ref 156 157 161 162 293 294 296 296 316 317 319 319 319 324 324 333 334 335 336 346 347 348 349 357 358 359 360 451 452 452 456 460 461 461 465 475 490 490 492 492 899 900 902 902 922 923 925 925 adj_axis_len 000341 automatic float bin(27) dcl 734 set ref 750* 754* 797 805 810 alignment 000360 automatic fixed bin(17,0) dcl 734 set ref 760* 761* 804* 821* alloc_temp based fixed bin(18,0) array dcl 858 set ref 902* 908* 909* 925* 932* 936* alloc_temp_length 000375 automatic fixed bin(17,0) dcl 858 set ref 893* 894* 896* 936 angle parameter float bin(27) dcl 443 in procedure "internal_symbol" set ref 441 490 490 492 492 496* angle parameter float bin(27) dcl 409 in procedure "ccs_" set ref 407 437* 607 626* 727 785* array parameter float bin(27) array dcl 631 set ref 629 669 674 675 722* 723* atp 000376 automatic pointer initial dcl 858 set ref 858* 896* 902 908 909 925 932 936 axis_len parameter float bin(27) dcl 631 ref 629 666 667 727 750 754 814 827 based_static_info based structure level 1 dcl 67 binary builtin function dcl 638 ref 692 693 707 712 718 750 754 814 827 blue_color defined fixed bin(17,0) dcl 369 set ref 381* char_len 000323 automatic fixed bin(17,0) dcl 612 set ref 620* 623* 626* char_number 000315 automatic char(24) unaligned dcl 612 set ref 620* 623* 626* 798* 799 800* 800 804 804 code parameter fixed bin(35,0) dcl 231 in procedure "append_element" set ref 228 239* 240 245* 247 253* 255 263* code 000256 automatic fixed bin(35,0) dcl 123 in procedure "ccs_" set ref 94* 95 95* 100* 101 104* 105 109* 111 196* 199 200* 204* 205 206* 216* 218 219* 296* 298 299* 303* 304 304* 381* 382 383* 387* 388 389* 479* 482 483* 496* 497 498* 502* 503 504* 508* 509 510* 529* 531* 536* 537 557* 558 559* 560* 562 563* 571* 572 573* 578* 581 582* 587* 588 589* 763* 764 766* 767 769* 770 772* 773 774* 778* 779 780* 785* 786 787* 791* 793 804* 814* 817 821* 822 823* 827* 829 830* 834* 835 836* 840* 841 841* 896* 897 902* 903 904* 925* 926 936* 937 938* 942* 943 943* color parameter fixed bin(17,0) dcl 365 set ref 363 375 376 379 395* compensation 000334 automatic float bin(27) dcl 638 set ref 710* 711* 712 716* 717* 718 control parameter fixed bin(17,0) dcl 729 ref 727 758 760 819 cosd builtin function dcl 638 ref 490 492 counter 000402 automatic fixed bin(17,0) dcl 864 set ref 915* 920* 920 930 cu_$grow_stack_frame 001322 constant entry external dcl 862 ref 896 cumulative_rels 12 000010 internal static float bin(27) initial array level 2 dcl 52 set ref 891* 911* 911 928* 928 946 cur_color 000102 automatic fixed bin(17,0) array dcl 76 set ref 92* 378* 379* 381 381 381 381 381 381 cur_factors 2 000010 internal static float bin(27) initial array level 2 dcl 52 set ref 91* 281* cur_offs_factors 10 000010 internal static float bin(27) initial array level 2 dcl 52 set ref 91* 194 cur_offsets 6 000010 internal static float bin(27) initial array level 2 dcl 52 set ref 89* 194 cur_position 000010 internal static float bin(27) initial array level 2 dcl 52 set ref 89* 159* 946* 946 cur_x based float bin(27) level 2 dcl 67 set ref 156 161* 316 333 451 452 cur_y 1 based float bin(27) level 2 dcl 67 set ref 157 162* 317 334 460 461 current_sublist 20 000010 internal static fixed bin(18,0) level 2 dcl 52 set ref 104* 107 239* 253* 258* 263* default_screen_size_factor constant float bin(27) initial dcl 636 ref 666 749 879 delta_val parameter float bin(27) dcl 729 ref 727 744 delta_value 000337 automatic float bin(27) dcl 638 set ref 697* 699* 701* 703* 705* 707* 712 712 718 718 719* 719 723 744* 798 delta_value_x 000370 automatic float bin(27) dcl 852 set ref 876* 882 delta_value_y 000371 automatic float bin(27) dcl 852 set ref 877* 883 dirname 000035 internal static char(168) initial unaligned dcl 427 set ref 536* 557* display_list 21 000010 internal static fixed bin(18,0) level 2 dcl 52 set ref 107* 109* do_symbols 000400 automatic bit(1) dcl 864 set ref 885* 887 908 930 ename 000107 internal static char(32) initial unaligned dcl 427 set ref 529 531* 557* error_table_$badcall 001310 external static fixed bin(35,0) dcl 123 set ref 212* 322* 395* error_table_$out_of_sequence 001312 external static fixed bin(35,0) dcl 402 set ref 136* every_n 000401 automatic fixed bin(17,0) dcl 864 set ref 890* 893 894 930 exponent 000331 automatic fixed bin(17,0) dcl 638 set ref 692* 693 first_time 000034 internal static bit(1) initial dcl 76 set ref 527 539* first_val parameter float bin(27) dcl 729 ref 727 745 first_value 000340 automatic float bin(27) dcl 638 set ref 712* 718* 722 745* 798 first_value_x 000372 automatic float bin(27) dcl 852 set ref 873* 899 first_value_y 000373 automatic float bin(27) dcl 852 set ref 874* 900 fixed builtin function dcl 638 ref 712 718 750 754 814 827 fixed_bin_based based fixed bin(17,0) dcl 420 set ref 475* fixed_num 000324 automatic fixed bin(17,0) dcl 612 set ref 617* 618* 620* float_num parameter float bin(27) dcl 609 set ref 607 617 617 618 623* fudge 000456 automatic fixed bin(18,0) array dcl 235 set ref 242* 243* 245* 253* 263* graphic_chars_ 001316 constant entry external dcl 416 ref 560 804 821 graphic_chars_$init 001304 constant entry external dcl 87 ref 98 graphic_chars_$long_tb 001314 constant entry external dcl 416 ref 479 graphic_compiler_$display 001276 constant entry external dcl 2-21 ref 216 graphic_error_table_$lsm_blk_len 001324 external static fixed bin(35,0) dcl 237 ref 240 graphic_manipulator_$add_element 001270 constant entry external dcl 1-68 ref 239 graphic_manipulator_$assign_name 001264 constant entry external dcl 1-60 ref 109 graphic_manipulator_$create_array 001262 constant entry external dcl 1-55 ref 104 245 502 587 778 834 936 graphic_manipulator_$create_color 001260 constant entry external dcl 1-35 ref 381 graphic_manipulator_$create_position 001252 constant entry external dcl 1-9 ref 100 196 763 766 769 772 791 814 827 902 925 graphic_manipulator_$create_rotation 001256 constant entry external dcl 1-24 ref 496 785 graphic_manipulator_$create_scale 001254 constant entry external dcl 1-19 ref 296 578 graphic_manipulator_$find_structure 001266 constant entry external dcl 1-63 ref 571 graphic_manipulator_$get_struc 001274 constant entry external dcl 1-134 ref 557 graphic_manipulator_$init 001250 constant entry external dcl 1-3 ref 94 graphic_manipulator_$replace_element 001272 constant entry external dcl 1-71 ref 253 263 green_color defined fixed bin(17,0) dcl 368 set ref 381* hcs_$fs_get_path_name 001302 constant entry external dcl 76 ref 536 hcs_$make_ptr 001300 constant entry external dcl 76 ref 529 height parameter float bin(27) dcl 443 in procedure "internal_symbol" ref 441 472 473 height parameter float bin(27) dcl 409 in procedure "ccs_" set ref 407 437* 607 626* i 000252 automatic fixed bin(17,0) dcl 82 set ref 169* 171 172 673* 674 675* 797* 798 804 805 805* 810* 812 813 814 821 827 834 918* 925 931* 931 932* 936 indicator parameter fixed bin(17,0) dcl 120 in procedure "ccs_" set ref 118 144* indicator parameter fixed bin(17,0) dcl 150 in procedure "internal_plot" set ref 148 159 165 212* initialized 23 000010 internal static bit(1) initial level 2 dcl 52 set ref 113* 136 223* ioa_$rsnnl 001320 constant entry external dcl 424 ref 554 620 623 798 item parameter fixed bin(18,0) dcl 231 set ref 228 239* 243 j 000253 automatic fixed bin(17,0) dcl 82 set ref 798* 801* 801 804 804 916* 918 919* 919 922 922 923 923 last_height 16 000010 internal static float bin(27) initial level 2 dcl 52 set ref 91* 472 473* last_string_ended 14 000010 internal static float bin(27) initial array level 2 dcl 52 set ref 89* line_type parameter fixed bin(17,0) dcl 848 ref 846 885 890 913 log10 builtin function dcl 638 ref 691 logno 000330 automatic float bin(27) dcl 638 set ref 691* 692 max builtin function dcl 638 ref 324 675 maxel 000326 automatic float bin(27) dcl 638 set ref 669* 675* 675 678 681* 682 687* 687 688 716 718 min builtin function dcl 638 ref 674 minel 000325 automatic float bin(27) dcl 638 set ref 669* 674* 674 678 679 680* 682 686* 686 688 710 712 mod builtin function dcl 864 ref 169 930 movement 000257 automatic fixed bin(17,0) dcl 123 set ref 178* 183* 188* 192* 196* 200 206 913* 914* 925* n_points parameter fixed bin(17,0) dcl 631 ref 629 673 722 723 846 873 874 876 877 893 894 894 918 n_tics 000332 automatic fixed bin(17,0) dcl 638 set ref 666* 667* 691 695 named_display_list 22 000010 internal static fixed bin(18,0) level 2 dcl 52 set ref 109* 216* node 000254 automatic fixed bin(18,0) dcl 82 set ref 100* 103 196* 204* 296* 303* 381* 387* 502* 508* 834* 840* 887* 908 932 936* 942* node_fake 000251 automatic fixed bin(18,0) array dcl 82 set ref 103* 104* nondimensional 000333 automatic float bin(27) dcl 638 set ref 695* 697 699 701 703 705 null builtin function dcl 864 ref 95 95 136 136 200 200 206 206 212 212 219 219 299 299 304 304 322 322 383 383 389 389 395 395 483 483 498 498 504 504 510 510 529 529 530 531 531 559 559 563 563 573 573 582 582 589 589 774 774 780 780 787 787 823 823 830 830 836 836 836 836 841 841 858 904 904 938 938 943 943 pgs_ptr 000100 automatic pointer dcl 76 set ref 529* 530 536* precision parameter fixed bin(17,0) dcl 609 set ref 607 616 617 618 623* raw_dv 000336 automatic float bin(27) dcl 638 set ref 693* 695 697 699 701 703 705 707 real_height 000304 automatic float bin(27) dcl 422 in procedure "ccs_" set ref 472* 473* 475* 479 479 real_height parameter float bin(27) dcl 521 in procedure "get_special_symbol" ref 519 545 560 560 578 578 598 real_x 000302 automatic float bin(27) dcl 422 set ref 452* 455* 468* 470* real_y 000303 automatic float bin(27) dcl 422 set ref 461* 464* 468* 470* red_color defined fixed bin(17,0) dcl 367 set ref 381* rel_motion 000442 automatic float bin(27) array dcl 154 set ref 156* 157* 174 174 194* 194 196 196 rel_positions 4 000010 internal static float bin(27) initial array level 2 dcl 52 set ref 911 928 return_node parameter fixed bin(18,0) dcl 521 set ref 519 546* 560* 587* 599 save_cur_x 000466 automatic float bin(27) dcl 443 set ref 451* 455* 515* save_cur_y 000467 automatic float bin(27) dcl 443 set ref 460* 464* 515* saved_special_symbol_heights 000737 internal static float bin(27) initial array dcl 430 set ref 89* 545 550 598* saved_special_symbols 000117 internal static fixed bin(18,0) initial array dcl 430 set ref 89* 542 543 546 550 593 593 599* 600* scaling parameter float bin(27) dcl 274 set ref 272 281 309 319* 324* screen_size parameter float bin(27) dcl 401 ref 399 404 screen_size_factor 17 000010 internal static float bin(27) initial level 2 dcl 52 set ref 196 196 404* 479 479 487 488 560 560 578 578 666 749 755 814 827 879 882 883 887 946 sign builtin function dcl 638 ref 758 sind builtin function dcl 638 ref 490 492 spread 000327 automatic float bin(27) dcl 638 set ref 678* 679 682* 688* 691 695 static_info 000010 internal static structure level 1 dcl 52 set ref 156 157 161 162 293 294 296 296 316 317 319 319 319 324 324 333 334 335 336 346 347 348 349 357 358 359 360 451 452 452 456 460 461 461 465 490 490 492 492 899 900 902 902 922 923 925 925 step_size parameter fixed bin(17,0) dcl 631 ref 629 671 709 846 873 874 876 877 918 919 922 923 steps 000335 automatic fixed bin(17,0) dcl 638 set ref 671* 673 673 673 722 723 string parameter char unaligned dcl 443 in procedure "internal_symbol" set ref 441 475 479 479 483 483 string parameter char unaligned dcl 409 in procedure "ccs_" set ref 407 437* string_len parameter fixed bin(17,0) dcl 443 in procedure "internal_symbol" ref 441 468 475 479 479 483 483 515 string_len parameter fixed bin(17,0) dcl 409 in procedure "ccs_" set ref 407 437* sub_err_ 001306 constant entry external dcl 123 ref 95 136 200 206 212 219 299 304 322 383 389 395 483 498 504 510 531 559 563 573 582 589 774 780 787 823 830 836 841 904 938 943 substr builtin function dcl 638 ref 479 479 483 483 799 800 804 804 821 821 switch 000255 automatic fixed bin(17,0) dcl 123 set ref 165* 167 169 176 symbol_name 000305 automatic char(32) unaligned dcl 424 set ref 554* 557* 559* 571* 573* 589* symbol_no parameter fixed bin(17,0) dcl 521 in procedure "get_special_symbol" set ref 519 542 543 545 546 550 550 554* 593 593 598 599 600 symbol_no parameter fixed bin(17,0) dcl 848 in procedure "ccs_" set ref 846 887* temp 000476 automatic fixed bin(18,0) array dcl 521 in procedure "get_special_symbol" set ref 550* 571* 578* 587* 600 temp 000454 automatic fixed bin(18,0) dcl 234 in procedure "append_element" set ref 245* 253* 258 263* temp 000105 automatic fixed bin(18,0) array dcl 82 in procedure "ccs_" set ref 475* 479* 496* 502* 785* 791* 804* 805* 812* 813* 814* 821* 827* 834* temp_scale 000374 automatic float bin(27) dcl 852 set ref 879* 880* 882 883 tic_mark 000343 automatic fixed bin(18,0) dcl 734 set ref 778* 805 tic_vect 000356 automatic float bin(27) dcl 734 set ref 758* 763* 766* 772 791 814 827 title parameter char unaligned dcl 729 ref 727 821 821 title_len 000357 automatic fixed bin(17,0) dcl 734 set ref 819* 821 821 underflow 000362 stack reference condition dcl 740 ref 795 808 whoami parameter char unaligned dcl 443 in procedure "internal_symbol" set ref 441 468* 470* 475* 483* 498* 504* 510* 515* whoami parameter char unaligned dcl 521 in procedure "get_special_symbol" set ref 519 559* 563* 573* 582* 589* whoami 000260 automatic char(64) unaligned dcl 275 in procedure "ccs_" set ref 277* 289* 299* 304* whoami parameter char unaligned dcl 150 in procedure "internal_plot" set ref 148 200* 206* 212* 219* x_array parameter float bin(27) array dcl 848 ref 846 873 876 899 922 922 x_between_tics 000342 automatic float bin(27) dcl 734 set ref 751* 755* 769* x_factor 2 based float bin(27) level 2 dcl 67 set ref 293* 296* 319 319 324 335 x_offs_factor 10 based float bin(27) level 2 dcl 67 set ref 348* 359 x_offset 6 based float bin(27) level 2 dcl 67 set ref 346* 357 x_position parameter float bin(27) dcl 311 set ref 309 316* 329 333* x_rel 4 based float bin(27) level 2 dcl 67 set ref 899* 902* 922* 925* x_scale 000403 automatic float bin(27) dcl 864 set ref 882* 899 922 x_scaling parameter float bin(27) dcl 286 set ref 284 293 329 335* 339 348 353 359* x_string_ended 14 based float bin(27) level 2 dcl 67 set ref 452 456* 490* 490 x_string_ended_temp 000300 automatic float bin(27) dcl 414 set ref 479* 487* 487 490 492 x_zero parameter float bin(27) dcl 341 set ref 339 346 353 357* y_array parameter float bin(27) array dcl 848 ref 846 874 877 900 923 923 y_factor 3 based float bin(27) level 2 dcl 67 set ref 294* 296* 319 324 336 y_offs_factor 11 based float bin(27) level 2 dcl 67 set ref 349* 360 y_offset 7 based float bin(27) level 2 dcl 67 set ref 347* 358 y_position parameter float bin(27) dcl 311 set ref 309 317* 329 334* y_rel 5 based float bin(27) level 2 dcl 67 set ref 900* 902* 923* 925* y_scale 000404 automatic float bin(27) dcl 864 set ref 883* 900 923 y_scaling parameter float bin(27) dcl 286 set ref 284 294 329 336* 339 349 353 360* y_string_ended 15 based float bin(27) level 2 dcl 67 set ref 461 465* 492* 492 y_string_ended_temp 000301 automatic float bin(27) dcl 414 set ref 479* 488* 488 490 492 y_zero parameter float bin(27) dcl 341 set ref 339 347 353 358* NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. Any_device internal static fixed bin(17,0) initial dcl 3-9 Array internal static fixed bin(17,0) initial dcl 3-9 Blink internal static fixed bin(17,0) initial dcl 3-9 Blinking internal static fixed bin(17,0) initial dcl 3-9 Clipping internal static fixed bin(17,0) initial dcl 3-9 Color internal static fixed bin(17,0) initial dcl 3-9 Dash_dotted internal static fixed bin(17,0) initial dcl 3-9 Dashed internal static fixed bin(17,0) initial dcl 3-9 Datablock internal static fixed bin(17,0) initial dcl 3-9 Dotted internal static fixed bin(17,0) initial dcl 3-9 Full_intensity internal static fixed bin(17,0) initial dcl 3-9 Half_intensity internal static fixed bin(17,0) initial dcl 3-9 Insensitive internal static fixed bin(17,0) initial dcl 3-9 Intensity internal static fixed bin(17,0) initial dcl 3-9 Invisible internal static fixed bin(17,0) initial dcl 3-9 Joystick internal static fixed bin(17,0) initial dcl 3-9 Keyboard internal static fixed bin(17,0) initial dcl 3-9 Left internal static fixed bin(17,0) initial dcl 3-9 Light_pen internal static fixed bin(17,0) initial dcl 3-9 Linetype internal static fixed bin(17,0) initial dcl 3-9 List internal static fixed bin(17,0) initial dcl 3-9 Long_dashed internal static fixed bin(17,0) initial dcl 3-9 Lower_right internal static fixed bin(17,0) initial dcl 3-9 Mouse internal static fixed bin(17,0) initial dcl 3-9 Null internal static fixed bin(17,0) initial dcl 3-9 On_dup_error internal static fixed bin(17,0) initial dcl 3-9 On_dup_source internal static fixed bin(17,0) initial dcl 3-9 On_dup_target_then_nulls internal static fixed bin(17,0) initial dcl 3-9 On_dup_target_then_source internal static fixed bin(17,0) initial dcl 3-9 Point internal static fixed bin(17,0) initial dcl 3-9 Right internal static fixed bin(17,0) initial dcl 3-9 Rotation internal static fixed bin(17,0) initial dcl 3-9 Scaling internal static fixed bin(17,0) initial dcl 3-9 Sensitive internal static fixed bin(17,0) initial dcl 3-9 Sensitivity internal static fixed bin(17,0) initial dcl 3-9 Setpoint internal static fixed bin(17,0) initial dcl 3-9 Solid internal static fixed bin(17,0) initial dcl 3-9 Steady internal static fixed bin(17,0) initial dcl 3-9 Symbol internal static fixed bin(17,0) initial dcl 3-9 Tablet_and_pen internal static fixed bin(17,0) initial dcl 3-9 Terminal_program internal static fixed bin(17,0) initial dcl 3-9 Text internal static fixed bin(17,0) initial dcl 3-9 Trackball internal static fixed bin(17,0) initial dcl 3-9 Upper_left internal static fixed bin(17,0) initial dcl 3-9 Upper_right internal static fixed bin(17,0) initial dcl 3-9 cleanup 000000 stack reference condition dcl 864 gc_$d 000000 constant entry external dcl 2-21 gc_$d_switch 000000 constant entry external dcl 2-26 gc_$da 000000 constant entry external dcl 2-11 gc_$da_switch 000000 constant entry external dcl 2-16 gc_$display 000000 constant entry external dcl 2-21 gc_$display_append 000000 constant entry external dcl 2-11 gc_$display_append_switch 000000 constant entry external dcl 2-16 gc_$display_name 000000 constant entry external dcl 2-51 gc_$display_name_append 000000 constant entry external dcl 2-41 gc_$display_name_append_switch 000000 constant entry external dcl 2-46 gc_$display_name_switch 000000 constant entry external dcl 2-56 gc_$display_switch 000000 constant entry external dcl 2-26 gc_$dn 000000 constant entry external dcl 2-51 gc_$dn_switch 000000 constant entry external dcl 2-56 gc_$dna 000000 constant entry external dcl 2-41 gc_$dna_switch 000000 constant entry external dcl 2-46 gc_$l 000000 constant entry external dcl 2-31 gc_$l_switch 000000 constant entry external dcl 2-36 gc_$ln 000000 constant entry external dcl 2-61 gc_$ln_switch 000000 constant entry external dcl 2-66 gc_$load 000000 constant entry external dcl 2-31 gc_$load_name 000000 constant entry external dcl 2-61 gc_$load_name_switch 000000 constant entry external dcl 2-66 gc_$load_switch 000000 constant entry external dcl 2-36 gc_$prune_tree 000000 constant entry external dcl 2-71 gc_$return_string 000000 constant entry external dcl 2-6 gc_$rs 000000 constant entry external dcl 2-6 gc_$tree_ptr 000000 constant entry external dcl 2-3 gm_$add_element 000000 constant entry external dcl 1-68 gm_$assign_name 000000 constant entry external dcl 1-60 gm_$carray 000000 constant entry external dcl 1-55 gm_$cclip 000000 constant entry external dcl 1-29 gm_$ccolor 000000 constant entry external dcl 1-35 gm_$cdata 000000 constant entry external dcl 1-45 gm_$clist 000000 constant entry external dcl 1-50 gm_$cmode 000000 constant entry external dcl 1-14 gm_$cpos 000000 constant entry external dcl 1-9 gm_$create_array 000000 constant entry external dcl 1-55 gm_$create_clip 000000 constant entry external dcl 1-29 gm_$create_color 000000 constant entry external dcl 1-35 gm_$create_data 000000 constant entry external dcl 1-45 gm_$create_list 000000 constant entry external dcl 1-50 gm_$create_mode 000000 constant entry external dcl 1-14 gm_$create_position 000000 constant entry external dcl 1-9 gm_$create_rotation 000000 constant entry external dcl 1-24 gm_$create_scale 000000 constant entry external dcl 1-19 gm_$create_text 000000 constant entry external dcl 1-40 gm_$crot 000000 constant entry external dcl 1-24 gm_$cscale 000000 constant entry external dcl 1-19 gm_$ctext 000000 constant entry external dcl 1-40 gm_$ecolor 000000 constant entry external dcl 1-96 gm_$edata 000000 constant entry external dcl 1-129 gm_$elist 000000 constant entry external dcl 1-109 gm_$emap 000000 constant entry external dcl 1-101 gm_$emode 000000 constant entry external dcl 1-91 gm_$epos 000000 constant entry external dcl 1-86 gm_$esymbol 000000 constant entry external dcl 1-119 gm_$esymtab 000000 constant entry external dcl 1-114 gm_$etext 000000 constant entry external dcl 1-124 gm_$examine_color 000000 constant entry external dcl 1-96 gm_$examine_contents 000000 constant entry external dcl 1-106 gm_$examine_data 000000 constant entry external dcl 1-129 gm_$examine_list 000000 constant entry external dcl 1-109 gm_$examine_mapping 000000 constant entry external dcl 1-101 gm_$examine_mode 000000 constant entry external dcl 1-91 gm_$examine_position 000000 constant entry external dcl 1-86 gm_$examine_symbol 000000 constant entry external dcl 1-119 gm_$examine_symtab 000000 constant entry external dcl 1-114 gm_$examine_text 000000 constant entry external dcl 1-124 gm_$examine_type 000000 constant entry external dcl 1-83 gm_$find_structure 000000 constant entry external dcl 1-63 gm_$fstruc 000000 constant entry external dcl 1-63 gm_$get_struc 000000 constant entry external dcl 1-134 gm_$gstruc 000000 constant entry external dcl 1-134 gm_$init 000000 constant entry external dcl 1-3 gm_$pstruc 000000 constant entry external dcl 1-139 gm_$put_struc 000000 constant entry external dcl 1-139 gm_$remove_symbol 000000 constant entry external dcl 1-77 gm_$replace_element 000000 constant entry external dcl 1-71 gm_$replace_node 000000 constant entry external dcl 1-74 gm_$replicate 000000 constant entry external dcl 1-80 gm_$save_file 000000 constant entry external dcl 1-144 gm_$segp 000000 constant entry external dcl 1-6 gm_$use_file 000000 constant entry external dcl 1-147 graphic_compiler_$d 000000 constant entry external dcl 2-21 graphic_compiler_$d_switch 000000 constant entry external dcl 2-26 graphic_compiler_$da 000000 constant entry external dcl 2-11 graphic_compiler_$da_switch 000000 constant entry external dcl 2-16 graphic_compiler_$display_append 000000 constant entry external dcl 2-11 graphic_compiler_$display_append_switch 000000 constant entry external dcl 2-16 graphic_compiler_$display_name 000000 constant entry external dcl 2-51 graphic_compiler_$display_name_append 000000 constant entry external dcl 2-41 graphic_compiler_$display_name_append_switch 000000 constant entry external dcl 2-46 graphic_compiler_$display_name_switch 000000 constant entry external dcl 2-56 graphic_compiler_$display_switch 000000 constant entry external dcl 2-26 graphic_compiler_$dn 000000 constant entry external dcl 2-51 graphic_compiler_$dn_switch 000000 constant entry external dcl 2-56 graphic_compiler_$dna 000000 constant entry external dcl 2-41 graphic_compiler_$dna_switch 000000 constant entry external dcl 2-46 graphic_compiler_$l 000000 constant entry external dcl 2-31 graphic_compiler_$l_switch 000000 constant entry external dcl 2-36 graphic_compiler_$ln 000000 constant entry external dcl 2-61 graphic_compiler_$ln_switch 000000 constant entry external dcl 2-66 graphic_compiler_$load 000000 constant entry external dcl 2-31 graphic_compiler_$load_name 000000 constant entry external dcl 2-61 graphic_compiler_$load_name_switch 000000 constant entry external dcl 2-66 graphic_compiler_$load_switch 000000 constant entry external dcl 2-36 graphic_compiler_$prune_tree 000000 constant entry external dcl 2-71 graphic_compiler_$return_string 000000 constant entry external dcl 2-6 graphic_compiler_$rs 000000 constant entry external dcl 2-6 graphic_compiler_$tree_ptr 000000 constant entry external dcl 2-3 graphic_manipulator_$carray 000000 constant entry external dcl 1-55 graphic_manipulator_$cclip 000000 constant entry external dcl 1-29 graphic_manipulator_$ccolor 000000 constant entry external dcl 1-35 graphic_manipulator_$cdata 000000 constant entry external dcl 1-45 graphic_manipulator_$clist 000000 constant entry external dcl 1-50 graphic_manipulator_$cmode 000000 constant entry external dcl 1-14 graphic_manipulator_$cpos 000000 constant entry external dcl 1-9 graphic_manipulator_$create_clip 000000 constant entry external dcl 1-29 graphic_manipulator_$create_data 000000 constant entry external dcl 1-45 graphic_manipulator_$create_list 000000 constant entry external dcl 1-50 graphic_manipulator_$create_mode 000000 constant entry external dcl 1-14 graphic_manipulator_$create_text 000000 constant entry external dcl 1-40 graphic_manipulator_$crot 000000 constant entry external dcl 1-24 graphic_manipulator_$cscale 000000 constant entry external dcl 1-19 graphic_manipulator_$ctext 000000 constant entry external dcl 1-40 graphic_manipulator_$ecolor 000000 constant entry external dcl 1-96 graphic_manipulator_$edata 000000 constant entry external dcl 1-129 graphic_manipulator_$elist 000000 constant entry external dcl 1-109 graphic_manipulator_$emap 000000 constant entry external dcl 1-101 graphic_manipulator_$emode 000000 constant entry external dcl 1-91 graphic_manipulator_$epos 000000 constant entry external dcl 1-86 graphic_manipulator_$esymbol 000000 constant entry external dcl 1-119 graphic_manipulator_$esymtab 000000 constant entry external dcl 1-114 graphic_manipulator_$etext 000000 constant entry external dcl 1-124 graphic_manipulator_$examine_color 000000 constant entry external dcl 1-96 graphic_manipulator_$examine_contents 000000 constant entry external dcl 1-106 graphic_manipulator_$examine_data 000000 constant entry external dcl 1-129 graphic_manipulator_$examine_list 000000 constant entry external dcl 1-109 graphic_manipulator_$examine_mapping 000000 constant entry external dcl 1-101 graphic_manipulator_$examine_mode 000000 constant entry external dcl 1-91 graphic_manipulator_$examine_position 000000 constant entry external dcl 1-86 graphic_manipulator_$examine_symbol 000000 constant entry external dcl 1-119 graphic_manipulator_$examine_symtab 000000 constant entry external dcl 1-114 graphic_manipulator_$examine_text 000000 constant entry external dcl 1-124 graphic_manipulator_$examine_type 000000 constant entry external dcl 1-83 graphic_manipulator_$fstruc 000000 constant entry external dcl 1-63 graphic_manipulator_$gstruc 000000 constant entry external dcl 1-134 graphic_manipulator_$pstruc 000000 constant entry external dcl 1-139 graphic_manipulator_$put_struc 000000 constant entry external dcl 1-139 graphic_manipulator_$remove_symbol 000000 constant entry external dcl 1-77 graphic_manipulator_$replace_node 000000 constant entry external dcl 1-74 graphic_manipulator_$replicate 000000 constant entry external dcl 1-80 graphic_manipulator_$save_file 000000 constant entry external dcl 1-144 graphic_manipulator_$segp 000000 constant entry external dcl 1-6 graphic_manipulator_$use_file 000000 constant entry external dcl 1-147 NAMES DECLARED BY EXPLICIT CONTEXT. append_element 006424 constant entry internal dcl 228 ref 204 303 387 508 840 942 append_scales 001510 constant label dcl 296 ref 282 apply_offsets 006052 constant label dcl 194 ref 190 axis 003227 constant entry external dcl 727 axis_err 004431 constant label dcl 830 ref 793 817 bad_color 002305 constant label dcl 395 ref 375 376 bad_line 005213 constant label dcl 904 ref 897 926 calcomp_compatible_subrs_ 000765 constant entry external dcl 18 ccs_ 000755 constant entry external dcl 18 check_init 005671 constant entry internal dcl 134 ref 130 279 291 314 331 344 355 373 435 659 742 871 close_picture 006337 constant label dcl 216 ref 167 dfact 001464 constant entry external dcl 284 dwhr 001770 constant entry external dcl 329 error_return 001422 constant label dcl 270 ref 201 207 214 220 484 499 505 511 533 564 574 583 590 factor 001426 constant entry external dcl 272 get_special_symbol 007475 constant entry internal dcl 519 ref 475 887 indicator_out_of_bounds 006265 constant label dcl 212 ref 171 172 init_err 001147 constant label dcl 95 ref 101 105 111 internal_plot 005745 constant entry internal dcl 148 ref 144 468 470 515 747 886 internal_symbol 006562 constant entry internal dcl 441 ref 437 626 line 004705 constant entry external dcl 846 newpen 002104 constant entry external dcl 363 number 002477 constant entry external dcl 607 offset 002021 constant entry external dcl 339 pgs_err 007551 constant label dcl 531 ref 537 plot 001364 constant entry external dcl 118 plot_common 006066 constant label dcl 196 ref 181 186 plot_label 000000 constant label array(2:23) dcl 178 ref 176 plots 000775 constant entry external dcl 50 scale 002676 constant entry external dcl 629 set_dimension 002364 constant entry external dcl 399 strip_blanks 004070 constant label dcl 799 ref 802 sym_unknown 007706 constant label dcl 554 ref 542 543 symbol 002406 constant entry external dcl 407 tic_err 003503 constant label dcl 774 ref 764 767 770 where 001656 constant entry external dcl 309 wofst 002052 constant entry external dcl 353 NAMES DECLARED BY CONTEXT OR IMPLICATION. hbound builtin function ref 543 593 lbound builtin function ref 542 593 STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 11210 12536 10557 11220 Length 13176 10557 1326 423 431 1240 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME ccs_ 776 external procedure is an external procedure. check_init internal procedure shares stack frame of external procedure ccs_. internal_plot internal procedure shares stack frame of external procedure ccs_. append_element internal procedure shares stack frame of external procedure ccs_. internal_symbol internal procedure shares stack frame of external procedure ccs_. get_special_symbol internal procedure shares stack frame of external procedure ccs_. on unit on line 795 64 on unit STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 static_info ccs_ 000034 first_time ccs_ 000035 dirname ccs_ 000107 ename ccs_ 000117 saved_special_symbols ccs_ 000737 saved_special_symbol_heights ccs_ STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME ccs_ 000100 pgs_ptr ccs_ 000102 cur_color ccs_ 000105 temp ccs_ 000251 node_fake ccs_ 000252 i ccs_ 000253 j ccs_ 000254 node ccs_ 000255 switch ccs_ 000256 code ccs_ 000257 movement ccs_ 000260 whoami ccs_ 000300 x_string_ended_temp ccs_ 000301 y_string_ended_temp ccs_ 000302 real_x ccs_ 000303 real_y ccs_ 000304 real_height ccs_ 000305 symbol_name ccs_ 000315 char_number ccs_ 000323 char_len ccs_ 000324 fixed_num ccs_ 000325 minel ccs_ 000326 maxel ccs_ 000327 spread ccs_ 000330 logno ccs_ 000331 exponent ccs_ 000332 n_tics ccs_ 000333 nondimensional ccs_ 000334 compensation ccs_ 000335 steps ccs_ 000336 raw_dv ccs_ 000337 delta_value ccs_ 000340 first_value ccs_ 000341 adj_axis_len ccs_ 000342 x_between_tics ccs_ 000343 tic_mark ccs_ 000344 a ccs_ 000356 tic_vect ccs_ 000357 title_len ccs_ 000360 alignment ccs_ 000370 delta_value_x ccs_ 000371 delta_value_y ccs_ 000372 first_value_x ccs_ 000373 first_value_y ccs_ 000374 temp_scale ccs_ 000375 alloc_temp_length ccs_ 000376 atp ccs_ 000400 do_symbols ccs_ 000401 every_n ccs_ 000402 counter ccs_ 000403 x_scale ccs_ 000404 y_scale ccs_ 000442 rel_motion internal_plot 000454 temp append_element 000456 fudge append_element 000466 save_cur_x internal_symbol 000467 save_cur_y internal_symbol 000476 temp get_special_symbol THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. fx1_to_fl2 r_e_as r_ne_as alloc_cs call_ext_out_desc call_ext_out return fl2_to_fx1 sign mod_fx1 enable shorten_stack ext_entry ext_entry_desc int_entry trunc_fx2 divide_fx1 sind cosd log10 real_p_int THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. cu_$grow_stack_frame graphic_chars_ graphic_chars_$init graphic_chars_$long_tb graphic_compiler_$display graphic_manipulator_$add_element graphic_manipulator_$assign_name graphic_manipulator_$create_array graphic_manipulator_$create_color graphic_manipulator_$create_position graphic_manipulator_$create_rotation graphic_manipulator_$create_scale graphic_manipulator_$find_structure graphic_manipulator_$get_struc graphic_manipulator_$init graphic_manipulator_$replace_element hcs_$fs_get_path_name hcs_$make_ptr ioa_$rsnnl sub_err_ THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$badcall error_table_$out_of_sequence graphic_error_table_$lsm_blk_len LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 858 000750 18 000754 20 000773 50 000774 89 001003 91 001077 92 001125 94 001136 95 001145 98 001217 100 001224 101 001252 103 001254 104 001265 105 001314 107 001316 109 001321 111 001352 113 001354 115 001357 118 001360 130 001372 144 001373 270 001422 272 001423 277 001437 279 001442 281 001443 282 001457 284 001460 289 001477 291 001502 293 001503 294 001506 296 001510 298 001530 299 001532 300 001577 303 001600 304 001602 306 001651 309 001652 314 001667 316 001670 317 001674 319 001676 322 001705 324 001754 327 001762 329 001763 331 002003 333 002004 334 002010 335 002012 336 002014 337 002016 339 002017 344 002034 346 002035 347 002041 348 002043 349 002045 351 002047 353 002050 355 002065 357 002066 358 002072 359 002074 360 002076 361 002100 363 002101 373 002112 375 002113 376 002117 378 002121 379 002131 381 002135 382 002154 383 002156 384 002226 387 002227 388 002231 389 002233 390 002303 393 002304 395 002305 397 002361 399 002362 404 002372 405 002377 407 002400 435 002425 437 002426 439 002470 607 002471 616 002510 617 002513 618 002532 620 002546 621 002574 623 002575 626 002627 627 002670 629 002671 659 002707 666 002710 667 002721 669 002724 671 002737 673 002744 674 002771 675 003010 676 003015 678 003020 679 003023 680 003026 681 003030 682 003032 683 003034 686 003035 687 003037 688 003042 691 003044 692 003053 693 003055 695 003064 697 003066 699 003073 701 003101 703 003107 705 003115 707 003123 709 003126 710 003131 711 003136 712 003140 713 003147 716 003150 717 003155 718 003157 719 003166 722 003171 723 003206 725 003217 727 003220 742 003250 744 003251 745 003254 747 003256 749 003306 750 003312 751 003322 752 003324 754 003325 755 003331 758 003333 760 003341 761 003346 763 003350 764 003373 766 003375 767 003421 769 003423 770 003447 772 003451 773 003501 774 003503 775 003553 778 003554 779 003603 780 003605 781 003655 785 003656 786 003700 787 003702 788 003752 791 003753 793 004003 795 004005 797 004022 798 004033 799 004070 800 004074 801 004077 802 004101 804 004102 805 004153 806 004163 808 004165 810 004166 812 004174 813 004177 814 004201 817 004236 819 004240 821 004246 822 004315 823 004320 824 004370 827 004371 829 004427 830 004431 831 004501 834 004502 835 004532 836 004534 837 004621 840 004622 841 004624 844 004676 846 004677 871 004713 873 004714 874 004732 876 004743 877 004754 879 004761 880 004770 882 004772 883 004776 885 005001 886 005004 887 005017 890 005055 891 005063 893 005075 894 005104 896 005124 897 005136 899 005140 900 005155 902 005167 903 005211 904 005213 905 005263 908 005264 909 005272 911 005274 913 005307 914 005315 915 005317 916 005321 918 005322 919 005342 920 005344 922 005345 923 005370 925 005407 926 005433 928 005435 930 005450 931 005456 932 005457 934 005463 936 005465 937 005525 938 005527 939 005577 942 005600 943 005602 946 005654 948 005670 134 005671 136 005672 140 005744 148 005745 156 005756 157 005763 159 005766 161 006005 162 006007 165 006011 167 006017 169 006021 171 006024 172 006026 174 006030 176 006035 178 006037 181 006041 183 006042 186 006044 188 006045 190 006047 192 006050 194 006052 196 006066 199 006116 200 006120 201 006177 204 006200 205 006202 206 006204 207 006263 210 006264 212 006265 214 006336 216 006337 218 006347 219 006351 220 006420 223 006421 224 006423 228 006424 239 006426 240 006446 242 006454 243 006455 245 006457 247 006505 253 006511 255 006532 258 006536 263 006541 265 006561 441 006562 450 006600 451 006604 452 006607 453 006611 455 006612 456 006614 459 006617 460 006622 461 006624 462 006626 464 006627 465 006631 468 006633 470 006665 472 006713 473 006723 475 006726 479 006756 482 007034 483 007037 484 007122 487 007124 488 007130 490 007133 492 007152 496 007171 497 007214 498 007216 499 007265 502 007266 503 007315 504 007317 505 007366 508 007367 509 007371 510 007373 511 007442 515 007443 517 007474 519 007475 527 007506 529 007511 530 007545 531 007551 533 007625 536 007626 537 007660 539 007662 542 007664 543 007667 545 007671 546 007674 547 007677 550 007700 554 007706 557 007736 558 007770 559 007772 560 010045 562 010112 563 010114 564 010163 567 010164 571 010165 572 010212 573 010214 574 010267 578 010270 581 010322 582 010324 583 010373 587 010374 588 010424 589 010426 590 010504 593 010505 598 010512 599 010516 600 010520 603 010522 ----------------------------------------------------------- Historical Background This edition of the Multics software materials and documentation is provided and donated to Massachusetts Institute of Technology by Group BULL including BULL HN Information Systems Inc. as a contribution to computer science knowledge. This donation is made also to give evidence of the common contributions of Massachusetts Institute of Technology, Bell Laboratories, General Electric, Honeywell Information Systems Inc., Honeywell BULL Inc., Groupe BULL and BULL HN Information Systems Inc. to the development of this operating system. Multics development was initiated by Massachusetts Institute of Technology Project MAC (1963-1970), renamed the MIT Laboratory for Computer Science and Artificial Intelligence in the mid 1970s, under the leadership of Professor Fernando Jose Corbato. Users consider that Multics provided the best software architecture for managing computer hardware properly and for executing programs. Many subsequent operating systems incorporated Multics principles. Multics was distributed in 1975 to 2000 by Group Bull in Europe , and in the U.S. by Bull HN Information Systems Inc., as successor in interest by change in name only to Honeywell Bull Inc. and Honeywell Information Systems Inc. . ----------------------------------------------------------- Permission to use, copy, modify, and distribute these programs and their documentation for any purpose and without fee is hereby granted,provided that the below copyright notice and historical background appear in all copies and that both the copyright notice and historical background and this permission notice appear in supporting documentation, and that the names of MIT, HIS, BULL or BULL HN not be used in advertising or publicity pertaining to distribution of the programs without specific prior written permission. Copyright 1972 by Massachusetts Institute of Technology and Honeywell Information Systems Inc. Copyright 2006 by BULL HN Information Systems Inc. Copyright 2006 by Bull SAS All Rights Reserved