'===========================================================================
' Subject: GRAPHICAL USER INTERFACE           Date: 11-04-95 (00:00)       
'  Author: Tika Carr                          Code: QB, PDS                
'  Origin: FidoNet QUIK_BAS Echo            Packet: EGAVGA.ABC
'===========================================================================
' Graphical User Interface V. 1.0

' 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: Delta4@VivaNET.com
  
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 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:
  
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)

 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)
  
 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 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