'===========================================================================
' Subject: DISPLAY ANSI FILE WITH MUSIC      Date: 11-16-95 (18:07)       
' Author:  Tyler Barnes                      Code: QB, QBasic, PDS        
' Origin:  FidoNet QUIK_BAS Echo           Packet: ANSI.ABC
'===========================================================================
' On November 16, 1995 at 6:07 PM  Tyler Barnes replied to some other guy:

' > Does anyone out there know how to display ansi in Qbasic?

'Here's something... It supports the common ANSI escape codes, and ANSI music. 
'This was written by someone else, modified by myself to support ANSI music, 
'and to work on 24 lines instead of 25... and some other stuff. If for some 
'reason you don't like this one, I have another routine written in full by 
'myself. It's a bit bigger, and doesn't support ANSI music, but I've found that
'it works better in some cases. It also seems to be easier to add escape codes, 
'but that might be just because I know EXACTLY how it works.

DECLARE SUB ShowFile(FileName$)
DECLARE SUB PrintANSI(Text$,LF)
CONST Yes=1,No=0
SUB PrintANSI(Text$,LF)
LF$=LTRIM$(STR$(LF))
DEF SEG=&HB800
DEFINT A-Z
STATIC W,E,L,F,B,O,V,E$,Music,MBuff$
C=(((CSRLIN-1)*80)+(POS(0)-1)):L=CSRLIN-1
IF C>=1920 THEN MaxSize=2000 ELSE MaxSize=1920
FOR I=1 TO LEN(Text$)
A$=MID$(Text$,I,1):GOSUB ANSI
NEXT I:GOTO EndItAll
ANSI:
IF W<99 THEN W=100:F=7:B=0:A=0:Music=No:MBuff$=""
IF Music=Yes THEN GOTO Music
IF E <> 27 THEN
IF ASC(A$) <> 27 THEN GOSUB CHRout: ELSE E=27:E$=A$
TCP=C
RETURN
END IF
IF O <> 27 AND ASC(A$)=34 THEN O=E:RETURN
IF O=27 THEN
IF ASC(A$)=34 THEN O=0
RETURN
END IF:E$=E$+A$
IF LEN(E$)=2 AND A$ <>"[" THEN E=0:E$="":RETURN
S=INSTR("HfABCDsuJKmM",A$)
SELECT CASE S
CASE 0:RETURN
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
CASE 12:Music=Yes
END SELECT:E=0:E$="":RETURN
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: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=12 THEN CLS :C=0:L=0
IF P=8 AND C>0 THEN C=C-1:POKE C*2,32
IF P <> 10 AND P <> 12 AND P <> 8 THEN POKE C*2+1,F+16*B:POKE C*2,P:C=C+1
IF C>=MaxSize THEN
C=C-80:LOCATE 24,80:PRINT
END IF:RETURN
Music:
MBuff$=MBuff$+A$
IF A$ <>"" THEN RETURN
IF UCASE$(LEFT$(MBuff$,1))="F" THEN MBuff$=RIGHT$(MBuff$,LEN(MBuff$)-1)
MBuff$="MB"+RTRIM$(LTRIM$(LEFT$(MBuff$,LEN(MBuff$)-1)))
PLAY MBuff$
MBuff$="":E$="":Music=No
RETURN
EndItAll:
LF=VAL(LF$)
LOCATE INT(C/80)+1,C-((INT(C/80))*80)+1
COLOR F,B
IF LF=Yes THEN PRINT
DEF SEG
EXIT SUB
END SUB
DEFSNG A-Z
SUB ShowFile(FileName$)
Z%=FREEFILE
OPEN FileName$ FOR INPUT AS Z%:CLOSE Z%
OPEN FileName$ FOR BINARY AS Z%
Remaining%=LOF(Z%)
DO UNTIL Remaining%=0
IF Remaining%>=4096 THEN
ThisPass%=4096
ELSE
ThisPass%=Remaining%
END IF
Data$=INPUT$(ThisPass%,Z%)
PrintANSI Data$,No
Remaining%=Remaining%-ThisPass%
LOOP
CLOSE Z%
END SUB