guile-risk-calculator/model.scm

(define-module (model)
  #:export (<risk-rules>
            make-risk-rules
            get-att-dice set-att-dice
            get-def-dice set-def-dice
            get-eq-eyes-win set-eq-eyes-win

            <fight-situation>
            make-fight-situation
            get-att-wins
            get-att-rems
            get-def-wins
            get-def-rems))


(use-modules
 ;; SRFI 1 for additional list procedures
 (srfi srfi-1)
 ;; for functional structs (not part of srfi-9 directly)
 (srfi srfi-9 gnu)
 (rnrs enums))


(define-public *equal-eyes-winner*
  (make-enumeration
   '(att
     def
     both
     none)))


(define-immutable-record-type <risk-rules>
  ;; define constructor
  (make-risk-rules att-dice def-dice eq-eyes-win)
  ;; define predicate
  risk-rules?
  ;; define accessors and functional setters
  (att-dice get-att-dice set-att-dice)
  (def-dice get-def-dice set-def-dice)
  (eq-eyes-win get-eq-eyes-win set-eq-eyes-win))


(define-immutable-record-type <fight-situation>
  ;; define constructor
  (make-fight-situation att-wins att-rems def-wins def-rems)
  ;; define predicate
  fight-situation?
  ;; define accessors and functional setters
  (att-wins get-att-wins)
  (att-rems get-att-rems)
  (def-wins get-def-wins)
  (def-rems get-def-rems))


(define-public make-init-fight-situation
  (λ (att-count def-count)
    "Create an initial fight situation, where no one yet has won any dice
comparisons."
    (make-fight-situation 0 att-count 0 def-count)))


(define-public fight-situation-less-than
  (λ (fs1 fs2)
    (cond
     [(< (get-att-wins fs1) (get-att-wins fs2)) #t]
     [(> (get-att-wins fs1) (get-att-wins fs2)) #f]
     [else  ; =
      (cond
       [(< (get-att-rems fs1) (get-att-rems fs2)) #t]
       [(> (get-att-rems fs1) (get-att-rems fs2)) #f]
       [else  ; =
        (cond
         [(< (get-def-wins fs1) (get-def-wins fs2)) #t]
         [(> (get-def-wins fs1) (get-def-wins fs2)) #f]
         [else  ; =
          (cond
           [(< (get-def-rems fs1) (get-def-rems fs2)) #t]
           [(> (get-def-rems fs1) (get-def-rems fs2)) #f]
           [else  ; =
            #f])])])])))


(define-public list->fight-situation
  (λ (lst)
    (make-fight-situation (first lst)
                          (second lst)
                          (third lst)
                          (fourth lst))))


(define-public fight-sit-list-att-wins first)
(define-public fight-sit-list-att-rems second)
(define-public fight-sit-list-def-wins third)
(define-public fight-sit-list-def-rems fourth)


(define-public att-lost?
  (lambda* (fight-result #:key (rules *default-risk-rules*))
    ;; NOTE: FUTUE: Currently the rules do not contain anything, which would
    ;; make it necessary to look at them, when determining, whether the attacker
    ;; lost.
    (= (get-att-rems fight-result) 1)))


(define-public def-lost?
  (lambda* (fight-result #:key (rules *default-risk-rules*))
    ;; NOTE: FUTUE: Currently the rules do not contain anything, which would
    ;; make it necessary to look at them, when determining, whether the defender
    ;; lost.
    (= (get-def-rems fight-result) 0)))


(define-public fight-res-list-att-lost?
  (λ (fight-res-list)
    (= (fight-sit-list-att-rems fight-res-list) 1)))


(define-public fight-res-list-att-win?
  (λ (fight-res-list)
    (> (fight-sit-list-att-rems fight-res-list) 1)))


(define-public fight-res-list-def-lost?
  (λ (fight-res-list)
    (= (fight-sit-list-def-rems fight-res-list) 0)))


(define-public fight-res-list-def-win?
  (λ (fight-res-list)
    (> (fight-sit-list-def-rems fight-res-list) 0)))


(define-public fight-situation->hash-key
  (λ (fight-situation)
    (list (get-att-wins fight-situation)
          (get-att-rems fight-situation)
          (get-def-wins fight-situation)
          (get-def-rems fight-situation))))


(define-public *default-risk-rules*
  (make-risk-rules 3 2 'def))


(define-public attacker-lost?
  (lambda* (attackers-remaining #:key (rules *default-risk-rules*))
    "Tell whether the attacker lost a fight according to the rules."
    ;; Currently the rules model does not contain anything used to tell, whether
    ;; the attacker lost. It could contain something in the future, for example
    ;; the requirement, that the attacker must retain at least 2 units in the
    ;; source area.
    (< attackers-remaining 2)))


(define-public defender-lost?
  (lambda* (defenders-remaining #:key (rules *default-risk-rules*))
    "Tell whether the defenders lost a fight according to the rules."
    ;; Currently the rules model does not contain anything used to tell, whether
    ;; the defender lost. It could contain something in the future, for example
    ;; the requirement, that the defender loses when only 1 unit is left.
    (= defenders-remaining 0)))