PROGRAM SubMenuDemo

?   Use of submenus in F-Basic, by C. Vassallo, 1992.
?   After Robert D'Asto, Amazing Computing, Vol4, No1, pps.77-88
?   Note that the D'Asto's paper contains an incorrect size for
?   MenuItem structures and an incorrect procedure to release the memory

TYPE MenuItem IS RECORD
  PTR_TO INTEGER Next
  WORD           Left,Top,Width,Height,Flags
  INTEGER        MutualExclude,Text,SelectFill
  WORD           Cmd,S1,S2,NextSelect          
ENDTYPE

TYPE IntuiText IS RECORD
  WORD           Pens,Draw,Left,Top
  INTEGER        Font
  PTR_TO TEXT    Text,NextText
ENDTYPE
  

GLOBAL
  INTEGER ExecPtr,IntuiPtr

LOCAL
  INTEGER i,j,SUBITEM_NUMBER,exit
  TEXT*12 Str1(6),Str2(6),Str3(6),SubStr1(6),SubStr2(6),SubStr3(6)
  TEXT*1 aa

SUBPROGRAM
  INTEGER SubMenu
  SUBROUTINE FreeSubMenu

  DATA (Str1,"Menu 1","Item 1","Item 2","Item 3","Exit")
  DATA (Str2,"Menu 2","Item 1","Item 2","Item 3","Item 4")
  DATA (Str3,"Menu 3","Item 1","Item 2","Item 3","Item 4")
  DATA (SubStr1,"SubItem 1","SubItem 2","SubItem 3","SubItem 4")
  DATA (SubStr2,"SubItem 1","SubItem 2")
  DATA (SubStr3,"SubItem 1","SubItem 2","SubItem 3","SubItem 4","SubItem 5")

  IntuiPtr=OPENLIB("intuition.library",0)
  ExecPtr=OPENLIB("exec.library",0)

&SYSLIB 1

  i=SCREEN #1(0,256,2,2,0)
  j=WINDOW #1(0,0,640,256,50,50,640,256,1,2,16,@"SubMenus",1)

  j=AvailMem(ExecPtr,2)
  PRINT "Chip memory before setting submenus : ",AvailMem(ExecPtr,2)

  i=MENU #1(@Str1,4)  
  i=MENU #2(@Str2,4) 
  i=MENU #3(@Str3,4)
  MENU_ON     ; ? must be set before setting the submenus 

  i=SubMenu(1,2,@SubStr1,12,4)
  i=SubMenu(1,3,@SubStr2,12,2)
  i=SubMenu(3,1,@SubStr3,12,5)

  ON MENU_SELECT EVENT
    i=$(24+ #(WINDOW_INFO(2)+94))          ; ? i=Menu number 
    SUBITEM_NUMBER=1+((i/2048) AND 1F'16)
    CURS_LOC (20,1)
    PRINT "menu=",MENU_NUMBER[3],"   item=",ITEM_NUMBER[3],"   subitem=",SUBITEM_NUMBER[3]
    IF MENU_NUMBER=1 AND ITEM_NUMBER=4 THEN exit=1   
  END EVENT  

  exit=0
  WHILE exit=0 DO
    SLEEP
  ENDWHILE

  
  FreeSubMenu(1,2,@SubStr1,12,4)  
  FreeSubMenu(1,3,@SubStr2,12,2)
  FreeSubMenu(3,1,@SubStr3,12,5)


  PRINT "Chip memory after freeing submenus  : ",AvailMem(ExecPtr,2)
  PRINT "Hit a key to exit"
  i=CLOSELIB(IntuiPtr)
  aa=INCHAR()
  MENU_CLOSE
  WINDOW_CLOSE #1
  SCREEN_CLOSE #1

END

? --------------------------------------------------------
? The function SubMenu takes 5 input parameters: menu, item (both counted
?  from 1), address of the first subitem name, the length declared for 
?  these names, and the number of subitems. All the names are copied into
?  a (TextLength)x(SubItemNumber)-bit long chip string which is linked with
?  the first IntuiText structure in the first (sub) MenuItem structure. 

? A zero is returned in case of failure (unlikely, only if you are too short
? of chip memory)

FUNCTION SubMenu

PARAMETER
  INTEGER Menu,MenuItem
  PTR_TO TEXT SubItemText
  INTEGER TextLength,SubItemNumber

LOCAL
  INTEGER i,j,opt
  PTR_TO TEXT text0,t0,t1
  PTR_TO MenuItem m0,m1
  PTR_TO IntuiText it0
  PTR_TO INTEGER AddrMenu,AddrSubMenu

&SYSLIB 1

  opt=2'16+10000'16 ; SubMenu=0

  ? Creates a chip area to store the subitem name array and includes
  ? the CHAR(0)

  i=TextLength*SubItemNumber 
  text0=ALLOCATE_WITH(i,opt)
  IF text0=0 THEN RETURN
  t0=text0
  t1=SubItemText
  FOR i=1 TO SubItemNumber
    FOR j=1 TO TextLength
      ^t0+ = ^t1  ; INC(t1)
    NEXT
    ^(t0-1)=0 
  NEXT

  ? General loop : creation of linked MenuItem and IntuiText structures

  SubMenu=ALLOCATE_WITH(34,opt)
  m0=SubMenu

  FOR i=1 TO SubItemNumber
    m1=0
    IF i<>SubItemNumber THEN m1=ALLOCATE_WITH(34,opt)
    it0=ALLOCATE_WITH(24,opt)
    IF m0<>0 THEN
      m0.Next  =m1    
      m0.Left  =68
      m0.Top   =10*(i-1)  
      m0.Width =(TextLength-1)*8  
      m0.Height=10
      m0.Flags =2'16 + 10'16 + 40'16 +9     
      m0.Text  =it0
    ENDIF
    IF it0<>0 THEN
      it0.Pens =1
      it0.Text =text0
    ENDIF
    text0=text0+TextLength
    m0=m1
  NEXT

  ? Links the submenu to the menu item 

  AddrMenu=#(WINDOW_INFO(2)+28)
  i=F800'16+32*(MenuItem-1)+Menu-1
  AddrSubMenu=ItemAddress(IntuiPtr,AddrMenu,i)
  #(AddrSubMenu+28)=SubMenu 

END

? -----------------------------------
?  Frees memory occupied by submenus structure. Same arguments as
?  SubMenu function. The @SubItemText is useless, but I kept it because
?  it is simpler to copy the whole Submenu instruction and to edit it
?  into a FreeSubMenu instruction 

  SUBROUTINE FreeSubMenu

PARAMETER
  INTEGER Menu,MenuItem
  PTR_TO TEXT SubItemText
  INTEGER TextLength,SubItemNumber

LOCAL
  INTEGER i,j 
  PTR_TO TEXT text0 
  PTR_TO MenuItem m0,m1
  PTR_TO IntuiText it0
  PTR_TO INTEGER AddrMenu,AddrSubMenu

&SYSLIB 1

  ? Looks for the submenu address

  AddrMenu=#(WINDOW_INFO(2)+28)
  i=F800'16+32*(MenuItem-1)+Menu-1
  AddrSubMenu=ItemAddress(IntuiPtr,AddrMenu,i)
  m0=#(AddrSubMenu+28)
  it0=m0.Text
  text0=it0.Text

  IF text0<>0 THEN j=DEALLOCATE(TextLength*SubItemNumber,text0)
  FOR i=1 TO SubItemNumber
    m1=m0.Next
    it0=m0.Text
    IF m0<>0  THEN j=DEALLOCATE(34,m0)
    IF it0<>0 THEN j=DEALLOCATE(24,it0)
    m0=m1 
  NEXT
END