[comp.lang.pascal] TOADLN Turbo Procedure

kirsch@braggvax.arpa (David Kirschbaum) (08/24/88)

NetLandians,
 Attached is a new Turbo Pascal procedure to permit keyboard input (with
"full screen" editing) of strings up to 255 chars in length.  (Turbo Pascal
and its READLN is limited to 128 chars, and is horrible for editing beyond the
screen's "wraparound".)
 Regrets for the size of this thing .. I usually upload stuff like this to
SIMTEL20 and announce a pointer to there .. but good old SIMTEL's been down
for a week or so.
 You'll need INLINE.COM to compile the .ASM code to Turbo Inline code.
 Yell directly if you want this to do more/less than it does already.
Regards,
David Kirschbaum
Toad Hall
kirsch@braggvax.ARPA
------ Test program, then .ASM source follows -----

(*
TESTLN.PAS
 Test program for new Procedure ToadLn

 Like READLN, but:
  - Strings only (e.g., don't Toadln(VAR i : INTEGER)
    like you could READLN(VAR i : INTEGER)!
  - TOADLN does NOT "initialize" the string VAR.
    In other words, you can edit an existing string as you desire.
    WATCH OUT FOR "NONINITIALIZED" STRINGS!  No telling WHAT they might
    contain .. Turbo Pascal does NOT initialize a string variable
    to length 0, clear it, or anything else!  String length and contents
    will be unknown.
  - up to 255 chars with "full screen" cursor control and
    editing:
    ^U   - clear string, home cursor
    Home - move cursor to string start
    End  - move cursor to actual string end (last str char +1 or 255th char)
    Lft Arr - move cursor 1 char left (up to string start)
    Rt Arr  - move cursor 1 char right (will not go beyond last char)
    Dn Arr  - move cursor 1 line down (or to last string char +1)
    Up Arr  - move cursor 1 line up (or to string start)
    BackSpace - Move cursor 1 character left, do a Delete.
                If at "Home", acts like Delete.
    Delete  - Delete character at current cursor position,
              move rest of string left 1 char.
    Return,
    ^Z      - Done, CR/LF, returns string.  (Ignores cursor position.)
    Other Chars:
     - Gobbles any other function or cursor keys.
     - Passes through other Control chars as the PC "graphics" character.
       (You'll get funny-looking characters.)
     - Unlike READLN, passes through the ESCape key as its ASCII value
       (so you can do ANSI command sequences if you want).

  Released to Public Domain.
  David Kirschbaum
  Toad Hall
  kirsch@braggvax.ARPA
*)

TYPE
  Str255 = STRING[255];

VAR
  S : Str255;

PROCEDURE ToadLn(VAR S : Str255);
  VAR  xy, width : INTEGER;  {required local variables}
  BEGIN
    {$I TOADLN4.OBJ}      {you'd BETTER have it}
  END;  {of ToadLn}

BEGIN
  S := '';
  WHILE LENGTH(S) < 140 DO    {build a long string}
    S := S + '0123456789';
  ClrScr;
  GotoXY(1,8);
  Write('Prompt at line 8: ');
  Toadln(S);
  Writeln('Your answer: [', S, '] ', LENGTH(S));

  GotoXY(1,25);
  Write('Prompt at screen bottom (notice the automatic scroll): ');
  Toadln(S);
  Writeln('Your answer: [', S, '] ', LENGTH(S));
END.
;TOADLN - Turbo Pascal procedure
; Accept keyboard input for strings up to 255 chars in length,
; with full "screen" editing (cursor keys, Delete, BS).
; Terminate input with Ctrl C or Ctrl Z.
;
; Released to Public Domain
; David Kirschbaum
; Toad Hall
; kirsch@braggvax.ARPA
;
;Globally requires:
; TYPE  Str255 = STRING[255];
;
;Use the following for your procedure header:
;PROCEDURE ToadLn(VAR S : Str255);
;  VAR  xy,width : INTEGER;
  push DS             ;save DS
  call InitScr        ;init screen vars
;
  lds  si,>S[bp]      ;DS:SI = string vector
  mov  ax,DS
  mov  ES,ax          ;ES:DI also string vector
  call PadStr         ;pad, display, home cursor
;
;Clear keyboard buffer
ChkKbd:
  mov  ah,1           ;report if char is ready
  int  $16            ;BIOS
  jz   KeyIn          ;kbd buff is empty
   xor ah,ah          ; Svc 0, read next kbd char
   int $16            ; BIOS
   jmp short ChkKbd   ; Until kbd buff is empty
;
;Kbd buffer is now empty
;Now get/process the user's keyboard input.
KeyIn:
  call GetKey         ;Read, process kbd char
  or   ax,ax          ;no cursor moving?
  je   KeyIn          ;right, next key
   cmp  ax,$1C0D      ; Was it a CR or ^Z?
   je   ReturnStr     ; yep, done
;insure cursor is updated
    call AbsCur       ;  repsn cursor, update len
    jmp  short Keyin  ;  next key, please
;
ReturnStr:
  mov di,$FFFF        ;force char ptr to end
  call AbsCur         ;cursor to screen end
  call ShowStr        ;update length, display
  mov  ax,$0E0D       ;CR
  int  $10
  mov  al,$0A         ;LF
  int  $10
  jmp  Done           ;finished
;
;Codes returned in AX from a svc 0, Int 16H call:
;CTRLU  EQU 1615H  ;^U
;CTRLZ  EQU 2C1AH  ;^Z
;DNARR  EQU 5000H  ;Cursor down
;UPARR  EQU 4800H  ;Cursor up
;HOMKEY EQU 4700H  ;Home key
;ENDKEY EQU 4F00H  ;End key
;LFTARR EQU 4B00H  ;Cursor left
;RTARR  EQU 4D00H  ;Cursor right
;INSKEY EQU 5200H  ;Insert key
;DELKEY EQU 5300H  ;Delete key
;BSKEY  EQU 0E08H  ;Backspace/Rubout key
;CRKEY  EQU 1C0DH  ;Return key
;
GetKey:
;Processes the keyboard char, acts as required.
  xor  ah,ah          ;svc 0, read next kbd char
  int  $16            ;BIOS
  cmp  ax,$1615       ;Is it a ^U?
  jne  LftArrTst      ;nope
;^U clears the string and screen
   mov byte [si],0    ; clear str length
   call PadStr        ; clear screen/string
   ret
;
LftArrTst:
  cmp  ax,$4B00       ;how about cursor left?
  jne  RtArrTst       ;nope
   dec  di            ; back up ptr
   ret
;
RtArrTst:
  cmp  ax,$4D00       ;right cursor?
  jne  DelTst         ;nope
   inc  di            ; bump 1 to right
   ret
;
DelTst:
;Delete key rubs out the CURRENT character, does NOT
;move cursor to left, moves rest of string left.
;We can Del a single char that we can NOT Backspace over.
  cmp  ax,$5300       ;Delete key?
  jne  BSTst          ;nope
   jmp short DoBS     ; yep
;
BSTst:
  cmp  ax,$0E08       ;Is it a BS? (Rubout)
  jne  DnArrTst       ;nope
;BS is just like Delete, except we must be able
;to move left.  No action if we're at first char
;
  dec di              ;back up next char ptr
  cmp  di,si          ;did we back up to length byte
  jbe  NoBS           ;yep, can't do that
DoBS:
  mov  byte [di],$B0  ;"delete" char right here
  call AbsCur         ;fix cursor psn,current str psn
  mov  ax,di          ;new current psn
  sub  ax,si          ;- start = next char ofs
  cmp  ax,cx          ;is cursor within string? (not at end)
  jae  BSShow         ;nope, at end or beyond
;
DoMov1:
  sub  cx,ax          ;len - cur psn = bytes to move
  push si             ;save str start
  push di             ;save this new psn
  mov  si,di          ;new char ptr
  inc  si             ;move from old char ptr
  cld                 ;insure fwd
  rep  movsb
  mov  byte [di],$B0  ;clear last char
  pop  di             ;restore current psn
  pop  si             ;restore str start
BSShow:
  call ShowStr
  ret
NoBS:
   xor di,di          ;force to start
   xor ax,ax          ;flag no cursor move
   ret
;
DnArrTst:
  cmp  ax,$5000       ;down cursor?
  jne  EndTst         ;nope
   add di,>width[bp]  ; 1 line down
   jc  End1           ; went beyond MAXINT
    ret               ;  done
;
EndTst:
  cmp  ax,$4F00       ;End key?
  jne  UpArrTst       ;nope
End1:
   mov di,$FFFF       ; max out next char ptr
   ret
;
UpArrTst:
  cmp  ax,$4800       ;up cursor?
  jne  HomTst         ;nope
   sub di,>width[bp]  ;1 line up
   jb  DoHome         ;went negative, home
    ret               ;done
;
HomTst:
  cmp  ax,$4700       ;home key?
  jne  CrTst          ;nope
DoHome:
   xor  di,di         ; back to start
   ret
;
CrTst:
  cmp  ax,$1C0D       ;Is it a CR?
  je   GetKeyX        ;yep, done
  cmp  ax,$2C1A       ; how about ^Z
  jne  FunTst         ; nope
   mov ax,$1C0D       ;  force to CR
   ret
;
FunTst:
  xor ah,ah           ;clear msb
  or  al,al           ;is it a special? (cursor/function)
  je  GetKeyX         ;yep, ignore it (AX=0)
;
;We assume it's a legal character now, so we display it.
PrChr:
  stosb               ;stuff ASCII char, bump DI
  mov  ah,$0E         ;write char TTY
  int  $10            ;BIOS
GetKeyX:
  ret                 ;AX <> 0, so cursor, len is tested
;
PadStr:
;Pads from past last char to 255 chars with spaces
;displays str, homes cursor
;returns CX=str length, DI=str start
;
  xor  ch,ch          ;clear msb
  mov  cl,[si]        ;get str length
  mov  di,si          ;current char = str start
  inc  di             ;bump past len byte
  push si             ;str start
  push di             ;and next char ptr
;
  add  di,cx          ;add in length (if any)
  not  cl             ;255-str len
  mov  al,$B0         ;pad with graphic char
  cld                 ;insure fwd (sigh...)
  rep  stosb          ;do the pad
  pop  di             ;restore str start
  pop  si             ;and next char ptr
  mov  dx,>xy[bp]     ;home cursor
;fall thru to ShowStr and return
;
ShowStr:
; Display string at starting coordinates,
; Clear to EOL (e.g., full 255 chars),
;Exit with CX=current str length,DI unchanged,
;cursor psn unchanged.
  push dx             ;remember current cursor psn
  mov  ah,3           ;read cur psn (want cursor size)
  int  $10            ;BIOS CX = current cursor size
;
  push cx             ;save cursor size
  mov  ch,$20         ;turn cursor off
  mov  ah,1           ;set cursor size
  int  $10            ;BIOS
  mov  dx,>xy[bp]     ;"home" cursor
  mov  ah,2           ;position cursor
  int  $10            ;BIOS
;
;We display all 255 chars. Str buffer may be padded
;with spaces (not part of real length), but we show
;them to "Clr EOL".
  push si             ;str start
  inc  si             ;bump past length byte
  mov  cx,255         ;255 chars
  mov  ah,$0E         ;BIOS display char TTY
SL1:
  lodsb               ;next string char
  int  $10            ;display it
  loop SL1            ;do them all
  pop  si             ;restore str start
;
  pop  cx             ;old cursor size
;
  mov  ah,1           ;set cursor size
  int  $10            ;BIOS
  pop  dx             ;old cursor psn
  mov  ah,2           ;set cursor psn
  int  $10            ;BIOS
  call GetLen         ;update CX=len
  mov  [si],cl        ;and force into len byte
  xor  ax,ax          ;so we don't call AbsCur
  ret
;
AbsCur:
;Absolute cursor movement to next char ptr (DI).
;Enter with DI = next str char.
;Test to insure DI doesn't point beyond
; 255 chars past start (from FixLen)
;Exit with
; DX= adjusted xy coords
; DI = adjusted current char ptr (from FixLen)
; CX = str length (from GetLen)
; cursor pointing to next str char
;
  mov  dx,>xy[bp]     ;get str's starting cursor psn
  call FixLen         ;check str len,char ptr
;Returns CX=str len, AX=next char ofs
  or  ax,ax           ;curr char = start?
  je  PsnCur          ;yep, go "home" cursor
;
  dec  ax
  push cx             ;save str len
  mov  cx,>width[bp]  ;get screen width
  add  al,dl          ;add in starting col
  adc  ah,0           ;in case of carry
AL1:
  cmp  ax,cx          ;less than 1 line?
  jbe  A3             ;yep
   sub ax,cx          ;>width, subtract width
   inc  dh            ;bump row
   jmp short AL1      ;until col < = width
A3:                   ;updated DL=col,DH=row
  pop  cx             ;restore length
  mov  dl,al          ;update row
;
PsnCur:
  mov  ah,2           ;svc 2, position cursor
  int  $10            ;BIOS
  ret
;
FixLen:
;Insures str len (and CX) are legal,
;keeps DI within legal limits (start + 0..254)
;Enters with DI = current char ptr (could be beyond str length),
;Exits with CX = str len, AX=rel cursor psn within string
;first scan for our terminating $B0 graphics char
  call GetLen         ;returns with CX=len
  jcxz F0             ;no str length, force to start
;now insure str ptr is legal (within string)
  mov  ax,di          ;str ptr
  sub  ax,si          ;- str start = next char ofs
  ja   F1             ;ok, next char > start
F0:
   xor ax,ax          ; next char ofs = 0
   mov di,si          ; force next char to start
   inc di             ; bump to 1st char
   ret                ; done
;
;at or above 1st char, how about beyond str end?
F1:
  cmp  ax,cx          ;< len?
  jbe  F2             ;yep
   mov  di,si         ; start
   mov  ax,cx         ; get length
   cmp  al,255        ; maxed out?
   je   F1A           ; yep
    inc  ax           ;  no, so bump to next char
F1A:
   add  di,ax         ; point to last char
F2:
  ret
;
GetLen:
  push di             ;save next char ptr
  mov  di,si          ;start
  mov  cx,255         ;max possible len
  add  di,cx          ;point to end
  std                 ;scan backwards
  mov  al,$B0         ;graphics char ends it
  repe scasb          ;scan until we run out of $B0's
  cld
;CX points to the non-$B0 char (or 0)
  jz G1               ;didn't find ANY
   inc cx             ; adjust from the scasb
G1:
  pop  di             ;restore next char ptr
  ret                 ;with CX=len
;
InitScr:
;Get required screen stuff
  mov  ah,$0F         ;get current video mode
  int  $10            ;BIOS
;BH = active display page (protect it!)
  mov  al,ah          ;need width as LSB
  xor  ah,ah          ;clear msb
  mov  >width[bp],ax  ;save current screen width
;
;We need 255 chars of screen space WITHOUT SCROLLING,
;or our cursor positioning will be screwed up.
;Test now to see if we have enough room.
;If not, do our scrolling NOW instead of letting BIOS do it.
;
  mov  si,ax          ;save width in SI
  mov  ah,3           ;get current cursor psn in DX
  int  $10            ;BIOS
  cmp  dh,21          ;row 21 or less?
  jbe  NoScroll       ;yep, scroll testing
;
  mov  al,dh          ;current row
  mov  cx,si          ;CL = width multiplier
  mul  cl             ;AX=row * width
C1:
  add  al,dl          ;add in current col
  adc  ah,0           ;in case of carry
  mov  cx,ax          ;remember as abs scr psn
  add  ax,255         ;plus full line length
  mov  di,ax          ;abs scrn psn + string
CL1:
  cmp  di,cx          ;less than 1 line?
  jbe  CDone          ;yep, ok
   mov  ax,$0E0A      ; display LF via BIOS
   int  $10           ; BIOS
   sub  di,si         ; subtract width
   dec  dh            ; back up 1 row
   jmp short CL1
CDone:
  mov  ah,2           ;svc 2, position cursor
  int  $10            ;BIOS
NoScroll:
  mov  >xy[bp],dx     ;now save current cursor psn
;
;Get screen attributes at current cursor psn
  mov  ah,8           ;Read char & attrib
  int  $10            ;BIOS
  mov  bl,ah
;BL = screen attribute (protect it!)
  ret
;
Done:
  pop  DS             ;restore DS
;let Turbo do the rest