[Back to TSR SWAG index] [Back to Main SWAG index] [Original]

    {
    From: ANDREW KEY
    Subj: Screen Save
    }

    unit Scrnsavr;
    {$F+}
    (*************************************************************************)
    (*                        Screen Saver                                   *)
    (*                                                                       *)
    (*  Written by Jay A. Key -- Oct 1993                                    *)
    (*  Code may be modified and used freely.  Please mention my name        *)
    (*  somewhere in your docs or in the program itself.                     *)
    (*                                                                       *)
    (*  Self contained unit to install a text-mode screen saver in Turbo     *)
    (*  Pascal programs.  Simply include the following line in your code.    *)
    (*    uses ScrnSavr;                                                     *)
    (*                                                                       *)
    (*  It will initialize itself automatically, and will remove itself      *)
    (*  upon exit from your program, graceful exit or not.  Functions        *)
    (*  SetTimeOut and SetDelay are included if you wish to modify the       *)
    (*  default values.                                                      *)
    (*                                                                       *)
    (*  Warning: will not properly save and restore screens while running    *)
    (*  under the Turbo Pascal IDE.  Runs great from DOS.                    *)
    (*************************************************************************)

    interface

    uses Dos,Crt;

    function NumRows: byte;          {Returns number of rows in current screen}
    function ColorAdaptor: boolean;  {TRUE if color video card installed}
    procedure SetTimeOut(T: integer); {Delay(seconds) before activation}
    procedure SetDelay(T: integer);  {Interval between iterations}

    (************************************)

    implementation

    type
      VideoArray = array[1..2000] of word;  {buffer to save video screen}

    var
      Timer: word;
      Waiting: boolean;
      OldInt15,                  {Keyboard interrupt}
      OldInt1C,                  {Timer interrupt}
      OldInt23,                  {Cntl-C/Cntl-Break handler}
      ExitSave: pointer;
      Position, Cursor: integer; {save and restore cursor positions}
      VideoSave: VideoArray;
      VideoMem: ^VideoArray;
      TimeOut, Delay: integer;

    procedure JumpToPriorIsr(p: pointer);
    {Originally written by Brook Monroe, "An ISR Clock", pg. 64,
     PC Techniques Aug/Sep 1992}
      inline($5b/$58/$87/$5e/$0e/$87/$46/$10/$89/$ec/$5d/$07/$1f/
             $5f/$5e/$5a/$59/$cb);

    function ColorAdaptor: boolean; assembler;
      asm
        int 11                   {BIOS call - get equipment list}
        and al,$0010             {mask off all but bit 4}
        xor al,$0010             {flip bit 4 - return val is in al}
      end;

    function NumRows: byte; assembler;  {returns number of displayable rows}
      asm
        mov ax,$40
        mov es,ax
        mov ax,$84
        mov di,ax
        mov al,[es:di]           {byte at [$40:$84] is number of rows in display}
      end;

    procedure HideCursor; assembler;
      asm
        mov ah,$03
        xor bh,bh
        int $10               {video interrupt}
        mov Position,dx       {save cursor position}
        mov Cursor,cx         {and type}
        mov ah,$01
        mov ch,$20
        int $10               {video interrupt - hide cursor}
      end;

    procedure RestoreCursor; assembler;
      asm
        mov ah,$02
        xor bh,bh
        mov dx,Position       {get old position}
        int $10               {video interrupt - restore cursor position}
        mov cx,Cursor         {get old cursor type}
        mov ah,$01
        int $10               {video interrupt - restore cursor type}
      end;

    procedure RestoreScreen;
      begin
        VideoMem^ := VideoSave;  {Copy saved image back onto video memory}
        RestoreCursor;
      end;

    procedure SaveScreen;
      begin
        VideoSave := VideoMem^;  {Copy video memory to array}
        HideCursor;
      end;

    procedure DispMsg;  {simple stub-out for displaying YOUR message(s),
                         pictures, etc...use your imagination!!!}
      begin
        ClrScr;
        GotoXY(random(50),random(23));
        writeln('This would normally be something witty!');
      end;

    procedure NewInt15(Flags,CS,IP,AX,BX,CX,DX,
                       SI,DI,DS,ES,BP:WORD); interrupt; {keyboard handler}
      begin
        Timer:=0;                     {Reset timer}
        if Waiting then               {Screen saver activated?}
          begin
            RestoreScreen;            {Restore saved screen image}
            Waiting:= FALSE;          {De-activate screen saver}
            Flags:=(Flags and $FFFE); {Tell BIOS to ignore current keystroke}
          end
        else
          JumpToPriorISR(OldInt15);   {call original int 15}
      end;

    procedure NewInt1C; interrupt;    {timer interrupt}
      begin
        Inc(Timer);                   {Increment timer}
        if Timer>TimeOut then         {No key hit for TimeOut seconds?}
          begin
            Waiting := TRUE;          {Activate screen saver}
            SaveScreen;               {Save image of video memory}
            DispMsg;                  {Display your own message}
            Timer := 0;               {Reset timer}
          end;
        if waiting then               {Is saver already active?}
          begin
            if Timer>Delay then       {Time for next message?}
              begin
                Timer := 0;           {Reset timer}
                DispMsg;              {Display next message}
              end;
          end;
        JumpToPriorISR(OldInt1C);     {Chain to old timer interrupt}
      end;

    procedure ResetIntVectors;        {Restores Intrrupt vectors to orig. values}
      begin
        SetIntVec($15,OldInt15);
        SetIntVec($1C,OldInt1C);
        SetIntVec($23,OldInt23);
      end;

    procedure NewInt23; interrupt;    {Called to handle cntl-c/brk}
      begin
        ResetIntVectors;              {Restore old interrupt vectors}
        JumpToPriorISR(OldInt23);     {Chain to original int 23h}
      end;

    procedure MyExit; far;            {exit code for unit}
      begin
        ResetIntVectors;              {Restore old interrupt vectors}
        ExitProc:=ExitSave;           {Restore old exit code}
      end;

    procedure SetVideoAddress;        {Returns pointer to text video memory}
      begin
        if ColorAdaptor then
          VideoMem := ptr($B000,$0000)
        else
          VideoMem := ptr($B800,$0000);
      end;

    procedure SetTimeOut(T: integer); {Set delay(seconds) before activation}
      begin
        TimeOut:=Round(T*18.2);
      end;

    procedure SetDelay(T: integer);  {Set interval between iterations}
      begin
        Delay:=Round(T*18.2);
      end;

    {Initialize unit}
    begin
      SetVideoAddress;             {Set up address for video memory}
      Waiting := FALSE;            {Screen saver initially OFF}
      Timer := 0;                  {Reset timer}
      ExitSave := ExitProc;        {Save old exit routine}
      ExitProc := @MyExit;         {Install own exit routine}
    {Install user defined int vectors}
      GetIntVec($15,OldInt15);     {Keyboard handler}
      SetIntVec($15,@NewInt15);
      GetIntVec($1c,OldInt1C);     {Timer int}
      SetIntVec($1c,@NewInt1C);
      GetIntVec($23,OldInt23);     {Cntl-C/Brk handler}
      SetIntVec($23,@NewInt23);
      SetTimeOut(120);
      SetDelay(15);
    end.

[Back to TSR SWAG index] [Back to Main SWAG index] [Original]