glitcherature-mode.el

   1 ;;; glitcherature-mode.el --- A minor mode to glitch text.
   2 ;;
   3 ;; Copyright (c) 2014 Rob Myers <rob@robmyers.org>
   4 ;;
   5 ;; This program is free software: you can redistribute it and/or modify
   6 ;; it under the terms of the GNU General Public License as published by
   7 ;; the Free Software Foundation, either version 3 of the License, or
   8 ;; (at your option) any later version.
   9 ;;
  10 ;; This program is distributed in the hope that it will be useful,
  11 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13 ;; GNU General Public License for more details.
  14 ;;
  15 ;; You should have received a copy of the GNU General Public License
  16 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  17
  18 ;;; Commentary:
  19
  20 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  21 ;; Usage
  22 ;;
  23 ;; To use, save glitcherature-mode.el to a directory in your load-path.
  24 ;;
  25 ;; (require 'glitcherature-mode)
  26 ;; (add-hook 'text-mode-hook 'glitcherature-mode)
  27 ;;
  28 ;; or
  29 ;;
  30 ;; M-x glitcherature-mode
  31 ;;
  32 ;; Dependencies
  33 ;;
  34 ;; The ocr function requires that gocr be installed.
  35 ;;
  36 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  37
  38 ;;; Code:
  39
  40 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  41 ;; Customization
  42 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  43
  44 ;; Enable features individually
  45
  46 (defcustom glitcherature-line-font-size 6
  47   "The size to rasterize text at for OCR"
  48   :type '(integer)
  49   :group 'glitcherature-mode)
  50
  51 (defcustom glitcherature-case-probability 2
  52   "The default 1/n probability of changing letter cases"
  53   :type '(integer)
  54   :group 'glitcherature-mode)
  55
  56 (defcustom glitcherature-line-length 80
  57   "The line length for various operations"
  58   :type '(integer)
  59   :group 'glitcherature-mode)
  60
  61 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  62 ;; Utility code
  63 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  64
  65 (defun random-char (source)
  66   "Pick one character from source at random"
  67   (let ((index (random (length source))))
  68     (substring source index (+ index 1))))
  69
  70 (defun random-char-run (source length)
  71   "Generate a string of length of one character randomly chosen from source"
  72   (let ((char (random-char source))
  73         (chars '()))
  74     (dotimes (i length) (push char chars))
  75     (apply 'concat chars)))
  76
  77 (defun random-chars-run (source length)
  78   "Generate a string of length characters randomly chosen from source"
  79   (let ((chars '()))
  80     (dotimes (i length) (push (random-char source) chars))
  81     (apply 'concat chars)))
  82
  83 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  84 ;; OCR Text substitution
  85 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  86
  87 (defun glitcherature-ocr-line (line line-font-size)
  88   (shell-command-to-string (format "pbmtextps -fontsize %d \"%s\" | gocr -"
  89                                    line-font-size line)))
  90
  91 (defun glitcherature-ocr-replace-text (start end font-size)
  92   "Rasterise the text then OCR it, replacing the original text"
  93   (interactive "r\np")
  94   (let* ((original-text (buffer-substring-no-properties start end))
  95          (original-lines (split-string original-text "\n"))
  96          (line-font-size (if (and current-prefix-arg
  97                                   (not (consp current-prefix-arg)))
  98                              font-size
  99                            glitcherature-line-font-size))
 100          (glitched-text (mapconcat
 101                          (lambda (line)
 102                            (glitcherature-ocr-line line line-font-size))
 103                          original-lines
 104                          "")))
 105     (delete-region start end)
 106     (insert glitched-text)))
 107
 108 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 109 ;; Runs
 110 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 111
 112 (defun glitcherature-random-run (count chars)
 113   "Insert a run of randomly chosen characters from chars.
 114    The count is taken from the numeric prefix arg, or the default."
 115   (interactive "p\nsCharacters to choose from: ")
 116   (let ((reps (if (and current-prefix-arg
 117                        (not (consp current-prefix-arg)))
 118                   count
 119                 glitcherature-line-length)))
 120     (insert (random-chars-run chars reps))))
 121
 122 (defun glitcherature-sub-space-runs (start end max-run-length chars)
 123   "Replace spaces with a random run of chars of max numeric prefix arg length"
 124   (interactive "r\np\nsCharacters to choose from: ")
 125   (save-excursion
 126     (save-restriction
 127       (narrow-to-region start end)
 128       (while (re-search-forward " +" nil t)
 129         (replace-match (random-char-run chars
 130                                         (+ (random max-run-length) 1)))))))
 131
 132 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 133 ;; Wrappers
 134 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 135
 136 (defun glitcherature-wrap-words (start end probability before after)
 137   "Wrap words in the region or after point with before and after
 138    1/probability of the time"
 139   (interactive "r\np\nsBefore: \nsAfter: ")
 140   (save-excursion
 141     (save-restriction
 142       (narrow-to-region start end)
 143       (while (re-search-forward " +" nil t)
 144         (if (= (random probability) 0)
 145             (replace-match (format "%s%s%s" before (match-string 0) after)))))))
 146
 147 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 148 ;; Case
 149 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 150
 151 (defun glitcherature-random-letter-case (start end probability)
 152   "Change each letter in the region or after point to uppercase
 153    1/probability of the time"
 154   (interactive "r\np")
 155   (save-excursion
 156     (save-restriction
 157       (narrow-to-region start end)
 158       (let ((prob (if (and current-prefix-arg
 159                        (not (consp current-prefix-arg)))
 160                   probability
 161                   glitcherature-case-probability)))
 162         (while (re-search-forward "\\w" nil t)
 163           (if (= (random prob) 0)
 164               (replace-match (upcase (match-string 0)))))))))
 165
 166 (defun glitcherature-random-word-case (start end probability)
 167   "Change each word in the region or after point to upper or lower case
 168    upper case is 1/probability of the time"
 169   (interactive "r\np")
 170   (save-excursion
 171     (save-restriction
 172       (narrow-to-region start end)
 173       (let ((prob (if (and current-prefix-arg
 174                        (not (consp current-prefix-arg)))
 175                   probability
 176                   glitcherature-case-probability)))
 177         (while (re-search-forward "\\w+" nil t)
 178           (if (= (random prob) 0)
 179               (replace-match (upcase (match-string 0)))
 180             (replace-match (downcase (match-string 0)))))))))
 181
 182 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 183 ;; Binary
 184 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 185
 186 (defun glitcherature-ascii-bin-char (char)
 187   "Convert the byte representing the character to a binary string"
 188   (let ((num (string-to-char char))
 189         (bin '()))
 190     (dotimes (i 8)
 191       (push (if (= 1 (logand (lsh num (- i)) 1)) "1" "0") bin))
 192     (apply 'concat bin)))
 193
 194 (defun glitcherature-ascii-bin (start end)
 195   "Convert the byte representing each character in the region or after point
 196    to a binary string"
 197 (interactive "r")
 198   (save-excursion
 199     (save-restriction
 200       (narrow-to-region start end)
 201       (while (re-search-forward "." nil t)
 202             (replace-match (glitcherature-ascii-bin-char (match-string 0)))))))
 203
 204 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 205 ;; Insertions and deletions
 206 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 207
 208 ;; Insert/overwrite n spaces
 209
 210 ;; Delete % spaces
 211
 212 ;; Insert n newlines
 213
 214 ;; Insert/overwrite n random chars
 215
 216 ;; Insert inappropriate hyphenation
 217
 218 ;; Substitute random typing errors (near letters on keyboard)
 219
 220 ;; Substitute typing errors then autocorrect
 221
 222 ;; Substiture % letters, vowels, consonants
 223
 224 ;; Shift % letters > unicode range (add number, convert to char)
 225
 226 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 227 ;; 1337
 228 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 229
 230 (defconst glitcherature-leet-lookup
 231   '(("a". ("@" "/\\\\" "/-\\\\" "λ"))
 232     ("b" . ("8" "|3" "6" "]3"))
 233     ("c" . ("(" "{" "<" "©"))
 234     ("d" . ("|)" "|]" "])" "∂"))
 235     ("e" . ("3" "£" "€" "="))
 236     ("f" . ("ʃ" "|=" "]=" ")="))
 237     ("g" . ("6" "9" "&" "C-"))
 238     ("h" . ("|-|" "#" "}{" ")-("))
 239     ("i" . ("!" "1" "|" "`|"))
 240     ("j" . ("_|" "]" "_/" "_)"))
 241     ("k" . ("|<" "|{" "|X" "]<"))
 242     ("l" . ("1" "7" "|_" "|"))
 243     ("m" . ("44" "/\\\\/\\\\" "|\\\\/|" "|v|"))
 244     ("n" . ("|\\\\|" "/\\\\/" "И" "~"))
 245     ("o" . ("()" "[]" "0" "Ø"))
 246     ("p" . ("|*" "?" "9" "|\""))
 247     ("q" . ("0_" "0" "(2" "¶"))
 248     ("r" . ("®" "Я" "I^" "|2"))
 249     ("s" . ("$" "5" "§" "_\-"))
 250     ("t" . ("7" "+" "†" "|["))
 251     ("u" . ("\\\\/" "|_|" "μ" "/_/"))
 252     ("v" . ("\\\\\\\\//" "\\\\/" "√" "V"))
 253     ("w" . ("vv" "\\\\/\\\\/" "Ш" "\\\\^/"))
 254     ("x" . ("%" "><" "*" "Ж"))
 255     ("y" . ("`/" "\"/" "`(" "-/"))
 256     ("z" . ("2" "3" "`/_" "%"))))
 257
 258 (defconst glitcherature-leet-kinds-count
 259   (safe-length (assoc "a" glitcherature-leet-lookup)))
 260
 261 ;; Make sure all lists are the same length
 262 (mapc (lambda (choices) (assert (= (safe-length choices)
 263                                 glitcherature-leet-kinds-count)))
 264       glitcherature-leet-lookup)
 265
 266 ;; Make sure no symbol or text appears twice in the same column
 267 ;; for the same letter
 268 (dotimes (i (- glitcherature-leet-kinds-count 1))
 269   (let ((column (mapcar (lambda (row) (nth i row))
 270                         glitcherature-leet-lookup)))
 271     (assert (= (safe-length column)
 272                (safe-length glitcherature-leet-lookup)))))
 273
 274 (defun glitcherature-sub-leet-vowels (start end probability)
 275   "Replace vowels after point or in the current region
 276    with 1337 1/probability of the time"
 277   (interactive "r\np")
 278   (save-excursion
 279     (save-restriction
 280       (narrow-to-region start end)
 281       (let ((column (random glitcherature-leet-kinds-count)))
 282         (while (re-search-forward "[aeiou]" nil t)
 283           (if (= (random probability) 0)
 284               (replace-match (nth column
 285                                   (assoc (match-string 0)
 286                                          glitcherature-leet-lookup)))))))))
 287
 288 (defun glitcherature-sub-leet (start end probability)
 289   "Replace letters after point or in the current region
 290    with 1337 1/probability of the time"
 291   (interactive "r\np")
 292   (save-excursion
 293     (save-restriction
 294       (narrow-to-region start end)
 295       (let ((column (random glitcherature-leet-kinds-count)))
 296       (while (re-search-forward "[a-z]" nil t)
 297         (if (= (random probability) 0)
 298             (replace-match (nth column
 299                                 (assoc (match-string 0)
 300                                        glitcherature-leet-lookup)))))))))
 301
 302 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 303 ;; The mode
 304 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 305
 306 (defconst glitcherature-mode-keymap (make-keymap))
 307
 308 (define-key glitcherature-mode-keymap (kbd "C-c C-g b")
 309 'glitcherature-ascii-bin)
 310 (define-key glitcherature-mode-keymap (kbd "C-c C-g l")
 311   'glitcherature-sub-leet)
 312 (define-key glitcherature-mode-keymap (kbd "C-c C-g o")
 313   'glitcherature-ocr-replace-text)
 314 (define-key glitcherature-mode-keymap (kbd "C-c C-g r")
 315   'glitcherature-random-run)
 316 (define-key glitcherature-mode-keymap (kbd "C-c C-g v")
 317   'glitcherature-sub-leet-vowels)
 318 (define-key glitcherature-mode-keymap (kbd "C-c C-g w")
 319   'glitcherature-wrap-words)
 320
 321 ;;;###autoload
 322 (define-minor-mode glitcherature-mode "Glitch text in various ways"
 323   :lighter " glitch"
 324   :keymap glitcherature-mode-keymap
 325   :group 'glitcherature-mode)
 326
 327 (provide 'glitcherature-mode)