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 / HILBERT.PAS < prev    next >
Pascal/Delphi Source File  |  1979-12-31  |  4KB  |  153 lines
  1. program HILBERT;
  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.   This version includes colour procedures    }
  24.  
  25. {$C-}
  26.  
  27. const
  28.   w0 = 160; h0 = 64;
  29.   title = '*** Hilbert Curves ***';
  30.  
  31. var
  32.   i,n : byte;
  33.   h,t,w,x,y,x0,y0 : integer;
  34.  
  35. {$I normal.pro}
  36. {$I lores80.pro}
  37. {$I draw.pro}
  38. {$I ploti2.pro}
  39. {$I colinit.pro}
  40.  
  41. {$A-}
  42.  
  43. procedure B(i : byte); forward;
  44.  
  45. procedure C(i : byte); forward;
  46.  
  47. procedure D(i : byte); forward;
  48.  
  49. procedure A(i : byte);
  50. begin if i > 0 then
  51.   begin
  52.     D(i - 1); t := x-w; plot(x,y,t,y); x := t;
  53.     A(i - 1); t := y-h; plot(x,y,x,t); y := t;
  54.     A(i - 1); t := x+w; plot(x,y,t,y); x := t;
  55.     B(i - 1)
  56.   end
  57. end; {A(i)}
  58.  
  59. procedure B;
  60. begin if i > 0 then
  61.   begin
  62.     C(i - 1); t := y+h; plot(x,y,x,t); y := t;
  63.     B(i - 1); t := x+w; plot(x,y,t,y); x := t;
  64.     B(i - 1); t := y-h; plot(x,y,x,t); y := t;
  65.     A(i - 1)
  66.   end
  67. end; {B(i)}
  68.  
  69. procedure C;
  70. begin if i > 0 then
  71.   begin
  72.     B(i - 1); t := x+w; plot(x,y,t,y); x := t;
  73.     C(i - 1); t := y+h; plot(x,y,x,t); y := t;
  74.     C(i - 1); t := x-w; plot(x,y,t,y); x := t;
  75.     D(i - 1)
  76.   end
  77. end; {C(i)}
  78.  
  79. procedure D;
  80. begin if i > 0 then
  81.   begin
  82.     A(i - 1); t := y-h; plot(x,y,x,t); y := t;
  83.     D(i - 1); t := x-w; plot(x,y,t,y); x := t;
  84.     D(i - 1); t := y+h; plot(x,y,x,t); y := t;
  85.     C(i - 1)
  86.   end
  87. end; {D(i)}
  88.  
  89. procedure set_col;
  90. const
  91.   next_line = $50;
  92. var
  93.   col_ram,left,right : integer;
  94.   line,loc,colour : byte;
  95. begin
  96.   port[8] := 78; {colour RAM on, RGB full}
  97.   left := $F800; right := $F84F; colour := 0;
  98.   for col_ram := left to right do
  99.     mem[col_ram] := 4; {line 1, red on black}
  100.   for col_ram := left + next_line*21 to right + next_line*21 do
  101.     mem[col_ram] := 4;
  102.   for line := 2 to 21 do
  103.     begin
  104.       mem[left + next_line] := 4;  {left side }
  105.       mem[right + next_line] := 4; {right side}
  106.       colour := colour + 1;
  107.       if colour = 16 then colour := 1; {avoid black on black!}
  108.       for loc := 1 to 78 do
  109.         mem[left + next_line + loc] := colour;
  110.       left := left + next_line; right := right + next_line
  111.     end; {for line}
  112.   port[8] := 14; {PCG ram on, RGB full}
  113. end; {procedure set_col}
  114.  
  115.  
  116. begin {main}
  117.   clrscr;
  118.   colinit; {initialise for color procedure}
  119.   gotoxy(24,8);
  120.   color(4,6,0); {red foreground, deep blue background, intensity 0}
  121.   write(title);
  122.   repeat
  123.     gotoxy(10,11);
  124.     color(2,3,0); {green foreground, olive background}
  125.     write(^G,'What order of Curve do you require (1 to 4 only) : ');
  126.     color(4,3,0); {response red on olive}
  127.     readln(n)
  128.   until (n > 0) and (n <5 );
  129.   gotoxy(52,24); {establish cursor position clear of graphics}
  130.   set_col;       {set up colour values in colour RAM}
  131.   i := 0; h := h0; w := w0; x0 := w div 2; y0 := h div 2;
  132.   lores80;
  133.   plot(0,0,159,0);     {plot frame}
  134.   plot(0,64,159,64);
  135.   plot(0,1,0,63);
  136.   plot(159,1,159,63);
  137.   repeat
  138.     i := i + 1; h := h div 2; w := w div 2;
  139.     x0 :=  x0 + (w div 2); y0 := y0 + (h div 2);
  140.     x := x0; y := y0;
  141.     A(i)
  142.   until i = n;
  143.   gotoxy(30,24);
  144.   color(0,3,7); {black foreground, yellow background}
  145.   write(title);
  146.   repeat until keypressed;
  147.   clrscr;  {replace chr(128) with chr(32)}
  148.   normal;
  149.   writeln(^G);
  150. end. {main}
  151.  
  152.  
  153.