;;; -*- Mode: Common-Lisp; Package: User; Base: 10.; Patch-File: T -*-

;;; Reason: Corrected calculation of translation between ged-pane and mouse-sheet coordinates.
;;; Adjust the x-offset for brush-thickness to ensure paint always flows from the tip of
;;; the brush. [SPRs 5318, 9869] [Codereader: Mark Young]

;;;                           RESTRICTED RIGHTS LEGEND
;;;
;;; Use, duplication, or disclosure by the Government is subject to
;;; restrictions as set forth in subdivision (c)(1)(ii) of the Rights in
;;; Technical Data and Computer Software clause at 52.227-7013.
;;;
;;;   TEXAS INSTRUMENTS INCORPORATED      
;;;   P.O. BOX 2909, M/S 2151             
;;;   AUSTIN, TEXAS 78769                 
;;;
;;; Copyright (C) 1989 Texas Instruments Incorporated.
;;; All rights reserved.

;;; Written 06/26/89 13:27:53 by GRENINGER,
;;; while running on Salk from band LODA
;;; With SYSTEM 6.7, VIRTUAL-MEMORY 6.1, EH 6.3, MAKE-SYSTEM 6.0, MICRONET 6.0, LOCAL-FILE 6.0,
;;;  BASIC-PATHNAME 6.0, NETWORK-SUPPORT-COLD 6.0, BASIC-NAMESPACE 6.1, NETWORK-NAMESPACE 6.0,
;;;  DISK-IO 6.0, DISK-LABEL 6.0, BASIC-FILE 6.2, MAC-PATHNAME 6.0, NETWORK-PATHNAME 6.0,
;;;  COMPILER 6.4, TV 6.10, DATALINK 6.0, CHAOSNET 6.0, GC 6.3, MEMORY-AUX 6.0, NVRAM 6.0,
;;;  SYSLOG 6.0, STREAMER-TAPE 6.2, UCL 6.0, INPUT-EDITOR 6.0, METER 6.0, ZWEI 6.3,
;;;  Experimental DEBUG-TOOLS 6.2, NETWORK-SUPPORT 6.0, NETWORK-SERVICE 6.0, DATALINK-DISPLAYS 6.0,
;;;  FONT-EDITOR 6.1, SERIAL 6.0, PRINTER 6.1, MAC-PRINTER-TYPES 6.1, PRINTER-TYPES 6.0,
;;;  IMAGEN 6.0, SUGGESTIONS 6.0, MAIL-DAEMON 6.2, MAIL-READER 6.0, TELNET 6.0, VT100 6.0,
;;;  NAMESPACE-EDITOR 6.0, PROFILE 6.1, VISIDOC 6.2, TI-CLOS 6.8, CLEH 6.4, IP 3.46,
;;;  Experimental BUG 11.10, Experimental CLX 6.1, CLUE 6.5, X11M 6.1, Experimental GRAPHICS-WINDOW 6.0,
;;;  Experimental GED 6.0, Experimental SC 1.3, Experimental CLUSO 9.0,  microcode 428,
;;;  Band Name: Release 6.0 + SLE 6/5

#!C
; From file PAINT.LISP#> GED; MR-X:
#10R GED#:
(COMPILER-LET ((*PACKAGE* (FIND-PACKAGE "GED"))
                          (SI:*LISP-MODE* :COMMON-LISP)
                          (*READTABLE* SYS:COMMON-LISP-READTABLE)
                          (SI:*READER-SYMBOL-SUBSTITUTIONS* SYS::*COMMON-LISP-SYMBOL-SUBSTITUTIONS*))
  (COMPILER#:PATCH-SOURCE-FILE "SYS: GED; PAINT.É#É"


(defmethod (buffer :paint-command) ()
  "Paint between mouse points and add to the list of points that define the painting."
  
  (let* ((world    (send g-pane :world))
	 (color    (send world :current-edge-color))
	 x-offset y-offset
	 (brush-thickness-adjustment (FLOOR (SEND world :current-thickness) 2))
	 first-x
	 first-y
	 last-mouse-click
	 untrans-x
	 untrans-y)
    ;;   Calculate the translations necessary to move from a point's mouse-sheet
    ;;   coordinate to its g-pane coordinate...
    (MULTIPLE-VALUE-SETQ (x-offset y-offset)
      (tv:sheet-calculate-offsets g-pane w:mouse-sheet))
    (DECF x-offset brush-thickness-adjustment)
    
    (when (null raster-points)		   ; just beginning to draw with mouse
      (copy-array-contents (send g-pane :transform) (send sprite-window :transform))
      (send sprite-window :set-identity? (send g-pane :identity?))
      ;;; Always make sprite-window bit-array (and screen-array) the same color as the
      ;;; background-color of the graphics-window (g-pane).  This is because the raster image
        ;;; is bitblted from the bit-array into the identity-cache of the raster object.  See also
        ;;; GED;buffer-object-methods and GWIN;raster-entity.  This is strictly for use on color systems.
      (SEND sprite-window :set-background-color (SEND g-pane :background-color))
      (send sprite-window :clear-screen)
      (UNLESS (w:color-system-p g-pane)  ;; avoid white paint kludge when on color system - 08/28/87 KJF
	(if (eq first-white :white)	   ; white-paint kludge notice to user
	    (inform "You have begun a white painting."))))
    (setq untrans-x system:mouse-x
	  untrans-y system:mouse-y)
    (multiple-value-setq (first-x first-y)
      (send g-pane :untransform-point (- untrans-x x-offset) (- untrans-y y-offset)))
    (loop with alu = (send world :current-alu)
	  with thickness = (send world :current-thickness)
          with (next-x next-y untrans-x2 untrans-y2)
	  until (and (setq last-mouse-click (read-any-no-hang g-pane nil nil))
	             (send *ged* :legal-mouse-click last-mouse-click))
          do (wait-for-mouse-move-or-any-io g-pane untrans-x untrans-y)
             (setq untrans-x2 system:mouse-x
	           untrans-y2 system:mouse-y)
             (multiple-value-setq (next-x next-y)
	       (send g-pane :untransform-point (- untrans-x2 x-offset) (- untrans-y2 y-offset)))
             (send g-pane :draw-line first-x first-y next-x next-y thickness color alu)
	                                   ;; avoid white paint kludge when on color system - 08/28/87 KJF
             (if (AND (eq first-white :white) (NOT (w:color-system-p g-pane)))   ; Part of white-paint kludge.
	         ;; Draw in black in sprite window and compensate later.
	         (send sprite-window :draw-line first-x first-y next-x next-y thickness
	                                                                  black normal)
	         ;; The normal situation.
	         (send sprite-window :draw-line first-x first-y next-x next-y thickness color alu))
             (setq raster-points (nconc raster-points (list (list first-x first-y)))
	           untrans-x     untrans-x2
	           untrans-y     untrans-y2
	           first-x       next-x
	           first-y       next-y)
          ;; The NIL in the raster-point list indicates the end of one chunk of paint.
          finally (setq raster-points (nconc raster-points (list (list next-x next-y) ()))))
    (unread-any last-mouse-click g-pane))) 

))

#!C
; From file CURSOR-DEFS.LISP#> GED; MR-X:
#10R GED#:
(COMPILER-LET ((*PACKAGE* (FIND-PACKAGE "GED"))
                          (SI:*LISP-MODE* :COMMON-LISP)
                          (*READTABLE* SYS:COMMON-LISP-READTABLE)
                          (SI:*READER-SYMBOL-SUBSTITUTIONS* SYS::*COMMON-LISP-SYMBOL-SUBSTITUTIONS*))
  (COMPILER#:PATCH-SOURCE-FILE "SYS: GED; DEFINITIONS.É#É"


(define-cursor *cursor-alist* 'paint-mode-cursor 21 0 15) 

))
