'===========================================================================
' Subject: GRAPHICAL USER INTERFACE 1.01     Date: 05-02-96 (00:00)       
' Author:  Tika Carr                         Code: QB, PDS                
' Origin:  FidoNet QUIK_BAS Echo           Packet: EGAVGA.ABC
'===========================================================================
' Graphical User Interface V. 1.01
' Written by Tika Carr
' Released into the Public Domain on November 4, 1995
' Please keep me posted on any changes you make, so I can add them on too.
' E-Mail: (as of 5/2/96, Internet E-mail Address is pending)
' FidoNet: 1:2613/601

' Bug Fixes:
'
' May 2, 1996 v. 1.01 - Fixed Menu Flipping when holding mouse button
'                       on a menu button. Thank You to Justin Pasher
'                       for the code fix and ClearMouse Sub.


DECLARE SUB Mouse2 ()
DECLARE SUB Overlay (x1%, y1%, x2%, y2%, Klr%, OFlg%)
DECLARE SUB OvrWin (x1%, y1%, x2%, y2%, Klr%)
DECLARE SUB Mouse ()
DECLARE SUB ClearMouse ()
DECLARE SUB CircleBtn ()
DECLARE SUB VScreen (x1%, y1%, x2%, y2%, Bkgn%)
DECLARE SUB startmouse ()
DECLARE SUB showmouse ()
DECLARE SUB getmousecord (btn%, M3%, M4%)
DECLARE SUB hidemouse ()
DECLARE SUB MakeButton (P$, XL%, KKr%, KKh%)
DECLARE SUB ButtonDraw ()
DECLARE SUB gprint (S$, x%, y%, Klr%)

' This uses VGA graphics mode 12:  640 x 480/16 color, 80 x 60 text area

DEFINT A-Z
'$INCLUDE: 'QB.BI'

TYPE COORD
 bx1 AS INTEGER
 bx2 AS INTEGER
 Flag AS INTEGER
END TYPE

DIM SHARED Inregs AS RegType, Outregs AS RegType
DIM SHARED Buttons(1 TO 9) AS COORD
COMMON SHARED BN, Flg, Bkgn, VW, CFlag, PI, x, y, btn
PI = 3.141593


SCREEN 12: CLS
WIDTH 80, 60

'Possible Palettes:

'PALETTE 0, (65536 * 47 + 256 * 47 + 47) ' Grey Background
PALETTE 0, (65536 * 45 + 256 * 45 + 63)  ' Baby Pink Background
'PALETTE 0, (65536 * 57 + 256 * 57 + 57)  ' White Background
'PALETTE 0, (65536 * 50 + 256 * 47 + 0)   ' Cyan Background

'Help Button Hide/Display default

HideHelp = 0: CFlag = 1

'Circle Button for Help - 0 is 'Display (don't hide)

IF HideHelp = 0 THEN
 CALL CircleBtn
END IF

'Syntax: MakeButton(Title, XLocation(LOCATE), Text Color, Highlight Color)

'NOTE: Flg=1 is button is "out"; Flg=0 is button is "in"

BN = 2: Flg = 1: CALL MakeButton("File", 8, 8, 1)

' NOTE: Bkgn MUST be LESS than 8 (Bkgn values must be 0-7)
'       Other combinations may or may not work.  Test values before
'       using them.  GPRINT uses a BIOS video write to put text on screen.

'Syntax: VScreen(x1, y1, x2, y2, Bkgn)

CALL VScreen(0, 30, 639, 479, 7)
VW = 1: CALL gprint("Hello", 45, 23, 6)  'VW is view window is "on" for GPRINT

startmouse
showmouse

'Start Input

Inloop:

ClearMouse
Mouse
IF btn = 2 THEN GOTO Done

'Check Mouse Coordinates

'Help Button

IF x < 21 AND y < 21 THEN
 x1 = 314: y1 = 153: x2 = 554: y2 = 394: Klr = 3
 ga = 4 + INT(((x2 - x1 + 1) * (1) + 7) / 8) * 4 * ((y2 - y1) + 1)
 DIM OvScn(1 TO ga) AS INTEGER
 GET (x1, y1)-(x2, y2), OvScn
 CFlag = 0
 CALL CircleBtn
 CALL OvrWin(x1, y1, x2, y2, Klr)
 CALL gprint("This is the Help Screen.", 42, 23, 2)
 CALL gprint("Click Mouse to Continue.", 42, 25, 13)
 ClearMouse
 Mouse
 hidemouse
 PUT (x1, y1), OvScn, PSET
 ERASE OvScn
 showmouse
 CFlag = 1
 CALL CircleBtn
END IF

' File Menu Activated.

IF x >= 51 AND y >= 2 AND x <= 90 AND y <= 18 THEN
 Flg = 0
 ButtonDraw
   
 x1 = 32: y1 = 34: x2 = 115: y2 = 146: Klr = 3
 ga = 4 + INT(((x2 - x1 + 1) * (1) + 7) / 8) * 4 * ((y2 - y1) + 1)
 DIM OvScn(1 TO ga) AS INTEGER
 GET (x1, y1)-(x2, y2), OvScn
 VW = 1: OFlg = 1
 CALL Overlay(x1, y1, x2, y2, Klr, OFlg)
 CALL gprint("New", 5, 2, 13)
 CALL gprint("Open", 5, 4, 13)
 CALL gprint("Save", 5, 6, 13)
 CALL gprint("Save As..", 5, 8, 13)
 CALL gprint("Print", 5, 10, 13)
 CALL gprint("Exit", 5, 12, 13)
 ClearMouse
 Mouse
   
 'Exit Option

 mx1 = 35: my1 = 123: mx2 = 112: my2 = 138: mKlr = 3: mOFlg = 0
 IF x > mx1 AND x < mx2 AND y > my1 AND y < my2 THEN
  hidemouse
 CALL Overlay(mx1, my1, mx2, my2, mKlr, mOFlg)
  CALL gprint("Exit", 5, 12, 1)
  showmouse
  Mouse2
 IF x > mx1 AND x < mx2 AND y > my1 AND y < my2 THEN
  END
 ELSE
 GOTO DDN
 END IF
 END IF

 'Print Option

 'The mx values are 16 less that that of the Exit option
 '(8 pixels/row so since they are every other row, 8 * 2 = 16)

 mx1 = 35: my1 = 107: mx2 = 112: my2 = 122: mKlr = 3: mOFlg = 0
 IF x > mx1 AND x < mx2 AND y > my1 AND y < my2 THEN
  hidemouse
 CALL Overlay(mx1, my1, mx2, my2, mKlr, mOFlg)
 
  'Note here we change gprint to reflect the Print option and its
  'y coordinate location.
 
  CALL gprint("Print", 5, 10, 1)
  showmouse
  Mouse2
 IF x > mx1 AND x < mx2 AND y > my1 AND y < my2 THEN
 
  'Action for Print Option goes here.

 ELSE
 GOTO DDN
 END IF
 END IF
DDN:
  hidemouse
  PUT (x1, y1), OvScn, PSET
  showmouse
  ERASE OvScn
   
  Flg = 1
  ButtonDraw

END IF

GOTO Inloop

Done:

'Pause Display and Wait for Keypress
'Pause$ = INPUT$(1)

hidemouse

SUB ButtonDraw
hidemouse
yb = Buttons(BN).bx2 - Buttons(BN).bx1
IF Flg = 1 THEN k1 = 15: k2 = 8 ELSE k1 = 8: k2 = 15
DRAW "C" + STR$(k1) + "BM" + STR$(Buttons(BN).bx1) + ",18U15R" + STR$(yb)
DRAW "C" + STR$(k2) + "BM" + STR$(Buttons(BN).bx1) + ",18R" + STR$(yb) + "U15"
showmouse
END SUB

SUB CircleBtn
   
hidemouse
 LINE (9, 0)-(11, 11), 0, BF
 CIRCLE (10, 11), 10, 8
 PAINT (10, 11), 12, 8
 IF CFlag = 1 THEN c1 = 15: c2 = 8 ELSE c1 = 8: c2 = 15
 CIRCLE (10, 11), 9, c1, 1, INT(PI + 1)
 CIRCLE (10, 11), 9, c2, INT(PI + 1), .5

 VW = 0: CALL gprint("?", 1, 2, 3)  'Note: VW is view window ON/OFF; 0=OFF

 'NOTE: above colors for GPRINT: 2 is Yellow, 3 is White
 '      for last number: GPRINT($, x, y, color)

showmouse
END SUB

SUB ClearMouse
DO
 getmousecord btn, x, y
 LOCATE 59, 5
 PRINT x, y, btn;

LOOP UNTIL btn = 0

END SUB

SUB getmousecord (btn%, M3%, M4%)
Inregs.ax% = 3
CALL INTERRUPT(&H33, Inregs, Outregs)
M3% = Outregs.cx%
M4% = Outregs.dx%
btn% = Outregs.bx%
END SUB

SUB gprint (S$, x, y, Klr)
IF VW = 1 THEN y = y + 5

IF Klr < 10 THEN
 Klr = Klr + 8
 B = (Bkgn XOR Klr) - 8
ELSE
 B = Bkgn XOR Klr
END IF

IF B < 10 THEN B$ = "&HF" + HEX$(B) ELSE B$ = "&HF" + HEX$(B)

Inregs.bx% = VAL(B$)
Inregs.cx% = 1
AH$ = "9"

FOR count = 1 TO LEN(S$)
 A$ = MID$(S$, count, 1)
 AL$ = HEX$(ASC(A$))
 Inregs.ax% = VAL("&H" + AH$ + AL$)
 LOCATE y, x + count
 CALL INTERRUPT(&H10, Inregs, Outregs)
NEXT count

END SUB

SUB hidemouse
Inregs.ax% = 2
CALL INTERRUPT(&H33, Inregs, Outregs)
END SUB

SUB MakeButton (P$, XL, KKr, KKh)

'Highlight First Character

PH$ = LEFT$(P$, 1): PR$ = RIGHT$(P$, LEN(P$) - 1)
COLOR KKh: LOCATE 2, XL: PRINT PH$;
COLOR KKr: PRINT PR$

Buttons(BN).bx1 = (XL - 1) * 8 - 4
Buttons(BN).bx2 = Buttons(BN).bx1 + (LEN(P$) * 8) + 6

LINE (Buttons(BN).bx1 - 1, 2)-(Buttons(BN).bx2 + 1, 19), 8, B

CALL ButtonDraw

END SUB

SUB Mouse

DO
 getmousecord btn, x, y
 LOCATE 59, 5
 PRINT x, y, btn;

LOOP WHILE btn = 0

END SUB

SUB Mouse2
DO
 getmousecord btn, x, y
 LOCATE 59, 5
 PRINT x, y, btn;

LOOP WHILE btn <> 0
DO
 getmousecord btn, x, y
 LOCATE 59, 5
 PRINT x, y, btn;

LOOP WHILE btn = 0

END SUB

SUB Overlay (x1, y1, x2, y2, Klr, OFlg)
 IF OFlg = 1 THEN c1 = 15: c2 = 8 ELSE c1 = 8: c2 = 15
 hidemouse
 LINE (x1, y1)-(x2, y2), 8, B
 PAINT (x1 + 1, y1 + 1), Klr, 8
 DRAW "c" + STR$(c1) + "bm" + STR$(x1 + 1) + "," + STR$(y2 - 1) + "U" + STR$(y2 - y1 - 2) + "R" + STR$(x2 - x1 - 2)
 DRAW "c" + STR$(c2) + "bm" + STR$(x1 + 1) + "," + STR$(y2 - 1) + "R" + STR$(x2 - x1 - 2) + "U" + STR$(y2 - y1 - 2)
 showmouse
END SUB

SUB OvrWin (x1, y1, x2, y2, Klr)

A = x1 + 1: B = y2 - 1: C = y2 - y1 - 2
E = x1 + 9: F = y2 - 9: G = y2 - y1 - 18

LINE (x1, y1)-(x2, y2), 8, B
PAINT (x1 + 10, y1 + 10), Klr, 8

LINE (x1 + 8, y1 + 9)-(x2 - 8, y2 - 8), 8, B
PAINT (x1 + 10, y1 + 10), Klr, 8

DRAW "C15BM" + STR$(A) + "," + STR$(B) + "U" + STR$(C) + "R" + STR$(C)
DRAW "C8BM" + STR$(A) + "," + STR$(B) + "R" + STR$(C - 1) + "U" + STR$(C - 1)
DRAW "C8BM" + STR$(E) + "," + STR$(F) + "U" + STR$(G) + "R" + STR$(G)
DRAW "C15BM" + STR$(E) + "," + STR$(F - 1) + "R" + STR$(G - 1) + "U" + STR$(G - 1)

END SUB

SUB showmouse
Inregs.ax% = 1
CALL INTERRUPT(&H33, Inregs, Outregs)
END SUB

SUB startmouse
Inregs.ax% = 0
CALL INTERRUPT(&H33, Inregs, Outregs)
MouseInitialize% = Outregs.ax%
END SUB

SUB VScreen (x1, y1, x2, y2, Bkgn)
LINE (x1, y1)-(x2, y2), 8, B
PAINT (x1 + 1, y1 + 1), Bkgn, 8
DRAW "c8bm" + STR$(x1 + 1) + "," + STR$(y2 - 1) + "u" + STR$(y2 - y1) + "r" + STR$(x2 - x1)
DRAW "c15bm" + STR$(x1 + 1) + "," + STR$(y2 - 1) + "r" + STR$(x2 - x1 - 2) + "u" + STR$(y2 - y1)
END SUB