The Third Dynasty of pokes: helper code
Jump to navigation
Jump to search
The schema of a sqlite database with gamestate information:
CREATE TABLE player (
name text primary key,
slush integer,
active integer,
integrity integer,
money integer
);
CREATE TABLE client (
name text primary key,
shortname text unique,
attorney text,
villainy integer,
worth integer,
type text
);
CREATE TABLE cases (
id integer,
open integer,
plaintiff text,
defendant text,
accusation text,
p_guilt integer,
d_guilt integer,
foreign key(plaintiff) references client(name),
foreign key(defendant) references client(name)
);
CREATE TABLE representation (
client text,
player text, active,
foreign key(client) references client(name),
foreign key(player) references player(name)
);
CREATE VIEW active_representation as select client, player from representation inner join player
where player.name = representation.player and player.active = 1 and representation.active = 1;
The final version of pokes-iii.lisp. "If either Party of the Case is represented by an Attorney who is already representing a Party in another Open Case, skip the rest of this atomic action" is not implemented; I did this step by hand.
(defpackage #:pokes-iii
(:use #:cl))
(in-package #:pokes-iii)
(defvar *crimes*
'("Arson" "Burglary" "Murder" "Perjury" "Jaywalking"))
(defvar *complaints*)
(setf *complaints*
'("Personal Injury" "Defamation" "Negligence" "Malpractice" "Probate" "Unpaid Debt"))
(defun prompt-gndt (options)
"Pick a random option from the GNDT. Substitutable for SECRETLY-RANDOM."
(loop :for opt :in options :do
(progn (princ opt) (princ " ")))
(princ "DICE") (princ (length options))
(terpri)
(princ ">>> ")
(- (read) 1))
(defun secretly-random (options)
"Pick a random option secretly. Substitutable for PROMPT-GNDT."
(format t "[random of: ~a] " options)
(let* ((n (length options))
(c (random n)))
(format t "~a/~a~%" c n)
c))
;;(random (length options)))
(defun is-business-p (db name)
"Check if NAME is a business, for the purposes of transforming complaint to unpaid debt."
(< 0 (sqlite:execute-single
db "select count(*) from client where name=? and type='business';" name)))
(defun verify-integrity (db)
"Find player/client pairs that have current representation and the player is mistrusted."
(let ((reps (sqlite:execute-to-list
db "select p.name, c.name, p.integrity, c.villainy from player as p inner join active_representation as r inner join client as c where r.player = p.name and r.client = c.name;"))
(ok t))
(loop :for r :in reps :do
(when (> 5 (+ (third r) (fourth r)))
(setf ok nil)
(format t "*** ~a mistrusts ~a~%" (second r) (first r))))
(if ok (format t "everything is okay~%"))))
(defun set-client-worth-by-name (db name worth)
(format t "*** update the worth of ~a: ~a~%" name worth)
(sqlite:execute-non-query
db "update client set worth=? where name=?;" worth name))
(defun get-client-worth-by-name (db name)
(sqlite:execute-single db "select worth from client where name=?;" name))
(defun increase-client-worth-by-name (db name inc)
(let* ((worth (get-client-worth-by-name db name))
(new-worth (+ worth inc)))
(format t "*** increasing the worth of ~a: ~a -> ~a~%" name worth new-worth)
(sqlite:execute-non-query
db "update client set worth=? where name=?;" new-worth name)))
(defun increase-player-money-loudly (db player inc)
(let* ((money (sqlite:execute-single db "select money from player where name=?;" player))
(new-money (max 0 (+ money inc))))
(format t "*** increase the public money of ~a: ~a -> ~a~%" player money new-money)
(sqlite:execute-non-query
db "update player set money=? where name=?;" new-money player)))
(defun increase-player-money-quietly (db player inc)
(let* ((slush (sqlite:execute-single db "select slush from player where name=?;" player))
(new-slush (+ slush inc)))
(format t "*** notify ~a of slush fund increase: ~a -> ~a~%" player slush new-slush)
(sqlite:execute-non-query
db "update player set slush=? where name=?;" new-slush player)))
(defun attorneys-of (db client)
"Get the (string) names of all players representing CLIENT."
(mapcar #'first
(sqlite:execute-to-list
db "select player from active_representation where client=?;" client)))
(defun is-represented-p (db client)
"Test if CLIENT has any representation."
(if (= 0 (length (attorneys-of db client))) nil t))
(defun is-represented-by-p (db client player)
"Test if CLIENT is represented by PLAYER."
(if (= 0 (sqlite:execute-single
db "select count(*) from active_representation where player=? and client=?;"
player client))
nil t))
(defun decrease-player-integrity-loudly (db player decrement)
(let* ((integrity (sqlite:execute-single db "select integrity from player where name=?;" player))
(new-integrity (max 0 (- integrity decrement))))
(format t "*** integrity of player ~a decreases: ~a -> ~a~%" player integrity new-integrity)
(sqlite:execute-non-query db "update player set integrity=? where name=?;" new-integrity player)))
(defun adjust-guilt-by-votes (db guilt party other-party
votes-for votes-against votes-veto)
(let ((adj-guilt guilt))
(loop :for vote :in votes-for :do
(when (is-represented-by-p db party vote)
(format t "adjusting guilt of ~a via FOR vote from ~a: ~a -> ~a~%" party vote
adj-guilt (- adj-guilt 2))
(increase-player-money-loudly db vote -2000)
(decf adj-guilt 2)))
(setf adj-guilt (max 0 adj-guilt))
(loop :for vote :in votes-against :do
(when (is-represented-by-p db other-party vote)
(format t "adjusting guilt of ~a via AGAINST vote from ~a: ~a -> ~a~%" party vote
adj-guilt (+ adj-guilt 1))
(decrease-player-integrity-loudly db vote 1)
(incf adj-guilt 1)))
(loop :for vote :in votes-veto :do
(when (is-represented-by-p db party vote)
(format t "adjusting guilt of ~a via VETO vote from ~a: ~a -> ~a~%" party vote
adj-guilt (+ adj-guilt 10))
(decrease-player-integrity-loudly db vote 2)
(incf adj-guilt 10)))
adj-guilt))
(defun check-spelling (db player)
(if (= 0 (sqlite:execute-single db "select count(*) from player where name=?;" player))
(error "player ~a wasn't found in the database" player)))
(defun check-all-spellings (db players)
(loop :for p :in players :do (check-spelling db p)))
(defun generate-case (db)
(sqlite:with-transaction db
(when (< 2 (sqlite:execute-single
db "select count(*) from cases where open=1;"))
(format t "aborting: 2 open cases already~%")
(return-from generate-case nil))
(let* ((clients
(sqlite:execute-to-list
db "select name, shortname, villainy, type from client;"))
;;(nclients (length clients))
(plaintiff-id
(secretly-random (mapcar #'second clients))) ;; formerly prompt-gndt
(plaintiff (nth plaintiff-id clients))
(defendants
(remove-if (lambda (c) (or (eq c plaintiff)
(equal (fourth c) "state"))) clients))
(defendant-id
(secretly-random (mapcar #'second defendants)))
(defendant (nth defendant-id defendants)))
(format t "preliminary: ~a v ~a~%" (first plaintiff) (first defendant))
(when (or (< 0 (length (intersection (attorneys-of db (first plaintiff))
(attorneys-of db (first defendant))
:test #'equal)))
(not (is-represented-p db (first plaintiff)))
(not (is-represented-p db (first defendant))))
(format t "aborting: no or bad representation~%")
(return-from generate-case nil))
(let* ((complaint
(if (equal (fourth plaintiff) "state")
(nth (prompt-gndt *crimes*) *crimes*)
(nth (prompt-gndt *complaints*) *complaints*)))
(plaintiff-guilt (random (1+ (* 2 (third plaintiff)))))
(defendant-guilt (random (1+ (* 2 (third defendant)))))
(case-id (progn (princ "case id>>> ") (read))))
(if (and (equal complaint "Probate")
(or (is-business-p db (first plaintiff)) (is-business-p db (first defendant))))
(setf complaint "Unpaid Debt"))
(if (= plaintiff-guilt defendant-guilt)
(if (= (random 2) 0) (incf plaintiff-guilt) (incf defendant-guilt)))
(format t "... plaintiff: ~a (guilt ~a) defendant: ~a (guilt ~a) complaint: ~a~%"
(first plaintiff) plaintiff-guilt
(first defendant) defendant-guilt
complaint)
(sqlite:execute-non-query
db "insert into cases values (?, 1, ?, ?, ?, ?, ?);"
case-id (first plaintiff) (first defendant) complaint
plaintiff-guilt defendant-guilt)
(loop :for rep :in (attorneys-of db (first plaintiff))
:do (format t "*** notify attorney ~a of plaintiff ~a guilt ~a~%"
rep (first plaintiff) plaintiff-guilt))
(loop :for rep :in (attorneys-of db (first defendant))
:do (format t "*** notify attorney ~a of defendant ~a guilt ~a~%"
rep (first defendant) defendant-guilt))
(list plaintiff defendant plaintiff-guilt defendant-guilt complaint)))))
(defun resolve-case (db case-id votes-for votes-against votes-veto)
(sqlite:with-transaction db
(check-all-spellings db votes-for)
(check-all-spellings db votes-against)
(check-all-spellings db votes-veto)
(multiple-value-bind
(plaintiff-name defendant-name p-guilt d-guilt)
(sqlite:execute-one-row-m-v
db "select plaintiff, defendant, p_guilt, d_guilt from cases where id=?" case-id)
(setf p-guilt (adjust-guilt-by-votes db p-guilt plaintiff-name defendant-name
votes-for votes-against votes-veto))
(setf d-guilt (adjust-guilt-by-votes db d-guilt defendant-name plaintiff-name
votes-for votes-against votes-veto))
(let* ((plaintiff-won (< p-guilt d-guilt))
(defendant-worth (get-client-worth-by-name db defendant-name))
(winner-name (if plaintiff-won plaintiff-name defendant-name))
(loser-name (if plaintiff-won defendant-name plaintiff-name))
(winner-attorneys
(mapcar #'first
(sqlite:execute-to-list
db "select player from active_representation where client=?;"
winner-name)))
(fee (if plaintiff-won (floor (* defendant-worth 0.3)) 0)))
(format t "the fine is: ~a~%" fee)
(increase-client-worth-by-name db winner-name (floor (* fee 0.9)))
(increase-client-worth-by-name db loser-name (- fee))
(loop :for player :in winner-attorneys :do
(let ((repped (< 0 (count-if (lambda (v) (equal v player)) votes-for))))
(if repped
(increase-player-money-loudly db player (floor (* fee 0.1)))
(increase-player-money-quietly db player (floor (* fee 0.1))))))
(sqlite:execute-non-query db "update cases set open=0 where id=?;" case-id)))))
