Programming C, C++, Java, PHP, Ruby, Turing, VB
Computer Science Canada 
Programming C, C++, Java, PHP, Ruby, Turing, VB  

Username:   Password: 
 RegisterRegister   
 multi colour gradient module
Index -> Programming, Turing -> Turing Submissions
View previous topic Printable versionDownload TopicRate TopicSubscribe to this topicPrivate MessagesRefresh page View next topic
Author Message
PaddyLong




PostPosted: 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
Sponsor
Sponsor
Sponsor
sponsor
Tony




PostPosted: Sun Dec 07, 2003 3:12 pm   Post subject: (No subject)

ohh Surprised look at all those preaty colors Laughing Have some +Bits
Latest from compsci.ca/blog: Tony's programming blog. DWITE - a programming contest.
PaddyLong




PostPosted: Sun Dec 07, 2003 3:49 pm   Post subject: (No subject)

aww my 420 bit count Sad thanks though
Tony




PostPosted: Sun Dec 07, 2003 5:17 pm   Post subject: (No subject)

Confused you could always just donate bits to someone... like Mazer Laughing
Latest from compsci.ca/blog: Tony's programming blog. DWITE - a programming contest.
PaddyLong




PostPosted: Sun Dec 07, 2003 9:08 pm   Post subject: (No subject)

hehe that's what I was doing
Display posts from previous:   
   Index -> Programming, Turing -> Turing Submissions
View previous topic Tell A FriendPrintable versionDownload TopicRate TopicSubscribe to this topicPrivate MessagesRefresh page View next topic

Page 1 of 1  [ 5 Posts ]
Jump to:   


Style:  
Search: