12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576 |
- #lang racket
- ;; start with some basic utilities
- (define (d n)
- (random 1 (+ n 1)))
- ;; the logic for judging the 'outcome' of an Ironsworn roll or progress track
- (define (judge-outcome attempt challenge-1 challenge-2)
- (let [(outcome
- (cond [(and (> attempt challenge-1) (> attempt challenge-2))
- 'success]
- [(or (> attempt challenge-1) (> attempt challenge-2))
- 'partial]
- [else 'failure]))]
- `(,outcome ,attempt (,challenge-1 ,challenge-2))))
-
- ;; a typical Ironsworn roll:
- (define (roll-plus-mod m)
- (let [
- ;; roll two challenge dice
- (challenge-1 (d 10))
- (challenge-2 (d 10))
- ;; roll an attempt die
- (attempt (+ (d 6) m))]
- ;; judge the outome
- (judge-outcome attempt challenge-1 challenge-2)))
- ;; this just keeps us honest that this is playable with dice
- (define *allowed-table-sizes* '(2 4 6 8 10 12 20 36 50 100))
- (define (oracle table)
- (cond [(andmap valid-oracle-result? table)
- (if (member (length table) *allowed-table-sizes*)
- (lambda () (car (shuffle table)))
- (error 'oracle "Length ~a is not a die-size-compatible length" (length table)))]
- [(andmap valid-table-member? table)
- (let [(max (max-table-size table))]
- (lambda () (table-index (d max) table)))]
- [else (error 'oracle "Unexpected argument: ~a" table)]))
- (define (max-table-size table)
- (let [(final (last table))]
- (if (= (length final) 3) (cadr final) (car final))))
- (define (valid-oracle-result? thing)
- (or (symbol? thing) (string? thing)))
- (define (valid-table-member? member)
- (and (list? member)
- (or (and (= (length member) 3)
- (number? (car member))
- (number? (cadr member))
- (valid-oracle-result? (caddr member)))
- (and (= (length member) 2)
- (number? (car member))
- (valid-oracle-result? (cadr member))))))
- (define (table-index idx table)
- (if (null? table)
- (error 'table-index "Unexpected empty table")
- (let [(head (car table))]
- (cond [(and (= (length head) 3)
- (>= idx (car head))
- (<= idx (cadr head)))
- (caddr head)]
- [(and (= (length head) 2)
- (= idx (car head)))
- (cadr head)]
- [else (table-index idx (cdr table))]))))
- (define-syntax-rule [define-oracle name . table]
- (define name (oracle (quote table))))
- (provide judge-outcome roll-plus-mod oracle define-oracle)
|