DUO Panoramic : Editeur de codes et Constructeur d'objets

dim r%,v%,b%
dim t,s,l
dim n%, pas

    FOR n%=1 TO 22
        PICTURE n%
        LEFT n%,n%*12-5
        TOP n%,15
        WIDTH n%,12
        HEIGHT n%,88
        COLOR n%,0,0,0
    NEXT n%

' Valeurs RVB de test
r% = 225
v% = 18
b% = 24

calculTSL(r%,v%,b%)
for n% = 1 to 22
    calculRVB(t,s,pas)
    color n%,r%,v%,b%
    pas = pas + 0.045454545
next n%

end
' ------------------------------------------------------------------------------
sub calculTSL(r1,v1,b1)
    dim_local mini, maxi, ecart

    ' conversion rvb dans l'interval [0,1]
    r1 = r1 / 255
    v1 = v1 / 255
    b1 = b1 / 255

    ' recherche de la plus grande valeur parmi les composantes r,v,b
    if r1 >= v1 and r1 >= b1 then maxi = r1
    if v1 >= r1 and v1 >= b1 then maxi = v1
    if b1 >= r1 and b1 >= v1 then maxi = b1

    ' recherche de la plus petite valeur parmi les composantes r,v,b
    if r1 <= v1 and r1 <= b1 then mini = r1
    if v1 <= r1 and v1 <= b1 then mini = v1
    if b1 <= r1 and b1 <= v1 then mini = b1

    ' calcul luminance l
    l = (maxi + mini) / 2

    ' calcul de l'écart entre la valeur mini et maxi
    ecart = maxi - mini

    ' si ecart est nul alors t et s sont nuls
    if ecart = 0
        t = 0
        s = 0
    else      
 ' calcul de la saturation s
 if l < 0.5 then s = ecart / (maxi + mini)
 if l >= 0.5 then s = ecart / (2 - maxi - mini )

        ' calcul de la teinte t
 if r1 = maxi then t = ( v1 - b1 ) / ecart
 if v1 = maxi then t = 2 + ((b1 - r1) / ecart)
 if b1 = maxi then t = 4 + ((r1 - v1) / ecart)
    end_if

    ' conversion de la teinte dans l'interval [0,1]
    t = t / 6
end_sub
' ------------------------------------------------------------------------------
sub calculRVB(t1,s1,l1)
    dim_local var1,var2

    If s1 = 0
        r% = int(l1*255)
        v% = int(l1*255)
        b% = int(l1*255)
    else
        if (l1 < 0.5)
            var2 = l1 * (1 + s1)
        else
            var2 = (l1 + s1) - (s1 * l1)
        end_if
        var1 = 2 * l1 - var2

        r% = 255 * teinteRVB(var1,var2,t1 + (1 / 3))
        v% = 255 * teinteRVB(var1,var2,t1 )
        b% = 255 * teinteRVB(var1,var2,t1 - (1 / 3))
   end_If
end_sub
' ------------------------------------------------------------------------------
fnc teinteRVB(v1,v2,vT)
   if vT < 0 then vT = vT + 1
   if vT > 1 then vT = vT - 1
   if  6 * vT < 1 then result (v1 + (v2 - v1) * 6 * vT) : exit_fnc
   if  2 * vT < 1 then result (v2 )  : exit_fnc
   if  3 * vT < 2 then result (v1 + (v2 - v1) * ((2 / 3) - vT) * 6)  : exit_fnc
   result v1
end_fnc
' ------------------------------------------------------------------------------