declare function AddArrow (event as EventHandle ptr,x as integer,y as integer,d as integer) as Gadget ptr
declare function AddSmallArrow (event as EventHandle ptr,x as integer,y as integer,d as integer) as Gadget ptr
declare function ArrowActions(refgad as Gadget ptr,action as integer) as integer
declare sub DrawArrow (gad as Gadget ptr)
declare sub DrawSmallArrow (gad as Gadget ptr)

'Steuerungsvariablen:
'Ctrl(0) enthält einen Richtungsmarker 0=links,1=rechts,2=hoch,3=runter
'Ctrl(1) wird für die Zeitverzögerung des Triggerns benötigt
function AddArrow (event as EventHandle ptr,x as integer,y as integer,d as integer) as Gadget ptr
  function=0
  dim as Gadget ptr tmpgad
  tmpgad=new Gadget
  if tmpgad then
    tmpgad->event=event
    tmpgad->nextGadget=0
  	tmpgad->sel=0
    tmpgad->act=0
    tmpgad->posx=x
    tmpgad->posy=y
    if d=0 or d=1 then
      tmpgad->gadw=16
      tmpgad->gadh=15
    end if
    if d=2 or d=3 then
      tmpgad->gadw=15
      tmpgad->gadh=16
    end if

    tmpgad->Ctrl(0)=d

    tmpgad->DoDraw     =@DrawArrow
    tmpgad->DoAction   =@ArrowActions
    tmpgad->DoUpdate   =@DrawArrow

		SaveBackGround(tmpgad)
    event->ChainGadget (tmpgad)

		function=tmpgad
  end if
end function



function AddSmallArrow (event as EventHandle ptr,x as integer,y as integer,d as integer) as Gadget ptr
  function=0
  dim as Gadget ptr tmpgad
  tmpgad=new Gadget
  if tmpgad then
    tmpgad->event=event
    tmpgad->nextGadget=0
  	tmpgad->sel=0
    tmpgad->act=0
    tmpgad->posx=x
    tmpgad->posy=y
    if d=0 or d=1 then
      tmpgad->gadw=10
      tmpgad->gadh=9
    end if
    if d=2 or d=3 then
      tmpgad->gadw=9
      tmpgad->gadh=10
    end if

    tmpgad->Ctrl(0)=d

    tmpgad->DoDraw     =@DrawSmallArrow
    tmpgad->DoAction   =@ArrowActions

		SaveBackGround(tmpgad)
    event->ChainGadget (tmpgad)

		function=tmpgad
  end if
end function



function ArrowActions(refgad as Gadget ptr,action as integer) as integer
  function=0
  static as single tt

  select case action

      case GADGET_HIT        'Control grad frisch gedrückt
        SetSelect (refgad,1)
        function=1
      
      case GADGET_HOLD       'Control wird gehalten, Maus über dem Control
        if refgad->Ctrl(1)=2 and timer >= tt+.05 then
          tt=timer
          function=1
        end if

        if refgad->Ctrl(1)=1 and timer >= tt+.8 then
          tt=timer
          refgad->Ctrl(1)=2
          function=1
        end if

        if refgad->Ctrl(1)=0 then
          tt=timer
          refgad->Ctrl(1)=1
        end if
      case GADGET_HOLDOFF    'Control wird gehalten, Maus neben dem Control

      case GADGET_RELEASE,GADGET_RELEASEOFF    'Control regulär losgelassen/ Control losgelassen, dabei ist Maus neben dem Control
        refgad->Ctrl(1)=0
        SetSelect (refgad,0)

  end select
end function


sub DrawArrow (gad as Gadget ptr)
	dim as integer i,x,y,w,h,d,o
  x   =gad->posx
	y   =gad->posy
	w		=gad->gadw
	h		=gad->gadh
  d   =gad->Ctrl(0)

  screenlock
	if gad->act=0 then
    put(x,y),gad->Images(0),pset
  else
    FrameB x, y, w, h,1'gad->sel
    FillA x+1,y+1,w-2,h-2,GadgetColor,gad->sel
    if gad->sel then o=1 else o=0
    if d=0 then Arrow x+5-o,y+3,4,d,GadgetTextColor
    if d=1 then Arrow x+5+o,y+3,4,d,GadgetTextColor
    if d=2 then Arrow x+3,y+5-o,4,d,GadgetTextColor
    if d=3 then Arrow x+3,y+5+o,4,d,GadgetTextColor
    if gad->act=2 then put(x,y),gad->Images(0),alpha,SleepShade
  end if
  screenunlock
end sub



sub DrawSmallArrow (gad as Gadget ptr)
	dim as integer i,x,y,w,h,d,o
  x   =gad->posx
	y   =gad->posy
	w		=gad->gadw
	h		=gad->gadh
  d   =gad->Ctrl(0)

  screenlock
	if gad->act=0 then
    put(x,y),gad->Images(0),pset
  else
    FrameB x, y, w, h,1'gad->sel
    FillA x+1,y+1,w-2,h-2,GadgetColor,gad->sel
    if gad->sel then o=1 else o=0
    if d=0 then Arrow x+3-o,y+2,2,d,GadgetTextColor
    if d=1 then Arrow x+3+o,y+2,2,d,GadgetTextColor
    if d=2 then Arrow x+2,y+3-o,2,d,GadgetTextColor
    if d=3 then Arrow x+2,y+3+o,2,d,GadgetTextColor
    if gad->act=2 then put(x,y),gad->Images(0),alpha,SleepShade
  end if
  screenunlock
end sub
