/* ***************************************************************************** /* /* GEOLOGICAL SURVEY OF CANADA /* --------------------------- /* /* Name: legend.aml /* Usage: LEGEND {legend_ascii_file} {graphics_file} /* Arc version: 7.0.3 /* Module: ARCPLOT /* OS: Solaris 2.4 /* Platform: Sun SPARCstation10 /* /* Purpose: Creates a geologic map legend by reading an ascii file /* containing codes. These codes are listed in the file /* gsc70/commands/arcplot/legend.doc. /* /* Called by: user /* Calls made: none /* /* History: Nov 96 - First release, original coding by Vic Dohar /* /* ***************************************************************************** /* /* CROWN COPYRIGHTS RESERVED /* /* NO GUARANTEE IS MADE BY THE AUTHOR(S) OR THE GEOLOGICAL SURVEY OF /* CANADA REGARDING EITHER THE ACCURACY OF THIS PROGRAM OR THE PROPER /* EXECUTION ON ALL COMPUTER SYSTEMS. /* /* ***************************************************************************** /* AML setup &args asciifile grafile &severity &warning &ignore &severity &error &routine ERROR &if [show &echo] = &OFF &then &messages &off &all &else &messages &on /* Change AML special characters for variable substitution &setchar &substitution \ /* Delete any legend global variables used on constructing previous legend &dv .leg$* /* Check if ascii file given as argument &if [null \asciifile\] &then &s asciifile [joinfile legend asc -ext] &else &do /* Check if skipped &if [quote \asciifile\] = '#' &then &s asciifile [joinfile legend asc -ext] &end /* else do /* Check if ascii file exists &if not [exists \asciifile\ -file] &then &do &type &type Ascii file \asciifile\ does not exist &setchar &standard &return &end /* then do /* Check if plotting legend to current page setup or to separate letter size /* pages as a series of graphic files &if [null \grafile\] &then &s page .FALSE. &else &do &s page .TRUE. /* Get current page size &s page_size [unquote [subst [show pagesize] , ' ']] /* Get current size of ACRPLOT screen &s display_size [unquote [subst [show window [unquote [extract 1 ~ [show windows all]]] size] , ' ']] /* Close and save current map composition &if not [null [show map]] &then &do &s map_composition [show map] MAP END &end /* then do &else &s map composition /* Initialize page counter &s page_counter 1 &call NEWPAGE &end /* else do /* Set page unit factor (P) depending on current pageunits; all coordinate /* calculations are based on pageunits being in inches &select [show pageunit] &when INCHES &s P 1 &when CM &s P 2.54 &otherwise &do &type &type Page units must be either INCHES or CM &setchar &standard &return &end /* otherwise &end /* select /* Variable for defaults for text characteristics /* All text sizes are given in points (72 points = 1 inch) /* The value of these variables can be altered using the SET command &s .leg$bkt_font 'Triumvirate Light' &s .leg$bkt_size 10 &s .leg$bkt_colour CMYK -1 -1 -1 100 &s .leg$box_font 'Triumvirate' &s .leg$box_size 10 &s .leg$box_colour CMYK -1 -1 -1 100 &s .leg$desc_font 'Triumvirate Light Italic' &s .leg$desc_size 8 &s .leg$desc_colour CMYK -1 -1 -1 100 &s .leg$headingl_font 'Triumvirate Light' &s .leg$headingl_size 9 &s .leg$headingl_colour CMYK -1 -1 -1 100 &s .leg$headingi_font 'Triumvirate Light' &s .leg$headingi_size 8 &s .leg$headingi_colour CMYK -1 -1 -1 100 &s .leg$headingb_font 'Triumvirate Light' &s .leg$headingb_size 8 &s .leg$headingb_colour CMYK -1 -1 -1 100 &s .leg$headingd_font 'Triumvirate Light Italic' &s .leg$headingd_size 8 &s .leg$headingd_colour CMYK -1 -1 -1 100 &s .leg$note_font 'Triumvirate Light Italic' &s .leg$note_size 8 &s .leg$note_colour CMYK -1 -1 -1 100 &s .leg$text_font 'Triumvirate Light Italic' &s .leg$text_size 8 &s .leg$text_colour CMYK -1 -1 -1 100 &s .leg$title_font 'Triumvirate Light' &s .leg$title_size 10 &s .leg$title_colour CMYK -1 -1 -1 100 /* Variables for default line spacing between legend elements /* Line spacing is measured in points (72 points = 1 inch), unless otherwise /* stated &s .leg$bkt_bottom_to_bkt_top [calc 3 * ( 72 / 25.4 )] &s .leg$bkt_bottom_to_box [calc 5 * ( 72 / 25.4 )] &s .leg$bkt_bottom_to_heading [calc 5 * ( 72 / 25.4 )] &s .leg$bkt_bottom_to_note [calc 5 * ( 72 / 25.4 )] &s .leg$bkt_bottom_to_text [calc 5 * ( 72 / 25.4 )] &s .leg$bkt_top_to_bkt_bottom 0 &s .leg$bkt_top_to_box [calc 3 * ( 72 / 25.4 )] &s .leg$bkt_top_to_heading [calc 5 * ( 72 / 25.4 )] &s .leg$bkt_top_to_note [calc 5 * ( 72 / 25.4 )] &s .leg$bkt_top_to_text [calc 5 * ( 72 / 25.4 )] &s .leg$box_to_bkt_bottom [calc 3 * ( 72 / 25.4 )] &s .leg$box_to_bkt_top [calc 5 * ( 72 / 25.4 )] &s .leg$box_to_box 0 &s .leg$box_to_heading 20 &s .leg$box_to_note 20 &s .leg$box_to_text 20 &s .leg$heading_to_bkt_top [calc 3 * ( 72 / 25.4 )] &s .leg$heading_to_box 4 &s .leg$heading_to_heading 10 &s .leg$heading_to_note 15 &s .leg$heading_to_text 15 &s .leg$note_to_bkt_bottom [calc 3 * ( 72 / 25.4 )] &s .leg$note_to_bkt_top [calc 3 * ( 72 / 25.4 )] &s .leg$note_to_box 15 &s .leg$note_to_heading 20 &s .leg$note_to_note 20 &s .leg$note_to_text 20 &s .leg$start_to_bkt_top 0 &s .leg$start_to_box 0 &s .leg$start_to_heading 10 &s .leg$start_to_note 0 &s .leg$start_to_text 10 &s .leg$symbol_to_text 13 &s .leg$text_to_bkt_bottom [calc 3 * ( 72 / 25.4 )] &s .leg$text_to_bkt_top [calc 5 * ( 72 / 25.4 )] &s .leg$text_to_box 10 &s .leg$text_to_heading 20 &s .leg$text_to_note 20 &s .leg$text_to_text 20 /* Variables for other properties of legend construction &s .leg$bkt_line_size 0.007 /* line thickness of bracket &s .leg$bkt_line_colour CMYK -1 -1 -1 100 /* line colour of bracket &s .leg$bkt_width 3 /* width of bracket from end-stem-point &s .leg$bkt_text_offset 1 /* text offset in X from point (mm) &s .leg$bkt_units 25.4 /* factor for units in BRACKET command &s .leg$box_height 10 /* box height (mm) &s .leg$box_width 18 /* box width (mm) &s .leg$box_line_spacing 72 /* factor for text only in boxes (points) &s .leg$box_indent 25.4 /* factor for text only in boxes (mm) &s .leg$column_width 5.0 /* column width (inches) &s .leg$column_gap 0.5 /* Column gap (inches) &s .leg$desc_indent 5 /* description indent from margin (picas) &s .leg$indent 6 /* factor for indenting &s .leg$line_size 0.010 /* box line thickness (inches) &s .leg$line_colour CMYK -1 -1 -1 100 /* box colour &s .leg$line_space .FALSE. /* control for spacing between boxes &s .leg$line_spacing 72 /* factor for line spacing &s .leg$lineset [show lineset] /* current lineset &s .leg$markerset [show markerset] /* current markerset &s .leg$textset [show textset] /* current textset &s .leg$shadeset [show shadeset] /* current shadeset &s .leg$space 14 /* for blank entry between boxes (points) &s .leg$sub_units 25.4 /* factor for X,Y in SUB commands &s .leg$subcover_units 25.4 /* factor for map units for cover &s .leg$textmask_shape RECTANGLE /* shape of text mask for pattern fills &s .leg$textmask_size 0.03 /* size of text mask buffer around text &s .leg$textmask_colour WHITE /* initial colour of text mask /* Default ARCPLOT settings TEXTQUALITY PROPORTIONAL TEXTSTYLE TYPESET TEXTANGLE 0 /* Open legend ascii file, read first line and set origin of legend &s file [open \asciifile\ openstatus -read] &s line [unquote [read \file\ readstatus]] &if \readstatus\ <> 0 &then &do &type &setchar &standard &return &warning Could not open file \asciifile\ successfully &end /* then do /* ============================================================================ /* /* ORIGIN /* /* Syntax: ORIGIN {PAGE} /* ORIGIN /* /* Sets the upper-left coordinate as the starting point for plotting the /* legend. Must be the first line in the ascii file (only if not plotting to /* page). /* Check if not plotting to page &if not \page\ &then &do /* Check for ORIGIN command on first line &if [upcase [extract 1 \line\]] = ORIGIN &then &do /* Check for required arguments &if not [null [extract 3 \line\]] &then &do /* Check if coordinates are numeric &if [type [extract 2 \line\]] < 0 and [type [extract 3 \line\]] < 0 ~ &then &do /* Check if entering either MAP or PAGE argument &if [null [extract 4 \line\]] &then &do /* Set legend origin coordinates &s .leg$x_origin [extract 2 \line\] &s .leg$y_origin [extract 3 \line\] &end /* then do &else &do /* Set legend origin coordinates based on coordinates being either /* in MAP or PAGE units &select [upcase [extract 4 \line\]] &when PAGE, # &do &s .leg$x_origin [extract 2 \line\] &s .leg$y_origin [extract 3 \line\] &end /* when PAGE, # &when MAP &do /* Convert map coordinates to page coordinates &s .leg$x_origin [extract 1 [show convert map [extract 2 \line\] ~ [extract 3 \line\] page]] &s .leg$y_origin [extract 2 [show convert map [extract 2 \line\] ~ [extract 3 \line\] page]] &end /* when MAP &otherwise &do &type &setchar &standard &s x [close -all] &return &warning Coordinates must be either MAP or PAGE (line 1) &end /* otherwise &end /* select &end /* else do /* Set initial coordinates for first column &s .leg$x \.leg$x_origin\ &s .leg$y \.leg$y_origin\ &end /* then do &else &do &type &setchar &standard &s x [close -all] &return &warning Invalid coordinates for ORIGIN (line 1) &end /* else do &end /* then do &else &do &type &setchar &standard &s x [close -all] &return &warning Missing required arguments for ORIGIN (line 1) &end /* else do &end /* then do &else &do &type &setchar &standard &s x [close -all] &return &warning ORIGIN command must appear on first line in ascii file &end /* else do &end /* then do /* Assign start values to required variables &s l 2 &s .leg$box_ymax \.leg$y\ &s .leg$box_ymin \.leg$y\ &s previous start &s title_text &s weeddraw [show weeddraw] /* Read next line &s line [unquote [read \file\ readstatus]] /* Start plotting legend, set previous to start &do &while \readstatus\ = 0 &select [upcase [extract 1 \line\]] /* ============================================================================ /* /* AP /* /* Syntax: AP /* /* Executes an Arcplot command. Command must be enclosed in single quotes. /* If using AML commands and the values of variables during the execution of /* the this AML, use the [quote command] function instead. &when AP &do &tty [unquote [extract 2 \line\]] &s .leg$lineset [show lineset] &s .leg$markerset [show markerset] &s .leg$shadeset [show shadeset] &s .leg$textset [show textset] &end /* when AP, AML /* ============================================================================ /* /* BOX /* /* Syntax: BOX {shade_symbol | colour} {text} {line_spacing} {indent} &when BOX &do /* Evaluate optional arguments and set initial values (Note: text /* argument is not evaluated and line spacing and indent arguments /* are evaluated in BOXTEXT routine if there is any text to plot) &s symbol /* Check if any arguments entered at all &if not [null [extract 2 \line\]] &then &do /* Check if value entered for shade symbol is numeric or character &if [type [extract 2 \line\]] < 0 &then &do /* Check if line symbol exists SHADEDELETE ALL SHADESET \.leg$shadeset\ &if [type [show shadeinfo [extract 2 \line\] 1]] > 0 &then SHADESYMBOL [extract 2 \line\] &else &do &s symbol x &type &type Shade symbol [extract 2 \line\] does not exist (line \l\) &end /* else do &end /* then do &else &do /* Check if skipping shade symbol argument &if [quote [extract 2 \line\]] <> '#' &then &do /* Check if colour name is valid SHADEDELETE ALL SHADETYPE COLOR &severity &error &routine INVALID_COLOUR &s colourname [unquote [extract 2 \line\]] SHADECOLOR [unquote [extract 2 \line\]] &end /* then do &else &s symbol x &end /* else do &end /* then do &else &s symbol x /* Check if line space included and previous element was also a box &if \.leg$line_space\ and \previous\ = box &then &do &s .leg$y [calc \.leg$y\ - ( \.leg$space\ / 72 )] &s .leg$line_space .FALSE. &end /* then do /* Calculate coordinates for box &s .leg$y [calc \.leg$y\ - ( [value .leg$\previous\_to_box] / 72 )] &s .leg$box_xmin \.leg$x\ &s .leg$box_ymin [calc \.leg$y\ - \.leg$box_height\ / 25.4] &s .leg$box_xmax [calc \.leg$x\ + \.leg$box_width\ / 25.4] &s .leg$box_ymax \.leg$y\ /* Set line symbol for box LINEDELETE ALL LINETYPE WIDE LINESIZE \.leg$line_size\ LINEPEN \.leg$line_size\ SQUARE MITER LINECOLOR [unquote \.leg$line_colour\] /* Flush any points in buffer &flushpoints /* Push box coordinates to buffer &pushpoint 1,\.leg$box_xmin\,\.leg$box_ymin\ &pushpoint 1,\.leg$box_xmax\,\.leg$box_ymax\ /* Plot box outline with or without a colour fill based on value of symbol &if [quote \symbol\] <> 'x' &then PATCH * OUTLINE &else BOX * /* Set variables used in SUB commands &s .leg$box_top \.leg$box_ymax\ &s .leg$box_left \.leg$box_xmin\ /* Set coordinates for text placement in box &s .leg$xmin \.leg$box_xmin\ &s .leg$ymin \.leg$box_ymin\ &s .leg$xmax \.leg$box_xmax\ &s .leg$ymax \.leg$box_ymax\ /* Check if any text to plot in box &if not [null [extract 3 \line\]] &then &do &s a 3 &call BOXTEXT &end /* then do /* Push box coordinates for pattern fill to buffer &s patternfill_cmd PATCH &flushpoints &pushpoint 1,\.leg$box_xmin\,\.leg$box_ymin\ &pushpoint 1,\.leg$box_xmax\,\.leg$box_ymax\ /* Set text mask colour for pattern fill masking &s .leg$textmask_colour [unquote [show shadecolor current 1]] /* Set Y coordinate of legend to bottom of legend box &s .leg$y [calc \.leg$y\ - \.leg$box_height\ / 25.4] &s previous box &end /* when BOX /* ============================================================================ /* /* BOXSIZE /* /* Syntax: BOXSIZE {MM | INCHES | POINTS} /* Syntax: BOXSIZE DEFAULT /* &when BOXSIZE &do /* Check if setting box to default size &if [null [extract 3 \line\]] &then &do &if [upcase [extract 2 \line\]] eq DEFAULT &then &do /* Set box size defaults in mm &s .leg$box_width 18 &s .leg$box_height 10 &end /* then do &else &do &type &type Invalid argument for BOXSIZE, box size not changed (line \l\) &end /* else do &end /* then do &else &do /* Check that width and height are numeric &if [type [extract 2 \line\]] < 0 and [type [extract 3 \line\]] < 0 ~ &then &do &s factor 1 /* Determine unit of measurments &if not [null [extract 4 \line\]] &then &do &select [upcase [extract 4 \line\]] &when MM, MILLIMETERS, MILLIMETRES, # &s factor 1 &when INCHES, I &s factor 25.4 &when POINTS, PT, P &s factor [calc 25.4 / 72] &otherwise &do &type &type Unknown units for BOXSIZE, defaulting to MM (line \l\) &end /* otherwise &end /* select &end /* then do /* Set box size defaults in mm &s .leg$box_width [calc [extract 2 \line\] * \factor\] &s .leg$box_height [calc [extract 3 \line\] * \factor\] &end /* then do &else &do &type &type Invalid distances for BOXSIZE, box size not changed (line \l\) &end /* else do &end /* else do &end /* when BOXSIZE /* ============================================================================ /* /* BRACKET /* /* Syntax: BRACKET TOP {LEFT | RIGHT} {offset} /* Syntax: BRACKET {UP | DOWN | HORIZONTAL} {shift} /* /* Variables: bkt_top - Y coordinate of top of bracket, used to calculate /* points for upper curve and mid-point of bracket /* bkt_side - plotting bracket to left or right side /* bkt_offset - offset distance of bracket form .leg$x coordinate /* bkt_point - Y coordinate of point of bracket /* bkt_shift - shift of point in Y direction /* bkt_bottom - Y coordinate of bottom of bracket /* bkt_textangle - angle of text plotted alongside bracket /* /* Note: Brackets are not plotted when plotting to a graphics file &when BRACKET &do /* Check if plotting to page &if not \page\ &then &do /* Check for required arguments &if not [null [extract 2 \line\]] &then &do &select [upcase [extract 2 \line\]] &when TOP &do /* Evaluate optional arguments, set initial values &s bkt_new .TRUE. &s .leg$y [calc \.leg$y\ - ~ [value .leg$\previous\_to_bkt_top] / 72] &s bkt_top \.leg$y\ &s bkt_side -1 &s bkt_offset 0 /* Check if any arguments entered at all &if not [null [extract 3 \line\]] &then &do &select [upcase [extract 3 \line\]] &when R, RIGHT &s bkt_side 1 &when LEFT, L, # &s bkt_side -1 &otherwise &do &type &type ~ Invalid keyword for argument {LEFT | RIGHT}, using default (line \l\) &end /* otherwise &end /* select /* Check if value entered for offset argument &if not [null [extract 4 \line\]] &then &do /* Check if value entered is numeric &if [type [extract 4 \line\]] < 0 &then &s bkt_offset [calc [extract 4 \line\] / \.leg$bkt_units\] &else &do /* Check if invalid value entered for offset distance &if [quote [extract 4 \line\]] <> '#' &then &do &type &type ~ Invalid value for argument {offset}, setting distance to 0 (line \l\) &end /* then do &end /* else do &end /* then do &end /* then do &s previous bkt_top &end /* when TOP &when BOTTOM, OVERLAP &do /* Check for required text argument &if not [null [extract 3 \line\]] &then &do /* Evaluate optional arguments, set initial values &s bkt_textangle 90 &s bkt_shift 0 /* Check if any optional arguments entered at all &if not [null [extract 4 \line\]] &then &do &select [upcase [extract 4 \line\]] &when UP, # &s bkt_textangle 90 &when DOWN &s bkt_textangle -90 &when HORIZONTAL &s bkt_textangle 0 &otherwise &do &type &type ~ Invalid keyword for argument {UP | DOWN | HORIZONTAL}, using default (line \l\) &end /* otherwise &end /* select /* Check if value entered for shift argument &if not [null [extract 5 \line\]] &then &do /* Check if value entered is numeric &if [type [extract 5 \line\]] < 0 &then &s bkt_shift [calc [extract 5 \line\] / ~ \.leg$bkt_units\] &else &do /* Check if invalid value entered for shift distance &if [quote [extract 5 \line\]] <> '#' &then &do &type &type ~ Invalid value for argument {shift}, setting distance to 0 (line \l\) &end /* then do &end /* else do &end /* then do &end /* then do /* Set line symbol LINEDELETE ALL LINETYPE WIDE LINEPEN \.leg$bkt_line_size\ BUTT MITER LINECOLOR \.leg$bkt_line_colour\ WEEDDRAW OFF /* Calculate Y coordinate for bottom of bracket &if [upcase [extract 2 \line\]] eq BOTTOM &then &do &s .leg$y [calc \.leg$y\ - [value ~ .leg$\previous\_to_bkt_bottom] / 72] &s bkt_bottom \.leg$y\ &end /* then do &else /* when OVERLAP &s bkt_bottom [calc \.leg$y\ + 6.5 / 25.4] /* Calculate Y coordinate for point (middle) of bracket &s bkt_point [calc ( \bkt_bottom\ + ~ ( \bkt_top\ - \bkt_bottom\ ) / 2 ) + \bkt_shift\] /* Flush any points in buffer &flushpoints /* Check if top of bracket to plot is start of a new bracket or /* a conatinuation of an existing plotted bracket &if \bkt_new\ &then &do /* Push coordinates of curve at top of bracket to buffer &do a = 0 &to 90 &by 9 &pushpoint 1,[calc \.leg$x\ + \bkt_offset\ + \bkt_side\ * ~ \.leg$bkt_width\ * [sin [angrad \a\]] / 25.4], ~ [calc \bkt_top\ - \.leg$bkt_width\ / 25.4 + ~ \.leg$bkt_width\ * [cos [angrad \a\]] / 25.4] &end /* do to by &end /* then do &else /* Push start coordinate to continue bracket &pushpoint 1,[calc \.leg$x\ + \bkt_offset\ + \bkt_side\ * ~ \.leg$bkt_width\ / 25.4],\bkt_top\ /* Push coordinates of upper curve of bracket point to buffer &do a = 0 &to 90 &by 9 &pushpoint 1,[calc ( \.leg$x\ + \bkt_offset\ + \bkt_side\ * ~ \.leg$bkt_width\ / 25.4 ) + \bkt_side\ * ~ ( \.leg$bkt_width\ / 25.4 - \.leg$bkt_width\ * ~ [cos [angrad \a\]] / 25.4 )], [calc \bkt_point\ + ~ \.leg$bkt_width\ / 25.4 - \.leg$bkt_width\ * ~ [sin [angrad \a\]] / 25.4] &end /* do to by /* Push coordinates of lower curve of bracket point to buffer &do a = 0 &to 90 &by 9 &pushpoint 1,[calc ( \.leg$x\ + \bkt_offset\ + \bkt_side\ * ~ \.leg$bkt_width\ / 25.4 ) + \bkt_side\ * ~ ( \.leg$bkt_width\ / 25.4 - \.leg$bkt_width\ * ~ [sin [angrad \a\]] / 25.4 )], [calc \bkt_point\ - ~ \.leg$bkt_width\ / 25.4 + \.leg$bkt_width\ * ~ [cos [angrad \a\]] / 25.4] &end /* do to by /* Check if terminating bracket or continuing it &if [upcase [extract 2 \line\]] = BOTTOM &then &do &do a = 0 &to 90 &by 9 &pushpoint 1,[calc \.leg$x\ + \bkt_offset\ + \bkt_side\ * ~ \.leg$bkt_width\ * [cos [angrad \a\]] / 25.4], ~ [calc \bkt_bottom\ + \.leg$bkt_width\ / 25.4 - ~ \.leg$bkt_width\ * [sin [angrad \a\]] / 25.4] &end /* do to by /* Plot bracket line &pushpoint 9,0,0 LINE * &s previous bkt_bottom &end /* then do &else &do /* Push end coordinate of bracket just before dashed line &pushpoint 1,[calc \.leg$x\ + \bkt_offset\ + \bkt_side\ * ~ \.leg$bkt_width\ / 25.4],\bkt_bottom\ &pushpoint 9,0,0 /* Plot bracket line up to dashes LINE * /* Push coordinates for dash line to buffer &do a = 1 &to 3 &by 1 &flushpoints &pushpoint 1,[calc \.leg$x\ + \bkt_offset\ + \bkt_side\ * ~ \.leg$bkt_width\ / 25.4],[calc \bkt_bottom\ - ~ ( 4 * \a\ - 3 ) / 25.4] &pushpoint 1,[calc \.leg$x\ + \bkt_offset\ + \bkt_side\ * ~ \.leg$bkt_width\ / 25.4],[calc \bkt_bottom\ - ~ 4 * \a\ / 25.4] &pushpoint 9,0,0 /* Plot dashed line LINE * /* Set bracket variables to continue bracket &s bkt_new .FALSE. &s bkt_top [calc \bkt_bottom\ - ( 4 * \a\ + 1 ) / 25.4] &end /* do to by &end /* else do /* Set text parameters for plotting text alongside bracket TEXTFONT \.leg$bkt_font\ TEXTSIZE \.leg$bkt_size\ PT TEXTCOLOR [unquote \.leg$bkt_colour\] TEXTANGLE \bkt_textangle\ /* Flush any points in buffer for text placement &flushpoints /* Calculate coordinates to place text depending on angle and /* orientation of bracket (left or right) &select \bkt_textangle\ &when 90 /* Text is read UP &do &if \bkt_side\ = -1 &then &do MOVE [calc \.leg$x\ + \bkt_offset\ + \bkt_side\ * ~ ( ( 2 * \.leg$bkt_width\ / 25.4 ) + ~ ( \.leg$bkt_text_offset\ / 25.4 ) )] \bkt_point\ &s justify LC &end /* then do &else &do /* ±25% is added to X coordinate to achive correct text /* offset distance from point, based on uppercase text MOVE [calc \.leg$x\ + \bkt_offset\ + \bkt_side\ * ~ ( ( 2 * \.leg$bkt_width\ / 25.4 ) + ~ ( \.leg$bkt_text_offset\ / 25.4 ) - ~ ( \.leg$bkt_size\ / 72 * 0.25 ) )] \bkt_point\ &s justify UC &end /* else do &end /* when 90 &when -90 /* Text is read DOWN &do &if \bkt_side\ = -1 &then &do /* 27% of point size is added to X coordinate to achive /* correct text offset distance from point, based /* on uppercase text MOVE [calc \.leg$x\ + \bkt_offset\ + \bkt_side\ * ~ ( ( 2 * \.leg$bkt_width\ / 25.4 ) + ~ ( \.leg$bkt_text_offset\ / 25.4 ) - ~ ( \.leg$bkt_size\ / 72 * 0.27 ) )] \bkt_point\ &s justify UC &end /* then do &else &do /* 5% of point size is added to X coordinate to achive /* correct text offset distance from point, based /* on uppercase text MOVE [calc \.leg$x\ + \bkt_offset\ + \bkt_side\ * ~ ( ( 2 * \.leg$bkt_width\ / 25.4 ) + ~ ( \.leg$bkt_text_offset\ / 25.4 ) + ~ ( \.leg$bkt_size\ / 72 * 0.05 ) )] \bkt_point\ &s justify LC &end /* else do &end /* when 90 &when 0 /* Text is read HORIZONTAL &do /* 15% of point size is added to Y coordinate to center text /* to point of bracket and ±10% of point size is added to X /* coordinate to achive correct offset distance from point MOVE [calc \.leg$x\ + \bkt_offset\ + \bkt_side\ * ~ ( ( 2 * \.leg$bkt_width\ / 25.4 ) + ~ ( \.leg$bkt_text_offset\ / 25.4 ) + \bkt_side\ * ~ ( \.leg$bkt_size\ / 72 * 0.1 ) )] [calc \bkt_point\ + ~ \.leg$bkt_size\ * 0.15 / 72] &if \bkt_side\ = 1 &then &s justify CL &else &s justify CR &end /* when 90 &end /* select /* Plot text TEXT [extract 3 \line\] \justify\ /* Reset text angle TEXTANGLE 0 &end /* then do &else &do &type &type Missing required text argument for BRACKET (line\l\) &end /* else do &end /* when BOTTOM, OVERLAP &otherwise &do &type &type ~ Invalid keyword for second argument in command BRACKET (line \l\) &end /* otherwise &end /* select &end /* then do &else &do &type &type Missing required arguments for BRACKET (line \l\) &end /* else do &end /* then do &end /* when BRACKET /* ============================================================================ /* /* COLUMN /* /* Syntax: COLUMN /* Syntax: COLUMN {INCHES | MM | PICAS} &when COLUMN &do /* Check for required arguments &if not [null [extract 2 \line\]] &then &do /* Check if starting a new column &if [type [extract 2 \line\]] > 0 &then &do &if [upcase [extract 2 \line\]] = NEW &then &do /* Check if using PAGE option &if not \page\ &then &do &type &type Starting new legend column &s .leg$y \.leg$y_origin\ &s .leg$x [calc \.leg$x\ + \.leg$column_width\ + ~ \.leg$column_gap\] &s previous start &end /* then do &else &do /* Plot on page that a new column supposed to begin here &s .leg$y [calc \.leg$y\ - 0.25] /* Flush any points in buffer &flushpoints MOVE \.leg$x\ \.leg$y\ TEXTSIZE 10 PT TEXTFONT Triumvirate TEXTCOLOR CMYK 0 0 0 100 TEXT 'Start of new column' LL &s .leg$y [calc \.leg$y\ - 0.25] &s previous start &if \.leg$y\ < 2 &then &do &s page_counter [calc \page_counter\ + 1] &call NEWPAGE &end /* then do &end /* else do &end /* then do &else &do &type &type Expecting keyword for argument (line \l\) &end /* else do &end /* then do &else &do /* Check for required arguments &if not [null [extract 3 \line\]] &then &do /* Check that width and gap are numeric &if [type [extract 2 \line\]] < 0 and ~ [type [extract 3 \line\]] < 0 &then &do /* Check if unit of measurement for width and gap entered &if [null [extract 4 \line\]] &then &s factor 1 &else &do /* Determine unit or factor of values for width and gap &select [upcase [extract 4 \line\]] &when INCHES, I &s factor 1 &when MM, MILLIMETERS, MILLIMETRES &s factor 25.4 &when PICAS, P &s factor 6 &otherwise &do &s factor 1 &type &type ~ Invalid value for argument {INCHES | MM | PICAS}, using default (line \l\) &end /* otherwise &end /* select &end /* else do &s .leg$column_width [calc [extract 2 \line\] / \factor\] &s .leg$column_gap [calc [extract 3 \line\] / \factor\] &end /* then do &else &do &type &type Invalid values for arguments (line \l\) &end /* else do &end /* then do &else &do &type &type Missing value for required argument (line \l\) &end /* else do &end /* else do &end /* then do &else &do &type &type ~ Missing value for required arguments or (line \l\) &end /* else do &end /* when COLUMN /* ============================================================================ /* /* DESC and NOTE /* /* Syntax: DESC /* /* Syntax: NOTE /* /* Note: Automatic word wrapping exists for DESC and NOTE commands, unless /* explicitly entering a value for line spacing and/or indent /* /* Syntax for following lines: {line_spacing} {indent} /* /* "line(s) of text" refers to lines of text in ascii file, "text string" refers /* to each line of text plotted in legend /* /* General procedure: /* - a counter is used to keep track of the number of DESC lines /* - set DESC parameters for each line /* - read the next line /* - if the line is valid and is another DESC line than repeat the above /* process /* - if the line is blank, recognize it as such and read next line; if next line /* is DESC then ignore previous blank line /* - if the line is invalid (EOF or other error in reading) or if it is not a /* DESC line then the looping process is terminated /* - following this, the base line for the first or only DESC line is calculated /* from the top of the box, based on the number of DESC lines registered /* - the DESC lines are then plotted /* - if the last DESC line is lower than the botton of the box then re-evaluate /* the global variable for the Y coordinate &when DESC, NOTE &do /* Set command as either DESC or NOTE to access variables for text symbol /* parameters &s command [upcase [extract 1 \line\]] /* Set initial text symbol parameters, necessary for determining text /* length TEXTFONT [value .leg$\command\_font] TEXTSIZE [value .leg$\command\_size] PT TEXTCOLOR [unquote [value .leg$\command\_colour]] /* Set counter for number of text string lines &s a 1 /* Set initial text string blank &s desc\a\_text /* Read next line in ascii file and increment line counter &s line [unquote [read \file\ readstatus]] &s l [calc \l\ + 1] /* Keep reading lines in ascii file until EOF, error in read status /* or a blank line as reached &do &while \readstatus\ = 0 and not [null \line\] /* Check if first word is a character &if [type [extract 1 \line\]] > 0 &then &do /* Check if any leftover text string exists &if not [null [value desc\a\_text]] &then /* Add line of text to leftover text string &s desc\a\_text [quote [unquote [value desc\a\_text]] \line\] &else &do /* Save line of text as text string, plus values for /* line spacing, indent and text symbol parameters &s desc\a\_text [quote \line\] &s desc\a\_line_spacing &s desc\a\_indent &s desc\a\_font [value .leg$\command\_font] &s desc\a\_size [value .leg$\command\_size] &s desc\a\_colour [value .leg$\command\_colour] &end /* else do &end /* then do &else &do /* if first word is numeric /* Clear temporary text string &s text /* Check if second word exists &if not [null [extract 2 \line\]] &then &do /* Check if second word is a character &if [type [extract 2 \line\]] > 0 &then &do /* Save rest of line of text as temporary text string, plus /* temporary values for line spacing and indent &s line_spacing [extract 1 \line\] &s indent &s text [after [quote \line\] [quote [extract 1 \line\] ]] &end /* then do &else &do /* if second word is numeric /* Check if third word exists &if not [null [extract 3 \line\]] &then &do /* Save rest of line of text as temporary text string, plus /* temporary values for line spacing and indent &s line_spacing [extract 1 \line\] &s indent [extract 2 \line\] &s text [after [quote \line\] [quote [extract 2 \line\] ]] &end /* then do &else &do &type &type ~ Missing text string after line spacing and indent values (line \l\) &end /* else do &end /* else do &end /* then do &else &do &type &type Missing text string after line spacing value (line \l\) &end /* else do /* Check if temporary text string extracted successfully &if not [null \text\] &then &do /* Check if any leftover text string exists in order to start a new /* line of text &if not [null [value desc\a\_text]] &then /* Increment counter for next text string line &s a [calc \a\ + 1] /* Save temporary text string, line spacing and indent values as /* next text string line, plus values for line spacing, indent and /* text symbol parameters &s desc\a\_text \text\ &s desc\a\_line_spacing \line_spacing\ &s desc\a\_indent \indent\ &s desc\a\_font [value .leg$\command\_font] &s desc\a\_size [value .leg$\command\_size] &s desc\a\_colour [value .leg$\command\_colour] &end /* then do &end /* else do /* /* Calculate limit of text string including any indent value &if [null [value desc\a\_indent]] &then &s limit [calc \.leg$column_width\ - \.leg$desc_indent\ / 6] &else &s limit [calc \.leg$column_width\ - \.leg$desc_indent\ / 6 - ~ [value desc\a\_indent] / 6] /* /* Trim text string if its length exceeds limit &if [extract 1 [show textlength [value desc\a\_text]]] > ~ \limit\ &then &do /* Keep trimming word by word from end of text string until length is /* less than or equal to limit or there is only one word remaining &do &until [extract 1 [show textlength ~ [value desc\a\_text]]] <= \limit\ or ~ [token [unquote [value desc\a\_text]] -count] = 1 /* Save text string to temporary text string used for trimming /* process &s temp [value desc\a\_text] /* Trim line of text word by word until its length is less than the /* limit &do &until [extract 1 [show textlength \temp\]] <= \limit\ /* Trim character by character until a space is encountered &do b = [calc [length \temp\] - 1] &to 0 &by -1 ~ &until [null [substr \temp\ \b\ 1]] &s temp [substr \temp\ 1 \b\] &end /* do to by until &end /* do until /* Save leftover, words trimmed off end from initial text string to /* next line of text &s desc[calc \a\ + 1]_text [subst [value desc\a\_text] \temp\] /* Save text string that has has words trimmed as line of text &s desc\a\_text \temp\ /* Increment counter for next line of text &s a [calc \a\ + 1] /* Save line spacing and indent values for next line of text &s desc\a\_line_spacing &s desc\a\_indent /* Save text symbol parameters for next line of text &s desc\a\_font [value .leg$\command\_font] &s desc\a\_size [value .leg$\command\_size] &s desc\a\_colour [value .leg$\command\_colour] /* Re-calculate limit value for next line of text &s limit [calc \.leg$column_width\ - \.leg$desc_indent\ / 6] &end /* do until &end /* then do /* Read next line &s line [unquote [read \file\ readstatus]] /* Increment line counter &s l [calc \l\ + 1] &end /* do while /* /* Flush any points in buffer &flushpoints /* Plot each line of text if there is any text to plot &do b = 1 &to \a\ &by 1 &while not [null \desc1_text\] TEXTFONT [value desc\b\_font] TEXTSIZE [value desc\b\_size] PT TEXTCOLOR [unquote [value desc\b\_colour]] &if \b\ = 1 &then &do &if \command\ = DESC &then &do /* Determine line spacing of first line for DESC command &if [null \desc1_line_spacing\] &then &do /* Calculate automatic line spacing for first line, based on the /* total number of lines. If the vertical distance of all lines /* exceeds the total height of the box then place the first line /* flush with the top of the box, otherwise, center the lines to /* the center of the box. In the calculations, it is assumed that /* the point size for all lines is the same as the first line's /* point size and that line spacing is constant (1.25 times point /* size). All calculations are in points, then converted to page /* units inches. &if [calc \desc1_size\ + ( \a\ - 1 ) * \desc1_size\ * 1.25] lt ~ [calc ( \.leg$ymax\ - \.leg$ymin\ ) * 72] &then /* Calculate automatic start position of DESC lines &s desc_y [calc \.leg$ymax\ - ( ( ( ( \.leg$ymax\ - ~ \.leg$ymin\ ) * 72 ) - ( \desc1_size\ + ( \a\ - 1 ) * ~ \desc1_size\ * 1.25 ) ) / 2 + \desc1_size\ - \desc1_size\ * ~ 0.15 ) / 72] &else /* Calculate start position of first DESC line flush with top of /* box if number of lines of text exceeds height of box &s desc_y [calc \.leg$ymax\ - ( \desc1_size\ - ~ \desc1_size\ * 0.15 ) / 72] &end /* then do &else /* Set start position based on entered line spacing value &s desc_y [calc \.leg$ymax\ - ( \desc1_line_spacing\ / 72 )] &end /* then do &else &do /* Determine line spacing for first line of text for NOTE command &if [null \desc1_line_spacing\] &then &s desc_y [calc \.leg$y\ - [value .leg$\previous\_to_note] / 72] &else &s desc_y [calc \.leg$y\ - \desc1_line_spacing\ / 72] &end /* else do &end /* then do &else &do /* Calculate Y-coordinate for remaining lines of text &if [null [value desc\b\_line_spacing]] or ~ [quote [value desc\b\_line_spacing]] = '0' &then &s desc_y [calc \desc_y\ - ( [value desc\b\_size] * 1.25 / 72 )] &else &s desc_y [calc \desc_y\ - ( [value desc\b\_line_spacing] / 72 )] &end /* else do /* Calculate indent, X-coordinate and move cusor to start of line of /* text &if [null [value desc\b\_indent]] &then MOVE [calc \.leg$x\ + \.leg$desc_indent\ / 6] \desc_y\ &else MOVE [calc \.leg$x\ + \.leg$desc_indent\ / 6 + [value ~ desc\b\_indent] / 6] \desc_y\ /* Plot text (finally!) TEXT [value desc\b\_text] LL &end /* do to by /* Delete variables for plotting lines of text &do b = 1 &to \a\ &by 1 &dv desc\b\_* &end /* do to by &if \readstatus\ <> 0 &then &call EXIT /* Re-evaluate y-axis &if \desc_y\ < \.leg$y\ &then &s .leg$y \desc_y\ /* Set previous to note if command was NOTE &if \command\ = NOTE &then &s previous note /* If plotting to page check if Y coordinate close to bottom of page &if \page\ and \.leg$y\ < 2 &then &do &s page_counter [calc \page_counter\ + 1] &call NEWPAGE &end /* then do &end /* when DESC, NOTE /* ============================================================================ /* /* END /* /* Syntax: END &when END &call EXIT /* ============================================================================ /* /* HEADING /* /* Syntax: HEADING {line_spacing} {indent} /* /* The first argument are tabs for eons, eras, groups, etc... Line spacing /* values are entered in points and indent values are entered in picas. &when HEADING &do /* Check for required arguments &if not [null [extract 3 \line\]] &then &do /* Check first argument, set default indent value and set text symbol &select [upcase [extract 2 \line\]] &when L, I, B, D &do TEXTFONT [value .leg$heading[extract 2 \line\]_font] TEXTSIZE [value .leg$heading[extract 2 \line\]_size] PT TEXTCOLOR [unquote [value .leg$heading[extract 2 \line\]_colour]] /* Set default indent value &select [upcase [extract 2 \line\]] &when L &s indent 0 &when I &s indent [calc \.leg$desc_indent\ / 2 * \.leg$indent\ / 6] &when B &s indent [calc ( \.leg$box_width\ / 25.4 ) * \.leg$indent\] &when D &s indent [calc \.leg$desc_indent\ * \.leg$indent\ / 6] &end /* select /* Set default line spacing &s linespacing [calc [value .leg$\previous\_to_heading] / 72] /* Check if a value for line spacing argument enetered &if not [null [extract 4 \line\]] &then &do /* Check if line spacing value is numeric &if [type [extract 4 \line\]] < 0 &then &s linespacing [calc [extract 4 \line\] / \.leg$line_spacing\] &else &do /* Check if line spacing argument skipped &if [quote [extract 4 \line\]] <> '#' &then &do &type &type ~ Invalid value for argument {line_spacing}, using default (line \l\) &end /* then do &end /* else do /* Check if a value for indent argument entered &if not [null [extract 5 \line\]] &then &do /* Check if indent value is numeric &if [type [extract 5 \line\]] < 0 &then &s indent [extract 5 \line\] &else &do /* Check if indent argument skipped &if [quote [extract 5 \line\]] <> '#' &then &do &type &type ~ Invalid value for argument {indent}, using default (line \l\) &end /* then do &end /* else do &end /* then do &end /* then do /* Flush any points in buffer &flushpoints /* Plot text &s .leg$y [calc \.leg$y\ - \linespacing\] MOVE [calc \.leg$x\ + \indent\ / \.leg$indent\] \.leg$y\ TEXT [extract 3 \line\] LL &s previous heading &end /* when L, I, B, D &otherwise &do &type &type Invalid keyword for argument (line \l\) &end /* otherwise &end /* select &end /* then do &else &do &type &type Missing required arguments for HEADING command (line \l\) &end /* else do &end /* when HEADING /* ============================================================================ /* /* PATTERNFILL /* /* Syntax: PATTERNFILL {shade_symbol} {shade_colour} {shade_scale} {ON | OFF} /* {text} {line_spacing} {indent} /* /* Plots a pattern fill inside a box, subbox, subshape or a subellipse. &when PATTERNFILL &do /* Evaluate optional arguments and set initial values (Note: text /* argument is not evaluated and line spacing and indent arguments /* are evaluated in BOXTEXT routine if there is any text to plot) &s symbol &s scale &s mask .TRUE. &s shadescale [show shadescale] /* Check if any arguments entered at all &if not [null [extract 2 \line\]] &then &do /* Check if value entered for shade symbol is numeric &if [type [extract 2 \line\]] < 0 &then &do /* Check if symbol number exists SHADEDELETE ALL SHADESET \.leg$shadeset\ &if [type [show shadeinfo [extract 2 \line\] 1]] > 0 &then SHADESYMBOL [extract 2 \line\] &else &do &s symbol x &type &type Shade symbol [extract 2 \line\] does not exist (line \l\) &end /* else do &end /* then do &else &do /* Check if invalid value entered for shade symbol &if [quote [extract 2 \line\]] <> '#' &then &do &s symbol x &type &type Invalid value for argument {shade_symbol} (line\l\) &end /* then do &end /* else do /* Check if anything entered for remaining arguments &if not [null [extract 3 \line\]] and [quote \symbol\] <> 'x' &then &do /* Check if skipping shade colour value &if [quote [extract 3 \line\]] <> '#' &then &do /* Check if shade colour exists &severity &error &routine INVALID_COLOUR &s colourname [unquote [extract 3 \line\]] SHADECOLOR [unquote [extract 3 \line\]] &end /* then do /* Check if anything entered for remaining arguments &if not [null [extract 4 \line\]] &then &do /* Check if value entered for shade scale is numeric &if [type [extract 4 \line\]] < 0 &then &s scale [extract 4 \line\] &else &do /* Check if invalid value entered for shade scale &if [quote [extract 4 \line\]] <> '#' &then &do &s scale x &type &type Invalid value for argument {shade_scale} (line \l\) &end /* then do &end /* else do /* Check if masking option entered &if not [null [extract 5 \line\]] &then &do &select [upcase [extract 5 \line\]] &when ON, # &s mask .TRUE. &when OFF &s mask .FALSE. &otherwise &do &type &type ~ Invalid value for argument {ON | OFF}, using default (line \l\) &end /* otherwise &end /* select &end /* then do &end /* then do &end /* then do &end /* then do /* Check that all arguments are valid for plotting patternfill &if [quote \symbol\] <> 'x' &then &do /* Check if masking text and that there is text to plot &if \mask\ and not [null [extract 6 \line\]] &then TEXTMASK \.leg$textmask_shape\ \.leg$textmask_size\ ~ [unquote \.leg$textmask_colour\] &else TEXTMASK NONE /* Set line symbol for pattern fill LINEDELETE ALL LINETYPE WIDE LINESIZE \.leg$line_size\ LINEPEN \.leg$line_size\ SQUARE MITER LINECOLOR \.leg$line_colour\ /* Apply shade scaling factor &if not [null \scale\] &then SHADESCALE \scale\ /* Plot pattern fill based on points in buffer or as an ellipse &select [upcase \patternfill_cmd\] &when PATCH PATCH * OUTLINE &when SHADE SHADE * OUTLINE &when ELLIPSE &do /* Flush any points in buffer &flushpoints /* Plot pattern fill in ellipse SHADEPUT 999 POLYGONSHADES \ellipse\ 999 /* Plot outline of ellipse ARCS \ellipse\ &end /* when ELLIPSE &end /* select /* Check if any text to plot in box &if not [null [extract 6 \line\]] &then &do &s a 6 &call BOXTEXT &end /* then do /* Turn text masking off and reset shade scaling factor TEXTMASK NONE SHADESCALE \shadescale\ &end /* then do &end /* when PATTERNFILL /* ============================================================================ /* /* SET /* /* Syntax: SET /* /* Used to reset default values to legend variables. &when SET &call SET /* ============================================================================ /* /* SKIP /* /* Syntax: SKIP /* /* Skip over lines in ascii file until another SKIP or END command is /* encountered or the end of the ascii file is reached. &when SKIP &do &do &until \skip_encountered\ or \readstatus\ <> 0 &s line [unquote [read \file\ readstatus]] &s l [calc \l\ + 1] &if \readstatus\ = 0 &then &do /* Check if END or SKIP encountered &select [upcase [extract 1 \line\]] &when EXIT &call EXIT &when SKIP &s skip_encountered .TRUE. &otherwise &s skip_encountered .FALSE. &end /* select &end /* then do &end /* do until &end /* when SKIP /* ============================================================================ /* /* SUBBOX /* /* Syntax: SUBBOX {shade_symbol | colour} {text} {line_spacing} {indent} &when SUBBOX &do /* Check for required arguments &if not [null [extract 3 \line\]] &then &do /* Check that coordinates are numeric &if [type [extract 2 \line\]] < 0 or ~ [type [extract 3 \line\]] < 0 &then &do /* Evaluate optional arguments and set initial values (Note: text /* argument is not evaluated and line spacing and indent arguments /* are evaluated in BOXTEXT routine if there is any text to plot) &s symbol /* Check if any arguments entered at all &if not [null [extract 4 \line\]] &then &do /* Check if value entered for shade symbol is numeric or character &if [type [extract 4 \line\]] < 0 &then &do /* Check if line symbol exists SHADEDELETE ALL SHADESET \.leg$shadeset\ &if [type [show shadeinfo [extract 4 \line\] 1]] > 0 &then SHADESYMBOL [extract 4 \line\] &else &do &s symbol x &type &type Shade symbol [extract 4 \line\] does not exist (line \l\) &end /* else do &end /* then do &else &do /* Check if skipping shade symbol argument &if [quote [extract 4 \line\]] <> '#' &then &do /* Check if colour name is valid SHADEDELETE ALL SHADETYPE COLOR &severity &error &routine INVALID_COLOUR &s colourname [unquote [extract 4 \line\]] SHADECOLOR [unquote [extract 4 \line\]] &end /* then do &end /* else do &end /* then do &else &s symbol x /* Calculate coordinates for box &s .leg$box_xmin [calc \.leg$box_left\ + ~ [extract 2 \line\] / \.leg$sub_units\] &s .leg$box_xmax [calc \.leg$box_xmin\ + \.leg$box_width\ / 25.4] &s .leg$box_ymax [calc \.leg$box_top\ - ~ [extract 3 \line\] / \.leg$sub_units\] &s .leg$box_ymin [calc \.leg$box_ymax\ - \.leg$box_height\ / 25.4] /* Set line symbol for box LINEDELETE ALL LINETYPE WIDE LINESIZE \.leg$line_size\ LINEPEN \.leg$line_size\ SQUARE MITER LINECOLOR [unquote \.leg$line_colour\] /* Flush any points in buffer &flushpoints /* Push box coordinates to buffer &pushpoint 1,\.leg$box_xmin\,\.leg$box_ymin\ &pushpoint 1,\.leg$box_xmax\,\.leg$box_ymax\ /* Plot box outline with or without a colour fill based on value of /* symbol &if [quote \symbol\] <> 'x' &then PATCH * OUTLINE &else BOX * /* Set coordinates for text placement in box &s .leg$xmin \.leg$box_xmin\ &s .leg$ymin \.leg$box_ymin\ &s .leg$xmax \.leg$box_xmax\ &s .leg$ymax \.leg$box_ymax\ /* Check if any text to plot in box &if not [null [extract 5 \line\]] &then &do &s a 5 &call BOXTEXT &end /* then do /* Push box coordinates for pattern fill to buffer &s patternfill_cmd PATCH &flushpoints &pushpoint 1,\.leg$box_xmin\,\.leg$box_ymin\ &pushpoint 1,\.leg$box_xmax\,\.leg$box_ymax\ /* Set text mask colour for pattern fill masking &s .leg$textmask_colour [unquote [show shadecolor current 1]] /* Re-evaluate legend Y coordinate if less than main box &if \.leg$box_ymin\ < \.leg$y\ &then &s .leg$y \.leg$box_ymin\ &end /* then do &else &do &type &type Invalid coordinates for SUBBOX (line \l\) &end /* else do &end /* then do &else &do &type &type Missing required arguments for SUBBOX (line \l\) &end /* else do &end /* when SUBBOX /* ============================================================================ /* /* SUBCOVER /* /* Syntax: SUBCOVER {symbol_item | symbol} &when SUBCOVER &do /* Check for required arguments &if not [null [extract 3 \line\]] &then &do /* Check that cover exists &if [exists [extract 2 \line\] -cover] &then &do /* Flush any points in buffer &flushpoints /* Position cover in box MAPEXTENT [extract 2 \line\] MAPUNITS \.leg$subcover_units\ MAPSCALE 1 MAPPOSITION 0 0 \.leg$box_xmin\ \.leg$box_ymin\ MAPLIMITS \.leg$box_xmin\ \.leg$box_ymin\ \.leg$box_xmax\ ~ \.leg$box_ymax\ /* Check for correct features to plot &if [upcase [quote [extract 3 \line\]]] = 'ARCS' or ~ [upcase [quote [extract 3 \line\]]] = 'POINTS' or ~ [upcase [quote [extract 3 \line\]]] = 'POLYGONS' &then &do /* Ensure weeddraw is off WEEDDRAW OFF /* Check if using current symbol to plot features &if [null [extract 4 \line\]] &then &do /* Plot arcs and points or polygons &if [upcase [extract 3 \line\]] = ARCS or ~ [upcase [extract 3 \line\]] = POINTS &then [upcase [extract 3 \line\]] [extract 2 \line\] &else &do /* Put existing shade symbol to a symbol number SHADEPUT 999 POLYGONSHADES [extract 2 \line\] 999 &end /* else do &end /* then do &else &do /* Set symbolset to use and plot cover &select [upcase [extract 3 \line\]] &when ARCS &do LINEDELETE ALL LINESET \.leg$lineset\ ARCLINES [extract 2 \line\] [extract 4 \line\] &end /* when ARCS &when POINTS &do MARKERDELETE ALL MARKERSET \.leg$markerset\ POINTMARKERS [extract 2 \line\] [extract 4 \line\] &end /* when POINTS &when POLYGONS &do SHADEDELETE ALL SHADESET \.leg$shadeset\ POLYGONSHADES [extract 2 \line\] [extract 4 \line\] &end /* when POLYGONS &end /* select &end /* else do /* Reset weeddraw value WEEDDRAW \weeddraw\ &end /* then do &else &do &type &type Invalid feature selection for SUBCOVER (line \l\) &end /* else do &end /* then do &else &do &type &type ~ Cover [upcase [extract 2 \line\]] does not exist for SUBCOVER (line \l\) &end /* else do &end /* then do &else &do &type &type Missing required arguments for SUBCOVER (line \l\) &end /* else do &end /* when SUBCOVER /* ============================================================================ /* /* SUBELLIPSE /* /* Syntax: SUBELLIPSE {shade_symbol | colour} {text} {line_spacing} {indent} /* /* Plots an ellipse inside a box of any size, where the ellipse will be scaled /* in order to fit the dimensions of the box. /* &when SUBELLIPSE &do /* Check if an &atool path is set &if not [null [extract 1 [show &atool]]] &then &do /* Check if cover ellipse exists in &atool path gsc70/covers &if [exists [joinfile [subst [extract 1 [show &atool]] amls covers] ~ ellipse -sub] -cover] &then &do /* Set ellipse cover &s ellipse [joinfile [subst [extract 1 [show &atool]] amls covers] ~ ellipse -sub] /* Evaluate optional arguments and set initial values (Note: text /* argument is not evaluated and line spacing and indent arguments /* are evaluated in BOXTEXT routine if there is any text to plot) &s symbol /* Check if any arguments entered at all &if not [null [extract 2 \line\]] &then &do /* Check if value entered for shade symbol is numeric or character &if [type [extract 2 \line\]] < 0 &then &do /* Check if line symbol exists SHADEDELETE ALL SHADESET \.leg$shadeset\ &if [type [show shadeinfo [extract 2 \line\] 1]] > 0 &then &do &s symbol [extract 2 \line\] /* Set text mask colour for masking pattern fills &s .leg$textmask_colour [show shadecolor \symbol\ 1] &end /* then do &else &do &s symbol x &type &type Shade symbol [extract 2 \line\] does not exist (line \l\) &end /* else do &end /* then do &else &do /* Check if skipping shade symbol argument &if [quote [extract 2 \line\]] <> '#' &then &do /* Check if colour name is valid SHADEDELETE ALL SHADETYPE COLOR &severity &error &routine INVALID_COLOUR &s colourname [unquote [extract 2 \line\]] SHADECOLOR [unquote [extract 2 \line\]] /* Set shade colour to symbol if valid &if [quote \symbol\] <> 'x' &then &do SHADEPUT 1 &s symbol 1 /* Set text mask colour for masking pattern fills &s .leg$textmask_colour [extract 2 \line\] &end /* then do &end /* then do &end /* else do &end /* then do &else &s symbol x /* Flush any points in buffer &flushpoints /* Set map to page environment for ellipse cover MAPEX ARC \ellipse\ MAPSCALE AUTOMATIC MAPLIMITS \.leg$box_xmin\ \.leg$box_ymin\ \.leg$box_xmax\ ~ \.leg$box_ymax\ MAPPOSITION CEN [calc \.leg$box_xmin\ + ( \.leg$box_xmax\ - ~ \.leg$box_xmin\ ) / 2] [calc \.leg$box_ymin\ + ( \.leg$box_ymax\ - ~ \.leg$box_ymin\ ) / 2] /* Decrease size of ellipse by subtracting 15% from map scale MAPSCALE [calc [show mapscale] + [show mapscale] * 0.15] WEEDDRAW OFF /* Set line symbol for ellipse LINEDELETE ALL LINETYPE WIDE LINESIZE \.leg$line_size\ LINEPEN \.leg$line_size\ ROUND ROUND LINECOLOR [unquote \.leg$line_colour\] /* Flush any points in buffer &flushpoints /* Plot ellipse with or withour a colour fill based on value of symbol &if [quote \symbol\] <> 'x' &then POLYGONSHADES \ellipse\ \symbol\ /* Plot outline of ellipse ARCS \ellipse\ WEEDDRAW \weeddraw\ /* Check if any text to plot in box &if not [null [extract 3 \line\]] &then &do &s a 3 &call BOXTEXT &end /* then do /* Set pattern fill option &s patternfill_cmd ELLIPSE &end /* then do &else &do &type &type Ellipse cover does not exists in your &atool path (line \l\) &end /* else do &end /* then do &else &do &type &type &atool path not set for SUBELLIPSE command (line \l\) &end /* else do &end /* when SUBELLIPSE /* ============================================================================ /* /* SUBLINE /* /* Syntax: SUBLINE {line_symbol} {OFF | ON} &when SUBLINE &do /* Check for required argument &if not [null [extract 2 \line\]] &then &do /* Check that each coordinate is a numeric value &s coordinates valid &do a = 1 &to [token [unquote [extract 2 \line\]] -count] &by 1 ~ &until \coordinates\ <> valid &if [type [extract \a\ [unquote [extract 2 \line\]]]] > 0 &then &s coordinates value &end /* do to by until /* Check that at least 2 coordinate pairs entered &if [token [unquote [extract 2 \line\]] -count] < 4 &then &s coordinates points /* Check that even number of coordinates are entered &if [mod [token [unquote [extract 2 \line\]] -count] 2] <> 0 &then &s coordinates odd /* Proceed if coordinates are valid &if \coordinates\ = valid &then &do /* Evaluate optional arguments and set initial values &s symbol &s spline .FALSE. /* Check if any arguments entered at all &if not [null [extract 3 \line\]] &then &do /* Check if value entered for line symbol is numeric &if [type [extract 3 \line\]] < 0 &then &do /* Check if line symbol exists LINEDELETE ALL LINESET \.leg$lineset\ &if [type [show lineinfo [extract 3 \line\] 1]] > 0 &then LINESYMBOL [extract 3 \line\] &else &do &s symbol x &type &type Line symbol [extract 3 \line\] does not exist (line \l\) &end /* else do &end /* then do &else &do /* Check if skipping line symbol argument &if [quote [extract 3 \line\]] <> '#' &then &do &s symbol x &type &type Invalid value for argument {line_symbol} (line \l\) &end /* then do &end /* else do /* Check if spline option entered &if not [null [extract 4 \line\]] &then &do &select [upcase [extract 4 \line\]] &when ON &s spline .TRUE. &when OFF, # &s spline .FALSE. &otherwise &do &type &type ~ Invalid value for argument {OFF | ON}, using default (line \l\) &end /* otherwise &end /* select &end /* then do &end /* then do /* Check that all arguments are valid for plotting shade &if [quote \symbol\] <> 'x' &then &do /* Begin processing coordinates &flushpoints &do a = 1 &to [token [unquote [extract 2 \line\]] -count] &by 2 &pushpoint 1,[calc \.leg$box_left\ + [extract \a\ [unquote ~ [extract 2 \line\]]] / \.leg$sub_units\],[calc ~ \.leg$box_top\ - [extract [calc \a\ + 1] [unquote ~ [extract 2 \line\]]] / \.leg$sub_units\] &end /* do to by &pushpoint 9,0,0 /* Plot sub line from coordinates in buffer &if \spline\ &then LINE SPLINE * &else LINE * &end /* then do &end /* then do &else &do &type &select \coordinates\ &when value &type Invalid coordinate values for SUBLINE (line \l\) &when points &type Minimum of 2 coordinates pairs are required (line \l\) &when odd &type Even number of coordinates required for SUBLINE (line \l\) &end /* select &end /* else do &end /* then do &else &do &type &type Missing required arguments for SUBLINE (line\l\) &end /* else do &end /* when SUBLINE /* ============================================================================ /* /* SUBMARKER /* /* Syntax: SUBMARKER {marker_symbol} {marker_angle} {marker_scale} &when SUBMARKER &do /* Set current marker scale &s markerscale [extract 1 [show markerscale]] /* Check for required arguments &if not [null [extract 3 \line\]] &then &do /* Check that coordinates are numeric &if [type [extract 2 \line\]] < 0 and [type ~ [extract 3 \line\]] < 0 &then &do /* Set x and y coordinates for symbol location &s x [calc \.leg$x\ + [extract 2 \line\] / \.leg$sub_units\] &s y [calc \.leg$box_top\ - [extract 3 \line\] / \.leg$sub_units\] /* Evaluate optional arguments, set initial values &s symbol &s angle &s scale /* Check if any arguments entered at all &if not [null [extract 4 \line\]] &then &do /* Check if value entered for marker symbol is numeric &if [type [extract 4 \line\]] < 0 &then &do /* Check if marker symbol exists MARKERDELETE ALL MARKERSET \.leg$markerset\ &if [type [show markerinfo [extract 4 \line\] 1]] > 0 &then MARKERSYMBOL [extract 4 \line\] &else &do &s symbol x &type &type Marker symbol [extract 4 \line\] does not exist (line \l\) &end /* else do &end /* then do &else &do /* Check if invalid value entered for marker symbol &if [quote [extract 4 \line\]] <> '#' &then &do &s symbol x &type &type Invalid value for argument {marker_symbol} (line \l\) &end /* then do &end /* else do /* Check if anything entered for remaining arguments &if not [null [extract 5 \line\]] &then &do /* Check if value entered for marker angle is numeric &if [type [extract 5 \line\]] < 0 &then &s angle [extract 5 \line\] &else &do /* Check if invalid value entered for marker angle &if [quote [extract 5 \line\]] <> '#' &then &do &s angle x &type &type Invalid value for argument {marker_angle} (line \l\) &end /* then do &end /* else do /* Check if anything entered for remaining argument &if not [null [extract 6 \line\]] &then &do /* Check if value entered for marker scale is numeric &if [type [extract 6 \line\]] < 0 &then &s scale [extract 6 \line\] &else &do /* Check if invalid value entered for marker scale &if [quote [extract 6 \line\]] <> '#' &then &do &s scale x &type &type Invalid value for argument {marker_scale} (line \l\) &end /* then do &end /* else do &end /* then do &end /* then do &end /* then do /* Check that all arguments are valid for plotting marker symbol &if [quote \symbol\] <> 'x' and [quote \angle\] <> 'x' and ~ [quote \scale\] <> 'x' &then &do /* Set markerangle &if not [null \angle\] &then &do /* Calculate angle for each layer &s repeat .TRUE. MARKERLAYER 1 &do &while \repeat\ MARKERANGLE [calc [show markerangle current ~ [show markerlayer current]] + \angle\] &if [show markerlayer next current] > 0 &then MARKERLAYER [show markerlayer next current] &else &s repeat .FALSE. &end /* do while &end /* then do /* Set marker scale &if not [null \scale\] &then MARKERSCALE \scale\ /* Flush any points in buffer &flushpoints /* Plot marker MARKER \x\ \y\ &end /* then do &end /* then do &else &do &type &type Invalid coordinates for SUBMARKER (line \l\) &end /* else do &end /* then do &else &do &type &type Missing required arguments for SUBMARKER (line \l\) &end /* else do &end /* when SUBMARKER /* ============================================================================ /* /* SUBSHAPE /* /* Syntax: SUBSHAPE {shade_symbol | colour} {text} {line_spacing} /* {indent} &when SUBSHAPE &do /* Check for required argument &if not [null [extract 2 \line\]] &then &do /* Check that each coordinate is a numeric value &s coordinates valid &do a = 1 &to [token [unquote [extract 2 \line\]] -count] &by 1 ~ &until \coordinates\ <> valid &if [type [extract \a\ [unquote [extract 2 \line\]]]] > 0 &then &s coordinates value &end /* do to by until /* Check that at least 3 coordinate pairs entered &if [token [unquote [extract 2 \line\]] -count] < 6 &then &s coordinates points /* Check that even number of coordinates are entered &if [mod [token [unquote [extract 2 \line\]] -count] 2] <> 0 &then &s coordinates odd /* Proceed if coordinates are valid &if \coordinates\ = valid &then &do /* Evaluate optional arguments and set initial values (Note: text /* argument is not evaluated and line spacing and indent arguments /* are evaluated in BOXTEXT routine if there is any text to plot) &s symbol /* Check if any arguments entered at all &if not [null [extract 3 \line\]] &then &do /* Check if value entered for shade symbol is numeric or character &if [type [extract 3 \line\]] < 0 &then &do /* Check if shade symbol exists SHADEDELETE ALL SHADESET \.leg$shadeset\ &if [type [show shadeinfo [extract 3 \line\] 1]] > 0 &then SHADESYMBOL [extract 3 \line\] &else &do &s symbol x &type &type Shade symbol [extract 3 \line\] does not exist (line \l\) &end /* else do &end /* then do &else &do /* Check if skipping shade symbol argument &if [quote [extract 3 \line\]] <> '#' &then &do /* Check if colour name is valid SHADEDELETE ALL SHADETYPE COLOR &severity &error &routine INVALID_COLOUR &s colourname [unquote [extract 3 \line\]] SHADECOLOR [unquote [extract 3 \line\]] &end /* then do &end /* else do &end /* then do /* Check that all arguments are valid for plotting shade &if [quote \symbol\] <> 'x' &then &do /* Begin processing coordinates &flushpoints &do a = 1 &to [token [unquote [extract 2 \line\]] -count] &by 2 /* Determine X and Y extent of shape for placement of text &if \a\ = 1 &then &do /* Set initial extent values for text placement &s .leg$xmin [calc \.leg$box_left\ + [extract 1 [unquote ~ [extract 2 \line\]]] / \.leg$sub_units\] &s .leg$ymin [calc \.leg$box_top\ - [extract 2 [unquote ~ [extract 2 \line\]]] / \.leg$sub_units\] &s .leg$xmax [calc \.leg$box_left\ + [extract 1 [unquote ~ [extract 2 \line\]]] / \.leg$sub_units\] &s .leg$ymax [calc \.leg$box_top\ - [extract 2 [unquote ~ [extract 2 \line\]]] / \.leg$sub_units\] &end /* then do &else &do /* Determine minimum and maximum X and Y extent values &s .leg$xmin [min \.leg$xmin\ [calc \.leg$box_left\ + [extract ~ \a\ [unquote [extract 2 \line\]]] / \.leg$sub_units\]] &s .leg$ymin [min \.leg$ymin\ [calc \.leg$box_top\ - [extract ~ [calc \a\ + 1] [unquote [extract 2 \line\]]] / ~ \.leg$sub_units\]] &s .leg$xmax [max \.leg$xmax\ [calc \.leg$box_left\ + [extract ~ \a\ [unquote [extract 2 \line\]]] / \.leg$sub_units\]] &s .leg$ymax [max \.leg$ymax\ [calc \.leg$box_top\ - [extract ~ [calc \a\ + 1] [unquote [extract 2 \line\]]] / ~ \.leg$sub_units\]] &end /* else do /* Push coordinates to buffer &pushpoint 1,[calc \.leg$box_left\ + [extract \a\ [unquote ~ [extract 2 \line\]]] / \.leg$sub_units\],[calc ~ \.leg$box_top\ - [extract [calc \a\ + 1] [unquote ~ [extract 2 \line\]]] / \.leg$sub_units\] &end /* do to by &pushpoint 9,0,0 /* Set line symbol for outline LINEDELETE ALL LINETYPE WIDE LINESIZE \.leg$line_size\ LINEPEN \.leg$line_size\ SQUARE MITER LINECOLOR \.leg$line_colour\ /* Plot shade SHADE * OUTLINE /* Check if any text to plot &if not [null [extract 4 \line\]] &then &do &s a 4 &call BOXTEXT &end /* then do /* Push shape coordinates to buffer for patternfill usage &s patternfill_cmd SHADE &flushpoints &do a = 1 &to [token [unquote [extract 2 \line\]] -count] &by 2 &pushpoint 1,[calc \.leg$box_left\ + [extract \a\ [unquote ~ [extract 2 \line\]]] / \.leg$sub_units\],[calc ~ \.leg$box_top\ - [extract [calc \a\ + 1] [unquote ~ [extract 2 \line\]]] / \.leg$sub_units\] &end /* do to by &pushpoint 9,0,0 /* Set text mask colour for pattern fill masking &s .leg$textmask_colour [unquote [show shadecolor current 1]] &end /* then do &end /* then do &else &do &type &select \coordinates\ &when value &type Invalid coordinate values for SUBSHAPE (line \l\) &when points &type Minimum of 3 coordinates pairs are required (line \l\) &when odd &type Even number of coordinates required for SUBSHAPE (line \l\) &end /* select &end /* else do &end /* then do &else &do &type &type Missing required arguments for SUBSHAPE (line\l\) &end /* else do &end /* when SUBSHAPE /* ============================================================================ /* /* SUBTEXT /* /* Syntax: SUBTEXT {text_symbol} {point_size} &when SUBTEXT &do /* Check for required arguments &if not [null [extract 4 \line\]] &then &do /* Evaluate coordinates are valid &if [type [extract 2 \line\]] lt 0 and ~ [type [extract 3 \line\]] lt 0 &then &do /* Flush any points in buffer &flushpoints /* Move cursor to place text MOVE [calc \.leg$x\ + [extract 2 \line\] / \.leg$sub_units\] ~ [calc \.leg$box_top\ - [extract 3 \line\] / \.leg$sub_units\] /* Check if no text symbol entered &if [null [extract 5 \line\]] &then /* Plot text TEXT [extract 4 \line\] LL &else &do /* Check if symbol argument is numeric or if it is skipped &if [type [extract 5 \line\]] = -1 or ~ [quote [extract 5 \line\]] = '#' &then &do /* Set text symbol to argument or to current symbol if skipped &if [type [extract 5 \line\]] = -1 &then &do &s textsymbol [extract 5 \line\] TEXTDELETE ALL TEXTSET \.leg$textset\ &end /* then do &else &s textsymbol [show textsymbol] /* Check if text symbol exists &if [type [show textinfo \textsymbol\ 1]] > 0 &then &do TEXTSYMBOL \textsymbol\ /* Check if no value entered for point size &if [null [extract 6 \line\]] &then /* Plot text TEXT [extract 4 \line\] LL &else &do /* Check if point size argument is numeric &if [type [extract 6 \line\]] = -1 &then &do TEXTSIZE [extract 6 \line\] PT /* Plot text TEXT [extract 4 \line\] LL &end /* then do &else &do &type &type Invalid value for argument {point_size} (line \l\) &end /* else do &end /* else do &end /* then do &else &do &type &type Text symbol [extract 5 \line\] does not exist (line \l\) &end /* else do &end /* then do &else &do &type &type Invalid value for argument {text_symbol} (line \l\) &end /* else do &end /* else do &end /* then do &else &do &type &type Invalid values for arguments (line \l\) &end /* else do &end /* then do &else &do &type &type Missing required arguments for SUBTEXT (line \l\) &end /* else do &end /* when SUBTEXT /* ============================================================================ /* /* TEXT /* /* Syntax: TEXT {line_spacing} {indent} /* Syntax: TEXT
{line_spacing} /* &when TEXT &do /* Set text symbol TEXTFONT \.leg$text_font\ TEXTSIZE \.leg$text_size\ PT TEXTCOLOR [unquote \.leg$text_colour\] /* Set default line spacing and indent &if \previous\ = start &then &s linespacing [calc \.leg$text_size\ / 72 - ( ~ \.leg$text_size\ / 72 ) * 0.2] &else &s linespacing [calc [value .leg$\previous\_to_text] / 72] &s indent 0 &s type LEFT /* Check for required text string &if not [null [extract 2 \line\]] &then &do /* Check optional arguments &if not [null [extract 3 \line\]] &then &do /* Check if third argument is numeric &if [type [extract 3 \line\]] < 0 &then /* Set line spacing &s linespacing [calc [extract 3 \line\] / \.leg$line_spacing\] &else &do /* Check if argument is CENTER or DASH or skipped &select [upcase [extract 3 \line\]] &when DASH, CENTER &s type [upcase [extract 3 \line\]] &when # &s type LEFT &otherwise &do &type &type ~ Invalid argument for {line_spacing}, using default (line \l\) &end /* otherwise &end /* select &end /* else do /* Check if forth argument entered &if not [null [extract 4 \line\]] &then &do /* Check if argument is numeric &if [type [extract 4 \line\]] < 0 &then &do &if \type\ = LEFT &then &s indent [extract 4 \line\] &else &s linespacing [calc [extract 4 \line\] / \.leg$line_spacing\] &end /* then do &else &do /* Check if indent skipped &if [quote [extract 4 \line\]] <> '#' &then &do &if \type\ = LEFT &then &do &type &type ~ Invalid value for argument {indent}, using default (line \l\) &end /* then do &else &do &type &type ~ Invalid value for argument {line_spacing}, using default (line \l\) &end /* else do &end /* then do &end /* else do &end /* then do &end /* then do /* Flush any points in buffer &flushpoints /* Plot text &s .leg$y [calc \.leg$y\ - \linespacing\] &select \type\ &when LEFT &do MOVE [calc \.leg$x\ + \indent\ / \.leg$indent\] \.leg$y\ TEXT [extract 2 \line\] LL &end /* when LEFT &when CENTER &do MOVE [calc \.leg$x\ + \.leg$column_width\ / 2] \.leg$y\ TEXT [extract 2 \line\] LC &end /* when CENTER &when DASH &do /* Plot line first then text with text mask LINEDELETE ALL LINETYPE WIDE LINEPEN 0.010 LINEINTERVAL 0.04 LINETEMPLATE 11 LINECOLOR CMYK -1 -1 -1 100 LINE \.leg$x\ [calc \.leg$y\ + \.leg$text_size\ / 72 * 0.3] ~ [calc \.leg$x\ + \.leg$column_width\] ~ [calc \.leg$y\ + \.leg$text_size\ / 72 * 0.3] TEXTMASK POLYGON 0.030 TEXTMASK COLOR CMYK 0 0 0 0 MOVE [calc \.leg$x\ + \.leg$column_width\ / 2] \.leg$y\ TEXT [extract 2 \line\] LC TEXTMASK NONE &end /* when DASH &end /* select &s previous [extract 1 \line\] &end /* then do &else &do &type &type Missing text string for command TEXT (line \l\) &end /* else do &end /* when TEXT /* ============================================================================ /* /* TITLE /* /* Syntax: TITLE {title} {line_spacing} {indent} /* &when TITLE &do /* Evaluate optional arguments, set initial values &s title_text 'L E G E N D' &s title_spacing &s title_indent /* Check if using default title &if not [null [extract 2 \line\]] &then &do /* Check if skipping title argument &if [quote [extract 2 \line\]] <> '#' &then &s title_text [extract 2 \line\] /* Check if entering line spacing value &if not [null [extract 3 \line\]] &then &do /* Check if line spacing value is numeric &if [type [extract 3 \line\]] < 0 &then &s title_spacing [extract 3 \line\] &else &do /* Check if line spacing argument skipped &if [quote [extract 3 \line\]] <> '#' &then &do &s title_text &type &type Invalid value for argument {line_spacing} (line \l\) &end /* then do &end /* else do /* Check if entering a indent value &if not [null [extract 4 \line\]] &then &do /* Check if indent value is numeric &if [type [extract 4 \line\]] < 0 &then &s title_indent [extract 4 \line\] &else &do /* Check if indent argument skipped &if [quote [extract 4 \line\]] <> '#' &then &do &s title_text &type &type Invalid value for argument {indent} (line \l\) &end /* then do &end /* else do &end /* then do &end /* then do &end /* then do &end /* when TITLE /* ============================================================================ /* /* Comment or unrecognized line /* &otherwise &do &if [quote [extract 1 \line\]] ne [quote [joinfile / *]] &then &do &type &type Unrecognized command (line \l\): [extract 1 \line\] &end /* then do &end /* otherwise &end /* select /* ============================================================================ /* Read next line. Blank lines are ignored, except if the previous element /* plotted was a box, and the line is recognized as such. &do &until not [null \line\] or \readstatus\ <> 0 &s line [unquote [read \file\ readstatus]] &s l [calc \l\ + 1] &if [null \line\] and \readstatus\ = 0 and \previous\ = box &then &s .leg$line_space .TRUE. &end /* do until &end /* do while loop &call EXIT &return /* End of AML /* ============================================================================ /* /* Routine BOXTEXT /* /* Used to place text in box based on default values or arguments. Error /* checking is performed on all arguments. /* &routine BOXTEXT /* Evaulate line spacing and indent arguments, and set initial default values &s x [calc \.leg$xmin\ + ( ( \.leg$xmax\ - \.leg$xmin\ ) / 2 )] &s y [calc \.leg$ymax\ - ( ( \.leg$ymax\ - \.leg$ymin\ ) / 2 ) + ~ ( ( \.leg$ymax\ - \.leg$ymin\ ) * 0.05 )] &s position CC &if not [null [extract [calc \a\ + 1] \line\]] &then &do /* Check if value entered for line spacing is numeric &if [type [extract [calc \a\ + 1] \line\]] < 0 &then &do &s y [calc \.leg$ymax\ - ( [extract [calc \a\ + 1] \line\] / ~ \.leg$box_line_spacing\ )] &s position LC &end /* then do &else &do /* Check if invalid value entered for line spacing &if [quote [extract [calc \a\ + 1] \line\]] <> '#' &then &do &s y &type &type Invalid value for argument {line_spacing} (line \l\) &end /* then do &end /* else do /* Check if anything entered for remaining argument &if not [null [extract [calc \a\ + 2] \line\]] &then &do /* Check if value entered for indent is numeric &if [type [extract [calc \a\ + 2] \line\]] < 0 &then &do &s x [calc \.leg$xmin\ + ( [extract [calc \a\ + 2] \line\] / ~ \.leg$box_indent\ )] &if \position\ = CC &then &s position CL &else &s position LL &end /* then do &else &do /* Check if invalid value entered for indent &if [quote [extract [calc \a\ + 2] \line\]] <> '#' &then &do &s x &type &type Invalid value for argument {indent} (line \l\) &end /* then do &end /* else do &end /* then do &end /* then do /* Plot text if arguments are valid &if not [null \x\] and not [null \y\] &then &do /* Set text symbol for text in box TEXTFONT \.leg$box_font\ TEXTSIZE \.leg$box_size\ PT TEXTCOLOR [unquote \.leg$box_colour\] /* Plot text MOVE \x\ \y\ TEXT [extract \a\ \line\] \position\ &end /* then do &return /* ============================================================================ /* /* Routine ERROR /* /* General procedure whenever an error is encountered in the AML. /* &routine ERROR &severity &error &ignore &s x [close -all] &setchar &standard &messages &on &type &type An error has occurred in the legend.aml while reading your file %asciifile% &return; &return &warning Final line read (line %l%): %line% /* ============================================================================ /* /* Routine EXIT /* &routine EXIT /* Check if title requested &if not [null \title_text\] and not \page\ &then &do /* Check if using default line spacing &if [null \title_spacing\] &then &s title_spacing [calc \.leg$title_size\ * 1.8] /* Set indent value if using default &if [null \title_indent\] &then &do &s title_indent [calc ( \.leg$x\ + \.leg$column_width\ - ~ \.leg$x_origin\ ) / 2 * \.leg$indent\] &s justify LC &end /* then do &else &s justify LL /* Set text symbol TEXTFONT \.leg$title_font\ TEXTSIZE \.leg$title_size\ PT TEXTCOLOR [unquote \.leg$title_colour\] /* Flush any points in buffer &flushpoints /* Plot title MOVE [calc \.leg$x_origin\ + \title_indent\ / \.leg$indent\] ~ [calc \.leg$y_origin\ + \title_spacing\ / \.leg$line_spacing\ ] TEXT \title_text\ \justify\ &end /* then do /* Close ASCII file &s x [close -all] &type &type Finished plotting legend from file \asciifile\ /* If plotting legend to graphics file (letter size), redisplay graphics window, /* page size and previous map composition if one open &if not [null \grafile\] &then &do /* Display total number of graphic file (pages) produced &type &type Total number of pages (legend1.gra, legend2.gra ...): \page_counter\ DISPLAY 9999 SIZE CANVAS \display_size\ PAGESIZE \page_size\ &if not [null \map_composition\] &then MAP \map_composition\ &end /* then do /* Reset AML characters to default values &setchar &standard /* Flush any points in buffer &flushpoints &messages &on &return; &return /* ============================================================================ /* /* Routine INVALID_COLOUR /* /* Used if an invalid colour is assigned to a symbol, preventing the AML /* from crashing due to the error. /* &routine INVALID_COLOUR &severity &error &routine ERROR &type &type Invalid colour name: \colourname\ (line \l\) &s symbol x &return /* ============================================================================ /* /* Routine NEWPAGE /* /* Plots the legend to a graphics file, set to letter page size /* &routine NEWPAGE /* /* Delete graphics file if it exists &if [exists [joinfile \grafile\\page_counter\ gra -ext] -file] &then &s x [delete [joinfile \grafile\\page_counter\ gra -ext] -file] DISPLAY 1040 1 [joinfile \grafile\\page_counter\ gra -ext] PAGESIZE 8.5 11 PAGEUNITS INCHES &s .leg$y 10 &s .leg$x 1 &s previous start &return /* ============================================================================ /* /* Routine SET /* &routine SET /* /* NOTE: No error checking is performed to ensure that the variable is /* given the correct value type (numeric, character). /* /* Check for required arguments &if not [null [extract 3 \line\]] &then &do /* Check if variable exists &if [variable .leg$[extract 2 \line\]] &then /* Assign value to variable &s .leg$[extract 2 \line\] [extract 3 \line\] &else &do &type &type Unknown variable: [extract 2 \line\] (line \l\) &end /* else do &end /* then do &else &do &type &type Missing required arguments (line \l\) &end /* else do &return