home *** CD-ROM | disk | FTP | other *** search
/ Microsoft Programmer's Library 1.3 / Microsoft-Programers-Library-v1.3.iso / sampcode / fortran / graph.for < prev    next >
Encoding:
Text File  |  1988-08-11  |  1.3 KB  |  67 lines
  1.     INTERFACE TO INTEGER[C] FUNCTION getmod[C]
  2.     END
  3. C
  4. C
  5.     INTERFACE TO SUBROUTINE init[C](num)
  6.     INTEGER[C] num
  7.     END
  8. C
  9. C
  10.     INTERFACE TO SUBROUTINE setbck[C](num)
  11.     INTEGER[C] num
  12.     END
  13. C
  14. C
  15.     INTERFACE TO SUBROUTINE palett[C](num)
  16.     INTEGER[C] num
  17.     END
  18. C
  19. C
  20.     INTERFACE TO SUBROUTINE circle[C](x, y, rad, col)
  21.     INTEGER[C] x, y, rad, col
  22.     END
  23. C
  24. C
  25. C    Change "back" between 1 and 15 and "pal" between 0 and 1 to
  26. C    get different results.
  27. C
  28.     PROGRAM graph
  29.     INTEGER[C] back/0/,pal/1/, imode, mode/4/, getmod
  30.     INTEGER xmax/320/, ymax/200/, radmax/18/, xcenter/160/
  31.     INTEGER y, xoff, radius, color, bumps/2/
  32.     INTEGER xoffs(4)/0, 46, 92, 140/
  33.     REAL pi
  34.     PARAMETER (pi = 3.141569265)
  35.     imode = getmod()
  36.     CALL init(mode)
  37.     CALL setbck(back)
  38.     CALL palett(pal)
  39.     DO 30 i = 1, 3
  40.         DO 20 y = 1, ymax
  41.             r      = (REAL(y)/ymax)*pi*bumps
  42.             x      = SIN(r)
  43.             radius = radmax * ABS(x)
  44.             DO 10 j = 1, 4
  45.                     xoff  = xoffs(j) * x
  46.                     color = MOD(j+i-1, 3)+1
  47.                     CALL mirror(xcenter, xoff, y, radius, color)
  48. 10            CONTINUE
  49. 20        CONTINUE
  50. 30    CONTINUE
  51.     DO 40 j = 1,300000
  52.         CALL timer
  53. 40    CONTINUE
  54.     CALL init(imode)
  55.     END
  56. C
  57. C
  58.     SUBROUTINE mirror(xcenter, xoff, y, radius, color)
  59.     IMPLICIT INTEGER (a-z) 
  60.     CALL circle(xcenter+xoff, y, radius, color)
  61.     CALL circle(xcenter-xoff, y, radius, color)
  62.     END
  63. C
  64. C
  65.     SUBROUTINE timer
  66.     END
  67.