codepad

Language:

; slots

(define rand #f)
(define randint #f)
(let ((two31 #x80000000) (a (make-vector 56 -1)) (fptr #f))
  (define (mod-diff x y) (modulo (- x y) two31)) ; generic version
  ; (define (mod-diff x y) (logand (- x y) #x7FFFFFFF)) ; fast version
  (define (flip-cycle)
    (do ((ii 1 (+ ii 1)) (jj 32 (+ jj 1))) ((< 55 jj))
      (vector-set! a ii (mod-diff (vector-ref a ii) (vector-ref a jj))))
    (do ((ii 25 (+ ii 1)) (jj 1 (+ jj 1))) ((< 55 ii))
      (vector-set! a ii (mod-diff (vector-ref a ii) (vector-ref a jj))))
    (set! fptr 54) (vector-ref a 55))
  (define (init-rand seed)
    (let* ((seed (mod-diff seed 0)) (prev seed) (next 1))
      (vector-set! a 55 prev)
      (do ((i 21 (modulo (+ i 21) 55))) ((zero? i))
        (vector-set! a i next) (set! next (mod-diff prev next))
        (set! seed (+ (quotient seed 2) (if (odd? seed) #x40000000 0)))
        (set! next (mod-diff next seed)) (set! prev (vector-ref a i)))
      (flip-cycle) (flip-cycle) (flip-cycle) (flip-cycle) (flip-cycle)))
  (define (next-rand)
    (if (negative? (vector-ref a fptr)) (flip-cycle)
      (let ((next (vector-ref a fptr))) (set! fptr (- fptr 1)) next)))
  (define (unif-rand m)
    (let ((t (- two31 (modulo two31 m))))
      (let loop ((r (next-rand)))
        (if (<= t r) (loop (next-rand)) (modulo r m)))))
  (init-rand 19380110) ; happy birthday donald e knuth
  (set! rand (lambda seed
    (cond ((null? seed) (/ (next-rand) two31))
          ((eq? (car seed) 'get) (cons fptr (vector->list a)))
          ((eq? (car seed) 'set) (set! fptr (caadr seed))
                                 (set! a (list->vector (cdadr seed))))
          (else (/ (init-rand (modulo (numerator
                  (inexact->exact (car seed))) two31)) two31)))))
  (set! randint (lambda args
    (cond ((null? (cdr args))
            (if (< (car args) two31) (unif-rand (car args))
              (floor (* (next-rand) (car args)))))
          ((< (car args) (cadr args))
            (let ((span (- (cadr args) (car args))))
              (+ (car args)
                 (if (< span two31) (unif-rand span)
                   (floor (* (next-rand) span))))))
          (else (let ((span (- (car args) (cadr args))))
                  (- (car args)
                     (if (< span two31) (unif-rand span)
                       (floor (* (next-rand) span))))))))))

(define wheel #("BAR" "BELL" "ORANGE" "LEMON" "PLUM" "CHERRY"))

(define (display-instructions)
  (display "WELCOME TO THE CASINO") (newline)
  (display "BET IN INCREMENTS OF FROM TO 00") (newline)
  (display "BET bash WHEN YOU ARE FINISHED") (newline))

(define (pull n)
  (let ((x (randint 6)) (y (randint 6)) (z (randint 6)))
    (display (vector-ref wheel x)) (display " ")
    (display (vector-ref wheel y)) (display " ")
    (display (vector-ref wheel z)) (newline)
    (cond ((= x y z 0)
            (let ((d (* 101 n)))
              (display "***JACKPOT***") (newline)
              (display "YOU WIN $") (display d) (newline) d))
          ((= x y z)
            (let ((d (* 11 n)))
              (display "***TOP DOLLAR***") (newline)
              (display "YOU WIN $") (display d) (newline) d))
          ((or (= x y 0) (= x z 0) (= y z 0))
            (let ((d (* 6 n)))
              (display "***DOUBLE BAR***") (newline)
              (display "YOU WIN $") (display d) (newline) d))
          ((or (= x y) (= x z) (= y z))
            (let ((d (* 3 n)))
              (display "***DOUBLE***") (newline)
              (display "YOU WIN $") (display d) (newline) d))
          (else (display "YOU LOSE $") (display n) (newline) (- n)))))

(define (play)
  (display-instructions)
  (display "ENTER YOUR BET: ")
  (let loop ((bet (read)) (purse 0))
    (cond ((or (not (integer? bet)) (negative? bet))
            (display "ENTER YOUR BET: ")
            (loop (read) purse))
          ((< 100 bet)
            (display "HOUSE LIMIT 00") (newline)
            (display "ENTER YOUR BET: ") (loop (read) purse))
          ((<= 1 bet 100)
            (let* ((p (pull bet)) (purse (+ p purse)))
              (cond ((positive? purse)
                      (display "YOU HAVE $") (display purse))
                    ((negative? purse)
                      (display "YOU OWE $") (display (- purse)))
                    (else (display "YOU ARE EVEN")))
              (newline) (display "ENTER YOUR BET: ")
              (loop (read) purse)))
          ((negative? purse)
            (display "PLACE $") (display (- purse))
            (display " ON THE KEYBOARD") (newline))
          ((positive? purse)
            (display "COLLECT $") (display purse)
            (display " FROM THE CASHIER") (newline))
          (else (display "YOU BROKE EVEN") (newline)))))

Private [?]

Run code