'===========================================================================
' Subject: ANSI DISPLAY                       Date: 02-03-96 (16:21)       
'  Author: David J. Arigan                    Code: QB, QBasic, PDS        
'  Origin: FidoNet QUIK_BAS Echo            Packet: ANSI.ABC
'===========================================================================
DECLARE SUB ansiout (s$)

' ANSI display V1.1 - Written by David Arigan
' You can use this freely provided you mention me in your credits.

DEFINT A-Z

OPEN "picture.ans" FOR BINARY AS #1

blen& = 4096: buf$ = SPACE$(blen&): flen& = LOF(1)
WHILE flen&
  IF blen& > flen& THEN blen& = flen&: buf$ = SPACE$(flen&)
  GET #1, , buf$: flen& = flen& - blen&: ansiout buf$
WEND
CLOSE

SUB ansiout (s$) STATIC
  DIM parm$(16)
  IF init = 0 THEN
    init = -1
    fc = 7: bc = 0: cfx = 0: blink = 0
    lx = 1: ly = 1
    DEF SEG = &H0
    xl = PEEK(&H44A) + 256 * PEEK(&H44B)
    yl = PEEK(&H44C) + 256 * PEEK(&H44D) \ 2 \ xl
    cc$ = "000402140105031500040206010503070812101409131115"
  END IF
  COLOR VAL(MID$(cc$, (fc + cfx) * 2 + 1, 2)) OR blink
  COLOR , VAL(MID$(cc$, bc * 2 + 1, 2)) AND 7
  FOR i = 1 TO LEN(s$)
    a$ = MID$(s$, i, 1)
    IF a$ = CHR$(10) THEN a$ = "" ' ***** Linefeed fix
    SELECT CASE sq$
    CASE ""
      IF a$ = CHR$(27) THEN sq$ = a$ ELSE PRINT a$;
    CASE CHR$(27)
      IF a$ = "[" THEN sq$ = sq$ + a$: parm = 0 ELSE anserr = 1
    CASE ELSE
      sq$ = sq$ + a$
      SELECT CASE a$
      CASE "0" TO "9"
        IF parm = 0 THEN parm = 1: parm$(1) = ""
        parm$(parm) = parm$(parm) + a$
      CASE ";", ","
        parm = parm + 1: parm$(parm) = ""
      CASE "=", "?"
      CASE "@"
        sq$ = ""
      CASE "A"
        IF parm = 0 THEN y = CSRLIN - 1 ELSE y = CSRLIN - VAL(parm$(1))
        IF y < 0 THEN y = 1
        LOCATE y: sq$ = ""
      CASE "B"
        IF parm = 0 THEN y = CSRLIN + 1 ELSE y = CSRLIN + VAL(parm$(1))
        IF y > yl THEN y = yl
        LOCATE y: sq$ = ""
      CASE "C"
        IF parm = 0 THEN x = POS(0) + 1 ELSE x = POS(0) + VAL(parm$(1))
        IF x > xl THEN x = xl
        LOCATE , x: sq$ = ""
      CASE "D"
        IF parm = 0 THEN x = POS(0) - 1 ELSE x = POS(0) - VAL(parm$(1))
        IF x < 0 THEN x = 1
        LOCATE , x: sq$ = ""
      CASE "f", "H"
        SELECT CASE parm
        CASE 0
          y = 1: x = 1
        CASE 1
          y = VAL(parm$(1))
        CASE ELSE
          y = VAL(parm$(1)): x = VAL(parm$(2))
        END SELECT
        IF y > yl THEN y = yl
        IF y < 1 THEN y = 1
        IF x > xl THEN x = xl
        IF x < 1 THEN x = 1
        LOCATE y, x: sq$ = ""
      CASE "h", "l"
        sq$ = ""    ' *** set/reset graphics mode
      CASE "J"
        IF parm = 1 AND VAL(parm$(1)) = 2 THEN CLS
        sq$ = ""
      CASE "K"
        x = POS(0): PRINT SPACE$(xl - x); : LOCATE , x: sq$ = ""
      CASE "L"
        sq$ = ""    ' *** Inserts n blank lines at cursor line.
      CASE "M"
        sq$ = ""    ' *** Deletes n lines including cursor line.
      CASE "m"
        FOR j = 1 TO parm
          SELECT CASE VAL(parm$(j))
          CASE 0
            fc = 7: bc = 0: cfx = 0: blink = 0
          CASE 1
            cfx = 16
          CASE 2
            cfx = 8
          CASE 4    ' *** Underscore on
          CASE 5
            blink = 16
          CASE 7
            SWAP fc, bc
          CASE 8    ' *** Attributes Invisible
          CASE 30 TO 37
            fc = VAL(parm$(j)) - 30
          CASE 40 TO 47
            bc = VAL(parm$(j)) - 40
          END SELECT
          COLOR VAL(MID$(cc$, (fc + cfx) * 2 + 1, 2)) OR blink
          COLOR , VAL(MID$(cc$, bc * 2 + 1, 2)) AND 7
        NEXT j
        sq$ = ""
      CASE "n"
        sq$ = ""    ' *** ESC[6n asks for a Position Report
      CASE "P"
        sq$ = ""    ' *** Deletes n chars including cursor char.
      CASE "p"
        BEEP
        sq$ = ""    ' *** Keyboard Reassignment
      CASE "R"
        sq$ = ""    ' *** Cursor Position Report
      CASE "s"
        lx = POS(0): ly = CSRLIN: sq$ = ""
      CASE "u"
        LOCATE ly, lx: sq$ = ""
      CASE "y"
        sq$ = ""    ' *** Output char translate.
      CASE ELSE
        anserr = 1
      END SELECT
    END SELECT
    IF anserr THEN anserr = 0: PRINT sq$; : i = i - 1: sq$ = ""
  NEXT i
END SUB