app.R

# app.R - Setback (Pitch) Card Game
# A classic 4-point trick-taking card game with family cookout AI personas

library(shiny)
library(bslib)
library(htmltools)

# Source game modules
source("R/game_engine.R")
source("R/bidding.R")
source("R/scoring.R")
source("R/game_state.R")
source("R/ai_strategy.R")
source("R/ai_personas.R")
source("R/ui_helpers.R")

# All state field names - used to sync state lists back to reactiveValues.
# R removes keys when you set list$field <- NULL, so names(state) misses them.
# This ensures NULL fields are explicitly written to gs (reactiveValues).
STATE_FIELDS <- names(new_game_state())

# ============================================================================
# UI
# ============================================================================

ui <- page_fluid(
  theme = bs_theme(
    bg = "#0d1117",
    fg = "#e6e6e6",
    primary = "#238636",
    base_font = font_google("Inter"),
    heading_font = font_google("Inter")
  ),

  tags$head(
    tags$link(rel = "stylesheet", href = "cards.css"),
    tags$link(rel = "stylesheet", href = "game.css"),
    tags$script(src = "game.js")
  ),

  tags$div(class = "game-container",
    # Header / Scoreboard
    uiOutput("scoreboard"),

    # Main layout: table + sidebar
    tags$div(class = "game-layout",

      # Left: Game table + actions
      tags$div(class = "game-table-wrapper",
        tags$div(class = "game-table",
          # North (Partner - Auntie Dee)
          tags$div(class = "player-area north",
            uiOutput("north_label"),
            uiOutput("north_hand"),
            uiOutput("north_bubble")
          ),

          # West (Opponent - Uncle Earl)
          tags$div(class = "player-area west",
            uiOutput("west_label"),
            uiOutput("west_hand"),
            uiOutput("west_bubble")
          ),

          # Center trick area
          tags$div(class = "trick-container",
            uiOutput("trick_area"),
            uiOutput("status_message")
          ),

          # East (Opponent - Cousin Ray)
          tags$div(class = "player-area east",
            uiOutput("east_label"),
            uiOutput("east_hand"),
            uiOutput("east_bubble")
          ),

          # South (You)
          tags$div(class = "player-area south",
            uiOutput("south_label"),
            uiOutput("player_hand"),
            uiOutput("bid_controls")
          )
        ),

        # Game actions (below table)
        uiOutput("game_actions")
      ),

      # Right sidebar: scoring breakdown + game log
      tags$div(class = "game-sidebar",
        uiOutput("scoring_breakdown"),
        tags$div(class = "sidebar-label", "Game Log"),
        uiOutput("game_log")
      )
    )
  )
)

# ============================================================================
# SERVER
# ============================================================================

server <- function(input, output, session) {

  # --- Reactive Game State ---
  gs <- reactiveValues()

  observe({
    state <- new_game_state()
    for (n in STATE_FIELDS) {
      gs[[n]] <- state[[n]]
    }
  }, priority = 100)

  # Speech bubbles: list(p2 = text, p3 = text, p4 = text)
  bubbles <- reactiveValues(p2 = NULL, p3 = NULL, p4 = NULL)

  # --- Helper: trigger AI turn ---
  trigger_ai <- function(delay = 1000) {
    session$sendCustomMessage('ai_delay', list(delay = delay))
  }

  # --- Helper: set speech bubble ---
  set_bubble <- function(player, text) {
    key <- paste0("p", player)
    bubbles[[key]] <- text
  }

  clear_bubbles <- function() {
    bubbles$p2 <- NULL
    bubbles$p3 <- NULL
    bubbles$p4 <- NULL
  }

  # --- Helper: check if human's turn ---
  is_human_turn <- function() {
    gs$current_player == 1L && gs$phase %in% c("bidding", "pitching", "playing")
  }

  # ========================================================================
  # GAME FLOW
  # ========================================================================

  # --- Start / New Game ---
  observeEvent(input$start_game, {
    state <- new_game_state()
    for (n in STATE_FIELDS) {
      gs[[n]] <- state[[n]]
    }
    clear_bubbles()

    # Deal first hand
    state <- start_new_hand(isolate(reactiveValuesToList(gs)))
    for (n in STATE_FIELDS) {
      gs[[n]] <- state[[n]]
    }

    # Check if AI bids first
    if (gs$current_player != 1L) {
      trigger_ai(1500)
    }
  })

  # --- Next Hand ---
  observeEvent(input$next_hand, {
    clear_bubbles()
    state <- start_new_hand(isolate(reactiveValuesToList(gs)))
    for (n in STATE_FIELDS) {
      gs[[n]] <- state[[n]]
    }

    if (gs$current_player != 1L) {
      trigger_ai(1500)
    }
  })

  # --- Human Bid ---
  observeEvent(input$human_bid, {
    req(gs$phase == "bidding", gs$current_player == 1L)

    bid_value <- input$human_bid
    state <- isolate(reactiveValuesToList(gs))
    state <- process_bid(state, player = 1L, bid_value = bid_value)

    for (n in STATE_FIELDS) {
      gs[[n]] <- state[[n]]
    }

    # If bidding continues and next is AI
    if (gs$phase == "bidding" && gs$current_player != 1L) {
      trigger_ai(1500)
    }

    # If bidding complete and pitcher is AI, trigger pitch
    if (gs$phase == "pitching" && gs$current_player != 1L) {
      trigger_ai(1800)
    }
  })

  # --- Human Card Play ---
  observeEvent(input$card_played, {
    req(gs$phase %in% c("pitching", "playing"), gs$current_player == 1L)

    card_id <- input$card_played
    state <- isolate(reactiveValuesToList(gs))
    state <- process_play(state, player = 1L, card_id = card_id)

    for (n in STATE_FIELDS) {
      gs[[n]] <- state[[n]]
    }

    if (gs$phase == "trick_done") {
      session$sendCustomMessage('trick_pause', list(delay = 4000))
    } else if (gs$current_player != 1L) {
      trigger_ai(1200)
    }
  })

  # --- AI Turn ---
  observeEvent(input$ai_turn_ready, {
    player <- gs$current_player
    req(player != 1L)

    state <- isolate(reactiveValuesToList(gs))

    if (gs$phase == "bidding") {
      # AI bid
      bid <- ai_decide_bid(state$hands[[paste0("p", player)]], state$bid_state, player)
      dialogue <- get_bid_dialogue(player, bid)
      set_bubble(player, dialogue)

      state <- process_bid(state, player, bid)
      for (n in STATE_FIELDS) {
        gs[[n]] <- state[[n]]
      }

      # Continue bidding
      if (gs$phase == "bidding" && gs$current_player != 1L) {
        trigger_ai(1500)
      } else if (gs$phase == "pitching" && gs$current_player != 1L) {
        trigger_ai(1800)
      }

    } else if (gs$phase == "pitching") {
      # AI pitches
      card_id <- ai_choose_pitch(state$hands[[paste0("p", player)]], player)
      state <- process_play(state, player, card_id)

      for (n in STATE_FIELDS) {
        gs[[n]] <- state[[n]]
      }

      # After pitch, next player plays (or trick continues)
      if (gs$phase == "trick_done") {
        session$sendCustomMessage('trick_pause', list(delay = 4000))
      } else if (gs$current_player != 1L) {
        trigger_ai(1200)
      }

    } else if (gs$phase == "playing") {
      # AI plays a card
      hand <- state$hands[[paste0("p", player)]]
      card_id <- ai_select_card(hand, state, player)

      state <- process_play(state, player, card_id)
      for (n in STATE_FIELDS) {
        gs[[n]] <- state[[n]]
      }

      if (gs$phase == "trick_done") {
        session$sendCustomMessage('trick_pause', list(delay = 4000))
      } else if (gs$current_player != 1L) {
        trigger_ai(1200)
      }
    }
  })

  # --- Trick Collected ---
  observeEvent(input$trick_collected, {
    req(gs$phase == "trick_done")

    state <- isolate(reactiveValuesToList(gs))
    state <- resolve_completed_trick(state)

    # Get trick dialogue from personas
    winner <- state$last_trick_winner
    if (!is.null(winner)) {
      for (p in c(2, 3, 4)) {
        dialogue <- get_trick_dialogue(p, winner)
        set_bubble(p, dialogue)
      }
    }

    for (n in STATE_FIELDS) {
      gs[[n]] <- state[[n]]
    }

    if (gs$phase == "scoring") {
      # Score the hand
      state <- isolate(reactiveValuesToList(gs))
      state <- score_hand(state)

      # Scoring dialogue
      if (!is.null(state$pitcher)) {
        pitcher_team <- get_team(state$pitcher)
        made_bid <- state$scores[[pitcher_team]] >=
          (isolate(gs$scores[[pitcher_team]])) # Compare before/after
        for (p in c(2, 3, 4)) {
          dialogue <- get_scoring_dialogue(p, state$pitcher,
            !any(grepl("SET BACK", tail(state$game_log, 3))))
          if (!is.null(dialogue)) set_bubble(p, dialogue)
        }
      }

      for (n in STATE_FIELDS) {
        gs[[n]] <- state[[n]]
      }

      session$sendCustomMessage('scroll_log', list())

    } else if (gs$current_player != 1L) {
      trigger_ai(1200)
    }
  })

  # ========================================================================
  # UI OUTPUTS
  # ========================================================================

  # --- Scoreboard ---
  output$scoreboard <- renderUI({
    render_scoreboard(
      scores = list(team1 = gs$scores$team1, team2 = gs$scores$team2),
      current_bid = gs$current_bid,
      pitcher = gs$pitcher,
      claude_suit = gs$claude_suit,
      hand_number = gs$hand_number
    )
  })

  # --- Player Labels ---
  output$north_label <- renderUI({
    render_player_label(3, gs$current_player == 3L,
      if (!is.null(gs$hands$p3)) nrow(gs$hands$p3) else 0)
  })
  output$west_label <- renderUI({
    render_player_label(2, gs$current_player == 2L,
      if (!is.null(gs$hands$p2)) nrow(gs$hands$p2) else 0)
  })
  output$east_label <- renderUI({
    render_player_label(4, gs$current_player == 4L,
      if (!is.null(gs$hands$p4)) nrow(gs$hands$p4) else 0)
  })
  output$south_label <- renderUI({
    render_player_label(1, gs$current_player == 1L,
      if (!is.null(gs$hands$p1)) nrow(gs$hands$p1) else 0)
  })

  # --- Opponent Hands (face down) ---
  output$north_hand <- renderUI({
    n <- if (!is.null(gs$hands$p3)) nrow(gs$hands$p3) else 0
    render_opponent_hand(n)
  })
  output$west_hand <- renderUI({
    n <- if (!is.null(gs$hands$p2)) nrow(gs$hands$p2) else 0
    render_opponent_hand(n, sideways = TRUE)
  })
  output$east_hand <- renderUI({
    n <- if (!is.null(gs$hands$p4)) nrow(gs$hands$p4) else 0
    render_opponent_hand(n, sideways = TRUE)
  })

  # --- Player Hand (face up, clickable during play) ---
  output$player_hand <- renderUI({
    hand <- gs$hands$p1
    if (is.null(hand) || nrow(hand) == 0) return(NULL)

    can_play <- isTRUE(gs$current_player == 1L) && gs$phase %in% c("pitching", "playing")

    if (can_play) {
      legal <- get_legal_plays(hand, gs$lead_suit, gs$claude_suit)
      render_hand(hand, clickable = TRUE, legal_ids = legal$card_id)
    } else {
      render_hand(hand, clickable = FALSE)
    }
  })

  # --- Trick Area ---
  output$trick_area <- renderUI({
    render_trick_area(gs$trick_cards)
  })

  # --- Bid Controls ---
  output$bid_controls <- renderUI({
    req(gs$phase == "bidding", gs$current_player == 1L)
    render_bid_controls(gs$bid_state, player = 1L)
  })

  # --- Speech Bubbles ---
  output$west_bubble <- renderUI({
    render_speech_bubble(2, bubbles$p2)
  })
  output$north_bubble <- renderUI({
    render_speech_bubble(3, bubbles$p3)
  })
  output$east_bubble <- renderUI({
    render_speech_bubble(4, bubbles$p4)
  })

  # --- Status Message ---
  output$status_message <- renderUI({
    if (gs$phase == "pre_game") {
      return(tags$div(class = "status-message", "Press 'Deal' to start!"))
    }
    if (gs$phase == "trick_done" && !is.null(gs$trick_explanation)) {
      return(tags$div(class = "status-message", gs$trick_explanation))
    }
    if (gs$phase == "bidding" && !isTRUE(gs$current_player == 1L)) {
      return(tags$div(class = "status-message",
        paste(PLAYER_NAMES[gs$current_player], "is thinking...")))
    }
    if (gs$phase == "pitching" && isTRUE(gs$current_player == 1L)) {
      return(tags$div(class = "status-message",
        "You won the bid! Play a card to set the suit."))
    }
    if (gs$phase == "playing" && isTRUE(gs$current_player == 1L)) {
      return(tags$div(class = "status-message", "Your turn - play a card."))
    }
    if (gs$phase == "game_over") {
      winner_name <- if (gs$winner == "team1") "Your Team" else "Opponents"
      return(tags$div(class = "status-message",
        paste(winner_name, "wins the game!")))
    }
    NULL
  })

  # --- Game Actions ---
  output$game_actions <- renderUI({
    if (gs$phase == "pre_game") {
      return(tags$div(class = "game-actions",
        tags$button(
          class = "action-btn primary",
          onclick = "Shiny.setInputValue('start_game', Math.random(), {priority: 'event'})",
          "Deal"
        )
      ))
    }
    if (gs$phase == "hand_complete") {
      return(tags$div(class = "game-actions",
        tags$button(
          class = "action-btn primary",
          onclick = "Shiny.setInputValue('next_hand', Math.random(), {priority: 'event'})",
          "Next Hand"
        )
      ))
    }
    if (gs$phase == "game_over") {
      return(tags$div(class = "game-actions",
        tags$button(
          class = "action-btn primary",
          onclick = "Shiny.setInputValue('start_game', Math.random(), {priority: 'event'})",
          "New Game"
        )
      ))
    }
    NULL
  })

  # --- Scoring Breakdown (sidebar) ---
  output$scoring_breakdown <- renderUI({
    req(gs$phase %in% c("hand_complete", "game_over", "scoring"))
    req(!is.null(gs$last_hand_points))
    render_scoring_breakdown(gs$last_hand_points, gs$last_scoring_result)
  })

  # --- Game Log ---
  output$game_log <- renderUI({
    render_game_log(gs$game_log)
  })
}

# Run the app
shinyApp(ui = ui, server = server)