# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1485474831 0
# Node ID 02235ffe8b98669b349c6292b9fd230c0baa1c93
# Parent  326c2d62fcebfaa6598dcf445fce775f832ffbeb
Add a name generator

diff -r 326c2d62fceb -r 02235ffe8b98 package.lisp
--- a/package.lisp	Thu Jan 26 22:54:28 2017 +0000
+++ b/package.lisp	Thu Jan 26 23:53:51 2017 +0000
@@ -248,6 +248,16 @@
   (:export
     ))
 
+(defpackage :sand.names
+  (:use
+    :cl
+    :losh
+    :iterate
+    :sand.quickutils
+    :sand.utils)
+  (:export
+    ))
+
 
 (defpackage :sand.sketch
   (:use
diff -r 326c2d62fceb -r 02235ffe8b98 sand.asd
--- a/sand.asd	Thu Jan 26 22:54:28 2017 +0000
+++ b/sand.asd	Thu Jan 26 23:53:51 2017 +0000
@@ -76,6 +76,7 @@
                  (:file "story")
                  (:file "qud")
                  (:file "istruct")
+                 (:file "names")
                  (:module "turing-omnibus"
                   :serial t
                   :components ((:file "wallpaper")
diff -r 326c2d62fceb -r 02235ffe8b98 src/names.lisp
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/names.lisp	Thu Jan 26 23:53:51 2017 +0000
@@ -0,0 +1,87 @@
+(in-package :sand.names)
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (defun normalize-namespec (namespec)
+    (trivia:ematch namespec
+      ((list pre suf) (list (symbol-name pre)
+                            nil
+                            (symbol-name suf)))
+      ((list pre in suf) (list (symbol-name pre)
+                               (symbol-name in)
+                               (symbol-name suf)))))
+
+  (defun parse-namespecs (namespecs)
+    (let ((namespecs (mapcar #'normalize-namespec namespecs)))
+      (values (map 'vector #'first namespecs)
+              (remove nil (map 'vector #'second namespecs))
+              (map 'vector #'third namespecs)))))
+
+
+(defun generate-name (prefixes infixes suffixes)
+  (concatenate 'string
+               (random-elt prefixes)
+               (if (randomp)
+                 (random-elt infixes)
+                 "")
+               (random-elt suffixes)))
+
+
+(defun build-name-generator% (prefixes infixes suffixes)
+  (lambda ()
+    (generate-name prefixes infixes suffixes)))
+
+(defun build-name-generator (namespecs)
+  (multiple-value-call #'build-name-generator% (parse-namespecs namespecs)))
+
+
+(defmacro define-name-generator (symbol &body namespecs)
+  (multiple-value-bind (prefixes infixes suffixes)
+      (parse-namespecs namespecs)
+    `(defun ,symbol ()
+       (generate-name ,prefixes ,infixes ,suffixes))))
+
+
+(define-name-generator icelandic-name
+  (si grun)
+  (kri strún)
+  (snó rri)
+  (au ður)
+  (na nna)
+  (gu nnar)
+  (fa nney)
+  (si gu rður)
+  (ha fdís)
+  (pa lmí)
+  (ha rpa)
+  (sæ var)
+  (ei nar)
+  (ra gnar)
+  (ra gnhei ður)
+  (ma gnus)
+  (hau kur)
+  (bja rtur)
+  (ey þór)
+  (si gu rbjörg)
+  (da rri)
+  (þo rva ldur))
+
+
+(define-name-generator spanish-name
+  (Sa ntia go)
+  (Se ba stián)
+  (Ma tías)
+  (Ma teo)
+  (Ni co lás)
+  (Ale ja ndro)
+  (Die go)
+  (Sa muel)
+  (Benja mín)
+  (So fia)
+  (I sa bella)
+  (Ca mi la)
+  (Va lenti na)
+  (Va le ria)
+  (Ma ria na)
+  (Lu cia nia)
+  (Da niela)
+  (Ga brie la))