procgen  threat.scm at trunk

File threat.scm artifact e796932c22 on branch trunk


(include "lib/lisp-macro.scm")
(include "lib/bot.scm")

(rule (maybe x) (x) (""))
(rule (maybe_ x) (x " "))
(rule (maybe* x) ((x)) (""))
(rule (maybe_* x) ((x) " ") (""))

(bank pronoun 'me 'you 'thou 'they 'him 'her 'myself)
(define pronouns '(
  (you    (nom . "you")  (acc . "you")  (gen . "your")  (poss . "yours")  (cop . "you're"))
  (thou   (nom . "thou") (acc . "thee") (gen . "thy")   (poss . "thine")  (cop . "thou art"))
  (they   (nom . "they") (acc . "them") (gen . "their") (poss . "theirs") (cop . "they're"))
  (her    (nom . "her")  (acc . "her")  (gen . "her")   (poss . "hers")   (cop . "she's"))
  (him    (nom . "he")   (acc . "him")  (gen . "his")   (poss . "his")    (cop . "he's"))
  (me	  (nom . "I")    (acc . "me")   (gen . "my")    (poss . "mine")   (cop . "I'm"))
  (myself (nom . "I") 	 (acc . "myself") (gen . "my own") (poss . "my own") (cop . "I'm"))))

(define (thy x) (string-append (inflect 'gen (pronoun)) " " x))

(bank article 'def 'indef 'dem-prox 'dem-dist)
(define (decline art nm n)
  ; art = (def indef dem-prox dem-dist)
  (let* ([sg (if (pair? (cdr n)) (cadr n) (cdr n))]
		 [pl (if (pair? (cdr n)) (cddr n) (string-append sg "s"))]
		 [vwl (car n)]
		 [sel (if (eq? nm 'sg) sg pl)])
	(apply string-append (case art
	  ((def)  (list "the " sel))
	  ((indef) (case nm
				 ((sg) (case vwl
						 ((a) (list "a " sel))
						 ((an) (list "an " sel))))
				 ((pl) (list sel))))
	  ((dem-prox) (case nm
					((sg) (list "this " sel))
					((pl) (list "these " sel))))
	  ((dem-dist) (case nm
					((sg) (list "that " sel))
					((pl) (list "those " sel))))))))

(bank relatives
	  "mother" "mom" "father" "dad" "aunt" "uncle" "dog" "friend" "granny"
	  "grandma" "grandfather" "grandpa" "grandmother")
(bank jobs
	  '(a . "banker")   '(a ."porn star") '(a . "general") '(a . "president") 
	  '(a . "janitor") '(an ."executive") '(a . ("sheep" . "sheep")) '(a . ("spy" . "spies"))
	  '(a . "fed") '(a . "war criminal"))

(rule (actors)
	  ((pronoun))
	  ((thy (relatives)))
	  ((decline (article) (one-of 'sg 'pl) (jobs)))
	  ((inflect 'gen (pronoun)) " " (relatives)))

(define (conjugate v t n)
  (if (eq? v 'cop)
	(case (cons t n) )))
	

(define (inflect c n)
  (if (string? n)
	(case c
	  ((nom acc)  n)
	  ((gen poss cop) (string-append n "'s")))
	; else
	  (cdr (assq c (cdr (assq n pronouns))))))

(bank organ
	  "balls" "gut" "face" "head" "nose" "brain" "heart"
	  "ass" "tits" "duodenum" "kidneys" "pooper")

(rule (action victim)
  ("port " (inflect 'acc victim) " to lisp")
  ("rain on " (inflect 'gen victim) " parade")
  ((one-of "shoot" "stab") " " (inflect 'acc victim) " in the " (organ))
  ("impale " (inflect 'acc victim)
   (@ ("") (" on " (one-of "the flagpole" "a spike" "the terrorspike"))))
  ("demolish " (inflect 'gen victim) " house")
  ("have " (inflect 'acc victim) " " (one-of "sent" "deported") " "
   (maybe "straight ") "to "
   (one-of "Siberia" "the north pole" "Betelgeuse" "the moon" "Cleveland")))

(rule (subject actor)
  ((inflect 'cop actor) " gonna")
  ((inflect 'cop actor) " " (one-of "fixing" "plotting" "planning" "scheming") " to"))
  ; ((inflect 'nom actor) " swear to"))

(rule (clause actor victim)
	  ((subject actor) " " (action victim)))
  
(print (clause (actors) (actors)))
  ; ((inflect
	; (pick '#(nom acc gen poss))
	; (pick actors)))

;(print (action "you"))