C
C DISPTTY.F
C Purpose: demonstrate calling int386 subroutine
C Copyright (C) MicroWay, Inc., 1989
C

C BRIGHT - intense attribute for screen chars 
C BLINKON - blinking attribute on for screen chars 
C BLINKOFF - blinking attribute off for screen chars 
C DEFAULT - leave attribute bits as they were 

      integer BRIGHT, BLINKON, BLINKOFF, DEFAULT
      parameter (BRIGHT=8,BLINKON=128,BLINKOFF=127,DEFAULT=255)

      WRITE (*,100) 
  100 FORMAT(' A horse that can count to 10 is a remarkable ',$)
      CALL DISPLAY_TTY (BRIGHT,DEFAULT,'horse')
      WRITE (*,101)
  101 FORMAT(1X)
      WRITE (*,102)
  102 FORMAT (' not a remarkable ',$)
      CALL DISPLAY_TTY (BRIGHT,DEFAULT,'mathematician.')
      WRITE (*,103)
  103 FORMAT (1X,' - Dr. Samuel Johnson')
C end of main program
      END

C ************************************************************
C DISPLAY_TTY
C This subroutine displays a string of characters on the screen
C with a given attribute, and advances the cursor. Since there
C is no single ROM BIOS video service that does both, it
C combines the functionality of two of them:
C       Service 9, Write Character and Attribute
C       Service 2, Set Cursor Position
C The three explicit parameters are:
C       The attribute(s) to be added
C       The attribute(s) to be deleted
C       String of one or more characters
C A fourth parameter is passed implicitly by the compiler
C       Length of the string
C The coding of the attribute byte:
C            Bit
C       7 6 5 4 3 2 1 0
C       1 . . . . . . .    Blinking of foreground character
C       . 1 . . . . . .    Red component of background color
C       . . 1 . . . . .    Green component of background color
C       . . . 1 . . . .    Blue component of background color
C       . . . . 1 . . .    Intensity of foreground color
C       . . . . . 1 . .    Red component of foreground color
C       . . . . . . 1 .    Green component of foreground color
C       . . . . . . . 1    Blue component of foreground color
C
C The current attribute byte ANDed with the attribute(s)
C to be removed and OR'd with the attribute(s) to be added.

      SUBROUTINE DISPLAY_TTY(ADD_ATTR, DEL_ATTR, STRING) 
C new attribute(s) to be added 
      INTEGER   ADD_ATTR
C attribute(s) to be removed 
      INTEGER   DEL_ATTR
C character(s) to be displayed 
      CHARACTER*(*) STRING

C VIDEO_IO is the interrupt # for ROM BIOS video services
      integer VIDEO_IO
      parameter (VIDEO_IO=16)

      INTEGER*1 CURRENT_ATTR
      INTEGER*1 ACTIVE_PAGE     
      INTEGER*1 ROW, COL
      INTEGER*1 MAXCOL
C Length of string
      INTEGER L

      INCLUDE "DOS.FH"

      INTEGER INTNUM

      INTNUM = VIDEO_IO

C get current video mode. ah = 15.
      BINREGS(2) = 15
      CALL INT386 (INTNUM, INREGS(1), OUTREGS(1))
C Active page returned in bh, screen width returned in ah
      ACTIVE_PAGE = BOUTREGS(6)
      MAXCOL = BOUTREGS(2)

C get current attribute. ah = 8.
      BINREGS(2) = 8
      CALL INT386 (INTNUM, INREGS(1), OUTREGS(1))
C Current attribute returned in ah
      CURRENT_ATTR = BOUTREGS(2)

C read cursor position. ah = 3, bh = active page.
      BINREGS(2) = 3
      BINREGS(6) = ACTIVE_PAGE
      CALL INT386 (INTNUM, INREGS(1), OUTREGS(1))
C Current row returned in dh, column in dl
      ROW = BOUTREGS(14)
      COL = BOUTREGS(13)

C Set cx = 1, for only one char, attr at a time
      WINREGS(5) = 1
C Get new attribute value into bl
      INREGS(2) = IAND(CURRENT_ATTR,DEL_ATTR)
      INREGS(2) = IOR(INREGS(2),ADD_ATTR)

      I = 1
      L = LEN (STRING)
C Beginning of loop to output characters
C If current char is null byte, or we are past end of string, quit
 1000 IF ((STRING(I:I).EQ.CHAR(0)) .OR. (I.GT.L)) GOTO 2000

C  output char, attr. ah = 9, al = character
          BINREGS(2) = 9
          BINREGS(1) = ICHAR (STRING(I:I))
          I = I + 1
          CALL INT386 (INTNUM, INREGS(1), OUTREGS(1))

          COL = COL + 1
          IF (COL .GE. MAXCOL) THEN
                  COL = 0
                  ROW = ROW + 1
                  IF (ROW .EQ. 25) THEN
                      ROW = 0
                  ENDIF
          ENDIF

C Advance cursor. ah = 2, dh = row, dl = column
          BINREGS(2) = 2
          BINREGS(14) = ROW
          BINREGS(13) = COL
          CALL INT386 (INTNUM, INREGS(1), OUTREGS(1))
      GOTO 1000
C end of loop to output characters
2000    RETURN
C end of DISPLAY_TTY
      END
