I finished up a first pass at translating the ancient game Hamurabi from BASIC to Haskell; I recently bought Real World Haskell and wanted to have another of my periodic goes at using the language.
The original BASIC program weighs in at 4,230 bytes and 121 lines. My port is somewhat more portly, at 10,280 bytes and 287 lines. The executable compiled by GHC is a mere 1.414 MB, which is a couple of orders of magnitude larger than the original probably would have been. Here is the source as it stands now:
-- Converted from the original FOCAL program and modified for Edusystem 70 by David Ahl, Digital
-- Modified for 8K Microsoft BASIC by Peter Turnbull
-- Ported to Haskell by James McNeill
import Char
import Random
import IO
import Text.Printf
-- Data structures
data GameState = GameState {
year :: Int,
people :: Int,
food :: Int, -- bushels
land :: Int, -- acres
landPrice :: Int, -- bushels per acre
totalDeaths :: Int,
cumDeathRate :: Double,
rng :: StdGen
} deriving (Show)
data Orders = Quit | Orders {
acresToBuyOrSell :: Int, -- negative number means sell
acresToPlant :: Int,
bushelsForFood :: Int
} deriving (Show)
data Results = Results {
peopleStarved :: Int,
peopleDiedOfPlague :: Int,
peopleBorn :: Int,
bushelsEatenByRats :: Int,
bushelsPerAcre :: Int
} deriving (Show)
data ValidateResult a = Abort String | Retry String | Accept a
-- Code
main = do
rng <- getStdGen
putStrLn "Try your hand at governing ancient Sumeria successfully for a 10-year term of\noffice."
let s = initialState rng
showResults s initialResults
doYears s
putStrLn "So long for now."
showResults :: GameState -> Results -> IO ()
showResults state results = do
printf "\nHamurabi: I beg to report to you,\n"
printf "In year %d, %d people starved, %d came to the city.\n" (year state) (peopleStarved results) (peopleBorn results)
printf "%s" (if (peopleDiedOfPlague results) > 0 then "A horrible plague struck! Half the people died.\n" else "")
printf "Population is now %d.\n" (people state)
printf "The city now owns %d acres.\n" (land state)
printf "You harvested %d bushels per acre.\n" (bushelsPerAcre results)
printf "Rats ate %d bushels.\n" (bushelsEatenByRats results)
printf "You now have %d bushels in store.\n" (food state)
doYears :: GameState -> IO ()
doYears sIn = do
let s = chooseNewLandPrice sIn
orders <- readOrders s
case orders of
Quit -> return ()
otherwise -> do
let (sOut, resultsOut) = applyOrders orders s
showResults sOut resultsOut
let fractionStarved = (fromIntegral (peopleStarved resultsOut)) / (fromIntegral (people s))
if fractionStarved > 0.45
then do
printf "You starved %d people in one year!\n" (peopleStarved resultsOut)
putStr finkMessage
else
if (year sOut) >= 10
then putStr $ finalReport sOut
else doYears sOut
readOrders :: GameState -> IO Orders
readOrders s = do
printf "Land is trading at %d bushels per acre.\n" (landPrice s)
buyLand s
applyOrders :: Orders -> GameState -> (GameState, Results)
applyOrders orders state = (stateOut, resultsOut)
where
stateOut = GameState {
year = (year state) + 1,
people = peopleFinal,
food = bushelsFinal,
land = landFinal,
landPrice = (landPrice state),
totalDeaths = (totalDeaths state) + peopleDiedOfPlague + peopleStarved,
cumDeathRate = (cumDeathRate state) + (fromIntegral peopleStarved) / (fromIntegral peopleInit),
rng = rngOut
}
resultsOut = Results {
peopleStarved = peopleStarved,
peopleDiedOfPlague = peopleDiedOfPlague,
peopleBorn = peopleBorn,
bushelsEatenByRats = bushelsEatenByRats,
bushelsPerAcre = harvestYield
}
landFinal = (land state) + (acresToBuyOrSell orders)
peopleFinal = peopleBeforePlague - peopleDiedOfPlague
peopleBeforePlague = peopleFed + peopleBorn
peopleDiedOfPlague
| plagueRandom < 0.15 = peopleBeforePlague `div` 2
| otherwise = 0
peopleFed = min peopleInit (bushelsEatenByPeople `div` 20)
peopleStarved = peopleInit - peopleFed
peopleBorn = 1 + ((birthRandom * (20 * landFinal + bushelsFinal)) `div` (peopleInit * 100))
peopleInit = people state
bushelsFinal = (bushelsBeforeRats - bushelsEatenByRats) + bushelsHarvested
bushelsEatenByRats
| ((ratD6 `mod` 2) == 1) = 0
| otherwise = bushelsBeforeRats `div` ratD6
bushelsBeforeRats =
(food state) -
bushelsEatenByPeople -
((acresToBuyOrSell orders) * (landPrice state)) -
((acresToPlant orders) `div` 2)
bushelsEatenByPeople = bushelsForFood orders
bushelsHarvested = harvestYield * (acresToPlant orders)
(birthRandom, rng1) = randomR (1, 6) (rng state)
(harvestYield, rng2) = randomR (1, 6) rng1
(plagueRandom, rng3) = random (rng2) :: (Double, StdGen)
(ratD6, rngOut) = randomR (1, 6) rng3
buyLand :: GameState -> IO Orders
buyLand s
| maxN <= 0 = sellLand s 0
| otherwise = do
choice <- readValidatedNum prompt validate defaultN
case choice of
Nothing -> return Quit
Just n -> sellLand s { land = (land s) + n, food = (food s) - ((landPrice s) * n) } n
where
prompt = "How many acres do you wish to buy (0-" ++ (show maxN) ++ ")? [" ++ (show defaultN) ++ "] "
maxN = (food s) `div` (landPrice s)
defaultN = 0
validate n
| n < 0 = Abort abortMessage
| n > maxN = Retry $ printf "Hammurabi: Think again. You have only %d bushels of grain. Now then," (food s)
| otherwise = Accept n
sellLand :: GameState -> Int -> IO Orders
sellLand s acresToBuy
| acresToBuy > 0 || maxN <= 0 = feedPeople s acresToBuy
| otherwise = do
choice <- readValidatedNum prompt validate defaultN
case choice of
Nothing -> return Quit
Just n -> feedPeople s { land = (land s) - n, food = (food s) + ((landPrice s) * n) } (-n)
where
prompt = "How many acres do you wish to sell (0-" ++ (show maxN) ++ ")? [" ++ (show defaultN) ++ "] "
defaultN = 0
maxN = land s
validate n
| n < 0 = Abort abortMessage
| n > maxN = Retry $ printf "Hammurabi: Think again. You have only %d acres. Now then," maxN
| otherwise = Accept n
feedPeople :: GameState -> Int -> IO Orders
feedPeople s acresToBuy
| maxN <= 0 = plantFields s acresToBuy 0
| otherwise = do
choice <- readValidatedNum prompt validate defaultN
case choice of
Nothing -> return Quit
Just n -> plantFields s { food = (food s) - n } acresToBuy n
where
prompt = "How many bushels do you wish to feed your people (0-" ++ (show maxN) ++ ")? [" ++ (show defaultN) ++ "] "
defaultN = min maxN (20 * (people s))
maxN = food s
validate n
| n < 0 = Abort abortMessage
| n > maxN = Retry $ printf "Hammurabi: Think again. You have only %d bushels of grain. Now then," maxN
| otherwise = Accept n
plantFields :: GameState -> Int -> Int -> IO Orders
plantFields s acresToBuy bushelsToFeed
| maxN <= 0 = return (Orders acresToBuy 0 bushelsToFeed)
| otherwise = do
choice <- readValidatedNum prompt validate defaultN
case choice of
Nothing -> return Quit
Just n -> return (Orders acresToBuy n bushelsToFeed)
where
prompt = "How many acres do you wish to plant with seed (0-" ++ (show maxN) ++ ")? [" ++ (show defaultN) ++ "] "
defaultN = maxN
maxN = min landAvailable (min (2 * foodAvailable) (10 * (people s)))
landAvailable = land s
foodAvailable = food s
validate n
| n < 0 = Abort abortMessage
| n > landAvailable = Retry $ printf "Hammurabi: Think again. You own only %d acres. Now then," landAvailable
| n > 2 * foodAvailable = Retry $ printf "Hammurabi: Think again. You have only %d bushels of grain. Now then," foodAvailable
| n > 10 * (people s) = Retry $ printf "But you have only %d people to tend the fields. Now then," (people s)
| otherwise = Accept n
finalReport :: GameState -> String
finalReport s =
"In your " ++ show numYears ++ "-year term of office, " ++
show (round (100.0 * avgDeathRate)) ++ " percent of the\n" ++
"population starved per year on average, i.e., " ++
"a total of " ++ show numDeaths ++ " people died!!\n" ++
"You started with 10 acres per person and ended with " ++
show (round acresPerPerson) ++ " acres per person.\n" ++
comments
where
numYears = year s
numPeople = people s
numAcres = land s
numDeaths = totalDeaths s
avgDeathRate = (cumDeathRate s) / (fromIntegral numYears)
acresPerPerson = (fromIntegral numAcres) / (fromIntegral numPeople)
comments
| avgDeathRate > 0.33 || acresPerPerson < 7 = finkMessage
| avgDeathRate > 0.1 || acresPerPerson < 9 =
"Your heavy-handed performance smacks of Nero and Ivan IV.\n" ++
"The people (remaining) find you an unpleasant ruler, and,\n" ++
"frankly, hate your guts!\n"
| avgDeathRate > 0.03 || acresPerPerson < 10 =
"Your performance could have been somewhat better, but\n" ++
"really wasn't too bad at all. " ++
show numHaters ++ " people would\n" ++
"dearly like to see you assassinated but we all have our\n" ++
"trivial problems.\n"
| otherwise =
"A fantastic performance!!! Charlemagne, Disraeli, and\n" ++
"Jefferson combined could not have done better!\n"
(numHaters, _) = randomR (0, (numPeople * 4) `div` 5) (rng s)
readValidatedNum :: String -> (Int -> ValidateResult Int) -> Int -> IO (Maybe Int)
readValidatedNum prompt validate defaultValue = do
putStr prompt
hFlush stdout
line <- getLine
case maybeRead line of
Nothing -> return (Just defaultValue)
Just n ->
case validate n of
Accept n -> return (Just n)
Abort s -> do
putStrLn s
return Nothing
Retry s -> do
putStrLn s
readValidatedNum prompt validate defaultValue
maybeRead :: Read a => String -> Maybe a
maybeRead s = case reads s of
[(x, str)] | all isSpace str -> Just x
_ -> Nothing
chooseNewLandPrice :: GameState -> GameState
chooseNewLandPrice s = s { landPrice = newLandPrice, rng = newRng }
where (newLandPrice, newRng) = randomR (17, 26) (rng s)
initialState :: StdGen -> GameState
initialState rng = GameState {
year = 0,
people = 100,
food = 2800,
land = 1000,
landPrice = 0,
totalDeaths = 0,
cumDeathRate = 0,
rng = rng }
initialResults :: Results
initialResults = Results 0 0 5 200 3
abortMessage :: String
abortMessage = "Hammurabi: I cannot do what you wish!\nGet yourself another steward!!!!!"
finkMessage :: String
finkMessage =
"Due to this extreme mismanagement you have not only\n" ++
"been impeached and thrown out of office but you have\n" ++
"also been declared 'National Fink' !!\n"
I've tried to mimic the original functionality as closely as possible. One small addition I made was for the program to print the range of valid input numbers after a question, as well as a default number which will be used if the player just presses Enter. This makes play a bit quicker.
It really bothers me that this program is so much longer than the original. I expect newer languages to have more power for making programs easy to write and read. If you have any concrete suggestions about how to improve/shorten this code (preferably with code snippets) I would love to hear them in the comments. I know this is pretty bad code.
I've separated getting instructions from the player from updating the game state. This allows the state update to be a pure function, but also means that some of the game state update has to be simulated during the process of getting instructions, so as to predict (for example) how much grain will be available for planting after feeding people. This causes some duplication of code.
The getting-instructions part is messy; you can see four very-similarly-shaped functions named buyLand, sellLand, feedPeople, and plantFields. These correspond to the four questions asked of the player. I'd like to find a way to extract more common structure from these since they are so similar.
The question-asking functions are chained so that each calls the next, if it is necessary to go on; the last one returns the completed Orders data structure. I don't like this structure; I'd prefer one where the questions were posed more independently. Unfortunately it is possible for the game to end immediately if the player ends a negative number which complicates control flow.
I will do a Python version of this some time. I expect it will turn out a bit longer than the BASIC due to using reasonable names for things but it will likely not be anywhere near this much longer.
This week I have also become infatuated with Mike Singleton's 1984 ZX Spectrum game The Lords of Midnight. I've been playing Davor Cubranic's Java port of it. Icemark.com is a website with lots of good info about how to play the game or its sequel.
Lords of Midnight is kind of a precursor to games like Heroes of Might and Magic, where the player commands armies led by heroes across a map. The big innovation in Lords of Midnight is that everything's done from a first-person perspective. This is of mixed benefit: it's more immediate, but you will find yourself playing primarily from a map (which you would have drawn on graph paper, in the old days) anyway. Everybody loves the 3D, with the people and the sunsets and the arrows flying right at my eye! but so often it just isn't the best perspective.
The other novel thing, again with middling success, is that it attempts to give situational reports in prose, as you can see in the screenshot. This is something that I think could be greatly improved and could actually prove useful. In this style of game you have to cycle through all your living heroes at least once per day to move them. It can be difficult to remember just who has done what, and where they're headed. A summary paragraph could be really nice.
