(define-module (fmt-stack)
  #:export (get-attr
            set-fg set-bg set-style
            make-fmt-frame empty-fmt-frame
            fmt-frame->ansi-esc)

  #:use-module (control monad)
  #:use-module (control monad state)

  #:use-module (data optional)

  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-9 gnu))

(define-immutable-record-type fmt-frame
  (make-fmt-frame style fg bg)
  fmt-frame?
  (style get-style set-style)
  (fg    get-fg    set-fg)
  (bg    get-bg    set-bg))

(define (empty-fmt-frame)
  (make-fmt-frame #f #f #f))

(define (fmt-frame->ansi-esc frame)
  (string-append
   "\x1b[m"
   (case (get-fg frame)
     ((B) "\x1b[0;34m")
     ((Y) "\x1b[0;33m")
     ((C) "\x1b[0;36m")
     (else ""))

   (case (get-bg frame)
     ((B) "\x1b[44m")
     ((Y) "\x1b[43m")
     ((C) "\x1b[46m")
     (else ""))

   (case (get-style frame)
     ((underline) "\x1b[4m")
     ((italic)    "\x1b[3m")
     ((bold)      "\x1b[1m")
     (else ""))))

(define (get-attr)
  (do stack <- (get)
      (return-state
       (fmt-frame->ansi-esc
        (make-fmt-frame
         (get-style (find get-style stack))
         (get-fg    (find get-fg    stack))
         (get-bg    (find get-bg    stack)))))))