#!/bin/sh
exec ${GUILE-guile} -e '(ttn-do display-wurld)' -s $0 "$@" # -*-scheme-*-
!#
;; Copyright (C) 2001, 2003, 2004, 2005, 2007, 2009,
;;   2010, 2011 Thien-Thi Nguyen
;;
;; This file is part of ttn-do, released 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.  There is NO WARRANTY.  See file COPYING for details.

;;; Commentary:

;; Usage: display-wurld [URL-LIST]
;;
;; Display an HTML "wurld" to stdout.  Optional arg URL-LIST names a file
;; containing one URL per line, in which case display-wurld decorates the
;; "denser" areas of the output with randomly chosen links.  If URL-LIST is
;; "-" the list of links is taken from stdin.

;;; Code:

(define-module (ttn-do display-wurld)
  #:export (main html-wurld-tree)
  #:use-module ((ice-9 optargs-kw) #:select (lambda*
                                             define*
                                             let-optional*
                                             let-keywords*))
  #:use-module ((ttn-do imgtxtlink) #:select (string<-image-command
                                              randomly-hyperlinked))
  #:use-module ((ttn-do zzz banalities) #:select (check-hv
                                                  qop<-args))
  #:use-module ((ttn-do zzz personally) #:select (fs))
  #:use-module ((ttn-do zzz xhtml-tree) #:select (~tt ~pre))
  #:use-module ((ttn-do zzz publishing) #:select (flatten))
  #:use-module ((ice-9 rdelim)    #:select (read-line)))

;; Return an html-data tree made from an ASCII-representation of a globe
;; image.  Keyword parameters, default values, and their meanings:
;;
;; @multitable @columnfractions .16 .16 .68
;; @item @t{#:size}
;; @tab @t{150}
;; @tab Size in pixels (NxN) of the originating image.
;;
;; @item @t{#:gen}
;; @tab @t{#:ppmforge}
;; @tab Preferred backend program used to generate the image, one of
;; @code{#:xearth}, @code{#:xplanet} or @code{#:ppmforge}.
;; The value can also be a symbol.
;;
;; @item @t{#:links}
;; @tab @t{#f}
;; @tab A list of URLs (strings), or a single filename.
;; When specified, the single string
;; return value is profiled for small non-whitespace intervals to be
;; ``marked up'' as the text of an @acronym{XHTML} @code{a} element,
;; with the reference (attribute @code{href}) taken randomly from
;; @var{links}.  If @var{links} is a filename, that file should
;; contain one URL per line.
;; @end multitable
;;
(define* (html-wurld-tree #:key
                          (size 150)
                          (gen #:ppmforge)
                          (links #f))
  (let ((world (string<-image-command
                (fs "ttn-do ppmglobe -s ~A -g ~A"
                    size (let ((gen (if (keyword? gen)
                                        (keyword->symbol gen)
                                        gen)))
                           (cond ((memq gen '(xearth
                                              xplanet
                                              ppmforge))
                                  gen)
                                 (else
                                  (error "bad #:gen value:" gen)))))
                #t)))
    (if (not links)
        (list world)
        (randomly-hyperlinked world (if (string? links)
                                        (list 'file-lines links)
                                        links)))))

(define (display-wurld links)
  (flatten (~tt (~pre (html-wurld-tree #:links links)))))

(define (main args)
  (check-hv args '((package . "ttn-do")
                   (version . "1.3")
                   ;; 1.3 -- bugfix: use empty list instead of "/dev/null"
                   ;; 1.2 -- no longer tries to display help on error condition
                   ;; 1.1 -- supports url list on stdin
                   ;; 1.0 -- plain
                   (help . commentary)))
  (display-wurld
   (cond ((= 1 (length args))
          '())
         ((and (= 2 (length args))
               (file-exists? (cadr args)))
          (cadr args))
         ((and (= 2 (length args))
               (string=? "-" (cadr args)))
          (let loop ((url (read-line (current-input-port)))
                     (acc '()))
            (if (eof-object? url)
                (list->vector acc)
                (loop (read-line (current-input-port))
                      (cons url acc)))))
         (else (error "bad command line, try --help")))))

;;; display-wurld ends here