home *** CD-ROM | disk | FTP | other *** search
/ Vectronix 2 / VECTRONIX2.iso / FILES_01 / P_FOTRAN.LZH / DEMOS.FOR / LINEA.FOR < prev    next >
Text File  |  1987-12-31  |  3KB  |  103 lines
  1. *     This demonstrates the use of the line A routines to draw simple
  2. *     lines, without the complexity of the GEM VDI
  3. *
  4. *     Date: 29 Oct 1987
  5. *     Copyright (c) 1987 Prospero Software
  6. *
  7.  
  8.       PROGRAM lineAdemo
  9.       INTEGER*2 fillpattern(0:7)
  10.  
  11.       CALL line(100,100,100,200)
  12.       CALL line(100,200,200,200)
  13.       CALL line(200,200,200,100)
  14.       CALL line(200,100,100,100)
  15.  
  16.       fillpattern(0) = $0101
  17.       DO 10 i = 1,7
  18.         fillpattern(i) = fillpattern(i-1) * 2 
  19. 10    CONTINUE
  20.  
  21.       CALL rect(101, 101, 199, 199, fillpattern, 7)
  22.  
  23.       CALL point(50, 50, 1)
  24.       END
  25.  
  26. *-------------------------------------------------------------------
  27. *
  28. *     SUBROUTINE line uses the A003 trap to draw a line
  29. *
  30. *-------------------------------------------------------------------
  31.       
  32.       SUBROUTINE line(x1, y1, x2, y2)
  33.       INTEGER x1, x2, y1, y2
  34.  
  35.       INTEGER*4 regs(0:14), ptr
  36.       EQUIVALENCE (ptr, regs(8))
  37.       
  38.       CALL a000(regs)                     ! Initialise Line A
  39.  
  40. *     Set up values in Line A variable area
  41.       
  42.       CALL poke2(ptr+38, x1)
  43.       CALL poke2(ptr+40, y1)
  44.       CALL poke2(ptr+42, x2)
  45.       CALL poke2(ptr+44, y2)
  46.  
  47.       CALL a003(regs)                     ! Draw a line
  48.       END
  49.  
  50. *-------------------------------------------------------------------
  51. *
  52. *     SUBROUTINE rect uses the A005 trap to draw a rectangle, using
  53. *     the fill pattern given by the array maskarray, which contains
  54. *     repeat number of INTEGER*2 values
  55. *
  56. *-------------------------------------------------------------------
  57.  
  58.       SUBROUTINE rect(x1, y1, x2, y2, maskarray, repeat)
  59.       INTEGER x1, x2, y1, y2, repeat
  60.       INTEGER*2 maskarray(0:repeat)
  61.  
  62.       INTEGER*4 regs(0:14), ptr
  63.       EQUIVALENCE (ptr, regs(8))
  64.       
  65.       CALL a000(regs)                     ! Initialise Line A
  66.  
  67. *     Set up values in Line A variable area
  68.       
  69.       CALL poke2(ptr+38, x1)               ! _X1 field
  70.       CALL poke2(ptr+40, y1)               ! _Y1
  71.       CALL poke2(ptr+42, x2)               ! _X2
  72.       CALL poke2(ptr+44, y2)               ! _Y2
  73.       CALL poke4(ptr+46, iaddr(maskarray)) ! _patptr
  74.       CALL poke2(ptr+50, repeat)           ! _patmsk
  75.  
  76.       CALL a005(regs)                     ! Draw a rectangle
  77.       END
  78.  
  79. *-------------------------------------------------------------------
  80. *
  81. *     SUBROUTINE point uses the A001 trap to plot a pixel to a given
  82. *     colour
  83. *
  84. *-------------------------------------------------------------------
  85.  
  86.       SUBROUTINE point(x, y, colour)
  87.       INTEGER x, y, intin, ptsin, colour
  88.  
  89.       INTEGER*4 regs(0:14), ptr
  90.       EQUIVALENCE (ptr, regs(8))
  91.       
  92.       CALL a000(regs)                     ! Initialise Line A
  93.  
  94.       intin = ipeek4(ptr+8)
  95.       ptsin = ipeek4(ptr+12)
  96.       CALL poke2(ptsin, x)
  97.       CALL poke2(ptsin+2, y)
  98.       CALL poke2(intin, colour)
  99.  
  100.       CALL A001
  101.       END
  102.       
  103.