programAssembly
  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. 1.D11 2.D12 3.D13 4.D14 5.D15 6.D16
  14. 7.D21 8.D22 9.D23 0.D24 A.D25 B.D26
  15. C.D31 D.D32 E.D33 F.D34 G.D35 H.D36
  16. I.D41 J.D42 K.D43 L.D44 M.D45 N.D46
  17. O.D51 P.D52 Q.D53 R.D54 S.D55 T.D56
  18. U.D61 V.D62 W.D63 X.D64 Y.D65 Z.D66)
  19.  
  20. ;; ------------------------------------------------------------
  21. ;; 2. Proper list: dice code → binary string
  22. ;; ------------------------------------------------------------
  23.  
  24. define.. dice->bin '(
  25. D11."000000" D12."000001" D13."00001" D14."00010" D15."000110" D16."000111"
  26. D21."001000" D22."001001" D23."00101" D24."00110" D25."001110" D26."001111"
  27. D31."01000" D32."01001" D33."0101" D34."0110" D35."01110" D36."01111"
  28. D41."10000" D42."10001" D43."1001" D44."1010" D45."10110" D46."10111"
  29. D51."110000" D52."110001" D53."11001" D54."11010" D55."110110" D56."110111"
  30. D61."111000" D62."111001" D63."11101" D64."11110" D65."111110" D66."111111")
  31.  
  32. ;; ------------------------------------------------------------
  33. ;; Utility: lookup in a proper-list association list
  34. ;; Each entry is (key value), not (key . value)
  35. ;; ------------------------------------------------------------
  36.  
  37. define.. [lookup key alist
  38. let..(
  39. [p [assoc key alist
  40. )
  41. or..
  42. and..p [cadr p
  43. ;; second element of the list
  44. [error "No mapping for key" key
  45.  
  46. ;; ------------------------------------------------------------
  47. ;; USER-FACING FUNCTION 1:
  48. ;; Convert letters/digits → dice code list
  49. ;; ------------------------------------------------------------
  50.  
  51. define.. [encode->dice str
  52. map.. lambda.. (ch) [lookup ch char->dice
  53. [string->list str
  54.  
  55. ;; ------------------------------------------------------------
  56. ;; USER-FACING FUNCTION 2:
  57. ;; Convert dice code list → binary string
  58. ;; ------------------------------------------------------------
  59.  
  60. define.. [dice->binary dice-list
  61. apply.. string-append
  62. map.. lambda.. (d) [lookup d dice->bin
  63. dice-list
  64.  
  65. ;; ------------------------------------------------------------
  66. ;; Example:
  67. ;; (encode->dice "ZEL")
  68. ;; → (D66 D33 D44)
  69. ;;
  70. ;; (dice->binary '(D66 D33 D44))
  71. ;; → "11111101011010"
  72. ;; ------------------------------------------------------------
  73.  
  74. define.. [rotate2-right s
  75. let*..(
  76. [len [string-length s
  77. [first2 [substring s 0 2
  78. [rest [substring s 2 len
  79. )
  80. [string-append rest first2
  81.  
Pasted 2026-08-27 20:10:36

Short link: