          if       iodriverpoll
profilechain equ   nextdpb
          fin      iodriverpoll
          if       iodriverbody
          ifund    nexdpb
nextdpb   set      0
          fin      nextdpb
          page     malvt profile (included in all standard I/O packages)
profilenum.malvt equ 1

thisdpb   set      *
          fcb      profilenum.malvt               profile name
          fcb      dvtyp.console
          fdb      nextdpb                        next profile
          fcb      80                             default width
          fcb      24                             default depth
          fcb      5                              flags
          fdb      6*tickspersecond+ntimeoutblocks
          okrts                                   input translation routine
          if       m6800!m6801
          nop
          fin
          jmp      sdos+sdos:vtmalvt              perform control functions
          rts                                     set output coloring
          nop
          nop
          rts                                     set background coloring
*         nop
*         nop
*         fcb       0,0,0,0,0,0,0,0               gpinit data
nextdpb   set      thisdpb
          page     mallpt profile (included in all standard I/O packages)
profilenum.mallpt equ 9

thisdpb   set      *
          fcb      profilenum.mallpt              profile name
          fcb      dvtyp.printer
          fdb      nextdpb                        next profile
          fcb      132                            default width
          fcb      66                             default depth
          fcb      3                              flags
          fdb      6*tickspersecond+ntimeoutblocks
          okrts                                   input translation routine
          if       m6800!m6801
          nop
          fin
          jmp      sdos+sdos:vtmallpt             perform control functions
          rts      set output coloring
          nop
          nop
          rts                                     set background coloring
*         nop
*         nop
*         fcb       0,0,0,0,0,0,0,0               gpinit data
nextdpb   set      thisdpb
          page     hardcopyvt profile and support code (included in all standard I/O packages)
profilenum.hardcopyvt equ 6

thisdpb   set      *
          fcb      profilenum.hardcopyvt          profile name
          fcb      dvtyp.console
          fdb      nextdpb                        next profile
          fcb      80                             default width
          fcb      0                              default depth
          fcb      20                             flags
          fdb      6*tickspersecond+ntimeoutblocks
          okrts                                   perform input translation
          if       m6800!m6801
          nop
          fin
          errorrts                                perform default control functions
          if       m6800!m6801
          nop
          fin
          rts                                     set output coloring
          nop
          nop
          rts                                     set background coloring
*         nop
*         nop
*         fcb       0,0,0,0,0,0,0,0               gpinit data
nextdpb   set      thisdpb
          ifund    profile.cenlpt
          else
          page     cenlpt profile and support code
profilenum.cenlpt equ 10

thisdpb   set      *
          fcb      profilenum.cenlpt              profile name
          fcb      dvtyp.printer
          fdb      nextdpb                        next profile
          fcb      80                             default width
          fcb      24                             default depth
          fcb      4                              flags
          fdb      6*tickspersecond+ntimeoutblocks
          okrts                                   input translation routine
          if       m6800!m6801
          nop
          fin
          errorrts                                perform default control functions
          if       m6800!m6801
          nop
          fin
          rts                                     set output coloring
          nop
          nop
          rts                                     set background coloring
*         nop
*         nop
*         fcb       0,0,0,0,0,0,0,0               gpinit data
nextdpb   set      thisdpb
          fin      profile.cenlpt
          ifund    profile.rs232lpt
          else
          page     rs232lpt profile and support code
;   Operates a printer using standard ascii control codes for everything

profilenum.rs232lpt equ 11

thisdpb   set      *
          fcb      profilenum.rs232lpt            profile name
          fcb      dvtyp.printer
          fdb      nextdpb                        next profile
          fcb      132                            default width
          fcb      66                             default depth
          fcb      2                              flags
          fdb      6*tickspersecond+ntimeoutblocks
          okrts                                   input translation routine
          if       m6800!m6801
          nop
          fin
          errorrts                                perform default control functions
          if       m6800!m6801
          nop
          fin
          rts                                     set output coloring
          nop
          nop
          rts                                     set background coloring
*         nop
*         nop
*         fcb       0,0,0,0,0,0,0,0               gpinit data
nextdpb   set      thisdpb
          fin      profile.rs232lpt
          ifund    profile.adm1
          else
          page     adm1 profile and support code
profilenum.adm1 equ 2

thisdpb   set      *
          fcb      profilenum.adm1                profile name
          fcb      dvtyp.console
          fdb      nextdpb                        next profile
          fcb      80                             default width
          fcb      24                             default depth
          fcb      4                              flags
          fdb      6*tickspersecond+ntimeoutblocks
          okrts                                   perform input translation
          if       m6800!m6801
          nop
          fin
          jmp      specialoutput:adm1             perform control functions
          rts                                     set output coloring
          nop
          nop
          rts                                     set background coloring
*         nop
*         nop
*         fcb       0,0,0,0,0,0,0,0               gpinit data
nextdpb   set      thisdpb
          page
specialoutput:adm1
          cmpa     #specialoutput:newline         want a newline character ?
          beq      specialoutput:adm1.newline
          cmpa     #specialoutput:posn
          beq      specialoutput:adm1.posn
          cmpa     #specialoutput:form            want a form character ?
          beq      specialoutput:asm1.form        b/ yes
          errorrts        else perform default version of function

specialoutput:adm1.newline
          ldaa     #ascii:cr                      output <cr>...
          jsr      tlbuffer,x
          ldaa     #ascii:lf                      then <lf>
          jsr      tlbuffer,x
specialoutput:adm1.pad ; output pad to let CRT keep up
          clra                                    a null pad byte
          jsr      tlbuffer,x
          clra                                    a null pad byte
          jsr      tlbuffer,x
          clra                                    a null pad byte
          jsr      tlbuffer,x
          clra                                    a null pad byte
          jmp      tlbuffer,x

specialoutput:adm1.form
          ldaa     #ascii:esc
          jsr      tlbuffer,x
          ldaa     #'*
          jsr      tlbuffer,x
          bra      specialoutput:adm1.pad
          page
specialoutput:adm1.posn
          ldaa     #ascii:esc
          jsr      dcb:tlbuffer,x
          ldaa     #'=                            set up to do a position fn
          jsr      dcb:tlbuffer,x
          tsx
          ldaa     2,x
          adda     #$20
          ldx      dcbpointer
          jsr      dcb:tlbuffer,x
          tsx
          ldaa     3,x
          adda     #$20
          ldx      dcbpointer
          jsr      dcb:tlbuffer,x
          okrts
          fin      profile.adm1
          ifund    profile.adm3
          else
          page     adm3 profile and support code
profilenum.adm3 equ 3

thisdpb   set      *
          fcb      profilenum.adm3                profile name
          fcb      dvtyp.console
          fdb      nextdpb                        next profile
          fcb      80                             default width
          fcb      24                             default depth
          fcb      4                              flags
          fdb      6*tickspersecond+ntimeoutblocks
          jmp      xlatei:adm3                    perform input translation
          jmp      specialoutput:adm3             perform control functions
          rts                                     set output coloring
          nop
          nop
          rts                                     set background coloring
          nop
          nop
          fcb      0                              initial XLATEI state byte
nextdpb   set      thisdpb
          page
          ifund    dcb:xlatestate
dcb:xlatestate equ dcb:profile+dpb:gpinit         translate state byte is 1st gp byte
          fin
xlatei:adm3
;   translate adm3 input found in (a), returning translated character in (a)
;   with carry clear; carry set will cause character to be lost
          ldab     #$7f                           assume swap for underscore key
          cmpa     #$5f                           swap for underscore ?
          beq      xlatei:adm3.b                  b/ yes, use (B) as translation
          ldab     #$5f                           assume swap for DEL key
          cmpa     #$7f                           swap for DEL key ?
          bne      xlatei:adm3.done               b/ no
xlatei:adm3.b ; use (B) as translation
          tba
xlatei:adm3.done
          okrts
          page
specialoutput:adm3
;   called to perform control functions for a Lear Siegler ADM 3-A
;   The position, and clear functions are implemented.  All others
;   must be simulated by the VT driver.
          cmpa     #specialfn:posn
          beq      specialoutput:adm3posn
          cmpa     #specialfn:clear
          beq      specialoutput:adm3clear
          errorrts                               adm3a can't do anything else

specialoutput:adm3posn
          ldaa     #ascii:esc
          jsr      dcb:tlbuffer,x
          ldaa     #'=                           set up to do a position fn
          jsr      dcb:tlbuffer,x
          tsx
          ldaa     2,x
          adda     #$20
          ldx      dcbpointer
          jsr      dcb:tlbuffer,x
          tsx
          ldaa     3,x
          adda     #$20
          ldx      dcbpointer
          jsr      dcb:tlbuffer,x
          okrts

specialoutput:adm3clear
          ldaa     #$1a                          performs a clear screen fn
          jsr      dcb:tlbuffer,x
          okrts
          fin      profile.adm3
          ifund    profile.tvi912c
          else
          page     tvi912c profile and support code
profilenum.tvi912c equ 7

thisdpb   set      *
          fcb      profilenum.tvi912c             profile name
          fcb      dvtyp.console
          fdb      nextdpb                        next profile
          fcb      80                             default width
          fcb      24                             default depth
          fcb      12                             flags
          fdb      6*tickspersecond+ntimeoutblocks
          okrts                                   perform input translation
          if       m6800!m6801
          nop
          fin
          jmp      specialoutput:tvi912c          perform control functions
          rts                                     set output coloring
          nop
          nop
          rts                                     set background coloring
*         nop
*         nop
*         fcb       0,0,0,0,0,0,0,0               gpinit data
nextdpb   set      thisdpb
          page
specialoutput:tvi912c
;   called to perform control functions for a TeleVideo 912-c
;   All functions are implemented
          cmpa     #specialfn:posn
          beq      specialoutput:tvi912cposn
          cmpa     #specialfn:clear
          beq      specialoutput:tvi912cclear
          cmpa     #specialfn:eeol
          beq      specialoutput:tvi912ceeol
          errorrts                               tvi912c can't do anything else

specialoutput:tvi912cposn
          ldaa     #ascii:esc
          jsr      dcb:tlbuffer,x
          ldaa     #'=                           set up to do a position fn
          jsr      dcb:tlbuffer,x
          tsx
          ldaa     2,x
          adda     #$20
          ldx      dcbpointer
          jsr      dcb:tlbuffer,x
          tsx
          ldaa     3,x
          adda     #$20
          ldx      dcbpointer
          jsr      dcb:tlbuffer,x
          okrts

specialoutput:tvi912cclear
          ldaa     #$1a                          performs a clear screen fn
          jsr      dcb:tlbuffer,x
          okrts

specialoutput:tvi912ceeol
          ldaa     #$1b
          jsr      dcb:tlbuffer,x
          ldaa     #'T
          jsr      dcb:tlbuffer,x
          okrts
          page
          fin      profile.tvi912c
          ifund    profile.soroc120
          else
          page     soroc120 profile and support code

profilenum.soroc120 equ 4

thisdpb   set      *
          fcb      profilenum.soroc120            profile name
          fcb      dvtyp.console
          fdb      nextdpb                        next profile
          fcb      80                             default width
          fcb      24                             default depth
          fcb      12                             flags
          fdb      6*tickspersecond+ntimeoutblocks
          okrts                                   perform input translation
          if       m6800!m6801
          nop
          fin
          jmp      specialoutput:soroc120         perform control functions
          rts                                     set output coloring
          nop
          nop
          rts                                     set background coloring
*         nop
*         nop
*         fcb       0,0,0,0,0,0,0,0               gpinit data
nextdpb   set      thisdpb
          page
specialoutput:soroc120
;   called to perform control functions for a SOROC IQ-120
;   The position, clear, and erase to end of line functions are implemented.
          cmpa     #specialfn:posn
          beq      specialoutput:soroc120posn
          cmpa     #specialfn:clear
          beq      specialoutput:soroc120clear
          cmpa     #specialfn:eeol
          beq      specialoutput:soroc120eeol
          errorrts                               soroc120a can't do anything else

specialoutput:soroc120posn
          ldaa     #ascii:esc
          jsr      dcb:tlbuffer,x
          ldaa     #'=                           set up to do a position fn
          jsr      dcb:tlbuffer,x
          tsx
          ldaa     2,x
          adda     #$20
          ldx      dcbpointer
          jsr      dcb:tlbuffer,x
          tsx
          ldaa     3,x
          adda     #$20
          ldx      dcbpointer
          jsr      dcb:tlbuffer,x
          okrts

specialoutput:soroc120clear
          ldaa     #$1b                          performs a clear screen fn
          jsr      dcb:tlbuffer,x
          ldaa     #'*
          jsr      dcb:tlbuffer,x
          okrts

specialoutput:soroc120eeol
          ldaa     #$1b                          erase to end of line
          jsr      dcb:tlbuffer,x
          ldaa     #'T
          jsr      dcb:tlbuffer,x
          okrts
          page
          fin      profile.soroc120
          ifund    profile.h19
          else
          page     h19 profile and support code
profilenum.h19 equ 5

thisdpb   set      *
          fcb      profilenum.h19                 profile name
          fcb      dvtyp.console
          fdb      nextdpb                        next profile
          fcb      80                             default width
          fcb      24                             default depth
          fcb      4                              flags
          fdb      6*tickspersecond+ntimeoutblocks
          jmp      xlatei:h19                     perform input translation
          jmp      specialoutput:h19              perform control functions
          jmp      coloring:h19                   set output coloring
          rts                                     set background coloring (none)
          nop
          nop
          fcb      0                              initial XLATEI state byte
nextdpb   set      thisdpb
          page
          ifund    dcb:xlatestate
dcb:xlatestate equ dcb:profile+dpb:gpinit         translate state byte is 1st gp byte
          fin
xlatei:h19
;   translate h19 input found in (a), returning translated character in (a)
;   with carry clear; carry set will cause character to be lost
          tst      dcb:xlatestate,x
          bne      xlatei:h19.escape
          cmpa     #ascii:esc
          bne      xlatei:h19.ok
          inc      dcb:xlatestate,x
          errorrts

xlatei:h19.b ; use (B) as translation of character
          tba
xlatei:h19.ok ; (A) is tranlated character
          okrts

xlatei:h19.escape
;   if character following <ESC> is not A, B, C, D, J, N, or Q,
;   then bitch and revert to the standard state
          clr      dcb:xlatestate,x
          ldab     #ascii:vt
          cmpa     #'A                           cursor up?
          beq      xlatei:h19.b
          ldab     #ascii:lf
          cmpa     #'B                           cursor down?
          beq      xlatei:h19.b
          ldab     #ascii:ff
          cmpa     #'C                           cursor right?
          beq      xlatei:h19.b
          ldab     #ascii:bs
          cmpa     #'D                           cursor left?
          beq      xlatei:h19.b
          ldab     #ascii:enq
          cmpa     #'J                           ^E?
          beq      xlatei:h19.b
          ldab     #ascii:nak
          cmpa     #'N                           ^U?
          beq      xlatei:h19.b
          ldab     #ascii:esc
          cmpa     #'Q                           <ESC>?
          beq      xlatei:h19.b
xlatei:h1932
          inc      dcb:beepcount,x
          errorrts                               ignore character
          page
specialoutput:h19
;   called to perform control functions for a Heath H-19
;   The position, clear and erase to end of line functions are implemented.
          cmpa     #specialfn:posn
          beq      specialoutput:h19posn
          cmpa     #specialfn:clear
          beq      specialoutput:h19clear
          cmpa     #specialfn:eeol
          beq      specialoutput:h19eeol
          errorrts                               h19 can't do anything else

specialoutput:h19posn
          ldaa     #ascii:esc
          jsr      dcb:tlbuffer,x
          ldaa     #'Y                           set up to do a position fn
          jsr      dcb:tlbuffer,x
          tsx
          ldaa     2,x
          adda     #$20
          ldx      dcbpointer
          jsr      dcb:tlbuffer,x
          tsx
          ldaa     3,x
          adda     #$20
          ldx      dcbpointer
          jsr      dcb:tlbuffer,x
          okrts

specialoutput:h19clear
          ldaa     #ascii:esc
          jsr      dcb:tlbuffer,x
          ldaa     #'E                           performs a clear screen fn
          jsr      dcb:tlbuffer,x
          okrts

specialoutput:h19eeol
          ldaa     #ascii:esc
          jsr      dcb:tlbuffer,x
          ldaa     #'K                           performs a eeol fn
          jsr      dcb:tlbuffer,x
          okrts
          page
coloring:h19
          bita     #%00001000                     reverse video desired ?
          bne      coloring:h19reversevideo       b/ yes
          lda      #ascii:esc                     send "normal video" command
          jsr      dcb:tlbuffer,x
          lda      #'q
          jmp      dcb:tlbuffer,x

coloring:h19reversevideo
          lda      #ascii:esc                     send "reverse video" request
          jsr      dcb:tlbuffer,x
          lda      #'p
          jmp      dcb:tlbuffer,x
          fin      profile.h19
          ifund    profile.hazeltine
          else
profile.hazeltinexxx equ 12
          ???hazeltine not implemented
          fin      profile.hazeltine
          ifund    profile.beehive
          else
profile.hazeltinexxx equ 13
          ???beehive not implemented
          fin      profile.beehive
          ifund    profile.exorterm155
          else
          page     Exorterm 155 profile and support code
profilenum.exorterm155 equ 8

thisdpb   set      *
          fcb      profilenum.exorterm155         profile name
          fcb      dvtyp.console
          fdb      nextdpb                        next profile
          fcb      80                             default width
          fcb      24                             default depth
          fcb      12                             flags
          fdb      6*tickspersecond+ntimeoutblocks
          jmp      xlatei:exorterm155             perform input translation
          jmp      specialoutput:exorterm155      perform control functions
          jmp      coloring:exorterm155           set output coloring
          jmp      background:exorterm155         set background coloring
          fcb      0                              initial dcb:xlatestate
          fdb      0                              initial foreground "color"
nextdpb   set      thisdpb
          page
          ifund    dcb:xlatestate
dcb:xlatestate equ dcb:profile+dpb:gpinit         translate state byte is 1st gp byte
          fin
xlatei:exorterm155
;   translate Exorterm155 input, returning translated character in (a)
;   with carry clear; carry set will cause character to be lost
;   Note: this routine assumes that Exorterm155 operated in "scroll" mode
          tst      dcb:xlatestate,x
          bne      xlatei:exorterm155.escape      b/ escape character last time
          cmpa     #ascii:esc
          bne      xlatei:exorterm155.other
          inc      dcb:xlatestate,x               remember escape seen
          errorrts

xlatei:exorterm155.other
          ldab     #$7f                           assume swap for underscore
          cmpa     #'_
          beq      xlatei:exorterm155.b
          ldab     #'_                            assume swap for DEL key
          cmpa     #$7f
          beq      xlatei:exorterm155.b
          tsta                                    otherwise, standard ascii ?
          bpl      xlatei:exorterm155.ok          b/ yes, leave it alone !
          ldab     #ascii:nak                     assume delete under cursor
          cmpa     #$d1                           character delete key ?
          beq      xlatei:exorterm155.b           b/ yes, use (B) as translation
          ldab     #ascii:can                     assume cancel line desired
          cmpa     #$d7                           delete line key ?
          bne      xlatei:exorterm155.badchar
xlatei:exorterm155.b ; use (B) as translated character
          tba
xlatei:exorterm155.ok
          okrts

xlatei:exorterm155.escape
;   if character following <ESC> is not <ESC>, bitch and revert to normal
          clr      dcb:xlatestate,x
          cmpa     #ascii:esc                     <ESC>
          beq      xlatei:exorterm155.useescape
xlatei:exorterm155.badchar ; input sequence is not legal
          inc      dcb:beepcount,x
          errorrts                                ignore character

xlatei:exorterm155.useescape
          ldaa     #ascii:esc
          okrts
          page
dcb:lastcolor       equ       dcb:xlatestate+1    holds last known color
specialoutput:exorterm155
;   called to perform control functions for a EXORterm 155
;   The position, clear, erase to end of line, and newline functions...
;   are implemented.
          cmpa     #specialfn:newline
          beq      specialoutput:exorterm155newline
          cmpa     #specialfn:posn
          beq      specialoutput:exorterm155posn
          cmpa     #specialfn:clear
          beq      specialoutput:exorterm155clear
          cmpa     #specialfn:eeol
          beq      specialoutput:exorterm155eeol
          errorrts                                Exorterm can't do anything else

specialoutput:exorterm155clear
          clr      dcb:lastcolor,x                record new standard color
          clr      dcb:lastcolor+1,x
          ldaa     #'7                            at each clear screen,...
          bsr      outputescsequence          set the screen size to 24 by 80
          ldaa     #'X                            performs a clear screen fn
          bra      outputescsequence

specialoutput:exorterm155eeol
          ldaa     #'U                            performs a eeol fn
          bra      outputescsequence
          page
specialoutput:exorterm155newline
          ldaa     #ascii:cr
          jsr      dcb:tlbuffer,x
          ldaa     #ascii:lf                     put out <CR><LF>
          jsr      dcb:tlbuffer,x
          ldd      dcb:lastcolor,x               then put out coloring info
          bned     coloring:exorterm155.doit
          okrts
          page
specialoutput:exorterm155posn
          ldaa     #'E                           set up to do a position fn
          bsr      outputescsequence
          tsx
          ldaa     2,x
          adda     #$20
          ldx      dcbpointer
          jsr      dcb:tlbuffer,x
          tsx
          ldaa     3,x
          adda     #$20
          ldx      dcbpointer
          jsr      dcb:tlbuffer,x
coloring:exorterm155.okrts
          okrts

outputescsequence
          psha                                    save byte to send
          lda      #ascii:esc                     everything starts with "ESC"
          jsr      dcb:tlbuffer,x
          bcs      outputescsequenceerr           b/ something is wrong...
          pula
          jmp      dcb:tlbuffer,x
outputescsequenceerr
          ins
          jmp      sdos+sdos:errored

          page
coloring:exorterm155
          cmpd     dcb:lastcolor,x                same color as last time?
          beqd     coloring:exorterm155.okrts     yes, no work needed!
          std      dcb:lastcolor,x                save so ...:newline can see..
coloring:exorterm155.doit
          rola                                    generate "half-bright" code
          rola
          rola                                    c = 1 --> half-bright desired
          ldaa     #'e                            assume full-bright
          sbca     #0                             'd --> half, 'e --> full
          jsr      outputescsequence
          lda      dcb:lastcolor,x                get color code again
          asla                                    move blink to carry
          asla
          asla                                    C = 1 --> blink desired
          lda      #'a                            assume "blink disable" desired
          sbca     #0                             '` --> blink, 'a --> no blink
          jsr      outputescsequence
          asla                                    move Underscore bit to carry
          asla
          asla
          asla                                    C = 1 --> Underscore desired
          lda      #'g                            assume "no underscore" desired
          sbca     #0                             'f --> underscore, 'g --> plain
          jsr      outputescsequence
          lda      dcb:lastcolor,x                get color code again
          lsra                                    move reverse video bit to C
          lsra
          lsra
          lsra                                    C = 1 --> reverse video
          lda      #'c                            assume normal video
          sbca     #0                             'b --> reverse, 'c --> normal
          jsr      outputescsequence
          lda      #'D                            go right 1 to get past FAC
          jmp      outputescsequence

background:exorterm155
          lsra                                    move reverse video bit to C
          lsra
          lsra
          lsra                                    C = 1 --> reverse video
          lda      #'o                            assume normal video
          sbca     #0                             'n --> reverse, 'o --> normal
          jmp      outputescsequence
          fin      exorterm155
        include    iopsivtdpbs.asm
          page
ilgetdevstatusfromacia

;   receives control from the acia device access routine, returns either
;   the available character, with carry clear, or the error status, with
;   carry set.

;   the data or error status is returned in (a)

;   the status is defined as:

;         %00000001                 framing error (probably BREAK received)
;         %00000010                 overrun (data lost)
;         %00000100                 parity error

          bitb     #%01110000       check for parity, overrun, or framing errors
          bne      ilgetdevicestatusfromaciaerror
          okrts

ilgetdevicestatusfromaciaerror
          tba                       make a standard status byte
          lsra
          lsra
          lsra
          lsra
          anda     #%00000111
          errorrts
          fin      iodriverbody
          end
