!  Menu routines
!
!  a True BASIC(tm), Inc. product
!
!  ABSTRACT
!     Library of portable menu routines
!     for use in user programs.
!
!  Copyright (c) 1985 by True BASIC, Inc.

EXTERNAL

SUB menu_set(where$,c$,maxent,maxlen,menu$,#9)

    ! Where$: top, bottom, left, or right
    ! C$ : color choice
    ! maxent: maximum items in menu 
    ! Maxlen: maximum length of menu item
    ! Menu$: for internal use
    ! #9 window

    ! Compute parameters

    LET w$ = lcase$(where$)       ! Screen position
    IF w$="left" or w$="right" then LET vert = 1      ! Vertical window
    LET m = min(maxent,10)        ! Max entries
    LET ml = min(maxlen,10)       ! Max length
    LET fill = 3                  ! Button, spaces
    LET zone = ml + fill          ! Zonewidth
    LET chars = 70                ! Chars per line

    IF vert = 0 then              ! Horizontal window
       IF m>5 then LET lines=3 else LET lines=1
    END IF

    ! Pack them

    LET menu$ = ""
    CALL packb(menu$,1,1,large)
    CALL packb(menu$,2,1,vert)
    CALL packb(menu$,3,1,extra)
    CALL packb(menu$,4,1,inverse)
    CALL packb(menu$,5,4,m)
    CALL packb(menu$,9,4,ml)
    CALL packb(menu$,13,4,perline)

    ! Open window

    IF vert = 1 then              ! Vertical window
       LET lines = 2*m
       LET y1 = (20-lines)/20
       LET y2 = 1
       LET width = max(zone,12)/chars
       IF where$ = "left" then
          LET x1 = 0
          LET x2 = width
       ELSE
          LET x1 = 1 - width
          LET x2 = 1
       END IF
       OPEN #9: screen x1,x2,y1,y2
       SET window 0,5,20*y1,20
    ELSE                          ! Horizontal window
       LET x1 = 0
       LET x2 = 1
       IF m<=5 then LET width = .1 else LET width = .2
       IF where$ = "top" then
          LET y1 = .95 - width
          LET y2 = .95
       ELSE
          LET y1 = 0
          LET y2 = width
       END IF
       OPEN #9: screen x1,x2,y1,y2
       IF m>5 then LET ym=0 else LET ym=1.75
       SET window 0,25,ym,3
    END IF

    SET color c$
    CLEAR

END SUB

SUB menu_show(M$(),m1,menu$,#9)

    WINDOW #9
    LET large = unpackb(menu$,1,1)
    LET vert = unpackb(menu$,2,1)
    LET extra = unpackb(menu$,3,1)
    LET inverse = unpackb(menu$,4,1)
    LET m = unpackb(menu$,5,4)
    LET m = min(m1,m)
    LET ml = unpackb(menu$,9,4)
    LET perline = unpackb(menu$,13,4)

    IF vert=0 then
       FOR i = 1 to m
           LET x$ = using$("############",m$(i))
           IF i<=5 then
              DRAW button(x$) with shift(5*i-4.75,2)
           ELSE
              DRAW button(x$) with shift(5*i-29.75,.25)
           END IF
       NEXT i
    ELSE
       FOR i = 1 to m
           LET x$ = using$("############",m$(i))
           DRAW button(x$) with shift(.25,20.5-2*i)
       NEXT i
    END IF

END SUB

PICTURE button(s$)
    PLOT .25,1;4.25,1;4.5,.75;4.5,.25;
    PLOT 4.25,0;.25,0;0,.25;0,.75;.25,1
    PLOT TEXT, at .25,.25: s$
END PICTURE

SUB menu_ask(m1,z,menu$,#9)

    LET ml = unpackb(menu$,5,4)
    LET m = min(m1,ml)
    LET vert = unpackb(menu$,2,1)
    WINDOW #9

    DO                            ! Force right answer
       DO
          GET MOUSE x,y,s
       LOOP until s=2
       IF vert=0 then
          LET v = int(x/5)+1
          IF y>=1.75 and y<=3 then
             LET z = v
          ELSEIF y<1.75 then
             LET z = v+5
          ELSE
             LET z = 0
          END IF
       ELSE
          LET v = int(19.5 - y)
          IF mod(v,2)=1 then
             LET z=0
          ELSE
             LET z = v/2 + 1
          END IF
       END IF
       IF z<1 or z>m then LET z = 0
    LOOP until z>0
    CALL blink(z,vert)

    SUB blink(i,v)
        IF v=0 then
           IF i<=5 then
              LET x1 = 5*i-4.5
              LET x2 = 5*i-.5
              LET y1 = 2.1
              LET y2 = 2.9
           ELSE
              LET x1 = 5*i-29.5
              LET x2 = 5*i-25.5
              LET y1 = .35
              LET y2 = 1.15
           END IF
        ELSE
           LET x1 = .5
           LET x2 = 4.5
           LET y1 = 20.5 - 2*i + .1
           LET y2 = y1 + .8
        END IF
        BOX KEEP x1,x2,y1,y2 in k$
        BOX CLEAR x1,x2,y1,y2
        PAUSE .2
        BOX SHOW k$ at x1,y1
    END SUB

END SUB

SUB menu(M$(),m,a,menu$,#9)       ! Show menu, get answer

    CALL menu_show(M$,m,menu$,#9)
    CALL menu_ask(m,a,menu$,#9)
    CLEAR

END SUB

SUB menu_all(M$(),m,prompt$,ans,menu$,#1,#9)

    WINDOW #1
    PRINT prompt$; "? ";
    CALL menu(M$,m,ans,menu$,#9)
    WINDOW #1
    PRINT M$(ans)

END SUB