home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / forth / compiler / fpc / source / l4p160.seq < prev    next >
Encoding:
Text File  |  1990-04-08  |  4.4 KB  |  144 lines
  1. \ Original Date: November 4, 1985
  2. \ Last Modified: January 2, 1989
  3. \ Author:        Jack W. Brown
  4. \ File name:     L4P16.SEQ
  5. \ Function:      Computes Area of a Polygon given the x,y
  6. \                coordinates of its verticies
  7.  
  8. \ The following mathematical algorithm is often used to
  9. \ determine the area of cross-section provided it can be
  10. \ represented adequately by a finite number of straight line
  11. \ segments (this is almost always possible).  The technique
  12. \ can also be applied to cross-sections with holes by moving
  13. \ around the hole in a counter clockwise direction and traversing
  14. \ to and from the hole along the same path.
  15.  
  16. \ The general algorithm.
  17.  
  18. \     p1 /---------\  p2        p1 = ( x1,y1 )
  19. \       /           \           p2 = ( x2,y2 )
  20. \      /             \  p3      p3 = ( x3,y3 )
  21. \     /              /          p4 = ( x4,y4 )
  22. \ p5 /--------------/ p4        p5 = ( x5,y5 )
  23. \
  24. \ AREA OF THE POLYGON =
  25. \ [(x1y5-x5y1)+(x2y1-x1y2)+(x3y2-x2y3)+(x4y3-x3y4)+(x5y4-x4y5)]/2
  26. \ In general:
  27. \            i=n
  28. \ AREA = 0.5*SUM [ x(i)y(i-1) - x(i-1)y(i) ]
  29. \            i=1
  30. \  where we define x0 to be x5 and y0 to be y5.
  31.  
  32. \ Example without a hole.
  33. \  X   Not drawn to scale!!
  34. \  |                              p1 = ( 8,4 )
  35. \  |                              p2 = ( 6,1 )
  36. \  |    p4 ----------- p1         p3 = ( 2,1 )
  37. \  |      /          /            p4 = ( 5,4 )
  38. \  |     /          /
  39. \  |    /          /
  40. \  | p3 -----------  p2
  41. \  |-----------------------Y
  42.  
  43. \ A = [(8*4-5*4)+(6*4-8*1)+(2*1-6*1)+(5*1-2*4)]/2 = 10.5
  44.  
  45.  
  46. \ Example of a polygon with a hole removed
  47. \ Sorry but the diagram below is not to scale.   units= centimeters
  48. \       Y
  49. \ p9 ---|-------------------------------- p1     p1 = (6,5)
  50. \    \  |   p5            p4            /        p2 = (2,0) = p8
  51. \     \ |     +----------+            /          p3 = (3,3) = p7
  52. \      \|     |cut out   |          /            p4 = (3,4)
  53. \       \     +----------+        /              p5 = (1,4)
  54. \       |\  p6         p7,p2    /                p6 = (1,3)
  55. \       | \                   /                  p7 = (3,3)
  56. \       |   \               /                    p8 = (2,0)
  57. \       |     \           /                      p9 = (-1,5)
  58. \       |       \       /
  59. \       |         \   /
  60. \       |          \/  p8,p2
  61. \    ---+-------------------------- X
  62. \
  63. \  Traverse outside clockwise and the cut out counter clockwise.
  64. \  A = [(6*5-(-1)*5)+(2*5-6*0)+(3*0-2*3)+(3*3-3*4)+(1*4-3*4)
  65. \                   +(1*4-1*3)+(3*3-1*3)+(2*3-3*0)+(-1*0-2*5)]/2
  66. \  A = 15.5 sq cm
  67.  
  68.  
  69. \ This should be replaced by the bullet proof version in the
  70. \ file JBINPUT.SEQ
  71. : #IN ( --  n )
  72.       QUERY  INTERPRET ;
  73.  
  74. CREATE X  102 ALLOT     \ Array for x coordinates
  75. CREATE Y  102 ALLOT     \ Array for y coordinates
  76.  
  77. VARIABLE  #POINTS       \ Number of points in polygon
  78. VARIABLE  AREA          \ Sum of the x(i)y(i-1) - x(i-1)y(i)
  79.  
  80. \ Fetch ith x component.
  81. : X@  ( i     x{i} ) 2* X + @ ;
  82.  
  83. \ Fetch ith y component.
  84. : Y@  ( i     y{i} ) 2* Y + @ ;
  85.  
  86. \ Store ith x component.
  87. : X!  ( x i     -- ) 2* X + ! ;
  88.  
  89. \ Store ith y component.
  90. : Y!  ( y i     -- ) 2* Y + ! ;
  91.  
  92. \ Move to the next tab stop.
  93. : TAB ( -- )
  94.          BEGIN  #OUT @ 8 MOD
  95.                IF SPACE ELSE EXIT THEN
  96.         AGAIN ;
  97.  
  98. \ Get number from keyboard.
  99. : GET#  ( --  n )
  100.          ASCII >  EMIT SPACE  #IN ;
  101.  
  102. \ Prompt and fetch number of data points.
  103. : GET_#POINTS  ( -- )
  104.         BEGIN
  105.         CR ." Enter number of data points. "
  106.         GET#  DUP 3 <
  107.         WHILE  CR ." You need at least 3 data points!"
  108.         REPEAT  50 MIN #POINTS ! ;
  109.  
  110.  
  111. \ Prompt and fetch all data points.
  112. : GET_DATA      ( -- )
  113.         CR CR ." Point " TAB ."   X" TAB ."   Y"
  114.         #POINTS @ 1+ 1
  115.         DO   CR I 3 .R  TAB GET# I X!
  116.              TAB GET# I Y! LOOP
  117.         #POINTS @ DUP X@ 0 X! Y@ 0 Y! ;  \ Store last point in 0th slot
  118.  
  119. \ Sum data points.
  120. : FIND_AREA   ( -- )
  121.         0 AREA !
  122.         #POINTS @ 1+  1         ( n+1 so we loop n times )
  123.         DO I    X@ I 1- Y@ *    ( X{i}*Y{i-1} )
  124.            I 1- X@ I    Y@ *    ( X{i-1}*Y{i} )
  125.            - AREA +!
  126.         LOOP  ;
  127.  
  128.  
  129. \ Display computed area.
  130. : PUT_AREA      ( -- )
  131.         AREA @ 2 /MOD
  132.         CR ." AREA = " 6 .R  ASCII . EMIT
  133.         IF ASCII 5 EMIT ELSE ASCII 0 EMIT THEN SPACE ;
  134.  
  135. \ Compute area of polygon.
  136. : POLY     ( -- )
  137.         GET_#POINTS
  138.         GET_DATA
  139.         FIND_AREA
  140.         PUT_AREA ;
  141.  
  142.  
  143.  
  144.