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