pig.f

Programs in the irregular grid design package described in this manual are used to carry out five ma

      end if

	call PigSetLineColour(FOREGR)
	call PigSetFillColour(BACKGR)
* Next line is added for testing the controlwin layouts       
	if(PigDebug()) call PigSetFillColour(DEBUG_BACKGR)
      IF (WinNum .EQ. CONTROLWIN) THEN
* draw filled polygon then an outline box
	   call PigSetWindowNum(CONTROLWIN)
	   call PigDrawFilledPolygon (N, CtrlX, CtrlY)
	   call PigDrawPolyline (N, CtrlX, CtrlY)

      ELSEIF (WinNum .EQ. STATUSWIN) THEN
	    call IPigEraseStatus
c      ELSEIF (WinNum .EQ. MENUWIN) THEN
c* draw filled polygon then an outline box
c          call PigDrawFilledPolygon (N, MenuX, MenuY)
c          call PigDrawPolyline (N, MenuX, MenuY)
c
      ELSEIF (WinNum .EQ. PROFILEWIN) THEN
* draw filled polygon then an outline box
	   call PigSetWindowNum(PROFILEWIN)
	 call PigGetProfileCoordinates(x1, x2, y1, y2)
	 MainX(1) = x2
	 MainY(1) = y2
	 MainX(2) = x1
	 MainY(2) = y2
	 MainX(3) = x1
	 MainY(3) = y1
	 MainX(4) = x2
	 MainY(4) = y1
	 MainX(5) = x2
	 MainY(5) = y2
	 call PigDrawFilledPolygon(N, MainX, MainY)
	 call PigDrawPolyline (5, MainX, MainY)
cw           call PigGetWorldCoordinates(x1, x2, y1, y2)
cw           call WPigEraseMain
      ELSEIF (WinNum .EQ. MAINWIN) THEN
* draw filled polygon then an outline box
	   call PigSetWindowNum(MAINWIN)
	 call PigGetWorldCoordinates(x1, x2, y1, y2)
	 MainX(1) = x2
	 MainY(1) = y2
	 MainX(2) = x1
	 MainY(2) = y2
	 MainX(3) = x1
	 MainY(3) = y1
	 MainX(4) = x2
	 MainY(4) = y1
	 MainX(5) = x2
	 MainY(5) = y2
	 call PigDrawFilledPolygon(N, MainX, MainY)
	 call PigDrawPolyline (5, MainX, MainY)
cw           call PigGetWorldCoordinates(x1, x2, y1, y2)
cw           call WPigEraseMain
      ELSE
	   call PigFatal('Invalid window requested...')
      ENDIF
      if(PigDebug()) then
        if(WinNum .ne. STATUSWIN) then
          write (DEBUGFILE,*)
     +      'Done erasing window ',WinNum
	    call PigDebugFlush
        end if
      end if

* restore states
	call PigSetFillColour(PrevFillColour)
	call PigSetLineColour(PrevLineColour)
	call PigSetWindowNum(PrevWin)
	end
* ========================================================================= *
	subroutine PigEraseMessage
*
*       PUBLIC
*+
*+      subroutine PigEraseMessage
*+ Call Sequence:
*+       call PigEraseMessage
*+ Purpose:  Blanks out a defined viewport by calling IPigErase(WinNum)
*+           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 :  None
*+ Returns:  None
*+ Effects:  Erases the entire status window, then draws the corresponding
*+           border outline.
*+
	include 'ipig.def'
	call PigErase(STATUSWIN)
	end
* ========================================================================= *
      integer function PigGetBackgroundColour()
*+
*+      integer function PigGetBackgroundColour()
*+ Call Sequence:
*+      integer PigGetBackgroundColour
*+      ...
*+      bgcol = PigGetBackgroundColour()
*+ Purpose:  To return the current background colour setting
*+ Givens :  none
*+ Returns : integer backgroundcolour
*+ Effects:  Returns value of backgr in common /background/ (see pig.def)
*+
	include '../pig/pig.def'
	PigGetBackgroundColour = backgr
	end

	subroutine PigSetBackgroundColour(newcolour)
*+
*+      subroutine PigSetBackgroundColour(newcolour)
*+ Call Sequence:
*+      call PigSetBackgroundColour(newcolour)
*+ Purpose:  To set a new background colour
*+ Givens :  newcolour
*+ Returns : none
*+ Effects:  sets value of backgr in common /background/ (see pig.def)
*+
	include 'ipig.def'
	integer newcolour
	if  (     (newcolour.eq.BLACK)
     +      .or.  (newcolour.eq.WHITE)
     +      .or.  (newcolour.eq.DEBUG_BACKGR)
     +      ) then
	    backgr = newcolour
	    call WPigSetBackgrColour(backgr)
	else
	    call PigFatal('Invalid colour PigSetBackgroundColour()')
	endif
	end

	subroutine PigPauseIfText
*+
*+      subroutine PigPauseIfText
*+ Call Sequence:
*+      call PigPauseIfText
*+      ...
*+ Purpose:  To await user response if in text program
*+ Givens :  none
*+ Returns : none
*+ Effects:  none, in graphics version
*+
	end

      SUBROUTINE PigPromptReal(msgp, ans, ans_real)
      character*(*) msgp
      character*(*) ans
      real ans_real

      character*(256) msg
      logical success

      msg = msgp
	success = .false.
	do while(.not.success)
        call PigPrompt(msg, ans)
        call PigReadReal(ans, ans_real, Success)
        if(.not.success)then
          msg = 'Error interpreting answer: '//msg
        end if
      enddo
      end

      SUBROUTINE PigPromptInteger(msgp, ans, ans_integer)
      character*(*) msgp
      character*(*) ans
      integer ans_integer

      character*(256) msg
      integer len
      character*(10) fmt
      integer PigEndStr
      logical success

      msg = msgp
	success = .false.
	do while(.not.success)
        call PigPrompt(msg, ans)
        len = PigEndStr(ans)
        success = .false.
        write(fmt, '(a,i1,a)') '(I',len,')'
        read(ans, fmt, err=900) ans_integer
        success = .true.
900     continue
        if(.not.success)then
          msg = 'Error interpreting answer: '//msg
        end if
      enddo
      end

*-                     PIG Application Interface
*- ========================================================================= *
*+ Purpose: The PIG.FOR and PIG1.FOR modules contains all necessary subroutines to
*+          interface with a graphics system.  Many specific subroutines
*+          will need to be changed as PIGS is ported from one graphical
*+          environment to another.  All subroutines starting with an I, like
*+          IPIGSetVP are internal calls and are not available for PUBLIC use.
*+
*+          This module also contains routines to open, initialize, and close
*+          a graphics system.
*+
*+ ------------------------------------------------------------------------- *
	logical function PigPrinting()
      include 'ipig.def'
c	logical WPigPrinting
	PigPrinting = WPigPrinting()
        end

        subroutine PigPrinterSetup
c do nothing routine for wpig
        end

        subroutine PigPrinterInit
c do nothing routine for wpig
        end

* ========================================================================= *
	SUBROUTINE PigPrompt( PromptString, RetString )
*       PUBLIC
*+
*+      SUBROUTINE PigPrompt( PromptString, RetString )
*+ Call Sequence:
*+       call PigPrompt( PromptString, RetString )
*+ Purpose: Prompt the user to input a string from the keyboard.
*+ Givens:  character*(*) PromptString : String to use as the prompt.
*+ Returns: character*80  RetString    : character return string.  Blank if an
*+                                       error occurred.
*+ Effects: User is prompted for appropriate input.
*
      include 'ipig.def'

      CHARACTER*(*) PromptString
      CHARACTER*(*) RetString
      CHARACTER*(TEMP_CHARLEN)  tmpRetString
      integer       nchar
      character*(TEMP_CHARLEN) tmpstr
c      integer    horz_j, vert_j
      integer    LEN
      integer PrevColour
	integer PigEndStr
C------------------BEGIN--------------------
	call PigGetTextColour(PrevColour)
c        call PigSetTextColour(BLACK)
c        call PigSetTextColour(PROMPT_COLOR)
	call PigSetTextColour(HITCOLOR)
c        call IPigGetTextAlignment( horz_j, vert_j )
c        call IPigSetTextAlignment( LEFT_JUSTIFY, 4 )

	call PigPutMessage(PromptString)
	tmpstr = PromptString
	nchar = LEN(PromptString)
	nchar = PigEndStr(tmpstr)
	if(nchar+1.ge.LEN(tmpstr) ) then
		nchar = LEN(tmpstr) - 1
c	    call PigFatal('PromptString too long in PigPrompt')
	endif
	tmpstr(nchar+1:) = char(0)
	nchar = LEN(RetString)
	if(nchar.ge.LEN(tmpRetString)) then
		nchar = LEN(tmpRetString) - 1
c	    call PigFatal('RetString too long in PigPrompt')
	endif
	tmpRetString = RetString
	nchar = PigEndStr(tmpRetString)	!was commented out...
	tmpRetString(nchar+1:) = char(0)
	nchar = LEN(RetString)	!was commented out...
	call WPigGetString(tmpstr, nchar, tmpRetString)
	if(nchar.eq.0) then
	    RetString = ' '
	else
	    RetString = tmpRetString(:nchar)
	endif
c        RetString(nchar+1:) = ' '
	call PigEraseMessage
c        call IPigSetTextAlignment( horz_j, vert_j )
	call PigSetTextColour(PrevColour)
	END

* ========================================================================= *

      FUNCTION PigLenWord1( Cstr )
C
C       PUBLIC
*+
*+      FUNCTION PigLenWord1( Cstr )
*+ Call Sequence:
*+       Answer = PigLenWord1( Cstr )
*+ Purpose: Return the length of a string up to but not including 'End of
*+          string' or the first 'space' character
*+ Givens : Character string
*+ Returns: Length of string or -1 for a NULL string
*+ Effects: String is not harmed.
*+
      CHARACTER*(*) Cstr

      integer       PigLenWord1
      integer       PigStrSearch

      LOGICAL       Found
      logical       PigDebug
      include       'ipig.def'

      PigLenWord1 = PigStrSearch( ' ', Cstr, Found )
      if(PigDebug()) then
	  if(found) then
	       write(DEBUGFILE,*)
     +    'PigLenWord1: Searched /',Cstr,'/ for / /, found at',
     +    PigLenWord1
	  else
	       write(DEBUGFILE,*)
     +    'PigLenWord1: Searched /',Cstr,'/ for / /, not found.'
	       write(DEBUGFILE,*)
     +    'PigLenWord1: PigLenWord1=',PigLenWord1
	  endif
      endif
      if (Found) then
	 PigLenWord1 = PigLenWord1 - 1
      else
	 if(PigDebug()) then
	   write(DEBUGFILE,*)
     +    'PigLenWord1: WARNING: Trying to set string length to -1'
	 endif
* next line fails when parsing a string with no blanks!
	 PigLenWord1 = Min(1,Len(Cstr))
	 if(PigDebug()) then
	   write(DEBUGFILE,*)
     +    'PigLenWord1: WARNING: String length set to ',PigLenWord1
	 endif
      endif

      END
* ========================================================================= *

      FUNCTION PigEndStr( Cstr )
*+
*+      FUNCTION PigEndStr( Cstr )
*+ Call Sequence:
*+       Answer = PigEndStr( Cstr )
*+ Purpose: Return the length of a string up to but not including 'End of
*+          string' or the last non 'space' character
*+ Givens : Character string
*+ Returns: Length of string or -1 for a NULL string
*+ Effects: String is not harmed.

* BUG: This routine can cause errors subsequently if it returns a value of
*      -1 which is used to reference a character array. Trap added.
* BUG: This routine can cause errors with improperly initialized strings,
*      which are not guaranteed inititialized with blanks. Could add a test
*      for a valid ASCII printable character...
*
      CHARACTER*(*)     Cstr
      integer           PigEndStr
      logical        PigDebug
      include 'ipig.def'

      PigEndStr = LEN(Cstr)
* next loop added agd 94/jul/15      
      do while    (    (PigEndStr.gt.0)
     +            .and.(     (Cstr(PigEndStr:PigEndStr) .eq. char(0))
     +                 .or.  (Cstr(PigEndStr:PigEndStr) .eq. ' ')
     +                 )
     +            )
	  PigEndStr = PigEndStr - 1
      end do
      PigEndStr = max(PigEndStr,1)
c      do while    (    (PigEndStr.gt.0)
c     +            .and.(Cstr(PigEndStr:PigEndStr) .eq. ' ')
c     +            )
c          PigEndStr = PigEndStr - 1
c      end do
      if(PigEndStr.lt.1) then
	if(PigDebug()) then
	    write(DEBUGFILE,*)
     +    'PigEndStr: WARNING: Trying to set string length to <=1'
	    write(DEBUGFILE,*)
     +	  'Len(Cstr) = ', Len(Cstr)
	    if(Len(Cstr) .gt. 0) write(DEBUGFILE,*)
     +	  'Cstr = [',Cstr,']'
	endif
	PigEndStr = Min(1,Len(Cstr))
      endif
      end

* ========================================================================= *

      FUNCTION PigStrSearch( lex, TheString, Found )
C
C       PUBLIC
*+
*+      FUNCTION PigStrSearch( lex, TheString, Found )
*+ Call Sequence:
*+      Answer = PigStrSearch(