Ben / Nujel

;;; Nujel - Copyright (C) 2020-2021 - Benjamin Vincent Schulenburg
;;; This project uses the MIT license, a copy should be included under /LICENSE
;;;
;;; A very simple pseudo random number generator, suitable for the illusion of
;;; randomness
(def seed 0)

(defclass rng
  "A simple RNG"
  :export

  (defn seed! (self seed)
        "Set a new seed value for the RNG"
        (set! self :seed seed))

  (defn rng! (self)
        "Generate a random integer"
        (set! self :seed (+ 12345 (* (ref self :seed) 1103515245)))
        (bit-or (bit-shift-left (bit-and (ref self :seed) #xFFFF) 16)
                (bit-and (bit-shift-right (ref self :seed) 16) #xFFFF)))

  (defn int (self max)
        "Return a value from 0 to MAX, or, if left out, a random int"
        (if max (rem (abs (:rng! self)) max) (:rng! self))))


(defn new (seed)
      :export
      { :seed (or seed (bit-xor (time) (time/milliseconds)))
        :prototype* rng })

(defn rng! ()
      :export
      (set! seed (+ 12345 (* seed 1103515245)))
      (bit-or (bit-shift-left (bit-and seed #xFFFF) 16)
              (bit-and (bit-shift-right seed 16) #xFFFF)))

(defn seed! (new-seed)
      :export
      "Set a new seed value for the RNG"
      (set! seed new-seed))

(defn seed ()
      :export
      "Return the current RNG seed value"
      (return seed))

(defn random (max)
      :export-as int
      "Return a value from 0 to MAX, or, if left out, a random int"
      (if max
          (rem (abs (rng!)) max)
          (rng!)))

(defn seed-initialize! ()
      :export
      (set! seed (bit-xor (time) (time/milliseconds))))
(seed-initialize!)

(deftest #t (int? (random/int)))
(deftest #t (random/seed! 123) (def first-value (random/int)) (random/seed! 123) (= first-value (random/int)))
(deftest #t (random/seed! 99) (not= (random/int) (random/int)))
(deftest #t (int? (-> (random/new) :int)))
(deftest #t (def rng (random/new 123)) (def a (:int rng)) (:seed! rng 123) (= (:int rng) a))
(deftest #t (def rng (random/new 99)) (not= (:int rng) (:int rng)))