'===========================================================================
' Subject: GUI PROGRAMMER'S LIBRARY V1.23     Date: 08-09-96 (17:04)       
'  Author: Tika Carr                          Code: QB, PDS                
'  Origin: FidoNet QUIK_BAS Echo            Packet: EGAVGA.ABC
'===========================================================================
'GUI123.BAS 8/9/96
'GUI Interface Programmer's Library v. 1.23
'for QuickBasic 4.5
'Copyright 1996 by Tika Carr

'Contact:
'Tika Carr 1:2613/601
'kari@rochgte.fidonet.org

DECLARE SUB clrscrn (clr%)
DECLARE SUB drwbtn (ds%, dc%, dfs%, dfc%, dx1%, dy1%, dx2%, dy2%)
DECLARE SUB gprint (z$, x%, y%, c%)
DECLARE SUB Mouse (a%)
DECLARE SUB PopInp (Prompt$, T2Len%, x1%, y1%, CurClr%)

'$INCLUDE: 'qb.bi'

COMMON SHARED mb%, mi%, mt%, mx%, my%        'mouse variables
COMMON SHARED black%, white%                 'used for palette
COMMON SHARED T2$                            'PopInp results
DIM SHARED Inregs AS RegType, Outregs AS RegType        'Interrupt
DIM SHARED Regs AS RegTypeX                             'InterruptX

SCREEN 12: CLS      '640 x 480 16 color VGA 80 x 30 text

'** PALETTE ASSIGNMENT **

' Color 0 and Color 15 are system colors (black and white) and should
' not be changed as they are used for buttons and such.

black% = 0: white% = 15

DEFINT A-Z

WIDTH 80, 60

'Clear the screen to color #3 (Cyan)
CALL clrscrn(3)

'Change white to be 7, causing the boarder highlight to be grey
'instead of white. Change the menu bar to be white, then draw menu
'bar, and change white back to color #14 (white)

white = 7
CALL drwbtn(2, 15, 0, 0, 0, 0, 639, 20)
white = 15

'The "Exit" box in the upper left.
CALL drwbtn(2, 7, 0, 0, 2, 2, 18, 18)
CALL gprint("X", 6, 4, 0)

'The "Help" box in the upper right.
CALL drwbtn(2, 7, 0, 0, 619, 2, 637, 18)
CALL gprint("?", 624, 4, 0)

'Menu Options
CALL gprint("File", 55, 3, 0)
CALL gprint("Edit", 107, 3, 0)

' A boxed frame text box
CALL drwbtn(4, 9, 10, 1, 10, 30, 629, 459)

' Some text in the box
a$(1) = "Here is an example of some things you can do in the GUI interface."
a$(2) = "I want to thank Douglas H. Lusher for his help in writing the gprint"
a$(3) = "routine. He developed a faster way to print text on the screen. This"
a$(4) = "routine does what the PRINT statement can't: Prints text virtually"
a$(5) = "anywhere on the screen, and transparently over the graphics."

y = 34
FOR g = 1 TO 5
    y = y + g + 16
    CALL gprint(a$(g), 32, y, 14)
NEXT g

Start:
'Loop to trap mouse events
CALL Mouse(0)       'initialize mouse
CALL Mouse(1)       'show mouse

WHILE mb = 0        'trap events
    CALL Mouse(3)
    LOCATE 60, 1
    PRINT mx, my, mb;
WEND

'The "Exit" box in the upper left clicked on.
IF mx > 2 AND my > 3 AND mx < 18 AND my < 18 THEN
    CALL Mouse(2)   'hide mouse
    CALL drwbtn(1, 7, 0, 0, 2, 2, 18, 18)
    CALL gprint("X", 6, 4, 0)
    FOR delay = 1 TO 30000: NEXT
    CALL drwbtn(2, 7, 0, 0, 2, 2, 18, 18)
    CALL gprint("X", 6, 4, 0)
    CALL PopInp("Do You Really Want To Quit?", 1, 160, 120, 3)
    IF LCASE$(T2$) = "n" THEN RUN ELSE END
END IF

GOTO Start

SUB clrscrn (clr%)
LINE (0, 0)-(639, 479), clr%, BF
END SUB

SUB drwbtn (ds, dc, dfs, dfc, dx1, dy1, dx2, dy2)
IF ds >= 3 AND ds <= 6 THEN c = dfc ELSE c = dc
SELECT CASE ds
    CASE 1: GOSUB dOn
    CASE 2: GOSUB dOff
    CASE 3: GOSUB dOn: GOSUB Inside: GOSUB dOff
    CASE 4: GOSUB dOff: GOSUB Inside: GOSUB dOn
    CASE 5: GOSUB dOn: GOSUB Inside: GOSUB dOn
    CASE 6: GOSUB dOff: GOSUB Inside: GOSUB dOff
    CASE 7: GOSUB Dsqu
    CASE 8: GOSUB Dsqu: LINE (dx1, dy1)-(dx2, dy2), black%: LINE (dx1, dy2)-(dx2, dy1), black%
    CASE 9: GOSUB Dcir
    CASE 10: GOSUB Dcir: CIRCLE (dx1, dy1), (15 - dfs) \ 2, dfc: PAINT (dx1, dy1), dfc, dfc
END SELECT

GOTO Ddone

Dsqu:
    LINE (dx1, dy1)-(dx2, dy2), black%, B
    PAINT (dx2 - 4, dy2 - 4), c, black%
RETURN

DBold:
    GOSUB Dsqu
    LINE (dx1 + 1, dy1 + 1)-(dx2 - 1, dy2 - 1), black%, B
RETURN

dOn:
    GOSUB DBold
    LINE (dx1 + 1, dy2 - 1)-(dx2 - 1, dy2 - 1), white%
    LINE -(dx2 - 1, dy1 + 1), white%
RETURN

dOff:
    GOSUB DBold
    LINE (dx1 + 1, dy2 - 1)-(dx1 + 1, dy1 + 1), white%
    LINE -(dx2 - 1, dy1 + 1), white%
RETURN

Dcir:
    CIRCLE (dx1, dy1), dfs, black%
    PAINT (dx1, dy1), dc, black%
RETURN

Inside:
    dx1 = dx1 + dfs: dy1 = dy1 + dfs
    dx2 = dx2 - dfs: dy2 = dy2 - dfs
    c = dc
RETURN

Ddone:
dx1 = dx1 - dfs: dy1 = dy1 - dfs
dx2 = dx2 + dfs: dy2 = dy2 + dfs

END SUB

SUB gprint (z$, x%, y%, c%)
Regs.ax = &H1130
Regs.bx = &H600
CALL INTERRUPTX(&H10, Regs, Regs)
CharSegment% = Regs.es: CharOffset% = Regs.bp
CharWid% = 8: CharHgt% = 16

DEF SEG = CharSegment%
XX% = x
FOR Char% = 1 TO LEN(z$)
   Ptr% = CharHgt% * ASC(MID$(z$, Char%, 1)) + CharOffset%
   FOR Ln% = 0 TO CharHgt% - 1
     BitPattern& = PEEK(Ptr% + Ln%) * 256&
     LineFormat% = (BitPattern& - 32768) XOR -32768
     LINE (XX%, y + Ln%)-STEP(CharWid% - 1, 0), c, , LineFormat%
   NEXT
   XX% = XX% + CharWid%
NEXT
DEF SEG
END SUB

SUB Mouse (a%)
Inregs.ax = a%
CALL INTERRUPT(&H33, Inregs, Outregs)
mb = Outregs.bx     'button 0 = off 1 = left 2 = right
mx = Outregs.cx     'x coordinate
my = Outregs.dx     'y coordinate
mi = Outregs.ax     'init (dummer variable)

END SUB

DEFSNG A-Z
SUB PopInp (Prompt$, T2Len%, x1%, y1%, CurClr%)

IF LEN(Prompt$) > T2Len% THEN PBoxLen = LEN(Prompt$) ELSE PBoxLen = T2Len%
x2% = x1% + (PBoxLen + 2) * 8: y2% = y1% + 64: nx = x1%: ny = y1%

CALL Mouse(2)
BitsPerPixel = 1: planes = 4        'Screen Mode 12
Ary% = 4 + INT(((x2% - x1% + 1) * (BitsPerPixel) + 7) / 8) * planes * ((y2% - y1%) + 1)

DIM VScreen(1 TO Ary%)
GET (x1%, y1%)-(x2%, y2%), VScreen

CALL drwbtn(2, 7, 0, 0, x1%, y1%, x2%, y2%)
x1% = x1% + 8
CALL gprint(Prompt$, x1%, y1% + 8, 0)

Inloop:
y1% = y1% + 32
'Input Field
CALL gprint(">", x1%, y1%, 0)
CALL gprint(STRING$(T2Len%, 219), x1% + 8, y1%, 15)

'** Turn on and show cursor
x1% = x1% + 8
cursor$ = CHR$(219)
CALL gprint(cursor$, x1%, y1%, 4)

'** Get Input and move cursor

T2$ = ""
1 T1$ = INKEY$: IF T1$ = "" THEN 1 'wait for keypress
st = ASC(T1$)

'Backspace and erase

IF st = 8 THEN
        'checks to make sure its in field
        x1% = x1% - 8: IF x1% < nx + 16 THEN x1% = nx + 16: GOTO 1
        CALL gprint(cursor$, x1% + 8, y1%, 15)
        CALL gprint(RIGHT$(T2$, 1), x1%, y1%, 0)
        CALL gprint(cursor$, x1%, y1%, 4)
        'subtracts deleted character from string
        IF LEN(T2$) >= 1 THEN T2$ = LEFT$(T2$, LEN(T2$) - 1)
        GOTO 1
END IF

IF T1$ = CHR$(13) THEN GOTO 2  'End of input when ENTER is pressed.

IF st < 32 OR st > 127 THEN BEEP: GOTO 1  'check for illegal character

T2$ = T2$ + T1$
CALL gprint(cursor$, x1%, y1%, 15)
CALL gprint(T1$, x1%, y1%, 0)
x1% = x1% + 8
'checks to make sure its in field
IF x1% > (nx + T2Len% * 8 + 8) THEN BEEP: GOTO 1
CALL gprint(cursor$, x1%, y1%, 4)

'Get more input
GOTO 1

2 'Erase menu, restore what was underneath
PUT (nx, ny), VScreen, PSET
ERASE VScreen
CALL Mouse(1)

END SUB