fantasy-vacation-planner/main.scm

(import
  (except (rnrs base) let-values map error vector-map)
  (only (guile)
        lambda* λ
        current-output-port
        simple-format
        command-line)
  ;; SRFIs
  ;; srfi-1 list and alist procs
  (srfi srfi-1)
  ;; srfi-8 for receive form
  (srfi srfi-8)
  ;; srfi-9 for structs
  (srfi srfi-9)
  (srfi srfi-9 gnu)
  ;; srfi-69 for hash tables
  (srfi srfi-69)
  ;; srfi-43 for vector procs
  (srfi srfi-43)

  ;; Libraries
  (json)
  ;; custom, not here implemented, libraries
  (fslib)
  ;; custom modules
  (lib math-procs)
  (lib alist-procs)
  (lib list-procs)
  (lib vector-procs)
  (lib fileio)
  (lib filesystem)
  (lib random)
  (lib user-input-output)
  (lib string-procs)
  (lib set)
  (prefix (lib logger) log:)
  (config)
  (model)
  (data-abstraction)
  (effect))


;; =====
;; EVENT
;; =====
(define calculate-event-probability
  (λ (event karma general-config)
    (let ([base-prob (alist-ref event "probability")]
          [event-karma-probability-modifier (alist-ref event "karma-probability-modifier")]
          [prob-multiplier (alist-nested-refs general-config '("difficulty"))]
          [min-prob (alist-nested-refs general-config '("min-probability"))]
          [max-prob (alist-nested-refs general-config '("max-probability"))])
      (let ([additional-probability-because-of-karma
             (* (/ 1 100) karma event-karma-probability-modifier)])
        (log:debug
         (string-format "additional-probability-because-of-karma: ~a"
                        additional-probability-because-of-karma))
        (log:debug
         (string-format "probability without karma effect: ~a"
                        (* base-prob prob-multiplier)))
        (log:debug
         (string-format "probability with karma effect: ~a"
                        (+ additional-probability-because-of-karma
                           (* base-prob prob-multiplier))))

        (limit-by-interval (+ additional-probability-because-of-karma
                              (* base-prob prob-multiplier))
                           min-prob
                           max-prob)))))


(define event-happening?
  (lambda* (event traveler-state general-config #:key (random-state #f))
    (log:debug
     (string-format "Checking if event ~a is happening ..." (alist-ref event "name")))
    (let ([event-probability
           (calculate-event-probability event
                                        (karma traveler-state)
                                        general-config)])
      (log:debug
       (string-format "Event has probability of ~a to happen." event-probability))
      (try-for-probability event-probability #:random-state random-state))))


(define handle-effects
  (λ (effects traveler-state transportation-configs effect-procs)
    "Handle effects in the order, in which they are
specified in the story parameters."
    (vector-fold
     (λ (ind acc-event-outcome effect)
       ;; Get the appropriate effect procedure and update
       ;; the traveler state using it. An effect procedure
       ;; gets the traveler's state and the story
       ;; parameters, in case it needs them for any reason.
       (log:debug (string-format "processing effect: ~a" effect))
       (log:debug (string-format "current event-outcome: ~a" acc-event-outcome))
       ((hash-table-ref effect-procs effect)
        acc-event-outcome traveler-state transportation-configs))
     (make-event-outcome)
     effects)))


(define describe-event-to-player
  (λ (event)
    (confirm-info-message (string-format "EVENT name: ~a" (alist-ref event "name")))
    (confirm-info-message (string-format "EVENT description: ~a" (choose-random-element (alist-ref event "explanations"))))
    (confirm-info-message (string-format "EVENT effects: ~a" (alist-ref event "default-effects")))))


(define handle-event-actions
  (λ (event traveler-state transportation-configs effect-procs)
    (log:debug (string-format "handling event ~a" (alist-ref event "name")))
    (let ([actions (alist-ref event "actions")])
      ;; Ask the user for a decision, which will result in
      ;; an event outcome.
      (log:debug (string-format "event has the following actions: ~a" actions))

      (ask-user-for-decision-with-continuations
       "How do you want to react?"
       (map number->string (range 1 (+ (vector-length actions) 1) #:end-inclusive #t))
       (append
        (vector->list
         (vector-map (λ (ind action) (alist-ref action "label")) actions))
        ;; add "other" case for people to specify their own action
        '("other"))
       (append
        (vector->list
         (vector-map (λ (ind action)
                       ;; Return a procedure, which will
                       ;; result in an event outcome when
                       ;; applied. The event outcome depends
                       ;; on the effects of the event.
                       (log:debug "vector map from actions to effect handling lambdas")
                       (λ ()
                         (confirm-info-message (alist-ref action "description"))
                         ;; Set the event outcome karma to
                         ;; the karma of the chosen action.
                         (set-event-outcome-karma
                          (handle-effects (alist-ref action "effects")
                                          traveler-state
                                          transportation-configs
                                          effect-procs)
                          (alist-ref action "karma"
                                     #:default (λ ()
                                                 (log:warning
                                                  (string-format "could not find field \"karma\" on action ~a"
                                                                 action))
                                                 0.00)))))
                     actions))
        ;; add custom action query and handling for "other"
        (list (λ ()
                (log:debug "will query for custom action")
                (let ([custom-action (query-user-for-custom-action)])
                  ;; Set the event outcome karma to the
                  ;; karma of the chosen action.
                  (set-event-outcome-karma
                   (handle-effects (alist-ref custom-action "effects")
                                   traveler-state
                                   transportation-configs
                                   effect-procs)
                   (alist-ref custom-action "karma"
                              #:default (λ ()
                                          (log:warning
                                           (string-format "could not find field \"karma\" on action ~a"
                                                          custom-action))
                                          0.00)))))))))))


(define calculate-event-outcome
  (λ (event traveler-state transportations-config effect-procs)
    "Calculate an event outcome from the event action's
effects or the fallback effects of the event itself."
    (let ([event-description (choose-random-element (alist-ref event "explanations"))]
          [event-effects (alist-ref event "default-effects")]
          [event-actions (alist-ref event "actions")])
      ;; If the event has actions to choose from, then let
      ;; the player choose and process the effects of their
      ;; choice of action. Otherwise use the fallback
      ;; effects stored in the event, if there are any.
      (cond
       [(vector-empty? event-actions)
        (cond
         [(null? event-effects)
          (log:debug "The event has no effects, returning default event outcome.")
          (make-event-outcome)]
         [else
          (log:debug "event has effects itself, calculating event outcome")
          (handle-effects event-effects
                          traveler-state
                          transportations-config
                          effect-procs)])]
       [else
        (log:debug "event has actions, will handle event actions")
        (handle-event-actions event
                              traveler-state
                              transportations-config
                              effect-procs)]))))


(define calculate-adjusted-traveler-karma
  (λ (event traveler-state)
    (let* ([traveler-karma (karma traveler-state)]
           [karma-probability-modifier
            (alist-ref event "karma-probability-modifier"
                       #:default (λ ()
                                   (log:warning
                                    (string-format "could not find key karma-probability-modifier in event ~a"
                                                   event))
                                   0))]
           [event-is-positive (> karma-probability-modifier 0)]
           [event-is-negative (< karma-probability-modifier 0)])
      ;; If the karma of the traveler is positive and the event is positive
      (cond
       ;; If the traveler has positive karma and a positive
       ;; event happens, the traveler profitted from
       ;; karma. They used up good karma, so we move
       ;; positive karma closer to 0.
       [(and event-is-positive (> traveler-karma 0))
        (max (- traveler-karma
                (/ (abs karma-probability-modifier)
                   2))
             0)]
       ;; If the traveler has negative karma and a negative
       ;; event happens, the traveler got punished by
       ;; karma. They paid, so we move negative karma closer
       ;; to 0.
       [(and event-is-negative (< traveler-karma 0))
        (min (+ traveler-karma
                (/ (abs karma-probability-modifier)
                   2))
             0)]
       ;; If the event is neutral, the traveler karma is
       ;; neutral or traveler karma and event do not agree
       ;; on being either both positive or both negative,
       ;; then justice was not served. In this case do not
       ;; adjust traveler karma.
       [else 0]))))


(define process-event
  (λ (event
      events
      event-groups
      traveler-state
      transportations-config
      effect-procs
      ;; continuations
      next-event next-event-group next-step)
    "Process an event. Processing an event has an event
outcome, according to which the traveler state is updated
and the journey continues."
      (describe-event-to-player event)
      (let ([traveler-state
             (set-fields traveler-state
                         [(event-count) (+ (event-count traveler-state) 1)]
                         [(karma) (calculate-adjusted-traveler-karma event traveler-state)])])
        ;; Calculate the event outcome and then act according
        ;; to it.
        (let ([event-outcome
               (calculate-event-outcome
                event traveler-state transportations-config effect-procs)])
          ;; Update route and numerical values of the traveler
          ;; state upfront and then handle the specifics of
          ;; the event outcome.
          (let ([updated-traveler-state
                 (set-fields traveler-state
                             [(traveler-route)
                              ;; If a route is returned in the
                              ;; event outcome, use that
                              ;; route, otherwise keep the one
                              ;; in the traveler state.
                              (or (event-outcome-updated-route event-outcome)
                                  (traveler-route traveler-state))]
                             [(journey-delay)
                              (+ (event-outcome-additional-delay event-outcome)
                                 (journey-delay traveler-state))]
                             [(additional-costs)
                              (+ (event-outcome-additional-costs event-outcome)
                                 (additional-costs traveler-state))]
                             [(karma)
                              (+ (event-outcome-karma event-outcome)
                                 (karma traveler-state))])])
            (log:debug (string-format "updated traveler state: ~a" updated-traveler-state))
            (cond
             [(event-outcome-route-changed event-outcome)
              (log:debug "event outcome has an updated route")
              (log:debug "going to next step of the journey")
              (next-step updated-traveler-state)]

             [(event-outcome-disable-event-group event-outcome)
              (log:debug "event outcome has disabled other events of the same event group")
              (log:debug "checking next event group")
              (next-event-group (rest event-groups) updated-traveler-state)]

             [(event-outcome-disable-events event-outcome)
              (log:debug "event outcome has disabled other events for this step of the journey")
              (log:debug "going to next step of the journey")
              (next-step updated-traveler-state)]

             [else
              (log:debug "going to next event")
              (next-event (rest events) updated-traveler-state)]))))))


(define travel
  (lambda* (init-traveler-state
            general-config
            transportations-config
            effect-procs
            #:key
            (random-state #f)
            (random-int-gen (make-random-integer-generator)))
    "Calculate the cost for one traveler travelling to the
destination of their journey."

    ;; Iterate through the route, which consists of steps of the journey.
    (let next-step ([traveler-state init-traveler-state])
      (cond
       ;; If there are no more steps, the traveler has arrived at their
       ;; destination. Return the additional costs.
       [(null? (traveler-route traveler-state))
        (confirm-info-message (string-format "Congratulations ~a, you reached your destination!" (traveler-name traveler-state)))
        traveler-state]
       ;; Otherwise continue with the current step of the journey.
       [else
        (let* ([step (first (traveler-route traveler-state))]
               [from (alist-ref step "from")]
               [to (alist-ref step "to")]
               [transportation (alist-ref step "transportation")]
               [event-groups (get:event-groups transportations-config transportation)])
          ;; (log:debug (string-format "event groups for this step are: ~a" event-groups))
          (confirm-info-message (string-format "~a you are currently in/at: ~a" (traveler-name traveler-state) from))
          (confirm-info-message (string-format "~a you are taking the ~a from ~a to ~a" (traveler-name traveler-state) transportation from to))
          ;; Iterate through the event groups.
          (let next-event-group ([remaining-event-groups event-groups]
                                 [traveler-state traveler-state])
            (cond
             ;; If there are no event groups remaining to handle, continue
             ;; with the next route part.
             [(null? remaining-event-groups)
              (log:debug "no more event groups in this step")
              (next-step
               (set-traveler-route traveler-state
                                   (rest (traveler-route traveler-state))))]
             [else
              (log:debug (string-format "Looking at events in event group ~s now ..." (first (first remaining-event-groups))))
              ;; Iterate through the events of the event group and break out,
              ;; if required.
              (let next-event ([remaining-events
                                (get:event-group/events (first remaining-event-groups))]
                               [current-traveler-state traveler-state])

                ;; Handle the events in the group of events,
                ;; if there are any.
                (cond
                 ;; If there are no events left to handle, continue with the
                 ;; next event group.
                 [(null? remaining-events)
                  (log:debug "no more events in this event group")
                  (next-event-group (rest remaining-event-groups) current-traveler-state)]
                 [else
                  ;; If there are events remaining, deal with the events.
                  (let ([event (first remaining-events)])
                    ;; Check if an event is happening and
                    ;; process the event and its effects, if
                    ;; it does happen.
                    (cond
                     [(event-happening? event current-traveler-state general-config #:random-state random-state)
                      (log:debug (string-format "event ~a is happening" (alist-ref event "name")))
                      ;; If the event does happen, handle
                      ;; the event.  Display the event
                      ;; explanation.
                      (process-event event
                                     remaining-events
                                     remaining-event-groups
                                     current-traveler-state
                                     transportations-config
                                     effect-procs
                                     ;; continuation procedures -- hand those
                                     ;; in, so that the return value does not
                                     ;; have to be processed
                                     next-event
                                     next-event-group
                                     next-step)]
                     [else
                      ;; If the event does not happen recur
                      ;; with 0 additional cost.
                      (next-event (rest remaining-events) current-traveler-state)]))]))])))]))))


(define process-traveler
  (lambda* (traveler general-config json-doc-story-params effect-procs
            #:key
            (random-state #f)
            (random-int-gen (make-random-integer-generator)))
    "Process a single traveler."
    (confirm-info-message (string-format "~a this is the start of your journey." (first traveler)))
    (let* ([planned-costs
            (ask-user-for-number
             (string-format "~a, how much does the transportation to your destination cost?"
                            (first traveler))
             (λ (num) #t))]
           [init-state
            (make-traveler-state (first traveler)
                                 (get:traveler/route traveler)
                                 planned-costs)])
      ;; TODO: think about return value of travel procedure
      (travel init-state
              general-config
              json-doc-story-params
              effect-procs
              #:random-state random-state
              #:random-int-gen random-int-gen))))


;; ====
;; MAIN
;; ====
(define main
  (λ ()
    (receive (transportations-config players-config general-config)
        (get-configuration)

      #;(log:debug
       (string-format "TRANSPORTATIONS-CONFIG: ~a" transportations-config))

      (let ([initial-random-state (seed->random-state 12345)]
            [random-int-gen (make-random-integer-generator #:seed 12345)])
        (let ([effect-procs
               (alist->hash-table
                `(("delay" . ,journey-delay-effect)
                  ("additional-costs" . ,additional-costs-effect)
                  ("unusable" . ,unusable-effect)
                  ("route-change" . ,route-change-effect)
                  ("disable-other-events" . ,disable-other-events-effect)))])
          (map
           (λ (player-config)
             (process-traveler player-config
                               general-config
                               transportations-config
                               effect-procs
                               #:random-state initial-random-state
                               #:random-int-gen random-int-gen))
           players-config))))))


(log:info (string-format "result: ~a" (main)))