'===========================================================================
' Subject: QB ANSI EMULATOR                   Date: 11-17-95 (00:18)       
'  Author: Kurt Kuzba                         Code: QB, QBasic, PDS        
'  Origin: FidoNet QUIK_BAS Echo            Packet: ANSI.ABC
'===========================================================================
'An unknown gentleman asked this question:

'>   i have just wrote a communications program, and it doesn't have
'>   ansi emulation. can anyone tell me how to use ansi ... ?
'>..................................................................

' And Kurt Kuzba replied:

'   You may use the CONSOLE for output, assuming that ANSI.SYS or
'some other ANSI interpreter is loaded, like this.
'   OPEN "CONS:" FOR OUTPUT AS #1: PRINT #1 Ansi$;: CLOSE 1
'Or you may use an internal emulator or library.
 '|================  begin ANSISUB.BAS  ==============================|
 '|  This is a QBasic SUB to display ANSI files without the use of    |
 '|  ANSI.SYS, using direct screen writes.                            |
 '|          Released to the Public Domain by Kurt Kuzba              |
 '|===================================================================|
DECLARE SUB ansi (A$)
ON ERROR GOTO Done: i$ = STRING$(16, " ") + STRING$(15, CHR$(29))
COLOR 2, 0: CLS : f$ = COMMAND$: PRINT f$
IF f$ = "" THEN
   LOCATE 5, 10: PRINT "File to display ";
   COLOR 1, 7: PRINT i$; : INPUT "", f$:
END IF
IF f$ = "" THEN GOTO Done
COLOR 2, 0: OPEN f$ FOR BINARY AS #1
WHILE NOT EOF(1)
   f$ = INPUT$(1024, #1): l% = LEN(f$)
   FOR t% = 1 TO l%: ansi (MID$(f$, t%, 1)): NEXT
WEND
Done:
   CLOSE 1: COLOR 2, 0: FOR S% = 5 TO 35: SOUND S% * 200, .1: NEXT
   R$ = "": WHILE R$ = "": R$ = INKEY$: WEND: END
SUB ansi (A$)
DEF SEG = &HB800
DEFINT A-Z: STATIC W, E, l, C, O, M, f, B, V, E$
IF W < 99 THEN W = 100: C = 0: f = 7: B = 0: A = 0: M = f + 16 * B
IF E <> 27 THEN
   IF ASC(A$) <> 27 THEN GOSUB CHRout:  ELSE E = 27: E$ = A$
   EXIT SUB
END IF
IF O <> 27 AND ASC(A$) = 34 THEN O = E: EXIT SUB
IF O = 27 THEN
   IF ASC(A$) = 34 THEN O = 0
   EXIT SUB
END IF: E$ = E$ + A$
IF LEN(E$) = 2 AND A$ <> "[" THEN E = 0: E$ = "": EXIT SUB
S = INSTR("HfABCDsuJKmhlp", A$)
SELECT CASE S
  CASE 0: EXIT SUB
  CASE 1: GOSUB CursorA
  CASE 2: GOSUB CursorA
  CASE 3: l = -1: GOSUB CursorL
  CASE 4: l = 1: GOSUB CursorL
  CASE 5: l = 1: GOSUB CursorC
  CASE 6: l = -1: GOSUB CursorC
  CASE 7: V = C
  CASE 8: C = V
  CASE 9: CLS : C = 0
  CASE 10: l = C: WHILE l MOD 80 <> 0: POKE l * 2, 32: l = l + 1: WEND
  CASE 11: GOSUB Colorz
END SELECT: E = 0: E$ = "": EXIT SUB
CursorA: l = VAL(MID$(E$, INSTR(E$, "[") + 1))
   C = VAL(MID$(E$, INSTR(E$, ";") + 1))
   IF C > 0 THEN C = (C - 1): IF C > 79 THEN C = 79
   IF l > 0 THEN l = (l - 1): IF l > 24 THEN l = 24
   C = l * 80 + C: RETURN
CursorL: P = VAL(MID$(E$, INSTR(E$, "[") + 1))
   P = P - (P < 1): l = INT(C / 80) + P * l
   IF l < 0 THEN l = 0:  ELSE IF l > 24 THEN l = 24
   C = (C MOD 80) + l * 80: RETURN
CursorC: P = VAL(MID$(E$, INSTR(E$, "[") + 1))
   P = P - (P < 1): l = (C MOD 80) + P * l: C = INT(C / 80) * 80
   IF l < 1 THEN l = 0:  ELSE IF l > 79 THEN l = 79
   C = C + l: RETURN
Colorz: E$ = MID$(E$, INSTR(E$, "[") + 1)
  DO: E = VAL(E$)
  SELECT CASE E
     CASE 0: f = 7: B = 0
     CASE 1: f = (f AND 7) OR 8
     CASE 5: B = (B AND 7) OR 8
     CASE 8: f = B
     CASE 30 TO 37: P = E - 29: E = ASC(MID$("@DBFAECG", P)) AND 7
                    f = (f AND 248) OR E
     CASE 40 TO 47: P = E - 39: E = ASC(MID$("@DBFAECG", P)) AND 7
                    B = (B AND 248) OR E
  END SELECT: P = INSTR(E$, ";"): E$ = MID$(E$, P + 1)
  LOOP WHILE P > 0: M = f + 16 * B: RETURN
CHRout: P = ASC(A$)
   IF P = 7 THEN BEEP: RETURN
   IF P = 13 THEN C = C - C MOD 80: RETURN
   IF P = 10 THEN C = C + 80
   IF P <> 10 THEN POKE C * 2, P: POKE C * 2 + 1, M: C = C + 1
   IF C >= 2000 THEN
      C = C - 80: LOCATE 25, 80: PRINT
      FOR l = 3680 TO 3840: POKE l, PEEK(l + 160): POKE l + 160, B: NEXT
   END IF: RETURN
END SUB
 '|===================  end ANSISUB.BAS  =========================|