tjhintz/farm
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Many updates.

Browse Source
This commit is contained in:
Thomas Hintz
2020-03-28 14:32:49 -07:00
parent 77a8692f71
commit c8e9ea1842
12 changed files with 992 additions and 593 deletions
Download Patch File Download Diff File Expand all files Collapse all files

14
jsconfig.json Normal file
View File

@@ -0,0 +1,14 @@
{
"compilerOptions": {
"target": "es2017",
"allowSyntheticDefaultImports": true,
"noEmit": true,
"checkJs": true,
"jsx": "react",
"lib": [ "dom", "es2017" ],
"include": [
"src",
"assets/game/acf"
]
}
}

2
package.json
View File

@@ -15,7 +15,7 @@
}, },
"keywords": [], "keywords": [],
"author": "", "author": "",
"license": "ISC", "license": "GPL-3.0-or-later",
"devDependencies": { "devDependencies": {
"@babel/core": "^7.8.3", "@babel/core": "^7.8.3",
"@babel/plugin-proposal-class-properties": "^7.8.3", "@babel/plugin-proposal-class-properties": "^7.8.3",

828
src/components/farm/Board.jsx
View File

File diff suppressed because it is too large Load Diff

8
src/components/farm/SpaceNode.jsx
View File

@@ -20,6 +20,8 @@ import React from 'react'
import { connect } from 'react-redux' import { connect } from 'react-redux'
import PlayerIcon from './PlayerIcon.jsx' import PlayerIcon from './PlayerIcon.jsx'
import { FontAwesomeIcon } from '@fortawesome/react-fontawesome'
import { faCreditCard, faQuestionCircle } from '@fortawesome/free-solid-svg-icons'
import { setMessagePanelSpace, mpMouse } from './actions.js' import { setMessagePanelSpace, mpMouse } from './actions.js'
@@ -55,8 +57,10 @@ class SpaceNode extends React.Component {
: (null)} : (null)}
{ this.props.space.players.length ? <PlayerIcon colors={this.props.space.players} /> : ''} { this.props.space.players.length ? <PlayerIcon colors={this.props.space.players} /> : ''}
<div className='space-description'> <div className='space-description'>
{this.props.space.description} {this.props.space.description}
</div> </div>
{this.props.showIcons && space.card === 'otb' ? (<div className='space-icon'><FontAwesomeIcon icon={faCreditCard} /></div>) : (<></>)}
{this.props.showIcons && space.card === 'fate' ? (<div className='space-icon'><FontAwesomeIcon icon={faQuestionCircle} /></div>) : (<></>)}
</div> </div>
</div> </div>
); );

1
src/components/farm/actionTypes.js
View File

@@ -36,3 +36,4 @@ export const ALERT = 'alert'
export const ALERT_HANDLED = 'alert-handled' export const ALERT_HANDLED = 'alert-handled'
export const AUTO_SKIP = 'auto-skip' export const AUTO_SKIP = 'auto-skip'
export const MESSAGE = 'message' export const MESSAGE = 'message'
export const SET_HARVEST_TABLE = 'set-harvest-table'

16
src/components/farm/actions.js
View File

@@ -20,13 +20,13 @@ import { UPDATE_GAME, UPDATE_PLAYER, GAME_STATE, SET_SELECTED_CARD, SET_CARDS,
SPACE_PUSH_PLAYER, SPACE_CLEAR_PLAYERS, SET_OLD_MESSAGES, MESSAGE_PANEL_SPACE, SPACE_PUSH_PLAYER, SPACE_CLEAR_PLAYERS, SET_OLD_MESSAGES, MESSAGE_PANEL_SPACE,
MP_MOUSE, SET_MP_DIMS, MARK_ACTION_CHANGE_HANDLED, SET_NEXT_ACTION, MP_MOUSE, SET_MP_DIMS, MARK_ACTION_CHANGE_HANDLED, SET_NEXT_ACTION,
MOVE_PLAYER, NEXT_UI_ACTION, NEXT_UI_ACTION_SILENT, ALERT, ALERT_HANDLED, MOVE_PLAYER, NEXT_UI_ACTION, NEXT_UI_ACTION_SILENT, ALERT, ALERT_HANDLED,
AUTO_SKIP, MESSAGE } from './actionTypes.js' AUTO_SKIP, MESSAGE, SET_HARVEST_TABLE } from './actionTypes.js'
export { updateGame, updatePlayer, gameState, setSelectedCard, setCards, export { updateGame, updatePlayer, gameState, setSelectedCard, setCards,
spacePushPlayer, spaceClearPlayers, setOldMessages, setMessagePanelSpace, spacePushPlayer, spaceClearPlayers, setOldMessages, setMessagePanelSpace,
mpMouse, setMPDims, movePlayer, setNextAction, nextUIAction, mpMouse, setMPDims, movePlayer, setNextAction, nextUIAction,
markActionChangeHandled, nextUIActionSilent, alert, alertHandled, markActionChangeHandled, nextUIActionSilent, alert, alertHandled,
autoSkip, message } autoSkip, message, setHarvestTable }
function updateGame(update) { function updateGame(update) {
return { type: UPDATE_GAME, return { type: UPDATE_GAME,
@@ -107,12 +107,12 @@ function markActionChangeHandled() {
return { type: MARK_ACTION_CHANGE_HANDLED }; return { type: MARK_ACTION_CHANGE_HANDLED };
} }
function alert(value, contents) { function alert(value, contents, id) {
return { type: ALERT, value, contents }; return { type: ALERT, value, contents, id };
} }
function alertHandled() { function alertHandled(id) {
return { type: ALERT_HANDLED }; return { type: ALERT_HANDLED, id };
} }
function autoSkip(component) { function autoSkip(component) {
@@ -122,3 +122,7 @@ function autoSkip(component) {
function message(message) { function message(message) {
return { type: MESSAGE, message }; return { type: MESSAGE, message };
} }
function setHarvestTable(table) {
return { type: SET_HARVEST_TABLE, table };
}

42
src/components/farm/interface.js
View File

@@ -24,7 +24,7 @@ import * as websocket from '../../websocket.js'
import { updateGame, updatePlayer, gameState, setSelectedCard, setCards, import { updateGame, updatePlayer, gameState, setSelectedCard, setCards,
movePlayer, setOldMessages, markActionChangeHandled, movePlayer, setOldMessages, markActionChangeHandled,
mpMouse, rolled, setNextAction, nextUIAction, nextUIActionSilent, alert, mpMouse, rolled, setNextAction, nextUIAction, nextUIActionSilent, alert,
autoSkip, message, alertHandled } from './actions.js' autoSkip, message, alertHandled, setHarvestTable } from './actions.js'
import { itemCard, fateCard } from 'game.js' import { itemCard, fateCard } from 'game.js'
export { initialize, buy, roll, endTurn, loan, trade, submitTradeAccept, export { initialize, buy, roll, endTurn, loan, trade, submitTradeAccept,
@@ -47,12 +47,16 @@ function handleMessage(evt) {
if (data.player.state === GAME_STATES.preTurn && if (data.player.state === GAME_STATES.preTurn &&
data.game.otherPlayers.length > 0 && data.game.otherPlayers.length > 0 &&
store.getState().farm.player.state !== GAME_STATES.preTurn) { store.getState().farm.player.state !== GAME_STATES.preTurn) {
store.dispatch(alert(ALERTS.beginTurn)); store.dispatch(alert(ALERTS.beginTurn, '', 'beginTurn' + data.game.turn));
}
if (data.game.calledAudit && !store.getState().farm.game.calledAudit) {
store.dispatch(alert(ALERTS.auditCalled, data.game.calledAudit,
'auditCalled' + data.game.turn));
}
if (data.player.trade.player && data.player.trade.originator !== data.player.name) {
store.dispatch(alert(ALERTS.proposedTrade, data.player.trade.originator,
'tradeProposed' + data.player.trade.number));
} }
// else if (data.game.otherPlayers.length > 0 &&
// data.game.currentPlayer !== store.getState().farm.game.currentPlayer) {
// store.dispatch(alert(ALERTS.otherPlayersTurn));
// }
// new turn clear actions // new turn clear actions
if (data.event === 'update' && if (data.event === 'update' &&
data.game.currentPlayer !== store.getState().farm.game.currentPlayer) { data.game.currentPlayer !== store.getState().farm.game.currentPlayer) {
@@ -62,6 +66,7 @@ function handleMessage(evt) {
store.dispatch(updatePlayer(data.player)); store.dispatch(updatePlayer(data.player));
if (data.event === 'init') { if (data.event === 'init') {
store.dispatch(movePlayer(data.player.space, 0, data.player.color)); store.dispatch(movePlayer(data.player.space, 0, data.player.color));
store.dispatch(setHarvestTable(data.harvestTable));
} }
// new player(s) added to game, put them on the board // new player(s) added to game, put them on the board
if (data.game.otherPlayers.length !== store.getState().farm.game.otherPlayers.length) { if (data.game.otherPlayers.length !== store.getState().farm.game.otherPlayers.length) {
@@ -75,11 +80,6 @@ function handleMessage(evt) {
const oldMessages = store.getState().farm.game.messages.slice(0, 20); const oldMessages = store.getState().farm.game.messages.slice(0, 20);
store.dispatch(updateGame(data.game)); store.dispatch(updateGame(data.game));
store.dispatch(setOldMessages(oldMessages)); store.dispatch(setOldMessages(oldMessages));
if (data.player.cards.length > 0) {
store.dispatch(setSelectedCard(data.player.cards[0]));
} else {
store.dispatch(setSelectedCard());
}
store.dispatch(setCards(data.player.cards)); store.dispatch(setCards(data.player.cards));
if (data.event === 'action') { if (data.event === 'action') {
if (data.player.name !== data.game.currentPlayer && if (data.player.name !== data.game.currentPlayer &&
@@ -94,15 +94,25 @@ function handleMessage(evt) {
if (data.player.state === GAME_STATES.midTurn && if (data.player.state === GAME_STATES.midTurn &&
data.player.cash < 0 && data.player.cash < 0 &&
!store.getState().farm.ui.nextAction) { !store.getState().farm.ui.nextAction) {
store.dispatch(alert(ALERTS.raiseMoney)); store.dispatch(alert(ALERTS.raiseMoney, '', 'raiseMoney' + data.game.turn));
} else if (data.player.state === GAME_STATES.midTurn) { }// else if (data.player.state === GAME_STATES.midTurn &&
store.dispatch(alertHandled()); // !data.game.state === 'finished') {
} // store.dispatch(alertHandled());
// }
if (data.event === 'auto-skip') { if (data.event === 'auto-skip') {
store.dispatch(autoSkip(data.component)); store.dispatch(autoSkip(data.component));
} }
if (data.event === 'end-of-game') { if (data.event === 'end-of-game') {
store.dispatch(alert(ALERTS.endOfGame, data.results)); store.dispatch(alert(ALERTS.endOfGame, data.results, 'endOfGame' + data.game.turn));
}
if (data.event === 'action' && data.action === false) {
const playerSpaces = store.getState().farm.ui.playerSpaces;
data.game.otherPlayers.map(x => x.player).concat([data.player]).forEach(player => {
if (player.space !== playerSpaces[player.color]) {
store.dispatch(movePlayer(player.space, playerSpaces[player.color],
player.color));
}
});
} }
}); });
}; };

139
src/components/farm/reducers.js
View File

@@ -21,62 +21,63 @@ import { UPDATE_GAME, UPDATE_PLAYER, GAME_STATE, SET_SELECTED_CARD, SET_CARDS,
SET_OLD_MESSAGES, MESSAGE_PANEL_SPACE, MP_MOUSE, SET_OLD_MESSAGES, MESSAGE_PANEL_SPACE, MP_MOUSE,
SET_MP_DIMS, MOVE_PLAYER, SET_NEXT_ACTION, NEXT_UI_ACTION, SET_MP_DIMS, MOVE_PLAYER, SET_NEXT_ACTION, NEXT_UI_ACTION,
MARK_ACTION_CHANGE_HANDLED, NEXT_UI_ACTION_SILENT, ALERT, ALERT_HANDLED, MARK_ACTION_CHANGE_HANDLED, NEXT_UI_ACTION_SILENT, ALERT, ALERT_HANDLED,
AUTO_SKIP, MESSAGE } from './actionTypes.js' AUTO_SKIP, MESSAGE, SET_HARVEST_TABLE } from './actionTypes.js'
import { GAME_STATES } from '../../constants.js' import { GAME_STATES } from '../../constants.js'
import { spaceContent, corners } from 'game.js' import { spaceContent, corners } from 'game.js'
const spaces = const spaces =
[[corners[0], 'buy'], [[corners[0], 'buy', false],
['January', 'buy'], ['January', 'buy', false],
['January', 'buy'], ['January', 'buy', 'otb'],
['January', 'buy'], ['January', 'buy', false],
['January', 'buy'], ['January', 'buy', false],
['February','buy'], ['February','buy', false],
['February', 'buy'], ['February', 'buy', 'fate'],
['February', 'buy'], ['February', 'buy', false],
['February', 'buy'], ['February', 'buy', 'otb'],
['March', 'buy'], ['March', 'buy', false],
['March', 'buy'], ['March', 'buy', false],
['March', 'buy'], ['March', 'buy', false],
['March', 'buy'], ['March', 'buy', false],
['April', 'buy'], ['April', 'buy', 'otb'],
[corners[1], 'buy'], [corners[1], 'buy', false],
['April', 'none'], ['April', 'none', false],
['April', 'none'], ['April', 'none', false],
['May', 'none'], ['May', 'none', false],
['May', 'none'], ['May', 'none', false],
['May', 'hay'], ['May', 'hay', false],
['May', 'hay'], ['May', 'hay', 'otb'],
['June', 'hay'], ['June', 'hay', false],
['June', 'hay'], ['June', 'hay', false],
['June', 'cherry'], ['June', 'cherry', false],
['June', 'cherry'], ['June', 'cherry', 'fate'],
[corners[2], 'cherry'], [corners[2], 'cherry', false],
['July', 'hay'], ['July', 'hay', false],
['July', 'hay'], ['July', 'hay', 'otb'],
['July', 'hay'], ['July', 'hay', false],
['July', 'wheat'], ['July', 'wheat', false],
['August', 'wheat'], ['August', 'wheat', false],
['August', 'wheat'], ['August', 'wheat', false],
['August', 'wheat'], ['August', 'wheat', false],
['August', 'wheat'], ['August', 'wheat', false],
['September', 'hay'], ['September', 'hay', false],
['September', 'hay'], ['September', 'hay', 'otb'],
['September', 'cows'], ['September', 'cows', false],
[corners[3], 'cows'], [corners[3], 'cows', false],
['September', 'cows'], ['September', 'cows', false],
['October', 'cows'], ['October', 'cows', false],
['October', 'hay'], ['October', 'hay', 'fate'],
['October', 'hay'], ['October', 'hay', 'otb'],
['October', 'apple'], ['October', 'apple', 'fate'],
['November', 'apple'], ['November', 'apple', 'otb'],
['November', 'apple'], ['November', 'apple', false],
['November', 'apple'], ['November', 'apple', false],
['November', 'corn'], ['November', 'corn', false],
['December', 'corn'], ['December', 'corn', false],
['December', 'corn']] ['December', 'corn', 'fate']]
.map((s, i) => { .map((s, i) => {
return { month: s[0], description: spaceContent[i], return { month: s[0], description: spaceContent[i],
card: s[2],
type: s[1], key: i, players: [] }}); type: s[1], key: i, players: [] }});
const initialState = { const initialState = {
@@ -112,10 +113,11 @@ const initialState = {
nextActionValue: null, nextActionValue: null,
actionChangeHandled: true, actionChangeHandled: true,
message: '', message: '',
alert: false, alerts: {},
alertContents: false, unhandledAlert: false,
autoSkip: false, autoSkip: false,
alertHandled: false }, playerSpaces: {},
harvestTable: false },
spaces: spaces, spaces: spaces,
space: null, space: null,
// message panel dimenions // message panel dimenions
@@ -150,7 +152,10 @@ export default function(state = initialState, action) {
.filter(x => x !== action.player) }; .filter(x => x !== action.player) };
} }
return item; return item;
}) }),
ui: { ...state.ui,
playerSpaces: { ...state.ui.playerSpaces,
[action.player]: action.newSpace }}
}; };
case SET_OLD_MESSAGES: case SET_OLD_MESSAGES:
return { ...state, oldMessages: action.messages }; return { ...state, oldMessages: action.messages };
@@ -179,16 +184,34 @@ export default function(state = initialState, action) {
case MARK_ACTION_CHANGE_HANDLED: case MARK_ACTION_CHANGE_HANDLED:
return { ...state, ui: { ...state.ui, actionChangeHandled: true }}; return { ...state, ui: { ...state.ui, actionChangeHandled: true }};
case ALERT: case ALERT:
let alerts = { ...state.ui.alerts,
[action.id]: { type: action.value,
id: action.id,
contents: action.contents,
handled: false }
};
return { ...state, ui: { ...state.ui, return { ...state, ui: { ...state.ui,
alert: action.value, alerts,
alertContents: action.contents, unhandledAlert: Object.values(alerts).find(x => !x.handled)
alertHandled: action.value === false ? true : false }}; }
};
case ALERT_HANDLED: case ALERT_HANDLED:
return { ...state, ui: { ...state.ui, alertHandled: true }}; alerts = { ...state.ui.alerts,
[action.id]: { ...state.ui.alerts[action.id],
handled: true
}
};
return { ...state, ui: { ...state.ui,
alerts,
unhandledAlert: Object.values(alerts).find(x => !x.handled)
}
};
case AUTO_SKIP: case AUTO_SKIP:
return { ...state, ui: { ...state.ui, autoSkip: action.component }}; return { ...state, ui: { ...state.ui, autoSkip: action.component }};
case MESSAGE: case MESSAGE:
return { ...state, ui: { ...state.ui, message: action.message }}; return { ...state, ui: { ...state.ui, message: action.message }};
case SET_HARVEST_TABLE:
return { ...state, ui: { ...state.ui, harvestTable: action.table }};
default: default:
return state; return state;
} }

25
src/components/new-game/NewGame.jsx
View File

@@ -57,19 +57,23 @@ class NewGame extends React.Component {
checkedColor: props.colors[0], checkedColor: props.colors[0],
gameId: typeof props.gameId === 'undefined' ? -1 : props.gameId, gameId: typeof props.gameId === 'undefined' ? -1 : props.gameId,
gameName: props.gameName || '', gameName: props.gameName || '',
downPayment: 0.2, downPayment: 0,
loanInterest: 0.2, loanInterest: 0,
maxDebt: 50000, maxDebt: 50000,
auditThreshold: 250000, auditThreshold: 250000,
startingCash: 5000, startingCash: 5000,
startingDebt: 5000 startingDebt: 5000,
trade: true
}; };
} }
handleInputChange = e => { handleInputChange = e => {
const target = e.target, const target = e.target,
value = target.type === 'checkbox' ? target.name : target.value, value = target.type === 'checkbox' && target.name !== 'trade'
name = target.type === 'checkbox' ? 'checkedColor' : target.name; ? target.name : target.value,
name = target.type === 'checkbox' && target.name !== 'trade'
? 'checkedColor' : target.name;
this.setState({ this.setState({
[name]: value [name]: value
@@ -183,6 +187,17 @@ class NewGame extends React.Component {
step={1000} step={1000}
value={this.state.startingDebt} value={this.state.startingDebt}
onChange={this.handleInputChange} /> onChange={this.handleInputChange} />
<Row>
<Col width='12'>
<label>
<input type='checkbox'
checked={this.state.trade}
onChange={this.handleInputChange}
name='trade' />
Enable Trading
</label>
</Col>
</Row>
</div> </div>
<Row> <Row>
<Col width='12'> <Col width='12'>

4
src/constants.js
View File

@@ -32,4 +32,6 @@ export const messagePanelId = 'message-panel';
export const ALERTS = { beginTurn: 'begin-turn', export const ALERTS = { beginTurn: 'begin-turn',
otherPlayersTurn: 'other-players-turn', otherPlayersTurn: 'other-players-turn',
endOfGame: 'end-of-game', endOfGame: 'end-of-game',
raiseMoney: 'raise-money' } auditCalled: 'audit-called',
raiseMoney: 'raise-money',
proposedTrade: 'proposed-trade' }

478
src/server/farm.scm
View File

@@ -60,6 +60,7 @@
(space initform: 0 accessor: player-space) (space initform: 0 accessor: player-space)
(previous-space initform: 0 accessor: player-previous-space) (previous-space initform: 0 accessor: player-previous-space)
(state initform: 'turn-ended accessor: player-state) (state initform: 'turn-ended accessor: player-state)
(finished initform: #f accessor: player-finished)
(assets initform: (assets initform:
'((hay . 10) (grain . 10) (fruit . 0) (cows . 0) '((hay . 10) (grain . 10) (fruit . 0) (cows . 0)
(harvester . 0) (tractor . 0)) (harvester . 0) (tractor . 0))
@@ -94,6 +95,7 @@
(state initform: 'playing accessor: game-state) (state initform: 'playing accessor: game-state)
(name initform: "game" accessor: game-name) (name initform: "game" accessor: game-name)
(turn initform: 1 accessor: game-turn) (turn initform: 1 accessor: game-turn)
(current-player initform: #f accessor: game-current-player)
(actions initform: '() accessor: game-actions) (actions initform: '() accessor: game-actions)
(settings initform: (settings initform:
'((down-payment . 0.2) '((down-payment . 0.2)
@@ -101,7 +103,8 @@
(max-debt . 50000) (max-debt . 50000)
(audit-threshold . 250000) (audit-threshold . 250000)
(starting-cash . 5000) (starting-cash . 5000)
(starting-debt . 5000)) (starting-debt . 5000)
(trade . #t))
accessor: game-settings))) accessor: game-settings)))
(define (game-setting setting game) (define (game-setting setting game)
@@ -223,37 +226,34 @@
'state (if (= (length (game-players game)) 0) 'state (if (= (length (game-players game)) 0)
'pre-turn 'turn-ended)))) 'pre-turn 'turn-ended))))
(set! (game-players game) (append (game-players game) (list player))) (set! (game-players game) (append (game-players game) (list player)))
(when (= (length (game-players game)) 1)
(set! (game-current-player game) player))
player)) player))
(define (all-players-finished game) (define (all-players-finished game)
(null? (filter (lambda (p) (null? (filter (lambda (p)
(not (eq? (player-state p) 'finished-game))) (not (player-finished p)))
(game-players game)))) (game-players game))))
(define (next-player game player) (define (next-player game)
(let ((tail (cdr (filter (lambda (p) (let ((tail (filter (lambda (p)
(not (eq? (player-state p) 'finished-game))) (not (player-finished p)))
(find-tail (cut eq? <> player) (game-players game)))))) (find-tail (cut eq? <> (game-current-player game))
(if (null? tail) (game-players game)))))
(car (game-players game)) (if (or (null? tail) (null? (cdr tail)))
(car tail)))) (car (filter (lambda (p)
(not (player-finished p)))
(game-players game)))
(car (cdr tail)))))
(define (advance-turn game player) (define (advance-turn game player)
(if (all-players-finished game) (if (all-players-finished game)
(set! (game-state game) 'finished) (set! (game-state game) 'finished)
(begin (set! (player-state player) 'turn-ended) (let ((next (next-player game)))
(set! (player-state (next-player game player)) 'pre-turn) (set! (player-state player) 'turn-ended)
(set! (game-turn game) (+ (game-turn game) 1))))) (set! (player-state next) 'pre-turn)
(set! (game-current-player game) next)
(define (current-players-turn game) (set! (game-turn game) (+ (game-turn game) 1)))))
(let loop ((players (game-players game)))
(cond ((null? players) ;; game finished use player 0 as a dummy player
(car (game-players game)))
((or (eq? (player-state (car players)) 'turn-ended)
(eq? (player-state (car players)) 'finished-game))
(loop (cdr players)))
(else
(car players)))))
(define (ridge-available? game ridge) (define (ridge-available? game ridge)
(let loop ((players (game-players game))) (let loop ((players (game-players game)))
@@ -326,7 +326,7 @@
(define (game->list g player) (define (game->list g player)
`((game . ((messages . ,(list->vector (reverse (game-messages g)))) `((game . ((messages . ,(list->vector (reverse (game-messages g))))
(currentPlayer . ,(player-name (current-players-turn g))) (currentPlayer . ,(player-name (game-current-player g)))
(otherPlayers (otherPlayers
. ,(list->vector . ,(list->vector
(map (map
@@ -340,7 +340,8 @@
(settings . ((downPayment . ,(game-setting 'down-payment g)) (settings . ((downPayment . ,(game-setting 'down-payment g))
(loanInterest . ,(game-setting 'loan-interest g)) (loanInterest . ,(game-setting 'loan-interest g))
(maxDebt . ,(game-setting 'max-debt g)) (maxDebt . ,(game-setting 'max-debt g))
(auditThreshold . ,(game-setting 'audit-threshold g)))))))) (auditThreshold . ,(game-setting 'audit-threshold g))
(trade . ,(game-setting 'trade g))))))))
(define (push-message player msg #!key (game (session-ref (sid) 'game))) (define (push-message player msg #!key (game (session-ref (sid) 'game)))
(if player (if player
@@ -405,6 +406,9 @@
(push-message player (conc "You bought " amount " " crop ".")) (push-message player (conc "You bought " amount " " crop "."))
#t))))) #t)))))
(define (make-player-year-rule id rule)
`((id . ,id) (rule . ,rule)))
(define (finish-year player #!optional (collect-wages #t)) (define (finish-year player #!optional (collect-wages #t))
(let ((game (session-ref (sid) 'game))) (let ((game (session-ref (sid) 'game)))
(when collect-wages (when collect-wages
@@ -417,10 +421,11 @@
(?value . "You earned $5,000 from your city job!")) (?value . "You earned $5,000 from your city job!"))
(game-actions game)))) (game-actions game))))
(when (game-called-audit game) (when (game-called-audit game)
(set! (player-state player) 'finished-game) (set! (game-actions game)
(advance-turn game player) (append (game-actions game)
;; advance turn resets state back to turn ended `(((?action . end-game)
(set! (player-state player) 'finished-game)) (?value . ,(lambda ()
(set! (player-finished player) #t))))))))
(set! (player-year-rules player) (player-next-year-rules player)) (set! (player-year-rules player) (player-next-year-rules player))
(set! (player-next-year-rules player) '()) (set! (player-next-year-rules player) '())
(when (not (null? (player-farmers-fates player))) (when (not (null? (player-farmers-fates player)))
@@ -436,12 +441,16 @@
(set! (game-farmers-fates game) (set! (game-farmers-fates game)
(filter (lambda (c) (not (eq? (alist-ref 'internal-id c) 'cows-15))) (filter (lambda (c) (not (eq? (alist-ref 'internal-id c) 'cows-15)))
(game-farmers-fates game))) (game-farmers-fates game)))
(push! `((?p cows player-action-post-harvest (push! (make-player-year-rule
,(make-remove-farmers-fate-from-hand 'cows-15)) 0
(?p cows)) `((?p cows player-action-post-harvest
,(make-remove-farmers-fate-from-hand 'cows-15))
(?p cows)))
(player-year-rules player)) (player-year-rules player))
(push! `((?d player-action ?p (push! (make-player-year-rule
,(make-remove-farmers-fate-after 'cows-15 40))) 1
`((?d player-action ?p
,(make-remove-farmers-fate-after 'cows-15 40))))
(player-year-rules player)))))) (player-year-rules player))))))
(define (find-player-by-name game name) (define (find-player-by-name game name)
@@ -489,50 +498,47 @@
'() '()
cards))) cards)))
(cond (basics (cond (basics
(push-message player (conc "You don't have enough " basics " to trade!")) (conc "You don't have enough " basics " to trade!"))
#f)
(other-basics (other-basics
(push-message player (conc (player-name other-player) (conc (player-name other-player)
" doesn't have enough " other-basics " to trade!")) " doesn't have enough " other-basics " to trade!"))
#f)
(ridges (ridges
(push-message player (conc ridges " ridge not available to trade!")) (conc ridges " ridge not available to trade!"))
#f)
((< (+ (player-cash player) (alist-ref 'money params eqv? 0)) 0) ((< (+ (player-cash player) (alist-ref 'money params eqv? 0)) 0)
(push-message player "You don't have enough cash to trade!") "You don't have enough cash to trade!")
#f)
((< (+ (player-cash other-player) (* (alist-ref 'money params eqv? 0) -1)) 0) ((< (+ (player-cash other-player) (* (alist-ref 'money params eqv? 0) -1)) 0)
(push-message player (conc (player-name other-player) (conc (player-name other-player)
" doesn't have enough cash to trade!")) " doesn't have enough cash to trade!"))
#f)
((not (null? missing-cards)) ((not (null? missing-cards))
(push-message player (conc "Nobody has cards: " (conc "Nobody has cards: "
(string-intersperse (string-intersperse
(map number->string missing-cards) (map number->string missing-cards)
", ") ".")) ", ") "."))
#f)
(else (else
other-player)))) other-player))))
(define *trade-number* 0)
(define (propose-trade game player params) (define (propose-trade game player params)
(let ((other-player (validate-trade game player params))) (let ((other-player (validate-trade game player params)))
(if other-player (if (not (string? other-player))
(let ((to-trade (filter (lambda (x) (and (not (equal? (cdr x) 0)) (let ((to-trade (filter (lambda (x) (and (not (equal? (cdr x) 0))
(not (equal? (cdr x) "")) (not (equal? (cdr x) ""))
(cdr x))) (cdr x)))
params))) params)))
(push-message player (set! *trade-number* (+ *trade-number* 1))
(conc "Trade proposed to " (player-name other-player) "!"))
(set! (player-trade other-player) (set! (player-trade other-player)
(append `((player . ,(player-name player)) (append `((player . ,(player-name player))
(originator . ,(player-name player))) (originator . ,(player-name player))
(trade-number . ,*trade-number*))
to-trade)) to-trade))
(set! (player-trade player) (set! (player-trade player)
(append `((player . ,(player-name other-player)) (append `((player . ,(player-name other-player))
(originator . ,(player-name player))) (originator . ,(player-name player))
(trade-number . ,*trade-number*))
to-trade)) to-trade))
#t) #t)
#f))) other-player)))
(define (otb-by-id player id) (define (otb-by-id player id)
(find (lambda (card) (find (lambda (card)
@@ -689,6 +695,7 @@
(when game (when game
(set! (game-messages game) '()) (set! (game-messages game) '())
(set! (player-last-cash player) (player-cash player))) (set! (player-last-cash player) (player-cash player)))
(print "message type: " type)
(cond ((string=? type "roll") (cond ((string=? type "roll")
(let ((num (+ (random 6) 1))) (let ((num (+ (random 6) 1)))
(when *next-roll* (set! num *next-roll*)) (when *next-roll* (set! num *next-roll*))
@@ -704,8 +711,6 @@
(when (and (> (player-previous-space player) 40) (when (and (> (player-previous-space player) 40)
(< (player-space player) 10)) (< (player-space player) 10))
(finish-year player)) (finish-year player))
(when (eq? (game-state game) 'finished)
(do-end-of-game game)) ;; TODO check
(set! (player-harvest-mult player) 1) (set! (player-harvest-mult player) 1)
(let ((resp `((from . ,(player-previous-space player)) (let ((resp `((from . ,(player-previous-space player))
(to . ,(player-space player))))) (to . ,(player-space player)))))
@@ -719,9 +724,11 @@
(create-ws-response player "action" `((action . "roll") (value . ,resp)))))) (create-ws-response player "action" `((action . "roll") (value . ,resp))))))
((and (string=? type "next-action") ((and (string=? type "next-action")
(not (eq? (player-state player) 'turn-ended))) (not (eq? (player-state player) 'turn-ended)))
(let loop () (let loop ((i 0))
(if (null? (game-actions game)) (if (or (null? (game-actions game))
(>= i 15))
(begin (begin
(set! (game-actions game) '())
(message-players! game player `((action . #f) (value . #f))) (message-players! game player `((action . #f) (value . #f)))
(create-ws-response player "action" '((action . #f)))) (create-ws-response player "action" '((action . #f))))
(let* ((action (car (game-actions game))) (let* ((action (car (game-actions game)))
@@ -756,7 +763,7 @@
(let ((res (do-action action player))) (let ((res (do-action action player)))
(set! (game-actions game) (cdr (game-actions game))) (set! (game-actions game) (cdr (game-actions game)))
(if (eq? res 'nothing) (if (eq? res 'nothing)
(loop) (loop (+ i 1))
(begin (begin
(message-players! (message-players!
game player game player
@@ -772,21 +779,27 @@
(set! (game-actions game) (set! (game-actions game)
(cdr (game-actions game))) (cdr (game-actions game)))
(if (= (- (player-cash player) previous-cash) 0) (if (= (- (player-cash player) previous-cash) 0)
(loop) (loop (+ i 1))
(begin (let ((res `((action . "money")
(message-players! game player (value . ((amount . ,(- (player-cash player)
`((action . "money") previous-cash))
(value . ,(- (player-cash player) (player . ,(player-name player)))))))
previous-cash)))) (message-players! game player res)
(create-ws-response player "action" (create-ws-response player "action" res)))))
`((action . "money") ((eq? name 'end-game)
(value . ,(- (player-cash player) (if (null? (cdr (game-actions game)))
previous-cash)))))))) (begin
(value)
(set! (game-actions game) '()))
(set! (game-actions game)
(append (cdr (game-actions game))
(list (car (game-actions game))))))
(loop (+ i 1)))
((or (eq? name 'harvest-mult) ((or (eq? name 'harvest-mult)
(eq? name 'player-action-post-harvest)) (eq? name 'player-action-post-harvest))
(set! (game-actions game) (cdr (game-actions game))) (set! (game-actions game) (cdr (game-actions game)))
(do-action action player) (do-action action player)
(loop)) (loop (+ i 1)))
((eq? value 'farmers-fate) ((eq? value 'farmers-fate)
(let ((ff (do-action action player))) (let ((ff (do-action action player)))
(set! (game-actions game) (set! (game-actions game)
@@ -800,14 +813,13 @@
(value . ,(alist-ref 'contents ff)))))) (value . ,(alist-ref 'contents ff))))))
((eq? name 'ff-money) ((eq? name 'ff-money)
(set! (game-actions game) (cdr (game-actions game))) (set! (game-actions game) (cdr (game-actions game)))
(if (= value 0) (if (= (alist-ref 'amount value) 0)
(loop) (loop (+ i 1))
(begin (let ((res `((action . "money")
(message-players! game player (value . ((amount . ,(alist-ref 'amount value))
`((action . "money") (value . ,value))) (player . ,(alist-ref 'name value)))))))
(create-ws-response player "action" (message-players! game player res)
`((action . "money") (create-ws-response player "action" res))))
(value . ,value))))))
((eq? name 'ff-uncle-bert) ((eq? name 'ff-uncle-bert)
(set! (game-actions game) (cdr (game-actions game))) (set! (game-actions game) (cdr (game-actions game)))
(message-players! game player (message-players! game player
@@ -838,7 +850,7 @@
((eq? name 'add-rule) ((eq? name 'add-rule)
(do-action action player) (do-action action player)
(set! (game-actions game) (cdr (game-actions game))) (set! (game-actions game) (cdr (game-actions game)))
(loop)) (loop (+ i 1)))
(else ;; TODO make error (else ;; TODO make error
(create-ws-response player "action" `((action . ,name))))))))) (create-ws-response player "action" `((action . ,name)))))))))
((string=? type "skip") ((string=? type "skip")
@@ -904,9 +916,13 @@
)) ))
(create-ws-response player "loan" '())) (create-ws-response player "loan" '()))
((string=? type "trade") ((string=? type "trade")
(propose-trade game player (alist-ref 'parameters msg)) (let ((res (propose-trade game player (alist-ref 'parameters msg))))
(message-players! game player '() type: "update") (if (eq? res #t)
(create-ws-response player "trade" '())) (begin
(message-players! game player '() type: "update")
(create-ws-response player "trade" '()))
(begin (set! (player-trade player) `((error . ,res)))
(create-ws-response player "trade-error" `())))))
((string=? type "trade-accept") ((string=? type "trade-accept")
(accept-trade game player) (accept-trade game player)
(message-players! game player '() type: "update") (message-players! game player '() type: "update")
@@ -934,11 +950,15 @@
(message-players! game player '() type: "update") (message-players! game player '() type: "update")
(create-ws-response player "called-audit" '())) (create-ws-response player "called-audit" '()))
((string=? type "init") ((string=? type "init")
(create-ws-response player "init" '())) (create-ws-response player "init" `((harvestTable . ,(map (lambda (row)
`(,(car row) . ,(list->vector (cdr row))))
*harvest-table*)))))
((string=? type "turn-ended") ((string=? type "turn-ended")
(if (>= (player-cash player) 0) (if (>= (player-cash player) 0)
(begin (advance-turn game player) (begin (advance-turn game player)
(message-players! game player '() type: "update") (if (eq? (game-state game) 'finished)
(do-end-of-game game)
(message-players! game player '() type: "update"))
(create-ws-response player "update" '())) (create-ws-response player "update" '()))
(begin (push-message player "Cannot end a turn with negative cash!") (begin (push-message player "Cannot end a turn with negative cash!")
(create-ws-response player "update" '())))) (create-ws-response player "update" '()))))
@@ -953,17 +973,18 @@
'id (next-game-id *app*) 'id (next-game-id *app*)
'otbs (setup-otbs) 'otbs (setup-otbs)
'operating-expenses (setup-operating-expenses) 'operating-expenses (setup-operating-expenses)
'farmers-fates (setup-farmers-fates) 'farmers-fates (setup-farmers-fates #t)
'settings 'settings
`((down-payment . ,(->pct (alist-ref 'downPayment msg) 0.2)) `((down-payment . ,(->pct (alist-ref 'downPayment msg) 0))
(loan-interest . ,(->pct (alist-ref 'loanInterest msg) 0.2)) (loan-interest . ,(->pct (alist-ref 'loanInterest msg) 0))
(max-debt . ,(->i (alist-ref 'maxDebt msg) 50000)) (max-debt . ,(->i (alist-ref 'maxDebt msg) 50000))
(audit-threshold . ,(->i (alist-ref 'auditThreshold msg) (audit-threshold . ,(->i (alist-ref 'auditThreshold msg)
250000)) 250000))
(starting-cash . ,(->i (alist-ref 'startingCash msg) (starting-cash . ,(->i (alist-ref 'startingCash msg)
5000)) 0))
(starting-debt . ,(->i (alist-ref 'startingDebt msg) (starting-debt . ,(->i (alist-ref 'startingDebt msg)
5000))))) 0))
(trade . ,(or (alist-ref 'trade msg) #t)))))
(player (add-player-to-game game (player (add-player-to-game game
color color
(alist-ref 'playerName msg)))) (alist-ref 'playerName msg))))
@@ -973,11 +994,14 @@
(set-startup-otbs game player 2) (set-startup-otbs game player 2)
(create-start-response "new-game-started"))) (create-start-response "new-game-started")))
((string=? type "join-game") ((string=? type "join-game")
(let* ((color (string->symbol (alist-ref 'checkedColor msg))) (let* ((name (alist-ref 'gameName msg))
(name (alist-ref 'gameName msg))
(id (alist-ref 'gameId msg)) (id (alist-ref 'gameId msg))
(game (find (lambda (g) (= (game-id g) id)) (game (find (lambda (g) (= (game-id g) id))
(app-games *app*))) (app-games *app*)))
(color-raw (string->symbol (alist-ref 'checkedColor msg)))
(color (if (not (member color-raw (game-colors game)))
(car (game-colors game))
color-raw))
(player (add-player-to-game game (player (add-player-to-game game
color color
(alist-ref 'playerName msg)))) (alist-ref 'playerName msg))))
@@ -1156,7 +1180,7 @@
(define (players-with asset game) (define (players-with asset game)
(filter (lambda (player) (filter (lambda (player)
(player-has-asset? 'harvester player)) (player-has-asset? asset player))
(game-players game))) (game-players game)))
(define (player-asset-binary-count asset game) (define (player-asset-binary-count asset game)
@@ -1256,88 +1280,105 @@
(iota (list-ref spec 0)))) (iota (list-ref spec 0))))
farmers-fates ff-texts))) farmers-fates ff-texts)))
(define (ff-money-response amount player-name)
`((?action . ff-money)
(?value . ((amount . ,amount)
(name . ,player-name)))))
(define-syntax with-ff-money-action (define-syntax with-ff-money-action
(syntax-rules (?action ff-money ?value) (syntax-rules ()
((_ (player) body ...) ((_ (player game) body ...)
(let ((previous-cash (player-cash player))) (let ((previous-cash (map (lambda (p)
(cons p (player-cash p))) (game-players game))))
body ... body ...
`(((?action . ff-money) `(,(ff-money-response (- (player-cash player)
(?value . ,(- (player-cash player) previous-cash)))))))) (cdr (find (lambda (x) (eq? (car x) player)) previous-cash)))
(player-name player))
,@(map (lambda (x)
(ff-money-response (- (player-cash (car x)) (cdr x))
(player-name (car x))))
(filter (lambda (x)
(and (not (eq? (car x) player))
(not (= (- (player-cash (car x))
(cdr x))
0))))
previous-cash))
)))))
(define *farmers-fates-specs* (define *farmers-fates-specs*
;; xxx multiplayer interaction `((1 ,(lambda (player game)
`((1 ,(lambda (player) (with-ff-money-action (player game)
(for-each (lambda (p) (for-each (lambda (p)
(let ((roll (+ (random 6) 1))) (let ((roll (+ (random 6) 1)))
(if (odd? roll) (if (odd? roll)
(push-message p (conc "You rolled a " roll " and escaped!")) ((make-player-pays (* (player-acres p) 100)) p))))
(begin (push-message p (conc "You rolled a " roll " and were hit!")) (filter (lambda (x) (not (eq? x player)))
((make-player-pays (* (player-acres p) 100)) p))))) (game-players (session-ref (sid) 'game))))
(filter (lambda (x) (not (eq? x player))) ((make-player-gains-per-unit 'hay 500) player)))
(game-players (session-ref (sid) 'game))))
(with-ff-money-action (player)
((make-player-gains-per-unit 'hay 500) player)))
#f) #f)
(1 ,(lambda (player) (1 ,(lambda (player game)
(with-ff-money-action (player) (with-ff-money-action (player game)
((make-player-gains-per-unit 'grain 100) player))) ((make-player-gains-per-unit 'grain 100) player)))
#f) #f)
(1 ,(lambda (player) (1 ,(lambda (player game)
(push! '((?p wheat harvest-mult 0.5) (?p grain)) (player-year-rules player)) (push! (make-player-year-rule 2 '((?p wheat harvest-mult 0.5) (?p grain)))
(push! `((?p wheat player-action-post-harvest
,(make-remove-farmers-fate-from-hand 'windy-spring))
(?p grain))
(player-year-rules player)) (player-year-rules player))
(push! `((?d player-action ?p (push! (make-player-year-rule
,(make-remove-farmers-fate-after 'windy-spring 34))) 3
`((?p wheat player-action-post-harvest
,(make-remove-farmers-fate-from-hand 'windy-spring))
(?p grain)))
(player-year-rules player))
(push! (make-player-year-rule
4
`((?d player-action ?p
,(make-remove-farmers-fate-after 'windy-spring 34))))
(player-year-rules player)) (player-year-rules player))
'()) '())
#t #t
windy-spring) windy-spring)
(1 ,(lambda (player) (1 ,(lambda (player game)
(if (player-has-asset? 'cows player) (if (player-has-asset? 'cows player)
(with-ff-money-action (player) ((make-player-gains 2000) player)) (with-ff-money-action (player game) ((make-player-gains 2000) player))
'())) '()))
#f) #f)
(1 ,(lambda (player) (1 ,(lambda (player game)
(with-ff-money-action (player) (with-ff-money-action (player game)
((make-player-gains-per-unit 'hay 100) player))) ((make-player-gains-per-unit 'hay 100) player)))
#f) #f)
(1 ,(lambda (player) (1 ,(lambda (player game)
(with-ff-money-action (player) ((make-player-gains 1000) player))) (with-ff-money-action (player game) ((make-player-gains 1000) player)))
#f) #f)
(1 ,(lambda (player) (1 ,(lambda (player game)
(with-ff-money-action (player) ((make-player-pays 7000) player))) (with-ff-money-action (player game) ((make-player-pays 7000) player)))
#f) #f)
(1 ,(lambda (player) (1 ,(lambda (player game)
(with-ff-money-action (player) (with-ff-money-action (player game)
((make-player-pays-per-unit 'fruit 500) player))) ((make-player-pays-per-unit 'fruit 500) player)))
#f) #f)
(1 ,(lambda (player) (1 ,(lambda (player game)
(with-ff-money-action (player) (with-ff-money-action (player game)
(let ((to-earn (* (player-acres player) 100))) (let ((to-earn (* (player-acres player) 100)))
(push-message player (conc "You earned $" to-earn "!")) (push-message player (conc "You earned $" to-earn "!"))
(set! (player-cash player) (set! (player-cash player)
(+ (player-cash player) to-earn))))) (+ (player-cash player) to-earn)))))
#f) #f)
(2 ,(lambda (player) (2 ,(lambda (player game)
`(((?action . player-action) `(((?action . player-action)
(?value . ,(lambda (player) (finish-year player #f)))) (?value . ,(lambda (player) (finish-year player #f))))
((?action . goto) (?value . jan2)))) ((?action . goto) (?value . jan2))))
#f) #f)
(1 ,(lambda (player) (1 ,(lambda (player game)
(with-ff-money-action (player) (with-ff-money-action (player game)
((make-player-pays-per-unit 'fruit 300) player))) ((make-player-pays-per-unit 'fruit 300) player)))
#f) #f)
;; xxx multiplayer interaction (2 ,(lambda (player game)
(2 ,(lambda (player) (with-ff-money-action (player game)
(with-ff-money-action (player)
(equipment-payout 'tractor player 3000 (session-ref (sid) 'game)))) (equipment-payout 'tractor player 3000 (session-ref (sid) 'game))))
#f) #f)
;; xxx multiplayer interaction (1 ,(lambda (player game)
(1 ,(lambda (player)
(if (player-has-asset? 'harvester player) (if (player-has-asset? 'harvester player)
(with-ff-money-action (player) (with-ff-money-action (player game)
(for-each (lambda (from-player) (for-each (lambda (from-player)
(when (not (eq? player from-player)) (when (not (eq? player from-player))
(when (not (player-has-asset? 'harvester from-player)) (when (not (player-has-asset? 'harvester from-player))
@@ -1348,42 +1389,49 @@
(game-players (session-ref (sid) 'game)))) (game-players (session-ref (sid) 'game))))
'())) '()))
#f) #f)
(1 ,(lambda (player) (1 ,(lambda (player game)
(push! '((?p ?any harvest-mult 0) (?p ?crop)) (player-year-rules player)) (push! (make-player-year-rule 5 '((?p ?any harvest-mult 0) (?p ?crop)))
(player-year-rules player))
'()) '())
#t) #t)
(1 ,(lambda (player) (1 ,(lambda (player game)
`(((?action . ff-uncle-bert) (?value . #f)))) `(((?action . ff-uncle-bert) (?value . #f))))
#f) #f)
;; xxx multiplayer interaction (1 ,(lambda (player game)
(1 ,(lambda (player) (with-ff-money-action (player game)
(with-ff-money-action (player)
(equipment-payout 'harvester player 2500 (equipment-payout 'harvester player 2500
(session-ref (sid) 'game)))) (session-ref (sid) 'game))))
#f) #f)
(1 ,(lambda (player) (1 ,(lambda (player game)
(push! `((?p cows harvest-mult 1.5) (?p cows)) (player-year-rules player)) (push! (make-player-year-rule 6 `((?p cows harvest-mult 1.5) (?p cows)))
(push! `((?p cows harvest-mult 1.5) (?p cows)) (player-next-year-rules player)) (player-year-rules player))
(push! (make-player-year-rule 7 `((?p cows harvest-mult 1.5) (?p cows)))
(player-next-year-rules player))
'()) '())
#t #t
cows-15) cows-15)
(1 ,(lambda (player) (1 ,(lambda (player game)
(with-ff-money-action (player) ((make-player-gains 2000) player))) (with-ff-money-action (player game) ((make-player-gains 2000) player)))
#f) #f)
(1 ,(lambda (player) (1 ,(lambda (player game)
(when (< (player-space player) 26) (when (< (player-space player) 26)
(push! '((?p cherries harvest-mult 0.5) (?p fruit)) (player-year-rules player)) (push! (make-player-year-rule 7 '((?p cherries harvest-mult 0.5) (?p fruit)))
(push! `((?p cherries player-action-post-harvest (player-year-rules player))
,(make-remove-farmers-fate-from-hand 'cherries-05)) (push! (make-player-year-rule
(?p fruit)) 8
`((?p cherries player-action-post-harvest
,(make-remove-farmers-fate-from-hand 'cherries-05))
(?p fruit)))
(player-year-rules player))) (player-year-rules player)))
(push! `((?d player-action ?p (push! (make-player-year-rule
,(make-remove-farmers-fate-after 'cherries-05 26))) 8
`((?d player-action ?p
,(make-remove-farmers-fate-after 'cherries-05 26))))
(player-year-rules player)) (player-year-rules player))
'()) '())
#t #t
cherries-05) cherries-05)
(1 ,(lambda (player) (1 ,(lambda (player game)
(let ((cows (player-asset 'cows player)) (let ((cows (player-asset 'cows player))
(ridge-cows (cows-on-ridges player))) (ridge-cows (cows-on-ridges player)))
(if (> cows ridge-cows) (if (> cows ridge-cows)
@@ -1398,16 +1446,19 @@
" cows slaughtered on your farm."))))) " cows slaughtered on your farm.")))))
'()))) '())))
#f) #f)
(1 ,(lambda (player) (1 ,(lambda (player game)
(with-ff-money-action (player) (with-ff-money-action (player game)
((make-player-pays-per-unit 'fruit 1000) player))) ((make-player-pays-per-unit 'fruit 1000) player)))
#f) #f)
(1 ,(lambda (player) (1 ,(lambda (player game)
(with-ff-money-action (player) ((make-semi-annual-interest-due) player))) (with-ff-money-action (player game) ((make-semi-annual-interest-due) player)))
#f))) #f)))
(define (setup-farmers-fates) (define (setup-farmers-fates shuffle?)
(shuffle (farmers-fate-spec-list->farmers-fate-cards *farmers-fates-specs* *ff-text*))) (let ((cards (farmers-fate-spec-list->farmers-fate-cards *farmers-fates-specs* *ff-text*)))
(if shuffle?
(shuffle cards)
cards)))
(define *farmers-fates-cards* (define *farmers-fates-cards*
(farmers-fate-spec-list->farmers-fate-cards *farmers-fates-specs* *ff-text*)) (farmers-fate-spec-list->farmers-fate-cards *farmers-fates-specs* *ff-text*))
;; (define *farmers-fates* (setup-farmers-fates)) ;; (define *farmers-fates* (setup-farmers-fates))
@@ -1466,10 +1517,9 @@
(length (operating-expenses-spec-list->operating-expenses-cards (length (operating-expenses-spec-list->operating-expenses-cards
*operating-expenses-specs* *oe-text*))) *operating-expenses-specs* *oe-text*)))
(define (draw-operating-expense) (define (draw-operating-expense game)
(let* ((game (session-ref (sid) 'game)) (let ((card (list-ref (game-operating-expenses game)
(card (list-ref (game-operating-expenses game) (game-operating-expense-index game))))
(game-operating-expense-index game))))
(if (= (+ (game-operating-expense-index game) 1) *total-operating-expenses*) (if (= (+ (game-operating-expense-index game) 1) *total-operating-expenses*)
(set! (game-operating-expense-index game) 0) (set! (game-operating-expense-index game) 0)
(set! (game-operating-expense-index game) (set! (game-operating-expense-index game)
@@ -1497,7 +1547,7 @@
((jan1 player-action ?p ,(make-semi-annual-interest-due))) ((jan1 player-action ?p ,(make-semi-annual-interest-due)))
((jan2 draw ?p otb)) ((jan2 draw ?p otb))
((jan3 money ?p ,(pays 500)) (?p cows)) ((jan3 money ?p ,(pays 500)) (?p cows))
((jan4 add-rule ?p ((?p hay harvest-mult 2) (?p hay)))) ((jan4 add-rule ?p ,(make-player-year-rule 9 '((?p hay harvest-mult 2) (?p hay)))))
((feb1 money ?p ,(gains 1000))) ((feb1 money ?p ,(gains 1000)))
((feb2 draw ?p farmers-fate)) ((feb2 draw ?p farmers-fate))
((feb3 goto ?p apr2)) ((feb3 goto ?p apr2))
@@ -1507,7 +1557,8 @@
((mar3 goto ?p jan2)) ((mar3 goto ?p jan2))
((mar4 money ?p ,(pays 2000)) (?p fruit)) ((mar4 money ?p ,(pays 2000)) (?p fruit))
((apr1 draw ?p otb)) ((apr1 draw ?p otb))
((apr2 add-rule ?p ((?p corn harvest-mult 2) (?p grain)))) ((apr2 add-rule ?p ,(make-player-year-rule
10 '((?p corn harvest-mult 2) (?p grain)))))
((apr3 money ?p ,(pays 500))) ((apr3 money ?p ,(pays 500)))
((apr4 money ?p ,(pays 1000))) ((apr4 money ?p ,(pays 1000)))
((may1 money ?p ,(gains 500))) ((may1 money ?p ,(gains 500)))
@@ -1574,7 +1625,7 @@
((dec2 harvest ?p corn) (?p grain)) ((dec2 harvest ?p corn) (?p grain))
((dec3 money ?p ,(gains 1000))) ((dec3 money ?p ,(gains 1000)))
,@(player-year-rules player) ,@(map (lambda (x) (alist-ref 'rule x)) (player-year-rules player))
((?date harvest-mult ?p ?val) (?date harvest ?p ?crop) (?p ?crop harvest-mult ?val)) ((?date harvest-mult ?p ?val) (?date harvest ?p ?crop) (?p ?crop harvest-mult ?val))
((?date player-action-post-harvest ?p ?val) (?date harvest ?p ?crop) (?p ?crop player-action-post-harvest ?val)) ((?date player-action-post-harvest ?p ?val) (?date harvest ?p ?crop) (?p ?crop player-action-post-harvest ?val))
@@ -1647,7 +1698,8 @@
(car new-otb)))) (car new-otb))))
(define (do-action action player) (define (do-action action player)
(let ((a (alist-ref '?action action))) (let ((a (alist-ref '?action action))
(game (session-ref (sid) 'game)))
(cond ((eq? a 'money) (cond ((eq? a 'money)
(let ((changed ((alist-ref '?value action) 0))) (let ((changed ((alist-ref '?value action) 0)))
(push-message player (conc "You " (if (>= changed 0) "earned" "paid") " $" (push-message player (conc "You " (if (>= changed 0) "earned" "paid") " $"
@@ -1655,10 +1707,11 @@
(set! (player-cash player) (set! (player-cash player)
((alist-ref '?value action) (player-cash player)))) ((alist-ref '?value action) (player-cash player))))
((eq? a 'add-rule) ((eq? a 'add-rule)
(set! (player-year-rules player) (when (not (member (alist-ref 'id (alist-ref '?value action))
(cons (alist-ref '?value action) (player-year-rules player))) (map (lambda (x) (alist-ref 'id x))
;; TODO handle being added multiple times (player-year-rules player))))
) (set! (player-year-rules player)
(cons (alist-ref '?value action) (player-year-rules player)))))
((eq? a 'goto) ((eq? a 'goto)
(set! (player-previous-space player) (player-space player)) (set! (player-previous-space player) (player-space player))
(set! (player-space player) (set! (player-space player)
@@ -1676,7 +1729,7 @@
(begin (push! (car new-ff) (player-farmers-fates player)) (begin (push! (car new-ff) (player-farmers-fates player))
(set! (game-farmers-fates game) remaining-ffs)) (set! (game-farmers-fates game) remaining-ffs))
(set! (game-farmers-fates game) (append remaining-ffs new-ff))) (set! (game-farmers-fates game) (append remaining-ffs new-ff)))
`((actions . ,((alist-ref 'action (car new-ff)) player)) `((actions . ,((alist-ref 'action (car new-ff)) player game))
(contents . ,(alist-ref 'contents (car new-ff))))))) (contents . ,(alist-ref 'contents (car new-ff)))))))
((or (eq? a 'player-action) (eq? a 'player-action-post-harvest)) ((or (eq? a 'player-action) (eq? a 'player-action-post-harvest))
((alist-ref '?value action) player)) ((alist-ref '?value action) player))
@@ -1696,22 +1749,36 @@
(player-harvest-mult player))))) (player-harvest-mult player)))))
(if (not (already-harvested? (alist-ref '?value action) player)) (if (not (already-harvested? (alist-ref '?value action) player))
(begin (begin
(push-message player (conc crop " Harvest! You rolled a " rolled
" and earned $" income "!"))
(when (not (= (player-harvest-mult player) 1))
(push-message player (conc "Harvest multiplied by " (player-harvest-mult player) "!")))
(set! (player-cash player) (set! (player-cash player)
(+ (player-cash player) income)) (+ (player-cash player) income))
(set! (player-harvest-mult player) 1) (set! (player-harvest-mult player) 1)
(let ((operating-expense (draw-operating-expense)) (let ((operating-expense (draw-operating-expense game))
(previous-cash (player-cash player))) (previous-cash (player-cash player))
(other-previous-cash (map (lambda (p)
(cons p (player-cash p)))
(filter
(lambda (p)
(not (string=? (player-name p)
(player-name player))))
(game-players game)))))
((alist-ref 'action operating-expense) player) ((alist-ref 'action operating-expense) player)
(push-message player (alist-ref 'summary operating-expense))
`((rolled . ,rolled) `((rolled . ,rolled)
(income . ,income) (income . ,income)
(operatingExpense . ,(alist-ref 'contents operating-expense)) (operatingExpense . ,(alist-ref 'contents operating-expense))
(operatingExpenseValue . ,(- (player-cash player) (operatingExpenseValue . ((,(string->symbol (player-name player))
previous-cash)) . ,(- (player-cash player)
previous-cash))
,@(map (lambda (p/c)
(let ((p (car p/c)))
`(,(string->symbol (player-name p))
. ,(- (player-cash p)
(cdr p/c)))))
(filter
(lambda (p/c)
(not (= 0
(- (player-cash (car p/c))
(cdr p/c)))))
other-previous-cash))))
(crop . ,(symbol->string (alist-ref '?value action))) (crop . ,(symbol->string (alist-ref '?value action)))
(acres . ,acres)))) (acres . ,acres))))
'nothing)))))) 'nothing))))))
@@ -1754,6 +1821,12 @@
((eq? b 'goto) #f) ((eq? b 'goto) #f)
(else #f)))))) (else #f))))))
(define (first-game)
(car (app-games *app*)))
(define (gp i)
(list-ref (game-players (first-game)) i))
(cond-expand (cond-expand
(geiser (geiser
'()) '())
@@ -1762,11 +1835,34 @@
(repl)) (repl))
(compiling ;; production (compiling ;; production
(run-awful) (run-awful)
(thread-join! *server-thread*))) (repl)
;; (thread-join! *server-thread*)
))
;; TODO ;; TODO
;; make game finished display results.
;; make sure two players can't have the same name ;; make sure two players can't have the same name
;; info actions should look better ;; info actions should look better
;; you can get $50 from harvest ;; you can get $50 from harvest
;; bug: new websocket messages should not reset IFS card selection ;; moving bug 5 from oct 2 saw by player 2
;; from harvest moon rolled 5
;; finished
;; infinite loop ((?action . end-game) (?value . #<procedure (a10302)>))
;; interface.js:172 Uncaught TypeError: Cannot read property 'toFixed' of undefined
;; at formatMoney (interface.js:172)
;; at interface.js:248
;; at Object.dispatch (redux.js:222)
;; at interface.js:94
;; at bk (react-dom.production.min.js:224)
;; at WebSocket.handleMessage (interface.js:46)
;; auto-skip loop
;; harvester / tractor don't say total price
;; trade screen: person who porposed trade is wrong
;; mark spaces
;; decling trade doesn't work
;; support trading farmers fates
;; repay loan box 1 more than max can repay
;; test tractor/harvester a lot better

28
src/style.scss
View File

@@ -267,6 +267,7 @@ $tab-margin: 0.3rem;
margin: 0; } margin: 0; }
.player-trade-resources .resource-unit { .player-trade-resources .resource-unit {
display: inline-block;
width: 4rem; } width: 4rem; }
.card-id { .card-id {
@@ -546,14 +547,26 @@ $tab-margin: 0.3rem;
max-width: 30rem; } max-width: 30rem; }
@include breakpoint(large) { @include breakpoint(large) {
font-size: 23px; font-size: 23px;
max-width: 45rem; } width: 100%; }
margin-left: auto; margin-left: auto;
margin-right: auto; } margin-right: auto; }
.tab-container { .tab-container {
overflow-y: auto; overflow-y: auto;
max-height: 80vh; max-height: 80vh;
flex-grow: 2; } @include breakpoint(medium down) {
flex-grow: 2;
}
@include breakpoint(large) {
width: 40rem;
}
}
.static-tab-container {
overflow-y: auto;
max-height: 80vh;
width: 26rem;
}
.tab { .tab {
$tab-border: 0.3rem solid $primary-color; $tab-border: 0.3rem solid $primary-color;
@@ -581,6 +594,11 @@ $tab-margin: 0.3rem;
.turn-container .button { .turn-container .button {
margin: 0; } margin: 0; }
.harvest-table {
overflow: auto;
max-width: 75vw;
}
.board-heading { .board-heading {
z-index: -1; z-index: -1;
position: absolute; position: absolute;
@@ -780,3 +798,9 @@ $intro-time: 6s;
.hidden { .hidden {
display: none; } display: none; }
.space-icon {
position: absolute;
bottom: 0;
opacity: 0.5;
right: 4px; }