Category : Files from Magazines
Archive   : ISSUE-33.ZIP
Filename : SYSTEM.FIG

type
RegisterRecord =
record case integer of
1:(AX, BX, CX, DX, BP,SI,DI,DS,ES,Flags: integer);
2:(AL,AH, BL,BH, CL,CH, DL,DH: byte);


type
game = record
TeamName: string[30];
case sport: (baseball, football) of
baseball: (inning: integer;
runs, hits, errors: integer;
BaseballTactics: (bunt, slide, steal,
badger, eject, homerun));
football: (quarter: integer;
points: integer;
penalties: integer;
FootballTactics: (kill, maim, sack, charge,
trap, bomb, tackle, block));
end; { game }

{========}

FUNCTION DiskSpaceFree: integer;
var
Registers : RegisterRecord;
Tracks, Sectors, BytesPerSector : integer;
begin
with Registers do
begin
fillchar( Registers, sizeof( Registers ), 0 );
AH:= $36; { function number }
DL:= 0; { choose LPT1 }
MSDOS( Registers ); { make service call }
Tracks:= BX;
Sectors:= AX;
BytesPerSector:= CX;
if AX = $FFFF then DiskSpaceFree:= AX
else DiskSpaceFree:= round( Sectors * BytesPerSector/1024.0 * Tracks );
end;
end; { DiskSpaceFree }

{========}

FUNCTION PrinterReady: boolean;
var
Status : byte;
Registers : RegisterRecord;
begin
fillchar( Registers, sizeof( Registers ), 0 );
with Registers do
begin
AH:= $01; { code to reset the printer }
DL:= $00; { printer number, 0 = LPT1 }
Intr( $17,Registers ); { call printer interrupt }
AH:= $02; { code for get the printer status }
DL:= $00; { printer number, 0 = LPT1 }
intr( $17,Registers ); { call printer interrupt }
Status:= AH;
end;
PrinterReady:= not Odd( Status shr 4 ); { test bit 4 }
end; { PrinterReady }

{========}

{ Note that there is no check in the procedure below to insure that the text
of the line will not wrap around to the next line; it is assumed that the
line will fit. Note also that the use of the Turbo whereX and whereY
functions assumes that the entire screen is being used. If you wish to use
this procedure with windows, it will be necessary to subtract the first
column number of the window from whereX and the first line number from
whereY in order to calculate the offset. }

type
string255 = string[255];

PROCEDURE SpeedWrite( Line : string255 );
const
ScreenSegment = $B800; { for color card, change to $B000 for monochrome }
var
Offset, i : integer;
begin
Offset:= pred( whereX )*2 + pred( whereY )*160; { calculate mem. location }
for i:= 1 to length( Line ) do
begin
Mem[ ScreenSegment:Offset ]:= ord( Line[i] ); { set character byte }
Offset:= Offset + 2; { skip attribute byte }
end;
gotoXY( whereX + length( Line ), whereY ); { move cursor to end of line }
end; { SpeedWrite }

{========}

{ This procedure swaps the colors of the character and the background at the
current cursor position, which effectively toggles reverse video on and off }

PROCEDURE InvertCharacter;
var
Registers : RegisterRecord;
begin
fillchar( Registers, sizeof( Registers ), 0 );
with Registers do
begin
AH:= 8; { code for read character and attribute at cursor location }
BH:= 0; { video page number, 0 = normally active page }
intr( $10,Registers ); { call video interrupt }
BL:= (AH shr 4) and $07 + (AH and $07) shl 4 + (AH and $08); { do invert }
BH:= 0; { video page number, as above }
AH:= 9; { code for write character and attribute }
CX:= 1; { number of characters to write }
intr( $10,Registers ); { call video interrupt }
end;
end; { InvertCharacter }

{========}

{ The following procedure will set the DTA to the memory location
defined by the values Segment and Offset. All subsequent disk
read and write data will be buffered at the new DTA, where you
can look at it and modify it if you like. Remember that the DTA
must be at least as large as the size of one sector. Default DTA
is located at 80h in the program segment prefix. }

PROCEDURE SetDataTransferArea( Segment, Offset : integer );
var
Registers : RegisterRecord;
begin
fillchar( Registers, sizeof( Registers ), 0 );
with Registers do
begin
AH:= $1A; { function code for set DTA }
DS:= Segment; { segment portion of address }
DX:= Offset; { offset portion of address }
MSDos( Registers ); { make service call }
end;
end; { SetDataTransferArea }

{========}

{ The following function returns the disk type of the drive number passed to
it, where fixed disk = F8h, quad density = F9h, SS 9 sector = FCh,
DS 9 sector = FDh, SS 8 sector = FEh, and DS 8 sector = FFh. }

PROCEDURE DiskType( Drive : byte );
var
Registers : RegisterRecord;
begin
fillchar( Registers, sizeof( Registers ), 0 );
with Registers do
begin
AH:= $1C; { function code for get FAT information }
DL:= Drive; { disk drive number, 0= Default, 1= A, etc. }
MsDos( Registers ); { make service call }
DiskType:= Mem[ DS:BX ];
end;
end; { DiskType }

{========}

{ The function below returns the number of the currently logged drive, where
for consistency's sake (0 often refers to the default drive) 1 = A, 2 = B,
and so on. }

FUNCTION CurrentDrive : byte;
var
Registers : RegisterRecord;
begin
fillchar( Registers, sizeof( Registers ), 0 );
with Registers do
begin
AH:= $19; { function code for get current drive number }
MsDos( Registers ); { make service call }
CurrentDrive:= succ( AL ); { 1 = A, 2 = B, etc. }
end;
end; { CurrentDrive }

{========}

{ The following procedure will turn the cursor on or off }

PROCEDURE TurnCursor( State : boolean );
const
Visible = 0;
Invisible = 1;
StartLine : integer = $06; { start and end lines should be changed }
EndLine : integer = $07; { for monochrome cards }
CursorType : integer = $00;
begin
fillchar( Registers, sizeof( Registers ), 0 );
with Registers do
begin
case State of
false : begin { blanks cursor }
CursorType:= Invisible;
CH:= CursorType shl 5 + StartLine;
CL:= EndLine;
end;
true : begin { sets cursor on }
CursorType:= Visible;
CH:= CursorType shl 5 + StartLine;
CL:= EndLine;
end;
end; { of case statement }
AH:= $01; { code for set cursor }
intr( $10, Registers ); { call video interrupt }
end;
end; { TurnCursor }