421231bbf89f

Refuckulate the armor/weapon gen
[view raw] [browse files]
author Steve Losh <steve@stevelosh.com>
date Thu, 19 Jan 2017 22:52:27 +0000
parents 8163984906d6
children 5ac0bb8b19b5
branches/tags (none)
files src/database.lisp src/main.lisp src/robots/rpg-shopkeeper.lisp

Changes

--- a/src/database.lisp	Thu Jan 19 18:23:28 2017 +0000
+++ b/src/database.lisp	Thu Jan 19 22:52:27 2017 +0000
@@ -6,6 +6,10 @@
   (setf *database* (connect path))
   (values))
 
+(defun check-db ()
+  (when (null *database*)
+    (error "You forgot to run (spinup) again you fuckin moron.")))
+
 (defun db-initialize ()
   (execute-non-query *database*
     "CREATE TABLE IF NOT EXISTS tweets(
@@ -20,6 +24,7 @@
   (values))
 
 (defun db-insert-tweet (account tweet)
+  (check-db)
   (execute-non-query *database*
     "INSERT INTO tweets (account, content) VALUES (?, ?)"
     (aesthetic-string account)
@@ -28,6 +33,7 @@
 
 (defun db-tweeted-since-p (account minutes-ago)
   (check-type minutes-ago (integer 1))
+  (check-db)
   (ensure-boolean
     (execute-single *database*
       "SELECT content FROM tweets
--- a/src/main.lisp	Thu Jan 19 18:23:28 2017 +0000
+++ b/src/main.lisp	Thu Jan 19 22:52:27 2017 +0000
@@ -1,5 +1,26 @@
 (in-package :magitek)
 
+(defclass* bot () (name generator hours))
+
+(defun make-bot (name generator hours)
+  (make-instance 'bot :name name :generator generator :hours hours))
+
+
+(define-with-macro bot
+  name generator hours)
+
+
+(defparameter *git-commands*
+  (make-bot :git-commands
+            #'magitek.robots.git-commands:random-string
+            12))
+
+(defparameter *rpg-shopkeeper*
+  (make-bot :rpg-shopkeeper
+            #'magitek.robots.rpg-shopkeeper:random-string 
+            12))
+
+
 (defun hours-to-minutes (h)
   (* h 60))
 
@@ -10,24 +31,27 @@
     (finding (funcall generator) :such-that #'tt-tweetable-p)))
 
 
-(defun run-bot (name generator &key (hours 12))
-  (format t "Running ~S~%" name)
-  (when (not (db-tweeted-since-p name (hours-to-minutes hours)))
-    (let ((tweet (generate-tweet generator)))
-      (if (null tweet)
-        (format t "Could not generate a suitable tweet for ~S~%" name)
-        (progn
-          (format t "Tweeting as ~S: ~S~%" name tweet)
-          (db-insert-tweet name tweet)
-          (tt-tweet name tweet)
-          (sleep 5.0))))))
+(defun run-bot (bot &key (force nil))
+  (with-bot (bot)
+    (format t "Running ~S~%" name)
+    (when (or force
+              (not (db-tweeted-since-p name (hours-to-minutes hours))))
+      (let ((tweet (generate-tweet generator)))
+        (if (null tweet)
+          (format t "Could not generate a suitable tweet for ~S~%" name)
+          (progn
+            (format t "Tweeting as ~S: ~S~%" name tweet)
+            (db-insert-tweet name tweet)
+            (tt-tweet name tweet)
+            (sleep 5.0)))))))
 
 
-(defun main ()
+(defun spinup ()
   (db-connect)
   (db-initialize)
-  (tt-load-credentials)
-  (run-bot :git-commands #'magitek.robots.git-commands:random-string
-           :hours 12)
-  (run-bot :rpg-shopkeeper #'magitek.robots.rpg-shopkeeper:random-string
-           :hours 12))
+  (tt-load-credentials))
+
+(defun main ()
+  (spinup)
+  (run-bot *git-commands*)
+  (run-bot *rpg-shopkeeper*))
--- a/src/robots/rpg-shopkeeper.lisp	Thu Jan 19 18:23:28 2017 +0000
+++ b/src/robots/rpg-shopkeeper.lisp	Thu Jan 19 22:52:27 2017 +0000
@@ -318,70 +318,116 @@
 
 
 ; ;;;; Weapons ------------------------------------------------------------------
-; (define-rule melee-weapon
-;   "dagger"
-;   "longsword"
-;   "short sword"
-;   "hand axe"
-;   "battleaxe"
-;   "spear"
-;   "halberd"
-;   "scythe"
-;   "scimitar"
-;   "lance"
-;   "hammer"
-;   "staff"
-;   "mace"
-;   "flail")
+(defclass* weapon ()
+  (material piece enchantment ornament))
 
-; (define-rule (bow-weapon :distribution :weighted)
-;   (2 "shortbow")
-;   (2 "longbow")
-;   (1 "crossbow")
-;   (1 "compound bow"))
+(define-piece "dagger" 5)
+(define-piece "longsword" 50)
+(define-piece "short sword" 20)
+(define-piece "hand axe" 30)
+(define-piece "battleaxe" 80)
+(define-piece "spear" 20)
+(define-piece "halberd" 80)
+(define-piece "scythe" 50)
+(define-piece "scimitar" 50)
+(define-piece "lance" 70)
+(define-piece "warhammer" 80)
+(define-piece "staff" 5)
+(define-piece "mace" 25)
+(define-piece "flail" 45)
+
+(define-rule piece-melee
+  !*dagger*
+  !*longsword*
+  !*short-sword*
+  !*hand-axe*
+  !*battleaxe*
+  !*spear*
+  !*halberd*
+  !*scythe*
+  !*scimitar*
+  !*lance*
+  !*warhammer*
+  !*staff*
+  !*mace*
+  !*flail*)
 
 
-; (define-rule vanilla-weapon
-;   (metal melee-weapon)
-;   (wood bow-weapon))
+(define-piece "shortbow" 35)
+(define-piece "longbow" 60)
+(define-piece "crossbow" 80)
+(define-piece "compound bow" 80)
 
-; (define-rule (weapon :distribution :weighted)
-;   (1 (vanilla-weapon nil))
-;   (1 (vanilla-weapon weapon-enchantment)))
+(define-rule (piece-ranged :distribution :weighted)
+  (2 !*shortbow*)
+  (2 !*longbow*)
+  (1 !*crossbow*)
+  (1 !*compound-bow*))
 
 
-; (defgeneric enchanted-weapon-description
-;   (base enchantment-type enchantment-arguments))
+(define-rule vanilla-weapon
+  (metal piece-melee)
+  (wood piece-ranged))
 
-; (defmethod enchanted-weapon-description
-;     (base (e (eql :slaying)) enchantment-args)
-;   (destructuring-bind (monster) enchantment-args
-;     (format nil "~A of ~A-slaying" base (monster-singular monster))))
+(define-rule (weapon% :distribution :weighted)
+  (2 (vanilla-weapon nil))
+  (1 (vanilla-weapon enchant-weapon)))
 
-; (defmethod enchanted-weapon-description
-;     (base (e (eql :element)) enchantment-args)
-;   (destructuring-bind (element) enchantment-args
-;     (format nil "~A ~A" (second element) base)))
-
-; (defmethod enchanted-weapon-description
-;     (base (e (eql :bonus)) enchantment-args)
-;   (destructuring-bind (val) enchantment-args
-;     (format nil "+~D ~A" val base)))
+(defun weapon ()
+  (destructuring-bind ((material piece) enchantment)
+      (weapon%)
+    (make-instance 'weapon
+      :material material
+      :piece piece
+      :enchantment enchantment
+      :ornament (ornament material))))
 
 
-; (defun vanilla-weapon-description (vanilla-weapon)
-;   (destructuring-bind (material piece) vanilla-weapon
-;     (format nil "~A ~A" (material-name material) piece)))
+(defun weapon-value (weapon)
+  (let ((enchantment (weapon-enchantment weapon)))
+    (* (+ (* (-> weapon weapon-piece piece-base-value)
+             (-> weapon weapon-material material-multiplier))
+          (if enchantment 100 0))
+       (enchantment-multiplier enchantment)
+       (if (weapon-ornament weapon) 1.5 1.0))))
+
+(defgeneric enchanted-weapon-description
+  (base enchantment-type enchantment-arguments))
+
+(defmethod enchanted-weapon-description
+    (base (e (eql :slaying)) enchantment-args)
+  (destructuring-bind (monster) enchantment-args
+    (format nil "~A of ~A-slaying" base (monster-singular monster))))
+
+(defmethod enchanted-weapon-description
+    (base (e (eql :element)) enchantment-args)
+  (destructuring-bind (element) enchantment-args
+    (format nil "~A ~A" (second element) base)))
+
+(defmethod enchanted-weapon-description
+    (base (e (eql :bonus)) enchantment-args)
+  (destructuring-bind (val) enchantment-args
+    (format nil "+~D ~A" val base)))
 
 
-; (defun weapon-description (weapon)
-;   (destructuring-bind (vanilla enchant) weapon
-;     (let ((vanilla-description (vanilla-weapon-description vanilla)))
-;       (if enchant
-;         (enchanted-weapon-description vanilla-description
-;                                       (first enchant)
-;                                       (rest enchant))
-;         vanilla-description))))
+(defun vanilla-weapon-description (vanilla-weapon)
+  (format nil "~A ~A"
+          (-> vanilla-weapon weapon-material material-name)
+          (-> vanilla-weapon weapon-piece piece-name)))
+
+(defun weapon-description (weapon)
+  (let ((vanilla-description (vanilla-weapon-description weapon))
+        (enchantment (weapon-enchantment weapon))
+        (ornament (weapon-ornament weapon)))
+    (concatenate 'string
+                 (if enchantment
+                   (enchanted-weapon-description vanilla-description
+                                                 (first enchantment)
+                                                 (rest enchantment))
+                   vanilla-description)
+                 (if ornament
+                   (format nil ", ~A" ornament)
+                   ""))))
 
 
 ;;;; Flavor -------------------------------------------------------------------
@@ -394,28 +440,48 @@
   "This is gonna go fast!")
 
 
-;;;; Main ---------------------------------------------------------------------
-(define-rule item
-  ; !(weapon-description @weapon)
-  armor)
+;;;; Prices -------------------------------------------------------------------
+(defun round-to (n sigfigs)
+  (let* ((digits (ceiling (log n 10)))
+         (div (expt 10 (max 0 (- digits sigfigs)))))
+    (-<> n
+      (round <> div)
+      (* <> div))))
 
-(defun item-description (item)
-  (etypecase item
-    (armor (armor-description item))))
+(defun sanitize-price (price)
+  (let ((price (round-to price 3)))
+    (if (< 50 price)
+      (* 5 (round price 5))
+      price)))
 
 (defun item-value (item)
-  (format nil "~:D"
-          (ceiling (etypecase item
-                     (armor (armor-value item))))))
+  (-<> (etypecase item
+         (armor (armor-value item))
+         (weapon (weapon-value item)))
+    (sanitize-price <>)
+    (format nil "~:D" <>)))
+
 
 (define-string for-the-low-price
   "only"
   "just"
   "yours for the low, low price of"
   "for you, only"
+  "on clearance for just"
   "a steal at"
   "on sale for")
 
+
+;;;; Main ---------------------------------------------------------------------
+(define-rule item
+  weapon
+  armor)
+
+(defun item-description (item)
+  (etypecase item
+    (armor (armor-description item))
+    (weapon (weapon-description item))))
+
 (defun offer ()
   (let ((item (item)))
     $("FOR SALE:" [!item item-description cap] :. "."
@@ -424,6 +490,13 @@
       sales-pitch)))
 
 
+; (loop :repeat 10 :do
+;       (terpri)
+;       (terpri)
+;       (print '-------------------------------)
+;       (terpri)
+;       (princ (offer)))
+
 ;;;; API ----------------------------------------------------------------------
 (defun random-string ()
   (offer))