$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 SUB MCLICKED(Rgt%,Lft%,Row%,Col%)
   DECLARE SUB SAY(BYVAL Row AS INTEGER, BYVAL Col AS INTEGER, BYVAL Text AS STRING, BYVAL Attr AS INTEGER)
   DECLARE SUB BWINDOW(Title$,Toprow%,Leftcolumn%,Bottomrow%,Rightcolumn%,Attr%,Shadow%,Border%)
   DECLARE SUB PUTSCREEN(BYVAL X AS STRING)
   DECLARE FUNCTION GETSCREEN() AS STRING
   DECLARE FUNCTION PROGNAME() AS STRING
   DECLARE FUNCTION CENTER(BYVAL X AS STRING, BYVAL L AS INTEGER, BYVAL PAD AS STRING) AS STRING
   DECLARE SUB SATTR(BYVAL XN AS INTEGER)
   DECLARE SUB PSPLIT(BYVAL Source AS STRING, Fldrive AS STRING, Flpath AS STRING, Flname AS STRING, SPEC AS STRING, E AS STRING)
   DECLARE SUB MOUSEOFF()
   DECLARE SUB MOUSEON()
   DECLARE SUB MLOCATE(BYVAL ROW,BYVAL COL)
   DECLARE FUNCTION ISMOUSELBR()
   DECLARE FUNCTION ISMOUSERBR()
   DECLARE FUNCTION TRIML(Strng$,Amount%) AS STRING
   DECLARE FUNCTION EXIST(BYVAL Filename AS STRING) AS INTEGER
'/*--------------------------------------------------------------------
$CODE SEG "MLIB3"
'/*--------------------------------------------------------------------
FUNCTION SMENU(TOPROW%,LEFTCOLUMN%,CHOICES$(),INFOLINE$(),ROPT%,DMOUSE%,WINSIZE%,TAG%,HOTKEY%,HELPTEXTCOLOR%,HIATTR%,ATTR%,SHADOW%,BORDER%,ST%) PUBLIC AS STRING
PSPLIT PROGNAME, DRV$, Home$, EXEName$, FS$, FE$
IF WINSIZE% < 1 THEN WINSIZE% = 1
i% = 0                                      'loop counter
j% = 0                                      'loop compare
Maxlength% = 0                              'string length counter

IF DMOUSE% THEN MOUSEOFF

DO

INCR i%
INCR j%                                 'first find out how many
                                        'strings there are and the
IF LEN (Choices$(i%)) = 0 THEN          'length of the longest one
  DECR i%
ELSE
  IF LEN(REMOVE$(Choices$(i%),"@")) > Maxlength% THEN
    Maxlength% = LEN(REMOVE$(Choices$(i%),"@"))
  END IF
END IF

LOOP WHILE i% = j%

Count% = i%
Rtrn$ = ""
INCR Maxlength%                'add a space
LessThanWinsize% = 0           'initialize to zero

FOR i% = 1 TO Count%
  Choices$(i%) = " " + Choices$(i%)
NEXT i%

IF Count% <= Winsize% - 1 THEN
  LessThanWinsize% = 1
END IF

IF LessThanWinsize% THEN      'we need to transfer Count% to Finish%
  Finish% = Count%
  ScrollDBAR% = 0
ELSE                          'fixed size scrolling box
  Finish% = Winsize%
  ScrollDBAR% = Count% \ (Winsize% - 2)
END IF


IF TopRow% = 0 THEN                            'do they want it centred
  LeftColumn% = 40 - ((Maxlength% + 2) \ 2)
  RightColumn% = LeftColumn% + (Maxlength% + 2)
  TopRow% = (25 - Finish% ) \ 2
  BottomRow% = TopRow% + (Finish% + 1)
ELSE
  RightColumn% = LeftColumn% + (Maxlength% + 2)
  BottomRow% = TopRow% + (Finish% + 1)
END IF
S2MENUScreen$ = GETSCREEN
SMENURESTARTPOINT:
BWINDOW Title$,TopRow%,LeftColumn%,BottomRow%,RightColumn%,Attr%,Shadow%,Border%

IF DMOUSE% THEN
  Test% = LEN(Title$)
  IF Test% THEN
  END IF
END IF

Pointer% = 1                      'initialize all these
Start% = 1
SelectionMade% = 0

DO

PrintRoutine:

IF DMOUSE% THEN MOUSEOFF
DBAR% = 0
Row% = TopRow% + 1
Col% = LeftColumn% + 1

FOR a% = Start% TO Finish%
  IF a% = Pointer% THEN
    Fixedup$ = REMOVE$(Choices$(a%),"@")
    SAY Row%,Col%,Fixedup$ + SPACE$(Maxlength% - LEN(Fixedup$) + 1),HiAttr%
    IF LEN(Infoline$(a%)) THEN
      InfoLinePrinted% = 1
      SAY 25,1,CENTER(Infoline$(a%),80," "),HELPTEXTCOLOR
    END IF
  ELSE
    IF INSTR(Choices$(a%),"@") > 0 THEN
      HotKeyPos% = INSTR(Choices$(a%),"@")
      Fixedup$ = REMOVE$(Choices$(a%),"@")
      Front$ = LEFT$(Fixedup$,(HotKeyPos% - 1))
      HotKey$ = MID$(Fixedup$,(HotKeyPos%),1)
      Back$ = RIGHT$(Fixedup$,LEN(Fixedup$) - HotKeyPos%)
      SAY Row%,Col%,Front$,Attr%
      SAY Row%,Col%+1,HotKey$,HotKey%
      SAY Row%,Col%+2,Back$ + SPACE$(Maxlength% - LEN(Fixedup$) + 1),Attr%
    ELSE
      SAY Row%,Col%,Choices$(a%) + SPACE$(Maxlength% - LEN(Choices$(a%)) + 1),Attr%
    END IF
  END IF

  IF ScrollDBAR% THEN
    IF a% = Start% THEN
    ELSEIF a% = Finish% THEN
    ELSE
      IF DBAR% = 0 THEN
        c% = Pointer%
        FOR i% = 1 TO ScrollDBAR%
          b% = c% \ ScrollDBAR%
          IF a% = b% + Start% THEN
            DBAR% = 1
            EXIT FOR
          ELSE
            INCR c%
          END IF
        NEXT i%
        IF DBAR% THEN
      SAY Row%,RightColumn%,CHR$(219),Attr%
        ELSE
          IF DBAR% = 0 AND a% = Finish% - 1 THEN
      SAY Row%,RightColumn%,CHR$(219),Attr%
          ELSE
      SAY Row%,RightColumn%,CHR$(176),Attr%
          END IF
        END IF
      ELSE
      SAY Row%,RightColumn%,CHR$(176),Attr%
      END IF
    END IF
  END IF
  INCR Row%
NEXT a%

WHILE NOT INSTAT
  IF DMOUSE% THEN
    IF SaveDMOUSE% THEN MLOCATE MouseRow%,MCol%
    Rgt% = 0:Lft% = 0:MRow% = 0:MCol% = 0:SaveDMOUSE% = 0
    MOUSEON
    MCLICKED Rgt%,Lft%,MRow%,MCol%
    IF MRow% >= TopRow% AND MRow% =< BottomRow% AND MCol% >= LeftColumn% AND MCol% =< RightColumn% THEN
      IF MRow% > TopRow% AND MRow% < BottomRow% AND MCol% > LeftColumn% AND MCol% < RightColumn% THEN
        MOUSEOFF
        IF ISMOUSERBR THEN
          IF Tag% THEN
            Chose% = 32: GOTO KeyBoardRoutine
          END IF
        ELSEIF ISMOUSELBR THEN
          Chose% = 13: GOTO KeyBoardRoutine
        END IF
        IF LessThanWinsize% THEN
          Pointer% = MRow% - TopRow%
          GOTO PrintRoutine
        ELSE
          Offset% = MRow% - (TopRow% + 1)
          Pointer% = Start% + Offset%
          GOTO PrintRoutine
        END IF
      ELSE
        SELECT CASE MRow%
          CASE TopRow%
            IF MCol% = LeftColumn% THEN
              IF ISMOUSELBR THEN          'Cancel Box bottom
                Chose% = 27: GOTO KeyBoardRoutine
              END IF
            END IF
'/*       CASE TopRow%
'/*         IF MCol% = RightColumn% THEN
              IF ISMOUSELBR THEN
                Chose% = -73: GOTO KeyBoardRoutine
              END IF
'/*         END IF
          CASE BottomRow%
'/*         IF MCol% = RightColumn% THEN
              IF ISMOUSELBR THEN
                Chose% = -81: GOTO KeyBoardRoutine
              END IF
'/*         END IF
'/*       CASE BottomRow%
'/*         SELECT CASE MCol%
'/*           CASE LeftColumn% + 2
'/*             IF ISMOUSELBR% THEN          'Cancel Box bottom
'/*               Chose% = 27: GOTO KeyBoardRoutine
'/*             END IF
'/*         END SELECT
        END SELECT
      END IF
'   ELSE
'     IF ISMOUSELBR% THEN
'       Chose% = 27: GOTO KeyBoardRoutine
'     END IF
    END IF
  END IF
WEND

Ky$ = INKEY$

IF LEN(Ky$) = 1 THEN
  Chose% = ASC(Ky$)
ELSE
  Chose% = -ASC(RIGHT$(Ky$,1))
END IF

KeyBoardRoutine:

IF DMOUSE% THEN
  IF MRow% > TopRow% AND MRow% < BottomRow% AND _
    MCol% > LeftColumn% AND MCol% < RightColumn% THEN
    SaveDMOUSE% = 1
    MLOCATE 1,1
  END IF
END IF

SELECT CASE Chose%
        CASE 13                          'enter key, exit and pass the
          SelectionMade% = 1             'selection to Rtrn$
          IF Tag% THEN
            IF LEN(Rtrn$) THEN
              Rtrn$ = Rtrn$
            ELSE
              IF ROPT% = 0 THEN Rtrn$ = REMOVE$(LTRIM$(Choices$(Pointer%)),"@") ELSE Rtrn$ = STR$(Pointer%)
            END IF
          ELSE
            IF ROPT% = 0 THEN Rtrn$ = REMOVE$(LTRIM$(Choices$(Pointer%)),"@") ELSE Rtrn$ = STR$(Pointer%)
          END IF
        CASE 27                          'Esc key, just exit routine
          SelectionMade% = 1
          Rtrn$ = "-27"
        CASE 32
          IF Tag% THEN
            IF INSTR(Choices$(Pointer%),CHR$(Tag%)) THEN
              IF ROPT% = 0 THEN Rtrn$ = REMOVE$(Rtrn$,REMOVE$(Choices$(Pointer%),"@")) ELSE Rtrn$ = STR$(Pointer%)
              Choices$(Pointer%) = " " + LTRIM$(Choices$(Pointer%),CHR$(Tag%))
            ELSE
              Choices$(Pointer%) = CHR$(Tag%) + TRIML(Choices$(Pointer%),1)
              IF ROPT% = 0 THEN Rtrn$ = Rtrn$ + REMOVE$(Choices$(Pointer%),"@") ELSE Rtrn$ = Rtrn$ + STR$(Pointer%)
            END IF
            IF LessThanWinsize% THEN     'it's not a scrolling box
              IF Pointer% < Finish% THEN
                INCR Pointer%
              ELSE
                Pointer% = Start%
              END IF
            ELSE                              'it's a scrolling box
              IF Pointer% < Finish% THEN
                INCR Pointer%
              ELSEIF Finish% < Count% THEN    'check to see if we have
                INCR Pointer%                 'any more choices waiting
                INCR Start%
                INCR Finish%
              END IF
            END IF
          END IF
        CASE 48 TO 57,65 TO 90,97 TO 122
            FOR m% = 1 TO Count%
              IF INSTR(Choices$(m%),"@") > 0 THEN
                HotKeyPos% = INSTR(Choices$(m%),"@")
                HotKey$ = UCASE$(MID$(Choices$(m%),(HotKeyPos% + 1),1))
                TestKey$ = UCASE$(CHR$(Chose%))
                IF HotKey$ = TestKey$ THEN
                  IF Tag% THEN
                    Pointer% = m%
                    IF LessThanWinsize% = 0 THEN
                      IF Pointer% + Winsize% <= Count% THEN
                        Finish% = Pointer% + (Winsize% - 1)
                        Start% = Finish% - (Winsize% - 1)
                      ELSE
                        Finish% = Count%
                        Start% = Finish% - (Winsize% - 1)
                      END IF
                    END IF
                    EXIT FOR
                  ELSE
                    IF ROPT% = 0 THEN Rtrn$ = REMOVE$(LTRIM$(Choices$(m%)),"@") ELSE Rtrn$ = STR$(m%)
                    SelectionMade% = 1
                    EXIT FOR
                  END IF
                END IF
              END IF
            NEXT m%
            IF ST% = 1 THEN
              IF ROPT% = 0 THEN Rtrn$ = REMOVE$(LTRIM$(Choices$(m%)),"@") ELSE Rtrn$ = STR$(m%)
              SelectionMade% = 1
            END IF
        CASE -71  'home key
          Pointer% = Start%
        CASE -72  'up arrow
          IF LessThanWinsize% THEN    'it's not a scrolling box
            IF Pointer% > Start% THEN
              DECR Pointer%
            ELSE
              Pointer% = Finish%
            END IF
          ELSE                            'it's a scrolling box
            IF Pointer% > Start% THEN
              DECR Pointer%
            ELSEIF Start% > 1 THEN
              DECR Pointer%
              DECR Start%
              DECR Finish%
            END IF
          END IF
        CASE -59  ' F1 Help key
          IF LEN(REMOVE$(Choices$(Pointer%),ANY "@ ")) > 8 THEN
            FileName$ = LEFT$(UCASE$(REMOVE$(Choices$(Pointer%),ANY "@ ")),8) + ".HLP"
          ELSE
            FileName$ = UCASE$(REMOVE$(Choices$(Pointer%),ANY "@ ")) + ".HLP"
          END IF
          T$ = Home$+FileName$
          T = EXIST(T$)
          IF T > 0 THEN
            PUTSCREEN S2MENUScreen$
'/*         t$ = BROWSEF(HelpTextColor%,Home$+FileName$,7,1,18,78,"",HelpTextColor%,1,0)
            PUTSCREEN S2MENUScreen$
            GOTO SMENURESTARTPOINT
          END IF
        CASE -73  'page up
          IF Start% - (Winsize% - 1) >= 1 THEN    'this block handles the
            DECR Start%,(Winsize% - 1)            'pageing
            DECR Pointer%,(Winsize% - 1)
            DECR Finish%,(Winsize% - 1)
          ELSE
            Pointer% = 1
            Start% = 1
            IF LessThanWinsize% THEN    'if we jump back to Start% make
              Finish% = Count%              'sure we check to see what kind
            ELSE                            'of scroll box and set Finish%
              Finish% = Winsize%            'accordingly
            END IF
          END IF
        CASE -79  'end key
          Pointer% = Finish%
        CASE -80  'down arrow
          IF LessThanWinsize% THEN    'it's not a scrolling box
            IF Pointer% < Finish% THEN
              INCR Pointer%
            ELSE
              Pointer% = Start%
            END IF
          ELSE                            'it's a scrolling box
            IF Pointer% < Finish% THEN
              INCR Pointer%
            ELSEIF Finish% < Count% THEN    'check to see if we have
              INCR Pointer%                 'any more choices waiting
              INCR Start%
              INCR Finish%
            END IF
          END IF
        CASE -81  'page down
          IF Finish% + (Winsize% - 1) <= Count% THEN    'this block handles
            INCR Start%,(Winsize% - 1)                  'the pageing
            INCR Finish%,(Winsize% - 1)
            INCR Pointer%,(Winsize% - 1)
          ELSE
            Pointer% = Count%
            Finish% = Count%
            IF LessThanWinsize% THEN       'if we jump to Finish% make
              Start% = 1                       'sure we check to see what
            ELSE                               'kind of scroll box and set
              Start% = Count% - (Winsize% - 1) 'Start% accordingly
            END IF
          END IF
        CASE -118  'Ctrl PgDown
          IF Finish < Count% THEN                   'routine as a scroll
            Start% = (Count% - (Winsize% - 1))      'box, and not a pick
            Finish% = Count%                        'list we handle
            Pointer% = Count%
          END IF
        CASE -132  'Ctrl PgUp
          IF Start% > 1 THEN
            Start% = 1
            Finish% = (Start% + (Winsize% - 1))
            Pointer% = Start%
          END IF
        CASE ELSE
          BEEP
END SELECT

LOOP UNTIL SelectionMade%

FOR i% = 1 TO Count%
  IF INSTR(Choices$(i%),CHR$(Tag%)) THEN
    Choices$(i%) = LTRIM$(Choices$(i%),CHR$(Tag%)) 'remove tag char
  ELSE
    Choices$(i%) = LTRIM$(Choices$(i%))            'remove the space
  END IF
NEXT i%

IF SaveDMOUSE% THEN MLOCATE MouseRow%,MCol%

IF DMOUSE% THEN MOUSEOFF

IF InfoLinePrinted% = 1 THEN
  SAY 25,15,SPACE$(50),Attr%
END IF

PUTSCREEN S2MENUScreen$
FUNCTION = Rtrn$
END FUNCTION
'/*-------------------------------------------------------------------
'  $INCLUDE "C:\CODE\MLIB\MLIB.INC"
'  DIM MN$(20)
'  DIM Info$(20)
'  DMouse% = 1
'  MN$(1) = "@Open"
'  MN$(2) = "@Create"
'  MN$(3) = "@List"
'  MN$(4) = "@DBROWSE"
'  MN$(5) = "@Add"
'  MN$(6) = "@Delete"
'  MN$(7) = "E@xtract"
'  MN$(8) = "@Print"
'  MN$(9) = "@Kill"
'  MN$(10) = "@Erase"
'  MN$(11) = "@Quit"
'  MN$(12) = "@12it"
'  MN$(13) = "@13it"
'  MN$(14) = "@14it"
'  MN$(15) = "@15it"
'  MN$(16) = "@16it"
'
'  Info$(1) = "Open a PowerBASIC Library for modification"
'  Info$(2) = "Create a PowerBASIC Library"
'  Info$(3) = "List the OBJ's or PBU modules in a Library"
'  Info$(4) = "DBROWSE the current List/Map File"
'  Info$(5) = "Add OBJ's or PBU modules to a Library"
'  Info$(6) = "Delete OBJ's or PBU modules from Library"
'  Info$(7) = "Extract OBJ's or PBU modules"
'  Info$(8) = "Print the currently selected library Map File"
'  Info$(9) = "Delete a PowerBASIC Library File from Disk"
'  Info$(10) = "Erase OBJ's or PBU modules from work Directory"
'  Info$(11) = "Quit the DNA Library Manager"
'
'/*FUNCTION S2MENU(CHOICES$(),INF(),R%,M%,WZ%,T%,C%,HOTKEY%,HELPTEXTCOLOR%,HIATTR%,ATTR%,TOPROW%,LEFTCOLUMN%,SHADOW%,BORDER%) PUBLIC AS STRING
'  Rtrn$ = SMENU(0,0,MN$(),Info$(),0,DMouse%,8,1,20,31,32,31,1,1,0)
'  PRINT Rtrn$
'  Y$ = GETKEY
'  IF LEN(Rtrn$) THEN
'    Mess$(1) = "You Picked > " + Rtrn$ + " <"
'    Mess$(2) = ""
'    MBOX Mess$(),"",0,DMouse%,1,0,0,112,1,1
'  END IF