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
|
|