home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / mbug / mbug013.arc / HILBERT2.PAS < prev    next >
Pascal/Delphi Source File  |  1979-12-31  |  3KB  |  116 lines
  1. program HILBERT2;
  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 with integer variables - so
  11.    limiting the maximum acceptable coordinate
  12.    to 128.  Thus
  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 = '*** Hilbert Curves ***';
  27.  
  28. var
  29.   i,n : byte;
  30.   h,t,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.     D(i - 1); t := x-w; plot(x,y,t,y); x := t;
  49.     A(i - 1); t := y-h; plot(x,y,x,t); y := t;
  50.     A(i - 1); t := x+w; plot(x,y,t,y); x := t;
  51.     B(i - 1)
  52.   end
  53. end; {A(i)}
  54.  
  55. procedure B;
  56. begin if i > 0 then
  57.   begin
  58.     C(i - 1); t := y+h; plot(x,y,x,t); y := t;
  59.     B(i - 1); t := x+w; plot(x,y,t,y); x := t;
  60.     B(i - 1); t := y-h; plot(x,y,x,t); y := t;
  61.     A(i - 1)
  62.   end
  63. end; {B(i)}
  64.  
  65. procedure C;
  66. begin if i > 0 then
  67.   begin
  68.     B(i - 1); t := x+w; plot(x,y,t,y); x := t;
  69.     C(i - 1); t := y+h; plot(x,y,x,t); y := t;
  70.     C(i - 1); t := x-w; plot(x,y,t,y); x := t;
  71.     D(i - 1)
  72.   end
  73. end; {C(i)}
  74.  
  75. procedure D;
  76. begin if i > 0 then
  77.   begin
  78.     A(i - 1); t := y-h; plot(x,y,x,t); y := t;
  79.     D(i - 1); t := x-w; plot(x,y,t,y); x := t;
  80.     D(i - 1); t := y+h; plot(x,y,x,t); y := t;
  81.     C(i - 1)
  82.   end
  83. end; {D(i)}
  84.  
  85. begin {main}
  86.   clrscr;
  87.   gotoxy(24,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(44,24); {establish cursor position clear of graphics}
  95.   i := 0; h := h0; w := w0; x0 := w div 2; y0 := h div 2;
  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; h := h div 2; w := w div 2;
  103.     x0 :=  x0 + (w div 2); y0 := y0 + (h div 2);
  104.     x := x0; y := y0;
  105.     A(i)
  106.   until i = n;
  107.   gotoxy(22,24);
  108.   write(title);
  109.   repeat until keypressed;
  110.   clrscr;  {replace chr(128) with chr(32)}
  111.   normal;
  112.   writeln(^G)
  113. end. {main}
  114.  
  115.  
  116.