\*
 *   ZEN 1.10 Device drivers for MSDOS 2.0 or later
 *     C 1990  by Martin Tracy
 *             Last modified  1.1.90
 *\

\ Read word at segment:offset.
CODE L@ ( off seg - w)
        mov   es,bx
        pop   bx
        mov   bx,es:[bx]
        NEXT
END-CODE

\ Write word to segment:offset.
CODE L! ( w off seg)
        mov   es,bx
        pop   bx
        pop   es:[bx]
        pop   bx
        NEXT
END-CODE

\ Fetch byte value at segment:offset.
CODE LC@ ( off seg - b)
        mov   es,bx
        pop   bx
        mov   bl,es:[bx]
        sub   bh,bh
        NEXT
END-CODE

\ Store lower byte value at segment:offset.
CODE LC! ( w off seg)
        mov   es,bx
        pop   bx
        pop   ax
        mov   es:[bx],al
        pop   bx
        NEXT
END-CODE

\ Move u bytes from seg:off to seg:off2, leftmost byte first
CODE LCMOVE ( off seg off2 seg2 u)
        mov   cx,bx
        mov   bx,si
        mov   dx,ds
        pop   es
        pop   di
        pop   ds
        pop   si
        jcxz  LCmo1
        rep movsb
LCmo1:  mov   si,bx
        mov   ds,dx
        pop   bx
        NEXT
END-CODE


\ Push code segment register.
CODE CSEG ( - seg)
        push  bx
        mov   bx,cs
        NEXT
END-CODE

\ Push data segment register.
CODE DSEG ( - seg)
        push  bx
        mov   bx,ds
        NEXT
END-CODE


3 EQU #CFA   \ code field size in address units.  See also PFA

\ Convert execution token into parameter field address.
CODE PFA ( cfa - pfa)
        add   bx,3
        NEXT
END-CODE


8   EQU BSP#  \ backspace
127 EQU DEL#  \ delete
13  EQU EOL#  \ end of line character

| CREATE BACKSP   \ Backspace sequence
3 C, BSP# C, BL C, BSP# C,

CREATE CRLF       \ End of line sequence
2 C, EOL# C, 10 C,

32 CONSTANT BL    \ ASCII blank  EXT CORE

\ Alter string to suppress trailing blanks
: -TRAILING ( a +n - a2 +n2) \ CORE
   BL SKIP> ;


\ Defined here far from INTERNAL.SRC to force a 3-byte jump.
LOX? \IF  | VARIABLE LX   \ Local pointer pseudo register
MUX? \IF    VARIABLE MX   \ Entry to cooperative multitasker


MUX? \*IF
\ Enter cooperative multitasker
: PAUSE
   MX PERFORM ;
*\


\ Output a string via Int 21h service 40h
| CODE TDOS ( addr u)
        mov   cx,bx
        pop   dx
        mov   bx,1
        mov   ah,40h
        int   21h
        pop   bx
END-CODE
MUX? \*IF
ASSEMBLER
        mov   ax,[MXv]
        jmp   ax
END-CODE
*\
MUX? NOT \*IF
ASSEMBLER
        NEXT
END-CODE
*\

\ Check for key pressed via Int 21h service 6
\ If key is special, get second key via Int 21h service 7
\ Special keys are returned in high byte with low byte zeroed
| CODE KDOS ( - key -1 | 0)
        push  bx
        mov   dl,0FFh
        mov   ah,6
        int   21h
        mov   bx,0
        je    KDOS2
        sub   ah,ah      ; special key?
        or    al,al
        jnz   KDOS1
        mov   ah,7
        int   21h
        sub   ah,ah
        xchg  al,ah
KDOS1:  push  ax
        mov   bx,TRUTH
KDOS2:
END-CODE
MUX? \*IF
ASSEMBLER
        mov   ax,[MXv]
        jmp   ax
END-CODE
*\
MUX? NOT \*IF
ASSEMBLER
        NEXT
END-CODE
*\


\ Carriage return
| : (CR) ( )
   CRLF COUNT TDOS ;

\ Page eject
| : (PAGE) ( )
   25 0 DO  CR  LOOP ;

\ Move cursor to given x y coordinates
| : (CORO) ( n n2)
   CR  DROP SPACES ;

\ Like TYPE but highlight if possible
| : (MARK) ( a n)
   ." ^"  TDOS ;

\ Audible alert
| : (BEEP)
   7 EMIT ;


\ IO transfer vectors.  Keep together.
  VARIABLE 'TYPE
| VARIABLE '?KEY
| VARIABLE 'CR
| VARIABLE 'PAGE
| VARIABLE 'CORO
| VARIABLE 'MARK
| VARIABLE 'BEEP
| VARIABLE 'SPARE

\ Type a string
: TYPE ( addr u) \ CORE
 'TYPE PERFORM ;

\ Return true and key if key is available;
\ otherwise return only false.
: ?KEY ( - key -1 | 0) \ CORE
 '?KEY PERFORM ;

\ Read a key
: KEY ( - c) \ CORE
   BEGIN  ?KEY UNTIL ;

\ Carriage return
: CR ( ) \ CORE
 'CR PERFORM ;

\ Page eject
: PAGE ( ) \ CORE
 'PAGE PERFORM ;

\ Move cursor to given x y coordinates
: >COLROW ( n n2)
  'CORO PERFORM ;

\ Like TYPE but highlight if possible
: MARK ( a n)
 'MARK PERFORM ;

\ Audible alert
: BEEP
 'BEEP PERFORM ;

\ IO vector in dictionary space.
| : IO
   TDOS KDOS (CR) (PAGE) (CORO) (MARK) (BEEP) ( EXIT:) ;

\ Initialize all IO commands for dumb terminal.
: DUMB
   ['] IO PFA CSEG 'TYPE DSEG 8 CELLS LCMOVE ;
