Lisp-Stat 翻译 —— 第八章 绘图窗体

第八章 绘图窗体

    Lisp-Stat提供的统计绘图其基础是由两个级别组成的。较低的级别将由本章描述，它提供了在窗体里绘制线与图形的工具，还有对用户动作产生的时间做出响应。第二级别，会在下一章描述，它增加了处理数据的能力。第二章里绘制的所有图形都是从下一章里描述的高级的原型里继承来的。如果你对定制一些标准图形感兴趣，你可以简略地浏览本章并移步下章内容。然而，尽管你不需要直接使用本章所述的细节，你也会发现理解支持高级绘图对象的基本的绘图模型是很有用的。

8.1 绘图模式

    在窗体里，通过改变图片元素也就是像素的颜色在窗体里绘制的对象叫图像。绘图模型提供了一个高级的，考虑绘图过程的统一框架。隐藏在Lisp-Stat绘图系统之下的绘图模型从本质上讲是Macintosh系统的QuickDraw模型的一个简化版本，再与SunView系统和X11系统的一些特征的组合。

8.1.1 坐标、绘图模式和颜色

    绘图窗体里的绘制操作发生在一个概念性的绘图画布里。该画布的维度可以是可变的也可以是固定的。如果维度可变，那么画布与窗体内容是相同的。如果维度是固定的，那么窗体仅展示了画布的子矩形视图。在这种情况下，可以通过使用滚动条将窗体固定到画布里。

    

图8.1 栅格显示器上的坐标系统

    在栅格显示器上，显示其上的最小单元叫像素，假设像素是正方形，因此它们的宽度自然成为测量屏幕长度的基本单元。当我们在屏幕上画一个点的时候，我们可以用来显示该点的最小显示方式就是一个像素。因为表示一个距离零点的实体点的数学语法是(x,y)，我们需要一个约定，用来关联像素与数学坐标系统。图8.1展示了一个叠加到像素点集上的坐标系统。对于一个绘图窗口，画布的左上角就是坐标系的原点。x轴(或者说横轴)以一个像素为单位向右增长；y轴(或者说纵轴)以一个像素为单位向下增长，这与通常的数学约定是相反的，但是这是在像素层面用来表示栅格图形的标准系统。使用左上角坐标，我们就可以饮用像素了。因此，像素(2,3)表示(2,3), (3,3), (3,4), (2,4)这4个顶点组成的矩形像素。

    每个像素都可以使用不同的颜色绘制。在单色显示器上，可用的颜色只有黑色和白色。在彩色显示器上其它颜色也是可用的。在大多数彩色显示器上，可用的颜色包括黑色、白色、红色、绿色、蓝色、青色、洋红色和黄色。初始情况下，窗体里所有像素的颜色是相同的，都是背景色。当你在窗体里绘图时，你可以将指定像素的颜色改变成要绘制的颜色。擦除操作指擦除指定对象，比如说矩形，将使用背景色代替组成对象的像素。涂色操作将使用绘图颜色代替对象的像素颜色。

    背景色和绘图色是绘图系统的状态，你可以在任何时间改变他们，新的颜色将一直有效直到你再次改变他们。改变当前背景色或者绘图色不会直接影响到任何像素。它只会对将来的绘图操作的结果又影响。每个窗体都有它自己的绘图状态集。

    绘图系统的另一个状态时绘图模式。绘图模式可以是正常模式和XOR(异或)模式中的一种。在正常模式里，对一个像素绘制操作的影响与该像素前一个颜色是独立的。在XOR(异或)模式里，对一个像素着色将反转像素的颜色。当绘制黑白颜色时，它是由良好定义的：如果像素是黑色，它将变成白色；如果像素是白色，它将变成黑色。在彩色绘图里该结果就是不可预测的了，但是即使在彩色显示器上，XOR模式也有如下特性：绘制一个对象两次，因此会反转组成它的对象两次，屏幕会恢复成它的原始状态。该特性使得XOR绘图成为一个有用的动画工具，因为它允许你再不需要强制保存和恢复背景的前提下，在背景上边移动一个对象。在Lisp-Stat绘图里，XOR绘图方法用来实现画刷矩形。

    绘图系统的最后两个状态时线类型和线宽。直线是使用画笔绘制的，画笔是方形像素集合，并与坐标轴平行，可视为从一个点移动到另一个点，将墨水描绘在它接触到的像素上。画笔的尺寸是由线宽指定的。画笔可以以不同的风格和类型绘图。画笔类型有两种：实线和虚线。

8.1.2 可绘图对象

    Lisp-Stat绘图系统提供了高级绘图程序，用来众多不同的对象，比如说矩形、字符和位图。

矩形、椭圆形和弧形

    一些基本的绘图程序可以处理矩形。矩形就是像素的直角集合，它们的边与屏幕边缘平行。矩形使用4个数的术语来指定：它的左上角的两个坐标，宽度，还有高。这四个数字就是一个矩形的坐标。矩形可以被擦除、涂色或者当做框架。当一个矩形被当做框架的时候，画笔将沿着矩形边缘的内侧运动。当前绘图模式和线型是可以使用。为矩形涂色就是将它的像素的颜色设置为绘图颜色；擦除矩形就是将它的像素的颜色设置为背景色。

    这里的椭圆形是指长轴和短轴都平行于坐标轴的椭圆。它们可以通过其包络矩形来指定。椭圆形的弧线由椭圆形的包络矩形和两个角度来指定，这两个角度是起始角度和增量。起始角度以横轴开始，向你始终方向为量度。增量就是从起始角度到弧度末端的角度，单位以度数制计。椭圆形和弧形也可以作为框架、可以涂色和删除。

多边形

    多边形是由整数对的列表指定的，表示多边形的顶点坐标。默认地，这些坐标被解释为相对于原点的绝对坐标。它们也可以解释成相对坐标，这种情况下坐标集的第二个元素表示与第一个元素的相对偏移量，第三个元素表示相对于第二个元素的相对偏移量，以此类推。多边形可以被框选、填充和擦除。对于填充和擦除操作，如果第一个点和最后一个点不相等的话，则在它们之间画一条弦。框选操作不会闭合一个多边形，如果你想框选一个闭合的多边形，你必须确保第一个和最后一个顶点是相等的。

符号、字符串和位图

    字符与点状符号是由位图构成的，即黑白像素的矩形集合。实例如图8.2。通过将那些位图叠加到窗口上来绘制字符。在正常的绘图模式下，在字符黑色部分下边的窗体像素将由绘图颜色上色，白色部分不变。在异或绘图模式下，黑色部分下的像素颜色反转。

    绘图符号是小位图对，一个用于高亮点，一个用于非高亮的点。在正常模式下用来绘制符号的规则与用来绘制字符的规则略有不同：在符号的白色区域的下边的窗体像素使用背景色进行上色，这确保了通过在老的符号上绘制一个新的符号的方式，将一个高亮的符号替换为一个非高亮的符号。Lisp-Stat提供的符号大小是不同的，它们可能是三个、四个或者五个像素宽度。

    符号位图是为了快速绘图而专心设计和实现的。你也可以使用0和1组成的二维数组来手工绘制矩形位图，这里的0表示白色，1表示黑色。位图影像也可以通过位图蒙版的方式来实现。只有那些与蒙版里相对应的像素才受绘图操作的影响。在正常绘图模式下，包含在蒙版里的影像的黑色像素使用绘图颜色来绘制，白色像素使用背景色绘制。对应使用蒙版的方式绘制字符的规则与字符影响是相同的；使用蒙版绘制符号的规则就是一个包裹符号影像的正方形。

8.2 绘图消息

8.2.1初始化和状态消息

    基础绘图常涉及到的原型是graph-window-proto，通过向该原型发送:new消息，可以创建新的窗体。该原型的:isnew方法不需要任何参数，但是可以提供标准的window关键字:title, :location, :size和:go-away，窗体的默认标题是"Graph Window"，go-away的默认值是t，还有一些其它的关键字也是可用的。使用:menu关键字可以创建带菜单的窗体，关键字:black-on-white, :has-v-scroll和:has-h-scroll用来设置初始化的绘图颜色和背景颜色，并且确定窗体是否有水平滚动条和垂直滚动条。默认地，绘图颜色是黑色，背景颜色是白色，窗体无滚动条。:isnew方法将在屏幕上显示一张图形，除非:show关键字的值为nil。表达式

> (setf w (send graph-window-proto :new))

构造了一个所有选项为默认设置的窗体。

    窗体的绘图心痛可以使用:back-color, :draw-color, :draw-mode, :line-width和:line-type消息来确定和设置。

> (send w :back-color)
WHITE
> (send w :draw-color)
BLACK
> (send w :draw-mode)
NORMAL
> (send w :line-width)
1
> (send w :line-type)
SOLID

    这些访问消息带一个可选参数用来设置新的状态，线宽必须是一个正整数，绘图模式指定为符号normal或者xor中的一个。我们刚刚创建的窗体的绘图模式可以使用下边的语句改变成xor模式，在改回normal模式：

> (send w :draw-mode 'xor)
XOR
> (send w :draw-mode 'normal)
NORMAL
> 

    线型可以指定为solid或者dashed，颜色可以是有color-symbols函数返回的列表中的符号中的任意一个，在黑白单色显示器上唯一可以使用的颜色是黑色和白色；在彩色显示器上可用的符号包括black, white, red, green, blue, cyan, magenta和yellow.

    色彩相关命令不会起任何作用，除非窗体正在使用彩色绘图，:use-color消息可以用来确定是否处于这种情况。通过分别给定一个可选参数true或者nil，它也可以用来指示窗体是否使用彩色。对于我们的窗体：

> (send w :use-color)
NIL

    初始情况下，窗体使用黑色和白色绘图。如果你的系统支持彩色，可以使用下面的表达式告诉窗体使用彩色绘图:

> (send w :use-color t)
T

在单色显示器上出白色以外的所有颜色都被当成黑色。

    消息:reverse-color偶尔是很有用的，它交替地改变当前绘图颜色和背景色，并且发送:redraw消息给窗体。

8.2.2 基础绘图消息

    为了在一个窗体里绘制一个单独的像素，你可以向窗体对象发送:draw-point消息，该消息带两个整型参数即该点的坐标。例如，下式用来将位置为(15,10)坐标位置的像素上色成绘图颜色：

> (send w :draw-point 15 10)
NIL

    为了绘制一条线，你可以向窗体对象发送一个带4个整型参数的:draw-line消息，直线开始点和结束点的x、y坐标值，表达式如下，它绘制了一条从(5,10)到(50,70)的直线：

> (send w :draw-line 5 10 50 70)
NIL

    矩形可以使用:fram-rect, :erase-rect和:paint-rect消息来绘制。这些消息都需要四个整形参数，即矩形左上角的x、y坐标，还有矩形的长与宽。下边的表达式绘制了一个宽度为100像素，高度为50像素的矩形图文框，它的左上角坐标正好是我们刚才画的哪条直线的终点。

> (send w :frame-rect 50 70 100 50)
NIL

    内接于矩形的椭圆形使用:fram-oval, :erase-oval和:paint-oval消息来绘制。这些消息需要四个整型参数来指定包络矩形。我们可以使用以下表达式将一个实心的椭圆形放置到矩形下侧10像素位置处：

> (send w :paint-oval 50 130 100 50)
NIL

    圆弧形可以使用:frame-arc, :paint-arc和:erase-arc消息来绘制。这些消息都需要6个参数，前四个参数是描述弧形所在的椭圆的包络矩形，剩下的两个参数是实数，用来指定弧形的开始和步进角度。一个开始角度为30°并在水平线之上增量为45°的弧形可以这样加到我们的窗体里：

> (send w :paint-arc 50 70 100 50 30 45)
NIL

    多边形可以使用:frame-poly, :paint-poly和:erase-poly来绘制。这些消息需要一个表示顶点的整型数值对列表的列表。默认地，这些坐标对会被解译成相对于原点的坐标。如果使用的可选参数的值为nil，那么除了第一个坐标之外其它坐标都是相对前一个点的相对坐标。我们可以使用:erase-poly在矩形上边绘制一个三角形：

> (send w :frame-poly '((50 50) (150 50) (100 10) (50 50)))
NIL

该表达式使用了绝对坐标，与其等价的相对坐标的表达式是这样的：

> (send w :frame-poly '((50 50) (100 0) (-50 -40) (-50 40)) nil)
NIL

这些绘图操作积累到一起的结果见图8.3。

图8.3 基础绘图窗口

    在大多数系统上，如果你使用另一个窗体覆盖窗体w，然后再移走，绘制的图形将消失——窗体没有记忆它的内容。第二章里描述的标准绘图函数重画了绘图内容，这样无论什么时候重新调整大小或者窗体遮盖部分重新露出来都会重绘。8.4节将描述如何确保在需要的时候，窗口会重画。

8.2.3 额外的消息

    窗体的全部内容可以通过向窗体发送:erase-window消息来擦除，为了擦除窗体内容，我们可以使用如下表达式：

> (send w :erase-window)
NIL

    与绘制一条定长度的直线不同，你可能想要绘制一条从窗体左上角到窗体中心的直线，为了做到这一点，你需要能够确定窗体画布的宽度与高度，:canvas-width和:canvas-height这两个消息将返回这些信息。该直线可以这样绘制：

> (let ((x (round (/ (send w :canvas-width) 2)))
        (y (round (/ (send w :canvas-height) 2))))
    (send w :draw-line 0 0 x y))
NIL

    :draw-string和:draw-string-up两个消息在窗体里水平地或者垂直地绘制一个字符串，这两个消息带一个字符串和两个整型数据为参数，这两个整型数代表字符串绘制点的x、y坐标。以下表达式在点(100,120)处绘制了字符串"Hello"。

    为了能够定位一个字符串相对于一个坐标刻度的位置，我们需要确定字符串的大小。:text-string消息带一个字符串为参数，并返回它是多少像素的宽度；:text-ascent消息不带参数，返回一个字符在窗体字体基线以上的最大上行高度（注：ascen上行高度：从原点到字体中最高，这里的高深都是以基线为参照线的，的字形的顶部的距离，ascent是一个正值），单位为像素；消息:text-descent返回相对基线以下的最小下行高度。那么下边的表达式将垂直地绘制一个字符串"World"，挨着字符串"Hello"的右侧。

> (let ((ta (send w :text-ascent))
        (tw (send w :text-width "Hello")))
    (send w :draw-string-up "World" (+ 100 ta tw) 120))
NIL

    很多情况下，你可以使用:draw-text消息绘制字符串而避免计算起始点，这个消息的方法带一个字符串和4个数字作为参数。前两个数字时一个点坐标，第三个数应该是0、1或2，分别表示字符串是否应该左对齐，居中对齐或右对齐，最后一个参数应该是0或1，表示字符串是否应该画在点的上边或下标。:draw-text-up消息与之相同，不过旋转90°。

    :draw-symbol消息在指定点绘制了一个符号，该符号使用两个参数指定，一个符号名和一个表示真假的标记，如果符号是高亮的，该标记就是true，否则为nil。符号名应该是由函数plot-symbol-symgols返回的类表的符号之中的一个，这个列表至少包含以下符号，dot, dot1, dot2, dot3, dot4, disk, diamond, cross, square, wedge1 wedge2和x。例如，以下两个表达式绘制了标准点状符号的常规版本和高亮版本，这些符号在第二章里用过了。

> (send w :draw-symbol 'disk nil 100 100)
NIL
> (send w :draw-symbol 'disk t 100 120)
NIL

    :replace-symboel消息在指定位置用另一个符号代替原有的符号。为了在(100,100)点处，用一个高亮的圆盘状符号代替一个常规的圆盘状符号，你可以使用如下表达式：

> (send w :replace-symbol 'disk nil 'disk t 100 100)
NIL

该表达式将检测在用新符号替换前是否有老符号要擦除。

    :draw-bitmap消息用来绘制位图，这个消息的方法需要3个参数：该位图和表示放置该位图的左上角坐标的两个整型数。位图本身应该是一个0、1矩阵。例如，下边的表达式将在窗体里绘制一个小十字。

> (send w :draw-bitmap
        '#2a((0 1 0) (1 1 1) (0 1 0)) 100 140)
NIL

:draw-bitmap消息也可能接收4个参数，即使用另一个位图矩阵作为蒙版。该矩阵的维度应该与影响位图的维度相同，默认蒙版是一个全1的矩阵。

练习 8.1

8.3 双缓冲和动画

    现在，我们开始看一下用来移动画刷通过图形或者旋转一个点云的技术了。这些技术叫做动画技术。可用的两个动画技术是异或绘图和双缓冲。

    让我们从异或绘图开始。那我们早前设置的窗体为例，下边的表达式将一个高亮的符号沿窗体对角线向下运动。

> (let ((width (send w :canvas-width))
        (height (send w :canvas-height))
        (mode (send w :draw-mode)))
    (send w :draw-mode 'xor)
    (dotimes (i (min width height))
             (send w :draw-symbol 'disk t i i)
             (send w :draw-symbol 'disk t i i))
    (send w :draw-mode mode))
NORMAL

    let语句里的变量绑定确定当前画布的大小，并且保存当前的绘图模式。代码里第一个表达式将绘图模式设置为xor（异或模式）；该设置持续有效直到它运行到代码底部重设为止。剩余语句是一个dotimes循环，该循环体包含两个相同的绘图表达式。第一条语句绘制这个符号，第二条语句再绘制一遍。因为绘图系统处于xor模式，第二条绘图命令的效果就是擦除了该符号。

    在一些系统里，本例中的动画可能运动得太快而很那见到，如果出现了这种情况，你可以向循环中的两条绘图命令之间插入一条pause表达式，比如(pause 2)。

    异或绘图对于简单对象通过一个简单的背景时是很有用的。然而，它确实有一些缺陷，随着大量动画技术的出现，这些缺陷降低了它的实用性：

• 如果背景包含很多项目，当绘制的对象移动并通过背景里的这些项目时，xor模式的倒置处理将会使正在绘制的对象变形。
• XOR绘图模式固有地引入了一定量的闪烁。在我们的例子中，当符号处于屏幕之上的时候，它花费了更多的时间在擦除符号上。
• 移动一些对象会导致一定量的变形，因为每次只能移动一个对象。
• 若果背景颜色不是黑色或者白色的话，XOR绘图模式里的倒置背景像素的概念就不是一个良好定义的行为。

无论如何，XOR绘图仍然是一个有用的技术，甚至在彩色显示器上，因为变成他自己的倒置这个属性是保持原状的。Lisp-Stat使用XOR模式绘图的两个目的：移动画刷和绘制点状标签。

    第二个动画方法是双缓冲。在双缓冲里，一个影像不在屏幕上，然后它被拷贝到屏幕上。只要这个拷贝的过程足够快，它将产生一个图像到另一个图像的无闪烁转换。为了支持双缓冲，绘图系统提供了一个独立的背景缓冲区，你可以将该缓冲区想象为在屏幕后边的另一个窗体，通过向窗体发送:start-buffering消息，你命令该窗体之前的所有的绘图消息放到该缓冲区里，:start-buffering方法将确保：当缓冲开始时，缓冲区的绘图系统的状态与窗体的状态时相同的。当缓冲开始起作用的时候，传递给窗体的状态改变指令对窗体和缓冲区都会有影响。绘图操作只影响缓冲区。当你结束在缓冲区中的绘图时，你可以将绘制的图像传递给窗体，并且通过向窗体发送:buffer-to-screen消息来关闭缓冲。

    下标的表达式是通过双缓冲的方法将一个符号沿窗体对角线向下移动的动画：

> (let ((width (send w :canvas-width))
        (height (send w :canvas-height)))
    (dotimes (i (min width height))
             (send w :start-buffering)
             (send w :erase-window)
             (send w :draw-symbol 'disk t i i)
             (send w :buffer-to-screen)
             (pause 2)))
NIL

    需要擦除消息来清理缓冲区的前一个符号。使用双缓冲，符号移动得更慢了，但是因为事实上没有了闪烁，看起来移动得更平滑了。

    :buffer-to-screen消息也可以接受一个矩形的坐标作为参数， 然后它只从缓冲区里将指定的矩形区域拷贝到屏幕上。例如，如果你想改变图形的内容而不改变坐标轴，这个功能就很有用了。

    如果你接连发送两次:start-buffering消息，而在两次发送之间没有将缓冲区拷贝到屏幕上，影响就是增加了一个缓冲区计数，发送:buffer-to-screen消息将递减该计数，仅当当计数达到0时才将缓冲区拷贝到屏幕上。如果你依据另一个方法（可能用到也可能没用到这个缓冲区）编写了一个方法的话，这个功能是很有用的。例如，标准散点图使用:redraw消息可以用来重画整个图形，或者使用:redraw-content消息来重画图形的内容，这两种重画都要用到缓冲区，:redraw方法是依据:redraw-content消息和代码来重画坐标。

    当你调试一个图形算法的时候，你可以将自己置于一个这样的状态，在那里你不知道窗体是不是一个缓冲区，函数reset-graphics-buffer关闭所有缓冲区，同时将缓冲区计数设置为0。发生错误或者中断而返回到顶层也会重置缓冲区。

    每次只能有一个窗体使用该缓冲区。

练习 8.2

略。

8.4 响应事件

    到目前为止，我们可以直接从解释器控制我们的图形窗口。换句话说，第二章里描述的图形能够响应它们自己的鼠标动作，能够重画和重新定义大小，等等。为了允许窗体响应用户产生的事件，当发生一个需要来自窗体的响应的事件时，绘图系统将向每一个窗体对象发送一个消息。

    通过重新改变大小或者露出窗体而产生的事件，明显与特定窗体有关；换句话说，由鼠标或键盘动作产生的事件可以根据一些不同的规则分配给各窗体。接受这些事件的窗体叫做焦点窗体，为了确定焦点窗体，不同的用户界面遵循不停的惯例。有的接口假定焦点窗体就是包含光标的窗体，其它的则需要一个被强制设置为当前窗体，例如通过点击该窗体。Lisp-Stat将确定焦点窗体的规则交给本地窗体系统。该窗体系统的接口负责将相应的用户动作发送给合适的窗体对象。

8.4.1 重定义及露出窗体

    在窗体被用户重新定义大小之后，系统首先要向窗体对象发送:resize消息，然后，再向窗体发送:redraw消息。窗体模糊的部分重新露出以后也会向窗体发送:redraw消息。通过响应这些消息，当窗体改变大小，其它窗体出现、消失和在它周围移动时，该窗体都可以保持它的影像不变。

    举个例子，让我们拿先前创建的试图在其中心一个高亮的符号的那个窗体来说，我们可以通过只是用:redraw消息的方式来实现，但是为了获得更多的实践，让我们使用:redraw和:resize消息。首先，我们可以添加两个槽来放置符号位置的坐标：

> (send w :add-slot 'x (/ (send w :canvas-width) 2))
125
> (send w :add-slot 'y (/ (send w :canvas-height) 2))
125.5

然后定义这两个槽的读取方法：

> (defmeth w :x (&optional (val nil set))
    (if set (setf (slot-value 'x) val))
    (slot-value 'x))
:X
> (defmeth w :y (&optional (val nil set))
    (if set (setf (slot-value 'y) val))
    (slot-value 'y))
:Y

接下来，我们可以定义一个:resize消息，无论窗体何时更新都会更新这些槽：

> (defmeth w :resize ()
    (send self :x (/ (send self :canvas-width) 2))
    (send self :y (/ (send self :canvas-height) 2)))
:RESIZE

最后，:redraw方法使用这些槽里的信息绘制符号：

> (defmeth w :redraw ()
    (let ((x (round (send self :x)))
          (y (round (send self :y))))
      (send self :erase-window)
      (send self :draw-symbol 'disk t x y)))
:REDRAW

round函数是必须的，因为传递给:draw-symbol消息的参数必须是整型数据。

    这是所有标准绘图需要使用的基本方法：当窗体改变大小时，窗体的大小基本信息将确认并保存，然后当需要的时候，重画消息将获得此信息。

    当创建一个新的窗体的时候，首先发送一个:resize消息，然后发送一个:redraw消息。因此，在窗体第一次绘制之前，你可以依赖于:resize调用。

练习 8.3

略。

8.4.2 鼠标事件

    鼠标事件有两种类型：移动事件和点击时间。当鼠标移动并且绘图窗口是焦点窗口时，绘图系统向窗体发送:do-motion消息，该参数带两个整型参数，鼠标新位置的x与y坐标值。例如，我们可以定义一个:do-motion方法，该方法在鼠标移动的时候，使一个符号跟随着鼠标位置的移动而移动。这样的方法定义如下：

> (defmeth w :do-motion (x y)
    (send self :x x)
    (send self :y y)
    (send self :redraw))
:DO-MOTION

与每次鼠标移动一次就调整一次符号位置不同，仅仅响应鼠标点击事件时才调整符号可能更好些，可以通过首先移除:do-motion方法的方式来完成：

> (send w :delete-method :do-motion)
T

    然后，再定义一个:do-click方法。无论何时发生鼠标点击事件，系统都会向焦点窗体发送:do-click消息，它带4个参数，前两个参数是整型数，鼠标点击位置的x与有坐标，剩下的两个参数是t或者nil，表示两个修改符的状态。第一个修改符是扩展修改符，第二个是选项修改符。用来发送这些修改符的方法依赖特殊的用户接口。在Macintosh系统上它们分别对应的是按下shift键和option键。对于我们的例子，响应一次点击时间来调整符号位置的方法可以这样定义：

> (defmeth w :do-click (x y m1 m2)
    (send self :x x)
    (send self :y y)
    (send self :redraw))
:DO-CLICK

    我们已经见过两种将一个对象定位到窗体的方法，第一种是在鼠标移动时跟踪鼠标，第二种是将对象移动到当鼠标点击的位置。很多情况下，通过允许鼠标拖拽时持续地移动对象，将这两种方法组合使用是很有用的（比如按下鼠标时进行移动）。为了允许鼠标按下时执行一个动作，你可以在:do-click消息体里向窗体对象发送:while-button-down消息，该消息需要一个参数，是一个函数，同时它也接受一个额外的可选参数。如果该可选参数是t（t是其默认值），那么当鼠标按下时，鼠标每移动一下函数就被调用一次。如果该可选参数是nil，函数将持续调用，直到鼠标释放为止。该函数参数应该有两个参数，鼠标当前位置的x与y坐标。当鼠标释放的时候，:while-button-down消息对应的方法返回。

    为了使拖拽在我们的例子里具体化，我们可以重新定义:do-click方法：

> (defmeth w :do-click (x y m1 m2)
  (flet ((set-symbol (x y)
                     (send self :x x)
                     (send self :y y)
                     (send self :redraw)))
    (set-symbol x y) (send self :while-button-down #'set-symbol))) :DO-CLICK

对局部函数set-symbol的首次调用将保证首次点击时将符号移动到鼠标点击的位置。

    因为在这个定义里:while-button-down消息使用不带可选参数的形式，set-symbol函数仅当鼠标按下时移动才会调用。如果最后一个表达式替换成小标的形式，那么set-symbol函数甚至在鼠标不动的时候都会被调用。

(send self :while-button-down #'set-symbol nil)))

在很多系统上，当鼠标按下时，这将导致符号的快速闪烁。持续调用一个函数的能力对于实现一个按键操作是很有用的，该按键操作在按下时会引起一个动作发生。Lisp-Stat里的旋转图形的旋转控制按钮就是这么实现的。

    与拖拽一个完整的对象不同，有时最好是拖拽一个对象的外接矩形。:drag-grey-rect消息使用XOR绘图模式在窗体上拖拽一个矩形，该消息需要四个参数：鼠标当前位置的x与y坐标，矩形的宽度与长度。它将绘制一个虚线矩形，然后对鼠标动作做出反应，直到鼠标释放。当鼠标释放的时候，该方法从屏幕上移除该虚线矩形，并返回最终矩形坐标的列表。为了在我们的例子里使用这个消息，我们可以这样定义:do-click方法：

> (defmeth w :do-click (x y m1 m2)
    (let ((xy (send self :dray-grey-rect x y 5 5)))
      (send self :x (+ 3 (first xy)))
      (send self :y (+ 3 (second xy)))
      (send self :redraw)))
:DO-CLICK

该定义使用一个宽度为5个像素的正方形，在符号所在的矩形内每个坐标中心都加上3.

    默认地，:drag-grey-rect方法将鼠标光标放置在矩形的右下侧，你可以提供两个表示偏移量（即矩形右边和下边相对鼠标位置的像素数值）的额外的整型参数给方法。因此下式将光标置于矩形的中心。

(send self :drag-grey-rect x y 5 5 3 3)

    我们可以多增加一个变量到我们的例子中，重定义:do-click方法如下：

> (defmeth w :do-click (x y m1 m2)
    (let ((cursor (send self :cursor)))
      (send self :cursor 'finger)
      (let ((xy (send self :drag-grey-rect x y 5 5)))
        (send self :x (+ 3 (first xy)))
        (send self :y (+ 3 (second xy)))
        (send self :redraw))
      (send self :cursor cursor)))
:DO-CLICK

当符号拖拽的时候，这导致光标变成一个有一根手指头的手型。可用的光标列表可以通过:cursor-symbols函数来返回，它应该包含arrow, brush, hand和finger。每个图形窗体都会保留一个使用的光标，无论何时，只要窗体焦点窗体同时鼠标在窗口之上。在一些简单的例子里，不需要改变光标。但是如果一幅图形在不同的绘图模式里，那么给用户一个光宇当前模式的可视化暗示就很重要了。所有标准的Lisp-Stat图形都可以存在于两种模式之中，刷模式和选择模式。另外，第九章里的一些例子将告诉你如何向图形里添加新的模式。多个可用模式很容易让人费解，为每个模式使用不同的光标可以减少这种费解。

练习 8.4

略。

连写 8.5

略。

8.4.3 键盘事件

    当敲击一个键，并且当前绘图窗体是焦点窗体的时候，那么将向该窗体发送:do-key消息，该消息带3个参数。第一个参数是对应敲击的键值的Lisp字符，剩下的两个参数是调节器，用来表示当键被敲击的时候，是否有shift、option或control等键被按下。

    对于我们的例子，我们可以定义一个:do-key方法，该方法将符号向上、下、右或左移动，分别对应的按下u, d, r,或者l按键。与预先设定的固定步进长度不同，最好是增加一个槽和一个对应的读取方法：

> (send w :add-slot 'step-size 10)
10

> (defmeth w :step-size (&optional (val nil set))
    (if set (setf (slot-value 'step-size) val))
    (slot-value 'step-size))
:STEP-SIZE

通过指定一个量来移动符号的方法，可以这样定义：

> (defmeth w :move (x y)
    (send self :x (+ x (send self :x)))
    (send self :y (+ y (send self :y)))
    (send self :redraw))
:MOVE
> 

使用这两个方法，:do-key方法可以这样定义：

> (defmeth w :do-key (c m1 m2)
    (let ((step (send self :step-size)))
      (case c
        (#\u (send self :move 0 (- step)))
        (#\d (send self :move 0 step))
        (#\r (send self :move step 0))
        (#\l (send self :move (- step) 0)))))
:DO-KEY

通过将case语句里的#\u这样的键形式替换成(#\u #\U)列表，我们可以同时使用大小写字符。

8.4.4 空闲操作

    通过按下带扩展调节器的控制键，Lisp-Stat选择图形操作可以指示图形持续旋转。这可以通过针对这些图形对象来指示系统使能ldling来实现。当ldling对于绘图窗体为使能状态时，系统每次从其时间循环里发送一次:do-idle消息给绘图窗体。

    :idle-on消息用来确定idling是否使能并使能之。不带参数的情况下，如果idling是使能的它将返回t，未使能则返回nil；在带一个参数的情况下，如果参数为ture则使能idling状态，如果是nil则关闭使能。为了避免idle功能失去控制，如果在idle动作里发生一个错误，idling将自动取消使能。

    为了继续我们的例子，我们可以使用:do-idle方法使重提里的符号随机移动，每次调用使选择向各个方向移动的可能性都是1/4。使用为:step-size和:move定义的方法，:do-idle方法可以这样编写：

> (defmeth w :do-idle ()
    (let ((step (send self :step-size)))
      (case (random 4)
        (0 (send self :move 0 (- step)))
        (1 (send self :move 0 step))
        (2 (send self :move step 0))
        (3 (send self :move (- step) 0)))))
:DO-IDLE

random函数带一个整型数据n为参数，返回一个随机均匀的从0到n-1的整数中的一个。以下表达式是开始随机遍历和停止遍历：

> (send w :idle-on t)
T

> (send w :idle-on nil)
NIL

练习 8.6

略。

练习 8.7

略。

8.4.5 菜单

    每个绘图窗体都提供一个支持想自己加入一个菜单的支持。引起菜单表示的特定的行为以来特定的窗体系统和用户接口。在XLISP-STAT的Macintosh版本里，当窗体是激活状态时，绘图窗体的菜单是安装在菜单栏的。在X11版本里，通过在窗体顶端按下一个菜单按钮来使菜单弹出。

    为了在一个绘图窗体里加入一个菜单，你可以向该窗体对象发送:menu消息，它的菜单式就是菜单自身；参数为nil将会使菜单从当前窗体移除；如果不带参数，该消息将返回窗体的当前菜单。

    对于我们的窗体w，这个实现了一个简单的随机遍历模拟器的窗体，能有一个菜单使遍历从窗体中心开始，并能允许打开和关闭遍历功能，这可能是很有用的。重启窗体的方法可以这样定义：

> (defmeth w :restart ()
    (send self :x (/ (send self :canvas-width) 2))
    (send self :y (/ (send self :canvas-height) 2))
    (send self :redraw))
:RESTART

发送消息的菜单对象可以这样给定：

> (setf restart-item
        (send menu-item-proto :new "Restart"
              :action #'(lambda () (send w :restart))))
#<Object: 13980f0, prototype = MENU-ITEM-PROTO, title = "Restart">

开始和停止遍历的菜单项这样给定：

> (setf run-item
        (send menu-item-proto :new "Run"
              :action
              #'(lambda ()
                  (send w :idle-on (not (send w :idle-on))))))
#<Object: 1396f50, prototype = MENU-ITEM-PROTO, title = "Run">

这个菜单项控制空闲的开与关。更新方法保证当遍历打开时，芥菜单项包含一个复选记号：

> (defmeth run-item :update ()
    (send self :mark (send w :idle-on)))
:UPDATE

最后，下边的表达式构造并安装菜单：

> (setf menu (send menu-proto :new "Random Walk"))
#<Object: 13a493c, prototype = MENU-PROTO, title = "Random Walk">
> (send menu :append-items restart-item run-item)
NIL
> (send w :menu menu)
#<Object: 13a493c, prototype = MENU-PROTO, title = "Random Walk">

    通过向菜单发送:popup消息，也可能响应一个鼠标事件来弹出一个菜单。这个消息的方法需要两个参数，表示菜单显示的点位的坐标值。默认地，这些坐标被解释成是相对于屏幕原点的，但是如果使用了额外的可选参数，那么该坐标被认为是相对于窗体内容的左上角坐标的。因此，下式定义了一个:do-click方法，在鼠标点击的位置将弹出窗体菜单。

8.5 额外的特性

8.5.1 画布维度

    窗体的画布是一个矩形区域，其坐标系统的原点在其左上角。画布的宽度与高度可以使固定的也可以是可变化的。如果是可变化的，它的宽度与高度与窗体内容的宽度与高度是相等的。对于一个新窗体，这个是默认的。为了给定窗体一个固定的宽度，你可以向窗体发送一个:has-h-scroll消息，其参数要么是t要么是一个正整数。整数用做画布的固定宽度，并且安装一个滚动条。固定画布的高度使用:has-v-scroll消息。可以给定:has-h-scroll和:has-v-scroll消息nil作为参数以使宽度和高度可变。调用不带参数的消息，如果当前的维度是固定的它们返回t，如果它是可变的就返回nil。对于绘图窗体原型，画布的宽度和高度的值可以这样指定，向该原型的:isnew方法传递:has-h-scroll和:has-v-scroll关键字。

    当一个维度是固定的时候，图形窗体为那个维度包含一个滚动条，这些滚动条可以用来定位画布里的窗体。你也可以通过向窗体对象发送带两个参数的:scroll消息来定位窗体，窗体的左上角坐标在画布坐标系内。:scroll消息也可以以不带参数的形式发送，以左上角当前坐标的列表。当前窗体矩形的坐标可以使用:view-rect消息获取。

    在大多数用户接口里滚动条都允许两种形式的滚动，一次滚动一行和一次滚动一页。默认地，行滚动每次滚动一个像素，页滚动每次滚动5个像素。你可以使用:h-scroll-incs和:v-scroll-incs消息来改变这些值。不带参数和带两个参数，行和页都递增。不带参数则返回一个当前增量的列表。

    固定画对于在一个小屏幕上检测一个散点图或者散点图矩阵是很有用的。它们不会用于标准图形的默认设置里，除非是在name-list图形里。但是所有的图形都允许附加的滚动条，它是通过图形菜单的Option...对话框设置的。

8.5.2 剪切

    有时候，能够将绘图约束到窗体的一个子矩形里，而不需要直接地强制性地检测每一个绘图动作的参数。这可以通过设置一个剪切矩形来完成。:clip-rect消息是用来设置这样的矩形的，它的参数可能是矩形的四个坐标，或者是nil值以关闭剪切功能。它返回当前剪切矩形左边的列表或者返回nil。也可以不使用任何坐标来调用该消息，目的是返回当前的剪切状态而不改变剪切消息。

    如果设置了剪切矩形，当窗体大小改变时，该剪切矩形不会自动改变大小，你不得不在你自己的:resize方法里调整它。

8.5.3 保存图形

    Lisp-Stat实现里应该提供一个将图形里的图像保存成文件的方法。在Macinton系统的XLISP-STAT版本里，Edit菜单里的Copy命令式可用的，它向窗体发送:copy-to-clip消息，目的是将图形拷贝到剪切板。在SunView系统和X11系统的版本里，可以向窗体对象发送:save-image消息，该消息的方法可以使用绘图窗体的:redraw方法来构造要保存的图像，如果:redraw方法不能重构当前图像的话它就不能合理地工作。

8.5.4 增加新的颜色

    Lisp-Stat系统可用的颜色可通过符号来识别，比如符号red和green。典型的颜色系统至少支持black, white, red, green, blues, cyan, magenta和yellow。你也可以使用color-symbols函数来获取可用颜色的列表。你也可以通过使用make-color函数要求系统生成一个新的可用的颜色，该函数带四个参数，为新颜色命名的符号和在[0, 1]范围内的三个实数，用来表示在颜色的RGB表示法里红绿蓝三色的贡献率。

    在今天的一些颜色工作站里，颜色是一个稀缺资源。在不同时间可以显示的不同颜色的数量是十分巨大的，大概有几百万中，但是可以在同一时刻显示的颜色数量一般仅有256种，也许甚至只有16种。结果，系统可能无法分配给你一个你请求色颜色。在这种情况下可能会发生一个错误信号，或者系统肯恩分配一个这样的颜色，分配给你一个和你需要的颜色极其相近的颜色。

    当你不再需要某个你使用make-color函数分配的颜色的时候，你可以使用free-color函数释放它。该函数只带一个参数，你要释放的那个颜色的符号。试图使用一个已经释放的颜色会引发一个错误。你可以使用make-color重定义一个颜色而不需要释放前边定义的颜色。

8.5.5 增加新光标

    在Lisp-Stat里，你可以向提供的实现里添加新的光标。make-cursor函数需要两个必需参数和三个可选参数。第一个参数是一个用来命名该光标的符号。接下来的两个参数是两个位图，它们是由0和1组成的二维数组，它们大小相等。第一个位图是光标的影像；第二个是光标的遮罩。影像里的每一个1都是用前景色绘制的，通常是黑色，每一个0都用背景色绘制，通常是白色，提供遮罩位图里有的响应的元素。遮罩里为0的像素不受映像。如果没有使用遮罩，遮罩层可以当做是全1的。最后两个可选参数是整型数，描述光标的热点的坐标，即图像里与鼠标位置相关联的点。默认的热点是左上角。

    今天大多数使用中的工作站都使用由16X16的位图构造的光标。有的工作站可能允许其它尺寸的光标。best-cursor-size函数返回了系统首选图标的宽度和高度的列表。该函数也可以只传递两个整型参数，然后返回与这两个参数表示的光标的宽度和高度最接近的一个光标。系统可能对不是最优尺寸的光标进行裁剪或扩张。

    cursor-symbols函数返回可用光标的列表。free-cursor接受一个光标符号为参数然后释放与之相关联的光标。试图使用一个已经释放的光标会引发一个错误。你也可以通过不释放前一个定义的光标，使用make-cursor函数来重定义这个光标。

8.6 一个例子

    作为一个例子，针对一个简单的位图构造器，我们可以使用绘图窗体原型作为基础。该想法是通过黑色和白色方块或者矩形来表示位图，黑色代表1，白色代表0。在方块里点击鼠标将该表位图数组里对应的实体，从0改成1，或者从1改成0，然后更新屏幕。

    为了开始之，让我们定义一个原型，该原型包含一个针对位图的槽，还包含两个处理显示在窗体的矩形网格的横轴和纵轴坐标的两个槽。

> (defproto bitmap-edit-proto
    '(bitmap h v) nil graph-window-proto)
BITMAP-EDIT-PROTO

:is-new方法应该需要两个整型参数，位图的宽度与高度：

> (defmeth bitmap-edit-proto :isnew (width height)
    (call-next-method)
    (setf (slot-value 'bitmap)
          (make-array (list height width) :initial-element 0)))
:ISNEW

我们还需要这三个槽的读取函数，它们这样定义：

> (defmeth bitmap-edit-proto :bitmap () (slot-value 'bitmap))
:BITMAP
> (defmeth bitmap-edit-proto :v () (slot-value 'v))
:V
> (defmeth bitmap-edit-proto :h () (slot-value 'h))
:H

矩形坐标可以设置到:resize方法里：

> (defmeth bitmap-edit-proto :resize ()
    (let ((m (array-dimension (send self :bitmap) 0))
          (n (array-dimension (send self :bitmap) 1))
          (height (send self :canvas-height))
          (width (send self :canvas-width)))
      (setf (slot-value 'v)
            (coerce (floor (* (iseq 0 m) (/ height m)))
                    'vector))
      (setf (slot-value 'h)
            (coerce (floor (* (iseq 0 n) (/ width n)))
                    'vector))))
:RESIZE

坐标保存为矢量格式，目的是可以快速随机获取它们的元素。

    为了绘制一个特定的位图矩形，一个方法给定如下：

> (defmeth bitmap-edit-proto :draw-pixel (i j)
    (let* ((b (send self :bitmap))
           (v (send self :v))
           (h (send self :h))
           (left (aref h j))
           (right (aref h (+ j 1)))
           (top (aref v i))
           (bottom (aref v (+ i 1))))
      (send self (if (= 1 (aref b i j)) :paint-rect :erase-rect)
            (left top (- right left) (- bottom top)))))
:DRAW-PIXEL

方法里的if表达式选择合适的消息选择器符号来使用，:paint-rect用来绘制该像素，:erase-rect用来擦除它。:redraw方法可以仅擦除窗体，然后为位图数组的每个元素发送一次:draw-pixel消息：

> (defmeth bitmap-edit-proto :redraw ()
    (let* ((b (send self :bitmap))
           (m (array-dimension b 0))
           (n (array-dimension b 1))
           (width (send self :canvas-width))
           (height (send self :canvas-height)))
      (send self :start-buffering)
      (send self :erase-rect 0 0 width height)
      (dotimes (i m)
               (dotimes (j n)
                        (send self :draw-pixel i j)))
      (send self :buffer-to-screen)))
:REDRAW

    为了支持鼠标点击方法，我们可以定义一个这样的方法：它带一个坐标对为参数，确定对应像素的位置，在位图数组里转置该值，然偶重画它的图像：

> (defmeth bitmap-edit-proto :set-pixel (x y)
    (let* ((b (send self :bitmap))
           (m (array-dimension b 0))
           (n (array-dimension b 1))
           (width (send self :canvas-width))
           (height (send self :canvas-height))
           (i (min (floor (* y (/ m height))) (- m 1)))
           (j (min (floor (* x (/ n width))) (- n 1))))
      (setf (aref b i j) (if (= (aref b i j) 1) 0 1))
      (send self :draw-piel i j)))
:SET-PIXEL

图8.4 一个简单的位图编辑器

然后，:do-click方法简化为：

> (defmeth bitmap-edit-proto :do-click (x y m1 m2)
    (send self :set-pixel x y))
:DO-CLICK

    现在我们可以为一个 16X16的位图构造一个位图编辑器：

> (setf w (send bitmap-edit-proto :new 16 16))

在一些鼠标点击结果可能好图8.4很像。

    这个例子上的多数变量是可能的，为了将位图分配给一个全局变量，我们可能需要将配位图而增加一个方法：

(defmeth bitmap-edit-proto :name-bitmap ()
    (let ((str (get-string-dialog "Symbol for the bitmap;")))
      (if str 
          (let ((name (with-input-from-string (s str) (read s))))
            (setf (symbol-value name) (send self :bitmap))))))
:NAME-BITMAP

如果OK按钮被点击那么get-string-dialog返回一个字符串，然后with-input-from-strin允许read函数使用标准读取惯例，来解压第一个实体。尤其地，该操作在构造符号之前，将名字转化为大写字母。

    另一个有用的方法可能是这样的：安装当前位图作为窗体光标。

> (defmeth bitmap-edit-proto :bitmap-as-cursor (yes)
    (if yes (make-cursor 'temp-cursor (send self :bitmap)))
    (send self :cusor (if yse 'temp-cursor 'arrow)))
:BITMAP-AS-CURSOR

如果我们通过提供一个有菜单的进行读取的，所有这些方法将很容易使用。我们可以为我们的窗体定义一个菜单：

> (setf bitmenu (send menu-proto :new "Bitmap"))
#<Object: 14ff1f4, prototype = MENU-PROTO, title = "Bitmap">

> (setf name-item 
        (send menu-item-proto :new "Name Bitmap..."
              :action #'(lambda () (send w :name-bitmap))))

还有：

> (setf cursor-item
        (send menu-item-proto :new "Use as Cursor"
              :action
              #'(lambda ()
                  (let ((mark (send cursor-item :mark)))
                    (send w :bitmap-as-cursor (not mark))
                    (send cursor-item :mark (not mark))))))
#<Object: 150a8e0, prototype = MENU-ITEM-PROTO, title = "Use as Cursor">

cursor-item的动作函数action使用项的复选标记，目的是跟踪位图或箭头当前状态下是否正在使用，其表达式是：

> (send bitmenu :append-items name-item cursor-item)

和

(send w :menu bitmenu)

它们将把菜单项安装到菜单里，将菜单安装到窗体里。

练习 8.8
略。

练习 8.9
略。