›;*********************************›;*                               *›;* 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›