Sound, Music & MIDI Collection 2/SMMVOL2.bin/PROG/ASMOD09S.ZIP/NEWCRT.PAS

Pascal/Delphi Source File | 1994-11-02 | 19.0 KB | 630 lines

{ ────────────────────────────────────────────────────────────────────────

  This code is Copyright (c) 1994 by Jonathan E. Wright and AmoebaSoft.

  To communicate with the author, send internet mail to: [e-mail]

  About this code:
    A replacement for some of the stuff that Borland's CRT unit does, though
    it lacks most of Borland's screen I/O stuff.  But the good part is it
    replaces the BIOS keyboard handler, therefore making the buffer 255
    characters instead of 15 and allowing multiple keys to be pressed and
    _sensed_ at one time.  Perfect for video games.

    If you use this code in any of your programs, or as a basis for anything
    else you may write, please give credit to Nelno the Amoeba.  A postcard
    from your country or town would also be nice.  Send it to:

    Nelno
    58 1/2 Woodland Rd.
    Asheville, NC 28804-3823
    USA

  ──────────────────────────────────────────────────────────────────────── }

UNIT NewCrt;

{$F+}

INTERFACE

USES
  DOS, Types;

CONST
  { Timer constants }
  IOCount    : WORD = 0;
  IOFlag     : BYTE = 0;
  IOLoops    : WORD = 0;
  TimerMult  : WORD = 1;
  Int08Flag  : WORD = 1;
  OrigRate   : WORD = 1;             { number of int 8's that will occur
                                       before old int 8 vector is called }

  { NewCrt constants for KeyFlags array }

  KeyPadMinus= $4A;
  LeftArrow  = $4B;
  RightArrow = $4D;
  KeyPadPlus = $4E;
  UpArrow    = $48;
  DownArrow  = $50;
  Space      = $39;
  KeyPad5    = $4C;
  Home       = $47;
  EndKey     = $4F;
  PageUp     = $49;
  PageDown   = $51;
  Insert     = $52;
  Delete     = $53;
  Escape     = $01;
  ScrollLock = $46;
  F1         = $3B;
  F2         = $3C;
  F3         = $3D;
  F4         = $3E;
  F5         = $3F;
  F6         = $40;
  F7         = $41;
  F8         = $42;
  F9         = $43;
  F10        = $44;

  Quit      : BOOLEAN = FALSE;          { set if Alt-X is pressed }

  { if a corresponding key is pressed the byte indexed by that key's
    scancode will be set to > 0.  When the key is released it will be set
    to 0.  Checking this array allows multiple keys to be pressed at once }
  KeyFlags  : ARRAY [0..127] OF BYTE = (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
                                        0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
                                        0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
                                        0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
                                        0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
                                        0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
                                        0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
                                        0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
                                        0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
                                        0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
                                        0, 0, 0, 0, 0, 0, 0, 0);

  KeyBuff   : ARRAY [0..255] OF BYTE = (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
                                        0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
                                        0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
                                        0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
                                        0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
                                        0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
                                        0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
                                        0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
                                        0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
                                        0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
                                        0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
                                        0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
                                        0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
                                        0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
                                        0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
                                        0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
                                        0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
                                        0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
                                        0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
                                        0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
                                        0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
                                        0, 0, 0, 0);

  KeyTran   : ARRAY [0..127] OF BYTE = (000,027,049,050,051,052,053,054,055,
                                        056,057,048,045,061,008,
                                        009,113,119,101,114,116,121,117,105,
                                        111,112,091,093,013,
                                        000,097,115,100,102,103,104,106,107,
                                        108,059,039,096,
                                        000,000,122,120,099,118,098,110,109,
                                        044,046,047,000,
{ spacebar row }
                                        042,000,032,000,
{ function keys = scan code + 80h }
                                        $BB,$BC,$BD,$BE,$BF,$C0,$C1,$C2,$C3,$C4,
{ Keypad = # code + 80 h }
                                        $C5,$C6,$C7,$C8,$C9,045,$CB,$CC,$CD,043,$CF,
                                        $D0,$D1,$D2,127,
{ Nothing }
                                        000,000,000,
{ F11 & F12 }
                                        197,198,
{ more Nothing }
                                        0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
                                        0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
                                        0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
                                        0, 0, 0);

  ShiftTran : ARRAY [0..127] OF BYTE = (000,027,033,064,035,036,037,094,038,
                                        042,040,041,095,043,008,
                                        009,081,087,069,082,084,089,085,073,
                                        079,080,123,125,013,
                                        000,065,083,068,070,071,072,074,075,
                                        076,058,034,126,
                                        000,000,090,088,067,086,066,078,077,
                                        060,062,063,000,
{ spacebar row }
                                        042,000,032,000,
{ function keys = scan code + 80h }
                                        187,188,189,190,191,192,193,194,195,196,
{ Keypad = # code + 80 h }
                                        000,000,055,056,057,045,052,053,054,043,049,
                                        050,051,048,046,
{ Nothing }
                                        000,000,000,
{ F11 & F12 }
                                        197,198,
{ more Nothing }
                                        0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
                                        0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
                                        0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
                                        0, 0, 0);


  KeyBuffOn : BYTE = 1;              { 0 = no buff, 1 = buffer all
                                       2 = do not buffer function & keypad }
  KeyHead   : WORD = OFS (KeyBuff);
  KeyTail   : WORD = OFS (KeyBuff);
  KeyChange : BYTE = 0;
  KillFlag  : BYTE = 0;

TYPE
  RKeyFunc    = FUNCTION : CHAR;
  KeyPrsdFunc = FUNCTION : BOOLEAN;

{ newCrt variables and procedures }

VAR
  Time      : BYTE;

  KeyPressed : KeyPrsdFunc;
  ReadKey    : RKeyFunc;


PROCEDURE ClrScr;
PROCEDURE InitKeyboard;
PROCEDURE RestoreKeyboard;
PROCEDURE Delay (ms:word);
PROCEDURE Sound (n : WORD);
PROCEDURE NoSound;
PROCEDURE StartTimer (ms : WORD);
PROCEDURE StopTimer;
PROCEDURE Beep;
PROCEDURE ClearBuff;

{ Timer variables and procedures }

VAR
  Start      : LONGINT;
  Finish     : LONGINT;
  TotalTime  : LONGINT;

PROCEDURE StartTime;
PROCEDURE StopTime;
PROCEDURE SetTimer0Rate (Multiplier : WORD);


IMPLEMENTATION

CONST
  ScanCode : BYTE = 0;

VAR
  OldInt9   : POINTER;
  SavedExit : POINTER;

{$L KEY.OBJ}

FUNCTION  KeyPrsd : BOOLEAN; EXTERNAL;
FUNCTION  RKey : CHAR; EXTERNAL;
PROCEDURE NewInt9; EXTERNAL;

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

PROCEDURE NewExit; FAR;

BEGIN
  ExitProc := SavedExit;
  RestoreKeyboard;
END;

{ ╔═══════════════════════════════════════════════════════════════════════╗
  ║                                                                       ║
  ║                                                                       ║
  ╚═══════════════════════════════════════════════════════════════════════╝ }

PROCEDURE ClrScr; ASSEMBLER;

ASM
  mov     ah,02
  xor     dx,dx
  xor     bx,bx

  int     10h    { set cursor position }

  mov     ah,09
  mov     al,20h
  xor     bx,bx
  mov     bl,07
  mov     cx,2000

  int     10h
END;

{ ╔═══════════════════════════════════════════════════════════════════════╗
  ║                                                                       ║
  ║                                                                       ║
  ╚═══════════════════════════════════════════════════════════════════════╝ }

FUNCTION BIOS_KeyPressed : BOOLEAN; ASSEMBLER;

ASM
  CMP     ScanCode,0
  JNE     @@1
  MOV     AH,1
  INT     16H
  MOV     AL,0
  JE      @@2

@@1:
  MOV     AL,1

@@2:
END;

{ ╔═══════════════════════════════════════════════════════════════════════╗
  ║                                                                       ║
  ║                                                                       ║
  ╚═══════════════════════════════════════════════════════════════════════╝ }

FUNCTION BIOS_ReadKey : CHAR; ASSEMBLER;

ASM
  MOV     AL,ScanCode
  MOV     ScanCode,0
  OR      AL,AL
  JNE     @@1

  XOR     AH,AH
  INT     16H

  OR      AL,AL
  JNE     @@1
  MOV     ScanCode,AH
  OR      AH,AH
  JNE     @@1
  MOV     AL,'C'-64
@@1:
END;

{ ╔═══════════════════════════════════════════════════════════════════════╗
  ║                                                                       ║
  ║                                                                       ║
  ╚═══════════════════════════════════════════════════════════════════════╝ }

PROCEDURE InitKeyboard;

BEGIN
  IF DebugKeys THEN Print ('InitKeyboard: Initializing keyboard...', $0F);
  GetIntVec ($09, OldInt9);

  IF DebugKeys THEN Print ('SetInt9 : Depriving BIOS...', $0F);
  SetIntVec ($09, @NewInt9);

  KeyPressed := KeyPrsd;
  ReadKey := RKey;
END;

{ ╔═══════════════════════════════════════════════════════════════════════╗
  ║                                                                       ║
  ║                                                                       ║
  ╚═══════════════════════════════════════════════════════════════════════╝ }

PROCEDURE RestoreKeyboard;

BEGIN
  KeyPressed := BIOS_KeyPressed;
  ReadKey := BIOS_ReadKey;

  IF DebugKeys THEN Print ('RestoreInt9: Re-instating BIOS handler...', $0F);
  SetIntVec ($09, OldInt9);
END;

{ ╔═══════════════════════════════════════════════════════════════════════╗
  ║                                                                       ║
  ║                                                                       ║
  ╚═══════════════════════════════════════════════════════════════════════╝ }

PROCEDURE Sound (n : WORD);

VAR
  F  : WORD;
  HF : BYTE;
  LF : BYTE;

BEGIN
  IF n >= 37 THEN
  BEGIN
    F := 1193280 DIV n;

    HF := Hi (F);
    LF := Lo (F);

    Port [$43] := $B6;

    Port [$42] := LF;
    Port [$42] := HF;

    asm
         in al, 61h
         or al, 3
         out 61h, al
    end;
  END;
END;

{ ╔═══════════════════════════════════════════════════════════════════════╗
  ║                                                                       ║
  ║                                                                       ║
  ╚═══════════════════════════════════════════════════════════════════════╝ }

PROCEDURE NoSound; ASSEMBLER;

ASM
  in al, 61h
  and al, 0FCh
  out 61h, al
END;

{ ╔═══════════════════════════════════════════════════════════════════════╗
  ║                                                                       ║
  ║                                                                       ║
  ╚═══════════════════════════════════════════════════════════════════════╝ }

PROCEDURE Delay (ms:word); ASSEMBLER;

ASM {machine independent delay function}
  mov     ax,1000
  mul     ms
  mov     cx,dx
  mov     dx,ax
  mov     ah,86h
  int     15h
END;

{ ╔═══════════════════════════════════════════════════════════════════════╗
  ║                                                                       ║
  ║                                                                       ║
  ╚═══════════════════════════════════════════════════════════════════════╝ }

PROCEDURE StartTimer (ms : WORD); ASSEMBLER;

ASM
  mov     Time,0

  mov     ah,83h
  mov     al,01
  int     15h

  mov     ax,1000
  mul     ms
  mov     cx,dx
  mov     dx,ax

  mov     ax,ds
  mov     es,ax
  mov     bx,OFFSET Time

  xor     al,al
  mov     ah,83h

  int     15h
END;

{ ╔═══════════════════════════════════════════════════════════════════════╗
  ║                                                                       ║
  ║                                                                       ║
  ╚═══════════════════════════════════════════════════════════════════════╝ }

PROCEDURE StopTimer; ASSEMBLER;

ASM
  mov    ah,83h
  mov    al,01
  int    15h

  mov    Time,0
END;

{ ╔═══════════════════════════════════════════════════════════════════════╗
  ║                                                                       ║
  ║                                                                       ║
  ╚═══════════════════════════════════════════════════════════════════════╝ }

PROCEDURE Beep;

BEGIN
  Sound (1000);
  Delay (50);
  NoSound;
END;

{ ╔═══════════════════════════════════════════════════════════════════════╗
  ║                                                                       ║
  ║                                                                       ║
  ╚═══════════════════════════════════════════════════════════════════════╝ }

PROCEDURE ClearBuff;

VAR
  I    : BYTE;
  Key  : CHAR;

BEGIN
  IF KeyPrsd THEN
  REPEAT
    Key := RKey;
  UNTIL NOT (KeyPrsd);
  Key := #0;
END;

{ ╔═══════════════════════════════════════════════════════════════════════╗
  ║                                                                       ║
  ║                                                                       ║
  ╚═══════════════════════════════════════════════════════════════════════╝ }

PROCEDURE StartTime;

VAR
  H, M, S, S100 : WORD;

BEGIN
  GetTime (H, M, S, S100);

  Start := LONGINT (H) * LONGINT (360000) + LONGINT (M) * LONGINT (6000) + LONGINT (S) * LONGINT (100) + LONGINT (S100);
END;

{ ╔═══════════════════════════════════════════════════════════════════════╗
  ║                                                                       ║
  ║                                                                       ║
  ╚═══════════════════════════════════════════════════════════════════════╝ }

PROCEDURE StopTime;

VAR
  H, M, S, S100 : WORD;

BEGIN
  GetTime (H, M, S, S100);

  Finish := LONGINT (H) * LONGINT (360000) + LONGINT (M) * LONGINT (6000) + LONGINT (S) * LONGINT (100) + LONGINT (S100);

  TotalTime := Finish - Start;
END;

{ ╔═══════════════════════════════════════════════════════════════════════╗
  ║                                                                       ║
  ║                                                                       ║
  ╚═══════════════════════════════════════════════════════════════════════╝ }

PROCEDURE IODelay; ASSEMBLER;

ASM
  mov     cx,IOCount
  jcxz    @IOInit

@IODelayLoop:
  loop    @IODelayLoop

  mov     sp,bp                         { exit procedure                }
  pop     bp
  ret

@IOInit:
  mov     ax,ds                         { put data segment in es        }
  mov     es,ax
  mov     ax,8300h                      { wait interval                 }
  mov     cx,0
  mov     dx,5000                       { delay 5ms                     }
  mov     bx,OFFSET IOFlag

  int     15h                           { start delay                   }

  jc      @Int15Error

@IODelayLoop2:
  test    IOFlag,80h
  jnz     @DelayDone
  jmp     @NextLabel

@NextLabel:
  loop    @IODelayLoop2

  mov     ax,100
  jmp     @IOExit

@DelayDone:
  mov     ax,0FFFFh                     { get number of times looped    }
  sub     ax,cx
  mov     IOLoops,ax

  mov     bx,1500                       { adjustment factor             }
  xor     dx,dx
  div     bx
  cmp     ax,0
  je      @IO1Delay                     { set at least 1 delay          }
  jmp     @IOSet

@Int15Error:
  or      ah,ah                         { int 15 busy, try again        }
  jz      @IOExit                       { if an old system, set 1 delay }

@IO1Delay:
  mov     ax,1

@IOSet:
  mov     IOCount,ax

@IOExit:
END;

{ ╔═══════════════════════════════════════════════════════════════════════╗
  ║                                                                       ║
  ║                                                                       ║
  ╚═══════════════════════════════════════════════════════════════════════╝ }

PROCEDURE SetTimer0Rate (Multiplier : WORD);

BEGIN
  OrigRate := Multiplier;
ASM
  mov     bx,Multiplier
  cmp     bx,0
  ja      @Start

  inc     bx
  mov     Multiplier,bx

@Start:
  mov     TimerMult,bx
  mov     Int08Flag,bx

  cli

  mov     al,36h                        { command for 16-bit port mode 3 }
  out     43h,al

  mov     cx,IOCount
@IOD1:
  loop    @IOD1

  mov     ax,65535
  xor     dx,dx
  div     bx
  out     40h,al                        { load timer 0 MSB              }

  mov     cx,IOCount
@IOD2:
  loop    @IOD2

  xchg    al,ah
  out     40h,al                        { load timer 0 LSB              }

  sti
END;
  IF DebugKeys THEN PRINT ('SetTimer0Rate: ' + ST (TRUNC (Multiplier * 18.2)) + ' per second.', $0F);
END;
{ ╔═══════════════════════════════════════════════════════════════════════╗
  ║                                                                       ║
  ║                                                                       ║
  ╚═══════════════════════════════════════════════════════════════════════╝ }
BEGIN
  SavedExit := ExitProc;
  ExitProc := @NewExit;

  IODelay;
  IF DebugKeys THEN PRINT ('IODelay: IOCount is ' + ST (IOCount) + ', IOLoops was ' + ST (IOLoops) + '.', $0F);

  InitKeyBoard;
END.