#!/bin/sh
exec ${GUILE-guile} -e '(ttn-do ppmglobe)' -s $0 "$@" # -*-scheme-*-
!#
;;; ppmglobe

;; Copyright (C) 2007, 2009, 2010 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: ppmglobe [options]
;;
;; Write to stdout ppm image data representing a random globe.
;; Options [defaults] are:
;;
;; -g, --generator PROGRAM  -- use PROGRAM (xearth, xplanet, or
;;                             ppmforge) to generate the image
;;                             [ppmforge]
;;
;; -s, --size N             -- image is roughly NxN pixels [360]
;;
;; If PROGRAM is not available, write to stderr the message
;; "program unavailable: PROGRAM" and exit failurefully.

;;; Code:

(define-module (ttn-do ppmglobe)
  #:export (main)
  #:use-module ((ttn-do zzz banalities) #:select (check-hv
                                                  qop<-args))
  #:use-module ((ttn-do zzz personally) #:select (fs fse))
  #:use-module ((ttn-do zzz subprocess) #:select (sysfmt find-program)))

(define (find name)
  (cond ((find-program name))
        (else (fse "ppmglobe: program unavailable: ~A~%" name)
              (exit #f))))

(define (xearth size)
  (sysfmt "~A -ppm -size ~A,~A -pos random"
          (find "xearth")
          size size))

(define (xplanet size)
  (let ((tmp (fs "/tmp/xplanet-~A.ppm" (getpid))))
    ;; xplanet doesn't write to stdout, hence the subshell kludge
    (sysfmt "( ~A ~A -geometry ~Ax~A -output ~A ; cat ~A ; rm ~A )"
            (find "xplanet")
            "-projection orthographic -random -num_times 1"
            size size
            tmp tmp tmp)))

(define (ppmforge size)
  (sysfmt "~A -quiet -xsize ~A -ysize ~A -stars 0"
          (find "ppmforge")
          size size))

(define (main/qop qop)
  ((case (qop 'generator string->symbol)
     ((xearth) xearth)
     ((xplanet) xplanet)
     ((ppmforge #f) ppmforge)
     (else (error "bad generator" (qop 'generator))))
   (or (qop 'size string->number)
       360)))

(define (main args)
  (check-hv args '((package . "ttn-do")
                   (version . "1.0")
                   (help . commentary)))
  (main/qop
   (qop<-args
    args '((generator (single-char #\g) (value #t))
           (size (single-char #\s) (value #t))))))

;;; ppmglobe ends here