uses graph;
const size=$1AFF;
type
t_memory=array[0..size]of byte;
var
pos:word;
i:integer;
memory:t_memory;
(****************************************************************************)
{$F+}function SVGA:integer;begin;SVGA:=0;end;{$F-}
(****************************************************************************)
function setsBit(_bitNum,_bitDat:byte):boolean;
begin
if (_bitDat and ($01 shl _bitNum))=0 then setsBit:=false else setsBit:=true;
end;
(****************************************************************************)
procedure byte_to_screen(screen_add:word;screen_dat:byte);
const recol:array[0..7]of byte=(0,1,4,5,2,3,6,7);
function getcol(_c:byte):byte;
var cc:byte;
begin
cc:=recol[_c and $07];
if (_c and $40)<>0 then inc(cc,8);
getcol:=cc;
end;
function getbgr(_c:byte):byte;
begin
getbgr:=recol[(_c and $38)shr 3];
end;
var _x,_y,_i,_j:integer;
_b1,_b2,_bgr,_col,_dat:byte;
_mem_adr:word;
begin
if screen_add<$1800 then
 begin
_b1:=hi(screen_add)and $18;
_b2:=(lo(screen_add)shr 5);
  _y:=(_b1 shl 3)or(_b2 shl 3)or(hi(screen_add)and $07);
  _x:=lo(screen_add)and $1F;
_dat:=memory[$1800or _x or((_b1 or _b2)shl 5)];
_col:=getcol(_dat);
_bgr:=getbgr(_dat);
_x:=_x shl 3;
  for _i:=0 to 7 do
   if setsBit(7-_i,screen_dat)then putpixel(_x+_i,_y,_col)else putpixel(_x+_i,_y,_bgr);
 end else
 begin
_b1:=(hi(screen_add)and $03)shl 3;
_b2:=lo(screen_add);
_y:=(_b1 or((_b2 and $E0)shr 5))shl 3;
_x:=(_b2 and $1F)shl 3;
_col:=getcol(screen_dat);
_bgr:=getbgr(screen_dat);
_mem_adr:=((_b1 shl 8)or _b2);
  for _j:=0 to 7 do
   begin
   _dat:=memory[_mem_adr];
   inc(_mem_adr,$0100);
   for _i:=0 to 7 do
    if setsBit(7-_i,_dat)then putpixel(_x+_i,_y+_j,_col)else putpixel(_x+_i,_y+_j,_bgr);
   end;
 end;
end;

(****************************************************************************)
procedure get_memo;
type t_ar=array[0..$FFFE]of byte;
const max_err=650000;
var
dat:byte;
err:longint;
procedure error(ms:string;_pos:word);
begin
{closegraph;
writeln('ошибка приема ',ms,' в позиции ',_pos);}
halt;
end;
begin
for pos:=0 to size do
 begin
err:=0;
repeat
inc(err);
if err>max_err then error('LO',pos);
until (port[$037A] and $04)<>0;
dat:=(port[$0379] shr 3)and$0F;
err:=0;
repeat
inc(err);
if err>max_err then error('HI',pos);
until (port[$037A] and $04)=0;
dat:=((port[$0379] shl 1)and$F0)or dat;
memory[pos]:=dat;
 end;
end;

begin
i:=InstallUserDriver('svga256',@SVGA);
i:=0;
initgraph(i,i,'');


repeat
get_memo;
for i:=0 to size do
byte_to_screen(i,memory[i]);

until {keypressed}false;
end.