;;; -*- Mode:LISP; Package:USER; Readtable:CL -*- (defvar alus (loop for sym in (apropos 'alu 'tv :boundp t :inherited nil :dont-print t) as val = (symbol-value sym) when (and(numberp val)(< val 8)) collect (cons sym (symbol-value sym)))) (defun test() (let((arr0 (tv:make-pixel-array 100 100 :type 'art-1b :initial-element 0)) (arr1 (tv:make-pixel-array 100 100 :type 'art-1b :initial-element 1)) (scr (send terminal-io :screen-array))) (flet((bb(from alu) (bitblt (let((alu (car alus))) ;;clear screen (send terminal-io :clear-screen) (send terminal-io :draw-char #\x 0 0) (bitblt tv:alu-andca 100 100 foo 0 0 (send terminal-io :screen-array) 0 0) ;;;magic BOOLE numbers ;(DEFCONSTANT TV:ALU-SETA 5 "Alu function for copying bits to destination.") ;(DEFCONSTANT TV:ALU-XOR 6 "Alu function for flipping bits in destination.") ;(DEFCONSTANT TV:ALU-ANDCA 2 "Alu function for clearing bits in destination.") ;(DEFCONSTANT TV:ALU-IOR 7 "Alu function for setting bits in destination.") ;(DEFCONSTANT TV:ALU-SETZ 0 "Alu function for setting bits in destination to zero.") ;(DEFCONSTANT TV:ALU-AND 1 "Alu function for anding.") ; 0 boole-clr == tv:alu-setz ; 1 boole-and == tv:alu-and ; 2 boole-andc2 == tv:alu-andca ; 3 boole-1 ; 4 boole-andc1 ; 5 boole-2 == tv:alu-seta ; 6 boole-xor == tv:alu-xor ; 7 boole-ior == tv:alu-ior ; 8 boole-nor ; 9 boole-eqv ; 10 ? ; 11 boole-orc2 ; 12 ? ; 13 boole-orc1 ; 14 boole-nand ; 15 boole-set ((TV:ALU-SETA . 5) (TV:ALU-XOR . 6) (TV::ALU-SETZ . 0) (TV:ALU-AND . 1) (TV:ALU-IOR . 7) (TV:ALU-ANDCA . 2))