PangolinTurtle
/
rp-helper


			
				
					
						
						
							123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305
							
;;;
;;; Copyright 2016 Jason K. MacDuffie
;;; License: GPLv3+
;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Prints a character sheet as an HTML or TXT document
;; This is built around FUDGE with a 1-to-7 scale
;;
;; Character sheets have this structure:
;; $ cat char-sheet.sxml
;; (character
;;  (name "My Name")
;;  (player "John Doe")
;;  (date-created 1999 01 10)
;;  (unspent-ep 0)
;;  (total-ep 0)
;;  (race "Human")
;;  (class "Merchant")
;;  (wounds (scratch #f #f)
;;          (hurt #f #f)
;;          (very-hurt #f #f)
;;          (incapacitated #f)
;;          (near-death #f))
;;  (attributes
;;   (str 4)
;;   (con 4)
;;   (dex 4)
;;   (int 4)
;;   (wis 4)
;;   (cha 4))
;;  (skills
;;   (climb 4)
;;   (heavy-armor 2))
;;  (gifts
;;   "Looks that can kill")
;;  (flaws
;;   "Heavy sleeper")
;;  (inventory
;;   (gold 10)
;;   (iron-sword 1)))
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(import (scheme base)
        (scheme cxr)
        (scheme char)
        (scheme write)
        (scheme read)
        (scheme file)
        (scheme process-context)
        (srfi 1)
        (srfi 28))

(define (usage)
  (display "Usage:\n")
  (exit)
  0)

;; To capitalize the first letter
(define (list-set l i v)
  (if (= i 0)
      (cons v (cdr l))
      (cons (car l) (list-set (cdr l) (- i 1) v))))

(define (string-set s i v)
  (list->string (list-set (string->list s) i v)))

(define (capitalize-first s)
  (string-set s 0 (char-upcase (string-ref s 0))))

;; Dates
(define (list->date l)
  (define datemap
    '(() January February March April May
      June July August September October November December))
  (define month (list-ref datemap (list-ref l 1)))
  (format "~a ~a, ~a" month (list-ref l 2) (list-ref l 0)))

(define sheet-location
  (if (null? (cdr (command-line)))
      (usage)
      (cadr (command-line))))

(define sheet
  (let ((p (open-input-file sheet-location)))
    (define s (read p))
    (close-input-port p)
    s))

(define mode
  (cond
   ((null? (cddr (command-line)))
    'html)
   ((equal? (caddr (command-line)) "--html")
    'html)
   ((equal? (caddr (command-line)) "--txt")
    'txt)
   (else
    (usage))))

(if (> (length (command-line)) 3)
    (usage))

(define (write-to-html)
  (define (display-keyval k v)
    (display
     (format "
           <li>
             <div class=\"col\">~a</div>
             <div class=\"col\">~a</div>
           </li>
"
             k
             v)))
  (display
   (format "
<!DOCTYPE html>
<head>
 <title>~a</title>
 <style>
    table.charsheet {
      background-color: #c0e0f0;
    }

    .col {
      display: inline-block;
      width: 4cm;
    }

    .minicol {
      display: inline-block;
      width: 3cm;
    }

    td {
      vertical-align: top;
    }

    ul {
      list-style-type: none;
    }
    
    body {
      color: #000070;
    }
  </style>
</head>
<body>
  <table style=\"width:20cm\" class=\"charsheet\">
    <tr>
      <td>
        <ul>
          <li>
            <div class=\"col\">Name:</div>
            <div class=\"col\">~a</div>
          </li>
          <li>
            <div class=\"col\">Player:</div>
            <div class=\"col\">~a</div>
          </li>
          <li>
            <div class=\"col\">Date created:</div>
            <div class=\"col\">~a</div>
          </li>
        </ul>
      </td>
      <td>
        <ul>
          <li>
            <div class=\"col\">Race:</div>
            <div class=\"col\">~a</div>
          </li>
          <li>
            <div class=\"col\">Class:</div>
            <div class=\"col\">~a</div>
          </li>
          <li>
            <div class=\"col\">Unspent EP:</div>
            <div class=\"col\">~a</div>
          </li>
          <li>
            <div class=\"col\">Total EP:</div>
            <div class=\"col\">~a</div>
          </li>
        </ul>
      </td>
    </tr>
    <tr>
      <td colspan=\"2\">
       <ul>
        <li><b>Wounds</b></li>
        <li>
"
            (cadr (assq 'name (cdr sheet)))
            (cadr (assq 'name (cdr sheet)))
            (cadr (assq 'player (cdr sheet)))
            (list->date (cdr (assq 'date-created (cdr sheet))))
            (cadr (assq 'race (cdr sheet)))
            (cadr (assq 'class (cdr sheet)))
            (cadr (assq 'unspent-ep (cdr sheet)))
            (cadr (assq 'total-ep (cdr sheet)))))
  ;; Now damage types
  (for-each (lambda (l)
              (display "<div class=\"minicol\">")
              (for-each (lambda (x)
                          (if x (display "X ") (display "O ")))
                        (cdr l))
              (display "</div>"))
            (cdr (assq 'wounds (cdr sheet))))
  (display "</li><li>")
  (for-each (lambda (l)
              (display "<div class=\"minicol\">")
              (display (car l))
              (display "</div>"))
            (cdr (assq 'wounds (cdr sheet))))
  (display "</li>")
  ;; Now display the non-fixed areas
  (display "
        </ul>
      </td>
    </tr>
    <tr>
      <td>
        <ul>
          <li><b>Attributes</b></li>")
  (for-each (lambda (l)
              (display-keyval
               (string-append
                (string-upcase (symbol->string (car l)))
                ":")
               (cadr l)))
            (cdr (assq 'attributes (cdr sheet))))
  (display "
        </ul>
      </td>
      <td>
        <ul>
          <li><b>Skills</b></li>")
  (for-each (lambda (l)
              (display-keyval
               (string-append
                (capitalize-first (symbol->string (car l)))
                ":")
               (cadr l)))
            (cdr (assq 'skills (cdr sheet))))
  (display "
        </ul>
      </td>
    </tr>
    <tr>
      <td>
        <ul>
          <li><b>Gifts</b></li>")
  (for-each (lambda (s)
              (display (format "
          <li>~a</li>\n" s)))
            (cdr (assq 'gifts (cdr sheet))))
  (display "
        </ul>
      </td>
      <td>
        <ul>
          <li><b>Flaws</b></li>")
  (for-each (lambda (s)
              (display (format "
          <li>~a</li>\n" s)))
            (cdr (assq 'flaws (cdr sheet))))
  (display "
        </ul>
      </td>
    </tr>
    <tr>
      <td>
        <ul>
          <li><b>Inventory</b></li>\n")
  (for-each (lambda (l)
              (display (format "<li>~a ~a</li>\n"
                               (cadr l)
                               (car l))))
            (cdr (assq 'inventory (cdr sheet))))
  (display "
      </ul>
    </td>
   </tr>
   <tr>
    <td colspan=\"2\">
     <ul>
      <li><b>Story</b></li>
      <li>")
  (display (cadr (assq 'story (cdr sheet))))
  (display "
     </li>
     </ul>
    </td>
   </tr>
  </table>
</body>
</html>
"))

(write-to-html)