unit emul_kbr;
interface
type e_t_reg=record F,A,C,B,E,D,L,H:byte end;
e_t_reg_w=record FA,BC,DE,HL:word end;
procedure GoEmulation;
var TheCommand:word;
e_write_b,e_mem_b:byte;
e_reg,e_reg_:e_t_reg;
e_reg_w:e_t_reg_w absolute e_reg;
e_reg__w:e_t_reg_w absolute e_reg_;

implementation
uses dos,emul_dat;
var
curSite:byte;
OldInt1C:pointer;
memDat,
memAddr:word;
sizeMemDat,
ImReturn,
ImReady:byte;
ImNotReady:boolean;
{$F+,S-}
procedure putKey(_cod:tCod);
var _w:word;
begin
_w:=c_key[_cod];
 asm
 mov ah,$05
 mov cx,_w
 int $16
 end;
end;
function getChar(_x,_y:byte):byte;
var _w:word;
begin
_w:=(_y*80+_x)*2;
getChar:=mem[$B800:_w];
end;

procedure writeByteToBufer(_data:byte);
const c_hex:array[0..$F]of tCod=(_0,_1,_2,_3,_4,_5,_6,_7,_8,_9,_a,_b,_c,_d,_e,_f);
begin
 putkey(c_hex[(_data and $F0)shr 4]);
 putkey(c_hex[_data and $0F]);
end;
function reHex(_ch:byte):byte;
begin
if _ch<=$39 then reHex:=_ch-$30 else reHex:=_ch-$41+10;
end;
function readByte(__x,__y:byte):byte;
begin
readByte:=$10*reHex(getChar(__x,__y))+reHex(getChar(__x+1,__y));
end;
function readFlag(__x,__y:byte):byte;
var _b,_f:byte;
begin
_f:=0;
for _b:=0 to 7 do
 begin
 inc(_f,reHex(getChar(__x+3*_b,__y)));
 if _b<7 then _f:=_f shl 1;
 end;
readFlag:=_f;
end;
procedure writeFlagToBufer(_data:byte);
var _b:byte;
begin
 for _b:=7 downto 0 do
  begin
  if (_data and ($01 shl _b))=0 then putkey(_0) else putkey(_1);
  putkey(_tab);
  end;
end;
procedure myInt1C;interrupt;
var i:integer;
const c_debug:array[1..7]of tCod=(_enter,_d,_e,_b,_u,_g,_enter);
      c_quit:array[1..5]of tCod=(_q,_u,_i,_t,_enter);
begin
if ImNotReady then exit;
ImNotReady:=true;
case ImReady of
{&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&}
$00:if getChar(0,0)=$C9{É} then{enter to debug mode}
 begin
 for i:=1 to 7 do
  putkey(c_debug[i]);
 ImReady:=$01;
 end;
{&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&}
$01:begin
memAddr:=0;
memDat:=TheCommand;{enter command}
sizeMemDat:=2;
ImReturn:=5;
  ImReady:=$20;
    end;
{&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&}
$02:
 begin
 putkey(_end);
 for i:=1 to 5 do{quit}
  putkey(c_quit[i]);
ImReady:=$FF;
 end;
{&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&}
$03:begin
     putkey(_down);putkey(_down);{trace}
     putkey(_0);putkey(_0);putkey(_0);putkey(_0);
     putkey(_enter);putkey(_s_alt);
     ImReady:=$10;
    end;
{&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&}
$05:begin{write Data}
writeByteToBufer(e_reg.A);putkey(_tab);
writeByteToBufer(e_reg.B);
writeByteToBufer(e_reg.C);putkey(_tab);
writeByteToBufer(e_reg.D);
writeByteToBufer(e_reg.E);putkey(_tab);
     inc(ImReady);
    end;
$06:begin
writeByteToBufer(e_reg.H);
writeByteToBufer(e_reg.L);putkey(_tab);
   inc(ImReady);
   end;
$07:begin
writeFlagToBufer(e_reg.F);
   inc(ImReady);
    end;
$08:begin
putkey(_home);
putkey(_down);
     inc(ImReady);
    end;
$09:begin
writeByteToBufer(e_reg_.A);putkey(_tab);
writeByteToBufer(e_reg_.B);
writeByteToBufer(e_reg_.C);putkey(_tab);
writeByteToBufer(e_reg_.D);
writeByteToBufer(e_reg_.E);putkey(_tab);
     inc(ImReady);
    end;
$0A:begin
writeByteToBufer(e_reg_.H);
writeByteToBufer(e_reg_.L);putkey(_tab);
   inc(ImReady);
   end;
$0B:begin
writeFlagToBufer(e_reg_.F);
   inc(ImReady);
    end;
$0C:begin
putkey(_home);
putkey(_down);
   inc(ImReady);
    end;
$0D:begin
memAddr:=e_reg_w.HL;
memDat:=e_mem_b;
sizeMemDat:=1;
ImReturn:=$03;
ImReady:=$20;
    end;
{&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&}
$10:if(getChar(5,9)<>$30{0})then{ready trace}
    begin{read Result}
e_reg.A:=readByte(3,3);
e_reg.B:=readByte(6,3);
e_reg.C:=readByte(8,3);
e_reg.D:=readByte(11,3);
e_reg.E:=readByte(13,3);
e_reg.H:=readByte(16,3);
e_reg.L:=readByte(18,3);
e_reg.F:=readFlag(22,3);
e_reg_.A:=readByte(3,5);
e_reg_.B:=readByte(6,5);
e_reg_.C:=readByte(8,5);
e_reg_.D:=readByte(11,5);
e_reg_.E:=readByte(13,5);
e_reg_.H:=readByte(16,5);
e_reg_.L:=readByte(18,5);
e_reg_.F:=readFlag(22,5);
putkey(_down);
putkey(_down);
putkey(_down);
memAddr:=e_reg_w.HL;
  writeByteToBufer(hi(memAddr));
  writeByteToBufer(lo(memAddr));
   inc(ImReady);
    end;
$11:begin
   inc(ImReady);
    end;
$12:begin
memDat:=readByte(8,9);
e_write_b:=memDat;
ImReady:=2;
    end;
{&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&}
$20:begin
  putkey(_d_alt);{enter data}
  putkey(_rwn_alt);
  writeByteToBufer(hi(memAddr));
  writeByteToBufer(lo(memAddr));
  putkey(_enter);
  inc(ImReady,sizeMemDat);
    end;
$21:begin
  writeByteToBufer(lo(memDat));
  putkey(_end);
ImReady:=ImReturn;
    end;
$22:begin
  writeByteToBufer(hi(memDat));
  dec(ImReady);
    end;
{&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&}
end;
ImNotReady:=false;
end;
{$F-,S+}
var HXs:string;
LastShape : word;
const HX='0123456789ABCDEF';

function whb(_dt:byte):string;
begin
whb:=HXs[(_dt shr 4)+1]+HXs[(_dt and $0F)+1];
end;
function whw(_dt:word):string;
begin
whw:=whb(hi(_dt))+whb(lo(_dt));
end;

procedure GoEmulation;
var _w,xx:word;
begin
HXs:=HX;
{repeat
asm
mov ah,$10
int $16
mov xx,ax
end;
writeln(whw(xx));
asm
mov ah,$10
int $16
mov xx,ax
end;
writeln(whw(xx));
until lo(xx)=27;
halt;}
asm cli end;

_w:=round(1.19e6/100);
asm
cli
mov al,$36
out $43,al
mov ax,_w
out $40,al
xchg al,ah
out $40,al
sti
end;
ImNotReady:=false;
ImReady:=$FF;
GetIntVec($1C,OldInt1C);
SetIntVec($1C,@MyInt1C);
asm
mov ah,$0F
int $10
mov curSite,bh
end;
asm sti end;
SwapVectors;
ImReady:=$00;
Exec('c:\emulat\z80mu52b\z80mu.exe','');
SwapVectors;
asm cli end;
SetIntVec($1C,OldInt1C);

asm
cli
mov al,$36
out $43,al
xor al,al{18.2}
out $40,al
out $40,al
sti
end;

asm sti end;
end;
end.