Adding AI.

src/components/farm/Board.jsx

@@ -34,7 +34,7 @@ import { FontAwesomeIcon } from '@fortawesome/react-fontawesome'
 import { faUser, faUsers, faTractor, faWindowRestore,
          faDollarSign, faTimes, faExchangeAlt,
          faInfoCircle, faArrowUp, faArrowDown, faAward,
-         faBan, faArrowCircleLeft } from '@fortawesome/free-solid-svg-icons'
+         faBan, faArrowCircleLeft, faPlusCircle } from '@fortawesome/free-solid-svg-icons'
 
 import { GroupBox, Row, Col, Button } from '../widgets.jsx'
 import SpaceNode from './SpaceNode.jsx'
@@ -48,7 +48,8 @@ import { setSelectedCard, setMessagePanelSpace, setMPDims, movePlayer,
 import { buy, roll, endTurn, loan, trade, submitTradeAccept,
          submitTradeDeny, submitTradeCancel, audit,
          buyUncleBert, skip, endAiTurn, startGame, readyToStart,
-         leaveGame, kickPlayer, toggleRevealForTrade } from './interface.js'
+         leaveGame, kickPlayer, toggleRevealForTrade,
+         addAIPlayer } from './interface.js'
 
 function netWorth(player) {
     return ((player.assets.hay + player.assets.grain) * 2000) +
@@ -1340,7 +1341,7 @@ class Harvest extends React.Component {
                                 Get ready to harvest <b>{this.props.acres}
                                     {this.props.crop === 'cows' ? ' head of cow' : ' acres'}</b>!
                             </div>
-                            {isCurrentPlayer ? (
+                            {isCurrentPlayer || this.props.currentPlayer.ai ? (
                                  <Button onClick={() => this.nextView('roll')}>
                                      Roll for harvest!
                                  </Button>
@@ -1356,7 +1357,7 @@ class Harvest extends React.Component {
                 view = (<Die decay={true} num={this.props.rolled} ms={2000} roll={true}
                              rolls={this.props.rolls}
                              showScreen={() => this.nextView('income')}
-                             skip={this.props.player.name === this.props.game.currentPlayer}
+                             skip={this.props.player.name === this.props.game.currentPlayer || this.props.currentPlayer.ai}
                              autoSkip={this.props.autoSkip === 'die'}
                              showScreenDelay={2000} />);
                 break;
@@ -1372,7 +1373,7 @@ class Harvest extends React.Component {
                                 </div>
                             </div>
                         </div>
-                        {isCurrentPlayer ? (
+                        {isCurrentPlayer || this.props.currentPlayer.ai ? (
                              <div className='center spacer'>
                                  <Button onClick={() => this.nextView('operating-expense')}>Draw Operating Expense</Button>
                              </div>
@@ -1389,7 +1390,7 @@ class Harvest extends React.Component {
                                      dangerouslySetInnerHTML={{__html: this.props.contents}} />
                             </GroupBox>
                         </div>
-                        {isCurrentPlayer ? (
+                        {isCurrentPlayer || this.props.currentPlayer.ai ? (
                              <div className='center spacer'>
                                  <Button onClick={() => this.nextView('expense-value')}>Continue</Button>
                              </div>
@@ -1424,7 +1425,7 @@ class Harvest extends React.Component {
                                 </div>
                             </div>
                         </div>
-                        {isCurrentPlayer ?
+                        {isCurrentPlayer || this.props.currentPlayer.ai ?
                          (
                              <div className='center spacer'>
                                  <Button onClick={this.props.nextAction}>Continue</Button>
@@ -1488,7 +1489,7 @@ class Action extends React.Component {
 
     bertSubmit = (e) => {
         e.preventDefault();
-        if (this.state.bertChoice === 'accept') {
+        if (this.state.bertChoice === 'accept' || this.props.currentPlayer.ai) {
             buyUncleBert();
             this.props.showNextAction();
         } else if (this.state.bertChoice === 'deny') {
@@ -1550,6 +1551,11 @@ class Action extends React.Component {
                         </form>
                     </>
                 );
+                const aiButton = (
+                    <form onSubmit={this.bertSubmit}>
+                        <Button type="submit">Continue</Button>
+                    </form>
+                );
                 view = (
                     <GroupBox title={`Uncle Bert's inheritance`}>
                         <div className='center'>
@@ -1567,6 +1573,7 @@ class Action extends React.Component {
                             <div>
                                 {(this.props.player.name === this.props.game.currentPlayer) ?
                                  ffButtons : (<Fragment />)}
+                                {currentPlayer.ai ? aiButton : (<></>)}
                             </div>
                         </div>
                     </GroupBox>
@@ -1937,6 +1944,11 @@ class StartGame extends React.Component {
                             ): (<></>)}
                         </li>
                     ))}
+                    <li>
+                        <span className="add-ai" onClick={addAIPlayer}>
+                            <FontAwesomeIcon icon={faPlusCircle} />AI
+                        </span>
+                    </li>
                 </ul>
                 <h4>Game Settings</h4>
                 <ul>

src/components/farm/interface.js

@@ -31,7 +31,8 @@ import { itemCard, fateCard } from 'game.js'
 export { initialize, buy, roll, endTurn, loan, trade, submitTradeAccept,
          submitTradeDeny, submitTradeCancel, audit, handleMessage,
          nextAction, buyUncleBert, actionsFinished, skip, endAiTurn,
-         startGame, readyToStart, leaveGame, kickPlayer, toggleRevealForTrade }
+         startGame, readyToStart, leaveGame, kickPlayer, toggleRevealForTrade,
+         addAIPlayer }
 
 let store;
 let movingTimer = 0;
@@ -217,6 +218,10 @@ function kickPlayer(name) {
     sendCommand({ type: 'kick-player', name });
 }
 
+function addAIPlayer() {
+    sendCommand({ type: 'add-ai-player' });
+}
+
 function toggleRevealForTrade(id) {
     sendCommand({ type: 'toggle-reveal-for-trading', id });
 }

src/server/farm.scm

@@ -120,7 +120,7 @@
    (next-year-rules initform: '() accessor: player-next-year-rules)
    (color initform: #f accessor: player-color)
    (name initform: "PLAYER X" accessor: player-name)
-   (user-id initform: #f accessor: player-user-id)
+   (user-id initform: -1 accessor: player-user-id)
    (trade initform: '() accessor: player-trade)
    (last-updated initform: 0 accessor: player-last-updated)
    (last-cash initform: 5000 accessor: player-last-cash)
@@ -202,7 +202,8 @@
     (last-cash . ,(player-cash player))
     (hay-doubled . ,(player-hay-doubled player))
     (corn-doubled . ,(player-corn-doubled player))
-    (stats . ,(player-stats player))))
+    (stats . ,(player-stats player))
+    (ai . ,(ai-player? player))))
 
 (define (game->sexp g)
   `((id . ,(game-id g))
@@ -317,7 +318,7 @@
       (set! *app* (sexp->app (read))))))
 
 (define (sexp->player x)
-  (let ((p (apply make <player>
+  (let ((p (apply make (if (alist-ref 'ai x) <ai> <player>)
                   'farmers-fates (let ((ffs (alist-ref 'farmers-fates x)))
                                    (list-copy
                                     (filter (lambda (card)
@@ -422,7 +423,7 @@
 
 (define (add-ai-to-game game color name)
   (let ((player (make <ai>
-                  'cash 10000
+                  'cash (game-setting 'starting-cash game)
                   'display-cash (game-setting 'starting-cash game)
                   'debt (game-setting 'starting-debt game)
                   'color color
@@ -555,6 +556,7 @@
                (state . ,(symbol->string (player-state p)))
                (cards . ,(list->vector (append (player-farmers-fates p)
                                                (player-otbs p))))
+               (revealedCards . ,(list->vector (player-revealed-cards p)))
                (color . ,(symbol->string (player-color p)))
                (name . ,(player-name p))
                (user-id . ,(player-user-id p))
@@ -1044,6 +1046,10 @@
         game-in-memory
         (let ((db-game (sexp->game (db-fetch-game id))))
           (push! db-game (app-games *app*))
+          (for-each (lambda (p)
+                      (when (ai-player? p)
+                        (thread-start! (make-ai-push-receiver db-game p))))
+                    (game-players db-game))
           db-game))))
 
 (define (next-roll last-roll)
@@ -1261,9 +1267,13 @@
         ((and (string=? type "next-action")
               (ai-player? (game-current-player game)))
          (print "ai next action trigger")
-         (print (player-name (game-current-player game)))
          (message-players! game player '() type: "ai-next-action")
          (create-ws-response player "update" `()))
+        ((and (string=? type "buy-uncle-bert")
+              (ai-player? (game-current-player game)))
+         (print "ai uncle bert trigger")
+         (message-players! game player '() type: "ai-uncle-bert")
+         (create-ws-response player "update" `()))
         ((string=? type "end-ai-turn")
          (message-players! game player '() type: "end-ai-turn")
          (create-ws-response player "update" `()))
@@ -1469,6 +1479,21 @@
            (set-startup-otbs game player (alist-ref 'starting-otbs (game-settings game)))
            (message-players! game player '() type: "update")
            (create-start-response "new-game-started")))
+        ((string=? type "add-ai-player")
+         (let* ((user (fetch-user-by-id (session-ref (sid) 'user-id)))
+                (name (conc "AI Player "
+                            (+ 1 (length (filter ai-player? (game-players game))))))
+                (game (*game*))
+                (color (car (game-colors game)))
+                (player (add-ai-to-game game
+                                            color
+                                            name)))
+           (safe-set! (game-colors game) (filter (cut neq? <> color) (game-colors game)))
+           (set-startup-otbs game player (alist-ref 'starting-otbs (game-settings game)))
+           (safe-set! (player-ready-to-start player) #t)
+           (thread-start! (make-ai-push-receiver game player))
+           (message-players! game player '() type: "update")
+           (create-ws-response (*player*) "update" '())))
         ((string=? type "join-as-existing")
          (let* ((id (or (alist-ref 'gameId msg)
                         (session-ref (sid) 'game-id)))
@@ -1547,6 +1572,79 @@
          (message-players! (*game*) (*player*) '() type: "update")
          (create-ws-response (*player*) "update" '()))))
 
+(define (round-down-1000 val)
+  (- val (remainder val 1000)))
+
+(define (ai-buy player game)
+  (print "ai attempting to buy")
+  (let ((room (+ (- (game-setting 'max-debt game) (player-debt player)) (round-down-1000 (player-cash player))))
+        (crops (map (lambda (card)
+                      (string->symbol (alist-ref 'crop card)))
+                    (player-otbs player))))
+    (print (conc "room: " room))
+    (print (conc "crops: " crops))
+    (let ((to-buy
+           (cond ((and (member 'cows crops) (>= room 5000))
+                  '(cows 10 5000))
+                 ((and (member 'fruit crops) (>= room 25000))
+                  '(fruit 5 25000))
+                 ((and (member 'grain crops) (>= room 20000))
+                  '(grain 10 20000))
+                 ((and (member 'hay crops) (>= room 20000))
+                  '(hay 10 20000))
+                 ((and (member 'harvester crops) (>= room 10000)
+                       (= (player-asset 'harvester player) 0))
+                  '(harvester 1 10000))
+                 ((and (member 'tractor crops) (>= room 10000)
+                       (= (player-asset 'tractor player) 0))
+                  '(tractor 1 10000))
+                 ((and (member 'ridge4 crops) (>= room 50000)
+                       (not (find (lambda (p)
+                                    (> (player-asset 'ridge4 p) 0))
+                                 (game-players game))))
+                  '(ridge4 50 50000))
+                 ((and (member 'ridge3 crops) (>= room 40000)
+                       (not (find (lambda (p)
+                                    (> (player-asset 'ridge3 p) 0))
+                                 (game-players game))))
+                  '(ridge3 40 40000))
+                 ((and (member 'ridge2 crops) (>= room 30000)
+                       (not (find (lambda (p)
+                                    (> (player-asset 'ridge2 p) 0))
+                                 (game-players game))))
+                  '(ridge2 30 30000))
+                 ((and (member 'ridge1 crops) (>= room 20000)
+                       (not (find (lambda (p)
+                                    (> (player-asset 'ridge1 p) 0))
+                                 (game-players game))))
+                  '(ridge1 20 20000))
+                 (else #f))))
+      (print "to buy: " to-buy)
+      (if to-buy
+          (begin
+           (print (conc "buying crop: " (first to-buy)))
+           (if (eq? (buy-crop (normalize-crop (first to-buy))
+                              (first to-buy)
+                              (second to-buy)
+                              (min (third to-buy) (round-down-1000 (player-cash player)))
+                              player
+                              game)
+                    #t)
+               (let ((id (alist-ref 'id
+                                    (find (lambda (c) (equal? (alist-ref 'crop c) (symbol->string (first to-buy))))
+                                          (player-otbs player)))))
+                 (safe-set! (game-otbs game)
+                            (append (game-otbs game)
+                                    (filter (lambda (x) (= id (alist-ref 'id x)))
+                                            (player-otbs player))))
+                 (safe-set! (player-otbs player)
+                            (filter (lambda (x) (not (= id (alist-ref 'id x))))
+                                    (player-otbs player)))
+                 #t)
+               #f))
+          #f)))
+  )
+
 (define (process-ai-push-message player game msg)
   (print (player-name player))
   (print msg)
@@ -1555,47 +1653,55 @@
      (if (and (eq? (player-state player) 'pre-turn)
               (not (ai-processing-turn player)))
          (begin (set! (ai-processing-turn player) #t)
+                ;; time to buy
+                (when (and (>= (player-space player) 9) (<= (player-space player) 14))
+                  (let loop ((cont (ai-buy player game)))
+                    (when cont (loop (ai-buy player game)))))
                 (let ((res (process-message player game "roll" '((type . "roll")))))
-                  (print "rolled a " (alist-ref 'value res))
-                  ;; (process-message player game "next-action" '((type . "next-action")))
-                  ;; (let loop ((msg (process-message player game "next-action" '((type . "next-action")))))
-                  ;;   (if (alist-ref 'action msg)
-                  ;;       (loop (process-message player game "next-action" '((type . "next-action"))))
-                  ;;       (print "done with actions")))
-                  ))))
+                  (print "rolled a " (alist-ref 'value res))))))
     ((auto-skip)
-     (print "ai auto-skip")
-     ;; (when (ai-processing-turn player)
-     ;;   (process-message player game "next-action" '((type . "next-action"))))
-     )
+     (print "ai auto-skip"))
     ((ai-next-action)
      (print "ai-next-action")
      (when (ai-processing-turn player)
        (let ((res (process-message player game "next-action" '((type . "next-action")))))
-         (display "res: ")
-         (write res)
-         (newline)
-         ;; (print "res1: " (eq? (alist-ref 'event res) 'action))
-         ;; (print "res2: " (not (alist-ref 'action res)))
-         ;; (print "res3: " (and (eq? (alist-ref 'event res) 'action)
-         ;;                      (not (alist-ref 'action res))))
-         ;; (when (and (string=? (alist-ref 'event res) "action")
-         ;;            (not (alist-ref 'action res)))
-         ;;   (print "ending turn")
-         ;;   (thread-sleep! 0.5)
-         ;;   (set! (ai-processing-turn player) #f)
-         ;;   (process-message player game "turn-ended" '()))
+         res
+         ;; (display "res: ")
+         ;; (write res)
+         ;; (newline)
          )))
+    ((ai-uncle-bert)
+     (print "ai-uncle-bert")
+     (when (ai-processing-turn player)
+       (safe-set! (player-debt player) (+ (player-debt player) 10000))
+       (safe-set! (player-assets player)
+                  (alist-update 'hay (+ (alist-ref 'hay (player-assets player)) 10)
+                                (player-assets player)))))
     ((end-ai-turn)
+     (if (eq? (player-state player) 'pre-turn)
+         (process-ai-push-message player game '((type . "update"))) ;; restarting at AI player's turn
          (when (ai-processing-turn player)
+           (when (< (player-cash player) 0)
+             (print "taking out loan")
+             (process-message player game "loan" `((amount . ,(/ (+ (abs (player-cash player))
+                                                                    (remainder (abs (player-cash player)) 1000))
+                                                                 1000)))))
+           (when (>= (player-cash player) 1000)
+             (print "repaying loan")
+             (process-message player game "loan" `((amount . ,(* (/ (- (player-cash player)
+                                                                       (remainder (player-cash player) 1000))
+                                                                    1000)
+                                                                 -1)))))
            (print "ending turn")
-       (thread-sleep! 0.5)
+           ;; (thread-sleep! 0.5)
            (set! (ai-processing-turn player) #f)
            (process-message player game "turn-ended" '())
-       ))))
+           )))))
 
 (define (make-ai-push-receiver game player)
   (lambda ()
+    (*game* game)
+    (*player* player)
     (let loop ((msg (mailbox-receive! (player-mailbox player))))
       (process-ai-push-message player game msg)
       (loop (mailbox-receive! (player-mailbox player))))))