[comp.lang.pascal] interrupt problems

IN307%DHAFEU11.BITNET@cunyvm.cuny.edu ( Peter Sawatzki) (09/26/90)

I use the following code fragment to make SnapShots from Autodesk
Animator FLI files. This is done from within the Animator by
catching Int16. If a certain key (Alt-s for Snap) is pressed
, a special mode is enterd: the next three times Int 16 is called
(from AA) the keystrokes 'p' (for "Pic"), 'v' (for "view") are returned.
Then a snapshot is taken, and the keystrokes Esc| CursorRight|
(show next FLI) are returned.
If the Alt-N key is pressed, one can enter the number of snaps.
(in the form "nn" Enter|).

Notice that you need Richard W. Prescotts integrated compile time
assembler and TP55 to compile the code. Also the EmulateInt
routine from the Objhect Professional Toolbox is needed.

Enjoy,
  Peter

Type
  IntRegisters =
    record
      case Byte of
        1 : (BP, ES, DS, DI, SI, DX, CX, BX, AX, IP, CS, Flags : Word);
        2 : (Dummy : Dummy5; DL, DH, CL, CH, BL, BH, AL, AH : Byte);
    end;

  {-original Interrupts}
  OldInt16: Pointer;

  Procedure GetIntVec (IntNo: Byte; Var Vector: Pointer);
  Assemble
    Pop Di
    Pop Es
    Pop Ax
    Push Es
    Mov Ah,35h
    Int 21h
    Mov Cx,Es
    Pop Es
    Cld
    Mov Ax,Bx
    StosW
    Mov Ax,Cx
    StosW
  End;

  Procedure SetIntVec (IntNo: Byte; Vector: Pointer);
  Assemble
    Pop Dx
    Pop Bx
    Pop Ax
    Push Ds
    Mov Ds,Bx
    Mov Ah,25h
    Int 21h
    Pop Ds
  End;

procedure ChainInt(var Regs : IntRegisters; JumpAddr : Pointer);
{-Restores stack, registers from Regs and 'jumps' to JumpAddr}
Assemble
  pop bx          ;BX = Ofs(JumpAddr^)
  pop ax          ;AX = Seg(JumpAddr^)
  pop si          ;SI = Ofs(Regs)
  pop ds          ;DS:SI => Regs
                  ;Change stack so RETF passes control to JumpAddr
                  ;restore Flags
  xchg bx,si+14| ;Switch old BX and Ofs(JumpAddr^)
  xchg ax,si+16| ;Switch old AX and Seg(JumpAddr^)
  mov  dx,si+22| ;Old Flags into DX
  push dx         ;Push altered flags
  popf            ;Pop them into place
                  ;Switch stacks -- make SS:SP point to Regs.BP
  mov dx,ds       ;DX = Seg(Regs)
  cli             ;Interrupts off
  mov ss,dx       ;Restore SS from DX
  mov sp,si       ;Restore SP from SI
  sti             ;Interrupts on
  pop bp          ;Restore BP
  pop es          ;Restore ES
  pop ds          ;Restore DS
  pop di          ;Restore DI
  pop si          ;Restore SI
  pop dx          ;Restore DX
  pop cx          ;Restore CX
                  ;BX and AX restored earlier; their places on stack
                  ;now have JumpAddr, which is where return will go
  retf            ;Chain to JumpAddr
End;

{$F+}
Procedure EmulateInt(var Regs : IntRegisters; IntAddr : Pointer);
External;
{$F-}
  {-Emulates an interrupt by filling the CPU registers with the values in Regs,
    clearing interrupts, pushing the flags, and calling far to IntAddr.}
{$L Smap}


Type
  Sounds = (Good,Bad,FinishGood,FinishBad,Acknowledge,Cont);

  Procedure Tone (WhatTone: Sounds);
  Var
    i,j: Byte;
  Begin
    Case WhatTone Of
      Cont: Begin Sound(500); Delay(5) End;
      Good: Begin Sound(500); Delay(30) End;
      Bad:  Begin Sound(100); Delay(200) End;
      FinishGood: For j:= 1 To 2 Do
                  For I:= 1 To 5 Do Begin
                    Sound(500+I*200);
                    Delay(30)
                  End;
      FinishBad: For j:= 1 To 2 Do
                 For I:= 1 To 5 Do Begin
                   Sound(200-I*20);
                   Delay(30)
                 End;
      Acknowledge: Begin Sound(1000); Delay(15) End;
    End;
    NoSound
  End;

  Function GetString (Var RetStr: String): Boolean;
  Var
    r: IntRegisters;
    s: String67|;
    c: Char;
    ende: Boolean;
  Begin
    s:= '';
    ende:= False;
    Repeat
      r.AH:= 0;
      EmulateInt(r,OldInt16);
      If r.AL<>0 Then Begin
        c:= UpCase(Char(r.AL));
        Case c Of
          'A'..'Z','0'..'9','\','.',':':
            If Length(s)<SizeOf(s)-1 Then Begin
              Inc(s0|);
              sLength(s)|:= c;
              Tone(Acknowledge)
            End Else
              Tone(Bad);
          #8: If Length(s)>0 Then Begin
                Dec(s0|);
                Tone(Acknowledge)
              End Else
                Tone(Bad);
          #13: ende:= True;
          #27: Begin
                 GetString:= False;
                 Exit
               End;
        Else
          Tone(Bad)
        End
      End
    Until Ende;
    GetString:= True;
    RetStr:= s
  End;

  Procedure GetNumber (Var n: Word);
  Var
    v: Word;
    s: String;
    err: Integer;
  Begin
    If GetString(s) Then Begin
      Val(s,v,err);
      If err>0 Then
        Tone(FinishBad)
      Else Begin
        n:= v;
        Tone(FinishGood)
      End
    End
  End;

  Function Escape: Boolean;
  Var
    r: IntRegisters;
  Begin
    Escape:= False;
    r.Ah:= 1;
    EmulateInt(r,OldInt16);
    If (r.Flags And $2>0) And (r.AL=27) Then Begin
      Escape:= True;
      r.Ah:= 0;
      EmulateInt(r,OldInt16) {discard ESC key}
    End
  End;

  Procedure ToneOn (b: Boolean);
  Begin
    If b Then
      Tone(FinishGood)
    Else
      Tone(Good)
  End;

{=============================== Int 16 ====================}

  Procedure Int16(BP: Word); Interrupt;
  Const
    SnapCount: Word = 0;
    LastState = 3;
    SnapState: Word = 0;
  var
    Regs: IntRegisters absolute BP;
  Begin
    Case Regs.Ah Of
      0: If SnapCount>0 Then Begin
           {-Fr jeden Snap wird 'pv' Snap| ' ' Cursor Right| ausgefhrt
             Abschlu mit Cursor Up|}

           Case SnapState Of
             0: Begin
                  Dec(SnapCount);
                  If SnapCount=0 Then Begin
                    {-Ende Snap}
                    If Not EndSnap Then
                      Tone(FinishBad);
                    Regs.AX:= Swap(72) {Cursor Up}
                  End Else Begin
                    {-nchster Snap}
                    SnapState:= LastState+1;
                    Regs.AX:= Swap(25)+Byte('p');
                  End;
                End;
             1: Regs.AX:= Swap(77); {Cursor Right}
             2: Begin
                  If SnapCount=1 Then
                    ResetOptimize; {-beim letzten Snap kein Optimize}
                  If Not Escape And SaveSnap Then
                    Tone(Cont)
                  Else Begin
                    {-in case of error, signal last snap}
                    SnapCount:= 1;
                    Tone(FinishBad)
                  End;
                  Regs.Ax:= Swap(57)+Byte(' ');
                End;
             3: Regs.Ax:= Swap(47)+Byte('v');
           End;
           Dec(SnapState);
         End Else Begin
           EmulateInt(Regs,OldInt16);
           If Regs.Al=0 Then {Alt-..}
           Case Regs.AH Of
     {Alt-s} 31: If BeginSnap Then Begin
                   {-Snap Machine aktivieren}
                   ResetOptimize;
                   SnapCount:= SnapNumber;
                   SnapState:= LastState;
                   Regs.AX:= Swap(25)+Byte('p');
                 End;
     {Alt-n} 49: Begin
                   GetNumber(SnapNumber);
                   Regs.AX:= 0
                 End;
     {Alt-o} 24: Begin
                   If GetString(OutName) Then
                      Tone(FinishGood);
                   Regs.Ax:= 0
                 End;
     {Alt-v} 47: Begin
                   StretchMode:= Not StretchMode;
                   ToneOn(StretchMode)
                  End;
     {Alt-w} 17: Begin
                   WriteWMF:= Not WriteWMF;
                   ToneOn(WriteWMF)
                  End;
     {Alt-8}127: Begin
                   Write8514:= Not Write8514;
                   ToneOn(Write8514)
                 End;
            End
         End;
      1:  If SnapCount>0 Then
            {-signal char in buffer}
            Regs.Flags:= Regs.Flags Or $2
          Else
            ChainInt(Regs,OldInt16);
    Else
      ChainInt(Regs,OldInt16)
    End;
  End;

Begin
  GetIntVec($16,OldInt16);
  SwapVectors;
  SetIntVec($16,@Int16);
    Exec(StartProg,StartCmds);
  SetIntVec($16,OldInt16);
  SwapVectors
End.


 :::::::::::::::::::::::::::::::::::::::::
: Peter Sawatzki  <IN307DHAFEU11.BITNET> :
 :::::::::::::::::::::::::::::::::::::::::

kushmer@bnlux0.bnl.gov (christopher kushmerick) (09/27/90)

>Notice that you need Richard W. Prescotts integrated compile time
>assembler and TP55 to compile the code. Also the EmulateInt

Could someone please mail to me, or post if this is not generally known,
what is the Prescott integrated compile time assembler, how does it work,
and from where is it available.

-- 
Chris Kushmerick

kushmer@bnlux0.bnl.gov
kushmerick@pofvax.sunysb.edu