おっぱいそんちくびんびん♪ (common Lisp)

おっぱい.lisp

;;;;
;;;;  おっぱい.lisp
;;;;
;;;;  2019/08/24: initial release
;;;;
;;;;    Microsoft Windows 10 Version 1903 (OS build 18362.295)
;;;;
;;;;      Clozure Lisp Version 1.11.5/v1.11.5  (WindowsX8664)
;;;;
;;;;        How to build:
;;;;        $ wx86cl64 --no-init --load おっぱい.lisp
;;;;        $ ./おっぱい
;;;;
;;;;    Ubuntu 18.04.2 LTS (Bionic Beaver)
;;;;
;;;;      Steel Bank Common Lisp (SBCL) 1.4.3
;;;;
;;;;        How to build:
;;;;        $ sbcl --noinform --no-sysinit --no-userinit --load おっぱい.lisp
;;;;        $ ./おっぱい
;;;;
;;;;      GNU CLISP 2.49.60+ (2017-06-25) (built on lgw01-amd64-012.buildd [127.0.1.1])
;;;;
;;;;        How to build:
;;;;        $ clisp -norc おっぱい.lisp
;;;;        $ ./おっぱい
;;;;
;;;;  Dedicated to shirasu
;;;;  https://gist.github.com/8q/a5331c6ef8a205b32125
;;;;

(defparameter *real-str* "おっぱいそんちくびんびん")
(defparameter *oppai-elements* '("おっ" "ぱい" "そん" "ちく" "びん" "びん"))

(defun shuffle (sequence)
  (loop for i from (length sequence) downto 2
        do (rotatef (elt sequence (random i))
                    (elt sequence (1- i))))
  sequence)

(defun make-num-list()
  (shuffle '(0 1 2 3 4 5)))

(defun make-test-str()
  (format nil "~{~A~}"
    (mapcar #'(lambda (n) (nth n *oppai-elements*))(make-num-list))))

(defun congratulations(count)
  (format t "~A~A~A~D~A~A~A~%"
    "おめでとうございます！" " "
    "あなたは" count "回目に" *real-str* "しました。"))

(defun main-loop()
  (let ((*count 0) (test-str ""))
    (loop
      (setf *count (+ 1 *count))
      (setf test-str (make-test-str))
      (format t "~D ~A~%" *count test-str)
      (if (equal test-str *real-str*)
        (return (congratulations *count)) ))))

(defun oppai()
  (setf *random-state* (make-random-state t))
  (main-loop)
  (format t "end~%")
#+clisp (ext:quit)
  )

; If you use REPL only, comment out the following.
#+ccl (ccl:save-application "おっぱい"
#+ccl                       :toplevel-function #'oppai
#+ccl                       :prepend-kernel t)
#+sbcl (sb-ext:save-lisp-and-die "おっぱい"
#+sbcl                           :toplevel #'oppai
#+sbcl                           :executable t)
#+clisp (ext:saveinitmem "おっぱい"
#+clisp                  :quiet t
#+clisp                  :norc t
#+clisp                  :init-function #'oppai
#+clisp                  :executable t)