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 / SIERPIN2.PAS < prev    next >
Pascal/Delphi Source File  |  1979-12-31  |  3KB  |  119 lines
  1. program SIERPIN2;
  2.  
  3. {  Demonstration program in Turbo Pascal for
  4.       the MicroBee developed 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 which then
  12.    limits the maximum coordinate value to 128
  13.  
  14.        x coordinate range: 0 to 128
  15.        y coordinate range: 0 to 71
  16.        0,0 at top left of screen
  17.  
  18.   IMPORTANT :  Compiler switch A  must be set
  19.   to  negative  for  the RECURSIVE procedures
  20.            and MAIN code ONLY !                 }
  21.  
  22. {$C-}
  23.  
  24. const
  25.   w0 = 128; h0 = 64;
  26.   title = '*** Sierpinski Curves ***';
  27.  
  28. var
  29.   i,n : byte;
  30.   h,t1,t2,w,x,y,x0,y0 : integer;
  31.  
  32. {$I normal.pro}
  33. {$I lores80.pro}
  34. {$I draw.pro}
  35. {$I ploti.pro}
  36.  
  37. {$A-}
  38.  
  39. procedure B(i : byte); forward;
  40.  
  41. procedure C(i : byte); forward;
  42.  
  43. procedure D(i : byte); forward;
  44.  
  45. procedure A(i : byte);
  46. begin if i > 0 then
  47.   begin
  48.     A(i - 1); t1 := x+w; t2 := y-h; plot(x,y,t1,t2); x := t1; y := t2;
  49.     B(i - 1); t1 := x+2*w; plot(x,y,t1,y); x := t1;
  50.     D(i - 1); t1 := x+w; t2 := y+h; plot(x,y,t1,t2); x := t1; y := t2;
  51.     A(i - 1)
  52.   end
  53. end; {A(i)}
  54.  
  55. procedure B;
  56. begin if i > 0 then
  57.   begin
  58.     B(i - 1); t1 := x-w; t2 := y-h; plot(x,y,t1,t2); x := t1; y := t2;
  59.     C(i - 1); t2 := y-2*h; plot(x,y,x,t2); y := t2;
  60.     A(i - 1); t1 := x+w; t2 := y-h; plot(x,y,t1,t2); x := t1; y := t2;
  61.     B(i - 1)
  62.   end
  63. end; {B(i)}
  64.  
  65. procedure C;
  66. begin if i > 0 then
  67.   begin
  68.     C(i - 1); t1 := x-w; t2 := y+h; plot(x,y,t1,t2); x := t1; y := t2;
  69.     D(i - 1); t1 := x-2*w; plot(x,y,t1,y); x := t1;
  70.     B(i - 1); t1 := x-w; t2 := y-h; plot(x,y,t1,t2); x := t1; y := t2;
  71.     C(i - 1)
  72.   end
  73. end; {C(i)}
  74.  
  75. procedure D;
  76. begin if i > 0 then
  77.   begin
  78.     D(i - 1); t1 := x+w; t2 := y+h; plot(x,y,t1,t2); x := t1; y := t2;
  79.     A(i - 1); t2 := y+2*h; plot(x,y,x,t2); y := t2;
  80.     C(i - 1); t1 := x-w; t2 := y+h; plot(x,y,t1,t2); x := t1; y := t2;
  81.     D(i - 1)
  82.   end
  83. end; {D(i)}
  84.  
  85. begin {main}
  86.   clrscr;
  87.   gotoxy(22,8);
  88.   writeln(title);
  89.   repeat
  90.     gotoxy(10,11);
  91.     write(^G,'What order of Curve do you require (1 to 4 only) : ');
  92.     readln(n)
  93.   until (n > 0) and (n < 5);
  94.   gotoxy(45,24); {establish cursor position clear of graphics}
  95.   i := 0; h := h0 div 4; w := w0 div 4; x0 := 2*w; y0 := 3*h;
  96.   lores80;
  97.   plot(0,0,127,0);     {plot frame}
  98.   plot(128,0,128,64);
  99.   plot(127,64,0,64);
  100.   plot(0,64,0,0);
  101.   repeat
  102.     i := i + 1; x0 := x0 - w;
  103.     h := h div 2; w := w div 2; y0 := y0 + h;
  104.     x := x0; y := y0;
  105.     A(i); t1 := x+w; t2 := y-h; plot(x,y,t1,t2); x := t1; y := t2;
  106.     B(i); t1 := x-w; t2 := y-h; plot(x,y,t1,t2); x := t1; y := t2;
  107.     C(i); t1 := x-w; t2 := y+h; plot(x,y,t1,t2); x := t1; y := t2;
  108.     D(i); t1 := x+w; t2 := y+h; plot(x,y,t1,t2); x := t1; y := t2;
  109.   until i = n;
  110.   gotoxy(20,24);
  111.   write(title);
  112.   repeat until keypressed;
  113.   clrscr;  {replace chr(128) with chr(32)}
  114.   normal;
  115.   writeln(^G)
  116. end. {main}
  117.  
  118.  
  119.