Following is a dumb implementation of Rubik's cube for Emacs. I am not well versed in writing (e)lisp, so I ask for a review and corrections.
;; -*- lexical-binding: t; -*-
;;; rubic_cube.el
;; emulation and solution of rubic's cube in emacs
;; cube layout
(defconst rubic-cube-front-default '(" / \\ "
" / \\ "
" / \\ / \\ "
" / \\_/ \\ "
" / \\ / \\ / \\ "
" / \\_/ \\_/ \\ "
" |\\_ / \\ / \\ /| "
" | \\ / \\_/ \\_/ | "
" | |\\_ / \\ /| | "
" |\\_ | \\ / \\_/ | _/| "
" | \\| |\\_ _/| |/ | "
" | |\\_ | \\ / | _/| | "
" |\\_ | \\| | |/ | _/| "
" | \\| |\\ | /| |/ | "
" | |\\_ | \\|/ | _/| | "
" \\_ | \\| | |/ | _/ "
" \\| |\\_ | _/| |/ "
" \\_ | \\|/ | _/ "
" \\| | |/ "
" \\_ | _/ "
" \\|/ "))
(defconst rubic-cube-back-default '(" _/|\\_ "
" / | \\ "
" _/| | |\\_ "
" / | _/|\\_ | \\ "
" _/| |/ | \\| |\\_ "
" / | _/| | |\\_ | \\ "
" | |/ | _/|\\_ | \\| | "
" | _/| |/ | \\| |\\_ | "
" |/ | _/| | |\\_ | \\| "
" | |/ | _/ \\_ | \\| | "
" | _/| |/ \\| |\\_ | "
" |/ | _/ \\_ _/ \\_ | \\| "
" | |/ \\_/ \\| | "
" | _/ \\_ / \\_ _/ \\_ | "
" |/ \\_/ \\_/ \\| "
" \\_ _/ \\_ _/ \\_ _/ "
" \\ / \\_/ \\_/ "
" \\_ _/ \\_ _/ "
" \\ / \\_/ "
" \\_ _/ "
" \\_/ "))
(defvar-local rubic-cuve-back nil
"Canbas for front of rubic's cube")
(defvar-local rubic-cube-front nil
"Canvas for back of rubic's cube")
(defconst side-coord '[(0 14) (7 3) (11 17) (5 5) (1 15) (9 14)]
"Coordinates of starting points of the cube sides")
;; faces
(defface rubic-red
'((t . (:background "red")))
"Red colored cube side")
(defface rubic-orange
'((t . (:background "orange")))
"Orange colored cube side")
(defface rubic-white
'((t . (:background "antique white")))
"white colored cube side")
(defface rubic-blue
'((t . (:background "blue")))
"Blue colored cube side")
(defface rubic-yellow
'((t . (:background "yellow")))
"Yellow colored cube side")
(defface rubic-green
'((t . (:background "green")))
"green colored cube side")
(defconst rubic-faces [rubic-red
rubic-white
rubic-green
rubic-yellow
rubic-blue
rubic-orange])
;; painter functions
(defun rubic-color-painter (face)
"make function that will apply color to string"
(lambda (str beg end prn)
(add-face-text-property beg end face t str)))
(defun rubic-paint-diamond (cube-screen coord painter)
"Paint diamond shape with provided paint function"
(let ((l (first coord))
(c (second coord)))
(apply painter (nth l cube-screen) c (1+ c) nil nil)
(apply painter (nth (incf l) cube-screen) (- c 2) (+ c 3) t nil)
(apply painter (nth (incf l) cube-screen) (- c 2) (+ c 3) nil nil)
(apply painter (nth (incf l) cube-screen) c (1+ c) nil nil)))
(defun rubic-paint-slope-down (cube-screen coord painter)
"Paint downward slope with provided paint function"
(let ((l (first coord))
(c (second coord)))
(apply painter (nth l cube-screen) c (+ c 2) nil nil)
(apply painter (nth (incf l) cube-screen) c (+ c 3) t nil)
(apply painter (nth (incf l) cube-screen) (1+ c) (+ c 3) nil nil)))
(defun rubic-paint-slope-up (cube-screen coord painter)
"Paint upwards slope with provided paint function"
(let ((l (first coord))
(c (second coord)))
(apply painter (nth l cube-screen) (1- c) (1+ c) nil nil)
(apply painter (nth (incf l) cube-screen) (- c 2) (1+ c) t nil)
(apply painter (nth (incf l) cube-screen) (- c 2) c nil nil)))
(defun rubic-make-initial-cube ()
(loop with res = (make-vector (* 9 6) 0)
for i from 0 to 5
do (loop for j from 0 to 8
do (aset res (+ j (* i 9)) i))
finally return res))
(defun rubic-displace-diamond (coord local-number)
"Calculate displacement of the cell of top and bottom sides"
(let ((l (first coord))
(c (second coord))
(row (/ local-number 3))
(col (mod local-number 3)))
(setq l (+ l (* 2 row)))
(setq c (- c (* 4 row)))
(setq l (+ l (* 2 col)))
(setq c (+ c (* 4 col)))
(list l c)))
(defun rubic-displace-downslope (coord local-number)
"Calculate displacements of te cell of front and left sides"
(let ((l (first coord))
(c (second coord))
(row (/ local-number 3))
(col (mod local-number 3)))
(setq l (+ l (* 3 row)))
(setq l (+ l (* 2 col)))
(setq c (+ c (* 4 col)))
(list l c)))
(defun rubic-displace-upslope (coord local-number)
"Calculate displacements of te cell of front and left sides"
(let ((l (first coord))
(c (second coord))
(row (/ local-number 3))
(col (mod local-number 3)))
(setq l (+ l (* 3 row)))
(setq l (- l (* 2 col)))
(setq c (+ c (* 4 col)))
(list l c)))
(defun rubic-get-local-number (cell-number)
(list (/ cell-number 9) (mod cell-number 9)))
(defun rubic-paint-cell (front back number color)
(destructuring-bind (side local-number) (rubic-get-local-number number)
(let ((canvas (if (< side 3) front back))
(painter (rubic-color-painter (aref rubic-faces color)))
(filler (case side
((0 5) 'rubic-paint-diamond)
((1 4) 'rubic-paint-slope-down)
((2 3) 'rubic-paint-slope-up)))
(translator (case side
((0 5) 'rubic-displace-diamond)
((1 4) 'rubic-displace-downslope)
((2 3) 'rubic-displace-upslope))))
(apply filler canvas (apply translator (aref side-coord side) local-number nil) painter nil))))
(defun rubic-paint-cube (cube-state)
(setq rubic-cube-front (mapcar #'copy-sequence rubic-cube-front-default))
(setq rubic-cube-back (mapcar #'copy-sequence rubic-cube-back-default))
(loop for i from 1 to (* 6 9) do
(rubic-paint-cell rubic-cube-front rubic-cube-back (1- i) (aref cube-state (1- i)))))
;; definitions for rotational notation
(require 'calc)
(defconst rubic-i '(cplx 0 1))
(defconst rubic-neg-i '(cplx 0 -1))
(defconst rubic-desc-rot-identity
'((0 1) (1 1) (2 1) (3 1) (4 1) (5 1)))
(defconst rubic-desc-rot-1-2
`((1 1) (5 ,rubic-i) (2 ,rubic-neg-i) (0 -1) (4 ,rubic-i) (3 ,rubic-i)))
(defconst rubic-desc-rot-1-3
`((2 ,rubic-i) (1 ,rubic-i) (5 -1) (3 ,rubic-neg-i) (0 ,rubic-i) (4 1)))
(defconst rubic-desc-rot-2-3
`((0 ,rubic-neg-i) (2 1) (3 1) (4 1) (1 1) (5 ,rubic-i)))
(defun rubic-compose-rot (rot-1 rot-2)
"Make rotation from two defined ones"
(loop for (n1 r1) in rot-1
for (n2 r2) = (nth n1 rot-2)
collect (list n2 (math-mul r1 r2))))
(defun rubic-rotate (&rest turns)
"Compose as many rotations as needed"
(reduce 'rubic-compose-rot turns))
(defconst rubicside-renumbering-clockwise
'(6 3 0 7 4 1 8 5 2))
(defun rubic-compose-subst (sub1 sub2)
(loop for i1 in sub1
for i2 = (nth i1 sub2)
collect i2))
(defun rubic-substitute (&rest subs)
(reduce 'rubic-compose-subst subs))
(defconst rubic-side-rotations
(list (cons rubic-i rubicside-renumbering-clockwise)
(cons -1 (rubic-substitute rubicside-renumbering-clockwise
rubicside-renumbering-clockwise))
(cons rubic-neg-i (rubic-substitute rubicside-renumbering-clockwise
rubicside-renumbering-clockwise
rubicside-renumbering-clockwise))
;; we could call with 4 rotations or define a constant for identity. But therte is no need, really
(cons 1 (list 0 1 2 3 4 5 6 7 8))))
(defun rubic-expand-substitution (sub)
"Get substitution for entire cube state"
(loop with res = (make-vector (* 9 6) 0)
for i from 0 to 5
for (side-number rot) = (nth i sub)
for side-reorder = (cdr (assoc rot rubic-side-rotations))
for base-offset = (* i 9)
for target-offset = (* side-number 9)
do (loop for j from 0 to 8
do
(setf (aref res (+ j target-offset))
(+ base-offset (nth j side-reorder))))
finally return (append res nil)))
(defconst rubic-turn-top-substitution
(let ((temp (coerce (loop for i from 0 to (1- (* 9 6)) collect i) 'vector))
(side-offsets '((9 36) (18 9) (27 18) (36 27)))
(rotation (rubic-substitute rubicside-renumbering-clockwise
rubicside-renumbering-clockwise
rubicside-renumbering-clockwise)))
(loop for i from 0 to 8 do (aset temp i (nth i rotation)))
(loop for (loc num) in side-offsets do
(loop for i from 0 to 2 do
(aset temp (+ loc i) (+ num i))))
(append temp nil)))
(defun rubic-apply-transformation (state transform)
(let ((second (copy-sequence state)))
(loop for i from 0 to (1- (length second)) do
(aset state (nth i transform) (aref second i)))))
;; definitions of common transformations
(defconst rubic-U
rubic-turn-top-substitution)
(defconst rubic-U2
(rubic-substitute rubic-turn-top-substitution
rubic-turn-top-substitution))
(defconst rubic-Ui
(rubic-substitute rubic-turn-top-substitution
rubic-turn-top-substitution
rubic-turn-top-substitution))
(defconst rubic-F
(rubic-substitute (rubic-expand-substitution rubic-desc-rot-1-2)
rubic-turn-top-substitution
(rubic-expand-substitution
(rubic-rotate rubic-desc-rot-1-2
rubic-desc-rot-1-2
rubic-desc-rot-1-2))))
(defconst rubic-F2
(rubic-substitute (rubic-expand-substitution rubic-desc-rot-1-2)
rubic-turn-top-substitution
rubic-turn-top-substitution
(rubic-expand-substitution
(rubic-rotate rubic-desc-rot-1-2
rubic-desc-rot-1-2
rubic-desc-rot-1-2))))
(defconst rubic-Fi
(rubic-substitute (rubic-expand-substitution rubic-desc-rot-1-2)
rubic-turn-top-substitution
rubic-turn-top-substitution
rubic-turn-top-substitution
(rubic-expand-substitution
(rubic-rotate rubic-desc-rot-1-2
rubic-desc-rot-1-2
rubic-desc-rot-1-2))))
(defconst rubic-R
(rubic-substitute (rubic-expand-substitution rubic-desc-rot-1-3)
rubic-turn-top-substitution
(rubic-expand-substitution
(rubic-rotate rubic-desc-rot-1-3
rubic-desc-rot-1-3
rubic-desc-rot-1-3))))
(defconst rubic-R2
(rubic-substitute (rubic-expand-substitution rubic-desc-rot-1-3)
rubic-turn-top-substitution
rubic-turn-top-substitution
(rubic-expand-substitution
(rubic-rotate rubic-desc-rot-1-3
rubic-desc-rot-1-3
rubic-desc-rot-1-3))))
(defconst rubic-Ri
(rubic-substitute (rubic-expand-substitution rubic-desc-rot-1-3)
rubic-turn-top-substitution
rubic-turn-top-substitution
rubic-turn-top-substitution
(rubic-expand-substitution
(rubic-rotate rubic-desc-rot-1-3
rubic-desc-rot-1-3
rubic-desc-rot-1-3))))
(defconst rubic-L
(rubic-substitute (rubic-expand-substitution
(rubic-rotate rubic-desc-rot-1-3
rubic-desc-rot-1-3
rubic-desc-rot-1-3))
rubic-turn-top-substitution
(rubic-expand-substitution rubic-desc-rot-1-3)))
(defconst rubic-L2
(rubic-substitute (rubic-expand-substitution
(rubic-rotate rubic-desc-rot-1-3
rubic-desc-rot-1-3
rubic-desc-rot-1-3))
rubic-turn-top-substitution
rubic-turn-top-substitution
(rubic-expand-substitution rubic-desc-rot-1-3)))
(defconst rubic-Li
(rubic-substitute (rubic-expand-substitution
(rubic-rotate rubic-desc-rot-1-3
rubic-desc-rot-1-3
rubic-desc-rot-1-3))
rubic-turn-top-substitution
rubic-turn-top-substitution
rubic-turn-top-substitution
(rubic-expand-substitution rubic-desc-rot-1-3)))
(defconst rubic-B
(rubic-substitute (rubic-expand-substitution
(rubic-rotate rubic-desc-rot-1-2
rubic-desc-rot-1-2
rubic-desc-rot-1-2))
rubic-turn-top-substitution
(rubic-expand-substitution rubic-desc-rot-1-2)))
(defconst rubic-B2
(rubic-substitute (rubic-expand-substitution
(rubic-rotate rubic-desc-rot-1-2
rubic-desc-rot-1-2
rubic-desc-rot-1-2))
rubic-turn-top-substitution
rubic-turn-top-substitution
(rubic-expand-substitution rubic-desc-rot-1-2)))
(defconst rubic-Bi
(rubic-substitute (rubic-expand-substitution
(rubic-rotate rubic-desc-rot-1-2
rubic-desc-rot-1-2
rubic-desc-rot-1-2))
rubic-turn-top-substitution
rubic-turn-top-substitution
rubic-turn-top-substitution
(rubic-expand-substitution rubic-desc-rot-1-2)))
(defconst rubic-D
(rubic-substitute (rubic-expand-substitution
(rubic-rotate rubic-desc-rot-1-2
rubic-desc-rot-1-2))
rubic-turn-top-substitution
(rubic-expand-substitution
(rubic-rotate rubic-desc-rot-1-2
rubic-desc-rot-1-2))))
(defconst rubic-D2
(rubic-substitute (rubic-expand-substitution
(rubic-rotate rubic-desc-rot-1-2
rubic-desc-rot-1-2))
rubic-turn-top-substitution
rubic-turn-top-substitution
(rubic-expand-substitution
(rubic-rotate rubic-desc-rot-1-2
rubic-desc-rot-1-2))))
(defconst rubic-Di
(rubic-substitute (rubic-expand-substitution
(rubic-rotate rubic-desc-rot-1-2
rubic-desc-rot-1-2))
rubic-turn-top-substitution
rubic-turn-top-substitution
rubic-turn-top-substitution
(rubic-expand-substitution
(rubic-rotate rubic-desc-rot-1-2
rubic-desc-rot-1-2))))
(defconst rubic-x
(rubic-expand-substitution rubic-desc-rot-1-2))
(defconst rubic-x2
(rubic-expand-substitution
(rubic-rotate rubic-desc-rot-1-2
rubic-desc-rot-1-2)))
(defconst rubic-xi
(rubic-expand-substitution
(rubic-rotate rubic-desc-rot-1-2
rubic-desc-rot-1-2
rubic-desc-rot-1-2)))
(defconst rubic-y
(rubic-expand-substitution rubic-desc-rot-2-3))
(defconst rubic-y2
(rubic-expand-substitution
(rubic-rotate rubic-desc-rot-2-3
rubic-desc-rot-2-3)))
(defconst rubic-yi
(rubic-expand-substitution
(rubic-rotate rubic-desc-rot-2-3
rubic-desc-rot-2-3
rubic-desc-rot-2-3)))
(defconst rubic-zi
(rubic-expand-substitution rubic-desc-rot-1-3))
(defconst rubic-z2
(rubic-expand-substitution
(rubic-rotate rubic-desc-rot-1-3
rubic-desc-rot-1-3)))
(defconst rubic-z
(rubic-expand-substitution
(rubic-rotate rubic-desc-rot-1-3
rubic-desc-rot-1-3
rubic-desc-rot-1-3)))
;; mode definitions
(defvar-local cube-state nil
"State of the cube that is being processed")
(defvar-local cube-undo (list 'undo)
"List of previously executed commands")
(defvar-local cube-redo (list 'redo)
"List of previously undone commands")
(defun rubic-center-string (str l)
(if (> (length str) l)
(substring str l)
(let* ((sl (length str))
(pad (/ (- l sl) 2))
(rem (- l pad)))
(concat (format (format "%%%ds" rem) str) (make-string pad ? )))))
(defun rubic-display-cube ()
"Draw current cube state, assuming empty buffer"
;; first, update canvasses according to the cube state
(rubic-paint-cube cube-state)
(let ((w (length (first rubic-cube-front-default)))
(h (length rubic-cube-front-default)))
(insert (format "%s%s\n"
(rubic-center-string "*FRONT*" w)
(rubic-center-string "*BACK*" w)))
(insert-rectangle rubic-cube-front)
(forward-line (- (decf h)))
(move-end-of-line nil)
(insert-rectangle rubic-cube-back)))
(defun rubic-display-undo ()
"Print undo information"
(loop with line-str = "\nUndo: "
for cmd in (reverse (cdr cube-undo))
for i = 1 then (1+ i)
do (progn
(setq line-str (concat line-str (format "%d. %s " i (get cmd 'name))))
(when (> (length line-str) fill-column)
(insert line-str)
(setq line-str (concat "\n" (make-string 6 ? )))))
finally (insert line-str)))
(defun rubic-display-redo ()
"Print undo information"
(loop with line-str = "\nRedo: "
for cmd in (cdr cube-redo)
for i = 1 then (1+ i)
do (progn
(setq line-str (concat line-str (format "%d. %s " i (get cmd 'name))))
(when (> (length line-str) fill-column)
(insert line-str)
(setq line-str (concat "\n" (make-string 6 ? )))))
finally (insert line-str)))
(defun rubic-draw-all ()
(setq buffer-read-only nil)
(erase-buffer)
(rubic-display-cube)
(rubic-display-undo)
(rubic-display-redo)
(setq buffer-read-only t))
(defmacro rubic-define-command (transformation desc)
(let ((command-name (intern (concat (symbol-name transformation) "-command"))))
(put command-name 'name desc)
`(defun ,command-name (&optional arg)
(interactive)
(rubic-apply-transformation cube-state ,transformation)
(unless arg
(setcdr cube-redo nil)
(setcdr cube-undo (cons (quote ,command-name) (cdr cube-undo)))
(rubic-draw-all)))))
(defmacro rubic-define-commands (&rest transformations)
(let ((head (car transformations))
(command-name (cadr transformations))
(tail (cddr transformations)))
`(progn
,(when head
`(rubic-define-command ,head ,command-name))
,(when tail
`(rubic-define-commands ,@tail)))))
(rubic-define-commands rubic-U "Upper" rubic-U2 "Upper twice" rubic-Ui "Upper inverted"
rubic-F "Front" rubic-F2 "Front twice" rubic-Fi "Front inverted"
rubic-R "Right" rubic-R2 "Right twice" rubic-Ri "Right inverted"
rubic-L "Left" rubic-L2 "Left twice" rubic-Li "Left inverted"
rubic-B "Back" rubic-B2 "Back twice" rubic-Bi "Back inverted"
rubic-D "Down" rubic-D2 "Down twice" rubic-Di "Down inverted"
rubic-x "X rotation" rubic-x2 "X overturn" rubic-xi "X rotation inverted"
rubic-y "Y rotation" rubic-y2 "Y overturn" rubic-yi "Y rotation inverted"
rubic-z "Z rotation" rubic-z2 "Z overturn" rubic-zi "Z rotation inverted")
(defconst rubic-reverse-commands
'((rubic-U-command . rubic-Ui-command)
(rubic-U2-command . rubic-U2-command)
(rubic-F-command . rubic-Fi-command)
(rubic-F2-command . rubic-F2-command)
(rubic-R-command . rubic-Ri-command)
(rubic-R2-command . rubic-R2-command)
(rubic-L-command . rubic-Li-command)
(rubic-L2-command . rubic-L2-command)
(rubic-B-command . rubic-Bi-command)
(rubic-B2-command . rubic-B2-command)
(rubic-D-command . rubic-Di-command)
(rubic-D2-command . rubic-D2-command)
(rubic-x-command . rubic-xi-command)
(rubic-x2-command . rubic-x2-command)
(rubic-y-command . rubic-yi-command)
(rubic-y2-command . rubic-y2-command)
(rubic-z-command . rubic-zi-command)
(rubic-z2-command . rubic-z2-command)))
(defun rubic-reset ()
"Set cube to initial state"
(interactive)
(setq cube-state (rubic-make-initial-cube))
(setq cube-undo (list 'undo))
(setq cube-redo (list 'redo))
(rubic-draw-all))
(defun rubic-undo (&optional arg)
"Undo up to ARG commands from undo list"
(interactive "p")
(let ((num (or arg 1)))
(loop repeat num
for lastcmd = (cadr cube-undo)
when lastcmd do
(let ((revcmd (or (cdr (assoc lastcmd rubic-reverse-commands))
(car (rassoc lastcmd rubic-reverse-commands)))))
(setcdr cube-redo (cons lastcmd (cdr cube-redo)))
(setcdr cube-undo (cddr cube-undo))
(apply revcmd '(t))))
(rubic-draw-all)))
(defun rubic-redo (&optional arg)
"Redo up to ARG commands"
(interactive "p")
(let ((num (or arg 1)))
(loop repeat num
for lastcmd = (cadr cube-redo)
when lastcmd do
(progn
(setcdr cube-undo (cons lastcmd (cdr cube-undo)))
(setcdr cube-redo (cddr cube-redo))
(apply lastcmd '(t))))
(rubic-draw-all)))
(defvar rubic-mode-map
(let ((map (make-sparse-keymap))
(map-i (make-sparse-keymap))
(map-2 (make-sparse-keymap)))
(define-key map "u" 'rubic-U-command)
(define-key map-2 "u" 'rubic-U2-command)
(define-key map-i "u" 'rubic-Ui-command)
(define-key map "f" 'rubic-F-command)
(define-key map-2 "f" 'rubic-F2-command)
(define-key map-i "f" 'rubic-Fi-command)
(define-key map "r" 'rubic-R-command)
(define-key map-2 "r" 'rubic-R2-command)
(define-key map-i "r" 'rubic-Ri-command)
(define-key map "l" 'rubic-L-command)
(define-key map-2 "l" 'rubic-L2-command)
(define-key map-i "l" 'rubic-Li-command)
(define-key map "b" 'rubic-B-command)
(define-key map-2 "b" 'rubic-B2-command)
(define-key map-i "b" 'rubic-Bi-command)
(define-key map "d" 'rubic-D-command)
(define-key map-2 "d" 'rubic-D2-command)
(define-key map-i "d" 'rubic-Di-command)
(define-key map "x" 'rubic-x-command)
(define-key map-2 "x" 'rubic-x2-command)
(define-key map-i "x" 'rubic-xi-command)
(define-key map "y" 'rubic-y-command)
(define-key map-2 "y" 'rubic-y2-command)
(define-key map-i "y" 'rubic-yi-command)
(define-key map "z" 'rubic-z-command)
(define-key map-2 "z" 'rubic-z2-command)
(define-key map-i "z" 'rubic-zi-command)
(define-key map "g" 'rubic-reset)
(define-key map "2" map-2)
(define-key map "i" map-i)
(define-key map (kbd "M-u") 'rubic-undo)
(define-key map (kbd "M-r") 'rubic-redo)
map))
(define-derived-mode rubic-mode special-mode
"rubic's cube")
(add-hook 'rubic-mode-hook
(lambda ()
(rubic-reset)))
(defun rubic ()
"Prepare for rubic mode"
(interactive)
(switch-to-buffer "*Rubic*")
(rubic-mode))
