        SUBROUTINE GD13HI(IFXN,XA,YA)
C
C***   AMIGA 13" MONITOR DRIVER FOR DIGLIB, Craig Wuest, 1986
C***   HI-RES MODE (640 X 400, 16 COLORS)

C      Modified and enhanced by Jim Locker, 1988, 1989, 1990
C-----------------------------------------------------------------------
	IMPLICIT NONE
C
C
	INCLUDE AMIGA$KOM:EXEC.INC
	INCLUDE AMIGA$KOM:GRAPH.INC
	INCLUDE AMIGA$KOM:INTUIT.INC
	INCLUDE DIGLIB$KOM:WINDOW.INC
	INCLUDE DIGLIB$KOM:GCDCHR.PRM
C

	INTEGER*4 IXPOSN,IYPOSN
	INTEGER   IX,IY,NPTS,I
	INTEGER*4 ARRAY(16)
	REAL*4 XA(8),YA(3),DCHAR(8)
C
C
C       DECLARE VARS NEED FOR DRIVER OPERATION
C
	INTEGER amiga,loc		!DECLARE AMIGA FUNCTIONS
C
	INTEGER*4 RED(0:15),GREEN(0:15),BLUE(0:15)
        REAL TEMP2,TEMP3
C
        INTEGER*2 NorDisRow,NorDisCols,NorXRPM,NorYRPM
        INTEGER*4 wdwht,wdwwth
	INTEGER*4 i,message,class

C
C DCHAR(1) IS AN ID NUMBER (A BIG DON'T CARE)
C      (2) IS LENGTH IN CM OF X AXIS
C      (3) IS LENGTH IN CM OF Y AXIS
C      (4) IS PIXELS PER CM IN X DIRECTION
C      (5) IS PIXELS PER CM IN Y DIRECTION
C      (6) IS NUMBER OF DISPLAY COLORS
C      (7) IS DEVICE CHARACTERISTIC FLAG (ALWAYS = 69 FOR CRT)
C      (8) IS IMPORTANT TO PLOTTERS BUT NOT TO TUBES. (SHOULD BE 1)
C
        DATA DCHAR /1301.0,25.2,17.5,23.5,23.5,15.0,69.0,1.0/
        DATA NorDisRow/216/,NorDisCols/218/ !GfxBase offsets to VDT info
        DATA NorXRPM/220/,NorYRPM/222/ ! offsets to dpm in low res mode
C	w_title = "MatLab Plots "//CHAR(0)
C
C
C*****************
C
C       FIRST VERIFY WE GOT A GRAPHICS FUNCTION WE CAN HANDLE
C
        IF (IFXN .LE. 0 .OR. IFXN .GT. 13) RETURN
        IF (IFXN .EQ. 11) RETURN
C
C       NOW DISPATCH TO THE PROPER CODE TO HANDLE THAT FUNCTION
C
        GO TO (100,200,300,400,500,600,700,800,900,1000,1100,1200
     1  ,1300) IFXN
C
C       *********************
C       INITIALIZE THE DEVICE
C       *********************
C
100     CONTINUE
C
C
C       FIRST, INITIALIZE THE SCREEN AND WINDOW TO USE
C
	GFXBASE = amiga(OpenLibrary,'graphics.library'//CHAR(0)
     1     ,0) !open graphics library
	IF (GFXBASE=0) STOP "'Cannot open graphics library?!'"
        scrwth = word(GFXBASE+NorDisCols) !ask the system how many columns
        scrht = word(GFXBASE+NorDisRow)   !now ask about rows
        scrht = scrht + scrht       !set height for interlace
C
        Xrosiz = word(GFXBASE+NorXRPM) ! determine dots per meter x in lo res
        Yrosiz = word(GFXBASE+NorYRPM) ! and dots per meter y in lo res
        Xrosiz = Xrosiz + Xrosiz ! double them for hi res, interlace
        Yrosiz = Yrosiz + Yrosiz

C
C	
C	SET UP THE NewScreen data block and allocate the screen

      ns_LeftEdge   = 0
      ns_TopEdge    = 0
      ns_Width      = scrwth
      ns_Height     = scrht
      ns_Depth      = 4
      ns_DetailPen  = 1
      ns_BlockPen   = 0
      ns_ViewModes  = HIRES .or. LACE
      ns_Type       = CUSTOMSCREEN
      ns_Font       = loc(TextAttr)
      ns_DefTitle   = 0
      ns_Gadgets    = 0
      ns_CustBitMap = 0

      Screen = amiga(OpenScreen,NewScreen)
      if (Screen=0) stop "'OpenScreen' failed"
C
C     Send screen to back so user can see prompts
C
      WRITE(9,199)
199   FORMAT('Click to back screen to see plot')
      CALL amiga(ScreenToBack,Screen)
C
        RETURN
C
C       **************************
C       GET FRESH PLOTTING SURFACE
C       **************************
C
200     CONTINUE

      wdwwth=scrwth
      wdwht=scrht
* - set up the NewWindow data block

      nw_LeftEdge   = 0
      nw_TopEdge    = 0
      nw_Width      = wdwwth
      nw_Height     = wdwht
      nw_DetailPen  = 1
      nw_BlockPen   = 0
      nw_Title      = loc(w_title)
      nw_Flags      = WINDOWCLOSE .or. SMART_REFRESH .or. ACTIVATE .or.
     +                WINDOWSIZING .or. WINDOWDRAG .or. WINDOWDEPTH
      nw_IDCMPFlags = CLOSEWINDOW
      nw_Type       = CUSTOMSCREEN
      nw_FirstGdgt  = 0
      nw_CheckMark  = 0
      nw_Screen     = Screen
      nw_BitMap     = 0
      nw_MinWidth   = 100
      nw_MinHeight  = 25
      nw_MaxWidth   = wdwwth
      nw_MaxHeight  = wdwht

      Window = amiga(OpenWindow,NewWindow)
      if (Window=0) stop "'OpenWindow' failed"

	WIDTH = wdwwth
	HEIGHT = wdwht
C
C	Set up color map for DIGLIB default colors 0 through 7
C	Color 0 = black (background)
C	Color 1 = white (foreground)
C	Color 2 = red
C	Color 3 = green
C	Color 4 = blue
C	Color 5 = yellow
C	Color 6 = magenta
C	Color 7 = cyan
C
	RED(0)= 0;GREEN(0)= 0;BLUE(0)= 0
	RED(1)=15;GREEN(1)=15;BLUE(1)=15
	RED(2)=15;GREEN(2)= 0;BLUE(2)= 0
	RED(3)= 0;GREEN(3)=15;BLUE(3)= 0
	RED(4)= 0;GREEN(4)= 0;BLUE(4)=15
	RED(5)=15;GREEN(5)=15;BLUE(5)= 0
	RED(6)=15;GREEN(6)= 0;BLUE(6)=15
	RED(7)= 0;GREEN(7)=15;BLUE(7)=15
C
	viewport = amiga(ViewPortAddress,Window)
	DO(i = 0,7)
	CALL amiga(SetRGB4,viewport,i,RED(i),GREEN(i),BLUE(i))
	repeat
	ICOLOR = 1
	CALL amiga(SetAPen,long(Window+wd_RPort),ICOLOR)
        RETURN
C
C
C       ****
C       MOVE
C       ****
C
300     CONTINUE
C       CONVERT CM. TO GRAPHICS UNITS ROUNDED
        IXPOSN = XRES*XA(1)+0.5
        IYPOSN = FLOAT(HEIGHT)-YRES*YA(1)+0.5 	!invert y position
C        call Mov(GFXBASE,long(Window+wd_RPort),IXPOSN,IYPOSN)
	call amiga(Move,long(Window+wd_RPort),IXPOSN,IYPOSN)
        RETURN
C
C       ****
C       DRAW
C       ****
C
400     CONTINUE
        IXPOSN = XRES*XA(1)+0.5
        IYPOSN = FLOAT(HEIGHT)-YRES*YA(1)+0.5
C
C       DRAW A LINE
C
C        call Draw(GFXBASE,long(Window+wd_RPort),IXPOSN,IYPOSN)
	call amiga(Draw,long(Window+wd_RPort),IXPOSN,IYPOSN)
C
        RETURN
C
C       *****************************
C       FLUSH GRAPHICS COMMAND BUFFER
C       *****************************
C
500     CONTINUE
	CALL GSWAIT	!Wait for mouse click on CloseWindow Gadget
        call amiga(CloseWindow,Window)
        RETURN
C
C       ******************
C       RELEASE THE DEVICE
C       ******************
C
600     CONTINUE
C
C       DE-ASSIGN THE CHANNEL
C
        call amiga(CloseScreen,Screen)
        call amiga(CloseLibrary,GFXBASE)
C
        RETURN
C
C       *****************************
C       RETURN DEVICE CHARACTERISTICS
C       *****************************
C
700     CONTINUE
C
C   now figure the x and y screen size for this monitor (centimeter).
C
        DCHAR(2)=100 * FLOAT(scrwth)/FLOAT(Xrosiz)
        DCHAR(3)=100 * FLOAT(scrht)/FLOAT(Yrosiz)       
C
C figure the x and y resolutions
C
        DCHAR(4)= FLOAT(scrwth)/DCHAR(2)
        DCHAR(5)= FLOAT(scrht)/DCHAR(3)
C
C now average the x and y resolutions, then adjust the x and y axes
C so the display will look right (45 degree angles look 45 degrees, etc.)
C
        DCHAR(4)=(DCHAR(4)+DCHAR(5))/2
        DCHAR(5)=DCHAR(4)
        TEMP2=FLOAT(scrwth)*DCHAR(4)
        TEMP3=FLOAT(scrht)*DCHAR(5)
        DCHAR(2)=AMIN1(TEMP2,DCHAR(2))
        DCHAR(3)=AMIN1(TEMP3,DCHAR(3))
C
        DO 720 I=1,8
        XA(I) = DCHAR(I)
720     CONTINUE
        RETURN
C
C       ****************************
C       SELECT CURRENT DRAWING COLOR
C       ****************************
C
800     CONTINUE
	ICOLOR = XA(1)
        call amiga(SetAPen,long(Window+wd_RPort),ICOLOR)
        RETURN
C
C       ***********************************
C       PERFORM GRAPHICS INPUT WITH BUTTONS
C       ***********************************
C
900     CONTINUE
C
C       Wait for mouse click in CloseWindow gadget
C
	call amiga(Wait,shift(1,byte(long(Window+wd_UserPort)
     1                  +MP_SIGBIT)))
        RETURN
C
C       **********************
C       DEFINE COLOR USING RGB
C       **********************
C
1000    CONTINUE
	i=XA(1)
	RED(i)=(YA(1)*15./100.)
	GREEN(i)=(YA(2)*15./100.)
	BLUE(i)=(YA(3)*15./100.)
	CALL amiga(SetRGB4,viewport,i,RED(i),GREEN(i),BLUE(i))
C
        RETURN
C
1100	CONTINUE
	RETURN
C
C	*******************
C	DRAW FILLED POLYGON	!DEFEATED FOR THE TIME BEING USE SOFTWARE!
C	*******************
C
1200	CONTINUE
	NPTS = IFXN - 1024
	DO (I = 1,NPTS)
	IX = XRES*XA(NPTS) + 0.5
	IY = YRES*YA(NPTS) + 0.5
	ARRAY(2*I-1) = IX
	ARRAY(2*I) = IY
	REPEAT

	CALL amiga(PolyDraw,long(Window+wd_RPort),NPTS,ARRAY)
C
C	FIND A POINT INSIDE THE POLYGON TO START FILL FROM
C
CC	DIFFX = (ARRAY(1)-ARRAY(3))/2
CC	DIFFY = (ARRAY(2)-ARRAY(4))/2
CC	DIFFX = (DIFFX-ARRAY(5))/2
CC	DIFFY = (DIFFY-ARRAY(6))/2
C
CC	CALL amiga(Flood,long(Window+wd_Rport),1,DIFFX,DIFFY)
C
C     ***********************************************
C     * CHECK FOR CLICK ON CLOSE BUTTON ON THE FLY. *
C     ***********************************************
1300    CONTINUE
        XA(1)=0
        message = amiga(GetMsg,long(Window+wd_UserPort))
         if(message<>0) then
          class = long(message+im_Class)
          call amiga(ReplyMsg,message)
          if (class .EQ. CLOSEWINDOW) then
           call amiga(CloseWindow,Window)
           XA(1)=1
          endif
         endif
        RETURN
        END
