VT52 Emulator #
The following is a very primitive vt52 emulator for the 800. This actually is a vt52 with insert/delete line added, with auto-wrap, and tabs. It is written in Action! with lower case enabled.
To use this, you will need an rs232 device (I have only tested this at 300 buad using an 850 interface and 830 modem, but it seems to work well). The rs232 parameters are hard coded, so you will probably have to change the values of baud, parity, etc. Consult your 850 or R-verter manual. The values that may require change are the following..
speed = ~[1], wsize = ~[0], sbits = ~[0], lf = ~[0], iparity = ~[0], oparity = ~[0]
This works by defining an output device A: which works in graphics mode 8, which writes characters in 4 bits. I have used this emulator with vi, rogue, jove, etc., under UNIX using the vt52 termcap entry, and also (with some slight modification to allow generation of ENTER, pf, and cursor keys) under CMS. If anyone wants this version, I can mail the diff's.
The following characters are defined in addition to those found on the keyboard.
ctrl clear - {
ctrl insert - }
ctrl delete - ~
;*********************************
;* *
;* VT52A.ACT - a VT52+ emulator *
;* written in ACTION(tm) by *
;* *
;* Michael R. M. Jenkin *
;* University of Toronto *
;* ...!utcsri!utai!jenkin *
;* copyright(c) 1985 *
;* *
;* released into the public *
;* domain May, 1986. No part of *
;* this program may be *
;* redistributed for profit *
;* without permission of the *
;* author. *
;* *
;*********************************
MODULE
;A: handler, by Michael Jenkin
DEFINE LDY = "$A0",
RTS = "$60",
JMP = "$4C"
BYTE lmargin = $52, rmargin = $53,
rowcrs = $54, oldrow = $5A,
colcrs = $55,
oldchr = $5D, inesc, need,
needx, inv
CARD savmsc = $58,
oldcol = $5B
PROC Achr(BYTE cx, cy, cc)
BYTE POINTER base, offset
BYTE i, char, c
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
128 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
]
;strip high bit (inverse video)
cc ==& $7F
;display character
base = (cx RSH 1) + cy * 320 + savmsc
offset = cc
offset = offset LSH 3
offset ==+ chset
FOR i = 0 TO 7
DO
c = offset^
IF inv = 1 THEN
c = c XOR $FF ; c = NOT c
FI
char = base^
IF (cx & 1) THEN
c ==& $0F
char ==& $F0
ELSE
c = c LSH 4
char ==& $0F
FI
base^ = char % c
base ==+ 40
offset ==+1
OD
RETURN
PROC Acurse(BYTE cx, cy); invert char
BYTE POINTER base
BYTE i, char
base = (cx RSH 1) + 320 * cy + savmsc
FOR i = 0 TO 7
DO
char = base^
IF (cx & 1) THEN
char = char XOR $0F
ELSE
char = char XOR $F0
FI
base^ = char
base ==+ 40
OD
RETURN
PROC Ascroll() ; update cursor
IF colcrs > rmargin THEN
colcrs = lmargin
rowcrs ==+ 1
FI
IF rowcrs > 23 THEN
MoveBlock(savmsc,savmsc+320,320*23)
Zero(savmsc+23*320,320)
rowcrs = 23
FI
Acurse(colcrs,rowcrs)
RETURN
PROC Aesc(BYTE char) ; escape sequence
BYTE ch
BYTE POINTER addr
CARD i
IF need = 2 THEN ; 1st ESC Y
needx = char - $20
need ==- 1
ELSEIF need = 1 THEN ; 2nd ESC Y
char ==- $20
IF (needx <= 23) 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 < 23 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
Acurse(colcrs,rowcrs)
ELSE
FOR i = 0 TO 22 DO
addr = savmsc+320*(23-i)
MoveBlock(addr,addr-320,320)
OD
Zero(savmsc,320)
Acurse(colcrs,rowcrs)
FI
ELSEIF char = 'J THEN ; erase to EOS
FOR ch = colcrs TO 79
DO
Achr(ch,rowcrs,' )
OD
IF rowcrs < 23 THEN
Zero(savmsc+320*(rowcrs+1),320*(23-rowcrs))
FI
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 line
Acurse(colcrs,rowcrs)
FOR i = rowcrs TO 22 DO
addr = savmsc+320*(23-i+rowcrs)
MoveBlock(addr,addr-320,320)
OD
Zero(savmsc+320*rowcrs,320)
colcrs = 0
Acurse(colcrs,rowcrs)
ELSEIF char = 'M THEN ; delete line
IF rowcrs < 23 THEN
MoveBlock(savmsc+320*rowcrs,savmsc+320*(rowcrs+1),320*(23-rowcrs))
FI
Zero(savmsc+320*22,320)
colcrs = 0
Acurse(colcrs,rowcrs)
ELSEIF char = 'Y THEN ; cursor addr
need = 2
FI
IF need = 0 THEN
inesc = 0
FI
RETURN
PROC Aopen()
SetColor(0,0,0)
SetColor(1,12,15)
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)
BYTE i, n
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,
bcount = $02EB,
speed = ~[1],
wsize = ~[0],
sbits = ~[0],
lf = ~[0],
iparity = ~[0],
oparity = ~[0]
; iocb 3 definitions
BYTE iocb3cmd=$372 ; cmd byte
CARD iocb3buf=$374,; buffer address
iocb3len=$378 ; buffer length
DEFINE BUFLEN = "1024"
BYTE ARRAY BUFFER(BUFLEN)
PROC CIO=$E456(BYTE areg, xreg)
PROC init_R(); set options for R:
Close(3)
Open(3,"R:",13,0)
XIO(3,0,38,lf*64+oparity+4*iparity,0,"R1:")
XIO(3,0,36,speed+7+wsize*16+128*sbits,0,"R1:")
XIO(3,0,34,192,0,"R1:")
iocb3cmd=40 ; start concurrent I/O
iocb3buf=BUFFER
iocb3len=BUFLEN
CIO(0,$30) ; *** call CIO ***
bcount = 0
RETURN
PROC init_A(); set up A: device
Ahandler() ; install A: handler
Close(2)
Graphics(8+16)
Open(2,"A:",8,0)
RETURN
PROC intro()
Close(7)
Open(7,"K:",4,0)
init_R()
init_A()
RETURN
BYTE FUNC remote(); remote char?
XIO(3,0,13,0,0,"R:")
IF bcount = 0 THEN
RETURN(0)
FI
RETURN(1)
PROC do_remote(); process remote
BYTE char
char = GetD(3)
PutD(2,char)
RETURN
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 = 255 THEN ;right curl
char = 125
ELSEIF char = 96 THEN ;tilde
char = 126
ELSEIF char = 126 THEN ; delete
char = 127
FI
PutD(3,char)
RETURN
PROC main()
intro()
DO
IF remote() THEN
do_remote()
ELSEIF local() THEN
do_local()
FI
OD
RETURN
