pig.f

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

*-                  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.
*+
*+ ========================================================================= *

      subroutine PigMain
     +          (
     +          UserInitialiser,
     +          UserMenuEventHandler, 
     +          UserMouseEventHandler,
     +          UserMouseMoveEventHandler,
     +          UserStringEventHandler
     +          )

*+ Purpose:  Initialise PIG graphics, control execution and interaction 
*+           with menu items, mouse and keyboard, then on exit, close the
*+           PIG graphics system.
*+           Control program execution awaiting and handling user events.
*+           The precise nature of interaction is system dependent, some
*+           systems are unable to simultaneously await mouse and keyboard
*+           inputs. The user may control the next expected action, or
*+           exit PigMain by setting the return value in one of the
*+           UserXXXEventHandler user supplied functions.
*+ Givens :
*+       integer function UserInitialiser()
*+              A user supplied function with the above declaration, that
*+              provides the required actions prior to any events being
*+              detected. It is called after the graphics package hass
*+              been opened, and before menus are initialized.
*+              It must initialise the menus, display any default 
*+              information, and set the MAINWIN world coordinates.
*+              UserInitialiser() must return a value of MOUSE_EVENT,
*+              KEYBOARD_EVENT or QUIT_EVENT.
*+              The returned value controls the first kind of event sought.
*+              It will normally be set to MOUSE_EVENT, which is also used
*+              to return MENU_EVENTs.
*+       integer function UserMenuEventHandler(integer MenuItem)
*+              A user supplied function with the above declaration, that
*+              provides the required actions in response to the user
*+              choosing a menu item.
*+              UserInitialiser() must return a value of MOUSE_EVENT,
*+              KEYBOARD_EVENT or QUIT_EVENT.
*+              The returned value controls the next kind of event sought.
*+              It will normally be set to MOUSE_EVENT
*+       integer function UserMouseEventHandler
*+               (integer Window, integer MouseButton,
*+                       real MouseX, real MouseY)
*+              A user supplied function with the above declaration, that
*+              provices the required actions in response to the user
*+              taking an action with the mouse. At present the detected
*+              actions are limited to button releases (GKS restriction),
*+              and no detection of which button was pressed is implemented
*+              (non portable in GKS).
*+              UserMouseEventHandler() must return a value of MOUSE_EVENT,
*+              KEYBOARD_EVENT or QUIT_EVENT.
*+              The returned value controls the next kind of event sought.
*+              It will normally be set to MOUSE_EVENT
*+       integer function UserStringEventHandler
*+               (integer Clen, character*(Clen) String)
*+              A user supplied function with the above declaration, that
*+              provides the required actions in response to the user taking
*+              an action with the keyboard.
*+              UserStringEventHandler() must return a value of MOUSE_EVENT,
*+              KEYBOARD_EVENT or QUIT_EVENT.
c*+       integer FirstInputType
c*+              Must be set to either MOUSE_EVENT or KEYBOARD_EVENT.
c*+              This argument controls the first kind of event sought. It
c*+              will normally be set to MOUSE_EVENT
*+ Returns:  None
*+ Effects:  Controls interaction with user, passing next events to one of
*+           the three user supplied functions. Does not return until one of
*+           the user supplied functions returns QUIT_EVENT.
*+|========================================================================

	external UserInitialiser
	external UserMenuEventHandler
	external UserMouseEventHandler
	external UserMouseMoveEventHandler
	external UserStringEventHandler
	integer  UserInitialiser
	integer  UserMenuEventHandler
	integer  UserMouseEventHandler
	integer  UserMouseMoveEventHandler
	integer  UserStringEventHandler

      include 'ipig.def'

	character*(40) PigGetPlatform
	character*(40) Platform
      logical exist
      character*20 io_action
      integer iostat
      character*(80) Message

	call WPigMainInit()

	call PigOpenGraphicPkg(0.0,1.0,0.0,1.0)

      Platform = PigGetPlatform()
C      if (Platform(:5).eq.'Win32') then
Cc              inquire(unit=*, err=99, !causes compiler generated error message
C              inquire(6, err=99, 
Cc              inquire(0, err=99, 
C     +            iostat=iostat, 
C     +            action=io_action, 
C     +            exist=exist)
C              goto 100
C
C99            continue
Cc error in inquire statement
C              write(Message, '(a,i4,a,a,L)') 
C     +            'Cannot print: iostat=',iostat,
C     +            ' action='//io_action,
C     +            ' exist=',exist
C              call PigPutMessage(Message)
C              call PigUWait(3.0)
C              goto 101
C
C100           continue
C              if  (     (io_action.eq.'UNDEFINED') 
C     +            .or.  (io_action.eq.'READ')
C     +            ) then
C                call PigPutMessage('Unit * is UNDEFINED')
C                open(6,file='stdout.lis',err=991)
C                goto 1001
C
C991             continue
C                call PigPutMessage(
C     +  'Error opening file stdout.lis - File may be already open.')
Cc                call PigUWait(3.0)
Cc                call PigPutMessage(
Cc     +  'Please redirect output to a new file, e.g. app > newfile.out')
C                goto 101
C
C1001            continue
C                print *,
C     +            'This is output to UNDEFINED or READ standard output'
C              else if (io_action.eq.'WRITE') then
C                call PigPutMessage('Unit * is WRITE')
C                print *,'This is output to WRITE standard output'
C              else if (io_action.eq.'READWRITE') then
C                call PigPutMessage('Unit * is READWRITE')
C                print *,'This is output to READWRITE standard output'
C              else
C                call PigPutMessage('Unit * is /'//io_action//'/')
C              end if
C      	      print *,'This is a one line output to standard output'
C101           continue
C      end if
C
	call WPigMain( UserInitialiser,
     +          UserMenuEventHandler, 
     +          UserMouseEventHandler,
     +          UserMouseMoveEventHandler,
     +          UserStringEventHandler )

	End

      subroutine PigSetHandlers
     +          (
     +          UserInitialiser,
     +          UserMenuEventHandler, 
     +          UserMouseEventHandler,
     +          UserMouseMoveEventHandler,
     +          UserStringEventHandler
     +          )
*+ Purpose:  Change the event handlers and call UserInitialiser
*+           Arguments identical to call to PigMain, but does not 
*+           initialize the environment.
	external UserInitialiser
	external UserMenuEventHandler
	external UserMouseEventHandler
	external UserMouseMoveEventHandler
	external UserStringEventHandler
	integer  UserInitialiser
	integer  UserMenuEventHandler
	integer  UserMouseEventHandler
	integer  UserMouseMoveEventHandler
	integer  UserStringEventHandler

      include 'ipig.def'

	call WPigSetHandlers( 
     +          UserInitialiser,
     +          UserMenuEventHandler, 
     +          UserMouseEventHandler,
     +          UserMouseMoveEventHandler,
     +          UserStringEventHandler )
      end

* ========================================================================= *
	subroutine IPigDrawAttributes
*
*       PRIVATE
*-
*-      subroutine IPigDrawAttributes
*- Call Sequence:
*-               Not directly callable
*- Purpose:  Contains all integer attributes for drawing
*- Givens :  None
*- Returns:  None
*- Effects:  Not directly callable
*-
	include 'ipig.def'

*- input variables
	integer   NewColour
	real      NewWidth
	real      NewTextHeight
	integer   NewJustification
	integer   NewSymbolNumber
	real      NewSymbolSize
	integer	rgb_red, rgb_green, rgb_blue
	integer rgb_pixel_colour

*- returned variables
	integer   CurColour
	real      CurWidth
	real      CurTextHeight
	integer   CurJustification
	integer   CurSymbolNumber
	real      CurSymbolSize

*- storage variables for graphic attributes
	integer LineColour
	real    LineWidth
	integer TextColour
	integer FillColour
	integer SymbolNumber
	integer SymbolColour
	Real    TextHeight
	integer Justification
	Real    SymbolSize

*- used for text positioning
	integer BASE
	PARAMETER (BASE = 4)

*- local scratch variables
      integer tmpColour

*- storage variables for graphic attributes
	data    LineColour    /WHITE/
c	data    LineWidth     /1.0/
	data    LineWidth     /0.0/
	data    TextColour    /WHITE/
	data    FillColour    /WHITE/
	data    SymbolNumber  /1/
	data    SymbolColour  /WHITE/
	data    TextHeight    /2.2/
	data    Justification /LEFT_JUSTIFY/
	data    SymbolSize    /1.0/

*        SAVE
	call PigFatal('Cannot call IPigDrawAttributes directly')
	return

* ------------------------------------------------------------------------- *
	entry PigSetRGBColour(NewColour, rgb_red, rgb_green, rgb_blue)

*       PUBLIC
*+
*+      entry PigSetRGBColour(NewColour, rgb_red, rgb_green, rgb_blue)
*+ Call Sequence:
*+       call PigSetRGBColour(NewColour, rgb_red, rgb_green, rgb_blue)
*+ Purpose:  Set the RGB colour for colour NewColour.
*+ Givens :  integer      NewColour: the new colour to change
*+		   integer		rgb_red - the value (in 0..255) for red
*+		   integer		rgb_green - the value (in 0..255) for green
*+		   integer		rgb_blue - the value (in 0..255) for blue
*+ Returns:  None
*+ Effects:  Changes current line colour to colour passed in

	if (NewColour.lt.0) then
	    call PigPutMessage('Illegal colour number, must be > 0')
	else if (NewColour.gt.NUMCOLORS-1) then
	    call PigPutMessage(
     +	'Illegal colour number, must be < NUMCOLORS')
	else
		call WPigSetRGBColour 
     +		(NewColour, rgb_red, rgb_green, rgb_blue)
	endif
	return

* ------------------------------------------------------------------------- *
	entry PigGetRGBColour(NewColour, rgb_red, rgb_green, rgb_blue)

*       PUBLIC
*+
*+      entry PigGetRGBColour(NewColour, rgb_red, rgb_green, rgb_blue)
*+ Call Sequence:
*+       call PigGetRGBColour(NewColour, rgb_red, rgb_green, rgb_blue)
*+ Purpose:  Get the RGB colour for colour NewColour.
*+ Givens :  integer      NewColour: the new colour to change
*+		   integer		rgb_red - the value (in 0..255) for red
*+		   integer		rgb_green - the value (in 0..255) for green
*+		   integer		rgb_blue - the value (in 0..255) for blue
*+ Returns:  None
*+ Effects:  Changes current line colour to colour passed in

	if (NewColour.lt.0) then
	    call PigPutMessage('Illegal colour number, must be > 0')
	else if (NewColour.gt.NUMCOLORS-1) then
	    call PigPutMessage(
     +	'Illegal colour number, must be < NUMCOLORS')
	else
		call WPigGetRGBColour 
     +		(NewColour, rgb_red, rgb_green, rgb_blue)
	endif
	return

* ------------------------------------------------------------------------- *
	entry PigSetColourPixel(NewColour, rgb_pixel_colour)

*       PUBLIC
*+
*+      entry PigSetRGBColour(NewColour, red, green, blue)
*+ Call Sequence:
*+       call PigSetRGBColour(NewColour, red, green, blue)
*+ Purpose:  Set the RGB colour for colour NewColour.
*+ Givens :  integer      NewColour: the new colour to change
*+		   integer		red - the value (in 0..255) for red
*+		   integer		green - the value (in 0..255) for green
*+		   integer		blue - the value (in 0..255) for blue
*+ Returns:  None
*+ Effects:  Changes current line colour to colour passed in

	if (NewColour.lt.0) then
	    call PigPutMessage('Illegal colour number, must be > 0')
	else if (NewColour.gt.NUMCOLORS-1) then
	    call PigPutMessage(
     +	'Illegal colour number, must be < NUMCOLORS')
	else
		call WPigSetColourPixel (NewColour, rgb_pixel_colour)
	endif
	return

* ------------------------------------------------------------------------- *
	entry PigGetColourPixel(NewColour, rgb_pixel_colour)

*       PUBLIC
*+
*+      entry PigGetRGBColour(NewColour, red, green, blue)
*+ Call Sequence:
*+       call PigGetRGBColour(NewColour, red, green, blue)
*+ Purpose:  Get the RGB colour for colour NewColour.
*+ Givens :  integer      NewColour: the new colour to change
*+		   integer		red - the value (in 0..255) for red
*+		   integer		green - the value (in 0..255) for green
*+		   integer		blue - the value (in 0..255) for blue
*+ Returns:  None
*+ Effects:  Changes current line colour to colour passed in

	if (NewColour.lt.0) then
	    call PigPutMessage('Illegal colour number, must be > 0')
	else if (NewColour.gt.NUMCOLORS-1) then
	    call PigPutMessage(
     +	'Illegal colour number, must be < NUMCOLORS')
	else
		call WPigGetColourPixel (NewColour, rgb_pixel_colour)
	endif
	return

* ------------------------------------------------------------------------- *
	entry PigSetLineColour(NewColour)

*       PUBLIC
*+
*+      entry PigSetLineColour(NewColour)
*+ Call Sequence:
*+       call PigSetLineColour(NewColour)
*+ Purpose:  Set the current line colour for use to NewColour.  Lines
*+           drawn are in the current line colour.
*+ Givens :  integer      NewColour: the new colour to change to
*+ Returns:  None
*+ Effects:  Changes current line colour to colour passed in

	if (NewColour.lt.0) then
	       call PigPutMessage('Illegal colour number, must be > 0')

	else
		tmpColour = mod (NewColour,16)
        if(tmpColour .ne. LineColour) then
		  LineColour = tmpColour