code
- ;; ============================================================
- ;; R4RS-Compatible Dice Code System (Proper Lists Only)
- ;; Two user-facing functions:
- ;; (encode->dice "ABC123")
- ;; (dice->binary '(D1 D2 D13))
- ;; ============================================================
- ;; ------------------------------------------------------------
- ;; 1. Proper list: character → dice code
- ;; Replace these mappings with your real dice code.
- ;; ------------------------------------------------------------
- (define char->dice
- '((#\A D1)
- (#\B D2)
- (#\C D3)
- (#\D D4)
- (#\E D5)
- (#\F D6)
- (#\0 D10)
- (#\1 D11)
- (#\2 D12)
- (#\3 D13)
- (#\4 D14)
- (#\5 D15)
- (#\6 D16)
- (#\7 D17)
- (#\8 D18)
- (#\9 D19)))
- ;; ------------------------------------------------------------
- ;; 2. Proper list: dice code → binary string
- ;; Replace these with your reversible binary encoding.
- ;; ------------------------------------------------------------
- (define dice->bin
- '((D1 "000001")
- (D2 "000010")
- (D3 "000011")
- (D4 "000100")
- (D5 "000101")
- (D6 "000110")
- (D10 "001010")
- (D11 "001011")
- (D12 "001100")
- (D13 "001101")
- (D14 "001110")
- (D15 "001111")
- (D16 "010000")
- (D17 "010001")
- (D18 "010010")
- (D19 "010011")))
- ;; ------------------------------------------------------------
- ;; Utility: lookup in a proper-list association list
- ;; Each entry is (key value), not (key . value)
- ;; ------------------------------------------------------------
- (define (lookup key alist)
- (let ((p (assoc key alist)))
- (if p
- (cadr p) ;; second element of the list
- (error "No mapping for key" key))))
- ;; ------------------------------------------------------------
- ;; USER-FACING FUNCTION 1:
- ;; Convert letters/digits → dice code list
- ;; ------------------------------------------------------------
- (define (encode->dice str)
- (map (lambda (ch)
- (lookup ch char->dice))
- (string->list str)))
- ;; ------------------------------------------------------------
- ;; USER-FACING FUNCTION 2:
- ;; Convert dice code list → binary string
- ;; ------------------------------------------------------------
- (define (dice->binary dice-list)
- (apply string-append
- (map (lambda (d)
- (lookup d dice->bin))
- dice-list)))
- ;; ------------------------------------------------------------
- ;; Example:
- ;; (encode->dice "AB3")
- ;; → (D1 D2 D13)
- ;;
- ;; (dice->binary '(D1 D2 D13))
- ;; → "000001000010001101"
- ;; ------------------------------------------------------------
Pasted 2026-08-26 02:22:48
Short link:
Short link: