home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / l / l074 / 1.ddi / MENULIB.TRU < prev    next >
Encoding:
Text File  |  1985-01-09  |  4.6 KB  |  195 lines
  1. !  Menu routines
  2. !
  3. !  a True BASIC(tm), Inc. product
  4. !
  5. !  ABSTRACT
  6. !     Library of general purpose menu routines
  7. !     for use in user programs.
  8. !
  9. !  Copyright (c) 1985 by True BASIC, Inc.
  10.  
  11. EXTERNAL
  12.  
  13. sub menu_set(where$,c$,maxent,maxlen,menu$,#9)   ! Parameters, window
  14.  
  15. ! Where$: top, bottom, left, or right
  16. ! C$ : color choice
  17. ! maxent: maximum items in menu 
  18. ! Maxlen: maximum length of menu item
  19. ! Menu$: for internal use
  20. ! #9 window
  21.  
  22. ! Compute parameters
  23.  
  24. ask mode x$
  25. if x$="GRAPHICS" or x$="HIRES" then let graph = 1    ! Graphic mode
  26. if x$="40" or x$="80" then let inverse = 1           ! Inverse video
  27. if x$="40" or x$="BW40" or x$="GRAPHICS" then let large=1  ! Large chars
  28. let w$ = lcase$(where$)                              ! Screen position
  29. if w$="left" or w$="right" then let vert = 1         ! Vertical window
  30. let m = min(maxent,10)              ! Max entries
  31. let ml = min(maxlen,10)             ! Max length
  32. let fill = 5 - large - 2*vert       ! Digit, spaces
  33. let zone = ml + fill                ! Zonewidth
  34. let chars = 80 - 40*large           ! Chars per line
  35.  
  36. if vert = 0 then                    ! Horizontal window
  37.    let perline = int(chars/zone)    ! Items per line
  38.    if perline<3 then
  39.       let zone = zone - 1
  40.       let perline = 3
  41.    end if
  42.    call divide(m,perline,q,r)       ! No. of lines
  43.    if inverse=1 then let lines = 2*q+1 else let lines = q+1
  44.    if chars-r*zone < 12 then let extra = 1   ! Error on extra line
  45.    let lines = lines + extra
  46. end if
  47.  
  48. ! Pack them
  49.  
  50. let menu$ = ""
  51. call packb(menu$,1,1,large)
  52. call packb(menu$,2,1,vert)
  53. call packb(menu$,3,1,extra)
  54. call packb(menu$,4,1,inverse)
  55. call packb(menu$,5,4,m)
  56. call packb(menu$,9,4,ml)
  57. call packb(menu$,13,4,perline)
  58.  
  59. ! Open window
  60.  
  61. if vert = 1 then              ! Vertical window
  62.    let lines = 2*m + 2
  63.    let y1 = (25-lines)/25
  64.    let y2 = 1
  65.    let width = max(zone,12)/chars
  66.    if where$ = "left" then
  67.       let x1 = 0
  68.       let x2 = width
  69.    else
  70.       let x1 = 1 - width
  71.       let x2 = 1
  72.    end if
  73. else                          ! Horizontal window
  74.    let x1 = 0
  75.    let x2 = 1
  76.    let width = lines/25
  77.    if where$ = "top" then
  78.       let y1 = 1 - width
  79.       let y2 = 1
  80.    else
  81.       let y1 = 0
  82.       let y2 = width
  83.    end if
  84. end if
  85. open #9: screen x1,x2,y1,y2
  86. if vert=0 then set zonewidth zone
  87.  
  88. ! Colors
  89.  
  90. set color c$
  91. let p = pos(c$,"/")
  92. if p=0 then
  93.    if graph=1 then set back b else set back 0
  94. else
  95.    clear
  96. end if
  97.  
  98. end sub
  99.  
  100. sub menu_show(M$(),m1,menu$,#9)
  101.  
  102. window #9
  103. let large = unpackb(menu$,1,1)
  104. let vert = unpackb(menu$,2,1)
  105. let extra = unpackb(menu$,3,1)
  106. let inverse = unpackb(menu$,4,1)
  107. let m = unpackb(menu$,5,4)
  108. let m = min(m1,m)
  109. let ml = unpackb(menu$,9,4)
  110. let perline = unpackb(menu$,13,4)
  111. set cursor 1,1
  112.  
  113. if inverse=1 then                 ! Inverse video
  114.    ask color c
  115.    ask back b
  116.    set color b
  117.    set back c
  118. end if
  119.  
  120. def show$(i,l)
  121.     let sss$ = str$(i)
  122.     if l=1 then
  123.        if i<10 then let sss$ = sss$ & " "
  124.     else
  125.        if i<10 then let sss$ = " " & sss$
  126.        let sss$ = sss$ & " "
  127.     end if
  128.     let show$ = sss$
  129. end def
  130.  
  131. if vert=1 then                    ! Vertical window
  132.    for i = 1 to m
  133.        print show$(i,large);
  134.        print M$(i)[1:ml]
  135.        print
  136.    next i
  137. else                              ! Horizontal window
  138.    let f$ = repeat$("#",ml)       ! Format
  139.    for i = 1 to m
  140.        let x$ = using$(f$,M$(i)[1:ml])
  141.        if large=0 then print " ";
  142.        print show$(i,large);
  143.        if mod(i,perline)=0 then
  144.           print x$
  145.           if inverse=1 and i<m then print    ! Inv. video double spaced
  146.        else
  147.           print x$,
  148.        end if
  149.    next i
  150.    if extra=1 and mod(m,perline)<>0 then print       ! Error needs new line
  151. end if
  152.  
  153. if inverse=1 then
  154.    set color c
  155.    set back b
  156. end if
  157.  
  158. end sub
  159.  
  160. sub menu_ask(m1,a,menu$,#9)     ! Get response
  161.  
  162.     window #9
  163.     ask cursor x,y        ! Get response
  164.     let m = min(m1,unpackb(menu$,5,4))    ! Cf maxent
  165.     do                    ! Force legal response
  166.         get key a
  167.         let a = a-314     ! f-key
  168.         if a<1 or a>m then
  169.            set cursor x,y
  170.            print "Push f1-f"; str$(m);
  171.         else
  172.            exit do
  173.         end if
  174.     loop
  175.  
  176. end sub
  177.  
  178. sub menu(M$(),m,a,menu$,#9)       ! Display menu, get response
  179.  
  180.     call menu_show(M$,m,menu$,#9)
  181.     call menu_ask(m,a,menu$,#9)
  182.     clear
  183.  
  184. end sub
  185.  
  186. sub menu_all(M$(),m,prompt$,ans,menu$,#1,#9)   ! Do everything
  187.  
  188.     window #1
  189.     print prompt$; "? ";
  190.     call menu(M$,m,ans,menu$,#9)
  191.     window #1
  192.     print M$(ans)
  193.  
  194. end sub
  195.