Pastebin launched a little side project called HostCabi.net, check it out ;-)Don't like ads? PRO users don't see any ads ;-)
Guest

Rörd

By: a guest on Jul 31st, 2010  |  syntax: Lisp  |  size: 6.83 KB  |  hits: 182  |  expires: Never
download  |  raw  |  embed  |  report abuse  |  print
This paste has a previous version, view the difference. Text below is selected. Please press Ctrl+C to copy to your clipboard. (⌘+C on Mac)
  1. (defun main ()
  2.   (introduction)
  3.   (catch 'end
  4.     (main-loop)))
  5.  
  6. (defun introduction ()
  7.   (format t "~32tHAMURABI~%~
  8.              ~15tCREATIVE COMPUTING  MORRISTOWN, NEW JERSEY~%~%~%~%~
  9.              TRY YOUR HAND AT GOVERNING ANCIENT SUMERIA~%~
  10.              SUCCESSFULLY FOR A TEN-YEAR TERM OF OFFICE.~%~%"))
  11.  
  12. (defun main-loop ()
  13.   (let* ((*random-state* (make-random-state t))
  14.          (total-deaths 0)
  15.          (percent-deaths 0)
  16.          (year 0)
  17.          (population 95)
  18.          (stored-bushels 2800)
  19.          (harvest 3000)
  20.          (eaten (- harvest stored-bushels))
  21.          (yield 3)
  22.          (acres-of-land (/ harvest yield))
  23.          (immigrants 5)
  24.          (plague-p nil)
  25.          (deaths 0))
  26.     (loop
  27.        (format t "~%~%HAMURABI:  I BEG TO REPORT TO YOU,~%")
  28.        (incf year)
  29.        (format t "IN YEAR ~a, ~a PEOPLE STARVED, ~a CAME TO THE CITY.~%"
  30.                year deaths immigrants)
  31.        (incf population immigrants)
  32.        (when plague-p
  33.          (setf population (floor population 2))
  34.          (format t "A HORRIBLE PLAGUE STRUCK!  HALF THE PEOPLE DIED.~%"))
  35.        (format t "POPULATION IS NOW ~a~%" population)
  36.        (format t "THE CITY NOW OWNS ~a ACRES.~%" acres-of-land)
  37.        (format t "YOU HARVESTED ~a BUSHELS PER ACRE.~%" yield)
  38.        (format t "RATS ATE ~a BUSHELS.~%" eaten)
  39.        (format t "YOU NOW HAVE ~a BUSHELS IN STORE.~%~%" stored-bushels)
  40.        (when (= year 11) (end-of-term percent-deaths
  41.                                       total-deaths
  42.                                       acres-of-land
  43.                                       population))
  44.        (let ((price (+ (random 10) 17)))
  45.          (format t "LAND IS TRADING AT ~a BUSHELS PER ACRE.~%" price)
  46.          (ask-number "HOW MANY ACRES DO YOU WISH TO BUY"
  47.              acres-to-buy
  48.              (<= (* price acres-to-buy) stored-bushels)
  49.              (not-enough-grain stored-bushels)
  50.            (cond ((plusp acres-to-buy)
  51.                   (incf acres-of-land acres-to-buy)
  52.                   (decf stored-bushels (* price acres-to-buy)))
  53.                  ('otherwise
  54.                   (ask-number "HOW MANY ACRES DO YOU WISH TO SELL"
  55.                       acres-to-sell
  56.                       (< acres-to-sell acres-of-land)
  57.                       (not-enough-land acres-of-land)
  58.                     (decf acres-of-land acres-to-sell)
  59.                     (incf stored-bushels (* price acres-to-sell)))))))
  60.        (ask-number "HOW MANY BUSHELS DO YOU WISH TO FEED YOUR PEOPLE"
  61.            bushels-to-feed
  62.            ;; TRYING TO USE MORE GRAIN THAN IN THE SILOS?
  63.            (<= bushels-to-feed stored-bushels)
  64.            (not-enough-grain stored-bushels)
  65.          (decf stored-bushels bushels-to-feed)
  66.          ;; A BOUNTYFULL HARVEST!!
  67.          (setf yield (random1-5))
  68.          (setf harvest (cultivate acres-of-land
  69.                                   stored-bushels
  70.                                   population
  71.                                   yield))
  72.          (setf eaten
  73.                (let ((rats (random1-5)))
  74.                  (if (evenp rats)       ; THE RATS ARE RUNNING WILD!!
  75.                      (floor stored-bushels rats)
  76.                      0)))
  77.          (incf stored-bushels (- harvest eaten))
  78.          (let ((growth (random1-5)))
  79.            ;; LET'S HAVE SOME BABIES
  80.            (setf immigrants (floor (1+ (/ (* growth
  81.                                              (+ (* 20 acres-of-land)
  82.                                                 stored-bushels))
  83.                                           population
  84.                                           100)))))
  85.          ;; HOW MANY PEOPLE HAD FULL TUMMIES?
  86.          (let ((fed-people (floor bushels-to-feed 20)))
  87.            ;; HORRORS, A 15% CHANCE OF PLAGUE
  88.            (setf plague-p (< (random 2.0) .3))
  89.            (if (< population fed-people)
  90.                (setf deaths 0)
  91.                (progn
  92.                  ;; STARVE ENOUGH FOR IMPEACHMENT?
  93.                  (setf deaths (- population fed-people))
  94.                  (when (> deaths (* .45 population))
  95.                    (format t "~%YOU STARVED ~a PEOPLE IN ONE YEAR!!!~%"
  96.                            deaths)
  97.                    (impeachment))
  98.                  (setf percent-deaths (/ (+ (* (1- year) percent-deaths)
  99.                                             (/ (* deaths 100)
  100.                                                population))
  101.                                          year))
  102.                  (setf population fed-people)
  103.                  (incf total-deaths deaths))))))))
  104.  
  105. (defmacro ask-number (prompt var test error &body body)
  106.   `(let (,var)
  107.      (loop do
  108.           (format t "~%~a? " ,prompt)
  109.           (setf ,var (read))
  110.           (when (minusp ,var) (resignment))
  111.           until ,test
  112.           do ,error)
  113.      ,@body))
  114.  
  115. (defun cultivate (acres-of-land stored-bushels population yield)
  116.   (ask-number "HOW MANY ACRES DO YOU WISH TO PLANT WITH SEED"
  117.       acres-to-cultivate
  118.       ;; TRYING TO PLANT MORE ACRES THAN YOU OWN?
  119.       (<= acres-to-cultivate acres-of-land)
  120.       (not-enough-land acres-of-land)
  121.     (unless (zerop acres-to-cultivate)
  122.       ;; ENOUGH GRAIN FOR SEED?
  123.       (unless (< (floor acres-to-cultivate 2) stored-bushels)
  124.         (not-enough-grain stored-bushels)
  125.         (cultivate acres-of-land stored-bushels population yield))
  126.       ;; ENOUGH PEOPLE TO TEND THE CROPS?
  127.       (unless (< acres-to-cultivate (* 10 population))
  128.         (format t "BUT YOU HAVE ONLY ~a PEOPLE TO TEND THE~
  129.                   FIELDS. NOW THEN," population)
  130.         (cultivate acres-of-land stored-bushels population yield))
  131.       (decf stored-bushels (floor acres-to-cultivate 2)))
  132.     (* acres-to-cultivate yield)))
  133.  
  134. (defun impeachment ()
  135.   (format t "DUE TO THIS EXTREME MISMANAGEMENT YOU HAVE NOT ONLY~%")
  136.   (format t "BEEN IMPEACHED AND THROWN OUT OF OFFICE BUT YOU HAVE~%")
  137.   (format t "ALSO BEEN DECLARED 'NATIONAL FINK' !!~%")
  138.   (the-end))
  139.  
  140. (defun not-enough-grain (stored-bushels)
  141.   (format t "HAMURABI:  THINK AGAIN. YOU HAVE ONLY~%")
  142.   (format t "~a BUSHELS OF GRAIN. NOW THEN," stored-bushels))
  143.  
  144. (defun not-enough-land (acres-of-land)
  145.   (format t "HAMURABI:  THINK AGAIN. YOU OWN ONLY ~a ACRES. NOW THEN,"
  146.           acres-of-land))
  147.  
  148. (defun random1-5 () (1+ (random 5)))
  149.  
  150. (defun resignment ()
  151.   (format t "~%HAMURABI:  I CANNOT DO WHAT YOU WISH.~%")
  152.   (format t "GET YOURSELF ANOTHER STEWARD!!!!!~%")
  153.   (the-end))
  154.  
  155. (defun end-of-term (percent-deaths total-deaths acres-of-land population)
  156.   (format t "IN YOUR 10-YEAR TERM OF OFFICE, ~,1f PERCENT OF THE~%"
  157.           percent-deaths)
  158.   (format t "POPULATION STARVED PER YEAR ON AVERAGE, I.E., A TOTAL OF~%~
  159.              ~a PEOPLE DIED!!~%" total-deaths)
  160.   (let ((land-per-person (/ acres-of-land population)))
  161.     (format t "YOU STARTED WITH 10 ACRES PER PERSON AND ENDED WITH~%~
  162.                ~,1f ACRES PER PERSON.~%~%" land-per-person)
  163.     (cond ((> percent-deaths 33) (impeachment))
  164.           ((< land-per-person 7) (impeachment))
  165.           ((> percent-deaths 10) (bad-review))
  166.           ((< land-per-person 9) (bad-review))
  167.           ((> percent-deaths 3) (mediocre-review population))
  168.           ((< land-per-person 10) (mediocre-review population))
  169.           ('otherwise (great-review))))
  170.   (the-end))
  171.  
  172. (defun great-review ()
  173.   (format t "A FANTASTIC PERFORMANCE!!!  CHARLEMANGE, DISRAELI, AND~%~
  174.              JEFFERSON COMBINED COULD NOT HAVE DONE BETTER!~%"))
  175.  
  176. (defun bad-review ()
  177.   (format t "YOUR HEAVY-HANDED PERFORMANCE SMACKS OF NERO AND IVAN IV.~%~
  178.              THE PEOPLE (REMAINING) FIND YOU AN UNPLEASANT RULER, AND,~%~
  179.              FRANKLY, HATE YOUR GUTS!~%"))
  180.  
  181. (defun mediocre-review (population)
  182.   (format t "YOUR PERFORMANCE COULD HAVE BEEN SOMEWHAT BETTER, BUT~%~
  183.              REALLY WASN'T TOO BAD AT ALL. ~a PEOPLE~%"
  184.           (floor (* population .8 (random 1.0))))
  185.   (format t "DEARLY LIKE TO SEE YOU ASSASSINATED BUT WE ALL HAVE OUR~%~
  186.              TRIVIAL PROBLEMS.~%"))
  187.  
  188. (defun the-end ()
  189.   (loop repeat 10 do (princ #\Bel))
  190.   (format t  "~%SO LONG FOR NOW.~%~%")
  191.   (throw 'end nil))