Relay-Version: version B 2.10 5/3/83; site utzoo.UUCP
Path: utzoo!utgpu!water!watmath!clyde!rutgers!mcnc!gatech!bloom-beacon!mit-eddie!ll-xn!ames!aurora!labrea!decwrl!jumbo!ehs
From: ehs@jumbo.UUCP
Newsgroups: comp.sys.atari.8bit
Subject: VT52B: Yet Another Terminal Emulator (Part 3 of 3)
Message-ID: <954@jumbo.dec.com>
Date: Mon, 28-Sep-87 12:35:34 EDT
Article-I.D.: jumbo.954
Posted: Mon Sep 28 12:35:34 1987
Date-Received: Tue, 29-Sep-87 04:51:22 EDT
Organization: DEC Systems Research Center, Palo Alto
Lines: 744
Keywords: terminal emulator VT52 ACTION

--VT52B.ACT--cut here-------------------------
;*********************************
;*                               *
;* VT52B.ACT - a VT52+ emulator  *
;* written in ACTION(tm) by      *
;*                               *
;*     Ed Satterthwaite          *
;*     ehs@src.DEC.COM           *
;*     ...!decwrl!ehs            *
;*     Copyright 1987            *
;*                               *
;* derived with permission from  *
;*                               *
;*********************************
;*                               *
;* VT52A.ACT - a VT52+ emulator  *
;* written in ACTION(tm) by      *
;*                               *
;*     Michael R. M. Jenkin      *
;*     University of Toronto     *
;*     ...!utcsri!utai!jenkin    *
;*     copyright(c) 1985         *
;*                               *
;********************************* 
;*                               *
;* This program may be copied    *
;* and redistributed without     *
;* charge for noncommercial use. *
;* All commercial rights         *
;* reserved.                     *
;*                               *
;*********************************

MODULE
;A: handler, by Michael Jenkin
;   revised, by Ed Satterthwaite

DEFINE NB = "3",   ;# top blank lines
       NL = "24",  ;# lines on screen
       LL = "23",  ;indexed 0..LL
       DLSize = "246" ;NB + 10*NL + 3

DEFINE LDY = "$A0",
       RTS = "$60",
       JMP = "$4C"

CARD ARRAY ProgEnd(1)  ;compiler allocates this last

BYTE lmargin = $52, rmargin = $53,
     rowcrs  = $54, oldrow  = $5A,
     colcrs  = $55,
     oldchr  = $5D, inesc, need,
     needx, inv

CARD appmhi  = $0E,
     oldcol  = $5B,
     sdlst   = $230,
     memtop  = $2E5

BYTE ARRAY InvMask = [$00 $0F]

BYTE ARRAY chset = [
  0 0 0 0 0 0 0 0
  0 0 0 0 0 0 0 0
  0 0 0 0 0 0 0 0
  0 0 0 0 0 0 0 0
  0 0 0 0 0 0 0 0
  0 0 0 0 0 0 0 0
  0 0 0 0 0 0 0 0
  0 0 0 0 0 0 0 0
  0 0 0 0 0 0 0 0
  0 0 0 0 0 0 0 0
  0 0 0 0 0 0 0 0
  0 0 0 0 0 0 0 0
  0 0 0 0 0 0 0 0
  0 0 0 0 0 0 0 0
  0 0 0 0 0 0 0 0
  0 0 0 0 0 0 0 0
  0 0 0 0 0 0 0 0
  0 0 0 0 0 0 0 0
  0 0 0 0 0 0 0 0
  0 0 0 0 0 0 0 0
  0 0 0 0 0 0 0 0
  0 0 0 0 0 0 0 0
  0 0 0 0 0 0 0 0
  0 0 0 0 0 0 0 0
  0 0 0 0 0 0 0 0
  0 0 0 0 0 0 0 0
  0 0 0 0 0 0 0 0
  0 0 0 0 0 0 0 0
  0 0 0 0 0 0 0 0
  0 0 0 0 0 0 0 0
  0 0 0 0 0 0 0 0
  0 0 0 0 0 0 0 0
  0 0 0 0 0 0 0 0
  0 6 6 6 6 0 6 0
  0 10 10 10 0 0 0 0
  10 14 10 14 10 0 0 0
  4 14 8 14 2 14 4 0
  0 10 2 6 12 8 10 0
  0 14 2 6 6 2 14 0
  0 6 6 6 0 0 0 0
  0 6 12 8 8 12 6 0
  0 12 6 2 2 6 12 0
  0 10 4 14 4 10 0 0
  0 4 4 14 4 4 0 0
  0 0 0 0 0 6 6 12
  0 0 0 14 0 0 0 0
  0 0 0 0 0 6 6 0
  0 2 2 4 4 8 8 0
  0 14 10 10 10 10 14 0
  0 4 12 4 4 4 14 0
  0 14 2 2 14 8 14 0
  0 14 2 14 2 2 14 0
  0 10 10 10 14 2 2 0
  0 14 8 14 2 2 14 0
  0 14 8 14 10 10 14 0
  0 14 2 6 4 4 4 0
  0 14 10 14 10 10 14 0
  0 14 10 14 2 2 2 0
  0 0 6 6 0 6 6 0
  0 0 6 6 0 6 6 12
  0 2 6 12 12 6 2 0
  0 0 14 0 0 14 0 0
  0 8 12 6 6 12 8 0
  0 4 10 2 4 0 4 0
  14 10 10 14 8 8 14 0
  0 4 14 10 10 14 10 0
  0 12 10 12 10 10 12 0
  0 14 10 8 8 10 14 0
  0 12 10 10 10 10 12 0
  0 14 8 12 8 8 14 0
  0 14 8 12 8 8 8 0
  0 14 8 8 10 10 14 0
  0 10 10 14 10 10 10 0
  0 14 4 4 4 4 14 0
  0 2 2 2 2 10 14 0
  0 10 10 12 12 10 10 0
  0 8 8 8 8 8 14 0
  0 10 14 14 10 10 10 0
  0 12 10 10 10 10 10 0
  0 14 10 10 10 10 14 0
  0 14 10 14 8 8 8 0
  0 14 10 10 10 10 14 2
  0 14 10 14 12 10 10 0
  0 14 8 14 2 2 14 0
  0 14 4 4 4 4 4 0
  0 10 10 10 10 10 14 0
  0 10 10 10 10 10 4 0
  0 10 10 10 14 14 10 0
  0 10 10 4 4 10 10 0
  0 10 10 4 4 4 4 0
  0 14 2 4 4 8 14 0
  0 14 8 8 8 8 14 0
  0 8 8 4 4 2 2 0
  0 14 2 2 2 2 14 0
  0 4 4 10 0 0 0 0
  0 0 0 0 0 0 15 0
  0 4 6 2 0 0 0 0
  0 0 14 2 14 10 14 0
  0 8 8 14 10 10 14 0
  0 0 0 14 8 8 14 0
  0 2 2 14 10 10 14 0
  0 0 14 10 14 8 14 0
  0 0 14 8 12 8 8 0
  0 0 14 10 10 14 2 14
  0 8 8 14 10 10 10 0
  0 6 0 6 6 6 6 0
  0 6 0 6 6 6 6 12
  0 8 8 10 14 10 10 0
  0 12 4 4 4 4 14 0
  0 0 10 14 14 10 10 0
  0 0 12 10 10 10 10 0
  0 0 14 10 10 10 14 0
  0 0 14 10 10 14 8 8
  0 0 14 10 10 14 2 2
  0 0 14 10 8 8 8 0
  0 0 14 8 14 2 14 0
  0 4 14 4 4 4 4 0
  0 0 10 10 10 10 14 0
  0 0 10 10 10 10 4 0
  0 0 10 10 14 14 10 0
  0 0 10 14 4 14 10 0
  0 0 10 10 10 14 2 14
  0 0 14 2 4 8 14 0
  2 4 4 8 4 4 2 0
  6 6 6 0 0 6 6 6
  8 4 4 2 4 4 8 0
  0 10 5 0 0 0 0 0
  0 0 0 0 0 0 0 0 
]

CARD ARRAY
  DBase(NL), ;display line bases
  DLBase(2), ;display list bases
  LMaps(2)   ;line map bases

BYTE ARRAY   ;storage for line maps
  LMapA(NL),
  LMapB(NL)

BYTE ARRAY
  LMap      ;logical line -> DBase index

BYTE dl     ;current display list and line map selection

CARD FUNC DAlloc(CARD size, mask)
  CARD base
  base = memtop - size
  IF (base & mask) # ((memtop-1) & mask) THEN
    base = (memtop & mask) - size
  FI
  memtop = base
RETURN (base)

PROC InitBitMap()  ;build GR.8 line chunks
  BYTE i
  CARD base
  FOR i = 0 TO LL DO
    base = DAlloc(320, $F000)
    DBase(i) = base
    IF base >= appmhi THEN
      Zero(base, 320)
    FI
  OD
RETURN

PROC InitDL()     ;build display lists
  BYTE i, j
  CARD b, base
  BYTE ARRAY d
  LMaps(0) = LMapA
  LMaps(1) = LMapB
  LMap = LMaps(0)
  b = DAlloc(DLSize, $FC00)
  d = b
  IF b >= appmhi THEN
    FOR i = 1 TO NB DO
      d(0) = $70   ; blank skip
      d ==+ 1
    OD
    FOR i = 0 TO LL DO
      base = DBase(i)
      d(0) = $4F     ; mode line + LMS, Gr. 8
      d(1) = base & $FF
      d(2) = base RSH 8
      FOR j = 3 TO 9 DO
        d(j) = $0F   ; mode line, Gr. 8
      OD
      LMap(i) = i
      d ==+ 10
    OD
    d(0) = $41
    d(1) = b & $FF
    d(2) = b RSH 8
  FI
  DLBase(0) = b
  b = DAlloc(DLSize, $FC00)
  d = b
  IF b >= appmhi THEN
    MoveBlock(b, DLBase(0), DLSize)
    d(DLSize-2) = b & $FF
    d(DLSize-1) = b RSH 8
  FI
  DLBase(1) = b
  dl = 0
  sdlst = DLBase(0)
RETURN

PROC UpdateDL(BYTE del, ins)
  ; move line from row del to row ins
  ; and blank it
  BYTE i, j
  CARD old, new
  BYTE ARRAY oldLMap
  CARD POINTER s, d
  BYTE m
  CARD p
  old = DLBase(dl)
  oldLMap = LMap
  dl ==! 1
  new = DLBase(dl)
  LMap = LMaps(dl)
  s = old + NB + 1  ;skip blank lines
  d = new + NB + 1  ;and first mode byte
  m = oldLMap(del)
  j = 0
  FOR i = 0 TO LL DO
    IF j = del THEN
      s ==+ 10
      j ==+ 1
    FI
    IF i = ins THEN
      p = DBase(m)
      d^ = p
      LMap(i) = m
    ELSE
      d^ = s^      ;copy addr for LMS
      LMap(i) = oldLMap(j)
      s ==+ 10
      j ==+ 1
    FI
    d ==+ 10
  OD
  Zero(p, 320)
  sdlst = new    ;next VBI install dl
RETURN

PROC Achr(BYTE cx, cy, cc)
  BYTE POINTER sb, db
  BYTE i, mask
  sb = cc & $7F
  sb = (sb LSH 3) + chset
  db = (cx RSH 1) + DBase(LMap(cy))
  mask = InvMask(inv)
  IF cx & 1 THEN
    FOR i = 0 TO 7 DO
      db^ = ((db^ & $F0) % sb^)!mask
      sb ==+ 1
      db ==+ 40
    OD
  ELSE
    mask ==LSH 4
    FOR i = 0 TO 7 DO
      db^ = ((db^ & $0F) % (sb^ LSH 4))!mask
      sb ==+ 1
      db ==+ 40
    OD
  FI
RETURN

PROC Acurse(BYTE cx, cy); invert char
  BYTE POINTER db
  BYTE i, mask
  IF (cx & 1) THEN
    mask = $0F
  ELSE
    mask = $F0
  FI
  db = (cx RSH 1) + DBase(LMap(cy))
  FOR i = 0 TO 7 DO
    db^ ==! mask
    db ==+ 40
  OD
RETURN

PROC Ains(BYTE cx, cy)
  CARD lb
  BYTE POINTER db
  BYTE i, bx, b
  BYTE cout, t
  bx = cx RSH 1
  lb = DBase(LMap(cy))
  FOR i = 0 TO 7 DO
    b = bx
    db = lb + b
    IF cx & 1 THEN
      cout = db^ LSH 4
      db^ ==& $F0
      db ==+ 1
      b ==+ 1
    ELSE
      cout = 0
    FI
    WHILE b < 40 DO
      t = db^
      db^ = (t RSH 4) % cout
      cout = t LSH 4
      db ==+ 1
      b ==+ 1
    OD
    lb ==+ 40
  OD
RETURN
 
PROC Adel(BYTE cx, cy)
  CARD lb
  BYTE POINTER db
  BYTE i, bx, b
  BYTE cout, t
  bx = cx RSH 1
  lb = DBase(LMap(cy))
  FOR i = 0 TO 7 DO
    b = bx
    db = lb + 39
    cout = 0
    IF cx & 1 THEN
      b ==+ 1
    FI
    WHILE b < 40 DO
      t = db^
      db^ = (t LSH 4) % cout
      cout = t RSH 4
      db ==- 1
      b ==+ 1
    OD
    IF cx & 1 THEN
      db^ = (db^ & $F0) % cout
    FI
    lb ==+ 40
  OD
RETURN
 
PROC Ascroll() ; update cursor
  IF colcrs > rmargin THEN
    colcrs = lmargin
    rowcrs ==+ 1
  FI
  IF rowcrs > LL THEN
    UpdateDL(0, LL) 
    rowcrs = LL
  FI
  Acurse(colcrs,rowcrs)
RETURN

PROC Aesc(BYTE char) ; escape sequence
  BYTE ch
  BYTE i
  IF need = 2 THEN ; 1st ESC Y
    needx = char - $20
    need ==- 1
  ELSEIF need = 1 THEN ; 2nd ESC Y
    char ==- $20
    IF (needx <= LL) AND (char <= rmargin) THEN
      Acurse(colcrs,rowcrs)
      colcrs = char
      rowcrs = needx
      Acurse(colcrs,rowcrs)
    FI
    need = 0
  ELSEIF char = 'A THEN ; cursor up
    IF rowcrs > 0 THEN
      Acurse(colcrs,rowcrs)
      rowcrs ==- 1
      Acurse(colcrs,rowcrs)
    FI
  ELSEIF char = 'B THEN ; cursor down
    IF rowcrs < LL THEN
      Acurse(colcrs,rowcrs)
      rowcrs ==+ 1
      Acurse(colcrs,rowcrs)
    FI
  ELSEIF char = 'C THEN ; cursor right
    IF colcrs < rmargin THEN
      Acurse(colcrs,rowcrs)
      colcrs ==+ 1
      Acurse(colcrs,rowcrs)
    FI
  ELSEIF char = 'D THEN ; cursor left
    IF colcrs > 0 THEN
      Acurse(colcrs,rowcrs)
      colcrs ==- 1
      Acurse(colcrs,rowcrs)
    FI
  ELSEIF char = 'F THEN ; inverse on
    inv = 1
  ELSEIF char = 'G THEN ; inverse off
    inv = 0
  ELSEIF char = 'H THEN ; home
    Acurse(colcrs,rowcrs)
    colcrs = 0
    rowcrs = 0
    Acurse(colcrs,rowcrs)
  ELSEIF char = 'I THEN ; reverse lf
    Acurse(colcrs,rowcrs)
    IF rowcrs > 0 THEN
      rowcrs ==- 1
    ELSE
      UpdateDL(LL, 0)
    FI
    Acurse(colcrs,rowcrs)
  ELSEIF char = 'J THEN ; erase to EOS
    FOR ch = colcrs TO 79 DO
      Achr(ch,rowcrs,' )
    OD
    i = rowcrs + 1
    WHILE i <= LL DO
      Zero(DBase(LMap(i)),320)
      i ==+ 1
    OD
    Acurse(colcrs,rowcrs)
  ELSEIF char = 'K THEN ; erase to EOL
    FOR ch = colcrs TO 79 DO
      Achr(ch,rowcrs,' )
    OD
    Acurse(colcrs,rowcrs)
  ELSEIF char = 'L THEN ; insert space
    Acurse(colcrs, rowcrs)
    Ains(colcrs, rowcrs)
    Acurse(colcrs,rowcrs)
  ELSEIF char = 'M THEN ; delete char
    Adel(colcrs, rowcrs)
    Acurse(colcrs,rowcrs)
  ELSEIF char = 'N THEN ; insert line
    Acurse(colcrs, rowcrs)
    UpdateDL(LL, rowcrs)
    colcrs = 0
    Acurse(colcrs,rowcrs)
  ELSEIF char = 'O THEN ; delete line
    UpdateDL(rowcrs, LL)
    colcrs = 0
    Acurse(colcrs,rowcrs)
  ELSEIF char = 'Y THEN ; cursor addr
    need = 2
  FI
  IF need = 0 THEN
    inesc = 0
  FI
RETURN

PROC Aopen()
  CARD savetop
  savetop = memtop
  InitBitMap()
  InitDL()
  IF memtop < appmhi THEN
    memtop = savetop
    [LDY 147 RTS]    ; fail
  FI
  inesc = 0
  inv = 0
  need = 0
  lmargin = 0
  rmargin = 79
  rowcrs = 0
  colcrs = 0
  Acurse(colcrs,rowcrs)
  [LDY 1 RTS]

PROC Aclose()
  [LDY 1 RTS]

PROC Aput(BYTE areg)
  IF inesc =1 THEN; escape sequence
    Aesc(areg)
  ELSEIF areg = $1B THEN ; ESC
    inesc = 1
  ELSEIF areg = $9B THEN ; EOL
    Acurse(colcrs,rowcrs)
    colcrs = 0
    Ascroll()
  ELSEIF areg = $0A THEN ; lf
    Acurse(colcrs,rowcrs)
    rowcrs ==+ 1
    Ascroll()
  ELSEIF areg = $08 THEN ; BS
    IF colcrs > 0 THEN
      Acurse(colcrs,rowcrs)
      colcrs ==- 1
      Ascroll()
    FI
  ELSEIF areg = $07 THEN ; bell
    ; do nothing
  ELSEIF areg = $09 THEN ; TAB
    Acurse(colcrs,rowcrs)
    colcrs = (colcrs + 8) & $F8
    Ascroll()
  ELSE
    Achr(colcrs,rowcrs,areg)
    colcrs ==+ 1
    Ascroll()
  FI
  [LDY 1 RTS]

PROC Anofunc()
  [RTS]

PROC Adummy()
  [LDY 1 RTS]

PROC Ahandler()
  BYTE ARRAY hatabs = $031A
  BYTE pos, found
  ;do not change the following 3 lines
  CARD ARRAY atab(6)
  BYTE Jmp = [JMP]
  CARD init
  ; define device entry points
  atab(0) = Aopen - 1      ;OPEN
  atab(1) = Aclose - 1     ;CLOSE
  atab(2) = Anofunc - 1    ;READ
  atab(3) = Aput - 1       ;WRITE
  atab(4) = Adummy - 1     ;STATUS
  atab(5) = Anofunc - 1    ;SPECIAL
  init = Adummy            ;INIT
  ; find entry in hatabs
  found = 0
  pos = 0
  WHILE (pos < 34) AND (found = 0)
  DO
    IF hatabs(pos) = 0 THEN
      found = 1
    ELSE
      pos ==+ 3
    FI
  OD
  IF found = 0 THEN
    PrintE("*** A: too many devices")
  ELSE
    hatabs(pos) = 'A
    hatabs(pos + 1) = atab & 255
    hatabs(pos + 2) = atab RSH 8
  FI
RETURN

;****************************
;* MAIN PROGRAM
;****************************

MODULE

BYTE
  ch = $02FC,
  shflok = $02BE,
  speed = [3],
  wsize = [0],
  sbits = [0],
  lf = [0],
  iparity = [0],
  oparity = [0]

CARD
  bcount = $02EB

; iocb 3 definitions
BYTE iocb3cmd=$372 ; cmd byte
CARD iocb3buf=$374,  ; buffer address
     iocb3len=$378   ; buffer length
BYTE iocb3aux1=$37A, ; aux1 byte
     iocb3aux2=$37B  ; aux2 byte

DEFINE BUFLEN = "1024"
BYTE ARRAY BUFFER(BUFLEN)

PROC CIO=$E456(BYTE areg, xreg)

PROC XIO_R(BYTE cmd, aux1, aux2)
 ;because library XIO seemed flakey
  iocb3cmd = cmd
  iocb3buf = 0
  iocb3len = 0
  iocb3aux1 = aux1
  iocb3aux2 = aux2
  CIO(0,$30)
RETURN

PROC load_R(); load R: handlers
 [$A9 $50  $8D $00 $03
  $A9 $01  $8D $01 $03
  $A9 $3F  $8D $02 $03
  $A9 $40  $8D $03 $03
  $A9 $05  $8D $06 $03  $8D $05 $03
  $A9 $00  $8D $04 $03  $8D $09 $03
           $8D $0A $03  $8D $0B $03
  $A9 $0C  $8D $08 $03
  $20 $59 $E4
  $10 $01  $60
  $A2 $0B
  $BD $00 $05  $9D $00 $03
  $CA
  $10 $F7
  $20 $59 $E4
  $30 $06
  $20 $06 $05  $6C $0C $00
  $60
 ]

PROC init_R(); set options for R:
  Close(3)
  Open(3,"R1:",13,0)
  XIO_R(34,192+48,0)
  XIO_R(38,lf*64+oparity+4*iparity,0)
  XIO_R(36,speed+7+wsize*16+128*sbits,0)
  iocb3cmd=40 ; start concurrent I/O
  iocb3buf=BUFFER
  iocb3len=BUFLEN
  CIO(0,$30)
  bcount = 0
RETURN

PROC init_A(); set up A: device
  Ahandler() ; install A: handler
  Close(2)
  Open(2,"A:",8,0)
  SetColor(1,0,0)
; SetColor(2,12,15)  ;white field
; SetColor(2,3,6)    ;amber field
  SetColor(2,10,12)  ;lt. blue field
RETURN

PROC intro()
  Close(7)
  Open(7,"K:",4,0)
  shflok = 0
  init_R()
  init_A()
RETURN

BYTE FUNC remote(); remote char?
  iocb3cmd=13 ; get R: status       
  CIO(0,$30) ; *** call CIO ***
  IF bcount = 0 THEN
    RETURN(0)
  FI
RETURN(1)

BYTE FUNC local() ; local char?
RETURN($FF-ch)

PROC do_local(); process local
  BYTE char
  char = GetD(7)
  IF char = 127 THEN     ;tab 
    char = 9
  ELSEIF char = 125 THEN ;left curl
    char = 123
  ELSEIF char = 157 THEN ;right curl
    char = 125
  ELSEIF char = 255 THEN ;right curl
    char = 125
  ELSEIF char = 156 THEN  ;tilde
    char = 126
  ELSEIF char = 254 THEN  ;tilde
    char = 126
  ELSEIF char = 126 THEN ; delete
    char = 127
  FI
  PutD(3,char)
RETURN

PROC main()
  BYTE char
  load_R()
  appmhi = ProgEnd
  intro()
  DO
    IF remote() THEN
      char = GetD(3)
      PutD(2,char)
    ELSEIF local() THEN
      do_local()
    FI
  OD
RETURN