core.rkt 2.5 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576
  1. #lang racket
  2. ;; start with some basic utilities
  3. (define (d n)
  4. (random 1 (+ n 1)))
  5. ;; the logic for judging the 'outcome' of an Ironsworn roll or progress track
  6. (define (judge-outcome attempt challenge-1 challenge-2)
  7. (let [(outcome
  8. (cond [(and (> attempt challenge-1) (> attempt challenge-2))
  9. 'success]
  10. [(or (> attempt challenge-1) (> attempt challenge-2))
  11. 'partial]
  12. [else 'failure]))]
  13. `(,outcome ,attempt (,challenge-1 ,challenge-2))))
  14. ;; a typical Ironsworn roll:
  15. (define (roll-plus-mod m)
  16. (let [
  17. ;; roll two challenge dice
  18. (challenge-1 (d 10))
  19. (challenge-2 (d 10))
  20. ;; roll an attempt die
  21. (attempt (+ (d 6) m))]
  22. ;; judge the outome
  23. (judge-outcome attempt challenge-1 challenge-2)))
  24. ;; this just keeps us honest that this is playable with dice
  25. (define *allowed-table-sizes* '(2 4 6 8 10 12 20 36 50 100))
  26. (define (oracle table)
  27. (cond [(andmap valid-oracle-result? table)
  28. (if (member (length table) *allowed-table-sizes*)
  29. (lambda () (car (shuffle table)))
  30. (error 'oracle "Length ~a is not a die-size-compatible length" (length table)))]
  31. [(andmap valid-table-member? table)
  32. (let [(max (max-table-size table))]
  33. (lambda () (table-index (d max) table)))]
  34. [else (error 'oracle "Unexpected argument: ~a" table)]))
  35. (define (max-table-size table)
  36. (let [(final (last table))]
  37. (if (= (length final) 3) (cadr final) (car final))))
  38. (define (valid-oracle-result? thing)
  39. (or (symbol? thing) (string? thing)))
  40. (define (valid-table-member? member)
  41. (and (list? member)
  42. (or (and (= (length member) 3)
  43. (number? (car member))
  44. (number? (cadr member))
  45. (valid-oracle-result? (caddr member)))
  46. (and (= (length member) 2)
  47. (number? (car member))
  48. (valid-oracle-result? (cadr member))))))
  49. (define (table-index idx table)
  50. (if (null? table)
  51. (error 'table-index "Unexpected empty table")
  52. (let [(head (car table))]
  53. (cond [(and (= (length head) 3)
  54. (>= idx (car head))
  55. (<= idx (cadr head)))
  56. (caddr head)]
  57. [(and (= (length head) 2)
  58. (= idx (car head)))
  59. (cadr head)]
  60. [else (table-index idx (cdr table))]))))
  61. (define-syntax-rule [define-oracle name . table]
  62. (define name (oracle (quote table))))
  63. (provide judge-outcome roll-plus-mod oracle define-oracle)