aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--lisp/play/zone.el130
1 files changed, 65 insertions, 65 deletions
diff --git a/lisp/play/zone.el b/lisp/play/zone.el
index 5bc87faef10..4ef3c2cb517 100644
--- a/lisp/play/zone.el
+++ b/lisp/play/zone.el
@@ -57,7 +57,7 @@
57 zone-pgm-jitter 57 zone-pgm-jitter
58 zone-pgm-putz-with-case 58 zone-pgm-putz-with-case
59 zone-pgm-dissolve 59 zone-pgm-dissolve
60; zone-pgm-explode 60 ;; zone-pgm-explode
61 zone-pgm-whack-chars 61 zone-pgm-whack-chars
62 zone-pgm-rotate 62 zone-pgm-rotate
63 zone-pgm-rotate-LR-lockstep 63 zone-pgm-rotate-LR-lockstep
@@ -149,10 +149,10 @@
149 149
150(defun zone-shift-up () 150(defun zone-shift-up ()
151 (let* ((b (point)) 151 (let* ((b (point))
152 (e (progn 152 (e (progn
153 (end-of-line) 153 (end-of-line)
154 (if (looking-at "\n") (1+ (point)) (point)))) 154 (if (looking-at "\n") (1+ (point)) (point))))
155 (s (buffer-substring b e))) 155 (s (buffer-substring b e)))
156 (delete-region b e) 156 (delete-region b e)
157 (goto-char (point-max)) 157 (goto-char (point-max))
158 (insert s))) 158 (insert s)))
@@ -162,10 +162,10 @@
162 (forward-line -1) 162 (forward-line -1)
163 (beginning-of-line) 163 (beginning-of-line)
164 (let* ((b (point)) 164 (let* ((b (point))
165 (e (progn 165 (e (progn
166 (end-of-line) 166 (end-of-line)
167 (if (looking-at "\n") (1+ (point)) (point)))) 167 (if (looking-at "\n") (1+ (point)) (point))))
168 (s (buffer-substring b e))) 168 (s (buffer-substring b e)))
169 (delete-region b e) 169 (delete-region b e)
170 (goto-char (point-min)) 170 (goto-char (point-min))
171 (insert s))) 171 (insert s)))
@@ -173,20 +173,20 @@
173(defun zone-shift-left () 173(defun zone-shift-left ()
174 (while (not (eobp)) 174 (while (not (eobp))
175 (or (eolp) 175 (or (eolp)
176(let ((c (following-char))) 176 (let ((c (following-char)))
177 (delete-char 1) 177 (delete-char 1)
178 (end-of-line) 178 (end-of-line)
179 (insert c))) 179 (insert c)))
180 (forward-line 1))) 180 (forward-line 1)))
181 181
182(defun zone-shift-right () 182(defun zone-shift-right ()
183 (while (not (eobp)) 183 (while (not (eobp))
184 (end-of-line) 184 (end-of-line)
185 (or (bolp) 185 (or (bolp)
186(let ((c (preceding-char))) 186 (let ((c (preceding-char)))
187 (delete-backward-char 1) 187 (delete-backward-char 1)
188 (beginning-of-line) 188 (beginning-of-line)
189 (insert c))) 189 (insert c)))
190 (forward-line 1))) 190 (forward-line 1)))
191 191
192(defun zone-pgm-jitter () 192(defun zone-pgm-jitter ()
@@ -216,14 +216,14 @@
216 (let ((tbl (copy-sequence (get 'zone-pgm-whack-chars 'wc-tbl)))) 216 (let ((tbl (copy-sequence (get 'zone-pgm-whack-chars 'wc-tbl))))
217 (while (not (input-pending-p)) 217 (while (not (input-pending-p))
218 (let ((i 48)) 218 (let ((i 48))
219(while (< i 122) 219 (while (< i 122)
220 (aset tbl i (+ 48 (random (- 123 48)))) 220 (aset tbl i (+ 48 (random (- 123 48))))
221 (setq i (1+ i))) 221 (setq i (1+ i)))
222(translate-region (point-min) (point-max) tbl) 222 (translate-region (point-min) (point-max) tbl)
223(sit-for 0 2))))) 223 (sit-for 0 2)))))
224 224
225(put 'zone-pgm-whack-chars 'wc-tbl 225(put 'zone-pgm-whack-chars 'wc-tbl
226 (let ((tbl (make-string 128 ?x)) 226 (let ((tbl (make-vector 128 ?x))
227 (i 0)) 227 (i 0))
228 (while (< i 128) 228 (while (< i 128)
229 (aset tbl i i) 229 (aset tbl i i)
@@ -237,17 +237,17 @@
237 (while working 237 (while working
238 (setq working nil) 238 (setq working nil)
239 (save-excursion 239 (save-excursion
240(goto-char (point-min)) 240 (goto-char (point-min))
241(while (not (eobp)) 241 (while (not (eobp))
242 (if (looking-at "[^(){}\n\t ]") 242 (if (looking-at "[^(){}\n\t ]")
243 (let ((n (random 5))) 243 (let ((n (random 5)))
244(if (not (= n 0)) 244 (if (not (= n 0))
245 (progn 245 (progn
246 (setq working t) 246 (setq working t)
247 (forward-char 1)) 247 (forward-char 1))
248 (delete-char 1) 248 (delete-char 1)
249 (insert " "))) 249 (insert " ")))
250 (forward-char 1)))) 250 (forward-char 1))))
251 (sit-for 0 2)))) 251 (sit-for 0 2))))
252 252
253(defun zone-pgm-dissolve () 253(defun zone-pgm-dissolve ()
@@ -261,14 +261,14 @@
261 (let ((i 0)) 261 (let ((i 0))
262 (while (< i 20) 262 (while (< i 20)
263 (save-excursion 263 (save-excursion
264(goto-char (point-min)) 264 (goto-char (point-min))
265(while (not (eobp)) 265 (while (not (eobp))
266 (if (looking-at "[^*\n\t ]") 266 (if (looking-at "[^*\n\t ]")
267 (let ((n (random 5))) 267 (let ((n (random 5)))
268(if (not (= n 0)) 268 (if (not (= n 0))
269 (forward-char 1)) 269 (forward-char 1))
270 (insert " "))) 270 (insert " ")))
271 (forward-char 1))) 271 (forward-char 1)))
272 (setq i (1+ i)) 272 (setq i (1+ i))
273 (sit-for 0 2))) 273 (sit-for 0 2)))
274 (zone-pgm-jitter)) 274 (zone-pgm-jitter))
@@ -285,25 +285,25 @@
285;; less interesting effect than you might imagine. 285;; less interesting effect than you might imagine.
286(defun zone-pgm-2nd-putz-with-case () 286(defun zone-pgm-2nd-putz-with-case ()
287 (let ((tbl (make-string 128 ?x)) 287 (let ((tbl (make-string 128 ?x))
288(i 0)) 288 (i 0))
289 (while (< i 128) 289 (while (< i 128)
290 (aset tbl i i) 290 (aset tbl i i)
291 (setq i (1+ i))) 291 (setq i (1+ i)))
292 (while (not (input-pending-p)) 292 (while (not (input-pending-p))
293 (setq i ?a) 293 (setq i ?a)
294 (while (<= i ?z) 294 (while (<= i ?z)
295(aset tbl i 295 (aset tbl i
296 (if (zerop (random 5)) 296 (if (zerop (random 5))
297 (upcase i) 297 (upcase i)
298(downcase i))) 298 (downcase i)))
299(setq i (+ i (1+ (random 5))))) 299 (setq i (+ i (1+ (random 5)))))
300 (setq i ?A) 300 (setq i ?A)
301 (while (<= i ?z) 301 (while (<= i ?z)
302(aset tbl i 302 (aset tbl i
303 (if (zerop (random 5)) 303 (if (zerop (random 5))
304 (downcase i) 304 (downcase i)
305(upcase i))) 305 (upcase i)))
306(setq i (+ i (1+ (random 5))))) 306 (setq i (+ i (1+ (random 5)))))
307 (translate-region (point-min) (point-max) tbl) 307 (translate-region (point-min) (point-max) tbl)
308 (sit-for 0 2)))) 308 (sit-for 0 2))))
309 309
@@ -311,18 +311,18 @@
311 (goto-char (point-min)) 311 (goto-char (point-min))
312 (while (not (input-pending-p)) 312 (while (not (input-pending-p))
313 (let ((np (+ 2 (random 5))) 313 (let ((np (+ 2 (random 5)))
314 (pm (point-max))) 314 (pm (point-max)))
315 (while (< np pm) 315 (while (< np pm)
316(goto-char np) 316 (goto-char np)
317 (let ((prec (preceding-char)) 317 (let ((prec (preceding-char))
318 (props (text-properties-at (1- (point))))) 318 (props (text-properties-at (1- (point)))))
319 (insert (if (zerop (random 2)) 319 (insert (if (zerop (random 2))
320 (upcase prec) 320 (upcase prec)
321 (downcase prec))) 321 (downcase prec)))
322 (set-text-properties (1- (point)) (point) props)) 322 (set-text-properties (1- (point)) (point) props))
323(backward-char 2) 323 (backward-char 2)
324(delete-char 1) 324 (delete-char 1)
325(setq np (+ np (1+ (random 5)))))) 325 (setq np (+ np (1+ (random 5))))))
326 (goto-char (point-min)) 326 (goto-char (point-min))
327 (sit-for 0 2))) 327 (sit-for 0 2)))
328 328
@@ -334,9 +334,9 @@
334 (save-excursion 334 (save-excursion
335 (goto-char (window-start)) 335 (goto-char (window-start))
336 (while (< (point) (window-end)) 336 (while (< (point) (window-end))
337(when (looking-at "[\t ]*\\([^\n]+\\)") 337 (when (looking-at "[\t ]*\\([^\n]+\\)")
338 (setq ret (cons (cons (match-beginning 1) (match-end 1)) ret))) 338 (setq ret (cons (cons (match-beginning 1) (match-end 1)) ret)))
339(forward-line 1))) 339 (forward-line 1)))
340 ret)) 340 ret))
341 341
342(defun zone-pgm-rotate (&optional random-style) 342(defun zone-pgm-rotate (&optional random-style)
@@ -413,7 +413,7 @@
413(defun zone-fall-through-ws (c col wend) 413(defun zone-fall-through-ws (c col wend)
414 (let ((fall-p nil) ; todo: move outward 414 (let ((fall-p nil) ; todo: move outward
415 (wait 0.15) 415 (wait 0.15)
416 (o (point)) ; for terminals w/o cursor hiding 416 (o (point)) ; for terminals w/o cursor hiding
417 (p (point))) 417 (p (point)))
418 (while (progn 418 (while (progn
419 (forward-line 1) 419 (forward-line 1)
@@ -455,7 +455,7 @@
455 ((= i nl)) 455 ((= i nl))
456 (insert line))))) 456 (insert line)))))
457 ;; 457 ;;
458 (catch 'done; ugh 458 (catch 'done ;; ugh
459 (while (not (input-pending-p)) 459 (while (not (input-pending-p))
460 (goto-char (point-min)) 460 (goto-char (point-min))
461 (sit-for 0) 461 (sit-for 0)
@@ -541,8 +541,8 @@
541 mode-line-bg (face-attribute 'mode-line :background)) 541 mode-line-bg (face-attribute 'mode-line :background))
542 (set-face-attribute 'mode-line nil 542 (set-face-attribute 'mode-line nil
543 :foreground bg 543 :foreground bg
544 :background bg 544 :background bg
545 :box nil)) 545 :box nil))
546 546
547 (let ((msg "Zoning... (zone-pgm-stress)")) 547 (let ((msg "Zoning... (zone-pgm-stress)"))
548 (while (not (string= msg "")) 548 (while (not (string= msg ""))