! Color subroutines palette_shade_gray_fade = 0.4 sub color_range_horizontal zmin zmax zstep palette$ width height format$ pixels ! draws a horizontal color range default zstep 1 default palette "color" default width xg(xgmax)-xg(xgmin) default height 0.25 default format "fix 0" default pixels -1 if pixels = -1 then pixels = (zmax-zmin)/zstep end if begin box name cmap if palette$ = "gray" then colormap "x" 0 1 0 1 pixels 1 width height else if palette$ = "color" then colormap "x" 0 1 0 1 pixels 1 width height color else colormap "x" 0 1 0 1 pixels 1 width height palette palette$ end if end box set just tc local xp = zmin while xp <= zmax amove pointx(cmap.lc)+(xp-zmin)/(zmax-zmin)*width pointy(cmap.bc) rline 0 -height/3; rmove 0 -height/3; write format$(xp, format$) xp = xp + zstep next end sub sub color_range_vertical zmin zmax zstep palette$ width height format$ pixels ! draws a vertical color range default zstep 1 default palette "color" default width 0.25 default height yg(ygmax)-yg(ygmin) default format "fix 0" default pixels -1 if pixels = -1 then pixels = (zmax-zmin)/zstep end if begin box name cmap if palette$ = "gray" then colormap "y" 0 1 0 1 1 pixels width height else if palette$ = "color" then colormap "y" 0 1 0 1 1 pixels width height color else colormap "y" 0 1 0 1 1 pixels width height palette palette$ end if end box set just lc local xp = zmin while xp <= zmax amove pointx(cmap.rc) pointy(cmap.bc)+(xp-zmin)/(zmax-zmin)*height rline width/3 0; rmove width/3 0; write format$(xp, format$) xp = xp + zstep next end sub sub palette_blue_white_red z ! a custom palette ranging from blue over white to red local r = 0 local g = 0 local b = 0 ! RED if (z > 0.25) and (z <= 0.50) then r = (z-0.25)*4 if (z > 0.50) and (z <= 0.75) then r = 1 if (z > 0.75) then r = 1-(123/255)*4*(z-0.75) ! GREEN if (z > 0.25) and (z <= 0.50) then g = (z-0.25)*4 if (z > 0.50) and (z <= 0.75) then g = 1-4*(z-0.5) if (z > 0.75) then g = 0 ! BLUE if (z <= 0.25) then b = 132/255+(123/255)*4*z if (z > 0.25) and (z <= 0.50) then b = 1 if (z > 0.50) and (z <= 0.75) then b = 1-4*(z-0.5) if (z > 0.75) then b = 0 return rgb(r,g,b) end sub sub palette_blue_purple_red z ! a custom palette ranging from blue over purple to red return rgb(z,0,1-z) end sub sub set_palette_shade_gray_fade fade palette_shade_gray_fade = fade end sub sub sgp_color z x local y = palette_shade_gray_fade ! set to 0 to fade completely white, 1 no fade at all return (z*(1-y)+y)*(x/255-1)+1 ! the final +1 hard codes this to fade to white end sub sub palette_shade_gray z r g b ! r, g, b is the color of the gradient which will fade towards white return rgb(sgp_color(z,r), sgp_color(z,g), sgp_color(z,b)) end sub