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

Add new attachment

Only authorized users are allowed to upload new attachments.
« This page (revision-2) was last changed on 20-Aug-2010 21:29 by Carsten Strotmann