Computer Science Canada

multi colour gradient module

Author:  PaddyLong [ Sun Dec 07, 2003 2:52 pm ]
Post subject:  multi colour gradient module

this is a gradient module I wrote that allows you to have as many colours as you want in a gradient by giving the function an array of the key colours (as RGB strings) of the gradient as well as a pass by reference array to fill with the gradient

code:

module gradient
    export makeGradient
    procedure stringRGB2realRGB (stringRGB : string, var realRGB : array 1 .. 3 of real)
        var RGBstring : string := ""
        var RGBselect : int := 1
        for q : 1 .. length (stringRGB)
            if stringRGB (q) not= "," then
                RGBstring += stringRGB (q)
            elsif stringRGB (q) = "," then
                realRGB (RGBselect) := strreal (RGBstring) / 255
                RGBselect += 1
                RGBstring := ""
            end if
        end for
        realRGB (RGBselect) := strreal (RGBstring) / 255
    end stringRGB2realRGB

    procedure makeGradient (var colrs : array 0 .. * of int, colours : array 1 .. * of string)
        type real3array : array 1 .. 3 of real

        var colrsPer : int := ceil (upper (colrs) / (upper (colours) - 1))
        var numGrads : int := upper (colours) - 1
        var rColours : array 1 .. upper (colours) of real3array
        var increments : array 1 .. numGrads, 1 .. 3 of real
        var colrArrays : array 1 .. numGrads, 1 .. colrsPer of int
        var currColr : real3array
        var currColrCount : int := 0

        for q : 1 .. upper (colours)
            stringRGB2realRGB (colours (q), rColours (q))
        end for

        for q : 1 .. numGrads
            for w : 1 .. 3
                increments (q, w) := (rColours (q + 1) (w) - rColours (q) (w)) / colrsPer
            end for

            for w : 1 .. colrsPer
                for e : 1 .. 3
                    currColr (e) := rColours (q) (e) + (increments (q, e) * w)
                end for

                colrArrays (q, w) := RGB.AddColor (currColr (1), currColr (2), currColr (3))
            end for
        end for

        for q : 1 .. (upper (colours) - 1)
            for w : 1 .. colrsPer
                colrs (currColrCount) := colrArrays (q, w)
                currColrCount += 1
                exit when currColrCount > upper (colrs)
            end for
            exit when currColrCount > upper (colrs)
        end for

        for q : 256 .. upper (colrs) by 256
            colrs (q) := colrs (q - 1)
        end for
        colrs (upper (colrs)) := RGB.AddColor (rColours (1) (1), rColours (1) (2), rColours (1) (3))
        colrs (0) := RGB.AddColor (rColours (upper (rColours)) (1), rColours (upper (rColours)) (2), rColours (upper (rColours)) (3))
    end makeGradient
end gradient



and a demo of how to use it ....
code:

const howMany := maxx

var colours : array 1 .. 5 of string
var colrs : array 0 .. howMany of int

colours (1) := "255,0,0"
colours (2) := "0,255,0"
colours (3) := "0,0,255"
colours (4) := "255,255,255"
colours (5) := "0,0,0"

gradient.makeGradient (colrs, colours)

for q : 0 .. howMany
    drawline (q, 0, q, 25, colrs (q))
end for

Author:  Tony [ Sun Dec 07, 2003 3:12 pm ]
Post subject: 

ohh Surprised look at all those preaty colors Laughing Have some +Bits

Author:  PaddyLong [ Sun Dec 07, 2003 3:49 pm ]
Post subject: 

aww my 420 bit count Sad thanks though

Author:  Tony [ Sun Dec 07, 2003 5:17 pm ]
Post subject: 

Confused you could always just donate bits to someone... like Mazer Laughing

Author:  PaddyLong [ Sun Dec 07, 2003 9:08 pm ]
Post subject: 

hehe that's what I was doing


: