This appendix contains a complete FORTRAN 77 GKS program, written in strict FORTRAN 77, except for the installation dependent inclusion of a PARAMETER statement.
The program is based on the example in Section 2.8. Introductory and terminating GKS functions have been added to make the example into a complete program and the program comments contain references to the description of these additional functions.
C PROGRAM DUCKS
C
REAL XNEWDK(44), YNEWDK(44), XNEWW(10), YNEWW(10)
C
C Include FORTRAN 77 PARAMETER definitions of enumeration
C type parameters (installation dependent)
C
C
$INSERT SYSCOM > GKS.PAR.lNS.F77
C
C Set up array of aspect source flags
C
INTEGER LASFS(13)
DATA LASFS/13*GBUNDL/
C
C Open GKS, open and activate one workstation, and set aspect source flags
C (see Chapters 7, 8 and 13)
C
CALL GOPKS(1, -1)
CALL GOPWK(1, 1, 5)
CALL GACWK(1)
CALL GSASF(LASFS)
C
C Set window 1, use default viewport 1 and select
C normalization transformation 1 (see Chapter 3)
C
CALL GSWN(1, 0.0, 90.0, 0.0, 90.0)
CALL GSELNT(1)
C
C Set required polyline, polymarker, fill area and text representations
C use values assumed in Chapter 2 - negative values are implementation dependent
C (see Chapter 7)
C
CALL GSPLR(1, 1, 1, 1.0, 1)
CALL GSPLR(1, 2, 2, 1.0, 1)
CALL GSPMR(1, 1, 3, 1.0, 1)
CALL GSPMR(1, 2, 4, 1.0, 1)
CALL GSPMR(1, 3, 2, 1.0, 1)
CALL GSFAR(1, 1, GHOLLO, 0, 1)
CALL GSFAR(1, 2, GSOLID, 0, 1)
CALL GSFAR(1, 3, GHATCH, -4, 1)
CALL GSTXR(l, 1, -104, GSTRKP, 1.0, 0.0, 1)
C
C Continue with example from Section 2.8
C
PI = 4.0* ATAN(1.0)
XCEN = 45.0
YCEN = 45.0
RADIUS = 30.0
C
THETA = 5.0*PI/6.0
CALL MOVEDK(XCEN, YCEN, RADIUS, THETA, XNEWDK, YNEWDK,
1 XNEWW, YNEWW)
CALL GSPLI(1)
CALL GPL(44, XNEWDK, YNEWDK)
CALL GPL(10, XNEWW, YNEWW)
C
THETA = PI/2.0
CALL MOVEDK(XCEN, YCEN, RADIUS, THETA, XNEWDK, YNEWDK,
1 XNEWW, YNEWW)
CALL GSPLI(2)
CALL GPL(44, XNEWDK, YNEWDK)
CALL GPL(10, XNEWW, YNEWW)
THETA = PI/6.0
CALL MOVEDK(XCEN, YCEN, RADIUS, THETA, XNEWDK, YNEWDK,
1 XNEWW, YNEWW)
CALL GSPMI(1)
CALL GPM(44, XNEWDK, YNEWDK)
CALL GSPMI(3)
CALL GPM(10, XNEWW, YNEWW)
C
THETA=-PI/6.0
CALL MOVEDK(XCEN, YCEN, RADIUS, THETA, XNEWDK, YNEWDK,
1 XNEWW, YNEWW)
CALL GSFAI(2)
CALL GFA(44, XNEWDK, YNEWDK)
C
THETA=-PI/2.0
CALL MOVEDK(XCEN, YCEN, RADIUS, THETA, XNEWDK, YNEWDK,
1 XNEWW, YNEWW)
CALL GSFAI(3)
CALL GFA(44, XNEWDK, YNEWDK)
CALL GSPLI(1)
CALL GPL(44, XNEWDK, YNEWDK)
C
THETA = -5.0*PI/6.0
CALL MOVEDK(XCEN, YCEN, RADIUS, THETA, XNEWDK, YNEWDK,
1 XNEWW, YNEWW)
CALL GFA(44, XNEWDK, YNEWDK)
CALL GSPLI(2)
CALL GPL(44, XNEWDK, YNEWDK)
C
CALL GSTXI(1)
CALL GSCHH(6.0)
CALL GSTXAL(GARITE, GAHALF)
CALL GTX(24.0, 45.0, 'G')
CALL GSCHH(3.0)
CALL GSTXAL(GALEFT, GAHALF)
CALL GTX(24.0, 45.0, 'RAPHICAL')
CALL GSTXAL(GARITE, GAHALF)
CALL GTX(60.0, 45.0, 'DUC)
CALL GSCHH(6.0)
CALL GSTXAL(GALEFT, GAHALF)
CALL GTX(60.0, 45.0, 'KS')
C
C Deactivate and close workstation and close GKS
C (see Chapters 8 and 7)
C
CALL GDAWK(1)
CALL GCLWK(1)
CALL GCLKS
END
C
SUBROUTINE MOVEDK(XC, YC, R, THETA, XNWDK, YNWDK, XNWW, YNWW)
C
C Calculates coordinates of duck and wing when centre of duck
C is placed on circle centre (XC, YC) of radius R at angle
C THETA from horizontal radius.
C
REAL XNWDK(44), YNWDK(44), XNWW(10), YNWW(10)
REAL XDK(44), YDK(44), XW(10), YW(10)
C
C DATA initialise XDK, YDK, XW, YW as earlier
C
DATA XDK/ 0.0, 2.0, 4.0, 6.0, 8.0, 10.0, 12.0, 14.0, 16.4, 17.0, 17.3,
1 17.8, 18.5, 20.0, 22.0, 24.0, 26.0, 28.0, 29.0, 28.8, 27.2,25.0,
2 23.0, 21.5, 21.1, 21.5, 22.8, 24.1, 25.1, 25.2, 24.2, 22.1, 20.0,
3 18.0, 16.0, 14.0, 12.0, 10.0, 8.0, 6.1, 4.2, 3.0, 1.3, 0.0/
DATA YDK/ 8.8, 7.6, 7.1, 7.4, 8.0, 8.9, 9.6, 9.9, 9.4, 9.7, 12.0,
1 14.0, 16.1, 17.0, 17.0, 16.0, 13.9, 13.1, 13.2, 12.3, 11.5, 11.5,
2 11.5, 11.2, 10.5, 9.0, 8.0, 7.0, 5.1, 3.6, 1.9, 1.1, 0.9,
3 0.7, 0.8, 1.0, 1.0, 1.2, 1.8, 2.1, 2.9, 4.1, 6.0, 8.8/
DATA XW/15.7, 17.0, 17.7, 17.3, 15.3, 13.0, 11.0, 9.0, 7.0, 4.7/
DATA YW/ 7.0, 6.1, 5.0, 3.8, 3.0, 2.7, 3.0, 3.6, 4.2, 5.2/
C
XPOS = XC + R*COS(THETA)
YPOS = YC + R *SIN(THETA)
DO 100 I=1,44
XNWDK(I) = XDK(I)-14.5 + XPOS
100 YNWDK(I) = YDK(I)-8.85 + YPOS
DO 200 I=1,10
XNWW(I)= XW(I)-14.5 + XPOS
200 YNWW(I) =YW(I)-8.85 + YPOS
RETURN
END