$CPU 8086          ' make compatible with XT systems
$LIB ALL OFF       ' turn off all PowerBASIC libraries
$ERROR ALL OFF     ' turn off all PowerBASIC error checking
$OPTIMIZE SIZE     ' optimize for smaller code
 $COMPILE UNIT      ' compile to a UNIT (.PBU)
'$COMPILE EXE       ' compile to a UNIT (.PBU)

DEFINT A-Z         ' Required for all numeric functions, forces PB to not
                   ' include floating point in UNIT (makes it smaller)
'/*------------------------------------------------------------------*/
DECLARE FUNCTION GETSCREEN() AS STRING
DECLARE SUB PUTSCREEN(BYVAL X AS STRING)
DECLARE FUNCTION MKTATTR(CF,CB) AS INTEGER
DECLARE SUB GETFB(ATTR,CF,CB)
DECLARE SUB MCLICKED(Rgt%,Lft%,Row%,Col%)
DECLARE SUB MOUSEON()
DECLARE SUB MOUSEOFF()
DECLARE SUB MLOCATE(BYVAL ROW,BYVAL COL)
DECLARE FUNCTION REATTR(ULR%,ULC%,LRR%,LRC%,ATTR%) AS STRING
DECLARE SUB SAY(BYVAL Row AS INTEGER, BYVAL Col AS INTEGER, BYVAL Text AS STRING, BYVAL Attr AS INTEGER)
 DECLARE FUNCTION SUBSTR(BYVAL X AS STRING, BYVAL N AS INTEGER, BYVAL L AS INTEGER, BYVAL PAD AS STRING) AS STRING
DECLARE FUNCTION XWORD(BYVAL W$,BYVAL WN, BYVAL SCHAR) AS STRING
 DECLARE FUNCTION XWORDS(BYVAL F$,BYVAL CHAR) AS INTEGER
 DECLARE FUNCTION XWORDINDEX(BYVAL F$,BYVAL WN,BYVAL CHAR) AS INTEGER
 DECLARE FUNCTION XWORDLENGTH(BYVAL F$,BYVAL WN,BYVAL CHAR) AS INTEGER
 DECLARE FUNCTION WORD(BYVAL X AS STRING,XN AS INTEGER) AS STRING
 DECLARE FUNCTION WORDS(BYVAL X AS STRING) AS INTEGER
 DECLARE FUNCTION WORDINDEX(BYVAL X AS STRING, BYVAL NBR AS INTEGER) AS INTEGER
    DECLARE SUB PUTWINDOW(Temp$)
'/* DECLARE SUB MOUSE(Button AS INTEGER, Row AS INTEGER, Column AS INTEGER)
DECLARE SUB MWHERE(BTN, ROW, COL)
    DECLARE FUNCTION GETWINDOW(ULR%,ULC%,LRR%,LRC%)  AS STRING
 DECLARE SUB TBOX(BYVAL ROW,BYVAL COL,BYVAL ROWS,BYVAL COLS,BYVAL ATTR,BYVAL OPT,BYVAL SHAD)
'/*------------------------------------------------------------------*/
$CODE SEG "MLIB6"
'/*------------------------------------------------------------------*/
   SUB MENU(ROW,COL,PS$,ATTR,HATTR,PATTR,PTR,VPTR,RKEY$,MF) PUBLIC
     REDIM HROW(12)
     REDIM HCOL(12)
     REDIM HMEN$(12)
     REDIM HCHAR$(12,24)
     REDIM VROW(12,24)
     REDIM VCOL(12,24)
     REDIM VMEN$(12,24)
     REDIM VLEN$(12)
'/*  --- Save Screen --------------------------------------------------
'/*  MSCREEN$ = GETSCREEN
'/*  --- Set Defaults if NOT Passed -----------------------------------
     IF ROW = 0 THEN ROW = 1
     IF COL = 0 THEN COL = 1
     IF ATTR = 0 THEN
       ATTR = 112
       PATTR = 32
       HKATTR = 116
     END IF
 SPECJUMP:
     IF ATTR > 0 AND HKATTR = 0 THEN
       GETFB ATTR,AFC,ABC
       PATTR = MKTATTR(ABC,AFC)
       HKATTR = MKTATTR(4,ABC)
     END IF
     IF PTR = 0 THEN PTR = 1
'/*  --- Set Vars -----------------------------------------------------
     TM$ = ""
     GETFB ATTR,AFC,ABC
     GETFB HKATTR,HFC,HBC
     GETFB PATTR,PFC,PBC
     HATTR = MKTATTR(HFC,ABC)
     PHATTR = MKTATTR(HFC,PBC)
     AK$ = CHR$(0,72,0,80,0,75,0,77)         :'/*Arrow Keys
     VK$ = CHR$(0,72,0,80)                   :'/*Vertical Arrow Keys
'/*                    1         2         3         4         5
'/*           12345678901234567890123456789012345678901234567890
     ALTK$ = "               QWERTYUIOP    ASDFGHJKL     ZXCVBNM"
     TMCNT = XWORDS(PS$,126)
     VMFLAG = 0
     HPTR = 0
     HVPTR = 0
'/*  --- Get Horizontal Menu Items ------------------------------------
     MS$ = XWORD(PS$,1,126)
     ITEMCNT = WORDS(MS$)
     FOR CNT = 1 TO ITEMCNT
       HROW(CNT) = ROW
       HCOL(CNT) = WORDINDEX(MS$,CNT)
       HMEN$(CNT) = " "+WORD(MS$,CNT)
       IF INSTR(1,HMEN$(CNT),"@") < 1 AND INSTR(1,HMEN$(CNT),"#") < 1 THEN HMEN$(CNT) = HMEN$(CNT) + " "
       S = INSTR(1,HMEN$(CNT),"@")
       IF S > 0 THEN HCHAR$(CNT,0) = UCASE$(MID$(HMEN$(CNT),S+1,1)) ELSE HCHAR$(CNT,0) = ""
     NEXT CNT
'/*--- Get Vertical Menu Items ----------------------------------------
     IF TMCNT > 1 THEN
       FOR VCNT = 1 TO TMCNT-1
         T$ = XWORD(PS$,VCNT+1,126)
         TCNT = XWORDS(T$,44)
         VMEN$(VCNT,0) = STR$(TCNT)
         IF TCNT = 1 AND XWORDLENGTH(XWORD(T$,1,44),1,44) = 1 THEN
           VMEN$(VCNT,0) = STR$(0)
           ITERATE
         END IF
         MLEN = 0
'/*      --- Get Vertical Menu Data ---
         FOR CNT = 1 TO TCNT
           VMEN$(VCNT,CNT) = " " + XWORD(T$,CNT,44)
           VROW(VCNT,CNT) = HROW(VCNT)+CNT+1
           VCOL(VCNT,CNT) = HCOL(VCNT)
           S = INSTR(1,VMEN$(VCNT,CNT),"@")
           IF S > 0 THEN HCHAR$(VCNT,CNT) = UCASE$(MID$(VMEN$(VCNT,CNT),S+1,1)) ELSE HCHAR$(VCNT,CNT) = ""
           IF LEN(VMEN$(VCNT,CNT)) > MLEN THEN MLEN = LEN(VMEN$(VCNT,CNT))
         NEXT CNT
'/*      --- Set VMENU Length ---
         VLEN(VCNT) = MLEN +1
'/*      --- Does VMENU Location Extends Beyond Screen? ---
         ADJVCOL = 0
         IF MLEN + VCOL(VCNT,CNT-1) > LEN(MS$) THEN
           ADJVCOL = LEN(MS$) - MLEN -1
         END IF
'/*      --- Does VMENU Start Before Screen? ---
         IF (VCOL(VCNT,CNT-1)-1) < 1 THEN
           ADJVCOL = 2
         END IF
'/*      --- Make Each Menu Item the Same Length ---
         FOR CNT = 1 TO TCNT
           IF ADJVCOL > 0 THEN VCOL(VCNT,CNT) = ADJVCOL
           IF VMEN$(VCNT,CNT) = " -" THEN
             VMEN$(VCNT,CNT) = STRING$(MLEN-1,CHR$(196))
           ELSE
             VMEN$(VCNT,CNT) = SUBSTR(VMEN$(VCNT,CNT),1,MLEN+1," ")
           END IF
         NEXT CNT
       NEXT VCNT
     END IF
'/*  --- Display Horizontal Menu --------------------------------------
     IF PTR = 0 OR PTR > ITEMCNT THEN PTR = 1
     SAY ROW,COL,STRING$(LEN(MS$)," "),ATTR
     FOR CNT = 1 TO ITEMCNT
       SAYJ HROW(CNT),HCOL(CNT),HMEN$(CNT),ATTR,HATTR
     NEXT CNT
     HCOL(CNT) = LEN(MS$)+4
'/*  --- Save Menu Bar Screen -----------------------------------------
     MSCREENB$ = GETWINDOW(ROW,1,ROW,80)
'/*  MSCREENB$ = GETSCREEN
     SAYJ HROW(PTR),HCOL(PTR),HMEN$(PTR),PATTR,PHATTR
'/*  --- Display Passed Vertical Menu? --------------------------------
     IF VPTR > 0 THEN GOSUB MENUDVERTICAL
'/*--- Display and Exit Only? -----------------------------------------
     IF INSTR(1,RKEY$,"DISPLAY") > 0 THEN MENUEEXITSUB
'/*--- Main Loop ------------------------------------------------------
     DO
       MLB = 0
       MRB = 0
       MENUHJ0:
       HPTR = PTR
       HVPTR = VPTR
       MENUHJ1:
'/*    --- Selection Made? ---
       HPTR = PTR
       HVPTR = VPTR
'/*    --- Use Mouse if Flag is Set ---
       IF MF > 0 THEN
         MLB = 0
         MRB = 0
         MLOCATE MRROW,MRCOL
         MOUSEON
         WHILE NOT INSTAT
           MWHERE BUT,MRROW,MRCOL
           IF BUT > 0 THEN
             WHILE BUT <> 0
               DELAY .05
'/*              --- Menu Bar? ---
                 IF MRROW = HROW(PTR) THEN
'/*                --- Determine Item Position ---
                   FOR CNT = 1 TO ITEMCNT
                     IF MRCOL > HCOL(CNT)-1 AND MRCOL < HCOL(CNT)-2+LEN(HMEN$(CNT)) THEN
                       NPTR = CNT
                       EXIT FOR
                     END IF
                   NEXT CNT
'/*                --- Horizontal Pointer Changed? ---
                   IF NPTR <> PTR OR VMFLAG = 0 THEN
                     MOUSEOFF
                     IF VMFLAG > 0 THEN PUTWINDOW WH$
                     SAYJ HROW(PTR),HCOL(PTR),HMEN$(PTR),ATTR,HATTR
                     VPTR = 99
                     VMFLAG = 1
                     PTR = NPTR
                     SAYJ HROW(PTR),HCOL(PTR),HMEN$(PTR),PATTR,PHATTR
                     GOSUB MENUDVERTICAL
                     MOUSEON
                   END IF
'/*              --- Vertical Menu ---
                 ELSE
'/*                --- Determine VITEM Position ---
                   FOR CNT = 1 TO VITEMCNT
                     IF MRROW = VROW(PTR,CNT) THEN
                       NVPTR = CNT
                       EXIT FOR
                     END IF
                   NEXT CNT
'/*                --- Vertical Position Changed? ---
                   IF MRCOL > VCOL(PTR,NVPTR)-1 AND MRCOL < VCOL(PTR,CNT)+LEN(VMEN$(PTR,NVPTR)) THEN
                     IF NVPTR <> VPTR AND CNT <= VITEMCNT AND LEFT$(VMEN$(PTR,NVPTR),1) <> "Ä" THEN
                       MOUSEOFF
                       SAYJ VROW(PTR,VPTR),VCOL(PTR,VPTR)+1,VMEN$(PTR,VPTR),ATTR,HATTR
                       VPTR = NVPTR
                       SAYJ VROW(PTR,VPTR),VCOL(PTR,VPTR)+1,VMEN$(PTR,VPTR),PATTR,PHATTR
                       MOUSEON
                     END IF
                   END IF
                 END IF
               MWHERE BUT,MRROW,MRCOL
             WEND
'/*          --- Mouse Button Released ---
             Y$ = ""
             IF MRROW = HROW(PTR) AND INSTR(1,HMEN$(PTR),"@") < 1 THEN Y$ = CHR$(13)
             IF MRROW = VROW(PTR,VPTR) AND MRCOL => VCOL(PTR,VPTR)-1 AND MRCOL <= VCOL(PTR,VPTR)+LEN(VMEN$(PTR,VPTR)) THEN Y$ = CHR$(13)
             IF MRROW = HROW(PTR) AND INSTR(1,HMEN$(PTR),"#") > 0 THEN Y$ = ""
             IF Y$ = CHR$(13) THEN EXIT LOOP
           END IF
         WEND
         MOUSEOFF
       END IF
'/*    --- Key Waiting? -----------------------------------------------
       IF INSTAT THEN Y$ = INKEY$
'/*    IF Y$ = "+" OR Y$ = "-" THEN
'/*      IF Y$ = "-" THEN DECR ATTR
'/*      IF Y$ = "+" THEN INCR ATTR
'/*      IF ATTR < 1 THEN ATTR = 255
'/*      IF ATTR > 255 THEN ATTR = 1
'/*      HKATTR = 0
'/*      GOTO SPECJUMP
'/*    END IF
       MENUHJ2:
'/*    --- Up/Down Arrow Key? -----------------------------------------
       IF INSTR(1,AK$,Y$) > 0 THEN
         IF VMFLAG > 0 AND INSTR(1,VK$,Y$) > 0 AND VMEN$(PTR,0) <> " 0" THEN
           SAYJ VROW(PTR,VPTR),VCOL(PTR,VPTR)+1,VMEN$(PTR,VPTR),ATTR,HATTR
           IF Y$ = CHR$(0,72) THEN
             DECR VPTR        :'/* Up Arrow
             IF LEFT$(VMEN$(PTR,VPTR),1) = CHR$(196) THEN DECR VPTR
           END IF
           IF Y$ = CHR$(0,80) THEN
             INCR VPTR        :'/* Dn Arrow
             IF LEFT$(VMEN$(PTR,VPTR),1) = CHR$(196) THEN INCR VPTR
           END IF
           IF VPTR < 1 THEN VPTR = 1
           IF VPTR > VITEMCNT THEN VPTR = VITEMCNT
           SAYJ VROW(PTR,VPTR),VCOL(PTR,VPTR)+1,VMEN$(PTR,VPTR),PATTR,PHATTR
         END IF
'/*    --- Left/Right Arrow Key ?--------------------------------------
         IF Y$ = CHR$(0,75) OR Y$ = CHR$(0,77) THEN
           MENUHJ5:
           IF VMFLAG > 0 THEN PUTWINDOW WH$
           SAYJ HROW(PTR),HCOL(PTR),HMEN$(PTR),ATTR,HATTR
           VPTR = 1
           IF Y$ = CHR$(0,75) THEN DECR PTR         :'/* Lt Arrow
           IF Y$ = CHR$(0,77) THEN INCR PTR         :'/* Rt Arrow
           IF PTR < 1 THEN PTR = ITEMCNT
           IF PTR > ITEMCNT THEN PTR = 1
           SAYJ HROW(PTR),HCOL(PTR),HMEN$(PTR),PATTR,PHATTR
           IF VMFLAG > 0 THEN GOSUB MENUDVERTICAL
         END IF
         GOTO MENUHJ0
       END IF
'/*    --- Valid ALT Key Pressed? -------------------------------------
       IF LEN(Y$) > 1 THEN
         T = ASCII(Y$,2)
         T$ = MID$(ALTK$,T,1)
         FOR CNT = 1 TO ITEMCNT
           T = VAL(VMEN$(CNT,0))
           FOR TVCNT = 0 TO T
             IF TVCNT = 0 AND T$ = HCHAR$(CNT,TVCNT) THEN
               PTR = CNT-1
               Y$ = CHR$(0,77)
               VMFLAG = 1
               PUTWINDOW MSCREENB$
               IF WH$ = "" THEN WH$ = MSCREENB$
               GOTO MENUHJ5:
             END IF
             IF TVCNT > 0 AND T$ = HCHAR$(CNT,TVCNT) THEN
               PTR = CNT
               VPTR = TVCNT
               GOTO MENUHEEXIT
             END IF
           NEXT TVCNT
         NEXT CNT
       END IF
'/*    --- Enter Key Selecting Menu Bar Item? ------------------------
       IF Y$ = CHR$(13) AND VMFLAG = 0 THEN
         IF INSTR(1,HMEN$(PTR),"#") > 0 THEN GOTO MENUHJ0
         IF VAL(VMEN$(PTR,0)) = 0 THEN GOTO MENUHEEXIT
         GOSUB MENUDVERTICAL
         GOTO MENUHJ0
       END IF
'/*    --- ENTER Key Selecting and Vertical Menu Item? ---
       IF Y$ = CHR$(13) AND VMFLAG > 0 THEN
         IF INSTR(1,VMEN$(PTR,VPTR),"#") > 0 THEN GOTO MENUHJ0
         GOTO MENUHEEXIT
       END IF
       IF Y$ = CHR$(13) THEN GOTO MENUHEEXIT
'/*    --- ESC Key Deselecting Vertical Menu? ------------------------
       IF Y$ = CHR$(27) AND VMFLAG = 1 THEN
'/*      PUTSCREEN MSCREENB$
         PUTWINDOW WH$
         SAYJ HROW(PTR),HCOL(PTR),HMEN$(PTR),PATTR,PHATTR
         VMFLAG = 0
         VPTR = 0
         GOTO MENUHJ0
       END IF
       IF Y$ = CHR$(27) AND INSTR(1,RKEY$,"NOESC") < 1 THEN
         VPTR = 0
         PTR = 0
         GOTO MENUHEEXIT
       END IF
'/*    ---------------------------------------------------------------
       MENUHJ3:
       IF HPTR <> PTR THEN
         GOTO MENUHJ0
       END IF
       S = INSTR(1,RKEY$,Y$)
       IF S = 0 THEN GOTO MENUHJ1
     LOOP UNTIL S > 0
     MENUHEEXIT:
'/*  PUTSCREEN MSCREEN$
     RKEY$ = Y$
     GOTO MENUEEXITSUB
'/*  --- Display Vertical Menu Items ----------------------------------
     MENUDVERTICAL:
       IF VMEN$(PTR,0) = " 0" THEN RETURN
       VMFLAG = 1
       VITEMCNT = VAL(VMEN$(PTR,0))
       WH$ = GETWINDOW(HROW(PTR)+1,VCOL(PTR,1)-1,HROW(PTR)+VITEMCNT+3,VCOL(PTR,1)+VLEN(PTR)+2)
'/*    TH$ = REATTR(HROW(PTR)+1,VCOL(PTR,1)+1,HROW(PTR)+VITEMCNT+3,VCOL(PTR,1)+VLEN(PTR)+2,7)
       TBOX HROW(PTR)+1,VCOL(PTR,1)-1,VITEMCNT+2,VLEN(PTR)+2,ATTR,1,1
       FOR CNT = 1 TO VITEMCNT
         IF MID$(VMEN$(PTR,CNT),2,1) = CHR$(196) THEN
           SAY VROW(PTR,CNT),VCOL(PTR,CNT)-1,CHR$(195)+VMEN$(PTR,CNT)+CHR$(196,196,180),ATTR
           ITERATE
         END IF
         IF (VPTR > 0 AND CNT = VPTR) OR (VPTR = 0 AND CNT = 1) THEN
           IF VPTR < 99 THEN SAYJ VROW(PTR,CNT),VCOL(PTR,CNT)+1,VMEN$(PTR,CNT),PATTR,PHATTR
           IF VPTR > VITEMCNT THEN VPTR = 0
           IF VPTR = 0 THEN VPTR = 1
         ELSE
           SAYJ VROW(PTR,CNT),VCOL(PTR,CNT)+1,VMEN$(PTR,CNT),ATTR,HATTR
         END IF
       NEXT CNT
     RETURN
'/*-------------------------------------------------------------------
     MENUEEXITSUB:
     IF VMEN$(PTR,0) = " 0" THEN VPTR = 0
   END SUB
'/*------------------------------------------------------------------*/
   SUB SAYJ(ROW,COL,S$,ATTR,HATTR)
     H$ = REMOVE$(S$,"@")
     T = INSTR(1,S$,"@")
     L = INSTR(1,S$,"#")
'/*  --- Marker NOT Present ---
     IF T = 0 AND L = 0 THEN
       SAY ROW,COL-1,S$,ATTR
       EXIT SUB
     END IF
'/*  --- Highlite Marker Present ---
     IF T > 0 THEN
       SAY ROW,COL-1,H$+" ",ATTR
       SAY ROW,COL+T-2,MID$(H$,T,1),HATTR
       EXIT SUB
     END IF
'/*  --- Dim Marker Present ---
     IF L > 0 THEN
       H$ = REMOVE$(S$,"#")
       GETFB ATTR,FC,BC
       SAY ROW,COL-1,H$+" ",MKTATTR(8,BC)
     END IF
   END SUB
'/*------------------------------------------------------------------*/
'  $INCLUDE "C:\CODE\MLIB\MLIB.INC"
'  ROW = 1
'  COL = 1
'  ATTR = 0
'  HKATTR = 0
'  MTYPE = 0
'  PTR = 1
'  PATTR = 32
'  RKEY$ = "NOESC"
'  MF = 1
'  VPTR = 0
'/*T$ = SUBSTR("   @File     @Edit     @Help",1,80," ")
'  T$ = "@File        @Edit    NOTME   #MEEITHER                                    @Help"
'  T$ = T$ + "~@New,@Open,@Save,S@ave as ...,-,@Print,Print to Disk,E@xit"
'  T$ = T$ + "~Cu@t,#Paste,-,@Search,@Replace"
'  T$ = T$ + "~ ~ "
'  T$ = T$ + "~@Information,@About"
'  SAY 1,1,STRING$(2000,178),15
'  MENU ROW,COL,T$,ATTR,HKATTR,PATTR,PTR,VPTR,RKEY$,MF
'  SAY 25,1,"PTR ="+STR$(PTR)+" VPTR ="+STR$(VPTR),12
'  Y$ = GETKEY
'/*------------------------------------------------------------------*/