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 / MBUG072.ARC / CATCHJAN.PAS < prev    next >
Pascal/Delphi Source File  |  1979-12-31  |  4KB  |  170 lines
  1. {
  2.  
  3.   Microbee Graphics Technology
  4.   Part 4: Line and circle drawings
  5.           in multiple modes.
  6.  
  7.   LINE & CIRCLE DRAWING TESTS
  8.   File : MGTPART4.PAS
  9.   For MBUG Australia Inc..
  10.       P O Box 157,
  11.       Nunawadding  3131.
  12.  
  13. }
  14.  
  15. const
  16.      Scr64by16 : array[0..15] of byte =
  17.                 ($6B,$40,$51,$37,$12,$09,$10,$12,$48,$0F,$2F,$0F,0,0,0,0);
  18.      Scr80by24 : array[0..15] of byte =
  19.                 ($6B,$50,$58,$37,$1B,$05,$18,$1A,$48,$0A,$2A,$0A,$20,0,0,0);
  20. type
  21.    plot_type = (doset,reset,invert);
  22.  
  23. var
  24.    aspect_ratio : real;
  25.    xpos, ypos : integer;
  26.         mode : plot_type;
  27.  
  28.    {***********************************************************}
  29.    {********** START OF MICROBEE SPECIFIC SUBROUTINES *********}
  30.  
  31. procedure Set64by16;               {Set up 6454 for 64*16 screen}
  32. var
  33.  i : integer;
  34. begin
  35.  for i := 0 to 15 do
  36.  begin
  37.   port[$0c] := i;
  38.   port[$0d] := Scr64by16[i];
  39.  end;
  40. end;
  41.  
  42. procedure Set80by24;               {Set up 6454 for 64*16 screen}
  43. var
  44.  i : integer;
  45. begin
  46.  for i := 0 to 15 do
  47.  begin
  48.   port[$0c] := i;
  49.   port[$0d] := Scr80by24[i];
  50.  end;
  51. end;
  52.  
  53. procedure point_plot ( x,y : integer);
  54. var
  55.   byteadr : integer;
  56.      mask : byte;
  57. begin
  58.  byteadr := $F800 + (x div 8)*16 + (y mod 16);
  59.  if ((y mod 32) - 15) > 0 then byteadr := byteadr+$400;
  60.  mask := 1 shl (7 - (x mod 8));
  61.  port[$1C] := (y div 32) + $80;
  62.  case mode of
  63.  doset   : mem[byteadr] := mem[byteadr] or mask;
  64.  reset   : begin
  65.             mem[byteadr] := mem[byteadr] and not mask;
  66.            end;
  67.  invert  : mem[byteadr] := mem[byteadr] xor mask;
  68.  end;
  69. end;
  70.  
  71. procedure FillAttribute;
  72. var
  73.  x,y : integer;
  74. begin
  75.  port[$1C] := $90;             {Latch Attribute Ram}
  76.  for y := 0 to 7 do
  77.   for x := 0 to 127 do
  78.    mem[$f000+x+y*128] := y;
  79. end;
  80.  
  81. procedure ColScreen;
  82. var
  83.  y : integer;
  84. begin
  85.  port[8] := $40;
  86.  for y := 0 to $3FF do
  87.   mem[$F800+y] := 14;
  88.   port[8] := $00;
  89. end;
  90.  
  91. procedure FillScreen;
  92. var
  93.  x,y : integer;
  94. begin
  95.  port[$1c] := $80;             {Latch Screen Ram}
  96.  for y := 0 to 7 do
  97.   for x := 0 to 127 do
  98.   mem[$f000+x+(y*128)] := x+$80;
  99. end;
  100.  
  101. procedure blankmem;
  102.  var  x,y : integer;
  103. begin
  104.  for y := 0 to 7 do begin
  105.  port[$1c] := $80 + y;
  106.  for x := 0 to $7FF do mem[$F800+x] := $00;
  107.  end;
  108. end;
  109.  
  110. procedure setinv;
  111. var
  112.  i : integer;
  113. begin
  114.  port[$0b] := $01;
  115.  for i := 0 to $7FF do
  116.  mem[$F800+i] := not mem[$F000+i]; port[$0b] := $00;
  117. end;
  118.  
  119.  {*******************************************************************}
  120.  {*************** START OF POINT PLOTTING SUBROUTINES ***************}
  121.  
  122. procedure DDA (x1,y1,x2,y2 : integer);
  123. var
  124.  length, i : integer;
  125.  x,y, xincrement, yincrement : real;
  126. begin
  127.  length := abs(x2-x1);
  128.  if abs(y2-y1) > length then length := abs(y2-y1);
  129.  xincrement := (x2-x1)/length;
  130.  yincrement := (y2-y1)/length;
  131.  x := x1+0.5; y := y1 + 0.5;
  132.  for i := 1 to length do
  133.   begin
  134.    point_plot(trunc(x),trunc(y));
  135.    x := x + xincrement;
  136.    y := y + yincrement;
  137.   end;
  138. end;
  139.  
  140. procedure circle(x1,y1,radius : integer);
  141. var
  142.  xloc, yloc : integer;
  143.  angle : real;
  144. begin
  145.  aspect_ratio := 1.6;
  146.  angle := 0.0;
  147.  repeat
  148.   xloc := trunc((radius+0.0)*sin(angle)*aspect_ratio);
  149.   yloc := trunc((radius+0.0)*cos(angle));
  150.   point_plot(x1+xloc, y1+yloc);
  151.   point_plot(x1+xloc, y1-yloc);
  152.   point_plot(x1-xloc, y1+yloc);
  153.   point_plot(x1-xloc, y1-yloc);
  154.   angle := angle + 0.01745; { pi/180, 1 degree }
  155.  until angle > 1.57079;     { pi/2, 90 degrees }
  156. end;
  157.  
  158.       {*************** START OF MAIN PROGRAM ***************}
  159.  
  160. begin      { main program }
  161.  blankmem; { clean up all 8 PCG banks first }
  162.  set64by16; fillscreen; colscreen; fillattribute; { fill screen, colour .. }
  163.  xpos := 511; ypos := 255;
  164.  mode := doset;
  165.  dda(0,0,xpos,ypos); { draw line , from 0,0 to xpos, ypos}
  166.  circle(255,127,50); { draw circle, at 255,127 radius 50 units }
  167.  set80by24; port[$1c] := $00; setinv;
  168. end.
  169.  
  170.