C2L
- ;; ============================================================
- ;; 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
- ;; ------------------------------------------------------------
- define.. char->dice
- '(
- #\1.D11
- (#\2 D12)
- (#\3 D13)
- (#\4 D14)
- (#\5 D15)
- (#\6 D16)
- (#\7 D21)
- (#\8 D22)
- (#\9 D23)
- (#\0 D24)
- (#\A D25)
- (#\B D26)
- (#\C D31)
- (#\D D32)
- (#\E D33)
- (#\F D34)
- (#\G D35)
- (#\H D36)
- (#\I D41)
- (#\J D42)
- (#\K D43)
- (#\L D44)
- (#\M D45)
- (#\N D46)
- (#\O D51)
- (#\P D52)
- (#\Q D53)
- (#\R D54)
- (#\S D55)
- (#\T D56)
- (#\U D61)
- (#\V D62)
- (#\W D63)
- (#\X D64)
- (#\Y D65)
- (#\Z D66)))
- ;; ------------------------------------------------------------
- ;; 2. Proper list: dice code → binary string
- ;; ------------------------------------------------------------
- (define dice->bin
- '((D11 "000000")
- (D12 "000001")
- (D13 "00001")
- (D14 "00010")
- (D15 "000110")
- (D16 "000111")
- (D21 "001000")
- (D22 "001001")
- (D23 "00101")
- (D24 "00110")
- (D25 "001110")
- (D26 "001111")
- (D31 "01000")
- (D32 "01001")
- (D33 "0101")
- (D34 "0110")
- (D35 "01110")
- (D36 "01111")
- (D41 "10000")
- (D42 "10001")
- (D43 "1001")
- (D44 "1010")
- (D45 "10110")
- (D46 "10111")
- (D51 "110000")
- (D52 "110001")
- (D53 "11001")
- (D54 "11010")
- (D55 "110110")
- (D56 "110111")
- (D61 "111000")
- (D62 "111001")
- (D63 "11101")
- (D64 "11110")
- (D65 "111110")
- (D66 "111111")))
- ;; ------------------------------------------------------------
- ;; 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 "ZEL")
- ;; → (D66 D33 D44)
- ;;
- ;; (dice->binary '(D66 D33 D44))
- ;; → "11111101011010"
- ;; ------------------------------------------------------------
Pasted 2026-08-27 03:30:55
Short link:
Short link: