⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 pig.f

📁 Programs in the irregular grid design package described in this manual are used to carry out five ma
💻 F
📖 第 1 页 / 共 5 页
字号:
*       real            MainwinTextHeight, MenuwinTextHeight
*       real            ControlwinTextHeight, StatuswinTextHeight
	real            wx1, wx2, wy1, wy2
	real            px1, px2, py1, py2
c temporary variables        
CX      integer         i, j
	integer         np
	integer         MAXPOLYLINE
	parameter       (MAXPOLYLINE = 16384)
	real            xtemp(MAXPOLYLINE), ytemp(MAXPOLYLINE)
	common  /IPIGDRAWPACKAGELOCAL/ xtemp, ytemp


	data    LastWinNum /MAINWIN/
*       save
	return

* ------------------------------------------------------------------------- *
	entry PigDrawPolyline(n, x, y)
*
*      PUBLIC
*+
*+      entry PigDrawPolyline(n, x, y)
*+ Call Sequence:
*+       call PigDrawPolyline(n, x, y)
*+ Purpose:  Draw a line in the current LineColour.
*+ Givens :  integer     n      :    number of points
*+           real        x(n)   :    X coordinates of points in WC
*+           real        y(n)   :    Y coordinates of points in WC
*+ Returns:  None
*+ Effects:  Draws n number of lines of x,y coordinates
*+
* Modified: Adrian Dolling - April 1994. Workaround bug in gpl -
*                                        cannot handle very long arrays
* Modified: Adrian Dolling - March 1995. Suspicion that WPigDrawPolyLine
*                                        fails at n >= 16384
*                                        This failure is more to do with
*                                        memory access, so making a local
*                                        copy in 16K chunks might solve
*                                        and localize the problem.
*
c           do i=1,n,MAXPOLYLINE-1
c               np = min(n-i+1,MAXPOLYLINE)
c               do j=1,np
c                  xtemp(j) = x(i+j-1)
c                  ytemp(j) = y(i+j-1)
c               end do
c               call WPigDrawPolyLine(np, xtemp, ytemp)
c           end do
	call WPigDrawPolyLine(n, x, y)
	return

* ------------------------------------------------------------------------- *
	entry PigDrawFilledPolygon(n, x, y)
*
*       PUBLIC
*+
*+      entry PigDrawFilledPolygon(n, x, y)
*+ Call Sequence:
*+       call PigDrawFilledPolygon(n, x, y)
*+ Purpose: Draws a filled polygon of n points of x,y coordinates
*+ Givens :  integer     n     :   number of points
*+           real        x(n)  :    X coordinates of points in WC
*+           real        y(n)  :    Y coordinates of points in WC
*+ Returns:  None
*+ Effects:  Draws a filled polgon
*+
	np = n
cw         do i=1,n,500
cw             np = min(n-i+1,500)
	       call WPigDrawFilledPolygon(n, x, y)
cw         end do
	return

* ------------------------------------------------------------------------- *
	entry PigDrawSymbols(n, x, y)
*
*       PUBLIC
*+
*+      entry PigDrawSymbols(n, x, y)
*+ Call Sequence:
*+       call PigDrawSymbols(n, x, y)
*+ Purpose:  Draw current symbol in current FillColour at n points in x, y
*+ Givens :  integer     n      :     number of points
*+           real        x(n)   :     X coordinates of points in WC
*+           real        y(n)   :     Y coordinates of points in WC
*+ Returns:  None
*+ Effects:  Draws the current symbol
*+
	np = n
CW      call gpm(np, x, y)
	call WPigDrawSymbols (np, x, y)
	return

* ------------------------------------------------------------------------- *
	entry PigDrawText(x1, y1, Text)
*       PUBLIC
*+
*+      entry PigDrawText(x1, y1, Text)
*+ Call Sequence:
*+       call PigDrawText(x1, y1, Text)
*+ Purpose:  Draw Text string at x1, y1, with current TextColour and Justification
*+ Givens :  real        x1     :    X coordinate of Text position in WC
*+           real        y1     :    Y coordinate of Text position in WC
*+           character *(*) Text:    string of characters
*+ Returns:  None
*+ Effects:  Draws Text at given x,y coordinates in current text color
*+
	if (PigDebug()) then
*            print *,Text
	     write (DEBUGFILE,'(a)') Text
	endif

	aStr = Text
	lenstr = LEN(Text)
	if(LEN(Text).ge.LEN(aStr))then
		lenstr = LEN(aStr) - 1
c	    call PigFatal('Text too long in PigDrawText')
	endif
	aStr(lenstr+1:) = char(0)
	call WPigDrawText(x1, y1, aStr)
	return

* ------------------------------------------------------------------------- *
	entry PigSetWorldCoordinates(x1, x2, y1, y2)
*
*       PUBLIC
*+
*+      entry PigSetWorldCoordinates(x1, x2, y1, y2)
*+ Call Sequence:
*+       call PigSetWorldCoordinates(x1, x2, y1, y2)
*+ Purpose:  Set the world coordinates for the graphic window.
*+ Givens :  real x1, x2, y1, y2     are in WC.  (x1 < x2) and (y1 < y2)
*+ Returns:  None
*+ Effects:  Changes the MAIN window world coordinates
*+
* save world coordinates
	  if ((x1 .ne. x2) .and. (y1 .ne. y2)) then
	     wx1 = x1
	     wx2 = x2
	     wy1 = y1
	     wy2 = y2
	     call WPigSetWorldCoordinates(x1,x2,y1,y2)
	  endif
	  return

* ------------------------------------------------------------------------- *
	entry PigGetWorldCoordinates(x1, x2, y1, y2)
*
*       PUBLIC
*+
*+      entry PigGetWorldCoordinates(x1, x2, y1, y2)
*+ Call Sequence:
*+       call PigGetWorldCoordinates(x1, x2, y1, y2)
*+ Purpose:  Return the current world coordinates for the graphic window.
*+           this routine may need to query the hardware
*+ Givens :  None
*+ Returns:  real        x1, x2   : in WC    (x1 < x2)
*+           real        y1, y2   : in WC    (y1 < y2)
*+ Effects:  Returns the current world coordinates
*+
* all w's contain the current world coordinates
cw          x1 = wx1
cw          x2 = wx2
cw          y1 = wy1
cw          y2 = wy2
	  call WPigGetWorldCoordinates(x1,x2,y1,y2)

	return
* ------------------------------------------------------------------------- *
	entry PigSetProfileCoordinates(x1, x2, y1, y2)
*
*       PUBLIC
*+
*+      entry PigSetProfileCoordinates(x1, x2, y1, y2)
*+ Call Sequence:
*+       call PigSetWorldCoordinates(x1, x2, y1, y2)
*+ Purpose:  Set the world coordinates for the profile graphic window.
*+ Givens :  real x1, x2, y1, y2     are in WC.  (x1 < x2) and (y1 < y2)
*+ Returns:  None
*+ Effects:  Changes the PROFILEWIN window world coordinates
*+
* save world coordinates
	  if ((x1 .ne. x2) .and. (y1 .ne. y2)) then
	     px1 = x1
	     px2 = x2
	     py1 = y1
	     py2 = y2
	     call WPigSetProfileCoordinates(x1,x2,y1,y2)
	  endif
	  return

* ------------------------------------------------------------------------- *
	entry PigGetProfileCoordinates(x1, x2, y1, y2)
*
*       PUBLIC
*+
*+      entry PigGetProfileCoordinates(x1, x2, y1, y2)
*+ Call Sequence:
*+       call PigGetProfileCoordinates(x1, x2, y1, y2)
*+ Purpose:  Return the current profile window world coordinates for
*+           the graphic window.
*+           this routine may need to query the hardware
*+ Givens :  None
*+ Returns:  real        x1, x2   : in WC    (x1 < x2)
*+           real        y1, y2   : in WC    (y1 < y2)
*+ Effects:  Returns the current world coordinates
*+
* all w's contain the current world coordinates
	  x1 = px1
	  x2 = px2
	  y1 = py1
	  y2 = py2

	return

* ------------------------------------------------------------------------- *
	entry PigSetWindowNum(WinNum)
*
*       PUBLIC
*+
*+      entry PigSetWindowNum(WinNum)
*+ Call Sequence:
*+       call PigSetWindowNum(WinNum)
*+ Purpose:  Change the current window number to WinNum
*+ Givens :  integer     WinNum  : window number to change to
*+ Returns:  None
*+ Effects:  Changes the window number
*+

	if(.not.
     +        (    (WinNum.eq.MAINWIN)
     +        .or. (WinNum.eq.MENUWIN)
     +        .or. (WinNum.eq.STATUSWIN)
     +        .or. (WinNum.eq.CONTROLWIN)
     +        .or. (WinNum.eq.PROFILEWIN)
     +        )
     +      ) then
	    if(PigDebug()) write (DEBUGFILE,*)
     +          'PigSetWindowNum(',WinNum,') : Illegal WinNum'
	    call PigDebugFlush
	    write(aStr,'(a,i20,a)') 'PigSetWindowNum(',WinNum,
     +          ') : Illegal WinNum'
	    if(WinNum.ne.0) call PigFatal(aStr)
	    LastWinNum = WinNum
	    return
	endif
* save the new window number
	LastWinNum = WinNum
	call WPigSetWindowNum(LastWinNum)
	return

* ------------------------------------------------------------------------- *
	entry PigGetWindowNum(WinNum)
*
*       PUBLIC
*+
*+      entry PigGetWindowNum(WinNum)
*+ Call Sequence:
*+       call PigGetWindowNum(WinNum)
*+ Purpose:  Get the current window number
*+ Givens :  None
*+ Returns:  integer     WinNum  : the current window number
*+ Effects:  None
*+
	WinNum = LastWinNum
	return

	end

* ========================================================================= *
	Subroutine PigPutMessage(Text)
*
*       PUBLIC
*+
*+      Subroutine PigPutMessage(Text)
*+ Call Sequence:
*+       call PigPutMessage(Text)
*+ Purpose:  Draws a text message (Text) at set locations in the STATUSWIN
*+           window, clears STATUSWIN first then draws
*+ Givens :  character*(*)    Text   :  a variable length character string
*+ Returns:  None
*+ Effects:  Blanks the STATUSWIN, then prints Text (trailing blanks are
*+           removed) in the current text colour in the STATUSWIN window
*+
	character*(*)   Text
        call IPigPutMessage(Text)
	end

* ========================================================================= *
	Subroutine PigPutWarning(Text)
*
*       PUBLIC
*+
*+      Subroutine PigPutMessage(Text)
*+ Call Sequence:
*+       call PigPutMessage(Text)
*+ Purpose:  Draws a text message (Text) at set locations in the STATUSWIN
*+           window, clears STATUSWIN first then draws
*+ Givens :  character*(*)    Text   :  a variable length character string
*+ Returns:  None
*+ Effects:  Blanks the STATUSWIN, then prints Text (trailing blanks are
*+           removed) in the current text colour in the STATUSWIN window
*+
	character*(*)   Text
      call PigPutMessage(Text)
c      call IPigPutWarning(Text)
	end

* ========================================================================= *
	subroutine PigEraseScreen
*
*       PUBLIC
*+
*+      subroutine PigEraseScreen
*+ Call Sequence:
*+       call PigEraseScreen
*+ Purpose:  Clears the display workstation screen.  This is necessary in 
*+           some Xwindow versions to kill the backingstore file which
*+           can slow the display considerably
*+ Effects:  Makes it ALL go away.....
*+
* Written:  Roy Walters -- Dec 1994 for gpig version
* Modified: Adrian Dolling -- Jan 1995, adapted for Wpig version, where it
*                               does nothing but act as a placeholder
*
c       include 'ipig.def'

* Clear the screen window - under GKS this clears the workstation, which has
* the effect of erasing the backing store, if any.
c       if(GKS_SYSTEM.eq.RS6GKS) then
c         call GCLRWK( crtdev, ONE )
c       endif

	end
* ========================================================================= *

	subroutine PigErase(WinNum)
*
*       PUBLIC
*+
*+      subroutine PigErase(WinNum)
*+ Call Sequence:
*+       call PigErase(WinNum)
*+ Purpose:  Blanks out a defined viewport by calling PigDrawFilledPolygon
*+           with the fill colour set to the background colour. This gives
*+           the effect of erasing an are on the screen. Called before text
*+           is output to a viewport.
*+ Givens :  integer        WinNum      :  window to erase
*+ Returns:  None
*+ Effects:  Erases an entire window, then draws the corresponding
*+           border outline.
*+
	include  'ipig.def'
	integer         N
	parameter       (N = 5)

	integer         PrevLineColour, PrevFillColour,
     +                  WinNum, PrevWin

	real            x1, x2, y1, y2
	logical         PigDebug
c        logical         WPigPrinting
	real    CtrlX(N), CtrlY(N) 
c	real    MenuX(N), MenuY(N)
	real    MainX(N), MainY(N)

	Data    CtrlX(1), CtrlX(2), CtrlX(3), CtrlX(4), CtrlX(5)
     +          /XCtrlMin, XCtrlMin, XCtrlMax,
     +          XCtrlMax, XCtrlMin/
	Data    CtrlY(1), CtrlY(2), CtrlY(3), CtrlY(4), CtrlY(5)
     +          /YCtrlMin, YCtrlMax, YCtrlMax,
     +          YCtrlMin, YCtrlMin/

c	Data    MenuX(1), MenuX(2), MenuX(3), MenuX(4), MenuX(5)
c     +          /XMenuMin, XMenuMin, XMenuMax,
c     +          XMenuMax, XMenuMin/
c	Data    MenuY(1), MenuY(2), MenuY(3), MenuY(4), MenuY(5)
c     +          /YMenuMin, YMenuMax, YMenuMax,
c     +          YMenuMin, YMenuMin/

* save current states
	call PigGetWindowNum(PrevWin)
	call PigGetLineColour(PrevLineColour)
	call PigGetFillColour(PrevFillColour)

      if(PigDebug()) then
        if(WinNum .ne. STATUSWIN) then
          write (DEBUGFILE,*)
     +  'About to erase window ', WinNum, ' PrevWin=',PrevWin
	    call PigDebugFlush
        end if

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -