← Back to branch summary

~ubuntu-branches/ubuntu/quantal/cl-kmrcl/quantal

« back to all changes in this revision

Viewing changes to random.lisp

  • Committer: Bazaar Package Importer
  • Author(s): Kevin M. Rosenberg
  • Date: 2004-06-12 08:14:46 UTC
  • Revision ID: james.westby@ubuntu.com-20040612081446-7fylzj3qe93x2ugp
Tags: upstream-1.73
Import upstream version 1.73

Show diffs side-by-side

added added

removed removed

Lines of Context:
random.lisp
 
1
;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
 
2
;;;; *************************************************************************
 
3
;;;; FILE IDENTIFICATION
 
4
;;;;
 
5
;;;; Name:          random.lisp
 
6
;;;; Purpose:       Random number functions for KMRCL package
 
7
;;;; Programmer:    Kevin M. Rosenberg
 
8
;;;; Date Started:  Apr 2000
 
9
;;;;
 
10
;;;; $Id: random.lisp 8573 2004-01-29 23:30:50Z kevin $
 
11
;;;;
 
12
;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg
 
13
;;;;
 
14
;;;; KMRCL users are granted the rights to distribute and use this software
 
15
;;;; as governed by the terms of the Lisp Lesser GNU Public License
 
16
;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
 
17
;;;; *************************************************************************
 
18
 
 
19
(in-package #:kmrcl)
 
20
 
 
21
(defun seed-random-generator ()
 
22
  "Evaluate a random number of items"
 
23
  (let ((randfile (make-pathname 
 
24
                   :directory '(:absolute "dev") 
 
25
                   :name "urandom")))
 
26
    (setf *random-state* (make-random-state t))
 
27
    (if (probe-file randfile)
 
28
        (with-open-file
 
29
            (rfs randfile :element-type 'unsigned-byte)
 
30
          (let* 
 
31
              ;; ((seed (char-code (read-char rfs))))
 
32
              ((seed (read-byte rfs)))
 
33
            ;;(format t "Randomizing!~%")
 
34
            (loop
 
35
                for item from 1 to seed
 
36
                do (loop
 
37
                       for it from 0 to (+ (read-byte rfs) 5)
 
38
                       do (random 65536))))))))
 
39
 
 
40
 
 
41
(defmacro random-choice (&rest exprs)
 
42
  `(case (random ,(length exprs))
 
43
     ,@(let ((key -1))
 
44
         (mapcar #'(lambda (expr)
 
45
                     `(,(incf key) ,expr))
 
46
                 exprs))))
 
47