Welcome to the CHICKEN Scheme pasting service

(use posix)
(use ezxdisp)

(define (battery-status)
   (let* ((tokens (string-split-fields "[,:]+" 
                  (with-input-from-pipe
                      "apm -m"
		       read-line) #:infix))
          (status (list-ref tokens 0))
          (online? (equal? "On-line" status))
          (percenttime (string-split (list-ref tokens 2)))
          (percent (list-ref percenttime 0))
          (timeleft (string-append
                       (list-ref percenttime 1)
                       (list-ref percenttime 2))))
      (values online? percent timeleft)))

(define black (make-ezx-color 0 0 0))
(define grey (make-ezx-color 0.5 0.5 0.5))
(define good (make-ezx-color 0 1 0))
(define fair (make-ezx-color 1 1 0))
(define critical (make-ezx-color 1 0 0))

(define (fill-color fill)
      (cond ((>= fill 80) good)
            ((>= fill 20) fair)
            (else critical)))

(define (draw-battery-window w x y)
   (let* ((lr-border (floor (* y 0.05)))
          (top-border (floor (* x 0.2)))
          (bottom-border (floor (* y 0.02)))
          (height (- y (+ top-border bottom-border)))
          (width (- x (* 2 lr-border)))
          (notch-height (floor (* top-border 0.66)))
          (notch-width (floor (* width 0.5)))
          (x0 lr-border)
          (y0 top-border)
          (x1 (+ lr-border width))
          (y1 (+ height top-border)))
      (receive (status percent timeleft)
                      (battery-status)
         (let ((fill (string->number
                   (string-filter char-set:digit percent))))
            (ezx-wipe w)
            (ezx-fillrect-2d w (+ (* width 0.25) lr-border)
                         (- top-border notch-height)
                         (+ notch-width (* width 0.25) lr-border)
                         top-border grey)
            (ezx-rect-2d w (+ (* width 0.25) lr-border)
                         (- top-border notch-height)
                         (+ notch-width (* width 0.25) lr-border)
                         top-border black 1)
            (ezx-fillrect-2d w x0 (+ y0 (- height (* height (/ fill 100))))
                x1 y1
               (fill-color fill))
            (ezx-rect-2d w x0 y0 x1 y1 black 1)
            (ezx-str-2d w (- (/ x1 3) lr-border)
                          (+ (/ y 2) top-border) percent black)
            (ezx-redraw w)))))

(define (print-battery-status)
   (receive (online? percent timeleft) (battery-status)
      (let ((online (if online? "Online" "Offline")))
         (print (format "~A ~A ~A" online percent timeleft)))))

(print-battery-status)