//
  QFRestore ¯222,60®
#include "common.ch"
#include "Gra.ch"
#include "Xbp.ch"
#include "Appevent.ch"
#include "Font.ch"
#include "dll.ch"

#Define DefaultStartAngle 75

Class ColorWheel From XbpStatic
  Exported:
    Method Create
    Method Destroy
    Method Paint
    Method Motion
    Method lbClick

    Method LoadColorsFromBase
    Method DrawColorWheel
    Method NewBase

    Var aColors
    Var aBaseClr
    Var aBig
    Var nCurSlice
    Var bSliceChange
    Var bNewBase

  Hidden:
    Var xOldClr
    Var aCenter
    Var nRadius

EndClass

Method ColorWheel:Create(oParent,oOwner,aPos,aSize,aPresParam,lVisible)
  Local aTemp, oMomma

  oMomma := XbpStatic():New(oParent,oOwner,aPos,aSize,aPresParam,lVisible)
  oMomma:Type := XBPSTATIC_TYPE_RAISEDBOX
  oMomma:Create()

  aTemp := oMomma:CurrentSize()
  aTemp[1] -= 2
  aTemp[2] -= 2

  ::XbpStatic:Create(oMomma,,{1,1},aTemp)

  ::LoadColorsFromBase()

  ::XbpStatic:SetColorBG(GraMakeRGBColor({228,228,228}))

  ::aCenter := ::XbpStatic:CurrentSize()
  ::aCenter[1] := Int( ::aCenter[1] / 2 )
  ::aCenter[2] := Int( ::aCenter[2] / 2 )

  aTemp := ::XbpStatic:CurrentSize()
  ::nRadius := Int( ( Min(aTemp[1],aTemp[2]) - 40 ) / 2 )

  Default ::aBaseClr  to {255,0,0}
  Default ::aBig      to {1}
  Default ::nCurSlice to 0

  Return Self

Method ColorWheel:Destroy()

  aSize(::aBaseClr,0)
  aSize(::aCenter ,0)
  aSize(::aColors ,0)
  aSize(::aBig    ,0)

  ::aBaseClr := nil
  ::nRadius  := nil
  ::aColors  := nil
  ::aBig     := nil
  ::aCenter  := nil

  ::XbpStatic:Destroy()

  Return Self

Method ColorWheel:Paint(aRect)
  Local oPS

  If ValType(::aColors) == 'A'
    If Len(::aColors) == 12
      oPS := ::XbpStatic:LockPS()
      ::DrawColorWheel(oPS)
      oPS := ::XbpStatic:UnLockPS()
    EndIf
  EndIf

  Return Self

Method ColorWheel:NewBase(aColor)

  If ValType(aColor) == 'N'
    aColor := GraGetRGBIntensity(aColor)
  EndIf

  ::aBaseClr := aColor
  ::LoadColorsFromBase()
  ::XbpStatic:InvalidateRect()

  If !Empty(::bNewBase)
    Eval(::bNewBase,aColor)
  EndIf

  Return Self

Method ColorWheel:LoadColorsFromBase()
  Local aColor, i, aRet

  ::aColors := {}
  aColor  := RGBtoHSL(::aBaseClr)//**

  aEval(aColor,{|x,i| If(aColor[i]==NIL,aColor[i]:=0,nil)})

  aAdd(::aColors,HSLtoRGB(aColor))//**

  For i := 1 to 11
    aColor[1] += 30
    If aColor[1] >= 360
      aColor[1] -= 360
    EndIf
    aAdd(::aColors,HSLtoRGB(aColor))//**
  Next i

  aEval(::aColors,{|x,i| ::aColors[i,1] := Int(::aColors[i,1]),::aColors[i,2] := Int(::aColors[i,2]),::aColors[i,3] := Int(::aColors[i,3]) })

  aRet := {}
  aEval(::aColors,{|x,i| aAdd(aRet,GraMakeRGBColor(x)) })

  ::aColors := aClone(aRet)

  Return Self


Method ColorWheel:DrawColorWheel(oPS)

  Local i, nStartAngle, aAttr, aLineAttr, nSegment, nBGColor

  //** store the background color of the static
  nBGColor := ::XbpStatic:SetColorBG()

  nStartAngle := DefaultStartAngle

  ::LoadColorsFromBase()

  For i := 1 TO 12

    If i $ ::aBig
      ::nRadius += 10
    EndIf

    DrawFilledPartialArc(oPS,::aCenter,::nRadius,nStartAngle,30,,.T.,::aColors[i])

    nStartAngle    += 30      // increment starting angle

    If nStartAngle  > 360
      nStartAngle  -= 360
    EndIf

    If i $ ::aBig
      ::nRadius -= 10
    EndIf

  Next

  //** select fill pattern
  aAttr := Array( GRA_AA_COUNT )
  aAttr[GRA_AA_COLOR ] := nBGColor
  aAttr[GRA_AA_SYMBOL] := GRA_SYM_SOLID
  aAttr := GraSetAttrArea( oPS, aAttr )

  //** set the line parameters
  aLineAttr := Array( GRA_AL_COUNT )
  aLineAttr[GRA_AL_WIDTH] := 2
  aLineAttr := GraSetAttrLine(oPS,aLineAttr)

  //** open a new segment
  nSegment := GraSegOpen( oPS, GRA_SEG_MODIFIABLE )

  //** begin a new path definition
  GraPathBegin(oPS)

  //** move the pointer to the center point we specified
  GraPos( oPS, ::aCenter )

  //** now define the arc itself
  GraArc( oPS, ::aCenter, ::nRadius/2)

  //** end the path now
  GraPathEnd( oPS, .T. )

  //** Close out the segment
  GraSegClose(oPS)

  //** now create the path itself
  GraSegDraw( oPS, nSegment )

  //** fill the path using the current setup
  GraPathFill(oPS)

  //** recreate path for outlining
  GraSegDraw( oPS, nSegment )

  //** outline the path
  GraPathOutline(oPS)

  //** Now remove the segment from mem
  GraSegDestroy( oPS, nSegment)

  //** restore the settings that we had when we got here
  GraSetAttrArea( oPS, aAttr )

  Return Self

Method ColorWheel:lbClick(aPos)

  If !Empty(::nCurSlice)
    If !(::nCurSlice == 1)
      ::NewBase(GraGetRGBIntensity(::aColors[14-::nCurSlice]))
    EndIf
  EndIf
  Return Self

Method ColorWheel:Motion(aPos)
  Local nD1, nAngle, nX1, nX2, nX3, nY1, nY2, nY3, nX, aAngles, nCircum, nPart

  //** center
  nX1 := ::aCenter[1]
  nY1 := ::aCenter[2]

  //** current
  nX2 := aPos[1]
  nY2 := aPos[2]

  //** right angle point
  nX3 := nx2
  nY3 := ny1

  //** do some angle math
  nAngle := GetAngle(nX1,nY1,nX2,nY2,nX3,nY3)
  nAngle := RadtoDeg(nAngle)
  nAngle += 15
  nAngle := DegToFull(nAngle,aPos,::aCenter)

  //** get the distance from point to point
  nD1 := Sqrt((nX2-nX1)**2 + (nY2-nY1)**2)

  //** only do something if we are actually on the wheel
  If !( nD1 > ::nRadius .or. nD1 < (::nRadius/2) )
    nCircum := Pi() * (2*::nRadius)
    nPart   := ((nAngle/360)) * nCircum
    nPart   := Int(nPart / (nCircum/12))
    nPart   += 1
    If nPart == 13
      nPart := 1
    EndIf

    If ::nCurSlice != nPart
      ::nCurSlice := nPart
      If !Empty(::bSliceChange)
        Eval(::bSliceChange,::nCurSlice)
      EndIf
    EndIf
  Else
    If !Empty(::nCurSlice)
      ::nCurSlice := 0
      If !Empty(::bSliceChange)
        Eval(::bSliceChange,::nCurSlice)
      EndIf
    EndIf
  EndIf

  Return Self

/*
** Coder      : VBHelper.com
*/
Function DotProduct(ax,ay,bx,by,cx,cy)
  Local bax, bay, bcx, bcy

  //** get vector coords
  BAx := Ax - Bx
  BAy := Ay - By
  BCx := Cx - Bx
  BCy := Cy - By

  Return ( BAx * BCx + BAy * BCy )

/*
** Coder      : VBHelper.com
*/
Function CrossProductLength(ax,ay,bx,by,cx,cy)
  Local bax, bay, bcx, bcy

  //** get vector coords
  BAx = Ax - Bx
  BAy = Ay - By
  BCx = Cx - Bx
  BCy = Cy - By

  Return ( BAx * BCy - BAy * BCx )

/*
** Coder      : VBHelper.com
*/
Function GetAngle(ax,ay,bx,by,cx,cy)
  Local dot_product, cross_product

  //** Get the dot product and cross product.
  dot_product = DotProduct(Ax, Ay, Bx, By, Cx, Cy)
  cross_product = CrossProductLength(Ax, Ay, Bx, By, Cx, Cy)

  Return ATn2(cross_product, dot_product)

/* Name       : RadtoDeg
**
** Purpose    : Convert radians to degrees
**
** Parameters : nRad - the radians
**
** Coder      : Richard L. Hankins, Jr.
**
** Change Log : Date        Who   What
** --------------------------------------------------------------------------------
**              06/27/2005  RLHJ  Initial Write
**
*/
Function RadtoDeg(nRad)
  Return ( nRad * (180/Pi()) )

Function DegToFull(nDeg,aPoint,aCenter)
  Local nRet

  //** this don't work like it should per xbase rules
  //** 0 is at 12:00 and degrees go up clockwise, just
  //** seems right in my head... and the voices agree.
  If     aPoint[1] > aCenter[1] .and. aPoint[2] > aCenter[2]
    nRet := nDeg
  ElseIf aPoint[1] > aCenter[1] .and. aPoint[2] < aCenter[2]
    nRet := 90 + (90+nDeg)
  ElseIf aPoint[1] < aCenter[1] .and. aPoint[2] < aCenter[2]
    nRet := 180 + nDeg
  ElseIf aPoint[1] < aCenter[1] .and. aPoint[2] > aCenter[2]
    nRet := 360 + nDeg
  ElseIf aPoint[1] == aCenter[1] .and. aPoint[2] > aCenter[2]
    nRet := 0
  ElseIf aPoint[1] > aCenter[2] .and. aPoint[2] == aCenter[2]
    nRet := 90
  ElseIf aPoint[1] == aCenter[1] .and. aPoint[2] < aCenter[2]
    nRet := 180
  ElseIf aPoint[1] < aCenter[2] .and. aPoint[2] == aCenter[2]
    nRet := 270
  EndIf

  Return Int(nRet)