home *** CD-ROM | disk | FTP | other *** search
/ Crawly Crypt Collection 2 / crawlyvol2.bin / program / pascal / passrc / mount2.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1985-11-18  |  9.3 KB  |  304 lines
  1. { -----------------------------------------------------------------------------
  2.  
  3.                                  NOTICE:
  4.  
  5.       THESE MATERIALS are UNSUPPORTED by OSS!  If you do not understand how to
  6.       use them do not contact OSS for help!  We will not teach you how to 
  7.       program in Pascal.  If you find an error in these materials, feel free
  8.       to SEND US A LETTER explaining the error, and how to fix it.
  9.  
  10.       THE BOTTOM LINE:
  11.  
  12.          Use it, enjoy it, but you are on your own when using these materials!
  13.  
  14.  
  15.                                DISCLAIMER:
  16.  
  17.       OSS makes no representations or warranties with respect to the contents
  18.       hereof and specifically disclaim all warranties of merchantability or
  19.       fitness for any particular purpose.   This document is subject to change
  20.       without notice.
  21.       
  22.       OSS provides these materials for use with Personal Pascal.  Use them in
  23.       any way you wish.
  24.  
  25.    -------------------------------------------------------------------------- }
  26.  
  27.  
  28. PROGRAM mountain2;
  29.  
  30. { This program is supposed to draw "Mandelbrot" shapes that resemble }
  31. { mountains.     This is done by starting with a triangle figure and }
  32. { successively subdividing (randomly spaced) the sides. These points }
  33. { are then joined to form four smaller triangles within the original }
  34. { one.  The process is repeated for each of these four triangles and }
  35. { onto the next step of transformation.....                          }
  36.  
  37. {      Original Pascal program written by: John O'Neill              }
  38. {     Translated to C for the Atari ST by: Bob Ritter (Nov. 1985)    }
  39. {     Translated back to Pascal(!) by Mark Rose -- 24 April, 1986    }
  40. {       (sorry, but the C version didn't have many comments and I    }
  41. {        didn't have time to explain everything!)                    }
  42.  
  43.   CONST
  44.     {$I gemconst.pas}
  45.  
  46.     num_steps = 7;      { That's all we can generate with our array size! }
  47.     two_pi = 6.2631853;
  48.  
  49.   TYPE
  50.     {$I gemtype.pas}
  51.  
  52.     tree_rec = RECORD
  53.                  locx, locy, left, right: integer;
  54.                END;
  55.  
  56.   VAR
  57.     mtree: ARRAY[ 0..3999 ] OF tree_rec;
  58.     step: integer;
  59.     go_left: boolean;
  60.     i, c, num_trees: integer;
  61.     s, line_str: str255;
  62.     scale: real; (* Was 0.22 in original version *)
  63.     junk: integer;
  64.  
  65.   {$I gemsubs.pas}
  66.  
  67.   FUNCTION random: real;
  68.  
  69.     CONST
  70.       max_random = 16777215;    { 2^24 - 1 }
  71.  
  72.     FUNCTION irandom: long_integer;
  73.       XBIOS( 17 );
  74.  
  75.     BEGIN
  76.       random := irandom / max_random;
  77.     END;
  78.  
  79.  
  80.  
  81.   PROCEDURE str( n: integer; VAR s: str255 );
  82.  
  83.     VAR
  84.       digit,            { Holds each digit value of 'n' as it is created }
  85.       divisor,          { Division by this is used to find each digit }
  86.       i: integer;       { Index in string at which to put next character }
  87.       leading: boolean; { True, if the next digit will be the leading digit }
  88.  
  89.     BEGIN { str - main routine }
  90.       s := '     0';
  91.       i := 0;           { Start at the beginning of the string }
  92.       IF n < 0 THEN     { If the number is negative, add a minus sign }
  93.         BEGIN
  94.           s[1] := '-';
  95.           n := -n;
  96.         END;
  97.       divisor := 10000;
  98.       leading := true;
  99.       FOR i := 2 TO 6 DO
  100.         BEGIN
  101.           digit := n DIV divisor;
  102.           IF (digit <> 0) OR NOT( leading ) THEN
  103.             BEGIN
  104.               s[i] := chr(digit + ord('0'));
  105.               leading := false;
  106.             END;
  107.           n := n MOD divisor;
  108.           divisor := divisor DIV 10;
  109.         END;
  110.     END;
  111.  
  112.  
  113.  
  114.   { wait_button - Wait for the user to press the mouse button.  Return with the
  115.       X and Y position where it was pressed. }
  116.  
  117.   PROCEDURE wait_button( VAR x, y: integer );
  118.  
  119.     VAR
  120.       junk: integer;
  121.       msg: Message_Buffer;
  122.  
  123.     BEGIN
  124.       junk := Get_Event( E_Button, 1, 1, 1, 0,
  125.                         false, 0, 0, 0, 0, false, 0, 0, 0, 0,
  126.                         msg, junk, junk, junk, x, y, junk );
  127.       junk := Get_Event( E_Button, 1, 0, 1, 0,
  128.                         false, 0, 0, 0, 0, false, 0, 0, 0, 0,
  129.                         msg, junk, junk, junk, junk, junk, junk );
  130.     END;
  131.  
  132.  
  133.  
  134.   { setup - Get the scale and first three points from user.  These form the
  135.       first triangle in the deformation. }
  136.  
  137.   PROCEDURE setup;
  138.  
  139.     VAR
  140.       junk, mx1, my1, mx2, my2, mx3, my3: integer;
  141.  
  142.     BEGIN
  143.       { Set the system up to do GEM calls}
  144.       junk := Init_Gem;
  145.  
  146.       Hide_Mouse;
  147.       Clear_Screen;
  148.       Show_Mouse;
  149.       Set_Mouse( M_Point_Hand );
  150.       Draw_String( 16, 15, 'Choose desired scale:' );
  151.       Draw_String( 16, 50, '0' );
  152.       Draw_String( 215, 50, '1' );
  153.       Line( 23, 52, 215, 52 );
  154.       wait_button( mx1, my1 );
  155.       IF mx1 < 16 THEN mx1 := 16;
  156.       IF mx1 > 215 THEN mx1 := 215;
  157.       scale := (mx1-16) / 200;
  158.  
  159.       Hide_Mouse;
  160.       Clear_Screen;
  161.       Show_Mouse;
  162.       Set_Mouse( M_Thin_Cross );
  163.  
  164.       Draw_String( 16, 15, 'Click the mouse on the 3 starting co-ordinates.' );
  165.       Wait_Button( mx1, my1 );
  166.       Wait_Button( mx2, my2 );
  167.       Hide_Mouse;
  168.       Line( mx1, my1, mx2, my2 );
  169.       Show_Mouse;
  170.       Wait_Button( mx3, my3 );
  171.       Hide_Mouse;
  172.       Line( mx2, my2, mx3, my3 );
  173.       Line( mx3, my3, mx1, my1 );
  174.       Show_Mouse;
  175.       Set_Mouse( M_Arrow );
  176.  
  177.       num_trees := 2;  { well, really it's one more... }
  178.       mtree[0].left  := 1;
  179.       mtree[0].right := 2;
  180.       mtree[1].left  := 0;
  181.       mtree[1].right := 0;
  182.       mtree[2].left  := 0;
  183.       mtree[2].right := 0;
  184.       mtree[0].locx := mx1;
  185.       mtree[0].locy := my1;
  186.       mtree[1].locx := mx2;
  187.       mtree[1].locy := my2;
  188.       mtree[2].locx := mx3;
  189.       mtree[2].locy := my3;
  190.     END;
  191.  
  192.  
  193.  
  194.   { midpoint - Deform the midpoint of a line segment, and put the new point
  195.       into the position 'mp' in the tree. }
  196.  
  197.   PROCEDURE midpoint( mp, x1, y1, x2, y2: integer );
  198.  
  199.     VAR
  200.       dx, dy, length, radius, angle: real;
  201.  
  202.     BEGIN
  203.       dx := x2 - x1;
  204.       dy := y2 - y1;
  205.       length := sqrt( dx*dx + dy*dy );
  206.       radius := length * scale * random;
  207.       angle := two_pi * random;
  208.       mtree[mp].locx := round( (x1+x2)/2 );
  209.       { This code is deleted: + cos(angle) * radius ); -- We now only deform
  210.         the midpoint in the y axis.  This makes the resulting mountain look
  211.         better -- MER }
  212.       mtree[mp].locy := round( (y1+y2)/2 + sin(angle) * radius );
  213.     END;
  214.  
  215.  
  216.  
  217.   { transform - Compute the next iteration of the tree of mountain vertices.
  218.       Each current triangle is subdivided into 4 new triangles, slightly
  219.       deformed. }
  220.  
  221.   PROCEDURE transform( node: integer );
  222.  
  223.     BEGIN
  224.       IF go_left AND (mtree[mtree[node].left].left <> 0) THEN
  225.          transform( mtree[node].left );
  226.       go_left := false;
  227.       IF mtree[mtree[node].right].right <> 0 THEN
  228.         transform( mtree[node].right );
  229.       str( c, s );
  230.       Draw_String( 32, 32, s );
  231.       c := c - 1;
  232.       midpoint( num_trees+1, mtree[node].locx, mtree[node].locy,
  233.                 mtree[mtree[node].left].locx, mtree[mtree[node].left].locy );
  234.       midpoint( num_trees+2,
  235.                 mtree[mtree[node].left].locx, mtree[mtree[node].left].locy,
  236.                 mtree[mtree[node].right].locx, mtree[mtree[node].right].locy );
  237.       midpoint(num_trees+3, mtree[node].locx, mtree[node].locy,
  238.                 mtree[mtree[node].right].locx, mtree[mtree[node].right].locy );
  239.       mtree[num_trees+1].left  := mtree[node].left;
  240.       mtree[num_trees+1].right := num_trees + 2;
  241.       mtree[num_trees+3].left  := num_trees + 2;
  242.       mtree[num_trees+3].right := mtree[node].right;
  243.       mtree[num_trees+2].left  := mtree[mtree[node].left].right;
  244.       mtree[num_trees+2].right := mtree[mtree[node].right].left;
  245.       mtree[node].left  := num_trees + 1;
  246.       mtree[node].right := num_trees + 3;
  247.       num_trees := num_trees + 3;
  248.     END;
  249.  
  250.  
  251.  
  252.   { display - Show the current iteration of the mountain. }
  253.  
  254.   PROCEDURE display( node: integer );
  255.  
  256.     BEGIN
  257.       IF go_left AND (mtree[mtree[node].left].left <> 0) THEN
  258.         display( mtree[node].left );
  259.       go_left := false;
  260.       IF mtree[mtree[node].right].right <> 0 THEN
  261.         display( mtree[node].right );
  262.       Line( mtree[node].locx, mtree[node].locy,
  263.                 mtree[mtree[node].left].locx, mtree[mtree[node].left].locy );
  264.       Line( mtree[mtree[node].left].locx, mtree[mtree[node].left].locy,
  265.                 mtree[mtree[node].right].locx, mtree[mtree[node].right].locy );
  266.       Line( mtree[mtree[node].right].locx, mtree[mtree[node].right].locy,
  267.                 mtree[node].locx, mtree[node].locy );
  268.     END;
  269.  
  270.  
  271.  
  272.   { main routine! }
  273.  
  274.   BEGIN
  275.     line_str := 'Step:        Number of points:      ';
  276.     setup;
  277.     go_left := true;
  278.     Hide_Mouse;
  279.     display( 0 );
  280.     Show_Mouse;
  281.     wait_button( junk, junk );
  282.     FOR step := 2 TO num_steps DO
  283.       BEGIN
  284.         go_left := true;
  285.         c := num_trees;
  286.         transform( 0 );
  287.         go_left := true;
  288.         Hide_Mouse;
  289.         Clear_Screen;
  290.         Show_Mouse;
  291.         str( step, s );
  292.         FOR i := 1 TO length(s) DO
  293.           line_str[5+i] := s[i];
  294.         str(num_trees+1, s );
  295.         FOR i := 1 TO length(s) DO
  296.           line_str[30+i] := s[i];
  297.         Hide_Mouse;
  298.         Draw_String( 75, 15, line_str );
  299.         display( 0 );
  300.         Show_Mouse;
  301.         wait_button( junk, junk );
  302.       END;
  303.   END.
  304.