#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)