#!/local/gauche/bin/gosh

(use file.util)
(use srfi-13)
(use text.html-lite)
(use text.tree)
(use gauche.process)

(define GRID-WIDTH  5)
(define IMAGE-EXTS  (list ".jpg" ".jpeg" ".JPG" ))
(define THUMBNAIL   "djpeg -pnm < ~a | pnmscale -height 100 | cjpeg > ~a")
(define TRANSFORM   "djpeg -pnm < ~a | pnmscale -height 800 | cjpeg > ~a")
(define WEBDIR      "grid")
(define THUMBPREFIX "thumb_")

(define (make-html files)
  (let ((rows '())
	(row  '()))

    ;
    ; Makes a list of rows that are length GRID-WIDTH or less.
    ;
    (for-each
     (lambda (file)
       (if (= (length row) GRID-WIDTH)
	   (begin
	     (set! rows (cons row rows))
	     (set! row (list file)))
	   (set! row (cons file row)))
       )
     files)
    (if (> (length row) 0) (set! rows (cons row rows)))

    ;
    ; Generates HTML from the list of rows by mapping TR onto each row
    ; and mapping TD onto each
    ;
    (html:html
     (html:head (html:title "Image Grid"))
     (html:body
      (html:table
       (map
	(lambda (row)
	  (html:tr
	   (map
	    (lambda (file)
	      (html:td (html:a :href file
			       (html:img :src
					 (format #f "~a~a"
						 THUMBPREFIX file)))))
	    row)))
	(reverse rows)))))
    )
  )

(define (main args)
  (if (null? (cdr args))
      (die "No arguments were given")
      (set! args (cdr args)))

  (if (file-exists? WEBDIR)
      (die "The directory/file " WEBDIR
	   " exists and must be removed or renamed."))

  ;
  ; Checks to make sure that the image files given look kind of reasonable
  ; and strips the path names off.  This makes another list of filenames
  ; without path names.  The list is named ``files''.
  ;
  (let ((files
	 (map
	  (lambda (file)

	    (if (not (file-is-regular? file))
		(die "The file " file " is not a regular file."))

	    (if (call-with-current-continuation
		 (lambda (leave-loop)
		   (for-each
		    (lambda (ext)
		      (if (string-suffix? file ext)
			  (leave-loop #t)))
		    IMAGE-EXTS)
		   #f))
		(die "The file " file " is apparently not an image file."))
	    
	    (basename file))
	  args)))

    (make-directory* WEBDIR)

    ;
    ; Executes shell commands to turn the images into something useable
    ; This iterates over the lists "files" and "args"
    ;
    (for-each
     (lambda (file arg)
       (print "Transforming " arg)
       (sys-system (format #f TRANSFORM arg (format #f "~a/~a" WEBDIR file)))
       (print "Thumbnailing " arg)
       (sys-system (format #f THUMBNAIL arg
			   (format #f "~a/~a~a" WEBDIR THUMBPREFIX file))))
       files args)
    
    ;
    ; Output the HTML file.
    ;
    (with-output-to-file (format #f "~a/index.html" WEBDIR)
      (lambda ()
	(display (tree->string (make-html files)))))
    ))

(define (basename path)
  (let ((s (string-index-right path #\/)))
    (if (number? s)
	(string-drop path (+ 1 s))
	path)))

(define (die . args)
  (for-each (lambda (t) (display t (standard-error-port))) args)
  (display "\n" (standard-error-port))
  (exit 1))

(define (warn . args)
  (for-each (lambda (t) (display t (standard-error-port))) args)
  (display "\n" (standard-error-port)))