Programmer's ROM - The Computer Language Library

home *** CD-ROM | disk | FTP | other *** search

/ Programmer's ROM - The Computer Language Library / programmersrom.iso / ada / tools / wmgs.src < prev next >

Wrap

Text File | 1988-05-03 | 297.1 KB | 8,964 lines

--:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: --menudraw.sp --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: package MENU_DRAW is type NESTED_LEVEL is ( ONE, TWO, THREE, FOUR ); procedure DRAW_ERROR_PORT ( TEXT1 : in string; TEXT : in string ); procedure DRAW_DP_MENU ( LEVEL : in NESTED_LEVEL ); procedure DRAW_SDF_MENU ( CMD_DRAW : in boolean := true ); procedure DRAW_DIG_MENU; procedure DRAW_PLC_MENU; procedure DRAW_SESSION_MENU; procedure DRAW_MAP_MENU; -- procedure DRAW_HELP_MENU; -- procedure DRAW_HELP_SUB_MENU; procedure INITIALIZE_MENUS; procedure DRAW_PROJ_PARAM_FIELDS ( OMIT : in boolean := false ); procedure DRAW_PROJ_LIMIT_FIELDS ( OMIT : in boolean := false ); procedure DRAW_SESSION_FILENAME; procedure DRAW_DISPLAY_FILENAME; end MENU_DRAW; --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: --menuparse.sp --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: package MENU_PARSE is type MENUS is ( SESSION, DISPLAY_PARAM, SEC_DISPLAY_PARAM, -- HELP_TOPIC, -- HELP_SUBTOPIC, SPECIAL_DISPLAY, DIAGNOSTIC, MAP_OF, PLOTTER_CHAR ); type COMMAND is ( EDIT, CONTINUE, SAVE, -- HELP, LEAVE, QUIT, -- UNDO, SPECIAL, -- APPEND, OPENF ); procedure INITIALIZE_PARSE; function PARSE_COMMAND_LINE return COMMAND; function CURRENT_MENU return MENUS; procedure EDIT; procedure CONTINUE; procedure SAVE; -- procedure HELP; procedure LEAVE; procedure QUIT; -- procedure UNDO; procedure SPECIAL; -- procedure APPEND; procedure OPENF; end MENU_PARSE; --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: --menufilei.sp --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: package MENU_FILE_IO is procedure OPEN_MENU_FILE ( FILE : in string ); -- use for OPENF command. procedure CREATE_MENU_FILE ( FILE : in string ); -- use for SAVE command. procedure CLOSE_MENU_FILE; -- use for OPENF & SAVE commands. procedure WRITE_DISPLAY_CURRENTS; procedure WRITE_SESSION_CURRENTS; procedure READ_DISPLAY_DEFAULTS; procedure READ_SESSION_DEFAULTS; end MENU_FILE_IO; --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: --worlddata.sp --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: with DIRECT_IO; package WORLD_DATA_FILES is -- type LATITUDE_LONGITUDE_PAIR is -- record -- LATITUDE : float; -- LONGITUDE : float; -- end record; -- MAXIMUM_LAT_LON_PAIRS : constant integer := 750; MAXIMUM_LAT_LON_PAIRS : constant integer := 1000; subtype LAT_LON_PAIR_INDEX is integer range 1 .. MAXIMUM_LAT_LON_PAIRS; type SET_OF_LAT_LON_PAIRS is array (LAT_LON_PAIR_INDEX'first .. LAT_LON_PAIR_INDEX'last) of float; type LAT_LON_RECORD is record NUMBER_OF_PAIRS : LAT_LON_PAIR_INDEX; MINIMUM_LAT : float; MAXIMUM_LAT : float; MINIMUM_LON : float; MAXIMUM_LON : float; LAT_LON_PAIRS : SET_OF_LAT_LON_PAIRS; end record; package WORLD_DATA_IO is new DIRECT_IO ( LAT_LON_RECORD ); end WORLD_DATA_FILES; --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: --graphic.sp --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: package Graphic is type View_Port is private; subtype Coordinate is float; type Color_Type is (Black, Brown, Blue, Green, Yellow, Red, White); subtype Color_Spectrum is float; -- range is 0.0 .. 1.0 type Terminal_Mode is (Graphics, Text); procedure Create_Port(Port : in out View_Port; Left, Top, Width, Height : in Coordinate); procedure Create_Port(Port : in out View_Port; Left, Top, Width, Height : in integer); procedure Redefine(Port: in out View_Port; Left, Top, Width, Height: in Coordinate); procedure Redefine(Port: in out View_Port; Left, Top, Width, Height: in integer); procedure New_Screen_Size(Columns, Lines : in integer); procedure Set_Window(Left, Bottom, Right, Top : in Coordinate); procedure Set_Window(Left, Bottom, Right, Top : in integer); procedure Select_Port(Port: in View_Port); procedure Erase_Screen; procedure Erase_Port(Color : in Color_Type); procedure Erase_Port(Color : in Color_Spectrum := 0.0); procedure Erase_Port(Port: in View_Port; Color : in Color_Type); procedure Erase_Port(Port: in View_Port; Color : in Color_Spectrum := 0.0); procedure Frame_Port; procedure Move_To(New_X, New_Y : in Coordinate); procedure Move_To(New_X, New_Y : in integer); procedure Move(Delta_X, Delta_Y : in Coordinate); procedure Move(Delta_X, Delta_Y : in integer); procedure Clip(X1, Y1, X2, Y2 : in out Coordinate; In_View : in out boolean); procedure Draw_Line(Start_WX, Start_WY, End_WX, End_WY : in Coordinate; Color : in Color_Spectrum); procedure Line_To(New_X, New_Y : in Coordinate); procedure Line_To(New_X, New_Y : in integer); procedure Line(Delta_X, Delta_Y : in Coordinate); procedure Line(Delta_X, Delta_Y : in integer); function Set_Color(Color_Code : in Color_Spectrum) return Color_Spectrum; function Set_Color(Color : in Color_Type) return Color_Type; procedure Set_Color(Color_Code : in Color_Spectrum); procedure Set_Color(Color : in Color_Type); procedure Where_Am_I(Current_X, Current_Y : out Coordinate); procedure Set_Mode(Mode : in Terminal_Mode); procedure Print_Screen(File_Name : String); function What_Port return View_Port; Illegal_Color : exception; -- Set color outside 0.0 .. 1.0 Illegal_Screen_Size : exception; -- Screen size unavailable for this terminal Not_Implemented : exception; Terminal_Limitation : exception; Undefined_Window : exception; -- Attempt to draw without a defined window Value_Off_Screen : exception; -- Veiw_Port boundaries Zero_Area : exception; -- Window boundaries private subtype Pixel is integer; type V_Port is record Color : Color_Spectrum; -- current color Window_Defined : boolean; -- true iff Set_Window called X_Current, Y_Current : Coordinate; -- last point drawn or moved to X_Scale, Y_Scale : float; -- scale factor to pixel coordinates X_Shift, Y_Shift : float; -- shift factor from screen origin Left, Right, Top, Bottom : Pixel; -- view_port pixel boundaries WX_Min, WX_Max, WY_Min, WY_Max : Coordinate; -- view_port world boundaries end record; type View_Port is access V_Port; end Graphic; --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: --termfunct.sp --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: -- -- TERM_FUNCTIONS will define a series of functions and procedures which -- allow simple cursor positioning and I/O to a graphics terminal in text mode. -- Any terminal which supports ASCII standards will work. Any terminal dependent -- features are outlined as such, and would need to be modified for a particular -- terminal. -- package TERM_FUNCTIONS is subtype POSITIVE_NUMBER is integer range 0 .. integer'last; type CURSOR_HALF is ( TOP, BOTTOM ); type TERMINAL_STATUS is ( READY, ERROR_RESET_RETRY ); type CURSOR_POS is record LINE : POSITIVE_NUMBER; COLUMN : POSITIVE_NUMBER; end record; type DEVICE_TYPE is ( VT52, VT100, VT102, VT240 ); type TOKEN is ( UP_ARROW, DOWN_ARROW, RIGHT_ARROW, LEFT_ARROW, RETURN_KEY, BACK_SPACE, TAB, ALPHA_NUM ); procedure SET_TOP_AND_BOTTOM_MARGINS ( TOP, BOTTOM : in POSITIVE_NUMBER ); procedure SET_HOME; procedure RESET_HOME; procedure POSITION_CURSOR ( ITEM : in CURSOR_POS ); procedure FILL ( CONSTRAIN : in integer ); procedure FLUSH ( ITEM : out string; LAST : out integer ); procedure PUT_STRING ( ITEM : in string ); procedure GET_CHAR ( ITEM : in out character ); -- -- Convert a floating point number to a string. -- function FL_STRING ( ITEM : in float ) return string; function STRING_FL ( ITEM : in string ) return float; -- -- Interpret keystrokes from the terminal and return the type of token. -- function PARSE_INPUT return TOKEN; -- -- Return the last character parsed. -- function PARSED_CHAR return CHARACTER; procedure CURSOR_HOME; procedure SET_132_COLUMNS_PER_LINE; -- VT DEPENDENT. procedure SET_80_COLUMNS_PER_LINE; procedure SET_LOCAL_ECHO; procedure RESET_LOCAL_ECHO; end TERM_FUNCTIONS; --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: --menutypes.sp --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: with GRAPHIC; package MENU_TYPES is use GRAPHIC; subtype FILENAME is string ( 1 .. 40 ); subtype MAP_TITLE is string ( 1 .. 40 ); type KIND_OF_PROJECTION is ( STEREOGRAPHIC, ORTHOGRAPHIC, GNOMONIC, SATELLITE, LAMBERT, AZIMUTHAL, CARTESIAN, MERCATOR ); -- type PROJECTION_PARAMETERS ( KIND : KIND_OF_PROJECTION := ORTHOGRAPHIC ) is -- record -- LAT_CENTER : float := 0.0; -- LON_CENTER : float := 0.0; -- CLK_ROT_AR_CENT : float := 0.0; -- case KIND is -- when SATELLITE => -- SAT_ALTITUDE : float := 0.0; -- VIEW_ALTITUDE : float := 0.0; -- when others => -- null; -- end case; -- end record; type PROJECTION_PARAMETERS is record LAT_CENTER : float; LON_CENTER : float; CLK_ROT_AR_CENT : float; SAT_ALTITUDE : float; VIEW_ALTITUDE : float; end record; type GRID_LINE_PARAMETERS is record SHOW_LINES : boolean; DEGREES_BTWN_LATS : float; DEGREES_BTWN_LONS : float; SEGMENT_LENGTH : float; end record; type KIND_OF_PROJECTION_LIMIT is ( ALL_EARTH, MIN_MAX_LAT_LON, MIN_MAX_COORDINATES, ANGULAR_DIST_FROM_PROJECTION_CENTER, LAT_LON_BOUNDARY ); type CORRD is record X : float; Y : float; end record; -- type PROJECTION_LIMITS ( KIND : KIND_OF_PROJECTION_LIMIT := ALL_EARTH ) is -- record -- case KIND is -- when MIN_MAX_LAT_LON => -- MIN_LAT_LON : CORRD; -- MAX_LAT_LON : CORRD; -- when MIN_MAX_COORDINATES => -- NORTH_EAST : CORRD; -- SOUTH_WEST : CORRD; -- when ANGULAR_DIST_FROM_PROJECTION_CENTER => -- ANGLE_UP : float; -- ANGLE_DOWN : float; -- ANGLE_RIGHT : float; -- ANGLE_LEFT : float; -- when LAT_LON_BOUNDARY => -- POINT_UP : CORRD; -- POINT_DOWN : CORRD; -- POINT_RIGHT : CORRD; -- POINT_LEFT : CORRD; -- when others => -- null; -- end case; -- end record; type PROJECTION_LIMITS is record MIN_LAT_LON : CORRD; MAX_LAT_LON : CORRD; NORTH_EAST : CORRD; SOUTH_WEST : CORRD; ANGLE_UP : float; ANGLE_DOWN : float; ANGLE_RIGHT : float; ANGLE_LEFT : float; POINT_UP : CORRD; POINT_DOWN : CORRD; POINT_RIGHT : CORRD; POINT_LEFT : CORRD; end record; type COLOR_SELECTION is record BACKGROUND : COLOR_TYPE; DEFAULT : COLOR_TYPE; MAP_OUTLINE : COLOR_TYPE; GRID_LINES : COLOR_TYPE; HORIZON : COLOR_TYPE; end record; type SPECIAL_DISPLAYS is record BEAM_DATA : FILENAME ; BEAM_COLOR : COLOR_TYPE; BEAM_LAST : integer; SWATH_DATA : FILENAME ; SWATH_COLOR : COLOR_TYPE; SWATH_LAST : integer; POINTS_DATA : FILENAME ; POINTS_COLOR : COLOR_TYPE; POINTS_LAST : integer; end record; type DIAGNOSTICS is record WARNING : boolean; ERROR : boolean; FATAL : boolean; end record; type PLOT_CHARACTERISTICS is record AXIS_LENGTH : CORRD; ORIGIN : CORRD; end record; end MENU_TYPES; --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: --menutext.sp --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: package MENU_TEXT is -- -- Menu Dimensions -- width_max : constant integer := 132; height_max : constant integer := 24; LEVEL_2_WIDTH : constant integer := width_max - 8; LEVEL_2_HEIGHT : constant integer := height_max - 6; LEVEL_3_WIDTH : constant integer := width_max - 12; LEVEL_3_HEIGHT : constant integer := height_max - 11; LEVEL_4_WIDTH : constant integer := width_max - 16; LEVEL_4_HEIGHT : constant integer := height_max - 14; COM_1_INDENT : constant integer := 5; COM_2_INDENT : constant integer := 10; COM_3_INDENT : constant integer := 15; COM_4_INDENT : constant integer := 20; FIELD_1_3_MAX : constant integer := 4; FIELD_4_MAX : constant integer := 6; FIELD_5_MAX : constant integer := 5; -- -- Menu Text -- DP_TITLE_LINE : constant string := "Display Parameters"; DP_T_LEV_1 : constant integer := ( WIDTH_MAX - DP_TITLE_LINE'length ) / 2; DP_T_LEV_2 : constant integer := ( LEVEL_2_WIDTH - DP_TITLE_LINE'length ) / 2; SDF_TITLE : constant string := "Special Display Functions"; SDF_T_LEV_3 : constant integer := ( LEVEL_3_WIDTH - SDF_TITLE'length ) / 2; DIG_TITLE : constant string := "Diagnostic Settings"; DIG_T_LEV_4 : constant integer := ( LEVEL_4_WIDTH - DIG_TITLE'length ) / 2; PLC_TITLE : constant string := "Plot Characteristics"; PLC_T_LEV_4 : constant integer := ( LEVEL_4_WIDTH - PLC_TITLE'length ) / 2; SES_TITLE : constant string := "Session Defaults"; SES_T_LEV_1 : constant integer := ( WIDTH_MAX - SES_TITLE'length ) / 2; MAP_TITLEM : string ( 1 .. 47 ) := "Map Of: " & " " & " " & " "& " "; MAP_T_LEV_1 : constant integer := ( WIDTH_MAX - MAP_TITLEM'length ) / 2; -- HTOP_TITLE : string ( 1 .. 22 ) := "Help < " & -- " >"; -- HTOP_LEV_2 : constant integer := -- ( LEVEL_2_WIDTH - HTOP_TITLE'length ) / 2; -- HTOP_LEV_3 : constant integer := -- ( LEVEL_3_WIDTH - HTOP_TITLE'length ) / 2; C0 : constant string := "o Map title:"; C1 : constant string := "o Projection parameters type:"; C2 : constant string := "o Lat of center of projection:"; C3 : constant string := "o Lon of center of projection:"; C4 : constant string := "o Rot clockwise around center:"; C5 : constant string := "o Satellite altitude :"; C6 : constant string := "o Viewing altitude :"; C7 : constant string := "o Projection limits type:"; C8 : constant string := "o Minimum longitude:"; C9 : constant string := "o Minimum latitude :"; C10 : constant string := "o Maximum longitude:"; C11 : constant string := "o Maximum latitude :"; C12 : constant string := "o North East X :"; C13 : constant string := "o North East Y :"; C14 : constant string := "o South West X :"; C15 : constant string := "o South West Y :"; C16 : constant string := "o Angle Up :"; C17 : constant string := "o Angle Down :"; C18 : constant string := "o Angle Right :"; C19 : constant string := "o Angle Left :"; C20 : constant string := "o Point Up X :"; C21 : constant string := "o Point Up Y :"; C22 : constant string := "o Point Down X :"; C23 : constant string := "o Point Down Y :"; C24 : constant string := "o Point Right X :"; C25 : constant string := "o Point Right Y :"; C26 : constant string := "o Point Left X :"; C27 : constant string := "o Point Left Y :"; C28 : constant string := "o Color selection"; C29 : constant string := "o Map outline:"; C30 : constant string := "o Grid line :"; C31 : constant string := "o Horizon :"; C3A : constant string := "o Default :"; C3B : constant string := "o Background :"; C32 : constant string := "o Grid line parameters"; C33 : constant string := "o Show lines :"; C34 : constant string := "o Degrees between latitudes :"; C35 : constant string := "o Degrees between longitudes:"; C3C : constant string := "o Segment length degrees :"; -- C36 : constant string := "o Clipping :"; C37 : constant string := "o Beam data :"; C38 : constant string := "o Symbol data :"; C39 : constant string := "o Map data :"; C40 : constant string := "o Beam color :"; C41 : constant string := "o Symbol color :"; C42 : constant string := "o Map color :"; C43 : constant string := "o Warning:"; C44 : constant string := "o Error :"; C45 : constant string := "o Fatal :"; C46 : constant string := "o Axis length X:"; C47 : constant string := "o Axis length Y:"; C48 : constant string := "o Origin X:"; C49 : constant string := "o Origin Y:"; C50 : constant string := "o Session menu filename:"; C51 : constant string := "o Display menu filename:"; C52 : constant string := "o Show Land:"; -- -- Command Line Text -- CL1 : constant string := "Edit Continue Save Exit Quit Openf"; CL2 : constant string := "Edit Continue Exit Quit"; CL3 : constant string := "Edit Save Continue Exit Quit Openf"; CL4 : constant string := "Edit Special Continue Exit Quit"; CL5 : constant string := "Continue Exit Quit"; -- -- Command Line Field Offsets from start in X direction -- COM_FIE_OFF : constant array ( 1 .. 7 ) of integer := ( 0, 10, 24, 34, 44, 54, 64 ); end MENU_TEXT; --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: --menucurre.sp --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: with MENU_TYPES; package MENU_CURRENTS is use MENU_TYPES; CURRENT_TYPE_OF_PROJECTION : KIND_OF_PROJECTION; CURRENT_TYPE_OF_PROJECTION_LIMIT : KIND_OF_PROJECTION_LIMIT; CURRENT_MAP_TITLE : MAP_TITLE; CURRENT_GRID_LINES : GRID_LINE_PARAMETERS; CURRENT_COLOR : COLOR_SELECTION; CURRENT_SPECIALS : SPECIAL_DISPLAYS; CURRENT_PROJECTION : PROJECTION_PARAMETERS; CURRENT_PROJECTION_LIM : PROJECTION_LIMITS; CURRENT_PLOT_CHARACTERISTICS : PLOT_CHARACTERISTICS; --CURRENT_CLIPPING : boolean; CURRENT_LAND : boolean; CURRENT_DIAGS : DIAGNOSTICS; CURRENT_SESSION_FILENAME : FILENAME; CURRENT_DISPLAY_FILENAME : FILENAME; SESSION_TERMINATED : boolean; STATUS : DIAGNOSTICS; DRAW_MAP : boolean; DEFAULT_TYPE_OF_PROJECTION : KIND_OF_PROJECTION; DEFAULT_TYPE_OF_PROJECTION_LIMIT : KIND_OF_PROJECTION_LIMIT; DEFAULT_MAP_TITLE : MAP_TITLE; DEFAULT_GRID_LINES : GRID_LINE_PARAMETERS; DEFAULT_COLOR : COLOR_SELECTION; DEFAULT_SPECIALS : SPECIAL_DISPLAYS; DEFAULT_PROJECTION : PROJECTION_PARAMETERS; DEFAULT_PROJECTION_LIM : PROJECTION_LIMITS; DEFAULT_PLOT_CHARACTERISTICS : PLOT_CHARACTERISTICS; -- DEFAULT_CLIPPING : boolean; DEFAULT_LAND : boolean; DEFAULT_DIAGS : DIAGNOSTICS; procedure SET_CURRENTS_FROM_DEFAULTS; procedure SET_DEFAULTS_FROM_CURRENTS; end MENU_CURRENTS; --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: --worldmenu.sp --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: --*P* --*P* The purpose of World_Menu is to provide the values which represent --*P* the menu fields and indicate the end of the mapping session. It also --*P* provides procedures to initialize the World_Menu capability and the stub --*P* which starts the menu generation cycle. --*P* with MENU_TYPES; --*D* --*D* Menu_Types provides all the type information for the menu fields. --*D* package WORLD_MENUS is use MENU_TYPES; function END_OF_SESSION return boolean; function TYPE_OF_PROJECTION return KIND_OF_PROJECTION; function TYPE_OF_PROJECTION_LIMIT return KIND_OF_PROJECTION_LIMIT; function CURRENT_TITLE return MAP_TITLE; function CURRENT_PROJECTION_PARAMETERS return PROJECTION_PARAMETERS; function CURRENT_PROJECTION_LIMITS return PROJECTION_LIMITS; function CURRENT_GRID_LINE_PARAMETERS return GRID_LINE_PARAMETERS; function CURRENT_COLOR_SELECTION return COLOR_SELECTION; function CURRENT_SPECIAL_DISPLAYS return SPECIAL_DISPLAYS; function CURRENT_DIAGNOSTICS return DIAGNOSTICS; function CURRENT_PLOT_CHAR return PLOT_CHARACTERISTICS; function PLOT_LAND return boolean; function SHOW_GRID return boolean; function SHOW_BEAM return boolean; function SHOW_SWATH return boolean; -- function CLIPPING return boolean; procedure GENERATE_MENUS; procedure INITIALIZE; end WORLD_MENUS; --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: --menuconst.sp --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: with MENU_TEXT, TERM_FUNCTIONS; package MENU_CONSTANTS is use MENU_TEXT; use TERM_FUNCTIONS; type FIELD_INDEX is ( CI0, CI1, CI2, CI3, CI4, CI5, CI6, CI7, CI8, CI9, CI10, CI11, CI12, CI13, CI14, CI15, CI16, CI17, CI18, CI19, CI20, CI21, CI22, CI23, CI24, CI25, CI26, CI27, CI28, CI29, CI30, CI31, CI3A, CI3B, CI32, CI33, CI34, CI35, CI3C, --CI36, CI37, CI38, CI39, CI40, CI41, CI42, CI43, CI44, CI45, CI46, CI47, CI48, CI49, CI50, CI51, CI52 ); X_Y_POS : constant array ( FIELD_INDEX'first .. FIELD_INDEX'last ) of TERM_FUNCTIONS.CURSOR_POS := -- Display Parameters Title Line. C0 ( ( LINE => 07, COLUMN => 10 ), -- Display Parameters/Projection Parameters/Projection Type. C1 ( LINE => 09, COLUMN => 10 ), -- Display Parameters/Projection Parameters/Lat of center. C2 ( LINE => 10, COLUMN => 12 ), -- Display Parameters/Projection Parameters/Lon of center. C3 ( LINE => 11, COLUMN => 12 ), -- Display Parameters/Projection Parameters/Rot clkwse. C4 ( LINE => 12, COLUMN => 12 ), -- Display Parameters/Projection Parameters/Satellite alt. C5 ( LINE => 13, COLUMN => 12 ), -- Display Parameters/Projection Parameters/Viewing alt. C6 ( LINE => 14, COLUMN => 12 ), -- Display Parameters/Projection Limits/Limit Type. C7 ( LINE => 09, COLUMN => 66 ), -- Display Parameters/Projection Limits/Limit Min Latitude C8 ( LINE => 10, COLUMN => 68 ), -- Display Parameters/Projection Limits/Limit Min Longitude C9 ( LINE => 11, COLUMN => 68 ), -- Display Parameters/Projection Limits/Limit Max Latitude C10 ( LINE => 12, COLUMN => 68 ), -- Display Parameters/Projection Limits/Limit Max Longitude C11 ( LINE => 13, COLUMN => 68 ), -- Display Parameters/Projection Limits/Limit North east x C12 ( LINE => 10, COLUMN => 68 ), -- Display Parameters/Projection Limits/Limit North east y C13 ( LINE => 11, COLUMN => 68 ), -- Display Parameters/Projection Limits/Limit South west x C14 ( LINE => 12, COLUMN => 68 ), -- Display Parameters/Projection Limits/Limit South west y C15 ( LINE => 13, COLUMN => 68 ), -- Display Parameters/Projection Limits/Limit Angle up C16 ( LINE => 10, COLUMN => 68 ), -- Display Parameters/Projection Limits/Limit Angle down C17 ( LINE => 11, COLUMN => 68 ), -- Display Parameters/Projection Limits/Limit Angle right C18 ( LINE => 12, COLUMN => 68 ), -- Display Parameters/Projection Limits/Limit Angle left C19 ( LINE => 13, COLUMN => 68 ), -- Display Parameters/Projection Limits/Limit Point up x C20 ( LINE => 10, COLUMN => 68 ), -- Display Parameters/Projection Limits/Limit Point up y C21 ( LINE => 11, COLUMN => 68 ), -- Display Parameters/Projection Limits/Limit Point down x C22 ( LINE => 12, COLUMN => 68 ), -- Display Parameters/Projection Limits/Limit Point down y C23 ( LINE => 13, COLUMN => 68 ), -- Display Parameters/Projection Limits/Limit Point right x C24 ( LINE => 14, COLUMN => 68 ), -- Display Parameters/Projection Limits/Limit Point right y C25 ( LINE => 15, COLUMN => 68 ), -- Display Parameters/Projection Limits/Limit Point left x C26 ( LINE => 16, COLUMN => 68 ), -- Display Parameters/Projection Limits/Limit Point left y C27 ( LINE => 17, COLUMN => 68 ), -- Display Parameters/Color Selection C28 ( LINE => 16, COLUMN => 10 ), -- Display Parameters/Color Selection/Map outline C29 ( LINE => 17, COLUMN => 12 ), -- Display Parameters/Color Selection/Grid line C30 ( LINE => 18, COLUMN => 12 ), -- Display Parameters/Color Selection/Horizon C31 ( LINE => 19, COLUMN => 12 ), -- Display Parameters/Color Selection/Default C3A ( LINE => 20, COLUMN => 12 ), -- Display Parameters/Color Selection/Background C3B ( LINE => 21, COLUMN => 12 ), -- Display Parameters/Grid lines C32 ( LINE => 17, COLUMN => 39 ), -- Display Parameters/Grid lines/Show lines C33 ( LINE => 18, COLUMN => 41 ), -- Display Parameters/Grid lines/Degrees between latitudes C34 ( LINE => 19, COLUMN => 41 ), -- Display Parameters/Grid lines/Degrees between longitude C35 ( LINE => 20, COLUMN => 41 ), -- Display Parameters/Grid lines/Segment length C3C ( LINE => 21, COLUMN => 41 ), -- Display Parameters/Clipping C36 -- ( LINE => 18, COLUMN => 88 ), -- Special Display Functions/Beam Data C37 ( LINE => 12, COLUMN => 10 ), -- Special Display Functions/Swath Data C38 ( LINE => 13, COLUMN => 10 ), -- Special Display Functions/Points Data C39 ( LINE => 14, COLUMN => 10 ), -- Special Display Functions/Beam color C40 ( LINE => 12, COLUMN => 80 ), -- Special Display Functions/Swath color C41 ( LINE => 13, COLUMN => 80 ), -- Special Display Functions/Points color C42 ( LINE => 14, COLUMN => 80 ), -- Diagnostics/Warning C43 ( LINE => 14, COLUMN => 20 ), -- Diagnostics/Error C44 ( LINE => 14, COLUMN => 50 ), -- Diagnostics/Fatal C45 ( LINE => 14, COLUMN => 80 ), -- Plot characteristics/Axis length x C46 ( LINE => 14, COLUMN => 20 ), -- Plot characteristics/Axis length y C47 ( LINE => 15, COLUMN => 20 ), -- Plot characteristics C48 ( LINE => 14, COLUMN => 70 ), -- Plot characteristics C49 ( LINE => 15, COLUMN => 70 ), -- Session menu filename C50 ( LINE => 03, COLUMN => 10 ), -- Display menu filename C51 ( LINE => 03, COLUMN => 10 ), -- Display Parameters/Show Land C52 ( LINE => 19, COLUMN => 88 ) ); function X_Y_POS_ALT ( ITEM : in FIELD_INDEX ) return TERM_FUNCTIONS.CURSOR_POS; end MENU_CONSTANTS; --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: --trigf.sp --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: package TRIG_LIB is function SIN(X : FLOAT) return FLOAT; function COS(X : FLOAT) return FLOAT; function TAN(X : FLOAT) return FLOAT; function COT(X : FLOAT) return FLOAT; function ASIN(X : FLOAT) return FLOAT; function ACOS(X : FLOAT) return FLOAT; function ATAN(X : FLOAT) return FLOAT; function ATAN2(V, U : FLOAT) return FLOAT; function SINH(X : FLOAT) return FLOAT; function COSH(X : FLOAT) return FLOAT; function TANH(X : FLOAT) return FLOAT; end TRIG_LIB; --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: --floatch.sp --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: package FLOATING_CHARACTERISTICS is -- This package is a floating mantissa definition of a binary FLOAT -- It was first used on the DEC-10 and the VAX but should work for any -- since the parameters are obtained by initializing on the actual hardware -- Otherwise the parameters could be set in the spec if known -- This is a preliminary package that defines the properties -- of the particular floating point type for which we are going to -- generate the math routines -- The constants are those required by the routines described in -- "Software Manual for the Elementary Functions" W. Cody & W. Waite -- Prentice-Hall 1980 -- Actually most are needed only for the test programs -- rather than the functions themselves, but might as well be here -- Most of these could be in the form of attributes if -- all the floating types to be considered were those built into the -- compiler, but we also want to be able to support user defined types -- such as software floating types of greater precision than -- the hardware affords, or types defined on one machine to -- simulate another -- So we use the Cody-Waite names and derive them from an adaptation of the -- MACHAR routine as given by Cody-Waite in Appendix B IBETA : INTEGER; -- The radix of the floating-point representation IT : INTEGER; -- The number of base IBETA digits in the DIS_FLOAT significand IRND : INTEGER; -- TRUE (1) if floating addition rounds, FALSE (0) if truncates NGRD : INTEGER; -- Number of guard digits for multiplication MACHEP : INTEGER; -- The largest negative integer such that -- 1.0 + FLOAT(IBETA) ** MACHEP /= 1.0 -- except that MACHEP is bounded below by -(IT + 3) NEGEP : INTEGER; -- The largest negative integer such that -- 1.0 -0 FLOAT(IBETA) ** NEGEP /= 1.0 -- except that NEGEP is bounded below by -(IT + 3) IEXP : INTEGER; -- The number of bits (decimal places if IBETA = 10) -- reserved for the representation of the exponent (including -- the bias or sign) of a floating-point number MINEXP : INTEGER; -- The largest in magnitude negative integer such that -- FLOAT(IBETA) ** MINEXP is a positive floating-point number MAXEXP : INTEGER; -- The largest positive exponent for a finite floating-point number EPS : FLOAT; -- The smallest positive floating-point number such that -- 1.0 + EPS /= 1.0 -- In particular, if IBETA = 2 or IRND = 0, -- EPS = FLOAT(IBETA) ** MACHEP -- Otherwise, EPS = (FLOAT(IBETA) ** MACHEP) / 2 EPSNEG : FLOAT; -- A small positive floating-point number such that 1.0-EPSNEG /= 1.0 XMIN : FLOAT; -- The smallest non-vanishing floating-point power of the radix -- In particular, XMIN = FLOAT(IBETA) ** MINEXP XMAX : FLOAT; -- The largest finite floating-point number -- Here the structure of the floating type is defined -- I have assumed that the exponent is always some integer form -- The mantissa can vary -- Most often it will be a fixed type or the same floating type -- depending on the most efficient machine implementation -- Most efficient implementation may require details of the machine hardware -- In this version the simplest representation is used -- The mantissa is extracted into a FLOAT and uses the predefined operations subtype EXPONENT_TYPE is INTEGER; -- should be derived ########## subtype MANTISSA_TYPE is FLOAT; -- range -1.0..1.0; -- A consequence of the rigorous constraints on MANTISSA_TYPE is that -- operations must be very carefully examined to make sure that no number -- greater than one results -- Actually this limitation is important in constructing algorithms -- which will also run when MANTISSA_TYPE is a fixed point type -- If we are not using the STANDARD type, we have to define all the -- operations at this point -- We also need PUT for the type if it is not otherwise available -- Now we do something strange -- Since we do not know in the following routines whether the mantissa -- will be carried as a fixed or floating type, we have to make some -- provision for dividing by two -- We cannot use the literals, since FIXED/2.0 and FLOAT/2 will fail -- We define a type-dependent factor that will work MANTISSA_DIVISOR_2 : constant FLOAT := 2.0; MANTISSA_DIVISOR_3 : constant FLOAT := 3.0; -- This will work for the MANTISSA_TYPE defined above -- The alternative of defining an operation "/" to take care of it -- is too sweeping and would allow unAda-like errors MANTISSA_HALF : constant MANTISSA_TYPE := 0.5; procedure DEFLOAT(X : in FLOAT; N : out EXPONENT_TYPE; F : out MANTISSA_TYPE); procedure REFLOAT(N : in EXPONENT_TYPE; F : in MANTISSA_TYPE; X : out FLOAT); -- Since the user may wish to define a floating type by some other name -- CONVERT_TO_FLOAT is used rather than just FLOAT for explicit coersion function CONVERT_TO_FLOAT(K : INTEGER) return FLOAT; -- function CONVERT_TO_FLOAT(N : EXPONENT_TYPE) return FLOAT; function CONVERT_TO_FLOAT(F : MANTISSA_TYPE) return FLOAT; end FLOATING_CHARACTERISTICS; --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: --coref.sp --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: with FLOATING_CHARACTERISTICS; use FLOATING_CHARACTERISTICS; package CORE_FUNCTIONS is EXP_LARGE : FLOAT; EXP_SMALL : FLOAT; function SQRT(X : FLOAT) return FLOAT; function CBRT(X : FLOAT) return FLOAT; function LOG(X : FLOAT) return FLOAT; function LOG10(X : FLOAT) return FLOAT; function EXP(X : FLOAT) return FLOAT; function "**"(X, Y : FLOAT) return FLOAT; end CORE_FUNCTIONS; --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: --numpr.sp --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: with FLOATING_CHARACTERISTICS; use FLOATING_CHARACTERISTICS; package NUMERIC_PRIMITIVES is -- This may seem a little much but is put in this form to allow the -- same form to be used for a generic package -- If that is not needed, simple litterals could be substituted ZERO : FLOAT := CONVERT_TO_FLOAT(INTEGER(0)); ONE : FLOAT := CONVERT_TO_FLOAT(INTEGER(1)); TWO : FLOAT := ONE + ONE; THREE : FLOAT := ONE + ONE + ONE; HALF : FLOAT := ONE / TWO; -- The following "constants" are effectively deferred to -- the initialization part of the package body -- This is in order to make it possible to generalize the floating type -- If that capability is not desired, constants may be included here PI : FLOAT; ONE_OVER_PI : FLOAT; TWO_OVER_PI : FLOAT; PI_OVER_TWO : FLOAT; PI_OVER_THREE : FLOAT; PI_OVER_FOUR : FLOAT; PI_OVER_SIX : FLOAT; function SIGN(X, Y : FLOAT) return FLOAT; -- Returns the value of X with the sign of Y function MAX(X, Y : FLOAT) return FLOAT; -- Returns the algebraicly larger of X and Y function TRUNCATE(X : FLOAT) return FLOAT; -- Returns the floating value of the integer no larger than X -- AINT(X) function ROUND(X : FLOAT) return FLOAT; -- Returns the floating value nearest X -- AINTRND(X) function RAN return FLOAT; -- This uses a portable algorithm and is included at this point -- Algorithms that presume unique machine hardware information -- should be initiated in FLOATING_CHARACTERISTICS end NUMERIC_PRIMITIVES; --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: --worldmap.sp --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: package World_Map is procedure Draw_Map; end World_Map; --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: --menudraw.txt --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: with MENU_CONSTANTS, WORLD_MENUS; package body MENU_DRAW is use MENU_CONSTANTS, MENU_TEXT, TERM_FUNCTIONS; use WORLD_MENUS, MENU_TYPES, GRAPHIC; CURRENT_CURSOR_POS : CURSOR_POS; BELL_BELL : string ( 1 .. 2 ) := ( 1 .. 2 => ascii.bel ); -- LEVEL_1 is the entire screen. LEVEL_2 : VIEW_PORT; LEVEL_3 : VIEW_PORT; LEVEL_4 : VIEW_PORT; LEVEL_1_TITLE : VIEW_PORT; LEVEL_1_BODI : VIEW_PORT; LEVEL_1_COMMAND : VIEW_PORT; LEVEL_1_ERRORS : VIEW_PORT; LEVEL_2_TITLE : VIEW_PORT; LEVEL_2_BODI : VIEW_PORT; LEVEL_2_COMMAND : VIEW_PORT; LEVEL_3_TITLE : VIEW_PORT; LEVEL_3_BODI : VIEW_PORT; LEVEL_3_COMMAND : VIEW_PORT; LEVEL_4_TITLE : VIEW_PORT; LEVEL_4_BODI : VIEW_PORT; BLANKS : constant string ( 1 .. 50 ) := ( 1 .. 50 => ' ' ); SATELITE_DRAWN : boolean := false; POINTS_DRAWN : boolean := false; procedure DRAW_TEXT ( POSITION : in CURSOR_POS; TEXT : in string ) is begin POSITION_CURSOR ( POSITION ); PUT_STRING ( TEXT ); end DRAW_TEXT; procedure DRAW_PAIR ( POSITION : in CURSOR_POS; TEXT : in string; ALT_POS : in CURSOR_POS; TEXT1 : in string ) is TEMP : integer := 1; begin DRAW_TEXT ( POSITION, TEXT ); TEMP := ALT_POS.COLUMN - ( POSITION.COLUMN + TEXT'LENGTH - 1 ); PUT_STRING ( BLANKS ( 1 .. TEMP ) ); DRAW_TEXT ( ALT_POS , TEXT1 ); end DRAW_PAIR; procedure FRM_PORT ( PORT : in VIEW_PORT; FRAME_COLOR : in COLOR_TYPE ) is begin SELECT_PORT ( PORT ); SET_COLOR ( FRAME_COLOR ); FRAME_PORT; end FRM_PORT; procedure CLEAR ( PORT : in VIEW_PORT ) is begin SELECT_PORT ( PORT ); ERASE_PORT ( BLACK ); end CLEAR; procedure DRAW_PORT_TEXT ( PORT : in VIEW_PORT; POSITION : in CURSOR_POS; TEXT : in string; FRAME_COLOR : in COLOR_TYPE := BLUE ) is begin DRAW_TEXT ( POSITION, TEXT ( TEXT'first .. TEXT'last ) ); FRM_PORT ( PORT, FRAME_COLOR ); end DRAW_PORT_TEXT; procedure MAP_TITLE_FIELD is begin DRAW_PAIR ( X_Y_POS ( CI0 ) , C0, X_Y_POS_ALT ( CI0 ), CURRENT_TITLE ); end MAP_TITLE_FIELD; procedure DRAW_PROJ_PARAM_FIELDS ( OMIT : in boolean := false ) is TEMP_TYPE : KIND_OF_PROJECTION; TEMP : PROJECTION_PARAMETERS; begin TEMP_TYPE := TYPE_OF_PROJECTION; TEMP := CURRENT_PROJECTION_PARAMETERS; if not OMIT then DRAW_PAIR ( X_Y_POS ( CI1 ) , C1, X_Y_POS_ALT ( CI1 ), KIND_OF_PROJECTION'image ( TEMP_TYPE ) ); else DRAW_TEXT ( X_Y_POS_ALT ( CI1 ), BLANKS ( 1 .. 15 ) ); DRAW_TEXT ( X_Y_POS_ALT ( CI1 ), KIND_OF_PROJECTION'image ( TEMP_TYPE ) ); end if; DRAW_PAIR ( X_Y_POS ( CI2 ) , C2, X_Y_POS_ALT ( CI2 ), FL_STRING ( TEMP.LAT_CENTER ) ); DRAW_PAIR ( X_Y_POS ( CI3 ) , C3, X_Y_POS_ALT ( CI3 ), FL_STRING ( TEMP.LON_CENTER ) ); DRAW_PAIR ( X_Y_POS ( CI4 ) , C4, X_Y_POS_ALT ( CI4 ), FL_STRING ( TEMP.CLK_ROT_AR_CENT )); if ( TEMP_TYPE /= SATELLITE ) and then SATELITE_DRAWN then DRAW_PAIR ( X_Y_POS ( CI5 ) , BLANKS ( 1 .. C5'length ), X_Y_POS_ALT ( CI5 ), BLANKS ( 1 .. 13 ) ); DRAW_PAIR ( X_Y_POS ( CI6 ) , BLANKS ( 1 .. C6'LENGTH ), X_Y_POS_ALT ( CI6 ), BLANKS ( 1 .. 13 ) ); end if; if TEMP_TYPE = SATELLITE then SATELITE_DRAWN := true; DRAW_PAIR ( X_Y_POS ( CI5 ) , C5, X_Y_POS_ALT ( CI5 ), FL_STRING ( TEMP.SAT_ALTITUDE ) ); DRAW_PAIR ( X_Y_POS ( CI6 ) , C6, X_Y_POS_ALT ( CI6 ), FL_STRING ( TEMP.VIEW_ALTITUDE ) ); else SATELITE_DRAWN := false; end if; end DRAW_PROJ_PARAM_FIELDS; procedure DRAW_PROJ_LIMIT_FIELDS ( OMIT : in boolean := false ) is TEMP_TYPE : KIND_OF_PROJECTION_LIMIT; TEMP : PROJECTION_LIMITS; begin TEMP_TYPE := TYPE_OF_PROJECTION_LIMIT; TEMP := CURRENT_PROJECTION_LIMITS; if not OMIT then DRAW_PAIR ( X_Y_POS ( CI7 ) , C7, X_Y_POS_ALT ( CI7 ), KIND_OF_PROJECTION_LIMIT'image ( TEMP_TYPE ) ); else DRAW_TEXT ( X_Y_POS_ALT ( CI7 ), BLANKS ( 1 .. 35 ) ); DRAW_TEXT ( X_Y_POS_ALT ( CI7 ), KIND_OF_PROJECTION_LIMIT'image ( TEMP_TYPE ) ); end if; if ( TEMP_TYPE /= LAT_LON_BOUNDARY ) and then POINTS_DRAWN then DRAW_PAIR ( X_Y_POS ( CI24 ) , BLANKS ( 1 .. C24'length ), X_Y_POS_ALT ( CI24 ), BLANKS ( 1 .. 13 ) ); DRAW_PAIR ( X_Y_POS ( CI25 ) , BLANKS ( 1 .. C25'length ), X_Y_POS_ALT ( CI25 ), BLANKS ( 1 .. 13 ) ); DRAW_PAIR ( X_Y_POS ( CI26 ) , BLANKS ( 1 .. C26'length ), X_Y_POS_ALT ( CI26 ), BLANKS ( 1 .. 13 ) ); DRAW_PAIR ( X_Y_POS ( CI27 ) , BLANKS ( 1 .. C27'length ), X_Y_POS_ALT ( CI27 ), BLANKS ( 1 .. 13 ) ); end if; POINTS_DRAWN := false; case TEMP_TYPE is when ALL_EARTH => DRAW_PAIR ( X_Y_POS ( CI8 ) , BLANKS ( 1 .. C8'length ), X_Y_POS_ALT ( CI8 ), BLANKS ( 1 .. 13 ) ); DRAW_PAIR ( X_Y_POS ( CI9 ) , BLANKS ( 1 .. C9'length ), X_Y_POS_ALT ( CI9 ), BLANKS ( 1 .. 13 ) ); DRAW_PAIR ( X_Y_POS ( CI10 ) , BLANKS ( 1 .. C10'length ), X_Y_POS_ALT ( CI10 ), BLANKS ( 1 .. 13 ) ); DRAW_PAIR ( X_Y_POS ( CI11 ) , BLANKS ( 1 .. C11'length ), X_Y_POS_ALT ( CI11 ), BLANKS ( 1 .. 13 ) ); when MIN_MAX_LAT_LON => DRAW_PAIR ( X_Y_POS ( CI8 ) , C8, X_Y_POS_ALT ( CI8 ), FL_STRING ( TEMP.MIN_LAT_LON.X ) ); DRAW_PAIR ( X_Y_POS ( CI9 ) , C9, X_Y_POS_ALT ( CI9 ), FL_STRING ( TEMP.MIN_LAT_LON.Y ) ); DRAW_PAIR ( X_Y_POS ( CI10 ) , C10, X_Y_POS_ALT ( CI10 ), FL_STRING ( TEMP.MAX_LAT_LON.X ) ); DRAW_PAIR ( X_Y_POS ( CI11 ) , C11, X_Y_POS_ALT ( CI11 ), FL_STRING ( TEMP.MAX_LAT_LON.Y ) ); when MIN_MAX_COORDINATES => DRAW_PAIR ( X_Y_POS ( CI12 ) , C12, X_Y_POS_ALT ( CI12 ), FL_STRING ( TEMP.NORTH_EAST.X ) ); DRAW_PAIR ( X_Y_POS ( CI13 ) , C13, X_Y_POS_ALT ( CI13 ), FL_STRING ( TEMP.NORTH_EAST.Y ) ); DRAW_PAIR ( X_Y_POS ( CI14 ) , C14, X_Y_POS_ALT ( CI14 ), FL_STRING ( TEMP.SOUTH_WEST.X ) ); DRAW_PAIR ( X_Y_POS ( CI15 ) , C15, X_Y_POS_ALT ( CI15 ), FL_STRING ( TEMP.SOUTH_WEST.Y ) ); when ANGULAR_DIST_FROM_PROJECTION_CENTER => DRAW_PAIR ( X_Y_POS ( CI16 ) , C16, X_Y_POS_ALT ( CI16 ), FL_STRING ( TEMP.ANGLE_UP ) ); DRAW_PAIR ( X_Y_POS ( CI17 ) , C17, X_Y_POS_ALT ( CI17 ), FL_STRING ( TEMP.ANGLE_DOWN ) ); DRAW_PAIR ( X_Y_POS ( CI18 ) , C18, X_Y_POS_ALT ( CI18 ), FL_STRING ( TEMP.ANGLE_RIGHT ) ); DRAW_PAIR ( X_Y_POS ( CI19 ) , C19, X_Y_POS_ALT ( CI19 ), FL_STRING ( TEMP.ANGLE_LEFT ) ); when LAT_LON_BOUNDARY => POINTS_DRAWN := true; DRAW_PAIR ( X_Y_POS ( CI20 ) , C20, X_Y_POS_ALT ( CI20 ), FL_STRING ( TEMP.POINT_UP.X ) ); DRAW_PAIR ( X_Y_POS ( CI21 ) , C21, X_Y_POS_ALT ( CI21 ), FL_STRING ( TEMP.POINT_UP.Y ) ); DRAW_PAIR ( X_Y_POS ( CI22 ) , C22, X_Y_POS_ALT ( CI22 ), FL_STRING ( TEMP.POINT_DOWN.X ) ); DRAW_PAIR ( X_Y_POS ( CI23 ) , C23, X_Y_POS_ALT ( CI23 ), FL_STRING ( TEMP.POINT_DOWN.Y ) ); DRAW_PAIR ( X_Y_POS ( CI24 ) , C24, X_Y_POS_ALT ( CI24 ), FL_STRING ( TEMP.POINT_RIGHT.X ) ); DRAW_PAIR ( X_Y_POS ( CI25 ) , C25, X_Y_POS_ALT ( CI25 ), FL_STRING ( TEMP.POINT_RIGHT.Y ) ); DRAW_PAIR ( X_Y_POS ( CI26 ) , C26, X_Y_POS_ALT ( CI26 ), FL_STRING ( TEMP.POINT_LEFT.X ) ); DRAW_PAIR ( X_Y_POS ( CI27 ) , C27, X_Y_POS_ALT ( CI27 ), FL_STRING ( TEMP.POINT_LEFT.Y ) ); when others => null; end case; end DRAW_PROJ_LIMIT_FIELDS; procedure CS_FIELD is TEMP : COLOR_SELECTION; begin TEMP := CURRENT_COLOR_SELECTION; DRAW_TEXT ( X_Y_POS ( CI28 ), C28 ); DRAW_PAIR ( X_Y_POS ( CI29 ) , C29, X_Y_POS_ALT ( CI29 ), COLOR_TYPE'image ( TEMP.MAP_OUTLINE ) ); DRAW_PAIR ( X_Y_POS ( CI30 ) , C30, X_Y_POS_ALT ( CI30 ), COLOR_TYPE'image ( TEMP.GRID_LINES ) ); DRAW_PAIR ( X_Y_POS ( CI31 ) , C31, X_Y_POS_ALT ( CI31 ), COLOR_TYPE'image ( TEMP.HORIZON ) ); DRAW_PAIR ( X_Y_POS ( CI3A ) , C3A, X_Y_POS_ALT ( CI3A ), COLOR_TYPE'image ( TEMP.DEFAULT ) ); DRAW_PAIR ( X_Y_POS ( CI3B ) , C3B, X_Y_POS_ALT ( CI3B ), COLOR_TYPE'image ( TEMP.BACKGROUND ) ); end CS_FIELD; procedure GL_FIELD is TEMP : GRID_LINE_PARAMETERS; begin TEMP := CURRENT_GRID_LINE_PARAMETERS; DRAW_TEXT ( X_Y_POS ( CI32 ), C32 ); DRAW_PAIR ( X_Y_POS ( CI33 ) , C33, X_Y_POS_ALT ( CI33 ), boolean'image ( TEMP.SHOW_LINES ) ); DRAW_PAIR ( X_Y_POS ( CI34 ) , C34, X_Y_POS_ALT ( CI34 ), FL_STRING ( TEMP.DEGREES_BTWN_LATS ) ); DRAW_PAIR ( X_Y_POS ( CI35 ) , C35, X_Y_POS_ALT ( CI35 ), FL_STRING ( TEMP.DEGREES_BTWN_LONS ) ); DRAW_PAIR ( X_Y_POS ( CI3C ) , C3C, X_Y_POS_ALT ( CI3C ), FL_STRING ( TEMP.SEGMENT_LENGTH ) ); end GL_FIELD; procedure CLP_FIELD is begin -- DRAW_PAIR ( X_Y_POS ( CI36 ) , C36, -- X_Y_POS_ALT ( CI36 ), -- boolean'image ( CLIPPING )); DRAW_PAIR ( X_Y_POS ( CI52 ) , C52, X_Y_POS_ALT ( CI52 ), boolean'image ( PLOT_LAND )); end CLP_FIELD; procedure DRAW_ERROR_PORT ( TEXT1 : in string; TEXT : in string ) is CH : character := ' '; begin PUT_STRING ( BELL_BELL ); CURRENT_CURSOR_POS := ( 02, COM_1_INDENT ); DRAW_TEXT ( CURRENT_CURSOR_POS, TEXT1 ( TEXT1'first .. TEXT1'last ) ); CURRENT_CURSOR_POS.LINE := CURRENT_CURSOR_POS.LINE + 1; DRAW_TEXT ( CURRENT_CURSOR_POS, TEXT ( TEXT'first .. TEXT'last ) ); CURRENT_CURSOR_POS.LINE := CURRENT_CURSOR_POS.LINE + 1; CURRENT_CURSOR_POS.COLUMN := CURRENT_CURSOR_POS.COLUMN + 5; DRAW_PORT_TEXT ( LEVEL_1_ERRORS, CURRENT_CURSOR_POS, "Hit any character to continue =>", RED ); GET_CHAR ( CH ); CLEAR ( LEVEL_1_ERRORS ); FRM_PORT ( LEVEL_1_BODI, BLUE ); end DRAW_ERROR_PORT; procedure DRAW_COMMAND ( LEVEL : in NESTED_LEVEL; TEXT : in string ) is begin case LEVEL is when ONE => CURRENT_CURSOR_POS := ( HEIGHT_MAX, COM_1_INDENT ); DRAW_PORT_TEXT ( LEVEL_1_COMMAND, CURRENT_CURSOR_POS, TEXT ( TEXT'first .. TEXT'last ) ); when TWO => CURRENT_CURSOR_POS := ( HEIGHT_MAX - 2, COM_2_INDENT ); DRAW_PORT_TEXT ( LEVEL_2_COMMAND, CURRENT_CURSOR_POS, TEXT ( TEXT'first .. TEXT'last ) ); when THREE => CURRENT_CURSOR_POS := ( HEIGHT_MAX - 4, COM_3_INDENT ); DRAW_PORT_TEXT ( LEVEL_3_COMMAND, CURRENT_CURSOR_POS, TEXT ( TEXT'first .. TEXT'last ) ); when others => null; end case; end DRAW_COMMAND; procedure DRAW_DP_MENU ( LEVEL : in NESTED_LEVEL ) is begin if LEVEL = ONE then ERASE_SCREEN; CURRENT_CURSOR_POS := ( COM_1_INDENT - 4, DP_T_LEV_1 ); DRAW_PORT_TEXT ( LEVEL_1_TITLE, CURRENT_CURSOR_POS, DP_TITLE_LINE ); else CLEAR ( LEVEL_2 ); CURRENT_CURSOR_POS := ( COM_2_INDENT - 5, DP_T_LEV_2 ); DRAW_PORT_TEXT ( LEVEL_2_TITLE, CURRENT_CURSOR_POS, DP_TITLE_LINE ); end if; MAP_TITLE_FIELD; DRAW_PROJ_PARAM_FIELDS; DRAW_PROJ_LIMIT_FIELDS; CS_FIELD; GL_FIELD; CLP_FIELD; if LEVEL = ONE then FRM_PORT ( LEVEL_1_BODI, BLUE ); DRAW_COMMAND ( ONE, CL1 ); else FRM_PORT ( LEVEL_2_BODI, BLUE ); end if; end DRAW_DP_MENU; procedure DRAW_SDF_MENU ( CMD_DRAW : in boolean := true ) is TEMP : SPECIAL_DISPLAYS; begin TEMP := CURRENT_SPECIAL_DISPLAYS; CLEAR ( LEVEL_3 ); CURRENT_CURSOR_POS := ( COM_3_INDENT - 8, SDF_T_LEV_3 ); DRAW_PORT_TEXT ( LEVEL_3_TITLE, CURRENT_CURSOR_POS, SDF_TITLE ); DRAW_PAIR ( X_Y_POS ( CI37 ) , C37, X_Y_POS_ALT ( CI37 ), TEMP.BEAM_DATA ); DRAW_PAIR ( X_Y_POS ( CI38 ) , C38, X_Y_POS_ALT ( CI38 ), TEMP.SWATH_DATA ); DRAW_PAIR ( X_Y_POS ( CI39 ) , C39, X_Y_POS_ALT ( CI39 ), TEMP.POINTS_DATA ); DRAW_PAIR ( X_Y_POS ( CI40 ) , C40, X_Y_POS_ALT ( CI40 ), COLOR_TYPE'image ( TEMP.BEAM_COLOR ) ); DRAW_PAIR ( X_Y_POS ( CI41 ) , C41, X_Y_POS_ALT ( CI41 ), COLOR_TYPE'image ( TEMP.SWATH_COLOR ) ); DRAW_PAIR ( X_Y_POS ( CI42 ) , C42, X_Y_POS_ALT ( CI42 ), COLOR_TYPE'image ( TEMP.POINTS_COLOR ) ); FRM_PORT ( LEVEL_3_BODI, BLUE ); if CMD_DRAW then DRAW_COMMAND ( THREE, CL2 ); end if; end DRAW_SDF_MENU; procedure DRAW_DIG_MENU is TEMP : DIAGNOSTICS; begin TEMP := CURRENT_DIAGNOSTICS; CLEAR ( LEVEL_4 ); CURRENT_CURSOR_POS := ( COM_4_INDENT - 11, DIG_T_LEV_4 ); DRAW_PORT_TEXT ( LEVEL_4_TITLE, CURRENT_CURSOR_POS, DIG_TITLE ); DRAW_PAIR ( X_Y_POS ( CI43 ) , C43, X_Y_POS_ALT ( CI43 ), boolean'image ( TEMP.WARNING ) ); DRAW_PAIR ( X_Y_POS ( CI44 ) , C44, X_Y_POS_ALT ( CI44 ), boolean'image ( TEMP.ERROR ) ); DRAW_PAIR ( X_Y_POS ( CI45 ) , C45, X_Y_POS_ALT ( CI45 ), boolean'image ( TEMP.FATAL ) ); FRM_PORT ( LEVEL_4_BODI, BLUE ); end DRAW_DIG_MENU; procedure DRAW_PLC_MENU is TEMP : PLOT_CHARACTERISTICS; begin TEMP := CURRENT_PLOT_CHAR; CLEAR ( LEVEL_4 ); CURRENT_CURSOR_POS := ( COM_4_INDENT - 11, PLC_T_LEV_4 ); DRAW_PORT_TEXT ( LEVEL_4_TITLE, CURRENT_CURSOR_POS, PLC_TITLE ); DRAW_PAIR ( X_Y_POS ( CI46 ) , C46, X_Y_POS_ALT ( CI46 ), FL_STRING ( TEMP.AXIS_LENGTH.X ) ); DRAW_PAIR ( X_Y_POS ( CI47 ) , C47, X_Y_POS_ALT ( CI47 ), FL_STRING ( TEMP.AXIS_LENGTH.Y ) ); DRAW_PAIR ( X_Y_POS ( CI48 ) , C48, X_Y_POS_ALT ( CI48 ), FL_STRING ( TEMP.ORIGIN.X ) ); DRAW_PAIR ( X_Y_POS ( CI49 ) , C49, X_Y_POS_ALT ( CI49 ), FL_STRING ( TEMP.ORIGIN.Y ) ); FRM_PORT ( LEVEL_4_BODI, BLUE ); end DRAW_PLC_MENU; procedure DRAW_SESSION_MENU is begin ERASE_SCREEN; CURRENT_CURSOR_POS := ( COM_1_INDENT - 4, SES_T_LEV_1 ); DRAW_PORT_TEXT ( LEVEL_1_TITLE, CURRENT_CURSOR_POS, SES_TITLE ); FRM_PORT ( LEVEL_1_BODI, BLUE ); DRAW_COMMAND ( ONE, CL3 ); end DRAW_SESSION_MENU; procedure DRAW_MAP_MENU is begin ERASE_SCREEN; CURRENT_CURSOR_POS := ( COM_1_INDENT - 4, MAP_T_LEV_1 ); MAP_TITLEM ( 8 .. MAP_TITLEM'last ) := CURRENT_TITLE; DRAW_PORT_TEXT ( LEVEL_1_TITLE, CURRENT_CURSOR_POS, MAP_TITLEM ); FRM_PORT ( LEVEL_1_BODI, BLUE ); DRAW_COMMAND ( ONE, CL4 ); end DRAW_MAP_MENU; -- procedure DRAW_HELP_MENU is -- begin -- CLEAR ( LEVEL_2 ); -- CURRENT_CURSOR_POS := ( COM_2_INDENT - 5, HTOP_LEV_2 ); -- DRAW_PORT_TEXT ( LEVEL_2_TITLE, CURRENT_CURSOR_POS, HTOP_TITLE ); -- FRM_PORT ( LEVEL_2_BODI, BLUE ); -- DRAW_COMMAND ( TWO, CL5 ); -- end; procedure DRAW_SESSION_FILENAME is begin DRAW_PAIR ( X_Y_POS ( CI50 ), C50, X_Y_POS_ALT ( CI50 ), BLANKS ); end DRAW_SESSION_FILENAME; procedure DRAW_DISPLAY_FILENAME is begin DRAW_PAIR ( X_Y_POS ( CI51 ), C51, X_Y_POS_ALT ( CI51 ), BLANKS ); end DRAW_DISPLAY_FILENAME; -- procedure DRAW_HELP_SUB_MENU is -- begin -- CLEAR ( LEVEL_3 ); -- CURRENT_CURSOR_POS := ( COM_3_INDENT - 8, HTOP_LEV_3 ); -- DRAW_PORT_TEXT ( LEVEL_3_TITLE, CURRENT_CURSOR_POS, HTOP_TITLE ); -- FRM_PORT ( LEVEL_3_BODI, BLUE ); -- DRAW_COMMAND ( THREE, CL5 ); -- end; procedure INITIALIZE_MENUS is begin SET_TOP_AND_BOTTOM_MARGINS ( 0, HEIGHT_MAX ); SET_HOME; SET_132_COLUMNS_PER_LINE; NEW_SCREEN_SIZE ( WIDTH_MAX, HEIGHT_MAX ); CURSOR_HOME; -- LEVEL_1 is the entire screen. CREATE_PORT ( LEVEL_2, 04, 04, LEVEL_2_WIDTH, LEVEL_2_HEIGHT ); CREATE_PORT ( LEVEL_3, 06, 06, LEVEL_3_WIDTH, LEVEL_3_HEIGHT ); CREATE_PORT ( LEVEL_4, 08, 08, LEVEL_4_WIDTH, LEVEL_4_HEIGHT ); CREATE_PORT ( LEVEL_1_TITLE, 00, 00, WIDTH_MAX , 01 ); CREATE_PORT ( LEVEL_1_BODI, 00, 01, WIDTH_MAX , 22 ); CREATE_PORT ( LEVEL_1_COMMAND, 00, HEIGHT_MAX - 1, WIDTH_MAX , 01 ); CREATE_PORT ( LEVEL_1_ERRORS, 04, 01, LEVEL_2_WIDTH, 03 ); CREATE_PORT ( LEVEL_2_TITLE, 04, 04, LEVEL_2_WIDTH, 01 ); CREATE_PORT ( LEVEL_2_BODI, 04, 05, LEVEL_2_WIDTH, LEVEL_2_HEIGHT - 1 ); CREATE_PORT ( LEVEL_2_COMMAND, 04, 21, LEVEL_2_WIDTH, 01 ); CREATE_PORT ( LEVEL_3_TITLE, 06, 06, LEVEL_3_WIDTH, 01 ); CREATE_PORT ( LEVEL_3_BODI, 06, 07, LEVEL_3_WIDTH, LEVEL_3_HEIGHT - 1 ); CREATE_PORT ( LEVEL_3_COMMAND, 06, 19, LEVEL_3_WIDTH, 01 ); CREATE_PORT ( LEVEL_4_TITLE, 08, 08, LEVEL_4_WIDTH, 01 ); CREATE_PORT ( LEVEL_4_BODI, 08, 09, LEVEL_4_WIDTH, LEVEL_4_HEIGHT - 1 ); DRAW_SESSION_MENU; DRAW_DP_MENU ( TWO ); end INITIALIZE_MENUS; begin null; end MENU_DRAW; --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: --menuparse.txt --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: with MENU_CONSTANTS, MENU_CURRENTS, MENU_DRAW, MENU_FILE_IO; package body MENU_PARSE is use MENU_CURRENTS, MENU_TYPES, MENU_FILE_IO; use MENU_CONSTANTS, TERM_FUNCTIONS, MENU_TEXT, MENU_DRAW, GRAPHIC; CURRENT_MEN : MENUS := SESSION; CURRENT_COM_FIELD : integer range 0 .. FIELD_4_MAX + 1 := 0; CURRENT_CURSOR_POS : CURSOR_POS := ( 0, 0 ); CURRENT_TOKEN : TOKEN := ALPHA_NUM; CUR_INDEX : FIELD_INDEX := CI0; TEMP_COMMAND : COMMAND := QUIT; FLOAT_INC : constant FLOAT := 10.0; BLANK_STRING : string ( 1 .. 40 ) := ( 1 .. 40 => ' ' ); HOLD_STRING : string ( 1 .. 40 ) := ( 1 .. 40 => ' ' ); LAST : integer := 0; procedure SET_COM_CURSOR ( COM_LINE, INDENT : in integer ) is begin CURRENT_CURSOR_POS := ( COM_LINE, INDENT + COM_FIE_OFF ( CURRENT_COM_FIELD ) ); POSITION_CURSOR ( CURRENT_CURSOR_POS ); end SET_COM_CURSOR; procedure MOVE_RIGHT ( COM_LINE, MAX_FIELDS, INDENT : in integer ) is begin if CURRENT_COM_FIELD = MAX_FIELDS then CURRENT_COM_FIELD := 0; end if; CURRENT_COM_FIELD := CURRENT_COM_FIELD + 1; SET_COM_CURSOR ( COM_LINE, INDENT ); end MOVE_RIGHT; procedure MOVE_LEFT ( COM_LINE, MAX_FIELDS, INDENT : in integer ) is begin if CURRENT_COM_FIELD = 1 then CURRENT_COM_FIELD := MAX_FIELDS + 1; end if; CURRENT_COM_FIELD := CURRENT_COM_FIELD - 1; SET_COM_CURSOR ( COM_LINE, INDENT ); end MOVE_LEFT; procedure PARSE_COMMAND ( COM_LINE, MAX_FIELD, INDENT : in integer ) is begin loop CURRENT_TOKEN := PARSE_INPUT; case CURRENT_TOKEN is when TAB | RIGHT_ARROW => MOVE_RIGHT ( COM_LINE, MAX_FIELD, INDENT); when BACK_SPACE | LEFT_ARROW => MOVE_LEFT ( COM_LINE, MAX_FIELD, INDENT ); when RETURN_KEY => exit; when others => null; end case; end loop; end PARSE_COMMAND; procedure INITIALIZE_PARSE is begin CURRENT_MEN := SEC_DISPLAY_PARAM; CURRENT_COM_FIELD := 2; SET_COM_CURSOR ( HEIGHT_MAX, COM_1_INDENT ); end INITIALIZE_PARSE; procedure SET_TEMP ( P1, P2, P3, P4, P5, P6, P7: in COMMAND ) is begin case CURRENT_COM_FIELD is when 1 => TEMP_COMMAND := P1; when 2 => TEMP_COMMAND := P2; when 3 => TEMP_COMMAND := P3; when 4 => TEMP_COMMAND := P4; when 5 => TEMP_COMMAND := P5; when 6 => TEMP_COMMAND := P6; when 7 => TEMP_COMMAND := P7; when others => null; end case; end SET_TEMP; -- procedure HELP_CHECK is -- begin -- SET_TEMP ( CONTINUE, LEAVE, QUIT, QUIT, QUIT, QUIT, QUIT ); -- end HELP_CHECK; function PARSE_COMMAND_LINE return COMMAND is begin TEMP_COMMAND := QUIT; case CURRENT_MEN is when SESSION | SEC_DISPLAY_PARAM | DIAGNOSTIC | PLOTTER_CHAR => PARSE_COMMAND ( HEIGHT_MAX, FIELD_4_MAX, COM_1_INDENT ); SET_TEMP ( EDIT, SAVE, CONTINUE, LEAVE, QUIT, OPENF, QUIT ); when DISPLAY_PARAM => PARSE_COMMAND ( HEIGHT_MAX, FIELD_4_MAX, COM_1_INDENT ); SET_TEMP ( EDIT, CONTINUE, SAVE, LEAVE, QUIT, OPENF, QUIT); when MAP_OF => PARSE_COMMAND ( HEIGHT_MAX, FIELD_5_MAX, COM_1_INDENT ); SET_TEMP ( EDIT, SPECIAL, CONTINUE, LEAVE, QUIT, QUIT, QUIT ); -- when HELP_TOPIC => -- PARSE_COMMAND ( LEVEL_2_HEIGHT + 5, FIELD_5_MAX, COM_2_INDENT ); -- HELP_CHECK; -- when HELP_SUBTOPIC => -- PARSE_COMMAND ( LEVEL_3_HEIGHT + 7, FIELD_5_MAX, COM_3_INDENT ); -- HELP_CHECK; when SPECIAL_DISPLAY => PARSE_COMMAND ( LEVEL_3_HEIGHT + 7, FIELD_1_3_MAX, COM_3_INDENT ); SET_TEMP ( EDIT, CONTINUE, LEAVE, QUIT, QUIT, QUIT, QUIT ); when others => null; end case; return TEMP_COMMAND; end PARSE_COMMAND_LINE; procedure SET_SESSION_COM_CURSOR is begin CURRENT_COM_FIELD := 1; SET_COM_CURSOR ( HEIGHT_MAX, COM_1_INDENT ); end SET_SESSION_COM_CURSOR; procedure SET_DP_COM_CURSOR is begin SET_SESSION_COM_CURSOR; end SET_DP_COM_CURSOR; procedure SET_MAP_COM_CURSOR is begin SET_SESSION_COM_CURSOR; end SET_MAP_COM_CURSOR; procedure SET_SPECIAL_COM_CURSOR is begin CURRENT_COM_FIELD := 1; SET_COM_CURSOR ( LEVEL_3_HEIGHT + 7, COM_3_INDENT ); end SET_SPECIAL_COM_CURSOR; -- procedure SET_HELP_COM_CURSOR is -- begin -- CURRENT_COM_FIELD := 1; -- SET_COM_CURSOR ( LEVEL_2_HEIGHT + 5, COM_2_INDENT ); -- end SET_HELP_COM_CURSOR; -- procedure SET_HELP_SUB_COM_CURSOR is -- begin -- SET_SPECIAL_COM_CURSOR; -- end SET_HELP_SUB_COM_CURSOR; function CURRENT_MENU return MENUS is begin return CURRENT_MEN; end CURRENT_MENU; procedure SET_LIMIT_RIGHT is begin case CURRENT_TYPE_OF_PROJECTION_LIMIT is when ALL_EARTH => CUR_INDEX := CI29; when MIN_MAX_LAT_LON => CUR_INDEX := CI8; when MIN_MAX_COORDINATES => CUR_INDEX := CI12; when ANGULAR_DIST_FROM_PROJECTION_CENTER => CUR_INDEX := CI16; when LAT_LON_BOUNDARY => CUR_INDEX := CI20; when others => null; end case; end SET_LIMIT_RIGHT; procedure SET_LIMIT_LEFT is begin case CURRENT_TYPE_OF_PROJECTION_LIMIT is when ALL_EARTH => CUR_INDEX := CI7; when MIN_MAX_LAT_LON => CUR_INDEX := CI11; when MIN_MAX_COORDINATES => CUR_INDEX := CI15; when ANGULAR_DIST_FROM_PROJECTION_CENTER => CUR_INDEX := CI19; when LAT_LON_BOUNDARY => CUR_INDEX := CI27; when others => null; end case; end SET_LIMIT_LEFT; procedure RIGHT_MOVE is begin case CUR_INDEX is when CI4 => if CURRENT_TYPE_OF_PROJECTION = SATELLITE then CUR_INDEX := FIELD_INDEX'succ ( CUR_INDEX ); else CUR_INDEX := CI7; end if; when CI7 => SET_LIMIT_RIGHT; when CI11 | CI15 | CI19 | CI27 => CUR_INDEX := CI29; when CI3B => CUR_INDEX := CI33; -- when CI36 => when CI3C => CUR_INDEX := CI52; when CI42 => CUR_INDEX := CI37; when CI45 => CUR_INDEX := CI43; when CI49 => CUR_INDEX := CI46; when CI50 | CI51 => null; when CI52 => CUR_INDEX := CI0; when others => CUR_INDEX := FIELD_INDEX'succ ( CUR_INDEX ); end case; end RIGHT_MOVE; procedure LEFT_MOVE is begin case CUR_INDEX is when CI0 => CUR_INDEX := CI52; when CI7 => if CURRENT_TYPE_OF_PROJECTION = SATELLITE then CUR_INDEX := FIELD_INDEX'pred ( CUR_INDEX ); else CUR_INDEX := CI4; end if; when CI12 | CI16 | CI20 => CUR_INDEX := CI7; when CI29 => SET_LIMIT_LEFT; when CI33 => CUR_INDEX := CI3B; when CI37 => CUR_INDEX := CI42; when CI43 => CUR_INDEX := CI45; when CI46 => CUR_INDEX := CI49; when CI50 | CI51 => null; when CI52 => CUR_INDEX := CI3C; when others => CUR_INDEX := FIELD_INDEX'pred ( CUR_INDEX ); end case; end LEFT_MOVE; procedure COLOR_UP ( ITEM : in out COLOR_TYPE ) is begin if ITEM = COLOR_TYPE'first then ITEM := COLOR_TYPE'last; else ITEM := COLOR_TYPE'pred ( ITEM ); end if; PUT_STRING ( COLOR_TYPE'image ( ITEM ) & " " ); end COLOR_UP; procedure COLOR_DOWN ( ITEM : in out COLOR_TYPE ) is begin if ITEM = COLOR_TYPE'last then ITEM := COLOR_TYPE'first; else ITEM := COLOR_TYPE'succ ( ITEM ); end if; PUT_STRING ( COLOR_TYPE'image ( ITEM ) & " " ); end COLOR_DOWN; procedure BOOL_UP ( ITEM : in out boolean ) is begin ITEM := ( not ITEM ); PUT_STRING ( boolean'image ( ITEM ) & " " ); end BOOL_UP; procedure FLOAT_UP ( ITEM : in out float ) is begin ITEM := ITEM + FLOAT_INC; PUT_STRING ( FL_STRING ( ITEM ) ); exception when others => STATUS.ERROR := true; if CURRENT_DIAGS.ERROR then DRAW_ERROR_PORT ( "Error => Invalid numeric item or number too large.", " " ); end if; PUT_STRING ( FL_STRING ( ITEM ) ); end FLOAT_UP; procedure FLOAT_DOWN ( ITEM : in out float ) is begin ITEM := ITEM - FLOAT_INC; PUT_STRING ( FL_STRING ( ITEM ) ); exception when others => STATUS.ERROR := true; if CURRENT_DIAGS.ERROR then DRAW_ERROR_PORT ( "Error => Invalid numeric item or number too small.", " " ); end if; PUT_STRING ( FL_STRING ( ITEM ) ); end FLOAT_DOWN; procedure ARROW_UP is begin POSITION_CURSOR ( X_Y_POS_ALT ( CUR_INDEX ) ); case CUR_INDEX is when CI1 => if CURRENT_TYPE_OF_PROJECTION = KIND_OF_PROJECTION'first then CURRENT_TYPE_OF_PROJECTION := KIND_OF_PROJECTION'last; else CURRENT_TYPE_OF_PROJECTION := KIND_OF_PROJECTION'PRED ( CURRENT_TYPE_OF_PROJECTION ); end if; DRAW_PROJ_PARAM_FIELDS ( OMIT => true ); when CI2 => FLOAT_UP ( CURRENT_PROJECTION.LAT_CENTER ); when CI3 => FLOAT_UP ( CURRENT_PROJECTION.LON_CENTER ); when CI4 => FLOAT_UP ( CURRENT_PROJECTION.CLK_ROT_AR_CENT ); when CI5 => FLOAT_UP ( CURRENT_PROJECTION.SAT_ALTITUDE ); when CI6 => FLOAT_UP ( CURRENT_PROJECTION.VIEW_ALTITUDE ); when CI7 => if CURRENT_TYPE_OF_PROJECTION_LIMIT = KIND_OF_PROJECTION_LIMIT'first then CURRENT_TYPE_OF_PROJECTION_LIMIT := KIND_OF_PROJECTION_LIMIT'last; else CURRENT_TYPE_OF_PROJECTION_LIMIT := KIND_OF_PROJECTION_LIMIT'PRED ( CURRENT_TYPE_OF_PROJECTION_LIMIT ); end if; DRAW_PROJ_LIMIT_FIELDS ( OMIT => true ); when CI8 => FLOAT_UP ( CURRENT_PROJECTION_LIM.MIN_LAT_LON.X ); when CI9 => FLOAT_UP ( CURRENT_PROJECTION_LIM.MIN_LAT_LON.Y ); when CI10 => FLOAT_UP ( CURRENT_PROJECTION_LIM.MAX_LAT_LON.X ); when CI11 => FLOAT_UP ( CURRENT_PROJECTION_LIM.MAX_LAT_LON.Y ); when CI12 => FLOAT_UP ( CURRENT_PROJECTION_LIM.NORTH_EAST.X ); when CI13 => FLOAT_UP ( CURRENT_PROJECTION_LIM.NORTH_EAST.Y ); when CI14 => FLOAT_UP ( CURRENT_PROJECTION_LIM.SOUTH_WEST.X ); when CI15 => FLOAT_UP ( CURRENT_PROJECTION_LIM.SOUTH_WEST.Y ); when CI16 => FLOAT_UP ( CURRENT_PROJECTION_LIM.ANGLE_UP ); when CI17 => FLOAT_UP ( CURRENT_PROJECTION_LIM.ANGLE_DOWN ); when CI18 => FLOAT_UP ( CURRENT_PROJECTION_LIM.ANGLE_RIGHT ); when CI19 => FLOAT_UP ( CURRENT_PROJECTION_LIM.ANGLE_LEFT ); when CI20 => FLOAT_UP ( CURRENT_PROJECTION_LIM.POINT_UP.X ); when CI21 => FLOAT_UP ( CURRENT_PROJECTION_LIM.POINT_UP.Y ); when CI22 => FLOAT_UP ( CURRENT_PROJECTION_LIM.POINT_DOWN.X ); when CI23 => FLOAT_UP ( CURRENT_PROJECTION_LIM.POINT_DOWN.Y ); when CI24 => FLOAT_UP ( CURRENT_PROJECTION_LIM.POINT_RIGHT.X ); when CI25 => FLOAT_UP ( CURRENT_PROJECTION_LIM.POINT_RIGHT.Y ); when CI26 => FLOAT_UP ( CURRENT_PROJECTION_LIM.POINT_LEFT.X ); when CI27 => FLOAT_UP ( CURRENT_PROJECTION_LIM.POINT_LEFT.Y ); when CI29 => COLOR_UP ( CURRENT_COLOR.MAP_OUTLINE ); when CI30 => COLOR_UP ( CURRENT_COLOR.GRID_LINES ); when CI31 => COLOR_UP ( CURRENT_COLOR.HORIZON ); when CI3A => COLOR_UP ( CURRENT_COLOR.DEFAULT ); when CI3B => COLOR_UP ( CURRENT_COLOR.BACKGROUND ); when CI33 => BOOL_UP ( CURRENT_GRID_LINES.SHOW_LINES ); when CI34 => FLOAT_UP ( CURRENT_GRID_LINES.DEGREES_BTWN_LATS ); when CI35 => FLOAT_UP ( CURRENT_GRID_LINES.DEGREES_BTWN_LONS ); when CI3C => FLOAT_UP ( CURRENT_GRID_LINES.SEGMENT_LENGTH ); -- when CI36 => -- BOOL_UP ( CURRENT_CLIPPING ); when CI40 => COLOR_UP ( CURRENT_SPECIALS.BEAM_COLOR ); when CI41 => COLOR_UP ( CURRENT_SPECIALS.SWATH_COLOR ); when CI42 => COLOR_UP ( CURRENT_SPECIALS.POINTS_COLOR ); CURRENT_COLOR.MAP_OUTLINE := CURRENT_SPECIALS.POINTS_COLOR; when CI43 => BOOL_UP ( CURRENT_DIAGS.WARNING ); when CI44 => BOOL_UP ( CURRENT_DIAGS.ERROR ); when CI45 => BOOL_UP ( CURRENT_DIAGS.FATAL ); when CI46 => FLOAT_UP ( CURRENT_PLOT_CHARACTERISTICS.AXIS_LENGTH.X ); when CI47 => FLOAT_UP ( CURRENT_PLOT_CHARACTERISTICS.AXIS_LENGTH.Y ); when CI48 => FLOAT_UP ( CURRENT_PLOT_CHARACTERISTICS.ORIGIN.X ); when CI49 => FLOAT_UP ( CURRENT_PLOT_CHARACTERISTICS.ORIGIN.Y ); when CI52 => BOOL_UP ( CURRENT_LAND ); when others => null; end case; end ARROW_UP; procedure ARROW_DOWN is begin POSITION_CURSOR ( X_Y_POS_ALT ( CUR_INDEX ) ); case CUR_INDEX is when CI1 => if CURRENT_TYPE_OF_PROJECTION = KIND_OF_PROJECTION'last then CURRENT_TYPE_OF_PROJECTION := KIND_OF_PROJECTION'first; else CURRENT_TYPE_OF_PROJECTION := KIND_OF_PROJECTION'succ ( CURRENT_TYPE_OF_PROJECTION ); end if; DRAW_PROJ_PARAM_FIELDS ( OMIT => true ); when CI2 => FLOAT_DOWN ( CURRENT_PROJECTION.LAT_CENTER ); when CI3 => FLOAT_DOWN ( CURRENT_PROJECTION.LON_CENTER ); when CI4 => FLOAT_DOWN ( CURRENT_PROJECTION.CLK_ROT_AR_CENT ); when CI5 => FLOAT_DOWN ( CURRENT_PROJECTION.SAT_ALTITUDE ); when CI6 => FLOAT_DOWN ( CURRENT_PROJECTION.VIEW_ALTITUDE ); when CI7 => if CURRENT_TYPE_OF_PROJECTION_LIMIT = KIND_OF_PROJECTION_LIMIT'last then CURRENT_TYPE_OF_PROJECTION_LIMIT := KIND_OF_PROJECTION_LIMIT'first; else CURRENT_TYPE_OF_PROJECTION_LIMIT := KIND_OF_PROJECTION_LIMIT'succ ( CURRENT_TYPE_OF_PROJECTION_LIMIT ); end if; DRAW_PROJ_LIMIT_FIELDS ( OMIT => true ); when CI8 => FLOAT_DOWN ( CURRENT_PROJECTION_LIM.MIN_LAT_LON.X ); when CI9 => FLOAT_DOWN ( CURRENT_PROJECTION_LIM.MIN_LAT_LON.Y ); when CI10 => FLOAT_DOWN ( CURRENT_PROJECTION_LIM.MAX_LAT_LON.X ); when CI11 => FLOAT_DOWN ( CURRENT_PROJECTION_LIM.MAX_LAT_LON.Y ); when CI12 => FLOAT_DOWN ( CURRENT_PROJECTION_LIM.NORTH_EAST.X ); when CI13 => FLOAT_DOWN ( CURRENT_PROJECTION_LIM.NORTH_EAST.Y ); when CI14 => FLOAT_DOWN ( CURRENT_PROJECTION_LIM.SOUTH_WEST.X ); when CI15 => FLOAT_DOWN ( CURRENT_PROJECTION_LIM.SOUTH_WEST.Y ); when CI16 => FLOAT_DOWN ( CURRENT_PROJECTION_LIM.ANGLE_UP ); when CI17 => FLOAT_DOWN ( CURRENT_PROJECTION_LIM.ANGLE_DOWN ); when CI18 => FLOAT_DOWN ( CURRENT_PROJECTION_LIM.ANGLE_RIGHT ); when CI19 => FLOAT_DOWN ( CURRENT_PROJECTION_LIM.ANGLE_LEFT ); when CI20 => FLOAT_DOWN ( CURRENT_PROJECTION_LIM.POINT_UP.X ); when CI21 => FLOAT_DOWN ( CURRENT_PROJECTION_LIM.POINT_UP.Y ); when CI22 => FLOAT_DOWN ( CURRENT_PROJECTION_LIM.POINT_DOWN.X ); when CI23 => FLOAT_DOWN ( CURRENT_PROJECTION_LIM.POINT_DOWN.Y ); when CI24 => FLOAT_DOWN ( CURRENT_PROJECTION_LIM.POINT_RIGHT.X ); when CI25 => FLOAT_DOWN ( CURRENT_PROJECTION_LIM.POINT_RIGHT.Y ); when CI26 => FLOAT_DOWN ( CURRENT_PROJECTION_LIM.POINT_LEFT.X ); when CI27 => FLOAT_DOWN ( CURRENT_PROJECTION_LIM.POINT_LEFT.Y ); when CI29 => COLOR_DOWN ( CURRENT_COLOR.MAP_OUTLINE ); when CI30 => COLOR_DOWN ( CURRENT_COLOR.GRID_LINES ); when CI31 => COLOR_DOWN ( CURRENT_COLOR.HORIZON ); when CI3A => COLOR_DOWN ( CURRENT_COLOR.DEFAULT ); when CI3B => COLOR_DOWN ( CURRENT_COLOR.BACKGROUND ); when CI33 => BOOL_UP ( CURRENT_GRID_LINES.SHOW_LINES ); when CI34 => FLOAT_DOWN ( CURRENT_GRID_LINES.DEGREES_BTWN_LATS ); when CI35 => FLOAT_DOWN ( CURRENT_GRID_LINES.DEGREES_BTWN_LONS ); when CI3C => FLOAT_DOWN ( CURRENT_GRID_LINES.SEGMENT_LENGTH ); -- when CI36 => -- BOOL_UP ( CURRENT_CLIPPING ); when CI40 => COLOR_DOWN ( CURRENT_SPECIALS.BEAM_COLOR ); when CI41 => COLOR_DOWN ( CURRENT_SPECIALS.SWATH_COLOR ); when CI42 => COLOR_DOWN ( CURRENT_SPECIALS.POINTS_COLOR ); CURRENT_COLOR.MAP_OUTLINE := CURRENT_SPECIALS.POINTS_COLOR; when CI43 => BOOL_UP ( CURRENT_DIAGS.WARNING ); when CI44 => BOOL_UP ( CURRENT_DIAGS.ERROR ); when CI45 => BOOL_UP ( CURRENT_DIAGS.FATAL ); when CI46 => FLOAT_DOWN ( CURRENT_PLOT_CHARACTERISTICS.AXIS_LENGTH.X ); when CI47 => FLOAT_DOWN ( CURRENT_PLOT_CHARACTERISTICS.AXIS_LENGTH.Y ); when CI48 => FLOAT_DOWN ( CURRENT_PLOT_CHARACTERISTICS.ORIGIN.X ); when CI49 => FLOAT_DOWN ( CURRENT_PLOT_CHARACTERISTICS.ORIGIN.Y ); when CI52 => BOOL_UP ( CURRENT_LAND ); when others => null; end case; end ARROW_DOWN; procedure FILLER is begin case CUR_INDEX is when CI0 | CI37 .. CI39 | CI50 | CI51 => FILL ( 40 ); when CI1 => FILL ( 15 ); when CI7 => FILL ( 35 ); when CI2 .. CI6 | CI8 .. CI27 | CI34 .. CI3C | CI46 .. CI49 => FILL ( 12 ); when CI28 .. CI33 | CI40 .. CI45 | CI52 => FILL ( 5 ); when others => null; end case; end FILLER; procedure FLUSH_BOOL ( ITEM : out boolean ) is begin HOLD_STRING ( 1 .. 5 ) := ( 1 .. 5 => ' ' ); LAST := 0; FLUSH ( HOLD_STRING ( 1 .. 5 ), LAST ); if LAST /= 0 then ITEM := boolean'value ( HOLD_STRING ( 1 .. LAST ) ); end if; exception when others => STATUS.ERROR := true; if CURRENT_DIAGS.ERROR then DRAW_ERROR_PORT ( "Error => Invalid boolean value.", " " ); end if; end FLUSH_BOOL; procedure FLUSH_COLOR ( ITEM : out COLOR_TYPE ) is begin HOLD_STRING ( 1 .. 5 ) := ( 1 .. 5 => ' ' ); LAST := 0; FLUSH ( HOLD_STRING ( 1 .. 5 ), last ); if LAST /= 0 then ITEM := COLOR_TYPE'value ( HOLD_STRING ( 1 .. last ) ); end if; exception when others => STATUS.ERROR := true; if CURRENT_DIAGS.ERROR then DRAW_ERROR_PORT ( "Error => Invalid color value.", " " ); end if; end FLUSH_COLOR; procedure FLUSH_FLOAT ( ITEM : out float ) is begin HOLD_STRING ( 1 .. 12 ) := ( 1 .. 12 => ' ' ); LAST := 0; FLUSH ( HOLD_STRING ( 1 .. 12 ), last ); if LAST /= 0 then ITEM := STRING_FL ( HOLD_STRING ( 1 .. 12 ) ); end if; exception when others => STATUS.ERROR := true; if CURRENT_DIAGS.ERROR then DRAW_ERROR_PORT ( "Error => Invalid numeric value or number too large.", " " ); end if; end FLUSH_FLOAT; procedure FLUSHER is begin HOLD_STRING := ( 1 .. 40 => ' ' ); LAST := 0; case CUR_INDEX is when CI0 => FLUSH ( HOLD_STRING , last ); if LAST /= 0 then CURRENT_MAP_TITLE := HOLD_STRING; end if; when CI1 => FLUSH ( HOLD_STRING ( 1 .. 15 ), last ); if LAST /= 0 then CURRENT_TYPE_OF_PROJECTION := KIND_OF_PROJECTION'value ( HOLD_STRING ( 1 .. last ) ); DRAW_PROJ_PARAM_FIELDS ( OMIT => true ); end if; when CI2 => FLUSH_FLOAT ( CURRENT_PROJECTION.LAT_CENTER ); when CI3 => FLUSH_FLOAT ( CURRENT_PROJECTION.LON_CENTER ); when CI4 => FLUSH_FLOAT ( CURRENT_PROJECTION.CLK_ROT_AR_CENT ); when CI5 => FLUSH_FLOAT ( CURRENT_PROJECTION.SAT_ALTITUDE ); when CI6 => FLUSH_FLOAT ( CURRENT_PROJECTION.VIEW_ALTITUDE ); when CI7 => FLUSH ( HOLD_STRING ( 1 .. 35 ), last ); if LAST /= 0 then CURRENT_TYPE_OF_PROJECTION_LIMIT := KIND_OF_PROJECTION_LIMIT'value ( HOLD_STRING ( 1 .. last ) ); DRAW_PROJ_LIMIT_FIELDS ( OMIT => true ); end if; when CI8 => FLUSH_FLOAT ( CURRENT_PROJECTION_LIM.MIN_LAT_LON.X ); when CI9 => FLUSH_FLOAT ( CURRENT_PROJECTION_LIM.MIN_LAT_LON.Y ); when CI10 => FLUSH_FLOAT ( CURRENT_PROJECTION_LIM.MAX_LAT_LON.X ); when CI11 => FLUSH_FLOAT ( CURRENT_PROJECTION_LIM.MAX_LAT_LON.Y ); when CI12 => FLUSH_FLOAT ( CURRENT_PROJECTION_LIM.NORTH_EAST.X ); when CI13 => FLUSH_FLOAT ( CURRENT_PROJECTION_LIM.NORTH_EAST.Y ); when CI14 => FLUSH_FLOAT ( CURRENT_PROJECTION_LIM.SOUTH_WEST.X ); when CI15 => FLUSH_FLOAT ( CURRENT_PROJECTION_LIM.SOUTH_WEST.Y ); when CI16 => FLUSH_FLOAT ( CURRENT_PROJECTION_LIM.ANGLE_UP ); when CI17 => FLUSH_FLOAT ( CURRENT_PROJECTION_LIM.ANGLE_DOWN ); when CI18 => FLUSH_FLOAT ( CURRENT_PROJECTION_LIM.ANGLE_RIGHT ); when CI19 => FLUSH_FLOAT ( CURRENT_PROJECTION_LIM.ANGLE_LEFT ); when CI20 => FLUSH_FLOAT ( CURRENT_PROJECTION_LIM.POINT_UP.X ); when CI21 => FLUSH_FLOAT ( CURRENT_PROJECTION_LIM.POINT_UP.Y ); when CI22 => FLUSH_FLOAT ( CURRENT_PROJECTION_LIM.POINT_DOWN.X ); when CI23 => FLUSH_FLOAT ( CURRENT_PROJECTION_LIM.POINT_DOWN.Y ); when CI24 => FLUSH_FLOAT ( CURRENT_PROJECTION_LIM.POINT_RIGHT.X ); when CI25 => FLUSH_FLOAT ( CURRENT_PROJECTION_LIM.POINT_RIGHT.Y ); when CI26 => FLUSH_FLOAT ( CURRENT_PROJECTION_LIM.POINT_LEFT.X ); when CI27 => FLUSH_FLOAT ( CURRENT_PROJECTION_LIM.POINT_LEFT.Y ); when CI29 => FLUSH_COLOR ( CURRENT_COLOR.MAP_OUTLINE ); when CI30 => FLUSH_COLOR ( CURRENT_COLOR.GRID_LINES ); when CI31 => FLUSH_COLOR ( CURRENT_COLOR.HORIZON ); when CI3A => FLUSH_COLOR ( CURRENT_COLOR.DEFAULT ); when CI3B => FLUSH_COLOR ( CURRENT_COLOR.BACKGROUND ); when CI33 => FLUSH_BOOL ( CURRENT_GRID_LINES.SHOW_LINES ); when CI34 => FLUSH_FLOAT ( CURRENT_GRID_LINES.DEGREES_BTWN_LATS ); when CI35 => FLUSH_FLOAT ( CURRENT_GRID_LINES.DEGREES_BTWN_LONS ); when CI3C => FLUSH_FLOAT ( CURRENT_GRID_LINES.SEGMENT_LENGTH ); -- when CI36 => -- FLUSH_BOOL ( CURRENT_CLIPPING ); when CI37 => FLUSH ( HOLD_STRING, LAST ); if LAST /= 0 then CURRENT_SPECIALS.BEAM_DATA := HOLD_STRING; if CURRENT_SPECIALS.BEAM_DATA = BLANK_STRING then LAST := 0; end if; CURRENT_SPECIALS.BEAM_LAST := LAST; end if; when CI38 => FLUSH ( HOLD_STRING, LAST ); if LAST /= 0 then CURRENT_SPECIALS.SWATH_DATA := HOLD_STRING; if CURRENT_SPECIALS.SWATH_DATA = BLANK_STRING then LAST := 0; end if; CURRENT_SPECIALS.SWATH_LAST := LAST; end if; when CI39 => FLUSH ( HOLD_STRING, LAST ); if LAST /= 0 then CURRENT_SPECIALS.POINTS_DATA := HOLD_STRING; if CURRENT_SPECIALS.POINTS_DATA = BLANK_STRING then LAST := 0; end if; CURRENT_SPECIALS.POINTS_LAST := LAST; end if; when CI40 => FLUSH_COLOR ( CURRENT_SPECIALS.BEAM_COLOR ); when CI41 => FLUSH_COLOR ( CURRENT_SPECIALS.SWATH_COLOR ); when CI42 => FLUSH_COLOR ( CURRENT_SPECIALS.POINTS_COLOR ); CURRENT_COLOR.MAP_OUTLINE := CURRENT_SPECIALS.POINTS_COLOR; when CI43 => FLUSH_BOOL ( CURRENT_DIAGS.WARNING ); when CI44 => FLUSH_BOOL ( CURRENT_DIAGS.ERROR ); when CI45 => FLUSH_BOOL ( CURRENT_DIAGS.FATAL ); when CI46 => FLUSH_FLOAT ( CURRENT_PLOT_CHARACTERISTICS.AXIS_LENGTH.X ); when CI47 => FLUSH_FLOAT ( CURRENT_PLOT_CHARACTERISTICS.AXIS_LENGTH.Y ); when CI48 => FLUSH_FLOAT ( CURRENT_PLOT_CHARACTERISTICS.ORIGIN.X ); when CI49 => FLUSH_FLOAT ( CURRENT_PLOT_CHARACTERISTICS.ORIGIN.Y ); when CI50 => FLUSH ( HOLD_STRING, LAST ); CURRENT_SESSION_FILENAME := HOLD_STRING; when CI51 => FLUSH ( HOLD_STRING, LAST ); CURRENT_DISPLAY_FILENAME := HOLD_STRING; when CI52 => FLUSH_BOOL ( CURRENT_LAND ); when others => null; end case; exception when others => STATUS.ERROR := true; if CURRENT_DIAGS.ERROR then DRAW_ERROR_PORT ( "Error => Invalid kind of projection or projection limit.", " " ); end if; end FLUSHER; procedure PARSE_LOOP is POS : boolean := true; begin loop if POS then POSITION_CURSOR ( X_Y_POS_ALT ( CUR_INDEX ) ); else POS := true; end if; CURRENT_TOKEN := PARSE_INPUT; case CURRENT_TOKEN is when RIGHT_ARROW => FLUSHER; exit when ( CUR_INDEX = CI50 or else CUR_INDEX = CI51 ); RIGHT_MOVE; when LEFT_ARROW => FLUSHER; exit when ( CUR_INDEX = CI50 or else CUR_INDEX = CI51 ); LEFT_MOVE; when TAB => FLUSHER; exit; when UP_ARROW => FLUSHER; exit when ( CUR_INDEX = CI50 or else CUR_INDEX = CI51 ); ARROW_UP; when DOWN_ARROW => FLUSHER; exit when ( CUR_INDEX = CI50 or else CUR_INDEX = CI51 ); ARROW_DOWN; when ALPHA_NUM | BACK_SPACE | RETURN_KEY => POS := false; FILLER; when others => null; end case; end loop; end PARSE_LOOP; procedure EDIT_DISPLAY is begin CUR_INDEX := CI0; PARSE_LOOP; end EDIT_DISPLAY; procedure EDIT_SPECIALS is begin CUR_INDEX := CI37; PARSE_LOOP; end EDIT_SPECIALS; procedure EDIT_DIAGNOSTICS is begin CUR_INDEX := CI43; PARSE_LOOP; end EDIT_DIAGNOSTICS; procedure EDIT_PLOT is begin CUR_INDEX := CI46; PARSE_LOOP; end EDIT_PLOT; procedure EDIT is begin case CURRENT_MEN is when SESSION | SEC_DISPLAY_PARAM | DIAGNOSTIC | PLOTTER_CHAR => CURRENT_MEN := SEC_DISPLAY_PARAM; EDIT_DISPLAY; CURRENT_MEN := SPECIAL_DISPLAY; DRAW_SDF_MENU ( false ); EDIT_SPECIALS; CURRENT_MEN := DIAGNOSTIC; DRAW_DIG_MENU; EDIT_DIAGNOSTICS; CURRENT_MEN := PLOTTER_CHAR; DRAW_PLC_MENU; EDIT_PLOT; SET_DEFAULTS_FROM_CURRENTS; DRAW_DP_MENU ( TWO ); SET_SESSION_COM_CURSOR; when DISPLAY_PARAM => EDIT_DISPLAY; SET_SESSION_COM_CURSOR; when SPECIAL_DISPLAY => EDIT_SPECIALS; SET_SPECIAL_COM_CURSOR; when MAP_OF => CURRENT_MEN := DISPLAY_PARAM; DRAW_DP_MENU ( ONE ); SET_DP_COM_CURSOR; EDIT_DISPLAY; SET_SESSION_COM_CURSOR; when others => null; end case; end EDIT; procedure CONTINUE is begin case CURRENT_MEN is when SESSION | SEC_DISPLAY_PARAM | DIAGNOSTIC | PLOTTER_CHAR => CURRENT_MEN := DISPLAY_PARAM; DRAW_DP_MENU ( ONE ); SET_DP_COM_CURSOR; when DISPLAY_PARAM => CURRENT_MEN := MAP_OF; DRAW_MAP_MENU; DRAW_MAP := true; SET_MAP_COM_CURSOR; when MAP_OF => CURRENT_MEN := DISPLAY_PARAM; DRAW_DP_MENU ( ONE ); SET_DP_COM_CURSOR; when SPECIAL_DISPLAY => CURRENT_MEN := MAP_OF; DRAW_MAP_MENU; DRAW_MAP := true; SET_MAP_COM_CURSOR; -- when HELP_TOPIC => -- null; -- when HELP_SUBTOPIC => -- null; when others => null; end case; end CONTINUE; procedure SAVE is begin case CURRENT_MEN is when SESSION | SEC_DISPLAY_PARAM | DIAGNOSTIC | PLOTTER_CHAR => DRAW_SESSION_FILENAME; CUR_INDEX := CI50; PARSE_LOOP; if CURRENT_SESSION_FILENAME /= BLANK_STRING then CREATE_MENU_FILE ( CURRENT_SESSION_FILENAME ( 1 .. LAST ) ); WRITE_SESSION_CURRENTS; CLOSE_MENU_FILE; end if; SET_SESSION_COM_CURSOR; when DISPLAY_PARAM => DRAW_DISPLAY_FILENAME; CUR_INDEX := CI51; PARSE_LOOP; if CURRENT_DISPLAY_FILENAME /= BLANK_STRING then CREATE_MENU_FILE ( CURRENT_DISPLAY_FILENAME ( 1 .. LAST ) ); WRITE_SESSION_CURRENTS; CLOSE_MENU_FILE; end if; SET_SESSION_COM_CURSOR; when others => null; end case; exception when others => STATUS.ERROR := true; if CURRENT_DIAGS.ERROR then DRAW_ERROR_PORT ( "Error => Invalid file name.", " " ); end if; SET_SESSION_COM_CURSOR; end SAVE; -- procedure HELP is -- begin -- case CURRENT_MEN is -- when SESSION | SEC_DISPLAY_PARAM | DIAGNOSTIC | PLOTTER_CHAR => -- null; -- when DISPLAY_PARAM => -- null; -- when MAP_OF => -- null; -- when SPECIAL_DISPLAY => -- null; -- when others => -- null; -- end case; -- end HELP; procedure LEAVE is begin case CURRENT_MEN is when SESSION | SEC_DISPLAY_PARAM | DIAGNOSTIC | PLOTTER_CHAR => SESSION_TERMINATED := TRUE; DRAW_MAP := TRUE; when DISPLAY_PARAM => SET_CURRENTS_FROM_DEFAULTS; CURRENT_MEN := SESSION; DRAW_SESSION_MENU; DRAW_DP_MENU ( TWO ); SET_SESSION_COM_CURSOR; when MAP_OF => CURRENT_MEN := DISPLAY_PARAM; DRAW_DP_MENU ( ONE ); SET_DP_COM_CURSOR; when SPECIAL_DISPLAY => DRAW_MAP := TRUE; CURRENT_MEN := MAP_OF; DRAW_MAP_MENU; SET_MAP_COM_CURSOR; -- when HELP_TOPIC => -- null; -- when HELP_SUBTOPIC => -- null; when others => null; end case; end LEAVE; procedure QUIT is begin DRAW_MAP := TRUE; SESSION_TERMINATED := TRUE; end; -- procedure UNDO is -- begin -- null; -- end; procedure SPECIAL is begin CURRENT_MEN := SPECIAL_DISPLAY; DRAW_SDF_MENU; SET_SPECIAL_COM_CURSOR; end; -- procedure APPEND is -- begin -- null; -- end; procedure OPENF is begin case CURRENT_MEN is when SESSION | SEC_DISPLAY_PARAM | DIAGNOSTIC | PLOTTER_CHAR => DRAW_SESSION_FILENAME; CUR_INDEX := CI50; PARSE_LOOP; if CURRENT_SESSION_FILENAME /= BLANK_STRING then OPEN_MENU_FILE ( CURRENT_SESSION_FILENAME ( 1 .. LAST ) ); READ_SESSION_DEFAULTS; CLOSE_MENU_FILE; end if; CURRENT_MEN := DISPLAY_PARAM; LEAVE; when DISPLAY_PARAM => DRAW_DISPLAY_FILENAME; CUR_INDEX := CI51; PARSE_LOOP; if CURRENT_DISPLAY_FILENAME /= BLANK_STRING then OPEN_MENU_FILE ( CURRENT_DISPLAY_FILENAME ( 1 .. LAST ) ); READ_DISPLAY_DEFAULTS; CLOSE_MENU_FILE; end if; CURRENT_MEN := MAP_OF; SET_CURRENTS_FROM_DEFAULTS; LEAVE; when others => null; end case; exception when CONSTRAINT_ERROR => CLOSE_MENU_FILE; STATUS.ERROR := true; if CURRENT_DIAGS.ERROR then DRAW_ERROR_PORT ( "Error => Invalid file data for this menu.", " " ); end if; SET_SESSION_COM_CURSOR; when others => STATUS.ERROR := true; if CURRENT_DIAGS.ERROR then DRAW_ERROR_PORT ( "Error => File not found.", " " ); end if; SET_SESSION_COM_CURSOR; end OPENF; begin null; end MENU_PARSE; --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: --menufilei.txt --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: with TEXT_IO, MENU_CURRENTS, MENU_TYPES, GRAPHIC; package body MENU_FILE_IO is use TEXT_IO; package FLT_IO is new FLOAT_IO ( float ); use FLT_IO; use MENU_CURRENTS, MENU_TYPES, GRAPHIC; CURRENT_FILE : FILE_TYPE; HOLD_STRING : string ( 1 .. 40 ) := ( 1 .. 40 => ' ' ); LAST : integer := 0; procedure OPEN_MENU_FILE ( FILE : in string ) is -- use for OPENF command. begin OPEN ( CURRENT_FILE, IN_FILE, FILE ( FILE'first .. FILE'last ) ); end OPEN_MENU_FILE; procedure CLOSE_MENU_FILE is -- use for OPENF & SAVE commands. begin CLOSE ( CURRENT_FILE ); end CLOSE_MENU_FILE; procedure CREATE_MENU_FILE ( FILE : in string ) is -- use for SAVE command. begin CREATE ( CURRENT_FILE, OUT_FILE, FILE ( FILE'first .. FILE'last ) ); end CREATE_MENU_FILE; procedure READ ( ITEM : in out float ) is begin GET ( CURRENT_FILE, ITEM ); SKIP_LINE ( CURRENT_FILE ); end READ; procedure READ ( ITEM : in out string; LAST : in out integer ) is begin GET_LINE ( CURRENT_FILE, ITEM, LAST ); end READ; procedure WRITE ( ITEM : in float ) is begin PUT ( CURRENT_FILE, ITEM ); NEW_LINE ( CURRENT_FILE ); end WRITE; procedure WRITE ( ITEM : in string ) is begin PUT ( CURRENT_FILE, ITEM ( ITEM'first .. ITEM'last) ); NEW_LINE ( CURRENT_FILE ); end WRITE; procedure WRITE_DISPLAY_CURRENTS is begin WRITE ( CURRENT_MAP_TITLE ); WRITE ( KIND_OF_PROJECTION'image ( CURRENT_TYPE_OF_PROJECTION ) ); WRITE ( CURRENT_PROJECTION.LAT_CENTER ); WRITE ( CURRENT_PROJECTION.LON_CENTER ); WRITE ( CURRENT_PROJECTION.CLK_ROT_AR_CENT ); WRITE ( CURRENT_PROJECTION.SAT_ALTITUDE ); WRITE ( CURRENT_PROJECTION.VIEW_ALTITUDE ); WRITE ( KIND_OF_PROJECTION_LIMIT'image ( CURRENT_TYPE_OF_PROJECTION_LIMIT ) ); WRITE ( CURRENT_PROJECTION_LIM.MIN_LAT_LON.X ); WRITE ( CURRENT_PROJECTION_LIM.MIN_LAT_LON.Y ); WRITE ( CURRENT_PROJECTION_LIM.MAX_LAT_LON.X ); WRITE ( CURRENT_PROJECTION_LIM.MAX_LAT_LON.Y ); WRITE ( CURRENT_PROJECTION_LIM.NORTH_EAST.X ); WRITE ( CURRENT_PROJECTION_LIM.NORTH_EAST.Y ); WRITE ( CURRENT_PROJECTION_LIM.SOUTH_WEST.X ); WRITE ( CURRENT_PROJECTION_LIM.SOUTH_WEST.Y ); WRITE ( CURRENT_PROJECTION_LIM.ANGLE_UP ); WRITE ( CURRENT_PROJECTION_LIM.ANGLE_DOWN ); WRITE ( CURRENT_PROJECTION_LIM.ANGLE_RIGHT ); WRITE ( CURRENT_PROJECTION_LIM.ANGLE_LEFT ); WRITE ( CURRENT_PROJECTION_LIM.POINT_UP.X ); WRITE ( CURRENT_PROJECTION_LIM.POINT_UP.Y ); WRITE ( CURRENT_PROJECTION_LIM.POINT_DOWN.X ); WRITE ( CURRENT_PROJECTION_LIM.POINT_DOWN.Y ); WRITE ( CURRENT_PROJECTION_LIM.POINT_RIGHT.X ); WRITE ( CURRENT_PROJECTION_LIM.POINT_RIGHT.Y ); WRITE ( CURRENT_PROJECTION_LIM.POINT_LEFT.X ); WRITE ( CURRENT_PROJECTION_LIM.POINT_LEFT.Y ); WRITE ( COLOR_TYPE'image ( CURRENT_COLOR.BACKGROUND ) ); WRITE ( COLOR_TYPE'image ( CURRENT_COLOR.DEFAULT ) ); WRITE ( COLOR_TYPE'image ( CURRENT_COLOR.MAP_OUTLINE ) ); WRITE ( COLOR_TYPE'image ( CURRENT_COLOR.GRID_LINES ) ); WRITE ( COLOR_TYPE'image ( CURRENT_COLOR.HORIZON ) ); WRITE ( boolean'image ( CURRENT_GRID_LINES.SHOW_LINES ) ); WRITE ( CURRENT_GRID_LINES.DEGREES_BTWN_LATS ); WRITE ( CURRENT_GRID_LINES.DEGREES_BTWN_LONS ); WRITE ( CURRENT_GRID_LINES.SEGMENT_LENGTH ); -- WRITE ( boolean'image ( CURRENT_CLIPPING ) ); WRITE ( boolean'image ( CURRENT_LAND ) ); exception when others => raise CONSTRAINT_ERROR; end WRITE_DISPLAY_CURRENTS; procedure WRITE_SESSION_CURRENTS is begin WRITE_DISPLAY_CURRENTS; WRITE ( CURRENT_SPECIALS.BEAM_DATA ); WRITE ( COLOR_TYPE'image ( CURRENT_SPECIALS.BEAM_COLOR ) ); WRITE ( integer'image ( CURRENT_SPECIALS.BEAM_LAST ) ); WRITE ( CURRENT_SPECIALS.SWATH_DATA ); WRITE ( COLOR_TYPE'image ( CURRENT_SPECIALS.SWATH_COLOR ) ); WRITE ( integer'image ( CURRENT_SPECIALS.SWATH_LAST ) ); WRITE ( CURRENT_SPECIALS.POINTS_DATA ); WRITE ( COLOR_TYPE'image ( CURRENT_SPECIALS.POINTS_COLOR ) ); WRITE ( integer'image ( CURRENT_SPECIALS.POINTS_LAST ) ); WRITE ( boolean'image ( CURRENT_DIAGS.WARNING ) ); WRITE ( boolean'image ( CURRENT_DIAGS.ERROR ) ); WRITE ( boolean'image ( CURRENT_DIAGS.FATAL ) ); WRITE ( CURRENT_PLOT_CHARACTERISTICS.AXIS_LENGTH.X ); WRITE ( CURRENT_PLOT_CHARACTERISTICS.AXIS_LENGTH.Y ); WRITE ( CURRENT_PLOT_CHARACTERISTICS.ORIGIN.X ); WRITE ( CURRENT_PLOT_CHARACTERISTICS.ORIGIN.Y ); exception when others => raise CONSTRAINT_ERROR; end WRITE_SESSION_CURRENTS; procedure READ_DISPLAY_DEFAULTS is begin READ ( DEFAULT_MAP_TITLE, LAST ); READ ( HOLD_STRING, LAST ); DEFAULT_TYPE_OF_PROJECTION := KIND_OF_PROJECTION'value ( HOLD_STRING ( 1 .. LAST ) ); READ ( DEFAULT_PROJECTION.LAT_CENTER ); READ ( DEFAULT_PROJECTION.LON_CENTER ); READ ( DEFAULT_PROJECTION.CLK_ROT_AR_CENT ); READ ( DEFAULT_PROJECTION.SAT_ALTITUDE ); READ ( DEFAULT_PROJECTION.VIEW_ALTITUDE ); READ ( HOLD_STRING, LAST ); DEFAULT_TYPE_OF_PROJECTION_LIMIT := KIND_OF_PROJECTION_LIMIT'value ( HOLD_STRING ( 1 .. LAST ) ); READ ( DEFAULT_PROJECTION_LIM.MIN_LAT_LON.X ); READ ( DEFAULT_PROJECTION_LIM.MIN_LAT_LON.Y ); READ ( DEFAULT_PROJECTION_LIM.MAX_LAT_LON.X ); READ ( DEFAULT_PROJECTION_LIM.MAX_LAT_LON.Y ); READ ( DEFAULT_PROJECTION_LIM.NORTH_EAST.X ); READ ( DEFAULT_PROJECTION_LIM.NORTH_EAST.Y ); READ ( DEFAULT_PROJECTION_LIM.SOUTH_WEST.X ); READ ( DEFAULT_PROJECTION_LIM.SOUTH_WEST.Y ); READ ( DEFAULT_PROJECTION_LIM.ANGLE_UP ); READ ( DEFAULT_PROJECTION_LIM.ANGLE_DOWN ); READ ( DEFAULT_PROJECTION_LIM.ANGLE_RIGHT ); READ ( DEFAULT_PROJECTION_LIM.ANGLE_LEFT ); READ ( DEFAULT_PROJECTION_LIM.POINT_UP.X ); READ ( DEFAULT_PROJECTION_LIM.POINT_UP.Y ); READ ( DEFAULT_PROJECTION_LIM.POINT_DOWN.X ); READ ( DEFAULT_PROJECTION_LIM.POINT_DOWN.Y ); READ ( DEFAULT_PROJECTION_LIM.POINT_RIGHT.X ); READ ( DEFAULT_PROJECTION_LIM.POINT_RIGHT.Y ); READ ( DEFAULT_PROJECTION_LIM.POINT_LEFT.X ); READ ( DEFAULT_PROJECTION_LIM.POINT_LEFT.Y ); READ ( HOLD_STRING, LAST ); DEFAULT_COLOR.BACKGROUND := COLOR_TYPE'value ( HOLD_STRING ( 1 .. LAST ) ); READ ( HOLD_STRING, LAST ); DEFAULT_COLOR.DEFAULT := COLOR_TYPE'value ( HOLD_STRING ( 1 .. LAST ) ); READ ( HOLD_STRING, LAST ); DEFAULT_COLOR.MAP_OUTLINE := COLOR_TYPE'value ( HOLD_STRING ( 1 .. LAST ) ); READ ( HOLD_STRING, LAST ); DEFAULT_COLOR.GRID_LINES := COLOR_TYPE'value ( HOLD_STRING ( 1 .. LAST ) ); READ ( HOLD_STRING, LAST ); DEFAULT_COLOR.HORIZON := COLOR_TYPE'value ( HOLD_STRING ( 1 .. LAST ) ); READ ( HOLD_STRING, LAST ); DEFAULT_GRID_LINES.SHOW_LINES := boolean'value ( HOLD_STRING ( 1 .. LAST ) ); READ ( DEFAULT_GRID_LINES.DEGREES_BTWN_LATS ); READ ( DEFAULT_GRID_LINES.DEGREES_BTWN_LONS ); READ ( DEFAULT_GRID_LINES.SEGMENT_LENGTH ); -- READ ( HOLD_STRING, LAST ); -- DEFAULT_CLIPPING := boolean'value ( HOLD_STRING ( 1 .. LAST ) ); READ ( HOLD_STRING, LAST ); DEFAULT_LAND := boolean'value ( HOLD_STRING ( 1 .. LAST ) ); exception when others => raise CONSTRAINT_ERROR; end READ_DISPLAY_DEFAULTS; procedure READ_SESSION_DEFAULTS is begin READ_DISPLAY_DEFAULTS; READ ( DEFAULT_SPECIALS.BEAM_DATA, LAST ); READ ( HOLD_STRING, LAST ); DEFAULT_SPECIALS.BEAM_COLOR := COLOR_TYPE'value ( HOLD_STRING ( 1 .. LAST ) ); READ ( HOLD_STRING, LAST ); DEFAULT_SPECIALS.BEAM_LAST := integer'value ( HOLD_STRING ( 1 .. LAST ) ); READ ( DEFAULT_SPECIALS.SWATH_DATA, LAST ); READ ( HOLD_STRING, LAST ); DEFAULT_SPECIALS.SWATH_COLOR := COLOR_TYPE'value ( HOLD_STRING ( 1 .. LAST ) ); READ ( HOLD_STRING, LAST ); DEFAULT_SPECIALS.SWATH_LAST := integer'value ( HOLD_STRING ( 1 .. LAST ) ); READ ( DEFAULT_SPECIALS.POINTS_DATA, LAST ); READ ( HOLD_STRING, LAST ); DEFAULT_SPECIALS.POINTS_COLOR := COLOR_TYPE'value ( HOLD_STRING ( 1 .. LAST ) ); READ ( HOLD_STRING, LAST ); DEFAULT_SPECIALS.POINTS_LAST := integer'value ( HOLD_STRING ( 1 .. LAST ) ); READ ( HOLD_STRING, LAST ); DEFAULT_DIAGS.WARNING := boolean'value ( HOLD_STRING ( 1 .. LAST ) ); READ ( HOLD_STRING, LAST ); DEFAULT_DIAGS.ERROR := boolean'value ( HOLD_STRING ( 1 .. LAST ) ); READ ( HOLD_STRING, LAST ); DEFAULT_DIAGS.FATAL := boolean'value ( HOLD_STRING ( 1 .. LAST ) ); READ ( DEFAULT_PLOT_CHARACTERISTICS.AXIS_LENGTH.X ); READ ( DEFAULT_PLOT_CHARACTERISTICS.AXIS_LENGTH.Y ); READ ( DEFAULT_PLOT_CHARACTERISTICS.ORIGIN.X ); READ ( DEFAULT_PLOT_CHARACTERISTICS.ORIGIN.Y ); exception when others => raise CONSTRAINT_ERROR; end READ_SESSION_DEFAULTS; end MENU_FILE_IO; --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: --worlddata.txt --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: package body WORLD_DATA_FILES is begin null; end WORLD_DATA_FILES; --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: --termfunct.txt --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: with TEXT_IO; package body TERM_FUNCTIONS is use TEXT_IO; C : character := ' '; BUF : string ( 1 .. 80 ) := ( 1 .. 80 => ' ' ); BUF_INDEX : integer := 1; package FLT_IO is new FLOAT_IO ( FLOAT ); procedure PUT_STRING ( ITEM : in string ) is begin PUT ( ITEM ( ITEM'first .. ITEM'last ) ); end PUT_STRING; procedure GET_CHAR ( ITEM : in out character ) is begin GET ( ITEM ); end GET_CHAR; procedure SET_TOP_AND_BOTTOM_MARGINS ( TOP, BOTTOM : in POSITIVE_NUMBER ) is TEMPTOP : constant string := integer'image ( TOP ); TEMPBOTTOM : constant string := integer'image ( BOTTOM ); begin PUT ( ASCII.ESC ); PUT ( "[" & TEMPTOP ( 2 .. TEMPTOP'last ) & ";" & TEMPBOTTOM ( 2 .. TEMPBOTTOM'last ) & "r" ); end SET_TOP_AND_BOTTOM_MARGINS; procedure SET_HOME is begin PUT ( ASCII.ESC ); PUT ( "[?6h" ); end SET_HOME; procedure RESET_HOME is begin PUT ( ASCII.ESC ); PUT ( "[?6l" ); end RESET_HOME; procedure POSITION_CURSOR ( ITEM : in CURSOR_POS ) is TEMPLINE : constant string := integer'image ( ITEM.LINE ); TEMPCOLUMN : constant string := integer'image ( ITEM.COLUMN ); begin PUT ( ASCII.ESC ); PUT ( "[" & TEMPLINE ( 2 .. TEMPLINE'last ) & ";" & TEMPCOLUMN ( 2 .. TEMPCOLUMN'last ) & "H" ); end POSITION_CURSOR; procedure CURSOR_HOME is begin PUT ( ASCII.ESC ); PUT ( "[H" ); end CURSOR_HOME; function PARSE_INPUT return TOKEN is TEMP : TOKEN := ALPHA_NUM; LEN : integer := 0; begin SET_LOCAL_ECHO; GET ( C ); if C = ' ' then TEMP := RETURN_KEY; elsif C = ascii.ht then TEMP := TAB; elsif C = ascii.bs then TEMP := BACK_SPACE; elsif C = ascii.esc then GET ( C ); GET ( C ); if C = 'A' then TEMP := UP_ARROW; elsif C = 'B' then TEMP := DOWN_ARROW; elsif C = 'C' then TEMP := RIGHT_ARROW; else TEMP := LEFT_ARROW; end if; end if; return TEMP; end PARSE_INPUT; function PARSED_CHAR return CHARACTER is begin return C; end PARSED_CHAR; procedure SET_132_COLUMNS_PER_LINE is begin PUT ( ASCII.ESC ); PUT ( "[?3h" ); end SET_132_COLUMNS_PER_LINE; procedure SET_80_COLUMNS_PER_LINE is begin PUT ( ASCII.ESC ); PUT ( "[?3l" ); end SET_80_COLUMNS_PER_LINE; procedure SET_LOCAL_ECHO is -- TURNS OFF WHAT YOU TYPE! begin PUT ( ASCII.ESC ); PUT ( "[12h" ); end SET_LOCAL_ECHO; procedure RESET_LOCAL_ECHO is -- Turns on what you type. begin PUT ( ASCII.ESC ); PUT ( "[12l" ); end RESET_LOCAL_ECHO; function STRING_FL ( ITEM : in string ) return float is VALR : float := 0.0; TEMP : positive := 15; begin FLT_IO.GET ( ITEM ( ITEM'first .. ITEM'last ), VALR, TEMP ); return VALR; end STRING_FL; function FL_STRING ( ITEM : in float ) return string is TEMP : string ( 1 .. 12 ) := ( 1 .. 12 => ' ' ); begin FLT_IO.PUT ( TEMP, ITEM ); return TEMP; end FL_STRING; procedure FILL ( CONSTRAIN : in integer ) is begin if C = ascii.BS then if BUF_INDEX /= 1 then BUF_INDEX := BUF_INDEX - 1; BUF ( BUF_INDEX ) := ' '; PUT ( C ); end if; elsif BUF_INDEX <= CONSTRAIN then BUF ( BUF_INDEX ) := C; BUF_INDEX := BUF_INDEX + 1; PUT ( C ); end if; end FILL; procedure FLUSH ( ITEM : out STRING; LAST : out integer ) is begin LAST := 0; if BUF_INDEX /= 1 then ITEM := BUF ( 1 .. ITEM'last ); LAST := BUF_INDEX - 1; if BUF_INDEX <= ITEM'last then PUT ( BUF ( BUF_INDEX .. ITEM'last ) ); -- BLANKS end if; BUF_INDEX := 1; BUF ( 1 .. BUF'last ) := ( 1 .. BUF'last => ' ' ); end if; end FLUSH; begin null; end TERM_FUNCTIONS; --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: --menutypes.txt --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: package body MENU_TYPES is begin null; end MENU_TYPES; --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: --menutext.txt --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: package body MENU_TEXT is begin null; end MENU_TEXT; --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: --menucurre.txt --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: package body MENU_CURRENTS is procedure SET_CURRENTS_FROM_DEFAULTS is begin CURRENT_TYPE_OF_PROJECTION := DEFAULT_TYPE_OF_PROJECTION; CURRENT_TYPE_OF_PROJECTION_LIMIT := DEFAULT_TYPE_OF_PROJECTION_LIMIT; CURRENT_MAP_TITLE := DEFAULT_MAP_TITLE; CURRENT_GRID_LINES := DEFAULT_GRID_LINES; CURRENT_COLOR := DEFAULT_COLOR; CURRENT_SPECIALS := DEFAULT_SPECIALS; CURRENT_PROJECTION := DEFAULT_PROJECTION; CURRENT_PROJECTION_LIM := DEFAULT_PROJECTION_LIM; CURRENT_PLOT_CHARACTERISTICS := DEFAULT_PLOT_CHARACTERISTICS; -- CURRENT_CLIPPING := DEFAULT_CLIPPING; CURRENT_LAND := DEFAULT_LAND; CURRENT_DIAGS := DEFAULT_DIAGS; end SET_CURRENTS_FROM_DEFAULTS; procedure SET_DEFAULTS_FROM_CURRENTS is begin DEFAULT_TYPE_OF_PROJECTION := CURRENT_TYPE_OF_PROJECTION; DEFAULT_TYPE_OF_PROJECTION_LIMIT := CURRENT_TYPE_OF_PROJECTION_LIMIT; DEFAULT_MAP_TITLE := CURRENT_MAP_TITLE; DEFAULT_GRID_LINES := CURRENT_GRID_LINES; DEFAULT_COLOR := CURRENT_COLOR; DEFAULT_SPECIALS := CURRENT_SPECIALS; DEFAULT_PROJECTION := CURRENT_PROJECTION; DEFAULT_PROJECTION_LIM := CURRENT_PROJECTION_LIM; DEFAULT_PLOT_CHARACTERISTICS := CURRENT_PLOT_CHARACTERISTICS; -- DEFAULT_CLIPPING := CURRENT_CLIPPING; DEFAULT_LAND := CURRENT_LAND; DEFAULT_DIAGS := CURRENT_DIAGS; end SET_DEFAULTS_FROM_CURRENTS; begin null; end MENU_CURRENTS; --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: --worldmenu.txt --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: with MENU_CURRENTS, MENU_PARSE, MENU_DRAW; package body WORLD_MENUS is use MENU_CURRENTS, MENU_TYPES, GRAPHIC, MENU_PARSE, MENU_DRAW; function END_OF_SESSION return boolean is begin return SESSION_TERMINATED; end END_OF_SESSION; function TYPE_OF_PROJECTION return KIND_OF_PROJECTION is begin return CURRENT_TYPE_OF_PROJECTION; end TYPE_OF_PROJECTION; function TYPE_OF_PROJECTION_LIMIT return KIND_OF_PROJECTION_LIMIT is begin return CURRENT_TYPE_OF_PROJECTION_LIMIT; end TYPE_OF_PROJECTION_LIMIT; -- function CLIPPING return boolean is -- begin -- return CURRENT_CLIPPING; -- end CLIPPING; function CURRENT_TITLE return MAP_TITLE is begin return CURRENT_MAP_TITLE; end CURRENT_TITLE; function CURRENT_PROJECTION_PARAMETERS return PROJECTION_PARAMETERS is begin return CURRENT_PROJECTION; end CURRENT_PROJECTION_PARAMETERS; function CURRENT_PROJECTION_LIMITS return PROJECTION_LIMITS is begin return CURRENT_PROJECTION_LIM; end CURRENT_PROJECTION_LIMITS; function CURRENT_GRID_LINE_PARAMETERS return GRID_LINE_PARAMETERS is begin return CURRENT_GRID_LINES; end CURRENT_GRID_LINE_PARAMETERS; function CURRENT_COLOR_SELECTION return COLOR_SELECTION is begin return CURRENT_COLOR; end CURRENT_COLOR_SELECTION; function CURRENT_SPECIAL_DISPLAYS return SPECIAL_DISPLAYS is begin return CURRENT_SPECIALS; end CURRENT_SPECIAL_DISPLAYS; function CURRENT_DIAGNOSTICS return DIAGNOSTICS is begin return CURRENT_DIAGS; end CURRENT_DIAGNOSTICS; function CURRENT_PLOT_CHAR return PLOT_CHARACTERISTICS is begin return CURRENT_PLOT_CHARACTERISTICS; end CURRENT_PLOT_CHAR; function PLOT_LAND return boolean is begin return CURRENT_LAND; end PLOT_LAND; function SHOW_GRID return boolean is begin return CURRENT_GRID_LINES.SHOW_LINES; end SHOW_GRID; function SHOW_BEAM return boolean is TEMP : boolean := false; begin if CURRENT_SPECIALS.BEAM_LAST /= 0 then TEMP := true; end if; return TEMP; end SHOW_BEAM; function SHOW_SWATH return boolean is TEMP : boolean := false; begin if CURRENT_SPECIALS.SWATH_LAST /= 0 then TEMP := true; end if; return TEMP; end SHOW_SWATH; procedure GENERATE_MENUS is MENU : MENUS := CURRENT_MENU; begin DRAW_MAP := false; loop case PARSE_COMMAND_LINE is when EDIT => EDIT; when CONTINUE => CONTINUE; when SAVE => SAVE; -- when HELP => -- HELP; when LEAVE => LEAVE; when QUIT => QUIT; -- when UNDO => -- UNDO; when SPECIAL => SPECIAL; -- when APPEND => -- APPEND; when OPENF => OPENF; when others => null; end case; exit when DRAW_MAP; end loop; end GENERATE_MENUS; procedure INITIALIZE is begin DRAW_MAP := FALSE; CURRENT_TYPE_OF_PROJECTION := CARTESIAN; CURRENT_TYPE_OF_PROJECTION_LIMIT := MIN_MAX_COORDINATES; DEFAULT_TYPE_OF_PROJECTION := CURRENT_TYPE_OF_PROJECTION; DEFAULT_TYPE_OF_PROJECTION_LIMIT := CURRENT_TYPE_OF_PROJECTION_LIMIT; for I in MAP_TITLE'range loop CURRENT_MAP_TITLE ( I ) := ' '; end loop; DEFAULT_MAP_TITLE := CURRENT_MAP_TITLE; SESSION_TERMINATED := false; CURRENT_GRID_LINES := ( SHOW_LINES => true, DEGREES_BTWN_LATS => 45.0, DEGREES_BTWN_LONS => 45.0, SEGMENT_LENGTH => 4.0 ); DEFAULT_GRID_LINES := CURRENT_GRID_LINES; CURRENT_COLOR := ( BACKGROUND => GRAPHIC.BLACK, DEFAULT => GRAPHIC.BLUE, MAP_OUTLINE => GRAPHIC.GREEN, GRID_LINES => GRAPHIC.RED, HORIZON => GRAPHIC.BLUE ); DEFAULT_COLOR := CURRENT_COLOR; CURRENT_SPECIALS := ( BEAM_DATA => " " & " " & " " & " ", BEAM_COLOR => GRAPHIC.BLUE, BEAM_LAST => 0, SWATH_DATA => " " & " " & " " & " ", SWATH_COLOR => GRAPHIC.RED, SWATH_LAST => 0, POINTS_DATA => "WORLDPTS.D" & "AT " & " " & " ", POINTS_COLOR => GRAPHIC.GREEN, POINTS_LAST => 12 ); DEFAULT_SPECIALS := CURRENT_SPECIALS; -- CURRENT_PROJECTION := ( KIND => SATELLITE, -- LAT_CENTER => 0.0, -- LON_CENTER => 0.0, -- CLK_ROT_AR_CENT => 0.0, -- SAT_ALTITUDE => 0.0, -- VIEW_ALTITUDE => 0.0 ); CURRENT_PROJECTION := ( LAT_CENTER => 0.0, LON_CENTER => 0.0, CLK_ROT_AR_CENT => 0.0, SAT_ALTITUDE => 0.0, VIEW_ALTITUDE => 0.0 ); DEFAULT_PROJECTION := CURRENT_PROJECTION; -- CURRENT_PROJECTION_LIM := ( KIND => MIN_MAX_LAT_LON, -- MIN_LAT_LON => ( X => 0.0, -- Y => 0.0 ), -- MAX_LAT_LON => ( X => 0.0, -- Y => 0.0 ) ); CURRENT_PROJECTION_LIM := ( MIN_LAT_LON => ( X => 0.0, Y => 0.0 ), MAX_LAT_LON => ( X => 0.0, Y => 0.0 ), NORTH_EAST => ( X => 50.0, Y => 330.0 ), SOUTH_WEST => ( X => 20.0, Y => 230.0 ), ANGLE_UP => 0.0, ANGLE_DOWN => 0.0, ANGLE_RIGHT => 0.0, ANGLE_LEFT => 0.0, POINT_UP => ( X => 0.0, Y => 0.0 ), POINT_DOWN => ( X => 0.0, Y => 0.0 ), POINT_RIGHT => ( X => 0.0, Y => 0.0 ), POINT_LEFT => ( X => 0.0, Y => 0.0 ) ); DEFAULT_PROJECTION_LIM := CURRENT_PROJECTION_LIM; STATUS := ( WARNING => false, ERROR => false, FATAL => false ); CURRENT_DIAGS := ( WARNING => true, ERROR => true, FATAL => true ); DEFAULT_DIAGS := CURRENT_DIAGS; -- CURRENT_CLIPPING := true; -- DEFAULT_CLIPPING := CURRENT_CLIPPING; CURRENT_LAND := true; DEFAULT_LAND := CURRENT_LAND; CURRENT_PLOT_CHARACTERISTICS := ( AXIS_LENGTH => ( X => 8.0, Y => 8.0 ), ORIGIN => ( X => 0.0, Y => 0.0 )); DEFAULT_PLOT_CHARACTERISTICS := CURRENT_PLOT_CHARACTERISTICS; CURRENT_SESSION_FILENAME := ( 1 .. 40 => ' ' ); CURRENT_DISPLAY_FILENAME := CURRENT_SESSION_FILENAME; INITIALIZE_MENUS; INITIALIZE_PARSE; end INITIALIZE; begin null; end WORLD_MENUS; --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: --menuconst.txt --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: package body MENU_CONSTANTS is TEMP_POS : TERM_FUNCTIONS.CURSOR_POS; procedure INC ( AMOUNT : in integer ) is begin TEMP_POS.COLUMN := TEMP_POS.COLUMN + AMOUNT + 2; end INC; function X_Y_POS_ALT ( ITEM : in FIELD_INDEX ) return TERM_FUNCTIONS.CURSOR_POS is begin TEMP_POS := ( LINE => X_Y_POS ( ITEM ).LINE, COLUMN => X_Y_POS ( ITEM ).COLUMN ); case ITEM is when CI0 => INC ( C0'length ); when CI1 => INC ( C1'length ); when CI2 => INC ( C2'length ); when CI3 => INC ( C3'length ); when CI4 => INC ( C4'length ); when CI5 => INC ( C5'length ); when CI6 => INC ( C6'length ); when CI7 => INC ( C7'length ); when CI8 => INC ( C8'length ); when CI9 => INC ( C9'length ); when CI10 => INC ( C10'length ); when CI11 => INC ( C11'length ); when CI12 => INC ( C12'length ); when CI13 => INC ( C13'length ); when CI14 => INC ( C14'length ); when CI15 => INC ( C15'length ); when CI16 => INC ( C16'length ); when CI17 => INC ( C17'length ); when CI18 => INC ( C18'length ); when CI19 => INC ( C19'length ); when CI20 => INC ( C20'length ); when CI21 => INC ( C21'length ); when CI22 => INC ( C22'length ); when CI23 => INC ( C23'length ); when CI24 => INC ( C24'length ); when CI25 => INC ( C25'length ); when CI26 => INC ( C26'length ); when CI27 => INC ( C27'length ); when CI28 => INC ( C28'length ); when CI29 => INC ( C29'length ); when CI30 => INC ( C30'length ); when CI31 => INC ( C31'length ); when CI3A => INC ( C3A'length ); when CI3B => INC ( C3B'length ); when CI32 => INC ( C32'length ); when CI33 => INC ( C33'length ); when CI34 => INC ( C34'length ); when CI35 => INC ( C35'length ); when CI3C => INC ( C3C'length ); -- when CI36 => -- INC ( C36'length ); when CI37 => INC ( C37'length ); when CI38 => INC ( C38'length ); when CI39 => INC ( C39'length ); when CI40 => INC ( C40'length ); when CI41 => INC ( C41'length ); when CI42 => INC ( C42'length ); when CI43 => INC ( C43'length ); when CI44 => INC ( C44'length ); when CI45 => INC ( C45'length ); when CI46 => INC ( C46'length ); when CI47 => INC ( C47'length ); when CI48 => INC ( C48'length ); when CI49 => INC ( C49'length ); when CI50 => INC ( C50'length ); when CI51 => INC ( C51'length ); when CI52 => INC ( C52'length ); when others => null; end case; return TEMP_POS; end X_Y_POS_ALT; end MENU_CONSTANTS; --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: --trigf.txt --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: with TEXT_IO; use TEXT_IO; with FLOATING_CHARACTERISTICS; use FLOATING_CHARACTERISTICS; with NUMERIC_PRIMITIVES; use NUMERIC_PRIMITIVES; with CORE_FUNCTIONS; use CORE_FUNCTIONS; package body TRIG_LIB is package INT_IO is new INTEGER_IO ( INTEGER ); package FLT_IO is new FLOAT_IO ( FLOAT ); use INT_IO, FLT_IO; -- PRELIMINARY VERSION ********************************* -- The following routines are coded directly from the algorithms and -- coeficients given in "Software Manual for the Elementry Functions" -- by William J. Cody, Jr. and William Waite, Prentice_Hall, 1980 -- This particular version is stripped to work with FLOAT and INTEGER -- and uses a mantissa represented as a FLOAT -- A more general formulation uses MANTISSA_TYPE, etc. -- The coeficients are appropriate for 25 to 32 bits floating significance -- They will work for less but slightly shorter versions are possible -- The routines are coded to stand alone so they need not be compiled together -- 16 JULY 1982 W A WHITAKER AFATL EGLIN AFB FL 32542 -- T C EICHOLTZ USAFA function SIN(X : FLOAT) return FLOAT is SGN, Y : FLOAT; N : INTEGER; XN : FLOAT; F, G, X1, X2 : FLOAT; RESULT : FLOAT; YMAX : FLOAT := FLOAT(INTEGER(PI * TWO**(IT/2))); BETA : FLOAT := CONVERT_TO_FLOAT(IBETA); epsilon : FLOAT := BETA ** (-IT/2); C1 : constant FLOAT := 3.140625; C2 : constant FLOAT := 9.6765_35897_93E-4; function R(G : FLOAT) return FLOAT is R1 : constant FLOAT := -0.16666_66660_883; R2 : constant FLOAT := 0.83333_30720_556E-2; R3 : constant FLOAT := -0.19840_83282_313E-3; R4 : constant FLOAT := 0.27523_97106_775E-5; R5 : constant FLOAT := -0.23868_34640_601E-7; begin return ((((R5*G + R4)*G + R3)*G + R2)*G + R1)*G; end R; begin if X < ZERO then SGN := -ONE; Y := -X; else SGN := ONE; Y := X; end if; if Y > YMAX then NEW_LINE; PUT(" SIN CALLED WITH ARGUMENT TOO LARGE FOR ACCURACY "); PUT(X); NEW_LINE; end if; N := INTEGER(Y * ONE_OVER_PI); XN := CONVERT_TO_FLOAT(N); if N mod 2 /= 0 then SGN := -SGN; end if; X1 := TRUNCATE(ABS(X)); X2 := ABS(X) - X1; F := ((X1 - XN*C1) + X2) - XN*C2; if ABS(F) < EPSILON then RESULT := F; else G := F * F; RESULT := F + F*R(G); end if; return (SGN * RESULT); end SIN; function COS(X : FLOAT) return FLOAT is SGN, Y : FLOAT; N : INTEGER; XN : FLOAT; F, G, X1, X2 : FLOAT; RESULT : FLOAT; YMAX : FLOAT := FLOAT(INTEGER(PI * TWO**(IT/2))); BETA : FLOAT := CONVERT_TO_FLOAT(IBETA); EPSILON : FLOAT := BETA ** (-IT/2); C1 : constant FLOAT := 3.140625; C2 : constant FLOAT := 9.6765_35897_93E-4; function R(G : FLOAT) return FLOAT is R1 : constant FLOAT := -0.16666_66660_883; R2 : constant FLOAT := 0.83333_30720_556E-2; R3 : constant FLOAT := -0.19840_83282_313E-3; R4 : constant FLOAT := 0.27523_97106_775E-5; R5 : constant FLOAT := -0.23868_34640_601E-7; begin return ((((R5*G + R4)*G + R3)*G + R2)*G + R1)*G; end R; begin SGN := 1.0; Y := ABS(X) + PI_OVER_TWO; if Y > YMAX then NEW_LINE; PUT(" COS CALLED WITH ARGUMENT TOO LARGE FOR ACCURACY "); PUT(X); NEW_LINE; end if; N := INTEGER(Y * ONE_OVER_PI); XN := CONVERT_TO_FLOAT(N); if N mod 2 /= 0 then SGN := -SGN; end if; XN := XN - 0.5; -- TO FORM COS INSTEAD OF SIN X1 := TRUNCATE(ABS(X)); X2 := ABS(X) - X1; F := ((X1 - XN*C1) + X2) - XN*C2; if ABS(F) < EPSILON then RESULT := F; else G := F * F; RESULT := F + F*R(G); end if; return (SGN * RESULT); end COS; function TAN(X : FLOAT) return FLOAT is SGN, Y : FLOAT; N : INTEGER; XN : FLOAT; F, G, X1, X2 : FLOAT; RESULT : FLOAT; YMAX : FLOAT := FLOAT(INTEGER(PI * TWO**(IT/2))) /2.0; BETA : FLOAT := CONVERT_TO_FLOAT(IBETA); EPSILON : FLOAT := BETA ** (-IT/2); C1 : constant FLOAT := 8#1.444#; C2 : constant FLOAT := 4.8382_67948_97E-4; function R(G : FLOAT) return FLOAT is P0 : constant FLOAT := 1.0; P1 : constant FLOAT := -0.11136_14403_566; P2 : constant FLOAT := 0.10751_54738_488E-2; Q0 : constant FLOAT := 1.0; Q1 : constant FLOAT := -0.44469_47720_281; Q2 : constant FLOAT := 0.15973_39213_300E-1; begin return ((P2*G + P1)*G*F + F) / (((Q2*G + Q1)*G +0.5) + 0.5); end R; begin Y := ABS(X); if Y > YMAX then NEW_LINE; PUT(" TAN CALLED WITH ARGUMENT TOO LARGE FOR ACCURACY "); PUT(X); NEW_LINE; end if; N := INTEGER(X * TWO_OVER_PI); XN := CONVERT_TO_FLOAT(N); X1 := TRUNCATE(X); X2 := X - X1; F := ((X1 - XN*C1) + X2) - XN*C2; if ABS(F) < EPSILON then RESULT := F; else G := F * F; RESULT := R(G); end if; if N mod 2 = 0 then return RESULT; else return -1.0/RESULT; end if; end TAN; function COT(X : FLOAT) return FLOAT is SGN, Y : FLOAT; N : INTEGER; XN : FLOAT; F, G, X1, X2 : FLOAT; RESULT : FLOAT; YMAX : FLOAT := FLOAT(INTEGER(PI * TWO**(IT/2))) /2.0; BETA : FLOAT := CONVERT_TO_FLOAT(IBETA); EPSILON : FLOAT := BETA ** (-IT/2); EPSILON1 : FLOAT := 1.0/XMAX; C1 : constant FLOAT := 8#1.444#; C2 : constant FLOAT := 4.8382_67948_97E-4; function R(G : FLOAT) return FLOAT is P0 : constant FLOAT := 1.0; P1 : constant FLOAT := -0.11136_14403_566; P2 : constant FLOAT := 0.10751_54738_488E-2; Q0 : constant FLOAT := 1.0; Q1 : constant FLOAT := -0.44469_47720_281; Q2 : constant FLOAT := 0.15973_39213_300E-1; begin return ((P2*G + P1)*G*F + F) / (((Q2*G + Q1)*G +0.5) + 0.5); end R; begin Y := ABS(X); if Y < EPSILON1 then NEW_LINE; PUT(" COT CALLED WITH ARGUMENT TOO NEAR ZERO "); PUT(X); NEW_LINE; if X < 0.0 then return -XMAX; else return XMAX; end if; end if; if Y > YMAX then NEW_LINE; PUT(" COT CALLED WITH ARGUMENT TOO LARGE FOR ACCURACY "); PUT(X); NEW_LINE; end if; N := INTEGER(X * TWO_OVER_PI); XN := CONVERT_TO_FLOAT(N); X1 := TRUNCATE(X); X2 := X - X1; F := ((X1 - XN*C1) + X2) - XN*C2; if ABS(F) < EPSILON then RESULT := F; else G := F * F; RESULT := R(G); end if; if N mod 2 /= 0 then return -RESULT; else return 1.0/RESULT; end if; end COT; function ASIN(X : FLOAT) return FLOAT is G, Y : FLOAT; RESULT : FLOAT; BETA : FLOAT := CONVERT_TO_FLOAT(IBETA); EPSILON : FLOAT := BETA ** (-IT/2); function R(G : FLOAT) return FLOAT is P1 : constant FLOAT := -0.27516_55529_0596E1; P2 : constant FLOAT := 0.29058_76237_4859E1; P3 : constant FLOAT := -0.59450_14419_3246; Q0 : constant FLOAT := -0.16509_93320_2424E2; Q1 : constant FLOAT := 0.24864_72896_9164E2; Q2 : constant FLOAT := -0.10333_86707_2113E2; Q3 : constant FLOAT := 1.0; begin return (((P3*G + P2)*G + P1)*G) / (((G + Q2)*G + Q1)*G + Q0); end R; begin Y := ABS(X); if Y > HALF then if Y > 1.0 then NEW_LINE; PUT(" ASIN CALLED FOR "); PUT(X); PUT(" (> 1) TRUNCATED TO 1, CONTINUED"); NEW_LINE; Y := 1.0; end if; G := ((0.5 - Y) + 0.5) / 2.0; Y := -2.0 * SQRT(G); RESULT := Y + Y * R(G); RESULT := (PI_OVER_FOUR + RESULT) + PI_OVER_FOUR; else if Y < EPSILON then RESULT := Y; else G := Y * Y; RESULT := Y + Y * R(G); end if; end if; if X < 0.0 then RESULT := -RESULT; end if; return RESULT; end ASIN; function ACOS(X : FLOAT) return FLOAT is G, Y : FLOAT; RESULT : FLOAT; BETA : FLOAT := CONVERT_TO_FLOAT(IBETA); EPSILON : FLOAT := BETA ** (-IT/2); function R(G : FLOAT) return FLOAT is P1 : constant FLOAT := -0.27516_55529_0596E1; P2 : constant FLOAT := 0.29058_76237_4859E1; P3 : constant FLOAT := -0.59450_14419_3246; Q0 : constant FLOAT := -0.16509_93320_2424E2; Q1 : constant FLOAT := 0.24864_72896_9164E2; Q2 : constant FLOAT := -0.10333_86707_2113E2; Q3 : constant FLOAT := 1.0; begin return (((P3*G + P2)*G + P1)*G) / (((G + Q2)*G + Q1)*G + Q0); end R; begin Y := ABS(X); if Y > HALF then if Y > 1.0 then NEW_LINE; PUT(" ACOS CALLED FOR "); PUT(X); PUT(" (> 1) TRUNCATED TO 1, CONTINUED"); NEW_LINE; Y := 1.0; end if; G := ((0.5 - Y) + 0.5) / 2.0; Y := -2.0 * SQRT(G); RESULT := Y + Y * R(G); if X < 0.0 then RESULT := (PI_OVER_TWO + RESULT) + PI_OVER_TWO; else RESULT := -RESULT; end if; else if Y < EPSILON then RESULT := Y; else G := Y * Y; RESULT := Y + Y * R(G); end if; if X < 0.0 then RESULT := (PI_OVER_FOUR + RESULT) + PI_OVER_FOUR; else RESULT := (PI_OVER_FOUR - RESULT) + PI_OVER_FOUR; end if; end if; return RESULT; end ACOS; function ATAN(X : FLOAT) return FLOAT is F, G : FLOAT; subtype REGION is INTEGER range 0..3; -- ########## N : REGION; RESULT : FLOAT; BETA : FLOAT := CONVERT_TO_FLOAT(IBETA); EPSILON : FLOAT := BETA ** (-IT/2); SQRT_3 : constant FLOAT := 1.73205_08075_68877_29353; SQRT_3_MINUS_1 : constant FLOAT := 0.73205_08075_68877_29353; TWO_MINUS_SQRT_3 : constant FLOAT := 0.26794_91924_31122_70647; function R(G : FLOAT) return FLOAT is P0 : constant FLOAT := -0.14400_83448_74E1; P1 : constant FLOAT := -0.72002_68488_98; Q0 : constant FLOAT := 0.43202_50389_19E1; Q1 : constant FLOAT := 0.47522_25845_99E1; Q2 : constant FLOAT := 1.0; begin return ((P1*G + P0)*G) / ((G + Q1)*G + Q0); end R; begin F := ABS(X); if F > 1.0 then F := 1.0 / F; N := 2; else N := 0; end if; if F > TWO_MINUS_SQRT_3 then F := (((SQRT_3_MINUS_1 * F - 0.5) - 0.5) + F) / (SQRT_3 + F); N := N + 1; end if; if ABS(F) < EPSILON then RESULT := F; else G := F * F; RESULT := F + F * R(G); end if; if N > 1 then RESULT := - RESULT; end if; case N is when 0 => RESULT := RESULT; when 1 => RESULT := PI_OVER_SIX + RESULT; when 2 => RESULT := PI_OVER_TWO + RESULT; when 3 => RESULT := PI_OVER_THREE + RESULT; end case; if X < 0.0 then RESULT := - RESULT; end if; return RESULT; end ATAN; function ATAN2(V, U : FLOAT) return FLOAT is X, RESULT : FLOAT; begin if U = 0.0 then if V = 0.0 then RESULT := 0.0; NEW_LINE; PUT(" ATAN2 CALLED WITH 0/0 RETURNED "); PUT(RESULT); NEW_LINE; elsif V > 0.0 then RESULT := PI_OVER_TWO; else RESULT := - PI_OVER_TWO; end if; else X := ABS(V/U); -- If underflow or overflow is detected, go to the exception RESULT := ATAN(X); if U < 0.0 then RESULT := PI - RESULT; end if; if V < 0.0 then RESULT := - RESULT; end if; end if; return RESULT; exception when NUMERIC_ERROR => if ABS(V) > ABS(U) then RESULT := PI_OVER_TWO; if V < 0.0 then RESULT := - RESULT; end if; else RESULT := 0.0; if U < 0.0 then RESULT := PI - RESULT; end if; end if; return RESULT; end ATAN2; function SINH(X : FLOAT) return FLOAT is G, W, Y, Z : FLOAT; RESULT : FLOAT; BETA : FLOAT := CONVERT_TO_FLOAT(IBETA); EPSILON : FLOAT := BETA ** (-IT/2); YBAR : FLOAT := EXP_LARGE; LN_V : FLOAT := 8#0.542714#; V_OVER_2_MINUS_1 : FLOAT := 0.13830_27787_96019_02638E-4; WMAX : FLOAT := YBAR - LN_V + 0.69; function R(G : FLOAT) return FLOAT is P0 : constant FLOAT := 0.10622_28883_7151E4; P1 : constant FLOAT := 0.31359_75645_6058E2; P2 : constant FLOAT := 0.34364_14035_8506; Q0 : constant FLOAT := 0.63733_73302_1822E4; Q1 : constant FLOAT := -0.13051_01250_9199E3; Q2 : constant FLOAT := 1.0; begin return (((P2*G + P1)*G + P0)*G) / ((G + Q1)*G + Q0); end R; begin Y := ABS(X); if Y <= 1.0 then if Y < EPSILON then RESULT := X; else G := X * X; RESULT := X + X * R(G); end if; else if Y <= YBAR then Z := EXP(Y); RESULT := (Z - 1.0/Z) / 2.0; else W := Y - LN_V; if W > WMAX then NEW_LINE; PUT(" SINH CALLED WITH TOO LARGE ARGUMENT "); PUT(X); PUT(" RETURN BIG"); NEW_LINE; W := WMAX; end if; Z := EXP(W); RESULT := Z + V_OVER_2_MINUS_1 * Z; end if; if X < 0.0 then RESULT := -RESULT; end if; end if; return RESULT; end SINH; function COSH(X : FLOAT) return FLOAT is G, W, Y, Z : FLOAT; RESULT : FLOAT; BETA : FLOAT := CONVERT_TO_FLOAT(IBETA); EPSILON : FLOAT := BETA ** (-IT/2); YBAR : FLOAT := EXP_LARGE; LN_V : FLOAT := 8#0.542714#; V_OVER_2_MINUS_1 : FLOAT := 0.13830_27787_96019_02638E-4; WMAX : FLOAT := YBAR - LN_V + 0.69; function R(G : FLOAT) return FLOAT is P0 : constant FLOAT := 0.10622_28883_7151E4; P1 : constant FLOAT := 0.31359_75645_6058E2; P2 : constant FLOAT := 0.34364_14035_8506; Q0 : constant FLOAT := 0.63733_73302_1822E4; Q1 : constant FLOAT := -0.13051_01250_9199E3; Q2 : constant FLOAT := 1.0; begin return (((P2*G + P1)*G + P0)*G) / ((G + Q1)*G + Q0); end R; begin Y := ABS(X); if Y <= YBAR then Z := EXP(Y); RESULT := (Z + 1.0/Z) / 2.0; else W := Y - LN_V; if W > WMAX then NEW_LINE; PUT(" COSH CALLED WITH TOO LARGE ARGUMENT "); PUT(X); PUT(" RETURN BIG"); NEW_LINE; W := WMAX; end if; Z := EXP(W); RESULT := Z + V_OVER_2_MINUS_1 * Z; end if; return RESULT; end COSH; function TANH(X : FLOAT) return FLOAT is G, W, Y, Z : FLOAT; RESULT : FLOAT; BETA : FLOAT := CONVERT_TO_FLOAT(IBETA); EPSILON : FLOAT := BETA ** (-IT/2); XBIG : FLOAT := (LOG(2.0) + CONVERT_TO_FLOAT(IT + 1) * LOG(BETA))/2.0; LN_3_OVER_2 : FLOAT := 0.54930_61443_34054_84570; function R(G : FLOAT) return FLOAT is P0 : constant FLOAT := -0.21063_95800_0245E2; P1 : constant FLOAT := -0.93363_47565_2401; Q0 : constant FLOAT := 0.63191_87401_5582E2; Q1 : constant FLOAT := 0.28077_65347_0471E2; Q2 : constant FLOAT := 1.0; begin return ((P1*G + P0)*G) / ((G + Q1)*G + Q0); end R; begin Y := ABS(X); if Y > XBIG then RESULT := 1.0; else if Y > LN_3_OVER_2 then RESULT := 0.5 - 1.0 / (EXP(Y + Y) + 1.0); RESULT := RESULT + RESULT; else if Y < EPSILON then RESULT := Y; else G := Y * Y; RESULT := Y + Y * R(G); end if; end if; end if; if X < 0.0 then RESULT := - RESULT; end if; return RESULT; end TANH; begin null; end TRIG_LIB; --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: --floatch.txt --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: with TEXT_IO; use TEXT_IO; package body FLOATING_CHARACTERISTICS is -- This package is a floating mantissa definition of a binary FLOAT A, B, Y, Z : FLOAT; I, K, MX, IZ : INTEGER; BETA, BETAM1, BETAIN : FLOAT; ONE : FLOAT := 1.0; ZERO : FLOAT := 0.0; procedure DEFLOAT(X : in FLOAT; N : out EXPONENT_TYPE; F : out MANTISSA_TYPE) is -- This is admittedly a slow method - but portable - for breaking down -- a floating point number into its exponent and mantissa -- Obviously with knowledge of the machine representation -- it could be replaced with a couple of simple extractions EXPONENT_LENGTH : INTEGER := IEXP; Q : MANTISSA_TYPE; M, L : EXPONENT_TYPE; W, Y, Z : FLOAT; begin L := 0; Q := 0.0; Y := ABS(X); if Y = 0.0 then return; elsif Y < 0.5 then for J in reverse 0..(EXPONENT_LENGTH - 2) loop -- Dont want to go all the way to 2.0**(EXPONENT_LENGTH - 1) -- Since that (or its reciprocal) will overflow if exponent biased -- Ought to use talbular values rather than compute each time M := EXPONENT_TYPE(2 ** J); Z := 1.0 / (2.0**M); W := Y / Z; if W < 1.0 then Y := W; L := L - M; end if; end loop; else for J in reverse 0..(EXPONENT_LENGTH - 2) loop M := EXPONENT_TYPE(2 ** J); Z := 2.0**M; W := Y / Z; if W >= 0.5 then Y := W; L := L + M; end if; end loop; -- And just to clear up any loose ends from biased exponents end if; while Y < 0.5 loop Y := Y * 2.0; L := L - 1; end loop; while Y >= 1.0 loop Y := Y / 2.0; L := L + 1; end loop; Q := MANTISSA_TYPE(Y); if X < 0.0 then Q := -Q; end if; N := L; F := Q; return; exception when others => N := 0; F := 0.0; return; end DEFLOAT; procedure REFLOAT(N : in EXPONENT_TYPE; F : in MANTISSA_TYPE; X : out FLOAT) is -- Again a brute force method - but portable -- Watch out near MAXEXP M : INTEGER; Y, Z : FLOAT; begin if F = 0.0 then Z := ZERO; X := Z; return; end if; M := INTEGER(N); Y := ABS(FLOAT(F)); while Y < 0.5 loop M := M - 1; if M < MINEXP then Z := ZERO; X := Z; end if; Y := Y + Y; exit when M <= MINEXP; end loop; if M = MAXEXP then M := M - 1; Z := Y * 2.0**M; Z := Z * 2.0; X := Z; elsif M <= MINEXP + 2 then M := M + 3; Z := Y * 2.0**M; Z := ((Z / 2.0) / 2.0) / 2.0; X := Z; else Z := Y * 2.0**M; X := Z; end if; if F < 0.0 then Z := -Z; X := Z; end if; return; end REFLOAT; function CONVERT_TO_FLOAT(K : INTEGER) return FLOAT is begin return FLOAT(K); end CONVERT_TO_FLOAT; -- function CONVERT_TO_FLOAT(N : EXPONENT_TYPE) return FLOAT is -- begin -- return FLOAT(N); -- end CONVERT_TO_FLOAT; function CONVERT_TO_FLOAT(F : MANTISSA_TYPE) return FLOAT is begin return FLOAT(F); end CONVERT_TO_FLOAT; begin PUT_LINE ( "BEGIN INITIALIZATION" ); IBETA := 2; IT := 23; IRND := 0; NGRD := 0; NEGEP := -24; MACHEP := -24; EPSNEG := FLOAT(IBETA) ** MACHEP; EPS := EPSNEG; MINEXP := -126; IEXP := 8; MAXEXP := 126; XMIN := FLOAT(IBETA) ** MINEXP; XMAX := FLOAT(IBETA) ** MAXEXP; PUT_LINE ("INITIALIZED"); NEW_LINE; end FLOATING_CHARACTERISTICS; --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: --coref.txt --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: with TEXT_IO; use TEXT_IO; with FLOATING_CHARACTERISTICS; use FLOATING_CHARACTERISTICS; with NUMERIC_PRIMITIVES; use NUMERIC_PRIMITIVES; package body CORE_FUNCTIONS is package FLT_IO is new FLOAT_IO ( FLOAT ); package INT_IO is new INTEGER_IO ( INTEGER ); use FLT_IO, INT_IO; -- The following routines are coded directly from the algorithms and -- coeficients given in "Software Manual for the Elementry Functions" -- by William J. Cody, Jr. and William Waite, Prentice_Hall, 1980 -- CBRT by analogy -- A more general formulation uses MANTISSA_TYPE, etc. -- The coeficients are appropriate for 25 to 32 bits floating significance -- They will work for less but slightly shorter versions are possible -- The routines are coded to stand alone so they need not be compiled together -- These routines have been coded to accept a general MANTISSA_TYPE -- That is, they are designed to work with a manitssa either fixed of float -- There are some explicit conversions which are required but these will -- not cause any extra code to be generated -- 16 JULY 1982 W A WHITAKER AFATL EGLIN AFB FL 32542 -- T C EICHOLTZ USAFA function SQRT(X : FLOAT) return FLOAT is M, N : EXPONENT_TYPE; F, Y : MANTISSA_TYPE; RESULT : FLOAT; subtype INDEX is INTEGER range 0..100; -- ######################### SQRT_L1 : INDEX := 3; -- Could get away with SQRT_L1 := 2 for 28 bits -- Using the better Cody-Waite coeficients overflows MANTISSA_TYPE SQRT_C1 : MANTISSA_TYPE := 8#0.3317777777#; SQRT_C2 : MANTISSA_TYPE := 8#0.4460000000#; SQRT_C3 : MANTISSA_TYPE := 8#0.55202_36314_77747_36311_0#; begin if X = ZERO then RESULT := ZERO; return RESULT; elsif X = ONE then -- To get exact SQRT(1.0) RESULT := ONE; return RESULT; elsif X < ZERO then NEW_LINE; PUT("CALLED SQRT FOR NEGATIVE ARGUMENT "); PUT(X); PUT(" USED ABSOLUTE VALUE"); NEW_LINE; RESULT := SQRT(ABS(X)); return RESULT; else DEFLOAT(X, N, F); Y := SQRT_C1 + MANTISSA_TYPE(SQRT_C2 * F); for J in 1..SQRT_L1 loop Y := Y/MANTISSA_DIVISOR_2 + MANTISSA_TYPE((F/MANTISSA_DIVISOR_2)/Y); end loop; if (N mod 2) /= 0 then Y := MANTISSA_TYPE(SQRT_C3 * Y); N := N + 1; end if; M := N/2; REFLOAT(M,Y,RESULT); return RESULT; end if; exception when others => NEW_LINE; PUT(" EXCEPTION IN SQRT, X = "); PUT(X); PUT(" RETURNED 1.0"); NEW_LINE; return ONE; end SQRT; function CBRT(X : FLOAT) return FLOAT is M, N : EXPONENT_TYPE; F, Y : MANTISSA_TYPE; RESULT : FLOAT; subtype INDEX is INTEGER range 0..100; -- ######################### CBRT_L1 : INDEX := 3; CBRT_C1 : MANTISSA_TYPE := 0.5874009; CBRT_C2 : MANTISSA_TYPE := 0.4125990; CBRT_C3 : MANTISSA_TYPE := 0.62996_05249; CBRT_C4 : MANTISSA_TYPE := 0.79370_05260; begin if X = ZERO then RESULT := ZERO; return RESULT; else DEFLOAT(X, N, F); F := ABS(F); Y := CBRT_C1 + MANTISSA_TYPE(CBRT_C2 * F); for J in 1 .. CBRT_L1 loop Y := Y - ( Y/MANTISSA_DIVISOR_3 - MANTISSA_TYPE((F/MANTISSA_DIVISOR_3) / MANTISSA_TYPE(Y*Y)) ); end loop; case (N mod 3) is when 0 => null; when 1 => Y := MANTISSA_TYPE(CBRT_C3 * Y); N := N + 2; when 2 => Y := MANTISSA_TYPE(CBRT_C4 * Y); N := N + 1; when others => null; end case; M := N/3; if X < ZERO then Y := -Y; end if; REFLOAT(M, Y, RESULT); return RESULT; end if; exception when others => RESULT := ONE; if X < ZERO then RESULT := - ONE; end if; NEW_LINE; PUT("EXCEPTION IN CBRT, X = "); PUT(X); PUT(" RETURNED "); PUT(RESULT); NEW_LINE; return RESULT; end CBRT; function LOG(X : FLOAT) return FLOAT is -- Uses fixed formulation for generality RESULT : FLOAT; N : EXPONENT_TYPE; XN : FLOAT; Y : FLOAT; F : MANTISSA_TYPE; Z, ZDEN, ZNUM : MANTISSA_TYPE; C0 : constant MANTISSA_TYPE := 0.20710_67811_86547_52440; -- SQRT(0.5) - 0.5 C1 : constant FLOAT := 8#0.543#; C2 : constant FLOAT :=-2.12194_44005_46905_82767_9E-4; function R(Z : MANTISSA_TYPE) return MANTISSA_TYPE is -- Use fixed formulation here because the float coeficents are > 1.0 -- and would exceed the limits on a MANTISSA_TYPE A0 : constant MANTISSA_TYPE := 0.04862_85276_587; B0 : constant MANTISSA_TYPE := 0.69735_92187_803; B1 : constant MANTISSA_TYPE :=-0.125; C : constant MANTISSA_TYPE := 0.01360_09546_862; begin return Z + MANTISSA_TYPE(Z * MANTISSA_TYPE(MANTISSA_TYPE(Z * Z) * (C + MANTISSA_TYPE(A0/(B0 + MANTISSA_TYPE(B1 * MANTISSA_TYPE(Z * Z))))))); end R; begin if X < ZERO then NEW_LINE; PUT("CALLED LOG FOR NEGATIVE "); PUT(X); PUT(" USE ABS => "); RESULT := LOG(ABS(X)); PUT(RESULT); NEW_LINE; elsif X = ZERO then NEW_LINE; PUT("CALLED LOG FOR ZERO ARGUMENT, RETURNED "); RESULT := -XMAX; -- SUPPOSED TO BE -LARGE PUT(RESULT); NEW_LINE; else DEFLOAT(X,N,F); ZNUM := F - MANTISSA_HALF; Y := CONVERT_TO_FLOAT(ZNUM); ZDEN := ZNUM / MANTISSA_DIVISOR_2 + MANTISSA_HALF; if ZNUM > C0 then Y := Y - MANTISSA_HALF; ZNUM := ZNUM - MANTISSA_HALF; ZDEN := ZDEN + MANTISSA_HALF/MANTISSA_DIVISOR_2; else N := N -1; end if; Z := MANTISSA_TYPE(ZNUM / ZDEN); RESULT := CONVERT_TO_FLOAT(R(Z)); if N /= 0 then XN := CONVERT_TO_FLOAT(N); RESULT := (XN * C2 + RESULT) + XN * C1; end if; end if; return RESULT; exception when others => NEW_LINE; PUT(" EXCEPTION IN LOG, X = "); PUT(X); PUT(" RETURNED 0.0"); NEW_LINE; return ZERO; end LOG; function LOG10(X : FLOAT) return FLOAT is LOG_10_OF_2 : constant FLOAT := CONVERT_TO_FLOAT(MANTISSA_TYPE(8#0.33626_75425_11562_41615#)); begin return LOG(X) * LOG_10_OF_2; end LOG10; function EXP(X : FLOAT) return FLOAT is RESULT : FLOAT; N : EXPONENT_TYPE; XG, XN, X1, X2 : FLOAT; F, G : MANTISSA_TYPE; BIGX : FLOAT := EXP_LARGE; SMALLX : FLOAT := EXP_SMALL; ONE_OVER_LOG_2 : constant FLOAT := 1.4426_95040_88896_34074; C1 : constant FLOAT := 0.69335_9375; C2 : constant FLOAT := -2.1219_44400_54690_58277E-4; function R(G : MANTISSA_TYPE) return MANTISSA_TYPE is Z , GP, Q : MANTISSA_TYPE; P0 : constant MANTISSA_TYPE := 0.24999_99999_9992; P1 : constant MANTISSA_TYPE := 0.00595_04254_9776; Q0 : constant MANTISSA_TYPE := 0.5; Q1 : constant MANTISSA_TYPE := 0.05356_75176_4522; Q2 : constant MANTISSA_TYPE := 0.00029_72936_3682; begin Z := MANTISSA_TYPE(G * G); GP := MANTISSA_TYPE( (MANTISSA_TYPE(P1 * Z) + P0) * G ); Q := MANTISSA_TYPE( (MANTISSA_TYPE(Q2 * Z) + Q1) * Z ) + Q0; return MANTISSA_HALF + MANTISSA_TYPE( GP /(Q - GP) ); end R; begin if X > BIGX then NEW_LINE; PUT(" EXP CALLED WITH TOO BIG A POSITIVE ARGUMENT, "); PUT(X); PUT(" RETURNED XMAX"); NEW_LINE; RESULT := XMAX; elsif X < SMALLX then NEW_LINE; PUT(" EXP CALLED WITH TOO BIG A NEGATIVE ARGUMENT, "); PUT(X); PUT(" RETURNED ZERO"); NEW_LINE; RESULT := ZERO; elsif ABS(X) < EPS then RESULT := ONE; else N := EXPONENT_TYPE(X * ONE_OVER_LOG_2); XN := CONVERT_TO_FLOAT(N); X1 := ROUND(X); X2 := X - X1; XG := ( (X1 - XN * C1) + X2 ) - XN * C2; G := MANTISSA_TYPE(XG); N := N + 1; F := R(G); REFLOAT(N, F, RESULT); end if; return RESULT; exception when others => NEW_LINE; PUT(" EXCEPTION IN EXP, X = "); PUT(X); PUT(" RETURNED 1.0"); NEW_LINE; return ONE; end EXP; function "**" (X, Y : FLOAT) return FLOAT is -- This is the last function to be coded since it appeared that it really -- was un-Ada-like and ought not be in the regular package -- Nevertheless it was included in this version -- It is specific for FLOAT and does not have the MANTISSA_TYPE generality M, N : EXPONENT_TYPE; G : MANTISSA_TYPE; P, TEMP, IW1, I : INTEGER; RESULT, Z, V, R, U1, U2, W, W1, W2, W3, Y1, Y2 : FLOAT; K : constant FLOAT := 0.44269_50408_88963_40736; IBIGX : constant INTEGER := INTEGER(TRUNCATE(16.0 * LOG(XMAX) - 1.0)); ISMALLX : constant INTEGER := INTEGER(TRUNCATE(16.0 * LOG(XMIN) + 1.0)); P1 : constant FLOAT := 0.83333_32862_45E-1; P2 : constant FLOAT := 0.12506_48500_52E-1; Q1 : constant FLOAT := 0.69314_71805_56341; Q2 : constant FLOAT := 0.24022_65061_44710; Q3 : constant FLOAT := 0.55504_04881_30765E-1; Q4 : constant FLOAT := 0.96162_06595_83789E-2; Q5 : constant FLOAT := 0.13052_55159_42810E-2; A1 : array (1 .. 17) of FLOAT:= ( 8#1.00000_0000#, 8#0.75222_5750#, 8#0.72540_3067#, 8#0.70146_3367#, 8#0.65642_3746#, 8#0.63422_2140#, 8#0.61263_4520#, 8#0.57204_2434#, 8#0.55202_3631#, 8#0.53254_0767#, 8#0.51377_3265#, 8#0.47572_4623#, 8#0.46033_7602#, 8#0.44341_7233#, 8#0.42712_7017#, 8#0.41325_3033#, 8#0.40000_0000# ); A2 : array (1 .. 8) of FLOAT := ( 8#0.00000_00005_22220_66302_61734_72062#, 8#0.00000_00003_02522_47021_04062_61124#, 8#0.00000_00005_21760_44016_17421_53016#, 8#0.00000_00007_65401_41553_72504_02177#, 8#0.00000_00002_44124_12254_31114_01243#, 8#0.00000_00000_11064_10432_66404_42174#, 8#0.00000_00004_72542_16063_30176_55544#, 8#0.00000_00001_74611_03661_23056_22556# ); function REDUCE (V : FLOAT) return FLOAT is begin return FLOAT(INTEGER(16.0 * V)) * 0.0625; end REDUCE; begin if X <= ZERO then if X < ZERO then RESULT := (ABS(X))**Y; NEW_LINE; PUT("X**Y CALLED WITH X = "); PUT(X); NEW_LINE; PUT("USED ABS, RETURNED "); PUT(RESULT); NEW_LINE; else if Y <= ZERO then if Y = ZERO then RESULT := ZERO; else RESULT := XMAX; end if; NEW_LINE; PUT("X**Y CALLED WITH X = 0, Y = "); PUT(Y); NEW_LINE; PUT("RETURNED "); PUT(RESULT); NEW_LINE; else RESULT := ZERO; end if; end if; else DEFLOAT(X, M, G); P := 1; if G <= A1(9) then P := 9; end if; if G <= A1(P+4) then P := P + 4; end if; if G <= A1(P+2) then P := P + 2; end if; Z := ((G - A1(P+1)) - A2((P+1)/2))/(G + A1(P+1)); Z := Z + Z; V := Z * Z; R := (P2 * V + P1) * V * Z; R := R + K * R; U2 := (R + Z * K) + Z; U1 := FLOAT(INTEGER(M) * 16 - P) * 0.0625; Y1 := REDUCE(Y); Y2 := Y - Y1; W := U2 * Y + U1 * Y2; W1 := REDUCE(W); W2 := W - W1; W := W1 + U1 * Y1; W1 := REDUCE(W); W2 := W2 + (W - W1); W3 := REDUCE(W2); IW1 := INTEGER(TRUNCATE(16.0 * (W1 + W3))); W2 := W2 - W3; if W > FLOAT(IBIGX) then RESULT := XMAX; PUT("X**Y CALLED X ="); PUT(X); PUT(" Y ="); PUT(Y); PUT(" TOO LARGE RETURNED "); PUT(RESULT); NEW_LINE; elsif W < FLOAT(ISMALLX) then RESULT := ZERO; PUT("X**Y CALLED X ="); PUT(X); PUT(" Y ="); PUT(Y); PUT(" TOO SMALL RETURNED "); PUT(RESULT); NEW_LINE; else if W2 > ZERO then W2 := W2 - 0.0625; IW1 := IW1 + 1; end if; if IW1 < INTEGER(ZERO) then I := 0; else I := 1; end if; M := EXPONENT_TYPE(I + IW1/16); P := 16 * INTEGER(M) - IW1; Z := ((((Q5 * W2 + Q4) * W2 + Q3) * W2 + Q2) * W2 + Q1) * W2; Z := A1(P+1) + (A1(P+1) * Z); REFLOAT(M, Z, RESULT); end if; end if; return RESULT; end "**"; begin EXP_LARGE := LOG(XMAX) * (ONE - EPS); EXP_SMALL := LOG(XMIN) * (ONE - EPS); end CORE_FUNCTIONS; --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: --numpr.txt --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: with FLOATING_CHARACTERISTICS; use FLOATING_CHARACTERISTICS; package body NUMERIC_PRIMITIVES is function SIGN(X, Y : FLOAT) return FLOAT is -- Returns the value of X with the sign of Y begin if Y >= 0.0 then return X; else return -X; end if; end SIGN; function MAX(X, Y : FLOAT) return FLOAT is begin if X >= Y then return X; else return Y; end if; end MAX; function TRUNCATE(X : FLOAT) return FLOAT is -- Optimum code depends on how the system rounds at exact halves begin if FLOAT(INTEGER(X)) = X then return X; end if; if X > ZERO then return FLOAT(INTEGER(X - HALF)); elsif X = ZERO then return ZERO; else return FLOAT(INTEGER(X + HALF)); end if; end TRUNCATE; function ROUND(X : FLOAT) return FLOAT is begin return FLOAT(INTEGER(X)); end ROUND; package KEY is X : INTEGER := 10_001; Y : INTEGER := 20_001; Z : INTEGER := 30_001; end KEY; function RAN return FLOAT is -- This rectangular random number routine is adapted from a report -- "A Pseudo-Random Number Generator" by B. A. Wichmann and I. D. Hill -- NPL Report DNACS XX (to be published) -- In this stripped version, it is suitable for machines supporting -- INTEGER at only 16 bits and is portable in Ada W : FLOAT; begin KEY.X := 171 * (KEY.X mod 177 - 177) - 2 * (KEY.X / 177); if KEY.X < 0 then KEY.X := KEY.X + 30269; end if; KEY.Y := 172 * (KEY.Y mod 176 - 176) - 35 * (KEY.Y / 176); if KEY.Y < 0 then KEY.Y := KEY.Y + 30307; end if; KEY.Z := 170 * (KEY.Z mod 178 - 178) - 63 * (KEY.Z / 178); if KEY.Z < 0 then KEY.Z := KEY.Z + 30323; end if; -- CONVERT_TO_FLOAT is used instead of FLOAT since the floating -- type may be software defined W := CONVERT_TO_FLOAT(KEY.X)/30269.0 + CONVERT_TO_FLOAT(KEY.Y)/30307.0 + CONVERT_TO_FLOAT(KEY.Z)/30323.0; return W - CONVERT_TO_FLOAT(INTEGER(W - 0.5)); end RAN; begin PI := CONVERT_TO_FLOAT(INTEGER(3)) + CONVERT_TO_FLOAT(MANTISSA_TYPE(0.14159_26535_89793_23846)); ONE_OVER_PI := CONVERT_TO_FLOAT(MANTISSA_TYPE(0.31830_98861_83790_67154)); TWO_OVER_PI := CONVERT_TO_FLOAT(MANTISSA_TYPE(0.63661_97723_67581_34308)); PI_OVER_TWO := CONVERT_TO_FLOAT(INTEGER(1)) + CONVERT_TO_FLOAT(MANTISSA_TYPE(0.57079_63267_94896_61923)); PI_OVER_THREE := CONVERT_TO_FLOAT(INTEGER(1)) + CONVERT_TO_FLOAT(MANTISSA_TYPE(0.04719_75511_96597_74615)); PI_OVER_FOUR := CONVERT_TO_FLOAT(MANTISSA_TYPE(0.78539_81633_97448_30962)); PI_OVER_SIX := CONVERT_TO_FLOAT(MANTISSA_TYPE(0.52359_87755_98298_87308)); end NUMERIC_PRIMITIVES; --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: --worldmap.txt --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: with Graphic, Core_Functions, Trig_Lib, Numeric_Primitives, World_Menus, Menu_Draw, World_Data_Files; use Graphic, Core_Functions, Trig_Lib, Numeric_Primitives, World_Menus, Menu_types; package body World_Map is procedure Draw_Map is -- Draw the map defined by the World_Menus package. type Beam_Or_Symbol is (Map_Data, Beam_Data, Symbol_Data); Eps : constant float := 1.0E-7; -- Small number used to avoid divide by zero errors. Way_Out : constant float := 1.0E+8; -- A location always off the screen. Radians_Per_Degree : constant float := 0.0174532925; Degrees_Per_Radian : constant float := 57.295779510; Max_Points : constant := 400; type Float_Array is array (1..Max_Points) of float; Map_Color : constant Color_Selection := World_Menus.Current_Color_Selection; Limit_Type : constant Kind_Of_Projection_Limit := Type_Of_Projection_Limit; Projection : Kind_Of_Projection := Type_Of_Projection; Proj_Params : Projection_Parameters; Specials : constant Special_Displays := Current_Special_Displays; Max_Line : float; -- The longest allowable line on the screen. Phio : float; -- The longitude center of the projection. Symbol : integer;-- The symbol to be used 1 --> Square -- 2 --> Plus -- 3 --> Diamond -- 4 --> Triangle Symbol_Size : float; -- The size of the symbol to be drawn is Symbol_Scale: constant float := 100.0; -- <window width> / Symbol_Scale. Lon_Pic_Min, Lon_Pic_Max, -- The min's and max's of the viewport Lat_Pic_Min, -- used to avoid plotting points that cannot Lat_Pic_Max : float; -- possibly be visible. SinO, CosO, -- Sin and Cos of the center of the projection SinR, CosR : float; -- Sin and Cos of the rotation Umin, Umax, -- The basis for determining the windowing Vmin, -- of the Viewport. Vmax : float; Caught_Error : exception; function Sat_Scale(Alt, Ref_Alt : float) return float is -- Finds scale for satellite view. Earth_Radius : constant float := 3443.9336; F, H, Alfa, Beta : float; begin if Alt <= 0.0 then Menu_Draw.Draw_Error_Port("Invalid Satellite Altitude.", "Plot aborted."); raise Caught_Error; elsif Ref_Alt <= 0.0 then Menu_Draw.Draw_Error_Port("Invalid Satellite Reference Altitude.", "Plot aborted."); raise Caught_Error; end if; F := Ref_Alt / Earth_Radius; H := Alt / Earth_Radius; Beta := ASin(1.0 / (1.0 + H)); Alfa := ASin(1.0 / (1.0 + F)); F := Tan(Beta) / Tan(Alfa); return F / (H * Beta); end Sat_Scale; procedure Project(Lat, Lon : in float; U, V : out float) is -- Sets up the calls to the various projection algorithms. -- The point (Lat, Lon) is input in degrees and is transformed -- to (U, V) in the mapping coordinates according to the kind -- of projection. R, H, SinA, CosA, SinB, CosB, SinPH, CosPH, SinLat, CosLat : float; Del_Lon : float; function Calc_Del_Lon(Lon : float) return float is -- Offsets Lon by the center of the projection adjusting for wraparound. Del_Lon : float; begin Del_Lon := Lon - Phio; if Del_Lon >= 180.0 then Del_Lon := Del_Lon - 360.0; elsif Del_Lon < -180.0 then Del_Lon := Del_Lon + 360.0; end if; return Del_Lon; end Calc_Del_Lon; procedure Do_Trig_Calculations is begin SinPH := Sin(Del_Lon * Radians_Per_Degree); CosPH := Cos(Del_Lon * Radians_Per_Degree); SinLat := Sin( Lat * Radians_Per_Degree); CosLat := Cos( Lat * Radians_Per_Degree); CosA := SinLat*SinO + CosLat*CosO*CosPH; if abs(CosA) > 1.0 then CosA := Sign(1.0, CosA); end if; SinA := Sqrt( 1.0 + Eps - CosA*CosA); SinB := CosLat * SinPH / SinA; CosB := (SinLat*CosO - CosLat*SinO*CosPH) / SinA; end Do_Trig_Calculations; procedure Cylin(Lat, Lon : in float; U, V : out float) is -- This is a cylindrcal projection routine. -- Point (Lat, Lon) is transformed to mapping coordinates (U, V). Out_Of_Range : exception; begin Del_Lon := Calc_Del_Lon(Lon); if Proj_Params.Lat_Center = 0.0 then Case Projection is when Cartesian => U := Del_Lon; V := Lat; when Mercator => U := Del_Lon * Radians_Per_Degree; V := Log( Tan(0.00872664*(Lat+90.0001)) ); when others => null; end case; else Do_Trig_Calculations; Case Projection is when Cartesian => if abs(1.0 - CosA*CosA) < 1.0E-4 then raise Out_Of_Range; end if; U := ATan2(SinB*CosR + CosB*SinR, SinB*SinR - CosB*CosR) * Degrees_Per_Radian; V := 90.0 - ACos(CosA)*Degrees_Per_Radian; when Mercator => if abs(1.0 - CosA*CosA) < 2.0E-6 then raise Out_Of_Range; end if; U := ATan2(SinB*CosR + CosB*SinR, SinB*SinR - CosB*CosR); V := Log( (1.0+CosA) / SinA); when others => null; end case; end if; exception when Out_Of_Range => U := Way_Out; V := Way_Out; end Cylin; procedure Azim(Lat, Lon : in float; U, V : out float) is -- This is an Azimuthal projection routine. -- Point (Lat, Lon) is transformed to mapping coordinates (U, V). R, H : float; Out_Of_Range : exception; begin -- Azim Del_Lon := Calc_Del_Lon(Lon); Do_Trig_Calculations; case Projection is when Stereographic => R := (1.0 - CosA) / SinA; when Gnomonic => null; if CosA <= 0.0 then raise Out_Of_Range; end if; R := SinA / CosA; when Lambert => if abs(CosA+1.0) < 1.0E-6 then raise Out_Of_Range; end if; R := (1.0 + CosA) / SinA; R := 2.0 / (Sqrt(1.0 + R*R)); when Orthographic => if CosA <= 0.0 then raise Out_Of_Range; end if; R := SinA; when Satellite => H := Proj_Params.Sat_Altitude / 3444.0; if (CosA - 1.0/(H+1.0)) <= 0.0 then raise Out_Of_Range; end if; R := Sat_Scale(Proj_Params.Sat_Altitude, Proj_Params.View_Altitude) * H * ATan( SinA / (H+1.0-CosA)); when Azimuthal => null; if abs(CosA+1.0) < 1.0E-6 then raise Out_Of_Range; end if; R := ACos(CosA); when others => null; end case; U := R * (SinB*CosR + CosB*SinR); V := R * (CosB*CosR - SinB*SinR); exception when Out_Of_Range => U := Way_Out; V := Way_Out; end Azim; begin -- Project case Projection is when Cartesian | Mercator => Cylin(Lat, Lon, U, V); when others => Azim(Lat, Lon, U, V); end case; end Project; procedure Initialize_Plot is -- Sets Umin, Umax, Vmin, and Vmax. In other words, it determines -- the minimums and maximums of the viewing of the projection. -- These four variables are what determine the "zooming" characteristics. Limits : constant Projection_Limits := World_Menus.Current_Projection_Limits; Phia : float; -- the latitude center of the projection. SinO1, CosO1 : float; procedure Do_All_Earth is -- Set limits to see as much of the earth is possible for this projection. begin case Projection is when Stereographic | Gnomonic | Lambert => Umin := -2.0; Umax := 2.0; Vmin := -2.0; Vmax := 2.0; when Orthographic | Satellite => Umin := -1.0; Umax := 1.0; Vmin := -1.0; Vmax := 1.0; when Azimuthal | Mercator => Umin := -180.0 * Radians_Per_Degree; Umax := -Umin; Vmin := Umin * 0.9; Vmax := Umax; when Cartesian => Umin := -180.0; Umax := 180.0; Vmin := -90.0; Vmax := 90.0; end case; end Do_All_Earth; procedure Force_In_Bounds(Umin, Umax, Vmin, Vmax : in out float) is -- Given a projection such as orthographic, not all of the points can -- can be plotted for a given projection because they will be on the -- other side of the globe. The user may zoom in by giving limits -- where some of them are on the other side of the globe. -- This routine adjusts to limits which are not visible by adjusting -- the limit to be on the horizon or the line between visibility and -- invisibility. begin if Umin >= Way_Out then case Projection is when Stereographic | Gnomonic | Lambert => Umin := -2.0; when Orthographic | Satellite => Umin := -1.0; when Azimuthal | Mercator => Umin := -180.0 * Radians_Per_Degree; when Cartesian => Umin := -180.0; end case; end if; if Umax >= Way_Out then case Projection is when Stereographic | Gnomonic | Lambert => Umax := 2.0; when Orthographic | Satellite => Umax := 1.0; when Azimuthal | Mercator => Umax := 180.0 * Radians_Per_Degree; when Cartesian => Umax := 180.0; end case; end if; if Vmin >= Way_Out then case Projection is when Stereographic | Gnomonic | Lambert => Vmin := -2.0; when Orthographic | Satellite => Vmin := -1.0; when Azimuthal | Mercator => Vmin := -180.0 * Radians_Per_Degree; when Cartesian => Vmin := -90.0; end case; end if; if Vmax >= Way_Out then case Projection is when Stereographic | Gnomonic | Lambert => Vmax := 2.0; when Orthographic | Satellite => Vmax := 1.0; when Azimuthal | Mercator => Vmax := 180.0 * Radians_Per_Degree; when Cartesian => Vmax := 90.0; end case; end if; end Force_In_Bounds; procedure Do_Min_Max_Lat_Lon is -- Limits are defined by min/max latitudes and min/max longitudes. U1, V1, U2, V2 : float; function Max(X, Y : float) return float is begin if X > Y then return X; else return Y; end if; end Max; function Min(X, Y : float) return float is begin if X > Y then return Y; else return X; end if; end Min; begin -- Do_Min_Max_Lat_Lon Lat_Pic_Min := Limits.Min_Lat_Lon.Y; Lat_Pic_Max := Limits.Max_Lat_Lon.Y; Lon_Pic_Min := Limits.Min_Lat_Lon.X; Lon_Pic_Max := Limits.Max_Lat_Lon.X; Project(Lat_Pic_Min, Lon_Pic_Min, U1, V1); Project(Lat_Pic_Max, Lon_Pic_Min, U2, V2); Force_In_Bounds(U1, V1, U2, V2); Vmin := Min(V1, V2); Vmax := Max(V1, V2); Umin := Min(U1, U2); Umax := Max(U1, U2); end Do_Min_Max_Lat_Lon; procedure Do_Min_Max_Coordinates is -- Limits are defined by two points of a rectangle, one in the upper -- right corner and one in the lower left corner. TUmin, TVmin, TUmax, TVmax : float; function Map(Val, Max_Val : float) return float is begin if Val > Max_Val then return Val - 2.0*Max_Val; else return Val; end if; end Map; begin -- Do_Min_Max_Coordinates Lon_Pic_Min := Map(Limits.South_West.X, 180.0); Lon_Pic_Max := Map(Limits.North_East.X, 180.0); Lat_Pic_Min := Map(Limits.South_West.Y, 90.0); Lat_Pic_Max := Map(Limits.North_East.Y, 90.0); Project(Lat_Pic_Min, Lon_Pic_Min, TUmin, TVmin); Project(Lat_Pic_Max, Lon_Pic_Max, TUmax, TVmax); Force_In_Bounds(TUmin, TUmax, TVmin, TVmax); Umin := TUmin; Vmin := TVmin; Umax := TUmax; Vmax := TVmax; end Do_Min_Max_Coordinates; procedure Do_Angular is -- Limits are determined by earth central angles. TUmin : float := Limits.Angle_Left; TUmax : float := Limits.Angle_Right; TVmin : float := Limits.Angle_Down; TVmax : float := Limits.Angle_Up; CosUmin : constant float := Cos(TUmin * Radians_Per_Degree); SinUmin : constant float := Sqrt(1.0 + Eps - CosUmin*CosUmin); CosUmax : constant float := Cos(TUmax * Radians_Per_Degree); SinUmax : constant float := Sqrt(1.0 + Eps - CosUmax*CosUmax); CosVmin : constant float := Cos(TVmin * Radians_Per_Degree); SinVmin : constant float := Sqrt(1.0 + Eps - CosVmin*CosVmin); CosVmax : constant float := Cos(TVmax * Radians_Per_Degree); SinVmax : constant float := Sqrt(1.0 + Eps - CosVmax*CosVmax); Bad_Limits : exception; begin case Projection is when Stereographic => Umin := -(1.0 - CosUmin) / SinUmin; Umax := (1.0 - CosUmax) / SinUmax; Vmin := -(1.0 - CosVmin) / SinVmin; Umax := (1.0 - CosUmax) / SinUmax; when Orthographic => if TUmin > 90.0 or TUmax > 90.0 or TVmin > 90.0 or TUmax > 90.0 then raise Bad_Limits; end if; Umin := -SinUmin; Umax := SinUmax; Vmin := -SinVmin; Vmax := SinVmax; when Gnomonic => if TUmin >= 90.0 or TUmax >= 90.0 or TVmin >= 90.0 or TUmax >= 90.0 then raise Bad_Limits; end if; Umin := -SinUmin / CosUmin; Umax := SinUmax / CosUmax; Vmin := -SinVmin / CosVmin; Vmax := SinVmax / CosVmax; when Lambert => TUmin := (1.0 + CosUmin) / SinUmin; Umin := -2.0 / Sqrt(1.0 + TUmin*TUmin); TUmax := (1.0 + CosUmax) / SinUmax; Umax := 2.0 / Sqrt(1.0 + TUmax*TUmax); TVmin := (1.0 + CosVmin) / SinVmin; Vmin := -2.0 / Sqrt(1.0 + TVmin*TVmin); TVmax := (1.0 + CosVmax) / SinVmax; Vmax := 2.0 / Sqrt(1.0 + TVmax*TVmax); when Azimuthal => Umin := -TUmin * Radians_Per_Degree; Umax := TUmax * Radians_Per_Degree; Vmin := -TVmin * Radians_Per_Degree; Vmax := TVmax * Radians_Per_Degree; when Cartesian => Umin := -TUmin; Umax := TUmax; Vmin := -TVmin; Vmax := TVmax; when Mercator => if TVmin >= 90.0 or TUmax >= 90.0 then raise Bad_Limits; end if; Umin := -TUmin * Radians_Per_Degree; Umax := TUmax * Radians_Per_Degree; Vmin := -Log((1.0+SinVmin) / CosVmin); Vmax := Log((1.0+SinVmax) / CosVmax); when Satellite => Umin := -1.0; Umax := 1.0; Vmin := -1.0; Vmax := 1.0; end case; exception when Bad_Limits => Menu_Draw.Draw_Error_Port("Angular limits too great.", "Plot aborted."); raise Caught_Error; end Do_Angular; procedure Do_Lat_Lon_Boundary is -- Limits are determined by four points, one on each of the four -- sides of a rectangle. U1, V1, U2, V2, U3, V3, U4, V4 : float; begin Lat_Pic_Min := Limits.Point_Down.Y; Lat_Pic_Max := Limits.Point_Up.Y; Lon_Pic_Min := Limits.Point_Left.X; Lon_Pic_Max := Limits.Point_Right.X; Project(Limits.Point_Left.Y, Lon_Pic_Min, U1, V1); Project(Lat_Pic_Min, Limits.Point_Down.X, U2, V2); Project(Limits.Point_Right.Y, Lon_Pic_Max, U3, V3); Project(Lat_Pic_Max, Limits.Point_Up.X, U4, V4); Force_In_Bounds(U1, U3, V2, V4); Umin := U1; Umax := U3; Vmin := V2; Vmax := V4; end Do_Lat_Lon_Boundary; procedure Do_Off_Center_Latitude is -- Set up for projections with centers off Latitude 0.0. begin case Projection is when Cartesian | Mercator => if Phia = 0.0 and Proj_Params.Clk_Rot_Ar_Cent = 0.0 then SinO := 1.0; CosO := 0.0; SinR := 0.0; CosR := 1.0; elsif Phia = 0.0 and abs(Proj_Params.Clk_Rot_Ar_Cent) = 180.0 then Phio := Phio + 180.0; SinO := -1.0; CosO := 0.0; SinR := 0.0; CosR := 1.0; else SinO1 := CosO*CosR; CosO1 := Sqrt(1.0 + Eps - SinO1*SinO1); Phio := Phio - ATan2(SinR/CosO1, -CosR*SinO/CosO1) * Degrees_Per_Radian; SinR := SinR * CosO/CosO1; CosR := -SinO/CosO1; SinO := SinO1; CosO := CosO1; end if; when others => null; end case; end Do_Off_Center_Latitude; procedure Set_Scaling is -- Sets the windowing of the viewport. -- Also determines the maximum line to be drawn to avoid wraparound problems. -- Also determines the size of the symbols to be drawn. X_Max : constant float := 17.0; -- Maximum these can ever be under Y_Max : constant float := 11.0; -- any circumstances. Scale : constant Plot_Characteristics := World_Menus.Current_Plot_Char; Delta_U, Delta_V : float; Left, Bottom, Right, Top: float; begin Delta_U := abs(Umax - Umin); Delta_V := abs(Vmax - Vmin); if Delta_U*0.6 > Delta_V then Left := Umin; Right := Umax; Top := (Vmin + Vmax) / 2.0; Bottom := Top; Symbol_Size := (Right - Left) * 0.6 / Symbol_Scale; else Top := Vmax; Bottom := Vmin; Left := (Umin + Umax) / 2.0; Right := Left; Symbol_Size := (Top - Bottom) / Symbol_Scale; end if; -- Set View_Port here Set_Window(Left, Bottom, Right, Top); -- calculate the length of a 30 degree line at the center of the projection Project(0.0, Proj_Params.Lon_Center-15.0, Left, Top); Project(0.0, Proj_Params.Lon_Center+15.0, Right, Top); -- Make that the maximum length line drawable Max_Line := abs(Right - Left); end Set_Scaling; begin -- Initialize_Plot Lat_Pic_Max := 90.0; Lat_Pic_Min := -90.0; Lon_Pic_Max := 180.0; Lon_Pic_Min := -180.0; Phia := Proj_Params.Lat_Center; Phio := Proj_Params.Lon_Center; SinR := Sin(Proj_Params.Clk_Rot_Ar_Cent * Radians_Per_Degree); CosR := Cos(Proj_Params.Clk_Rot_Ar_Cent * Radians_Per_Degree); SinO := Sin(Phia * Radians_Per_Degree); CosO := Cos(Phia * Radians_Per_Degree); Do_Off_Center_Latitude; case Type_Of_Projection_Limit is when All_Earth => Do_All_Earth; when Min_Max_Lat_Lon => Do_Min_Max_Lat_Lon; when Min_Max_Coordinates => Do_Min_Max_Coordinates; when Angular_Dist_From_Projection_Center => Do_Angular; when Lat_Lon_Boundary => Do_Lat_Lon_Boundary; end case; Set_Scaling; end Initialize_Plot; procedure Graff(NPts : in integer; U, V : in Float_Array; Mode : in integer) is -- Plots arrays NPts points from U and V. -- Mode : 1 - Line plot -- 2 - Point plot -- 3 - connect every other point (for grids) Line_Mode : constant := 1; Point_Mode : constant := 2; Dash_Mode : constant := 3; Even : boolean := true; procedure Square(Center_X, Center_Y, Size : in float) is Half_Size : constant float := Size / 2.0; begin Move_To(Center_X + Half_Size, Center_Y + Half_Size); Line( Size, 0.0); Line(0.0, -Size); Line(-Size, 0.0); Line(0.0, Size); end Square; procedure Plus(Center_X, Center_Y, Size : in float) is Half_Size : constant float := Size / 2.0; begin Move_To(Center_X - Half_Size, Center_Y); Line(Size, 0.0); Move_To(Center_X, Center_Y - Half_Size); Line(0.0, Size); end Plus; procedure Diamond(Center_X, Center_Y, Size : in float) is Half_Size : constant float := Size / 2.0; Horisize : constant float := Half_Size * 0.75; begin Move_To(Center_X, Center_Y + Half_Size); Line( Horisize, -Half_Size); Line(-Horisize, -Half_Size); Line(-Horisize, Half_Size); Line( Horisize, Half_Size); end Diamond; procedure Triangle(Center_X, Center_Y, Size : in float) is Half_Size : constant float := Size / 2.0; Bottom : constant float := Size * 0.433; begin Move_To(Center_X - Half_Size, Center_Y - Bottom); Line(Size, 0.0); Line(-Half_Size, Size); Line(-Half_Size, -Size); end Triangle; begin -- Graff Move_To(U(1), V(1)); case Mode is when Line_Mode => for I in 2..NPts loop if abs(U(I) - U(I-1)) > Max_Line THEN Move_To(U(I), V(I)); else Line_To(U(I), V(I)); end if; end loop; when Point_Mode => for I in 1 .. NPts loop case Symbol is when 1 => Square (U(I), V(I), Symbol_Size); when 2 => Plus (U(I), V(I), Symbol_Size); when 3 => Diamond (U(I), V(I), Symbol_Size); when others => Triangle(U(I), V(I), Symbol_Size); end case; end loop; when Dash_Mode => for I in 2..NPts loop if Even then if U(I-1) /= Way_Out then if abs(U(I) - U(I-1)) > Max_Line THEN Move_To(U(I), V(I)); else Line_To(U(I), V(I)); end if; end if; else Move_To(U(I), V(I)); end if; Even := not Even; end loop; when others => null; end case; end Graff; procedure Plot_Points(Points_Type : Beam_Or_Symbol; Name_Length : integer; File_Name : FileName; Draw_Color : Color_Type) is -- Plots map, beam, and symbol data. use World_Data_Files; Lat_Lon : Lat_Lon_Record; Point_File : World_Data_Io.File_Type; procedure Plot_Rec(Rec : Lat_Lon_Record) is Stop : constant integer := 2 * Lat_Lon.Number_Of_Pairs; N, I, NPts : integer; Draw_Mode : integer; ProjU, ProjV : Float_Array; begin if Points_Type = Symbol_Data then Draw_Mode := 2; else Draw_Mode := 1; end if; NPts := 0; I := 1; loop exit when I > Stop; NPts := NPts + 1; Project(Lat_Lon.Lat_Lon_Pairs(I), Lat_Lon.Lat_Lon_Pairs(I+1), ProjU(NPts), ProjV(NPts)); if NPts = Max_Points then Graff(Max_Points, ProjU, ProjV, Draw_Mode); ProjU(1) := ProjU(Max_Points); ProjV(1) := ProjV(Max_Points); NPts := 1; end if; I := I + 2; end loop; if NPts > 1 then Graff(NPts, ProjU, ProjV, Draw_Mode); end if; end Plot_Rec; function In_View return boolean is -- Determines whether or not the current record will be visible -- in the window. Lat_Min : constant float := Lat_Lon.Minimum_Lat; Lat_Max : constant float := Lat_Lon.Maximum_Lat; Lon_Min : float := Lat_Lon.Minimum_Lon; Lon_Max : float := Lat_Lon.Maximum_Lon; begin if Lon_Max > 180.0 then Lon_Min := Lon_Min - 180.0; Lon_Max := Lon_Max - 180.0; end if; if Lat_Min >= Lat_Pic_Max or else Lon_Min >= Lon_Pic_Max or else Lat_Max <= Lat_Pic_Min or else Lon_Max <= Lon_Pic_Min then return false; else return true; end if; end In_View; begin -- Plot_Points World_Data_Io.Open(Point_File, World_Data_Io.in_file, File_Name(1..Name_Length), ""); Set_Mode(Graphics); Set_Color(Draw_Color); while not World_Data_Io.end_of_file(Point_File) loop World_Data_Io.Read(Point_File, Lat_Lon); if Points_Type = Symbol_Data then Symbol := integer(Lat_Lon.Minimum_Lat); Plot_Rec(Lat_Lon); elsif In_View then Plot_Rec(Lat_Lon); end if; end loop; Set_Mode(Text); exception when World_Data_Io.Name_Error => if Points_Type = Map_Data then Menu_Draw.Draw_Error_Port("Map file not found.", ""); elsif Points_Type = Beam_Data then Menu_Draw.Draw_Error_Port("Beam file not found.", ""); else Menu_Draw.Draw_Error_Port("Symbol file not found.", ""); end if; end Plot_Points; procedure Draw_Limb is -- Draws Limb line around map. Segments : constant integer := 73; -- 5 degree increments (360/5 + 1) Sin1 : constant float := 8.71557420E-2; -- sin(360/(Segments-1)) Cos1 : constant float := 9.96194698E-1; -- cos(360/(Segments-1)) Radius, Axis, D, Angle : float; ProjU, ProjV : Float_Array; N : integer; Invalid_Operation : exception; begin Axis := 1.0; Case Projection is when Orthographic => Radius := 1.0; when Satellite => D := Proj_Params.Sat_Altitude / 3444.0; Radius := D * Sat_Scale(Proj_Params.Sat_Altitude, Proj_Params.View_Altitude) * ASin(1.0/(D+1.0)); when Lambert => Radius := 2.0; when Azimuthal => Radius := Pi; when others => raise Invalid_Operation; end case; ProjU(1) := Radius; ProjV(1) := 0.0; N := 1; Angle := 0.0; Set_Mode(Graphics); Set_Color(Map_Color.Map_Outline); for I in 1 .. Segments loop N := N + 1; Angle := Angle + 0.087266462; ProjU(N) := Radius*Cos(Angle); ProjV(N) := Radius*Sin(Angle); if N = Max_Points then Graff(N, ProjU, ProjV, 1); ProjU(1) := ProjU(N); ProjV(1) := ProjV(N); N := 1; end if; end loop; if N /= 1 then Graff(N, ProjU, ProjV, 1); end if; Set_Mode(Text); exception when Invalid_Operation => N := 0; -- null; end Draw_Limb; procedure Draw_Grids is -- Draws the grid lines on the map. Grid_Rec : constant Grid_Line_Parameters := World_Menus.Current_Grid_Line_Parameters; Lat_Initial : constant float := -90.0; Lat_Final : constant float := 89.0; Lon_Initial : constant float := -180.0; Lon_Final : constant float := 180.0; Increment : constant float := Grid_Rec.Segment_Length; Grid_Lat : constant float := Grid_Rec.Degrees_Btwn_Lats; Grid_Lon : constant float := Grid_Rec.Degrees_Btwn_Lons; S_Lat : constant float := 7.5; A_Lon : constant integer := 90; ProjU, ProjV : Float_Array; X_Lat, X_Lon : float; Lat_Stop : float; NPts : integer; procedure Reset is begin NPts := 0; if integer(X_Lon) mod A_Lon = 0 then X_Lat := Lat_Initial + S_Lat; Lat_Stop := Lat_Final - S_Lat; else X_Lat := Lat_Initial; Lat_Stop := Lat_Final; end if; end Reset; begin -- Draw_Grids Set_Mode(Graphics); Set_Color(Map_Color.Grid_Lines); if Grid_Lat /= 0.0 then X_Lat := Lat_Initial + Grid_Lat; X_Lon := Lon_Initial; NPts := 0; loop NPts := NPts + 1; Project(X_Lat, X_Lon, ProjU(NPts), ProjV(NPts)); X_Lon := X_Lon + Increment; if X_Lon > Lon_Final then Graff(NPts, ProjU, ProjV, 3); X_Lat := X_Lat + Grid_Lat; exit when X_Lat > Lat_Final; X_Lon := Lon_Initial; NPts := 0; end if; end loop; end if; if Grid_Lon /= 0.0 then X_Lon := Lon_Initial + Grid_Lon; Reset; loop NPts := NPts + 1; Project(X_Lat, X_Lon, ProjU(NPts), ProjV(NPts)); X_Lat := X_Lat + Increment; if X_Lat > Lat_Stop then Graff(NPts, ProjU, ProjV, 3); X_Lon := X_Lon + Grid_Lon; exit when X_Lon > Lon_Final; Reset; end if; end loop; end if; Set_Mode(Text); end Draw_Grids; begin -- Draw_Map Proj_Params := World_Menus.Current_Projection_Parameters; Initialize_Plot; if Plot_Land then Plot_Points(Map_Data, Specials.Points_Last, Specials.Points_Data, Specials.Points_Color); end if; Draw_Limb; if Show_Grid then Draw_Grids; end if; if Show_Beam then Plot_Points(Beam_Data, Specials.Beam_Last, Specials.Beam_Data, Specials.Beam_Color); end if; if Show_Swath then Plot_Points(Symbol_Data, Specials.Swath_Last, Specials.Swath_Data, Specials.Swath_Color); end if; exception when Caught_Error => null; when Constraint_Error => Menu_Draw.Draw_Error_Port("Constraint Error", ""); when Numeric_Error => Menu_Draw.Draw_Error_Port("Numeric Error", ""); when Storage_Error => Menu_Draw.Draw_Error_Port("Storage Error", ""); when Tasking_Error => Menu_Draw.Draw_Error_Port("Tasking Error", ""); when others => null; Menu_Draw.Draw_Error_Port("Unknown Error", ""); end Draw_Map; begin -- World_Map null; end World_Map; --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: --world.txt --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: with Text_Io, Graphic, World_Menus, World_Map; use Text_Io, Graphic, World_Menus, World_Map; procedure World is Map : View_Port; begin World_Menus.Initialize; Create_Port( Map, 0, 1, 132, 22 ); loop Generate_Menus; exit when End_Of_Session; Select_Port(Map); Draw_Map; end loop; end World; --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: --grprntrnx.txt --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: with text_io; use text_io; package body Graphic is -- This body was written for use on a Printronix 300 printer. --Required constants for all versions. Screen_X_Max : constant Pixel := 650; Screen_Y_Max : constant Pixel := 650; Y_To_X_Ratio : constant float := 1.2; --Required variables for all versions. X_Text_To_Bit : float := 6.0; Y_Text_To_Bit : float := 12.0; Draw_Port : View_Port := null; Epsilon : constant float := 1.0e-15; --Printronix 300 stuff. type Pixel_Value is (Off, On); -- type Screen_Type is array (0..Screen_Y_Max, -- 0..Screen_X_Max) of Pixel_Value; -- type Screen_Ptr is access Screen_Type; -- -- Screen : Screen_Ptr; type Screen_Type is array ( 0 .. Screen_Y_Max ) of Pixel_Value; type Big_array_Ptr is access Screen_Type; type Screen_ptr is array ( 0 .. Screen_X_Max ) of Big_Array_Ptr; Screen : Screen_Ptr; empty_column : constant screen_type := ( 0 .. Screen_Y_Max => Off ); function Less_Than(A, B: Coordinate) return boolean is begin if abs(A-B) < Epsilon then return false; --because that's close enough to being equal else return A < B; end if; end Less_Than; function Greater_Than(A, B: Coordinate) return boolean is begin if abs(A-B) < Epsilon then return false; --because that's close enough to being equal else return A > B; end if; end Greater_Than; function Equals(A, B: Coordinate) return boolean is begin if abs(A-B) < Epsilon then return true; --because that's close enough to being equal else return false; end if; end Equals; function Adjust_Y_To_Screen(Y : in integer) return integer is -- Isolate the dependency of a terminal's origin location. TRNX -- assumes (0,0) in lower left corner. If it is a bad assumption, -- it is corrected here. begin -- for terminals with (0,0) in upper left corner (VT241) -- use -- return Screen_Y_Max - Y; -- for terminals with (0,0) in lower left corner (Printronix 300) -- use return Y; end Adjust_Y_To_Screen; procedure Redefine(Port: in out View_Port; Left, Top, Width, Height: in Coordinate) is procedure Verify(Value, Max: in Pixel) is -- verify Value to be between Min and Max. begin if Value < 0 or Value > Max then raise Value_Off_Screen; end if; end Verify; begin -- Redefine Port.Color := 1.0; -- start with white Port.Window_Defined := false; Port.Left := integer(Left*X_Text_To_Bit); Port.Right := Port.Left + integer(Width*X_Text_To_Bit) - 1; Port.Top := Screen_Y_Max - integer(Top*Y_Text_To_Bit); Port.Bottom := Screen_Y_Max - (integer((Top+Height)*Y_Text_To_Bit)-1); Verify(Port.Left, Screen_X_Max); Verify(Port.Right, Screen_X_Max); Verify(Port.Top, Screen_Y_Max); Verify(Port.Bottom, Screen_Y_Max); Draw_Port := Port; end Redefine; procedure Redefine(Port: in out View_Port; Left, Top, Width, Height: in integer) is begin Redefine(Port, float(Left), float(Top), float(Width), float(Height)); end Redefine; procedure Create_Port(Port: in out View_Port; Left, Top, Width, Height: in Coordinate) is begin Port := new V_Port; Redefine(Port, Left, Top, Width, Height); end Create_Port; procedure Create_Port(Port: in out View_Port; Left, Top, Width, Height: in integer) is begin Create_Port(Port, float(Left), float(Top), float(Width), float(Height)); end Create_Port; procedure New_Screen_Size(Columns, Lines : in integer) is -- Set X_Text_To_Bit and Y_Text_To_Bit to coorespond to a given screen size. -- This routine should only have an affect on terminal with varying text -- screens. If Columns and Lines passed do not match some configuration -- available on the terminal, Illegal_Screen_Size is raised. begin if Columns /= 132 then raise Illegal_Screen_Size; end if; case Lines is when 66 => Y_Text_To_Bit := 12.0; when 88 => Y_Text_To_Bit := 9.0; when 110 => Y_Text_To_Bit := 7.2; when others => raise Illegal_Screen_Size; end case; end New_Screen_Size; procedure Window_To_Pixel(Window_X, Window_Y : in Coordinate; Pixel_X, Pixel_Y : in out Pixel) is -- Translate a window coordinate to a pixel coordinate through the current -- drawing port. If the current drawing port's window has not been defined, -- the Undefined_Window exception is raised. begin if Draw_Port.Window_Defined then Pixel_X := integer(Window_X * Draw_Port.X_Scale + Draw_Port.X_Shift); Pixel_Y := Adjust_Y_To_Screen( integer(Window_Y * Draw_Port.Y_Scale + Draw_Port.Y_Shift) ); else raise Undefined_Window; end if; end Window_To_Pixel; procedure Set_Window(Left, Bottom, Right, Top: in Coordinate) is -- Defines the world coordinates to be seen through the current View_Port. -- If either the width or Height is zero, Set_Window will define them -- such that the aspect ratio is sqaure (cause circles to be round). -- If both are zero, the Zero_Area exception is raised. Aspect_Ratio : float; Half_Size : float; -- Half the X or Y world size of the view port L, B, R, T : Coordinate; -- Copies of the input parameters function Min(A, B: Coordinate) return Coordinate is begin if A < B then return A; else return B; end if; end Min; function Max(A, B: Coordinate) return Coordinate is begin if A > B then return A; else return B; end if; end Max; begin -- Set_Window if Equals(Left, Right) and Equals(Bottom, Top) then raise Zero_Area; else L := Left; B := Bottom; R := Right; T := Top; Aspect_Ratio := Y_To_X_Ratio * float(Draw_Port.Right - Draw_Port.Left) / float(Draw_Port.Top - Draw_Port.Bottom); -- Check for zero area in one direction. -- If found, insure a "square" area port if Equals(Left, Right) then Half_Size := (Top - Bottom) * Aspect_Ratio / 2.0; R := R + Half_Size; L := L - Half_Size; elsif Equals(Top, Bottom) then Half_Size := ((Right - Left) / Aspect_Ratio) / 2.0; T := T + Half_Size; B := B - Half_Size; end if; Draw_Port.WX_Min := Min(L,R); Draw_Port.WY_Min := Min(B,T); Draw_Port.WX_Max := Max(L,R); Draw_Port.WY_Max := Max(B,T); Draw_Port.X_Scale := float(Draw_Port.Right - Draw_Port.Left) / (R - L); Draw_Port.Y_Scale := float(Draw_Port.Top - Draw_Port.Bottom) / (T - B); Draw_Port.X_Shift := float(Draw_Port.Left) - L * Draw_Port.X_Scale; Draw_Port.Y_Shift := float(Draw_Port.Bottom) - B * Draw_Port.Y_Scale; Draw_Port.X_Current := 0.0; Draw_Port.Y_Current := 0.0; Draw_Port.Window_Defined := true; end if; end Set_Window; procedure Set_Window(Left, Bottom, Right, Top: in integer) is begin Set_Window(float(Left), float(Bottom), float(Right), float(Top)); end Set_Window; function Color_To_Spectrum(Color : Color_Type) return Color_Spectrum is -- Convert a Color_Type to a Color_Spectrum. begin Case Color is when Black => return 0.0; when Brown => return 0.1667; when Blue => return 0.3333; when Green => return 0.5; when Yellow => return 0.6667; when Red => return 0.8333; when White => return 1.0; when others => null; end case; end Color_To_Spectrum; function Spectrum_To_Color(Spectrum : in Color_Spectrum) return Color_Type is -- Convert a Color_Spectrum to a Color_Type begin case integer(Spectrum*10.0) is when 0 => return Black; when 1..2 => return Brown; when 3 => return Blue; when 4..5 => return Green; when 6..7 => return Yellow; when 8..9 => return Red; when 10 => return White; when others => null; end case; end Spectrum_To_Color; function Color_Char(Color : Color_Spectrum) return character is Color_String : constant string(1..7) := "DDBGYRW"; Color_Index : integer; begin Color_Index := 1 + Color_Type'pos(Spectrum_To_Color(Color)); return Color_String(Color_Index); end Color_Char; procedure Draw_Line(Start_WX, Start_WY, End_WX, End_WY : in Coordinate; Color : in Color_Spectrum) is -- Draws a line segment from (Start_WX, Start_WY) to (End_WX, End_WY). No -- clipping is performed. Start_PX, Start_PY, End_PX, End_PY : Pixel; procedure Draw_Segment(Sx, Sy, Ex, Ey : in integer; Color : in Color_Spectrum) is -- Printronix 300 dependent. Will draw a line segment from (Sx,Sy) to -- (Ex,Ey) of Color. Algorithm taken from Newman and Sproull. Y_Length, Length, I : integer; X, Y, X_Increment, Y_Increment : float; Zero_Length : exception; Pixel_Color : Pixel_Value; begin if Color = 0.0 then Pixel_Color := Off; else Pixel_Color := On; end if; Length := abs(Ex - Sx); Y_Length := abs(Ey - Sy); if Y_Length >= Length then if Y_Length = 0 then Screen(Sy)(Sx) := On; raise Zero_Length; end if; Length := abs(Ey - Sy); end if; X_Increment := float(Ex - Sx) / float(Length); Y_Increment := float(Ey - Sy) / float(Length); X := float(Sx); Y := float(Sy); for I in 1 .. Length loop Screen(integer(Y))(integer(X)) := Pixel_Color; X := X + X_Increment; Y := Y + Y_Increment; end loop; exception when Zero_Length => null; end Draw_Segment; begin --Draw_Line Window_To_Pixel(Start_WX, Start_WY, Start_PX, Start_PY); Window_To_Pixel(End_WX, End_WY, End_PX, End_PY); Draw_Segment(Start_PX, Start_Py, End_PX, End_PY, Color); end Draw_Line; procedure Select_Port(Port: in View_Port) is -- Select a different port to draw in. begin Draw_Port := Port; end Select_Port; procedure Erase_Screen is -- A quick way to erase all TRNXs on the screen. begin -- Printronix 300 dependent. Put_Line("Erasing screen"); for Row in 0 .. Screen_X_Max loop Screen(Row)( 0 .. Screen_Y_Max ) := Empty_Column; end loop; Put_Line("Erasing complete"); end Erase_Screen ; procedure Erase_Port(Color : in Color_Type) is -- Erase the port currently being drawn in. begin Erase_Port(Draw_Port, Color_To_Spectrum(Color)); end Erase_Port ; procedure Erase_Port(Color : in Color_Spectrum := 0.0) is -- Erase the port currently being drawn in. begin Erase_Port(Draw_Port, Color); end Erase_Port ; procedure Erase_Port(Port: in View_Port; Color : in Color_Type) is -- Erase a specified port. begin Erase_Port(Port, Color_To_Spectrum(Color)); end Erase_Port; procedure Erase_Port(Port: in View_Port; Color : in Color_Spectrum := 0.0) is -- Erase a specified port. Pixel_Color : Pixel_Value; begin -- Printronix 300. if Color = 0.0 then Pixel_Color := Off; else Pixel_Color := On; end if; for Row in Port.Top .. Port.Bottom loop for Col in Port.Left .. Port.Right loop Screen(Row)(Col) := Pixel_Color; end loop; end loop; end Erase_Port; procedure Frame_Port is -- Draw a frame around the port currently being drawn in. begin Draw_Line(Draw_Port.WX_Min, Draw_Port.WY_Min, Draw_Port.WX_Max, Draw_Port.WY_Min, Draw_Port.Color); Draw_Line(Draw_Port.WX_Max, Draw_Port.WY_Min, Draw_Port.WX_Max, Draw_Port.WY_Max, Draw_Port.Color); Draw_Line(Draw_Port.WX_Max, Draw_Port.WY_Max, Draw_Port.WX_Min, Draw_Port.WY_Max, Draw_Port.Color); Draw_Line(Draw_Port.WX_Min, Draw_Port.WY_Max, Draw_Port.WX_Min, Draw_Port.WY_Min, Draw_Port.Color); end Frame_Port ; procedure Move_To(New_X, New_Y: in Coordinate) is -- Move the drawing start position to the absolute coordinates (New_X, New_Y). begin Draw_Port.X_Current := New_X; Draw_Port.Y_Current := New_Y; end Move_To; procedure Move_To(New_X, New_Y: in integer) is begin Draw_Port.X_Current := float(New_X); Draw_Port.Y_Current := float(New_Y); end Move_To; procedure Move(Delta_X, Delta_Y: in Coordinate) is -- Change the drawing start position by Delta_X and Delta_Y. begin Move_To( Draw_Port.X_Current + Delta_X, Draw_Port.Y_Current + Delta_Y ); end Move; procedure Move(Delta_X, Delta_Y: in integer) is begin Move_To( Draw_Port.X_Current + float(Delta_X), Draw_Port.Y_Current + float(Delta_Y)); end Move; procedure Clip(X1, Y1, X2, Y2: in out Coordinate; In_View: in out boolean) is -- Given an imaginary line segment between the coordinates (X1,Y1) and -- (X2, Y2), insure that they are within the current View_Port. -- In_View is returned false iff the line segment lies completely outside of -- the View_Port. -- The algorithm is taken from Newman and Sproull, Principles of Interactive -- Computer TRNXs pp. 66-67. type Edge is (Left, Bottom, Right, Top); type Edge_Set is array(Left..Top) of boolean; yy : Edge; C, C1, C2 : Edge_Set; X, Y : Coordinate; None : constant Edge_Set := Edge_Set'(others => false); Off_Screen_Completely : exception; procedure Code(X, Y: in Coordinate; C: out Edge_Set) is begin C := None; if Less_Than(X, Draw_Port.WX_Min) then C(Left) := true; elsif Greater_Than(X, Draw_Port.WX_Max) then C(Right) := true; end if; if Less_Than(Y, Draw_Port.WY_Min) then C(Bottom) := true; elsif Greater_Than(Y, Draw_Port.WY_Max) then C(Top) := true; end if; end Code; function C1_and_C2_ne_None return boolean is -- make up for compiler bug. Result : boolean := false; I : Edge; begin I := Left; loop if C1(I) and C2(I) then Result := true; exit; end if; exit when I = Top; I := Edge'Succ(I); end loop; return Result; end C1_and_C2_ne_None; begin -- Clip Code(X1, Y1, C1); Code(X2, Y2, C2); while (C1 /= None) or (C2 /= None) loop if C1_and_C2_ne_None then raise Off_Screen_Completely; end if; C := C1; if C = None then C := C2; end if; if C(Left) then -- Crosses left edge Y := Y1 + (Y2 - Y1) * (Draw_Port.WX_Min - X1) / (X2 - X1); X := Draw_Port.WX_Min; elsif C(Bottom) then -- Crosses bottom edge X := X1 + (X2 - X1) * (Draw_Port.WY_Min - Y1) / (Y2 - Y1); Y := Draw_Port.WY_Min; elsif C(Right) then -- Crosses right edge Y := Y1 + (Y2 - Y1) * (Draw_Port.WX_Max - X1) / (X2 - X1); X := Draw_Port.WX_Max; elsif C(Top) then -- Crosses top edge X := X1 + (X2 - X1) * (Draw_Port.WY_Max - Y1) / (Y2 - Y1); Y := Draw_Port.WY_Max; end if; if C = C1 then X1 := X; Y1 := Y; Code(X, Y, C1); else X2 := X; Y2 := Y; Code(X, Y, C2); end if; end loop; In_View := true; exception when Off_Screen_Completely => In_View := false; end Clip; procedure Line_To(New_X, New_Y: in Coordinate) is -- Draw a line from the drawing start position to the absolute coordinates -- (New_X, New_Y). SX, SY, EX, EY : Coordinate; Drawable : boolean; begin SX := Draw_Port.X_Current; SY := Draw_Port.Y_Current; EX := New_X; EY := New_Y; Clip(SX, SY, EX, EY, Drawable); if Drawable then Draw_Line(SX, SY, EX, EY, Draw_Port.Color); end if; Draw_Port.X_Current := New_X; Draw_Port.Y_Current := New_Y; end Line_To; procedure Line_To(New_X, New_Y: in integer) is begin Line_To(float(New_X), float(New_Y)); end Line_To; procedure Line(Delta_X, Delta_Y: in Coordinate) is -- Draw a line from the drawing start position to the point Delta_X and -- Delta_Y away. begin Line_To( Draw_Port.X_Current + Delta_X, Draw_Port.Y_Current + Delta_Y ); end Line; procedure Line(Delta_X, Delta_Y: in integer) is begin Line_To( Draw_Port.X_Current + float(Delta_X), Draw_Port.Y_Current + float(Delta_Y)); end Line; procedure Set_Color(Color_Code: in Color_Spectrum) is -- Change the drawing color to Color_Code returning the previous color. -- The Color_Spectrum is defined to range from 0.0 (black) to 1.0 (white). -- Any color code outside that range will cause Illegal_Color exception to -- be raised. begin if Color_Code < 0.0 or Color_Code > 1.0 then raise Illegal_Color; else Draw_Port.Color := Color_Code; end if; end Set_Color; function Set_Color(Color_Code: in Color_Spectrum) return Color_Spectrum is Old_Color_Code : Color_Spectrum := Draw_Port.Color; begin Set_Color(Color_Code); return Old_Color_Code; end Set_Color; procedure Set_Color(Color: in Color_Type) is begin Set_Color(Color_To_Spectrum(Color)); end Set_Color; function Set_Color(Color: in Color_Type) return Color_Type is Old_Color : Color_Type := Spectrum_To_Color(Draw_Port.Color); begin Set_Color(Color_To_Spectrum(Color)); return Old_Color; end Set_Color; procedure Where_Am_I(Current_X, Current_Y: out Coordinate) is begin Current_X := Draw_Port.X_Current; Current_Y := Draw_Port.Y_Current; end Where_Am_I; procedure Set_Mode(Mode: in Terminal_Mode) is begin null; end Set_Mode; procedure Print_Screen(File_Name : String) is -- Put the screen to a file for output to a TRNX printer. -- This implementation is Printronix 300 dependent. Trnx_Line_Designator : constant character := character'val(5); F : File_Type; Col, Line : integer; Int_Byte : integer; Trnx_Line : String(1 .. 134); Last_Char : integer; Last_Non_Blank : integer; Dot : integer := 0; begin Create(F, Out_File, File_Name, ""); for Line in reverse 0 .. Screen_Y_Max loop if Line mod 50 = 0 then new_line; end if; put('.'); Last_Char := 0; Last_Non_Blank := 0; Col := 0; loop Int_Byte := 1; for Bit in reverse 0..5 loop Int_Byte := Int_Byte * 2; if Screen(Line)(Col+Bit) = On then Int_Byte := Int_Byte + 1; end if; end loop; Last_Char := Last_Char + 1; if Int_Byte /= 64 then Last_Non_Blank := Last_Char; end if; Trnx_Line(Last_Char) := character'Val(Int_Byte); Col := Col + 6; exit when Col > Screen_X_Max; end loop; if Last_Non_Blank < Last_Char then Last_Char := Last_Non_Blank; end if; Last_Char := Last_Char + 1; Trnx_Line(Last_Char) := TRNX_Line_Designator; Put_Line(F, Trnx_Line(1..Last_Char)); end loop; Close(F); end Print_Screen; function What_Port return View_Port is begin return Draw_Port; end What_Port; begin -- Printronix 300 initialization for I in 0 .. Screen_Y_Max loop Screen(I) := new Screen_Type; end loop; Erase_Screen; end Graphic; --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: --grvt240.txt --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: with text_io; use text_io; package body Graphic is -- This is the VT240 body. --Required constants for all versions. Screen_X_Max : constant Pixel := 799; Screen_Y_Max : constant Pixel := 479; Y_To_X_Ratio : constant float := 1.0; Epsilon : constant float := 1.0E-15; -- for math operations, telesoft ada. --Required variables for all versions. X_Text_To_Bit : float := 10.0; Y_Text_To_Bit : float := 20.0; Draw_Port : View_Port := null; System_Mode : Terminal_Mode := Text; --Required terminal dependendent variables TT : File_Type; subtype Intens_Type is string(1..4); Old_Intensity : Intens_Type := "????"; Last_X, Last_Y : integer := integer'first; function Less_Than(A, B: Coordinate) return boolean is begin if abs(A-B) < Epsilon then return false; --because that's close enough to being equal else return A < B; end if; end Less_Than; function Greater_Than(A, B: Coordinate) return boolean is begin if abs(A-B) < Epsilon then return false; --because that's close enough to being equal else return A > B; end if; end Greater_Than; function Equals(A, B: Coordinate) return boolean is begin if abs(A-B) < Epsilon then return true; --because that's close enough to being equal else return false; end if; end Equals; function Adjust_Y_To_Screen(Y : in integer) return integer is -- Isolate the dependency of a terminal's origin location. Graphic -- assumes (0,0) in lower left corner. If it is a bad assumption, -- it is corrected here. begin -- for terminals with (0,0) in upper left corner (VT241) -- use return Screen_Y_Max - Y; -- for terminals with (0,0) in lower left corner (Printronix 300) -- use -- return Y; end Adjust_Y_To_Screen; procedure Redefine(Port: in out View_Port; Left, Top, Width, Height: in Coordinate) is procedure Verify(Value, Max: in Pixel) is -- verify Value to be between Min and Max. begin if Value < 0 or Value > Max then raise Value_Off_Screen; end if; end Verify; begin -- Redefine Port.Color := 1.0; -- start with white Port.Window_Defined := false; Port.Left := integer(Left*X_Text_To_Bit); Port.Right := Port.Left + integer(Width*X_Text_To_Bit) - 1; Port.Top := Screen_Y_Max - integer(Top*Y_Text_To_Bit); Port.Bottom := Screen_Y_Max - (integer((Top+Height)*Y_Text_To_Bit)-1); Verify(Port.Left, Screen_X_Max); Verify(Port.Right, Screen_X_Max); Verify(Port.Top, Screen_Y_Max); Verify(Port.Bottom, Screen_Y_Max); Draw_Port := Port; end Redefine; procedure Redefine(Port: in out View_Port; Left, Top, Width, Height: in integer) is begin Redefine(Port, float(Left), float(Top), float(Width), float(Height)); end Redefine; procedure Create_Port(Port: in out View_Port; Left, Top, Width, Height: in Coordinate) is begin Port := new V_Port; Redefine(Port, Left, Top, Width, Height); end Create_Port; procedure Create_Port(Port: in out View_Port; Left, Top, Width, Height: in integer) is begin Create_Port(Port, float(Left), float(Top), float(Width), float(Height)); end Create_Port; procedure New_Screen_Size(Columns, Lines : in integer) is -- Set X_Text_To_Bit and Y_Text_To_Bit to coorespond to a given screen size. -- This routine should only have an affect on terminal with varying text -- screens. If Columns and Lines passed do not match some configuration -- available on the terminal, Illegal_Screen_Size is raised. -- VT240 dependent. begin case Columns is when 80 => X_Text_To_Bit := 10.0; when 132 => X_Text_To_Bit := 6.0; when others => raise Illegal_Screen_Size; end case; if Lines /= 24 then raise Illegal_Screen_Size; end if; end New_Screen_Size; procedure Window_To_Pixel(Window_X, Window_Y : in Coordinate; Pixel_X, Pixel_Y : in out Pixel) is -- Translate a window coordinate to a pixel coordinate through the current -- drawing port. If the current drawing port's window has not been defined, -- the Undefined_Window exception is raised. begin if Draw_Port.Window_Defined then Pixel_X := integer(Window_X * Draw_Port.X_Scale + Draw_Port.X_Shift); Pixel_Y := Adjust_Y_To_Screen( integer(Window_Y * Draw_Port.Y_Scale + Draw_Port.Y_Shift) ); else raise Undefined_Window; end if; end Window_To_Pixel; procedure Set_Window(Left, Bottom, Right, Top: in Coordinate) is -- Defines the world coordinates to be seen through the current View_Port. -- If either the width or Height is zero, Set_Window will define them -- such that the aspect ratio is sqaure (cause circles to be round). -- If both are zero, the Zero_Area exception is raised. Aspect_Ratio : float; Half_Size : float; -- Half the X or Y world size of the view port L, B, R, T : Coordinate; -- Copies of the input parameters function Min(A, B: Coordinate) return Coordinate is begin if A < B then return A; else return B; end if; end Min; function Max(A, B: Coordinate) return Coordinate is begin if A > B then return A; else return B; end if; end Max; begin -- Set_Window if Equals(Left, Right) and Equals(Bottom, Top) then raise Zero_Area; else L := Left; B := Bottom; R := Right; T := Top; Aspect_Ratio := Y_To_X_Ratio * float(Draw_Port.Right - Draw_Port.Left) / float(Draw_Port.Top - Draw_Port.Bottom); -- Check for zero area in one direction. -- If found, insure a "square" area port if Equals(Left, Right) then Half_Size := (Top - Bottom) * Aspect_Ratio / 2.0; R := R + Half_Size; L := L - Half_Size; elsif Equals(Top, Bottom) then Half_Size := ((Right - Left) / Aspect_Ratio) / 2.0; T := T + Half_Size; B := B - Half_Size; end if; Draw_Port.WX_Min := Min(L,R); Draw_Port.WY_Min := Min(B,T); Draw_Port.WX_Max := Max(L,R); Draw_Port.WY_Max := Max(B,T); Draw_Port.X_Scale := float(Draw_Port.Right - Draw_Port.Left) / (R - L); Draw_Port.Y_Scale := float(Draw_Port.Top - Draw_Port.Bottom) / (T - B); Draw_Port.X_Shift := float(Draw_Port.Left) - L * Draw_Port.X_Scale; Draw_Port.Y_Shift := float(Draw_Port.Bottom) - B * Draw_Port.Y_Scale; Draw_Port.X_Current := 0.0; Draw_Port.Y_Current := 0.0; Draw_Port.Window_Defined := true; end if; end Set_Window; procedure Set_Window(Left, Bottom, Right, Top: in integer) is begin Set_Window(float(Left), float(Bottom), float(Right), float(Top)); end Set_Window; function Color_To_Spectrum(Color : Color_Type) return Color_Spectrum is -- Convert a Color_Type to a Color_Spectrum. begin Case Color is when Black => return 0.0; when Brown => return 0.1667; when Blue => return 0.3333; when Green => return 0.5; when Yellow => return 0.6667; when Red => return 0.8333; when White => return 1.0; when others => null; end case; end Color_To_Spectrum; function Spectrum_To_Color(Spectrum : in Color_Spectrum) return Color_Type is -- Convert a Color_Spectrum to a Color_Type begin case integer(Spectrum*10.0) is when 0 => return Black; when 1..2 => return Brown; when 3 => return Blue; when 4..5 => return Green; when 6..7 => return Yellow; when 8..9 => return Red; when 10 => return White; when others => null; end case; end Spectrum_To_Color; function Intensity(Color : Color_Spectrum) return Intens_Type is -- VT240 dependent begin if Color < 0.25 then return "L0 "; elsif Color < 0.5 then return "L33 "; elsif Color < 0.75 then return "L67 "; else return "L100"; end if; end Intensity; procedure Draw_Segment(Sx, Sy, Ex, Ey : in integer; Color : in Color_Spectrum) is -- Draw a line segment from (Sx,Sy) to (Ex,Ey) of Color. -- VT240 dependent New_Intensity : constant Intens_Type := Intensity(Color); begin if System_Mode = Text then -- temporarily change to graphics mode Put(TT, Ascii.Esc); Put(TT, "P1p"); end if; if New_Intensity /= Old_Intensity then Put(TT, "W(I(" & New_Intensity & "))"); Old_Intensity := New_Intensity; end if; if Sx /= Last_X or Sy /= Last_Y then Put(TT, "P[" & integer'image(Sx) & "," & integer'image(Sy) & "]"); end if; Put(TT, "V[" & integer'image(Ex) & "," & integer'image(Ey) & "]"); New_Line(TT); Last_X := Ex; Last_Y := Ey; if System_Mode = Text then -- change it back Put(TT, Ascii.Esc); Put(TT, "\"); end if; end Draw_Segment; procedure Draw_Line(Start_WX, Start_WY, End_WX, End_WY : in Coordinate; Color : in Color_Spectrum) is -- Draws a line segment from (Start_WX, Start_WY) to (End_WX, End_WY). No -- clipping is performed. Start_PX, Start_PY, End_PX, End_PY : Pixel; begin Window_To_Pixel(Start_WX, Start_WY, Start_PX, Start_PY); Window_To_Pixel(End_WX, End_WY, End_PX, End_PY); Draw_Segment(Start_PX, Start_Py, End_PX, End_PY, Color); end Draw_Line; procedure Select_Port(Port: in View_Port) is -- Select a different port to draw in. begin Draw_Port := Port; end Select_Port; procedure Erase_Screen is -- A quick way to erase all graphics on the screen. -- VT240 dependent begin -- Side effect is all text is erased as well as graphics. if System_Mode = Text then -- temporarily change to graphics mode Put(TT, Ascii.Esc); Put(TT, "P1p"); end if; Put(TT, "S(E)"); if System_Mode = Text then -- change it back Put(TT, Ascii.Esc); Put(TT, "\"); end if; end Erase_Screen ; procedure Erase_Port(Color : in Color_Type) is -- Erase the port currently being drawn in. begin Erase_Port(Draw_Port, Color_To_Spectrum(Color)); end Erase_Port ; procedure Erase_Port(Color : in Color_Spectrum := 0.0) is -- Erase the port currently being drawn in. begin Erase_Port(Draw_Port, Color); end Erase_Port ; procedure Erase_Port(Port: in View_Port; Color : in Color_Type) is -- Erase a specified port. begin Erase_Port(Port, Color_To_Spectrum(Color)); end Erase_Port; procedure Erase_Port(Port: in View_Port; Color : in Color_Spectrum := 0.0) is -- Erase a specified port. -- VT240 dependent Y_Min : constant string := integer'image(Adjust_Y_To_Screen(Port.Top)); X_Max : constant string := integer'image(Port.Right); New_Intensity : constant Intens_Type := Intensity(Color); begin if System_Mode = Text then -- temporarily change to graphics mode Put(TT, Ascii.Esc); Put(TT, "P1p"); end if; if New_Intensity /= Old_Intensity then Put(TT, "W(I(" & New_Intensity & "))"); Old_Intensity := New_Intensity; end if; Put(TT, "P[" & X_Max & "," & integer'image(Adjust_Y_To_Screen(Port.Bottom)) & "]W(S1)V[" & X_Max & "," & Y_Min & "][" & integer'image(Port.Left) & "," & Y_Min & "]W(S0)" ); if System_Mode = Text then -- change it back Put(TT, Ascii.Esc); Put(TT, "\"); end if; end Erase_Port; procedure Frame_Port is -- Draw a frame around the port currently being drawn in. New_Top : integer := Adjust_Y_To_Screen(Draw_Port.Top); New_Bottom : integer := Adjust_Y_To_Screen(Draw_Port.Bottom); begin Draw_Segment(Draw_Port.Left, New_Top, Draw_Port.Right, New_Top, Draw_Port.Color); Draw_Segment(Draw_Port.Right, New_Top, Draw_Port.Right, New_Bottom, Draw_Port.Color); Draw_Segment(Draw_Port.Right, New_Bottom, Draw_Port.Left, New_Bottom, Draw_Port.Color); Draw_Segment(Draw_Port.Left, New_Bottom, Draw_Port.Left, New_Top, Draw_Port.Color); end Frame_Port ; procedure Move_To(New_X, New_Y: in Coordinate) is -- Move the drawing start position to the absolute coordinates (New_X, New_Y). begin Draw_Port.X_Current := New_X; Draw_Port.Y_Current := New_Y; end Move_To; procedure Move_To(New_X, New_Y: in integer) is begin Draw_Port.X_Current := float(New_X); Draw_Port.Y_Current := float(New_Y); end Move_To; procedure Move(Delta_X, Delta_Y: in Coordinate) is -- Change the drawing start position by Delta_X and Delta_Y. begin Move_To( Draw_Port.X_Current + Delta_X, Draw_Port.Y_Current + Delta_Y ); end Move; procedure Move(Delta_X, Delta_Y: in integer) is begin Move_To( Draw_Port.X_Current + float(Delta_X), Draw_Port.Y_Current + float(Delta_Y)); end Move; procedure Clip(X1, Y1, X2, Y2: in out Coordinate; In_View: in out boolean) is -- Given an imaginary line segment between the coordinates (X1,Y1) and -- (X2, Y2), insure that they are within the current View_Port. -- In_View is returned false iff the line segment lies completely outside of -- the View_Port. -- The algorithm is taken from Newman and Sproull, Principles of Interactive -- Computer Graphics pp. 66-67. type Edge is (Left, Bottom, Right, Top); type Edge_Set is array(Left..Top) of boolean; yy : Edge; C, C1, C2 : Edge_Set; X, Y : Coordinate; None : constant Edge_Set := Edge_Set'(others => false); Off_Screen_Completely : exception; procedure Code(X, Y: in Coordinate; C: out Edge_Set) is begin C := None; if Less_Than(X, Draw_Port.WX_Min) then C(Left) := true; elsif Greater_Than(X, Draw_Port.WX_Max) then C(Right) := true; end if; if Less_Than(Y, Draw_Port.WY_Min) then C(Bottom) := true; elsif Greater_Than(Y, Draw_Port.WY_Max) then C(Top) := true; end if; end Code; function C1_and_C2_ne_None return boolean is -- make up for compiler bug. Result : boolean := false; I : Edge; begin I := Left; loop if C1(I) and C2(I) then Result := true; exit; end if; exit when I = Top; I := Edge'Succ(I); end loop; return Result; end C1_and_C2_ne_None; begin -- Clip Code(X1, Y1, C1); Code(X2, Y2, C2); while (C1 /= None) or (C2 /= None) loop if C1_and_C2_ne_None then raise Off_Screen_Completely; end if; C := C1; if C = None then C := C2; end if; if C(Left) then -- Crosses left edge Y := Y1 + (Y2 - Y1) * (Draw_Port.WX_Min - X1) / (X2 - X1); X := Draw_Port.WX_Min; elsif C(Bottom) then -- Crosses bottom edge X := X1 + (X2 - X1) * (Draw_Port.WY_Min - Y1) / (Y2 - Y1); Y := Draw_Port.WY_Min; elsif C(Right) then -- Crosses right edge Y := Y1 + (Y2 - Y1) * (Draw_Port.WX_Max - X1) / (X2 - X1); X := Draw_Port.WX_Max; elsif C(Top) then -- Crosses top edge X := X1 + (X2 - X1) * (Draw_Port.WY_Max - Y1) / (Y2 - Y1); Y := Draw_Port.WY_Max; end if; if C = C1 then X1 := X; Y1 := Y; Code(X, Y, C1); else X2 := X; Y2 := Y; Code(X, Y, C2); end if; end loop; In_View := true; exception when Off_Screen_Completely => In_View := false; end Clip; procedure Line_To(New_X, New_Y: in Coordinate) is -- Draw a line from the drawing start position to the absolute coordinates -- (New_X, New_Y). SX, SY, EX, EY : Coordinate; Drawable : boolean; begin SX := Draw_Port.X_Current; SY := Draw_Port.Y_Current; EX := New_X; EY := New_Y; Clip(SX, SY, EX, EY, Drawable); if Drawable then Draw_Line(SX, SY, EX, EY, Draw_Port.Color); end if; Draw_Port.X_Current := New_X; Draw_Port.Y_Current := New_Y; end Line_To; procedure Line_To(New_X, New_Y: in integer) is begin Line_To(float(New_X), float(New_Y)); end Line_To; procedure Line(Delta_X, Delta_Y: in Coordinate) is -- Draw a line from the drawing start position to the point Delta_X and -- Delta_Y away. begin Line_To( Draw_Port.X_Current + Delta_X, Draw_Port.Y_Current + Delta_Y ); end Line; procedure Line(Delta_X, Delta_Y: in integer) is begin Line_To( Draw_Port.X_Current + float(Delta_X), Draw_Port.Y_Current + float(Delta_Y)); end Line; procedure Set_Color(Color_Code: in Color_Spectrum) is -- Change the drawing color to Color_Code returning the previous color. -- The Color_Spectrum is defined to range from 0.0 (black) to 1.0 (white). -- Any color code outside that range will cause Illegal_Color exception to -- be raised. begin if Color_Code < 0.0 or Color_Code > 1.0 then raise Illegal_Color; else Draw_Port.Color := Color_Code; end if; end Set_Color; function Set_Color(Color_Code: in Color_Spectrum) return Color_Spectrum is Old_Color_Code : Color_Spectrum := Draw_Port.Color; begin Set_Color(Color_Code); return Old_Color_Code; end Set_Color; procedure Set_Color(Color: in Color_Type) is begin Set_Color(Color_To_Spectrum(Color)); end Set_Color; function Set_Color(Color: in Color_Type) return Color_Type is Old_Color : Color_Type := Spectrum_To_Color(Draw_Port.Color); begin Set_Color(Color_To_Spectrum(Color)); return Old_Color; end Set_Color; procedure Where_Am_I(Current_X, Current_Y: out Coordinate) is begin Current_X := Draw_Port.X_Current; Current_Y := Draw_Port.Y_Current; end Where_Am_I; procedure Set_Mode(Mode: in Terminal_Mode) is -- VT240 dependent begin if Mode /= System_Mode then if Mode = Graphics then Put(TT, Ascii.Esc); Put(TT, "Pp"); else Put(TT, Ascii.Esc); Put(TT, "\"); end if; end if; System_Mode := Mode; end Set_Mode; procedure Print_Screen(File_Name : String) is -- Put the screen to a file for output to a graphic printer. -- This is not implemented for this device. begin null; end Print_Screen; function What_Port return View_Port is begin return Draw_Port; end What_Port; begin -- Graphic initialization -- VT240 dependent -- Allocate VT240 terminal -- Reset terminal to defaults -- Enter regis mode -- Set color map to Dark, Blue, Red, Green -- Set screen background to Dark -- Turn off graphic cursor -- Erase screen -- Exit regis mode begin Open(TT, Out_File, "TD$VT241:"); exception when use_error => Put("Graphic output going to GRAPH.LIS"); Create(TT, Out_File, "GRAPH.LIS"); end; Put(TT, Ascii.Esc); Put(TT, "!p"); Put(TT, Ascii.Esc); Put(TT, "Pp"); Put(TT, "S(M0(L0)1(L33)2(L67)3(L100),I(L0),C0,E)"); Put(TT, Ascii.Esc); Put(TT, "\"); end Graphic; --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: --grvt241.txt --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: with text_io; use text_io; package body Graphic is -- This is the VT241 body. --Required constants for all versions. Screen_X_Max : constant Pixel := 799; Screen_Y_Max : constant Pixel := 479; Y_To_X_Ratio : constant float := 1.0; Epsilon : constant float := 1.0E-15; -- for math operations, telesoft ada. --Required variables for all versions. X_Text_To_Bit : float := 10.0; Y_Text_To_Bit : float := 20.0; Draw_Port : View_Port := null; System_Mode : Terminal_Mode := Text; --Required terminal dependendent variables TT : File_Type; Old_Color_Char : Character := '?'; Last_X, Last_Y : integer := integer'first; function Less_Than(A, B: Coordinate) return boolean is begin if abs(A-B) < Epsilon then return false; --because that's close enough to being equal else return A < B; end if; end Less_Than; function Greater_Than(A, B: Coordinate) return boolean is begin if abs(A-B) < Epsilon then return false; --because that's close enough to being equal else return A > B; end if; end Greater_Than; function Equals(A, B: Coordinate) return boolean is begin if abs(A-B) < Epsilon then return true; --because that's close enough to being equal else return false; end if; end Equals; function Adjust_Y_To_Screen(Y : in integer) return integer is -- Isolate the dependency of a terminal's origin location. Graphic -- assumes (0,0) in lower left corner. If it is a bad assumption, -- it is corrected here. begin -- for terminals with (0,0) in upper left corner (VT241) -- use return Screen_Y_Max - Y; -- for terminals with (0,0) in lower left corner (Printronix 300) -- use -- return Y; end Adjust_Y_To_Screen; procedure Redefine(Port: in out View_Port; Left, Top, Width, Height: in Coordinate) is procedure Verify(Value, Max: in Pixel) is -- verify Value to be between Min and Max. begin if Value < 0 or Value > Max then raise Value_Off_Screen; end if; end Verify; begin -- Redefine Port.Color := 1.0; -- start with white Port.Window_Defined := false; Port.Left := integer(Left*X_Text_To_Bit); Port.Right := Port.Left + integer(Width*X_Text_To_Bit) - 1; Port.Top := Screen_Y_Max - integer(Top*Y_Text_To_Bit); Port.Bottom := Screen_Y_Max - (integer((Top+Height)*Y_Text_To_Bit)-1); Verify(Port.Left, Screen_X_Max); Verify(Port.Right, Screen_X_Max); Verify(Port.Top, Screen_Y_Max); Verify(Port.Bottom, Screen_Y_Max); Draw_Port := Port; end Redefine; procedure Redefine(Port: in out View_Port; Left, Top, Width, Height: in integer) is begin Redefine(Port, float(Left), float(Top), float(Width), float(Height)); end Redefine; procedure Create_Port(Port: in out View_Port; Left, Top, Width, Height: in Coordinate) is begin Port := new V_Port; Redefine(Port, Left, Top, Width, Height); end Create_Port; procedure Create_Port(Port: in out View_Port; Left, Top, Width, Height: in integer) is begin Create_Port(Port, float(Left), float(Top), float(Width), float(Height)); end Create_Port; procedure New_Screen_Size(Columns, Lines : in integer) is -- Set X_Text_To_Bit and Y_Text_To_Bit to coorespond to a given screen size. -- This routine should only have an affect on terminal with varying text -- screens. If Columns and Lines passed do not match some configuration -- available on the terminal, Illegal_Screen_Size is raised. -- VT241 dependent begin case Columns is when 80 => X_Text_To_Bit := 10.0; when 132 => X_Text_To_Bit := 6.0; when others => raise Illegal_Screen_Size; end case; if Lines /= 24 then raise Illegal_Screen_Size; end if; end New_Screen_Size; procedure Window_To_Pixel(Window_X, Window_Y : in Coordinate; Pixel_X, Pixel_Y : in out Pixel) is -- Translate a window coordinate to a pixel coordinate through the current -- drawing port. If the current drawing port's window has not been defined, -- the Undefined_Window exception is raised. begin if Draw_Port.Window_Defined then Pixel_X := integer(Window_X * Draw_Port.X_Scale + Draw_Port.X_Shift); Pixel_Y := Adjust_Y_To_Screen( integer(Window_Y * Draw_Port.Y_Scale + Draw_Port.Y_Shift) ); else raise Undefined_Window; end if; end Window_To_Pixel; procedure Set_Window(Left, Bottom, Right, Top: in Coordinate) is -- Defines the world coordinates to be seen through the current View_Port. -- If either the width or Height is zero, Set_Window will define them -- such that the aspect ratio is sqaure (cause circles to be round). -- If both are zero, the Zero_Area exception is raised. Aspect_Ratio : float; Half_Size : float; -- Half the X or Y world size of the view port L, B, R, T : Coordinate; -- Copies of the input parameters function Min(A, B: Coordinate) return Coordinate is begin if A < B then return A; else return B; end if; end Min; function Max(A, B: Coordinate) return Coordinate is begin if A > B then return A; else return B; end if; end Max; begin -- Set_Window if Equals(Left, Right) and Equals(Bottom, Top) then raise Zero_Area; else L := Left; B := Bottom; R := Right; T := Top; Aspect_Ratio := Y_To_X_Ratio * float(Draw_Port.Right - Draw_Port.Left) / float(Draw_Port.Top - Draw_Port.Bottom); -- Check for zero area in one direction. -- If found, insure a "square" area port if Equals(Left, Right) then Half_Size := (Top - Bottom) * Aspect_Ratio / 2.0; R := R + Half_Size; L := L - Half_Size; elsif Equals(Top, Bottom) then Half_Size := ((Right - Left) / Aspect_Ratio) / 2.0; T := T + Half_Size; B := B - Half_Size; end if; Draw_Port.WX_Min := Min(L,R); Draw_Port.WY_Min := Min(B,T); Draw_Port.WX_Max := Max(L,R); Draw_Port.WY_Max := Max(B,T); Draw_Port.X_Scale := float(Draw_Port.Right - Draw_Port.Left) / (R - L); Draw_Port.Y_Scale := float(Draw_Port.Top - Draw_Port.Bottom) / (T - B); Draw_Port.X_Shift := float(Draw_Port.Left) - L * Draw_Port.X_Scale; Draw_Port.Y_Shift := float(Draw_Port.Bottom) - B * Draw_Port.Y_Scale; Draw_Port.X_Current := 0.0; Draw_Port.Y_Current := 0.0; Draw_Port.Window_Defined := true; end if; end Set_Window; procedure Set_Window(Left, Bottom, Right, Top: in integer) is begin Set_Window(float(Left), float(Bottom), float(Right), float(Top)); end Set_Window; function Color_To_Spectrum(Color : Color_Type) return Color_Spectrum is -- Convert a Color_Type to a Color_Spectrum. begin Case Color is when Black => return 0.0; when Brown => return 0.1667; when Blue => return 0.3333; when Green => return 0.5; when Yellow => return 0.6667; when Red => return 0.8333; when White => return 1.0; when others => null; end case; end Color_To_Spectrum; function Spectrum_To_Color(Spectrum : in Color_Spectrum) return Color_Type is -- Convert a Color_Spectrum to a Color_Type begin case integer(Spectrum*10.0) is when 0 => return Black; when 1..2 => return Brown; when 3 => return Blue; when 4..5 => return Green; when 6..7 => return Yellow; when 8..9 => return Red; when 10 => return White; when others => null; end case; end Spectrum_To_Color; function Color_Char(Color : Color_Spectrum) return character is -- Return the character that the VT241 expects in order to draw -- using Color. -- VT241 dependent. Color_String : constant string(1..7) := "DDBGYRW"; Color_Index : integer; begin Color_Index := 1 + Color_Type'pos(Spectrum_To_Color(Color)); return Color_String(Color_Index); end Color_Char; procedure Draw_Segment(Sx, Sy, Ex, Ey : in integer; Color : in Color_Spectrum) is -- Draw a line segment from (Sx,Sy) to (Ex,Ey) of Color. -- VT241 dependent. New_Color_Char : constant character := Color_Char(Color); begin if System_Mode = Text then -- temporarily change to graphics mode Put(TT, Ascii.Esc); Put(TT, "P1p"); end if; if New_Color_Char /= Old_Color_Char then Put(TT, "W(I("); Put(TT, New_Color_Char); Put(TT, "))"); Old_Color_Char := New_Color_Char; end if; if Sx /= Last_X or Sy /= Last_Y then Put(TT, "P[" & integer'image(Sx) & "," & integer'image(Sy) & "]"); end if; Put(TT, "V[" & integer'image(Ex) & "," & integer'image(Ey) & "]"); New_Line(TT); Last_X := Ex; Last_Y := Ey; if System_Mode = Text then -- change it back Put(TT, Ascii.Esc); Put(TT, "\"); end if; end Draw_Segment; procedure Draw_Line(Start_WX, Start_WY, End_WX, End_WY : in Coordinate; Color : in Color_Spectrum) is -- Draws a line segment from (Start_WX, Start_WY) to (End_WX, End_WY). No -- clipping is performed. Start_PX, Start_PY, End_PX, End_PY : Pixel; begin Window_To_Pixel(Start_WX, Start_WY, Start_PX, Start_PY); Window_To_Pixel(End_WX, End_WY, End_PX, End_PY); Draw_Segment(Start_PX, Start_Py, End_PX, End_PY, Color); end Draw_Line; procedure Select_Port(Port: in View_Port) is -- Select a different port to draw in. begin Draw_Port := Port; end Select_Port; procedure Erase_Screen is -- A quick way to erase all graphics on the screen. -- VT241 dependent begin -- Side effect is all text is erased as well as graphics. if System_Mode = Text then -- temporarily change to graphics mode Put(TT, Ascii.Esc); Put(TT, "P1p"); end if; Put(TT, "S(E)"); if System_Mode = Text then -- change it back Put(TT, Ascii.Esc); Put(TT, "\"); end if; end Erase_Screen ; procedure Erase_Port(Color : in Color_Type) is -- Erase the port currently being drawn in. begin Erase_Port(Draw_Port, Color_To_Spectrum(Color)); end Erase_Port ; procedure Erase_Port(Color : in Color_Spectrum := 0.0) is -- Erase the port currently being drawn in. begin Erase_Port(Draw_Port, Color); end Erase_Port ; procedure Erase_Port(Port: in View_Port; Color : in Color_Type) is -- Erase a specified port. begin Erase_Port(Port, Color_To_Spectrum(Color)); end Erase_Port; procedure Erase_Port(Port: in View_Port; Color : in Color_Spectrum := 0.0) is -- Erase a specified port. Y_Min : constant string := integer'image(Adjust_Y_To_Screen(Port.Top)); X_Max : constant string := integer'image(Port.Right); New_Color_Char : constant character := Color_Char(Color); begin -- VT240 dependent if System_Mode = Text then -- temporarily change to graphics mode Put(TT, Ascii.Esc); Put(TT, "P1p"); end if; if New_Color_Char /= Old_Color_Char then Put(TT, "W(I("); Put(TT, New_Color_Char); Put(TT, "))"); Old_Color_Char := New_Color_Char; end if; Put(TT, "P[" & X_Max & "," & integer'image(Adjust_Y_To_Screen(Port.Bottom)) & "]W(S1)V[" & X_Max & "," & Y_Min & "][" & integer'image(Port.Left) & "," & Y_Min & "]W(S0)" ); if System_Mode = Text then -- change it back Put(TT, Ascii.Esc); Put(TT, "\"); end if; end Erase_Port; procedure Frame_Port is -- Draw a frame around the port currently being drawn in. New_Top : integer := Adjust_Y_To_Screen(Draw_Port.Top); New_Bottom : integer := Adjust_Y_To_Screen(Draw_Port.Bottom); begin Draw_Segment(Draw_Port.Left, New_Top, Draw_Port.Right, New_Top, Draw_Port.Color); Draw_Segment(Draw_Port.Right, New_Top, Draw_Port.Right, New_Bottom, Draw_Port.Color); Draw_Segment(Draw_Port.Right, New_Bottom, Draw_Port.Left, New_Bottom, Draw_Port.Color); Draw_Segment(Draw_Port.Left, New_Bottom, Draw_Port.Left, New_Top, Draw_Port.Color); end Frame_Port ; procedure Move_To(New_X, New_Y: in Coordinate) is -- Move the drawing start position to the absolute coordinates (New_X, New_Y). begin Draw_Port.X_Current := New_X; Draw_Port.Y_Current := New_Y; end Move_To; procedure Move_To(New_X, New_Y: in integer) is begin Draw_Port.X_Current := float(New_X); Draw_Port.Y_Current := float(New_Y); end Move_To; procedure Move(Delta_X, Delta_Y: in Coordinate) is -- Change the drawing start position by Delta_X and Delta_Y. begin Move_To( Draw_Port.X_Current + Delta_X, Draw_Port.Y_Current + Delta_Y ); end Move; procedure Move(Delta_X, Delta_Y: in integer) is begin Move_To( Draw_Port.X_Current + float(Delta_X), Draw_Port.Y_Current + float(Delta_Y)); end Move; procedure Clip(X1, Y1, X2, Y2: in out Coordinate; In_View: in out boolean) is -- Given an imaginary line segment between the coordinates (X1,Y1) and -- (X2, Y2), insure that they are within the current View_Port. -- In_View is returned false iff the line segment lies completely outside of -- the View_Port. -- The algorithm is taken from Newman and Sproull, Principles of Interactive -- Computer Graphics pp. 66-67. type Edge is (Left, Bottom, Right, Top); type Edge_Set is array(Left..Top) of boolean; yy : Edge; C, C1, C2 : Edge_Set; X, Y : Coordinate; None : constant Edge_Set := Edge_Set'(others => false); Off_Screen_Completely : exception; procedure Code(X, Y: in Coordinate; C: out Edge_Set) is begin C := None; if Less_Than(X, Draw_Port.WX_Min) then C(Left) := true; elsif Greater_Than(X, Draw_Port.WX_Max) then C(Right) := true; end if; if Less_Than(Y, Draw_Port.WY_Min) then C(Bottom) := true; elsif Greater_Than(Y, Draw_Port.WY_Max) then C(Top) := true; end if; end Code; function C1_and_C2_ne_None return boolean is -- make up for compiler bug. Result : boolean := false; I : Edge; begin I := Left; loop if C1(I) and C2(I) then Result := true; exit; end if; exit when I = Top; I := Edge'Succ(I); end loop; return Result; end C1_and_C2_ne_None; begin -- Clip Code(X1, Y1, C1); Code(X2, Y2, C2); while (C1 /= None) or (C2 /= None) loop if C1_and_C2_ne_None then raise Off_Screen_Completely; end if; C := C1; if C = None then C := C2; end if; if C(Left) then -- Crosses left edge Y := Y1 + (Y2 - Y1) * (Draw_Port.WX_Min - X1) / (X2 - X1); X := Draw_Port.WX_Min; elsif C(Bottom) then -- Crosses bottom edge X := X1 + (X2 - X1) * (Draw_Port.WY_Min - Y1) / (Y2 - Y1); Y := Draw_Port.WY_Min; elsif C(Right) then -- Crosses right edge Y := Y1 + (Y2 - Y1) * (Draw_Port.WX_Max - X1) / (X2 - X1); X := Draw_Port.WX_Max; elsif C(Top) then -- Crosses top edge X := X1 + (X2 - X1) * (Draw_Port.WY_Max - Y1) / (Y2 - Y1); Y := Draw_Port.WY_Max; end if; if C = C1 then X1 := X; Y1 := Y; Code(X, Y, C1); else X2 := X; Y2 := Y; Code(X, Y, C2); end if; end loop; In_View := true; exception when Off_Screen_Completely => In_View := false; end Clip; procedure Line_To(New_X, New_Y: in Coordinate) is -- Draw a line from the drawing start position to the absolute coordinates -- (New_X, New_Y). SX, SY, EX, EY : Coordinate; Drawable : boolean; begin SX := Draw_Port.X_Current; SY := Draw_Port.Y_Current; EX := New_X; EY := New_Y; Clip(SX, SY, EX, EY, Drawable); if Drawable then Draw_Line(SX, SY, EX, EY, Draw_Port.Color); end if; Draw_Port.X_Current := New_X; Draw_Port.Y_Current := New_Y; end Line_To; procedure Line_To(New_X, New_Y: in integer) is begin Line_To(float(New_X), float(New_Y)); end Line_To; procedure Line(Delta_X, Delta_Y: in Coordinate) is -- Draw a line from the drawing start position to the point Delta_X and -- Delta_Y away. begin Line_To( Draw_Port.X_Current + Delta_X, Draw_Port.Y_Current + Delta_Y ); end Line; procedure Line(Delta_X, Delta_Y: in integer) is begin Line_To( Draw_Port.X_Current + float(Delta_X), Draw_Port.Y_Current + float(Delta_Y)); end Line; procedure Set_Color(Color_Code: in Color_Spectrum) is -- Change the drawing color to Color_Code returning the previous color. -- The Color_Spectrum is defined to range from 0.0 (black) to 1.0 (white). -- Any color code outside that range will cause Illegal_Color exception to -- be raised. begin if Color_Code < 0.0 or Color_Code > 1.0 then raise Illegal_Color; else Draw_Port.Color := Color_Code; end if; end Set_Color; function Set_Color(Color_Code: in Color_Spectrum) return Color_Spectrum is Old_Color_Code : Color_Spectrum := Draw_Port.Color; begin Set_Color(Color_Code); return Old_Color_Code; end Set_Color; procedure Set_Color(Color: in Color_Type) is begin Set_Color(Color_To_Spectrum(Color)); end Set_Color; function Set_Color(Color: in Color_Type) return Color_Type is Old_Color : Color_Type := Spectrum_To_Color(Draw_Port.Color); begin Set_Color(Color_To_Spectrum(Color)); return Old_Color; end Set_Color; procedure Where_Am_I(Current_X, Current_Y: out Coordinate) is begin Current_X := Draw_Port.X_Current; Current_Y := Draw_Port.Y_Current; end Where_Am_I; procedure Set_Mode(Mode: in Terminal_Mode) is -- VT241 dependent begin if Mode /= System_Mode then if Mode = Graphics then Put(TT, Ascii.Esc); Put(TT, "Pp"); else Put(TT, Ascii.Esc); Put(TT, "\"); end if; end if; System_Mode := Mode; end Set_Mode; procedure Print_Screen(File_Name : String) is -- Put the screen to a file for output to a graphic printer. -- This is not implemented for this device. begin null; end Print_Screen; function What_Port return View_Port is begin return Draw_Port; end What_Port; begin -- Graphic initialization -- VT241 dependent -- Allocate VT241 terminal -- Reset terminal to defaults -- Enter regis mode -- Set color map to Dark, Blue, Red, Green -- Set screen background to Dark -- Turn off graphic cursor -- Erase screen -- Exit regis mode begin Open(TT, Out_File, "TD$VT241:"); exception when use_error => Put("Graphic output going to GRAPH.LIS"); Create(TT, Out_File, "GRAPH.LIS"); end; Put(TT, Ascii.Esc); Put(TT, "!p"); Put(TT, Ascii.Esc); Put(TT, "Pp"); Put(TT, "S(M0(D)1(B)2(R)3(G),I(D),C0,E)"); Put(TT, Ascii.Esc); Put(TT, "\"); end Graphic; --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: --plotmenu.sp --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: with GRAPHIC; package PLOT_MENU is use GRAPHIC; subtype FILENAME is string ( 1 .. 40 ); subtype MAP_TITLE is string ( 1 .. 40 ); type KIND_OF_PROJECTION is ( STEREOgraphic, ORTHOgraphic, GNOMONIC, SATELLITE, LAMBERT, AZIMUTHAL, CARTESIAN, MERCATOR ); type PROJECTION_PARAMETERS is record LAT_CENTER : float; LON_CENTER : float; CLK_ROT_AR_CENT : float; SAT_ALTITUDE : float; VIEW_ALTITUDE : float; end record; type GRID_LINE_PARAMETERS is record SHOW_LINES : boolean; DEGREES_BTWN_LATS : float; DEGREES_BTWN_LONS : float; SEGMENT_LENGTH : float; end record; type KIND_OF_PROJECTION_LIMIT is ( ALL_EARTH, MIN_MAX_LAT_LON, MIN_MAX_COORDINATES, ANGULAR_DIST_FROM_PROJECTION_CENTER, LAT_LON_BOUNDARY ); type CORRD is record X : float; Y : float; end record; type PROJECTION_LIMITS is record MIN_LAT_LON : CORRD; MAX_LAT_LON : CORRD; NORTH_EAST : CORRD; SOUTH_WEST : CORRD; ANGLE_UP : float; ANGLE_DOWN : float; ANGLE_RIGHT : float; ANGLE_LEFT : float; POINT_UP : CORRD; POINT_DOWN : CORRD; POINT_RIGHT : CORRD; POINT_LEFT : CORRD; end record; type COLOR_SELECTION is record BACKGROUND : COLOR_TYPE; DEFAULT : COLOR_TYPE; MAP_OUTLINE : COLOR_TYPE; GRID_LINES : COLOR_TYPE; HORIZON : COLOR_TYPE; end record; type SPECIAL_DISPLAYS is record BEAM_DATA : FILENAME ; BEAM_COLOR : COLOR_TYPE; BEAM_LAST : integer; SWATH_DATA : FILENAME ; SWATH_COLOR : COLOR_TYPE; SWATH_LAST : integer; POINTS_DATA : FILENAME ; POINTS_COLOR : COLOR_TYPE; POINTS_LAST : integer; end record; type DIAGNOSTICS is record WARNING : boolean; ERROR : boolean; FATAL : boolean; end record; type PLOT_CHARACTERISTICS is record AXIS_LENGTH : CORRD; ORIGIN : CORRD; end record; TYPE_OF_PROJECTION : KIND_OF_PROJECTION; TYPE_OF_PROJECTION_LIMIT : KIND_OF_PROJECTION_LIMIT; Current_TITLE : MAP_TITLE; CURRENT_GRID_LINE_PARAMETERS : GRID_LINE_PARAMETERS; CURRENT_COLOR_SELECTION : COLOR_SELECTION; CURRENT_SPECIAL_DISPLAYS : SPECIAL_DISPLAYS; CURRENT_PROJECTION_PARAMETERS : PROJECTION_PARAMETERS; CURRENT_PROJECTION_LIMITS : PROJECTION_LIMITS; CURRENT_PLOT_CHAR : PLOT_CHARACTERISTICS; -- CLIPPING : boolean; PLOT_LAND : boolean; CURRENT_DIAGNOSTICS : DIAGNOSTICS; function SHOW_GRID return boolean; function SHOW_BEAM return boolean; function SHOW_SWATH return boolean; procedure DRAW_ERROR_PORT ( TEXT1 : in string; TEXT : in string ); procedure OPEN_MENU_FILE ( FILE : in string ); -- use for OPENF command. procedure CLOSE_MENU_FILE; -- use for OPENF & SAVE commands. procedure READ_SESSION_DEFAULTS; end PLOT_MENU; --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: --plotmenu.txt --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: with text_io; package body PLOT_MENU is use TEXT_IO; package FLT_IO is new FLOAT_IO ( float ); use FLT_IO; CURRENT_FILE : FILE_TYPE; HOLD_STRING : string ( 1 .. 40 ) := ( 1 .. 40 => ' ' ); LAST : integer := 0; function SHOW_GRID return boolean is begin return CURRENT_GRID_LINE_parameters.SHOW_LINES; end SHOW_GRID; function SHOW_BEAM return boolean is TEMP : boolean := false; begin if current_special_displays.BEAM_LAST /= 0 then TEMP := true; end if; return TEMP; end SHOW_BEAM; function SHOW_SWATH return boolean is TEMP : boolean := false; begin if current_special_displays.SWATH_LAST /= 0 then TEMP := true; end if; return TEMP; end SHOW_SWATH; procedure DRAW_ERROR_PORT ( TEXT1: IN STRING; TEXT : IN STRING ) IS BEGIN NULL; END; procedure OPEN_MENU_FILE ( FILE : in string ) is -- use for OPENF command. begin OPEN ( CURRENT_FILE, IN_FILE, FILE ( FILE'first .. FILE'last ) ); end OPEN_MENU_FILE; procedure CLOSE_MENU_FILE is -- use for OPENF & SAVE commands. begin CLOSE ( CURRENT_FILE ); end CLOSE_MENU_FILE; procedure READ ( ITEM : in out float ) is begin GET ( CURRENT_FILE, ITEM ); SKIP_LINE ( CURRENT_FILE ); end READ; procedure READ ( ITEM : in out string; LAST : in out integer ) is begin GET_LINE ( CURRENT_FILE, ITEM, LAST ); end READ; procedure READ_DISPLAY_DEFAULTS is begin READ ( current_TITLE, LAST ); READ ( HOLD_STRING, LAST ); TYPE_OF_PROJECTION := KIND_OF_PROJECTION'value ( HOLD_STRING ( 1 .. LAST ) ); READ ( CURRENT_PROJECTION_PARAMETERS.LAT_CENTER ); READ ( CURRENT_PROJECTION_PARAMETERS.LON_CENTER ); READ ( CURRENT_PROJECTION_PARAMETERS.CLK_ROT_AR_CENT ); READ ( CURRENT_PROJECTION_PARAMETERS.SAT_ALTITUDE ); READ ( CURRENT_PROJECTION_PARAMETERS.VIEW_ALTITUDE ); READ ( HOLD_STRING, LAST ); TYPE_OF_PROJECTION_LIMIT := KIND_OF_PROJECTION_LIMIT'value ( HOLD_STRING ( 1 .. LAST ) ); READ ( CURRENT_PROJECTION_LIMITS.MIN_LAT_LON.X ); READ ( CURRENT_PROJECTION_LIMITS.MIN_LAT_LON.Y ); READ ( CURRENT_PROJECTION_LIMITS.MAX_LAT_LON.X ); READ ( CURRENT_PROJECTION_LIMITS.MAX_LAT_LON.Y ); READ ( CURRENT_PROJECTION_LIMITS.NORTH_EAST.X ); READ ( CURRENT_PROJECTION_LIMITS.NORTH_EAST.Y ); READ ( CURRENT_PROJECTION_LIMITS.SOUTH_WEST.X ); READ ( CURRENT_PROJECTION_LIMITS.SOUTH_WEST.Y ); READ ( CURRENT_PROJECTION_LIMITS.ANGLE_UP ); READ ( CURRENT_PROJECTION_LIMITS.ANGLE_DOWN ); READ ( CURRENT_PROJECTION_LIMITS.ANGLE_RIGHT ); READ ( CURRENT_PROJECTION_LIMITS.ANGLE_LEFT ); READ ( CURRENT_PROJECTION_LIMITS.POINT_UP.X ); READ ( CURRENT_PROJECTION_LIMITS.POINT_UP.Y ); READ ( CURRENT_PROJECTION_LIMITS.POINT_DOWN.X ); READ ( CURRENT_PROJECTION_LIMITS.POINT_DOWN.Y ); READ ( CURRENT_PROJECTION_LIMITS.POINT_RIGHT.X ); READ ( CURRENT_PROJECTION_LIMITS.POINT_RIGHT.Y ); READ ( CURRENT_PROJECTION_LIMITS.POINT_LEFT.X ); READ ( CURRENT_PROJECTION_LIMITS.POINT_LEFT.Y ); READ ( HOLD_STRING, LAST ); CURRENT_COLOR_SELECTION.BACKGROUND := COLOR_TYPE'value ( HOLD_STRING ( 1 .. LAST ) ); READ ( HOLD_STRING, LAST ); CURRENT_COLOR_SELECTION.DEFAULT := COLOR_TYPE'value ( HOLD_STRING ( 1 .. LAST ) ); READ ( HOLD_STRING, LAST ); CURRENT_COLOR_SELECTION.MAP_OUTLINE := COLOR_TYPE'value ( HOLD_STRING ( 1 .. LAST ) ); READ ( HOLD_STRING, LAST ); CURRENT_COLOR_SELECTION.GRID_LINES := COLOR_TYPE'value ( HOLD_STRING ( 1 .. LAST ) ); READ ( HOLD_STRING, LAST ); CURRENT_COLOR_SELECTION.HORIZON := COLOR_TYPE'value ( HOLD_STRING ( 1 .. LAST ) ); READ ( HOLD_STRING, LAST ); CURRENT_GRID_LINE_PARAMETERS.SHOW_LINES := boolean'value ( HOLD_STRING ( 1 .. LAST ) ); READ ( CURRENT_GRID_LINE_PARAMETERS.DEGREES_BTWN_LATS ); READ ( CURRENT_GRID_LINE_PARAMETERS.DEGREES_BTWN_LONS ); READ ( CURRENT_GRID_LINE_PARAMETERS.SEGMENT_LENGTH ); -- READ ( HOLD_STRING, LAST ); -- CLIPPING := boolean'value ( HOLD_STRING ( 1 .. LAST ) ); READ ( HOLD_STRING, LAST ); PLOT_LAND := boolean'value ( HOLD_STRING ( 1 .. LAST ) ); exception when others => raise CONSTRAINT_ERROR; end READ_DISPLAY_DEFAULTS; procedure READ_SESSION_DEFAULTS is begin READ_DISPLAY_DEFAULTS; READ ( CURRENT_SPECIAL_DISPLAYS.BEAM_DATA, LAST ); READ ( HOLD_STRING, LAST ); CURRENT_SPECIAL_DISPLAYS.BEAM_COLOR := COLOR_TYPE'value ( HOLD_STRING ( 1 .. LAST ) ); READ ( HOLD_STRING, LAST ); CURRENT_SPECIAL_DISPLAYS.BEAM_LAST := integer'value ( HOLD_STRING ( 1 .. LAST ) ); READ ( CURRENT_SPECIAL_DISPLAYS.SWATH_DATA, LAST ); READ ( HOLD_STRING, LAST ); CURRENT_SPECIAL_DISPLAYS.SWATH_COLOR := COLOR_TYPE'value ( HOLD_STRING ( 1 .. LAST ) ); READ ( HOLD_STRING, LAST ); CURRENT_SPECIAL_DISPLAYS.SWATH_LAST := integer'value ( HOLD_STRING ( 1 .. LAST ) ); READ ( CURRENT_SPECIAL_DISPLAYS.POINTS_DATA, LAST ); READ ( HOLD_STRING, LAST ); CURRENT_SPECIAL_DISPLAYS.POINTS_COLOR := COLOR_TYPE'value ( HOLD_STRING ( 1 .. LAST ) ); READ ( HOLD_STRING, LAST ); CURRENT_SPECIAL_DISPLAYS.POINTS_LAST := integer'value ( HOLD_STRING ( 1 .. LAST ) ); READ ( HOLD_STRING, LAST ); CURRENT_DIAGNOSTICS.WARNING := boolean'value ( HOLD_STRING ( 1 .. LAST ) ); READ ( HOLD_STRING, LAST ); CURRENT_DIAGNOSTICS.ERROR := boolean'value ( HOLD_STRING ( 1 .. LAST ) ); READ ( HOLD_STRING, LAST ); CURRENT_DIAGNOSTICS.FATAL := boolean'value ( HOLD_STRING ( 1 .. LAST ) ); READ ( current_PLOT_CHAR.AXIS_LENGTH.X ); READ ( current_PLOT_CHAR.AXIS_LENGTH.Y ); READ ( current_PLOT_CHAR.ORIGIN.X ); READ ( current_PLOT_CHAR.ORIGIN.Y ); exception when others => raise CONSTRAINT_ERROR; end READ_SESSION_DEFAULTS; begin null; end PLOT_MENU; --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: --plot.txt --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: with Text_Io, Core_Functions, Trig_Lib, Numeric_Primitives, Plot_Menu, World_Data_Files; use Text_Io, Core_Functions, Trig_Lib, Numeric_Primitives, Plot_Menu, World_Data_Files, Graphic; procedure Plot is Map : View_Port; Namer : string ( 1 .. 40 ) := ( 1 .. 40 => ' ' ); Laster : integer := 0; procedure Draw_Map is -- Draw the map defined by the World_Menus package. type Beam_Or_Symbol is (Map_Data, Beam_Data, Symbol_Data); Eps : constant float := 1.0E-7; -- Small number used to avoid divide by zero errors. Way_Out : constant float := 1.0E+8; -- A location always off the screen. Radians_Per_Degree : constant float := 0.0174532925; Degrees_Per_Radian : constant float := 57.295779510; Max_Points : constant := 400; type Float_Array is array (1..Max_Points) of float; Map_Color : constant Color_Selection := Plot_Menu.Current_Color_Selection; Limit_Type : constant Kind_Of_Projection_Limit := Type_Of_Projection_Limit; Projection : Kind_Of_Projection := Type_Of_Projection; Proj_Params : Projection_Parameters; Specials : constant Special_Displays := Current_Special_Displays; Max_Line : float; -- The longest allowable line on the screen. Phio : float; -- The longitude center of the projection. Symbol : integer;-- The symbol to be used 1 --> Square -- 2 --> Plus -- 3 --> Diamond -- 4 --> Triangle Symbol_Size : float; -- The size of the symbol to be drawn is Symbol_Scale: constant float := 100.0; -- <window width> / Symbol_Scale. Lon_Pic_Min, Lon_Pic_Max, -- The min's and max's of the viewport Lat_Pic_Min, -- used to avoid plotting points that cannot Lat_Pic_Max : float; -- possibly be visible. SinO, CosO, -- Sin and Cos of the center of the projection SinR, CosR : float; -- Sin and Cos of the rotation Umin, Umax, -- The basis for determining the windowing Vmin, -- of the Viewport. Vmax : float; Caught_Error : exception; function Sat_Scale(Alt, Ref_Alt : float) return float is -- Finds scale for satellite view. Earth_Radius : constant float := 3443.9336; F, H, Alfa, Beta : float; begin if Alt <= 0.0 then Put_Line("Invalid Satellite Altitude. Plot aborted."); raise Caught_Error; elsif Ref_Alt <= 0.0 then Put_Line("Invalid Satellite Reference Altitude. Plot aborted."); raise Caught_Error; end if; F := Ref_Alt / Earth_Radius; H := Alt / Earth_Radius; Beta := ASin(1.0 / (1.0 + H)); Alfa := ASin(1.0 / (1.0 + F)); F := Tan(Beta) / Tan(Alfa); return F / (H * Beta); end Sat_Scale; procedure Project(Lat, Lon : in float; U, V : out float) is -- Sets up the calls to the various projection algorithms. -- The point (Lat, Lon) is input in degrees and is transformed -- to (U, V) in the mapping coordinates according to the kind -- of projection. R, H, SinA, CosA, SinB, CosB, SinPH, CosPH, SinLat, CosLat : float; Del_Lon : float; function Calc_Del_Lon(Lon : float) return float is -- Offsets Lon by the center of the projection adjusting for wraparound. Del_Lon : float; begin Del_Lon := Lon - Phio; if Del_Lon >= 180.0 then Del_Lon := Del_Lon - 360.0; elsif Del_Lon < -180.0 then Del_Lon := Del_Lon + 360.0; end if; return Del_Lon; end Calc_Del_Lon; procedure Do_Trig_Calculations is begin SinPH := Sin(Del_Lon * Radians_Per_Degree); CosPH := Cos(Del_Lon * Radians_Per_Degree); SinLat := Sin( Lat * Radians_Per_Degree); CosLat := Cos( Lat * Radians_Per_Degree); CosA := SinLat*SinO + CosLat*CosO*CosPH; if abs(CosA) > 1.0 then CosA := Sign(1.0, CosA); end if; SinA := Sqrt( 1.0 + Eps - CosA*CosA); SinB := CosLat * SinPH / SinA; CosB := (SinLat*CosO - CosLat*SinO*CosPH) / SinA; end Do_Trig_Calculations; procedure Cylin(Lat, Lon : in float; U, V : out float) is -- This is a cylindrcal projection routine. -- Point (Lat, Lon) is transformed to mapping coordinates (U, V). Out_Of_Range : exception; begin Del_Lon := Calc_Del_Lon(Lon); if Proj_Params.Lat_Center = 0.0 then Case Projection is when Cartesian => U := Del_Lon; V := Lat; when Mercator => U := Del_Lon * Radians_Per_Degree; V := Log( Tan(0.00872664*(Lat+90.0001)) ); when others => null; end case; else Do_Trig_Calculations; Case Projection is when Cartesian => if abs(1.0 - CosA*CosA) < 1.0E-4 then raise Out_Of_Range; end if; U := ATan2(SinB*CosR + CosB*SinR, SinB*SinR - CosB*CosR) * Degrees_Per_Radian; V := 90.0 - ACos(CosA)*Degrees_Per_Radian; when Mercator => if abs(1.0 - CosA*CosA) < 2.0E-6 then raise Out_Of_Range; end if; U := ATan2(SinB*CosR + CosB*SinR, SinB*SinR - CosB*CosR); V := Log( (1.0+CosA) / SinA); when others => null; end case; end if; exception when Out_Of_Range => U := Way_Out; V := Way_Out; end Cylin; procedure Azim(Lat, Lon : in float; U, V : out float) is -- This is an Azimuthal projection routine. -- Point (Lat, Lon) is transformed to mapping coordinates (U, V). R, H : float; Out_Of_Range : exception; begin -- Azim Del_Lon := Calc_Del_Lon(Lon); Do_Trig_Calculations; case Projection is when Stereographic => R := (1.0 - CosA) / SinA; when Gnomonic => null; if CosA <= 0.0 then raise Out_Of_Range; end if; R := SinA / CosA; when Lambert => if abs(CosA+1.0) < 1.0E-6 then raise Out_Of_Range; end if; R := (1.0 + CosA) / SinA; R := 2.0 / (Sqrt(1.0 + R*R)); when Orthographic => if CosA <= 0.0 then raise Out_Of_Range; end if; R := SinA; when Satellite => H := Proj_Params.Sat_Altitude / 3444.0; if (CosA - 1.0/(H+1.0)) <= 0.0 then raise Out_Of_Range; end if; R := Sat_Scale(Proj_Params.Sat_Altitude, Proj_Params.View_Altitude) * H * ATan( SinA / (H+1.0-CosA)); when Azimuthal => null; if abs(CosA+1.0) < 1.0E-6 then raise Out_Of_Range; end if; R := ACos(CosA); when others => null; end case; U := R * (SinB*CosR + CosB*SinR); V := R * (CosB*CosR - SinB*SinR); exception when Out_Of_Range => U := Way_Out; V := Way_Out; end Azim; begin -- Project case Projection is when Cartesian | Mercator => Cylin(Lat, Lon, U, V); when others => Azim(Lat, Lon, U, V); end case; end Project; procedure Initialize_Plot is -- Sets Umin, Umax, Vmin, and Vmax. In other words, it determines -- the minimums and maximums of the viewing of the projection. -- These four variables are what determine the "zooming" characteristics. Limits : constant Projection_Limits := Plot_Menu.Current_Projection_Limits; Phia : float; -- the latitude center of the projection. SinO1, CosO1 : float; procedure Do_All_Earth is -- Set limits to see as much of the earth is possible for this projection. begin case Projection is when Stereographic | Gnomonic | Lambert => Umin := -2.0; Umax := 2.0; Vmin := -2.0; Vmax := 2.0; when Orthographic | Satellite => Umin := -1.0; Umax := 1.0; Vmin := -1.0; Vmax := 1.0; when Azimuthal | Mercator => Umin := -180.0 * Radians_Per_Degree; Umax := -Umin; Vmin := Umin * 0.9; Vmax := Umax; when Cartesian => Umin := -180.0; Umax := 180.0; Vmin := -90.0; Vmax := 90.0; end case; end Do_All_Earth; procedure Force_In_Bounds(Umin, Umax, Vmin, Vmax : in out float) is -- Given a projection such as orthographic, not all of the points can -- can be plotted for a given projection because they will be on the -- other side of the globe. The user may zoom in by giving limits -- where some of them are on the other side of the globe. -- This routine adjusts to limits which are not visible by adjusting -- the limit to be on the horizon or the line between visibility and -- invisibility. begin if Umin >= Way_Out then case Projection is when Stereographic | Gnomonic | Lambert => Umin := -2.0; when Orthographic | Satellite => Umin := -1.0; when Azimuthal | Mercator => Umin := -180.0 * Radians_Per_Degree; when Cartesian => Umin := -180.0; end case; end if; if Umax >= Way_Out then case Projection is when Stereographic | Gnomonic | Lambert => Umax := 2.0; when Orthographic | Satellite => Umax := 1.0; when Azimuthal | Mercator => Umax := 180.0 * Radians_Per_Degree; when Cartesian => Umax := 180.0; end case; end if; if Vmin >= Way_Out then case Projection is when Stereographic | Gnomonic | Lambert => Vmin := -2.0; when Orthographic | Satellite => Vmin := -1.0; when Azimuthal | Mercator => Vmin := -180.0 * Radians_Per_Degree; when Cartesian => Vmin := -90.0; end case; end if; if Vmax >= Way_Out then case Projection is when Stereographic | Gnomonic | Lambert => Vmax := 2.0; when Orthographic | Satellite => Vmax := 1.0; when Azimuthal | Mercator => Vmax := 180.0 * Radians_Per_Degree; when Cartesian => Vmax := 90.0; end case; end if; end Force_In_Bounds; procedure Do_Min_Max_Lat_Lon is -- Limits are defined by min/max latitudes and min/max longitudes. U1, V1, U2, V2 : float; function Max(X, Y : float) return float is begin if X > Y then return X; else return Y; end if; end Max; function Min(X, Y : float) return float is begin if X > Y then return Y; else return X; end if; end Min; begin -- Do_Min_Max_Lat_Lon Lat_Pic_Min := Limits.Min_Lat_Lon.Y; Lat_Pic_Max := Limits.Max_Lat_Lon.Y; Lon_Pic_Min := Limits.Min_Lat_Lon.X; Lon_Pic_Max := Limits.Max_Lat_Lon.X; Project(Lat_Pic_Min, Lon_Pic_Min, U1, V1); Project(Lat_Pic_Max, Lon_Pic_Min, U2, V2); Force_In_Bounds(U1, V1, U2, V2); Vmin := Min(V1, V2); Vmax := Max(V1, V2); Umin := Min(U1, U2); Umax := Max(U1, U2); end Do_Min_Max_Lat_Lon; procedure Do_Min_Max_Coordinates is -- Limits are defined by two points of a rectangle, one in the upper -- right corner and one in the lower left corner. TUmin, TVmin, TUmax, TVmax : float; function Map(Val, Max_Val : float) return float is begin if Val > Max_Val then return Val - 2.0*Max_Val; else return Val; end if; end Map; begin -- Do_Min_Max_Coordinates Lon_Pic_Min := Map(Limits.South_West.X, 180.0); Lon_Pic_Max := Map(Limits.North_East.X, 180.0); Lat_Pic_Min := Map(Limits.South_West.Y, 90.0); Lat_Pic_Max := Map(Limits.North_East.Y, 90.0); Project(Lat_Pic_Min, Lon_Pic_Min, TUmin, TVmin); Project(Lat_Pic_Max, Lon_Pic_Max, TUmax, TVmax); Force_In_Bounds(TUmin, TUmax, TVmin, TVmax); Umin := TUmin; Vmin := TVmin; Umax := TUmax; Vmax := TVmax; end Do_Min_Max_Coordinates; procedure Do_Angular is -- Limits are determined by earth central angles. TUmin : float := Limits.Angle_Left; TUmax : float := Limits.Angle_Right; TVmin : float := Limits.Angle_Down; TVmax : float := Limits.Angle_Up; CosUmin : constant float := Cos(TUmin * Radians_Per_Degree); SinUmin : constant float := Sqrt(1.0 + Eps - CosUmin*CosUmin); CosUmax : constant float := Cos(TUmax * Radians_Per_Degree); SinUmax : constant float := Sqrt(1.0 + Eps - CosUmax*CosUmax); CosVmin : constant float := Cos(TVmin * Radians_Per_Degree); SinVmin : constant float := Sqrt(1.0 + Eps - CosVmin*CosVmin); CosVmax : constant float := Cos(TVmax * Radians_Per_Degree); SinVmax : constant float := Sqrt(1.0 + Eps - CosVmax*CosVmax); Bad_Limits : exception; begin case Projection is when Stereographic => Umin := -(1.0 - CosUmin) / SinUmin; Umax := (1.0 - CosUmax) / SinUmax; Vmin := -(1.0 - CosVmin) / SinVmin; Umax := (1.0 - CosUmax) / SinUmax; when Orthographic => if TUmin > 90.0 or TUmax > 90.0 or TVmin > 90.0 or TUmax > 90.0 then raise Bad_Limits; end if; Umin := -SinUmin; Umax := SinUmax; Vmin := -SinVmin; Vmax := SinVmax; when Gnomonic => if TUmin >= 90.0 or TUmax >= 90.0 or TVmin >= 90.0 or TUmax >= 90.0 then raise Bad_Limits; end if; Umin := -SinUmin / CosUmin; Umax := SinUmax / CosUmax; Vmin := -SinVmin / CosVmin; Vmax := SinVmax / CosVmax; when Lambert => TUmin := (1.0 + CosUmin) / SinUmin; Umin := -2.0 / Sqrt(1.0 + TUmin*TUmin); TUmax := (1.0 + CosUmax) / SinUmax; Umax := 2.0 / Sqrt(1.0 + TUmax*TUmax); TVmin := (1.0 + CosVmin) / SinVmin; Vmin := -2.0 / Sqrt(1.0 + TVmin*TVmin); TVmax := (1.0 + CosVmax) / SinVmax; Vmax := 2.0 / Sqrt(1.0 + TVmax*TVmax); when Azimuthal => Umin := -TUmin * Radians_Per_Degree; Umax := TUmax * Radians_Per_Degree; Vmin := -TVmin * Radians_Per_Degree; Vmax := TVmax * Radians_Per_Degree; when Cartesian => Umin := -TUmin; Umax := TUmax; Vmin := -TVmin; Vmax := TVmax; when Mercator => if TVmin >= 90.0 or TUmax >= 90.0 then raise Bad_Limits; end if; Umin := -TUmin * Radians_Per_Degree; Umax := TUmax * Radians_Per_Degree; Vmin := -Log((1.0+SinVmin) / CosVmin); Vmax := Log((1.0+SinVmax) / CosVmax); when Satellite => Umin := -1.0; Umax := 1.0; Vmin := -1.0; Vmax := 1.0; end case; exception when Bad_Limits => Put_Line("Angular limits too great. Plot aborted."); raise Caught_Error; end Do_Angular; procedure Do_Lat_Lon_Boundary is -- Limits are determined by four points, one on each of the four -- sides of a rectangle. U1, V1, U2, V2, U3, V3, U4, V4 : float; begin Lat_Pic_Min := Limits.Point_Down.Y; Lat_Pic_Max := Limits.Point_Up.Y; Lon_Pic_Min := Limits.Point_Left.X; Lon_Pic_Max := Limits.Point_Right.X; Project(Limits.Point_Left.Y, Lon_Pic_Min, U1, V1); Project(Lat_Pic_Min, Limits.Point_Down.X, U2, V2); Project(Limits.Point_Right.Y, Lon_Pic_Max, U3, V3); Project(Lat_Pic_Max, Limits.Point_Up.X, U4, V4); Force_In_Bounds(U1, U3, V2, V4); Umin := U1; Umax := U3; Vmin := V2; Vmax := V4; end Do_Lat_Lon_Boundary; procedure Do_Off_Center_Latitude is -- Set up for projections with centers off Latitude 0.0. begin case Projection is when Cartesian | Mercator => if Phia = 0.0 and Proj_Params.Clk_Rot_Ar_Cent = 0.0 then SinO := 1.0; CosO := 0.0; SinR := 0.0; CosR := 1.0; elsif Phia = 0.0 and abs(Proj_Params.Clk_Rot_Ar_Cent) = 180.0 then Phio := Phio + 180.0; SinO := -1.0; CosO := 0.0; SinR := 0.0; CosR := 1.0; else SinO1 := CosO*CosR; CosO1 := Sqrt(1.0 + Eps - SinO1*SinO1); Phio := Phio - ATan2(SinR/CosO1, -CosR*SinO/CosO1) * Degrees_Per_Radian; SinR := SinR * CosO/CosO1; CosR := -SinO/CosO1; SinO := SinO1; CosO := CosO1; end if; when others => null; end case; end Do_Off_Center_Latitude; procedure Set_Scaling is -- Sets the windowing of the viewport. -- Also determines the maximum line to be drawn to avoid wraparound problems. -- Also determines the size of the symbols to be drawn. X_Max : constant float := 17.0; -- Maximum these can ever be under Y_Max : constant float := 11.0; -- any circumstances. Scale : constant Plot_Characteristics := Plot_Menu.Current_Plot_Char; Delta_U, Delta_V : float; Left, Bottom, Right, Top: float; begin Delta_U := abs(Umax - Umin); Delta_V := abs(Vmax - Vmin); if Delta_U*0.6 > Delta_V then Left := Umin; Right := Umax; Top := (Vmin + Vmax) / 2.0; Bottom := Top; Symbol_Size := (Right - Left) * 0.6 / Symbol_Scale; else Top := Vmax; Bottom := Vmin; Left := (Umin + Umax) / 2.0; Right := Left; Symbol_Size := (Top - Bottom) / Symbol_Scale; end if; -- Set View_Port here Set_Window(Left, Bottom, Right, Top); -- calculate the length of a 30 degree line at the center of the projection Project(0.0, Proj_Params.Lon_Center-15.0, Left, Top); Project(0.0, Proj_Params.Lon_Center+15.0, Right, Top); -- Make that the maximum length line drawable Max_Line := abs(Right - Left); end Set_Scaling; begin -- Initialize_Plot Lat_Pic_Max := 90.0; Lat_Pic_Min := -90.0; Lon_Pic_Max := 180.0; Lon_Pic_Min := -180.0; Phia := Proj_Params.Lat_Center; Phio := Proj_Params.Lon_Center; SinR := Sin(Proj_Params.Clk_Rot_Ar_Cent * Radians_Per_Degree); CosR := Cos(Proj_Params.Clk_Rot_Ar_Cent * Radians_Per_Degree); SinO := Sin(Phia * Radians_Per_Degree); CosO := Cos(Phia * Radians_Per_Degree); Do_Off_Center_Latitude; case Type_Of_Projection_Limit is when All_Earth => Do_All_Earth; when Min_Max_Lat_Lon => Do_Min_Max_Lat_Lon; when Min_Max_Coordinates => Do_Min_Max_Coordinates; when Angular_Dist_From_Projection_Center => Do_Angular; when Lat_Lon_Boundary => Do_Lat_Lon_Boundary; end case; Set_Scaling; end Initialize_Plot; procedure Graff(NPts : in integer; U, V : in Float_Array; Mode : in integer) is -- Plots arrays NPts points from U and V. -- Mode : 1 - Line plot -- 2 - Point plot -- 3 - connect every other point (for grids) Line_Mode : constant := 1; Point_Mode : constant := 2; Dash_Mode : constant := 3; Even : boolean := true; procedure Square(Center_X, Center_Y, Size : in float) is Half_Size : constant float := Size / 2.0; begin Move_To(Center_X + Half_Size, Center_Y + Half_Size); Line( Size, 0.0); Line(0.0, -Size); Line(-Size, 0.0); Line(0.0, Size); end Square; procedure Plus(Center_X, Center_Y, Size : in float) is Half_Size : constant float := Size / 2.0; begin Move_To(Center_X - Half_Size, Center_Y); Line(Size, 0.0); Move_To(Center_X, Center_Y - Half_Size); Line(0.0, Size); end Plus; procedure Diamond(Center_X, Center_Y, Size : in float) is Half_Size : constant float := Size / 2.0; Horisize : constant float := Half_Size * 0.75; begin Move_To(Center_X, Center_Y + Half_Size); Line( Horisize, -Half_Size); Line(-Horisize, -Half_Size); Line(-Horisize, Half_Size); Line( Horisize, Half_Size); end Diamond; procedure Triangle(Center_X, Center_Y, Size : in float) is Half_Size : constant float := Size / 2.0; Bottom : constant float := Size * 0.433; begin Move_To(Center_X - Half_Size, Center_Y - Bottom); Line(Size, 0.0); Line(-Half_Size, Size); Line(-Half_Size, -Size); end Triangle; begin -- Graff Move_To(U(1), V(1)); case Mode is when Line_Mode => for I in 2..NPts loop if abs(U(I) - U(I-1)) > Max_Line THEN Move_To(U(I), V(I)); else Line_To(U(I), V(I)); end if; end loop; when Point_Mode => for I in 1 .. NPts loop case Symbol is when 1 => Square (U(I), V(I), Symbol_Size); when 2 => Plus (U(I), V(I), Symbol_Size); when 3 => Diamond (U(I), V(I), Symbol_Size); when others => Triangle(U(I), V(I), Symbol_Size); end case; end loop; when Dash_Mode => for I in 2..NPts loop if Even then if U(I-1) /= Way_Out then if abs(U(I) - U(I-1)) > Max_Line THEN Move_To(U(I), V(I)); else Line_To(U(I), V(I)); end if; end if; else Move_To(U(I), V(I)); end if; Even := not Even; end loop; when others => null; end case; end Graff; procedure Plot_Points(Points_Type : Beam_Or_Symbol; Name_Length : integer; File_Name : FileName; Draw_Color : Color_Type) is -- Plots map, beam, and symbol data. use World_Data_Files; Lat_Lon : Lat_Lon_Record; Point_File : World_Data_Io.File_Type; procedure Plot_Rec(Rec : Lat_Lon_Record) is Stop : constant integer := 2 * Lat_Lon.Number_Of_Pairs; N, I, NPts : integer; Draw_Mode : integer; ProjU, ProjV : Float_Array; begin if Points_Type = Symbol_Data then Draw_Mode := 2; else Draw_Mode := 1; end if; NPts := 0; I := 1; loop exit when I > Stop; NPts := NPts + 1; Project(Lat_Lon.Lat_Lon_Pairs(I), Lat_Lon.Lat_Lon_Pairs(I+1), ProjU(NPts), ProjV(NPts)); if NPts = Max_Points then Graff(Max_Points, ProjU, ProjV, Draw_Mode); ProjU(1) := ProjU(Max_Points); ProjV(1) := ProjV(Max_Points); NPts := 1; end if; I := I + 2; end loop; if NPts > 1 then Graff(NPts, ProjU, ProjV, Draw_Mode); end if; end Plot_Rec; function In_View return boolean is -- Determines whether or not the current record will be visible -- in the window. Lat_Min : constant float := Lat_Lon.Minimum_Lat; Lat_Max : constant float := Lat_Lon.Maximum_Lat; Lon_Min : float := Lat_Lon.Minimum_Lon; Lon_Max : float := Lat_Lon.Maximum_Lon; begin if Lon_Max > 180.0 then Lon_Min := Lon_Min - 180.0; Lon_Max := Lon_Max - 180.0; end if; if Lat_Min >= Lat_Pic_Max or else Lon_Min >= Lon_Pic_Max or else Lat_Max <= Lat_Pic_Min or else Lon_Max <= Lon_Pic_Min then return false; else return true; end if; end In_View; begin -- Plot_Points if Points_Type = Map_Data then Put_Line("Plotting Map..."); elsif Points_Type = Beam_Data then Put_Line("Plotting Beam Data..."); else Put_Line("Plotting Symbol Data..."); end if; World_Data_Io.Open(Point_File, World_Data_Io.in_file, File_Name(1..Name_Length), ""); Set_Mode(Graphics); Set_Color(Draw_Color); while not World_Data_Io.end_of_file(Point_File) loop World_Data_Io.Read(Point_File, Lat_Lon); if Points_Type = Symbol_Data then Symbol := integer(Lat_Lon.Minimum_Lat); Plot_Rec(Lat_Lon); elsif In_View then Plot_Rec(Lat_Lon); end if; end loop; Set_Mode(Text); exception when World_Data_Io.Name_Error => if Points_Type = Map_Data then Put_Line("Map file not found."); elsif Points_Type = Beam_Data then Put_Line("Beam file not found."); else Put_Line("Symbol file not found."); end if; end Plot_Points; procedure Draw_Limb is -- Draws Limb line around map. Segments : constant integer := 73; -- 5 degree increments (360/5 + 1) Sin1 : constant float := 8.71557420E-2; -- sin(360/(Segments-1)) Cos1 : constant float := 9.96194698E-1; -- cos(360/(Segments-1)) Radius, Axis, D, Angle : float; ProjU, ProjV : Float_Array; N : integer; Invalid_Operation : exception; begin Axis := 1.0; Case Projection is when Orthographic => Radius := 1.0; when Satellite => D := Proj_Params.Sat_Altitude / 3444.0; Radius := D * Sat_Scale(Proj_Params.Sat_Altitude, Proj_Params.View_Altitude) * ASin(1.0/(D+1.0)); when Lambert => Radius := 2.0; when Azimuthal => Radius := Pi; when others => raise Invalid_Operation; end case; ProjU(1) := Radius; ProjV(1) := 0.0; N := 1; Angle := 0.0; Set_Mode(Graphics); Set_Color(Map_Color.Map_Outline); for I in 1 .. Segments loop N := N + 1; Angle := Angle + 0.087266462; ProjU(N) := Radius*Cos(Angle); ProjV(N) := Radius*Sin(Angle); if N = Max_Points then Graff(N, ProjU, ProjV, 1); ProjU(1) := ProjU(N); ProjV(1) := ProjV(N); N := 1; end if; end loop; if N /= 1 then Graff(N, ProjU, ProjV, 1); end if; Set_Mode(Text); exception when Invalid_Operation => N := 0; -- null; end Draw_Limb; procedure Draw_Grids is -- Draws the grid lines on the map. Grid_Rec : constant Grid_Line_Parameters := Plot_Menu.Current_Grid_Line_Parameters; Lat_Initial : constant float := -90.0; Lat_Final : constant float := 89.0; Lon_Initial : constant float := -180.0; Lon_Final : constant float := 180.0; Increment : constant float := Grid_Rec.Segment_Length; Grid_Lat : constant float := Grid_Rec.Degrees_Btwn_Lats; Grid_Lon : constant float := Grid_Rec.Degrees_Btwn_Lons; S_Lat : constant float := 7.5; A_Lon : constant integer := 90; ProjU, ProjV : Float_Array; X_Lat, X_Lon : float; Lat_Stop : float; NPts : integer; procedure Reset is begin NPts := 0; if integer(X_Lon) mod A_Lon = 0 then X_Lat := Lat_Initial + S_Lat; Lat_Stop := Lat_Final - S_Lat; else X_Lat := Lat_Initial; Lat_Stop := Lat_Final; end if; end Reset; begin -- Draw_Grids Set_Mode(Graphics); Set_Color(Map_Color.Grid_Lines); if Grid_Lat /= 0.0 then X_Lat := Lat_Initial + Grid_Lat; X_Lon := Lon_Initial; NPts := 0; loop NPts := NPts + 1; Project(X_Lat, X_Lon, ProjU(NPts), ProjV(NPts)); X_Lon := X_Lon + Increment; if X_Lon > Lon_Final then Graff(NPts, ProjU, ProjV, 3); X_Lat := X_Lat + Grid_Lat; exit when X_Lat > Lat_Final; X_Lon := Lon_Initial; NPts := 0; end if; end loop; end if; if Grid_Lon /= 0.0 then X_Lon := Lon_Initial + Grid_Lon; Reset; loop NPts := NPts + 1; Project(X_Lat, X_Lon, ProjU(NPts), ProjV(NPts)); X_Lat := X_Lat + Increment; if X_Lat > Lat_Stop then Graff(NPts, ProjU, ProjV, 3); X_Lon := X_Lon + Grid_Lon; exit when X_Lon > Lon_Final; Reset; end if; end loop; end if; Set_Mode(Text); end Draw_Grids; begin -- Draw_Map Proj_Params := Plot_Menu.Current_Projection_Parameters; Initialize_Plot; if Plot_Land then Plot_Points(Map_Data, Specials.Points_Last, Specials.Points_Data, Specials.Points_Color); end if; Draw_Limb; if Show_Grid then Draw_Grids; end if; if Show_Beam then Plot_Points(Beam_Data, Specials.Beam_Last, Specials.Beam_Data, Specials.Beam_Color); end if; if Show_Swath then Plot_Points(Symbol_Data, Specials.Swath_Last, Specials.Swath_Data, Specials.Swath_Color); end if; exception when Caught_Error => null; when Constraint_Error => Put_Line("Constraint Error"); when Numeric_Error => Put_Line("Numeric Error"); when Storage_Error => Put_Line("Storage Error"); when Tasking_Error => Put_Line("Tasking Error"); when others => null; Put_Line("Unknown Error"); end Draw_Map; begin -- World Create_Port(Map, 5, 5, 100, 45); loop Select_Port(Map); Put("Session Menu Filename=> "); Get_Line(Namer, Laster); exit when Laster = 0; Open_Menu_File( namer(1 .. laster) ); Read_Session_Defaults; Close_Menu_File; Select_Port(Map); Draw_Map; Frame_Port; Put_line("Building Plot File..."); Print_Screen("Map.lis"); Put_Line("Plot file built"); Erase_Screen; end loop; Put_Line("Ending plot generation"); end Plot; --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: --pointsrea.txt --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: with TEXT_IO, WORLD_DATA_FILES; use TEXT_IO, WORLD_DATA_FILES; pragma elaborate (WORLD_DATA_FILES); procedure POINTS_READ is FORT_BUF : string ( 1 .. 80 ) := "**********" & "**********" & "**********" & "**********" & "**********" & "**********" & "**********" & "**********"; FORT_FILE : FILE_TYPE; LAT_FILE : World_DATA_IO.FILE_TYPE; LAST_ONE : integer := 0; RESULT : integer; RESULT_FLOAT : float := 0.0; CURRENT_RECORD: lat_lon_record; FIlE_NAME_INP : string ( 1 .. 20 ) := " "; LONGITUDE : constant integer := 1; LATITUDE : constant integer := 0; PAIR : integer range 1 .. MAXIMUM_LAT_LON_PAIRS; LAST_COUNT : integer := MAXIMUM_LAT_LON_PAIRS; package INT_IO is new INTEGER_IO ( integer ); package FLT_IO is new FLOAT_IO ( float ); begin PUT ( "Point file to read : " ); GET_LINE ( FILE_NAME_INP, LAST_ONE ); OPEN ( FORT_FILE, IN_FILE, FILE_NAME_INP(1..20)); PUT ( "World Data File to Create : " ); GET_LINE ( FILE_NAME_INP, LAST_ONE ); WORLD_DATA_IO.CREATE ( LAT_FILE, WORLD_DATA_IO.OUT_FILE, FILE_NAME_INP ( 1 .. LAST_ONE ) ); WORLD_DATA_IO.SET_INDEX ( LAT_FILE, WORLD_DATA_IO.POSITIVE_COUNT ( 1 ) ); while not end_of_file ( fort_file ) loop -- -- INIT CURRENT RECORD; -- CURRENT_RECORD.MINIMUM_LAT := 0.0; CURRENT_RECORD.MAXIMUM_LAT := 0.0; CURRENT_RECORD.MINIMUM_LON := 0.0; CURRENT_RECORD.MAXIMUM_LON := 0.0; for I in 1 .. LAST_COUNT loop current_record.lat_lon_pairs(I) := 0.0; end loop; LAST_COUNT := 0; -- -- Get Irec. -- GET_LINE ( FORT_FILE, FORT_BUF , LAST_ONE ); INT_IO.GET ( FORt_buf ( 1 .. LAST_ONE ), RESULT, LAST_ONE ); PUT ( "IREC => " ); INT_IO.PUT ( RESULT ); WORLD_DATA_IO.SET_INDEX ( LAT_FILE, WORLD_DATA_IO.POSITIVE_COUNT (RESULT) ); -- -- Get Number of lat lon pairs. -- GET_LINE ( FORT_FILE, FORT_BUF , LAST_ONE ); INT_IO.GET ( FORt_buf ( 1 .. LAST_ONE ), RESULT, LAST_ONE ); PUT ( " NUMBER OF LAT LON PAIRS => "); INT_IO.PUT ( RESULT ); CURRENT_RECORD.NUMBER_OF_PAIRS := RESULT; PAIR := 1; loop -- -- 1st float. -- GET_LINE ( FORT_FILE, FORT_BUF , LAST_ONE ); flt_io.get ( FORT_BUF ( 1 .. LAST_ONE ), RESULT_FLOAT, LAST_ONE ); CURRENT_RECORD.LAT_LON_PAIRS(PAIR + LATITUDE) := RESULT_FLOAT; -- -- 2nd float. -- GET_LINE ( FORT_FILE, FORT_BUF , LAST_ONE ); flt_io.get ( FORT_BUF ( 1 .. LAST_ONE ), RESULT_FLOAT, LAST_ONE ); CURRENT_RECORD.LAT_LON_PAIRS(PAIR + LONGITUDE) := RESULT_FLOAT; LAST_COUNT := LAST_COUNT + 2; -- -- Blank line -- GET_LINE ( FORT_FILE, FORT_BUF , LAST_ONE ); if PAIR = 1 then CURRENT_RECORD.MINIMUM_LAT := current_record.lat_lon_pairs(1 + latitude ); CURRENT_RECORD.MAXIMUM_LAT := current_record.lat_lon_pairs(1 + latitude ); CURRENT_RECORD.MINIMUM_LON := current_record.lat_lon_pairs(1 + longitude ); CURRENT_RECORD.MAXIMUM_LON := current_record.lat_lon_pairs(1 + longitude ); else if CURRENT_RECORD.MINIMUM_LAT > CURRENT_RECORD.LAT_LON_PAIRS(PAIR + LATITUDE) then CURRENT_RECORD.MINIMUM_LAT := CURRENT_RECORD.LAT_LON_PAIRS(PAIR + LATITUDE); end if; if CURRENT_RECORD.MAXIMUM_LAT < CURRENT_RECORD.LAT_LON_PAIRS(PAIR + LATITUDE) then CURRENT_RECORD.MAXIMUM_LAT := CURRENT_RECORD.LAT_LON_PAIRS(PAIR + LATITUDE); end if; if CURRENT_RECORD.MINIMUM_LON > CURRENT_RECORD.LAT_LON_PAIRS(PAIR + LONGITUDE) then CURRENT_RECORD.MINIMUM_LON := CURRENT_RECORD.LAT_LON_PAIRS(PAIR + LONGITUDE); end if; if CURRENT_RECORD.MAXIMUM_LON < CURRENT_RECORD.LAT_LON_PAIRS(PAIR + LONGITUDE) then CURRENT_RECORD.MAXIMUM_LON := CURRENT_RECORD.LAT_LON_PAIRS(PAIR + LONGITUDE); end if; end if; exit when (PAIR + 1)/2 = RESULT; PAIR := PAIR + 2; end loop; WORLD_DATA_IO.WRITE ( LAT_FILE, CURRENT_RECORD ); NEW_LINE; end loop; CLOSE ( FORT_FILE ); WORLD_DATA_IO.CLOSE ( LAT_FILE ); end POINTS_READ; --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: --symbolrea.txt --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: with TEXT_IO, WORLD_DATA_FILES; use TEXT_IO, WORLD_DATA_FILES; pragma elaborate (WORLD_DATA_FILES); procedure SYMBOL_READ is FORT_BUF : string ( 1 .. 80 ) := "**********" & "**********" & "**********" & "**********" & "**********" & "**********" & "**********" & "**********"; FORT_FILE : FILE_TYPE; LAT_FILE : World_DATA_IO.FILE_TYPE; LAST_ONE : integer := 0; RESULT : integer; RESULT_FLOAT : float := 0.0; CURRENT_RECORD: lat_lon_record; FIlE_NAME_INP : string ( 1 .. 20 ) := " "; LONGITUDE : constant integer := 1; LATITUDE : constant integer := 0; PAIR : integer range 1 .. MAXIMUM_LAT_LON_PAIRS; LAST_COUNT : integer := MAXIMUM_LAT_LON_PAIRS; package INT_IO is new INTEGER_IO ( integer ); package FLT_IO is new FLOAT_IO ( float ); begin PUT ( "Point file to read : " ); GET_LINE ( FILE_NAME_INP, LAST_ONE ); OPEN ( FORT_FILE, IN_FILE, FILE_NAME_INP(1..20)); PUT ( "World Data File to Create : " ); GET_LINE ( FILE_NAME_INP, LAST_ONE ); WORLD_DATA_IO.CREATE ( LAT_FILE, WORLD_DATA_IO.OUT_FILE, FILE_NAME_INP ( 1 .. LAST_ONE ) ); WORLD_DATA_IO.SET_INDEX ( LAT_FILE, WORLD_DATA_IO.POSITIVE_COUNT ( 1 ) ); while not end_of_file ( fort_file ) loop -- -- INIT CURRENT RECORD; -- CURRENT_RECORD.MINIMUM_LAT := 0.0; CURRENT_RECORD.MAXIMUM_LAT := 0.0; CURRENT_RECORD.MINIMUM_LON := 0.0; CURRENT_RECORD.MAXIMUM_LON := 0.0; for I in 1 .. LAST_COUNT loop current_record.lat_lon_pairs(I) := 0.0; end loop; LAST_COUNT := 0; -- -- Get Irec. -- GET_LINE ( FORT_FILE, FORT_BUF , LAST_ONE ); INT_IO.GET ( FORt_buf ( 1 .. LAST_ONE ), RESULT, LAST_ONE ); PUT ( "IREC => " ); INT_IO.PUT ( RESULT ); WORLD_DATA_IO.SET_INDEX ( LAT_FILE, WORLD_DATA_IO.POSITIVE_COUNT (RESULT) ); -- -- Get symbol type. -- GET_LINE ( FORT_FILE, FORT_BUF , LAST_ONE ); flt_io.get ( FORT_BUF ( 1 .. LAST_ONE ), RESULT_FLOAT, LAST_ONE ); CURRENT_RECORD.MINIMUM_LAT := RESULT_FLOAT; -- -- Get Number of lat lon pairs. -- GET_LINE ( FORT_FILE, FORT_BUF , LAST_ONE ); INT_IO.GET ( FORt_buf ( 1 .. LAST_ONE ), RESULT, LAST_ONE ); PUT ( " NUMBER OF LAT LON PAIRS => "); INT_IO.PUT ( RESULT ); CURRENT_RECORD.NUMBER_OF_PAIRS := RESULT; PAIR := 1; loop -- -- 1st float. -- GET_LINE ( FORT_FILE, FORT_BUF , LAST_ONE ); flt_io.get ( FORT_BUF ( 1 .. LAST_ONE ), RESULT_FLOAT, LAST_ONE ); CURRENT_RECORD.LAT_LON_PAIRS(PAIR + LATITUDE) := RESULT_FLOAT; -- -- 2nd float. -- GET_LINE ( FORT_FILE, FORT_BUF , LAST_ONE ); flt_io.get ( FORT_BUF ( 1 .. LAST_ONE ), RESULT_FLOAT, LAST_ONE ); CURRENT_RECORD.LAT_LON_PAIRS(PAIR + LONGITUDE) := RESULT_FLOAT; LAST_COUNT := LAST_COUNT + 2; -- -- Blank line -- GET_LINE ( FORT_FILE, FORT_BUF , LAST_ONE ); exit when (PAIR + 1)/2 = RESULT; PAIR := PAIR + 2; end loop; WORLD_DATA_IO.WRITE ( LAT_FILE, CURRENT_RECORD ); NEW_LINE; end loop; CLOSE ( FORT_FILE ); WORLD_DATA_IO.CLOSE ( LAT_FILE ); end SYMBOL_READ; --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: --symbolmer.txt --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: with TEXT_IO, WORLD_DATA_FILES; use TEXT_IO, WORLD_DATA_FILES; pragma elaborate (WORLD_DATA_FILES); procedure SYMBOL_MERGE is NEW_FILE : World_DATA_IO.FILE_TYPE; OLD_FILE : World_DATA_IO.FILE_TYPE; LAST_ONE : integer := 0; CURRENT_RECORD: lat_lon_record; FIlE_NAME_INP : string ( 1 .. 80 ) := ( 1 .. 80 => ' ' ); begin PUT ( "World Symbol File to Create : " ); GET_LINE ( FILE_NAME_INP, LAST_ONE ); WORLD_DATA_IO.CREATE ( NEW_FILE, WORLD_DATA_IO.OUT_FILE, FILE_NAME_INP ( 1 .. LAST_ONE ) ); WORLD_DATA_IO.SET_INDEX ( NEW_FILE, WORLD_DATA_IO.POSITIVE_COUNT ( 1 ) ); PUT ( "World symbol file to merge: " ); GET_LINE ( FILE_NAME_INP, LAST_ONE ); while LAST_ONE /= 0 loop WORLD_DATA_IO.OPEN ( OLD_FILE, WORLD_DATA_IO.IN_FILE, FILE_NAME_INP ( 1 .. LAST_ONE ) ); while not WORLD_DATA_IO.END_OF_FILE ( OLD_FILE ) loop WORLD_DATA_IO.READ ( OLD_FILE, CURRENT_RECORD ); WORLD_DATA_IO.WRITE ( NEW_FILE, CURRENT_RECORD ); end loop; WORLD_DATA_IO.CLOSE ( OLD_FILE ); PUT ( "World symbol file to merge: " ); GET_LINE ( FILE_NAME_INP, LAST_ONE ); end loop; WORLD_DATA_IO.CLOSE ( NEW_FILE ); end SYMBOL_MERGE;