blob: 56bddd064b9507f04ceed0ba59d9b5c2752e9ee9 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
|
;;; wasp-genealogy --- Colonq Family Genealogy -*- lexical-binding: t; -*-
;;; Commentary:
;;; Code:
(require 'wasp-ai)
(require 'dash)
(require 's)
(require 'f)
(require 'ht)
(require 'cl-lib)
(load (w/asset "irish/genealogy-data.el"))
(cl-defstruct
(w/ancestor
(:constructor w/make-ancestor))
title
firstname
middlename
nickname
namesake
job
dateofbirth
dateofdeath
causeofdeath)
(defun w/ancestor-serialize (a)
"Serialize an ancestor A."
(list
(w/ancestor-title a)
(w/ancestor-firstname a)
(w/ancestor-middlename a)
(w/ancestor-nickname a)
(w/ancestor-namesake a)
(w/ancestor-job a)
(w/ancestor-dateofbirth a)
(w/ancestor-dateofdeath a)
(w/ancestor-causeofdeath a)))
(defun w/generate-name (era)
"Determine an appropriate name from ERA."
(let ((names (alist-get era w/era-names)))
(nth (random (length names)) names)))
(defun w/generate-job (era)
"Determine an appropriate job from ERA."
(let ((jobs (alist-get era w/era-jobs)))
(nth (random (length jobs)) jobs)))
(defun w/generate-nickname (era)
"Determine an appropriate job from ERA."
(let ((nicknames (alist-get era w/era-nicknames)))
(nth (random (length nicknames)) nicknames)))
(defun w/generate-birth-year ()
"Determine which year the astrally-focused ancestor was born."
(+ 1000 (random 1000)))
(defun w/year-era (year)
"Determine the era for YEAR."
(cond
((< year 1200) 'medievaltimes)
((< year 1400) 'ageofsail)
((< year 1800) 'renaissance)
((< year 1900) 'steampunk)
(t 'modern)))
(defun w/decide-title (era job)
"Determine the title for JOB in ERA."
(cl-case era
(medievaltimes (alist-get job w/medieval-titles nil nil #'s-equals?))
(steampunk "Sir")
(t nil)))
(defun w/generate-cause-of-death (anc k)
"Determine ANC's cause of death and pass it to K."
(w/ai
(w/describe-ancestor-short anc)
k
"Given a description of a fictional person, invent a plausible cause of death. The output should be no more than a single clause."
"Kingkaliente Vasher_1025 \"Grimaldi\" Colonq
Born 1429
Died 1519
Employed as: painting hanger"
"fell off a ladder"))
(defun w/generate-ancestor (user k)
"Search the genealogical record to find USER's namesake and pass the result to K."
(let* ((birthyear (w/generate-birth-year))
(era (w/year-era birthyear))
(job (w/generate-job era))
(has-nickname (= 0 (random 10)))
(nickname (when has-nickname (w/generate-nickname era)))
(ret
(w/make-ancestor
:title (w/decide-title era job)
:nickname nickname
:namesake user
:job job
:dateofbirth birthyear
:dateofdeath (+ birthyear (random 100))
:firstname (w/generate-name era))))
(if (= 0 (random 2))
(w/generate-cause-of-death
ret
(lambda (causeofdeath)
(setf (w/ancestor-causeofdeath ret) causeofdeath)
(funcall k ret)))
(setf (w/ancestor-causeofdeath ret) "unknown")
(funcall k ret)))
nil)
(defun w/ancestor-name (anc)
"Return the full name of ANC."
(s-concat
(if-let* ((tit (w/ancestor-title anc))) (s-concat tit " ") "")
(w/ancestor-firstname anc) " "
(s-titleize (w/ancestor-namesake anc)) " "
(if-let* ((nn (w/ancestor-nickname anc))) (s-concat "\"" nn "\" ") "")
"Colonq"
))
(defun w/describe-ancestor-short (anc)
"Describe ANC."
(s-concat
(w/ancestor-name anc) "\n"
(format "Born %s\n" (w/ancestor-dateofbirth anc))
(format "Died %s\n" (w/ancestor-dateofdeath anc))
(format "Employed as: %s\n" (w/ancestor-job anc))))
(defun w/describe-ancestor (anc)
"Describe ANC."
(s-concat
(w/describe-ancestor-short anc)
(format "Cause of death: %s\n" (w/ancestor-causeofdeath anc))))
(provide 'wasp-genealogy)
;;; wasp-genealogy.el ends here
|
