Programmer's ROM - The Computer Language Library

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

/ Programmer's ROM - The Computer Language Library / programmersrom.iso / ada / pdl / gaddsgn.doc < prev next >

Wrap

Text File | 1988-05-03 | 263.3 KB | 4,466 lines

GGGGG RRRRRR AAAA PPPPPP HH HH IIIIII CCCCC GG RR RR AA AA PP PP HH HH II CC GG RRRR AAAAAA PPPPPP HHHHHH II CC GG GG RR RR AA AA PP HH HH II CC GGGG RR RR AA AA PP HH HH IIIIII CCCCC AAAA DDDDD AAAA AA AA DD DD AA AA AAAAAA DD DD AAAAAA AA AA DD DD AA AA AA AA DD DD AA AA DDDDD EEEEEE SSSSS IIIIII GGGGG NN NN EEEEEE RRRRRR DD DD EE SS II GG NNN NN EE RR RR DD DD EEEE SSSS II GG NNNNNN EEEE RRRRR DD DD EE SS II GG GG NN NNN EE RR RR DDDDD EEEEEE SSSSS IIIIII GGGG NN NN EEEEEE RR RR D E S I G N D O C U M E N T Preliminary Version JULY 1985 Ada Technology Group SYSCON Corporation 3990 Sherman Street San Diego, California 92110 Table of Contents Section Page ---------------------------------------------------------------------------- 1 INTRODUCTION . . . . . . . . . . . . . . . . . . . . . . . . . 1-1 1.1 Purpose . . . . . . . . . . . . . . . . . . . . . . . . . . . . 1-1 1.2 Scope . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 1-2 1.3 Background . . . . . . . . . . . . . . . . . . . . . . . . . . 1-2 2 REQUIREMENTS SUMMARY . . . . . . . . . . . . . . . . . . . . . 2-1 2.1 Feature Overview . . . . . . . . . . . . . . . . . . . . . . . 2-1 2.2 Functional Requirements . . . . . . . . . . . . . . . . . . . . 2-2 2.2.1 Graphics Design Functions . . . . . . . . . . . . . . . . . . . 2-2 2.2.2 Ada PDL Production Functions . . . . . . . . . . . . . . . . . 2-3 2.2.3 File Management Functions . . . . . . . . . . . . . . . . . . . 2-5 2.2.4 MMI Functions . . . . . . . . . . . . . . . . . . . . . . . . . 2-5 2.3 Data Structure Requirements . . . . . . . . . . . . . . . . . . 2-8 2.3.1 PDL Information . . . . . . . . . . . . . . . . . . . . . . . 2-10 2.3.2 Graphics Information . . . . . . . . . . . . . . . . . . . . . 2-11 3 TOP-LEVEL DESIGN . . . . . . . . . . . . . . . . . . . . . . . 3-1 4 MACROSCOPIC DESIGN . . . . . . . . . . . . . . . . . . . . . . 4-1 4.1 RUN_GAD . . . . . . . . . . . . . . . . . . . . . . . . . . . . 4-3 4.2 GRAPH_TREE_ACCESS . . . . . . . . . . . . . . . . . . . . . . . 4.3 MMI . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 4.4 PDL_GEN . . . . . . . . . . . . . . . . . . . . . . . . . . . . 4.5 GRAPHICS_DRIVER . . . . . . . . . . . . . . . . . . . . . . . . 4.6 GKS_PRIME . . . . . . . . . . . . . . . . . . . . . . . . . . . 4.7 VIRTUAL_TERMINAL . . . . . . . . . . . . . . . . . . . . . . . List of Illustrations Figure Title Page -------------------------------------------------------------------------- 2-1 GAD Interfaces . . . . . . . . . . . . . . . . . . . . . . . 2-2 2-2 Ada Graphic Notation Conventions . . . . . . . . . . . . . . 2-4 2-3 MMI Menu Netowrk Organization . . . . . . . . . . . . . . . 2-6 2-4 MMI Menu Network Overview . . . . . . . . . . . . . . . . . 2-7 2-5 Major Data Structure Overview . . . . . . . . . . . . . . . 2-10 3-1 GAD II Architectural Diagram . . . . . . . . . . . . . . . . 3-2 3-2 GAD II Control Flow Diagram . . . . . . . . . . . . . . . . 3-3 4-1 Run_GAD Procedure Design Diagram . . . . . . . . . . . . . . 4-3 4-2 Graph_Tree_Access OODD . . . . . . . . . . . . . . . . . . . 4-3 MMI OODD . . . . . . . . . . . . . . . . . . . . . . . . . . 4-4 PDL_Generator OODD . . . . . . . . . . . . . . . . . . . . . 4-5 Graphic_Driver OODD. . . . . . . . . . . . . . . . . . . . . 4-6 GKS_Prime OODD . . . . . . . . . . . . . . . . . . . . . . . 4-7 Virtual_Terminal_Interface OODD. . . . . . . . . . . . . . . List of Tables Table Title Page ------------------------------------------------------------------------- 4-1 Macroscopic Design Library . . . . . . . . . . . . . . . . . 4-2 4-2 RUN_GAD Dependencies List . . . . . . . . . . . . . . . . . 4-3 4-3 GRAPH_TREE_ACCESS Dependencies List. . . . . . . . . . . . . 4-4 MMI Dependencies List . . . . . . . . . . . . . . . . . . . 4-5 PDL_GENERATOR Dependencies List. . . . . . . . . . . . . . . 4-6 GRAPHICS_DRIVER Dependencies List. . . . . . . . . . . . . . 4-7 GKS_PRIME Dependencies List. . . . . . . . . . . . . . . . . 4-8 VIRTUAL_TERMINAL_INTERFACE Dependencies List . . . . . . . . 1. INTRODUCTION The Graphic Ada Designer (GAD) is a tool principally targeted to assist with generation of design diagrams and Program Design Language (PDL) in support of the development of Ada software. GAD is designed to create graphical Object Oriented Design Diagrams (OODDs) for Ada programs and high level PDL representations associated with each OODD. GAD is written in Ada, hosted on VAX computer systems utilizing the VMS operating system and utilizes the capabilities of a VT100 compatible color bit mapped graphics terminal.. 1.1 PURPOSE The development of GAD utilizes the Ada-based development methodology consisting of the following steps: o Concept formulation o Requirements o Macroscopic design o Microscopic design o Code/debug o Integration/test o Evaluation The macroscopic design phase is the point in the methodology where the Ada language is introduced in the form of OODDs and corresponding Ada-based PDL. This document serves as the reference document for GAD tool development to the macroscopic level of design. This document, together with the GAD User's Manual, forms the basis for the Critical Design Review (CDR) of the GAD tool development. 1.2 SCOPE The design of GAD is presented in the remaining three sections. The Requirements Summary Section provides an overview of GAD requirements based on the functional descriptions contained in the User's Manual. The Top-Level Design Section identifies the major functional components of GAD and their architectural relationships. The Macroscopic Design Section provides textual overview, the formal design OODDs and the corresponding PDL for the package specifications for each module that reflects the microscopic level of design. 1.3 BACKGROUND The GAD represents a major enhancement of a tool previously prototyped by SYSCON Corporation. The GAD is designed to support the Ada Graphic Notation conventions derived by SYSCON from the Object Oriented Design work of Grady Booch and the Ada-based graphical representation techniques for analysis given by Dr. R. Buhr of Carleton University (see "Software Engineering with Ada" by Grady Booch and "System Design with Ada" by R.J.A. Buhr). The development of the tool incorporates the SYSCON Ada software development methodology, which includes the use of the Ada Graphic Notation and the Ada PDL that this tool is designed to support. 2.1 FEATURE OVERVIEW The GAD is designed to use the capabilities of a color bit-mapped graphics terminal to build graphic representations of Ada program structures. This tool will make use of available advanced hardware features, such as windowing, cursor control device input, internal memory and graphic segment manipulation capabilities, to provide an efficient interactive graphics environment. The GAD will be hosted on a VAX, using the VMS operating system, and is written in Ada. Initially the program will be compiled using the TeleSoft Ada compiler (Version 1.5). The program will be written in machine and compiler independent Ada. It will only be dependent on the graphics terminal and printer used. The hardware dependencies are to be localized to greatest extent possible. The interaction of GAD with the user, host operating system and file system, and graphics terminal and printer is illustrated in Figure 2-1. The design diagrams developed using GAD are stored in a tree-like representation form maintained by GAD and preserved in a file structure. GAD uses the CRT to provide a "window" onto the diagram with the capability of pan and zoom. At standard zoom (ie. no magnification) the user can view an entire design diagram. At maximum zoom, approximately 25% of the diagram will be displayed in the window. VAX/VMS HOST --------------------------------------------------- | GAD | | ----------------------------------- | | | Functional | Memory Resident | | | | Modules | Tree Based Forms | | | ----------------------------------- | | | Ada Runtime System | | | ----------------------------------- | --------------------------------------------------- (* Keyboard & ^ | | ^ Cursor Control Device) | | | | User Input * ------+ | | +---> Design File Graphics Output <------------+ +---------> PDL File | v Graphics Hardcopy Figure 2.1-1 GAD Interfaces 2.2 Functional Requirements The basic functions of GAD fall into four (4) major catagories. The Graphics Design functions provide the capability to create, display and modify OODD diagrams on the graphics terminal. The PDL Production functions provide the capability to extract the necessary syntax and semantic information from the design diagram data structures and generate PDL text files. The Storage Management functions provide for the automatic creation and access to GAD files. The MMI functions provide the user interface through which the design operator orchestrates all GAD operations. 2.2.1 Graphics Design Functions GAD provides a graphics design capability which consists of creating, deleting, and editing Object Oriented Design Diagrams formed of entities representing Ada structures (e.g., packages, subprograms, tasks, or bodies), and connections which represent relationships between entities. Strict Ada (PDL) syntax to the appropriate level of detail will be enforced in the graphs at the completion of each operation. The graphics design capabilities will be in accordance with the Ada Graphic Design conventions summarized in figure 2-2 and described in detail in Section 3 of the GAD User's Manual. 2.2.2 Ada PDL Production Functions GAD provides a command to generate the PDL corresponding to the current graph design. The program generates the PDL and places it in an ASCII text file of the name supplied by the user. The Ada PDL that is produced will be syntactically correct, and compilable if context clause (with statement) is added for the DESIGN_SUPPORT_PACKAGE documented in the GAD User's manual. For PDL generation, the general guideline will be to generate as much code as possible and permit the user to delete what is not needed. The code produced will be a mix of Ada and embedded English comment statements. ENTITY DECLARATIONS CONTROL FLOW INDICATORS DATA FLOW INDICATORS (<name>) - type declaration ------>* - guarded entry o-*-*-*-> :<name>: - object declaration T-----> - timed call on entry <-*-*-*-o <<name>> - exception declaration C-----> - conditional call on entry <-*-*-*-> |<name>| - subprogram T----->* - timed call on guarded entry /<name>/ - task entry C----->* - conditional call on guarded entry |<name[]>| - subprogram with parameters ------> - caller-callee (subprograms, tasks) /<name[]>/ - task entry with parameters IMPORT DECLARATIONS EXPORT DECLARATIONS ------> <name> - package/subprogram reference ( ) - type ----->> <name> - virtual package reference : : - object < > - exception | | - subprogram / / - task entry VIRTUAL_PACKAGE PACKAGE TASK SUBPROGRAM <name> <name>(gd | gi) <name> - - - - - - - - - - - --------------------- --------------------- ===================== | | /<name>/ 1 / |<name>(gi | gd) | | | | | / / |===================| | | /<name1>/ 2 / | | | | | | /<name2>/ / --------------------- | | / / <name> - procedure | | | | /<name3>/ 3 / =<name> - function | | /<name4>/ / gd - generic declaration | | | | / / gi - generic instantiation | | /<name5>/ 4 / - - - - - - - - - - - --------------------- --------------------- gd - generic declaration tt - task type PACKAGE, SUBPROGRAM OR TASK BODY gi - generic instantiation (not supported) --- 1 - single entry / \ O 2 - selective wait \ / 3 - serial entries --- 4 - entry family Figure 2-2 Ada Graphic Notation Conventions Summary 2.2.3 File Management Functions GAD provides mechanisms to save and restore graphs between invocations of the tool. The necessary graphics and syntax information is saved in a file, one graph per file. There are no relationships maintained by GAD between files, although a user may create a series of graphs depicting the evolution of a design. The PDL text file is an ouput-only structure from the perspective of the GAD tool. There are no editing capabilities provided with which to alter this file. The file is strictly created from the design structures. The PDL file is a standard VMS text file which can be accessed by source line editors or word processors, print utilities and Ada compiler(s) hosted on the system. 2.2.4 MMI Functions The GAD MMI provides an efficient means for designing Ada OODDs. The MMI approach is predicated on utilizing the full capabilities of the graphics terminal (including color bit-mapped graphics, tone generation, cursor control device, and keyboard with definable 'soft' keys, if available). The basic MMI goals are itemized below as: o Minimize keyboard interaction o Maximize use of cursor control device o Support pick and move operations at terminal o Implement drawing using cursor control device to mark graph points o Provide menu support for 'pickable' command icons o Provide quick response by using the terminal's internal memory and segment operation capabilities Figure 2-3 illustrates the MMI menu network. Figure 2-4 illustrates the menu options and control flows through the MMI menu netork. ------------ | GENERIC | -------------- +------------->| MENU | | PARAMETER | | ------------ | STATUS | +-----------------------------+--->| MENU | ---------- ------------ | -------------- +-------->| CREATE | |CONNECTOR | | -------------- | | MENU |--------->|MENU |------->| CALL STATUS| | ---------- ------------ | | MENU | ---------- ---------- ------------ | -------------- | DESIGN | | EDIT | |ANNOTATING|---+ -------------- +--->| MENU |---->| MENU |--------->|MENU |------->| ENTRY POINT| | ---------- ---------- ------------ | STATUS | | | | -------------- | | v -------- | ---------- | MAIN | +-------------->|CONFIRM | | MENU | |MENU | -------- ---------- | -------------- +--->| ATTRIBUTES | ------------ | MENU | +------>| LINE | -------------- | | MENU | | --------------- | ------------ +-------->| CHANGE TYPE |---+ ------------ | MENU |---------->| COLOR | --------------- | MENU | ------------ Figure 2-3 MMI Menu Network Organization +--> Design Menu +-----> Create Menu +--------> Generic Menu +--> Parameter Status Menu | ==================== | =================== | ======================= | ===================== | | CREATE |--------------+ | VIRTUAL_PACKAGE | | | DECLARATION | | | HAS PARAMETERS | | | EDIT |------------+ | PACKAGE |--->+ | INSTANTIATION | | | NO PARAMETERS | | | DELETE |---------+ | | PROCEDURE |--->+-+ | NON-GENERIC | | ===================== | | MOVE | | | | FUNCTION |--->+-+ ======================= | | | ZOOM-IN | | | | TASK | +---------------------------+ | | ZOOM-OUT | | | | CONNECTION |----------> Connector Menu ^ | | PAN RIGHT | | | | BODY | ======================= | | | PAN LEFT | | | =================== | CALL |------> Call Status Menu | | PAN UP | | +-----> Edit Menu | DATA | | ===================== | | PAN DOWN | | =================== ======================= | | CONDITIONAL | | ==================== | | ADD |-------------> Annotating Menu | | NORMAL | +----------------+ | | MODIFY | ======================= | | TIMED | Main Menu | | | REMOVE |--+ | TASK ENTRY |->+ ===================== =============== | | =================== | | EXPORT TYPE | | | DESIGN |->+ +--------> Delete Menu <-----+ | EXPORT OBJECT | +---> Entry Point Menu | ATTRIBUTES |------>+ =================== | EXPORT EXCEPTION | ===================== | GENERATE PDL| | | CONFIRM | | EXPORT PROCEDURE | | IS GUARDED | | FILE | | | CANCEL | | EXPORT FUNCTION | | NOT GUARDED | | PRINT | | =================== | EXPORT TASK | ===================== | QUIT | | +-------> Change Type Menu | EXPORT_TYPE | | EXIT | | | =================== | EXPORT_OBJECT | =============== | | | LINE |---+ | EXPORT_EXCEPTION | Attributes Menu <-+ | | COLOR |-+ | | EXPORT_PROCEDURE | ===================== | =================== | | | EXPORT_FUNCTION | | CONDITIONAL CALL |-->+-------+ Color Menu <----+ | | EXPORT_TASK | | TIMED CALL |-->+ =================== | | IMPORT_V_PACKAGE | | NORMAL REFERENCE |-->+ | RED | | | IMPORT_PACKAGE | | VIRTUAL REFERENCE |-->+ | YELLOW | | | IMPORT_PROCEDURE | | GUARDED ENTRY |-->+ | GREEN | | | IMPORT_FUNCTION | | CALL CONNECTION |-->+ | VIOLET | | ======================= | DATA CONNECTION |-->+ | ORANGE | +-----> Line Menu | SUBPROGRAM |-->+ | BLACK | =================== | VIRTUAL PACKAGE |-->+ | BROWN | | SOLID | | PACKAGE |-->+ | BLUE | | DASHED | | TASK |-->+ =================== | DOTTED | ===================== =================== Figure 2-4 MMI Menu Network Overview 2.3 DATA STRUCTURE REQUIREMENTS The problem posed to GAD is to formulate a major data structure design that achieves a two-fold purpose. The first is to provide a correlation between the graphic conventions for Ada entities (reference User's Manual, Section 3) and the Ada language semantic/syntax associated with each entity. The second is to maintain the interrelationshps (e.g. scoping, call dependencies and data dependencies) between entities. The data structures utilized by GAD are to capture the Ada syntax and graphical information associated with the graph as they are created, edited and positioned within the design diagram. The data structures must support: o PDL Generation o Regeneration of graphs between sessions o Detection of severed connections (due to move or delete operations) o Syntax and semantic information verification To be able to perform the required functions, the data structure must support the ability to trace relations in multiple directions, such as parent-child and caller-callee. The design of choice is to specify two different but related structures: Syntax_Tree and Graph_Tree structures. Figure 2-5 presents a structural overview of the major data structures. The Syntax_Tree is comprised of two substructures, Tree_Node and Entity_List structures. The Tree_Node structures contain basic information about the entity they represent, such as name, scope and generic attributes (if applicable). Each Tree_Node contains a set of pointers to the various Entity_List structures which contain lists of information unique to the entity with which it is associated. The types of Entity_List structures that will be maintained are: o Contained_Lists o Callee_Lists o Data_Connect_Lists o Entry_Lists o Imported_Lists o Exported_Lists o Exception_Lists o Object_Lists o Type_Lists The Graph_Tree structures consist of nodes which contain the basic graphic information about an entity, such as location and size. The Syntax_Tree and Graph_Tree structures both contain different kinds of information about the objects being diagramed. It should be noted that the data structure figure is a simplified representation. In actuality, the various nodes and associated entity pointers are multi-threaded (for example, there exist forward and backward pointers between the nodes of the Syntax_Tree and Graph_Tree). The structure takes on a more n-dimensional characteristic which is not representable on two-dimensional media. SYNTAX_TREE GRAPH_TREE ------------------------------------------------ ----------- | Tree Nodes +------------------------------------>| Node 1 | | ---------- | List Nodes | | | | | Root | | ----------- | |---------| | +->| |--|------------>| | | +-->| Node 2 | | | ---------- | ----------- |--+ | | | | | | | +-------->| |-- | | | |---------| | | ---------- | | ----------- |--+ | | | | | | +--| Node 1 |--+ | | |-- | | | | | | | +->| |----+ ----------- | | | | | |---------| | | ---------- | |-- | | | | | | | | ^ | | | | | | | : | | | | ----------- | | | | | : | | | +----------------------------------+ | | | : | | | | | | | : | | | | | | | : | | | ---------- | | | | | | | | Node n |<--------------------------+ | | |---------| | +__| |--------------------------------|---+ | Node m | | ---------- | | | | | ----------- ------------------------------------------------ Figure 2-5 Major Data Structure Overview 2.3.1 PDL INFORMATION Generation of the PDL requires information on each entity for which code is to be generated. This information includes 1) the name, 2) the enclosing scope, 3) the type of entity, 4) a list of what it encloses, 5) it's relationship with other entities including whether it is exported, and 6) miscellaneous entity specific information (e.g., generic status). The basic syntax information is provided in a tree-like arrangement of the structures described in Section 2.3 above. Much of the scope and relationship information required can be provided in a structure of this type. Walking the tree to detect all references to particular entity (node) can be excessively time consuming. For this reason, the basic Syntax_Tree is enhanced to include back pointers for each possible relationship (including parent-child). 2.3.2 GRAPHICS INFORMATION The minimum graphics information required for each entity is its size and position on the graph. This information, and all other required graphics information, is stored in the Graph_Tree data structure described in Section 2.3. The approach will be to use the terminal's hardware capabilities to simplify user selection, movement, and deletion operations. This requires the maintenance of the graphic segment identifiers corresponding to each entity in the design. The Software Architecture of GAD will resemble that of the prototype version of the tool. Figure 3-1 illustrates the hierarchical organization of the functional modules. The following is a brief overview of the GAD functional components or modules: RUN_GAD: The MAIN procedure (Program Unit) of the tool. It controls the initialization, execution, and termination of GAD. GRAPH_TREE_ACCESS_PKG: This module defines the tree structure which holds the semantic and graphics data associated with the graph. It provides the necessary primitives to manipulate and access the tree. It provides I/O routines for the capture and preservation of design diagrams between editing sessions. MMI: This module provides the MMI required to allow operation interaction with the tool. PDL_GEN: This module implements the subprograms which generate the Ada PDL from the Graph Tree. GRAPHICS_DRIVER: This module provides the routines to perform the graphics functions of GAD. GKS_PRIME: This module provides a proper subset of the Graphics_Kernel_System (GKS). This module encapsulates all terminal specific characteristics of the system. VIRTUAL_TERMINAL: This module provides a set of standard routines and data structures for ASCII Text I/O operations on a VT100 type terminal. Figure 3-2 uses Ada Graphic Notation to illustrate the control flow relationships of the GAD components. ------------------------------------------ --------------------- --------------------- | | | PDL_ | | | | | | | | GENERATOR | | | | | | RUN_GAD | MMI |----------------| | | | | | | | GRAPH_ | | | | | | | | TREE_ | | Compiler Packages | | | | | | ACCESS | | Run-Time System | | | |----------------------------------------| | | | VAX/VMS | | | | ->| OPERATING | v | | | SYSTEM | |----------------------------------------| |-------------------| | ENVIRONMENT | | GRAPHICS_DRIVER | ->| SYSTEM | | | |----------------------------------------| |-------------------| | | | | ->| CALENDAR | | | v v |-------------------| | | |----------------------------------------| ->| TEXT_IO | |-------------------| | VIRTUAL_ | | |-------------------| | SYSTEM | | TERMINAL_ | GKS_PRIME | | | | | | INTERFACE | | ->| DIRECT_IO | | INTERFACES | ------------------------------------------ --------------------- --------------------- Figure 3-1 GAD Architectural Diagram ---------------------------------------------------------------------------------------------------------------- | GRAPH_TREE_ACCESS | | ===================== - - - - - - - - - - - | | | RUN_GAD | | | |===================| | |->+--------------------------->| DIRECT_IO | | | | ------- ^ | | | |->+->+------+--->| | | | | | | | | | ^ ------- | VIRTUAL_TERMINAL | | --------------------- | | | | | | - - - - - - - | | | | | - - - - - - - - - - - | | | | | +------------------------------+ | | | | | | | ------- | | | +-------------------------------------+------>| | | | | | | PDL_GENERATOR | ------- | | | | - - - - - - - - - - - | | |-+ | | | | | | | - - - - - - - | | | +------------------------------+ | ------- | | | | | +---------->| | | | | | | | | ------- | GKS_PRIME | | | | | | |--+ - - - - - - - v | | | | - - - - - - - - - - - | |-+->| TEXT_IO | | | MMI | GRAPHICS_DRIVER | | | - - - - - - - - - - - | - - - - - - - - - - - | | | | | | ------- | | | | | | | | +--->| | | | | | | | ------- | | | ------- | ------- | | | | | +---->| | |----+---------->| | | | - - - - - - - | | ------- ------- -----+------------------------->| CALENDER | | | | | | | | - - - - - - - - - - - - - - - - - - - - - - | ---------------------------------------------------------------------------------------------------------------- Figure 3-2 GAD Control Flow Diagram SECTION 4 Macroscopic Design The Macroscopic Design specifies the high-level design approach to providing the functions described in Section 2.4, Functional Requirements, Section 3, Top-Level Design, and based on the functional requirements described in the GAD User's Manual. The functional modules described in Section 2.4 are each considered a "virtual package" in the Macroscopic Design phase of the methodology. A virtual package is a conceptual encapsulation of those data structures, compilation units and dependencies that cumulatively makeup the functional module in question. This section contains the contains supporting diagrams, the OODD virtual package representations and the PDL listings for the GAD Macroscopic Design virtual package specifications. The order of presentation is in reverse of the compilation order as follows: 4 - 1 SECTION 4 Macroscopic Design Table 4-1 Graphic Ada Designer Design Library Virtual Packag Name Module Name Source File Name Comments ======================================================================================================================== | | RUN_GAD | RUNSKT.TXT | Main Sketcher Program Unit | |-----------------------+-------------------------+--------------------+-----------------------------------------------| | GRAPH_TREE_ACCESS | TREE_DATA | TREEDATA.TXT | Syntax Tree Data Structures Library Unit | | | TREE_IO | TREEIO.TXT | Syntax Tree I/O Routines Library Unit | | | TREE_OPS | TREEOPS.TXT | Syntax Tree Manipulation Routine Library Unit| |-----------------------+-------------------------+--------------------+-----------------------------------------------| | MMI | MMI_PARAMETERS | MMIPARAM.TXT | Data Structures Library Unit | | | UTILITIES | MMIUTIL.TXT | Utility Routines Library Unit | | | MMI | MMIOPS.TXT | Main Menu Control Routines Library Unit | | | MMI_ATTRIBUTES | MMIATTRIB.TXT | Attribute Menu Control Routines Library Unit | | | MMI_DESIGN | MMIDESIGN.TXT | Design Menu Control Routines Library Unit | | | MMI_MENU | MMIMENU.TXT | | |-----------------------+-------------------------+--------------------+-----------------------------------------------| | PDL_GENERATOR | PDL_GEN | PDLGEN.TXT | PDL Generation Routines Library Unit | |-----------------------+-------------------------+--------------------+-----------------------------------------------| | GRAPHICS_DRIVER | GRAPHICS_DATA | GRPHDATA.TXT | GAD Specific Graphics Structures Library Unit| | | | GRPHDRVR.TXT | GAD Specific Graphics Routines Library Unit | |-----------------------+-------------------------+--------------------+-----------------------------------------------| | GKS_PRIME | GKS_SPECIFICATION | GKSPEC.TXT | GKS Data Structures Library Unit | | | | PRIORITYC.TXT | for termacces.env only | | | MINI_MATH_PAC | MATHPACK.TXT | Math Routines Library Unit | | | TERMINAL_ACCESS | TERMACCES.TXT | GKS Terminal Specific Library Unit | | | | GKSPRIME.TXT | GKS Terminal Independent Library Unit | |-----------------------+-------------------------+--------------------+-----------------------------------------------| | VIRTUAL_TERMINAL_ | VIRTUAL_TERMINAL_ | VTI.TXT | VT100 Terminal Driver Library Unit | | INTERFACE | INTERFACE | | | |-----------------------+-------------------------+--------------------+-----------------------------------------------| | | | DESIGNPKG.TXT | Design Library Unit | | | | TRACE.TXT | Debug Utility Library Unit | | | | ENVSPEC.TXT | Envision Hardware Library Unit | | | | TXTCNVRT.TXT | Envision Hardware Library Unit | | | | CNTLSET.TXT | Envision Hardware Library Unit | | | | DSPLST.TXT | Envision Hardware Library Unit | | | | DRAWING.TXT | Envision Hardware Library Unit | | | | SGMTOPS.TXT | Envision Hardware Library Unit | ----------------------------------------------------------------------------------------------------------------------- 4 - 2 SECTION 4 Macroscopic Design 4.1 RUN_GAD This procedure is the main procedure (outer most Ada compilation unit) for the GAD tool. It provides routines to control initialization, termination (normal and abnormal), and vectoring of operator control to the MMI virtual package for operator interaction with the tool. The design characteristics of the Run_GAD virtual package are as follows: Table 4-2 RUN_GAD Dependencies List COMPILATION UNITS TYPE COMMENTS DEPENDENCIES + _____________________________________________________________________ Run_GAD Procedure Program Unit System Design_Pkg MMI Graph_Tree_Access ========================================= | RUN_GAD | |=======================================| | | | ------------------------- | < SYSTEM > | < DESIGN_PKG > | +--->(A)--<< MMI >> | +--->(B)--<< GRAPH_TREE_ACCESS >> | ^ ------------------------- | | | | ---- | | / \ | | \ / | | ---- | ----------------------------------------- Figure 4-1 Run_GAD Procedure Design Diagram 4 - 3 SECTION 4 Macroscopic Design Opening runskt.text 1: pragma source_info(on); 2: 3: with SYSTEM ; 4: with MMI ; use MMI ; 5: with UTILITIES ; use UTILITIES ; 6: with TREE_IO ; use TREE_IO ; 7: with TEXT_IO ; use TEXT_IO ; 8: 9: -- controlled by BOB MAREK 10: -- version 85-07-18 10:05 by RAM 11: 12: procedure RUN_GAD is 13: -- ======================================================= 14: -- 15: -- This is the main procedure of GAD and it will 16: -- control and execute the procedures and packages needed 17: -- to operate GAD. It will control the opening, 18: -- closing, creating, and renaming of the data files; 19: -- initialization of the program, and top level error 20: -- handling. 21: -- 22: -- Requirements: 23: -- 1) create working file 24: -- 2) open existing file and copy into working file, 25: -- close when completed. 26: -- 3) invoke MMI_OPERATIONS command processor 27: -- 4) handle error conditions (exceptions) 28: -- 5) delete or rename working file as appropriate 29: -- 30: -- ================================================================== 31: SESSION_EXTENTION : constant String := ".GPH" ; 32: SESSION_FILE : TEXT_IO.FILE_TYPE ; 33: SESSION_FILE_NAME : String ( 1..12 ) ; 34: OLD_SESSION_NAME : Boolean := True ; 35: 36: begin 37: MMI.INITIALIZE ; -- initialize global and package specific data 38: -- get new_filename 39: SESSION_FILE_NAME := UTILITIES.GET_FILE_HANDLE & SESSION_EXTENTION ; 40: -- set up tree file name 4 - 4 SECTION 4 Macroscopic Design 41: TREE_IO.DATA_FILENAME ( 1..12 ) := SESSION_FILE_NAME ; 42: CHECK_FOR_OLD_SESSION_NAME : 43: declare -- CHECK_FOR_OLD_SESSION_NAME 44: begin -- CHECK_FOR_OLD_SESSION_NAME 45: if SESSION_FILE_NAME ( 1..8 ) /= TREE_IO.DEFAULT_FILENAME then 46: -- see if file currently exists 47: TEXT_IO.OPEN ( SESSION_FILE , 48: TEXT_IO.IN_FILE , 49: SESSION_FILE_NAME ) ; 50: -- close file for tree_io.read 51: TEXT_IO.CLOSE ( SESSION_FILE ) ; 52: -- filename is used so read it in to initialize the GRAPH_TREE 53: TREE_IO.READ ( TREE_IO.DATA_FILENAME ) ; 54: -- now draw the tree 55: UTILITIES.DRAW_GRAPH_TREE ; 56: end if ; 57: exception -- CHECK_FOR_OLD_SESSION_NAME 58: when NAME_ERROR => 59: OLD_SESSION_NAME := False ; 60: when others => 61: -- unknown error so pass it on 62: raise ; 63: end CHECK_FOR_OLD_SESSION_NAME ; 64: MMI.PROCESS_COMMAND ; -- invoke GAD command processor 65: 66: --{ catch any unhandled exceptions and notify the user. 67: --{ attempt to save the work file. 68: exception 69: when OTHERS => 70: MMI.PANIC_EXIT ; 71: -- FILE_HANDLING_ON_EXIT := PANIC_SAVE; 72: -- GRAPH_TREE_IO.CLOSE_WORK_FILE (FILE_HANDLING_ON_EXIT); 73: 74: TEXT_IO.PUT_LINE(" PANIC EXIT PROCESS COMPLETED "); 75: raise; 76: 77: end RUN_GAD ; Compilation complete Syntax errors: 0 Semantic errors: 0 Lines compiled: 77 4 - 5 4.2 GRAPH_TREE_ACCESS The virtual package GRAPH_TREE_ACCESS provides three major services; the type declarations and objects which comprise the primary data structure for GAD, primitive routines for the manipulation of the data structure and I/O routines to preserve the data structures in a file for multi-session editing. The Tree_Data package provides the declarations and objects for the Graph Tree which holds all the graphical, syntax, and semantic information required by the program. The tree contains TREE, LIST and GRAPH nodes. The TREE nodes represent Ada entities (structures) which are connected in a hierarchal order (tree) indicating the scope of each entity. The LIST nodes are used to store relationships (e.g., context clauses) and annotations (e.g., exported type declarations). The GRAPH nodes contain the graphical data associated with each TREE node. The Tree_IO package provides all the necessary operations to read and write the graph tree from the graphics files in the host file system. This package manipulates data files which consist of copies of the graph tree nodes. The node types (GRAPH, TREE, and LIST) are stored in arrays in the package TREE_DATA. This TREE_IO package will copy the graph tree by copying the arrays to the specified data file. The requirements on this package are to 1) provide the read and write operations needed to maintain the graphics files, and 2) detect corrupted data files. The Tree_Operations package provides a set of operations on the data structures declared in the package Tree_Data. These operations include the management of indices into the arrays of GRAPH, LIST, and TREE nodes. The Get_Node functions will return the index value and initialize the corresponding node to be the specified variant of the record. The Release_Node procedures remove all references to the node, and mark the node being released as unused (and hence available for reuse). The operations set also includes functions such as general list manipulation facilities, and methods for walking the tree. Table 4-3 GRAPH_TREE_ACCESS Dependencies List COMPILATION UNITS TYPE COMMENTS DEPENDENCIES Graph_Tree_Data Package Syntax/Semantic/Entity System List Structure Direct_IO Tree_Operations Package Tree List Primitives Design_Pkg Tree_IO Package Design File I/O Routines GRAPH_TREE_ACCESS_VIRTUAL_PACKAGE - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | | -------------------- TREE_DATA ( TREE_DATA_TYPES )<---------+ ------------------------------- --------------------- < TREE_OPS_EXCEPTS ><----+ | | | < SYSTEM > ( TREE_IO_TYPES )<-+ | +---( DECLARATIONS ) ----- | +---------------->(A)-< DIRECT_IO > : TREE_IO_OBJECTS :<-+ | | / \ | | << DESIGN_PKG > < TREE_IO_EXCEPTS )<-+ | | \ / | | --------------------- -------------------- | | | ----- | | | | | ------------------------------- | | | | TREE_IO | | | | ------------------------------- | | | | | =========== | | | | +-------(DECLARATIONS) | WRITE[] | | | | | | +----->|=========| | | | | | | =========== |------->+ | ---------- | ------- |+->| READ[] |--- | | | |---------------------->| |--+| |=========| | | | | |---------------------->| |---+ | |__________>+ ---------- | ------- ----------- | | | | ------------------------------- | TREE_OPERATIONS | | | --------------------------------------------------- | | ========================= | | | +----------(DECLARATIONS) +--------->| =GET_NEW_GRAPH_NODE[] | | | | |=======================| | | | | | | | | | | _________________________ | | | o o | | | o o | | | | ========================= | | | |+-------->| =FIND_NODE_REFERENCE[]| | | --------- ------- || |=======================| | | |---------------------->| |------+| ========================= | | | | |---------------------->| |-------+ | =FIND_NODE_REFERENCE[]|---- | | |---------------------->| |------------>|=======================| | | --------- ------- | | | | | ------------------------- | | --------------------------------------------------- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Figure 4-2 GRAPH_TREE_ACCESS Virtual Package Design Diagram 1: with GRAPHICS_DATA; use GRAPHICS_DATA; 2: 3: -- controlled by JOHN REDDAN 4: -- version 85-07-24 14:10 by RAM 5: 6: package TREE_DATA is 7: ------------------------------------------------------------------------- 8: -- 9: -- This package provides the declarations and objects for the 10: -- Graph Tree which holds all the graphical, syntax, and 11: -- semantic information required by the program. The tree contains 12: -- TREE, LIST and GRAPH nodes. The TREE nodes represent Ada 13: -- entities (structures) and are connected in a hierarchal order (tree) 14: -- indicating the scope of each entity. The LIST nodes are used to 15: -- store relationships (e.g., context clauses) and annotations (e.g., 16: -- exported type declarations). The GRAPH nodes contain the graphical 17: -- data associated with each TREE node. 18: -- 19: ------------------------------------------------------------------------- 20: 21: ---------------------------------------------------------------------- 22: -- All of the Ada entities, one for each type of TREE node. 23: ---------------------------------------------------------------------- 24: type ENTITY_TYPE is (UNUSED, 25: ROOT, 26: TYPE_VIRTUAL_PACKAGE, 27: TYPE_PACKAGE, 28: TYPE_PROCEDURE, 29: TYPE_FUNCTION, 30: TYPE_TASK, 31: TYPE_ENTRY_POINT, 32: TYPE_BODY, 33: IMPORTED_VIRTUAL_PACKAGE, 34: IMPORTED_PACKAGE, 35: IMPORTED_PROCEDURE, 36: IMPORTED_FUNCTION, 37: EXPORTED_PROCEDURE, 38: EXPORTED_FUNCTION, 39: EXPORTED_TASK, 40: EXPORTED_ENTRY_POINT, 41: EXPORTED_TYPE, 42: EXPORTED_OBJECT, 43: EXPORTED_EXCEPTION, 44: CONNECTION_BY_CALL, 45: CONNECTION_FOR_DATA); 46: 47: ---------------------------------------------------------------------- 48: -- ENTITY Names 49: ---------------------------------------------------------------------- 50: MAXIMUM_NAME_LENGTH : constant POSITIVE := 80; 51: subtype NAME_TYPE is STRING (1..MAXIMUM_NAME_LENGTH); 52: NULL_NAME : constant NAME_TYPE := " "& 53: " "; 54: 55: ---------------------------------------------------------------------- 56: -- GENERIC information 57: ---------------------------------------------------------------------- 58: type GENERIC_STATUS_TYPE is (NOT_GENERIC, 59: GENERIC_DECLARATION, 60: GENERIC_INSTANTIATION); 61: 62: 63: ---------------------------------------------------------------------- 64: -- TASK information 65: ---------------------------------------------------------------------- 66: type TASK_STATUS_TYPE is (NORMAL_TASK, 67: TASK_TYPE_DECLARATION, 68: TASK_TYPE_OBJECT); 69: 70: 71: ---------------------------------------------------------------------- 72: -- The ACCESS types 73: ---------------------------------------------------------------------- 74: -- The access type for GRAPH_NODEs, implemented as an 75: -- index into GRAPH array. 76: subtype GRAPH_NODE_ACCESS_TYPE is INTEGER; 77: 78: -- The access type for LIST_NODEs, implemented as an 79: -- index into LIST array. 80: subtype LIST_NODE_ACCESS_TYPE is INTEGER; 81: 82: -- The access index of TREE_NODE_TYPEs. A negative number 83: -- will indicate a 'NULL' pointer. 84: subtype TREE_NODE_ACCESS_TYPE is INTEGER; 85: 86: -- To be used to initialize the access values to indicate it 87: -- is not currently pointing to anything. 88: NULL_POINTER : INTEGER := -1; 89: 90: ---------------------------------------------------------------------- 91: -- The graphical data for each tree node, stored in the 92: -- GRAPH_DATA_ARRAY. A null OWNING_TREE_NODE indicates that 93: -- the node is unused. 94: ---------------------------------------------------------------------- 95: type GRAPH_NODE_TYPE is 96: record 97: OWNING_TREE_NODE : TREE_NODE_ACCESS_TYPE := NULL_POINTER; 98: DATA : GRAPHICS_DATA.GRAPHICS_DATA_TYPE; 99: end record; 100: 101: 102: ---------------------------------------------------------------------- 103: -- LINE type 104: ---------------------------------------------------------------------- 105: MAXIMUM_NO_LINE_SEGMENTS : constant INTEGER := 20; 106: subtype POINTS is GRAPH_NODE_ACCESS_TYPE; 107: type LINE_TYPE is array (1..MAXIMUM_NO_LINE_SEGMENTS) of POINTS; 108: 109: NULL_LINE : constant LINE_TYPE := (-1,-1,-1,-1,-1,-1,-1,-1,-1,-1, 110: -1,-1,-1,-1,-1,-1,-1,-1,-1,-1); 111: 112: ---------------------------------------------------------------------- 113: -- The possible Call Connection types. 114: ---------------------------------------------------------------------- 115: type CALL_CONNECTION_TYPE is (NO_CONNECTION, 116: NORMAL, 117: TIMED, 118: CONDITIONAL); 119: 120: 121: ---------------------------------------------------------------------- 122: -- The various LISTS occuring in the tree are declared below. 123: -- The list format to be used to create specific kinds of lists. 124: -- A doubly linked list is required for forward and back tracing. 125: ---------------------------------------------------------------------- 126: -- The lists contained in a Tree Node. The order of the Lists 127: -- is the order of the List scan during a tree walk. 128: 129: type LIST_TYPE is (START, -- for starting node list scans 130: CONTAINED_LIST, 131: CALLEE_LIST, 132: DATA_CONNECT_LIST, 133: ENTRY_LIST, 134: EXPORTED_LIST, 135: IMPORTED_LIST, 136: NULL_LIST); 137: 138: -- The list structures of the Tree are created from the list 139: -- nodes declared below, which link Tree nodes. Each List 140: -- node is associated with a Tree node (ITEM), and hence a null 141: -- ITEM indicates an unused node. 142: type LIST_NODE_TYPE is 143: record 144: ITEM : TREE_NODE_ACCESS_TYPE := NULL_POINTER; 145: PRIOR : LIST_NODE_ACCESS_TYPE := NULL_POINTER; 146: NEXT : LIST_NODE_ACCESS_TYPE := NULL_POINTER; 147: -- for use in Membership Lists 148: REF_COUNT : NATURAL := 0; -- count of refs by ITEM to List Owner 149: MEMBER_OF : LIST_TYPE := NULL_LIST; -- the refering list type 150: end record; 151: 152: -- A list of all called entities and their connections. 153: subtype CALLEE_LIST_TYPE is LIST_NODE_ACCESS_TYPE; 154: -- A list of all contained entities. 155: subtype CONTAINED_ENTITY_LIST_TYPE is LIST_NODE_ACCESS_TYPE; 156: -- A list of all Data connections for an entity 157: subtype DATA_CONNECT_LIST_TYPE is LIST_NODE_ACCESS_TYPE; 158: -- A list of all the entries for a task. 159: subtype ENTRY_LIST_TYPE is LIST_NODE_ACCESS_TYPE; 160: -- A list of all exported entities. 161: subtype EXPORTED_LIST_TYPE is LIST_NODE_ACCESS_TYPE; 162: -- A list of all imported entities. 163: subtype IMPORTED_LIST_TYPE is LIST_NODE_ACCESS_TYPE; 164: 165: ---------------------------------------------------------------------- 166: -- The definition of the MEMBERSHIP list. 167: ---------------------------------------------------------------------- 168: -- The MEMBERSHIP list exists to maintain a back pointer for 169: -- relations established by other lists. The TREE_OPS package 170: -- should be the only manipulator of this list. 171: -- 172: -- The access type for the MEMBERSHIP list, is implemented as an 173: -- index into LIST array. This is done to minimize the number 174: -- of node types to be handled. 175: 176: subtype MEMBERSHIP_LIST_TYPE is LIST_NODE_ACCESS_TYPE; 177: 178: ---------------------------------------------------------------------- 179: -- The definition of the tree structure. A variant record 180: -- is not possible if this record is to be output using 181: -- an instantiation of DIRECT_IO (see TREE_IO). 182: ---------------------------------------------------------------------- 183: type TREE_NODE_TYPE (NODE_TYPE: ENTITY_TYPE := UNUSED) is 184: record 185: NAME : NAME_TYPE := NULL_NAME; -- the name of this node 186: PARENT : TREE_NODE_ACCESS_TYPE := NULL_POINTER; -- the parent 187: GRAPH_DATA : GRAPH_NODE_ACCESS_TYPE := NULL_POINTER; 188: ------------------------------------------------------------------- 189: -- A list of all list nodes pointing to this node 190: ------------------------------------------------------------------- 191: MEMBERSHIP : MEMBERSHIP_LIST_TYPE := NULL_POINTER; 192: ------------------------------------------------------------------- 193: -- The lists pointing to connected, contained, or related nodes 194: ------------------------------------------------------------------- 195: case NODE_TYPE is 196: when ROOT .. TYPE_TASK => 197: CONTAINED_ENTITY_LIST : CONTAINED_ENTITY_LIST_TYPE := NULL_POINTER; 198: case NODE_TYPE is 199: when TYPE_VIRTUAL_PACKAGE .. TYPE_TASK => 200: BODY_PTR : TREE_NODE_ACCESS_TYPE := NULL_POINTER; 201: case NODE_TYPE is 202: when TYPE_VIRTUAL_PACKAGE .. TYPE_FUNCTION => 203: GENERIC_STATUS : GENERIC_STATUS_TYPE := NOT_GENERIC; 204: CU_INSTANTIATED : NAME_TYPE := NULL_NAME; 205: DATA_CONNECT_LIST : DATA_CONNECT_LIST_TYPE := NULL_POINTER; 206: case NODE_TYPE is 207: when TYPE_VIRTUAL_PACKAGE | TYPE_PACKAGE => 208: EXPORTED_LIST : EXPORTED_LIST_TYPE := NULL_POINTER; 209: IMPORTED_LIST : IMPORTED_LIST_TYPE := NULL_POINTER; 210: when TYPE_FUNCTION | TYPE_PROCEDURE => 211: HAS_PARAMETERS : BOOLEAN := FALSE; 212: when others => 213: null; 214: end case; 215: when TYPE_TASK => 216: TASK_STATUS : TASK_STATUS_TYPE := NORMAL_TASK; 217: ENTRY_LIST : ENTRY_LIST_TYPE := NULL_POINTER; 218: when others => 219: null; 220: end case; 221: when others => 222: null ; 223: end case ; 224: when TYPE_ENTRY_POINT => 225: IS_GUARDED : BOOLEAN := FALSE; -- for task entry points 226: WITH_PARAMETERS : BOOLEAN := FALSE; 227: when TYPE_BODY => 228: CALLEE_LIST : CALLEE_LIST_TYPE := NULL_POINTER; 229: when EXPORTED_PROCEDURE .. CONNECTION_FOR_DATA => 230: CALL_VARIETY : CALL_CONNECTION_TYPE := NO_CONNECTION; 231: CONNECTEE : TREE_NODE_ACCESS_TYPE := NULL_POINTER ; 232: LINE : LINE_TYPE := NULL_LINE ; 233: when others => 234: null; 235: end case; 236: end record; 237: 238: ---------------------------------------------------------------------- 239: -- The arrays containing GRAPH, LIST, and TREE nodes. 240: ---------------------------------------------------------------------- 241: type GRAPH_ARRAY is array (GRAPH_NODE_ACCESS_TYPE range <>) 242: of GRAPH_NODE_TYPE; 243: type LIST_ARRAY is array (LIST_NODE_ACCESS_TYPE range <>) 244: of LIST_NODE_TYPE; 245: type TREE_ARRAY is array (TREE_NODE_ACCESS_TYPE range <>) 246: of TREE_NODE_TYPE; 247: 248: ---------------------------------------------------------------------- 249: -- The size of the arrays 250: ---------------------------------------------------------------------- 251: MAX_GRAPH_NODES : constant GRAPH_NODE_ACCESS_TYPE := 199; 252: MAX_LIST_NODES : constant LIST_NODE_ACCESS_TYPE := 199; 253: MAX_TREE_NODES : constant TREE_NODE_ACCESS_TYPE := 99; 254: 255: ---------------------------------------------------------------------- 256: -- The array declarations 257: ---------------------------------------------------------------------- 258: GRAPH : GRAPH_ARRAY (1..MAX_GRAPH_NODES); 259: LIST : LIST_ARRAY (1..MAX_LIST_NODES); 260: TREE : TREE_ARRAY (1..MAX_TREE_NODES); 261: -- The first element of the TREE is defined to be the ROOT 262: 263: ---------------------------------------------------------------------- 264: -- The Root Node of the TREE 265: ---------------------------------------------------------------------- 266: ROOT_NODE : constant TREE_NODE_ACCESS_TYPE := 1; 267: 268: end TREE_DATA; 269: 270: package body TREE_DATA is 271: begin 272: -- initialize the root of the tree. 273: TREE(ROOT_NODE) := (ROOT, -- NODE_TYPE 274: NULL_NAME, -- NAME 275: NULL_POINTER, -- PARENT 276: NULL_POINTER, -- GRAPH_DATA 277: NULL_POINTER, -- MEMBERSHIP 278: NULL_POINTER); -- CONTAINED_ENTITY_LIST 279: end TREE_DATA; Compilation complete Syntax errors: 0 Semantic errors: 0 Lines compiled: 279 1: pragma source_info ( on ) ; 2: 3: with TREE_DATA; use TREE_DATA; 4: 5: -- controlled by JOHN REDDAN 6: -- version 85-07-18 07:50 by RAM 7: 8: package TREE_IO is 9: -- This package provides all the necessary operations to 10: -- read and write the graph tree from the graphics 11: -- files in the host file system. 12: -- 13: -- This package manipulates data files which consist of copies 14: -- of the graph tree nodes. The node types (GRAPH, TREE, 15: -- and LIST) are stored in arrays in the package 16: -- TREE_DATA. This TREE_IO package will 17: -- copy the graph tree by copying the arrays to the 18: -- specified data file. 19: -- 20: -- Requirements: 21: -- 1) provide the read and write operations needed to 22: -- maintain the graphics files. 23: -- 2) detect corrupted data files. 24: -- 25: 26: -- type to hold filenames 27: subtype FILENAME_TYPE is STRING (1..80); 28: 29: -- null filename for setting FILENAME_TYPE objects 30: NULL_FILENAME : constant FILENAME_TYPE := " "& 31: " "; 32: 33: -- name of file containing original data used 34: DATA_FILENAME : FILENAME_TYPE := NULL_FILENAME; 35: 36: -- name of default file for initialization 37: DEFAULT_FILENAME : constant String := "DATAFILE" ; 38: 39: -- the graphics data file control parameters 40: type FILE_HANDLING_TYPE is (SAVE, 41: NO_SAVE, 42: PANIC_SAVE); 43: FILE_HANDLING_ON_EXIT : FILE_HANDLING_TYPE := SAVE; 44: 45: procedure READ (FILE: in FILENAME_TYPE); 46: -- read the specified page into the arrays in 47: -- the package TREE_DATA. Set all necessary 48: -- parameters based on the values in the file 49: -- (possibly number of nodes). 50: 51: procedure WRITE (FILE: in FILENAME_TYPE); 52: -- Write the contents of the arrays in the 53: -- package TREE_DATA to the specified file. 54: 55: INVALID_FILE_SPECIFIER : exception; 56: FILE_OPERATION_FAILURE : exception; 57: 58: end TREE_IO; 59: 60: 61: with DIRECT_IO; 62: with TEXT_IO; 63: package body TREE_IO is 64: 205: end TREE_IO; Compilation complete Syntax errors: 0 Semantic errors: 0 Lines compiled: 205 1: with TREE_DATA; use TREE_DATA; 2: package TREE_OPS is 3: 4: -- Controlled by John Reddan 5: -- version 7-25-85 0900 by JL 6: -------------------------------------------------------------------------- 7: -- Declare the operations needed to use the TREE 8: -------------------------------------------------------------------------- 9: 10: ----------------------------------------------------------------------- 11: -- These subprograms manage the indices into the arrays of GRAPH, 12: -- LIST, and TREE nodes. The Get Node functions will return the 13: -- index value and initialize the corresponding node to be the 14: -- specified variant of the record. The Release Node procedures 15: -- mark the node being released as unused (and hence available for 16: -- reuse). 17: ----------------------------------------------------------------------- 18: 19: function GET_NEW_GRAPH_NODE (OWNING_TREE: in TREE_NODE_ACCESS_TYPE) 20: return GRAPH_NODE_ACCESS_TYPE; 21: -- Get a new Graph Node, and set the OWNING_TREE_NODE field to 22: -- the specified Tree Node. 23: procedure RELEASE_GRAPH_NODE (NODE: in GRAPH_NODE_ACCESS_TYPE); 24: -- This procedure releases the specified Graph Node. 25: 26: function GET_NEW_LIST_NODE (ITEM: in TREE_NODE_ACCESS_TYPE) 27: return LIST_NODE_ACCESS_TYPE; 28: -- Get a new List Node, and set the ITEM field to the specified 29: -- value. The ITEM pointer must not be null, as this indicates 30: -- an used List Node. 31: procedure RELEASE_LIST_NODE (NODE: in LIST_NODE_ACCESS_TYPE); 32: -- This procedure releases the specified list node. 33: 34: 35: function GET_NEW_TREE_NODE (NODE_TYPE: in ENTITY_TYPE) 36: return TREE_NODE_ACCESS_TYPE; 37: -- Initialize the NODE to the correct type and set all values 38: -- to NULL (or the equivalent); 39: procedure RELEASE_TREE_NODE (NODE: in TREE_NODE_ACCESS_TYPE); 40: -- This procedure deletes the specified TREE_NODE and all of 41: -- its children (if any). It will remove any dependencies 42: -- which exist on this node as well. 43: 44: ----------------------------------------------------------------------- 45: -- The following subprograms provide operations to help 46: -- use the tree. 47: ----------------------------------------------------------------------- 48: 49: procedure SET_PARENT (CHILD : in TREE_NODE_ACCESS_TYPE; 50: PARENT : in TREE_NODE_ACCESS_TYPE; 51: RELATION : IN LIST_TYPE); 52: -- Set the Parent Field of the Child Node, and Place the 53: -- Child in the specified List of the Parent. 54: 55: procedure START_TREE_WALK (PARENT : in TREE_NODE_ACCESS_TYPE); 56: function TREE_WALK return TREE_NODE_ACCESS_TYPE; 57: -- This procedure and function are used to walk the tree which 58: -- has the Parent as its root. The function TREE_WALK will 59: -- return NULL_POINTER when all the children have been visited. 60: -- The tree walk excludes the Membership list. Only one tree 61: -- walk can be executed at a time (it is not re-entrant). 62: 63: 64: ----------------------------------------------------------------------- 65: -- These subprograms perform LIST manipulation functions 66: -- and check to make sure that the LIST_NODE pointed to is 67: -- the LIST header node (null back pointer). 68: -- 69: -- The subprograms will also add or remove the corresponding 70: -- node from the MEMBERSHIP list of the TREE_NODE pointed to 71: -- by the node(s). 72: ----------------------------------------------------------------------- 73: 74: function GET_LIST_HEAD (LIST_OWNER: in TREE_NODE_ACCESS_TYPE; 75: REQUESTED_LIST: in LIST_TYPE) 76: return LIST_NODE_ACCESS_TYPE; 77: -- Get the List Head for the REQUESTED_LIST of the specified 78: -- Tree Node LIST_OWNER. This function raises a constraint 79: -- error if the REQUESTED_LIST is not valid for the node type 80: -- of LIST_OWNER. 81: 82: procedure SET_LIST_HEAD (LIST_OWNER: in TREE_NODE_ACCESS_TYPE; 83: REQUESTED_LIST: in LIST_TYPE; 84: NEW_LIST_HEAD: in LIST_NODE_ACCESS_TYPE); 85: -- Set the List Head for the REQUESTED_LIST of the specificed 86: -- Tree Node LIST_OWNER. 87: 88: procedure DELETE_LIST (LIST_OWNER: in TREE_NODE_ACCESS_TYPE; 89: REQUESTED_LIST: in LIST_TYPE); 90: -- Delete the entire REQUESTED_LIST, resulting in a NULL_POINTER 91: -- for the LIST_HEAD. 92: 93: procedure ADD_NODE_TO_LIST (LIST_OWNER: in TREE_NODE_ACCESS_TYPE; 94: REQUESTED_LIST: in LIST_TYPE; 95: NODE_TO_BE_ADDED : in LIST_NODE_ACCESS_TYPE); 96: -- Add the Node to the end of the current list. Start a new 97: -- LIST if the current one is NULL. Place a reference to the 98: -- LIST_OWNER in the MEMBERSHIP list of the ITEM of the list 99: -- node NODE_TO_BE_ADDED. 100: 101: procedure REMOVE_NODE_FROM_LIST (LIST_OWNER: in TREE_NODE_ACCESS_TYPE; 102: REQUESTED_LIST: in LIST_TYPE; 103: NODE: in LIST_NODE_ACCESS_TYPE); 104: -- Remove the specified node from the List. Set LIST_HEAD to NULL 105: -- if this is the last element being removed. Remove the 106: -- reference to the LIST_OWNER from the MEMBERSHIP list of the 107: -- ITEM pointed to by the list node NODE. 108: 109: function FIND_NODE_REFERENCE (LIST_HEAD : in LIST_NODE_ACCESS_TYPE; 110: NODE : in TREE_NODE_ACCESS_TYPE) 111: return LIST_NODE_ACCESS_TYPE; 112: -- Search the specified list for a reference to the specified node, 113: -- and return the List Node with the reference. If no reference is 114: -- found, then return a NULL_POINTER. 115: 116: function NEXT_LIST_TO_SCAN (SCANNED_NODE: in TREE_NODE_ACCESS_TYPE; 117: CURRENT_LIST : in LIST_TYPE := START) 118: return LIST_TYPE; 119: -- Return the type of the next list to be scanned for the node 120: -- specified. If no more lists are to be scanned, return a value 121: -- of NULL_LIST. 122: 123: ----------------------------------------------------------------------- 124: -- These are the exceptions which will occur if the operations fail. 125: ----------------------------------------------------------------------- 126: 127: INVALID_LIST_SPECIFIED : exception; 128: INVALID_OPERATION_REQUESTED : exception; 129: INVALID_NODE_SPECIFIED : exception; 130: LIST_CORRUPTED : exception; -- invalid list pointers detected 131: MISMATCHED_DEPENDENCIES : exception; 132: NODE_SUPPLY_EXHAUSTED : exception; 133: WALK_STACK_OVERFLOW : exception; 134: TREE_CORRUPTED : exception; 135: 136: end TREE_OPS; 137: 138: 139: with TRACE_PKG ; 140: package body TREE_OPS is 993: end TREE_OPS; Compilation complete Syntax errors: 0 Semantic errors: 0 Lines compiled: 993 4.3 MMI The MMI virtual package provides the MMI functions of GAD. The operator interactively makes requests from the terminal input devices (keyboard/cursor control device) to which the MMI routines respond according to the input. Graphics outputs and command inputs are requested via the Graphics_Driver virtual package. Normal text outputs and inputs are requested via the Virtual_Terminal virtual package. The syntax tree structure is maintained (according the graphics operation currently in progress) via calls to the Graph_Tree_Access virtual package primitives. Control is passed to the PDL_Generator virtual package when the PDL generation function is requested. The tool is exited normally upon operator request, which transfers control back to the Run_GAD procedure. The MMI package provides the MMI and implements the requested graphics operations for the GAD program. It inputs the commands from the user via the GRAPHICS_DRIVER to isolate it from device dependencies. The decoded commands are then passed to the appropriate routine(s) of the MMI_OPERATIONS package body. The requirements on this package are to; 1) decode commands entered by the user, and 2) implement the commands required in the GAD User's Manual. The MMI package is supported by a Utilities package which provides the common MMI functions, implemented so as to use the formated screen and selected command features of the GRAPHICS_INTERFACE. This package provides the help facility for each command level. Table 4-4 MMI Virtual Package Dependencies List COMPILATION UNITS TYPE COMMENTS DEPENDENCIES LIST MMI_Parameters Package Data Structures System Utilities Package Includes Help Routines Design_Pkg MMI_Attributes Package Attributes Menu Graph_Tree_Access Control Routines PDL_Generator MMI_Design Package Design Menu Control Graphics_Driver MMI_Menu Package Menu Display Routines Virtual_Terminal MMIops Package MMI - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - MMI MMI_PARAMETERS | -------------------------------------- ----------------- -------------------------------- | ===================== | | | < SYSTEM | | +-------->| INITIALIZE | | (DECLARATIONS) | (A)--< DESIGN_PKG > | | |===================| | | | (B)--< GKS_PRIME > | | | ===================== | | ----------------- (C)--<< GRAPH_TREE_ACCESS >> ------- ------- | +--->| PROCESS_COMMANDS |--- | (D)--<< VIRTUAL_TERMINAL_INTERFACE >> | |---->| |-+ | |===================| | (E)--<< GRAPHICS_DRIVER >> | |---->| |---+ ===================== |------------------->+ (F)--<< PDL_GENERATOR >> | |---->| |---->| PANIC_EXIT |--- | | -------------------------------- ------- ------- |===================| | | MMI_CONTROL_MENUS | | | | | | ------------------------------------ | | --------------------- | | ------- ======================== | | -------------------------------------- | +-->| |---->|=CONFIRM | | | | +-->| o | |======================| | | MMI_ATTRIBUTES | +-->| o | ======================== |----->+ --------------------------------------- +--------|-+-->| |->|=CONTROL_GENERIC_MENU |--- | | | ------- ========================== | | | ------- |======================| | | | | |--->|CONTROL_ATTRIBUTES_MENU | | | | | | |-------->+ | ------- |========================|--------->+ | | ------------------------ | | | | | |------------------>+ ------------------------------------ | | | -------------------------- | | +<----------------------------------------------+ --------------------------------------- | | UTILITIES | MMI_DESIGN | | ------------------------------------ | --------------------------------------- | | ---------------- | | ------- ========================== | | | ( DECLARATIONS ) | | | |--->|CONTROL_DESIGN_MENU | | | | ---------------- | | ------- |========================|--------->+ | | ===================== | | | | |------------------>+ | +------>|=DISPLAY_AND_IDENT | | | | -------------------------- | | ------- | |===================| | | --------------------------------------- +--->| |-+ ===================== | | | +--->| o | +-->|=GET_FILE_HANDLE[] |-- | | +--->| o | | |===================| | ------- +--->| |---+ ===================== | | | | |----------------------------------------------------------------->| |---->| SIGN_ON |-- | ------- ------- |===================| | | | | | | | | --------------------- | | ------------------------------------ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - MMI Virtual Package Design Diagram 1: pragma source_info(on) ; 2: 3: with SYSTEM ; 4: with VIRTUAL_TERMINAL_INTERFACE ; use VIRTUAL_TERMINAL_INTERFACE ; 5: with GKS_SPECIFICATION ; use GKS_SPECIFICATION ; 6: with GRAPHICS_DATA ; use GRAPHICS_DATA ; 7: with GRAPHIC_DRIVER ; use GRAPHIC_DRIVER ; 8: 9: -- controlled by JERRY BAKER 10: -- version 85-07-17 13:10 by RAM 11: 12: package MMI_PARAMETERS is -- version 85-07-16-0830 by JL 13: -- ============================================================== 14: -- 15: -- This package declares the parameters (types and objects) 16: -- used to implement the Man-Machine Interface. The parameters 17: -- are a key part of the interaction between the MMI control 18: -- routines and the GRAPHICS_DRIVER. 19: -- 20: -- 21: -- =============================================================== 22: 23: 24: package GRAPHICS renames GRAPHICS_DATA ; 25: 26: subtype FORMAT_FCT is VIRTUAL_TERMINAL_INTERFACE.FORMAT_FUNCTION ; 27: subtype CURSOR_ADDR is VIRTUAL_TERMINAL_INTERFACE.CURSOR_ADDRESS ; 28: subtype ROW_NO is VIRTUAL_TERMINAL_INTERFACE.ROW_TYPE ; 29: subtype COL_NO is VIRTUAL_TERMINAL_INTERFACE.COLUMN_TYPE ; 30: 31: ----------------------------------------------------- 32: -- list of GRAPHICS_GENERATOR icons used in each menu 33: -- *** order of icons is critical do not alter *** 34: ----------------------------------------------------- 35: type COMMAND_TYPE is ( 36: -- commands common to all menus 37: -- ( excluding the backup command from the main menu ) 38: HELP_CMD , 39: RESTART_CMD , 40: BACKUP_CMD , 41: 42: -- commands in MAIN_MENU 43: DESIGN_CMD , 44: ATTRIBUTES_CMD , 45: GEN_PDL_CMD , 46: FILE_CMD , 47: PRINT_CMD , 48: QUIT_CMD , 49: FINISHED_CMD , 50: 51: -- commands in DESIGN_MENU 52: CREATE_CMD , 53: DELETE_CMD , 54: EDIT_CMD , 55: MOVE_OBJECT_CMD , 56: ZOOM_IN_CMD , 57: ZOOM_OUT_CMD , 58: PAN_UP_CMD , 59: PAN_DOWN_CMD , 60: PAN_LEFT_CMD, 61: PAN_RIGHT_CMD , 62: 63: -- commands in ATTRIBUTES_MENU 64: COND_CALL_CMD , 65: TIMED_CALL_CMD , 66: NORM_REF_CALL_CMD , 67: VIRT_REF_CALL_CMD , 68: GUARD_ENTRY_CMD , 69: CALL_LINE_CMD , 70: DATA_LINE_CMD , 71: SUBPROGRAM_CMD , 72: 73: -- commands common to ATTRIBUTES_MENU and CREATE_MENU 74: VIRT_PACKAGE_CMD , 75: PACKAGE_CMD , 76: TASK_CMD , 77: 78: -- commands in CREATE_MENU 79: PROCEDURE_CMD , 80: FUNCTION_CMD , 81: CONNECTION_CMD , 82: BODY_CMD , 83: 84: -- commands in EDIT_MENU 85: ADD_CMD , 86: MODIFY_CMD , 87: REMOVE_CMD , 88: 89: -- commands in CHANGE_TYPE_MENU 90: PEN_COLOR_CMD , 91: SYMBOL_CMD , 92: 93: -- commands in GENERIC_MENU 94: DECLARATION_CMD , 95: INSTANTIATION_CMD , 96: NON_GENERIC_CMD , 97: 98: -- commands in CONNECTION_MENU 99: CALL_CMD , 100: DATA_CMD , 101: 102: -- commands in ANNOTATING_MENU 103: TASK_ENTRY_CMD , 104: EXPORT_TYPE_CMD , 105: EXPORT_OBJ_CMD , 106: EXPORT_EXCEPT_CMD , 107: EXPORT_PROC_CMD , 108: EXPORT_FUNC_CMD , 109: EXPORT_TASK_CMD , 110: IMPORT_VP_CMD , 111: IMPORT_PKG_CMD , 112: IMPORT_PROC_CMD , 113: IMPORT_FUNC_CMD , 114: 115: -- commands in CONFIRM_MENU 116: CONFIRM_CMD , 117: CANCEL_CMD , 118: 119: -- commands in COLOR_MENU 120: RED_CMD , 121: ORANGE_CMD , 122: YELLOW_CMD , 123: VIOLET_CMD , 124: BLUE_CMD , 125: GREEN_CMD , 126: BROWN_CMD , 127: BLACK_CMD , 128: 129: -- commands in LINE_MENU 130: SOLID_CMD , 131: DASHED_CMD , 132: DOTTED_CMD , 133: 134: -- commands in PARAMETER_STATUS_MENU 135: HAS_PARAMETERS , 136: NO_PARAMETERS , 137: 138: -- commands in CALL_STATUS_MENU 139: CONDITIONAL , 140: NORMAL , 141: TIMED , 142: 143: -- commands in ENTRY_POINT_STATUS_MENU 144: IS_GUARDED , 145: NOT_GUARDED , 146: 147: -- commands in NULL_MENU 148: NULL_CMD ) ; 149: 150: subtype COMMON_MENU_CMD is COMMAND_TYPE range 151: HELP_CMD..BACKUP_CMD ; 152: subtype MAIN_MENU_CMD is COMMAND_TYPE range 153: DESIGN_CMD..FINISHED_CMD ; 154: subtype DESIGN_MENU_CMD is COMMAND_TYPE range 155: CREATE_CMD..PAN_RIGHT_CMD ; 156: subtype ATTRIBUTES_MENU_CMD is COMMAND_TYPE range 157: COND_CALL_CMD..TASK_CMD ; 158: subtype CREATE_MENU_CMD is COMMAND_TYPE range 159: VIRT_PACKAGE_CMD..CONNECTION_CMD ; 160: subtype EDIT_MENU_CMD is COMMAND_TYPE range 161: ADD_CMD..REMOVE_CMD ; 162: subtype CHANGE_TYPE_MENU_CMD is COMMAND_TYPE range 163: PEN_COLOR_CMD..SYMBOL_CMD ; 164: subtype GENERIC_MENU_CMD is COMMAND_TYPE range 165: DECLARATION_CMD..NON_GENERIC_CMD ; 166: subtype CONNECTION_MENU_CMD is COMMAND_TYPE range 167: CALL_CMD..DATA_CMD ; 168: subtype CONFIRM_MENU_CMD is COMMAND_TYPE range 169: CONFIRM_CMD..CANCEL_CMD ; 170: subtype ANNOTATING_MENU_CMD is COMMAND_TYPE range 171: TASK_ENTRY_CMD..IMPORT_FUNC_CMD ; 172: subtype COLOR_MENU_CMD is COMMAND_TYPE range 173: RED_CMD..BLACK_CMD ; 174: subtype LINE_MENU_CMD is COMMAND_TYPE range 175: SOLID_CMD..DOTTED_CMD ; 176: subtype PARAMETER_STATUS_CMD is COMMAND_TYPE range 177: HAS_PARAMETERS..NO_PARAMETERS ; 178: subtype CALL_STATUS_CMD is COMMAND_TYPE range 179: CONDITIONAL..TIMED ; 180: subtype ENTRY_POINT_STATUS_CMD is COMMAND_TYPE range 181: IS_GUARDED..NOT_GUARDED ; 182: subtype NULL_MENU_CMD is COMMAND_TYPE range 183: NULL_CMD..NULL_CMD ; 184: 185: type MENU_ID is ( MAIN_MENU , 186: DESIGN_MENU , 187: ATTRIBUTES_MENU , 188: CREATE_MENU , 189: CONFIRM_MENU , 190: EDIT_MENU , 191: CHANGE_TYPE_MENU , 192: GENERIC_MENU , 193: CONNECTION_MENU , 194: ANNOTATING_MENU , 195: COLOR_MENU , 196: LINE_MENU , 197: PARAMETER_STATUS_MENU , 198: CALL_STATUS_MENU , 199: ENTRY_POINT_STATUS_MENU , 200: NULL_MENU ) ; 201: 202: ----------------------------------------------------------------- 203: -- The identifiers for icon locations. 204: ----------------------------------------------------------------- 205: subtype ICON_ID is POSITIVE range 1..20 ; 206: 207: ----------------------------------------------------------------- 208: -- This table allows the translation of icon ID's into commands. 209: ----------------------------------------------------------------- 210: MAX_NAME_SIZE : constant POSITIVE := 13 ; 211: NULL_NAME : STRING( 1..MAX_NAME_SIZE ) := "* null cmd * "; 212: 213: type MENU_TABLE_ENTRY is 214: record 215: COMMAND : COMMAND_TYPE := NULL_CMD ; 216: NAME : STRING ( 1..MAX_NAME_SIZE ) := NULL_NAME ; 217: end record ; 218: 219: MENU_TABLE : array ( MENU_ID , ICON_ID ) of MENU_TABLE_ENTRY ; 220: 221: SESSION_NAME : STRING (1..40) := -- A FILENAME 222: " " ; 223: 224: ----------------------------------------------------------------- 225: -- Define the array containing the segment numbers of the menu 226: -- icons indexed by menu and icon. 227: ----------------------------------------------------------------- 228: ICON_SEGMENTS : array ( MENU_ID ) of 229: GRAPHICS_DATA.SEGMENT_LIST_TYPE( ICON_ID'first..ICON_ID'last ) := 230: ( MAIN_MENU..NULL_MENU => ( ICON_ID'first..ICON_ID'last => 231: GRAPHICS_DATA.NULL_SEGMENT )); 232: 233: ---------------------------------------------------------------- 234: -- icon location to id cross reference of lower BOUNDARY 235: ---------------------------------------------------------------- 236: type BOUNDARY_VALUES is 237: record 238: UPPER : GKS_SPECIFICATION.WC ; 239: LOWER : GKS_SPECIFICATION.WC ; 240: end record ; 241: ICON_BOUNDARY : array ( ICON_ID ) of BOUNDARY_VALUES ; 242: 243: ---------------------------------------------------------------- 244: -- Minimum and maximum X values for menu rectangle. 245: ---------------------------------------------------------------- 246: MENU_X_MIN, MENU_X_MAX : GKS_SPECIFICATION.WC ; 247: 248: ---------------------------------------------------------------- 249: -- Menu which is currently displayed to operator. 250: ---------------------------------------------------------------- 251: CURRENT_MENU : MENU_ID := NULL_MENU ; 252: 253: ---------------------------------------------------------------- 254: -- Local exceptions indicating an invalid symbol was selected or 255: -- the user attempted to improperly use a command. 256: ---------------------------------------------------------------- 257: INVALID_COMMAND_SELECTED : exception ; 258: IMPROPER_COMMAND_USAGE : exception ; 259: 260: end MMI_PARAMETERS; 261: 262: 263: 264: package body MMI_PARAMETERS is 556: end MMI_PARAMETERS ; Compilation complete Syntax errors: 0 Semantic errors: 0 Lines compiled: 556 1: pragma source_info(on); 2: 3: with SYSTEM ; 4: with GKS_SPECIFICATION ; use GKS_SPECIFICATION ; 5: with GRAPHICS_DATA ; use GRAPHICS_DATA ; 6: with MMI_PARAMETERS ; use MMI_PARAMETERS ; 7: with TREE_DATA ; use TREE_DATA ; 8: 9: -- controlled by JERRY BAKER 10: -- version 85-07-24 16:25 by JL 11: 12: package UTILITIES is 13: -- =========================================================== 14: -- 15: -- This package provides the common MMI functions, implemented 16: -- so as to use the formated screen and mouse selected command 17: -- features of the GRAPHICS_INTERFACE. 18: -- 19: -- This package provides the help facility. Help can be provided 20: -- on each command level. 21: -- 22: -- The specification is null for compilation under compiler 23: -- version 1.5 24: -- 25: -- ========================================================== 26: 27: package GRAPHICS renames GRAPHICS_DATA ; 28: 29: --{{ Utilities to be placed here as they are recognized, one 30: --{{ example is given below. 31: 32: subtype FILE_NAME is STRING( 1..8 ) ; 33: 34: function GET_FILE_HANDLE 35: return FILE_NAME ; 36: -- =================================================== 37: -- This function prompts the user for a filename and 38: -- opens the file returning the FILE_TYPE needed to 39: -- access the file. 40: -- =================================================== 41: 42: procedure HELP ( MENU : in MENU_ID ) ; 43: -- ======================================================== 44: -- This procedure provides help for the current 45: -- Command Level and all levels beneath it. The format of 46: -- the help will be textual (i.e., it will be implemented 47: -- on the Text plane of the terminal so as to not interfere 48: -- with the graphics. 49: -- ========================================================= 50: 51: procedure SIGN_ON ; 52: -- ========================================================== 53: -- This routine provides initial system start up utilities 54: -- such as clearing the terminal screen, displaying a 55: -- copyright message, etc. 56: -- ========================================================== 57: 58: procedure DISPLAY_MENU_AND_GET_COMMAND 59: ( MENU : in MENU_ID ; 60: NEW_COMMAND : out COMMAND_TYPE ); 61: -- ========================================================== 62: -- Display the appropriate menu and get the user selected 63: -- command. 64: -- ========================================================== 65: 66: procedure DISPLAY_MENU 67: ( MENU : in MENU_ID ; 68: COMMAND : in COMMAND_TYPE ) ; 69: -- ========================================================== 70: -- Display the appropriate menu and highlight the specified 71: -- command. 72: -- ========================================================== 73: 74: procedure DISPLAY_ERROR 75: ( DISPLAY_STRING : in STRING ); 76: -- ========================================================= 77: -- This procedure displays the received string to the 78: -- operator, waits for an operator acknowledgement, and 79: -- clears the displayed line. 80: -- ========================================================= 81: 82: procedure REFERENCE_MARKER 83: ( MODE : in GKS_SPECIFICATION.SEGMENT_VISIBILITY ; 84: LOCATION : in GKS_SPECIFICATION.POINT ) ; 85: -- ========================================================== 86: -- Place the system marker segment at the specified location 87: -- and set the segment visible or invisible. 88: -- ========================================================== 89: 90: function SCOPE_CHECK 91: ( NEW_ENTITY_POINT : in GKS_SPECIFICATION.POINT ; 92: PARENT : in TREE_DATA.TREE_NODE_ACCESS_TYPE ) 93: return BOOLEAN ; 94: -- ========================================================== 95: -- If the specified new entity being drawn is within the 96: -- boundary of the Parent's reference and size points then 97: -- return true; else return false. 98: -- ========================================================== 99: 100: function SCOPE_SEARCH 101: ( REFERENCE_POINT : in GKS_SPECIFICATION.POINT ) 102: return TREE_DATA.TREE_NODE_ACCESS_TYPE ; 103: -- ========================================================== 104: -- Return a Tree Pointer to the Parent of the user 105: -- specified reference point. The Parent is the object 106: -- whose reference and size points contain the user 107: -- specified reference point. 108: -- ========================================================== 109: 110: function TRUNCATE_NAME 111: ( USER_NAME : in STRING ; 112: SPACE_WIDTH : in NATURAL ) 113: return STRING; 114: -- ========================================================== 115: -- Truncate the user name to a width which will fit into 116: -- the user specified space width, and return the 117: -- truncate name. 118: -- ========================================================== 119: 120: procedure REQUEST_CONNECTION 121: (LINE_PARENT : in TREE_DATA.TREE_NODE_ACCESS_TYPE ; 122: START_POINT : in GKS_SPECIFICATION.POINT ; 123: END_POINT : in GKS_SPECIFICATION.POINT ; 124: CONNECTION : in out TREE_DATA.LINE_TYPE ) ; 125: ----------------------------------------------------------------- 126: -- This procedure performs the operations necessary to 127: -- have the User enter the points which define a series 128: -- of line segments which form a connection between the 129: -- starting and ending points. 130: ----------------------------------------------------------------- 131: 132: procedure REQUEST_POINT 133: ( DISPLAY_STRING : in STRING ; 134: REFERENCE_POINT : out GKS_SPECIFICATION.POINT ; 135: PARENT : out TREE_DATA.TREE_NODE_ACCESS_TYPE ) ; 136: -- ========================================================= 137: -- This procedure displays the received string to the 138: -- operator, and returns an operator specified point and 139: -- the associated parent entity. 140: -- ========================================================= 141: 142: procedure REQUEST_POINTS 143: ( REFERENCE_POINT : out GKS_SPECIFICATION.POINT ; 144: SIZE_POINT : out GKS_SPECIFICATION.POINT ; 145: PARENT : out TREE_DATA.TREE_NODE_ACCESS_TYPE ); 146: -- ========================================================= 147: -- This procedure request the operator to input the upper 148: -- left and lower right points of the rectangle which 149: -- delineates the area enclosing the entity to be drawn. 150: -- ========================================================= 151: 152: procedure REQUEST_LABEL 153: ( LABEL : in out TREE_DATA.NAME_TYPE ) ; 154: -- ========================================================== 155: -- Prompt the operator for the label of a graphical entity, 156: -- and verify the validity of the label. 157: -- ========================================================== 158: 159: procedure REQUEST_LABEL 160: ( LABEL : in out TREE_DATA.NAME_TYPE ; 161: PROMPT : in STRING ) ; 162: -- ========================================================== 163: -- Prompt the operator for the label of a graphical entity, 164: -- and verify the validity of the label. 165: -- ========================================================== 166: 167: procedure DIMENSION_CHECK 168: ( SHAPE : in GRAPHICS_DATA.SHAPE_TYPE ; 169: POINT_A : in GKS_SPECIFICATION.POINT ; 170: POINT_B : in out GKS_SPECIFICATION.POINT ) ; 171: -- ========================================================= 172: -- This procedure checks that point b has the minimum 173: -- magnitudes from point a in the x & y directions based 174: -- on the type of object being drawn. If any errors occur 175: -- then the user is notified and the new point b position 176: -- is drawn and confirmation is required. 177: -- ========================================================= 178: 179: procedure DRAW_GRAPH_TREE ; 180: -- ========================================================= 181: -- This procedure draws the contents of the graph tree to 182: -- the graphics display. 183: -- ========================================================= 184: 185: function CHECK_IF_GENERIC_INSTAN 186: ( TREE_NODE : TREE_NODE_ACCESS_TYPE ) 187: return BOOLEAN ; 188: -- ===================================================================== 189: -- This procedure returns true if the TREE_NODE passed to it is 190: -- a generic instantiation. 191: -- ===================================================================== 192: 193: procedure PICK_GRAPH_ENTITY ( PROMPT : in STRING ; 194: GRAPH_NODE : out TREE_DATA.GRAPH_NODE_ACCESS_TYPE ) ; 195: -- ========================================================= 196: -- This procedure performs the prompt display and graph node 197: -- lookup for a picked graphic entity. 198: -- The routine exits with the window being 199: -- the GRAPH_VIEW_PORT. 200: -- ========================================================= 201: 202: function ENTITY_TO_FIGURE_TYPE ( PARENT : ENTITY_TYPE ) return 203: GRAPHICS_DATA.GRAPHIC_ENTITY ; 204: -- ========================================================= 205: -- This procedure returns the graphic_entity declaration 206: -- for the corresponding entity_type declaration. 207: -- ========================================================= 208: 209: function DISPLAY_AND_IDENTIFY ( ENTITY_ITEM : ENTITY_TYPE ; 210: ENTITY_NAME : TREE_DATA.NAME_TYPE ; 211: LABEL_POINT : GKS_SPECIFICATION.POINT ; 212: COLOR : GRAPHICS_DATA.COLOR_TYPE ) return 213: GKS_SPECIFICATION.SEGMENT_IDENTIFIER ; 214: -- ========================================================= 215: -- This procedure displays the entity and returns the 216: -- segment identifier. 217: -- ========================================================= 218: 219: --------------------------------------------------------------- 220: -- This exception is raised if an utility subprogram is unable 221: -- to properly complete the requested operation. 222: --------------------------------------------------------------- 223: UTILITY_FAILED : exception ; 224: 225: end UTILITIES ; 226: 227: -- pragma PAGE ; 228: 229: with GRAPHIC_DRIVER ; use GRAPHIC_DRIVER ; 230: with VIRTUAL_TERMINAL_INTERFACE ; use VIRTUAL_TERMINAL_INTERFACE ; 231: with TEXT_IO ; use TEXT_IO; 232: with TREE_IO ; 233: with TREE_OPS ; 234: with TRACE_PKG ; 235: 236: package body UTILITIES is 1719: end UTILITIES ; Compilation complete Syntax errors: 0 Semantic errors: 0 Lines compiled: 1719 1: pragma source_info ( on ) ; 2: 3: -- controlled by JOHN LONG 4: -- version 85-07-16 0845 by JL 5: 6: package MMI_ATTRIBUTES is 7: -- ============================================================= 8: -- 9: -- This package implements the attribute control capability of 10: -- the Man-Machine Interface. It controls the ATTRIBUTES_MENU 11: -- and all subordinate menus, both in terms of displaying 12: -- the menus and implementing their implied functionality. 13: -- 14: -- ============================================================= 15: 16: procedure CONTROL_ATTRIBUTES_MENU ; 17: -- ========================================================= 18: -- This procedure performs operations required to implement 19: -- the attributes menu commands. 20: -- ========================================================= 21: 22: end MMI_ATTRIBUTES ; 23: 24: with GRAPHICS_DATA ; use GRAPHICS_DATA ; 25: with MMI_PARAMETERS ; use MMI_PARAMETERS ; 26: with UTILITIES ; use UTILITIES ; 27: with VIRTUAL_TERMINAL_INTERFACE ; use VIRTUAL_TERMINAL_INTERFACE ; 28: 29: package body MMI_ATTRIBUTES is 441: end MMI_ATTRIBUTES ; Compilation complete Syntax errors: 0 Semantic errors: 0 Lines compiled: 441 1: pragma source_info ( on ) ; 2: 3: -- controlled by JOHN REDDAN 4: -- version 85-07-25 0935 by JL 5: 6: package MMI_DESIGN is 7: -- ============================================================= 8: -- 9: -- This package implements the design capability of the 10: -- Man-Machine Interface. It controls the DESIGN_MENU 11: -- and all subordinate menus, both in terms of displaying 12: -- the menus and implementing their implied functionality. 13: -- 14: -- ============================================================= 15: 16: procedure CONTROL_DESIGN_MENU ; 17: -- ========================================================= 18: -- This procedure performs operations required to implement 19: -- the design menu commands. 20: -- ========================================================= 21: 22: end MMI_DESIGN ; 23: 24: 25: with GKS_SPECIFICATION ; use GKS_SPECIFICATION ; 26: with GRAPHICS_DATA ; use GRAPHICS_DATA ; 27: with GRAPHIC_DRIVER ; use GRAPHIC_DRIVER ; 28: with MMI_CONTROL_MENUS ; use MMI_CONTROL_MENUS ; 29: with MMI_PARAMETERS ; use MMI_PARAMETERS ; 30: with TRACE_PKG ; 31: with TREE_DATA ; use TREE_DATA ; 32: with TREE_OPS ; use TREE_OPS ; 33: with UTILITIES ; use UTILITIES ; 34: with VIRTUAL_TERMINAL_INTERFACE ; use VIRTUAL_TERMINAL_INTERFACE ; 35: 36: package body MMI_DESIGN is 936: end MMI_DESIGN ; Compilation complete Syntax errors: 0 Semantic errors: 0 Lines compiled: 936 1: pragma source_info ( on ) ; 2: 3: -- controlled by JOHN REDDAN 4: -- version 85-07-24 12:45 by JL 5: 6: with MMI_PARAMETERS ; use MMI_PARAMETERS ; 7: 8: package MMI_CONTROL_MENUS is 9: -- ============================================================= 10: -- 11: -- This package contains the menu control subprograms 12: -- used by the Design functions of the Man-Machine 13: -- Interface. 14: -- 15: -- ============================================================= 16: 17: function CONTROL_GENERIC_MENU return COMMAND_TYPE ; 18: -- ========================================================= 19: -- This procedure performs operations required to implement 20: -- the generic menu commands. 21: -- ========================================================= 22: 23: function CONTROL_PARAMETER_STATUS_MENU return COMMAND_TYPE ; 24: -- ========================================================= 25: -- This procedure performs operations required to implement 26: -- the parameter status menu commands. 27: -- ========================================================= 28: 29: function CONTROL_CALL_STATUS_MENU return COMMAND_TYPE ; 30: -- ========================================================= 31: -- This procedure performs operations required to implement 32: -- the call status menu commands. 33: -- ========================================================= 34: 35: function CONTROL_ENTRY_POINT_STATUS_MENU return COMMAND_TYPE ; 36: -- ========================================================= 37: -- This procedure performs operations required to implement 38: -- the entry point status menu commands. 39: -- ========================================================= 40: 41: function CONTROL_CONNECTION_MENU return COMMAND_TYPE ; 42: -- ========================================================= 43: -- This procedure performs operations required to implement 44: -- the connection menu commands. 45: -- ========================================================= 46: 47: function CONTROL_ANNOTATING_MENU return COMMAND_TYPE ; 48: -- ========================================================= 49: -- This procedure performs operations required to implement 50: -- the add menu commands. 51: -- ========================================================= 52: 53: function CONFIRM return COMMAND_TYPE ; 54: -- ========================================================== 55: -- This function returns true if the user wishes to confirm 56: -- the execution of the operation in progress. Any response 57: -- but confirm will return false. 58: -- ========================================================== 59: 60: end MMI_CONTROL_MENUS ; 61: 62: 63: with GKS_SPECIFICATION ; use GKS_SPECIFICATION ; 64: with GRAPHICS_DATA ; use GRAPHICS_DATA ; 65: with GRAPHIC_DRIVER ; use GRAPHIC_DRIVER ; 66: with TRACE_PKG ; 67: with TREE_DATA ; use TREE_DATA ; 68: with TREE_OPS ; use TREE_OPS ; 69: with UTILITIES ; use UTILITIES ; 70: with VIRTUAL_TERMINAL_INTERFACE ; use VIRTUAL_TERMINAL_INTERFACE ; 71: 72: package body MMI_CONTROL_MENUS is 595: end MMI_CONTROL_MENUS ; Compilation complete Syntax errors: 0 Semantic errors: 0 Lines compiled: 595 1: pragma source_info(on); 2: 3: with SYSTEM ; 4: 5: -- controlled by JERRY BAKER 6: -- version 85-07-18 08:30 by RAM 7: 8: package MMI is 9: -- ============================================================== 10: -- 11: -- This package provides the Man-Machine Interface and 12: -- implements the requested graphics operations for 13: -- the GAD program. It inputs the commands from 14: -- the user via the GRAPHICS_DRIVER to isolate it from 15: -- device dependencies. The decoded commands are then 16: -- passed to the appropriate routine(s) of the MMI_OPERATIONS 17: -- package body. 18: -- 19: -- Requirements: 20: -- 1) decode commands entered by the user. 21: -- 2) implement the commands required in the GAD 22: -- User Manual. 23: -- 24: -- =============================================================== 25: 26: procedure INITIALIZE ; 27: -- ======================================================== 28: -- This procedure will initialize the command derefencing 29: -- table and download all terminal dependent command 30: -- data. 31: -- ======================================================== 32: 33: procedure PROCESS_COMMAND ; 34: -- ====================================================== 35: -- 36: -- This procedure will input commands from the user 37: -- via the GRAPHICS_DRIVER. The selected commands are 38: -- then passed to the MMI_OPERATIONS package. 39: -- ======================================================= 40: 41: procedure PANIC_EXIT ; 42: -- ======================================================== 43: -- This procedure orchestrates an abnormal termination 44: -- condition detected by the program unit. 45: -- ======================================================== 46: 47: end MMI ; 48: 49: -- pragma PAGE ; 50: with MMI_PARAMETERS ; use MMI_PARAMETERS ; 51: with MMI_DESIGN ; 52: with MMI_ATTRIBUTES ; 53: with VIRTUAL_TERMINAL_INTERFACE ; use VIRTUAL_TERMINAL_INTERFACE ; 54: with GKS_SPECIFICATION ; use GKS_SPECIFICATION ; 55: with GRAPHICS_DATA ; use GRAPHICS_DATA ; 56: with GRAPHIC_DRIVER ; use GRAPHIC_DRIVER ; 57: with PDL_GEN ; 58: with TRACE_PKG ; use TRACE_PKG ; 59: with TREE_IO ; 60: with UTILITIES ; use UTILITIES ; 61: 62: package body MMI is Compilation complete Syntax errors: 0 Semantic errors: 0 Lines compiled: 333 4.4 PDL_GENERATOR The virtual package PDL_GEN contains the subprograms which will generate the Ada PDL corresponding to the current Ada Graph being developed. The PDL_Generator package will create the Ada PDL corresponding to the information stored in the current graph tree (as stored in TREE_DATA). Table 4-5 PDL_GENERATOR Virtual Package Dependencies List COMPILATION UNITS TYPE COMMENTS DEPENDENCIES PDL_Generator Package System Direct_IO Design_Pkg Graph_Tree_Access PDL_GENERATOR - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | PDL_GEN | ----------------------------------------------------- ----------------------- --------------------- ---------------- | (A)-< SYSTEM > : PDL_GEN_OBJECTS : <--( DECLARATIONS ) | +->(B)-< DIRECT_IO > --------------------- ---------------- | | (C)-< DESIGN_PKG > | =========================== | | (D)-<< GRAPH_TREE_ACCESS >> | | +--------------->| TRACE[] | | | ----------------------- | | |=========================| | | | | | =========================== | | | | | +------------->| INDENT | | | | | | | |=========================|-- | | | | | =========================== | | | | | +----------->| INCREMENT_INDENTATION | | | | | | | |=========================|-- | | | | | =========================== | | | | | +--------->| DECREMENT_INDENTATION | | | | | | | |=========================|-- | | | | | =========================== | | | | | +------->| = EXTRACT[] | | | | | | | |=========================|-- | | | | | =========================== | | | | | +----->| EMIT_SPECS[] | | | | | | | |=========================|-- | | | | | =========================== | | | | | +--->| EMIT_BODIES[] | | | | | | | |=========================|-- | | | | | | | | | | | | --------------------------- | | | | +-------------------------+ | | | --------- ----- ===================== | | | | |---------------->| |------>| GENERATE_PDL[] | | | | | --------- ----- |===================| | | | | | | |--+---------------------+ | | --------------------- | | ----------------------------------------------------- | - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Figure 4 - PDL_GENERATOR Virtual Package Design Diagram 1: -- controlled by John Reddan 2: -- version dated: 16 July 1985 17:20 3: 4: package PDL_GEN is 5: ------------------------------------------------------------------------ 6: -- 7: -- This package will create the Ada PDL corresponding to the 8: -- information stored in the current graph tree (as stored 9: -- in TREE_DATA). 10: ------------------------------------------------------------------------ 11: 12: --------------------------------------------------------------------- 13: -- 14: -- The following are the parameters controlling PDL generation. 15: -- 16: --------------------------------------------------------------------- 17: 18: TRACE_GENERATION : BOOLEAN := False ; -- TRUE; 19: -- Trace the PDL Generation process with an emphasis on 20: -- tracking the nodes traversed. 21: 22: INDENTATION_INCREMENT : NATURAL range 1..8 := 3; 23: -- The number of spaces indented for each nesting level. 24: 25: MAX_INDENTATION : NATURAL range 0..40 := INDENTATION_INCREMENT*10; 26: -- The greatest amount of indentation allowed, should always be 27: -- an multiple of the INDENTATION_INCREMENT 28: 29: MAX_LINE_LENGTH : NATURAL range 50..256 := 80; 30: -- The longest line output in PDL generation 31: 32: UNTRANSLATABLE_CODE_COMMENT_SYMBOL : CHARACTER := '/'; 33: -- The character appended to a standard Ada comment symbol 34: -- to denote an untranslatable code statement (for example, 35: -- a virtual package declaration). 36: -- 37: 38: --------------------------------------------------------------------- 39: -- The following procedure is invoked to cause the PDL generation 40: -- to occur 41: --------------------------------------------------------------------- 42: 43: procedure GENERATE_PDL (PDL_FILE_NAME: in STRING); 44: -- 45: -- This procedure walks the current Graph Tree and emits the 46: -- corresponding Ada PDL in the file designated by the user. 47: -- The procedure expects that PDL_FILE is an handle on 48: -- an open file into which the PDL should be placed. The 49: -- file will be not be closed by GENERATE_PDL. 50: -- 51: 52: end PDL_GEN; 53: 54: 55: 56: with TEXT_IO; 57: with TREE_DATA; use TREE_DATA; 58: with TREE_OPS; use TREE_OPS; 59: package body PDL_GEN is 794: end PDL_GEN; 795: Compilation complete Syntax errors: 0 Semantic errors: 0 Lines compiled: 795 4.5 GRAPHICS_DRIVER The GRAPHICS_DRIVER virtual package provides the primitives required by GAD to communicate with the graphics device(s) it is using. The Graphics_Data package provides the data type containing the graphic information (location and attributes) for each entity in the graph. The pointer to the owning TREE_NODE is maintained in a record which includes the record type declared below. This data will be maintained in arrays, which will allow fairly fast searchs to be conducted. The Graphics_Driver package provides all the necessary screen and graphic manipulation functions needed to perform editing of Graphic Ada Notation. The requirements on the Graphics_Driver package are summarized as follows: 1) Draw graphical entities 2) Erase graphical entities 3) Move graphical entities 4) Save and restore graphical entities 5) Initialize the graphics device 6) Restore the graphics device to VT-100 compatibility mode 7) Provide a device and compiler independent interface This package is designed to perform the low level graphics functions associated with the Graphic Ada Designer, which will use a VT-100 compatible bit-mapped graphics device. This package will be independent of the bit-mapped oriented characteristics of the actual terminal. The package needs to group symbols into hierarchies so that related symbols can be moved together (e.g., the name (label) of a package (box)). The terminal display list capability is utilized to meet part of this requirement. Table 4-6 GRAPHICS_DRIVER Virtual Package Dependencies List COMPILATION UNITS TYPE COMMENTS DEPENDENCIES Graphics_Data Package Graphics List Structures System Graphics_Driver Package Calendar Graph_Tree_Access GKS_Prime GRAPHICS_DRIVER - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - GRAPHICS_DATA | ---------------- | ------------------------- ---------------- | ------------------------------- ( GRAPHICS_DATA_TYPES )<----( DECLARATIONS ) | < SYSTEM > ( GRAPHIC_DRIVER_EXCEPTS)<-+ ---------------- | < DESIGN_PKG > ------------------------- | | | << GRAPH_TREE_ACCESS >> | | | | +-<< GKS_PRIME >> | | | +-<< VIRTUAL_TERMINAL_INTERFACE>> | | ---------------- | ------------------------------- | GRAPHIC_DRIVER +----+ | | ---------------------------------------------- | | | | | | | | ---------------- | | | +---------( DECLARATIONS ) | | | ---------------- | | | | ======================= | | | | +--->| ZOOM | | | | | | |=====================| | | | | | | | | | | | | | |-------->+ | | | ----------------------- | | | ------- ------ | o | o | |----------------------------->| |---------+ o | o | | o |----------------------------->| o | o | o | o |----------------------------->| o | ======================= | | | | |----------------------------->| |------------->| CLEAR_MENU | | | ------- ------ |=====================| | | | | | | | | | | | |-------->+ | | ----------------------- | | ---------------------------------------------- | - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Figure 4 - 5 GRAPHIC_DRIVER Virtual Package Design Diagram 1: pragma source_info(on); 2: 3: with DESIGN_PKG ; use DESIGN_PKG ; 4: with GKS_SPECIFICATION ; use GKS_SPECIFICATION ; 5: 6: -- controlled by BOB MAREK 7: -- version 85-07-24-14:45 by RAM 8: 9: package GRAPHICS_DATA is 10: -- ================================================================ 11: -- 12: -- This package provides the data types containing the graphic 13: -- information (location and attributes) for each entity in 14: -- the graph. Some of the data is device dependent, and hence 15: -- this declaration is separated from the GRAPH_TREE_ACCESS_PACKAGE. 16: -- The pointer to the owning TREE_NODE is maintained in a record 17: -- which includes the record type declared below. This data 18: -- will be maintained in arrays, which will allow fairly fast 19: -- searchs to be conducted. 20: -- 21: -- ================================================================== 22: 23: ---------------------------------- 24: -- The three windows of GAD 25: ---------------------------------- 26: type WINDOW_TYPE is 27: ( GRAPH_VIEW_PORT, -- The graph viewport window 28: MENU_VIEW_PORT , -- The command window 29: TEXT_VIEW_PORT ) ; -- Text interaction window 30: 31: ------------------------------------------------ 32: -- The angular direction used in whole degrees. 33: ------------------------------------------------ 34: subtype ANGLE_TYPE is NATURAL range 1..360 ; 35: 36: -------------------------------------- 37: -- ID number of a segment of objects. 38: -------------------------------------- 39: NULL_SEGMENT : constant GKS_SPECIFICATION.SEGMENT_IDENTIFIER := 40: GKS_SPECIFICATION.SEGMENT_IDENTIFIER'first ; 41: 42: -------------------------------------- 43: -- Define a list of segments. 44: -------------------------------------- 45: type SEGMENT_LIST_TYPE is array( NATURAL range <> ) 46: of GKS_SPECIFICATION.SEGMENT_IDENTIFIER ; 47: 48: -------------------------------------- 49: -- Define a null point 50: ------------------------------------- 51: NULL_POINT : constant GKS_SPECIFICATION.POINT := ( X => 0 , Y => 0 ) ; 52: 53: ------------------------------------------------------- 54: -- The scale factor to be utilized for software zoom. 55: ------------------------------------------------------- 56: subtype SCALE_FACTOR_TYPE is NATURAL range 1..8 ; 57: 58: ------------------------------------------------------- 59: -- Define the zoom direction. 60: ------------------------------------------------------- 61: type ZOOM_DIRECTION is ( ZOOM_IN, ZOOM_OUT ); 62: 63: ------------------------------------------------------- 64: -- Define the pan direction. 65: ------------------------------------------------------- 66: type PAN_DIRECTION is ( PAN_LEFT, PAN_RIGHT, PAN_UP, PAN_DOWN ); 67: 68: ------------------------------------------------------- 69: -- The line type to be utilized in drawing lines. 70: ------------------------------------------------------- 71: type LINE_TYPE is 72: ( SOLID, DASHED, DOTTED ) ; 73: 74: ------------------------------------------------------- 75: -- End of line terminators for use in drawing connectors. 76: ------------------------------------------------------- 77: type TERMINATOR_TYPE is 78: ( NONE, LEFT_ARROW, RIGHT_ARROW, PLUS_SIGN ) ; 79: 80: ------------------------------------------------------------------ 81: -- Define the available colors. 82: ------------------------------------------------------------------ 83: type COLOR_TYPE is 84: ( ORANGE, GREEN, YELLOW, VIOLET, RED, BLUE, 85: BLACK, WHITE, BROWN, DARK_RED, CYAN, 86: PINK, MAGENTA, PEACH, GRAY, DARK_PURPLE ) ; 87: 88: ---------------------------- 89: -- Graphics data declaration 90: ---------------------------- 91: type GRAPHICS_DATA_TYPE is 92: record 93: WINDOW : WINDOW_TYPE := GRAPH_VIEW_PORT ; 94: LABEL_SEG_ID : GKS_SPECIFICATION.SEGMENT_IDENTIFIER := NULL_SEGMENT ; 95: SEGMENT_ID : GKS_SPECIFICATION.SEGMENT_IDENTIFIER := NULL_SEGMENT ; 96: LOCATION : GKS_SPECIFICATION.POINT := NULL_POINT ; 97: SIZE : GKS_SPECIFICATION.POINT := NULL_POINT ; 98: COLOR : COLOR_TYPE := BLACK ; 99: end record ; 100: 101: ------------------------ 102: -- GENERIC informations 103: ------------------------ 104: type GENERIC_STATUS_TYPE is 105: ( NON_GENERIC, GENERIC_DECLARATION, GENERIC_INSTANTIATION ) ; 106: 107: --------------------------------------- 108: -- The possible Call Connection types. 109: --------------------------------------- 110: type CALL_CONNECTION_TYPE is 111: ( NO_CONNECTION, NORMAL, TIMED, CONDITIONAL ) ; 112: 113: ------------------------------------------- 114: -- General signal parameter for operations. 115: ------------------------------------------- 116: type MODE_TYPE is ( ON , OFF ) ; 117: 118: ------------------ 119: -- ENTITY Names 120: ------------------ 121: MAXIMUM_NAME_LENGTH : constant POSITIVE := 80 ; 122: subtype NAME_TYPE is STRING ( 1..MAXIMUM_NAME_LENGTH ) ; 123: 124: type IMPORT_EXPORT_SYMBOL_TYPE is array (1..2) of STRING (1..1) ; 125: 126: PKG_DECL : IMPORT_EXPORT_SYMBOL_TYPE := ("#","#") ; 127: VIRT_PKG_DECL : IMPORT_EXPORT_SYMBOL_TYPE := ("%","%") ; 128: TYPE_DECL : IMPORT_EXPORT_SYMBOL_TYPE := ("(",")") ; 129: OBJECT_DECL : IMPORT_EXPORT_SYMBOL_TYPE := (":",":") ; 130: EXCEPTION_DECL : IMPORT_EXPORT_SYMBOL_TYPE := ("<",">") ; 131: SUBPROG_DECL : IMPORT_EXPORT_SYMBOL_TYPE := ("|","|") ; 132: PARAMS_DECL : IMPORT_EXPORT_SYMBOL_TYPE := ("[","]") ; 133: TASK_ENTRY_DECL : IMPORT_EXPORT_SYMBOL_TYPE := ("/","/") ; 134: SERIAL_ENTRY_DECL : IMPORT_EXPORT_SYMBOL_TYPE := ("/","}") ; 135: ENTRY_FAMILY_DECL : IMPORT_EXPORT_SYMBOL_TYPE := ("(",")") ; 136: 137: subtype INDICATOR_LENGTH_1 is STRING ( 1..1 ) ; 138: subtype INDICATOR_LENGTH_2 is STRING ( 1..2 ) ; 139: subtype INDICATOR_LENGTH_4 is STRING ( 1..4 ) ; 140: 141: FUNCTION_SYMBOL : INDICATOR_LENGTH_1 := "=" ; 142: NORMAL_REFERENCE_SYMBOL : INDICATOR_LENGTH_1 := ">" ; 143: VIRTUAL_REFERENCE_SYMBOL : INDICATOR_LENGTH_2 := ">>" ; 144: TIMED_CALL_SYMBOL : INDICATOR_LENGTH_1 := "T" ; 145: CONDITIONAL_CALL_SYMBOL : INDICATOR_LENGTH_1 := "C" ; 146: GUARDED_ENTRY_SYMBOL : INDICATOR_LENGTH_1 := "*" ; 147: GENERIC_DECL_SYMBOL : INDICATOR_LENGTH_2 := "gd" ; 148: GENERIC_INST_SYMBOL : INDICATOR_LENGTH_2 := "gi" ; 149: TASK_TYPE_SYMBOL : INDICATOR_LENGTH_4 := "(tt)" ; 150: 151: ------------------------------------------------------------ 152: -- This structure defines the shape to be drawn for 153: -- each of the entities which can be graphed. 154: ------------------------------------------------------------ 155: type SHAPE_TYPE is 156: ( SINGLE_RECTANGLE, 157: STACKED_RECTANGLE, 158: SQUARE, 159: PARALLELOGRAM, 160: CIRCLE ) ; 161: 162: ------------------------------------------------------------ 163: -- Define the supported graphic entities. 164: ------------------------------------------------------------ 165: type GRAPHIC_ENTITY is 166: ( VIRTUAL_PKG_FIGURE, 167: PACKAGE_FIGURE, 168: SUBPROGRAM_FIGURE, 169: TASK_FIGURE, 170: BODY_FIGURE, 171: CALL_CONNECT_LINE, 172: DATA_CONNECT_LINE ) ; 173: 174: 175: ------------------------------------------------------------ 176: -- Define the supported graphic entities which consist of 177: -- a line, and those which consist a figure. 178: ------------------------------------------------------------ 179: subtype LINE_ENTITY is GRAPHIC_ENTITY 180: range CALL_CONNECT_LINE..DATA_CONNECT_LINE ; 181: 182: subtype FIGURE_ENTITY is GRAPHIC_ENTITY 183: range VIRTUAL_PKG_FIGURE..BODY_FIGURE ; 184: 185: ------------------------------------------------------------ 186: -- Define the arrays containing the current attributes for 187: -- each of the supported graphic entities. 188: ------------------------------------------------------------ 189: type SHAPE_ARRAY is array ( FIGURE_ENTITY ) of SHAPE_TYPE ; 190: 191: type LINE_ARRAY is array ( GRAPHIC_ENTITY ) of LINE_TYPE ; 192: 193: type COLOR_ARRAY is array ( GRAPHIC_ENTITY ) of COLOR_TYPE ; 194: 195: ------------------------------------------------------------------- 196: -- Initialize the arrays containing the current attributes for 197: -- each of the supported graphic entities. 198: ------------------------------------------------------------------- 199: 200: ENTITY_SHAPE : SHAPE_ARRAY := ( 201: VIRTUAL_PKG_FIGURE => SHAPE_TYPE'( SINGLE_RECTANGLE ), 202: PACKAGE_FIGURE => SHAPE_TYPE'( SINGLE_RECTANGLE ), 203: SUBPROGRAM_FIGURE => SHAPE_TYPE'( STACKED_RECTANGLE ), 204: TASK_FIGURE => SHAPE_TYPE'( PARALLELOGRAM ), 205: BODY_FIGURE => SHAPE_TYPE'( CIRCLE ) ); 206: 207: ENTITY_LINE : LINE_ARRAY := ( 208: VIRTUAL_PKG_FIGURE => LINE_TYPE'( DASHED ), 209: PACKAGE_FIGURE => LINE_TYPE'( SOLID ), 210: SUBPROGRAM_FIGURE => LINE_TYPE'( SOLID ), 211: TASK_FIGURE => LINE_TYPE'( SOLID ), 212: BODY_FIGURE => LINE_TYPE'( SOLID ), 213: CALL_CONNECT_LINE => LINE_TYPE'( SOLID ), 214: DATA_CONNECT_LINE => LINE_TYPE'( DOTTED ) ); 215: 216: ENTITY_COLOR : COLOR_ARRAY := ( 217: VIRTUAL_PKG_FIGURE => COLOR_TYPE'( BLACK ), 218: PACKAGE_FIGURE => COLOR_TYPE'( BLACK ), 219: SUBPROGRAM_FIGURE => COLOR_TYPE'( BLACK ), 220: TASK_FIGURE => COLOR_TYPE'( BLACK ), 221: BODY_FIGURE => COLOR_TYPE'( BLACK ), 222: CALL_CONNECT_LINE => COLOR_TYPE'( BLACK ), 223: DATA_CONNECT_LINE => COLOR_TYPE'( BLACK ) ); 224: 225: ------------------------------------------------- 226: -- ICON Structure Definition 227: ------------------------------------------------- 228: subtype ICON_TYPE is POSITIVE range 1 .. 100 ; 229: 230: ------------------------------------------------- 231: -- offset constants for labels 232: ------------------------------------------------- 233: ENITITY_NAME_Y_OFFSET : GKS_SPECIFICATION.WC ; 234: IMPORT_EXPORT_X_OFFSET : GKS_SPECIFICATION.WC ; 235: CHARACTER_WIDTH_OFFSET : GKS_SPECIFICATION.WC ; 236: STACKED_SIZE : GKS_SPECIFICATION.WC ; 237: 238: 239: end GRAPHICS_DATA ; 240: 241: 242: package body GRAPHICS_DATA is 254: end GRAPHICS_DATA ; Compilation complete Syntax errors: 0 Semantic errors: 0 Lines compiled: 254 1: pragma source_info(on) ; 2: 3: with DESIGN_PKG ; use DESIGN_PKG ; 4: with GRAPHICS_DATA ; use GRAPHICS_DATA ; 5: with GKS_SPECIFICATION ; use GKS_SPECIFICATION ; 6: 7: -- controlled by BOB MAREK 8: -- version 85-07-22 13:20 by RAM 9: 10: package GRAPHIC_DRIVER is 11: -- ================================================================ 12: -- 13: -- This package provides all the necessary screen and graphic 14: -- manipulation functions needed to perform editing of Graphic 15: -- Ada Notation. 16: -- 17: -- Requirements: 18: -- 1) draw graphical entities 19: -- 2) erase graphical entities 20: -- 3) move graphical entities 21: -- 4) save and restore graphical entities 22: -- 5) initialize the graphics device 23: -- 6) restore the graphics device to VT-100 compatibility mode 24: -- 7) provide a device and compiler independent interface 25: -- 26: -- This package is designed to perform the low level graphics 27: -- functions associated with the Graphic Ada Designer, which 28: -- will use on a VT-100 compatible bit-mapped graphics device. 29: -- This package will be independent of the bit-mapped oriented 30: -- characteristics of the actual terminal. This is accomplished 31: -- by using the VIRTUAL_DISPLAY_INTERFACE (similar to that used by 32: -- the GKS graphics system). Specific features of the VT-100 terminal 33: -- will be supported by this package. 34: -- 35: -- The package needs to group symbols into hierarchies so that 36: -- related symbols can be moved together (e.g., the name (label) 37: -- of a package (box)). If the display list capability is 38: -- utilized, it will be utilized to meet this requirement. 39: -- 40: -- ================================================================== 41: 42: package GRAPHICS renames GRAPHICS_DATA ; 43: 44: procedure CLEAR_MENU 45: ( MENU : in GRAPHICS.SEGMENT_LIST_TYPE ) ; 46: -- ====================================================== 47: -- Clear the selected menu in the menu window. 48: -- ====================================================== 49: 50: procedure CLOSE_SEGMENT ; 51: -- =============================================================== 52: -- Close the currently active drawing segment. 53: -- ============================================================== 54: 55: procedure DELETE_SEGMENT 56: ( SEGMENT : in GKS_SPECIFICATION.SEGMENT_IDENTIFIER ) ; 57: -- =============================================================== 58: -- Delete a segment from the graphic output. 59: -- ============================================================== 60: 61: procedure DISPLAY_MENU 62: ( MENU : in GRAPHICS.SEGMENT_LIST_TYPE ) ; 63: -- ====================================================== 64: -- Display the selected menu in the menu window. 65: -- ====================================================== 66: 67: function DRAW_BOX 68: ( COLOR : in GRAPHICS.COLOR_TYPE ; 69: FILL : in GKS_SPECIFICATION.INTERIOR_STYLE_TYPE ; 70: LINE : in GRAPHICS.LINE_TYPE ; 71: UPPER_LEFT : in GKS_SPECIFICATION.POINT ; 72: LOWER_RIGHT : in GKS_SPECIFICATION.POINT ) 73: return GKS_SPECIFICATION.SEGMENT_IDENTIFIER ; 74: -- ======================================================== 75: -- Procedure draws a box of defined parameters, used for 76: -- creating menus and icons only. 77: -- ======================================================== 78: 79: function DRAW_FIGURE 80: ( DRAWING_ENTITY : GRAPHICS.FIGURE_ENTITY ; 81: BEGIN_POINT : GKS_SPECIFICATION.POINT ; 82: END_POINT : GKS_SPECIFICATION.POINT ) 83: return GKS_SPECIFICATION.SEGMENT_IDENTIFIER ; 84: -- ====================================================== 85: -- Draw the specified graphic entity at the specified 86: -- position using the currently defined attributes for 87: -- the graphic entity, and return its SEGMENT_ID. 88: -- ====================================================== 89: 90: function DRAW_LINE 91: ( DRAWING_ENTITY : GRAPHICS.LINE_ENTITY ; 92: STARTING_POINT : GKS_SPECIFICATION.POINT ; 93: ENDING_POINT : GKS_SPECIFICATION.POINT ) 94: return GKS_SPECIFICATION.SEGMENT_IDENTIFIER ; 95: -- ====================================================== 96: -- Draw a line at the specified position using the 97: -- currently defined attributes for the specified 98: -- graphic entity, and return its SEGMENT_ID. 99: -- ====================================================== 100: 101: function GET_GRAPHICS_CURSOR_POSITION 102: return GKS_SPECIFICATION.POINT ; 103: -- ===================================================== 104: -- Return the position of the graphics cursor in world 105: -- coordinates. 106: -- ===================================================== 107: 108: procedure GRAPHICS_SCREEN 109: ( MODE : in MODE_TYPE ) ; 110: -- ===================================================== 111: -- Activates or Deactivates the visibility of the 112: -- graphics screen. 113: -- ===================================================== 114: 115: procedure HILITE_SEGMENT 116: ( SEGMENT_ID : in GKS_SPECIFICATION.SEGMENT_IDENTIFIER; 117: MODE : in GKS_SPECIFICATION.SEGMENT_HIGHLIGHTING ) ; 118: -- ====================================================== 119: -- Turn the selected segment highlight on or off. 120: -- ====================================================== 121: 122: procedure INITIALIZE_GRAPHICS_MODE ; 123: -- ======================================================== 124: -- Initialize device for graphics capability. 125: -- ======================================================== 126: 127: procedure INIT_SCREEN 128: ( NEW_COLOR : in GRAPHICS.COLOR_TYPE ; 129: MENU_AREA : out GKS_SPECIFICATION.RECTANGLE ) ; 130: -- ======================================================== 131: -- Set the screen parameters as needed. This will include 132: -- establishing a scroll region on the bottom two lines. 133: -- ======================================================== 134: 135: function LABEL 136: ( LOCATION : in GKS_SPECIFICATION.POINT ; 137: NAME : in String ; 138: CHARACTER_COLOR : in GRAPHICS.COLOR_TYPE ; 139: BACKGROUND_COLOR : in GRAPHICS.COLOR_TYPE := WHITE ) 140: return GKS_SPECIFICATION.SEGMENT_IDENTIFIER ; 141: -- ====================================================== 142: -- Place the specified label on the graph and associate it with 143: -- the specified object, returning the label SEGMENT_ID. 144: -- ====================================================== 145: 146: procedure MOVE 147: ( SEGMENT_ID : in GKS_SPECIFICATION.SEGMENT_IDENTIFIER ; 148: NEW_LOCATION : in GKS_SPECIFICATION.POINT ) ; 149: -- ====================================================== 150: -- Move the specified segment to its new location. 151: -- ====================================================== 152: 153: function OPEN_SEGMENT 154: return GKS_SPECIFICATION.SEGMENT_IDENTIFIER ; 155: -- =============================================================== 156: -- Create and open a segment for graphic output. 157: -- ============================================================== 158: 159: procedure PAN 160: ( DIRECTION : in GRAPHICS.PAN_DIRECTION ) ; 161: -- ====================================================== 162: -- Pan away from the current display. 163: -- ====================================================== 164: 165: function PICK_SEGMENT 166: return GKS_SPECIFICATION.SEGMENT_IDENTIFIER ; 167: -- ====================================================== 168: -- Ask the operator to pick a graphical object and return 169: -- its SEGMENT_ID. 170: -- ====================================================== 171: 172: procedure REFRESH_SCREEN ; 173: -- ========================================================== 174: -- This procedure rewrites the entire screen with 175: -- the contents of the current window on the graphics 176: -- page. This will be done using the display list 177: -- capability. If the window has not yet been defined it 178: -- will default to a window on (0,0) with scaling of 1. 179: -- =========================================================== 180: 181: procedure SEGMENT_VISIBILITY 182: ( SEGMENT : in GKS_SPECIFICATION.SEGMENT_IDENTIFIER ; 183: MODE : in GKS_SPECIFICATION.SEGMENT_VISIBILITY ) ; 184: -- ====================================================== 185: -- Change the segment visibility. 186: -- ====================================================== 187: 188: procedure SELECT_WINDOW 189: ( WINDOW : in GRAPHICS.WINDOW_TYPE ) ; 190: -- ============================================================= 191: -- Set the currently active window. 192: -- ============================================================= 193: 194: procedure TERMINATE_GRAPHICS_MODE ; 195: -- ======================================================== 196: -- Restore the device to VT100 mode. 197: -- ======================================================== 198: 199: procedure UPDATE_COLOR_ATTRIBUTE 200: ( DRAWING_ENTITY : in GRAPHICS.GRAPHIC_ENTITY ; 201: NEW_COLOR : in GRAPHICS.COLOR_TYPE ) ; 202: -- ====================================================== 203: -- Update the value of the currently defined color 204: -- attribute for the specified graphic entity. 205: -- ====================================================== 206: 207: procedure UPDATE_LINE_ATTRIBUTE 208: ( DRAWING_ENTITY : in GRAPHICS.GRAPHIC_ENTITY ; 209: NEW_LINE : in GRAPHICS.LINE_TYPE ) ; 210: -- ====================================================== 211: -- Update the value of the currently defined line 212: -- attribute for the specified graphic entity. 213: -- ====================================================== 214: 215: procedure UPDATE_SHAPE_ATTRIBUTE 216: ( DRAWING_ENTITY : in GRAPHICS.FIGURE_ENTITY ; 217: NEW_SHAPE : in GRAPHICS.SHAPE_TYPE ) ; 218: -- ====================================================== 219: -- Update the value of the currently defined shape 220: -- attribute for the specified graphic entity. 221: -- ====================================================== 222: 223: procedure ZOOM 224: ( DIRECTION : in GRAPHICS.ZOOM_DIRECTION ) ; 225: -- ====================================================== 226: -- Zoom in or out from the current display. 227: -- ====================================================== 228: 229: --------------------------------------------------------- 230: -- The following exceptions can be raised in this package: 231: -- 232: -- INVALID_SEGMENT_ID 233: -- Raised if an illegal SEGMENT_ID is specified. 234: -- INVALID_GRAPHICS_OPERATION 235: -- Raised if an invalid, illegal, or unimplementable graphics 236: -- operation is requested. 237: -- INVALID_LOCATION 238: -- Raised if an invalid location is specified for the graphing 239: -- of an object. For example if a label is not placed on its 240: -- associated object this exception will be raised. 241: ----------------------------------------------------------------- 242: INVALID_SEGMENT_ID : exception ; 243: INVALID_GRAPHICS_OPERATION : exception ; 244: INVALID_LOCATION : exception ; 245: 246: end GRAPHIC_DRIVER ; 247: 248: --pragma PAGE ; 249: with GKS_SPECIFICATION ; use GKS_SPECIFICATION ; 250: with GKS_PRIME ; use GKS_PRIME ; 251: with VIRTUAL_TERMINAL_INTERFACE ; use VIRTUAL_TERMINAL_INTERFACE ; 252: with TRACE_PKG ; use TRACE_PKG ; 253: with TEXT_IO ; use TEXT_IO ; 254: 255: package body GRAPHIC_DRIVER is 1500: end GRAPHIC_DRIVER ; Compilation complete Syntax errors: 0 Semantic errors: 0 Lines compiled: 1500 4.6 GKS_PRIME The GKS_Specification package declares the types and operations declared below, reflect the facilities required by the Graphic Ada Designer. Unused operations may be commented out to reduce compilation overhead. The operations for each level are segmented into separately compilable packages for compilation efficiency reasons. The GKS_PRIME package implements a subset of the GKS developed by SYSCON Corporation for use with the Graphic Ada Designer. The specification is based on: 1) The Ada Phase I GKS developed by Harris Corp, and 2) draft GKS Binding to ANSI Ada. This implementation will initially be a partial subset, with only those operations required by the Graphic Ada Designer implemented. Although the semantics of the functions implemented are intended to be faithful to those decribed in the GKS Binding, the goal of efficiency and compactness may result in the implementation code ignoring certain arguments (e.g., opening a workstation may be unnecessary and implemented as a null operation). The code will directly manipulate primitives of the target graphics device, without the intermediate operations associated with GKS. The implementation and utilization of this package will be faithful enough to the real GKS to permit the Graphic Ada Designer to be easily converted to using a real version of GKS. The Terminal_Access package implements a version of the GKS developed by SYSCON Corporation for use to the target terminal type. Calls to this package will originate only from package GKS. The only calls originating from this package will be to the target terminal drivers. This package is the standard interface for all target terminal accesses. Table 4-7 GKS_PRIME Virtual Package Dependencies List COMPILATION UNITS TYPE COMMENTS DEPENDENCIES GKS_Specification Package GKS Type Declarations System GKS_Prime Package Text_IO Terminal_Access Package Terminal Specific Design_Pkg Routines Envision_Pkg GKS_PRIME - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - GKS_SPECIFICATION | --------------------- | ---------------- | | ----------------------- ( GKS_TYPES )<---( DECLARATIONS ) | < SYSTEM > ---------------- | | (A)--< TEXT_IO > | --------------------- < DESIGN_PKG > | GKS_PRIME (B)--< ENVISION_PACKAGES > -------------------------------------- TERMINAL_ACCESS ----------------------- | | | ----------------------------------------- | LEVEL_0A | | ===================== | | | | --------------- | ---------------- +--->| SET_CURRENT_WINDOW| | | | | | ( DECLARATIONS ) | |===================| | | | | ------- | | ---------------- | | |---->+->(A,B) | +---->| | | | | | --------------------- | | | | | | ------- |------->+ --------- | o | | | | --------------- | +-->| |--------+ ===================== | | | | | | LEVEL_0B | +-->| |------------>| INIT_TERMINAL | | | | | --------------- | | --------- |===================| | | | | | | | | | | | | |---->+->(A,B) | | ------- | | | | --------------------- | | | ------ ----- | +->| | | | | ----------------------------------------| | | |--->| |--------+ | ------- |------->+ +-----------------------------------------------+ | | |--->| |-----------+ --------------- | | | MINI_MATH_PAC | |--->| |--------+ LEVEL_1A | | | --------------------------------------------- | | |--->| |-------+| --------------- | | | | ===================== | ------ ----- || | | | | | ---------------- +--->|=SINE[] | | | | | || ------- | | | | ( DECLARATIONS ) | |===================| | | | |+---->| | | | | | ---------------- | | | | | | | ------- |------->+ | | | --------------------- | | | | --------------- | | | ------- | o | | | | LEVEL_1B | +---+>| |------------+ ===================== | | | | --------------- | +---+>| |---------------->|=SQRT[] | | | | | | | | | ------- |===================| | | | | ------- | | | | | | | | | +----->| | | | | | --------------------- | | | ------- |------->+ --------------------------------------------- | | --------------- | | -------------------------------------- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - GKS_PRIME Virtual Package Design Diagram 1: pragma source_info(on); 2: 3: with DESIGN_PKG ; use DESIGN_PKG ; 4: 5: -- controlled by BOB MAREK 6: -- VERSION 85-07-16-12:45 by RAM 7: 8: package GKS_SPECIFICATION is 9: -- ============================================================== 10: -- This package implements the type declarations for the 11: -- version of the Graphical Kernel System (GKS) developed 12: -- by SYSCON Corporation for use with the Graphic Ada Designer. 13: -- The specification is based on: 14: -- 15: -- 1) The Ada Phase I GKS developed by Harris Corp. 16: -- 2) Draft GKS Binding to ANSI Ada 17: -- 18: -- The types and operations declared below, reflect the 19: -- facilities required by the Graphic Ada Designer. Unused 20: -- operations may be commented out to reduce compilation 21: -- overhead. 22: -- ============================================================== 23: 24: type WORKSTATION_ID is 25: ( ENVISION_230 , 26: TEKTRONIX_4107 , 27: NONE ) ; 28: 29: type WORKSTATION_ID_LIST is array ( 1 .. 1 ) of WORKSTATION_ID ; 30: 31: type CONNECTION_ID is ( UNIT_I ) ; 32: 33: type WORKSTATION_TYPE is ( COLOUR_OUTPUT ) ; 34: 35: type WORKSTATION_TYPE_LIST is array ( 1 .. 1 ) of WORKSTATION_TYPE ; 36: 37: subtype MEMORY_UNITS is POSITIVE ; 38: 39: ------------------------------------------ 40: -- Define segment as VISIBLE or INVISIBLE 41: ------------------------------------------ 42: type SEGMENT_VISIBILITY is 43: ( VISIBLE , 44: INVISIBLE ) ; 45: 46: --------------------------------------------------------------- 47: -- Define segment as DETECTABLE or UNDETECTABLE for pick input. 48: --------------------------------------------------------------- 49: type SEGMENT_DETECTABILITY is 50: ( UNDETECTABLE , 51: DETECTABLE ) ; 52: 53: ------------------------------------------- 54: -- Define segment as HIGHLIGHTED or NORMAL. 55: ------------------------------------------- 56: type SEGMENT_HIGHLIGHTING is 57: ( NORMAL , 58: HIGHLIGHTED ) ; 59: 60: ------------------------------------------------------------------ 61: -- Record containing initialization data for locator input device. 62: ------------------------------------------------------------------ 63: type LOCATOR_DATA_RECORD is 64: record 65: TBD : DESIGN_PKG.T_B_D ; 66: end record ; 67: 68: --{ type SEGMENT_PRIORITY is digits 5 range 0.0 .. 1.0 ; 69: --{ NUMBER_OF_DEVICES : constant := 1 ; 70: --{ type DEVICE_NUMBER is range 1 .. NUMBER_OF_DEVICES ; 71: 72: subtype SEGMENT_PRIORITY is FLOAT ; 73: NUMBER_OF_DEVICES : constant POSITIVE := 1 ; 74: subtype DEVICE_NUMBER is POSITIVE range 1 .. NUMBER_OF_DEVICES ; 75: 76: ----------------------------------------- 77: -- Definition of pick identifier values. 78: ----------------------------------------- 79: subtype PICK_VALUE_TYPE is INTEGER ; 80: 81: --------------------------------------------------------------- 82: -- Contains initialization values which are passed to the pick 83: -- logical input device when the device is initialized. 84: --------------------------------------------------------------- 85: type PICK_DATA_RECORD is 86: record 87: TBD : DESIGN_PKG.T_B_D ; 88: end record ; 89: 90: --------------------------------------------------------- 91: -- The following structure declarations define the 92: -- GKS World Coordinate System space: 93: -- 94: -- WC : Definition for World Coordinate (WC) system variables. 95: -- LIMITS : World coordinate system boundary values. 96: -- POINT : Definition of point in world coordinate system. 97: -- VECTOR : Definition of vector in world coordinate system. 98: -- SIZE : Character size in world coordinate system. 99: -- RECTANGLE: Rectangle in world coordinate system. 100: --------------------------------------------------------- 101: --{ subtype WC is FLOAT ; 102: MAX_WC : constant NATURAL := 32_767 ; 103: MIN_WC : constant NATURAL := 0 ; 104: subtype WC is NATURAL range MIN_WC..MAX_WC ; 105: 106: type LIMITS is 107: record 108: MIN : WC ; 109: MAX : WC ; 110: end record ; 111: type POINT is 112: record 113: X : WC ; 114: Y : WC ; 115: end record ; 116: type POINT_LIST is array ( integer range <> ) of POINT ; 117: 118: type VECTOR is 119: record 120: X : WC ; 121: Y : WC ; 122: end record ; 123: 124: type SIZE is 125: record 126: X : WC ; 127: Y : WC ; 128: end record ; 129: 130: type RECTANGLE is 131: record 132: X : LIMITS ; 133: Y : LIMITS ; 134: end record ; 135: 136: ----------------------------------------------------------- 137: -- The following structure declarations define the 138: -- Device Coordinate System Space. 139: -- 140: -- DC : Definition for Device Coordinate (DC) system variables. 141: -- LIMITS_DC : Device coordinate system boundary values. 142: -- POINT_DC : Definition of point in device coordinate system. 143: -- RECTANGLE_DC : Rectangle in device coordinate system. 144: -- SIZE_DC : Workstation maximum display size. 145: ------------------------------------------------------------ 146: --{ subtype DC is FLOAT ; 147: subtype DC is WC ; 148: 149: type DC_UNITS is 150: ( METRES , 151: OTHER ) ; 152: 153: subtype LIMITS_DC is LIMITS ; 154: -- type LIMITS_DC is 155: -- record 156: -- MIN : DC ; 157: -- MAX : DC ; 158: -- end record ; 159: 160: subtype POINT_DC is POINT ; 161: -- type POINT_DC is 162: -- record 163: -- X : DC ; 164: -- Y : DC ; 165: -- end record ; 166: 167: subtype POINT_DC_LIST is POINT_LIST ; 168: -- type POINT_DC_LIST is array ( integer range <> ) of POINT_DC ; 169: 170: subtype RECTANGLE_DC is RECTANGLE ; 171: -- type RECTANGLE_DC is 172: -- record 173: -- X : LIMITS_DC ; 174: -- Y : LIMITS_DC ; 175: -- end record ; 176: 177: subtype SIZE_DC is SIZE ; 178: -- type SIZE_DC is 179: -- record 180: -- X : DC ; 181: -- Y : DC ; 182: -- end record ; 183: 184: -- scale_factor range 0.0 .. 1.0 185: subtype SCALE_FACTOR is FLOAT ; 186: 187: ----------------------------------------------------------------- 188: -- Define scale factors and translation factors used to 189: -- perform transformations. 190: ----------------------------------------------------------------- 191: type SCALING_FACTOR is 192: record 193: X : SCALE_FACTOR ; 194: Y : SCALE_FACTOR ; 195: end record ; 196: 197: type TRANSLATE_FACTOR is 198: record 199: A : SCALE_FACTOR; 200: B : SCALE_FACTOR; 201: end record; 202: 203: -------------------------------------- 204: -- Definition of text character paths. 205: -------------------------------------- 206: type TEXT_PATH is 207: ( RIGHT , 208: LEFT , 209: UP , 210: DOWN ) ; 211: 212: type TEXT_PRECISION is 213: ( STRING_PRECISION , 214: STROKE_PRECISION , 215: CHAR_PRECISION ) ; 216: 217: type FONT_TYPE is 218: ( STD , 219: MILITARY ) ; 220: 221: type TEXT_FONT_PRECISION is 222: record 223: FONT : FONT_TYPE ; 224: PRECISION : TEXT_PRECISION ; 225: end record ; 226: 227: subtype PICK_IDENTIFIER is NATURAL ; 228: subtype SEGMENT_IDENTIFIER is NATURAL range 0..6000 ; -- 0=null_segment 229: type TEXT_FONT_PRECISION_LIST is array ( 1 .. 2 ) of TEXT_FONT_PRECISION ; 230: subtype CHAR_EXPANSION is NATURAL ; 231: subtype CHAR_SPACING is NATURAL ; 232: subtype CHAR_HEIGHT is NATURAL ; 233: 234: -- intensity range 0.0 .. 1.0 235: subtype INTENSITY is NATURAL ; 236: 237: type COLOUR_REP is 238: record 239: RED : INTENSITY ; 240: GREEN : INTENSITY ; 241: BLUE : INTENSITY ; 242: end record ; 243: 244: -- colour_index range 0..15 245: subtype COLOUR_INDEX is NATURAL ; 246: 247: -- marker_type range 1..5 248: subtype MARKER_TYPE is POSITIVE ; 249: 250: -- line_type range 1..4 251: subtype LINE_TYPE is POSITIVE ; 252: 253: type INTERIOR_STYLE_TYPE is 254: ( HOLLOW , 255: SOLID ); 256: 257: --------------------------------------------------------------------- 258: -- Determine type of generalized drawing primitive (GDP) requested. 259: -- All GDP functions based on a two point definition point list 260: -- to completely describe the location of the entity, the two points 261: -- define a box that is used for a rectangle or show the outer limits 262: -- of the circles location using the first (upper left) point as the 263: -- standard reference. 264: --------------------------------------------------------------------- 265: type GDP_ID is 266: ( GDP_CIRCLE , 267: GDP_RECTANGLE ) ; 268: 269: type GDP_ID_LIST is array ( 1 .. 1 ) of GDP_ID ; 270: 271: type ESCAPE_IDENTIFIER is 272: ( ALPHA_BACKGROUND , 273: ALPHA_WRITING , 274: GRAPHIC_BACKGROUND , 275: GRAPHICS_VISIBILITY , 276: MAP_WINDOW_TO_VIEWPORT , 277: SEGMENT_MOVEMENT , 278: SELECT_WINDOW ) ; 279: 280: type ESCAPE_RECORD ( IDENTIFIER : ESCAPE_IDENTIFIER ) is 281: record 282: case IDENTIFIER is 283: when ALPHA_BACKGROUND | ALPHA_WRITING | GRAPHIC_BACKGROUND => 284: COLOUR : COLOUR_INDEX ; 285: when GRAPHICS_VISIBILITY => 286: GRAPHICS_ON : Boolean ; 287: when SEGMENT_MOVEMENT => 288: SEGMENT : SEGMENT_IDENTIFIER ; 289: POSITION : POINT ; 290: when SELECT_WINDOW => 291: WINDOW : Natural ; 292: when MAP_WINDOW_TO_VIEWPORT => 293: VIEW_WINDOW_ID : Natural ; 294: WINDOW_RECTANGLE , 295: VIEW_RECTANGLE : RECTANGLE ; 296: when others => 297: null ; 298: end case ; -- IDENTIFIER 299: end record ; -- ESCAPE_RECORD 300: 301: 302: --{ This portion defines the GKS state list, the workstation state 303: --{ list, and the workstation description table. The table 304: --{ definitions contain only a subset of the table fields defined 305: --{ by GKS. The defined table entries support the version of 306: --{ GKS developed by SYSCON Corporation. 307: 308: ------------------ 309: -- GKS STATE LIST 310: ------------------ 311: type GKS_STATE_LIST is 312: record 313: -- Current line attributes 314: CURRENT_LINETYPE : LINE_TYPE := 1; 315: CURRENT_LINEWIDTH_SCALE_FACTOR : SCALE_FACTOR := 1.0; 316: CURRENT_POLYLINE_COLOUR_INDEX : COLOUR_INDEX := 0; 317: -- Current marker attributes 318: CURRENT_MARKER_TYPE : MARKER_TYPE := 1; 319: CURRENT_MARKER_SIZE_SCALE_FACTOR : SCALE_FACTOR := 1.0; 320: CURRENT_POLYMARKER_COLOUR_INDEX : COLOUR_INDEX := 0; 321: -- Current text attributes 322: CURRENT_TEXT_FONT_AND_PRECISION : TEXT_FONT_PRECISION := 323: (STD,STRING_PRECISION); 324: CURRENT_CHARACTER_EXPANSION_FACTOR : CHAR_EXPANSION := 0; 325: CURRENT_CHARACTER_SPACING : CHAR_SPACING := 1; 326: CURRENT_TEXT_COLOUR_INDEX : COLOUR_INDEX := 0; 327: CURRENT_CHARACTER_HEIGHT : CHAR_HEIGHT := 1; 328: CURRENT_CHARACTER_UP_VECTOR : VECTOR := (0,1); 329: CURRENT_TEXT_PATH : TEXT_PATH := RIGHT; 330: -- Current fill area attributes 331: CURRENT_FILL_AREA_INTERIOR_STYLE : INTERIOR_STYLE_TYPE := 332: ( HOLLOW ) ; 333: CURRENT_FILL_AREA_COLOUR_INDEX : COLOUR_INDEX := 0; 334: CURRENT_PATTERN_SIZE : SIZE ; 335: CURRENT_PATTERN_REFERENCE_POINT : POINT ; 336: CURRENT_FILL_AREA_LINETYPE : LINE_TYPE := 1; 337: -- Current normalization transformation window. 338: CURRENT_WINDOW : RECTANGLE := ((WC'FIRST,WC'LAST), 339: (WC'FIRST,WC'LAST)); 340: end record; 341: 342: -------------------------- 343: -- WORKSTATION STATE LIST 344: ------------------------- 345: type WK_STATE_LIST is 346: record 347: -- Current workstation viewport 348: CURRENT_WS_VIEWPORT : RECTANGLE_DC ; 349: end record; 350: 351: --------------------------------- 352: -- WORKSTATION DESCRIPTION TABLE 353: --------------------------------- 354: type WK_DESC_TABLE is 355: record 356: WKST_TYPE : WORKSTATION_TYPE := COLOUR_OUTPUT; 357: DEV_COORD_UNITS : DC_UNITS := OTHER; 358: end record; 359: 360: -- GKS exceptions 361: -- STATE_ERRORs 362: GKS_ERROR_1 , -- GKS not in proper state: GKS should be in state GKCL 363: GKS_ERROR_2 , -- GKS not in proper state: GKS should be in state GKOP 364: GKS_ERROR_3 , -- GKS not in proper state: GKS should be in state WSAC 365: GKS_ERROR_4 , -- GKS not in proper state: GKS should be in state SGOP 366: GKS_ERROR_5 , -- GKS not in proper state: GKS should be 367: -- either in the state WSAC or in the state SGOP 368: GKS_ERROR_6 , -- GKS not in proper state: GKS should be 369: -- either in the state WSOP or in the state WSAC 370: GKS_ERROR_7 , -- GKS not in proper state: GKS should be 371: -- in one of the states WSOP, WSAC, or SGOP 372: GKS_ERROR_8 , -- GKS not in proper state: GKS should be 373: -- in one of the states GKOP, WSOP, WSAC, or SGOP 374: -- WS_ERRORs 375: GKS_ERROR_20 , -- Specified workstation identifier is invalid 376: GKS_ERROR_21 , -- Specified connection identifier is invalid 377: GKS_ERROR_22 , -- Specified workstation type is invalid 378: GKS_ERROR_23 , -- Specified workstation type does not exist 379: GKS_ERROR_24 , -- Specified workstation is open 380: GKS_ERROR_25 , -- Specified workstation is not open 381: GKS_ERROR_26 , -- Workstation Independent Segment Storage is not open 382: GKS_ERROR_29 , -- Specified workstation is active 383: GKS_ERROR_30 , -- Specified workstation is not active 384: GKS_ERROR_31 , -- Specified workstation is of category MO 385: GKS_ERROR_32 , -- Specified workstation is not of category MO 386: GKS_ERROR_33 , -- Specified workstation is of category MI 387: GKS_ERROR_37 , -- Specified workstation is not of category OUTIN 388: GKS_ERROR_39 , -- Specified workstation is not category INPUT or OUTIN 389: -- TRANSFORMATION_ERRORs 390: GKS_ERROR_50 , -- Transformation number is invalid 391: GKS_ERROR_51 , -- Rectangle definition is invalid 392: -- OUTPUT_ATTRIBUTE_ERRORs 393: GKS_ERROR_60 , -- Polyline index is invalid 394: -- INPUT_ERRORs 395: GKS_ERROR_147 , -- Input queue has overflowed 396: GKS_ERROR_150 , -- No input value of the correct class is in event report 397: -- OTHER_ERRORs implementation defined 398: GKS_ERROR_900 , -- Locator read failure 399: -- UNKNOWN_OTHER_ERROR 400: GKS_ERROR_999 -- unknown GKS detected error 401: : EXCEPTION ; 402: 403: end GKS_SPECIFICATION ; Compilation complete Syntax errors: 0 Semantic errors: 0 Lines compiled: 403 1: pragma SOURCE_INFO(ON); 2: 3: -- controlled by BOB MAREK 4: -- version 85-07-15:10:35 by RAM 5: 6: package MINI_MATH_PAC is 7: -- ===================================================== 8: -- 9: -- 10: -- ===================================================== 11: ------------------------------------ 12: -- Math Constant Declarations 13: ------------------------------------ 14: PI : constant FLOAT := 3.141_592_654 ; 15: E : constant FLOAT := 2.718_281_828_459_045 ; 16: 17: function FACTORIAL 18: ( UNIT : in INTEGER ) 19: return INTEGER ; 20: -- ==================================================== 21: -- produces the factorial result of the input UNIT such 22: -- that UNIT=X then X!=X*(X-1)*...*1 23: -- ===================================================== 24: 25: function EXP 26: ( X : FLOAT ) 27: return FLOAT ; 28: -- ================================================== 29: -- produces the exponant x of constant e 30: -- such that EXP(x) = e ** X, where e @= 2.718.... 31: -- ================================================== 32: 33: function LN 34: ( X : FLOAT ) 35: return FLOAT ; 36: -- ==================================================== 37: -- produces the natural logrithm of the input X from a constant e 38: -- such that ln(X)=1/e**X , where e @= 2.718.... 39: -- ==================================================== 40: 41: function SQRT 42: ( X : FLOAT ) 43: return FLOAT ; 44: -- ==================================================== 45: -- produces the square root of the input X such that 46: -- X_root**2 = X within the accuracy specified 47: -- ==================================================== 48: 49: function RANDOM 50: return FLOAT ; 51: -- ==================================================== 52: -- produces a random number between 0.0 and 1.0 . 53: -- ==================================================== 54: 55: function MAGNATUDE 56: ( FIRST_X , 57: FIRST_Y , 58: SECOND_X , 59: SECOND_Y : in FLOAT ) 60: return FLOAT; 61: -- ==================================================== 62: -- produces the magnatude from first point to the second point. 63: -- ==================================================== 64: 65: function SIN 66: ( X : FLOAT ) 67: return FLOAT; 68: -- ==================================================== 69: -- input values are in radians. 70: -- ==================================================== 71: 72: function COS 73: ( X : FLOAT ) 74: return FLOAT; 75: -- ==================================================== 76: -- input values are in radians. 77: -- ==================================================== 78: 79: -- ==================================================== 80: -- indicators for unhandled exceptions in functions 81: -- ==================================================== 82: MINI_MATH_PAC_FACTORIAL_ERROR , 83: MINI_MATH_PAC_EXP_ERROR , 84: MINI_MATH_PAC_LN_ERROR , 85: MINI_MATH_PAC_SQRT_ERROR , 86: MINI_MATH_PAC_MAGNATUDE_ERROR , 87: MINI_MATH_PAC_SIN_ERROR , 88: MINI_MATH_PAC_COS_ERROR , 89: MINI_MATH_PAC_RANDOM_ERROR : EXCEPTION ; 90: 91: end MINI_MATH_PAC ; 92: 93: with CALENDAR; use CALENDAR; 94: 95: package body MINI_MATH_PAC is 341: end MINI_MATH_PAC; Compilation complete Syntax errors: 0 Semantic errors: 0 Lines compiled: 341 1: pragma source_info(on) ; 2: 3: with GKS_SPECIFICATION ; use GKS_SPECIFICATION ; 4: 5: -- controlled by BOB MAREK 6: -- VERSION 85-07-25 08:50 by RAM 7: 8: package TERMINAL_ACCESS is 9: -- ================================================================== 10: -- This package implements a version of the Graphical 11: -- Kernel System (GKS) developed by SYSCON Corporation 12: -- for use to the target terminal type. 13: -- Calls to this package will originate only from package GKS. 14: -- The only calls originating from this package will be to 15: -- the target terminal drivers. This package is the standard interface 16: -- for all target terminal accesses. 17: -- =================================================================== 18: 19: package GKS_SPEC renames GKS_SPECIFICATION ; 20: 21: ------------------------------- 22: -- operations available to GKS 23: ------------------------------- 24: type OPERATIONS_TYPE is 25: ( USE_BOX , 26: USE_CIRCLE , 27: USE_MARKER , 28: USE_POLYGON , 29: USE_POLYLINE , 30: USE_POLYMARKER , 31: USE_REG_POLYGON , 32: USE_TEXT ) ; 33: 34: ------------------------------------------------------------------- 35: -- dedicated operation to use for an object draw 36: ------------------------------------------------------------------- 37: subtype CIRCLE_OPERATIONS_TYPE is OPERATIONS_TYPE 38: range USE_CIRCLE..USE_CIRCLE ; 39: subtype FILL_AREA_OPERATIONS_TYPE is OPERATIONS_TYPE 40: range USE_POLYGON..USE_POLYGON ; 41: subtype POLYLINE_OPERATIONS_TYPE is OPERATIONS_TYPE 42: range USE_POLYLINE..USE_POLYLINE ; 43: subtype POLYMARKER_OPERATIONS_TYPE is OPERATIONS_TYPE 44: range USE_MARKER..USE_MARKER ; 45: subtype RECTANGLE_OPERATIONS_TYPE is OPERATIONS_TYPE 46: range USE_BOX..USE_BOX ; 47: subtype TEXT_OPERATIONS_TYPE is OPERATIONS_TYPE 48: range USE_TEXT..USE_TEXT ; 49: 50: ----------------------------------------- 51: -- kinds of segment operation to perform 52: ----------------------------------------- 53: type SEGMENT_OPERATIONS_TYPE is 54: ( START , 55: FINISH , 56: DESTROY , 57: REDRAW ) ; 58: 59: ---------------------------------------------------------------- 60: -- record to congregate all parameters needed by draw procedure 61: -- 62: -- type OBJECT_DATA_RECORD field usage -- 63: --------------------------------------------------------- 64: -- | USE_ type -- 65: -- |-------------------------------- 66: -- | | | | |- - POLYnnn - -| 67: -- record | B | C | M | T | G | L | M | R | 68: -- field | O | I | A | E | O | I | A | E | 69: -- | X | R | R | X | N | N | R | G | 70: -- | | C | K | T | | E | K | G | 71: -- | | L | E | | | | E | O | 72: -- | | E | R | | | | R | N | 73: ------------------------- - - - - - - - - - - - - - - - - 74: -- REFERENCE_POINT | * | * | * | * | | | | * | 75: ------------------------- - - - - - - - - - - - - - - - - 76: -- SIZE_POINT | * | * | | | | | | * | 77: ------------------------- - - - - - - - - - - - - - - - - 78: -- SIDES | | | | | | | | * | 79: ------------------------- - - - - - - - - - - - - - - - - 80: -- SHAPE_DATA_LIST | | | | | | | * | | 81: ------------------------- - - - - - - - - - - - - - - - - 82: -- TEXT | | | | * | | | | | 83: ------------------------- - - - - - - - - - - - - - - - - 84: -- POLY_SHAPE_DATA_LIST | | | | | * | * | * | | 85: ------------------------- - - - - - - - - - - - - - - - - 86: type OBJECT_DATA_RECORD ( DESCRIPTION : OPERATIONS_TYPE ) is 87: record 88: case DESCRIPTION is -- 1 89: when USE_BOX | USE_CIRCLE 90: | USE_MARKER | USE_REG_POLYGON | USE_TEXT => 91: REFERENCE_POINT : GKS_SPEC.POINT ; 92: case DESCRIPTION is -- 2 93: when USE_BOX | USE_CIRCLE | USE_REG_POLYGON => 94: SIZE_POINT : GKS_SPEC.POINT ; 95: case DESCRIPTION is -- 3 96: when USE_REG_POLYGON => 97: SIDES : Natural ; 98: when others => null ; 99: end case ; -- DESCRIPTION 3 100: when USE_TEXT => 101: TEXT : STRING ( 1..80 ) := 102: " " & -- 20 SPACES 103: " " & -- 20 SPACES 104: " " & -- 20 SPACES 105: " " ; -- 20 SPACES 106: TEXT_LENGTH : Natural := 80 ; 107: when others => null ; 108: end case ; -- DESCRIPTION 2 109: when USE_POLYGON | USE_POLYLINE | USE_POLYMARKER => 110: SHAPE_DATA_LIST : GKS_SPEC.POINT_LIST ( 1..100 ) ; 111: SHAPE_LIST_LENGTH : Natural ; 112: when others => 113: null ; 114: end case ; 115: end record ; 116: 117: ------------------------- 118: -- kinds of styles to use 119: ------------------------- 120: type STYLES_TYPE is 121: ( FILL_PATTERN , 122: LINE_PATTERN , 123: MARKER_PATTERN ) ; 124: 125: ------------------------------------------------------------------------- 126: -- record type to congregate all parameters needed by set style procedure 127: ------------------------------------------------------------------------- 128: type STYLE_RECORD ( DESCRIPTION : STYLES_TYPE ) is 129: record 130: case DESCRIPTION is 131: when LINE_PATTERN => LINE : GKS_SPEC.LINE_TYPE ; 132: when FILL_PATTERN => FILL : GKS_SPEC.INTERIOR_STYLE_TYPE ; 133: when MARKER_PATTERN => MARKER : GKS_SPEC.MARKER_TYPE ; 134: end case ; 135: end record ; 136: 137: type COLOR_OBJECTS is 138: ( ALPHA_COLOR , 139: ALPHA_BACKGROUND , 140: GRAPHIC_BACKGROUND , 141: FILL_COLOR , 142: LINE_COLOR , 143: MARKER_COLOR , 144: TEXT_COLOR ) ; 145: 146: ------------------------------------------------------ 147: -- dedicated color index parameter variable selectors 148: ------------------------------------------------------ 149: subtype FOR_ALPHA_BACKGROUND_TYPE is COLOR_OBJECTS 150: range ALPHA_BACKGROUND..ALPHA_BACKGROUND ; 151: subtype FOR_ALPHA_WRITING_TYPE is COLOR_OBJECTS 152: range ALPHA_COLOR..ALPHA_COLOR ; 153: subtype FOR_GRAPHIC_BACKGROUND_TYPE is COLOR_OBJECTS 154: range GRAPHIC_BACKGROUND..GRAPHIC_BACKGROUND ; 155: subtype FOR_CHARACTER_COLOR_TYPE is COLOR_OBJECTS 156: range TEXT_COLOR..TEXT_COLOR ; 157: subtype FOR_FILL_STYLE_COLOR_TYPE is COLOR_OBJECTS 158: range FILL_COLOR..FILL_COLOR ; 159: subtype FOR_LINE_STYLE_COLOR_TYPE is COLOR_OBJECTS 160: range LINE_COLOR..LINE_COLOR ; 161: subtype FOR_MARKERS_COLOR_TYPE is COLOR_OBJECTS 162: range MARKER_COLOR..MARKER_COLOR ; 163: 164: procedure INIT_TERMINAL 165: ( TERM_TYPE : out GKS_SPECIFICATION.WORKSTATION_ID ) ; 166: -- ========================================================= 167: -- Initialize the terminal for graphics operations. 168: -- ========================================================= 169: 170: procedure CLOSE_TERMINAL ; 171: -- ========================================================= 172: -- End graphics operations at terminal and cleanup. 173: -- ========================================================= 174: 175: procedure DRAW 176: ( OBJECT_DEFINITION : in OBJECT_DATA_RECORD ) ; 177: -- ========================================================= 178: -- draw the object described by the object definition 179: -- ========================================================= 180: 181: procedure GRAPHICS_SCREEN 182: ( GRAPHICS_VISIBILITY : in Boolean ) ; 183: -- ========================================================= 184: -- Turn the graphics screen on and off. 185: -- ========================================================= 186: 187: procedure SET_COLOR_INDEX 188: ( FIGURE : in COLOR_OBJECTS; 189: COLOUR : in GKS_SPEC.COLOUR_INDEX ) ; 190: -- ========================================================= 191: -- Set the colour index for use with the figure type. 192: -- Effect : The current figure colour index is set to the 193: -- specified value. 194: -- ========================================================= 195: 196: procedure SET_STYLE 197: ( STYLE_DEFINITION : STYLE_RECORD ) ; 198: -- ========================================================= 199: -- Set the specified style type parameter for line, fill and marker. 200: -- Effect : The current style type is set to the specified value. 201: -- item Linetypes: markertypes: 202: -- 1 - solid dot 203: -- 2 - dashed plus sign 204: -- 3 - dotted asterisk 205: -- 4 - * dashed-dotted circle 206: -- 5 - * diagonal cross 207: -- * - implementation dependent 208: -- ========================================================= 209: 210: procedure SET_TEXT_PATH 211: ( PATH : in GKS_SPEC.TEXT_PATH ) ; 212: -- ========================================================= 213: -- Select the text path RIGHT, LEFT, UP, or DOWN 214: -- Effect : Set the text path of character strings to the specified 215: -- values for all subsequent text output primitives until 216: -- the values are reset by another call to this function. 217: -- ========================================================= 218: 219: procedure DEFINE_COLOR 220: ( INDEX : in GKS_SPEC.COLOUR_INDEX ; 221: COLOUR : in GKS_SPEC.COLOUR_REP ) ; 222: -- ========================================================= 223: -- Define the colour to be associated with a colour index on 224: -- Effect : Redefines the entries in the colour look up table pointed 225: -- at by the colour index. 226: -- ========================================================= 227: 228: function REQUEST_LOCATOR 229: ( DEVICE : in GKS_SPEC.DEVICE_NUMBER ) 230: return GKS_SPEC.POINT ; 231: -- ========================================================= 232: -- Request position in WC and normalization transformation number 233: -- from a locator device 234: -- Effect : Perform a request on the specified locator device. 235: -- ========================================================= 236: 237: procedure SEGMENT_OPERATION 238: ( SELECTION : in SEGMENT_OPERATIONS_TYPE ; 239: SEGMENT_ID : in SEGMENT_IDENTIFIER ) ; 240: -- ========================================================= 241: -- FINISH Segment construction finished 242: -- Effect : Close the currently open segment. Primitives may no longer 243: -- be added to the closed segment. 244: -- START a segment and start constructing it 245: -- Effect : Create a segment. Subsequent calls to output primitive 246: -- functions will place the primitives into the currently 247: -- open segment. 248: -- DESTROY a segment 249: -- Effect : Delete all copies of the specified segment stored in 250: -- GKS. The segment name may be reused. 251: -- REDRAW a visible segment. 252: -- Effect : For the specified workstation, the visible segment 253: -- is displayed. 254: -- ========================================================= 255: 256: procedure MOVE_SEGMENT 257: ( SEGMENT_ID : in GKS_SPEC.SEGMENT_IDENTIFIER ; 258: LOCATION : in GKS_SPEC.POINT ) ; 259: -- ========================================================= 260: -- relocates segment 261: -- Effect : Sets the reference point of the segment to new location. 262: -- ========================================================= 263: 264: procedure RENAME_SEGMENT 265: ( OLD_SEGMENT_NAME : in GKS_SPEC.SEGMENT_IDENTIFIER ; 266: NEW_SEGMENT_NAME : in GKS_SPEC.SEGMENT_IDENTIFIER ) ; 267: -- ========================================================= 268: -- Change name of a segment 269: -- Effect : Rename the specified segment. The old segment name 270: -- may be reused. 271: -- ========================================================= 272: 273: procedure SET_HIGHLIGHTING 274: ( SEGMENT_ID : in GKS_SPEC.SEGMENT_IDENTIFIER ; 275: HIGHLIGHT : in GKS_SPEC.SEGMENT_HIGHLIGHTING ) ; 276: -- ========================================================= 277: -- Mark segment normal or highlighted 278: -- Effect : Set the highlighting attribute to the value 279: -- HIGHLIGHTED or NORMAL. 280: -- ========================================================= 281: 282: procedure SET_SEGMENT_PRIORITY 283: ( SEGMENT_ID : in GKS_SPEC.SEGMENT_IDENTIFIER ; 284: PRIORITY : in GKS_SPEC.SEGMENT_PRIORITY ) ; 285: -- ========================================================= 286: -- Set priority of a segment 287: -- Effect : Set the priority of the specified segment to the specified 288: -- priority. Priority is a value in the range 0 to 1. 289: -- ========================================================= 290: 291: procedure REDRAW_ALL_SEGMENTS; 292: -- ========================================================= 293: -- Redraw all visible segments stored. 294: -- Effect : For the specified workstation, all deferred actions are 295: -- executed, the display surface is cleared if not empty, 296: -- and all visible segments are displayed. 297: -- ========================================================= 298: 299: procedure SET_VISIBILITY 300: ( SEGMENT_ID : in GKS_SPEC.SEGMENT_IDENTIFIER ; 301: VISIBILITY : in GKS_SPEC.SEGMENT_VISIBILITY ) ; 302: -- ========================================================= 303: -- Mark segment visible or invisible 304: -- Effect : Set the visibility attributes of the specified segment 305: -- to VISIBLE or INVISIBLE. 306: -- ========================================================= 307: 308: function REQUEST_PICK 309: ( DEVICE : in GKS_SPEC.DEVICE_NUMBER ) 310: return GKS_SPEC.PICK_VALUE_TYPE ; 311: -- ========================================================= 312: -- Request segment name, pick identifier and pick status from a 313: -- pick device 314: -- Effect : Perform a request on the specified pick device. 315: -- ========================================================= 316: 317: procedure SET_DETECTABILITY 318: ( SEGMENT_ID : in GKS_SPEC.SEGMENT_IDENTIFIER ; 319: DETECTABILITY : in GKS_SPEC.SEGMENT_DETECTABILITY ) ; 320: -- ========================================================= 321: -- Mark segment undetectable or detectable 322: -- Effect : Set the detectability attributes of the specified segment 323: -- to DETECTABLE or UNDETECTABLE. 324: -- ========================================================= 325: 326: procedure MAP_WINDOW_TO_VIEWPORT 327: ( WINDOW : in NATURAL ; 328: UPPER_LEFT_WINDOW , 329: LOWER_RIGHT_WINDOW , 330: UPPER_LEFT_VIEWPORT , 331: LOWER_RIGHT_VIEWPORT : in GKS_SPEC.POINT ) ; 332: -- ========================================================= 333: -- Creates windows at the terminal. 334: -- Effect : All subsequent window references will occur in the 335: -- selected viewport. 336: -- ========================================================= 337: 338: procedure SET_CURRENT_WINDOW 339: ( WINDOW : in NATURAL ) ; 340: -- ========================================================= 341: -- Selects the current active window 342: -- Effect : All subsequent drawing will occur in the new current 343: -- window. 344: -- ========================================================= 345: 346: -- exception conditions to be handled by user packages 347: LOCATOR_INPUT_ERROR : exception ; 348: 349: end TERMINAL_ACCESS; 350: -- pragma PAGE ; 351: 352: with ENVISION_SPECIFICATION ; use ENVISION_SPECIFICATION ; 353: with CONTROL_AND_SETUP ; use CONTROL_AND_SETUP ; 354: with GRAPH_DRAWING ; use GRAPH_DRAWING ; 355: with SEGMENT_OPERATIONS ; use SEGMENT_OPERATIONS ; 356: with DISPLAY_LIST_CONTROL ; use DISPLAY_LIST_CONTROL ; 357: with MINI_MATH_PAC ; use MINI_MATH_PAC ; 358: with PRIORITY_CALCULATOR ; use PRIORITY_CALCULATOR ; 359: 360: with TRACE_PKG ; use TRACE_PKG ; 361: 362: package body TERMINAL_ACCESS is 1553: end TERMINAL_ACCESS ; Compilation complete Syntax errors: 0 Semantic errors: 0 Lines compiled: 1553 1: pragma source_info(on) ; 2: 3: with DESIGN_PKG ; use DESIGN_PKG ; 4: with GKS_SPECIFICATION ; use GKS_SPECIFICATION ; 5: 6: --controlled by BOB MAREK 7: -- VERSION 85-07-16-12:00 by RAM 8: 9: package GKS_PRIME is 10: -- ============================================================ 11: -- This package implements a version of the Graphical 12: -- Kernel System (GKS) developed by SYSCON Corporation 13: -- for use with the Graphic Ada Designer. The specification 14: -- is based on: 15: -- 16: -- 1) The Ada Phase I GKS developed by Harris Corp. 17: -- 2) Draft GKS Binding to ANSI Ada 18: -- 19: -- This implementation will initially be a partial subset, 20: -- with only those operations required by the Graphic Ada 21: -- Designer implemented. Although the semantics of the 22: -- functions implemented are intended to be faithful to those 23: -- decribed in the GKS Binding, the goal of efficiency and 24: -- compactness may result in the implementation code ignoring 25: -- certain arguments (e.g., opening a workstation may be 26: -- unnecessary and implemented as a null operation). The 27: -- code will directly manipulate primitives of the target 28: -- graphics device, without the intermediate operations 29: -- associated with GKS. The implementation and utilization 30: -- of this package will be faithful enough to the real GKS, 31: -- to permit the Graphic Ada Designer to be easily converted 32: -- to using a real version of GKS. 33: -- ============================================================ 34: 35: package GKS_SPEC renames GKS_SPECIFICATION ; 36: 37: package LEVEL_0A is 38: -- ======================================================== 39: -- This packages declares the Level 0A operations of GKS. 40: -- ======================================================== 41: 42: procedure CLOSE_GKS ; 43: -- ============================================================== 44: -- Stop working with GKS 45: -- ISO/DIS 7942, section 5.2, page 79 46: -- Effect : GKS is closed and all termination processing required 47: -- by the implementation is performed. 48: -- ============================================================== 49: 50: procedure CLOSE_WORKSTATION ( WK_ID : in WORKSTATION_ID ) ; 51: -- ============================================================= 52: -- Release the connection between a workstation and GKS 53: -- ISO/DIS 7942, section 5.2, page 80 54: -- Effect : For the specified workstation, an implicit UPDATE 55: -- WORKSTATION is performed, and the connection to the 56: -- workstation is released. 57: -- ============================================================= 58: 59: procedure EMERGENCY_CLOSE_GKS ; 60: -- =============================================================== 61: -- Tries to close GKS in case of an error, saving as much information 62: -- as possible 63: -- ISO/DIS 7942, section 5.11, page 202 64: -- Effect : GKS is emergency closed. The function is called when it 65: -- is not possible to recover from an error. 66: -- =============================================================== 67: 68: procedure ERROR_HANDLING 69: ( ERROR_NUMBER : in INTEGER ; 70: ID : in STRING ; 71: ERROR_FILE : in STRING ) ; 72: -- =============================================================== 73: -- A procedure called by GKS when an error is detected. It may be 74: -- user supplied 75: -- ISO/DIS 7942, section 5.11, page 202 76: -- Effect : The GKS detected error is logged via a call to 77: -- ERROR_LOGGING and control is returned to the GKS 78: -- function where the error has been detected. 79: -- ============================================================== 80: 81: procedure ERROR_LOGGING 82: ( ERROR_NUMBER : in INTEGER ; 83: ID : in STRING ; 84: ERROR_FILE : in STRING ) ; 85: -- ============================================================== 86: -- A procedure called by the standard GKS error handling procedure. 87: -- It prints an error message and function identification on the 88: -- error file 89: -- ISO/DIS 7942, section 5.11, page 203 90: -- Effect : An error message and GKS function identification is 91: -- written to the error file. 92: -- ============================================================== 93: 94: procedure ESCAPE 95: ( ESCAPE_ID : ESCAPE_IDENTIFIER ; 96: ESCAPE_DATA : ESCAPE_RECORD ) ; 97: -- ===================================================== 98: -- A standard way of invoking non-standard features 99: -- ISO/DIS 7942, section 5.2, page 86 100: -- Effect : The specified non-standard specific escape 101: -- function is invoked. 102: -- ===================================================== 103: 104: procedure FILL_AREA ( POINTS : in POINT_LIST ; 105: LINETYPE : in LINE_TYPE ) ; 106: -- ================================================================ 107: -- Generate a polygon which may be filled with a colour, a hatch or 108: -- a pattern or may be hollow 109: -- ISO/DIS 7942, section 5.3, page 88 110: -- Effect : A FILL AREA primitive is generated, and the current values 111: -- of the fill area attributes are bound to the primitive. 112: -- The attributes are listed in section 4.4.2, page 21. 113: -- ================================================================ 114: 115: procedure GDP 116: ( POINTS : in POINT_LIST ; 117: GDP_IDENTIFIER : in GDP_ID ) ; 118: -- ================================================================ 119: -- Generate a generalized drawing primitive defined by a sequence 120: -- of points in WC and a data record 121: -- ISO/DIS 7942, section 5.3, page 91 122: -- Effect : A generalized drawing primitive (GDP) of the type 123: -- indicated by the GDP identifier is generated on the basis 124: -- of the given points and the GDP data record. 125: -- ================================================================ 126: 127: procedure OPEN_GKS 128: ( ERROR_FILE : in STRING ; 129: AMOUNT_OF_MEMORY : in MEMORY_UNITS := 1000 ) ; 130: -- ============================================================= 131: -- Start working with GKS 132: -- ISO/DIS 7942, section 5.2, page 79 133: -- Effect : GKS is opened and all initialization processing required 134: -- by the implementation is performed. 135: -- ============================================================== 136: 137: procedure OPEN_WORKSTATION 138: ( WK_ID : in out WORKSTATION_ID ; 139: CONN_ID : in CONNECTION_ID ; 140: WK_TYPE : in WORKSTATION_TYPE ) ; 141: -- ============================================================ 142: -- Create a connection between a workstation and GKS 143: -- ISO/DIS 7942, section 5.2, page 79 144: -- Effect : Specifies the number to be used to identify the 145: -- workstation, requests the specified connection to 146: -- the workstation, and, if needed, clears the display 147: -- surface. 148: -- ============================================================ 149: 150: procedure POLYLINE ( POINTS : in POINT_LIST ) ; 151: -- ============================================================ 152: -- Generate a polyline defined by points in WC 153: -- ISO/DIS 7942, section 5.3, page 87 154: -- Effect : A sequence of connected straight lines is generated, 155: -- starting at the first point and ending at the last point. 156: -- ============================================================ 157: 158: procedure POLYMARKER ( POINTS : in POINT_LIST ) ; 159: -- ============================================================ 160: -- Generate markers of a given type at positions in WC 161: -- ISO/DIS 7942, section 5.3, page 87 162: -- Effect : A sequence of markers is generated to identify all the 163: -- given positions. 164: -- ============================================================ 165: 166: procedure SET_COLOUR_REP 167: ( WK_ID : in WORKSTATION_ID ; 168: INDEX : in COLOUR_INDEX ; 169: COLOUR : in COLOUR_REP ) ; 170: -- ============================================================ 171: -- Define the colour to be associated with a colour index on 172: -- a workstation 173: -- ISO/DIS 7942, section 5.4, page 110 174: -- Effect : Redefines the entries in the colour look up table pointed 175: -- at by the colour index. 176: -- ============================================================ 177: 178: procedure SET_FILL_AREA_COLOUR_INDEX ( COLOUR : in COLOUR_INDEX ) ; 179: -- ============================================================ 180: -- Set the fill area colour index for use when the corresponding 181: -- ASF is INDIVIDUAL 182: -- ISO/DIS 7942, section 5.4, page 103 183: -- Effect : The current fill area colour index is set to the 184: -- specified value. 185: -- ============================================================ 186: 187: procedure SET_FILL_AREA_INTERIOR_STYLE 188: ( STYLE : in INTERIOR_STYLE_type ) ; 189: -- ============================================================ 190: -- Set the fill area interior style for use when the corresponding 191: -- ASF is INDIVIDUAL 192: -- ISO/DIS 7942, section 5.4, page 102 193: -- Effect : The current fill area interior style is set to the 194: -- specified value. 195: -- ============================================================ 196: 197: procedure SET_LINETYPE ( LINETYPE : in LINE_TYPE ) ; 198: -- ============================================================ 199: -- Set the linetype for use when the corresponding ASF 200: -- is INDIVIDUAL 201: -- ISO/DIS 7942, section 5.4, page 94 202: -- Effect : The current line type is set to the specified value. 203: -- Linetypes: 204: -- 1 - solid 205: -- 2 - dashed 206: -- 3 - dotted 207: -- 4 - dashed-dotted 208: -- >4 - implementation dependent 209: -- ============================================================ 210: 211: procedure SET_MARKER_TYPE ( MARKERTYPE : in MARKER_TYPE ) ; 212: -- ============================================================ 213: -- Set the marker type for use when the corresponding ASF 214: -- is INDIVIDUAL 215: -- ISO/DIS 7942, section 5.4, page 96 216: -- Effect : The current marker type is set to the specified value. 217: -- Marker types: 218: -- 1 - dot 219: -- 2 - plus sign 220: -- 3 - asterisk 221: -- 4 - circle 222: -- 5 - diagonal cross 223: -- >5 - implementation dependent 224: -- ============================================================ 225: 226: procedure SET_POLYLINE_COLOUR_INDEX ( COLOUR : in COLOUR_INDEX ) ; 227: -- ============================================================ 228: -- Set the polyline colour index for use when the corresponding ASF 229: -- is INDIVIDUAL 230: -- ISO/DIS 7942, section 5.4, page 95 231: -- Effect : The current polyline colour index is set to the 232: -- specified value. 233: -- ============================================================ 234: 235: procedure SET_POLYMARKER_COLOUR_INDEX ( COLOUR : in COLOUR_INDEX ) ; 236: -- ============================================================ 237: -- Set the polymarker colour index for use when the corresponding 238: -- ASF is INDIVIDUAL 239: -- ISO/DIS 7942, section 5.4, page 97 240: -- Effect : The current polymarker colour index is set to the 241: -- specified value. 242: -- ============================================================ 243: 244: procedure SET_TEXT_COLOUR_INDEX ( COLOUR : in COLOUR_INDEX ) ; 245: -- ============================================================ 246: -- Set the text colour index for use when the corresponding 247: -- ASF is INDIVIDUAL 248: -- ISO/DIS 7942, section 5.4, page 99 249: -- Effect : The current text colour index is set to the 250: -- specified value. 251: -- ============================================================ 252: 253: procedure SET_TEXT_PATH ( PATH : in TEXT_PATH ) ; 254: -- ============================================================ 255: -- Select the text path RIGHT, LEFT, UP, or DOWN 256: -- ISO/DIS 7942, section 5.4, page 101 257: -- Effect : Set the text path of character strings to the specified 258: -- values for all subsequent text output primitives until 259: -- the values are reset by another call to this function. 260: -- ============================================================ 261: 262: procedure SET_WINDOW 263: ( LIMITS : in RECTANGLE ) ; 264: -- ============================================================ 265: -- Set window in WC of a normalization transformation 266: -- ISO/DIS 7942, section 5.5, page 112 267: -- Effect : Defines a window for the specified normalization 268: -- transformation. 269: -- ============================================================ 270: 271: procedure SET_WORKSTATION_VIEWPORT 272: ( WK_ID : in WORKSTATION_ID ; 273: LIMITS : in RECTANGLE_DC ) ; 274: -- ============================================================ 275: -- Set workstation viewport in DC 276: -- ISO/DIS 7942, section 5.5, page 114 277: -- Effect : Specifies where on the workstation display the view 278: -- of NDC space will appear. 279: -- ============================================================ 280: 281: procedure TEXT 282: ( POSITION : in POINT ; 283: TEXT_STRING : in STRING ) ; 284: -- ============================================================ 285: -- Generate a text string at the given position in WC 286: -- ISO/DIS 7942, section 5.3, page 87 287: -- Effect : Generates the specified text string at the specified 288: -- position. 289: -- ============================================================ 290: 291: end LEVEL_0A ; 292: 293: package LEVEL_0B is 294: -- ============================================================ 295: -- This package declares the GKS Level 0B operations. 296: -- ============================================================ 297: 298: procedure REQUEST_LOCATOR 299: ( WK_ID : in WORKSTATION_ID ; 300: DEVICE : in DEVICE_NUMBER ; 301: POSITION : out POINT ) ; 302: -- ============================================================ 303: -- Request position in WC and normalization transformation number 304: -- from a locator device 305: -- ISO/DIS 7942, section 5.7, page 134 306: -- Effect : Perform a request on the specified locator device. 307: -- ============================================================ 308: 309: end LEVEL_0B ; 310: 311: package LEVEL_1A is 312: -- ============================================================ 313: -- This package declares the GKS Level 1A operations. 314: -- ============================================================ 315: 316: procedure CLOSE_SEGMENT ; 317: -- ============================================================ 318: -- Segment construction finished 319: -- ISO/DIS 7942, section 5.6, page 116 320: -- Effect : Close the currently open segment. Primitives may no longer 321: -- be added to the closed segment. 322: -- ============================================================ 323: 324: procedure CREATE_SEGMENT ( SEGMENT_ID : in SEGMENT_IDENTIFIER ) ; 325: -- ============================================================ 326: -- Create a segment and start constructing it 327: -- ISO/DIS 7942, section 5.6, page 116 328: -- Effect : Create a segment. Subsequent calls to output primitive 329: -- functions will place the primitives into the currently 330: -- open segment. 331: -- ============================================================ 332: 333: procedure DELETE_SEGMENT ( SEGMENT_ID : in SEGMENT_IDENTIFIER ) ; 334: -- ============================================================ 335: -- Delete a segment 336: -- ISO/DIS 7942, section 5.6, page 117 337: -- Effect : Delete all copies of the specified segment stored in 338: -- GKS. The segment name may be reused. 339: -- ============================================================ 340: 341: procedure REDRAW_ALL_SEGMENTS_ON_WORKSTATION 342: ( WK_ID : in WORKSTATION_ID ) ; 343: -- ============================================================ 344: -- Redraw all visible segments stored on a workstation 345: -- ISO/DIS 7942, section 5.2, page 83 346: -- Effect : For the specified workstation, all deferred actions are 347: -- executed, the display surface is cleared if not empty, 348: -- and all visible segments are displayed. 349: -- ============================================================ 350: 351: procedure RENAME_SEGMENT 352: ( OLD_SEGMENT_NAME : in SEGMENT_IDENTIFIER ; 353: NEW_SEGMENT_NAME : in SEGMENT_IDENTIFIER ) ; 354: -- ============================================================ 355: -- Change name of a segment 356: -- ISO/DIS 7942, section 5.6, page 116 357: -- Effect : Rename the specified segment. The old segment name 358: -- may be reused. 359: -- ============================================================ 360: 361: procedure SET_HIGHLIGHTING 362: ( SEGMENT_ID : in SEGMENT_IDENTIFIER ; 363: HIGHLIGHT : in SEGMENT_HIGHLIGHTING ) ; 364: -- ============================================================ 365: -- Mark segment normal or highlighted 366: -- ISO/DIS 7942, section 5.6, page 121 367: -- Effect : Set the highlighting attribute to the value 368: -- HIGHLIGHTED or NORMAL. 369: -- ============================================================ 370: 371: procedure SET_SEGMENT_PRIORITY 372: ( SEGMENT_ID : in SEGMENT_IDENTIFIER ; 373: PRIORITY : in SEGMENT_PRIORITY ) ; 374: -- ============================================================ 375: -- Set priority of a segment 376: -- ISO/DIS 7942, section 5.6, page 122 377: -- Effect : Set the priority of the specified segment to the specified 378: -- priority. Priority is a value in the range 0 to 1. 379: -- ============================================================ 380: 381: procedure SET_VISIBILITY 382: ( SEGMENT_ID : in SEGMENT_IDENTIFIER ; 383: VISIBILITY : in SEGMENT_VISIBILITY ) ; 384: -- ============================================================ 385: -- Mark segment visible or invisible 386: -- ISO/DIS 7942, section 5.6, page 121 387: -- Effect : Set the visibility attributes of the specified segment 388: -- to VISIBLE or INVISIBLE. 389: -- ============================================================ 390: 391: end LEVEL_1A ; 392: 393: package LEVEL_1B is 394: -- ============================================================ 395: -- This package declares the GKS Level 1B operations. 396: -- ============================================================ 397: 398: procedure REQUEST_PICK 399: ( WK_ID : in WORKSTATION_ID ; 400: DEVICE : in DEVICE_NUMBER ; 401: PICK : out PICK_VALUE_TYPE ) ; 402: -- ============================================================ 403: -- Request segment name, pick identifier and pick status from a 404: -- pick device 405: -- ISO/DIS 7942, section 5.7, page 137 406: -- Effect : Perform a request on the specified pick device. 407: -- ============================================================ 408: 409: procedure SET_DETECTABILITY 410: ( SEGMENT_ID : in SEGMENT_IDENTIFIER ; 411: DETECTABILITY : in SEGMENT_DETECTABILITY ) ; 412: -- ============================================================ 413: -- Mark segment undetectable or detectable 414: -- ISO/DIS 7942, section 5.6, page 123 415: -- Effect : Set the detectability attributes of the specified segment 416: -- to DETECTABLE or UNDETECTABLE. 417: -- ============================================================ 418: 419: end LEVEL_1B ; 420: 421: end GKS_PRIME ; 422: -- pragma PAGE ; 423: 424: with TEXT_IO ; use TEXT_IO ; -- used for error and journal files 425: with TERMINAL_ACCESS ; use TERMINAL_ACCESS ; 426: with TRACE_PKG ; use TRACE_PKG ; 427: 428: package body GKS_PRIME is 1363: end GKS_PRIME ; Compilation complete Syntax errors: 0 Semantic errors: 0 Lines compiled: 1363 4.7 VIRTUAL_TERMINAL The VIRTUAL_TERMINAL_INTERFACE package provides a device independent set of subprograms which provide alphanumeric text services. The primary function of this package is to support text I/O to the alphanumeric window. In particular this package will support a region of two lines on the bottom of the terminal screen for use in prompting for and reading interactive text. Table 4-8 VIRTUAL_TERMINAL Virtual Package Dependencies List COMPILATION UNITS TYPE COMMENTS DEPENDENCIES Virtual_Terminal Package System Text_IO Design_Pkg VIRTUAL_TERMINAL - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | VIRTUAL_TERMINAL_INTERFACE | ------------------------------------------- --------------------- ------------------- ---------------- | < SYSTEM > ( VTI_TYPE )<-( DECLARATIONS ) ===================== | +-----------------------+-->< TEXT_IO > ------------------- ---------------- +--->| SCREEN_WIDTH_132 | | ^ ^ --------------------- | | |===================| | | | | | +--+ =====================|----->+ +-------------------+| | |+---->| SCREEN_WIDTH_80 |- | | VT100_SCREEN_CONTROL | | | || |===================| | | -------------------------------------- || ------- ------- || =====================|------>+ | | | | |-------------->| |-------+|+-->| KEY_PAD_IO = |- | | ---------------- | | | | |-------------->| |--------+| |===================| | | ( DECLARATIONS ) | | | |-------------->| |---------+ =====================|------->+ ---------------- =====================| | | | |-------------->| |----------->| FORMAT_LINE[] |- | | | +-------->| POSITION_CURSOR[] || | | |-------------->| |--------+ |===================| | | | | |===================|| | | | |-------------->| |-------+| =====================|-------->+ | | =====================|->+ | |-------------->| |------+|+->| REALIO[] |- | | | |+------>| HOME_CURSOR || | | | |-------------->| |-----+|| |===================| | | | || |===================|| | | |-------------->| |---+ ||| =====================|--------->+ | || =====================|->+ | ------- ------- | ||+->| INTEGERIO[] |- | | | ||+---->| ERASE_SCREEN |-| | | | | || |===================| | | ------ ||| |===================| | | | | | || =====================|---------->+->| |--+|| =====================|--->+ | | | |+->| CHARACTERIO[] |- | +->| |---+|+-->| ERASE_LINE |- | | | | | | |===================| | +->| |----+| |===================| | | | | | | =====================|----------->+->| |-----+ =====================|---->+ | | | +->| STRINGIO[] |- | |+>| |------->| RESET |- | | | | | |===================| | || ------ |===================| | | | | | =====================|------------>+| | | |----->+ | | +-->| VTI_INIT |- | | | --------------------- | | | |===================| | | ------------------------------------- | | | |---------------+ | | --------------------- | | ------------------------------------------ | - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Figure 4 - Virtual_Terminal Virtual Package Design Diagram 1: pragma source_info(on) ; 2: 3: with SYSTEM ; 4: 5: -- controlled by BOB MAREK 6: -- version 85-07-16-1530 by JL 7: 8: package VIRTUAL_TERMINAL_INTERFACE is 9: -- ================================================================== 10: -- 11: -- The VIRTUAL_TERMINAL_INTERFACE package provides a device 12: -- independent set of subprograms which provide alphanumeric text 13: -- services. The primary function of this package is to support 14: -- alphanumeric I/O to the alphanumeric window. 15: -- 16: -- In particular this package will support a scroll region of two 17: -- lines on the bottom of the terminal screen for use in prompting 18: -- for and reading interactive text. 19: -- 20: -- =================================================================== 21: 22: --{{ Suggested pragmas to speed performance of this critical 23: --{{ low level interface 24: -- pragma suppress ( division_check ) ; 25: -- pragma suppress ( overflow_check ) ; 26: -- pragma suppress ( index_check ) ; 27: -- pragma suppress ( range_check ) ; 28: -- pragma suppress ( length_check ) ; 29: 30: ------------------------------------------------------------ 31: -- One enumeration value for each possible keypad key value 32: -- (including usage of the GOLD key). 33: ------------------------------------------------------------- 34: type KEYPAD_KEY_TYPE is 35: ( GOLD , PF2 , PF3 , PF4 , KP7 , KP8 , KP9 , 36: KPhypen , KP4 , KP5 , KP6 , KPcomma , 37: KP1 , KP2 , KP3 , KP0 , KPdot , ENTER , 38: GOLD_PF2 , GOLD_PF3 , GOLD_PF4 , GOLD_KP7 , 39: GOLD_KP8 , GOLD_KP9 , GOLD_KPhypen , 40: GOLD_KP4 , GOLD_KP5 , GOLD_KP6 , GOLD_KPcomma , 41: GOLD_KP1 , GOLD_KP2 , GOLD_KP3 , GOLD_KP0 , 42: GOLD_KPdot , GOLD_ENTER , 43: UP_ARROW , DOWN_ARROW , LEFT_ARROW , RIGHT_ARROW ) ; 44: 45: ---------------------------------------------------- 46: -- The type used to communication with from the 47: -- graphics terminal operator . 48: ---------------------------------------------------- 49: subtype USER_REQUEST is STRING ( 1 .. 80 ) ; 50: subtype USER_RESPONSE is STRING ( 1 .. 80 ) ; 51: 52: ------------------------------------------------------------ 53: -- The following declarations define various terminal screen 54: -- I/O structures. 55: -- ROW_TYPE => screen row cursor position identifier. 56: -- COLUMN_TYPE => screen column cursor position identifier. 57: -- ESC => String definition of an ASCII escape. 58: -- DEL => String definition of an ASCII delete. 59: -- NUL => String definition of an ASCII nul. 60: ------------------------------------------------------------ 61: subtype ROW_TYPE is INTEGER range 1 .. 24 ; 62: subtype COLUMN_TYPE is INTEGER range 1 .. 132 ; 63: 64: MAXCOL : constant COLUMN_TYPE := 80 ; 65: MAXROW : constant ROW_TYPE := 24 ; 66: 67: ------------------------------------------------ 68: -- Terminal Screen Format Operation Declarations 69: ------------------------------------------------ 70: type FORMAT_FUNCTION is 71: ( CLEAR_SCREEN , CENTER_A_LINE , CLEAR_A_LINE ) ; 72: 73: ------------------------------------------------ 74: -- Terminal Screen I/O Operation Declarations 75: ------------------------------------------------ 76: type CURSOR_ADDRESS is 77: ( READ_NO_ADDRESS , READ_WITH_ADDRESS , 78: WRITE_NO_ADDRESS , WRITE_WITH_ADDRESS ) ; 79: 80: type LOW_LEVEL_CRT_FUNCTIONS is 81: ( SCREEN_WIDTH_80 , -- Max line characters = 80. 82: SCREEN_WIDTH_132 , 83: NEXT_LINE , -- Sets cursor @ begining of the next line. 84: SCROLL_UP , -- Scrolls the page text up one line. 85: SCROLL_DOWN , -- Scrolls the page text down one line. 86: HOME_CURSOR , -- Places cursor @ home position. 87: ERASE_CURSOR_TO_EOL , -- Erases from cursor position 88: -- to end of line. 89: ERASE_BOL_TO_CURSOR , -- Erases from begining of line 90: -- to cursor position. 91: ERASE_CURSOR_LINE , -- Erases all text on current line. 92: ERASE_CURSOR_TO_EOS , -- Erases screen from cursor position 93: -- to end of screen. 94: ERASE_BOS_TO_CURSOR , -- Erases screen from begining of screen 95: -- to cursor position. 96: ERASE_CURSOR_SCREEN , -- Erases all text on current screen. 97: BLINK_CHARS , -- Blink following characters. 98: NEGATIVE_CHARS , -- Reverse image of following characters. 99: CLEAR_ATTRIBUTES , -- Clear graphic attributes. 100: ERASE_SCREEN ) ; -- Erase Entire Screen 101: 102: procedure LOW_LEVEL_OPERATIONS 103: ( FORMAT_FCT : in LOW_LEVEL_CRT_FUNCTIONS ) ; 104: -- =========================================================== 105: -- This routine provides the operations that provide the 106: -- screen formatting capabilities identified in the Crt_Functions 107: -- declaration list above. 108: -- =========================================================== 109: 110: procedure SCROLLING_REGION 111: ( TOP_LINE, BOTTOM_LINE : in POSITIVE ) ; 112: -- ============================================================= 113: -- Defines the region of the screen used for text operations. 114: -- ============================================================= 115: 116: procedure MOVE_CURSOR_UP 117: ( ROWS : in ROW_TYPE ) ; 118: -- ============================================================= 119: -- Moves the alphanumeric cursor up n rows. 120: -- ============================================================= 121: 122: procedure MOVE_CURSOR_DOWN 123: ( ROWS : in ROW_TYPE ) ; 124: -- ============================================================= 125: -- Moves the alphanumeric cursor down n rows. 126: -- ============================================================= 127: 128: procedure MOVE_CURSOR_RIGHT 129: ( COLUMNS : in COLUMN_TYPE ) ; 130: -- ============================================================= 131: -- Moves the alphanumeric cursor right n columns. 132: -- ============================================================= 133: 134: procedure MOVE_CURSOR_LEFT 135: ( COLUMNS : in COLUMN_TYPE ) ; 136: -- ============================================================= 137: -- Moves the alphanumeric cursor left n columns. 138: -- ============================================================= 139: 140: procedure MOVE_CURSOR_TO 141: ( ROW : in ROW_TYPE ; 142: COLUMN : in COLUMN_TYPE ) ; 143: -- ============================================================= 144: -- Moves the alphanumeric cursor to a specified row 145: -- and column location. 146: -- ============================================================= 147: 148: procedure VTI_INIT ; 149: -- =========================================================== 150: -- Initialize this version of the VIRTUAL_TERMINAL_INTERFACE 151: -- with the terminal specific data required. 152: -- =========================================================== 153: 154: procedure STRINGIO 155: ( STRNG : in out STRING ; 156: ADDRESS : in CURSOR_ADDRESS ; 157: ROW : in ROW_TYPE ; 158: COL : in COLUMN_TYPE ) ; 159: -- ========================================================= 160: -- This routine performs string I/O operations as per 161: -- the specified formal parameters. 162: -- ========================================================= 163: 164: procedure CHARACTERIO 165: ( CHAR : in out CHARACTER ; 166: ADDRESS : in CURSOR_ADDRESS ; 167: ROW : in ROW_TYPE ; 168: COL : in COLUMN_TYPE ) ; 169: -- ========================================================= 170: -- This routine performs character I/O operations as per 171: -- the specified formal parameters. 172: -- ========================================================= 173: 174: procedure INTEGERIO 175: ( INT : in out INTEGER ; 176: ADDRESS : in CURSOR_ADDRESS ; 177: ROW : in ROW_TYPE ; 178: COL : in COLUMN_TYPE ) ; 179: -- ========================================================= 180: -- This routine performs integer I/O operations as per 181: -- the specified formal parameters. 182: -- ========================================================= 183: 184: procedure REALIO 185: ( REAL_NO : in out FLOAT ; 186: ADDRESS : in CURSOR_ADDRESS ; 187: ROW : in ROW_TYPE ; 188: COL : in COLUMN_TYPE ) ; 189: -- ========================================================= 190: -- This routine performs real I/O operations as per 191: -- the specified formal parameters. 192: -- ========================================================= 193: 194: procedure FORMAT_LINE 195: ( STRNG : in STRING ; 196: FORMAT : in FORMAT_FUNCTION ; 197: ROW : in ROW_TYPE ) ; 198: -- ========================================================= 199: -- This routine performs formatted string I/O operations 200: -- as per the specified formal parameters. 201: -- ========================================================= 202: 203: function KEY_PAD_IO 204: return KEYPAD_KEY_TYPE ; 205: -- =============================================================== 206: -- This routine provides keypad Input operations. 207: -- =============================================================== 208: 209: end VIRTUAL_TERMINAL_INTERFACE ; 210: 211: -- pragma PAGE ; 212: with TEXT_IO ; use TEXT_IO ; 213: 214: package body VIRTUAL_TERMINAL_INTERFACE is 678: end VIRTUAL_TERMINAL_INTERFACE ; Compilation complete Syntax errors: 0 Semantic errors: 0 Lines compiled: 678