Follow along with the video below to see how to install our site as a web app on your home screen.
Note: This feature may not be available in some browsers.
gfortran ducks.for -o ducks -lxgks -lX11 -lm -g
! example from:
! [URL unfurl="true"]http://www.chilton-computing.org.uk/acd/literature/books/gks/appc.htm[/URL]
!
! compile:
! gfortran ducks.for -o ducks -lxgks -lX11 -lm -g
!
! compiler switches taken from:
! [URL unfurl="true"]https://manpages.ubuntu.com/manpages/focal/man3/xgks.3.html#programming[/URL]
!
C PROGRAM DUCKS
C
REAL XNEWDK(44), YNEWDK(44), XNEWW(10), YNEWW(10)
! variables for waiting loop
integer STAT, CHNR
C
C Include FORTRAN 77 PARAMETER definitions of enumeration
C type parameters (installation dependent)
C
C
C$INSERT SYSCOM > GKS.PAR.lNS.F77
C
C Set up array of aspect source flags
C
C INTEGER LASFS(13)
C 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)
C CALL GOPWK(1, 1, 5)
CALL GOPWK(1, 1, 4)
CALL GACWK(1)
C 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(29.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(67.0, 45.0, 'KS')
! Waiting loop using the function GRQCH = ReQuest CHoice
! see: [URL unfurl="true"]https://www.ibm.com/docs/en/gddm?topic=functions-grqch[/URL]
write(*, '(A)') '* to Quit press F10 or close the Graphics Window'
STAT = 0
CHNR = 0
do
call GRQCH(1, 1, STAT, CHNR)
if (STAT == 1 .and. CHNR == 10) exit
end do
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,
1 17.3, 17.8, 18.5, 20.0, 22.0, 24.0, 26.0, 28.0, 29.0, 28.8,
2 27.2,25.0, 23.0, 21.5, 21.1, 21.5, 22.8, 24.1, 25.1, 25.2,
3 24.2, 22.1, 20.0, 18.0, 16.0, 14.0, 12.0, 10.0, 8.0, 6.1,
4 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
C
C ENUM.INC
C GKS and GKS-3D Enumeration Types
C ISO/DIS-8651-1 & ISO/IEC DIS 8806-1
C (Last Update: 27-04-89)
C
C aspect source: bundled individual
INTEGER GBUNDL, GINDIV
PARAMETER (GBUNDL=0, GINDIV=1)
C
C clear control flag: conditionally, always
INTEGER GCONDI, GALWAY
PARAMETER (GCONDI=0, GALWAY=1)
C
C clipping disable and enable
INTEGER GNCLIP, GCLIP
PARAMETER (GNCLIP=0, GCLIP=1)
C
C colour available: monochrome, colour
INTEGER GMONOC, GCOLOR
PARAMETER (GMONOC=0, GCOLOR=1)
C
C coordinate switch: World Coordinates, Normalized Device Coordinates
INTEGER GWC, GNDC
PARAMETER (GWC=0, GNDC=1)
C
C deferral mode: ASAP, BNIG, BNIL, ASTI
INTEGER GASAP, GBNIG, GBNIL, GASTI
PARAMETER (GASAP=0, GBNIG=1, GBNIL=2, GASTI=3)
C
C detectability: undetectable, detectable
INTEGER GUNDET, GDETEC
PARAMETER (GUNDET=0, GDETEC=1)
C
C device coordinate units: meters, other
INTEGER GMETRE, GOTHU
PARAMETER (GMETRE=0, GOTHU=1)
C
C display surface: empty not-empty, empty
INTEGER GNEMPT, GEMPTY
PARAMETER (GNEMPT=0, GEMPTY=1)
C
C dynamic modification: IRG, IMM
INTEGER GIRG, GIMM
PARAMETER (GIRG=0, GIMM=1)
C
C echo switch: no-echo, echo
INTEGER GNECHO, GECHO
PARAMETER (GNECHO=0, GECHO=1)
C
C fill area interior style: hollow, solid, pattern, hatch
INTEGER GHOLLO, GSOLID, GPATTR, GHATCH
PARAMETER (GHOLLO=0, GSOLID=1, GPATTR=2, GHATCH=3)
C
C highlighting: normal, highlighted
INTEGER GNORML, GHILIT
PARAMETER (GNORML=0, GHILIT=1)
C
C input device status: none, ok, no-pick, no-choice
INTEGER GNONE, GOK, GNPICK, GNCHOI
PARAMETER (GNONE=0, GOK=1, GNPICK=2, GNCHOI=2)
C
C input class: none, locator, stroke, valuator, choice, pick, string
INTEGER GNCLAS, GLOCAT, GSTROK, GVALUA,
* GCHOIC, GPICK, GSTRIN
PARAMETER (GNCLAS=0, GLOCAT=1, GSTROK=2, GVALUA=3,
* GCHOIC=4, GPICK=5, GSTRIN=6)
C
C implicit regeneration: mode suppressed, allowed
INTEGER GSUPPD, GALLOW
PARAMETER (GSUPPD=0, GALLOW=1)
C
C level of GKS: L0a, L0b, L0c, L1a, L1b, L1c, L2a, L2b, L2c
INTEGER GL0A, GL0B, GL0C, GL1A, GL1B,
* GL1C, GL2A, GL2B, GL2C
PARAMETER (GL0A=0, GL0B=1, GL0C=2, GL1A=3, GL1B=4,
* GL1C=5, GL2A=6, GL2B=7, GL2C=8)
C
C new frame action necessary: no, yes
INTEGER GNO, GYES
PARAMETER (GNO=0, GYES=1)
C
C off/on switch for edge flag
INTEGER GOFF, GON
PARAMETER (GOFF=0, GON=1)
C
C operating mode: request, sample, event
INTEGER GREQU, GSAMPL, GEVENT
PARAMETER (GREQU=0, GSAMPL=1, GEVENT=2)
C
C operating state value: GKS closed, GKS open, Workstation open,
C Workstation active, Segment open
INTEGER GGKCL, GGKOP, GWSOP, GWSAC,
* GSGOP
PARAMETER (GGKCL=0, GGKOP=1, GWSOP=2, GWSAC=3,
* GSGOP=4)
C
C presence of invalid values: absent, present
INTEGER GABSNT, GPRSNT
PARAMETER (GABSNT=0, GPRSNT=1)
C
C projection type for 3D: Parallel or Perspective
INTEGER GPARL, GPERS
PARAMETER (GPARL=0, GPERS=1)
C
C regeneration flag: postpone, perform
INTEGER GPOSTP, GPERFO
PARAMETER (GPOSTP=0, GPERFO=1)
C
C relative input priority: higher, lower
INTEGER GHIGHR, GLOWER
PARAMETER (GHIGHR=0, GLOWER=1)
C
C simultaneous events flag: no-more, more
INTEGER GNMORE, GMORE
PARAMETER (GNMORE=0, GMORE=1)
C
C text alignment: horizontal normal, left, center, right
INTEGER GAHNOR, GALEFT, GACENT, GARITE
PARAMETER (GAHNOR=0, GALEFT=1, GACENT=2, GARITE=3)
C
C text alignment: vertical normal, top, cap, half, base, bottom
INTEGER GAVNOR, GATOP, GACAP, GAHALF,
* GABASE, GABOTT
PARAMETER (GAVNOR=0, GATOP=1, GACAP=2, GAHALF=3,
* GABASE=4, GABOTT=5)
C
C text path: right, left, up, down
INTEGER GRIGHT, GLEFT, GUP, GDOWN
PARAMETER (GRIGHT=0, GLEFT=1, GUP=2, GDOWN=3)
C
C text precision: string, character, stroke
INTEGER GSTRP, GCHARP, GSTRKP
PARAMETER (GSTRP=0, GCHARP=1, GSTRKP=2)
C
C type of returned values: set, realized
INTEGER GSET, GREALI
PARAMETER (GSET=0, GREALI=1)
C
C update state: not-pending, pending
INTEGER GNPEND, GPEND
PARAMETER (GNPEND=0, GPEND=1)
C
C vector/raster/other: type vector, raster, other
INTEGER GVECTR, GRASTR, GOTHWK
PARAMETER (GVECTR=0, GRASTR=1, GOTHWK=2)
C
C visibility: invisible, visible
INTEGER GINVIS, GVISI
PARAMETER (GINVIS=0, GVISI=1)
C
C workstation category: Output, Input, Output+Input, Workstation
C Independent Segment Storage, Metafile Output, Metafile Input
INTEGER GOUTPT, GINPUT, GOUTIN, GWISS,
* GMO, GMI
PARAMETER (GOUTPT=0, GINPUT=1, GOUTIN=2, GWISS=3,
* GMO=4, GMI=5)
C
C workstation state: inactive, active
INTEGER GINACT, GACTIV
PARAMETER (GINACT=0, GACTIV=1)
C
C list of GDP attributes: polyline, polymarker, text, fill area
INTEGER GPLATT, GPMATT, GTXATT, GFAATT,
* GEDATT
PARAMETER (GPLATT=0, GPMATT=1, GTXATT=2, GFAATT=3,
* GEDATT=4)
C
C line type: solid, dash, dot, dash-dot
INTEGER GLSOLI, GLDASH, GLDOT, GLDASD
PARAMETER (GLSOLI=1, GLDASH=2, GLDOT=3, GLDASD=4)
C
C marker type: '.', '+', '*', 'o', 'x'
INTEGER GPOINT, GPLUS, GAST, GOMARK,
* GXMARK
PARAMETER (GPOINT=1, GPLUS=2, GAST=3, GOMARK=4,
* GXMARK=5)
C
C For use in Inquiry Functions returning both Current & Requested Values
INTEGER GCURVL, GRQSVL
PARAMETER (GCURVL=0, GRQSVL=1)
C
! example from:
! [URL unfurl="true"]http://www.chilton-computing.org.uk/acd/literature/books/gks/appc.htm[/URL]
!
! compile:
! gfortran ducks.for -o ducks -lxgks -lX11 -lm -g
!
! compiler switches taken from:
! [URL unfurl="true"]https://manpages.ubuntu.com/manpages/focal/man3/xgks.3.html#programming[/URL]
!
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
C$INSERT SYSCOM > GKS.PAR.lNS.F77
! GKS enumeration types taken from:
! [URL unfurl="true"]http://www.dnp.fmph.uniba.sk/cernlib/asdoc/gks_html3/node160.html[/URL]
include 'gks_enum.for'
! variables for waiting loop
integer STAT, CHNR
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, 4)
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(1, 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')
! Waiting loop using the function GRQCH = ReQuest CHoice
! see: [URL unfurl="true"]https://www.ibm.com/docs/en/gddm?topic=functions-grqch[/URL]
write(*, '(A)') '* to Quit press F10 or close the Graphics Window'
STAT = 0
CHNR = 0
do
call GRQCH(1, 1, STAT, CHNR)
if (STAT == 1 .and. CHNR == 10) exit
end do
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,
1 17.3, 17.8, 18.5, 20.0, 22.0, 24.0, 26.0, 28.0, 29.0, 28.8,
2 27.2,25.0, 23.0, 21.5, 21.1, 21.5, 22.8, 24.1, 25.1, 25.2,
3 24.2, 22.1, 20.0, 18.0, 16.0, 14.0, 12.0, 10.0, 8.0, 6.1,
4 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