Power-Programmierung/CD1.mdf/pascal/library/dos/tsr/tsrunit/tsr.pas

Pascal/Delphi Source File | 1989-09-14 | 11.2 KB | 500 lines

 UNIT tsr;

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

INTERFACE

USES DOS,CRT;
CONST
     altkey=8;ctrlkey=4;leftkey=2;rightkey=1;
     TSRversion : word = $0203;

TYPE
    string80 = string[80];
    chrwords = record case integer of
                      1: (w : word);
                      2: (c : char; a : byte);
               end;                            linewords = array[1..80] of chrwords;
    wordfuncs = function : word;

VAR
   tsrscrptr : pointer;
   tsrchrptr : pointer;
   tsrmode   : byte;
   tsrwidth  : byte;
   tsrpage   : byte;
   tsrcolumn : byte;
   tsrrow    : byte;

procedure tsrinstall( tsrname  : string;
                      tsrfunc  : wordfuncs;
                      shiftcomb: byte;
                      Keychr   : char);
function printerokay : boolean;
function printerstatus: byte;
function screenlinestr (row : byte): string80;
procedure screenline(row : byte; var line :linewords;
                                 var words:byte);

IMPLEMENTATION

VAR
   buffsize, initcmode : word;
   npxflag               : boolean;
   buffer                : array[0..8191] of word;
   npxstate              : array[0..93] of byte;
   retrnval, initvideo   : byte;
   theirfunc             : wordfuncs;

CONST
     unsafe = 0;    flg   = 1;     key     = 2;     shft  = 3;
     stkofs = 4;    stkss = 6;     dossp   = 8;     dosss = 10;
     prev   = 12;   flg9  = 13;    insnumb = 14;
     dos21  = $10;        dos25  = dos21+4;     dos26  = dos25+4;
     bios9  = dos26+4;    bios16 = bios9+4;     dostab = bios16+4;
     our21  = dostab+99;  our25  = our21+51;    our26  = our25+24;
     our09  = our26+24;   our16  = our09+127+8; inschr = our16+180-8;
     popup  = inschr+4;

procedure asm;
interrupt;
begin
inline(
       >0/>0/
       >0/>0/
       >0/>0/
       >0/>0/
       >0/>0/

       0/0/0/0/0/0/0/0/  0/0/0/0/0/1/1/1/  1/1/1/1/1/1/1/1/
       1/1/1/1/1/1/1/1/  1/1/1/1/1/1/0/1/  1/1/1/1/1/1/1/0/
       1/0/0/0/0/0/1/1/  1/1/1/1/1/1/1/1/  1/1/1/1/1/1/1/1/
       0/0/0/0/0/0/1/1/  0/0/0/0/1/0/1/1/  0/1/1/1/1/0/0/0/  0/0/0/

{**** OurIntr21 ****}
      $9c/
      $fb/
      $80/$fc/$63/
      $73/<22-7/
      $50/
      $53/
      $bb/>dostab/
      $8a/$c4/
      $2e/
      $d7/
      $3c/$00/
      $5b/
      $58/
      $74/$17/
      $2e/
      $fe/$06/>unsafe/
      $9d/
      $9c/
      $2e/
      $ff/$1e/>dos21/
      $fb/
      $9c/
      $2e/
      $fe/$0e/>unsafe/
      $9d/
      $ca/$02/$00/
      $9d/
      $2e/
      $ff/$2e/>dos21/

{**** OurIntr25 ****}

      $9c/
      $2e/
      $fe/$06/>unsafe/
      $9d/
      $9c/
      $2e/
      $ff/$1e/>dos25/
      $83/$c4/$02/
      $9c/
      $2e/
      $fe/$0e/>unsafe/
      $9d/
      $cb/

{**** OurIntr26 ****}

      $9c/
      $2e/
      $fe/$06/>unsafe/
      $9d/
      $9c/
      $2e/
      $ff/$1e/>dos26/
      $83/$c4/$02/
      $9c/
      $2e/
      $fe/$0e/>unsafe/
      $9d/
      $cb/

{**** OurIntr9 ****}

      $9c/
      $fb/
      $1e/
      $0e/
      $1f/
      $50/
      $31/$c0/
      $e4/$60/
      $3c/$e0/
      $74/<75-14/
      $3c/$f0/
      $74/<75-18/
      $80/$3e/>flg9/$00/
      $75/<77-25/
      $3a/$06/>key/
      $75/<88-31/

      $50/
      $06/
      $b8/$40/$00/
      $8e/$c0/
      $26/
      $a0/>$0017/
      $07/
      $24/$0f/
      $3a/$06/>shft/
      $58/
      $75/<88-52/

      $3a/$06/>prev/
      $74/<107-58/
      $a2/>prev/
      $f6/$06/>flg/3/
      $75/<99-68/
      $80/$0e/>flg/1/
      $eb/<107-75/

      $b4/$01/
      $88/$26/>flg9/
      $c6/$06/>prev/$ff/
      $eb/<99-88/

      $3c/$ff/
      $74/<99-92/
      $3c/$00/
      $74/<99-96/
      $a2/>prev/

      $58/
      $1f/
      $9d/
      $2e/
      $ff/$2e/>bios9/

      $e4/$61/
      $8a/$e0/
      $0c/$80/
      $e6/$61/
      $86/$e0/
      $e6/$61/
      $b0/$20/
      $e6/$20/
      $58/
      $1f/
      $9d/
      $cf/

{**** OurIntr16 ****}

      $58/
      $1f/
      $9d/
      $2e/
      $ff/$2e/>bios16/

      $9c/
      $fb/
      $1e/
      $50/
      $0e/
      $1f/
      $f6/$c4/$ef/
      $75/<48-19/

      $f6/$06/>flg/1/
      $74/<29-26/
      $e8/>122-29/
      $f6/$06/>flg/16/
      $75/<48-36/
      $fe/$c4/
      $9c/
      $fa/
      $ff/$1e/>bios16/
      $58/
      $50/
      $74/<19-48/

      $f6/$06/>flg/17/
      $74/<-55/
      $f6/$06/>flg/$01/
      $74/<65-62/
      $e8/>122-65/
      $f6/$06/>flg/$10/
      $74/<-72/
      $f6/$c4/$ee/
      $75/<-77/

      $58/
      $53/
      $06/
      $c4/$1e/>inschr/
      $26/
      $8a/$07/
      $07/
      $5b/
      $f6/$c4/$01/
      $b4/$00/
      $75/<114-96/
      $fe/$06/>inschr/
      $ff/$0e/>insnumb/
      $75/<111-106/
      $80/$26/>flg/$ef/
      $1f/
      $9d/
      $cf/

      $1f/
      $9d/
      $50/
      $40/
      $58/
      $ca/>0002/

      $50/
      $fa/
      $f6/$06/>unsafe/$ff/
      $75/<177-131/
      $a0/>flg/
      $24/$fe/
      $0c/$02/
      $a2/>flg/

      $a1/>stkofs/
      $87/$c4/
      $a3/>dossp/
      $8c/$16/>dosss/
      $8e/$16/>stkss/
      $fb/
      $9c/
      $ff/$1e/>popup/

      $fa/
      $8b/$26/>dossp/
      $8e/$16/>dosss/
      $80/$26/>flg/$fd/

      $fb/
      $58/
      $c3);

end;

procedure popupcode;
INTERRUPT;
CONST     BSeg = $0040;    VBiosOfs = $49;
TYPE
    VideoRecs = RECORD
                      VideoMode                      : BYTE;
                      NumbCol, ScreenSize, MemoryOfs : WORD;
                      CursorArea      : ARRAY[0..7] OF WORD;
                      CursorMode                     : WORD;
                      CurrentPage                    : BYTE;
                      VideoBoardAddr                 : WORD;
                      Current, CurrentColor          : BYTE;
                  END;
VAR
   Regs               : Registers;
   VideoRec           : Videorecs;
   KeyLock            : BYTE;
   ScrnSeg, NumbChr   : WORD;

BEGIN
     swapvectors;
     move(ptr(bseg,vbiosofs)^,videorec,sizeof(videorec));
     with videorec, regs do begin
          if (videomode > 7) or (screensize > buffsize) then BEGIN
          swapvectors;
          exit;
      END;
      keylock:=mem[bseg:$0017];
      if videomode = 7 then scrnseg:=$b000
      else scrnseg:=$b800;
      move(ptr(scrnseg, memoryofs)^,buffer, screensize);
      AX:=initvideo;
      if (videomode >=4) and (videomode<=6) then intr($10,regs);
      AX:=$0500;
      intr($10,regs);
      CX:=initcmode;
      AH:=1;
      intr($10,regs);

      tsrmode    := videomode;
      tsrwidth   := numbcol;
      tsrpage    := currentpage;
      tsrcolumn  := succ(lo(cursorarea[currentpage]));
      tsrrow     := succ(hi(cursorarea[currentpage]));

      if npxflag then inline($98/$dd/$36/>npxstate);

      numbchr:=theirfunc;
      memw[cseg:insnumb]:=numbchr;
      if numbchr>0 then begin
         meml[cseg:inschr]:=longint(tsrchrptr);
         mem[cseg:flg]:=mem[cseg:flg] or $10
     END;

         if npxflag then
            inline($98/$dd/$36/>npxstate);

         mem[bseg:$17]:=(mem[bseg:$17] and $0f) or (keylock and $f0);

         If mem[bseg:vbiosofs]<>videomode then begin
            AX:=videomode;
            intr($10,regs);
        end;
        AH:=1;  CX:=cursormode;
        intr($10,regs);
        ah:=5;al:=currentpage;
        intr($10,regs);
        ah:=2;bh:=currentpage;
        dx:=cursorarea[currentpage];
        intr($10,regs);
        move(buffer,ptr(scrnseg,memoryofs)^,screensize);

        swapvectors;
    end;
end;

function printerstatus:byte;

VAR regs : registers;

BEGIN
     with regs do begin
          ah:=2; dx:=0;
          intr($17,regs);
          printerstatus:=ah;
      end;
end;

function printerokay: boolean;
var s: byte;
begin
     s:=printerstatus;
     if ((s and $10) <> 0) and ((s and $29) = 0) then
        printerokay := true
     else printerokay := false;
end;

procedure screenline(row:byte;var line:linewords;var words:byte);

begin
     words:=40;
     if tsrmode>1 then words:=words*2;
     move(buffer[pred(row)*words],line,words*2);
end;

function screenlinestr(row:byte):string80;
var
   words,i     : byte;
   lineword    : linewords;
   line        : string80;
begin
     screenline(row,lineword,words);
     line:='';
     for i:=1 to words do insert(lineword[i].c,line,i);
     screenlinestr:=line;
end;

procedure tsrinstall( tsrname:string; tsrfunc:wordfuncs;
                      shiftcomb:byte; keychr:char);

const
     scanchr = '[phone]++++QWERTYUIOP++++ASDFGHJKL++++ZXCVBNM';
     combchr = 'RLCA"';
var
   plistptr            : ^string;
   i, j, k             : word;
   regs                : registers;
   comb,scancode       : byte;
begin
     if ofs(asm)<>0 then exit;
     memw[cseg:stkss]    := sseg;
     memw[cseg:stkofs]   := sptr+562;
     meml[cseg:popup]    := longint(@popupcode);
     theirfunc           := tsrfunc;
     writeln('Installing Stay Resident Program: ',TSRname);

     getintvec($09,pointer(meml[cseg:bios9]));
     getintvec($16,pointer(meml[cseg:bios16]));
     getintvec($21,pointer(meml[cseg:dos21]));
     getintvec($25,pointer(meml[cseg:dos25]));
     getintvec($26,pointer(meml[cseg:dos26]));

     with regs do begin
          intr($11,regs);
          npxflag:=(al and 2) = 2;
          ah:=15;
          intr($10,regs);
          initvideo:=al;
          ah:=3;bh:=0;
          intr($10,regs);
          initcmode:=cx;
    end;

    buffsize:=sizeof(buffer);
    tsrscrptr:=@buffer;

    comb:=0;i:=1;
    plistptr:=ptr(prefixseg,$80);
    while i<length(plistptr^) do begin
          if plistptr^[i] = '/' then begin
             inc(i);
             j:=pos(upcase(plistptr^[i]),combchr);
             if (j>0) and (j<5) then comb:=comb or (1 shl pred(j))
             else if j<>0 then begin
                  inc(i);k:=succ(i);
                  if i>length(plistptr^) then keychr:=#0
                  else begin
                  if ((k<=length(plistptr^)) and (plistptr^[k]='"'))
                     or (plistptr^[i]<>'"') then keychr:=plistptr^[i]
                  else keychr:=#0;
              end;
          end;
      end;
      inc(i);
   end;
   if comb=0 then comb:=shiftcomb;
   if comb=0 then comb:=altkey;
   scancode:=pos(upcase(keychr),scanchr);
   if scancode<2 then begin
      scancode:=2;keychr:='1';
   end;
   mem[cseg:shft]:=comb;
   mem[cseg:key]:=scancode;
   writeln('Memory used is approximately ',(($1000+seg(freeptr^)-prefixseg)/64.0):7:1,' K (K=1024).');
   writeln('Activate program by pressing the following keys simultaneously:');
          if (comb and 1)<>0 then write(' [Right Shift]');
          if (comb and 2)<>0 then write(' [Left Shift]');
          if (comb and 4)<>0 then write(' [Ctrl]');
          if (comb and 8)<>0 then write(' [Alt]');
          writeln(' and "', keychr, '".');
   setintvec($21,ptr(cseg,our21));
   setintvec($25,ptr(cseg,our25));
   setintvec($26,ptr(cseg,our26));
   setintvec($16,ptr(cseg,our16));
   setintvec($09,ptr(cseg,our09));
   swapvectors;
   memw[cseg:unsafe]:=0;
   keep(0);
end;
end.