// Use WebMenu.nui

// Status: possible to specify sub menus, but not to render them

Use Base.nui     // Item_Property command, Various macros (FOR_EX...), cArray, cSet and cStack classes (No User Interface)
Use WebAppXhtmlBuilder.nui // Global procedures for writing XHTML

      class WebMenuData is a cArray
        procedure construct_object
          forward send construct_object
          property integer piLevel public 0
        end_procedure
        item_property_list
          item_property integer piItemType.i // 0=menu item, 1=spacer, 2=sub menu
          item_property string  psLabel.i
          item_property string  psLink.i
          item_property integer phSubMenu.i  // Handle to another object of our own kind (cWA1P_Menu)
          item_property string  psModule.i
          item_property string  psPage.i
          item_property integer phPage.i     // If we're dealing with a module/page type link, the handle for the WebPage object will automatically be stored in here. This in turn will make sure that the menu item isn't written if the bAvailable function of the object returns FALSE.
          item_property string  psToolTip.i
          item_property string  psUrlParams.i // If we need more URL parameters than m(odule) and p(age), put them here
        end_item_property_list WebMenuData

        function bAvailable.i integer liRow returns integer // WebMenuData, WebMenu
          integer lbRval lhPage
          get phPage.i liRow to lhPage

          if (lhPage=0 and psPage.i(self,liRow)<>"") begin // If the menu item is module/page: try to obtain an object that we can ask if it's available to the the current user
            get WafPageObject (psModule.i(self,liRow)) (psPage.i(self,liRow)) to lhPage
            set phPage.i liRow to lhPage
          end

          if lhPage get bAvailable of lhPage to lbRval
          else move TRUE to lbRval

          function_return lbRval
        end_function

        procedure priv.reset
          integer liRow liMax lhObj
          get row_count to liMax
          decrement liMax
          for liRow from 0 to liMax
            get phSubMenu.i liRow to lhObj
            if lhObj begin
              send priv.reset of lhObj
              send destroy of lhObj
            end
          loop
          send delete_data
        end_procedure
      end_class // WebMenuData

class WebMenu is a WebMenuData
  procedure construct_object
    forward send construct_object
    object oStack is a cStack
    end_object
    property integer phMenu public self
    set piLevel to 0
  end_procedure

  procedure DoReset
    send priv.reset
    send delete_data of oStack
    set phMenu to self
  end_procedure

  procedure AddItem string lsValue string lsModule string lsPage string lsUrlParams
    integer liRow lhMenu
    string lsLink
    get phMenu to lhMenu
    get row_count of lhMenu to liRow
    set piItemType.i  of lhMenu liRow to 0
    get WafPageLink lsModule lsPage to lsLink
    set psLabel.i     of lhMenu liRow to lsValue
    set psLink.i      of lhMenu liRow to lsLink
    set psModule.i    of lhMenu liRow to lsModule
    set psPage.i      of lhMenu liRow to lsPage
    set psUrlParams.i of lhMenu liRow to lsUrlParams
  end_procedure

  procedure AddToolTip string lsValue
    integer lhMenu liRow
    get phMenu to lhMenu
    get row_count of lhMenu to liRow
    set psToolTip.i of lhMenu (liRow-1) to lsValue
  end_procedure

  procedure AddItem_ExtLink string lsValue string lsLink
    integer liRow lhMenu
    get phMenu to lhMenu
    get row_count of lhMenu to liRow
    set piItemType.i of lhMenu liRow to 0
    set psLabel.i    of lhMenu liRow to lsValue
    set psLink.i     of lhMenu liRow to lsLink
  end_procedure

  procedure AddSpacer string lsName
    integer liRow lhMenu
    get phMenu to lhMenu
    get row_count of lhMenu to liRow
    set piItemType.i of lhMenu liRow to 1
    set psLabel.i    of lhMenu liRow to lsName
  end_procedure

  procedure BeginSubMenu string lsValue
    integer liRow lhMenu liLevel lhSubMenu
    get piLevel to liLevel

    get phMenu to lhMenu
    get row_count of lhMenu to liRow
    set piItemType.i of lhMenu liRow to 2
    set psLabel.i    of lhMenu liRow to lsValue

    object oSubMenu is a WebMenuData
      move self to lhSubMenu
      set piLevel to (liLevel+1)
    end_object
    set phSubMenu.i of lhMenu liRow to lhSubMenu
    send push.i of oStack lhMenu
    set phMenu to lhSubMenu
  end_procedure

  procedure EndSubMenu
    set phMenu to (iPop(oStack(self)))
  end_procedure
end_class // WebMenu

enumeration_list
  define MS_NONE
  define MS_VERTICAL
  define MS_HORIZONTAL
end_enumeration_list

class WebMenuWriter is a cArray
  procedure construct_object
    forward send construct_object
    property integer piMenuStyle public 0
    property string  psMenuClass        public ""                     //ÂÄIf these are set all the others are ignored
    property string  psMenuItemClass    public ""                     //Ù

    property string  psBackgroundColor  public ""                     // Color of menu itself
    property string  psBackgroundImage  public ""                     // If this is set psBackgroundColor is ignored
    property string  psMenuHeight       public "300px"                // Set this to give the menu a fixed height. Otherwise it will adapt the number of items in it
    property string  psMenuPadding      public "2px"                  // Sets the padding of the menu itself
    property string  psMenuMargin       public "2px"                  // Sets the margin of the menu itself

    property string  psButtonFaceColor  public "#999999"              // Color of buttons
    property string  psButtonFaceImage  public ""                     // If this is set psButtonFaceColor is ignored
    property string  psButtonTextColor  public "white"                // This is used as the color attribute of the font element (makes it overrule the link colors)
    property string  psButtonFontFamily public ""                     // Sets the font used for menu items
    property string  psButtonFontSize   public ""                     // Sets the font size used for menu items
    property string  psButtonFontWeight public "bold"                 // Sets the font weight used for menu items
    property string  psButtonPadding    public "5px"                  // Sets the padding of each menu item
    property string  psButtonMargin     public "3px"                  // Sets the margin of each menu item
    property string  psButtonTextAlign  public "center"               // Sets the text alignment of the menu item texts

    property string  psSpacerClass      public ""                     // It this is set the psSpacerHeight is ignored
    property string  psSpacerHeight     public "8px"                  // Specifies the height of a spacer item
  end_procedure

  procedure DoWriteHTML integer lhMenu
    integer liRow liMax lbFirst lbAvailable lbHorizontal
    string lsLink lsToolTip lsParams

    if (piMenuStyle(self)<>MS_NONE) begin
      send XHTML_StartXhtml
      send XHTML_Add_Open_Element "div" // The menu itself

      move (piMenuStyle(self)=MS_HORIZONTAL) to lbHorizontal

      if (psMenuClass(self)<>"") send XHTML_Add_Attribute "class" (psMenuClass(self)) // If a class is indicated, write that
      else begin // Else do some manual settings
        if (psMenuHeight(self)<>"")      set CSS_Property_Value CSSPS_DIMEN_HEIGHT to (psMenuHeight(self))
        if (psMenuPadding(self)<>"")     set CSS_Property_Value CSSPS_PADDING      to (psMenuPadding(self))
        if (psMenuMargin(self)<>"")      set CSS_Property_Value CSSPS_MARGIN       to (psMenuMargin(self))
        if (psButtonTextAlign(self)<>"") set CSS_Property_Value CSSPS_TEXT_ALIGN   to (psButtonTextAlign(self))
        if (psBackgroundImage(self)<>"") begin
          set CSS_Property_Value CSSPS_BACKGROUND_IMAGE to (psBackgroundImage(self))
        end
        else begin
          if (psBackgroundColor(self)<>"") ;
            set CSS_Property_Value CSSPS_BACKGROUND_COLOR to (psBackgroundColor(self))
        end
        send XHTML_Add_Attribute_Css_Style
      end

      get row_count of lhMenu to liMax
      decrement liMax
      for liRow from 0 to liMax
        get psToolTip.i of lhMenu liRow to lsToolTip
        get bAvailable.i of lhMenu liRow to lbAvailable
        get psUrlParams.i of lhMenu liRow to lsParams

        if lbAvailable begin

          if (piItemType.i(lhMenu,liRow)=0) begin // A menu item

            if lbHorizontal send XHTML_Add_Open_Element "span"
            else            send XHTML_Add_Open_Element "div"

            if (psMenuItemClass(self)<>"") send XHTML_Add_Attribute "class" (psMenuItemClass(self))

            else begin
              if (psButtonPadding(self)<>"") set CSS_Property_Value CSSPS_PADDING to (psButtonPadding(self))
              if (psButtonMargin(self)<>"")  set CSS_Property_Value CSSPS_MARGIN  to (psButtonMargin(self))
              if (psButtonFaceImage(self)<>"") begin
                set CSS_Property_Value CSSPS_BACKGROUND_IMAGE to (psButtonFaceImage(self))
              end
              else begin
                if (psButtonFaceColor(self)<>"") ;
                  set CSS_Property_Value CSSPS_BACKGROUND_COLOR to (psButtonFaceColor(self))
              end
              send XHTML_Add_Attribute_Css_Style
            end

            if (psMenuItemClass(self)<>"") begin
              send XHTML_Add_Closed_Element "a" (psLabel.i(lhMenu,liRow))
              send XHTML_Add_Attribute "href" (psLink.i(lhMenu,liRow)+lsParams)
              send XHTML_Add_Attribute "style" "text-decoration:none"
              if (lsToolTip<>"") send XHTML_Add_Attribute "title" lsToolTip
            end
            else begin
              send XHTML_Add_Open_Element "a"
              send XHTML_Add_Attribute "href" (psLink.i(lhMenu,liRow)+lsParams)
              send XHTML_Add_Attribute "style" "text-decoration:none"
              if (lsToolTip<>"") send XHTML_Add_Attribute "title" lsToolTip

              //send XHTML_Add_Closed_Element "font" (psLabel.i(lhMenu,liRow))
              send XHTML_Add_Closed_Element "span" (psLabel.i(lhMenu,liRow))

              //if (psButtonTextColor(self)) send XHTML_Add_Attribute "color" (psButtonTextColor(self))
              if (psButtonTextColor(self))      set CSS_Property_Value CSSPS_TEXT_COLOR to (psButtonTextColor(self))
              if (psButtonFontSize(self)<>"")   set CSS_Property_Value CSSPS_FONT_SIZE to (psButtonFontSize(self))

              if (psButtonFontFamily(self)<>"") set CSS_Property_Value CSSPS_FONT_FAMILY to (psButtonFontFamily(self))
              if (psButtonFontWeight(self)<>"") set CSS_Property_Value CSSPS_FONT_WEIGHT to (psButtonFontWeight(self))

              set CSS_Property_Value CSSPS_TEXT_DECORATION to "none"

              send XHTML_Add_Attribute_Css_Style
              send XHTML_Close_Element //a
            end

            send XHTML_Close_Element //div
          end
          if (piItemType.i(lhMenu,liRow)=1) begin // A spacer
            send XHTML_Add_Open_Element "div"
            if (psSpacerClass(self)<>"") send XHTML_Add_Attribute "class" (psSpacerClass(self))
            else begin
              if (psSpacerHeight(self)<>"") begin
                if lbHorizontal set CSS_Property_Value CSSPS_DIMEN_WIDTH to (psSpacerHeight(self))
                else            set CSS_Property_Value CSSPS_DIMEN_HEIGHT to (psSpacerHeight(self))
                send XHTML_Add_Attribute_Css_Style
              end
            end
            send XHTML_Close_Element //div
          end
        end // lbAvailable
      loop
      send XHTML_Close_Element //div
      send XHTML_EndXhtml
    end
  end_procedure
end_class // WebMenuWriter

object WebQuickMenu is a WebMenu
end_object
object oWebMenuStandardWriter is a WebMenuWriter
end_object

procedure WebQuickMenu_Reset global
  send DoReset of WebQuickMenu
end_procedure
procedure WebQuickMenu_AddLinkInt global string lsValue string lsModule string lsPage string lsParams
  send AddItem of WebQuickMenu lsValue lsModule lsPage lsParams
end_procedure
procedure WebQuickMenu_AddLinkExt global string lsValue string lsLink
  send AddItem_ExtLink of WebQuickMenu lsValue lsLink
end_procedure
procedure WebQuickMenu_AddSpacer global //string lsValue string lsLink
  send AddSpacer of WebQuickMenu ""
end_procedure
procedure WebQuickMenu_WriteHtml global integer liMenuStyle
  integer lhMenu
  move WebQuickMenu to lhMenu
  set piMenuStyle of oWebMenuStandardWriter to liMenuStyle
  send DoWriteHTML of oWebMenuStandardWriter lhMenu
end_procedure