home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / MADTRB16.ZIP / DOMES.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1986-02-06  |  5.1 KB  |  159 lines
  1. PROGRAM geodesic(INPUT,OUTPUT);
  2.   {
  3.          On an IBM PC this Turbo Pascal 3.0 program constructs several
  4.     geodesic domes.
  5.  
  6.          Written by James L. Dean
  7.                     406 40th Street
  8.                     New Orleans, LA 70124
  9.   }
  10.   TYPE
  11.     point_ptr=^point;
  12.     point=RECORD
  13.              x     :  REAL;
  14.              y     :  REAL;
  15.              z     :  REAL;
  16.              next  :  point_ptr
  17.           END;
  18.   CONST
  19.     column_if_x_equals_0 = 320.0;
  20.     columns_per_x = 168.0;
  21.     number_of_iterations=4;
  22.     row_if_y_equals_0 = 99.0;
  23.     rows_per_y = -80.0;
  24.   VAR
  25.     iteration_number
  26.                    : INTEGER;
  27.     head_point_ptr,
  28.     tail_point_ptr
  29.                    : point_ptr;
  30.     distance_between_adjacent_vertices
  31.                    : REAL;
  32.   PROCEDURE set_up_icosahedron(
  33.    VAR head_point_ptr : point_ptr;
  34.    VAR tail_point_ptr : point_ptr);
  35.     TYPE
  36.       vertices = ARRAY [1..12,1..3] OF REAL;
  37.     CONST
  38.       icosahedron : vertices =
  39.        (( 0.000, 0.000,-1.000),( 0.000, 0.892,-0.452),( 0.848, 0.276,-0.452),
  40.         ( 0.524,-0.721,-0.452),(-0.524,-0.721,-0.452),(-0.848, 0.276,-0.452),
  41.         ( 0.524, 0.721, 0.452),( 0.848,-0.276, 0.452),( 0.000,-0.892, 0.452),
  42.         (-0.848,-0.276, 0.452),(-0.524, 0.721, 0.452),( 0.000, 0.000, 1.000));
  43.     VAR
  44.       vertex_number
  45.                   : INTEGER;
  46.       current_point_ptr,
  47.       previous_point_ptr
  48.                   : point_ptr;
  49.     BEGIN
  50.       NEW(head_point_ptr);
  51.       head_point_ptr^.x:=icosahedron[1,1];
  52.       head_point_ptr^.y:=icosahedron[1,2];
  53.       head_point_ptr^.z:=icosahedron[1,3];
  54.       previous_point_ptr:=head_point_ptr;
  55.       FOR vertex_number:=2 TO 12 DO
  56.         BEGIN
  57.           NEW(current_point_ptr);
  58.           previous_point_ptr^.next:=current_point_ptr;
  59.           current_point_ptr^.x:=icosahedron[vertex_number,1];
  60.           current_point_ptr^.y:=icosahedron[vertex_number,2];
  61.           current_point_ptr^.z:=icosahedron[vertex_number,3];
  62.           previous_point_ptr:=current_point_ptr
  63.         END;
  64.       tail_point_ptr:=previous_point_ptr;
  65.       tail_point_ptr^.next:=NIL
  66.     END;
  67.   PROCEDURE draw_a_dome(
  68.    VAR head_point_ptr : point_ptr;
  69.    VAR tail_point_ptr : point_ptr;
  70.    VAR distance_between_adjacent_vertices : REAL);
  71.     VAR
  72.       pause
  73.               : CHAR;
  74.       column_1,
  75.       column_2,
  76.       row_1,
  77.       row_2
  78.               : INTEGER;
  79.       new_point_ptr_1,
  80.       new_point_ptr_2,
  81.       old_point_ptr_1,
  82.       old_point_ptr_2
  83.               : point_ptr;
  84.       distance_between_vertices_squared,
  85.       magnitude,
  86.       x1,
  87.       x2,
  88.       y1,
  89.       y2,
  90.       z1,
  91.       z2
  92.               : REAL;
  93.     BEGIN
  94.       HIRES;
  95.       HIRESCOLOR(WHITE);
  96.       WRITELN(OUTPUT,'         Geodesic Domes');
  97.       old_point_ptr_1:=head_point_ptr;
  98.       new_point_ptr_1:=tail_point_ptr;
  99.       WHILE (old_point_ptr_1 <> tail_point_ptr) DO
  100.         BEGIN
  101.           x1:=old_point_ptr_1^.x;
  102.           y1:=old_point_ptr_1^.y;
  103.           z1:=old_point_ptr_1^.z;
  104.           IF z1 >= 0.0 THEN
  105.             BEGIN
  106.               column_1:=TRUNC(columns_per_x*x1+column_if_x_equals_0);
  107.               row_1:=TRUNC(rows_per_y*y1+row_if_y_equals_0)
  108.             END;
  109.           old_point_ptr_2:=old_point_ptr_1;
  110.           REPEAT
  111.             old_point_ptr_2:=old_point_ptr_2^.next;
  112.             x2:=old_point_ptr_2^.x;
  113.             y2:=old_point_ptr_2^.y;
  114.             z2:=old_point_ptr_2^.z;
  115.             distance_between_vertices_squared
  116.              :=SQR(x2-x1)+SQR(y2-y1)+SQR(z2-z1);
  117.             IF distance_between_vertices_squared
  118.              <= SQR(distance_between_adjacent_vertices) THEN
  119.               BEGIN
  120.                 IF ((z1 >= 0.0) AND (z2 >= 0.0)) THEN
  121.                   BEGIN
  122.                     column_2
  123.                      :=TRUNC(columns_per_x*x2+column_if_x_equals_0);
  124.                     row_2
  125.                      :=TRUNC(rows_per_y*y2+row_if_y_equals_0);
  126.                     Draw(column_1,row_1,column_2,row_2,1)
  127.                   END;
  128.                 x2:=(x2+x1)/2.0;
  129.                 y2:=(y2+y1)/2.0;
  130.                 z2:=(z2+z1)/2.0;
  131.                 magnitude:=SQRT(x2*x2+y2*y2+z2*z2);
  132.                 NEW(new_point_ptr_2);
  133.                 new_point_ptr_2^.x:=x2/magnitude;
  134.                 new_point_ptr_2^.y:=y2/magnitude;
  135.                 new_point_ptr_2^.z:=z2/magnitude;
  136.                 new_point_ptr_1^.next:=new_point_ptr_2;
  137.                 new_point_ptr_1:=new_point_ptr_2
  138.              END
  139.           UNTIL
  140.             (old_point_ptr_2 = tail_point_ptr);
  141.           old_point_ptr_1:=old_point_ptr_1^.next
  142.         END;
  143.       tail_point_ptr:=new_point_ptr_1;
  144.       tail_point_ptr^.next:=NIL;
  145.       distance_between_adjacent_vertices
  146.        :=distance_between_adjacent_vertices/2.0;
  147.       GotoXY(1,24);
  148.       WRITE(OUTPUT,'Press RETURN to continue.');
  149.       READLN(INPUT,pause)
  150.     END;
  151.   BEGIN
  152.     set_up_icosahedron(head_point_ptr,tail_point_ptr);
  153.     distance_between_adjacent_vertices:=1.5;
  154.     FOR iteration_number:=1 TO number_of_iterations DO
  155.      draw_a_dome(head_point_ptr,tail_point_ptr,
  156.       distance_between_adjacent_vertices);
  157.     TextMode
  158.   END.
  159.