Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/BININT.ZIP/BININT.PAS

Pascal/Delphi Source File | 1988-10-23 | 7.9 KB | 303 lines

{
 BININT offers a way to access normally hidden information while within a
 BINED event handler. See BININT.DOC for details.

 Written by Kim Kokkonen, TurboPower Software.
 Released to the public domain.
 Compuserve [72457,2131]

 Version 1.0, 10/22/88
   first release
}

{$R-,S-,I-,B-,F-}

unit BinInt;
  {-Make BINED internals available to event handlers}

interface

uses
  BinEd;

type
  EdIntRec =
    record
      EditSeg : Word;             {Segment where editor control block is located}
      BuffOfs : Word;             {Offset in EditSeg where text buffer starts}
      LineOfs : Word;             {Offset in EditSeg where offset of current line is stored}
      StrtOfs : Word;             {Offset in EditSeg where line buffer is stored}
      CurrOfs : Word;             {Offset in EditSeg where offset of position in line buffer is stored}
      CharOfs : Word;             {Offset in EditSeg of character buffer}
      OptnOfs : Word;             {Offset in EditSeg of editor options}
    end;

procedure FindInternals(EdData : EdCB; var E : EdIntRec);
  {-Initialize an internal data record}

function CurrLineOfs(var E : EdIntRec) : Word;
  {-Return text buffer offset at start of current line}

function CurrChar(var E : EdIntRec) : Char;
  {-Return character at cursor position}

function LinePos(var E : EdIntRec) : Byte;
  {-Return cursor position within current line, 1..247}

function LineLen(var E : EdIntRec) : Byte;
  {-Return length of current line}

function CurrLine(var E : EdIntRec) : string;
  {-Return the current line as a string}

function EditOptions(var E : EdIntRec) : Byte;
  {-Return the current editor options}

procedure ClearKbd(var E : EdIntRec);
  {-Clears both the BIOS and internal BINED keyboard buffers}

procedure StuffKey(W : Word);
  {-Stuffs a keystroke into the keyboard buffer}

  {======================================================================}

implementation

const
  KbdStart = $1E;
  KbdEnd = $3C;
type
  Barray = array[0..30000] of Byte;
  BarrayPtr = ^Barray;
  SO =
    record
      O : Word;
      S : Word;
    end;
var
  KbdHead : Word absolute $40 : $1A;
  KbdTail : Word absolute $40 : $1C;

  function Search(var Buffer; BuffLen : Word;
                  var Match; MatchLen : Word) : Pointer;
    {-Return pointer to start of match, nil if none}
  var
    B : BarrayPtr;
    M : BarrayPtr;
    I : Word;
    J : Word;
    Matched : Boolean;
  begin
    B := @Buffer;
    M := @Match;
    for I := 1 to BuffLen do begin
      if B^[0] = M^[0] then begin
        {Start of a match, try the rest}
        if MatchLen = 1 then
          Matched := True
        else begin
          J := 1;
          repeat
            Matched := (B^[J] = M^[J]);
            Inc(J);
          until not Matched or (J = MatchLen);
        end;
        if Matched then begin
          {Complete match}
          Search := B;
          Exit;
        end;
      end;
      {Move to next byte}
      Inc(SO(B).O);
    end;
    {No match}
    Search := nil;
  end;

  function CodeMatch(B, M : BarrayPtr; Len : Word) : Boolean;
    {-Return true if B^ matches M^ after discounting addresses}
  var
    MB : Byte;
    I : Word;
  begin
    for I := 0 to Len-1 do begin
      MB := M^[I];
      if MB <> 0 then
        if MB <> B^[I] then begin
          CodeMatch := False;
          Exit;
        end;
    end;
    CodeMatch := True;
  end;

  procedure FindInternals(EdData : EdCB; var E : EdIntRec);
    {-Initialize an internal data record}
  type
    WordPtr = ^Word;
  const
    {Code we must find to determine data offsets}
    Match0 : array[0..7] of Byte =
    ($C3,                         {RET}
     $C3,                         {RET}
     $F6, $06, $00, $00, $01,     {TEST [Options],01}
     $C3);                        {RET}
    Match1 : array[0..18] of Byte =
    ($C6, $07, $1A,               {MOV BYTE PTR [BX],1Ah}
     $8B, $16, $00, $00,          {MOV DX,[LineOfs]}
     $2B, $16, $00, $00,          {SUB DX,[BuffOfs]}
     $BE, $00, $00,               {MOV SI,StrtOfs}
     $FC,                         {CLD}
     $3B, $36, $00, $00);         {CMP SI,[CurrOfs]}
    Match2 : array[0..7] of Byte =
    ($5B,                         {POP BX}
     $80, $3E, $00, $00, $FF,     {CMP [BufChar],$FF}
     $B0, $FF);                   {MOV AL,$FF}
  var
    B0 : BarrayPtr;
    B1 : BarrayPtr;
    B2 : BarrayPtr;
  begin
    {All zeros will indicate error}
    FillChar(E, SizeOf(EdIntRec), 0);

    {B0 is base of the binary editor code segment}
    B0 := Ptr(Seg(InitBinaryEditor), 0);

    {Find code for editor options}
    B0 := Search(B0^, 10000, Match0, 4);
    if B0 = nil then
      {Not found}
      Exit;
    if not CodeMatch(B0, @Match0, SizeOf(Match0)) then
      {Not a complete match}
      Exit;

    {Find code for various buffer offsets}
    B1 := Search(B0^, 10000, Match1, 5);
    if B1 = nil then
      Exit;
    if not CodeMatch(B1, @Match1, SizeOf(Match1)) then
      Exit;

    {Find code for character buffer}
    B2 := Search(B1^, 10000, Match2, 3);
    if B2 = nil then
      Exit;
    if not CodeMatch(B2, @Match2, SizeOf(Match2)) then
      Exit;

    {Initialize the internals record}
    with E do begin
      EditSeg := EdData.DataSeg;
      BuffOfs := SO(EdData.Buffer).O;
      OptnOfs := WordPtr(@B0^[4])^;
      LineOfs := WordPtr(@B1^[5])^;
      StrtOfs := WordPtr(@B1^[12])^;
      CurrOfs := WordPtr(@B1^[17])^;
      CharOfs := WordPtr(@B2^[3])^;
    end;
  end;

  function CurrLineOfs(var E : EdIntRec) : Word;
    {-Return text buffer offset of start of current line}
  begin
    with E do
      if EditSeg = 0 then
        CurrLineOfs := $FFFF
      else
        CurrLineOfs := MemW[EditSeg:LineOfs]-BuffOfs;
  end;

  function CurrChar(var E : EdIntRec) : Char;
    {-Return character at cursor position}
  begin
    with E do
      if EditSeg = 0 then
        CurrChar := #$FF
      else
        CurrChar := Char(Mem[EditSeg:MemW[EditSeg:CurrOfs]]);
  end;

  function LinePos(var E : EdIntRec) : Byte;
    {-Return cursor position within current line}
  begin
    with E do
      if EditSeg = 0 then
        LinePos := $FF
      else
        LinePos := MemW[EditSeg:CurrOfs]-StrtOfs+1;
  end;

  function LineLen(var E : EdIntRec) : Byte;
    {-Return length of current line}
  var
    O : Word;
  begin
    with E do
      if EditSeg = 0 then
        LineLen := $FF
      else begin
        O := StrtOfs+247;
        while (O >= StrtOfs) and (Mem[EditSeg:O] = $20) do
          Dec(O);
        LineLen := O+1-StrtOfs;
      end;
  end;

  function CurrLine(var E : EdIntRec) : string;
    {-Return the current line as a string}
  var
    L : string;
    LL : Byte absolute L;
  begin
    LL := LineLen(E);
    if LL = $FF then
      LL := 0
    else with E do
      Move(Mem[EditSeg:StrtOfs], L[1], LL);
    CurrLine := L;
  end;

  function EditOptions(var E : EdIntRec) : Byte;
    {-Return the current editor options}
  begin
    with E do
      if EditSeg = 0 then
        EditOptions := $FF
      else
        EditOptions := Mem[EditSeg:OptnOfs];
  end;

  procedure ClearKbd(var E : EdIntRec);
    {-Clears both the BIOS and internal BINED keyboard buffers}
  begin
    with E do
      if EditSeg <> 0 then begin
        {Clear BIOS keyboard buffer}
        KbdHead := KbdTail;
        {Clear BINED character buffer}
        Mem[EditSeg:CharOfs] := $FF;
      end;
  end;

  procedure StuffKey(W : Word);
    {-Stuffs a keystroke into the keyboard buffer}
  var
    SaveKbdTail : Word;
  begin
    SaveKbdTail := KbdTail;
    if KbdTail = KbdEnd then
      KbdTail := KbdStart
    else
      Inc(KbdTail, 2);
    if KbdTail = KbdHead then
      {Buffer full, ignore request}
      KbdTail := SaveKbdTail
    else
      MemW[$40:SaveKbdTail] := W;
  end;

end.