LMFL#!C(:HOST "SYS" :BACKUP-DATE 2760032656. :SYSTEM-TYPE :LOGICAL :VERSION 1. :TYPE "LISP" :NAME "ROTATE" :DIRECTORY ("REL3-PUBLIC" "PUBLIC" "GRAPHICS-DEMO") :SOURCE-PATTERN "( :DIRECTORY (\"REL3-PUBLIC\") :NAME :WILD :TYPE :WILD :VERSION :NEWEST)" :CHARACTERS T :NOT-BACKED-UP T :CREATION-DATE 2753213809. :AUTHOR "REL3" :LENGTH-IN-BYTES 2988. :LENGTH-IN-BLOCKS 3. :BYTE-SIZE 8.)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                   ;;; -*- Mode:Common-Lisp; Package:DEMO; Lowercase:T; Base:10 -*-;;; Created 11/24/81 09:57:32 by CMB;;; Modified, moved to POINTER, and installed by DLW, 1/9/82;;; This rotate function was translated from Smalltalk.  It appeared in the August 1981;;; issue of Byte magazine.  The array must be square and a power of two bits on a side.;;; The direction of rotation will be clockwise.  To rotate a 512x512 bit array takes;;; about 5 seconds of solid bitblt time.  Rotate takes 2 + 15*log(N) bitblts.(defmacro copy-all-to (from xoffset yoffset to alu)  `(bitblt ,alu (- width ,xoffset) (- width ,yoffset) ,from 0 0 ,to ,xoffset ,yoffset))(defmacro copy-all-from (to xoffset yoffset from alu)  `(bitblt ,alu (- width ,xoffset) (- width ,yoffset) ,from ,xoffset ,yoffset ,to 0 0))(defun rotate (myself w)  (let* ((width (array-dimension myself 1)) (mask (make-array (list width width) ':type 'art-1b)) (temp (make-array (list width width) ':type 'art-1b)))    (copy-all-to mask 0 0 mask TV:ALU-SETZ)    (copy-all-from mask (floor width 2) (floor width 2) mask boole-set)    (do ((quad (floor width 2) (floor quad 2)))((< quad 1))      (copy-all-to mask 0 0 temp TV:ALU-SETA); 1      (copy-all-to mask 0 quad temp TV:ALU-IOR); 2      (copy-all-to myself 0 0 temp TV:ALU-AND); 3      (copy-all-to temp 0 0 myself TV:ALU-XOR); 4      (copy-all-from temp quad 0 myself TV:ALU-XOR); 5      (copy-all-from myself quad 0 myself TV:ALU-IOR); 6      (copy-all-to temp quad 0 myself TV:ALU-XOR); 7      (copy-all-to myself 0 0 temp TV:ALU-SETA); 8      (copy-all-from temp quad quad myself TV:ALU-XOR); 9      (copy-all-to mask 0 0 temp TV:ALU-AND); 10      (copy-all-to temp 0 0 myself TV:ALU-XOR); 11      (copy-all-to temp quad quad myself TV:ALU-XOR); 12      (copy-all-from mask (floor quad 2) (floor quad 2) mask TV:ALU-AND); 13      (copy-all-to mask quad 0 mask TV:ALU-IOR); 14      (copy-all-to mask 0 quad mask TV:ALU-IOR); 15      (funcall w ':bitblt tv:alu-seta width width myself 0 0 0 0))    (return-array (prog1 mask (setq mask nil)))    (return-array (prog1 temp (setq temp nil))))  myself)(defvar *rotate-source* nil)(defvar *rotate-size* 512)(defun run-rotate ()  (tv:window-call (*hof-window* :deactivate)    (with-real-time      (funcall *hof-window* ':set-label "Rotate")      (if (null *rotate-source*)  (setq *rotate-source* (make-array (list *rotate-size* *rotate-size*)    ':type 'art-1b)))      (funcall *hof-window* ':clear-screen)      (bitblt tv:alu-xor *rotate-size* *rotate-size* *rotate-source* 0 0 *rotate-source* 0 0)       (princ (documentation 'format) *hof-window*)      (funcall *hof-window* ':bitblt-from-sheet       tv:alu-seta *rotate-size* *rotate-size* 0 0 *rotate-source* 0 0)      (rotate *rotate-source* *hof-window*)      (funcall *hof-window* ':tyi))))(defdemo "Rotate" "A demonstration of an interesting algorithm for rotating a bit array."  (run-rotate))ry))  (second (car history))  (third (car history))  (fourth (car his