Copyright (c) Digital Equipment Corporation 1987, 1988. All rights reserved
PRODUCT: VAX GKS V3.0
OVERVIEW:
This program is the STARRY_NIGHT example in PL/I from the GKS Users
Manual, V3.0, pages B-31 through B-36. This article contains
approximately 300 lines. It was tested on a VT340 terminal.
It should run on any on GKS supported graphics terminal.
CAUTION: This sample program has been tested using GKS, V3.0, and
PL/I, V3.1, on VAX/VMS, V5.0. However, we cannot guarantee its
effectiveness because of the possibility of error in transmitting
or implementing it. It is meant to be used as a template for
writing your own program, and it may require modification for use on
your system.
PROGRAM:
starry_night: PROCEDURE OPTIONS( MAIN );
/* External procedure declarations for GKS */
%INCLUDE 'sys$library:gksdefs.pli';
DECLARE SET_UP ENTRY( FIXED BIN );
DECLARE CLEAN_UP ENTRY( FIXED BIN );
DECLARE DRAW_PICTURE ENTRY
( FIXED BIN, FIXED BIN, FIXED BIN, FIXED BIN,
FIXED BIN, FIXED BIN, FIXED BIN, FIXED BIN );
DECLARE WS_ID FIXED BIN INITIAL( 1 ),
TITLE FIXED BIN INITIAL( 1 ),
STARS FIXED BIN INITIAL( 2 ),
TREE FIXED BIN INITIAL( 3 ),
SIDE FIXED BIN INITIAL( 4 ),
ROAD FIXED BIN INITIAL( 5 ),
HORIZON FIXED BIN INITIAL( 6 ),
HOUSE FIXED BIN INITIAL( 7 );
CALL SET_UP( WS_ID );
CALL DRAW_PICTURE( WS_ID, TITLE, STARS, TREE, SIDE, ROAD, HOUSE,
HORIZON );
CALL CLEAN_UP( WS_ID );
END starry_night;
/* Set up the VAX GKS and the workstation environments. */
set_up: PROCEDURE( WS_ID );
%INCLUDE 'sys$library:gksdefs.pli';
DECLARE (WS_ID, WS_TYPE, ERROR_STATUS, CATEGORY,
DUMMY_INTEGER, DEF_MODE, REGEN_FLAG) FIXED BIN;
DECLARE INQUIRY_OKAY FIXED BIN INITIAL( 0 );
DECLARE DUMMY_STRING CHAR(80);
CALL GKS$OPEN_GKS( 'SYS$ERROR:' );
CALL GKS$INQ_WS_CATEGORY( GKS$K_WSTYPE_DEFAULT, ERROR_STATUS,
CATEGORY );
/* Make sure that the workstation type is valid. */
IF (( ERROR_STATUS ^= INQUIRY_OKAY ) |
(( CATEGORY = GKS$K_WSCAT_OUTPUT ) &
(( CATEGORY = GKS$K_WSCAT_OUTIN )))) THEN
DO;
PUT SKIP LIST('The specified workstation type is invalid.');
PUT SKIP LIST('Error status:', ERROR_STATUS );
STOP;
END;
CALL GKS$OPEN_WS( WS_ID, GKS$K_CONID_DEFAULT, GKS$K_WSTYPE_DEFAULT );
CALL GKS$ACTIVATE_WS( WS_ID );
/*
* Make sure that the deferral mode and regeneration flag are
* properly set.
*/
CALL GKS$INQ_WS_TYPE( WS_ID, ERROR_STATUS, DUMMY_STRING,
WS_TYPE, DUMMY_INTEGER );
CALL GKS$INQ_DEF_DEFER_STATE( WS_TYPE, ERROR_STATUS,
DEF_MODE, REGEN_FLAG );
/*
* You can check the status of the inquiry routine execution, as
* follows:
*/
IF ( ERROR_STATUS ^= INQUIRY_OKAY ) THEN
DO;
PUT SKIP LIST ('The deferral inquiry caused an error.');
PUT SKIP LIST ('Error status:', ERROR_STATUS );
STOP;
END;
/*
* Defer output as long as possible and suppress
* implicit regenerations.
*/
IF (( DEF_MODE ^= GKS$K_ASTI ) &
( REGEN_FLAG ^= GKS$K_IRG_SUPPRESSED )) THEN
CALL GKS$SET_DEFER_STATE( WS_ID, GKS$K_ASTI,
GKS$K_IRG_SUPPRESSED );
END set_up;
/* Draw the picture, and place each primitive in a segment. */
draw_picture: PROCEDURE( WS_ID, TITLE, STARS, TREE, SIDE, ROAD,
HOUSE, HORIZON );
%INCLUDE 'sys$library:gksdefs.pli';
DECLARE (WS_ID, TITLE, STARS, TREE, SIDE, ROAD, HOUSE, HORIZON,
ERROR_STATUS,
DUMMY_INTEGER, WS_TYPE, DUMMY_INT_ARRAY( 50 ),
COLOR_FLAG, NUM_INDEXES ) FIXED BIN;
DECLARE DUMMY_STRING CHAR(80);
DECLARE ( MAX_WIDTH, DUMMY_REAL, NOM_WIDTH ) FLOAT BIN;
DECLARE TEXT_START_X FLOAT BIN INITIAL( 0.05 ),
TEXT_START_Y FLOAT BIN INITIAL( 0.9 ),
NUM_STARS FIXED BIN INITIAL( 6 ),
NUM_TREE_PTS FIXED BIN INITIAL( 29 ),
NUM_HOUSE_PTS FIXED BIN INITIAL( 12 ),
NUM_LAND_PTS FIXED BIN INITIAL( 15 ),
SIDE_START_X FLOAT BIN INITIAL( 0.2 ),
SIDE_START_Y FLOAT BIN INITIAL( 0.3 ),
SIDE_DIAG_X FLOAT BIN INITIAL( 0.25 ),
SIDE_DIAG_Y FLOAT BIN INITIAL( 0.15 ),
SIDE_OFF_COL FIXED BIN INITIAL( 1 ),
SIDE_OFF_ROW FIXED BIN INITIAL( 1 ),
SIDE_NUM_COL FIXED BIN INITIAL( 1 ),
SIDE_NUM_ROW FIXED BIN INITIAL( 2 ),
ROAD_START_X FLOAT BIN INITIAL( 0.0 ),
ROAD_START_Y FLOAT BIN INITIAL( 0.15 ),
ROAD_DIAG_X FLOAT BIN INITIAL( 1.0 ),
ROAD_DIAG_Y FLOAT BIN INITIAL( 0.0 ),
ROAD_OFF_COL FIXED BIN INITIAL( 1 ),
ROAD_OFF_ROW FIXED BIN INITIAL( 1 ),
ROAD_NUM_COL FIXED BIN INITIAL( 10 ),
ROAD_NUM_ROW FIXED BIN INITIAL( 1 ),
LIGHT FIXED BIN INITIAL( 2 ),
DARK FIXED BIN INITIAL( 3 ),
LARGER FLOAT BIN INITIAL( 0.04 ),
WIDER FLOAT BIN INITIAL( 3.0 ),
THREE FIXED BIN INITIAL( 3 ),
BW_NUM_PTS FIXED BIN INITIAL( 9 );
DECLARE BW_X_VALUES (9) FLOAT BIN INITIAL
( 0.0, 0.0, 0.2, 0.2, 0.25, 0.25, 1.0, 1.0, 0.0 );
DECLARE BW_Y_VALUES (9) FLOAT BIN INITIAL
( 0.0, 0.15, 0.15, 0.3, 0.3, 0.15, 0.15, 0.0, 0.0 );
DECLARE SIDE_COLORS ( 1, 2 ) FIXED BIN INITIAL ( 2, 3 );
DECLARE ROAD_COLORS ( 10, 1 ) FIXED BIN INITIAL
( 2, 3, 2, 3, 2, 3, 2, 3, 2, 3 );
DECLARE STARS_X_VALUES (6) FLOAT BIN INITIAL
( 0.05, 0.06, 0.36, 0.66, 0.835, 0.92 );
DECLARE STARS_Y_VALUES (6) FLOAT BIN INITIAL
( 0.7, 0.86, 0.81, 0.86, 0.701, 0.82 );
DECLARE TREE_X (29) FLOAT BIN INITIAL
( 0.425, 0.5, 0.52, 0.54, 0.6, 0.575,
0.56, 0.559, 0.64, 0.69, 0.689, 0.66,
0.63, 0.645, 0.59, 0.53, 0.48, 0.45,
0.42, 0.375, 0.35, 0.375, 0.44, 0.45,
0.515, 0.51, 0.495, 0.475, 0.425 );
DECLARE TREE_Y (29) FLOAT BIN INITIAL
( 0.28, 0.3, 0.26, 0.3, 0.28, 0.33,
0.42, 0.49, 0.53, 0.57, 0.61, 0.64,
0.66, 0.71, 0.76, 0.78, 0.75, 0.71,
0.65, 0.645, 0.6, 0.55, 0.54, 0.5,
0.5, 0.425, 0.38, 0.33, 0.28 );
DECLARE HOUSE_X (12) FLOAT BIN INITIAL
( 0.1, 0.3, 0.3, 0.325, 0.3, 0.3,
0.25, 0.25, 0.2, 0.075, 0.1, 0.1 );
DECLARE HOUSE_Y (12) FLOAT BIN INITIAL
( 0.3, 0.3, 0.6, 0.6, 0.64, 0.75,
0.75, 0.7, 0.75, 0.6, 0.6, 0.3 );
DECLARE LAND_X (15) FLOAT BIN INITIAL
( 0.0, 0.04, 0.055, 0.08, 0.1, 0.3,
0.375, 0.44, 0.49, 0.56, 0.68, 0.8, 0.9, 0.95, 1.0 );
DECLARE LAND_Y (15) FLOAT BIN INITIAL
( 0.35, 0.375, 0.376, 0.36, 0.365, 0.366,
0.38, 0.385, 0.375, 0.36, 0.38, 0.35, 0.359, 0.375, 0.385 );
CALL GKS$SET_TEXT_HEIGHT( LARGER );
CALL GKS$SET_PMARK_TYPE( GKS$K_MARKERTYPE_PLUS );
CALL GKS$SET_FILL_INT_STYLE( GKS$K_INTSTYLE_SOLID );
CALL GKS$SET_PLINE_LINETYPE( GKS$K_LINETYPE_DASHED_DOTTED );
/* Obtain the workstation type. */
CALL GKS$INQ_WS_TYPE( WS_ID, ERROR_STATUS, DUMMY_STRING,
WS_TYPE, DUMMY_INTEGER );
/*
* Make sure that you don't ask for a line wider than the
* workstation's widest line.
*/
CALL GKS$INQ_PLINE_FAC( WS_TYPE, ERROR_STATUS,
DUMMY_INTEGER, DUMMY_INT_ARRAY, DUMMY_INTEGER,
NOM_WIDTH, DUMMY_REAL, MAX_WIDTH, DUMMY_INTEGER,
DUMMY_INTEGER );
DO WHILE (( WIDER * NOM_WIDTH ) > MAX_WIDTH );
WIDER = WIDER - 0.1;
END;
CALL GKS$SET_PLINE_LINEWIDTH( WIDER );
CALL GKS$CREATE_SEG( TITLE );
CALL GKS$TEXT( TEXT_START_X, TEXT_START_Y, 'Starry Night' );
CALL GKS$CLOSE_SEG();
CALL GKS$CREATE_SEG( STARS );
CALL GKS$POLYMARKER( NUM_STARS, STARS_X_VALUES, STARS_Y_VALUES );
CALL GKS$CLOSE_SEG();
CALL GKS$CREATE_SEG( TREE );
CALL GKS$FILL_AREA( NUM_TREE_PTS, TREE_X, TREE_Y );
CALL GKS$CLOSE_SEG();
/* Check to see if you are working with a color workstation. */
CALL GKS$INQ_COLOR_FAC( WS_TYPE, ERROR_STATUS,
DUMMY_INTEGER, COLOR_FLAG, NUM_INDEXES );
/*
* For all monochrome workstations (not including the VT125/240 or
* the monochrome VAXStations), use GKS$FILL_AREA instead of
* GKS$CELL_ARRAY for the sidewalk and road.
*/
IF ( NUM_INDEXES < THREE ) THEN
DO;
CALL GKS$CREATE_SEG( SIDE );
CALL GKS$SET_FILL_INT_STYLE( GKS$K_INTSTYLE_HATCH );
CALL GKS$FILL_AREA( BW_NUM_PTS, BW_X_VALUES, BW_Y_VALUES );
CALL GKS$SET_FILL_INT_STYLE( GKS$K_INTSTYLE_SOLID );
CALL GKS$CLOSE_SEG();
END;
ELSE
DO;
CALL GKS$CREATE_SEG( SIDE );
CALL GKS$CELL_ARRAY( SIDE_START_X, SIDE_START_Y,
SIDE_DIAG_X, SIDE_DIAG_Y, SIDE_OFF_COL,
SIDE_OFF_ROW, SIDE_NUM_COL, SIDE_NUM_ROW,
SIDE_COLORS );
CALL GKS$CLOSE_SEG();
CALL GKS$CREATE_SEG( ROAD );
CALL GKS$CELL_ARRAY( ROAD_START_X, ROAD_START_Y,
ROAD_DIAG_X, ROAD_DIAG_Y, ROAD_OFF_COL,
ROAD_OFF_ROW, ROAD_NUM_COL, ROAD_NUM_ROW,
ROAD_COLORS );
CALL GKS$CLOSE_SEG();
END;
CALL GKS$CREATE_SEG( HORIZON );
CALL GKS$POLYLINE( NUM_LAND_PTS, LAND_X, LAND_Y );
CALL GKS$CLOSE_SEG();
CALL GKS$CREATE_SEG( HOUSE );
/*
* Only change the color index if working with a color
* workstation (or a VT125/240 or a VAXstation).
*/
IF ( NUM_INDEXES >= THREE ) THEN
CALL GKS$SET_FILL_COLOR_INDEX( DARK );
CALL GKS$FILL_AREA( NUM_HOUSE_PTS, HOUSE_X, HOUSE_Y );
CALL GKS$CLOSE_SEG();
END draw_picture;
/* Clean up the VAX GKS and the workstation environments. */
clean_up: PROCEDURE( WS_ID );
%INCLUDE 'sys$library:gksdefs.pli';
DECLARE (WS_ID, DUMMY) FIXED BIN;
CALL GKS$UPDATE_WS( WS_ID, 1 );
GET LIST( DUMMY );
CALL GKS$DEACTIVATE_WS( WS_ID );
CALL GKS$CLOSE_WS( WS_ID );
CALL GKS$CLOSE_GKS();
END clean_up;
HOW TO COPY THIS ARTICLE:
We suggest reading this article on a hardcopy terminal. This will reduce
the possibility of errors from copying the code by hand. If you must copy
the code by hand, we strongly recommend that after you have copied it, you
select the article from the menu a second time to compare the two versions.
This process will help you spot possible transmission errors.
|
|
buy online or call 1.800.AT.COMPAQ
|