pig.f

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

	  PrevMouseX = ipx
	  PrevMouseY = ipy

	  if(PigDebug()) then
	       write(Message,'(a,i2,i2,f8.3,f8.3)')
     +      'Mouse input is:',Window, MouseButton, ipx, ipy
	       call PigPutMessage(Message)
	  endif
	return

	entry PigGetRubberMouseAndButton(Window, MouseButton, ipx, ipy)

*       PUBLIC
*+
*+      entry PigGetRubberMouseAndButton(Window, MouseButton, ipx, ipy)
*+ Call Sequence:
*+       call PigGetRubberMouseAndButton(Window, MouseButton, ipx, ipy)
*+ Purpose:  To activate the mouse.
*+           Identical to PigGetMouseAndButton, except that a rubber line is drawn
*+           following the mouse, until clicked.
*+           PigGetRubberMouseAndButton returns the world
*+           coordinates (ipx, ipy) and the current normalization
*+           transformation number (Window number) of the current
*+           mouse location when the mouse button is released. To
*+           ensure the mouse cursor doesn't 'fly away' each time
*+           the mouse is clicked, PigGetMouseAndButton should be called
*+           with the same values as it returned on the previous
*+           call.
*+ Givens :  None
*+ Returns:  integer     Window: the normalization transformation number
*+                               where the mouse was clicked
*+           integer     MouseButton: Button number, from (0..n)
*+           real        ipx   : the x world coordinate of the mouse location
*+           real        ipy   : the y world coordinate of the mouse location
*+ Effects:  Routine waits for mouse input

* Move the window number into an integer*2 var. and re-initialize the
* last x/y coords.
	  
c          NormTrans = PrevMouseWindow
C         ipx = PrevMouseX
C         ipy = PrevMouseY

	  call PigGetWindowNum(PrevWindow)
	  call PigSetWindowNum(Window)
	  call PigGetWindowNum(CurWindow)
	  Window = -1
	  PrevMouseX = ipx
	  PrevMouseY = ipy
	  do while(Window.ne.CurWindow)
		ipx = PrevMouseX
		ipy = PrevMouseY
		
		Window = CurWindow
		call WPigGetRubberMouseAndButton 
     +                  (Window, MouseButton, ipx, ipy)
	  end do

	  PrevMouseWindow = Window
	  PrevMouseX = ipx
	  PrevMouseY = ipy

	  if(PigDebug()) then
	       write(Message,'(a,i2,i2,f8.3,f8.3)')
     +      'Mouse input is:',Window, MouseButton, ipx, ipy
	       call PigPutMessage(Message)
	  endif
	  call PigSetWindowNum(PrevWindow)
	return

* ------------------------------------------------------------------------- *
	entry PigSetMouse(Window, ipx, ipy)

*       PUBLIC
*+
*+      entry PigSetMouse(Window, ipx, ipy)
*+ Call Sequence:
*+       call PigSetMouse(Window, ipx, ipy)
*+ Purpose:  To set the saved mouse position.
*+ Givens :  integer     Window: the normalization transformation number
*+                               in which to position the mouse
*+           real        ipx   : the x world coordinate of the mouse location
*+           real        ipy   : the y world coordinate of the mouse location
*+ Returns:  None
*+ Effects:  Routine waits for mouse input
*+
* Written:  Adrian Dolling -- June 1993
*
* Move the window number into an integer*2 var. and re-initialize the
* last x/y coords.
	PrevMouseWindow = Window
	PrevMouseX = ipx
	PrevMouseY = ipy
	return

* ------------------------------------------------------------------------- *
	entry PigGetMousePrev(Window, ipx, ipy)

*       PUBLIC
*+
*+      entry PigGetMousePrev(Window, ipx, ipy)
*+ Call Sequence:
*+       call PigGetMousePrev(Window, ipx, ipy)
*+ Purpose:  To retrieve the last known position of the mouse. 
*+           PigGetMousePrev returns the world
*+           coordinates (ipx, ipy) and the current normalization
*+           transformation number (Window number) of the last known
*+           mouse location when the mouse button was released. 
*+ Givens :  None
*+ Returns:  integer     Window: the normalization transformation number
*+                               in which to position the mouse
*+           real        ipx   : the x world coordinate of the mouse location
*+           real        ipy   : the y world coordinate of the mouse location
*+ Effects:  None.
*+
* Written:  Adrian Dolling -- June 1993

* Move the window number into an integer*2 var. and re-initialize the
* last x/y coords.
	Window = PrevMouseWindow
	ipx = PrevMouseX
	ipy = PrevMouseY
	return
      end
* ------------------------------------------------------------------------- *
	subroutine PigGetMouse(Window, ipx, ipy)

*       PUBLIC
*+
*+      subroutine PigGetMouse(Window, ipx, ipy)
*+ Call Sequence:
*+       call PigGetMouse(Window, ipx, ipy)
*+ Purpose:  To activate the mouse. PigGetMouse returns the world
*+           coordinates (ipx, ipy) and the current normalization
*+           transformation number (Window number) of the current
*+           mouse location when the mouse button is released. To
*+           ensure the mouse cursor doesn't 'fly away' each time
*+           the mouse is clicked, PigGetMouse should be called
*+           with the same values as it returned on the previous
*+           call.
*+ Givens :  None
*+ Returns:  integer     Window: the normalization transformation number
*+                               where the mouse was clicked
*+           real        ipx   : the x world coordinate of the mouse location
*+           real        ipy   : the y world coordinate of the mouse location
*+ Effects:  Routine waits for mouse input

	integer Window
	integer MouseButton
	real    ipx, ipy
	call PigGetMouseAndButton(Window, MouseButton, ipx, ipy)
	end

	subroutine PigGetRubberMouse(Window, ipx, ipy)

*       PUBLIC
*+
*+      subroutine PigGetRubberMouse(Window, ipx, ipy)
*+ Call Sequence:
*+       call PigGetRubberMouse(Window, ipx, ipy)
*+ Purpose:  To activate the mouse. 
*+           Identical to PigGetMouse, except that a rubber line is drawn
*+           following the mouse, until clicked.
*+           PigGetRubberMouse returns the world
*+           coordinates (ipx, ipy) and the current normalization
*+           transformation number (Window number) of the current
*+           mouse location when the mouse button is released. To
*+           ensure the mouse cursor doesn't 'fly away' each time
*+           the mouse is clicked, PigGetRubberMouse should be called
*+           with the same values as it returned on the previous
*+           call.
*+ Givens :  None
*+ Returns:  integer     Window: the normalization transformation number
*+                               where the mouse was clicked
*+           real        ipx   : the x world coordinate of the mouse location
*+           real        ipy   : the y world coordinate of the mouse location
*+ Effects:  Routine waits for mouse input

	integer Window
	integer MouseButton
	real    ipx, ipy
	call PigGetRubberMouseAndButton(Window, MouseButton, ipx, ipy)
	end

* ========================================================================= *
	subroutine IPigOpenClose

*       PRIVATE
*-
*-      subroutine IPigOpenClose
*- Call Sequence:
*-       Not callable
*- Purpose: To open the graphis package, set defaults and windows
*- Givens : None
*- Returns: None
*- Effects: Not directly callable

	include 'ipig.def'
	logical         pig_open
c        logical         exists

cw        integer         Size
c        integer*2       err
c        real            scale, aspect
	real            x1, x2, y1, y2
* added rpcname local variable agd 94/feb/28
cw        integer         rpclen
cw        character*(60)  rpcname /'c:/trigrid/lib/gksr.rpc'/

c        integer         PigEndStr
	logical         PigDebug
	data            pig_open        /.false./
*        save

	call PigFatal('Cannot call IPigOpenClose directly.')
	return

* ------------------------------------------------------------------------- *
	entry PigOpenGraphicPkg(x1, x2, y1, y2)

*       PUBLIC
*+
*+      entry PigOpenGraphicPkg(x1, x2, y1, y2)
*+ Call Sequence:
*+       call PigOpenGraphicPkg(x1, x2, y1, y2)
*+ Purpose:  To initialize a graphics package, open and connect all graphics
*+           devices that are required for the Trigrid program to utilize
*+           a graphic system.
*+ Givens :  real        x1, x2, y1, y2 : world coordinates of (any) two
*+                                        diagonally oposite corners
*+ Returns:  None
*+ Effects:  Four default Window and Viewport transformations will be defined:
*+                    1 = MENUWIN, 2 = STATUSWIN, 3 = CONTROLWIN, and 4 = MAINWIN
*+           All devices initialized and error logging enabled.  If an error
*+           file already exists, it is deleted before the new error file
*+           is created.

      if(pig_open) then
	 call PigFatal(
     +   'Call to PigOpenGraphicPkg detected when already open.')
      endif

	if(PigDebug()) then
CW            print *,'Initializing PIG graphics package'
	      call PigDebugOpen
	endif

      call PigSetWindowNum(MAINWIN)
      call WPigSetForegrColour(Foregr)
      call PigSetBackgroundColour(BLACK)

	if (PigDebug()) call PigSetBackgroundColour(Debug_Backgr)

*   call non portable special setups
	call IPigNPInit


* Connect to devices
      if(PigDebug()) write (DEBUGFILE,*) 'About to call PigDisplayOn'
CW      if(PigDebug()) print *, 'About to call PigDisplayOn'
      call PigDisplayOn

**end of old INITGKS

***** sets up colour and text defaults
      if(PigDebug()) write (DEBUGFILE,*)
     +  'About to call ipigsetdefaults'
CW      if(PigDebug()) print *,
CW         +     'About to call ipigsetdefaults'
      call IPigSetDefaults


* set fill style to solid
	 call IPigSetFillInteriorStyle(1)

* Set line type and colour then draw a box around each window/viewport.
	 call PigSetLineColour(FOREGR)
	 call PigSetTextColour(FOREGR)
	 call PigSetFillColour(FOREGR)

	 call PigSetWorldCoordinates(x1,x2,y1,y2)
      call PigSetWindowNum( MAINWIN )

      if(PigDebug()) write (DEBUGFILE,*)
     +  'About to erase all windows: MAINWIN, STATUSWIN,'//
     +  ' MENUWIN, CONTROLWIN'
      call PigErase(MAINWIN)
      if(PigDebug()) write (DEBUGFILE,*) 'Finished erasing MAINWIN'
      call PigDebugFlush
      call PigErase(STATUSWIN)
      if(PigDebug()) write (DEBUGFILE,*) 'Finished erasing STATUSWIN'
      call PigDebugFlush
      call PigErase(MENUWIN)
      if(PigDebug()) write (DEBUGFILE,*) 'Finished erasing MENUWIN'
      call PigDebugFlush
      call PigErase(CONTROLWIN)
      if(PigDebug()) write (DEBUGFILE,*) 'Finished erasing CONTROLWIN'
      if(PigDebug()) write (DEBUGFILE,*)
     +  'Finished erasing all windows: MAINWIN, STATUSWIN,'//
     +  ' MENUWIN, CONTROLWIN'
      call PigDebugFlush

* Make the MAINWIN window current and set the priority of the 0 viewport lower
* than all other viewports.
* Window priority order:     MAINWIN = CONTROLWIN = STATUSWIN = MENUWIN > DEFAULT
* Equivalent integer values:   1  =    2    =   3    =  4   >    0

* Set the active window      
      call PigSetWindowNum( MAINWIN )
* Position mouse - default is in centre of MAINWIN
CW      call PigSetMouse(MAINWIN, ((x1+x2)/2.), ((y1+y2)/2.))
      pig_open = .true.
      if(PigDebug()) write (DEBUGFILE,*)
     +  'Finished PigOpenGraphicPkg'
      call PigDebugFlush
      RETURN

* ------------------------------------------------------------------------- *
	entry PigCloseGraphicPkg
*       PUBLIC
*+
*+      entry PigCloseGraphicPkg
*+ Call Sequence:
*+       call PigCloseGraphicPkg
*+ Purpose: To shut down GKS and return to DOS
*+ Givens : None
*+ Returns: None
*+ Effects: Terminates workstation, and returns to DOS

* Close the printer, if open, which will flush and print if appropriate
      call PigPrinterClose

      if(PigDebug()) close(DEBUGFILE)
      pig_open = .false.
      END

* END IPigOpenClose

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

	subroutine PigDrawLine(x1, x2, y1, y2)
*
*       PUBLIC
*+
*+      subroutine PigDrawLine(x1, x2, y1, y2)
*+ Call Sequence:
*+       call PigDrawLine(x1, x2, y1, y2)
*+ Purpose: To draw a line from (x1, y1) to (x2, y2) in
*+          the current line colour.
*+ Givens : real         x1, x2:         xmin and xmax coordinates in WC
*+          real         y1, y2:         ymin and ymax coordinates in WC
*+ Returns: None
*+ Effects: Draws a line from (x1, y1) to (x2, y2).
*+
	real x1, x2, y1, y2, x(2), y(2)
      include 'ipig.def'

	x(1) = x1
	x(2) = x2
	y(1) = y1
	y(2) = y2

      call WPigDrawPolyLine(2, x, y)

	END

* ========================================================================= *
	subroutine IPigDrawPackage
*
*-
*-      subroutine IPigDrawPackage
*- Call Sequence:
*-       call IPigDrawPackage
*- Purpose:  Houses various drawing routines
*- Givens :  None
*- Returns:  None
*- Effects:  Not directly callable
*-
	 include 'ipig.def'
	 logical PigDebug
*        include 'gks.inc'
*        include 'window.def'

	integer         WinNum, n
	real            x1, x2, y1, y2
	real            x(*), y(*)
	character *(*)  Text
	character*(TEMP_CHARLEN) aStr
	integer          lenstr

c local copies of saved variables
	integer         LastWinNum