home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / mbug / mbug072.arc / SETRES.PAS < prev    next >
Pascal/Delphi Source File  |  1979-12-31  |  2KB  |  92 lines
  1. {
  2.  
  3.   Microbeσ Graphic≤ Technology
  4.   Par⌠ 3║ Savinτ Graphic≤ File≤
  5.           anΣ Poin⌠ Plotting.
  6.  
  7.   POIN╘ PLOTTIN╟ ALGORITH═ TES╘
  8.  
  9.   Fo≥ MBU╟ Australiß Inc..
  10.       ╨ ╧ Bo° 157,
  11.       Nunawaddinτ  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. var
  21.    xpos, ypos : integer;
  22.  
  23. procedure Set64by16;               {Set up 6454 for 64*16 screen}
  24. var
  25.  i : integer;
  26. begin
  27.  for i := 0 to 15 do
  28.  begin
  29.   port[$0c] := i;
  30.   port[$0d] := Scr64by16[i];
  31.  end;
  32. end;
  33.  
  34. procedure point_plot ( x,y : integer);
  35. var
  36.   byteadr : integer;
  37.      mask : byte;
  38. begin
  39.  byteadr := $F800 + (x div 8)*16 + (y mod 16);
  40.  if ((y mod 32) - 15) > 0 then byteadr := byteadr+$400;
  41.  mask := 1 shl (7 - (x mod 8));
  42.  port[$1C] := (y div 32) + $80;
  43.  mem[byteadr] := mem[byteadr] or mask;
  44. end;
  45.  
  46.  
  47. procedure FillAttribute;
  48. var
  49.  x,y : integer;
  50. begin
  51.  port[$1C] := $90;             {Latch Attribute Ram}
  52.  for y := 0 to 7 do
  53.   for x := 0 to 127 do
  54.    mem[$f000+x+y*128] := y;
  55. end;
  56.  
  57. procedure ColScreen;
  58. var
  59.  y : integer;
  60. begin
  61.  port[8] := $40;
  62.  for y := 0 to $3FF doè  mem[$F800+y] := 14;
  63.   port[8] := $00;
  64. end;
  65.  
  66. procedure FillScreen;
  67. var
  68.  x,y : integer;
  69. begin
  70.  port[$1c] := $80;             {Latch Screen Ram}
  71.  for y := 0 to 7 do
  72.   for x := 0 to 127 do
  73.   mem[$f000+x+(y*128)] := x+$80;
  74. end;
  75.  
  76. procedure blankmem;
  77.  var  x,y : integer;
  78. begin
  79.  for y := 0 to 7 do begin
  80.  port[$1c] := $80 + y;
  81.  for x := 0 to $7FF do mem[$F800+x] := $00;
  82.  end;
  83. end;
  84.  
  85. begiε      √ maiε prograφ }
  86.  set64by16; fillscreen; colscreen; fillattribute;
  87.  blankmem;
  88.  for xpos := 0 to 511 do
  89.   for ypos := 0 to 255 do
  90.    point_plot(xpos,ypos);
  91. end.
  92.