programAssembly
- ;; ============================================================
- ;; 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
- )
- or..
- and..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"
- ;; ------------------------------------------------------------
- define.. [rotate2-right s
- let*..(
- [len [string-length s
- [first2 [substring s 0 2
- [rest [substring s 2 len
- )
- [string-append rest first2
Pasted 2026-08-27 20:10:36
Short link:
Short link: