'===========================================================================
' Subject: MENU WITH FADE                     Date: 11-20-00 (23:11)       
'  Author: Joel Nothman                       Code: QB, QBasic, PDS        
'  Origin: jnothman@crosswinds.net          Packet: MENU.ABC
'===========================================================================
DECLARE SUB ClearBlock (x!, y!, w!, h!)
DECLARE FUNCTION Menu! (Items() AS STRING, NumItems!, Left!, Top!, StartSel!, ClearIt!)
DECLARE FUNCTION NotIt! (Num!)
DECLARE SUB PrintFade (InOut!, x!, y!, txt$)
DECLARE FUNCTION CentreVal! (l!)
DECLARE SUB Centre (y!, t$)

DIM SHARED FadeCols(4)
FadeCols(1) = 15
FadeCols(2) = 7
FadeCols(3) = 8
FadeCols(4) = 0

CONST CENTRED = 0             'for aligning menus
CONST MDONTCLEAR = 0          'clear or not after menu is shown
CONST MCLEAR = 1

CONST FADEIN = -1
CONST FADEOUT = 1
CONST CHARWIDTH = 80 'for screen 12 default
DIM SHARED FADINGON
FADINGON = 1

DIM SHARED KUP$, KDOWN$, KENTER$, KESCAPE$
KUP$ = CHR$(0) + "H"
KDOWN$ = CHR$(0) + "P"
KENTER$ = CHR$(13)
KESCAPE$ = CHR$(27)

CLS

DIM MenuItems(5) AS STRING
MenuItems(0) = "Start Game"
MenuItems(1) = "Options"
MenuItems(2) = "High Scores"
MenuItems(3) = "Quit"


COLOR 15

DO
     q = Menu(MenuItems(), 4, CENTRED, 10, q, MDONTCLEAR)
LOOP UNTIL q = 3 OR q = -1


SUB Centre (y, t$)
     LOCATE y, CHARWIDTH / 2 - LEN(t$) / 2
     PRINT t$
END SUB

FUNCTION CentreVal (l)
     CentreVal = CHARWIDTH / 2 - l / 2
END FUNCTION

SUB ClearBlock (x, y, w, h)
     FOR j = 0 TO h - 1
          LOCATE y + j, x
          PRINT STRING$(w, " ")
     NEXT
END SUB

FUNCTION Menu (Items() AS STRING, NumItems, Left, Top, StartSel, ClearIt)
     Sel = StartSel

     MaxLength = 0
     FOR j = 0 TO NumItems - 1
          IF LEN(Items(j)) > MaxLength THEN MaxLength = LEN(Items(j))
     NEXT

     DO
     LOOP UNTIL INKEY$ = ""

     't$ = "use up & down to scroll, enter to choose"
     'PrintFade FADEIN, CentreVal(LEN(t$)), CHARHEIGHT - 1, t$

     DO
          EndMenu = 0
          COLOR 8
          FOR j = 0 TO NumItems - 1
               LOCATE Top + j, Left + NotIt(Left) * CentreVal(MaxLength)
               PRINT STRING$(MaxLength, " ");
               LOCATE Top + j, Left + NotIt(Left) * CentreVal(LEN(Items(j)))
               PRINT Items(j);
          NEXT

          PrintFade FADEIN, Left + NotIt(Left) * CentreVal(LEN(Items(Sel))), Top + Sel, Items(Sel)
         
          RefreshMenu = 0
          DO
               a$ = INKEY$
               SELECT CASE a$
                    CASE KUP$
                         PrintFade FADEOUT, Left + NotIt(Left) * CentreVal(LEN(Items(Sel))), Top + Sel, Items(Sel)

                         Sel = (Sel + NumItems - 1) MOD NumItems
                         RefreshMenu = 1
                    CASE KDOWN$
                         PrintFade FADEOUT, Left + NotIt(Left) * CentreVal(LEN(Items(Sel))), Top + Sel, Items(Sel)

                         Sel = (Sel + 1) MOD NumItems
                         RefreshMenu = 1
                    CASE KENTER$, " "
                         RefreshMenu = 1
                         EndMenu = 1
                    CASE KESCAPE$
                         Sel = -1
                         RefreshMenu = 1
                         EndMenu = 1
               END SELECT
          LOOP UNTIL RefreshMenu = 1
     LOOP UNTIL EndMenu = 1
     Menu = Sel

     'PrintFade FADEOUT, Left + NotIt(Left) * CentreVal(LEN(t$)), CHARHEIGHT - 1, t$
     IF ClearIt = MCLEAR THEN
          ClearBlock Left + NotIt(Left) * CentreVal(MaxLength), Top, MaxLength, NumItems
     END IF
END FUNCTION

FUNCTION NotIt (Num)
     IF Num = 0 THEN
          NotIt = 1
     ELSE
          NotIt = 0
     END IF
END FUNCTION

SUB PrintFade (InOut, x, y, txt$)
     FOR k = (FADINGON * (InOut + 5) + NotIt(FADINGON) * (5 - InOut)) MOD 5 TO (5 - InOut) MOD 5 STEP InOut
          COLOR FadeCols(k)
          LOCATE y, x
          LOCATE y, x
          PRINT txt$;
          S = TIMER
          DO
          LOOP UNTIL TIMER - S > .01
     NEXT
END SUB