Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/TPSCRNSV.ZIP/SCRNSAVE.PAS

Pascal/Delphi Source File | 1990-04-01 | 10.4 KB | 409 lines

{$A-,B-,D+,E-,F+,I-,L+,N-,O-,R-,S-,V-}
{$M 5000,0,0}

PROGRAM SCRNSAVE;

{Resident portion of Screen Saver, the one that is locked in memory}
{Use SCSVCOMM to communicate with Screen Saver}

  Uses CRT,DOS,PSP,DosExten;

  TYPE Address=RECORD
                 CASE Boolean OF
                   True:(Ptr:Pointer);
                   False:(Offset, Segment:Word)
               END;

{ ------------------------------------------------------------------------- }
  CONST Able_to_Install_TSR:Boolean=True;


  CONST OldStackSS:Word=0;
                OldStackSP:Word=0;
        OurStackSeg:Word=0;
        OurStackSP:Word=0;

        StackSW:Integer=-1;

        EndDos:Word=0;

{ ------------------------Variables----------------------- }


  VAR Regs:Registers;

  VAR OldTimerVec,
      OldKbdVec:Pointer;

      DosSeg:Word;
      DosBusy:Word;

      OldDTASeg,
      OldDTAOfs,

      OurDTASeg,
      OurDTAOfs:Word;

      OldBreakStatus:Byte;

      TSR_Communication_Routine:Pointer;

      TSR_Byte,
      TSR_Communication_Vec:Byte;
      TSR_PSP,
      INT_PSP:Word;

      PSP_Array:Array[1..2] Of Word;
      PSP_Counter:Byte;

  CONST Counter:Word=0;
        Video_Disabled:Boolean=False;
        PortNum:Word=$3D8;
        TurnOff:Word=$25;
        TurnOn:Word=$2D;
        TimeLimit:Word=1092;


  CONST TimerInt=$1C;
        KbdInt=$09;

        TSR_Suspended:Boolean=False;

        PROCEDURE BeginInt;
          Inline($FF/$06/StackSw
                /$75/$10
                /$8C/$16/OldStackSS
                /$89/$26/OldStackSP
                /$8E/$16/OurStackSeg
                /$8B/$26/OurStackSP);

        PROCEDURE EndInt;
          Inline($FF/$0E/StackSw
                /$7D/$08
                /$8E/$16/OldStackSS
                /$8B/$26/OldStackSP);

        PROCEDURE CLI; Inline($FA);
        PROCEDURE STI; Inline($FB);

{ ****************************CallOldInt******************************** }

 PROCEDURE CallOldInt(Sub:Pointer);

   BEGIN
     Inline($9C/
            $FF/$5E/$06)
   END;

  PROCEDURE New_Clock_Interrupt(Flags,CS,IP,AX,BX,CX,DX,SI,DI,DS,ES,BP:Word);
    Interrupt;

    BEGIN
      CLI;

      CallOldInt(OldTimerVec);
      IF (Not TSR_Suspended) And (Not Video_Disabled) And (Counter>TimeLimit) THEN
        BEGIN
          NoSound;
          Sound(100);
          Delay(100);
          NoSound;

          Port[PortNum]:=TurnOff;
          Video_Disabled:=True
        END
          ELSE
            Inc(Counter);

    STI
  End; {of New_Clock_Interrupt}

{ ***********************New_Keyboard_Interrupt***************************** }

 PROCEDURE New_Keyboard_Interrupt(Flags,CS,IP,AX,BX,CX,DX,SI,DI,DS,ES,BP:Word);
   Interrupt;

   BEGIN
     CLI;

     Counter:=0;
     IF Video_Disabled THEN
       BEGIN
         Port[PortNum]:=TurnOn;
         Video_Disabled:=False;

         {Reset the keyboard}
         TSR_Byte:=Port[$61];
         Port[$61]:=TSR_Byte Or $80;
         Port[$61]:=TSR_Byte;

         {Signal end of interrupt}
         CLI;
         Port[$20]:=$20;
         STI;
       END
          ELSE CallOldInt(OldKbdVec);

     STI
   END; {of New_Keyboard_Interrupt}

{ ***************************Install_TSR_Interrupts************************ }

  PROCEDURE Install_TSR_Interrupts;

    BEGIN
      SetIntVec(TimerInt,@New_Clock_Interrupt);
      SetIntVec(KbdInt,@New_Keyboard_Interrupt);
      {SetIntVec(Int28h,@New_28h);}
      SetIntVec(TSR_Communication_Vec,TSR_Communication_Routine);
      IF StackSw=-1 THEN
        SetIntVec($1B,SaveInt1B)
    END;

{ ***************************Release_Memory********************************** }

     PROCEDURE Release_Memory;

         VAR EndDos_plus_1:Word;

         BEGIN {Release_Memory}

         WHILE (Mem[EndDos:$0000]=$4D) DO
             BEGIN
                 EndDos_plus_1:=EndDos+1;
                 IF MemW[EndDos:$0001]=TSR_PSP THEN
                     Release_Memory_Block(EndDos_plus_1);

         EndDos:=EndDos_plus_1+MemW[EndDos:$0003] {Next MCB}
         END
         END;

{ ************************TSR_Exit******************************************* }

  FUNCTION TSR_Exit:Boolean;

    VAR Current_Timer_Vec,
        Current_Kbd_Vec:Pointer;

    BEGIN {TSR_Exit}
      GetIntVec(TimerInt,Current_Timer_Vec);
      GetIntVec(KbdInt,Current_Kbd_Vec);

      IF (Current_Timer_Vec=@New_Clock_Interrupt) And
         (Current_Kbd_Vec=@New_Keyboard_Interrupt) THEN

         BEGIN
           SetIntVec(TimerInt,OldTimerVec);
           SetIntVec(KbdInt,OldKbdVec);
           SetIntVec(TSR_Communication_Vec,Nil);
           Release_Memory;
           TSR_Exit:=True
         END
       ELSE
         TSR_Exit:=False
    END; {of TSR_Exit}

{ *************************Setup*************************************** }

  PROCEDURE Setup;

    VAR Adr:Word;
        TSR_PSP_Plus_1:Word;

    BEGIN {Setup}
      CheckBreak:=False;

      OurStackSeg:=SSeg;    {Save TSR's Stack Segment & Stack Pointer}
      Inline($89/$26/OurStackSP);

      Get_DOS_Busy_Flag_Address(DosSeg,DosBusy);
      Get_DTA_Address(OurDTASeg,OurDTAOfs);
      TSR_PSP:=PSP_Segment;
      EndDos:=End_of_DOS_Memory;

      PSP_Counter:=0;
      Adr:=0;
      WHILE (PSP_Counter<2) And (((DosSeg Shl 4)+Adr)<(EndDos Shl 4)) DO
        BEGIN
          IF MemW[DosSeg:Adr]=TSR_PSP THEN
            BEGIN
              TSR_PSP_Plus_1:=TSR_PSP+1;
              Set_PSP_Segment(TSR_PSP_Plus_1);
              IF MemW[DosSeg:Adr]=TSR_PSP_Plus_1 THEN
                Inc(PSP_Counter);
              PSP_Array[PSP_Counter]:=Adr;
              Set_PSP_Segment(TSR_PSP)
            END;
          Inc(Adr)
        END; {of While...}

      GetIntVec(TimerInt,OldTimerVec);
      GetIntVec(KbdInt,OldKbdVec);

    END; {of Setup}

{ *****************************DupCheck*********************************** }

  FUNCTION DupCheck(VAR TSR_Signature:String;
                        TSR_Communication_Rtn:Pointer):Byte;

    VAR Vec:Word;
        Dif:Word;
        IntrAddress:Address;
        RtnAddress:Address Absolute TSR_Communication_Rtn;
        Current_Signature:String;
        Length_of_TSR_Signature:Byte Absolute TSR_Signature;
        Done:Boolean;
        Current_Comm_Rtn:Pointer;

    BEGIN {DupCheck}
      Dif:=DSeg-RtnAddress.Segment;
      Vec:=$60;
      Done:=False;

      WHILE (Vec<$68) And Not Done DO
        BEGIN
          GetIntVec(Vec,IntrAddress.Ptr);
          IF IntrAddress.Ptr=Nil THEN
            BEGIN {If TSR has not yet been installed...}
              TSR_Communication_Routine:=TSR_Communication_Rtn;
              GetIntVec(Vec,Current_Comm_Rtn);
              TSR_Communication_Vec:=Vec;
              DupCheck:=0;
              Done:=True
            END
              ELSE {If TSR may have been installed...}
                BEGIN
                  Move(Mem[IntrAddress.Segment+Dif:Ofs(TSR_Signature)],
                                  Current_Signature,Length_of_TSR_Signature+1);
                  IF Current_Signature=TSR_Signature THEN
                    BEGIN
                      DupCheck:=Vec;
                      TSR_Communication_Vec:=Vec;
                      Able_to_Install_TSR:=True;
                      Done:=True
                    END
                      ELSE Inc(Vec)
                END {of If TSR may have been installed...}
        END; {of While...}

        IF Not Done THEN
          BEGIN
           DupCheck:=0;
           Able_to_Install_TSR:=False
          END
      END; {of DupCheck}

{ ---------------------------------------------------------------------------}
   CONST TSR_Signature:String='The SCRNSAVE - Memory-resident Program by Ilya Shlyakhter';

   VAR TSR_Int:Byte;
       TSR_AX:Word;
       TSR_BX:Word;

{ *******************************Stop_TSR************************************ }

  PROCEDURE Stop_TSR;

    BEGIN
      Writeln;
      IF TSR_Exit THEN
        Writeln('SCRNSAVE unloaded.')
       ELSE Writeln('Unable to unload SCRNSAVE - other TSR has been installed.')
    END;


{ ****************************Suspend_TSR********************************** }

 PROCEDURE Suspend_TSR;

   BEGIN
     TSR_Suspended:=True;
     Writeln('SCRNSAVE suspended.');
     Write('Enter SCRNSAVE RESTART to restart Screen Saver.')
   END;


 { ****************************Restart_TSR********************************** }

 PROCEDURE Restart_TSR;

   BEGIN
     TSR_Suspended:=False;
     Writeln('SCRNSAVE restarted.')
   END;

{ ***************************MyCommRtn************************************ }

  PROCEDURE MyCommRtn(Flags,CS,IP,AX,BX,CX,DX,SI,DI,DS,ES,BP:Word); Interrupt;

    BEGIN
      TSR_AX:=AX;
      IF TSR_AX=5 THEN
        BEGIN
          IF TSR_Suspended THEN AX:=5 ELSE AX:=6
        END
          ELSE
            IF TSR_AX=8 THEN
              BEGIN
                TSR_BX:=BX;
                TimeLimit:=TSR_BX;
                Writeln('Time limit has been set to ',TimeLimit,' ticks (1 second=18.2 ticks)')
              END
                ELSE

      CASE TSR_AX OF
        1:Stop_TSR;
        2:Suspend_TSR;
        3:Restart_TSR
      END; {of Case}

   STI
 END;



{ **************************Outer block of the TSR*********************** }

  BEGIN
    TSR_Int:=DupCheck(TSR_Signature,@MyCommRtn);

    IF TSR_Int>0 THEN
      BEGIN

        Writeln;
        Writeln('SCRNSAVE already installed');
        Writeln;

      END {of prompting the user that we are already installled}
        ELSE {If TSR has not been installed yet...}
          IF Not Able_to_Install_TSR THEN
            BEGIN
              Writeln;
              Writeln('Unable to install SCRNSAVE - too many TSR''s have'+
                      ' been installed.')
            END
              ELSE
                BEGIN
                  Writeln('                  *****SCRNSAVE*****');
                  Writeln;

                  Write('Going resident...');

                  FillChar(Regs,SizeOf(Regs),0);
                  Intr($11,Regs);
                  IF (Regs.AL And $30)=$30 THEN
                    BEGIN
                      PortNum:=$3B8;
                      TurnOn:=$29;
                      TurnOff:=$21
                    END;

                  Setup;
                  Writeln('done.');
                  Writeln;
                  Install_TSR_Interrupts;
                  Keep(0)
                END {of installing the TSR}
   END. {of program}