(load "textgen.ss")

(define capitalize
  (lambda (str)
    (string-append (string (char-upcase (string-ref str 0)))
                   (substring str 1 (string-length str)))))

(define parts-of-speech
   (list 'adjective 'article 'noun 'tverb 'iverb 'name))

(define build-from-symbol
  (lambda (symbol)
    (cond
      ((eq? symbol 'adjective) (generate-part-of-speech 'adjective))
      ((eq? symbol 'article) (generate-part-of-speech 'article))
      ((eq? symbol 'intransitive-verb) (generate-part-of-speech 'iverb))
      ((eq? symbol 'name) (generate-part-of-speech 'name))
      ((eq? symbol 'noun) (generate-part-of-speech 'noun))
      ((eq? symbol 'transitive-verb) (generate-part-of-speech 'tverb))
      ((eq? symbol 'period) " ")
      ((eq? symbol 'space) " ")
      (else (symbol->string symbol)))))

(define build
  (lambda (structure)
    (cond 
      ; Strings we accept verbatim
      ((string? structure) structure)
      ; Symbols we translate accordingly
      ((symbol? structure) (build-from-symbol structure))
      ; Lists require us to build the arguments recursively and then
      ; apply the procedure
      (else (apply-procedure (car structure) (build-all (cdr structure)))))))

(define build-all
  (lambda (structures)
     (if (null? structures)
         null
         (cons (build (car structures))
               (build-all (cdr structures))))))

(define join
  (lambda (strings)
    (if (null? strings)
        ""
        (string-append (car strings) (join (cdr strings))))))

(define apply-procedure
  (lambda (proc params)
    (cond
      ((eq? proc 'join) (join params))
      ((eq? proc 'capitalize) (capitalize (car params)))
      (else (symbol->string proc)))))

(define random-structure
  (lambda (fname)
    (let ((port (open-input-file fname))
          (rnd (random 1000)))
      (letrec ((kernel (lambda (num)
                         (let ((entry (read port)))
                           (if (< num (cadr entry))
                               (begin (close-input-port port)
                                      (build (car entry)))
                               (kernel (- num (cadr entry))))))))
        (kernel rnd)))))