Source Code 1992 March/Source_Code_CD-ROM_Walnut_Creek_March_1992.iso/msdos/turbopas/tp_tsr.arc/CONSOLE.PAS

Pascal/Delphi Source File | 1989-02-11 | 9.2 KB | 255 lines

{══════════════════════════════ CONSOLE.PAS ══════════════════════════════}
{ ─────────  Turbo 4.0/5.0 stay-resident demonstration program  ───────── }
{                 Copyright (c) 1989  Richard W. Prescott                 }
{ This Unit provides routines for changing the cursor shape, as well as   }
{ substitutes for ReadKey, WhereX/Y, and WRITE which require less code    }
{ and do not respond to Ctrl-C and Ctrl-Break.                            }
{═════════════════════════════════════════════════════════════════════════}
{ This Unit was compiled and assembled using Turbo Pascal Version 5.0     }
{ and TP&Asm Version 2 ß.  TP&Asm provides an integrated compile-time     }
{ assembler within the Turbo development environment (and the command     }
{ line compiler TPC), resulting in an ASSEMBLY Development Environment    }
{ which is identical to your PASCAL Development Environment.              }
{                                                                         }
{ TP&Asm Version 2.0 will be available from me for $49 plus $3 P&H.  The  }
{ current Beta Test Version 2 ß is available now for $39 plus $3 P&H,     }
{ with a free upgrade to 2.0 when it becomes available.                   }
{          Please see the README file for further information.            }
{═════════════════════════════════════════════════════════════════════════}

Unit CONSOLE;

INTERFACE
VAR
  MaxColumn: BYTE; {- maximum screen column number as reported by the BIOS -}

PROCEDURE WriteSubStr(VAR S; Index,Count: WORD);
PROCEDURE WriteChar(Ch0: CHAR);

FUNCTION ReadCursor: WORD;
FUNCTION WhereX: BYTE;
FUNCTION WhereY: BYTE;
PROCEDURE SetCursor(Posn: WORD);

PROCEDURE WideCursor;
PROCEDURE ThinCursor;
PROCEDURE HideCursor;


FUNCTION BiosReadKey: CHAR; {compatible with T4 ReadKey w/o CheckBreak}

{══════════════════════════════ BiosFullKey ══════════════════════════════}
{ Read keyboard without echo to screen.  (Similar to ReadKey in CRT Unit) }
{ Returns a WORD with the character read in the low byte and the Scan     }
{ code of the key in the high byte.  Returns all keys, including extended }
{ keys, in a single call.  Useful if you want to DIFFERENTIATE "Enter"    }
{ from ^M, '+' from "Grey+", etc.  Treats Ctrl-C and Ctrl-Break the same  }
{ as all other keys, returning a character and scan code without          }
{ executing a user break.                                                 }
{══════════════════════════════ BiosFullKey ══════════════════════════════}
FUNCTION BiosFullKey: WORD; {- Inline Directive -}
  ASSEMBLE
    Xor Ah,Ah
    Int 016
  END; {Assemble}


{═══════════════════════════════ LookAhead ═══════════════════════════════}
{ Same as BiosFullKey but leave keystroke in buffer for subsequent read.  }
{═══════════════════════════════ LookAhead ═══════════════════════════════}
FUNCTION LookAhead:   WORD; {- Inline Directive -}
  ASSEMBLE
  WaitLoop:
    Mov Ah,1
    Int 016
    jZ WaitLoop
  END; {Assemble}


{══════════════════════════════ DosReadKey ═══════════════════════════════}
{ Read keyboard without echo to screen.  (Similar to ReadKey in CRT Unit) }
{ Returns the same character that would be returned by ReadKey, except    }
{ that ANSI.SYS macros are expanded and Ctrl-C and Ctrl-Break are treated }
{ as characters rather than as user break requests.                       }
{══════════════════════════════ DosReadKey ═══════════════════════════════}
FUNCTION DosReadKey:  CHAR; {- Inline Directive -}
  ASSEMBLE
    Mov Ah,7
    Int 21h
  END; {Assemble}


{═════════════════════════════ DefaultDrive ══════════════════════════════}
{ Returns the default drive as a capital letter.                          }
{═════════════════════════════ DefaultDrive ══════════════════════════════}
FUNCTION DefaultDrive: CHAR; {- Inline Directive -}
  ASSEMBLE
    Mov Ah,$19
    Int $21
    Add Al,$41
  END; {Assemble}


IMPLEMENTATION
{$S-}


{══════════════════════════════ WriteSubStr ══════════════════════════════}
{ Write a substring to the screen using DOS, without checking for a user  }
{ break.  Uses same parameters as COPY to describe the desired substring. }
{══════════════════════════════ WriteSubStr ══════════════════════════════}
PROCEDURE WriteSubStr(VAR S; Index,Count: WORD);
BEGIN
Assemble
  Mov Cx,Count
  jCXZ Finish
  Push Ds
  Lds Si,S
  Add Si,Index
  Mov Ah,06    ;Direct Console I/O
  Cld          ;set Forward
L0:
  LodSB
  Mov Dl,Al
  Cmp Dl,255      ;function 06 cannot display #255
  IF E Mov Dl,' ' ;Display Space instead
  Int 021
  Loop L0
  Pop Ds
Finish:
END; {Assemble}
END; {PROCEDURE WriteSubStr}


{═══════════════════════════════ WriteChar ═══════════════════════════════}
{ Write a single character to the screen using DOS, without checking for  }
{ a user break.                                                           }
{═══════════════════════════════ WriteChar ═══════════════════════════════}
PROCEDURE WriteChar(Ch0: CHAR);
BEGIN
Assemble
  Mov Ah,06  ;Direct Console I/O
  Mov Dl,Ch0
  Cmp Dl,255      ;function 06 cannot display #255
  IF E Mov Dl,' ' ;Display Space instead
  Int 021
  END; {Assemble}
END; {PROCEDURE WriteChar}


{══════════════════════════════ ReadCursor ═══════════════════════════════}
{ Return cursor position as a WORD with Lo byte = X and Hi byte = Y.      }
{ Sets MaxColumn to maximum screen column number as reported by the BIOS. }
{══════════════════════════════ ReadCursor ═══════════════════════════════}
FUNCTION ReadCursor: WORD;
BEGIN
ASSEMBLE
  Mov Ah,0Fh
  Int 10h           ;put Active Video Page into Bh
  Mov MaxColumn,Ah
  Mov Ah,03
  Int 10h           ;Get Coords
  Inc Dh,Dl         ;Use (1,1) for UpperLeft
  Mov ReadCursor,Dx ;Put in Function Result by name
  END; {Assemble}
END; {FUNCTION ReadCursor}


{═════════════════════════════ WhereX/WhereY ═════════════════════════════}
{ Provides same function as CRT unit WhereX/WhereY.                       }
{═════════════════════════════ WhereX/WhereY ═════════════════════════════}
FUNCTION WhereX: BYTE;
BEGIN WhereX := Lo(ReadCursor); END; {FUNCTION WhereX}
FUNCTION WhereY: BYTE;
BEGIN WhereY := Hi(ReadCursor); END; {FUNCTION WhereY}


{═══════════════════════════════ SetCursor ═══════════════════════════════}
{ Set cursor position to WORD value which specifies X position in Lo byte }
{ and Y position in Hi byte.                                              }
{═══════════════════════════════ SetCursor ═══════════════════════════════}
PROCEDURE SetCursor(Posn: WORD);
BEGIN
ASSEMBLE
  Mov Ah,0Fh
  Int 10h     ;put Active Video Page into Bh
  Mov Dx,Posn
  Dec Dh,Dl   ;BIOS uses (0,0) for UpperLeft
  Mov Ah,02
  Int 10h     ;set Coords
  END; {Assemble}
END; {PROCEDURE SetCursor}


{══════════════════════════════ WideCursor ═══════════════════════════════}
{ Set cursor shape to indicate insert mode.                               }
{══════════════════════════════ WideCursor ═══════════════════════════════}
PROCEDURE WideCursor; BEGIN
ASSEMBLE
  Mov Ah,0Fh
  Int 10h     ;put Active Video Page into Bh, Video mode in Al
  Mov Cx,0507
  Cmp Al,07h
  IF E Mov Cx,080C
  Mov Ah,01
  Int 10h     ;Set CursorType from Cx
  END; {Assemble}
END; {PROCEDURE WideCursor}


{══════════════════════════════ ThinCursor ═══════════════════════════════}
{ Set cursor shape to indicate overwrite mode.                            }
{══════════════════════════════ ThinCursor ═══════════════════════════════}
PROCEDURE ThinCursor; BEGIN
ASSEMBLE
  Mov Ah,0Fh
  Int 10h     ;put Active Video Page into Bh, Video mode in Al
  Mov Cx,0707
  Cmp Al,07h
  IF E Mov Cx,0B0C
  Mov Ah,01
  Int 10h     ;Set CursorType from Cx
  END; {Assemble}
END; {PROCEDURE ThinCursor}


{══════════════════════════════ HideCursor ═══════════════════════════════}
{ Turn off cursor display by setting starting line out of range.  This    }
{ technique may not work on all displays.                                 }
{══════════════════════════════ HideCursor ═══════════════════════════════}
PROCEDURE HideCursor; BEGIN
ASSEMBLE
  Mov Ah,0Fh
  Int 10h     ;put Active Video Page into Bh
  Mov Cx,02000 ;set bit 5 of Ch
  Mov Ah,01
  Int 10h     ;Set CursorType from Cx
  END; {Assemble}
END; {PROCEDURE HideCursor}


{══════════════════════════════ BiosReadKey ══════════════════════════════}
{ Read keyboard without echo to screen.  (Similar to ReadKey in CRT Unit) }
{ Returns the same character that would be returned by ReadKey, except    }
{ that Ctrl-C and Ctrl-Break are treated as characters rather than as     }
{ user break requests.  ANSI.SYS macros are not expanded.                 }
{══════════════════════════════ BiosReadKey ══════════════════════════════}
CONST BiosSaveScan: BYTE = 0;
FUNCTION BiosReadKey: CHAR; {compatible with T4 ReadKey w/o CheckBreak}
BEGIN
ASSEMBLE
  Xor Ax,Ax            ; Clear Ah and Al
  Xchg Al,BiosSaveScan ; Clear SaveScan
  Or Al,Al             ; Check Prior Scan
  jNZ Return           ; NZ, Return it
  Int 016              ; Else Get key via function 0
  Or Al,Al             ; Check Char
  jNZ Return           ; NZ, Return it
  Mov BiosSaveScan,Ah  ; Else Save Scan and return 0
Return:
  Mov BiosReadKey,Al
  END; {Assemble}
END; {FUNCTION BiosReadKey: BYTE; }

END.