NetNews Usenet Archive 1992 #30/NN_1992_30.iso/spool/comp/lang/pascal/7472

Internet Message Format | 1992-12-14 | 5.0 KB

Path: sparky!uunet!pipex!unipalm!uknet!comlab.ox.ac.uk!oxuniv!speedy
From: [e-mail]
Newsgroups: comp.lang.pascal
Subject: TVISION and Interrupts. Is it safe?
Message-ID: <[e-mail]>
Date: 14 Dec 92 21:02:07 GMT
Organization: Oxford University VAX 6620
Lines: 255

Interrupts and Turbo Vision
===========================

See source below...


Is this sort of thing safe. It certainly used to work in
Turbo Pascal 6 - but does not now seem to work in BP7. It
actually seems to work on a 486 but not on a 286 or 386 which
makes me think that there must be some sort of re-entry.
In certain circumstances it seems to utterly lock up the
computer (big red button time :-( ) Does turbo vision re-enable
interrupts? Or is it just not a safe thing to do with
TVISION? In the instance were I am using it - overlays
are being used in some parts of the program - however
Objects,Drivers,Views,App and DOS are not overlaid.
Initwaitbox is called in the main applications constructor.

Thank you for any help!



unit WaitBox;

      {*********************************************************************}
      {   Source File: WAITBOX.pas                                          }
      {   Description: Implements a wait box with moving dot on the screen  }
      {   Date       : Sat Dec 12 14:44:07 1992                             }
      {   Copyright  : (C) N.Waltham 1992                        }
      {*********************************************************************}

{$O-} {$F+} {$S-}

interface

function WaitOn(aTitle : String) : integer;
function WaitOff : integer;
procedure InitWaitBox;


implementation

Uses
 Objects,Drivers,Views,App,Dos;



type
 PWaitView  = ^TWaitView;
 TWaitView  = Object(TView)

              TickPosn    :  Integer;
              TextPos     :  TPoint;
              TextIs      :  String[20];
              TickStart   :  TPoint;

              constructor init(var Bounds :  TRect);
              procedure   TickOn;
              procedure   Draw; virtual;

              end;


 PWaitWindow = ^TWaitWindow;
 TWaitWindow = Object(TWindow)

               WaitView   :  PWaitView;

               constructor init(var Bounds : TRect; aTitle : TTitleStr);
               procedure   TickOn;

               end;

var
 Temp_Stack : array [0..16384] of byte;
 Wait_Box   : PWaitWindow;
 OldTimer   : pointer;
 OldExit    : pointer;
 TickCount  : longint;
 old_ss     : word;
 old_sp     : word;


procedure GrabTimer; forward;
procedure ReleaseTimer; forward;
procedure ProcessTimer(Flags, CS,
          IP, AX, BX,CX, DX, SI, DI, DS, ES, BP: Word); interrupt; forward;
procedure ExitWaitBox; far; forward;
procedure TickOn; forward;

procedure intoff; inline($FA); {CLI}
procedure inton; inline($FB); {STI}


{----------Objects-----------------}

constructor TWaitView.Init;


var
 R       : TRect;

begin
TView.Init(Bounds);
GetExtent(R);
TickPosn:=0;
TickStart.X:=((R.B.X-R.A.X) DIV 2 -3);
TickStart.Y:=R.B.Y-2;
TextIs:='Please Wait';
TextPos.Y:=R.A.Y+1;
TextPos.X:=((R.B.X-R.A.X) DIV 2) - (byte(TextIs[0]) DIV 2)
end;

procedure TWaitView.Draw;

begin
Owner^.Lock;
TView.Draw;
WriteStr(TextPos.X,TextPos.Y,TextIs,1);
WriteChar(TickStart.X,TickStart.Y,'-',3,6);
WriteChar(TickStart.X+TickPosn,TickStart.Y,'*',3,1);
Owner^.UnLock;
end;

procedure TWaitView.TickOn;

begin
 Inc(TickPosn);
 If TickPosn=6 then TickPosn:=0;
 DrawView;
end;


constructor TWaitWindow.Init;

var
 R : TRect;

begin
 TWindow.Init(Bounds,aTitle,wnNoNumber);
 Options:=(Options or ofCentered) AND NOT (ofSelectable);
 Flags:=0;
 GetExtent(R);
 R.Grow(-1,-1);
 WaitView:=New(PWaitView,Init(R));
 Insert(WaitView);
end;

procedure TWaitWindow.TickOn;

begin
 WaitView^.TickOn;
end;

procedure GrabTimer;

begin
 GetIntVec($1C,OldTimer);
 SetIntVec($1C,@ProcessTimer);
end;

procedure ReleaseTimer;

begin
 SetIntVec($1C,OldTimer);
end;

procedure ProcessTimer;

begin
asm {----Switch to temporary Stack so no unexpeceted stack overflows----}
 pushf {Push extra set of flags onto stack to iret comes back here}
 call dword ptr ds:[OldTimer];
 cli
 mov word ptr ds:[old_ss],ss;
 mov word ptr ds:[old_sp],sp;
 mov ax,ds;
 mov ss,ax;
 mov sp,offset temp_stack+16384;
end;
TickOn;
asm {Restore original stack & jump to next hook}
 mov ss,ds:[old_ss];
 mov sp,ds:[old_sp];
 end;
end;

procedure TickOn;

begin
If Wait_Box=nil then exit;
Inc(TickCount);
If TickCount=2 then
 begin
 TickCount:=0;
 Wait_Box^.TickOn;
 end;
end;

procedure ExitWaitBox;

begin
 ReleaseTimer;
 ExitProc:=OldExit;
end;

function WaitOn;

var
 R : TRect;
 TWait : PWaitWindow;

begin
intoff;
If Wait_Box<>nil then
 begin
 WaitOn:=-1;
 Exit;
 end;
R.Assign(1,5,14+byte(aTitle[0]),11);
TWait:=New(PWaitWindow,Init(R,aTitle));
DeskTop^.Insert(Twait);
Wait_Box:=TWait;
inton;
end;

function Waitoff;

var
 TWait : PWaitWindow;


begin
intoff;
TWait:=Wait_Box;
Wait_Box:=nil;
DeskTop^.Delete(TWait);
Dispose(TWait,Done);
Waitoff:=0;
inton;
end;

procedure InitWaitBox;

begin
 {exit;}
 Wait_Box:=nil;
 TickCount:=0;
 OldExit:=ExitProc;
 ExitProc:=@ExitWaitBox;
 GrabTimer;
end;


end.