C2L
  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. ;; ------------------------------------------------------------
  11.  
  12. define.. char->dice
  13. '(
  14. #\1.D11
  15. (#\2 D12)
  16. (#\3 D13)
  17. (#\4 D14)
  18. (#\5 D15)
  19. (#\6 D16)
  20. (#\7 D21)
  21. (#\8 D22)
  22. (#\9 D23)
  23. (#\0 D24)
  24. (#\A D25)
  25. (#\B D26)
  26. (#\C D31)
  27. (#\D D32)
  28. (#\E D33)
  29. (#\F D34)
  30. (#\G D35)
  31. (#\H D36)
  32. (#\I D41)
  33. (#\J D42)
  34. (#\K D43)
  35. (#\L D44)
  36. (#\M D45)
  37. (#\N D46)
  38. (#\O D51)
  39. (#\P D52)
  40. (#\Q D53)
  41. (#\R D54)
  42. (#\S D55)
  43. (#\T D56)
  44. (#\U D61)
  45. (#\V D62)
  46. (#\W D63)
  47. (#\X D64)
  48. (#\Y D65)
  49. (#\Z D66)))
  50.  
  51. ;; ------------------------------------------------------------
  52. ;; 2. Proper list: dice code → binary string
  53. ;; ------------------------------------------------------------
  54.  
  55. (define dice->bin
  56. '((D11 "000000")
  57. (D12 "000001")
  58. (D13 "00001")
  59. (D14 "00010")
  60. (D15 "000110")
  61. (D16 "000111")
  62. (D21 "001000")
  63. (D22 "001001")
  64. (D23 "00101")
  65. (D24 "00110")
  66. (D25 "001110")
  67. (D26 "001111")
  68. (D31 "01000")
  69. (D32 "01001")
  70. (D33 "0101")
  71. (D34 "0110")
  72. (D35 "01110")
  73. (D36 "01111")
  74. (D41 "10000")
  75. (D42 "10001")
  76. (D43 "1001")
  77. (D44 "1010")
  78. (D45 "10110")
  79. (D46 "10111")
  80. (D51 "110000")
  81. (D52 "110001")
  82. (D53 "11001")
  83. (D54 "11010")
  84. (D55 "110110")
  85. (D56 "110111")
  86. (D61 "111000")
  87. (D62 "111001")
  88. (D63 "11101")
  89. (D64 "11110")
  90. (D65 "111110")
  91. (D66 "111111")))
  92.  
  93. ;; ------------------------------------------------------------
  94. ;; Utility: lookup in a proper-list association list
  95. ;; Each entry is (key value), not (key . value)
  96. ;; ------------------------------------------------------------
  97.  
  98. (define (lookup key alist)
  99. (let ((p (assoc key alist)))
  100. (if p
  101. (cadr p) ;; second element of the list
  102. (error "No mapping for key" key))))
  103.  
  104. ;; ------------------------------------------------------------
  105. ;; USER-FACING FUNCTION 1:
  106. ;; Convert letters/digits → dice code list
  107. ;; ------------------------------------------------------------
  108.  
  109. (define (encode->dice str)
  110. (map (lambda (ch)
  111. (lookup ch char->dice))
  112. (string->list str)))
  113.  
  114. ;; ------------------------------------------------------------
  115. ;; USER-FACING FUNCTION 2:
  116. ;; Convert dice code list → binary string
  117. ;; ------------------------------------------------------------
  118.  
  119. (define (dice->binary dice-list)
  120. (apply string-append
  121. (map (lambda (d)
  122. (lookup d dice->bin))
  123. dice-list)))
  124.  
  125. ;; ------------------------------------------------------------
  126. ;; Example:
  127. ;; (encode->dice "ZEL")
  128. ;; → (D66 D33 D44)
  129. ;;
  130. ;; (dice->binary '(D66 D33 D44))
  131. ;; → "11111101011010"
  132. ;; ------------------------------------------------------------
  133.  
Pasted 2026-08-27 03:30:55

Short link: