'##############################################################################
'##############################################################################
'Begin Menu.bas
declare function Menu(event as EventHandle ptr,menuID as integer,entryID as integer,status as integer,mname as string="") as integer

declare function GetChecked (event as EventHandle ptr,menuID as integer,entryID as integer) as integer

declare sub CreateMissedHeaders(event as EventHandle ptr,menuID as integer)
declare sub CreateMissedItems(header as Menuheader ptr,itemID as integer)

declare function GetHeaderPointer(event as EventHandle ptr,ID as integer) as MenuHeader ptr
declare function GetItemPointer(header as MenuHeader ptr,ID as integer) as MenuItem ptr

declare sub RethinkHeaders(event as EventHandle ptr)
declare sub RethinkStrip(header as MenuHeader ptr)

declare sub ChainMenuItem (header as MenuHeader ptr,item as MenuItem ptr)

declare sub PullUpStrip(event as EventHandle ptr,header as MenuHeader ptr)
declare sub PullDownStrip(event as EventHandle ptr,header as MenuHeader ptr)

declare sub PullUpMenu (event as EventHandle ptr)

declare function MenuHeaderHit(hitheader as MenuHeader ptr) as integer
declare function MenuHeaderRelease(hitheader as MenuHeader ptr,relheader as MenuHeader ptr) as integer

declare sub MenuOn(event as EventHandle ptr)
declare sub MenuOff(event as EventHandle ptr)

declare sub DrawAllMenuHeaders(event as EventHandle ptr)
declare sub DrawAllMenuItems(header as MenuHeader ptr)

declare sub DrawMenuHeader (mh as MenuHeader ptr,hilite as integer)
declare sub DrawMenuItem (mi as MenuItem ptr, hilite as integer)


'***Header***
'Record         wo gesetzt
'---------------------------------
'event          Menu
'nextMenuHeader ChainMenuHeader(EventHandle Methode siehe in "sGUI.bas")
'act            Menu
'posx           RethinkHeaders
'headerw        Menu
'headerh        Menu
'text           Menu
'HeaderID       CreateMissedHeaders
'stripw         Menu(im Item Teil!!! ab "entryID>0")
'striph         RethinkStrip
'StripBuffer    zur Laufzeit von PullUpStrip / PullDownStrip benutzt
'firstMenuItem  ChainMenuItem
'lastMenuItem   ChainMenuItem
'PullUp         CreateMissedHeaders
'PullDown       CreateMissedHeaders
'DoDraw         CreateMissedHeaders


'***Item***
'Record         wo gesetzt
'---------------------------------
'event          Menu
'nextMenuItem   ChainMenuItem
'act            Menu
'hact           RethinkStrip
'itemtype       Menu
'posx           RethinkStrip
'posy           RethinkStrip
'itemw          RethinkStrip
'itemh          RethinkStrip
'text           Menu
'HeaderID       CreateMissedItems
'entryID        CreateMissedItems
'DoDraw         CreateMissedItems


'itemtypes:
'1 normaler Eintrag
'2 mit Häkchen
'4 Separator

function Menu (event as EventHandle ptr,menuID as integer,entryID as integer,status as integer,mname as string) as integer
  dim as MenuHeader ptr mh
  dim as MenuItem ptr mi
  dim as integer scrw,scrh,act,itemtype
  if menuID then

    CreateMissedHeaders(event,menuID) '"überprüft" und erzeugt, wenn nötig, nocht nicht vorhandene leere MenüHeader bis menuID

    if entryID=0 then'                                                <---MenüHeader erstellen oder bearbeiten
      mh=GetHeaderPointer(event,menuID)'Zeiger auf Header holen

      mh->event=event
      act=(status and 1)
      mh->act=act
      if mname<>"" then
        mh->headerw=(len(mname)+1)*8
      else
        mh->headerw=0
      end if
      mh->headerh=fontheight+4
      mh->text=mname
      RethinkHeaders(event) 'alle MenüHeaderpositionen neu berechnen
      if event->GetMenuStatus then DrawAllMenuHeaders(event)
      function=cast(integer,mh)
    else'                                                             <---MenüItem erstellen oder bearbeiten
      mh=GetHeaderPointer(event,menuID) 'Zeiger auf Header holen
      if (len(mname)+3)*8 > mh->stripw then mh->stripw=(len(mname)+3)*8
      CreateMissedItems(mh,entryID)'"überprüft" und erzeugt, wenn nötig, nocht nicht vorhandene leere MenüItems dieses MenüStrips bis zur angesprochenen entryID
      mi=GetItemPointer(mh,entryID)
      mi->event=event

      act=status and 1

      itemtype=1
      if (status and 2)=2 then itemtype=2
      if (status and 4)=4 then itemtype=4

      mi->act=act
      mi->itemtype=itemtype
      mi->text=mname

      if itemtype=4 then
        mi->act=0
        mi->text=""
      end if

      RethinkStrip(mh)
      function=cast(integer,mi)
    end if
  end if
end function



function GetChecked (event as EventHandle ptr,menuID as integer,entryID as integer) as integer
  function=0
  dim as MenuHeader ptr mh
  dim as MenuItem ptr mi
  if menuID then 
    mh=GetHeaderPointer(event,menuID)
    if mh then 
      mi=GetItemPointer(mh,entryID)
      if mi then
        if bit(mi->itemtype,1) then function=1'sollte 2.Bit gesetzt sein(Häkchen),dann gib 1 zurück
      end if
    end if
  end if
end function



sub CreateMissedHeaders(event as EventHandle ptr,menuID as integer)
  dim as integer lastmenuID
  dim as MenuHeader ptr tmpmh
  if menuID then                                'wenn angesprochene MenüID mindestens 1 ist dann
    if event->GetlastMenuHeader then               'und wenn schon ein MenüHeader existiert dann
      lastmenuID=event->GetlastMenuHeader->HeaderID'hole die letzte MenuID aus letztem Header
    else                                        'sollte noch kein Menü existieren dann
      lastmenuID=0                              'ist die letzte MenüID=0
    end if

    if menuID>lastmenuID then   'sollte die angeforderte MenüID grösser sein als die letzte existierende(lastmenuID) dann
      do                        'Schleife zum Erzeugen "leerer" MenüHeader bis zur gewünschten MenüID
        tmpmh=new MenuHeader                  'Erzeugen eines MenüHeaders
        if tmpmh then                         'wenn erfolgreich dann
          lastmenuID +=1                      'erhöhe die MenüID
          tmpmh->HeaderID =lastmenuID
          tmpmh->PullUp=@PullUpStrip
          tmpmh->PullDown=@PullDownStrip
          tmpmh->DoDraw=@DrawMenuHeader
          event->chainMenuHeader(tmpmh)
        end if
      loop until lastmenuID=menuID
    end if
  end if
end sub



sub CreateMissedItems(header as Menuheader ptr,itemID as integer)
  'das Verfahren für die Erzeugung der MenüItems ist vergleichbar mit dem in CreateMissedHeaders
  dim as MenuItem ptr tmpmi,lastitem
  dim as integer lastitemID
  if header->lastMenuItem then
    lastitemID=header->lastMenuItem->ItemID
  else
    lastitemID=0
  end if

  if itemID>lastitemID then
    do
      tmpmi=new MenuItem
      if tmpmi then
        lastitemID +=1
        tmpmi->HeaderID=header->HeaderID
        tmpmi->ItemID=lastitemID
        tmpmi->DoDraw=@DrawMenuItem
        chainMenuItem(header,tmpmi)
      end if
    loop until lastitemID=itemID
  end if
  header->striph=(fontheight+4)*lastItemID+2
end sub



'sucht nach einem Headerpointer auf Basis seiner ID
function GetHeaderPointer(event as EventHandle ptr,ID as integer) as MenuHeader ptr
  function=0
  dim as MenuHeader ptr header,found
  header=event->GetfirstMenuHeader
  if header then
    do
      if header->HeaderID=ID then found=header
      if found then exit do
      header=header->nextMenuHeader
    loop until header=0
    function=found
  end if
end function



'sucht nach einem Itempointer auf Basis seiner ID
function GetItemPointer(header as MenuHeader ptr,ID as integer) as MenuItem ptr
  function=0
  dim as MenuItem ptr item,found
  item=header->firstMenuItem
  if item then
    do
      if item->ItemID=ID then found=item
      if found then exit do
      item=item->nextMenuItem
    loop until item=0
    function=found
  end if
end function



'überdenkt die Position aller Header/Items neu, falls Veänderungen aufgetreten sind
sub RethinkHeaders(event as EventHandle ptr)
  dim as MenuHeader ptr mh
  dim as integer mhpos,mhw
  mh=event->GetfirstMenuHeader
  mhpos=16
  do
    mh->posx=mhpos        'Position in aktuellen Header schreiben
    mhpos +=mh->headerw   'neue Position berechnen für nachfolgenden Header(durch Aufaddieren der aktuellen Headerbreite)
    RethinkStrip(mh)      'den an diesem Header gekoppelten Strip neu überdenken
    mh=mh->nextMenuHeader 'nächsten Header holen
  loop until mh=0         'wenn keiner dann raus ausm Loop
end sub



'überdenkt die Position aller Items eines Headers neu, falls Veänderungen aufgetreten sind
sub RethinkStrip(header as MenuHeader ptr)
  dim as MenuItem ptr mi
  dim as integer miposy,mih,striph
  striph=0
  miposy=fontheight+5
  mi=header->firstMenuItem
  if mi then
    do
      if mi->itemtype=4 then mih=4 else mih=fontheight+4
      mi->hact=header->act
      mi->posx =header->posx+1
      mi->posy =miposy
      mi->itemw=header->stripw-2
      mi->itemh=mih
        miposy +=mih
        striph +=mih
      mi=mi->nextMenuItem
    loop until mi=0
    header->striph=striph+2
  end if
end sub



sub ChainMenuItem (header as MenuHeader ptr,item as MenuItem ptr)
  if header->firstMenuItem=0 then header->firstMenuItem=item
  if header->lastMenuItem then header->lastMenuItem->nextMenuItem=item'sich selbst als Nachfolger ins vorhergehende eintragen
  header->lastMenuItem=item                                           'sich selbst als letzten definieren
end sub



sub PullUpStrip(event as EventHandle ptr,header as MenuHeader ptr)
  if header->StripBuffer then
    put (header->posx,fontheight+4),header->StripBuffer,pset 'alten Hintergrund wieder herstellen
    imagedestroy header->StripBuffer                         'Image wieder freigeben
    header->StripBuffer=0                                    'zur Sicherheit auf Null setzen
  end if
end sub



sub PullDownStrip(event as EventHandle ptr,header as MenuHeader ptr)
  dim as MenuItem ptr mi
  dim as integer hilite,scrw,scrh,sx,sy,sw,sh
  screeninfo scrw,scrh
  mi=header->firstMenuItem
  if mi then
    sx=header->posx
    sy=fontheight+4
    sw=header->stripw
    sh=header->striph
    
    if sy+sh > scrh then sh=scrh-sy                                 'wenn unterer Striprand >Screenhöhe dann Image(Get) anpassen
    if sx<scrw then                                                 'wenn linker Striprand innerhalb des Screens
      if sx+sw>scrw then  sw=scrw-sx                                'wenn rechterStriprand >Screenbreite dann Image(Get) anpassen
      header->StripBuffer=imagecreate(sw,sh)                        'Image von der Grösse des Strips erzeugen
      get (sx,sy)-(sx+sw-1, sy+sh-1),header->StripBuffer            'den ursprünglichen Hintergrund sichern
      do
        mi->DoDraw(mi,hilite)                                       'Schleife alle Items zeichnen
        mi=mi->nextMenuitem
      loop until mi=0
      FrameStrip(header->posx,fontheight+4,header->stripw,header->striph,MenuColor) 'kleiner Rahmen um Strip
    end if
  end if
end sub



sub PullUpMenu (event as EventHandle ptr)
  event->PullUpMenu
end sub



sub MenuOn(event as EventHandle ptr)
  dim as integer scrw
  dim as integer ptr buffer
  screeninfo(scrw)
  buffer=imagecreate(scrw,fontheight+4)
  get (0,0)-(scrw-1,fontheight+3),buffer
  event->SetMenuBarBuffer(buffer)
  event->MenuSwitch(1)
  DrawAllMenuHeaders(event)
end sub



sub MenuOff(event as EventHandle ptr)
  dim as integer scrw
  dim as integer ptr buffer
  screeninfo(scrw)
  put (0,0),event->GetMenuBarBuffer,pset
  imagedestroy event->GetMenuBarBuffer
  event->SetMenuBarBuffer(0)
  event->MenuSwitch(0)
end sub




sub DrawAllMenuHeaders(event as EventHandle ptr)
  dim as integer scrw
  dim as MenuHeader ptr header
  screeninfo(scrw)
  BarA(0,0,scrw,fontheight+4,MenuColor)
  header=event->GetfirstMenuHeader
  if header then
    do
      header->DoDraw(header,0)
      header=header->nextMenuHeader
    loop until header=0
  end if
end sub



sub DrawMenuHeader (mh as MenuHeader ptr, hilite as integer)
  dim as integer mhx,mhw,mhh
  mhx=mh->posx
  mhw=mh->headerw
  mhh=mh->headerh
  if mhw>0 and mhh>0 then
    screenlock
    if mh->act then
      if hilite then
        FillA(mhx,1,mhw,mhh-2,MenuHiliteColor,1)
      else
        BarA(mhx,0,mhw,mhh,MenuColor)
      end if
      draw string(mhx+4,2),mh->text,MenuTextColor
    else
      BarA(mhx,0,mhw,mhh,MenuColor)
      draw string(mhx+4,2),mh->text,MenuGhostedColor
    end if
    screenunlock
  end if
end sub



sub DrawMenuItem (mi as MenuItem ptr, hilite as integer)
  dim as integer mix,miy,miw,mih,miact,hact,typ
  mix=mi->posx
  miy=mi->posy
  miw=mi->itemw
  mih=mi->itemh
  miact=mi->act
  hact=mi->hact
  typ=mi->itemtype

  if miw>0 and mih>0 then
    screenlock
    if miact=1 and hact=1 then
      if hilite then
        FillA(mix+1,miy+1,miw-2,mih-2,MenuHiliteColor,1)
      else
        ClearBox(mix,miy,miw,mih,MenuColor)
      end if
      if typ=2 then Tick (mix+4,miy+1+(fontheight-8)/2,MenuTextColor)

      draw string(mix+16,miy+2),mi->text,MenuTextColor

    else
      ClearBox(mix,miy,miw,mih,MenuColor)

      if typ=1 or typ=2 then draw string(mix+16,miy+2),mi->text,MenuGhostedColor

      if typ=2 then Tick (mix+4,miy+1+(fontheight-8)/2,MenuGhostedColor)

      if typ=4 then Separator (mix+20,miy+1,miw-24)
    end if

    screenunlock
  end if
end sub


'End Menu.bas
'##############################################################################
'##############################################################################
