Charlemagne, Disraeli, and Jefferson combined could not have done better! (in Haskell)

...but hopefully you can. I added the “in Haskell” part because I'm not sure exactly what summons the Haskelling hordes.



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.