code
  1. ;; ============================================================
  2. ;; R4RS-Compatible Dice Code System (Proper Lists Only)
  3. ;; Two user-facing functions:
  4. ;; (encode->dice "ABC123")
  5. ;; (dice->binary '(D1 D2 D13))
  6. ;; ============================================================
  7.  
  8. ;; ------------------------------------------------------------
  9. ;; 1. Proper list: character → dice code
  10. ;; Replace these mappings with your real dice code.
  11. ;; ------------------------------------------------------------
  12.  
  13. (define char->dice
  14. '((#\A D1)
  15. (#\B D2)
  16. (#\C D3)
  17. (#\D D4)
  18. (#\E D5)
  19. (#\F D6)
  20. (#\0 D10)
  21. (#\1 D11)
  22. (#\2 D12)
  23. (#\3 D13)
  24. (#\4 D14)
  25. (#\5 D15)
  26. (#\6 D16)
  27. (#\7 D17)
  28. (#\8 D18)
  29. (#\9 D19)))
  30.  
  31. ;; ------------------------------------------------------------
  32. ;; 2. Proper list: dice code → binary string
  33. ;; Replace these with your reversible binary encoding.
  34. ;; ------------------------------------------------------------
  35.  
  36. (define dice->bin
  37. '((D1 "000001")
  38. (D2 "000010")
  39. (D3 "000011")
  40. (D4 "000100")
  41. (D5 "000101")
  42. (D6 "000110")
  43. (D10 "001010")
  44. (D11 "001011")
  45. (D12 "001100")
  46. (D13 "001101")
  47. (D14 "001110")
  48. (D15 "001111")
  49. (D16 "010000")
  50. (D17 "010001")
  51. (D18 "010010")
  52. (D19 "010011")))
  53.  
  54. ;; ------------------------------------------------------------
  55. ;; Utility: lookup in a proper-list association list
  56. ;; Each entry is (key value), not (key . value)
  57. ;; ------------------------------------------------------------
  58.  
  59. (define (lookup key alist)
  60. (let ((p (assoc key alist)))
  61. (if p
  62. (cadr p) ;; second element of the list
  63. (error "No mapping for key" key))))
  64.  
  65. ;; ------------------------------------------------------------
  66. ;; USER-FACING FUNCTION 1:
  67. ;; Convert letters/digits → dice code list
  68. ;; ------------------------------------------------------------
  69.  
  70. (define (encode->dice str)
  71. (map (lambda (ch)
  72. (lookup ch char->dice))
  73. (string->list str)))
  74.  
  75. ;; ------------------------------------------------------------
  76. ;; USER-FACING FUNCTION 2:
  77. ;; Convert dice code list → binary string
  78. ;; ------------------------------------------------------------
  79.  
  80. (define (dice->binary dice-list)
  81. (apply string-append
  82. (map (lambda (d)
  83. (lookup d dice->bin))
  84. dice-list)))
  85.  
  86. ;; ------------------------------------------------------------
  87. ;; Example:
  88. ;; (encode->dice "AB3")
  89. ;; → (D1 D2 D13)
  90. ;;
  91. ;; (dice->binary '(D1 D2 D13))
  92. ;; → "000001000010001101"
  93. ;; ------------------------------------------------------------
  94.  
Pasted 2026-08-26 02:22:48

Short link: