home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 10 / 10.iso / l / l292 / 1.ddi / HIDELINE.FOR < prev    next >
Encoding:
Text File  |  1990-01-23  |  2.7 KB  |  103 lines
  1.       INCLUDE 'GRAFTYPE.FOR'
  2.       RECORD /WorldRect/  wr
  3.       RECORD /point3d/ contourMap(-15 : 15, -15 : 15)
  4.       COMMON /Map/ contourmap
  5.       INTEGER  i
  6.  
  7.  
  8.       CALL createFunction
  9.       CALL tInit3
  10.       CALL Init3D(-1, 'c:\FOR\LIB\*.FON')
  11.       CALL SetWorldRect(wr, -10.0, -10.0, 10.0, 10.0)
  12.       CALL SetWorldCoordinates(wr)
  13.       CALL WorldRotate3(20.0, 0)
  14.       CALL WorldRotate3(-45.0, 1)
  15.       CALL SelectColor (15)
  16.       DO i = 0, 4
  17.         CALL ClearViewportXX
  18.         CALL SelectColor(i + 1)
  19.         SELECT CASE (i)
  20.           CASE (0)
  21.            CALL Draw3DAxes(10.0, 10.0, 10.0)
  22.  
  23.           CASE (1)
  24.           CALL WorldScale3(.5, .5, .5)
  25.            CALL Draw3DAxes(10.0, 10.0, 10.0)
  26.  
  27.          CASE (2)
  28.           CALL WorldScale3(2.0, 2.0, 2.0)
  29.           CALL WorldRotate3(-40.0, 0)
  30.           CALL Draw3DAxes(10.0, 10.0, 10.0)
  31.          CASE (3)
  32.           CALL WorldRotate3(40.0, 0)
  33.           CALL WorldTran3(4.0, 3.0, 2.0)
  34.           CALL Draw3DAxes(10.0, 10.0, 10.0)
  35.          CASE (4)
  36.           CALL WorldTran3(-4.0, -3.0, -2.0)
  37.           CALL Persp(20.0)
  38.           CALL Draw3DAxes(10.0, 10.0, 10.0)
  39.         END SELECT
  40.         CALL DrawFunction
  41.         READ (*,*)
  42.       END DO
  43.  
  44.       CALL Close3DGraphics
  45.  
  46.       END
  47.  
  48.  
  49.  
  50.       SUBROUTINE createFunction
  51.       INCLUDE 'GRAFTYPE.FOR'
  52.       INTEGER  i,j
  53.       REAL x, y, z
  54.       RECORD /point3d/ contourMap(-15 : 15, -15 : 15)
  55.       COMMON /Map/ contourmap
  56.  
  57.       DO i = -15, 15
  58.         x = REAL(i) / 2.0
  59.         DO  j = -15, 15
  60.           z = REAL(j) / 2.0
  61.           y = 3.0 * SIN(SQRT(x ** 2 + z ** 2))
  62.           contourMap(i, j).x = x
  63.           contourMap(i, j).y = y
  64.           contourMap(i, j).z = z
  65.         END DO
  66.       END DO
  67.       END !SUB
  68.  
  69.       SUBROUTINE DrawFunction()
  70.       INCLUDE 'GRAFTYPE.FOR'
  71.       INTEGER  i, j
  72.       RECORD /point3D/ pv(0 : 5)
  73.       RECORD /point3d/ contourMap(-15 : 15, -15 : 15)
  74.       COMMON /Map/ contourmap
  75.  
  76.       DO j = -14,  15
  77.         DO i = -14, 15
  78.           pv(0).x = contourMap(i - 1, j - 1).x
  79.           pv(0).y = contourMap(i - 1, j - 1).y
  80.           pv(0).z = contourMap(i - 1, j - 1).z
  81.  
  82.           pv(1).x = contourMap(i, j - 1).x
  83.           pv(1).y = contourMap(i, j - 1).y
  84.           pv(1).z = contourMap(i, j - 1).z
  85.  
  86.           pv(2).x = contourMap(i, j).x
  87.           pv(2).y = contourMap(i, j).y
  88.           pv(2).z = contourMap(i, j).z
  89.  
  90.           pv(3).x = contourMap(i - 1, j).x
  91.           pv(3).y = contourMap(i - 1, j).y
  92.           pv(3).z = contourMap(i - 1, j).z
  93.  
  94.           pv(4).x = contourMap(i - 1, j - 1).x
  95.           pv(4).y = contourMap(i - 1, j - 1).y
  96.           pv(4).z = contourMap(i - 1, j - 1).z
  97.  
  98.           CALL PolyFill3D(pv, 1, 0, 5)
  99.         END DO
  100.       END DO
  101.       END !SUBROUTINE
  102.  
  103.