;;; -*- Mode: Lisp; Package: DESIGN; Syntax: Ansi-common-lisp -*-


(defclass MARKER (basic-point)
    ((tag :initform nil :initarg :tag :accessor marker-tag)
     (note :initform nil :initarg :note :accessor marker-note)))

(defmethod print-object ((marker marker) stream)
  (with-slots (note) marker
    (format stream "<MARKER: ~a>" note)))						

(defmethod save-form ((marker marker))
  (with-slots (tag note) marker
    `(,(type-of marker) :x ,(point-x marker) :y ,(point-y marker) :tag ,tag :note ,note)))

(defmethod plist ((marker marker))
  (with-slots (tag note) marker
    `(:tag ,tag :note ,note)))

(defmethod find-marker ((marker-string string) markers)
  (find marker-string markers :test #'string-equal :key #'marker-note))

(defmethod find-marker ((marker-tag symbol) markers)
  (find marker-tag markers :test #'eql :key #'marker-tag))

(defmethod marker-equal ((marker-tag symbol) marker)
  (eql (marker-tag marker) marker-tag))

(defmethod marker-equal ((marker-string string) marker)
  (string-equal (marker-note marker) marker-string))

(defun find-markers (marker-tag markers)
  (loop for marker in markers
	when (marker-equal marker-tag marker)
	  collect marker))

(defmethod save-marker-p ((marker marker))
  nil)

(defun make-marker (x y plist &optional (marker-type 'marker))
  (apply #'make-instance marker-type :x x :y y plist))

(defclass APPROACH-MARKER (marker)
    ())

(defmethod initialize-instance :after ((marker approach-marker) &rest plist)
  plist
  (with-slots (method tag note) marker
    (setf tag :approach-point)
    (setf note (dehyphenate (string tag)))))

(defmethod save-marker-p ((marker approach-marker))
  t)

(defmethod type-for-add ((marker approach-marker))
  'approach-marker)						

(defmethod name ((marker approach-marker))
  (marker-tag marker))

(defmethod print-object ((marker approach-marker) stream)
  (with-slots (note) marker
    (format stream "<MARKER: ~a ~a ~a>" note (point-x marker) (point-y marker))))