Category : BASIC Source Code
Archive   : QBFAQR01.ZIP
Filename : PANSI.BAS

'****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