home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / MBUG / MBUG013.ARC / SIERPIN3.PAS < prev    next >
Pascal/Delphi Source File  |  1979-12-31  |  3KB  |  124 lines
  1. program SIERPIN3;
  2.  
  3. {  Demonstration program in Turbo Pascal for
  4.          the MicroBee by Bob Burt
  5.  
  6.    Program to set up  PCG on the MicroBee for
  7.    LORES graphics and  PLOT between any  pair
  8.    of x,y coordinates, assuming a screen with
  9.    80 x 24 format. This version operates with
  10.    a plot routine using  integer variables to
  11.    speed up  the  plotting  rate,  but with a
  12.    real variable option  for the x coordinate
  13.    to cover values above 128
  14.  
  15.    Since the  4th  order  width (w) is not an
  16.    integer, only  3 orders  are permitted for
  17.    this version
  18.  
  19.        x coordinate range: 0 to 159
  20.        y coordinate range: 0 to 71
  21.        0,0 at top left of screen
  22.  
  23.   IMPORTANT :  Compiler switch A  must be set
  24.   to  negative  for  the RECURSIVE procedures
  25.             and MAIN code ONLY !               }
  26.  
  27. {$C-}
  28.  
  29. const
  30.   w0 = 160; h0 = 64;
  31.   title = '*** Sierpinski Curves ***';
  32.  
  33. var
  34.   i,n : byte;
  35.   h,w,t1,t2,x,x0,y,y0 : byte;
  36.  
  37. {$I normal.pro}
  38. {$I lores80.pro}
  39. {$I draw.pro}
  40. {$I ploti2.pro}
  41.  
  42. {$A-}
  43.  
  44. procedure B(i : byte); forward;
  45.  
  46. procedure C(i : byte); forward;
  47.  
  48. procedure D(i : byte); forward;
  49.  
  50. procedure A(i : byte);
  51. begin if i > 0 then
  52.   begin
  53.     A(i - 1); t1 := x+w; t2 := y-h; plot(x,y,t1,t2); x := t1; y := t2;
  54.     B(i - 1); t1 := x+2*w; plot(x,y,t1,y); x := t1;
  55.     D(i - 1); t1 := x+w; t2 := y+h; plot(x,y,t1,t2); x := t1; y := t2;
  56.     A(i - 1)
  57.   end
  58. end; {A(i)}
  59.  
  60. procedure B;
  61. begin if i > 0 then
  62.   begin
  63.     B(i - 1); t1 := x-w; t2 := y-h; plot(x,y,t1,t2); x := t1; y := t2;
  64.     C(i - 1); t2 := y-2*h; plot(x,y,x,t2); y := t2;
  65.     A(i - 1); t1 := x+w; t2 := y-h; plot(x,y,t1,t2); x := t1; y := t2;
  66.     B(i - 1)
  67.   end
  68. end; {B(i)}
  69.  
  70. procedure C;
  71. begin if i > 0 then
  72.   begin
  73.     C(i - 1); t1 := x-w; t2 := y+h; plot(x,y,t1,t2); x := t1; y := t2;
  74.     D(i - 1); t1 := x-2*w; plot(x,y,t1,y); x := t1;
  75.     B(i - 1); t1 := x-w; t2 := y-h; plot(x,y,t1,t2); x := t1; y := t2;
  76.     C(i - 1)
  77.   end
  78. end; {C(i)}
  79.  
  80. procedure D;
  81. begin if i > 0 then
  82.   begin
  83.     D(i - 1); t1 := x+w; t2 := y+h; plot(x,y,t1,t2); x := t1; y := t2;
  84.     A(i - 1); t2 := y+2*h; plot(x,y,x,t2); y := t2;
  85.     C(i - 1); t1 := x-w; t2 := y+h; plot(x,y,t1,t2); x := t1; y := t2;
  86.     D(i - 1)
  87.   end
  88. end; {D(i)}
  89.  
  90. begin {main}
  91.   clrscr;
  92.   gotoxy(22,8);
  93.   writeln(title);
  94.   repeat
  95.     gotoxy(10,11);
  96.     write(^G,'What order of Curve do you require (1 to 3 only) : ');
  97.     readln(n)
  98.   until (n > 0) and (n < 4);
  99.   gotoxy(53,24); {establish cursor position clear of graphics}
  100.   i := 0; h := h0 div 4; w := w0 div 4; x0 := 2*w; y0 := 3*h;
  101.   lores80;
  102.   plot(0,0,159,0);     {plot frame}
  103.   plot(0,63,159,63);
  104.   plot(0,1,0,62);
  105.   plot(159,1,159,62);
  106.   repeat
  107.     i := i + 1; x0 := x0 - w;
  108.     h := h div 2; w := w div 2; y0 := y0 + h;
  109.     x := x0; y := y0;
  110.     A(i); t1 := x+w; t2 := y-h; plot(x,y,t1,t2); x := t1; y := t2;
  111.     B(i); t1 := x-w; t2 := y-h; plot(x,y,t1,t2); x := t1; y := t2;
  112.     C(i); t1 := x-w; t2 := y+h; plot(x,y,t1,t2); x := t1; y := t2;
  113.     D(i); t1 := x+w; t2 := y+h; plot(x,y,t1,t2); x := t1; y := t2;
  114.   until i = n;
  115.   gotoxy(28,24);
  116.   write(title);
  117.   repeat until keypressed;
  118.   clrscr;  {replace chr(128) with chr(32)}
  119.   normal;
  120.   writeln(^G)
  121. end. {main}
  122.  
  123.  
  124.