aboutsummaryrefslogtreecommitdiff
path: root/plotlib/gw_subs.f
diff options
context:
space:
mode:
Diffstat (limited to 'plotlib/gw_subs.f')
-rw-r--r--plotlib/gw_subs.f625
1 files changed, 625 insertions, 0 deletions
diff --git a/plotlib/gw_subs.f b/plotlib/gw_subs.f
new file mode 100644
index 0000000..222a123
--- /dev/null
+++ b/plotlib/gw_subs.f
@@ -0,0 +1,625 @@
+C***********************************************************************
+C Module: gw_subs.f
+C
+C Copyright (C) 1996 Harold Youngren, Mark Drela
+C
+C This library is free software; you can redistribute it and/or
+C modify it under the terms of the GNU Library General Public
+C License as published by the Free Software Foundation; either
+C version 2 of the License, or (at your option) any later version.
+C
+C This library is distributed in the hope that it will be useful,
+C but WITHOUT ANY WARRANTY; without even the implied warranty of
+C MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+C Library General Public License for more details.
+C
+C You should have received a copy of the GNU Library General Public
+C License along with this library; if not, write to the Free
+C Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+C
+C Report problems to: guppy@maine.com
+C or drela@mit.edu
+C***********************************************************************
+C
+C***********************************************************************
+C --- Xplot11 driver for X windows plotting to screen
+C
+C Version 4.46 11/28/01
+C
+C Notes: These routines handle the interface to the graphics screen
+C window. Not normally called by the user.
+C The interface file Xwin.c is needed to link to X11
+C***********************************************************************
+
+ subroutine gw_setup(scrn_fraction)
+C---Sets default size of screen window
+C scrn_fraction relative size (0->1) of graphics window to root window
+C size defaults to 520x670 if scrn_fraction<0.0 and aspect ratio is set
+C by 8.5"x11.0" page size.
+C
+ include 'pltlib.inc'
+ DATA w1size, w2size / DEFAULT_PAGEHEIGHT, DEFAULT_PAGEWIDTH /
+C
+ G_SCRNFRAC = abs(scrn_fraction)
+ G_SCRNFRAC = MIN(1.0,G_SCRNFRAC)
+ IF(scrn_fraction .EQ. 0.0) G_SCRNFRAC = DEFAULT_SCREENFRACTION
+C
+C---set default window size
+ if(scrn_fraction .GE. 0.0) then
+ X_PAGE = w1size
+ Y_PAGE = w2size
+ I_PAGETYPE = Page_Landscape
+ else
+ X_PAGE = w2size
+ Y_PAGE = w1size
+ I_PAGETYPE = Page_Portrait
+ endif
+C
+C---window size in absolute units (pseudo-inches)
+ X_WIND = X_PAGE
+ Y_WIND = Y_PAGE
+C
+C---location of upper left window corner
+ GX_LOC = 0
+ GY_LOC = 0
+C
+C---location of plot origin on window
+ GX_ORG = 0
+ GY_ORG = 0
+C
+ return
+ end
+
+
+
+ subroutine gw_init
+C---Initializes graphics screen plotting and global plot variables
+ include 'pltlib.inc'
+C
+ ixsiz = GX_SIZ
+ iysiz = GY_SIZ
+ ixstart = GX_LOC
+ iystart = GY_LOC
+ scrnfrac = MIN(1.0,G_SCRNFRAC)
+ A_RATIO = Y_WIND/X_WIND
+C
+ if(.NOT.LGW_OPEN) then
+C---Open display and window if not already open
+ call gwxopen(iwidth,iheight,idepth)
+ G_WIDTH = iwidth
+ G_HEIGHT = iheight
+ G_DEPTH = idepth
+C---Adjust window size if fraction of root window is specified
+ if(scrnfrac.GT.0.0) then
+ ix = ifix(scrnfrac*float(G_WIDTH))
+ iy = ifix(scrnfrac*float(G_HEIGHT))
+ if(ix*A_RATIO.LT.iy) then
+ ixsiz = ix
+ iysiz = ifix(A_RATIO*float(ix))
+ else
+ iysiz = iy
+ ixsiz = ifix(float(iy)/A_RATIO)
+ endif
+ endif
+ ixsiz = MIN(ixsiz,G_WIDTH)
+ iysiz = MIN(iysiz,G_HEIGHT)
+ call gwxwinopen(ixstart,iystart,ixsiz,iysiz)
+C---Update flags for reference
+ LGW_OPEN = .TRUE.
+C---Graphics window color is not used if less than 4 bits (16 colors)
+C are available
+ LGW_COLOR = (G_DEPTH.gt.4)
+ if(.NOT.LGW_COLOR) then
+ write(*,*) 'Warning: color depth < 4 bits, color not used...'
+ endif
+C
+C---initial cursor warp will be to middle of window
+ GX_SIZ = ixsiz
+ GY_SIZ = iysiz
+ GX_CRS = GX_ORG + GX_SIZ/2
+ GY_CRS = GY_ORG + GY_SIZ/2
+C
+ else
+C
+C---Window already open, resize if specified
+ if(LGW_RESIZE) then
+C
+ ixorig = ixsiz
+ iyorig = iysiz
+C---Resize window if new fractional size of root window is specified
+ if(scrnfrac.GT.0.0) then
+ ix = ifix(scrnfrac*float(G_WIDTH))
+ iy = ifix(scrnfrac*float(G_HEIGHT))
+ if(ix*A_RATIO.LT.iy) then
+ ixsiz = ix
+ iysiz = ifix(A_RATIO*float(ix))
+ else
+ iysiz = iy
+ ixsiz = ifix(float(iy)/A_RATIO)
+ endif
+ else
+ write(*,*) 'Warning: scrnfrac=0 specified, ignoring...'
+ stop
+ endif
+ ixsiz = MIN(ixsiz,G_WIDTH)
+ iysiz = MIN(iysiz,G_HEIGHT)
+ call gwxresize(ixsiz,iysiz)
+ call gwxstatus(ixstart,iystart,ixsz,iysz)
+ if(ixsz.NE.ixsiz .OR. iysz.NE.iysiz) then
+ write(*,*) 'Window resize fails, using old window size'
+ ixsiz = ixorig
+ iysiz = iyorig
+ endif
+C---Update flags for reference
+ LGW_RESIZE = .FALSE.
+ LGW_CHANGED = .TRUE.
+C
+ else
+C
+C...Graphics window can be moved & resized, so reset position & size parameters
+ call gwxstatus(ixstart,iystart,ixsiz,iysiz)
+ LGW_CHANGED = (ixsiz.ne.GX_SIZ .or. iysiz.ne.GY_SIZ)
+C
+ endif
+C
+ call gwxclear
+ endif
+C
+C---Update size and origin
+ GX_LOC = ixstart
+ GY_LOC = iystart
+ GX_SIZ = ixsiz
+ GY_SIZ = iysiz
+C
+C---initial cursor warp will be to middle of window
+cc GX_CRS = GX_ORG + GX_SIZ/2
+cc GY_CRS = GY_ORG + GY_SIZ/2
+C
+C...Set new scale so that each window dimension is as big as possible
+C but no bigger than X_PAGE or Y_PAGE.
+ G_SCALE = max( float(GX_SIZ-1)/X_PAGE,
+ & float(GY_SIZ-1)/Y_PAGE )
+C
+C...New window dimensions
+ X_WIND = float(GX_SIZ-1)/G_SCALE
+ Y_WIND = float(GY_SIZ-1)/G_SCALE
+C
+ return
+ end
+
+
+ subroutine gw_line(X1,Y1,X2,Y2)
+C---Plots line segment to screen,
+C specified in absolute coordinates from X1,Y1 to X2,Y2
+ include 'pltlib.inc'
+C
+ if(LGW_OPEN) then
+C...reverse Y axis for X11 plotting
+ ix1 = GX_ORG + ifix(G_SCALE*X1)
+ ix2 = GX_ORG + ifix(G_SCALE*X2)
+ iy1 = GY_SIZ - (GY_ORG + ifix(G_SCALE*Y1)) - 1
+ iy2 = GY_SIZ - (GY_ORG + ifix(G_SCALE*Y2)) - 1
+ call gwxline(ix1,iy1,ix2,iy2)
+ endif
+C
+ return
+ end
+
+
+
+ subroutine gw_curs(X,Y,kchar)
+C---Gets location of mouse click in graphics window in
+C---absolute coordinates
+ include 'pltlib.inc'
+C
+ if(LGW_OPEN) then
+C
+C------ set previous cursor position (if any) for warping destination
+ ix = GX_ORG + GX_CRS
+ iy = GY_SIZ - (GY_ORG + GY_CRS)
+C
+ call gwxcurs(ix,iy,kchar)
+ GX_CRS = ix - GX_ORG
+ GY_CRS = GY_SIZ - iy - GY_ORG
+C
+ X = float(GX_CRS)/G_SCALE
+ Y = float(GY_CRS)/G_SCALE
+C
+ endif
+ return
+ end
+
+
+
+ subroutine gw_revflag
+C---Gets reverse video flag from users environment settings
+ include 'pltlib.inc'
+C
+ call gwxrevflag(irev)
+ LGW_REVVIDEO = (irev.ne.0)
+C
+ return
+ end
+
+
+ subroutine gw_endplot
+C---Flushes current graphics to window and returns control to
+C graphics window temporarily
+ include 'pltlib.inc'
+C
+ if(LGW_OPEN) then
+ call gwxflush
+ endif
+C
+ return
+ end
+
+
+ subroutine gw_pen(ipen)
+C...Sets pen width for screen display
+ include 'pltlib.inc'
+ dimension ipmap(5)
+c data ipmap / 0, 0, 2, 3, 4 / <- too wide!
+ data ipmap / 0, 0, 1, 1, 2 /
+C
+ ip = max(1,ipen)
+ ip = min(5,ip)
+ if(LGW_OPEN) then
+ call gwxpen(ipmap(ip))
+ endif
+C
+ return
+ end
+
+
+ subroutine gw_linepattern(ipat)
+C...Sets pen width for screen display
+ include 'pltlib.inc'
+C
+ if(LGW_OPEN) call gwxdash(ipat)
+ return
+ end
+
+
+ subroutine gw_flush
+C...Flushes out buffered plotting calls to display
+ include 'pltlib.inc'
+C
+ if(LGW_OPEN) call gwxflush
+ return
+ end
+
+
+ subroutine gw_drawtoscreen
+C...Sets graphics destination to screen
+ include 'pltlib.inc'
+C
+ if(LGW_OPEN) call gwxdrawtowindow
+ return
+ end
+
+
+ subroutine gw_drawtobuffer
+C...Sets graphics destination to background buffer
+ include 'pltlib.inc'
+C
+ if(LGW_OPEN) call gwxdrawtobuffer
+ return
+ end
+
+
+ subroutine gw_showbuffer
+C...Displays graphics drawn into background buffer on screen
+C This does not change the current destination for drawing commands
+ include 'pltlib.inc'
+C
+ if(LGW_OPEN) call gwxdisplaybuffer
+ return
+ end
+
+
+ subroutine gw_clear
+C...Erases graphics display
+ include 'pltlib.inc'
+C
+ if(LGW_OPEN) call gwxclear
+ return
+ end
+
+
+ subroutine gw_setsize(nx,ny)
+C...Resizes X-Window X,Y size to nx,ny in pixels
+ include 'pltlib.inc'
+C
+ if(nx.LE.10) then
+ write(*,*) 'No Resize: Window size too small: ',nx,ny
+ return
+ endif
+C
+C...Get current window parameters if display is open
+ if(LGW_OPEN) then
+ call gwxstatus(ixstart,iystart,ixsiz,iysiz)
+ LGW_CHANGED = (ixsiz.ne.GX_SIZ .or. iysiz.ne.GY_SIZ)
+ GX_LOC = ixstart
+ GY_LOC = iystart
+ GX_SIZ = ixsiz
+ GY_SIZ = iysiz
+ endif
+C
+C...Resize and replot the window contents
+ if(LGW_OPEN) then
+ call gwxresize(nx,ny)
+ call gwxstatus(ixstart,iystart,ixsz,iysz)
+ if(ixsz.NE.ixsiz .OR. iysz.NE.iysiz) then
+ write(*,*) 'Window resize fails, using old window size'
+ ixsz = ixsiz
+ iysz = iysiz
+ endif
+C---Update flags and size for reference
+ LGW_RESIZE = .FALSE.
+ LGW_CHANGED = .TRUE.
+ GX_SIZ = ixsz
+ GY_SIZ = iysz
+C
+C---initial cursor warp will be to middle of window
+ GX_CRS = GX_ORG + GX_SIZ/2
+ GY_CRS = GY_ORG + GY_SIZ/2
+C---Set new scale so that each window dimension is as big as possible
+C but no bigger than X_PAGE or Y_PAGE.
+ G_SCALE = max( float(GX_SIZ-1)/X_PAGE,
+ & float(GY_SIZ-1)/Y_PAGE )
+C---New window dimensions
+ X_WIND = float(GX_SIZ-1)/G_SCALE
+ Y_WIND = float(GY_SIZ-1)/G_SCALE
+C---refresh the newly sized window
+ call REPLOT(1)
+ endif
+ return
+ end
+
+
+ subroutine gw_getsize(nx,ny,ppi)
+C...Returns X Window X,Y size in pixels,
+C and plotting scale in pixels/(absolute coordinate)
+ include 'pltlib.inc'
+C
+ if(LGW_OPEN) then
+ nx = GX_SIZ
+ ny = GY_SIZ
+ ppi = G_SCALE
+ endif
+ return
+ end
+
+
+ subroutine gw_close
+C---Closes graphics window
+ include 'pltlib.inc'
+C
+ if(LGW_OPEN) then
+ call gwxclose
+ LGW_OPEN = .FALSE.
+ endif
+ return
+ end
+
+
+
+ subroutine gw_cname2rgb(colorname,ired,igrn,iblu)
+C...Determines RGB color components of color defined the color name
+C using the X window color database.
+C
+C colorname = name of color (must be in X windows rgb.txt file)
+C
+C The returned color components are
+C ired = 0-255 red component (-1 for no color)
+C igrn = 0-255 green component
+C iblu = 0-255 blue component
+C
+ include 'pltlib.inc'
+ character colorname*(*), cname*80
+ ired = -1
+ igrn = 0
+ iblu = 0
+ccc nc = len(colorname)
+ cname = colorname
+ call g_strip(cname,nc)
+ if(LGW_OPEN) then
+ call gwxcolorname2rgb(ired,igrn,iblu,nc,cname)
+ endif
+ return
+ end
+
+
+ subroutine gw_allocrgbcolor(ired,igrn,iblu,icolorindex)
+C...Allocates plotting color as defined by RGB components
+C The component colors are
+C ired = 0-255 red component
+C igrn = 0-255 green component
+C iblu = 0-255 blue component
+C
+C icolorindex = returned color index of allocated color in window colormap
+C
+ include 'pltlib.inc'
+ ic = -1
+ if(LGW_OPEN .AND. LGW_COLOR) then
+ ir = ired
+ ig = igrn
+ ib = iblu
+ call gwxallocrgbcolor(ir,ig,ib,ic)
+ icolorindex = ic
+ endif
+ return
+ end
+
+
+ subroutine gw_color(icolor)
+C...Sets foreground plotting color
+C The colors are defined by the colormap
+C
+C The color in the colormap table and colorindex go from 0 -> N_COLOR
+C
+ include 'pltlib.inc'
+c
+ if(LGW_OPEN .AND. LGW_COLOR) then
+c
+ icol = mod(icolor,N_COLOR+1)
+ if(icolor.le.0 .OR. icolor.gt.N_COLOR) then
+ write(*,*) '*** gw_color - color index out of bounds ',icolor
+ return
+ endif
+C
+C...Reverse white and black only in video window if LGW_REVVIDEO is set
+ if(LGW_REVVIDEO) then
+ if(icolor.eq.2) icol = 1
+ if(icolor.eq.1) icol = 2
+ endif
+C
+C...Check colorindex<0 for this color, if so this is an unallocated color
+ ic = G_COLOR_CINDEX(icol)
+C
+C...If color is unallocated, allocate it using the RGB components
+ if (ic.lt.0) then
+ irgb = COLOR_RGB(icol)
+ irg = irgb/256
+ ired = irg/256
+ igrn = irg - 256*ired
+ iblu = irgb - 256*irg
+ call gw_allocrgbcolor(ired,igrn,iblu,ic)
+C
+C...This gives the colorindex in the screen colormap (or -1 for no allocation)
+ if(ic.ge.0) G_COLOR_CINDEX(icol) = ic
+ endif
+C
+C...Now, if colorindex is valid, set the color
+ if(ic.ge.0) call gwxsetcolor(ic)
+c
+ endif
+ return
+ end
+
+
+ subroutine gw_bgcolor(icolor)
+C...Sets background plotting color
+C The colors are defined by the colormap
+C
+C The color in the colormap table and colorindex go from 0 -> N_COLOR
+C
+ include 'pltlib.inc'
+c
+ if(LGW_OPEN .AND. LGW_COLOR) then
+c
+ icol = mod(icolor,N_COLOR+1)
+ if(icolor.le.0 .OR. icolor.gt.N_COLOR) then
+ write(*,*) '*** gw_bgcolor - color index out of bounds ',
+ & icolor
+ return
+ endif
+C
+C...Reverse white and black only in video window if LGW_REVVIDEO is set
+ if(LGW_REVVIDEO) then
+ if(icolor.eq.2) icol = 1
+ if(icolor.eq.1) icol = 2
+ endif
+C
+C...Check colorindex<0 for this color, if so this is an unallocated color
+ ic = G_COLOR_CINDEX(icol)
+C
+C...If color is unallocated, allocate it using the RGB components
+ if (ic.lt.0) then
+ irgb = COLOR_RGB(icol)
+ irg = irgb/256
+ ired = irg/256
+ igrn = irg - 256*ired
+ iblu = irgb - 256*irg
+ call gw_allocrgbcolor(ired,igrn,iblu,ic)
+C
+C...This gives the colorindex in the screen colormap (or -1 for no allocation)
+ if(ic.ge.0) G_COLOR_CINDEX(icol) = ic
+ endif
+C
+C...Now, if colorindex is valid, set the color
+ if(ic.ge.0) call gwxsetbgcolor(ic)
+c
+ endif
+ return
+ end
+
+
+ subroutine gw_newcmap
+C...Sets up new colormap, old colormap is flushed
+ include 'pltlib.inc'
+ if(LGW_OPEN .AND. LGW_COLOR) then
+ do i = 1, N_COLOR
+ ic = G_COLOR_CINDEX(i)
+ if(ic.gt.0) call gwxfreecolor(ic)
+ end do
+ endif
+ return
+ end
+
+
+
+ subroutine gw_polyline(X,Y,n,ifill)
+C...Plots polyline (optionally filled) to screen in foreground color
+C X,Y polyline X,Y absolute coordinates
+C n number of X,Y points
+C ifill fill flag, 0 for no fill, 1 for filled polyline
+C
+ include 'pltlib.inc'
+ dimension X(n), Y(n), ix(MaxPolyLine), iy(MaxPolyLine)
+C
+ if(n.GT.MaxPolyLine) then
+ write(*,*) 'gw_polyline: array overflow. Increase MaxPolyline.'
+ return
+ endif
+c
+ if(n.LE.1) return
+ if(LGW_OPEN) then
+C...reverse Y axis for X11 plotting
+ do i = 1, n
+ ix(i) = GX_ORG + ifix(G_SCALE*X(i))
+ iy(i) = GY_SIZ - (GY_ORG + ifix(G_SCALE*Y(i))) - 1
+ end do
+ if(ifill.EQ.0) then
+ call gwxlinez(ix,iy,n)
+ else
+ call gwxpoly(ix,iy,n)
+ endif
+ endif
+ return
+ end
+
+
+
+ subroutine g_strip(strng,n)
+ character strng*(*)
+c
+ nc = len(strng)
+ n = nc
+ if (n.le.1) return
+c
+c---- Strips leading blanks off string
+ if(strng(1:1).EQ.' ') then
+c
+c---- find first non-blank character
+ do i=2, nc
+ if(strng(i:i).NE.' ') go to 10
+ end do
+ go to 20
+ 10 ioff = i
+C
+C---- shift STRNG so first character is non-blank
+ strng(1:nc-ioff) = strng(ioff:nc)
+C---- pad tail of STRNG with blanks
+ strng(nc-ioff+1:nc) = ' '
+c
+ endif
+c
+c---- find the index of the last non-blank charater in NAME
+ 20 do n=nc, 1, -1
+ if(strng(n:n).NE.' ') go to 40
+ end do
+ 40 return
+ end
+