home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / mbug / mbug013.arc / WCURVE.PAS < prev    next >
Pascal/Delphi Source File  |  1979-12-31  |  5KB  |  187 lines
  1. program W_CURVE(COLOUR);
  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.   This is a colour version,  using procedures
  24.       developed for the MicroBee              }
  25.  
  26.  
  27. const
  28.   w0 = 160; h0 = 64;
  29.   title = '*** W Curves ***';
  30.  
  31. var
  32.   i,n : byte;
  33.   h,t1,t2,w,x,y,x0,y0 : integer;
  34.  
  35. {$C-}
  36.  
  37. {$I normal.pro}
  38. {$I lores80.pro}
  39. {$I draw.pro}
  40. {$I ploti2.pro}
  41. {$I colinit.pro}
  42.  
  43. {$A-}
  44.  
  45. procedure B(i : byte); forward;
  46.  
  47. procedure C(i : byte); forward;
  48.  
  49. procedure D(i : byte); forward;
  50.  
  51. procedure A(i : byte);
  52. label 9,19;
  53.  
  54. begin if i > 0 then
  55.   begin
  56.     if i > 1 then begin
  57.                     A(i - 1); goto 9
  58.                   end;
  59.     t1 := x+w; plot(x,y,t1,y); x := t1; goto 19;
  60.  9: t2 := y-h; plot(x,y,x,t2); y := t2;
  61.     t1 := x+w; plot(x,y,t1,y); x := t1; B(i - 1);
  62.     t1 := x+w; plot(x,y,t1,y); x := t1; D(i - 1);
  63.     t1 := x+w; plot(x,y,t1,y); x := t1;
  64.     t2 := y+h; plot(x,y,x,t2); y := t2; A(i - 1);
  65. 19:end
  66. end; {A(i)}
  67.  
  68. procedure B;
  69. label 9,19;
  70.  
  71. begin if i > 0 then
  72.   begin
  73.     if i > 1 then begin
  74.                     B(i - 1); goto 9
  75.                   end;
  76.     t2 := y-h; plot(x,y,x,t2); y := t2; goto 19;
  77.  9: t1 := x-w; plot(x,y,t1,y); x := t1;
  78.     t2 := y-h; plot(x,y,x,t2); y := t2; C(i - 1);
  79.     t2 := y-h; plot(x,y,x,t2); y := t2; A(i - 1);
  80.     t2 := y-h; plot(x,y,x,t2); y := t2;
  81.     t1 := x+w; plot(x,y,t1,y); x := t1; B(i - 1);
  82. 19:end
  83. end; {B(i)}
  84.  
  85. procedure C;
  86. label 9,19;
  87.  
  88. begin if i > 0 then
  89.   begin
  90.     if i > 1 then begin
  91.                     C(i - 1); goto 9
  92.                   end;
  93.     t1 := x-w; plot(x,y,t1,y); x := t1; goto 19;
  94.  9: t2 := y+h; plot(x,y,x,t2); y := t2;
  95.     t1 := x-w; plot(x,y,t1,y); x := t1; D(i - 1);
  96.     t1 := x-w; plot(x,y,t1,y); x := t1; B(i - 1);
  97.     t1 := x-w; plot(x,y,t1,y); x := t1;
  98.     t2 := y-h; plot(x,y,x,t2); y := t2; C(i - 1);
  99. 19:end
  100. end; {C(i)}
  101.  
  102. procedure D;
  103. label 9,19;
  104.  
  105. begin if i > 0 then
  106.   begin
  107.     if i > 1 then begin
  108.                     D(i - 1); goto 9
  109.                   end;
  110.     t2 := y+h; plot(x,y,x,t2); y := t2; goto 19;
  111.  9: t1 := x+w; plot(x,y,t1,y); x := t1;
  112.     t2 := y+h; plot(x,y,x,t2); y := t2; A(i - 1);
  113.     t2 := y+h; plot(x,y,x,t2); y := t2; C(i - 1);
  114.     t2 := y+h; plot(x,y,x,t2); y := t2;
  115.     t1 := x-w; plot(x,y,t1,y); x := t1; D(i - 1);
  116. 19:end
  117. end; {D(i)}
  118.  
  119. procedure set_col;
  120. const
  121.   next_line = $50;
  122. var
  123.   col_ram,left,right : integer;
  124.   line,loc,colour : byte;
  125. begin
  126.   port[8] := 78; {colour RAM on, RGB full}
  127.   left := $F800; right := $F84F; colour := 0;
  128.   for col_ram := left to right do
  129.     mem[col_ram] := 4; {line 1, red on black}
  130.   for col_ram := left + next_line*21 to right + next_line*21 do
  131.     mem[col_ram] := 4;
  132.   for line := 2 to 21 do
  133.     begin
  134.       mem[left + next_line] := 4;  {left side }
  135.       mem[right + next_line] := 4; {right side}
  136.       colour := colour + 1;
  137.       if colour = 16 then colour := 1; {avoid black on black!}
  138.       for loc := 1 to 78 do
  139.         mem[left + next_line + loc] := colour;
  140.       left := left + next_line; right := right + next_line
  141.     end; {for line}
  142.   port[8] := 14; {PCG ram on, RGB full}
  143. end; {procedure set_col}
  144.  
  145. begin {main}
  146.   clrscr;
  147.   colinit; {initialise colour procedure}
  148.   color(3,3,0);
  149.   gotoxy(29,8);
  150.   write(title);
  151.   repeat
  152.     gotoxy(14,12); color(4,6,0);
  153.     write(^G,'What order of Curve do you require (1 to 4 only) : ');
  154.     readln(n)
  155.   until (n > 0) and (n < 5);
  156.   gotoxy(49,24); {establish cursor position clear of graphics}
  157.   set_col; {set up colour RAM values}
  158.   i := 0; h := h0 div 2; w := w0 div 2;
  159.   x := 3*w div 2; y := 3*h div 2;
  160.   lores80;
  161.   plot(1,0,159,0);     {plot frame}
  162.   plot(1,64,159,64);
  163.   plot(1,1,1,63);
  164.   plot(159,1,159,63);
  165.   repeat
  166.     i := i + 1;
  167.     h := h div 2; w := w div 2;
  168.     x := x - 3*w div 2; y := y + h div 2;
  169.     A(i); t2 := y-h; plot(x,y,x,t2); y := t2;
  170.           t1 := x+w; plot(x,y,t1,y); x := t1;
  171.     B(i); t1 := x-w; plot(x,y,t1,y); x := t1;
  172.           t2 := y-h; plot(x,y,x,t2); y := t2;
  173.     C(i); t2 := y+h; plot(x,y,x,t2); y := t2;
  174.           t1 := x-w; plot(x,y,t1,y); x := t1;
  175.     D(i); t1 := x+w; plot(x,y,t1,y); x := t1;
  176.           t2 := y+h; plot(x,y,x,t2); y := t2
  177.   until i = n;
  178.   color(6,1,7);
  179.   gotoxy(33,24);
  180.   write(title);
  181.   repeat until keypressed;
  182.   clrscr;  {replace chr(128) with chr(32)}
  183.   normal;
  184.   writeln(^G)
  185. end. {main}
  186.  
  187.