'===========================================================================
' Subject: ANSI SCREEN CAPTURE TSR           Date: 10-09-95 (00:00)       
' Author:  Jamshid Khoshrangi                Code: PB32                   
' Origin:  FidoNet POWER_BAS Echo          Packet: PB.ABC
'===========================================================================
$IF 0

    SCR2ANS.BAS              ScreenToAnsi               SCR2ANS.BAS

                             Version  1.0

                Copyright 1995 by AhuraMazda(tm) Software

                      Written by Jamshid Khoshrangi


    NOTES:

    Since this program uses pointers, it is PB 3.2 compatible only.

    This rough and dirty little TSR captures an 80x25 text screen
    to a file called SCREEN.ANS in the root directory of the c:
    drive.  The file  contains the appropriate ANSI codes to
    reproduce the captured screen exactly either in an ANSI
    emulator, or through an ANSI console driver like ANSI.SYS.

    The codes themselves are not optimized as well as they could be.

    Jamshid

$ENDIF

$ERROR ALL OFF
$LIB ALL OFF
$STRING 1
$COM 0
$SOUND 1

DEFINT A-Z

%Black      = 0 : %LowBlue    = 1 : %LowGreen   = 2 : %LowCyan    = 3
%LowRed     = 4 : %LowMagenta = 5 : %Brown      = 6 : %LowWhite   = 7
%Gray       = 8 : %HighBlue   = 9 : %HighGreen  = 10: %HighCyan   = 11
%HighRed    = 12: %HighMagenta= 13: %Yellow     = 14: %HighWhite  = 15
%Blink      = 16: %CursorOff  = 0 : %CursorOn   = 1

%FOREGROUND = 1
%BACKGROUND = 2

TYPE Video
  char AS BYTE
  attr AS BYTE
END TYPE

DIM cell AS Video PTR

'   Program begins here!

IF BIT(pbvScrnCard, 0) THEN
    cell = &HB000?? * 65536??
ELSE
    cell = &HB800?? * 65536??
END IF

X& = SETMEM(-700000)
X& = SETMEM(10000)

POPUP KEY CHR$(12, 30, 247)   ' CTRL-ALT-A

DO

    POPUP SLEEP USING EMS

    IF DIR$("C:\SCREEN.ANS") <> "" THEN
        KILL "C:\SCREEN.ANS"
    END IF

    OPEN "C:\SCREEN.ANS" FOR BINARY AS #1

    Temp$ = CHR$(27) + "[0m" + CHR$(27) + "[2J"

    PUT #1, , Temp$

    OldForeColor = 7
    OldBackColor = 0

    FOR Row = 1 TO 25

        $IF 0
        Temp$ = CHR$(27) + "[" + LTRIM$(RTRIM$(STR$(Row))) + "H"
        PUT #1, , Temp$
        OldForeColor = 7
        OldBackColor = 0
        OldBold = 0
        OldBlink = 0
        $ENDIF

        FOR Column = 1 TO 80

            attr = @cell.attr

            ForeColor = Attr MOD 16
            BackColor = Attr \ 16

            Bold  = BIT(ForeColor, 3)
            Blink = BIT(BackColor, 3)

            OutAnsi$ = ""

            IF Bold <> OldBold OR Blink <> OldBlink THEN
                OutAnsi$ = CHR$(27) + "[0"
                OldBold = Bold
                OldBlink = Blink
            END IF

            IF ForeColor <> OldForeColor OR BackColor <> OldBackColor THEN
                SELECT CASE OutAnsi$
                    CASE ""
                        OutAnsi$ = CHR$(27) + "["
                    CASE ELSE
                        OutAnsi$ = OutAnsi$ + ";"
                END SELECT
                IF ForeColor <> OldForeColor THEN
                    OldForeColor = ForeColor
                    OutAnsi$ = OutAnsi$ +_
                        ToAnsiColor(ForeColor, %FOREGROUND)
                END IF
                IF BackColor <> OldBackColor THEN
                    IF LEN(OutAnsi$) > 2 THEN
                        OutAnsi$ = OutAnsi$ + ";"
                    END IF
                    OldBackColor = BackColor
                    OutAnsi$ = OutAnsi$ +_
                        ToAnsiColor(BackColor, %BACKGROUND)
                END IF
                OutAnsi$ = OutAnsi$ + "m"
                PUT #1, , OutAnsi$

            ELSE
                SELECT CASE OutAnsi$
                    CASE ""

                    CASE ELSE
                        OutAnsi$ = OutAnsi$ + "m"
                        PUT #1, , OutAnsi$

                END SELECT

            END IF
            PUT #1, , @cell.char

            INCR cell, 2

        NEXT Column

    NEXT Row

    Temp$ = CHR$(27) + "[8m"
    PUT #1, , Temp$

    CLOSE #1
    BEEP 2

LOOP

FUNCTION ToAnsiColor (_
    Attr    AS INTEGER,_
    Ground  AS INTEGER) AS STRING

    SELECT CASE Attr
        CASE %Black         : Temp$ = "x0"
        CASE %LowBlue       : Temp$ = "x4"
        CASE %LowGreen      : Temp$ = "x2"
        CASE %LowCyan       : Temp$ = "x6"
        CASE %LowRed        : Temp$ = "x1"
        CASE %LowMagenta    : Temp$ = "x5"
        CASE %Brown         : Temp$ = "x3"
        CASE %LowWhite      : Temp$ = "x7"
        CASE %Gray          : Temp$ = "n;x0"
        CASE %HighBlue      : Temp$ = "n;x4"
        CASE %HighGreen     : Temp$ = "n;x2"
        CASE %HighCyan      : Temp$ = "n;x6"
        CASE %HighRed       : Temp$ = "n;x1"
        CASE %HighMagenta   : Temp$ = "n;x5"
        CASE %Yellow        : Temp$ = "n;x3"
        CASE %HighWhite     : Temp$ = "n;x7"
    END SELECT

    SELECT CASE Ground
        CASE %FOREGROUND
            REPLACE "x" WITH "3" IN Temp$
            REPLACE "n" WITH "1" IN Temp$

        CASE %BACKGROUND
            REPLACE "x" WITH "4" IN Temp$
            REPLACE "n" WITH "5" IN Temp$

    END SELECT

    FUNCTION = Temp$

END FUNCTION