Rutils/switch.col.r

In manfredo89/ED2io: Manages Input/Output for Ecosystem Demography 2 Model

#==========================================================================================#
#==========================================================================================#
#     This function switches colours from the default (white background, black foreground) #
# to the new colour framework.  Poor choices of background/foreground will cause it to     #
# crash.                                                                                   #
#------------------------------------------------------------------------------------------#
switch.col <<- function(x,fg="black",bg="white",diff.min=64,may.rev=TRUE){
   #----- Make sure x is defined. ---------------------------------------------------------#
   stopifnot(! missing(x))
   #---------------------------------------------------------------------------------------#

   #----- Transform the colours into RGB. -------------------------------------------------#
   new.bg = col2rgb(bg)
   new.fg = col2rgb(fg)
   #---------------------------------------------------------------------------------------#


   #---------------------------------------------------------------------------------------#
   #     Ensure that the new colour scheme will have enough room.                          #
   #---------------------------------------------------------------------------------------#
   new.diff = abs(new.fg-new.bg)
   if (any(new.diff < diff.min)){
      new.bg   = sprintf("%3i",new.bg  )
      new.fg   = sprintf("%3i",new.fg  )
      new.diff = sprintf("%3i",new.diff)
      cat("--------------------------==----------------------------------------","\n")
      cat("    Background and Foreground are poorly chosen:                    ","\n")
      cat(" RED   -- bg = ",new.bg[1],"  fg = ",new.fg[1]," diff = ",new.diff[1],"\n")
      cat(" GREEN -- bg = ",new.bg[2],"  fg = ",new.fg[2]," diff = ",new.diff[2],"\n")
      cat(" BLUE  -- bg = ",new.bg[3],"  fg = ",new.fg[3]," diff = ",new.diff[3],"\n")
      cat("--------------------------==----------------------------------------","\n")
      stop(paste(" Colours must be at least ",diff.min," points apart",sep=""))
   }#end if
   #---------------------------------------------------------------------------------------#




   #---------------------------------------------------------------------------------------#
   #     Transform the old colours into RGB.                                               #
   #---------------------------------------------------------------------------------------#
   nx       = length(x)
   sx       = nx - sequence(nx) + 1
   old.x    = col2rgb(x)
   swap     = new.bg < new.fg & may.rev
   #---------------------------------------------------------------------------------------#
   

   #---------------------------------------------------------------------------------------#
   #      Update colours.                                                                  #
   #---------------------------------------------------------------------------------------#
   new.bg  = 0*old.x + rep(new.bg,times=ncol(old.x))
   new.fg  = 0*old.x + rep(new.fg,times=ncol(old.x))
   new.x   = NA*old.x
   for (ch in 1:3){
      if (swap[ch]){
         scal.fg    = (new.fg[ch] - new.bg[ch]) / 255
         new.x[ch,] = new.bg[ch] + old.x[ch,] * scal.fg
      }else{
         scal.fg    = (new.bg[ch] - new.fg[ch]) / 255
         new.x[ch,] = new.fg[ch] + old.x[ch,] * scal.fg
      }#end if
   }#end for
   new.x   = 0 * old.x + as.integer(new.x * 255 / max(255,max(new.x)))
   #---------------------------------------------------------------------------------------#


   #---------------------------------------------------------------------------------------#
   #     Check whether to swap colours.                                                    #
   #---------------------------------------------------------------------------------------#
   for (ch in 1:3){if (swap[ch]) new.x[ch,] = new.x[ch,sx]}
   #---------------------------------------------------------------------------------------#



   #---------------------------------------------------------------------------------------#
   #      Create the new colours.                                                          #
   #---------------------------------------------------------------------------------------#
   ans = rgb(red=new.x[1,],green=new.x[2,],blue=new.x[3,],maxColorValue=255)
   return(ans)
   #---------------------------------------------------------------------------------------#
}#end switch.col
#==========================================================================================#
#==========================================================================================#






#==========================================================================================#
#==========================================================================================#
#     This function finds the negative colour using the new background.                    #
#------------------------------------------------------------------------------------------#
negative.col <<- function(x,fg="black",bg="white",diff.min=64){
   #----- Make sure x is defined. ---------------------------------------------------------#
   stopifnot(! missing(x))
   #---------------------------------------------------------------------------------------#

   #----- Transform the colours into RGB. -------------------------------------------------#
   new.bg = col2rgb(bg)
   new.fg = col2rgb(fg)
   #---------------------------------------------------------------------------------------#


   #---------------------------------------------------------------------------------------#
   #     Ensure that the new colour scheme will have enough room.                          #
   #---------------------------------------------------------------------------------------#
   new.diff = abs(new.fg-new.bg)
   if (any(new.diff < diff.min)){
      new.bg   = sprintf("%3i",new.bg  )
      new.fg   = sprintf("%3i",new.fg  )
      new.diff = sprintf("%3i",new.diff)
      cat("--------------------------==----------------------------------------","\n")
      cat("    Background and Foreground are poorly chosen:                    ","\n")
      cat(" RED   -- bg = ",new.bg[1],"  fg = ",new.fg[1]," diff = ",new.diff[1],"\n")
      cat(" GREEN -- bg = ",new.bg[2],"  fg = ",new.fg[2]," diff = ",new.diff[2],"\n")
      cat(" BLUE  -- bg = ",new.bg[3],"  fg = ",new.fg[3]," diff = ",new.diff[3],"\n")
      cat("--------------------------==----------------------------------------","\n")
      stop(paste(" Colours must be at least ",diff.min," points apart",sep=""))
   }#end if
   #---------------------------------------------------------------------------------------#




   #---------------------------------------------------------------------------------------#
   #     Transform the old colours into RGB.                                               #
   #---------------------------------------------------------------------------------------#
   nx       = length(x)
   sx       = nx - sequence(nx) + 1
   old.x    = col2rgb(x)
   #---------------------------------------------------------------------------------------#
   

   #---------------------------------------------------------------------------------------#
   #      Update colours.                                                                  #
   #---------------------------------------------------------------------------------------#
   new.bg  = 0*old.x + rep(new.bg,times=ncol(old.x))
   new.fg  = 0*old.x + rep(new.fg,times=ncol(old.x))
   
   new.x  = new.bg - (new.fg - new.bg) * ( old.x - 255) / 255
   new.x  = 0 * old.x + as.integer(new.x * 255 / max(255,max(new.x)))
   #---------------------------------------------------------------------------------------#



   #---------------------------------------------------------------------------------------#
   #      Create the new colours.                                                          #
   #---------------------------------------------------------------------------------------#
   ans = rgb(red=new.x[1,],green=new.x[2,],blue=new.x[3,],maxColorValue=255)
   return(ans)
   #---------------------------------------------------------------------------------------#
}#end negative.col
#==========================================================================================#
#==========================================================================================#