英数字を180度回転して表示するプログラム #xyzzy

flippy.l

;;; -*- Mode: Lisp; Encoding: Shift_JIS -*-

;;; 英数字を180度回転した文字を表示するプログラム
;;; 元ネタ: http://id.fnshr.info/2013/01/25/upsidedowntext/

(provide "flippy")

(in-package "user")

(defvar *flippy-alist* nil)
(unless *flippy-alist*
  (setq *flippy-alist*
        '((#\A . #\∀) (#\B . #\B) (#\C . #\C) (#\D . #\D) (#\E . #\∃)
          (#\F . #\x0df6) (#\G . #\G) (#\H . #\H) (#\I . #\I) (#\J . #\x15ae)
          (#\K . #\x5277) (#\L . #\7) (#\M . #\W) (#\N . #\N)
          (#\O . #\O) (#\P . #\d) (#\Q . #\x03bc) (#\R . #\R) (#\S . #\5)
          (#\T . #\⊥) (#\U . #\∩) (#\V . #\Λ) (#\W . #\M) (#\X . #\X)
          (#\Y . #\Y) (#\Z . #\2)
          (#\a . #\x1580) (#\b . #\q) (#\c . #\x1584) (#\d . #\p) (#\e . #\x1589)
          (#\f . #\x158f) (#\g . #\x1583) (#\h . #\x1595) (#\i . #\!) (#\j . #\x15ae)
          (#\k . #\x15ce) (#\l . #\1) (#\m . #\x159f) (#\n . #\u) (#\o . #\o)
          (#\p . #\d) (#\q . #\b) (#\r . #\x15a9) (#\s . #\s)
          (#\t . #\x15b7) (#\u . #\n) #|(#\v . #\x15bc)|# (#\v . #\^) (#\w . #\x15bd) (#\x . #\x)
          (#\y . #\x15be) (#\z . #\z)
          (#\0 . #\0) (#\1 . #\l) (#\2 . #\Z) (#\3 . #\ε) (#\4 . #\4)
          (#\5 . #\S) (#\6 . #\9) (#\7 . #\L) (#\8 . #\8) (#\9 . #\6)
          (#\. . #\.) (#\, . #\') (#\+ . #\+) (#\- . #\-) (#\: . #\:) (#\; . #\;)
          (#\! . #\i) (#\? . #\x013f) (#\& . #\&) (#\^ . #\v)
          )))

(defun flippy-char (c)
  (or (cdr (assoc c *flippy-alist*))
      (car (rassoc c *flippy-alist*))
      c))

(defun %flippy (in &optional out)
  (do ((c #1=(read-char in nil :eof) #1#))
      ((eq c :eof))
    (write-char (flippy-char c) out)))

(defun flippy-string (str)
  (with-input-from-string (in str)
    (with-output-to-string (out)
      (%flippy in out))))

(defun flippy ()
  (interactive)
  (let ((line (make-vector 16 :element-type 'character :fill-pointer 0 :adjustable t)))
    (loop
      (minibuffer-prompt "Flippy: ~a" line)
      (message "~a" (flippy-string line))
      (let ((c (read-char *keyboard*)))
        (case c
          (#\RET (clear-message) (return))
          (#\C-g (quit))
          (#\C-h (or (zerop (length line))
                     (vector-pop line)))
          (t (vector-push-extend c line)))))))

(defun flippy-region (from to)
  (interactive "*r")
  (ed::text-decode-region #'%flippy from to))


#|
;; zone.l と組み合わせてみる
;; こちらを参照: https://github.com/kosh04/xyzzy-lisp/blob/master/site-lisp/zone.l
(require "zone")

(defun zone-pgm-flippy ()
  "一文字ごとに Flippy"
  (interactive)
  (when (interactive-p)
    (zone 'zone-pgm-flippy)
    (return-from zone-pgm-flippy t))
  (goto-char (point-min))
  (while (and (not (ed::input-pending-p))
              (not (ed::zone-timeout-p)))
    (when (eobp)
      (goto-char (point-min)))
    (let ((c (following-char)))
      (delete-char)
      (insert (flippy-char c)))
    (forward-char)
    (sit-for 0.025)
    ))

(defun zone-pgm-flippy2 ()
  "一行ごとに Flippy"
  (interactive)
  (when (interactive-p)
    (zone 'zone-pgm-flippy2)
    (return-from zone-pgm-flippy2 t))
  (goto-char (point-min))
  (while (and (not (ed::input-pending-p))
              (not (ed::zone-timeout-p)))
    (let* ((a (save-excursion (goto-bol) (point)))
           (z (save-excursion (goto-eol) (point)))
           (line (buffer-substring a z)))
      (delete-region a z)
      (insert (flippy-string line)))
    (unless (forward-line)
      (goto-char (point-min)))
    (sit-for 0.05)
    ))

;; M-x: zone-pgm-flippy

;; C-u M-x: zone -> Zone program: zone-pgm-flippy
(push 'zone-pgm-flippy ed::zone-programs)
(push 'zone-pgm-flippy2 ed::zone-programs)

|#