;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: LAPIDARY; Base: 10 -*-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;         The Garnet User Interface Development Environment.      ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; This code was written as part of the Garnet project at          ;;;
;;; Carnegie Mellon University, and has been placed in the public   ;;;
;;; domain.  If you are using this code or any part of Garnet,      ;;;
;;; please contact garnet@cs.cmu.edu to be put on the mailing list. ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; -*- Mode: Lisp; Package: LAPIDARY -*-
;;; This file contains code for attaching halftones to editor
;;; objects

(in-package "LAPIDARY" :use '("LISP" "KR"))


;;; ===============================
;;; shade the selections
;;; with the designated halftone
;;; ===============================

(defun shade-menu-handler (inter selection)
  (declare (ignore inter selection))
  (declare (special *selection-info* shade-menu))
  (reset-undo)
  (let ((filling-style (g-value shade-menu :value)))
    (if (eq filling-style :constraint)
	(make-custom-constraint :filling-style)
	(dolist (obj (g-value *selection-info* :selected))
	  (undo-save obj :filling-style)
	  (destroy-constraint obj :filling-style)
	  (s-value obj :filling-style filling-style)))))

#|
;;; ===============================================
;;; go through each of the primary selections and
;;; attach the designated halftone to each of their
;;; components
;;; ===============================================

(defun attach-halftone (menu-selection halftone obj-list)

  (dolist (obj obj-list) 
    (if (is-a-p (g-value obj :is-a) opal:aggregate)
      (attach-halftone menu-selection 
		       halftone (g-value obj :components))
      (s-value obj :filling-style halftone))
    (update-menu-info obj :filling-style 
		      :filling-style (g-value menu-selection :choice))))
|#
;;; ===============================
;;; outline the selections
;;; with the designated line-style
;;; ===============================

(defun line-menu-handler (inter selection)
  (declare (ignore inter selection))
  (declare (special *selection-info* line-menu))
  (reset-undo)
  (let ((line-style (g-value line-menu :value)))
    (if (eq line-style :constraint)
	(make-custom-constraint :line-style)
	(dolist (obj (g-value *selection-info* :selected))
	  (undo-save obj :line-style)
	  (destroy-constraint obj :line-style)
	  (s-value obj :line-style line-style)))))

;;; ===============================
;;; draw the selections with
;;; the designated draw function
;;; ===============================

(defun draw-fct-handler (gadget values)
  (declare (ignore values))
  (let ((value (g-value gadget :value)))
;  (reset-undo)
  (dolist (obj (g-value *selection-info* :selected))
;      (undo-save obj :draw-function)
	  (destroy-constraint obj :draw-function)
	  (s-value obj :draw-function value))))

#|
;;; ===============================================
;;; go through each of the primary selections and
;;; attach the designated line-style to each of their
;;; components
;;; ===============================================

(defun attach-line-style (menu-selection line-style obj-list)

  (dolist (obj obj-list) 
    (if (is-a-p obj opal:aggregate)
	(attach-line-style menu-selection
			   line-style (g-value obj :components))
	(s-value obj :line-style line-style))
    (update-menu-info obj :line-style 
		      :line-style (g-value menu-selection :choice))))


;;; ========================================
;;; place the appropriate number of
;;; arrows on the selections which are lines
;;; ========================================

(defun arrow-menu-handler (menu-selection)
  (declare (special *selection-info*))
  (if (= (g-value menu-selection :choice) *constraint*)
      (format t "number of arrowheads determined by constraints")
      (let ((arrow-style (g-value menu-selection :choice)))
	(dolist (obj (g-value *selection-info* :p-selected))
	  (when (is-a-p obj garnet-toolkit:double-arrow-line)
	    (s-value obj :arrowhead-p
	       (cond ((= arrow-style *thin-line*) 0)
		     ((= arrow-style *arrow-2*) 2)))))
	(dolist (obj (g-value *selection-info* :s-selected))
	  (when (is-a-p obj garnet-toolkit:double-arrow-line)
	    (s-value obj :arrowhead-p
	       (cond ((= arrow-style *thin-line*) 0)
		     ((= arrow-style *arrow-2*) 2)))))))
    (update-*vp-editor-list*))

|#
