home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / fortran / library / os2 / f77_draw / os2vga.for < prev    next >
Encoding:
Text File  |  1991-01-17  |  4.6 KB  |  167 lines
  1.       INTERFACE TO SUBROUTINE ClrScr [PASCAL] (VGASeg,Color)
  2.       INTEGER*4  VGASeg [NEAR,VALUE]
  3.       INTEGER*2  Color  [NEAR,VALUE]
  4.       END
  5.       INTERFACE TO SUBROUTINE PntSet [PASCAL] (VGASeg,Color,X,Y)
  6.       INTEGER*4  VGASeg [NEAR,VALUE]
  7.       INTEGER*2  Color  [NEAR,VALUE]
  8.       INTEGER*2  X,Y    [NEAR,VALUE]
  9.       END
  10.       INTERFACE TO INTEGER*2 FUNCTION BeginThread(Rtn,Stk,Size,Arg)
  11.       INTEGER*4 Rtn[VALUE]
  12.       INTEGER*1 Stk(*)
  13.       INTEGER*4 Size
  14.       INTEGER*4 Arg
  15.       END
  16.  
  17.  
  18.       SUBROUTINE GrafIn
  19. ************************************************************************
  20. *     enter graphics mode
  21. ************************************************************************
  22.       INTEGER*1  Stack(1024)
  23.       INTEGER*2  BeginThread, ReturnCode
  24.       INTEGER*4  VGASeg
  25.       EXTERNAL   SRScrn
  26.       COMMON /SegCom/ VGASeg
  27.       CALL ScrLck(.TRUE.)
  28.       CALL GMode(.TRUE.)
  29.       CALL VIOAddr(VGASeg)
  30.       ReturnCode = BeginThread(LocFar(SRScrn),Stack,1024,VGASeg)
  31. * --- suppress the flickering of the OAK-VGA
  32. * --- the next two statements may be removed
  33.       CALL ClrScr(VGASeg,INT2(0))
  34.       CALL Wait(500)
  35.       CALL ScrLck(.FALSE.)
  36.       END
  37.  
  38.  
  39.  
  40.       SUBROUTINE GrafEx
  41. ************************************************************************
  42. *     leave graphics mode
  43. ************************************************************************
  44.       CALL GMode(.FALSE.)
  45.       END
  46.  
  47.  
  48.  
  49.       SUBROUTINE SetCol(Color)
  50. ************************************************************************
  51. *     set the color for the next pixels to be drawn
  52. ************************************************************************
  53.       INTEGER*2  Color,Farbe
  54.       COMMON /ColCom/ Farbe
  55.       Farbe = Color+8
  56.       END
  57.  
  58.  
  59.  
  60.       SUBROUTINE SetPxl(IX,IY)
  61. ************************************************************************
  62. *     draw pixel at (IX,IY)
  63. ************************************************************************
  64.       PARAMETER  ( MaxX=639, MaxY=479 )   ! VGA
  65. c     PARAMETER  ( MaxX=639, MaxY=349 )   ! EGA
  66.       INTEGER*2  IX,IY,JY,Farbe
  67.       INTEGER*4  VGASeg
  68.       COMMON /SegCom/ VGASeg
  69.       COMMON /ColCom/ Farbe
  70.       JY = MaxY - IY
  71.       IF( IX.LT.0 .OR. IX.GT.MaxX )  RETURN
  72.       IF( JY.LT.0 .OR. JY.GT.MaxY )  RETURN
  73.       CALL ScrLck(.TRUE.)
  74.       CALL PntSet(VGASeg,Farbe,IX,JY)
  75.       CALL ScrLck(.FALSE.)
  76.       END
  77.  
  78.  
  79.  
  80.       SUBROUTINE DrwLin(X1,Y1a,X2,Y2a)
  81. ************************************************************************
  82. *     draw a line between the points (X1,Y1a) and (X2,Y2a) using
  83. *     BRESENHAM'S algorithm
  84. *     the points must lay in the range of the VGA, e.g.
  85. *               -1 < X1 < 640 ,  -1 < Y1a < 480
  86. *               -1 < X2 < 640 ,  -1 < Y2a < 480
  87. *     the lower left corner is the origin!
  88. ************************************************************************
  89.       PARAMETER  ( MaxX=639, MaxY=479 )   ! VGA
  90. c     PARAMETER  ( MaxX=639, MaxY=349 )   ! EGA
  91.       LOGICAL*2  Inv,XPos,YPos
  92.       INTEGER*2  X1,X2,Y1,Y1a,Y2,Y2a,X,Y,DX,DY,I,E,DE1,DE2,DH, S1,S2
  93.       INTEGER*2  Farbe
  94.       INTEGER*4  VGASeg
  95.       COMMON /SegCom/ VGASeg
  96.       COMMON /ColCom/ Farbe
  97.       CALL ScrLck(.TRUE.)
  98.       Y1 = MaxY - Y1a
  99.       Y2 = MaxY - Y2a
  100.       IF( X1.LT.0 .OR. X1.GT.MaxX )  RETURN
  101.       IF( X2.LT.0 .OR. X2.GT.MaxX )  RETURN
  102.       IF( Y1.LT.0 .OR. Y1.GT.MaxY )  RETURN
  103.       IF( Y2.LT.0 .OR. Y2.GT.MaxY )  RETURN
  104.       S1 = X1
  105.       S2 = X2
  106.       DX = X2 - X1
  107.       DY = Y2 - Y1
  108.       XPos = DX .GT. 0
  109.       YPos = DY .GT. 0
  110.       DX = ABS(DX)
  111.       DY = ABS(DY)
  112.       IF( XPos )  THEN
  113.          X = X1
  114.       ELSE
  115.          X =-X1
  116.       END IF
  117.       IF( YPos )  THEN
  118.          Y = Y1
  119.       ELSE
  120.          Y =-Y1
  121.       END IF
  122.       Inv = DX .LT. DY
  123.       IF( Inv )  THEN
  124.          DH = DX
  125.          DX = DY
  126.          DY = DH
  127.       END IF
  128.       E = 2*DY - DX
  129.       DE1 = E - DX
  130.       DE2 = 2*DY
  131.       DO 10 I=1,DX+1
  132.       IF( XPos )  THEN
  133.          IF( YPos )  THEN
  134.             CALL PntSet(VGASeg,Farbe,X,Y)
  135.          ELSE
  136.             CALL PntSet(VGASeg,Farbe,X,-Y)
  137.          END IF
  138.       ELSE
  139.          IF( YPos )  THEN
  140.             CALL PntSet(VGASeg,Farbe,-X,Y)
  141.          ELSE
  142.             CALL PntSet(VGASeg,Farbe,-X,-Y)
  143.          END IF
  144.       END IF
  145.       IF( Inv ) THEN
  146.          Y = Y + 1
  147.       ELSE
  148.          X = X + 1
  149.       END IF
  150.       IF( E .GT. 0 )  THEN
  151.          IF( Inv )  THEN
  152.             X = X + 1
  153.          ELSE
  154.             Y = Y + 1
  155.          END IF
  156.          E = E + DE1
  157.       ELSE
  158.          E = E + DE2
  159.       END IF
  160.       X1 = X2
  161.       Y1 = Y2
  162. 10    CONTINUE
  163.       X1 = S1
  164.       X2 = S2
  165.       CALL ScrLck(.FALSE.)
  166.       END
  167.