functor (L:Level) ->
    functor (M:Out_channel_media) ->
  struct
    type color = terminal_color
    let r = ref []
    let set_colors l = r := l

    let string_of_color c =
      let code = 
        match c with
        | Blue -> 34
        | Cyan ->  36
        | Green -> 32
        | Magenta -> 35
        | Red -> 31
        | Yellow -> 33
      in
      Printf.sprintf "[%d;1m" code 

    include M

    let output level s =
      if level <= L.level () then
        (
         let oc = M.media () in
         let fd = Unix.descr_of_out_channel oc in
         (
          try
            match (Unix.fstat fd).Unix.st_kind with
              Unix.S_CHR ->
                (
                 try
                   let color = List.assoc level !r in
                   Printf.fprintf oc "%s" (string_of_color color)
                 with
                   Not_found -> ()
                )
            | _ -> ()
          with
            _ -> ()
         );
         M.output level s
        )
      else
        ()
  end