'##############################################################################
'##############################################################################
'Begin arrows.bas

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 ArrowHit(hitgad as Gadget ptr,junk as Gadget ptr) as integer
declare function ArrowHold(hitgad as Gadget ptr,holdgad as Gadget ptr) as integer
declare function ArrowRelease(hitgad as Gadget ptr,relgad as Gadget ptr) as integer


declare sub DrawArrow (gad as Gadget ptr)
declare sub DrawSmallArrow (gad as Gadget ptr)
'Steuerungsvariablen:
'Glist().Ca enthält einen Richtungsmarker 0=links,1=rechts,2=hoch,3=runter
'Glist().Cb 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
  dim as Gadget ptr tmpgad
  function=0
  tmpgad=new Gadget
  if tmpgad then
    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->event=event

    tmpgad->DoDraw     =@DrawArrow
    tmpgad->DoHit      =@ArrowHit
    tmpgad->DoHold     =@ArrowHold
    tmpgad->DoRelease  =@ArrowRelease

    tmpgad->Ca=d
		
		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
  dim as Gadget ptr tmpgad
  function=0
  tmpgad=new Gadget
  if tmpgad then
    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->event=event
    
    tmpgad->DoDraw     =@DrawSmallArrow
    tmpgad->DoHit      =@ArrowHit
    tmpgad->DoHold     =@ArrowHold
    tmpgad->DoRelease  =@ArrowRelease

    tmpgad->Ca=d
		
		SaveBackGround(tmpgad)
    event->ChainGadget (tmpgad)
    function=tmpgad
  end if
end function



function ArrowHit(hitgad as Gadget ptr,junk as Gadget ptr) as integer
  SetSelect (hitgad,1)
  function=-1
end function



function ArrowHold(hitgad as Gadget ptr,holdgad as Gadget ptr) as integer
  static as single tt
  function=0
  if hitgad=holdgad then
    if hitgad->Cb=2 and timer >= tt+.05 then
      tt=timer
      function=-1
    end if

    if hitgad->Cb=1 and timer >= tt+.8 then
      tt=timer
      hitgad->Cb=2
      function=-1
    end if

    if hitgad->Cb=0 then
      tt=timer
      hitgad->Cb=1
    end if
  end if
end function



function ArrowRelease(hitgad as Gadget ptr,holdgad as Gadget ptr) as integer
  hitgad->Cb=0
  SetSelect (hitgad,0)
  function=0
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->Ca

  screenlock
	if gad->act=0 then put(x,y),gad->BackGroundImage,pset

  if gad->act=1 then
    FrameB x, y, w, h,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
  end if

  if gad->act=2 then
    FrameB x, y, w, h,0
    FillA x+1,y+1,w-2,h-2,BackGroundColor,0
    if d=0 then Arrow x+5,y+3,4,d,ShiftRGB(BackGroundColor,-contrast\2)
    if d=1 then Arrow x+5,y+3,4,d,ShiftRGB(BackGroundColor,-contrast\2)
    if d=2 then Arrow x+3,y+5,4,d,ShiftRGB(BackGroundColor,-contrast\2)
    if d=3 then Arrow x+3,y+5,4,d,ShiftRGB(BackGroundColor,-contrast\2)
  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->Ca
  
  screenlock
	if gad->act=0 then put(x,y),gad->BackGroundImage,pset

  if gad->act=1 then
    FrameB x, y, w, h,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
  end if

  if gad->act=2 then
    FrameB x, y, w, h,0
    FillA x+1,y+1,w-2,h-2,BackGroundColor,0
    if d=0 then Arrow x+3,y+2,2,d,ShiftRGB(BackGroundColor,-contrast\2)
    if d=1 then Arrow x+3,y+2,2,d,ShiftRGB(BackGroundColor,-contrast\2)
    if d=2 then Arrow x+2,y+3,2,d,ShiftRGB(BackGroundColor,-contrast\2)
    if d=3 then Arrow x+2,y+3,2,d,ShiftRGB(BackGroundColor,-contrast\2)
  end if
  screenunlock
end sub

'End Arrows.bas
'##############################################################################
'##############################################################################
