'===========================================================================
' Subject: ANSI VIEWER                        Date: 03-19-96 (23:10)       
'  Author: Dave Navarro, Jr.                  Code: PB                     
'  Origin: comp.lang.basic.misc             Packet: PB.ABC
'===========================================================================
'> Could anyone please EMail me a complete source code to view ANSIs? I've
'> attempted to code a function myslef but I have been unsuccessful. Thanks!
'> Please reply

'Converted to PowerBASIC by Dave Navarro, Jr.
'This is a copyrighted file by Tom Hanlin which is included in the
'shareware version of BASWIZ.

DEFINT A - Z

Fore = 7
Back = 0
St$ = CHR$( 27 ) + "[2J"

AnsiPrintChars St$

OPEN "I", 1, "CHESS.ANS"
  WHILE NOT EOF( 1 )
    LINE INPUT#1, St$
    St$ = St$ + CHR$( 13, 10 )
    AnsiPrintChars St$
  WEND
CLOSE 1


SUB AnsiPrintChars( BYVAL St$ )
  FOR disp = 1 TO LEN( St$ )
    ch$ = MID$( St$, disp, 1 )
    AnsiPrint ch$
  NEXT
END SUB

SUB AnsiPrint( BYVAL Ch$ )

  STATIC ANSIst$, ANSIcode, Row, Col, SaveRow, SaveCol, Fore, Back
  STATIC First
  SHARED Music

  IF First = 0 THEN
    Fore = 7
    Back = 0
    First = -1
  END IF

  IF ANSIcode THEN
    IF LEFT$( ANSIst$, 2 ) = "[M" THEN
      IF ASC( ch$ ) = 14 THEN
        IF Music THEN PLAY "MB" + MID$( ANSIst$, 4 )
        ANSIst$ = ""
        ANSIcode = 0
      ELSE
        ANSIst$ = ANSIst$ + ch$
      END IF
    ELSEIF INSTR( "ABCDEFGHIJKLMNOPQRSTUVWXYZ", UCASE$( ch$ )) THEN
      SELECT CASE ch$
        CASE "A": GOSUB CursorUp
        CASE "B": GOSUB CursorDown
        CASE "C": GOSUB CursorRight
        CASE "D": GOSUB CursorLeft
        CASE "H", "f": GOSUB CursorLocate
        CASE "s": GOSUB SaveCursorPosn
        CASE "u": GOSUB RestCursorPosn
        CASE "J": GOSUB BigErase
        CASE "K": GOSUB SmallErase
        CASE "h", "l": REM set display mode... ignored
        CASE "m": GOSUB SetColors
        CASE ELSE
          PRINT ANSIst$;
          ANSIcode = 0
          ANSIst$ = ""
      END SELECT
      ANSIst$ = ""
      ANSIcode = 0
    ELSEIF ASC( ch$ ) < = 32 OR LEN( ANSIst$ ) > 60 THEN
      PRINT ANSIst$;
      ANSIcode = 0
      ANSIst$ = ""
    ELSE
      ANSIst$ = ANSIst$ + ch$
    END IF
  ELSEIF ASC( ch$ ) = 27 THEN
    ANSIcode = -1
    ANSIst$ = ""
  ELSEIF ASC( ch$ ) = 13 THEN
    LOCATE CSRLIN, 1
  ELSEIF ASC( ch$ ) = 10 THEN
    Tmp = POS( 0 )
    PRINT
    LOCATE, Tmp
  ELSE
    PRINT ch$;
  END IF
  EXIT SUB

CursorUp:
  Tmp = VAL( MID$( ANSIst$, 2 ))
  IF Tmp < 1 THEN Tmp = 1
  LOCATE Row, Col
  Row = Row - Tmp
  IF Row < 1 THEN Row = 1
  LOCATE Row, Col
  RETURN

CursorDown:
  Tmp = VAL( MID$( ANSIst$, 2 ))
  IF Tmp < 1 THEN Tmp = 1
  Row = CSRLIN
  Col = POS( 0 )
  Row = Row + Tmp
  IF Row > 23 THEN Row = 23
  LOCATE Row, Col
  RETURN

CursorLeft:
  Tmp = VAL( MID$( ANSIst$, 2 ))
  IF Tmp < 1 THEN Tmp = 1
  Row = CSRLIN
  Col = POS( 0 )
  Col = Col - Tmp
  IF Col < 1 THEN Col = 1
  LOCATE Row, Col
  RETURN

CursorRight:
  Tmp = VAL( MID$( ANSIst$, 2 ))
  IF Tmp < 1 THEN Tmp = 1
  Row = CSRLIN
  Col = POS( 0 )
  Col = Col + Tmp
  IF Col > 80 THEN Col = 80
  LOCATE Row, Col
  RETURN

CursorLocate:
  Row = VAL( MID$( ANSIst$, 2 ))
  Tmp = INSTR( ANSIst$, ";" )
  IF Tmp THEN
    Col = VAL( MID$( ANSIst$, Tmp + 1 ))
  ELSE
    Col = 1
  END IF
  IF Row < 1 THEN
    Row = 1
  ELSEIF Row > 25 THEN
    Row = 25
  END IF
  IF Col < 1 THEN
    Col = 1
  ELSEIF Col > 80 THEN
    Col = 80
  END IF
  LOCATE Row, Col
  RETURN

SaveCursorPosn:
  SaveRow = CSRLIN
  SaveCol = POS( 0 )
  RETURN

RestCursorPosn:
  IF SaveRow > 0 THEN
    LOCATE SaveRow, SaveCol
  END IF
  RETURN

BigErase:
  CLS
  LOCATE 1, 1
  RETURN

SmallErase:
  LOCATE Row, Col
  PRINT SPACE$( 80 - Col );
  LOCATE Row, Col
  RETURN

SetColors:
  ANSIst$ = MID$( ANSIst$, 2 )
  DO WHILE LEN( ANSIst$ )
    Tmp = VAL( ANSIst$ )
    SELECT CASE Tmp
      CASE 0: Fore = 7: Back = 0 'reset colors
      CASE 1: Fore = ( Fore OR 8 ) 'high intensity
      CASE 2: Fore = ( Fore AND &H17 ) 'normal intensity
      CASE 5: Fore = ( Fore OR 16 ) 'blink
      CASE 7: Fore = 0: Back = 7 'reverse video
      CASE 8: Fore = 0: Back = 0 'invisible
      CASE 30: Fore = ( Fore AND &H18 ) 'black foreground
      CASE 31: Fore = ( Fore AND &H18 ) OR 4 'red foreground
      CASE 32: Fore = ( Fore AND &H18 ) OR 2 'green foreground
      CASE 33: Fore = ( Fore AND &H18 ) OR 6 'yellow foreground
      CASE 34: Fore = ( Fore AND &H18 ) OR 1 'blue foreground
      CASE 35: Fore = ( Fore AND &H18 ) OR 5 'magenta foreground
      CASE 36: Fore = ( Fore AND &H18 ) OR 3 'cyan foreground
      CASE 37: Fore = ( Fore OR 7 ) 'white foreground
      CASE 40: Back = 0 'black background
      CASE 41: Back = 4 'red background
      CASE 42: Back = 2 'green background
      CASE 44: Back = 6 'yellow background
      CASE 44: Back = 1 'blue background
      CASE 45: Back = 5 'magenta background
      CASE 46: Back = 3 'cyan background
      CASE 47: Back = 7 'white background
      CASE ELSE 'ignore anything weird
    END SELECT
    Tmp = INSTR( ANSIst$, ";" )
    IF Tmp THEN
      ANSIst$ = MID$( ANSIst$, Tmp + 1 )
    ELSE
      ANSIst$ = ""
    END IF
  LOOP
  COLOR Fore, Back
  RETURN
END SUB
