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 / WCURVE3.PAS < prev   
Pascal/Delphi Source File  |  1979-12-31  |  4KB  |  153 lines
  1. program W_CURVES3;
  2.  
  3. {   Demonstration program in Turbo Pascal
  4.       for 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 which utilises integer type
  11.   variables to speed up the plotting,  and a
  12.   real variable for  the  x  coordinate when
  13.         the value 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. const
  24.   w0 = 160; h0 = 64;
  25.   title = '*** W Curves ***';
  26.  
  27. var
  28.   i,n : byte;
  29.   h,t1,t2,w,x,y,x0,y0 : integer;
  30.  
  31. {$C-}
  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. label 9,19;
  48.  
  49. begin if i > 0 then
  50.   begin
  51.     if i > 1 then begin
  52.                     A(i - 1); goto 9
  53.                   end;
  54.     t1 := x+w; plot(x,y,t1,y); x := t1; goto 19;
  55.  9: t2 := y-h; plot(x,y,x,t2); y := t2;
  56.     t1 := x+w; plot(x,y,t1,y); x := t1; B(i - 1);
  57.     t1 := x+w; plot(x,y,t1,y); x := t1; D(i - 1);
  58.     t1 := x+w; plot(x,y,t1,y); x := t1;
  59.     t2 := y+h; plot(x,y,x,t2); y := t2; A(i - 1);
  60. 19:end
  61. end; {A(i)}
  62.  
  63. procedure B;
  64. label 9,19;
  65.  
  66. begin if i > 0 then
  67.   begin
  68.     if i > 1 then begin
  69.                     B(i - 1); goto 9
  70.                   end;
  71.     t2 := y-h; plot(x,y,x,t2); y := t2; goto 19;
  72.  9: t1 := x-w; plot(x,y,t1,y); x := t1;
  73.     t2 := y-h; plot(x,y,x,t2); y := t2; C(i - 1);
  74.     t2 := y-h; plot(x,y,x,t2); y := t2; A(i - 1);
  75.     t2 := y-h; plot(x,y,x,t2); y := t2;
  76.     t1 := x+w; plot(x,y,t1,y); x := t1; B(i - 1);
  77. 19:end
  78. end; {B(i)}
  79.  
  80. procedure C;
  81. label 9,19;
  82.  
  83. begin if i > 0 then
  84.   begin
  85.     if i > 1 then begin
  86.                     C(i - 1); goto 9
  87.                   end;
  88.     t1 := x-w; plot(x,y,t1,y); x := t1; goto 19;
  89.  9: t2 := y+h; plot(x,y,x,t2); y := t2;
  90.     t1 := x-w; plot(x,y,t1,y); x := t1; D(i - 1);
  91.     t1 := x-w; plot(x,y,t1,y); x := t1; B(i - 1);
  92.     t1 := x-w; plot(x,y,t1,y); x := t1;
  93.     t2 := y-h; plot(x,y,x,t2); y := t2; C(i - 1);
  94. 19:end
  95. end; {C(i)}
  96.  
  97. procedure D;
  98. label 9,19;
  99.  
  100. begin if i > 0 then
  101.   begin
  102.     if i > 1 then begin
  103.                     D(i - 1); goto 9
  104.                   end;
  105.     t2 := y+h; plot(x,y,x,t2); y := t2; goto 19;
  106.  9: t1 := x+w; plot(x,y,t1,y); x := t1;
  107.     t2 := y+h; plot(x,y,x,t2); y := t2; A(i - 1);
  108.     t2 := y+h; plot(x,y,x,t2); y := t2; C(i - 1);
  109.     t2 := y+h; plot(x,y,x,t2); y := t2;
  110.     t1 := x-w; plot(x,y,t1,y); x := t1; D(i - 1);
  111. 19:end
  112. end; {D(i)}
  113.  
  114. begin {main}
  115.   clrscr;
  116.   gotoxy(26,8);
  117.   writeln(title);
  118.   repeat
  119.     gotoxy(10,11);
  120.     write(^G,'What order of Curve do you require (1 to 4 only) : ');
  121.     readln(n)
  122.   until (n > 0) and (n < 5);
  123.   gotoxy(49,24); {establish cursor position clear of graphics}
  124.   i := 0; h := h0 div 2; w := w0 div 2;
  125.   x := 3*w div 2; y := 3*h div 2;
  126.   lores80;
  127.   plot(2,0,159,0);     {plot frame}
  128.   plot(2,64,159,64);
  129.   plot(2,1,2,63);
  130.   plot(159,1,159,63);
  131.   repeat
  132.     i := i + 1;
  133.     h := h div 2; w := w div 2;
  134.     x := x - 3*w div 2; y := y + h div 2;
  135.     A(i); t2 := y-h; plot(x,y,x,t2); y := t2;
  136.           t1 := x+w; plot(x,y,t1,y); x := t1;
  137.     B(i); t1 := x-w; plot(x,y,t1,y); x := t1;
  138.           t2 := y-h; plot(x,y,x,t2); y := t2;
  139.     C(i); t2 := y+h; plot(x,y,x,t2); y := t2;
  140.           t1 := x-w; plot(x,y,t1,y); x := t1;
  141.     D(i); t1 := x+w; plot(x,y,t1,y); x := t1;
  142.           t2 := y+h; plot(x,y,x,t2); y := t2
  143.   until i = n;
  144.   gotoxy(33,24);
  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.