Power-Programmierung/CD1.mdf/basic/library/qb_pds/qbfaqr01/ansi/pansi.bas

BASIC Source File | 1992-08-09 | 16.0 KB | 527 lines

'****PART 1****
'PANSI.BAS
'ANSI emulator for QuickBASIC 4.5(maby PDS) v1.00
'By Richard Geldreich June 3, 1992
'Don't forget that "CALL INTERRUPT"  is
'used- "INTRPT.OBJ" in the QB.LIB library...

'Thanks to Mike Gallas... the person who gave me
'the idea! Hope this helps! This driver recognizes all but
'3 ANSI.SYS escape sequences(the 3 not supported aren't used
'in commumication...)

'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
'! Don't forget to modify the "SendStatus" procedure for your !
'!                       comm package!                        !
'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

'I welcome any suggestions or ideas about this program... It
'_should_ emulate DOS's ANSI.SYS device driver...
'This program is in the public domain; do what you want with it!
'Have a ball!! Just try and give me some credit. Thanks.
'I have tested this driver out with many BBS's and door programs and
'it works fine. Please test this driver out before you release it
'in a program!!!

'NOTE: This program assumes that the current segment is always
'pointing twards the video buffer!! If you change the current
'segment don't forget to change it back or sparks will fly when you
'write to the screen! (see GetVSeg or RestoreVS)

'Info on usage:
'ClearScreen- used internally by the PrintAnsi procedure- you may
'use it to clear the current window(the current background color
'is used in the clear). ONLY the current window is cleared.

'CursorControl A- if A is non-zero then the SetCursor routine(which
'is called by PrintAnsi) will update the cursor whenever it is moved.
'If it is zero then SetCursor won't touch the cursor's position.

'GetVSeg- Returns the current video segment.

'Init- you must call this before PrintAnsi can work properly. Sets
'up the color translation table, the screen(defualts to 80x25), and
'tests the adapter to see if it's monochrome or color(***hope that
'works***).

'PrintAnsi Char- where Char is an ASCII code from 0-255. Recognizes
'ANSI escape sequences(of course!). Processes the character and
'updates the display, if needed.

'PrintString A$- prints a string to the display. Calls PrintAnsi for
'each character.

'RestoreVS- since PrintAnsi always assumes that DEF SEG points twards
'the video segment, you must restore the video segment after you change
'it. (See pansi2.bas for an example of this.) See GetVSeg also.

'ScrollUpScreen- scrolls up the current window. Uses a BIOS call.
'Normally used internally by PrintAnsi.

'SendStatus- sends a CPR sequence to the receiver.
'In other words, SendStatus will output the current X and Y coordinates
'of the cursor to the remote terminal. Used by some BBS's and doors
'to see if the user's terminal has ANSI capibilities. You must modify
'this procedure to output the status string to your comm package!
'(this is used internally by PrintAnsi)

'SetCursor- moves the cursor to it's correct position(it doesn't turn
'it on however- use the LOCATE ,,1 command to do that). This procedure
'should work on all adapters, but I haven't tested it out on many
'cards yet... Use this to restore the cursor to where it should be
'after you move it.

'SetWindow Lx,Ly,Hx,Hy- defines a window where all text is printed.
'Lx and Ly are the upper-left lines of the window(where 1,1 is the
'upper corner of the screen) and Hx and Hy are the lower-right
'coordinates of the window. For instance, if you're in the 80x50
'mode, you must issue this command:
'SetWindow 1,1,80,50
'to print to the entire screen. The current cursor position is moved
'to the upper left corner of the new window.

'That's all! You can add more functions if you need them; I've
'documented the PrintAnsi procedure enough for you to get
'a good idea of how it works. As soon as any bugs are worked out
'I'll code this program in assembly and post it(trust me: IT WILL
'FLY!).

'Notes on ANSI music:
'The format for ANSI music is ESC[MF and then add the music in the
'basic play format. Terminate it with a CHR$(14). I didn't implemet
'****PART 2****
'ANSI music because I haven't seen anything that uses it: but if
'anybody needs it I'll be glad to add it! ANSI.SYS does not support
'ANSI music(... what a shame).

DEFINT A-Z
'$INCLUDE: 'pansi.bi'

TYPE RegType
     Ax    AS INTEGER
     Bx    AS INTEGER
     Cx    AS INTEGER
     Dx    AS INTEGER
     bp    AS INTEGER
     si    AS INTEGER
     di    AS INTEGER
     flags AS INTEGER
END TYPE

DIM SHARED Xpos, Ypos               'cursor's position
DIM SHARED MinX, MinY, MaxX, MaxY   'current window
DIM SHARED SaveX, SaveY             'used by SCR and RCP
DIM SHARED Colors(7), Attribute
DIM SHARED CursorOn, VideoSegment
DIM SHARED Monochrome               'monochrome adapter flag

CONST True = -1, False = NOT True   'usefull stuff

'The color translation table is used to translate an ANSI color
'to a screen color.
ColorTable:
    DATA 0,4,2,6,1,5,3,7


'The following code is not needed... It's only for testing!
'simple test
Init                    'must do this!
SetWindow 1, 1, 80, 25  'normal window
ClearScreen             'clear the window
LOCATE , , 1            'turn cursor on
CursorControl 1         'allow updating of cursor

'DO
'    A$ = INKEY$: IF A$ <> "" THEN PrintString A$
'LOOP

A$ = CHR$(27) + "[0;1;5;44;31mHello Everybody! "
A$ = A$ + CHR$(27) + "[0;1;44;33mR.G. Here!"
DO: printstring A$: LOOP UNTIL INKEY$ <> ""
printstring CHR$(27) + "[0m" + CHR$(27) + "[2J"

'Clears the current window.
SUB ClearScreen
    DIM Regs AS RegType
    Regs.Ax = &H600
    A& = Attribute * 256&
    IF A& > 32767 THEN A = A& - 65536 ELSE A = A&
    Regs.Bx = A
    Regs.Cx = (MinY * 256&) + MinX - 257
    Regs.Dx = (MaxY * 256&) + MaxX - 257
    CALL interrupt(&H10, Regs, Regs)
END SUB

'Enables or disables cursor updating.
SUB CursorControl (A)
    IF A THEN
        CursorOn = True
    ELSE
        CursorOn = False
    END IF
END SUB

'Returns the current video segment.
FUNCTION GetVSeg
    GetVSeg = VideoSegment
END FUNCTION

'Initilizes everything.
SUB Init
    DIM Regs AS RegType
    'window defualts to 80x25
    SetWindow 1, 1, 80, 25
    'default color:white on black
    Attribute = 7
    'set up saveX and saveY just in case
    'a RCP sequence is received before a SCR
    'sequence.
    SaveX = MinX: SaveY = MinY

    'current level is set to normal
    Level = 0

'****PART 3****
    'read in color translation table
    RESTORE ColorTable
    FOR A = 0 TO 7: READ Colors(A): NEXT

    '***********************************
    'The following code uses a BIOS call
    'to test if adaptor is monochrome or
    'color. This **should** work on all
    'adapters(hee hee ya right) but who
    'knows!
    '***********************************

    Regs.Ax = 15 * 256
    CALL interrupt(&H10, Regs, Regs)
    'if AL=7 then card is monochrome.
    IF (Regs.Ax AND 255) = 7 THEN
        VideoSegment = &HB000
        Monochrome = True
    ELSE
        VideoSegment = &HB800
        Monochrome = False
    END IF
    'Set segment to the screen.
    DEF SEG = VideoSegment
END SUB

'Prints an ASCII character on the screen; filters out
'ANSI escape sequences and parses them.
SUB PrintAnsi (Char) STATIC
    DIM Parameters(10)

    SELECT CASE Level
    CASE 0
        'normal mode
        GOSUB ProcessChar
    CASE 1
        'Level=1 after a chr$(27) is received.
        'valid escape sequence?
        IF Char <> 91 THEN
            Level = 0
            GOSUB ProcessChar
        ELSE
            'a valid escape sequence has been received:
            'initilize all the neat stuff...
            Level = 2
            CurrentParameter = 0
            NumParameters = 0
            ValidParameter = False
            FOR A = 1 TO 5: Parameters(A) = 0: NEXT
        END IF
    CASE 2
        'inside an escape sequence
        GOSUB ProcessCode
    END SELECT
EXIT SUB

ProcessChar:
    'processes a non-ANSI code
    SELECT CASE Char
    'process new page code
    '(clears to screen: this is something
    'ANSI.SYS doesn't do)
    CASE 12
        ClearScreen
        Xpos = MinX: Ypos = MinY
        SetCursor
    'process escape character
    CASE 27
        Level = 1
    'process enter
    CASE 13
        Xpos = MinX
        SetCursor
    'process line feed
    CASE 10
        Ypos = Ypos + 1
        IF Ypos > MaxY THEN Ypos = MaxY: ScrollUpScreen
        SetCursor
    'process backspace(non-destructive)
    CASE 8
        Xpos = Xpos - 1
        IF Xpos < MinX THEN Xpos = MinX
        SetCursor
    'process tab key(tab stops=8)
    CASE 9
        Xpos = ((Xpos \ 8) + 1) * 8
        IF Xpos > 80 THEN Xpos = 80
        SetCursor
    'process bell
    CASE 7
        'don't substitute a "BEEP" statement here!

'****PART 4****
        'BEEP resets the cursor to where QB thinks it is!
        SOUND 3150, 1.3
    'any other character is sent to the screen
    CASE ELSE
        'prints a character to the screen
        A = Xpos * 2 + Ypos * 160 - 162
        POKE A, Char: POKE A + 1, Attribute
        Xpos = Xpos + 1
        IF Xpos > MaxX THEN Xpos = MinX: Ypos = Ypos + 1
        IF Ypos > MaxY THEN Ypos = MaxY: ScrollUpScreen
        SetCursor
    END SELECT
RETURN
'processes a character within an ansi escape sequence
'non-valid characters are sent to the screen
ProcessCode:
    SELECT CASE Char
    CASE 48 TO 57                       '0-9
        IF CurrentParameter < 100 THEN
            CurrentParameter = CurrentParameter * 10 + (Char - 48)
            ValidParameter = True
        ELSE
            GOSUB ProcessChar
            Level = 0
        END IF
    CASE 59
        GOSUB MakeParameter             '";"
    'CUP-set cursor's position
    CASE 72, 102                        'H or f
        GOSUB MakeParameter
        IF NumParameters = 0 THEN
            Ynew = 1: Xnew = 1
        ELSEIF NumParameters = 1 THEN
            Ynew = Parameters(0): Xnew = 1
        ELSE
            Ynew = Parameters(0): Xnew = Parameters(1)
        END IF
        'the following if/then was split apart for echo
        IF (Ynew >= MinY AND Ynew <= MaxY) THEN
            IF (Xnew >= MinX AND Xnew <= MaxX) THEN
                Ypos = Ynew: Xpos = Xnew
                SetCursor
            END IF
        END IF
        Level = 0
    'CUU- cursor up
    CASE 65                             'A
        GOSUB MakeParameter
        IF NumParameters = 0 THEN
            Ynew = Ypos - 1
        ELSE
            Ynew = Ypos - Parameters(0)
        END IF
        IF NOT (Ynew < MinY OR Ynew > MaxY) THEN
            Ypos = Ynew
            SetCursor
        END IF
        Level = 0
    'CUD-cursor down
    CASE 66                             'B
        GOSUB MakeParameter
        IF NumParameters = 0 THEN
            Ynew = Ypos + 1
        ELSE
            Ynew = Ypos + Parameters(0)
        END IF
        IF (Ynew >= MinY AND Ynew <= MaxY) THEN
            Ypos = Ynew
            SetCursor
        END IF
        Level = 0
    'CUF-cursor forward
    CASE 67                             'C
        GOSUB MakeParameter
        IF NumParameters = 0 THEN
            Xpos = Xpos + 1
        ELSE
            Xpos = Xpos + Parameters(0)
        END IF
        IF Xpos > MaxX THEN Xpos = MaxX
        SetCursor
        Level = 0
    'CUB-cursor backward
    CASE 68                              'D
        GOSUB MakeParameter
        IF NumParameters = 0 THEN
            Xpos = Xpos - 1
        ELSE
            Xpos = Xpos - Parameters(0)
        END IF
        IF Xpos < MinX THEN Xpos = MinX

'****PART 5****
        SetCursor
        Level = 0
    'SCR-save cursor position
    CASE 115                            's
        SaveX = Xpos
        SaveY = Ypos
        Level = 0
    'RCP-restore cursor position
    CASE 117                            'u
        Xpos = SaveX
        Ypos = SaveY
        Level = 0
        SetCursor
    'ED-erase display(ESC[2J and ESC[J work
    'both work)
    CASE 74                             'J
        ClearScreen
        Xpos = MinX: Ypos = MinY
        Level = 0
        SetCursor
    'EL-erase in line
    CASE 75                             'K
        Y = Ypos * 160 - 160 - 2
        'this could be optimized
        FOR X = Xpos TO MaxX
            A = X * 2 + Y
            POKE A, 32: POKE A + 1, Attribute
        NEXT
        Level = 0
    'SGR-sets new color
    '(hopefully I handled the monochrome stuff
    'correctly...)
    CASE 109                            'm
        GOSUB MakeParameter
        FOR A = 0 TO NumParameters - 1
            P = Parameters(A)
            SELECT CASE P
            CASE IS <= 8
                SELECT CASE P
                'all attributes off
                CASE 0
                    Attribute = 7
                'high-intensity
                CASE 1
                    Attribute = Attribute OR 8
                'blinking
                CASE 5
                    Attribute = Attribute OR 128
                CASE 7
                'inverse video is not implemented at this time
                '...because I don't have the fuzziest idea what
                'it does!
                END SELECT
                'set foreground
            CASE 30 TO 37
                IF NOT Monochrome THEN
                    Attribute = (Attribute AND 248) OR Colors(P - 30)
                END IF
                'set background
            CASE 40 TO 47
                IF NOT Monochrome THEN
                    Attribute = (Attribute AND 143)
                    Attribute = Attribute OR Colors(P - 40) * 16
                END IF
            END SELECT
        NEXT
        Level = 0
    'DSR-outputs a CPR sequence
    'This function outputs the string "ESC[#;#R" where
    '#;# is the current Y and current X coordinate
    'to the receiver.
    'Calls SendStatus to do it's dirty work...
    CASE 110
        SendStatus Xpos, Ypos
        Level = 0
    'any other code is assumed to be invalid
    CASE ELSE
        Level=0
        GOSUB ProcessChar
    END SELECT
RETURN
'stores a numeric parameter into the parameter table
MakeParameter:
    'check to see if a least one digit has been received
    'for this parameter
    IF ValidParameter AND NumParameters < 5 THEN
        'add parameter to table
        Parameters(NumParameters) = CurrentParameter
        NumParameters = NumParameters + 1
        CurrentParameter = 0
        ValidParameter = False
'****PART 6****
    END IF
RETURN
END SUB

'Prints a string to the display.
SUB printstring (B$)
    A& = SADD(B$)
    IF A& < 0 THEN A& = A& + 65536
    Segment = VARSEG(B$) + A& \ 16
    Address = A& MOD 16
    FOR B = Address TO Address + LEN(B$) - 1
        DEF SEG = Segment
        A1 = PEEK(B)
        'RestoreVs
        DEF SEG = VideoSegment
        PrintAnsi A1
    NEXT
END SUB

SUB RestoreVs
    DEF SEG = VideoSegment
END SUB

SUB ScrollUpScreen
    DIM Regs AS RegType
    Regs.Ax = &H601

    A& = Attribute * 256&
    IF A& > 32767 THEN A = A& - 65536 ELSE A = A&
    Regs.Bx = A

    Regs.Cx = (MinY * 256&) + MinX - 257
    Regs.Dx = (MaxY * 256&) + MaxX - 257
    CALL interrupt(&H10, Regs, Regs)
END SUB

'Sends the screen's status to the receiver. You must modify the
'"PRINT #1, A$;" command to print to your comm package.
'Sends "ESC[##;##R" where ##;## is Y;X.
SUB SendStatus (X, Y)
    A$ = CHR$(27) + "[" + RIGHT$("0" + MID$(STR$(Y), 2), 2)
    A$ = A$ + ";" + RIGHT$("0" + MID$(STR$(X), 2), 2) + "R"
    '*****Change the next line for your comm package!!
    '*****(as it stands it's set up to work correctly with
    'PANSI3.BAS)*****
    PRINT #1, A$;           'DON'T insert a line feed!!

END SUB

SUB SetCursor
    IF CursorOn THEN
    LOCATE Ypos, Xpos
    END IF
END SUB

'Sets a new printing window.
SUB SetWindow (Lx, Ly, Hx, Hy)
    MinX = Lx: MaxX = Hx
    MinY = Ly: MaxY = Hy
    Xpos = MinX: Ypos = MinY
    SetCursor
END SUB

'end of main program; example programs follow