module Gis.Saga.LUT (bgrColTable)
where 
import Data.List (zip5, intercalate)
import Text.Printf (printf)

-- | Red-blue-green-colors
type RGB = (Int, Int, Int)

-- | Create a color lookup-table based on minimum and maximum values
bgrColTable :: Float -> Float -> String
bgrColTable  minV maxV = hd ++ unlines (map renderRec recs')
    where 
        d = maxV - minV
        s = d/fromIntegral n
        minVs = take n [minV, (minV + s) ..]
        maxVs = take n [(minV + s), (minV + 2*s) ..]
        n :: Int
        n = 100
        nms = take n $ map (\x -> "Class " ++ show x) [1..] 
        recs = zip5 bgr100 nms nms minVs maxVs
        recs' = (8388864 :: Int, "Class 0", "Class 0", 0 :: Float, minV) : 
                 recs  ++ 
                 [(391 ::Int , "Class 101", "Class 101", maxV, 10000 :: Float)]
        renderRec (col,nm,desc,k,j)= printf "%7i\t%s\t%s\t%10.7f\t%10.7f" 
            col (quote nm) (quote desc) k j
        quote s = "\"" ++ s ++ "\""
        hd = intercalate "\t" ["COLOR","NAME","DESCRIPTION","MINIMUM", "MAXIMUM"] ++ "\n"
        

-- | Convert a RGB-color to BGR-color
rgbToBgr ::  RGB -> Int
rgbToBgr (r,g,b) = (b * 65536) + (g * 256) + r

bgr100 :: [Int]
bgr100 = map rgbToBgr rgb100

rgb100 :: [RGB]
rgb100 = 
    [(000, 001, 128)
    ,(000, 001, 135)
    ,(000, 002, 143)
    ,(000, 003, 151)
    ,(000, 004, 159)
    ,(000, 007, 167)
    ,(000, 009, 174)
    ,(000, 013, 182)
    ,(000, 016, 189)
    ,(000, 020, 196)
    ,(000, 025, 202)
    ,(000, 030, 208)
    ,(000, 035, 214)
    ,(000, 041, 220)
    ,(000, 047, 225)
    ,(000, 053, 230)
    ,(000, 059, 235)
    ,(000, 066, 239)
    ,(000, 073, 242)
    ,(000, 081, 246)
    ,(000, 088, 248)
    ,(000, 096, 251)
    ,(000, 104, 252)
    ,(000, 112, 253)
    ,(000, 120, 254)
    ,(001, 128, 255)
    ,(001, 135, 254)
    ,(002, 143, 253)
    ,(003, 151, 252)
    ,(004, 159, 251)
    ,(007, 167, 248)
    ,(009, 174, 246)
    ,(013, 182, 242)
    ,(016, 189, 239)
    ,(020, 196, 235)
    ,(025, 202, 230)
    ,(030, 208, 225)
    ,(035, 214, 220)
    ,(041, 220, 214)
    ,(047, 225, 208)
    ,(053, 230, 202)
    ,(059, 235, 196)
    ,(066, 239, 189)
    ,(073, 242, 182)
    ,(081, 246, 174)
    ,(088, 248, 167)
    ,(096, 251, 159)
    ,(104, 252, 151)
    ,(112, 253, 143)
    ,(120, 254, 135)
    ,(128, 255, 127)
    ,(135, 254, 120)
    ,(143, 253, 112)
    ,(151, 252, 104)
    ,(159, 251, 096)
    ,(167, 248, 088)
    ,(174, 246, 081)
    ,(182, 242, 073)
    ,(189, 239, 066)
    ,(196, 235, 059)
    ,(202, 230, 053)
    ,(208, 225, 047)
    ,(214, 220, 041)
    ,(220, 214, 035)
    ,(225, 208, 030)
    ,(230, 202, 025)
    ,(235, 196, 020)
    ,(239, 189, 016)
    ,(242, 182, 013)
    ,(246, 174, 009)
    ,(248, 167, 007)
    ,(251, 159, 004)
    ,(252, 151, 003)
    ,(253, 143, 002)
    ,(254, 135, 001)
    ,(255, 128, 001)
    ,(254, 120, 000)
    ,(253, 112, 000)
    ,(252, 104, 000)
    ,(251, 096, 000)
    ,(248, 088, 000)
    ,(246, 081, 000)
    ,(242, 073, 000)
    ,(239, 066, 000)
    ,(235, 059, 000)
    ,(230, 053, 000)
    ,(225, 047, 000)
    ,(220, 041, 000)
    ,(214, 035, 000)
    ,(208, 030, 000)
    ,(202, 025, 000)
    ,(196, 020, 000)
    ,(189, 016, 000)
    ,(182, 013, 000)
    ,(174, 009, 000)
    ,(167, 007, 000)
    ,(159, 004, 000)
    ,(151, 003, 000)
    ,(143, 002, 000)
    ,(135, 001, 000)]