Monday, June 22, 2009

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
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)
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
| 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
| ((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
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)
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
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)
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" ++

numYears = year s
numPeople = people s
numAcres = land s
numDeaths = totalDeaths s
avgDeathRate = (cumDeathRate s) / (fromIntegral numYears)
acresPerPerson = (fromIntegral numAcres) / (fromIntegral numPeople)
| 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. 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.

Monday, June 15, 2009

I beg to report to you

I continued to work on my Haskell port of Hamurabi. (Here's a PHP version of Hamurabi that you can play in your browser.) It is nearly feature-complete; the yearly cycle works but it does not have impeachment or the final report after ten years. However it is still rather ugly. I should have something to share by next week.

I want to finish this up and move back onto ThiefRL. I've decided to bite the bullet and try a different turn order. I want to see what it's like when guards can prevent the player from getting past them, but to do that I need them to be able to see which way the player wants to move so they can intercept. So the turn order will be something like:
  • Display
  • Get player input
  • Get guard input (with guards looking at player input)
  • Resolve player's and guards' movements

The current turn order is mostly an “I go, you go” type of thing. The main exception is that guards' awareness is updated at the display point, rather than at the moment of their turn, thus ensuring that they see the world as it was displayed to the player.

Monday, June 8, 2009

Messing with Haskell

This week I spent some time attempting to port the old BASIC game Hamurabi to Haskell. I'd picked up a print copy of Real World Haskell so I was looking for something to try out.

It's been a challenge, and I haven't gotten as far as I would have expected. I wish the Haskell documentation, whether online or provided with the installation, was put together better. I'd like to have ready access to a language reference, not just the auto-generated library documentation; I'd like to have lots of sample code snippets; and I'd like for it to be fully searchable.

For instance: in BASIC you can write INPUT A to read an integer from the keyboard. The closest equivalent in Haskell is read but it aborts the program with an exception if the user does not type in something that can be parsed correctly. Since I was attempting to match BASIC's behavior I needed it to be able to deal more gracefully with bad input. With Google I eventually found a thread somewhere addressing this problem.

So far my program is not ending up any smaller than the original BASIC version, which surprises me a bit. I'm having difficulty deciding the best way to structure the program. I've discovered a method that emulates BASIC's goto style pretty closely, but it doesn't seem like that's necessarily a step toward readability, because the flow of control is embedded throughout the program:

main = buyLand

buyLand =
[choose how much land to buy with stored food]
if bought land:

sellLand =
[choose how much land to sell for food]

feedPeople =
[choose how much to feed your people]

plantFields =
[choose how many acres to sow with seed]

displayYearResults =
[show what happened as a result of player's choices]
if game not over:

I've omitted several additional control branches: If the user inputs nonsensical numbers the original program sometimes prints a huffy message and quits.

There is a basic game state that I pass through all the functions; it contains information that needs to persist from one year of game time to the next. There are additional bits of information that flow between some stages as well. For instance the choice of how many acres to sow with seed is needed in displayYearResults but not needed after that, so I've left it out of the main game state.

Simple as Hamurabi is, I found myself needing to step back and do an even simpler game first. Here's one where the computer picks a number and the player tries to guess it:

-- Computer chooses a number; player guesses what it is
-- Example of basic I/O

import Char
import Random
import IO

minNum = 1
maxNum = 1000

main = do
targetNum <- randomRIO (minNum, maxNum)
putStrLn ("I'm thinking of a number between " ++ (show minNum) ++
" and " ++ (show maxNum) ++ ". Can you guess it?")
guess 1 targetNum

guess :: Int -> Int -> IO ()
guess totalGuesses targetNum = do
putStr ("Guess " ++ (show totalGuesses) ++ ": ")
hFlush stdout
line <- getLine
case (maybeRead line) of
Nothing -> putStrLn ("Give up? The number was " ++ (show targetNum) ++ ".")
Just guessedNum ->
if targetNum == guessedNum then
putStrLn ("You guessed it in " ++ (show totalGuesses) ++ " tries!")
else do
putStrLn hint
guess (totalGuesses + 1) targetNum
hint = "My number is " ++ lessOrGreater ++ " than " ++ (show guessedNum) ++ "."
lessOrGreater = if targetNum < guessedNum then "less" else "greater"

maybeRead :: Read a => String -> Maybe a
maybeRead s = case reads s of
[(x, str)] | all isSpace str -> Just x
_ -> Nothing

This should give an idea of the level of verbosity that I'm contending with right now. Hopefully I can improve on this and come up with a clean way to structure the more complex program.

Monday, June 1, 2009

Back to work on ThiefRL

I spent Sunday morning trying to get my head back into my ThiefRL project. It seems to have promise. The question is how far to push with it. I have a bunch of potential features and I'm trying to organize and prioritize them.

I decided to axe a couple of potential features in order to keep the scope feasible. I'd been thinking about having sidekicks whose movements could be planned out ahead of a heist to some extent. The benefit would have been that it would create nice inter-character relationship fodder. However it would also involve an additional game mode (the planning stage) and it's not clear to me what, exactly, they would do. I worry that if they are capable of doing the same things as the player they would just steal the fun.

The other feature I've decided to drop is the idea of open-city gameplay. I'd been considering having big open cities with compounds embedded in them for more focused gameplay. However I worry that it would be difficult to get the density of risk and reward encounters up to acceptable levels across an entire city. It could certainly be done, but I am going to focus on running the player through a series of smaller areas instead.

These things could always be added in a sequel. Thief 3 added a city hub, for instance, which connected together all of the mission levels. I remember the city portion as being moderately successful.

I got a friend of mine who is a veteran gameplay designer/programmer to try it out recently. He said it was too difficult so I have been considering solutions. Part of the problem, I think, is training the player to move diagonally around corners to gain distance from pursuers. If I had the player follow an NPC in an early mission that might help with that.

I also need more ways to get away. I've got various ideas for that, and just need to start trying them out.