;;; -*- Mode:Common-Lisp; Package:USER; Fonts:(MEDFNT HL10B HL12BI); Base:10 -*- ;;; RESTRICTED RIGHTS LEGEND ;;;Use, duplication, or disclosure by the Government is subject to ;;;restrictions as set forth in subdivision (b)(3)(ii) of the Rights in ;;;Technical Data and Computer Software clause at 52.227-7013. ;;; ;;; TEXAS INSTRUMENTS INCORPORATED. ;;; P.O. BOX 2909 ;;; AUSTIN, TEXAS 78769 ;;; MS 2151 ;;; ;;; Copyright (C) 1987,1988 Texas Instruments Incorporated. All rights reserved. 1;;; ;;; This file contains Lisp forms that demonstrate how to use the graphics window system. To execute the examples, evaluate or compile the Lisp forms ;;; from a Zmacs buffer. Instructions for evaluating and compiling will appear immediately before the form. Note that little error checking is included ;;; in these forms, so that the essential code is not obscured. ;;; ;;; This same code can be executed on either Monochrome or Color Explorers. Color names (e.g. w:green, w:red, w:50%-gray-color) get mapped to ;;; gray patterns on monochrome systems. ;;; 2;;; ** 2Step* 21: * 2Creating a Graphics Window 1;;; ;;; This form splits the screen between a graphics window and this Zmacs** 1window. They will be nonoverlapping so that both windows can be exposed ;;; and drawn on at the same time. ;;; ;;; To evaluate this form, first click middle over the opening parenthesis to select the form, and then evaluate it by pressing CTRL-SHIFT-E. ;;;* (LET ((zmacs (w:sheet-superior w:selected-window))) (MULTIPLE-VALUE-BIND (left top right bottom) (SEND (w:sheet-superior zmacs) :edges) 1 ;; ;; Send a message to the Zmacs window to resize it. ;;* (SEND zmacs :set-edges left (- bottom 391.) right bottom) 1 ;; ;; Create a graphics window and set the global symbol window to point to it. ;;* (setq window (make-instance 'gwin:graphics-window :bottom (- bottom 391.) :left left :right right :top top :expose-p t))) 1 ;; ;; Set the global variable world to point to the world for the newly created graphics ;; window.* 1 ;;* (setq world (SEND window :world))) 2;;; Step 2: Defining a Graphics Object 1;;; ;;; The next form adds a graphics object to the world that is displayed in this window. The rectangle will start at the point (650., 10.). ;;; The width of the rectangle will be 300., and the height will be 200. The thickness of the edge will be 6. The edge will be black, and the ;;; interior will be filled with 33% gray. ;;; ;;; Note that the rectangle will not be drawn into the window by this form. ;;; ;;; To evaluate following form, select the opening parenthesis with the middle mouse button, and then press CTRL-SHIFT-E. ;;;** (SEND world :insert-rectangle 650. 10. 300. 200. 6. w:green w:yellow) 2;;; Step 3: Displaying a Graphics Object 1;;; ;;; Nothing has appeared in the window. The preceding form only inserted the rectangle into the world; drawing the rectangle into the window ;;; is done in a separate step. The following form draws the object into the window by refreshing the window. ;;; ;;; To evaluate the form, click middle on the opening parenthesis, and then press CTRL-SHIFT-E. ;;;** (SEND window :refresh) 2;;; Step 4: Creating a Polyline with Filled Interior 1;;; ;;; This form creates and draws a polyline object that has a filled interior. Instead of sending the window a refresh message, the polyline object ;;; is drawn by sending it a :draw message after it is created. ;;; ;;; Select the form by clicking middle over the opeing parenthesis, and then evaluate it by pressing CTRL-SHIFT-E. ;;;** (SEND (SEND world :insert-polyline '(60. 150. 100. 200. 250. 300. 400. 330. 220. 200. 60.) '(210. 150. 100. 10. 110. 20. 100. 200. 130. 180. 210.) t 4. w:red w:cyan) :draw window) 2;;; Step 5: Creating Other Primitive Objects 1;;; ;;; The following form creates the other types of primitive objects and displays them in the window. ;;; ;;; Select the opening parenthesis with the middle mouse button and evaluate the form with CTRL-SHIFT-E. ;;;** (PROGN (SEND world :insert-circle 70. 290. 50. 2. w:purple w:blue-green) (SEND world :insert-line 150. 300. 200. 300. 2. w:magenta) (SEND world :insert-arc 275. 290. 275. 340. 220. 2. w:light-brown w:white) (SEND world :insert-spline '(425. 428. 425. 416. 425. 440. 425. 404. 425. 452. 425. 392. 425. 464. 425. 380. 425.) '(290. 290. 296. 290. 278. 290. 308. 290. 266. 290. 320. 290. 254. 290. 332. 290. 242.) nil 2. w:black) (SEND world :insert-text 500. 240. "Demo Text" 1. gwin:43vxms-font w:50%-gray-color) (SEND world :insert-text 575. 290. "Demo Text" 1. gwin:bigfnt-font) (SEND world :insert-text 585. 315. "Demo Text" 1. gwin:medfnb-font w:orange w:pink) (SEND world :insert-text 595. 340. "Demo Text" 1. gwin:tr10-font) (SEND world :insert-triangle 800. 340. 840. 240. 950. 290. 5. w:75%-gray-color w:33%-gray-color) (SEND window :refresh)) 2;;; Step 6: Defining the pick Function 1;;; ;;; The next form defines a utility function that you will use in later steps. The function lets you pick an object that is in the window by putting the ;;; mouse cursor over the object and clicking any button. A pointer to the object and the x and y co-ordinates of the mouse cursor are returned. ;;; ;;; To compile this form, select it by clicking middle over the opening parenthesis, and then press CTRL-SHIFT-C. ;;;** (DEFUN pick () "This function will allow picking of an object from the graphics window by pointing at it with the mouse and clicking any button" (declare (:values object-pointer x-location y-location) (special window world)) (LET ((click-blip (SEND window :any-tyi))) (WHEN (AND (LISTP click-blip) (EQ (FIRST click-blip) :mouse-button)) (VALUES (SEND world :pick (FOURTH click-blip) (FIFTH click-blip)) (FOURTH click-blip) (FIFTH click-blip))))) 2;;; Step 7: Using the pick Function 1;;; ;;; Now, use the pick function to change the parameters of objects that have been inserted into the world. ;;; ;;; First, select and evaluate the following form by clicking middle and pressing CTRL-SHIFT-E. Then, move the mouse cursor over a graphics ;;; object and select the object by clicking any mouse button. A choose variable values menu will appear, which allows you to change the ;;; parameters of the object you have picked. ;;; ;;; Evaluate this form several times, and edit the parameters for different objects. The parameters will change depending on the object type. ;;;** (PROGN (SEND window :clear-input) (LOOP WITH (object dx dy) DO (MULTIPLE-VALUE-SETQ (object dx dy) (pick)) (WHEN object (MULTIPLE-VALUE-BIND (old-left old-top old-right old-bottom) (SEND object :extents) (SEND object :edit-parameters) (MULTIPLE-VALUE-BIND (left top right bottom) (SEND object :extents) (SEND window :refresh-area (MIN old-left left) (MIN old-top top) (MAX old-right right) (MAX old-bottom bottom))))) UNTIL object)) 2;;; Step 8:1 * Deleting Objects from the World 1;;; ;;; Objects that have been inserted into the world can be deleted. You can delete an individual object or a list of objects with the world ;;; :delete-entity method. Evaluating the following form will delete all the objects currently in the world. ;;; ;;; Click middle over the opening parenthesis to select the form, and then press CTRL-SHIFT-E to evaluate it. ;;;** (PROGN (SEND world :delete-entity (SEND world :display-list)) (SEND window :refresh)) 1;2;; Step 9: Reading a Saved Picture from Disk* ;;; ;;; This form reads a picture and inserts it into the world. Then, the graphics window is refreshed, because reading a display list does not redraw ;;; the window. ;;; ;;; Another method, the :write-display-list message, was used to write the display list to a file. ;;; ;;; Select the form with the middle button, and then evaluate the form by pressing CTRL-SHIFT-E. ;;;* (PROGN (SEND world :read-display-list "sys:gwin.starter-kit;examples.picture") (SEND window :refresh)) 2;;; Step 10: Creating Moving Sprites 1;;; ;;; Sprites cursors are defined as a bit image. Sprites can be moved in the window without refreshing the window. Sprites can also move ;;; automatically, which provides a type of animation. Each moving sprite can do one of the following at the edge of the window: reflect ;;; off the edge, wrap around to the opposite edge, or continue moving beyond the edge. This next form creates two moving sprite objects ;;; in the graphics window. Each is defined from the bit image of a newly created graphics object. ;;; ;;; Click middle to select, and then press CTRL-SHIFT-E to evaluate. ;;;** (PROGN (SETF sprite0 (gwin:make-sprite-from-objects window (MAKE-INSTANCE 'gwin:rectangle :width 20. :fill-color w:red) :frozen? nil :y-step 20. :time-between-moves 5.)) (SETF sprite1 (gwin:make-sprite-from-objects window (MAKE-INSTANCE 'gwin:circle :radius 20. :fill-color w:blue :edge-color w:yellow :weight 5) :frozen? nil :x-step 20.))) 2;;; Step 11: Deleting Sprite Objects 1;;; ;;; Sprites are cursor objects. To delete a sprite, send a :delete-cursor message to the window that owns the sprite. The following form ;;; deletes the two sprite objects that were created in the last step. ;;; ;;; Select the form by clicking middle over the opening parenthesis, and then evaluate the form by pressing CTRL-SHIFT-E. ;;;** (PROGN (SEND window :delete-cursor sprite0) (SEND window :delete-cursor sprite1)) 2;;; Step 12: Drag-moving Objects 1;;; ;;; The following form uses the pick function and sprite cursors to drag an object to a new place in the window. The variables w:mouse-x ;;; and w:mouse-y return the mouse position in window coordinates. Then, the coordinates are converted to world coordinates by ;;; the :untransform-point method before they are passed to the sprite :set-position method. The drag move form also uses four other ;;; methods: the :extents object method, which returns the world coordinates of the smallest rectangle that completely encloses the object; ;;; the :set-origin object method, which positions the upper left corner of the object at the specified world coordinates; the :refresh-area ;;; window method, which redraws part of the window; and the :calculate-extents world method, which calculates the extents of all the ;;; objects in the world. The x and y offsets that are passed to the make-sprite-from-objects function are in the window coordinates. ;;; ;;; Select the following form by clicking middle over the opening parenthesis, and evaluate it by pressing CTRL-SHIFT-E. Then, put the mouse cursor ;;; over an object in the window, and click any button. Drag the object to a new location, and click any button to drop the object at that point. ;;;** (PROGN (clear-input window) (LOOP WITH (object dx dy) DO (MULTIPLE-VALUE-SETQ (object dx dy) (pick)) (WHEN object (MULTIPLE-VALUE-BIND (x y) (SEND object :origin) (SETF dx (- dx x) dy (- dy y)) (MULTIPLE-VALUE-BIND (window-dx window-dy) (SEND window :transform-deltas dx dy) (LOOP WITH sprite = (gwin:make-sprite-from-objects window object :bottom-flag nil :left-flag nil :right-flag nil :top-flag nil :x-offset window-dx :y-offset window-dy) AND x2 AND y2 FOR x1 = system:mouse-x AND y1 = system:mouse-y DO (MULTIPLE-VALUE-SETQ (x2 y2) (SEND window :untransform-point x1 y1)) (SEND sprite :set-position x2 y2) (PROCESS-WAIT "drag-move" #'(LAMBDA (x y) (OR (NOT (= system:mouse-x x)) (NOT (= system:mouse-y y)) (SEND window :listen))) system:mouse-x system:mouse-y) UNTIL (w:read-any-no-hang window nil nil) FINALLY (SEND window :delete-cursor sprite) (MULTIPLE-VALUE-BIND (old-left old-top old-right old-botm) (SEND object :extents) (SEND object :set-origin (- x2 dx) (- y2 dy)) (MULTIPLE-VALUE-BIND (left top right botm) (SEND object :extents) (SEND window :refresh-area old-left old-top old-right old-botm) (SEND window :refresh-area left top right botm) (SEND world :calculate-extents))) )))) UNTIL object)) 2;;; Step 13: Drag-copying Objects 1;;; ;;; A few modifications to the drag-move form lets you drag-copy objects. This form uses the :copy method, which is in the basic set of ;;; methods available for graphics objects. After copying the object, it is added to the display list and to the list of objects in the window. Then, ;;; the tick count is updated, and the extents of the world are re-calculated. The tick count is the number of times the world has been modified. ;;; ;;; First, select the form by clicking middle, and evaluate the form by pressing CTRL-SHIFT-E. Then, click over an object to select it. Drag the ;;; copy of the object to a new location, and click to drop it. ;;;** (PROGN (SEND window :clear-input) (LOOP WITH (object dx dy) DO (MULTIPLE-VALUE-SETQ (object dx dy) (pick)) (WHEN object (MULTIPLE-VALUE-BIND (x y) (SEND object :origin) (SETF dx (- dx x) dy (- dy y)) (MULTIPLE-VALUE-bind (window-dx window-dy) (SEND window :transform-deltas dx dy) (LOOP WITH sprite = (gwin:make-sprite-from-objects window object :bottom-flag nil :left-flag nil :right-flag nil :top-flag nil :x-offset window-dx :y-offset window-dy) AND x2 AND y2 FOR x1 = system:mouse-x AND y1 = system:mouse-y DO (MULTIPLE-VALUE-SETQ (x2 y2) (SEND window :untransform-point x1 y1)) (SEND sprite :set-position x2 y2) (PROCESS-WAIT "drag-copy" #'(LAMBDA (x y) (OR (NOT (= system:mouse-x x)) (NOT (= system:mouse-y y)) (SEND window :listen))) system:mouse-x system:mouse-y) UNTIL (SEND window :any-tyi-no-hang) FINALLY (LET ((new-object (SEND object :copy)) (display-list (SEND world :display-list)) (objects-in-window (SEND world :objects-in-window))) (SEND window :delete-cursor sprite) (PUSH-END new-object display-list) (PUSH-END new-object objects-in-window) (SEND world :set-tick (1+ (SEND world :tick))) (SEND new-object :set-origin (- x2 dx) (- y2 dy)) (SEND new-object :draw window) (SEND world :calculate-extents))) ))) UNTIL object)) 2;;; Step 14: Highlighting Objects 1;;; ;;; Highlighting is used to mark selected objects in the window. The following form uses the pick function defined earlier and the :highlight ;;; method to highlight objects by displaying a hand that points to them. ;;; ;;; First, select the form by clicking middle, and evaluate it by pressing CTRL-SHIFT-E. Then, move the mouse cursor into ;;; the window and click on an object to highlight it. ;;; ** (PROGN (clear-input window) (MULTIPLE-VALUE-BIND (object dx dy) (pick) (WHEN object (SEND object :highlight window)))) 2;;; Step 15: Unhighlighting Objects 1;;; ;;; The :unhighlight method is used to remove highlighting. ;;; ;;; First, select the following form with the middle mouse button, and evaluate it by pressing CTRL-SHIFT-E. Then, move the mouse ;;; cursor into the window, and click on the object you highlighted in the last step. The highlighting will be removed. ;;;** (PROGN (clear-input window) (MULTIPLE-VALUE-BIND (object dx dy) (pick) (WHEN object (SEND object :unhighlight window)))) 2;;; Step 16: Scaling Objects 1;;; ;;; Objects can be scaled in the x and y directions. The following form uses a choose-variable-value menu to prompt for the scale ;;; factors. The :scale method does the scaling. Scaling is performed relative to the origin of the coordinate system; therefore, ;;; the object is first moved to the origin of the coordinate system by the :set-origin method, then scaled, and last moved back ;;; to its original position. ;;; ;;; Select the following form by clicking middle over the opening parenthesis, and then evaluate it by pressing CTRL-SHIFT-E. Then, ;;; pick an object by clicking over it and typing in new scale values on the menu. ;;;** (PROGN (clear-input window) (LOOP WITH (object dx dy) DO (MULTIPLE-VALUE-SETQ (object dx dy) (pick)) (WHEN object (LET ((sx 1.0) (sy 1.0) (scale-thickness? nil)) (declare (special sx sy scale-thickness?)) (w:choose-variable-values '((sx "X Scale" :number) (sy "Y Scale" :number) (scale-thickness? "Scale Thickness?" :boolean)) :label "Scale factors") (MULTIPLE-VALUE-BIND (left top right botm) (SEND object :extents) (MULTIPLE-VALUE-BIND (origin-x origin-y) (SEND object :origin) (SEND object :set-origin 0. 0.) (SEND object :scale sx sy scale-thickness?) (SEND object :set-origin origin-x origin-y)) (MULTIPLE-VALUE-BIND (new-left new-top new-right new-botm) (SEND object :extents) (SEND window :refresh-area (MIN left new-left) (MIN top new-top) (MAX right new-right) (MAX botm new-botm)))))) UNTIL object)) 2;;; Step 17: Rubber-banding 1;;; ;;; Rubber-banding is a computer graphics technique of changing the shape of an object while the points defining it are being moved. The following form ;;; uses the graphics window system to rubber-band a line. What is interesting to note is the alu's being used. ;;; ;;; The w:alu-add and w:alu-sub alu's are primarily for use on color systems. However, they perform the desired effect on monochrome systems also. ;;; ;;; On monochrome systems, the add and sub alu's act just like the opposite alu. The opposite alu is needed so that the rubber-banding line does not ;;; erase images currently on the screen. ;;; ;;; On color systems, the add and sub alu's function in a different manner. The add alu is used to draw the line and the sub alu is used to remove the ;;; line at its old position as the line is moved to a new position. Thus the same result is achieved; the rubber-banding line does not erase images ;;; currently on the screen. As the line moves, it appears in some "temporary" colors. This is a result of the way the add and sub alu's function. ;;; ;;; First, select and evaluate the form using the middle mouse button and the CTRL-SHIFT-E key sequence. Then, move the mouse cursor into the window, ;;; and press and hold any mouse button at the starting point of the line. As you move the mouse cursor on the screen, the line will rubber-band to ;;; follow the cursor. When you release the button, the line will be inserted into the world and drawn into the window. ;;;** (PROGN (clear-input window) (LET ((click-blip (w:read-any window nil nil) )) (WHEN (AND (LISTP click-blip) (EQ (FIRST click-blip) :mouse-button)) (LET ((x1 (FOURTH click-blip)) (y1 (FIFTH click-blip))) (LOOP WITH x3 AND y3 FOR x2 = w:mouse-x AND y2 = w:mouse-y DO (MULTIPLE-VALUE-SETQ (x3 y3) (SEND window :untransform-point x2 y2)) (SEND window :draw-line x1 y1 x3 y3 2. w:orange w:alu-add) (w:mouse-wait x2 y2) (SEND window :draw-line x1 y1 x3 y3 2. w:orange w:alu-sub) UNTIL (ZEROP w:mouse-last-buttons) FINALLY (SEND (SEND world :insert-line x1 y1 x3 y3 2. w:purple) :draw window)))))) 2;;; Step 18: Prepare for Transformation Demonstrations 1;;; ;;; Several methods are available for changing the position of the window in relation to the world. The following form creates a picture that will be used to demonstrate these methods. ;;; ;;; Select the following form by clicking middle over the opening parenthesis, and evaluate it by pressing CTRL-SHIFT-E. ;;;** (PROGN (SEND world :delete-entity (SEND world :display-list)) (SEND world :insert-circle 100. 100. 50. 2. w:dark-brown w:50%-gray-color) (SEND world :insert-line 0. 100. 200. 100. 2. w:yellow) (SEND world :insert-line 100. 0. 100. 200. 2. w:yellow) (SEND world :insert-text 150. 40. "Raster Text" 1. gwin:medfnb-font) (SEND world :insert-text 150. 60. "Vector Text" 1. gwin:standard-font) (SEND window :refresh)) 1 * 2;;; Step 19: Panning and Zooming 1;;; ;;; The following form uses the :pan and :zoom window methods. The window will pan left and up so that the circle is centered, and ;;; then it will zoom in on the world to magnify the picture. ;;; ;;; Select the form with the middle button, and then evaluate it by pressing CTRL-SHIFT-E. ;;;** (PROGN (SEND window :pan 350. 75.) (SEND window :zoom 1.5 1.5) (SEND window :refresh)) 2;;; Screen 20: Displaying the Default Window 1;;; ;;; To reset the transformation to a 1-to-1 mapping of world and window coordinates, the following form uses the :default-window method. ;;; ;;; Select the form by clicking middle over the opening parenthesis, and then evaluate it by pressing CTRL-SHIFT-E. ;;;** (PROGN (SEND window :default-window) (SEND window :refresh)) 2;;; Step 21: Displaying All Objects 1;;; ;;; The following form uses the :world-extents method to set the transformation of the window so that all objects in the current world are ;;; displayed. ;;; ;;; Select the following form by clicking middle over the opening parenthesis, and then evaluate it by pressing CTRL-SHIFT-E. ;;;** (PROGN (SEND window :world-extents-window) (SEND window :refresh)) 2;;; Step 22: Selecting the Window Area 1;;; ;;; You can define a rectangular area to be the window with the :new-window method. The following form uses rubber-banding to select ;;; the area. A thickness of 0 for the rubber-banded rectangle prevents the edges from being scaled when the transformation takes place. ;;; ;;; First, select the following form by clicking middle over the opening parenthesis, and then evaluate the form by pressing CTRL-SHIFT-E. ;;; Next, move the mouse cursor to the upper left corner of the rectangular area you want to be the window. Press and hold any button, ;;; and then move the cursor to the lower right corner of the area. ;;; ;;; To see the difference between raster and vector text, zoom in on the text. As the raster text gets larger, the raster pattern becomes clear; ;;; however, the vector text maintains its quality. ;;; ** (PROGN (clear-input window) (LET ((click-blip (w:read-any window nil nil) )) (WHEN (AND (LISTP click-blip) (EQ (FIRST click-blip) :mouse-button)) (LET ((x1 (FOURTH click-blip)) (y1 (FIFTH click-blip))) (LOOP WITH x3 AND y3 FOR x2 = system:mouse-x AND y2 = system:mouse-y DO (MULTIPLE-VALUE-SETQ (x3 y3) (SEND window :untransform-point x2 y2)) (SEND window :draw-rectangle x1 y1 (- x3 x1) (- y3 y1) 0. w:yellow w:alu-add) (w:mouse-wait x2 y2) (SEND window :draw-rectangle x1 y1 (- x3 x1) (- y3 y1) 0. w:yellow w:alu-sub) UNTIL (ZEROP w:mouse-last-buttons) FINALLY (SEND window :new-window x1 y1 (- x3 x1) (- y3 y1)) (SEND window :refresh)))))) 2;;; Step 23: Prepare for Mouse Demonstration 1;;; ;;; The mouse-handler-mixin contains methods that provide mouse handling functions. The following form returns the ;;; window to the default configuration, which will be used to demonstrate the mouse handling methods. ;;; ;;; Select the following form by clicking over the opening parenthesis, and evaluate the form by pressing CTRL-SHIFT-E. ;;;** (PROGN (SEND window :default-window) (SEND window :refresh)) 2;;; Step 24: Defining the Invisible Grid and Turning on the Crosshair 1;;; ;;; You can define a grid with the :set-grid-x, :set-grid-y, and :set-grid-on methods; when the grid is turned on, only grid points ;;; can be selected. If the crosshair cursor is also on, the mouse cursor moves in discrete steps corresponding to the grid. This is ;;; used as an aid in positioning the mouse. ;;; ;;; First, select the form by clicking middle, and evaluate it by pressing CTRL-SHIFT-E. Then, move the mouse cursor into the window. ;;; The mouse cursor will be a crosshair cursor, and it will move in discrete steps that corresponding to the grid you have defined. ;;; The ends of the four lines mark the adjacent grid points. ;;;** (PROGN (SEND window :set-grid-x 30.) (SEND window :set-grid-y 30.) (SEND window :set-grid-on t) (SEND window :turn-on-crosshair)) 2;;; Step 25: Making the Grid Visible 1;;; ;;; To see the grid, use the :draw-grid method to draw dots corresponding to the grid. ;;; ;;; First, select the form by clicking middle, and evaluate it by pressing CTRL-SHIFT-E. Then, move the mouse cursor into the ;;; window to see how the crosshair and grid points work. ;;; ;;; The dots are not the grid. When you refresh the window, the grid remains, but the dots disappear. ;;;** (SEND window :draw-grid (SEND window :grid-x) (SEND window :grid-y)) 2;;; Step 26: Turning off the Grid and Crosshair 1;;; ;;; You can turn off the grid and crosshair with the :grid-off and :turn-off-crosshair methods. ;;; ;;; Select the following form with the middle button, and evaluate it by pressing CTRL-SHIFT-E. Then, move the mouse cursor into ;;; the window. The mouse cursor will return to the default cursor. ;;;** (PROGN (SEND window :turn-off-crosshair) (SEND window :set-grid-on nil) (SEND window :refresh)) 2;;; Step 27: Changing the Mouse Cursor 1;;; ;;; You can change the mouse cursor from the standard arrow to any other character. The following form changes the cursor to a ;;; pointing finger. If the :mouse-standard-blinker method were not used, the mouse would not change until it entered the window. ;;; The make-instance actually inserts a fixed position cursor into the window; since the visibility is nil, it is invisible. ;;; ;;; Select the following form by clicking middle over the opening parenthesis, and then evaluate it by pressing CTRL-SHIFT-E. ;;;** (PROGN (SEND window :set-tracker-cursor (MAKE-INSTANCE 'gwin:cursor :character w:mouse-glyph-hand-pointing-left :font fonts:mouse :visibility nil :window window)) (SEND window :mouse-standard-blinker)) 2;;; Step 28: Restoring the Mouse Cursor 1;;; ;;; The next form changes the mouse cursor back to the default arrow. The :delete method removes the invisible cursor from the window, ;;; and setting the tracker cursor to nil causes the mouse to change to the default when the :mouse-standard-blinker method is evaluated. ;;; ;;; Select the form with the middle button, and evaluate it with the CTRL-SHIFT-E key sequence. ;;;** (PROGN (SEND (SEND window :tracker-cursor) :delete) (SEND window :set-tracker-cursor nil) (SEND window :mouse-standard-blinker)) 2;;; Step 29: Creating Screen Markers 1;;; ;;; So far, we have used several different types of cursors. We made use of ;;; sprite cursors to demonstrate animation and for use in drag moves and copies. ;;; We made use of the pointing finger, which is a character font cursor, to highlight ;;; objects. We changed the mouse into the crosshair cursor, which is a special ;;; type of cursor that has the capability of moving in discrete steps ;;; corresponding to a grid. Finally, we showed how to set the mouse to a ;;; character font cursor. The next few forms will demonstrate methods in the ;;; graphics-window-mixin that maintain a list of character font cursors and block ;;; cursors associated with a graphics window. We have not used the block ;;; cursor yet, but it is simply a solid rectangular blinker. We have already used ;;; these methods without realizing it when we highlighted and unhighlighted ;;; objects. We can explicitly call these methods to add and delete cursors from ;;; the graphics window. A typical use of these cursors is for markers. The ;;; :add-cursor methods will insert several cursors into the graphics window. ;;; The positioning parameters are in world coordinates, but the width and height ;;; parameters of the block cursor are in window units. When we add the ;;; cursors to the graphics window cursor list with this method, they will ;;; automatically be redrawn when we pan, zoom, or otherwise refresh the ;;; screen. You may want to back up and reevaluate some of the panning and ;;; zooming forms illustrated earlier to convince yourself of this after selecting ;;; and evaluating the following form. They can be found at step 22**. 1;;;* 1If you do pan and zoom be sure to restore the screen to the* 1default ;;; window using the instructions at step 23*. 1;;;* (PROGN (SEND window :add-cursor 'gwin:cursor :character w:mouse-glyph-hand-pointing-left :font fonts:mouse :window window :x-position 400. :y-position 100.) (SEND window :add-cursor 'gwin:cursor :character w:mouse-glyph-double-up-arrow :font fonts:mouse :window window :x-position 450. :y-position 150.) (SEND window :add-cursor 'gwin:cursor :character #\X :font fonts:bigfnt :window window :x-position 500. :y-position 200.) (SEND window :add-cursor 'gwin:block-cursor :height 25. :width 25. :window window :x-position 550. :y-position 250.)) 2;;; Step 30: Deleting Screen Markers 1;;; ;;; To delete cursors from the graphics window cursor list, use the :delete-cursor ;;; method. Select and evaluate the following form. The cursors will disappear ;;; from the graphics window. ;;;** (DOLIST (cursor (SEND window :cursor-list)) (SEND window :delete-cursor cursor)) 2;;; Step 31: Defining Subpictures 1;;; ;;; Another feature of the graphics window system is the subpicture. A subpicture ;;; allows us to group several graphics objects into a single object. As long as ;;; the objects are grouped into a subpicture, they may not be manipulated ;;; individually. The subpicture's origin will be the upper left corner of the ;;; rectangle defining the extent of all the objects making up the subpicture. We ;;; can use the following form to group graphics objects into subpictures using ;;; the rubber-banding technique illustrated earlier. In this example, the subpicture ;;; is drawn with a box around it to make it easier to see what objects got ;;; grouped together. If we had sent the :insert-subpicture message with the ;;; edge color parameter (last parameter) set to nil instead of w:black the box ;;; would not have been drawn. After defining the rectangle we check each ;;; object in the window to see if it is completely enclosed with the :inside-p ;;; object method. If it is in the rectangle, we delete it from the world, add it ;;; to a list of objects that will compose the subpicture, and change its origin to ;;; be in relation to the origin of the subpicture. After we have collected all the ;;; objects, we send the :insert-subpicture message to add the subpicture to the ;;; world and the :draw message to display it in the graphics window. The :draw ;;; message had to be issued to force the box around the subpicture to appear. ;;; Select and evaluate the form. Next move the mouse to the upper left ;;; corner of the area you wish to define. Press and hold any mouse button to ;;; rubber-band a rectangle around some objects. Only objects completely in the ;;; rectangle will be selected. Finally, release the mouse button to group them ;;; into a subpicture. You might want to reevaluate the drag move or drag copy ;;; forms shown earlier to see how the subpicture will now move as a unit. ;;; They can be found at steps 12 and 13. ;;;** (PROGN (clear-input window) (LET ((click-blip (w:read-any window nil nil))) (WHEN (AND (LISTP click-blip) (EQ (FIRST click-blip) :mouse-button)) (LET ((x1 (FOURTH click-blip)) (y1 (FIFTH click-blip))) (LOOP WITH x3 AND y3 FOR x2 = w:mouse-x AND y2 = w:mouse-y DO (MULTIPLE-VALUE-SETQ (x3 y3) (SEND window :untransform-point x2 y2)) (SEND window :draw-rectangle x1 y1 (- x3 x1) (- y3 y1) 0. w:88%-gray-color w:alu-add) (w:mouse-wait x2 y2) (SEND window :draw-rectangle x1 y1 (- x3 x1) (- y3 y1) 0. w:88%-gray-color w:alu-sub) UNTIL (ZEROP w:mouse-last-buttons) FINALLY (LOOP WITH subpicture-list FOR object IN (SEND world :objects-in-window) WHEN (SEND object :inside-p x1 y1 x3 y3) DO (SEND world :delete-entity object) (PUSH-END object subpicture-list) (SEND object :move (- x1) (- y1)) FINALLY (UNLESS (NULL subpicture-list) (SEND (SEND world :insert-subpicture x1 y1 subpicture-list "demo picture" 1. 1. w:black) :draw window))) ))))) 2;;; Step 32: Preparing for Raster Object Demonstration 1;;; ;;; For high speed drawing, normal graphics objects can be converted into raster ;;; objects. The trade-off is that raster objects are not as flexible as normal ;;; graphics objects because they exist only as a pattern of pixels. Some ;;; limitations of raster objects are: normal graphics object attributes such as fill ;;; color or edge thickness may be changed with the edit-parameter method, ;;; however only the position and alu function of raster objects may be ;;; changed; a subpicture that has been converted into a raster object may ;;; never be broken back into its individual components; the size of storage used ;;; to hold the pixel pattern of raster objects may be exceeded when scaling or ;;; zooming; scaling and zooming is very slow; finally, the picture quality ;;; degrades when scaling or zooming. The following form will draw some ;;; objects in the graphics window to be used for illustrating the speed of raster ;;; objects. Select and evaluate the form. ;;;** (PROGN (SEND world :delete-entity (SEND world :display-list)) (SEND window :default-window) (SEND world :insert-circle 250. 175. 150. 10. w:blue-green w:green) (SEND world :insert-circle 600. 175. 150. 10. w:red w:75%-gray-color) (SEND window :refresh)) 1 2;;; Step 33: Converting Graphic Objects to Raster Objects* ;;; ;;; Now we will convert one of the circles into a raster object and refresh the ;;; screen. We will first remove the picked object from the world, build a raster ;;; equivalent of it in the sprite-window, then send the world an :insert-raster ;;; message, passing the extents of the original object, the bit array of ;;; sprite-window, the width and height of sprite-window, and the x and y scale ;;; elements of the transformation matrix. Select and evaluate the following form. ;;; Then pick a circle with the mouse. Notice the difference in speed drawing ;;; the two circles. ;;;* (PROGN (clear-input window) (LOOP WITH (object dx dy) DO (MULTIPLE-VALUE-SETQ (object dx dy) (pick)) (WHEN object (SEND world :delete-entity object) (LET* ((width-height (gwin:rasterize-objects window object)) (transform (SEND window :transform)) (t00 (AREF transform 0. 0.)) (t01 (AREF transform 1. 1.))) (MULTIPLE-VALUE-BIND (xmin ymin xmax ymax) (SEND object :extents) (SEND world :insert-raster xmin ymin xmax ymax (w:sheet-screen-array w:sprite-window) 0. 0. (FIRST width-height) (SECOND width-height) t00 t01))) (SEND window :refresh)) UNTIL object)) 1;;; ;;; This concludes the graphics window system example set. ;;;