unofficial mirror of guile-user@gnu.org 
 help / color / mirror / Atom feed
* fortune-cookie
@ 2004-06-15 16:21 Thien-Thi Nguyen
  0 siblings, 0 replies; only message in thread
From: Thien-Thi Nguyen @ 2004-06-15 16:21 UTC (permalink / raw)
  Cc: guile-user

(use-modules (database binconv) (scripts slurp))

(define (fortune-cookie cookie-file)

  (let* ((port (open-input-file (string-append cookie-file ".dat")))
         (readw (let ((s (make-string 4)))
                  (lambda ()
                    (string-set! s 0 (read-char port))
                    (string-set! s 1 (read-char port))
                    (string-set! s 2 (read-char port))
                    (string-set! s 3 (read-char port))
                    (integer-byte-string->integer s #f #t)))))

    (define (read-header)
      (list (cons #:version  (readw))
            (cons #:count    (readw))
            (cons #:longest  (readw))
            (cons #:shortest (readw))
            (cons #:flags    (let* ((w (readw))
                                    (chk (lambda (mask val)
                                           (if (= 0 (logand mask w))
                                               '()
                                               (list val)))))
                               `(,@(chk #x1 #:random)
                                 ,@(chk #x2 #:ordered)
                                 ,@(chk #x4 #:rotated))))
            (cons #:delim    (read-char port))
            (cons #:filler   (list (read-char port)
                                   (read-char port)
                                   (read-char port)))))

    ;; do it!
    (let* ((header (read-header))
           (selection (random (assq-ref header #:count)))
           (start (do ((i 0 (1+ i)))
                      ((= i selection) (readw))
                    (readw)))
           (finish (readw))
           (len (- finish start 2))
           (cookie (make-string len)))
      (slurp-file! cookie cookie-file start len 0)
      (display cookie))))

;;(set! *random-state* (seed->random-state (current-time)))
;;(fortune-cookie "lambda.txt") ; use strfile(1) to make lambda.txt.dat


_______________________________________________
Guile-user mailing list
Guile-user@gnu.org
http://lists.gnu.org/mailman/listinfo/guile-user


^ permalink raw reply	[flat|nested] only message in thread

only message in thread, other threads:[~2004-06-15 16:21 UTC | newest]

Thread overview: (only message) (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2004-06-15 16:21 fortune-cookie Thien-Thi Nguyen

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).