------------------------------------------------------------------ -- -- NAME: CGM_GEN_WSD_UTILITIES - BODY -- DISCREPANCY REPORTS: -- ------------------------------------------------------------------ -- file: CGM_GEN_WSD_UTIL_B.ADA -- level: 0a with CGM_GENERATOR_BINARY; with CONVERT_NDC_DC; with NDC_POINT_OPS; with NDC_OPS; with GKS_TYPES; with CGM_STANDARD_TYPES; with CGM_ELEMENT_STATE; with CGM_GEN_STATE; with WSR_WS_TRANSFORMATION; with CGM_GEN_SET_INDIVIDUAL_ATTRIBUTES; use CGM_GENERATOR_BINARY; use GKS_TYPES; package body CGM_GEN_WSD_UTILITIES is --------------------------------------------------------------------- function ">" ( A, B : CGM_GEN_STATE.PICTURE_NUMBER ) return BOOLEAN renames CGM_GEN_STATE.">"; -- This function provides visibility to the operator so that -- it may be used in infix notation. --------------------------------------------------------------------- function "=" ( A, B : CGM_STANDARD_TYPES.COLOUR_DIRECT ) return BOOLEAN renames CGM_STANDARD_TYPES."="; -- This function provides visibility to the operator so that -- it may be used in infix notation. --------------------------------------------------------------------- function "-" ( A, B : CGM_STANDARD_TYPES.INTENSITY) return CGM_STANDARD_TYPES.INTENSITY renames CGM_STANDARD_TYPES."-"; -- This function provides visibility to the operator so that -- it may be used in infix notation. --------------------------------------------------------------------- function CONVERT_GKS_COLOUR_TO_CGM_COLOUR (GKS_COLOUR : in GKS_TYPES.COLOUR_REPRESENTATION) return CGM_STANDARD_TYPES.COLOUR_DIRECT is -- Convert the GKS colour intensities from real values, -- range 0.0 thru 1.0, to CGM colour direct integer values. -- The CGM colour direct value range is contained in the -- cgm gen state variable for colour value extent. This -- variable contains a max and min integer value for each -- of the colours: Red, Green, and Blue. If "X" is the GKS -- colour intensity, we map to the CGM intensity using... -- (((cgm_max - cgm_min) * X) + cgm_min). -- In the following, "A" = (cgm_max - cgm_min) -- and "B" = (cgm_min) -- so the mapping is... (A * X) + B A, B : FLOAT; -- Local storage which holds factors used to map GKS colour -- intensities to CGM colour initensities. CGM_COLOUR : CGM_STANDARD_TYPES.COLOUR_DIRECT; -- A CGM colour direct object. begin -- Get the mapping factors for the red intensity and -- assign the mapped value. A := FLOAT (CGM_GEN_STATE.COLOUR_VALUE_EXTENT.MAXIMUM.RED - CGM_GEN_STATE.COLOUR_VALUE_EXTENT.MINIMUM.RED); B := FLOAT (CGM_GEN_STATE.COLOUR_VALUE_EXTENT.MINIMUM.RED); CGM_COLOUR.RED := CGM_STANDARD_TYPES. INTENSITY (A * FLOAT(GKS_COLOUR.RED) + B); -- Get the mapping factors for the green intensity and -- assign the mapped value. A := FLOAT (CGM_GEN_STATE.COLOUR_VALUE_EXTENT.MAXIMUM.GREEN - CGM_GEN_STATE.COLOUR_VALUE_EXTENT.MINIMUM.GREEN); B := FLOAT (CGM_GEN_STATE.COLOUR_VALUE_EXTENT.MINIMUM.GREEN); CGM_COLOUR.GREEN := CGM_STANDARD_TYPES. INTENSITY (A * FLOAT(GKS_COLOUR.GREEN) + B); -- Get the mapping factors for the blue intensity and -- assign the mapped value. A := FLOAT (CGM_GEN_STATE.COLOUR_VALUE_EXTENT.MAXIMUM.BLUE - CGM_GEN_STATE.COLOUR_VALUE_EXTENT.MINIMUM.BLUE); B := FLOAT (CGM_GEN_STATE.COLOUR_VALUE_EXTENT.MINIMUM.BLUE); CGM_COLOUR.BLUE := CGM_STANDARD_TYPES. INTENSITY (A * FLOAT(GKS_COLOUR.BLUE) + B); return CGM_COLOUR; end CONVERT_GKS_COLOUR_TO_CGM_COLOUR; --------------------------------------------------------------------- function CONVERT_NDC_VDC (NDC_POINTS : in CGI.ACCESS_POINT_ARRAY_TYPE) return CGM_STANDARD_TYPES.VDC_COORDINATE.POINT_ARRAY is -- This function performs a type conversion from CGI NDC to -- CGM VDC for an array of points. -- The parameters used in this function are: -- NDC_POINTS A pointer to an array of NDC points. CGM_POINTS : CGM_STANDARD_TYPES. VDC_COORDINATE.POINT_ARRAY(NDC_POINTS'range); -- An array of VDC points. begin for I in NDC_POINTS'range loop CGM_POINTS(I) := ((CGM_STANDARD_TYPES. VDC_COORDINATE_TYPE(NDC_POINTS(I).X)), (CGM_STANDARD_TYPES. VDC_COORDINATE_TYPE(NDC_POINTS(I).Y))); end loop; return CGM_POINTS; end CONVERT_NDC_VDC; ---------------------------------------------------------------- function CONVERT_NDC_VDC (NDC_POINT : in NDC.POINT) return CGM_STANDARD_TYPES.VDC_COORDINATE.POINT is -- This function performs a type conversion from GKS NDC to a -- point in CGM VDC. -- The parameters used in this function are: -- NDC_POINT An NDC point. CGM_POINT : CGM_STANDARD_TYPES.VDC_COORDINATE.POINT; -- A VDC point. begin CGM_POINT := ((CGM_STANDARD_TYPES. VDC_COORDINATE_TYPE(NDC_POINT.X)), (CGM_STANDARD_TYPES. VDC_COORDINATE_TYPE(NDC_POINT.Y))); return CGM_POINT; end CONVERT_NDC_VDC; ---------------------------------------------------------------- function CONVERT_NDC_VDC (NDC_VECTOR : in NDC.VECTOR) return CGM_STANDARD_TYPES.VDC_COORDINATE.VECTOR is -- This function performs a type conversion from GKS NDC to -- a vector in CGM VDC. -- The parameters used in this function are: -- NDC_VECTOR An NDC vector. DC_VECTOR : DC.VECTOR; -- A temporary DC vector used in transforming an NDC vector to a -- VDC vector CGM_VECTOR : CGM_STANDARD_TYPES.VDC_COORDINATE.VECTOR; -- A VDC vector. begin CGM_VECTOR := ((CGM_STANDARD_TYPES. VDC_COORDINATE_TYPE(NDC_VECTOR.X)), (CGM_STANDARD_TYPES. VDC_COORDINATE_TYPE(NDC_VECTOR.Y))); return CGM_VECTOR; end CONVERT_NDC_VDC; ---------------------------------------------------------------- function CONVERT_NDC_VDC (NDC_RECT_LIMITS : in NDC.RECTANGLE_LIMITS) return CGM_STANDARD_TYPES.VDC_COORDINATE.RECTANGLE_LIMITS is -- This function performs a type conversion of rectangle limits -- in GKS NDC to rectangle limits in CGM VDC. -- The parameter used in this function is: -- NDC_RECT_LIMITS A rectangle in NDC's. CGM_RECT_LIMITS : CGM_STANDARD_TYPES.VDC_COORDINATE.RECTANGLE_LIMITS; -- A VDC rectangle. begin CGM_RECT_LIMITS := ((CGM_STANDARD_TYPES. VDC_COORDINATE_TYPE(NDC_RECT_LIMITS.XMIN)), (CGM_STANDARD_TYPES. VDC_COORDINATE_TYPE(NDC_RECT_LIMITS.XMAX)), (CGM_STANDARD_TYPES. VDC_COORDINATE_TYPE(NDC_RECT_LIMITS.YMIN)), (CGM_STANDARD_TYPES. VDC_COORDINATE_TYPE(NDC_RECT_LIMITS.YMAX))); return CGM_RECT_LIMITS; end CONVERT_NDC_VDC; ---------------------------------------------------------------- function CONVERT_NDC_VDC (NDC_SIZE : in NDC.SIZE) return CGM_STANDARD_TYPES.VDC_COORDINATE.SIZE is -- This function performs a type conversion from GKS NDC to a -- size in CGM VDC. -- The parameters used in this function are: -- NDC_SIZE An NDC size value. CGM_SIZE : CGM_STANDARD_TYPES.VDC_COORDINATE.SIZE; -- A VDC size object. begin CGM_SIZE := ((CGM_STANDARD_TYPES. VDC_COORDINATE.MAGNITUDE(NDC_SIZE.XAXIS)), (CGM_STANDARD_TYPES. VDC_COORDINATE.MAGNITUDE(NDC_SIZE.YAXIS))); return CGM_SIZE; end CONVERT_NDC_VDC; ------------------------------------------------------------------- function BUILD_PIC_STRING (PICTURE_NUMBER : in STRING) return CGM_STANDARD_TYPES.PICTURE_STRING is -- Returns a string with the COMPUTED name of the picture. The -- picture name contains the picture number. -- The parameters used in this function are: -- PICTURE_NUMBER The ASCII string of the picture number. begin return (8 + PICTURE_NUMBER'length -1, "PICTURE_" & PICTURE_NUMBER (PICTURE_NUMBER'first+1..PICTURE_NUMBER'last)); end BUILD_PIC_STRING; -------------------------------------------------------------- procedure SET_CGM_ATTRIBUTES (WS_STATE_LIST : in WS_STATE_LIST_TYPES.WS_STATE_LIST_PTR; NEW_PICTURE : in BOOLEAN := TRUE) is -- Converts the GKS data type in the WS STATE LIST to a CGM data -- type and calls the appropriate procedure to output a CGM element -- for all of the implemented attributes. -- This procedure is called either when a new picture is started -- or when the workstation has been activated. It's job is to -- make the current CGM state match the current workstation (GKS) -- state. It does this by outputing all of the attributes. -- Additionally, when a new picture starts, the state of the CGM -- implicitly returns to a default state so this routine changes -- the data structures in package CGM_ELEMENT_STATE to reflect this. -- This procedure is necessary when the workstation is activated -- because the GKS state may have changed since the workstation -- was deactivated and while deactivated only the workstation state -- list was updated (not the CGM element state or file). -- NOTE: -- The procedures called to build and write the CGM elements -- may or may not write the element to the file depending on -- the current CGM STATE (see package CGM_EL_ATTR.ADA for more -- details). Also, nothing is written if the display surface is -- empty. -- The parameters used in this procedure is: -- WS_STATE_LIST A pointer to the workstation state list -- NEW_PICTURE A flag that dictates if the cgm element -- state should be changed prior to calling -- the cgm el procedures that output the -- CGM attribute elements. NDC_CHAR_HEIGHT : NDC.MAGNITUDE; -- A temporary NDC magnitude object. COLOUR_REP : CGM_STANDARD_TYPES.COLOUR_DIRECT; -- Temporary storage which holds a parameter for updating -- the CGM colour table. CLIP_LIMITS : CGM_STANDARD_TYPES. VDC_COORDINATE.RECTANGLE_LIMITS; -- A VDC rectangle. NDC_CLIP_LIMITS : NDC.RECTANGLE_LIMITS; -- A NDC rectangle. begin if WS_STATE_LIST.WS_DISPLAY_SURFACE = GKS_TYPES.EMPTY then return; end if; -- Reset the current CGM element state and the CGM current -- colour table if this is a new picture. if NEW_PICTURE then CGM_ELEMENT_STATE.CURRENT := CGM_ELEMENT_STATE.DEFAULT; CGM_ELEMENT_STATE.DELETE_ALL_FROM_CURRENT_COLOUR_TABLE; end if; -- Request output of all CGM attributes (see note above). CGM_LINE_BUNDLE_INDEX (CGM_STANDARD_TYPES. POLYLINE_INDEX(WS_STATE_LIST. OUTPUT_ATTR. CURRENT_POLYLINE_INDEX)); CGM_LINE_TYPE (CGM_STANDARD_TYPES. LINETYPE(WS_STATE_LIST. OUTPUT_ATTR. CURRENT_LINETYPE)); CGM_LINE_WIDTH (CGM_STANDARD_TYPES. LINE_WIDTH(WS_STATE_LIST. OUTPUT_ATTR. CURRENT_LINEWIDTH_SCALE_FACTOR)); CGM_LINE_COLOUR (CGM_STANDARD_TYPES. COLOUR_INDEX(WS_STATE_LIST. OUTPUT_ATTR. CURRENT_POLYLINE_COLOUR_INDEX)); CGM_MARKER_BUNDLE_INDEX (CGM_STANDARD_TYPES. POLYMARKER_INDEX(WS_STATE_LIST. OUTPUT_ATTR. CURRENT_POLYMARKER_INDEX)); CGM_MARKER_TYPE (CGM_STANDARD_TYPES. MARKER_TYPE(WS_STATE_LIST. OUTPUT_ATTR. CURRENT_MARKER_TYPE)); CGM_MARKER_SIZE (CGM_STANDARD_TYPES. MARKER_SIZE(WS_STATE_LIST. OUTPUT_ATTR. CURRENT_MARKER_SIZE_SCALE_FACTOR)); CGM_MARKER_COLOUR (CGM_STANDARD_TYPES. COLOUR_INDEX(WS_STATE_LIST. OUTPUT_ATTR. CURRENT_POLYMARKER_COLOUR_INDEX)); CGM_TEXT_BUNDLE_INDEX (CGM_STANDARD_TYPES. TEXT_INDEX(WS_STATE_LIST. OUTPUT_ATTR. CURRENT_TEXT_INDEX)); CGM_TEXT_FONT_INDEX (CGM_STANDARD_TYPES. TEXT_FONT (WS_STATE_LIST. OUTPUT_ATTR. CURRENT_TEXT_FONT_AND_PRECISION. FONT)); CGM_TEXT_PRECISION (CGM_STANDARD_TYPES. TEXT_PRECISION'VAL (TEXT_PRECISION'POS (WS_STATE_LIST. OUTPUT_ATTR. CURRENT_TEXT_FONT_AND_PRECISION. PRECISION))); CGM_CHAR_EXPANSION_FACTOR (CGM_STANDARD_TYPES. CHAR_EXPANSION (WS_STATE_LIST. OUTPUT_ATTR. CURRENT_CHAR_EXPANSION_FACTOR)); CGM_CHAR_SPACING (CGM_STANDARD_TYPES. CHAR_SPACING (WS_STATE_LIST. OUTPUT_ATTR. CURRENT_CHAR_SPACING)); CGM_TEXT_COLOUR (CGM_STANDARD_TYPES. COLOUR_INDEX(WS_STATE_LIST. OUTPUT_ATTR. CURRENT_TEXT_COLOUR_INDEX)); NDC_CHAR_HEIGHT := NDC_POINT_OPS. NORM (WS_STATE_LIST. OUTPUT_ATTR. CURRENT_CHAR_HEIGHT_VECTOR); CGM_CHAR_HEIGHT (CGM_STANDARD_TYPES. VDC_CHAR_HEIGHT(NDC_CHAR_HEIGHT)); CGM_CHAR_ORIENTATION (CGM_GEN_WSD_UTILITIES. CONVERT_NDC_VDC(WS_STATE_LIST. OUTPUT_ATTR. CURRENT_CHAR_HEIGHT_VECTOR), CGM_GEN_WSD_UTILITIES. CONVERT_NDC_VDC(WS_STATE_LIST. OUTPUT_ATTR. CURRENT_CHAR_WIDTH_VECTOR)); CGM_TEXT_PATH(CGM_STANDARD_TYPES. TEXT_PATH'VAL(TEXT_PATH'POS(WS_STATE_LIST. OUTPUT_ATTR. CURRENT_TEXT_PATH))); CGM_TEXT_ALIGNMENT (CGM_STANDARD_TYPES. HORIZONTAL_ALIGNMENT'VAL (HORIZONTAL_ALIGNMENT'POS (WS_STATE_LIST. OUTPUT_ATTR. CURRENT_TEXT_ALIGNMENT.HORIZONTAL)), CGM_STANDARD_TYPES. VERTICAL_ALIGNMENT'VAL (VERTICAL_ALIGNMENT'POS (WS_STATE_LIST. OUTPUT_ATTR. CURRENT_TEXT_ALIGNMENT.VERTICAL))); CGM_FILL_BUNDLE_INDEX(CGM_STANDARD_TYPES. FILL_INDEX(WS_STATE_LIST. OUTPUT_ATTR. CURRENT_FILL_AREA_INDEX)); CGM_INTERIOR_STYLE (CGM_STANDARD_TYPES. INTERIOR_STYLE'VAL (INTERIOR_STYLE'POS (WS_STATE_LIST. OUTPUT_ATTR. CURRENT_FILL_AREA_INTERIOR_STYLE))); CGM_FILL_COLOUR (CGM_STANDARD_TYPES. COLOUR_INDEX(WS_STATE_LIST. OUTPUT_ATTR. CURRENT_FILL_AREA_COLOUR_INDEX)); CGM_HATCH_INDEX (CGM_STANDARD_TYPES. HATCH_INDEX(WS_STATE_LIST. OUTPUT_ATTR. CURRENT_FILL_AREA_STYLE_INDEX)); CGM_PATTERN_INDEX (CGM_STANDARD_TYPES. PATTERN_INDEX(WS_STATE_LIST. OUTPUT_ATTR. CURRENT_FILL_AREA_STYLE_INDEX)); CGM_FILL_REFERENCE_POINT (CGM_GEN_WSD_UTILITIES. CONVERT_NDC_VDC(WS_STATE_LIST. OUTPUT_ATTR. CURRENT_PATTERN_REFERENCE_POINT)); CGM_PATTERN_SIZE (CGM_GEN_WSD_UTILITIES. CONVERT_NDC_VDC(WS_STATE_LIST. OUTPUT_ATTR. CURRENT_PATTERN_HEIGHT_VECTOR), CGM_GEN_WSD_UTILITIES. CONVERT_NDC_VDC(WS_STATE_LIST. OUTPUT_ATTR. CURRENT_PATTERN_WIDTH_VECTOR)); UPDATE_COLOUR_TABLE: -- Pass the colour representation for each of the colour indicies -- one at a time from the workstation state list. for I in 0..CGM_GEN_STATE.MAXIMUM_COLOUR_INDEX loop -- Get the cgm_standard_types representation of the colour in the -- workstation state list for the current colour index. COLOUR_REP := CONVERT_GKS_COLOUR_TO_CGM_COLOUR (WS_STATE_LIST. COLOUR_TABLE(GKS_TYPES.COLOUR_INDEX(I))); -- Send the colour representation the procedure that generates -- colour table elements. CGM_COLOUR_TABLE (INDEX => I, COLOUR => COLOUR_REP); end loop UPDATE_COLOUR_TABLE; CGM_GEN_SET_INDIVIDUAL_ATTRIBUTES. SET_ASF (WS_STATE_LIST, WS_STATE_LIST.OUTPUT_ATTR.ASPECT_SOURCE_FLAGS); -- Update the clipping rectangle. Clip limits are not an -- attribute but must be output with the attributes. NDC_CLIP_LIMITS := NDC_OPS."AND" (WS_STATE_LIST.CURRENT_WS_WINDOW, WS_STATE_LIST.OUTPUT_ATTR.CLIPPING_RECTANGLE); CLIP_LIMITS := CGM_GEN_WSD_UTILITIES.CONVERT_NDC_VDC (NDC_CLIP_LIMITS); CGM_CLIP_RECTANGLE (CLIP_LIMITS); end SET_CGM_ATTRIBUTES; -------------------------------------------------------------- procedure BEGIN_METAFILE_PICTURE (WS_STATE_LIST : in WS_STATE_LIST_TYPES. WS_STATE_LIST_PTR) is -- This routine will output the CGM elements required at the start -- of a picture. The picture number stored in the generator -- state package is assumed to be the picture number being started. -- The parameters for this procedure are: -- WS_STATE_LIST A pointer to the current workstation state list -- data structure. LOWER_LEFT : CGM_STANDARD_TYPES.VDC_COORDINATE.POINT; -- A VDC point to contain the lower left point of VDC extent. UPPER_RIGHT : CGM_STANDARD_TYPES.VDC_COORDINATE.POINT; -- A VDC point to contain the upper right point of VDC extent. COLOUR_REP : CGM_STANDARD_TYPES.COLOUR_DIRECT; -- Temporary storage to hold a parameter for generating the -- background colour element. begin -- Generate the CGM delimiter element that starts a picture. CGM_BEGIN_PICTURE (BUILD_PIC_STRING (CGM_GEN_STATE. PICTURE_NUMBER'IMAGE(CGM_GEN_STATE. CURRENT_PICTURE_NUMBER))); -- In this generator, VDC is the same as NDC space and the CGM -- VDC extent is the bounds of the current workstation window. -- Generate the CGM element that defines the VDC extent after -- insuring that the WS window is current. if WS_STATE_LIST. WS_XFORM_UPDATE_STATE = GKS_TYPES.PENDING then WSR_WS_TRANSFORMATION.UPDATE_WS_TRANSFORMATION (WS_STATE_LIST); end if; LOWER_LEFT.X := CGM_STANDARD_TYPES. VDC_COORDINATE_TYPE (WS_STATE_LIST.CURRENT_WS_WINDOW.XMIN); LOWER_LEFT.Y := CGM_STANDARD_TYPES. VDC_COORDINATE_TYPE (WS_STATE_LIST.CURRENT_WS_WINDOW.YMIN); UPPER_RIGHT.X := CGM_STANDARD_TYPES. VDC_COORDINATE_TYPE (WS_STATE_LIST.CURRENT_WS_WINDOW.XMAX); UPPER_RIGHT.Y := CGM_STANDARD_TYPES. VDC_COORDINATE_TYPE (WS_STATE_LIST.CURRENT_WS_WINDOW.YMAX); CGM_VDC_EXTENT (LOWER_LEFT, UPPER_RIGHT); -- Scaling mode specifies if VDC space is abstract or related -- to a specific metric scale. This procedure sets two generator -- state variables: the scaling mode and the scale factor, both -- of which must be properly set before the scaling mode element -- is written. CGM_SCALING_MODE (CGM_GEN_STATE.SCALING_MODE, CGM_GEN_STATE.SCALE_FACTOR); -- Colour selection mode specifies if colours will be referenced -- by indicies or direct colour values (RGB tuples). CGM_COLOUR_SELECTION_MODE (CGM_GEN_STATE.COLOUR_SELECTION_MODE); -- Line width specification mode specifies if line widths -- will be absolute or scaled. CGM_LINE_WIDTH_SPECIFICATION_MODE (CGM_GEN_STATE.LINE_WIDTH_SPEC_MODE); -- Marker size specification mode specifies if marker size -- will be absolute or scaled. CGM_MARKER_SIZE_SPECIFICATION_MODE (CGM_GEN_STATE.MARKER_SIZE_SPEC_MODE); -- Edge width specification mode specifies if edge widths -- will be absolute or scaled. CGM_EDGE_WIDTH_SPECIFICATION_MODE (CGM_GEN_STATE.EDGE_WIDTH_SPEC_MODE); -- Get the cgm_standard_types representation of the colour in the -- workstation state list for colour index 0. COLOUR_REP := CONVERT_GKS_COLOUR_TO_CGM_COLOUR (WS_STATE_LIST.COLOUR_TABLE(0)); -- Compare it to the default colour representation for colour index -- zero and output a background colour element if they differ. if COLOUR_REP /= CGM_ELEMENT_STATE. DEFAULT_DIRECT_COLOUR_VALUE (0) then CGM_BACKGROUND_COLOUR (COLOUR_REP); end if; -- That is the end of the picture descriptor so terminate it -- and signal the start of the body of the picture. CGM_BEGIN_PICTURE_BODY; -- Display surface is no longer empty. WS_STATE_LIST.WS_DISPLAY_SURFACE := GKS_TYPES.NOTEMPTY; -- CGM returns to a default state at the beginning of a picture -- but GKS remains in it's current state. Make the CGM state -- match the current GKS/CGI state stored in the workstation -- state list. SET_CGM_ATTRIBUTES (WS_STATE_LIST => WS_STATE_LIST, NEW_PICTURE => TRUE); end BEGIN_METAFILE_PICTURE; --------------------------------------------------------------------- end CGM_GEN_WSD_UTILITIES;