87 lines
3.1 KiB
Common Lisp
87 lines
3.1 KiB
Common Lisp
;; splork.lsp
|
|
;; Copyright (C) 2025 William R. Moore <william@nerderium.com>
|
|
|
|
;; This program is free software: you can redistribute it and/or modify
|
|
;; it under the terms of the GNU General Public License as published by
|
|
;; the Free Software Foundation, either version 3 of the License, or
|
|
;; (at your option) any later version.
|
|
|
|
;; This program is distributed in the hope that it will be useful,
|
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
;; GNU General Public License for more details.
|
|
|
|
;; You should have received a copy of the GNU General Public License
|
|
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
|
|
|
|
(setf *random-state* (make-random-state t))
|
|
|
|
(load "words.lsp")
|
|
(load "sent-struct.lsp")
|
|
|
|
(defun sentence-case (sentence)
|
|
"Changes the sentence to a capital case letter at the beginning."
|
|
(let* ((first-char (subseq (string-trim " " sentence) 0 1))
|
|
(rest-of-sentence (subseq (string-trim " " sentence) 1)))
|
|
(format nil "~A~A" (string-upcase first-char) rest-of-sentence)))
|
|
|
|
(defun find-pos (words pos excludeProper)
|
|
"Find the Part of Speech from the array"
|
|
(let* ((new-words '()))
|
|
(setf new-words (remove nil (mapcar (lambda (x) (and (equal pos (nth 1 x)) x)) words)))
|
|
(if (equal 'true excludeProper)
|
|
(setf new-words (remove nil (mapcar (lambda (x) (and (not (equal "PROPER" (nth 2 x))) x)) new-words)))
|
|
)
|
|
(nth 0 (nth (random (length new-words)) new-words))
|
|
))
|
|
|
|
(defun find-place-noun (words)
|
|
"Generates a word from the list of place nouns"
|
|
(let* ((new-words '()))
|
|
(setf new-words (remove nil (mapcar (lambda (x) (and (equal "NOUN" (nth 1 x)) x)) words)))
|
|
(setf new-words (remove nil (mapcar (lambda (x) (and (equal "PLACE" (nth 2 x)) x)) new-words)))
|
|
(nth 0 (nth (random (length new-words)) new-words))
|
|
))
|
|
|
|
(defun find-noun-with-article (words)
|
|
"Generates any articles necessary for a noun"
|
|
(let* ((new-words '())
|
|
(word ""))
|
|
(setf new-words (remove nil (mapcar (lambda (x) (and (equal "NOUN" (nth 1 x)) x)) words)))
|
|
(setf word (nth (random (length new-words)) new-words))
|
|
|
|
(if (string-equal "PROPER" (nth 2 word))
|
|
(nth 0 word)
|
|
(if (string-equal "PLACE" (nth 2 word))
|
|
(nth 0 word)
|
|
(cons "the " (nth 0 word))
|
|
)
|
|
)
|
|
))
|
|
|
|
(defun exec-lambda (x)
|
|
(apply (eval x) '()))
|
|
|
|
(defun splork ()
|
|
(let* ((compiled-results '())
|
|
(generated-sentence ""))
|
|
(setf compiled-results (mapcar #'exec-lambda *sentence-structures*))
|
|
(setf generated-sentence (nth (random (length compiled-results)) compiled-results))
|
|
(let* ( (interjection (find-pos words "INTERJECTION" 'false)) )
|
|
(if (<= 10 (random 10))
|
|
(if (string-equal "!" interjection)
|
|
(setf generated-sentence (format nil "~A ~A" interjection (sentence-case generated-sentence)))
|
|
(setf generated-sentence (format nil "~A ~A" interjection generated-sentence))
|
|
)
|
|
(setf generated-sentence (format nil "~A" (sentence-case generated-sentence)))
|
|
)
|
|
)
|
|
|
|
(if (not (string-equal "!" generated-sentence))
|
|
(setf generated-sentence (format nil "~A." generated-sentence))
|
|
)
|
|
generated-sentence))
|
|
|
|
(princ (splork))
|
|
(exit)
|