jdf@ptsfd.UUCP (Jack Fine) (04/02/86)
I am using ms-dos version 2.1 and Turbo Pascal version 2. I would like to see if anyone can help me with the code necessary to load a program in RAM and call it up when needed by key selection. Hardware will be both ibm pc and compaq. In case I am asking this question poorly let me rephrase it. I would like to make a turbo pascal program memory resident with control returned to dos and the program called up by typing a certain key (using the interrupt process I assume.) This would be like programs such as Sidekick, Graphlink, and so on... Thanks In Advance. Jack
gbs@voder.UUCP (George Smith) (04/03/86)
In article <316@ptsfd.UUCP>, jdf@ptsfd.UUCP (Jack Fine) writes: > > I would like to > see if anyone can help me with the code necessary to load a program in RAM > and call it up when needed by key selection. Hardware will be both ibm pc > > Jack I think I can help. First there are two magazine articles that are very good references about writing Terminate and Stay Resident programs for PC-DOS. They are: (1) Writing Desk Accessories by Tom Wadlow Fall 85 Special issue of Byte called Inside the IBM PCs (2) Interrupt Borrowing with Turbo Pascal by Stephen Davis Sep/Oct 1985 issue of Micro/Systems Journal Second, I have the source code for the THELP.PAS program that is mentioned in the article by Davis. It could be used as a skeleton for any program that needs to be TSR and callable by hitting a 'hot key'. I will mail it to those who request it (if there are a lot of requests, I will post it to net.micro.pc).
emv@ccunix.UUCP (Edward Vielmetti) (04/06/86)
In addition to THELP.PAS, there's a collection called STAYRES.PAS (written by Lane Ferris, "The Hunter's Helper") which I found on the Borland SIG (BOR-100) of Compuserve. These have been posted to <info-ibmpc> for those of you with arpa access. If you can't find them on a local BBS, try the Wipcus BBS (313) 663-1835 24hr 2400baud. A big problem with writing resident code in turbo is the overhead associated with it--at least 15K, even for small applications. Until Borland comes out with an optimizing Turbo, if you want to write *real* resident programs stick to a lower-level language. (My 640K machine is already full of all the resident stuff it can handle.) Edward Vielmetti, computing center MicroGroup, University of Michigan vielmetti%UMich-MTS.Mailnet@MIT-Multics.ARPA emv@madvax.UUCP (it's near ihnp4, but I don't know how near)
dowdy@cepu.UUCP (Dowdy Jackson) (04/07/86)
If anyone has any info on this , I too would like to be informed.... Thanks in advance Dowdy Jackson UCLA Dept of Neurology UCLA School of Medicine
riedl@purdue.UUCP (John T Riedl) (04/08/86)
I got the following program from usc-isib's info-ibmpc directory. It
is a well documented model for building memory resident TURBO
programs. Cut the code at both the cut lines, and enjoy!
------ cut here ------
{$C-}
{-----------------------------------------------------------------------------}
{ }
{ }
{ }
{ " S o r r y , D a v e, I C a n ' t D o T h a t . " }
{ }
{ }
{ Arthur C. Clark }
{ " 2 0 0 1 " }
{-----------------------------------------------------------------------------}
{ A Turbo "stay-resident" program clobbers the Dos register stack. It
jumps over the Turbo run-time initialization code that would set up the
program registers and environment. Secondly, a stay-resident program
could not ordinarily issue file I/O since that would clobber Dos interrupt
registers. Therefore, the following code proposes an inline solution,
providing a Turbo entry stack for "stay-resident" programs and allowing
those programs to issue Dos I/O and other interrupts.
This Turbo stay-resident demo has been put together to perform both Dos I/O
and Bios interrupts. It has also been tested for re-entrancy and
recursiveness on an IBM PC with PCDos .
Separate the include files, compile to a COM file and execute with the
Alt-F10 key. It will also free its memory and return to Dos with the
Ctrl-Home key at the "Press a key" prompt. (Illustrated in the Stayxit
file). Maximum free dynamic memory should be between A40-B00 since this
demo uses a recursive stack.
The Hunters Helper
L.Ferris
4268 26th St
San Francisco,Ca. 94131
[ 70357,2716 ] }
{-----------------------------------------------------------------------------}
{ This code has been tested/used on an IBM PC using PC-DOS 2.10 }
{-----------------------------------------------------------------------------}
{ Authors: Lane H. Ferris (Stay Resident Code)
Neil J. Rubenking (Directory code and ideas)
Jim Everingham (The Window Manager/Editor)
Other Public Gurus on whose shoulders we stand.
{ PURPOSE: This code will serve as a template to create other "Stay Resident"
programs in Turbo Pascal(tm). This code intercepts Int 16,
displacing original Interrupt 16 Vector to User Interrupt 68.
During execution of other programs, it can be invoked by the
special key combination specified by "Our_Char" (in this case
<Alt>-F10.)
}
Program Stay_Resident;
{ * * * * * * * CONSTANTS * * * * * * * * * * * * * * * * * * * * * * }
const
Our_Char = 113; {this is the scan code for AltF10}
Ctrl_Home = #119; {Control Home Scan Code }
Quit_Key = #119;
Ctrl_End = #117; {Control End Scan Code }
User_Int = $68; {place to put new interrupt}
Kybrd_Int = $16; {BIOS keyboard interrupt}
{ - - - - - - - T Y P E D E C L A R A T I O N S - - - - - - - - - - - - }
Type
Regtype = record Ax,Bx,Cx,Dx,Bp,Si,Di,Ds,Es,Flags:integer end;
HalfRegtype = record Al,Ah,Bl,Bh,Cl,Ch,Dl,Dh:byte end;
filename_type = string[64];
{ - - - - - - - T Y P E D C O N S T A N T S - - - - - - - - - - - - - - -}
Const
{regs is defined as a typed constant in order to get it in the code segment}
Regs : regtype = (Ax:0;Bx:0;Cx:0;Dx:0;Bp:0;Si:0;Di:0;Ds:0;Es:0;Flags:0);
OurDseg: integer = 0; {Our Data Segment Value }
OurSseg: integer = 0; {Our Stack Segment Value }
DosSseg: integer = 0; {Dos Stack Segment Value }
Inuse : Boolean = false; {Recursion flag }
{ - - - - - - - V A R I A B L E S - - - - - - - - - - - - - - - - - - - - - -}
Var
SaveRegs : regtype;
HalfRegs : halfregtype absolute regs;
Terminate_flag : boolean ;
Keychr : char ;
Old_Xpos,Old_Ypos : integer ;
{ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }
{ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }
{ Check Terminate Keys
{ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }
Procedure Chk_Term_Key;
{$I StayXit.Inc} {Check for Exit to Dos }
{-----------------------------------------------------------------------------}
{ G E T F I L E }
{-----------------------------------------------------------------------------}
procedure get_file;
{$I staysubs.inc}
var
attribyte,
OldAttribute : byte;
Xcursor : integer ;
Ycursor : integer ;
{----------------------------------------------------------------------------}
begin
filename := '*.*' ;
attribyte := 255 ;
OldAttribute := attribyte;
Xcursor := 2 ;
Ycursor := 1 ;
GotoXy(Xcursor,Ycursor) ;
Find_First(attribyte,filename,Retcode);
If Retcode = 0 then
begin
write(Filename);
Ycursor := Ycursor +1 ;
end;
{Now we repeat Find_Next until an error occurs }
repeat
Find_Next(attribyte,filename,Retcode);
if Retcode = 0 then
begin
GotoXY(Xcursor,Ycursor);
Write(filename) ;
Ycursor := Ycursor + 1 ;
if WhereY >= 14 then
begin
Xcursor := Xcursor + 16 ;
Ycursor := 1 ;
end;
if (Xcursor >= 50) and (Ycursor = 13 ) then
begin
Ycursor := Ycursor + 1;
GotoXY(Xcursor,Ycursor);
Write ('More...');
read ;
clrscr ;
Xcursor := 2 ;
Ycursor := 1 ;
end;
end;
until Retcode <> 0;
GotoXY(Xcursor,Ycursor); Write('Press a key . . .');
repeat until keypressed ;
Chk_Term_Key ; { See if Return to Dos }
end;
{-----------------------------------------------------------------------------}
{ D E M O }
{-----------------------------------------------------------------------------}
Procedure Demo ; { Give Demonstration of Code }
{$I WINDMNGR.INC}
begin
Add_Window(5,5,75,20,11,0,2);
Get_file;
Remove(1);
end; { Demo }
{----------------------------------------------------------------------------}
{ P R O C E S S I N T E R R U P T }
{ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }
Procedure Process_Intr;
{ PURPOSE: This procedure replaces the standard keyboard interrupt. If
anything but <Alt>-F10 is pressed, the key is passed on to the
standard keyboard interrupt. B*U*T when <Alt>- F10 is pressed,
this program takes over. The variable InUse is set to TRUE to
ensure that this code doesn't try to run "on top of itself " AND to
indicate to the Inline code to save/restore the original interrupt
regs.
}
Begin
{ K e y b o a r d Interrupt o c c u r s here }
{----------------------------------------------------------------------}
{$I Staysave.inc}
{----------------------------------------------------------------------}
{ Check the Int 16 request function in Ah reg:
0 = read character from Keyboard
1 = check character available
2 = check shift key values
}
if HalfRegs.Ah <> 0 then {if this is not character request...}
Begin
Intr(User_Int,Regs) { just pass it on to standard interrupt }
End
Else { HalfRegs.Ah = 0 then { This is a Character Request }
Begin {Get Keyboard Char }
Intr (User_Int, Regs); { Use the standard interrupt}
if (Halfregs.Ah = Our_Char) { Separate the test so code }
{ performs efficiently }
then if (not InUse) then
begin { Demo }
InUse := true; { "dont clobber saved stack"}
{ .
.
. Your
. Program
. Goes
. Here
.
} { Get current Cursor Position }
Old_Xpos := WhereX; Old_Ypos := WhereY;
Demo ;
GotoXY(Old_Xpos,Old_Ypos); { Put Cursor Back }
Regs.Ax := Ord(KeyChr) shl 8 ; {Give back Last entered char }
InUse := false; { ok to restore interrupted stack }
end { Demo }
end; {Get Keyboard Char }
{$I Stayrstr.inc} { Return to Caller }
end ;
{-----------------------------------------------------------------------}
{The main program installs the new interrupt routine and makes it permanently
resident as the keyboard interrupt. The old keyboard interrupt is addressed
through #68H, so it can still be used.
The following dos calls are used:
Function 25 - Install interrupt address
input al = int number,
ds:dx = address to install
Function 35 - get interrupt address
input al = int number
output es:bx = address in interrupt
Function 31 - terminate and stay resident
input dx = size of resident program obtained from the memory
allocation block at [Cs:0 - $10 + 3]
Function 49 - Free Allocated Memory
input Es = Block Segment to free
Interrupt 20 - Return to invoking process
}
{-----------M A I N B L O C K---------------------------------------------}
Begin {**main**}
InUse := false;
OurDseg:= Dseg; { Save the Data Segment Address for Interrupts }
OurSseg:= Sseg; { Save our Stack Segment for Interrupts }
Terminate_Flag := false ;
{now install the interrupt routine}
SaveRegs.Ax := $35 shl 8 + User_Int;
Intr($21,SaveRegs); {Check to make sure int not already used}
if SaveRegs.Es <> $00 then
WriteLn ('Interrupt in use -- can''t install Resident Turbo Code')
else
begin
{ Initialize Your Progam Here since you wont get control again
until "Our_Char" is entered from the Keyboard. }
SaveRegs.Ax := $35 shl 8 + Kybrd_Int;
Intr($21,SaveRegs); {get the address of keyboard interrupt }
SaveRegs.Ax := $25 shl 8 + User_Int;
SaveRegs.Ds := SaveRegs.Es;
SaveRegs.Dx := SaveRegs.Bx;
Intr($21,SaveRegs); { set the user-interrupt address to point
{ to the keyboard interrupt address }
SaveRegs.Ax := $25 shl 8 + Kybrd_Int;
SaveRegs.Ds := Cseg;
SaveRegs.Dx := Ofs(Process_Intr);
Intr ($21,SaveRegs); { set the keyboard interrupt to point to
"Process-Intr" above}
Writeln(' Turbo Stay-Resident Demo: Press Alt-F10');
{now terminate and stay resident}
{ Pass return code of zero }
SaveRegs.Ax := $31 shl 8 + 0 ; { Terminate and Stay Resident }
SaveRegs.Dx := MemW [Cseg-1:0003] ; { Prog_Size from Allocation Blk}
Intr ($21,SaveRegs);
end;
{ END OF RESIDENCY CODE }
end.
{****************************************************************************}
{ S T A Y S A V E . I N C }
{ }
{ This is the Staysave.Inc file included above }
{ }
{ Separate the code out into a file or replace the $I Staysave.Inc }
{ statement above with this code. }
{****************************************************************************}
{This Inline routine will save the regs and Stack for Stay resident programs.
It restores Ds and Ss from the previously saved integer constants "OurDseg"
and "OurSSeg". This is important since Dos is not re-entrant and any attempt
to use Interrupt I/O services will clobber the very stack on which the
Resident Turbo program just saved its regs. Thus, on the final return, you
and Toto will end up somewhere other than Kansas and without your Ruby Reds.
}
{ Arthor: L.H. Ferris
Distributed to the Public Domain for use without profit.
Original Version 5.15.85
}
{ On entry the Stack will already contain: }
{ 1) Sp for Dos }
{ 2) Bp for Dos }
{ 3) Ip for Dos }
{ 4) Cs for Dos }
Inline ( { 5) Flags for Dos }
$FA / { Cli Stop all interrupts }
{ Bp and Sp aready saved at Begin Stmt }
$55/ {Push Bp Save again for Regpak }
$BD/Regs/ {Mov Bp,offset REGS}
$2E/$89/$46/$00/ {CS:Mov [Bp+0],AX}
$2E/$89/$5E/$02/ {Cs:Mov [Bp+2],Bx}
$2E/$89/$4E/$04/ {CS:Mov [Bp+4],CX}
$2E/$89/$56/$06/ {CS:Mov [Bp+6],DX}
$2E/$8F/$46/$08/ {Pop Cs:[Bp+8] Fetch Bp from stack }
$2E/$89/$76/$0A/ {CS:Mov [Bp+A],SI}
$2E/$89/$7E/$0C/ {CS:Mov [Bp+C],DI}
$2E/$8C/$5E/$0E/ {CS:Mov [Bp+E],DS}
$2E/$8C/$46/$10/ {CS:Mov [Bp+10],ES}
$9C/ {PUSHF put Flags on stack to retrieve }
$2E/$8F/$46/$12/ {POP Cs:[Bp+12]}
{ If Current SS := [OurSseg] or Inuse = True, then dont save the stack. }
{ This program is being recursive. }
$2E/$80/$3E/Inuse/$01/ {Cmp Cs:[Inuse],1 }
$74/$4D/ {Je ReCurin ------J-U-M-P--------------- }
{ Now save 5 Words from the Dos Stack before performing any }
{ I/O or re-using the Dos stack }
$2E/$8C/$16/DosSSeg/ {Mov Cs:DosSSeg,SS Save Dos Stack Segment }
$8C/$D6/ {Mov Si,SS If this is our Stack Seg }
$8E/$C6/ {Mov Es,Si Get Dos StackSeg }
$2E/$8E/$16/OurSSeg/ {Mov SS,Cs:OurSSeg Get our Stack segment }
$2E/$8E/$1E/OurDseg/ {Mov Ds,Cs:Our_Ds Setup our Data Segment }
$2E/$3B/$36/OurSSeg/ {Cmp Si,Cs:OurSSeg ..use current Stack ptr }
$89/$E6/ {Mov Si,Sp ..value..else reset stack }
$74/$05/ {Je $+5 ..to original Turbo stack }
$3E/$8B/$36/$74/$01/ {Mov Si,Ds:[174] ..(cf. code at B2B 3.0x) }
$87/$F4/ {Xchg Sp,Si Set new Stack Pointer }
$2E/$FF/$76/$00/ {Push [Bp+0] Save Dos/User regs for Exit }
$2E/$FF/$76/$02/ {Push [Bp+2] Save Bx }
$2E/$FF/$76/$04/ {Push [Bp+4] Save Cx }
$2E/$FF/$76/$06/ {Push [Bp+6] Save Dx }
{Push [Bp+8] Save Bp }
$2E/$FF/$76/$0A/ {Push [Bp+A] Save Si }
$2E/$FF/$76/$0C/ {Push [Bp+C] Save Di }
$2E/$FF/$76/$0E/ {Push [Bp+E] Save Ds }
$2E/$FF/$76/$10/ {Push [Bp+10] Save Es }
$2E/$8E/$16/OurSSeg/ {Mov SS,Cs:OurSSeg Set up our Stack }
$56/ {Push Si Save bottom of Dos Stack }
$2E/$8C/$5E/$0E/ {Mov Cs:[Bp+E],Ds Set New Data Segmt in regs}
{Recurin Jump here if Recursion }
$FB {Sti Enable Interrupts }
) ;
{****************************************************************************}
{ S T A Y R S T R . I N C }
{ }
{ This is the StayRstr.Inc file included above }
{ Separate the code out into a file or replace the $I StayRstr.Inc }
{ statement above with this code. }
{****************************************************************************}
{ Inline Code to restore the stack and regs moved to the Turbo Resident
Program Stack to allow re-entrancy into the Dos Code for I/O and
recursion from built-in Turbo functions.
; Arthor: L.H. Ferris
; Distributed to the Public Domain for use without profit.
; Original Version 5.15.85
;----------------------------------------------------------------------;
; Restore the Dos Regs and Stack
;----------------------------------------------------------------------;
; On entry the Stack will already contain:
;
; 1) Bottom of Dos Stack Ptr
; 2) Dos Flags
; 3) Dos Code Segment
; 4) Dos Instruction Ptr
; 5) Dos Base Pointer
; 6) Dos Original Stack Ptr
}
inline(
$BD/Regs/ {Mov Bp,offset REGS}
$2E/$8B/$46/$00/ {CS:Mov Ax,[Bp+0]}
$2E/$8B/$5E/$02/ {Cs:Mov Bx,[Bp+2]}
$2E/$8B/$4E/$04/ {CS:Mov Cx,[Bp+4]}
$2E/$8B/$56/$06/ {CS:Mov Dx,[Bp+6]}
$2E/$8B/$76/$0A/ {CS:Mov Si,[Bp+A]}
$2E/$8B/$7E/$0C/ {CS:Mov Di,[Bp+C]}
$2E/$8E/$5E/$0E/ {CS:Mov DS,[Bp+E]}
$2E/$8E/$46/$10/ {CS:Mov ES,[Bp+10]}
$2E/$FF/$76/$12/ {Push Cs:[Bp+12]}
$9D/ {Popf}
{ If [Cs:InUse]:= True, then dont restore the stack. This program is }
{ being recursive. Else restore Dos Stack and Program Entry registers }
$2E/$80/$3E/Inuse/$01/ {Cmp byte ptr Cs:[Inuse],1 }
$74/$12/ {Je ReCurOut }
$FA / { Cli ; Stop all interrupts }
$5D/ {Pop Bp Save Dos Sp across pops }
$07/ {Pop Es }
$1F/ {Pop Ds }
$5F/ {Pop Di }
$5E/ {Pop Si }
$5A/ {Pop Dx }
$59/ {Pop Cx }
$5B/ {Pop Bx }
$44/$44/ {Inc sp/Inc sp Thow old Ax value away }
$89/$EC/ {Mov Sp,Bp Setup Dos Stack Ptr }
$2E/$8E/$16/DosSSeg/ {Mov SS,Cs:DosSSeg Give back Dos Stack }
{RecurOut Clean up the Stack }
$5D/ {Pop Bp Throw away old dos Sp }
$BD/Regs/ {Mov Bp,offset REGS}
$2E/$FF/$76/$12/ {Push Cs:[Bp+12]}
$9D/ {Popf}
$5D/ {Pop Bp Retrieve old BP }
$FB/ {Sti Enable interrupts }
$CA/$02/$00 {Ret Far 002 }
);
{****************************************************************************}
{ S T A Y S U B S . I N C }
{ }
{ Separate this file into "Staysubs.Inc" to provide Directory routines }
{ for the Stay-Resident Demo. }
{ }
{****************************************************************************}
{----------------------------------------------------------------------------}
{ F I L E S U B R O U T I N E S }
{----------------------------------------------------------------------------}
type
Dir_Entry = record
Reserved : array[1..21] of byte;
Attribute: byte;
Time, Date, FileSizeLo, FileSizeHi : integer;
Name : string[13];
end;
var
RetCode : byte;
Filename : filename_type;
Buffer : Dir_Entry;
Attribute : byte;
{----------------------------------------------------------------------------}
{ S E T Disk Transfer Address }
{----------------------------------------------------------------------------}
Procedure Disk_Trns_Addr(var Disk_Buf);
var
Registers : regtype;
Begin
with Registers do
begin
Ax := $1A shl 8; { Set disk transfer address to }
Ds := seg(Disk_Buf); { our disk buffer }
Dx := ofs(Disk_Buf);
msdos(Registers);
end;
end;
{----------------------------------------------------------------------------}
{ F I N D N E X T F I L E E N T R Y }
{----------------------------------------------------------------------------}
Procedure Find_Next(var Att:byte; var Filename : Filename_type;
var Next_RetCode : byte);
var
Registers : regtype;
Carry_flag : integer;
N : byte;
Begin {Find_Next}
Buffer.Name := ' '; { Clear result buffer }
with Registers do
begin
Ax := $4F shl 8; { Dos Find next function }
MsDos(Registers);
Att := Buffer.Attribute; { Set file attribute }
Carry_flag := 1 and Flags; { Isolate the Error flag }
Filename := ' ';
if Carry_flag = 1 then
Next_RetCode := Ax and $00FF
else
begin { Move file name }
Next_RetCode := 0;
for N := 0 to 12 do FileName[N+1] := Buffer.Name[N];
end;
end; {with}
end;
{----------------------------------------------------------------------------}
{ F I N D F I R S T F I L E F U N C T I O N }
{----------------------------------------------------------------------------}
Procedure Find_First (var Att: byte;
var Filename: Filename_type;
var RetCode_code : byte);
var
Registers :regtype;
Carry_flag :integer;
Mask, N :byte;
begin
Disk_Trns_Addr(buffer);
Filename[length(Filename) + 1] := chr(0);
Buffer.Name := ' ';
with Registers do
begin
Ax := $4E shl 8; { Dos Find First Function }
Cx := Att; { Attribute of file to fine }
Ds := seg(Filename); { Ds:Dx Asciiz string to find }
Dx := ofs(Filename) + 1;
MsDos(Registers);
Att := Buffer.Attribute; { set the file attribute byte }
{ If error occured set, Return code. }
Carry_flag := 1 and Flags; { If Carry flag, error occured }
{ and Ax will contain Return code }
if Carry_flag = 1 then
begin
RetCode_code := Ax and $00FF;
end
else
begin
RetCode_code := 0;
Filename := ' ';
for N := 0 to 12 do FileName[N+1] := Buffer.Name[N];
end;
end; {with}
end;
{****************************************************************************}
{ S T A Y X I T . I N C }
{ }
{ Separate this file into "StayXIT.Inc" to provide a "Go-non-Resident" }
{ routine or the Stay-Resident Demo. }
{ }
{****************************************************************************}
{-----------------------------------------------------------------------------}
{ Stay_Xit Check Terminate Keys }
{ }
{ Check for Ctrl_Home key. Free the Environment , the program segment }
{ memory and return to Dos. Programs using this routine ,must be the }
{ last program in memory, else ,a hole will be left causing Dos }
{ to go GooGoo . }
{-----------------------------------------------------------------------------}
Begin { Block }
if Keypressed then
Begin { Keypressed }
While Keypressed do read (Kbd,Keychr);
If Keychr = Quit_Key then
Begin { Terminate }
Writeln ('Stay-Resident program Terminating') ;
SaveRegs.Ax := $35 shl 8 + User_Int;
MsDos(SaveRegs); {get the original Int 16 Addr }
SaveRegs.Ax := $25 shl 8 + Kybrd_Int;
SaveRegs.Ds := SaveRegs.Es;
SaveRegs.Dx := SaveRegs.Bx; { set the user-interrupt address to }
MsDos(SaveRegs); { the keyboard interrupt address }
MemW[$00:User_Int * 4] := 0 ; { Clear User Interrupt vector }
MemW[$00:User_Int * 4 + 2] :=0;
Saveregs.Ax := $49 shl 8 + 0 ; { Free Allocated Block function}
Saveregs.Es := MemW[Cseg:$2C] ; { Free environment block }
MsDos( Saveregs ) ;
Saveregs.Ax := $49 shl 8 + 0 ; { Free Allocated Block function}
Saveregs.Es := Cseg ; { Free Program }
MsDos( Saveregs ) ;
Intr($20,Regs) ; { Return to Dos }
End { Terminate } ;
End { Keypressed };
End { Block };
{****************************************************************************}
{ W I N D M N G R . I N C }
{ }
{ Separate this file into "WindMngr.Inc" to provide a Window for }
{ the Stay-Resident Demo. }
{ }
{****************************************************************************}
{ Window Manager/Editor System Include file .. }
{ Author:
Jim Everingham (The Window Manager/Editor) }
Const
MaxScreens = 8; { Number of Windows Allowed, do not Change }
Screen_seg = $B800; { Change to #B000 for MonoChrome, Change
then # sign to a Dollar sign Though. }
Data_Addr = $0000;
Fc : Array[1..4, 1..7] of Integer
= ((218, 196, 191, 179, 192, 196, 217),
(201, 205, 187, 186, 200, 205, 188),
(213, 205, 184, 179, 212, 205, 190),
(219, 219, 219, 219, 219, 219, 219));
type maxstr = string[80];
window_rec = record
x1,x2,y1,y2,c1,b1,w1,w2: Integer;
Screen: Array[1..4000] of byte;
end;
var Stack_Top,Last_Window_Num,
line_pos,F1 : Integer;
screen : Array[1..4000] of byte;
real_screen : Array[1..4000] of byte absolute Screen_Seg:Data_Addr;
Page_1 : Array[1..4000] of byte absolute Screen_Seg:$1000;
Imig : Array [1..MaxScreens] of Window_rec;
Original : Array[1..4000] of byte;
Coords : Array[1..8,1..MaxScreens] of Integer;
{----------------------------------------------------------------------------}
{ S E T _ P A G E }
{----------------------------------------------------------------------------}
procedure set_page(page: byte);
type
Result =
record
AX,BX,CX,DX,BP,SI,DI,DS,ES,Flags: byte;
end;
var rec:result;
begin
Rec.AX := page;
Rec.BX := $05;
Intr($10,Rec);
end;
{----------------------------------------------------------------------------}
{ S C R N _ O F F }
{----------------------------------------------------------------------------}
Procedure Scrn_off;
begin
inline($52/$50/$ba/$d8/$03/$b0/$21/$ee/$58/$5a)
end;
{----------------------------------------------------------------------------}
{ S C R N _ O N }
{----------------------------------------------------------------------------}
Procedure Scrn_on;
begin
inline($52/$50/$ba/$d8/$03/$b0/$29/$ee/$58/$5a)
end;
{----------------------------------------------------------------------------}
{ A C T I V E }
{----------------------------------------------------------------------------}
Function active: integer;
begin
active:=stack_top
end;
{----------------------------------------------------------------------------}
{ P U S H }
{----------------------------------------------------------------------------}
Procedure Push(Ulx, Uly, Lrx, Lry, Foreground, Background: integer);
{ This procedure Saves screens in memory. When a new window is put
on the Screen, the preceding window is stored away for later reference.}
begin
{ If last Window up, move the Original Screen into Screen Memory}
if stack_top = 0 then
begin
Scrn_off;
move(real_screen, Original, 4000);
Scrn_on
end;
{Save all Data concerning the windows}
if (Stack_top < MaxScreens) and (Stack_Top >= 0) then
begin
Stack_top:=Stack_top+1;
Imig[Stack_top].x1:=Ulx;
Imig[Stack_top].y1:=Uly;
Imig[Stack_top].x2:=Lrx;
Imig[Stack_top].y2:=Lry;
Imig[stack_top].c1:=Foreground;
Imig[Stack_top].b1:=Background
end;
{ Push Screen on Stack ... Sort of... }
Scrn_off;
Move(real_screen,Imig[Stack_top].Screen,4000);
Scrn_on
end;
{----------------------------------------------------------------------------}
{ P O P }
{----------------------------------------------------------------------------}
Procedure Pop;
{ This Procedure takes the screen that procedes the current window and
Copies back to screen memory, restores all data concerning the previous
window and activates it.. Neat huh? }
begin
{ If no windows are active, save the current screen }
if stack_top =0 then
begin
normvideo;
window(1,1,80,25);
Scrn_off;
move(Original, real_screen, 4000);
Scrn_on;
end;
{ Get Preceding screen and copy it to screen memory }
Scrn_off;
Move(Imig[Stack_top].Screen,Real_Screen,4000);
Scrn_on;
Stack_top:=Stack_top-1
end;
{----------------------------------------------------------------------------}
{ W R I T E X Y }
{----------------------------------------------------------------------------}
Procedure Writexy(long_string:maxstr; xcoord,ycoord:integer; var color: integer);
{ This procedure Draws whatever you want, wherever you want, by changing the
value of Screen in the variable declaration, it can draw a "Picture" any-
were in memory. This allows for the Speed of the window making process..}
var str_len, real_pos, scr_pos: integer;
begin
{$I-}
str_len:=length(long_string); { So I know how much to write }
Scr_pos:=0;
{ The next 8 lines write the string in every "even" location in memory
and ever odd location gets the attribute with determines how the
string is displayed on the screen}
for real_pos:=1 to str_len do
if scr_pos < 4001 then
begin
scr_pos:=((xcoord*2)-1)+(ycoord*160);
screen[scr_pos]:=ord(copy(long_string,real_pos,1));
screen[scr_pos+1]:=color;
xcoord:=xcoord+1;
end
{$I+}
end;
{----------------------------------------------------------------------------}
{ F R A M E }
{----------------------------------------------------------------------------}
Procedure Frame(WindowType, UpperLeftX, UpperLeftY, LowerRightX, LowerRightY, color: Integer);
{ This procedure draws the window frame in another part of memory. }
var i: integer;
begin
WriteXY(chr(Fc[WindowType,1]),UpperLeftX, UpperLeftY,color);
for i:=UpperLeftX+1 to LowerRightX-1 do WriteXY(chr(Fc[WindowType,2]),i,UpperleftY,color);
WriteXY(chr(Fc[WindowType,3]),i+1,UpperleftY,color);
for i:=UpperLeftY+1 to LowerRightY-1 do
begin
WriteXY(chr(Fc[WindowType,4]),UpperLeftX , i,color);
WriteXY(chr(Fc[WindowType,4]),LowerRightX, i,color);
end;
WriteXY(chr(Fc[WindowType,5]),UpperLeftX, LowerRightY, color);
for i:=UpperLeftX+1 to LowerRightX-1 do WriteXY(chr(Fc[WindowType,6]),i,LowerrightY,color);
WriteXY(chr(Fc[WindowType,7]),i+1,LowerRightY,color);
end { Frame };
{----------------------------------------------------------------------------}
{ I N I T I A L I Z E }
{----------------------------------------------------------------------------}
Procedure initialize;
{ Set up memory and the stack }
var i:integer;
begin
Stack_top:=0;
move(real_screen,screen,4000);
with imig[1] do for i:=1 to 4000 do screen[i]:=$00;
for i:=2 to 9 do move(Imig[i-1].screen,imig[i].screen,4000);
move(imig[1].screen,screen,4000);
move(imig[1].screen,original,4000)
end;
{----------------------------------------------------------------------------}
{ A D D _ W I N D O W }
{----------------------------------------------------------------------------}
Procedure Add_window(UpperLeftX,UpperLeftY,LowerRightX,LowerRightY,Foreground,
BackGround, WindowType: Integer);
{ This procedure does all the laborous work for you.. The variables make it
Fairly easy to understand. }
Var i,j,k,Color: Integer;
begin
Imig[Stack_top].w1:=whereX;
Imig[Stack_top].w2:=WhereY;
UpperLeftX:=UpperLeftX+1;
LowerRightX:=LowerRightX-1;
LowerRightY:=LowerRightY-2;
f1:=WindowType;color:=0;
Scrn_off;
move(real_screen,screen,4000);
Scrn_on;
{ Set color attribute for direct writeng to memory }
if background < 17 then Color:=foreground+(background*16);
{ Check for invalid window frame types }
if (WindowType > 5) or (WindowType < 0) then
begin
Clrscr;
Writeln('Invalid Frame Type!')
end
else
{ If the window is valid then Procede }
begin
{ Fill color Attribute of window directly into memory }
k:=1;
for j:=UpperLeftY to LowerRightY do
for i:=UpperLeftX to LowerRightX do
begin
k:=(j*160)+(i*2);
Screen[k]:=Color;
Screen[k-1]:=$20
end;
{ Frame Window }
Case Windowtype of
1:Frame(WindowType,UpperLeftX-1,UpperLeftY-1,
LowerRightX+1,LowerRightY+1,
color);
2:Frame(WindowType,UpperLeftX-1,UpperLeftY-1,
LowerRightX+1,LowerRightY+1,
color);
3:Frame(WindowType,UpperLeftX-1,UpperLeftY-1,
LowerRightX+1,LowerRightY+1,
color);
4:Frame(WindowType,UpperLeftX-1,UpperLeftY-1,
LowerRightX+1,LowerRightY+1,
color);
end { Case }
end;
{ Activate newly formed window }
Window(1,1,80,25);
Window(UpperLeftX,UpperLeftY+1,LowerRightX,LowerRightY+1);
push(UpperLeftx,UpperLeftY+1,LowerRightX,LowerRightY+1,Foreground, Background);
Scrn_off;
Move(screen,real_screen,4000);gotoxy(1,1);
Scrn_on;
Textcolor(Foreground);TextBackground(backGround);ClrScr;
end;
{----------------------------------------------------------------------------}
{ C O L O R _ W I N D O W }
{----------------------------------------------------------------------------}
Procedure Color_window(Foreground, Background: integer);
{ This procedure allows you to change the foreground and background color
of the active window. }
var i,j,Color: Integer;
begin
{ Set Attribute value }
if background < 8 then Color:=foreground+(background*16);
{ Write new attribute direclty to screen memory }
for j:=(Imig[Stack_top].y1-2) to Imig[Stack_top].y2 do
for i:=(Imig[Stack_top].x1-1) to (Imig[Stack_top].x2+1) do
begin
Real_Screen[(j*160)+(i*2)]:=Color
end
end;
{----------------------------------------------------------------------------}
{ R E M O V E }
{----------------------------------------------------------------------------}
Procedure Remove(Num_to_Remove: Integer);
{ This Procedure removes 1 or a specified number of windows from the
screen and reactivates the underlying window }
var i: integer;
begin
if (Num_to_Remove > 0) and (Num_to_Remove < MaxScreens) then
for i:=1 to Num_to_remove do Pop
else
Pop;
Window(1,1,80,25);
Window(Imig[Stack_top].x1+1,Imig[Stack_top].y1,Imig[Stack_top].x2,Imig[Stack_top].y2);
gotoxy(1,1);
TextBackground(Imig[Stack_top].b1);TextColor(Imig[Stack_top].c1);
GotoXY((Imig[Stack_top].w1-1),Imig[Stack_top].w2)
end;
{----------------------------------------------------------------------------}
{ W I N D O W _ T I T L E }
{----------------------------------------------------------------------------}
Procedure Window_Title(Name: Maxstr; color:integer);
var i, k, l, m: integer;
begin
If Length(name)>0 then
begin
l:=1;
color:=color+(Imig[Stack_top].b1*16);
if f1 < 4 then Real_Screen[(((Imig[Stack_top].Y1-2)*160)+(Imig[Stack_top].X1*2))+l]:=$5b;
for i:=1 to length(Name) do
begin
k:=(((Imig[Stack_top].Y1-2)*160)+(Imig[Stack_top].X1*2))+l+1;
Real_Screen[k+1]:=ord(copy(Name,i,1));
Real_Screen[k+2]:=color;
l:=l+2
end;
if f1 < 4 then Real_Screen[k+3]:=$5d
end
end;
{ Thats all.. }
------- cut here too --------
John Riedl
{ucbvax,decvax,hplabs}!purdue!riedl -or- riedl@mordred.Purdue.EDU