home *** CD-ROM | disk | FTP | other *** search
/ Frozen Fish 1: Amiga / FrozenFish-Apr94.iso / bbs / alib / d2xx / d267 / diglib.lha / Diglib / diglib.zoo / diglib / gd13hi.for < prev    next >
Text File  |  1989-06-20  |  9KB  |  332 lines
  1.         SUBROUTINE GD13HI(IFXN,XA,YA)
  2. C
  3. C***   AMIGA 13" MONITOR DRIVER FOR DIGLIB, Craig Wuest, 1986
  4. C***   HI-RES MODE (640 X 400, 16 COLORS)
  5. C-----------------------------------------------------------------------
  6.     IMPLICIT NONE
  7. C
  8. C
  9.     INCLUDE EXEC.INC
  10.     INCLUDE GRAPH.INC
  11.     INCLUDE INTUIT.INC
  12. C
  13.  
  14.     INTEGER IXPOSN,IYPOSN,IX,IY,NPTS,I
  15.     INTEGER*4 ARRAY(16),WIDTH,HEIGHT,ICOLOR
  16.     REAL*4 XA(8),YA(3),DCHAR(8),XRES,YRES,DEVID,XLENCM,YLENCM,
  17.      1         XCLIPD,YCLIPD,NDCLRS,IDVBTS,NFLINE
  18. C
  19. C
  20. C       DECLARE VARS NEED FOR DRIVER OPERATION
  21. C
  22. C
  23.     INTEGER amiga,loc        !DECLARE AMIGA FUNCTIONS
  24. C
  25.     INTEGER*4 RED(0:15),GREEN(0:15),BLUE(0:15)
  26.         REAL TEMP2,TEMP3
  27. C
  28.         INTEGER*2 NorDisRow,NorDisCols,NorXRPM,NorYRPM
  29.         INTEGER*4 wdwht,wdwwth
  30.     INTEGER*4 viewport,i,message,class
  31.     INTEGER Screen            !POINTER TO SCREEN STRUCTURE
  32.     INTEGER Window            !POINTER TO WINDOW STRUCTURE
  33.     INCLUDE WINDOW.INC
  34.     INCLUDE GCDCHR.PRM
  35. C
  36. C DCHAR(1) IS AN ID NUMBER (A BIG DON'T CARE)
  37. C      (2) IS LENGTH IN CM OF X AXIS
  38. C      (3) IS LENGTH IN CM OF Y AXIS
  39. C      (4) IS PIXELS PER CM IN X DIRECTION
  40. C      (5) IS PIXELS PER CM IN Y DIRECTION
  41. C      (6) IS NUMBER OF DISPLAY COLORS
  42. C      (7) IS DEVICE CHARACTERISTIC FLAG (ALWAYS = 69 FOR CRT)
  43. C      (8) IS IMPORTANT TO PLOTTERS BUT NOT TO TUBES. (SHOULD BE 1)
  44. C
  45.         DATA DCHAR /1301.0,25.2,17.5,23.5,23.5,15.0,69.0,1.0/
  46.         DATA NorDisRow/216/,NorDisCols/218/ !GfxBase offsets to VDT info
  47.         DATA NorXRPM/220/,NorYRPM/222/ ! offsets to dpm in low res mode
  48. C    w_title = "MatLab Plots "//CHAR(0)
  49. C
  50. C
  51. C*****************
  52. C
  53. C       FIRST VERIFY WE GOT A GRAPHICS FUNCTION WE CAN HANDLE
  54. C
  55.         IF (IFXN .LE. 0 .OR. IFXN .GT. 13) RETURN
  56.         IF (IFXN .EQ. 11) RETURN
  57. C
  58. C       NOW DISPATCH TO THE PROPER CODE TO HANDLE THAT FUNCTION
  59. C
  60.         GO TO (100,200,300,400,500,600,700,800,900,1000,1100,1200
  61.      1  ,1300) IFXN
  62. C
  63. C       *********************
  64. C       INITIALIZE THE DEVICE
  65. C       *********************
  66. C
  67. 100     CONTINUE
  68. C
  69. C
  70. C       FIRST, INITIALIZE THE SCREEN AND WINDOW TO USE
  71. C
  72.     GFXBASE = amiga(OpenLibrary,'graphics.library'//CHAR(0)
  73.      1     ,0) !open graphics library
  74.     IF (GFXBASE=0) STOP "'Cannot open graphics library?!'"
  75.         scrwth = word(GFXBASE+NorDisCols) !ask the system how many columns
  76.         scrht = word(GFXBASE+NorDisRow)   !now ask about rows
  77.         scrht = scrht + scrht       !set height for interlace
  78. C
  79.         Xrosiz = word(GFXBASE+NorXRPM) ! determine dots per meter x in lo res
  80.         Yrosiz = word(GFXBASE+NorYRPM) ! and dots per meter y in lo res
  81.         Xrosiz = Xrosiz + Xrosiz ! double them for hi res, interlace
  82.         Yrosiz = Yrosiz + Yrosiz
  83.  
  84. C
  85. C    
  86. C    SET UP THE NewScreen data block and allocate the screen
  87.  
  88.       ns_LeftEdge   = 0
  89.       ns_TopEdge    = 0
  90.       ns_Width      = scrwth
  91.       ns_Height     = scrht
  92.       ns_Depth      = 4
  93.       ns_DetailPen  = 1
  94.       ns_BlockPen   = 0
  95.       ns_ViewModes  = HIRES .or. LACE
  96.       ns_Type       = CUSTOMSCREEN
  97.       ns_Font       = loc(TextAttr)
  98.       ns_DefTitle   = 0
  99.       ns_Gadgets    = 0
  100.       ns_CustBitMap = 0
  101.  
  102.       Screen = amiga(OpenScreen,NewScreen)
  103.       if (Screen=0) stop "'OpenScreen' failed"
  104. C
  105. C     Send screen to back so user can see prompts
  106. C
  107.       WRITE(9,199)
  108. 199   FORMAT('Click to back screen to see plot')
  109.       CALL amiga(ScreenToBack,Screen)
  110. C
  111.         RETURN
  112. C
  113. C       **************************
  114. C       GET FRESH PLOTTING SURFACE
  115. C       **************************
  116. C
  117. 200     CONTINUE
  118.  
  119.       wdwwth=scrwth
  120.       wdwht=scrht
  121. * - set up the NewWindow data block
  122.  
  123.       nw_LeftEdge   = 0
  124.       nw_TopEdge    = 0
  125.       nw_Width      = wdwwth
  126.       nw_Height     = wdwht
  127.       nw_DetailPen  = 1
  128.       nw_BlockPen   = 0
  129.       nw_Title      = loc(w_title)
  130.       nw_Flags      = WINDOWCLOSE .or. SMART_REFRESH .or. ACTIVATE .or.
  131.      +                WINDOWSIZING .or. WINDOWDRAG .or. WINDOWDEPTH
  132.       nw_IDCMPFlags = CLOSEWINDOW
  133.       nw_Type       = CUSTOMSCREEN
  134.       nw_FirstGdgt  = 0
  135.       nw_CheckMark  = 0
  136.       nw_Screen     = Screen
  137.       nw_BitMap     = 0
  138.       nw_MinWidth   = 100
  139.       nw_MinHeight  = 25
  140.       nw_MaxWidth   = wdwwth
  141.       nw_MaxHeight  = wdwht
  142.  
  143.       Window = amiga(OpenWindow,NewWindow)
  144.       if (Window=0) stop "'OpenWindow' failed"
  145.  
  146.     WIDTH = wdwwth
  147.     HEIGHT = wdwht
  148. C
  149. C    Set up color map for DIGLIB default colors 0 through 7
  150. C    Color 0 = black (background)
  151. C    Color 1 = white (foreground)
  152. C    Color 2 = red
  153. C    Color 3 = green
  154. C    Color 4 = blue
  155. C    Color 5 = yellow
  156. C    Color 6 = magenta
  157. C    Color 7 = cyan
  158. C
  159.     RED(0)= 0;GREEN(0)= 0;BLUE(0)= 0
  160.     RED(1)=15;GREEN(1)=15;BLUE(1)=15
  161.     RED(2)=15;GREEN(2)= 0;BLUE(2)= 0
  162.     RED(3)= 0;GREEN(3)=15;BLUE(3)= 0
  163.     RED(4)= 0;GREEN(4)= 0;BLUE(4)=15
  164.     RED(5)=15;GREEN(5)=15;BLUE(5)= 0
  165.     RED(6)=15;GREEN(6)= 0;BLUE(6)=15
  166.     RED(7)= 0;GREEN(7)=15;BLUE(7)=15
  167. C
  168.     viewport = amiga(ViewPortAddress,Window)
  169.     DO(i = 0,7)
  170.     CALL amiga(SetRGB4,viewport,i,RED(i),GREEN(i),BLUE(i))
  171.     repeat
  172.     ICOLOR = 1
  173.     CALL amiga(SetAPen,long(Window+wd_RPort),ICOLOR)
  174.         RETURN
  175. C
  176. C
  177. C       ****
  178. C       MOVE
  179. C       ****
  180. C
  181. 300     CONTINUE
  182. C       CONVERT CM. TO GRAPHICS UNITS ROUNDED
  183.         IXPOSN = XRES*XA(1)+0.5
  184.         IYPOSN = FLOAT(HEIGHT)-YRES*YA(1)+0.5     !invert y position
  185.         call Mov(GFXBASE,long(Window+wd_RPort),IXPOSN,IYPOSN)
  186.         RETURN
  187. C
  188. C       ****
  189. C       DRAW
  190. C       ****
  191. C
  192. 400     CONTINUE
  193.         IXPOSN = XRES*XA(1)+0.5
  194.         IYPOSN = FLOAT(HEIGHT)-YRES*YA(1)+0.5
  195. C
  196. C       DRAW A LINE
  197. C
  198.         call Draw(GFXBASE,long(Window+wd_RPort),IXPOSN,IYPOSN)
  199. C
  200.         RETURN
  201. C
  202. C       *****************************
  203. C       FLUSH GRAPHICS COMMAND BUFFER
  204. C       *****************************
  205. C
  206. 500     CONTINUE
  207.     CALL GSWAIT    !Wait for mouse click on CloseWindow Gadget
  208.         call amiga(CloseWindow,Window)
  209.         RETURN
  210. C
  211. C       ******************
  212. C       RELEASE THE DEVICE
  213. C       ******************
  214. C
  215. 600     CONTINUE
  216. C
  217. C       DE-ASSIGN THE CHANNEL
  218. C
  219.         call amiga(CloseScreen,Screen)
  220.         call amiga(CloseLibrary,GFXBASE)
  221. C
  222.         RETURN
  223. C
  224. C       *****************************
  225. C       RETURN DEVICE CHARACTERISTICS
  226. C       *****************************
  227. C
  228. 700     CONTINUE
  229. C
  230. C   now figure the x and y screen size for this monitor (centimeter).
  231. C
  232.         DCHAR(2)=100 * FLOAT(scrwth)/FLOAT(Xrosiz)
  233.         DCHAR(3)=100 * FLOAT(scrht)/FLOAT(Yrosiz)       
  234. C
  235. C figure the x and y resolutions
  236. C
  237.         DCHAR(4)= FLOAT(scrwth)/DCHAR(2)
  238.         DCHAR(5)= FLOAT(scrht)/DCHAR(3)
  239. C
  240. C now average the x and y resolutions, then adjust the x and y axes
  241. C so the display will look right (45 degree angles look 45 degrees, etc.)
  242. C
  243.         DCHAR(4)=(DCHAR(4)+DCHAR(5))/2
  244.         DCHAR(5)=DCHAR(4)
  245.         TEMP2=FLOAT(scrwth)*DCHAR(4)
  246.         TEMP3=FLOAT(scrht)*DCHAR(5)
  247.         DCHAR(2)=AMIN1(TEMP2,DCHAR(2))
  248.         DCHAR(3)=AMIN1(TEMP3,DCHAR(3))
  249. C
  250.         DO 720 I=1,8
  251.         XA(I) = DCHAR(I)
  252. 720     CONTINUE
  253.         RETURN
  254. C
  255. C       ****************************
  256. C       SELECT CURRENT DRAWING COLOR
  257. C       ****************************
  258. C
  259. 800     CONTINUE
  260.     ICOLOR = XA(1)
  261.         call amiga(SetAPen,long(Window+wd_RPort),ICOLOR)
  262.         RETURN
  263. C
  264. C       ***********************************
  265. C       PERFORM GRAPHICS INPUT WITH BUTTONS
  266. C       ***********************************
  267. C
  268. 900     CONTINUE
  269. C
  270. C       Wait for mouse click in CloseWindow gadget
  271. C
  272.     call amiga(Wait,shift(1,byte(long(Window+wd_UserPort)
  273.      1                  +MP_SIGBIT)))
  274.         RETURN
  275. C
  276. C       **********************
  277. C       DEFINE COLOR USING RGB
  278. C       **********************
  279. C
  280. 1000    CONTINUE
  281.     i=XA(1)
  282.     RED(i)=(YA(1)*15./100.)
  283.     GREEN(i)=(YA(2)*15./100.)
  284.     BLUE(i)=(YA(3)*15./100.)
  285.     CALL amiga(SetRGB4,viewport,i,RED(i),GREEN(i),BLUE(i))
  286. C
  287.         RETURN
  288. C
  289. 1100    CONTINUE
  290.     RETURN
  291. C
  292. C    *******************
  293. C    DRAW FILLED POLYGON    !DEFEATED FOR THE TIME BEING USE SOFTWARE!
  294. C    *******************
  295. C
  296. 1200    CONTINUE
  297.     NPTS = IFXN - 1024
  298.     DO (I = 1,NPTS)
  299.     IX = XRES*XA(NPTS) + 0.5
  300.     IY = YRES*YA(NPTS) + 0.5
  301.     ARRAY(2*I-1) = IX
  302.     ARRAY(2*I) = IY
  303.     REPEAT
  304.  
  305.     CALL amiga(PolyDraw,long(Window+wd_RPort),NPTS,ARRAY)
  306. C
  307. C    FIND A POINT INSIDE THE POLYGON TO START FILL FROM
  308. C
  309. CC    DIFFX = (ARRAY(1)-ARRAY(3))/2
  310. CC    DIFFY = (ARRAY(2)-ARRAY(4))/2
  311. CC    DIFFX = (DIFFX-ARRAY(5))/2
  312. CC    DIFFY = (DIFFY-ARRAY(6))/2
  313. C
  314. CC    CALL amiga(Flood,long(Window+wd_Rport),1,DIFFX,DIFFY)
  315. C
  316. C     ***********************************************
  317. C     * CHECK FOR CLICK ON CLOSE BUTTON ON THE FLY. *
  318. C     ***********************************************
  319. 1300    CONTINUE
  320.         XA(1)=0
  321.         message = amiga(GetMsg,long(Window+wd_UserPort))
  322.          if(message<>0) then
  323.           class = long(message+im_Class)
  324.           call amiga(ReplyMsg,message)
  325.           if (class .EQ. CLOSEWINDOW) then
  326.            call amiga(CloseWindow,Window)
  327.            XA(1)=1
  328.           endif
  329.          endif
  330.         RETURN
  331.         END
  332.