Rörd

(defun main ()
  (introduction)
  (catch 'end
    (main-loop)))

(defun introduction ()
  (format t "~32tHAMURABI~%~
         ~15tCREATIVE COMPUTING  MORRISTOWN, NEW JERSEY~%~%~%~%~
         TRY YOUR HAND AT GOVERNING ANCIENT SUMERIA~%~
         SUCCESSFULLY FOR A TEN-YEAR TERM OF OFFICE.~%~%"))

(defun main-loop ()
  (let* ((*random-state* (make-random-state t))
     (total-deaths 0)
     (percent-deaths 0)
     (year 0)
     (population 95)
     (stored-bushels 2800)
     (harvest 3000)
     (eaten (- harvest stored-bushels))
     (yield 3)
     (acres-of-land (/ harvest yield))
     (immigrants 5)
     (plague-p nil)
     (deaths 0))
    (loop
       (format t "~%~%HAMURABI:  I BEG TO REPORT TO YOU,~%")
       (incf year)
       (format t "IN YEAR ~a, ~a PEOPLE STARVED, ~a CAME TO THE CITY.~%"
           year deaths immigrants)
       (incf population immigrants)
       (when plague-p
     (setf population (floor population 2))
     (format t "A HORRIBLE PLAGUE STRUCK!  HALF THE PEOPLE DIED.~%"))
       (format t "POPULATION IS NOW ~a~%" population)
       (format t "THE CITY NOW OWNS ~a ACRES.~%" acres-of-land)
       (format t "YOU HARVESTED ~a BUSHELS PER ACRE.~%" yield)
       (format t "RATS ATE ~a BUSHELS.~%" eaten)
       (format t "YOU NOW HAVE ~a BUSHELS IN STORE.~%~%" stored-bushels)
       (when (= year 11) (end-of-term percent-deaths
                      total-deaths
                      acres-of-land
                      population))
       (let ((price (+ (random 10) 17)))
     (format t "LAND IS TRADING AT ~a BUSHELS PER ACRE.~%" price)
     (ask-number "HOW MANY ACRES DO YOU WISH TO BUY"
         acres-to-buy
         (<= (* price acres-to-buy) stored-bushels)
         (not-enough-grain stored-bushels)
       (cond ((plusp acres-to-buy)
          (incf acres-of-land acres-to-buy)
          (decf stored-bushels (* price acres-to-buy)))
         ('otherwise
          (ask-number "HOW MANY ACRES DO YOU WISH TO SELL"
              acres-to-sell
              (< acres-to-sell acres-of-land)
              (not-enough-land acres-of-land)
            (decf acres-of-land acres-to-sell)
            (incf stored-bushels (* price acres-to-sell)))))))
       (ask-number "HOW MANY BUSHELS DO YOU WISH TO FEED YOUR PEOPLE"
       bushels-to-feed
       ;; TRYING TO USE MORE GRAIN THAN IN THE SILOS?
       (<= bushels-to-feed stored-bushels)
       (not-enough-grain stored-bushels)
     (decf stored-bushels bushels-to-feed)
     ;; A BOUNTYFULL HARVEST!!
     (setf yield (random1-5))
     (setf harvest (cultivate acres-of-land
                  stored-bushels
                  population
                  yield))
     (setf eaten
           (let ((rats (random1-5)))
         (if (evenp rats)   ; THE RATS ARE RUNNING WILD!!
             (floor stored-bushels rats)
             0)))
     (incf stored-bushels (- harvest eaten))
     (let ((growth (random1-5)))
       ;; LET'S HAVE SOME BABIES
       (setf immigrants (floor (1+ (/ (* growth
                         (+ (* 20 acres-of-land)
                        stored-bushels))
                      population
                      100)))))
     ;; HOW MANY PEOPLE HAD FULL TUMMIES?
     (let ((fed-people (floor bushels-to-feed 20)))
       ;; HORRORS, A 15% CHANCE OF PLAGUE
       (setf plague-p (< (random 2.0) .3))
       (if (< population fed-people)
           (setf deaths 0)
           (progn
         ;; STARVE ENOUGH FOR IMPEACHMENT?
         (setf deaths (- population fed-people))
         (when (> deaths (* .45 population))
           (format t "~%YOU STARVED ~a PEOPLE IN ONE YEAR!!!~%"
               deaths)
           (impeachment))
         (setf percent-deaths (/ (+ (* (1- year) percent-deaths)
                        (/ (* deaths 100)
                           population))
                     year))
         (setf population fed-people)
         (incf total-deaths deaths))))))))

(defmacro ask-number (prompt var test error &body body)
  `(let (,var)
     (loop do
      (format t "~%~a? " ,prompt)
      (setf ,var (read))
      (when (minusp ,var) (resignment))
      until ,test
      do ,error)
     ,@body))

(defun cultivate (acres-of-land stored-bushels population yield)
  (ask-number "HOW MANY ACRES DO YOU WISH TO PLANT WITH SEED"
      acres-to-cultivate
      ;; TRYING TO PLANT MORE ACRES THAN YOU OWN?
      (<= acres-to-cultivate acres-of-land)
      (not-enough-land acres-of-land)
    (unless (zerop acres-to-cultivate)
      ;; ENOUGH GRAIN FOR SEED?
      (unless (< (floor acres-to-cultivate 2) stored-bushels)
    (not-enough-grain stored-bushels)
    (cultivate acres-of-land stored-bushels population yield))
      ;; ENOUGH PEOPLE TO TEND THE CROPS?
      (unless (< acres-to-cultivate (* 10 population))
    (format t "BUT YOU HAVE ONLY ~a PEOPLE TO TEND THE~
                   FIELDS. NOW THEN," population)
    (cultivate acres-of-land stored-bushels population yield))
      (decf stored-bushels (floor acres-to-cultivate 2)))
    (* acres-to-cultivate yield)))

(defun impeachment ()
  (format t "DUE TO THIS EXTREME MISMANAGEMENT YOU HAVE NOT ONLY~%")
  (format t "BEEN IMPEACHED AND THROWN OUT OF OFFICE BUT YOU HAVE~%")
  (format t "ALSO BEEN DECLARED 'NATIONAL FINK' !!~%")
  (the-end))

(defun not-enough-grain (stored-bushels)
  (format t "HAMURABI:  THINK AGAIN. YOU HAVE ONLY~%")
  (format t "~a BUSHELS OF GRAIN. NOW THEN," stored-bushels))

(defun not-enough-land (acres-of-land)
  (format t "HAMURABI:  THINK AGAIN. YOU OWN ONLY ~a ACRES. NOW THEN,"
      acres-of-land))

(defun random1-5 () (1+ (random 5)))

(defun resignment ()
  (format t "~%HAMURABI:  I CANNOT DO WHAT YOU WISH.~%")
  (format t "GET YOURSELF ANOTHER STEWARD!!!!!~%")
  (the-end))

(defun end-of-term (percent-deaths total-deaths acres-of-land population)
  (format t "IN YOUR 10-YEAR TERM OF OFFICE, ~,1f PERCENT OF THE~%"
      percent-deaths)
  (format t "POPULATION STARVED PER YEAR ON AVERAGE, I.E., A TOTAL OF~%~
         ~a PEOPLE DIED!!~%" total-deaths)
  (let ((land-per-person (/ acres-of-land population)))
    (format t "YOU STARTED WITH 10 ACRES PER PERSON AND ENDED WITH~%~
           ~,1f ACRES PER PERSON.~%~%" land-per-person)
    (cond ((> percent-deaths 33) (impeachment))
      ((< land-per-person 7) (impeachment))
      ((> percent-deaths 10) (bad-review))
      ((< land-per-person 9) (bad-review))
      ((> percent-deaths 3) (mediocre-review population))
      ((< land-per-person 10) (mediocre-review population))
      ('otherwise (great-review))))
  (the-end))

(defun great-review ()
  (format t "A FANTASTIC PERFORMANCE!!!  CHARLEMANGE, DISRAELI, AND~%~
         JEFFERSON COMBINED COULD NOT HAVE DONE BETTER!~%"))

(defun bad-review ()
  (format t "YOUR HEAVY-HANDED PERFORMANCE SMACKS OF NERO AND IVAN IV.~%~
         THE PEOPLE (REMAINING) FIND YOU AN UNPLEASANT RULER, AND,~%~
         FRANKLY, HATE YOUR GUTS!~%"))

(defun mediocre-review (population)
  (format t "YOUR PERFORMANCE COULD HAVE BEEN SOMEWHAT BETTER, BUT~%~
         REALLY WASN'T TOO BAD AT ALL. ~a PEOPLE~%"
      (floor (* population .8 (random 1.0))))
  (format t "DEARLY LIKE TO SEE YOU ASSASSINATED BUT WE ALL HAVE OUR~%~
         TRIVIAL PROBLEMS.~%"))

(defun the-end ()
  (loop repeat 10 do (princ #\Bel))
  (format t  "~%SO LONG FOR NOW.~%~%")
  (throw 'end nil))