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