;''''''''''''''''''''''''''''''''''''
; "TVI925.ACT" - A display-list based
; terminal emulator by Charles Green.
;
; Derived from the public domain VT52+
; emulator written by Michael Jenkin.
;,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
MODULE
;A: handler, originally by Jenkin. 

DEFINE LDY = "$A0",
 RTS = "$60", JMP = "$4C", PLA="$68",
 GR8 = "$0F", SKIP8 = "$70",
 JVP = "$41", LMS = "$40", RTI="$40",
 ESC = "1", CUP = "2", SGR = "3",
 PHA= "$48", TAX= "$AA", TXA= "$8A",
 TAY="$A8",TYA="$98",
 CMO = "4",
 XITVBV = "$E462"

TYPE line = [BYTE mode
 CARD adrs]
BYTE ARRAY display(8831) ;data+dlist
BYTE ARRAY enhance(8), cursor(4)
line POINTER dlist
BYTE POINTER curln ;current line data
BYTE pmbase = $D407, gractl=$D01D,
 lmargin = $52, rmargin = $53,
 rowcrs = $54, colcrs = $55, brkcnt,
 gprior = $26F, pcolr0 = $2C0,
 audc1 =$D201, hposm0 = $D004,
 sdmctl = $22F, soundr = $41, saudc1,
; audf1 = $D200,
; sskctl = $232,
 skctl = $D20F,
 state, need, needx, ins_mode, curcnt
CARD
; savmsc = $58,
 sdlist = $230,cursad,keydef = $79,
 vvblkd = $224, brkky = $236
 BYTE ARRAY xlate = [ ; New kbd map
$6C $6A $3B $80 $80 $6B $2B $2A
$6F $80 $70 $75 $0D $69 $2D $3D
$76 $FF $63 $80 $80 $62 $78 $7A
$34 $80 $33 $36 $1B $35 $32 $31
$2C $20 $2E $6E $80 $6D $2F $7E
$72 $80 $65 $79 $09 $74 $77 $71
$39 $80 $30 $37 $08 $38 $3C $3E
$66 $68 $64 $80 $82 $67 $73 $61 ;lowr
$4C $4A $3A $80 $80 $4B $5C $5E
$4F $80 $50 $55 $0D $49 $5F $7C
$56 $FF $43 $80 $80 $42 $58 $5A
$24 $80 $23 $26 $1B $25 $22 $21
$5B $20 $5D $4E $80 $4D $3F $60
$52 $80 $45 $59 $FE $54 $57 $51
$28 $80 $29 $27 $7F $40 $7B $7D
$46 $48 $44 $80 $82 $47 $53 $41 ;uper
$0C $0A $F0 $80 $80 $0B $1C $1E
$F0 $80 $10 $15 $0A $09 $1F $F0
$16 $FF $03 $80 $80 $02 $18 $1A
$F0 $80 $F0 $F0 $1B $F0 $F0 $F0
$1B $00 $1D $0E $80 $0D $7F $F0
$12 $80 $05 $19 $FD $14 $17 $11
$F0 $80 $F0 $F0 $7F $00 $F0 $F0
$06 $08 $04 $80 $82 $07 $13 $01 ;ctrl
 ]

PROC vbi()
 IF curcnt = 0 THEN
  pcolr0 ==! 5 ;invert cursor
  curcnt = 15
 ELSEIF curcnt < 255 THEN
  curcnt ==- 1
 FI
 IF saudc1 > $E0 THEN
  saudc1 ==- 1
  audc1 = saudc1
; SOUND(2,100,14,bel)
 FI                                
 IF brkcnt THEN
  brkcnt ==- 1
  IF brkcnt = 0 THEN
;  sskctl ==& $7F ;remove force space
;  skctl = sskctl
   skctl = $73
  FI
 FI
 [JMP XITVBV]

PROC brk() ;break interrupt handler
; [TYA PHA TXA PHA]
 brkcnt = 15;
; sskctl ==% $80 ;force serial space
; skctl = sskctl
 skctl = $F3
; [PLA TAX PLA TAY]
 [PLA RTI]

PROC del_ch(BYTE POINTER adr, BYTE col)
 BYTE POINTER badr,wadr
 BYTE x, y, bcount
 bcount = (80-col) RSH 1
 FOR y = 1 TO 7
 DO
  adr ==+ 40
  wadr = adr + (col RSH 1) - 1
  badr = wadr + 1
  IF col & 1 THEN
   badr ==+ 1
   wadr ==+ 1
   wadr^ =(wadr^ & $F0)%(badr^ RSH 4)
  FI
  x = bcount
  WHILE x > 0
  DO
   badr ==+ 1
   wadr ==+ 1
   wadr^ =(wadr^ LSH 4)%(badr^ RSH 4)
   x ==- 1
  OD
  wadr^ ==& $F0
 OD
 RETURN ; null proc for now

PROC ins_ch(BYTE POINTER adr, BYTE col)
 BYTE POINTER badr,wadr
 BYTE x, y, bcount
 bcount = (79-col) RSH 1
 FOR y = 1 TO 7
 DO
  adr ==+ 40
  badr = adr + 39
  wadr = badr - 1
  x = bcount
  WHILE x > 0
  DO
   badr^ =(wadr^ LSH 4)%(badr^ RSH 4)
   x ==- 1
   badr ==- 1
   wadr ==- 1
  OD
  IF col & 1 THEN
   badr^ ==& $F0
  ELSE
   badr^ ==RSH 4
  FI
 OD
 RETURN ; null proc for now

PROC Achr(BYTE cx, cy, cc)
 BYTE POINTER base, offset
 BYTE i, chr, c
 BYTE ARRAY chset = [
  $00 $00 $00 $00 $00 $00 $00 ; SP
  $44 $44 $44 $00 $44 $00 $00
  $AA $AA $00 $00 $00 $00 $00
  $AA $EE $AA $EE $AA $00 $00
  $EE $CC $EE $66 $EE $00 $00
  $AA $22 $44 $88 $AA $00 $00
  $CC $44 $CC $EE $EE $00 $00
  $66 $22 $44 $00 $00 $00 $00
  $22 $44 $44 $44 $22 $00 $00
  $88 $44 $44 $44 $88 $00 $00
  $00 $AA $EE $AA $00 $00 $00
  $00 $44 $EE $44 $00 $00 $00
  $00 $00 $00 $66 $22 $44 $00
  $00 $00 $EE $00 $00 $00 $00
  $00 $00 $00 $66 $66 $00 $00
  $22 $22 $44 $44 $88 $88 $00
  $44 $AA $AA $AA $44 $00 $00 ;'0'
  $44 $CC $44 $44 $EE $00 $00
  $CC $22 $44 $88 $EE $00 $00
  $CC $22 $44 $22 $CC $00 $00
  $AA $AA $EE $22 $22 $00 $00
  $EE $88 $CC $22 $CC $00 $00
  $44 $88 $EE $AA $44 $00 $00
  $EE $22 $44 $88 $88 $00 $00
  $44 $AA $44 $AA $44 $00 $00
  $44 $AA $66 $22 $44 $00 $00
  $66 $66 $00 $66 $66 $00 $00
  $66 $66 $00 $66 $22 $44 $00
  $22 $44 $88 $44 $22 $00 $00
  $00 $EE $00 $EE $00 $00 $00
  $88 $44 $22 $44 $88 $00 $00
  $CC $22 $44 $00 $44 $00 $00
  $44 $AA $AA $88 $66 $00 $00 ;'@'
  $44 $AA $EE $AA $AA $00 $00
  $CC $AA $CC $AA $CC $00 $00
  $66 $88 $88 $88 $66 $00 $00
  $CC $AA $AA $AA $CC $00 $00
  $EE $88 $CC $88 $EE $00 $00
  $EE $88 $CC $88 $88 $00 $00
  $66 $88 $AA $AA $66 $00 $00
  $AA $AA $EE $AA $AA $00 $00
  $EE $44 $44 $44 $EE $00 $00
  $66 $22 $22 $AA $EE $00 $00
  $AA $CC $88 $CC $AA $00 $00
  $88 $88 $88 $88 $EE $00 $00
  $AA $EE $EE $AA $AA $00 $00
  $CC $AA $AA $AA $AA $00 $00
  $66 $AA $AA $AA $CC $00 $00
  $CC $AA $CC $88 $88 $00 $00 ;'P'
  $66 $AA $AA $AA $EE $22 $00
  $CC $AA $CC $CC $AA $00 $00
  $66 $88 $CC $22 $EE $00 $00
  $EE $44 $44 $44 $44 $00 $00
  $AA $AA $AA $AA $66 $00 $00
  $AA $AA $AA $44 $44 $00 $00
  $AA $AA $EE $EE $AA $00 $00
  $AA $AA $44 $AA $AA $00 $00
  $AA $AA $44 $44 $44 $00 $00
  $EE $22 $44 $88 $EE $00 $00
  $66 $44 $44 $44 $66 $00 $00
  $88 $88 $44 $44 $22 $22 $00
  $CC $44 $44 $44 $CC $00 $00
  $44 $AA $00 $00 $00 $00 $00
  $00 $00 $00 $00 $EE $00 $00
  $66 $44 $22 $00 $00 $00 $00
  $00 $CC $66 $AA $66 $00 $00 ;'a'
  $88 $CC $AA $AA $CC $00 $00
  $00 $66 $88 $88 $66 $00 $00
  $22 $66 $AA $AA $66 $00 $00
  $00 $EE $EE $88 $66 $00 $00
  $22 $44 $EE $44 $44 $00 $00
  $00 $66 $AA $AA $66 $22 $CC
  $88 $EE $AA $AA $AA $00 $00
  $44 $00 $CC $44 $EE $00 $00
  $44 $00 $CC $44 $44 $88 $00
  $88 $88 $AA $CC $AA $00 $00
  $CC $44 $44 $44 $EE $00 $00
  $00 $CC $EE $EE $AA $00 $00
  $00 $CC $AA $AA $AA $00 $00
  $00 $66 $AA $AA $CC $00 $00
  $00 $CC $AA $AA $CC $88 $88 ;'p'
  $00 $66 $AA $AA $66 $22 $22
  $00 $EE $88 $88 $88 $00 $00
  $00 $CC $EE $22 $CC $00 $00
  $44 $EE $44 $44 $44 $00 $00
  $00 $AA $AA $AA $66 $00 $00
  $00 $AA $AA $44 $44 $00 $00
  $00 $AA $EE $EE $66 $00 $00
  $00 $AA $44 $AA $AA $00 $00
  $00 $AA $AA $AA $66 $22 $CC
  $00 $EE $44 $88 $EE $00 $00
  $66 $44 $88 $44 $66 $00 $00
  $44 $44 $44 $44 $44 $00 $00
  $CC $44 $22 $44 $CC $00 $00
  $CC $66 $00 $00 $00 $00 $00
  $AA $44 $AA $44 $AA $44 $AA
 ]
;strip high bit (inverse video)
 offset = cc - $20
;display character            
 dlist=sdlist + cy * 10 + 3
 base = dlist.adrs + (cx RSH 1) + 40
 IF ins_mode THEN
  ins_ch(dlist.adrs, cx)
 FI
 offset = chset+(offset LSH 3)-offset
 FOR i = 1 TO 7
 DO
  c = offset^
   c = c XOR enhance(i)
  chr = base^                 
  IF (cx & 1) THEN
   c ==& $0F
   chr ==& $F0
  ELSE        
   c ==& $F0
   chr ==& $0F           
  FI                             
   base^ = chr % c
   base ==+ 40
   offset ==+1
 OD
 RETURN

PROC Acurse(); move cursor
 BYTE old_y ;Where we left cursor
 Zero(cursad+(old_y LSH 2), 4)
 hposm0 = (colcrs LSH 1) + 48
 MoveBlock(cursad+(rowcrs LSH 2),cursor,4)
 old_y = rowcrs ;memory for later clr
 pcolr0=5
 IF curcnt < 255 THEN
  curcnt=254
 FI
 RETURN

PROC scroll(BYTE first, last)
 line POINTER tdlist
 CARD tempadrs
 INT delta
 BYTE i   
 dlist=sdlist+3 + first*10
 tempadrs=dlist.adrs
 Zero(tempadrs,320)
 IF first>last THEN
  i=first
  first=last
  last=i
  delta=-1
 ELSE
  delta=1
 FI
 FOR i=first+1 TO last
 DO
  tdlist = dlist+10            *delta
  dlist.adrs = tdlist.adrs
  dlist = tdlist
 OD
 dlist.adrs = tempadrs
 RETURN

PROC Amargin() ; keep between margins
 IF colcrs > rmargin THEN
  colcrs = lmargin
  rowcrs ==+ 1
 FI ;fallthrough to Ascroll()
PROC Ascroll() ; roll screen if req'd
 IF rowcrs > 23 THEN
  scroll(0,23)
  rowcrs = 23
 FI
 RETURN

PROC curpos(BYTE chr)
 IF need = 2 THEN ; 1st ESC Y
  needx = chr - $20
  need ==- 1
 ELSEIF need = 1 THEN ; 2nd ESC Y
  chr ==- $20
  IF (needx <= 23) AND (chr <= rmargin) THEN
   colcrs = chr
   rowcrs = needx
;   Acurse()
  FI
  state = 0
 FI
 RETURN

PROC cursat(BYTE chr) ;cursor type
 IF chr = '2 THEN ;blinking block?
  curcnt = 254
  SetBlock(cursor,4,3)
 ELSEIF chr = '4 THEN ;steady line?
  curcnt = 255
  SetBlock(cursor,3,0)
  cursor(3) = 3
 FI
 pcolr0=5 ;third-intensity cursor
 state=0
 RETURN

PROC attrib(BYTE chr) ; enhance
 IF chr = '0 THEN
  Zero(enhance, 8)
 ELSEIF chr = '4 THEN ; reverse
  SetBlock(enhance, 8, $FF)
 ELSEIF chr = '8 THEN ; underline
  Zero(enhance, 8)
  enhance(6) = $FF
 ELSEIF chr = '> THEN ; both modes
  SetBlock(enhance, 8, $FF)
  enhance(6) = $00
 FI
 state = 0
 RETURN

PROC Aesc(BYTE chr) ; escape sequence
 BYTE ch
 CARD i
 IF chr = 'E THEN ; insert line
  dlist=sdlist+3+rowcrs*10
  scroll(23,rowcrs)
 ELSEIF chr = '. THEN ; cursor attrib
  state = CMO ; cursor rendition
  RETURN
 ELSEIF chr = 'G THEN ; inverse off
  state = SGR ; select rendition
  RETURN
 ELSEIF chr = 'I THEN ; back tab
  colcrs = (colcrs - 1) & $F8
 ELSEIF chr = 'j THEN ; reverse lf
  IF rowcrs > 0 THEN   
   rowcrs ==- 1
  ELSE
   scroll(23,0)
  FI
;  Acurse()
 ELSEIF chr = '* THEN ; home & clear
  rowcrs = 0
  colcrs = 0
  Aesc('Y) 
; erase to EOS ( y?? )
 ELSEIF chr = 'Y OR chr = 'y THEN
  FOR ch = colcrs TO 79
  DO
   Achr(ch,rowcrs,' )
  OD                             
  IF rowcrs < 23 THEN
   dlist=sdlist+3+10*rowcrs
   FOR i = rowcrs+1 TO 23
   DO
    dlist==+ 10
    Zero(dlist.adrs,320)
   OD
  FI
;  Acurse()
 ; erase to EOL
 ELSEIF chr = 'T OR chr = 't THEN
  FOR ch = colcrs TO 79
  DO
   Achr(ch,rowcrs,' )
  OD                   
;  Acurse()
 ELSEIF chr = 'R THEN ; delete line
  dlist=sdlist+3+10*rowcrs
  scroll(rowcrs,23)
 ELSEIF chr = '= THEN ; cursor addr
  state = CUP
  need = 2
  RETURN
 ELSEIF chr = 'Q THEN ; insert char
  dlist=sdlist+3+10*rowcrs
  ins_ch(dlist.adrs,colcrs)
 ELSEIF chr = 'W THEN ; delete char
  dlist=sdlist+3+10*rowcrs
  del_ch(dlist.adrs,colcrs)
 ELSEIF chr = 'Z THEN ; multi-insert
  ins_mode = 1;
 ELSEIF chr = 'r THEN ; end multi-ins
  ins_mode = 0;
 ELSEIF chr = 'b THEN ; BlackOnWhite
  SetColor(2,0,15)
  SetColor(1,0,0)
 ELSEIF chr = 'd THEN ; WhiteOnBlack
  SetColor(2,0,0)
  SetColor(1,0,15)
 FI      
 state = 0
 RETURN

PROC Aopen()
 BYTE i
 sdmctl=0 ;No Antic DMA till DL ready
 vvblkd=vbi ;Put our vbi routine in
 brkky=brk ;Put our break routine in
; Examine data array for alignment
 sdlist=(display & $F000) + $1C80
 pmbase=sdlist RSH 8 ;page of plr/mis
 cursad=sdlist+$100
 dlist=sdlist
 FOR i = 0 TO 2 DO
  dlist.mode = SKIP8
  dlist==+1
 OD
 curln=display
 FOR i=0 TO 23 DO
  IF (curln = sdlist) THEN
   curln==+ $180
  FI
  IF (curln & $FFF) > $EC0 THEN
   curln = (curln & $F000) + $1000
  FI
  dlist.mode = GR8 + LMS
  dlist.adrs = curln
  SetBlock(dlist+3,7,GR8)
  curln==+ 320
  dlist ==+ 10
 OD
 dlist.mode = JVP
 dlist.adrs = sdlist
 SetColor(2,0,0) ; was 0,0,0
 SetColor(1,0,15) ; was 1,12,15
 SetColor(4,0,2) ; new - border
 gprior=8 ;cursor behind letters
 gractl=1 ;turn missiles on     
 sdmctl=$26 ;enable missile DMA
 Zero(cursad,128) ;clear missile data
 cursad ==+ 16 ;true top of screen
 state = 0
 lmargin = 0
 rmargin = 79   
 rowcrs = 0
 colcrs = 0
 Acurse()
 attrib('0) ;normal video
 cursat('4) ;normal cursor
 [LDY 1 RTS]

PROC Aclose()
 [LDY 1 RTS]

PROC Aput(BYTE areg)
 IF state = ESC THEN; escape sequence
  Aesc(areg)
 ELSEIF state = CUP THEN ; cursor pos
  curpos(areg)
 ELSEIF state = CMO THEN ; curs enhnc
  cursat(areg)
 ELSEIF state = SGR THEN ; enhance
  attrib(areg)
 ELSEIF areg = $1B THEN ; ESC
  state = ESC
 ELSEIF areg = $1A THEN ; ClearScreen
  colcrs = 0
  rowcrs = 0
  Aesc('Y)
 ELSEIF areg = $1E THEN ; home
  colcrs = 0
  rowcrs = 0
;  Acurse()
 ELSEIF areg = $0B THEN ; cursor up
  IF rowcrs > 0 THEN
   rowcrs ==- 1
;   Acurse()
  FI
 ELSEIF areg = $16 THEN ; cursor down
  IF rowcrs < 23 THEN 
   rowcrs ==+ 1
;   Acurse()
  FI
 ELSEIF areg = $0C THEN ; cursor right
  IF colcrs < rmargin THEN
   colcrs ==+ 1
;   Acurse()
  FI
 ELSEIF areg = $0D THEN ; CR 
  colcrs = lmargin ; was = 0
 ELSEIF areg = $0A THEN ; lf
  rowcrs ==+ 1
  IF colcrs > rmargin THEN          
   colcrs = 0 ;altos vi kludge
  FI
  Ascroll()
 ELSEIF areg = $08 THEN ; BS 
  IF colcrs > lmargin THEN ;was >0
   colcrs ==- 1
  ELSEIF rowcrs > 0 THEN ;bs wraps
   colcrs = rmargin
   rowcrs==- 1
  FI
 ELSEIF areg = $07 THEN ; bell
  saudc1 = $F0
; bel = 16 ; vbi() will pickup
 ELSEIF areg = $09 THEN ; TAB
  colcrs = (colcrs + 8) & $F8
  Amargin()
 ELSEIF areg > $1F THEN ;printable  
  Amargin() ;new here
  Achr(colcrs,rowcrs,areg)
  colcrs ==+ 1
;ELSE unrecognized control-nothing
 FI
 Acurse() ;update cursor
 [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 Jump = [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 = [3], ;CWG 1=300BPS 3=1200
 wsize = [0],
 sbits = [0],
 lf = [0],
 iparity = [0],
 oparity = [0]     
   
PROC init_R(); set options for R:
 Close(3)
 Open(3,"R:",13,0)
 XIO(3,0,38,lf*64+32+iparity*4+oparity,0,"R1:") ;32=no xlate
 XIO(3,0,36,speed+7+wsize*16+128*sbits,0,"R1:")
 XIO(3,0,34,192,0,"R1:")
 XIO(3,0,40,0,0,"R1:") ;concurrent IO
 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()  
 soundr=0
 Close(7)
 Open(7,"K:",4,0)
 keydef = xlate ; load key translate
 init_R()
 init_A()
 soundr=0
 RETURN

PROC do_remote(); process remote
 BYTE chr
 BYTE stop = [0]
 BYTE HIWAT = [128]
 XIO(3,0,13,0,0,"R:")
 IF bcount > HIWAT THEN
  PutD(3,$13)     ;XOFF
  stop=1
 FI
 WHILE bcount > 0
 DO
  chr = GetD(3)
  PutD(2,chr & $7F)
  bcount ==- 1
 OD          
 IF stop THEN
  PutD(3,$11)     ;XON
  stop=0
 FI
 RETURN

PROC do_local(); process local
 BYTE chr
 IF $FF - ch THEN        ;INPUT
  chr = GetD(7)
  PutD(3,chr)
 FI      ; END IF CHAR
 RETURN

PROC main()
 intro()
 DO
  do_remote()
  do_local()
 OD
 RETURN