;;; -*- mode:lisp;package:tv;base:10.; -*- ;;; ;;; **************************************************************** ;;; Gray Border code ;;; **************************************************************** ;;; Following is code to generate gray borders. ;;; This is a 2 by 32 bit array with alternating 1's and 0's. It is ;;; used to fill the borders. (defvar *gray-pattern* (fillarray (make-array '(32. 2) ':type 'art-1b) '(1 0 0 1 1 0 0 1 1 0 0 1 1 0 0 1 1 0 0 1 1 0 0 1 1 0 0 1 1 0 0 1 1 0 0 1 1 0 0 1 1 0 0 1 1 0 0 1 1 0 0 1 1 0 0 1 1 0 0 1 1 0 0 1))) (defun draw-gray-border (window alu left top right bottom) (bitblt alu (- right left) (- bottom top) *gray-pattern* 0 0 (send window ':screen-array) left top)) (putprop 'draw-gray-border 4. 'default-border-size)