C-----------------------------------------------------------------------
C   PCDRAW  -- PC Graphics package using the library supplied with 
C              MS FORTRAN version 5.0
C
C   Version for DIFRAC.  Supports a graphics window as well as two
C   text windows, one for commands and the other for use by HKLN 
C-----------------------------------------------------------------------
      include 'fgraph.fi'
      SUBROUTINE PCDRAW (IFUNC,IX,IY,IZ,STRING)
      include 'fgraph.fd'
      include 'COMDIF'
      integer  ifunc, ix, iy, iz
      character string*(*)
C-----------------------------------------------------------------------
C  Definitions for the graphics package, these may not be standard
C  Fortran 
C-----------------------------------------------------------------------
      integer*2            result,
     $                     irt(3),ict(3),irb(3),icb(3), 
     $                     RED,BLUE,WHITE,CYAN,
     $                     irow,icol 
      common /pclocl/      irt,ict,irb,icb,ntextw
      record /videoconfig/ screen
      double precision wx,wy
      record /wxycoord/ wprev 
      record /rccoord/  cursor,cursor2,tcoords  
      logical first
      data first /.true./
      data RED,BLUE,WHITE,CYAN/4,1,15,3/
C-----------------------------------------------------------------------
C  XOPEN  Initialise the display 
C-----------------------------------------------------------------------
      if (IFUNC .eq. XOPEN) then
C-----------------------------------------------------------------------
C -- Find the graphics mode
C-----------------------------------------------------------------------
	 call getvideoconfig (screen)
	 select case (screen.adapter)
	   case ($CGA)
	      result = setvideomode ($HRESBW)
	      termgr = 'CGA' 
	   case ($OCGA)
	      result = setvideomode ($ORESCOLOR)
	      termgr = 'OCGA'
	   case ($EGA,$OEGA)
	      if (screen.monitor .eq. $MONO) then
		 result = setvideomode (ERESNOCOLOR)
		 termgr = 'EGAM'
	      else
		 result = setvideomode ($ERESCOLOR)
		 termgr = 'EGA'
	      endif
	   case ($HGC)
	      result = setvideomode ($HERCMONO)
	      termgr = 'HERC'
	   case ($MCGA)
	      result = setvideomode ($VRES2COLOR)
	      termgr = 'MCGA'
	   case ($VGA,$OVGA)
	      result = setvideomode ($VRES16COLOR)
	      termgr = 'VGA'
	   case DEFAULT
	      result = 0
	 end select
	 if (result .eq. 0) STOP 'ERROR: Unsupported graphics adaptor'
C-----------------------------------------------------------------------
C -- Now we can find out some dimensions
C-----------------------------------------------------------------------
	 call getvideoconfig (screen)
	 edxres = screen.numxpixels
	 edyres = screen.numypixels
	 nrows  = screen.numtextrows
	 ncols  = screen.numtextcols
C-----------------------------------------------------------------------
C -- And setup the default colour scheme
C-----------------------------------------------------------------------
	 result = setbkcolor ($BLUE)
	 result = setcolor (WHITE)
	 call clearscreen ($GCLEARSCREEN)
C-----------------------------------------------------------------------
C -- For now define text window 1 as the top three lines of the screen
C-----------------------------------------------------------------------
	 irt(1) = 1
	 irb(1) = 3
	 ict(1) = 1
	 icb(1) = ncols
	 call settextwindow (irt(1),ict(1),irb(1),icb(1))
	 call clearscreen ($GWINDOW)
	 call settextwindow (irt(1),ict(1),irb(1)+1,icb(1))
	 do 100 i = 2,79
	    win1bf(1)(i:i) = char(205)
	    win1bf(3)(i:i) = char(205)
100      continue
	 win1bf(2) = ' '
	 win1bf(1)(1:1) = char(201)
	 win1bf(1)(ncols:ncols) = char(187)
	 win1bf(2)(1:1) = char(186)
	 win1bf(2)(ncols:ncols) = char(186)
	 win1bf(3)(1:1) = char(200)
	 win1bf(3)(ncols:ncols) = char(188)
	 win1bf(2)(3:14) = 'D I F R A C '
	 do 110 i = 1,3
	    call settextposition (i,1,cursor)
	    call outtext (win1bf(i))
110      continue 
C-----------------------------------------------------------------------
C    And setup the constants for a second text window which is the
C    normal command window 
C-----------------------------------------------------------------------
	 irt(2) = nrows - 6
	 irb(2) = nrows
	 ict(2) = 1
	 icb(2) = ncols
	 call settextwindow (irt(2),ict(2),irb(2),icb(2))
	 call settextposition (1,1,cursor)
	 ntextw = 2 
C-----------------------------------------------------------------------
C    And then window 3 which is a full screen window.
C-----------------------------------------------------------------------
	 irt(3) = 4
	 irb(3) = nrows
	 ict(3) = 1
	 ict(3) = ncols 
C-----------------------------------------------------------------------
C -- And the graphics window as the top righthand corner of the 
C    screen on a scale of 4096 along the x-axis and 60% of the screen.
C-----------------------------------------------------------------------
	 xt = 0.0
	 ypix = edyres/float(nrows)
	 yt = 3.0 *  ypix + 1
	 yb = edyres - (7.0 * ypix + 1)
	 xb = (yb - yt) * edxres/edyres
	 call setviewport (xt,yt,xb,yb)
	 result = setwindow (.TRUE.,-205.0,-154.0,4300.0,3225.0)
	 result =  setcolor (BLUE)
C         call clearscreen ($GVIEWPORT)
C-----------------------------------------------------------------------
C  XMOVE  Move the graphics cursor to x,y 
C-----------------------------------------------------------------------
      else if (IFUNC .eq. XMOVE) then
	 wx = ix
	 wy = iy
	 call moveto_w (wx,wy,wprev) 
C-----------------------------------------------------------------------
C  XDRAW  Draw a line 
C-----------------------------------------------------------------------
      else if (IFUNC .eq. XDRAW) then
	 wx = ix
	 wy = iy
	 result = lineto_w (wx,wy) 
C-----------------------------------------------------------------------
C  XCLOSE Return to normal text mode 
C-----------------------------------------------------------------------
      else if (IFUNC .eq. XCLOSE) then
	 result = setvideomode ($DEFAULTMODE)
C-----------------------------------------------------------------------
C  XCLEAR Clear the graphics viewport 
C-----------------------------------------------------------------------
      else if (IFUNC .eq. XCLEAR) then
	 result = setcolor (BLUE)
	 call gettextposition (cursor2)
	 call settextwindow (irt(1),ict(1),irb(1)+1,icb(1))
	 call clearscreen ($GWINDOW)
	 do 120 i = 1,3
	    call settextposition (i,1,cursor)
	    call outtext (win1bf(i))
120      continue 
	 call displa (theta,omega,chi,phi)
	 call settextwindow (irt(2),ict(2),irb(2),icb(2))
	 irow = cursor2.row
	 icol = cursor2.col
	 call settextposition (irow,icol,cursor2)
	 result = rectangle_w ($GFILLINTERIOR,-205.0,-154.0,
     $                                        4300.0,3225.0)
	 result = setcolor (WHITE)
	 result = rectangle_w ($GBORDER,-205.0,-154.0,
     $                                        4300.0,3225.0)
	 ntextw = 2
C-----------------------------------------------------------------------
C  XTEXT  Output text to the current text window
C-----------------------------------------------------------------------
      else if (IFUNC .EQ. XTEXT) then
	 call outtext (string)
C-----------------------------------------------------------------------
C  XSCROL Scroll text in the current window 
C-----------------------------------------------------------------------
      else if (IFUNC .EQ. XSCROL) then
	 call gettextposition (tcoords)
	 irow = tcoords.row + 1
	 icol = 1 
	 mxlins = irb(ntextw) - irt(ntextw) + 1
	 if (irow .gt. mxlins) then
	    call scrolltextwindow ($GSCROLLUP)
	    irow = mxlins 
	 endif 
	 call settextposition (irow,icol,tcoords)
C-----------------------------------------------------------------------
C  XTDEL Delete a character 
C-----------------------------------------------------------------------
      else if (IFUNC .EQ. XTDEL) then
	 call gettextposition (tcoords)
	 irow = tcoords.row
	 icol = tcoords.col - 1
	 if (icol .ge. 1) then
	    call settextposition (irow,icol,tcoords)
	    call outtext (' ')
	    call settextposition (irow,icol,tcoords)
	 endif 
C-----------------------------------------------------------------------
C  XWIN   Set current text window  
C-----------------------------------------------------------------------
      else if (IFUNC .EQ. XWIN) then 
	 if (ix .ge. 1 .and. ix .le. 3) then 
	    call settextwindow (irt(ix),ict(ix),irb(ix),icb(ix))
	    if (iy .eq. XCLEAR) call clearscreen ($GWINDOW)
	    ntextw = ix 
	 endif 
      endif
      return
      end
C-----------------------------------------------------------------------
C  WNTEXT  Simple routine to output text the the current window 
C-----------------------------------------------------------------------
      SUBROUTINE WNTEXT (STRING)
      INCLUDE 'COMDIF'
      CHARACTER STRING*(*)
      INTEGER IX,IY,IZ
      DATA IX,IY,IZ/1,0,0/
      CALL PCDRAW (XTEXT,IX,IY,IZ,STRING)
      RETURN
      END 
C-----------------------------------------------------------------------
C  WNCDEL  Delete a character from the screen 
C-----------------------------------------------------------------------
      SUBROUTINE WNCDEL
      INCLUDE 'COMDIF'
      CALL PCDRAW (XTDEL,0,0,0,'Delete')
      RETURN
      END
C-----------------------------------------------------------------------
C  WNSET   Routine to set the current text window
C          Assumes:  1 -- Top left hand window
C                    2 -- Text window along bottom
C                    3 -- Full Screen
C-----------------------------------------------------------------------
      SUBROUTINE WNSET (I)
      INCLUDE 'COMDIF'
      LOGICAL FIRST
      DATA FIRST/.TRUE./
      IF (FIRST) THEN
	 CALL PCDRAW (XOPEN,0,0,0,'PCDRAW')
	 FIRST = .FALSE.
      ENDIF
      IF (I .EQ. 2 .AND. IWNCUR .NE. 3) THEN
	 CALL PCDRAW (XWIN,2,0,0,ANS)
      ELSE IF (I .EQ. 2 .AND. IWNCUR .EQ. 3) THEN
	 CALL PCDRAW (XWIN,3,XCLEAR,0,ANS)
	 CALL PCDRAW (XWIN,2,XCLEAR,0,ANS)
	 CALL PCDRAW (XCLEAR,0,0,0,ANS)
      ELSE IF (I .EQ. 3) THEN
	 CALL PCDRAW (XWIN,3,XCLEAR,0,ANS)
      ELSE
	 CALL PCDRAW (XWIN,I,0,0,ANS)
      ENDIF
      IWNCUR = I
      RETURN
      END
C-----------------------------------------------------------------------
C  WNEND  Tidy up for quitting 
C-----------------------------------------------------------------------
      SUBROUTINE WNEND
      INCLUDE 'COMDIF'
      CALL PCDRAW (XCLOSE,0,0,0,'WNEND')
      RETURN
      END 
C-----------------------------------------------------------------------
C  SCROLL Scroll text in current window 
C-----------------------------------------------------------------------
      SUBROUTINE SCROLL
      INCLUDE 'COMDIF' 
      CHARACTER STRING
      DATA IX,IY,IZ/0,0,0/,STRING/' '/
      CALL PCDRAW (XSCROL,IX,IY,IZ,STRING)
      RETURN
      END
C-----------------------------------------------------------------------
C  DISPLA Display current angle settings
C-----------------------------------------------------------------------
      SUBROUTINE DISPLA (ZT,ZO,ZC,ZP)
      include 'fgraph.fd'
      INCLUDE 'COMDIF'
      character buffer*76
      integer*2            result,
     $                     irt(3),ict(3),irb(3),icb(3)
      record /rccoord/     cursor,old
      common /pclocl/      irt,ict,irb,icb,ntextw
      nw = ntextw
      icount = acount(1)
      call gettextposition (old)
      call settextwindow (irt(1),ict(1),irb(1),icb(1))
      call settextposition (2,2,cursor)
      write (buffer,10000) ih,ik,il,zt,zo,zc,zp,nref,icount
10000 format (3i4,'    ',4f8.2,'      Nref',I5,'  Int',i8)
      call outtext (buffer(1:76))
      call settextwindow (irt(nw),ict(nw),irb(nw),icb(nw))
      call settextposition (old.row,old.col,cursor)
      return
      end
C-----------------------------------------------------------------------
C  DISPLC Display current count settings
C-----------------------------------------------------------------------
      SUBROUTINE DISPLC (ICOUNT)
      include 'fgraph.fd'
      INCLUDE 'COMDIF'
      character buffer*64
      integer*2            result,
     $                     irt(3),ict(3),irb(3),icb(3)
      record /rccoord/     cursor,old
      common /pclocl/      irt,ict,irb,icb,ntextw
      nw = ntextw
      call gettextposition (old)
      call settextwindow (irt(1),ict(1),irb(1),icb(1))
      call settextposition (2,54,cursor)
      write (buffer,10000) nref,icount
10000 format ('  Nref',I5,'  Int',i8)
      call outtext (buffer(1:24))
      call settextwindow (irt(nw),ict(nw),irb(nw),icb(nw))
      call settextposition (old.row,old.col,cursor)
      return
      end