📄 pig.f
字号:
* 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 + -