Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/CRTI.ZIP/CRTI.PAS

Pascal/Delphi Source File | 1988-03-03 | 17.3 KB | 350 lines

UNIT CRTi; {version 1.00 of 03/03/88}

{Copyright (c) 1988 by Carley Phillips.  Placed in the PUBLIC DOMAIN.}

{
Many of the message threads on Compuserve's BPROGA DL 2 involve the use (and
mis-use) of the CRT unit provided with Turbo 4.  These routines were written
to take some of the mystery out of what CRT routines do and do not do.

This unit is an input-only replacement for Borland's CRT.  This means that:
1. only the input and the misc functions (e.g. Sound) are implemented;
2. the parts which have to do with screen output are omitted; and
3. you have access to the source so you can change what you don't like.

This allows your programs to avoid USEing CRT at all if your video output
is done with Qwik40, FastWrite, or other packages.  If you use CRTi anywhere,
then make sure none of your units use CRT because the conflicts which may
result may be very difficult to debug.

Note that the equivalent of a Turbo variable (which they should have made
public) is contained in HadControlBreak.  This is the variable set by the
control-break handler if CheckBreak is true.  Normally Turbo tests this
during ReadKey and during screen output.  Your program can test this at
any time, however, such as in your replacement screen routines or during
a long mathematical calculation.

There are two new public routines here:
1. a keyboard flushing routine; and
2. an abort routine you can call if your program finds HadControlBreak true.

I will update these routines if anyone notifies me of bugs or of any way in
which these routines do not provide satisfactory duplicates of Borland
functionality.

Comments, suggestions, bug reports, etc. should be sent on Compuserve (via
EasyPlex since I'm not necessarily on every few days) to

Carley Phillips, 76630,3312.
}

{*****************************************************************************}
INTERFACE

var
   CheckBreak      : boolean; {false means ignore ^Break}
   SaveInt1B       : pointer; {where old interrupt 1B address is saved}
   HadControlBreak : boolean; {set by ^Break handler if CheckBreak true}

procedure Delay (mSec : word);
{
Direct replacement for CRT.Delay.  Delays mSec number of milliseconds.

Note that, like Borland's CRT unit, a delay count is determined during
initialization.  This means that if you change your machine speed after
starting a program, the delay values will no longer be what you intended them
to be.
}

procedure Sound (Hz : word);
{
Direct replacement for CRT.Sound.  Starts a Hz frequency tone until it is
turned off by NoSound.
}

procedure NoSound;
{
Direct replacement for CRT.NoSound.  Stops a tone started with Sound.
}

function Keypressed : boolean;
{
Direct replacement for CRT.Keypressed.  If you like, you can also check for
a control break here by un-commenting the indicated lines.
}

function ReadKey : char;
{
Direct replacement for CRT.ReadKey.
}

procedure FlushKeyboard;
{
NEW public routine to flush the BIOS keyboard buffer.  That is, unless the
user is extraordinarily lucky with his timing of new input, Keypressed will
be false immediatedly following FlushKeyboard.  Normally one flushes the
keyboard buffer in situations such as displaying an error message and then
waiting on the user to press a key.  If the buffer is not flushed, then the
user may have typed ahead enough that the error message will be on the screen
for too short a time to be read.
}

procedure ControlBreakAbort;
{
NEW public abort routine called when ReadKey detects that an allowed ^Break has
been entered.  Borland does something similar, but you are free to replace this
with other code or even an external routine.  Alternatively, you can use this
routine from your code if you find that HadControlBreak has become true.
}

{*****************************************************************************}
IMPLEMENTATION

var
   Cpm : word;   {counts per msec; initialized by InitDelay; used by Delay}
   Scan: byte;   {saves scan code for Keypressed and ReadKey}
   ExitSave : pointer; {place to save old ExitProc}

{*****************************************************************************}
procedure Delay (mSec : word);
begin
Inline(                  {Assembly by Inline 03/03/88 22:28}
  $8B/$56/<MSEC/         {         mov    DX,[BP+<mSec];get number of msec}
  $09/$D2/               {         or     DX,DX       ;check it}
  $74/$17/               {         jz     quit        ;quit if 0 delay}
  $BF/>CPM/              {         mov    DI,>Cpm     ;setup addr for subr}
  $8B/$05/               {         mov    AX,[DI]     ;delay count for 1msec}
  $89/$C1/               {onemsec: mov    CX,AX       ;init delay subr counter}
  $E8/$06/$00/           {         call   subr        ;call delay subr}
  $4A/                   {         dec    DX          ;count that we've done 1}
  $75/$F8/               {         jnz    onemsec     ;loop for each msec}
  $E9/$07/$00/           {         jmp    quit        ;skip over subroutine}
  $3A/$05/               {subr:    cmp    AL,[DI]     ;check if constant chngd}
  $75/$02/               {         jnz    out         ;it never will change}
  $E2/$FA/               {         loop   subr        ;count and loop for msec}
  $C3                    {out:     ret                ;return from local subr}
 );                      {quit:                       ;label for end of inline}
end;

{*****************************************************************************}
procedure Sound (Hz : word);
begin
Inline(                  {Assembly by Inline 03/03/88 22:28}
  $8B/$4E/<HZ/           {         mov    CX,[BP+<Hz] ;get frequency}
  $B8/$DD/$34/           {         mov    AX,$34DD    ;load lsh of 1,193,181}
  $BA/$12/$00/           {         mov    DX,$0012    ;load msh of 1,193,181}
  $39/$CA/               {         cmp    DX,CX       ;check frequency}
  $73/$1A/               {         jnb    quit        ;quit if too small}
  $F7/$F1/               {         div    CX          ;calculate timer divider}
  $89/$C1/               {         mov    CX,AX       ;save quotient}
  $E4/$61/               {         in     AL,$61      ;get sense data}
  $A8/$03/               {         test   AL,$03      ;check for two lsb}
  $75/$08/               {         jnz    set         ;skip if on}
  $0C/$03/               {         or     AL,$03      ;turn on two lsb}
  $E6/$61/               {         out    $61,AL      ;turn them on}
  $B0/$B6/               {         mov    AL,$B6      ;load control value}
  $E6/$43/               {         out    $43,AL      ;output to timer control}
  $88/$C8/               {set:     mov    AL,CL       ;get lsh of quotient}
  $E6/$42/               {         out    $42,AL      ;output to timer2}
  $88/$E8/               {         mov    AL,CH       ;get msh of quotient}
  $E6/$42                {         out    $42,AL      ;output to timer2}
 );                      {quit:                       ;label for end of inline}
end;

{*****************************************************************************}
procedure NoSound;
begin
Inline(                  {Assembly by Inline 03/03/88 22:28}
  $E4/$61/               {         in     AL,$61      ;get sense data}
  $24/$FC/               {         and    AL,$FC      ;turn off two lsb}
  $E6/$61                {         out    $61,AL      ;put it back}
 );                      {quit:                       ;label for end of inline}
end;

{*****************************************************************************}
function KeyPressed : boolean;
begin
(*
   if HadControlBreak then   {un-comment this if you want to check ^Break here}
      ControlBreakAbort;
*)
Inline(                  {Assembly by Inline 03/03/88 22:28}
  $80/$3E/>SCAN/$00/     {         cmp    Byte Ptr[>Scan],$00;check scan code}
  $75/$08/               {         jnz    yes         ;not 0 = we saved one}
  $B4/$01/               {         mov    AH,$01      ;check for char}
  $CD/$16/               {         int    $16         ;using BIOS}
  $B0/$00/               {         mov    AL,$00      ;assume we had none}
  $74/$02/               {         jz     quit        ;Z flag means we didn't}
  $B0/$01/               {yes:     mov    AL,$01      ;load "true"}
  $88/$46/$FF);          {quit:    mov    [BP-01],AL  ;save final value}
end;

{*****************************************************************************}
function ReadKey : char;
begin
Inline(                  {Assembly by Inline 03/03/88 22:28}
  $B0/$00/               {         mov    AL,0        ;load a zero}
  $86/$06/>SCAN/         {         xchg   [>Scan],AL  ;xchg with scan code}
  $08/$C0/               {         or     AL,AL       ;check for saved code}
  $75/$12/               {         jnz    saveit      ;not 0 = we had one}
  $30/$E4/               {         xor    AH,AH       ;read char}
  $CD/$16/               {         int    $16         ;using BIOS}
  $08/$C0/               {         or     AL,AL       ;check "char" we got}
  $75/$0A/               {         jnz    saveit      ;not 0 = got normal char}
  $88/$26/>SCAN/         {         mov    [>Scan],AH  ;save extended scan code}
  $08/$E4/               {         or     AH,AH       ;check scan code}
  $75/$02/               {         jnz    saveit      ;not = 0 means not ^Brk}
  $B0/$03/               {         mov    al,$03      ;use "normal" ^C instead}
  $88/$46/$FF);          {saveit:  mov    [BP-1],AL   ;save final char}
   if HadControlBreak then
      ControlBreakAbort;
end;

{*****************************************************************************}
procedure FlushKeyboard;
begin
Inline(                  {Assembly by Inline 03/03/88 22:28}
  $B4/$01/               {flush:   mov    AH,$01      ;check for char}
  $CD/$16/               {         int    $16         ;using BIOS}
  $74/$06/               {         jz     empty       ;Z flag means none there}
  $30/$E4/               {         xor    AH,AH       ;read char}
  $CD/$16/               {         int    $16         ;using BIOS}
  $EB/$F4/               {         jmp    flush       ;loop until no more}
  $C6/$06/>SCAN/$00);    {empty:   mov    Byte Ptr [>Scan],0;clear saved code}
end;

{*****************************************************************************}
procedure ControlBreakAbort;
begin
   HadControlBreak := false;
   FlushKeyboard;
Inline(                  {Assembly by Inline 03/03/88 22:28}
  $BB/$07/$00/           {         mov    BX,$0007    ;pg 0; graphics fg color}
  $B8/$07/$0E/           {         mov    AX,$0E07    ;load a BEL}
  $CD/$10/               {         int    $10         ;output using BIOS}
  $B8/$5E/$0E/           {         mov    AX,$0E5E    ;load a '^'}
  $CD/$10/               {         int    $10         ;output using BIOS}
  $B8/$43/$0E/           {         mov    AX,$0E43    ;load a 'C'}
  $CD/$10/               {         int    $10         ;output using BIOS}
  $B8/$0D/$0E/           {         mov    AX,$0E0D    ;load a CR}
  $CD/$10/               {         int    $10         ;output using BIOS}
  $B8/$0A/$0E/           {         mov    AX,$0E0A    ;load a LF}
  $CD/$10/               {         int    $10         ;output using BIOS}
  $CD/$23                {         int    $23         ;control-C interrupt}
                         {;Note that DOS manual says only DOS should do this.}
                         {;However, Turbo issues this interrupt directly in}
                         {;these same circumstances.  It is probably ok since}
 );                      {;Turbo has hooked this interrupt.}
end;

{*****************************************************************************}
{this is not public}
procedure InitDelay;
{
Right after loading, this routine executes, for 1 timer tick (55 msec) a delay
subroutine which is identical to that contained in the public Delay routine.
From the count generated, it is possible to calculate what the count would have
been for 1 millisecond and save this count in Cpm for later use by Delay.
Note that, like Borland's CRT unit, this count is determined during
initialization.  This means that if you change your machine speed after
starting a program, the delay values will no longer be what you intended them
to be.
}
begin
Inline(                  {Assembly by Inline 03/03/88 22:28}
  $1E/                   {         push   DS          ;save DS}
  $B8/$40/$00/           {         mov    AX,$0040    ;BIOS data segment}
  $8E/$D8/               {         mov    DS,AX       ;into DS}
  $BF/$6C/$00/           {         mov    DI,$6C      ;offset for lsh of timer}
  $8A/$05/               {         mov    AL,[DI]     ;get lsb of timer}
  $3A/$05/               {sync:    cmp    AL,[DI]     ;check if timer changed}
  $74/$FC/               {         jz     sync        ;loop until it changes}
  $8A/$05/               {         mov    AL,[DI]     ;get new timer value}
  $B9/$FF/$FF/           {         mov    CX,$FFFF    ;initialize large count}
  $E8/$12/$00/           {         call   subr        ;call delay subr}
  $1F/                   {         pop    DS          ;restore DS}
  $89/$C8/               {         mov    AX,CX       ;count to lsh of dividnd}
  $F7/$D0/               {         not    AX          ;AX=count for 55 msec}
  $31/$D2/               {         xor    DX,DX       ;clear msh of dividend}
  $B9/$37/$00/           {         mov    CX,55       ;msec per timer tick}
  $F7/$F1/               {         div    CX          ;compute count for 1 msec}
  $A3/>CPM/              {         mov    [>Cpm],AX   ;save count for Delay}
  $E9/$07/$00/           {         jmp    quit        ;skip over subroutine}
  $3A/$05/               {subr:    cmp    AL,[DI]     ;check if timer changed}
  $75/$02/               {         jnz    out         ;quit after 1 timer tick}
  $E2/$FA/               {         loop   subr        ;count and loop}
  $C3                    {out:     ret                ;return from local subr}
 );                      {quit:                       ;label for end of inline}
end;

{*****************************************************************************}
{this is not public}
procedure ControlBreakHandler (Flags,CS,IP,AX,BX,CX,DX,SI,DI,DS,ES,BP: word);
interrupt;
{
Initialization code sets this up as the interrupt handler for a $1B (control-
break interrupt.  All it does is set a flag for checking by other routines.
}
begin
   HadControlBreak := CheckBreak;
end;

{*****************************************************************************}
{this is not public}
procedure InitControlBreak;
{
Initialization routine to install ControlBreakHandler as the interrupt $1B
handler.  The old vector is saved in the public SaveInt1B just as in CRT.
This could be done totally in Turbo (without inline) but would require this
unit to USE the DOS unit.
}
var
   OurAdr : pointer;
begin
   OurAdr := @ControlBreakHandler;
Inline(                  {Assembly by Inline 03/03/88 22:28}
  $B8/$1B/$35/           {         mov    AX,$351B    ;setup for interrupt 1B}
  $CD/$21/               {         int    $21         ;get old int vector}
  $89/$1E/>SAVEINT1B/    {         mov    [>SaveInt1B],BX;save offset}
  $8C/$C3/               {         mov    BX,ES       ;get segment}
  $89/$1E/>SAVEINT1B+2/  {         mov    [>SaveInt1B+2],BX;save segment}
  $8B/$56/<OURADR/       {         mov    DX,[BP+<OurAdr]  ;get our offset}
  $8B/$46/<OURADR+2/     {         mov    AX,[BP+<OurAdr+2];get our segment}
  $1E/                   {         push   DS          ;save DS}
  $8E/$D8/               {         mov    DS,AX       ;move segment for call}
  $B8/$1B/$25/           {         mov    AX,$251B    ;setup for interrupt 1B}
  $CD/$21/               {         int    $21         ;set new int vector}
  $1F);                  {         pop    DS          ;restore DS}
end;

{*****************************************************************************}
{this is not public}
{$F+} procedure ExitHandler; {$F-}
{
Exit procedure to de-install ControlBreakHandler.
This could be done totally in Turbo (without inline) but would require this
unit to USE the DOS unit.
}
begin
Inline(                  {Assembly by Inline 03/03/88 22:28}
  $8B/$16/>SAVEINT1B/    {         mov    DX,[>SaveInt1B];get orig offset}
  $A1/>SAVEINT1B+2/      {         mov    AX,[>SaveInt1B+2];get orig segment}
  $1E/                   {         push   DS          ;save DS}
  $8E/$D8/               {         mov    DS,AX       ;move segment for call}
  $B8/$1B/$25/           {         mov    AX,$251B    ;setup for interrupt 1B}
  $CD/$21/               {         int    $21         ;restore old int vector}
  $1F);                  {         pop    DS          ;restore DS}
   ExitProc := ExitSave; {when we leave, chain to next exit procedure}
end;

{*****************************************************************************}
begin {CRTi initialization}
   CheckBreak := true;            {default break-checking flag to True}
   Scan := 0;                     {initialize saved scan code}
   HadControlBreak := false;      {initialize flag which says we had break}
   InitDelay;                     {determine the proper count for use by Delay}
   InitControlBreak;              {set up control-break handler}
   ExitSave := ExitProc;          {save old exit procedure}
   ExitProc := @ExitHandler;      {put our exit procedure in the chain}
end. {CRTi initialization}