;; This file is part of Idest
;; Copyright (C) 2011, 2015 Sergey Poznyakoff
;;
;; Idest is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;;
;; Idest is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with Idest.  If not, see <http://www.gnu.org/licenses/>.

(define-module (idest format pic))

(use-modules (ice-9 getopt-long)
             (rnrs io ports)
	     (srfi srfi-1))

(define-public description
  "show attached picture (APIC frame) or save it on disk")

(define-public idest-main #f)

;; Format specifiers
;; ~D - Input file directory part
;; ~N - Input file base name
;; ~C - Content description
;; ~T - Mime type without the "image/" prefix
;; ~P - Picture type
;; ~I - pid
(define (format-file-name fmt input-name frame)
  (let* ((data (cdr frame))
	 (fmtlist (string-split fmt #\~))
         (segments (reverse
                    (fold
                     (lambda (elt prev)
                       (if (string-null? elt)
                           (cons (string-append (car prev) "~") (cdr prev))
                           (let ((ch (string-ref elt 0)))
                             (case ch
                               ((#\D #\N #\C #\T #\P #\I) (cons elt prev))
                               (else
                                (cons (string-append (car prev) elt)
                                      (cdr prev)))))))
                     '()
                     (cdr fmtlist)))))
    (apply
     string-append
     (car fmtlist)
     (map
      (lambda (seg)
	(string-append
	 (case (string-ref seg 0)
	   ((#\D) (dirname input-name))
	   ((#\N) (let* ((bname (basename input-name))
			 (pos (string-rindex bname #\.)))
		    (if pos
			(substring bname 0 pos)
			bname)))
	   ((#\C) (assoc-ref data 'condesc))
	   ((#\T) (let* ((t (assoc-ref data 'mime-type))
			 (pos (string-index t #\/)))
		    (if pos
			(substring t (+ pos 1))
			t)))
	   ((#\P) (assoc-ref data 'pic-type))
	   ((#\I) (number->string (getpid))))
	 (substring seg 1)))
      segments))))

(define (save-picture name data)
  (let ((port (open-file-output-port name)))
    (for-each
     (lambda (c) (put-u8 port c))
     (let string->bytelist ((str data)
			    (bytelist '()))
       (cond
	((string-null? str)
	 (reverse bytelist))
	(else
	 (string->bytelist
	  (substring str 2)
	  (cons
	   (string->number (substring str 0 2) 16)
	   bytelist))))))
    (close-port port)))

(define (save-picture-0 name data)
  (with-output-to-file
      name
    (lambda ()
      (for-each
       (lambda (c) (put-u8 (current-output-port) c))
       (let string->bytelist ((str data)
			      (bytelist '()))
	 (cond
	  ((string-null? str)
	   (reverse bytelist))
	  (else
	   (string->bytelist
	    (substring str 2)
	    (cons
             (string->number (substring str 0 2) 16)
	     bytelist)))))))))

(define-public (idest-init)
  (let* ((cmd (command-line))
	 (progname (car cmd))
	 (description #f)
	 (mime-type #f)
	 (store #f)
	 (file #f)
	 (viewer "xv")
	 (grammar `((description (single-char #\d) (value #t))
		    (mime-type (single-char #\m) (value #t))
		    (store (single-char #\s) (value #f))
		    (file (single-char #\f) (value #t))
		    (viewer (single-char #\v) (value #t))
		    (help (single-char #\h)))))
    (catch 'misc-error
	   (lambda ()
	     (for-each
	      (lambda (x)
		(case (car x)
		  ((description)
		   (set! desciption (cdr x)))
		  ((mime-type)
		   (set! mime-type (cdr x)))
		  ((store)
		   (set! store #t))
		  ((file)
		   (set! file (cdr x)))
		  ((viewer)
		   (set! viewer (cdr x)))
		  ((help)
		   (format #t "usage: idest --format=~A [OPTIONS] FILE...\n"
			   progname)
		   (format #t "displays attached picture(s) or stores them on disc\n")
		   (format #t "OPTIONS are:\n")
		   (format #t "  -v, --viewer PROG      use PROG to view images (default: xv)\n")
		   (format #t "  -d, --description STR  look for picture with this description\n")
		   (format #t "  -m, --mime-type TYPE   picture must have this MIME type\n")
		   (format #t "  -s, --store            store picture on disk, don't show it\n")
		   (format #t "  -f, --file FILE        save picture to FILE (implies --store)\n")
		   (format #t "  -h, --help             show this help summary\n")
		   (newline)
		   (format #t "FILE is a format string and can contain the following meta-sequences:\n\n")
		   (format #t "Sequence   Expands to\n")
		   (format #t "---------+-----------------------------\n")
		   (for-each
		    (lambda (elt)
		      (display elt)
		      (newline))
		    (list
		     "   ~D      Input file directory part"
		     "   ~N      Input file base name"
		     "   ~C      Content description"
		     "   ~T      Mime type without the \"image/\" prefix"
		     "   ~P      Picture type"
		     "   ~I      PID"))
		   (newline)
		   (exit 0))
		  (else
		   (set-program-arguments (cons progname (cdr x))))))
	      (getopt-long cmd grammar)))
	   (lambda (key . args)
	     (with-output-to-port
		 (current-error-port)
	       (lambda ()
		 (format #t "~A: " progname)
		 (apply format #t (list-ref args 1) (list-ref args 2))
		 (newline)
		 (exit 1)))))

    (if file
	(set! store #t)
	(set! file "/tmp/~I-~N.~T"))
    (if (and mime-type (not (string-index mime-type #\/)))
	(set! mime-type (string-append "image/" mime-type)))
     
    (set! idest-main
	  (lambda (name frames)
	    (let ((pictures (filter
			     (lambda (frame)
			       (let ((data (cdr frame))
				     (id (car frame)))
				 (and (string=? id "APIC")
				      (or (not mime-type)
					  (string-ci=?
					   (or (assoc-ref data 'mime-type)
					       "image/png")
					   mime-type))
				      (or (not description)
					  (string-ci=?
					   (or (assoc-ref data 'condesc)
					       "")
					   description)))))
			     frames)))
	      (force-output (current-output-port))
	      (force-output (current-error-port))
	      (cond
	       ((null? pictures)
		(format (current-error-port) "~A: no (matching) picture~%"
			name))
	       (else
		(for-each
		 (lambda (pic)
		   (let ((data (assoc-ref (cdr pic) 'text))
			 (file-name (format-file-name file name pic)))
		     (format #t "Saving ~A~%" file-name)
		     (save-picture file-name data)
		     (cond
		      ((not store)
		       (let ((res (system* viewer file-name)))
			 (delete-file file-name)
			 (if (= res 256)
			     (exit 1)))))))
		 pictures))))))))