bn.xmp

/* XPM */
static char *bn[] = {
/* columns rows colors chars-per-pixel */
"45 45 76 1",
"  c black",
". c gray1",
"X c #060606",
"o c #0C0C0C",
"O c #0E0E0E",
"+ c gray6",
"@ c #101010",
"# c gray7",
"$ c #131313",
"% c #151515",
"& c #161616",
"* c #181818",
"= c #1E1E1E",
"- c gray12",
"; c gray15",
": c #272727",
"> c gray17",
", c #2D2D2D",
"< c #2F2F2F",
"1 c #353535",
"2 c #3C3C3C",
"3 c gray26",
"4 c #434343",
"5 c #444444",
"6 c gray27",
"7 c #494949",
"8 c #4E4E4E",
"9 c #505050",
"0 c gray32",
"q c #555555",
"w c #5D5D5D",
"e c #5F5F5F",
"r c #606060",
"t c gray39",
"y c gray40",
"u c #6C6C6C",
"i c #6D6D6D",
"p c #717171",
"a c #727272",
"s c gray49",
"d c #838383",
"f c #848484",
"g c #868686",
"h c gray53",
"j c #898989",
"k c #909090",
"l c #929292",
"z c #939393",
"x c gray58",
"c c gray59",
"v c #9A9A9A",
"b c #9D9D9D",
"n c #A2A2A2",
"m c gray66",
"M c #AEAEAE",
"N c #C3C3C3",
"B c #C8C8C8",
"V c #CDCDCD",
"C c gray81",
"Z c #D2D2D2",
"A c LightGray",
"S c #D7D7D7",
"D c #D8D8D8",
"F c gray86",
"G c #E6E6E6",
"H c #E7E7E7",
"J c gray91",
"K c #ECECEC",
"L c gray93",
"P c #EEEEEE",
"I c #F9F9F9",
"U c gray99",
"Y c #FDFDFD",
"T c #FEFEFE",
"R c gray100",
"E c None",
/* pixels */
"EEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEE",
"EEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEE",
"EEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEE",
"EEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEE",
"EEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEE",
"EEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEE",
"EEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEE",
"EEEEEEEEEEEEE  EEEEE  EEEEEEEEEEEEEEEEEEEEEEE",
"EEEEEEEEEEEEE   EEE   EEEEEEEEEEEEEEEEEEEEEEE",
"EEEEEEEEEEEEE    E     EEEEEEEEEEEEEEEEEEEEEE",
"EEEEEEEEEEEEE           8i2EEEEEEEEEEEEEEEEEE",
"EEEEEEEEEEEEE           yBUAyEEEEEEEEEEEEEEEE",
"EEEEEEEEEEEEE             @tFN>EEEEEEEEEEEEEE",
"EEEEEEEEEEEE  $7            XgJ2EEEEEEEEEEEEE",
"EEEEEEEEEEE  &YC              qH<EEEEEEEEEEEE",
"EEEEEEEEEEE  lRk               eSOEEEEEEEEEEE",
"EEEEEEEEEE   SI%                vxEEEEEEEEEEE",
"EEEEEEEEE    6@                 @G<EEEEEEEEEE",
"EEEEEEEEE                        amEEEEEEEEEE",
"EEEEEEEE                         oK-EEEEEEEEE",
"EEEEEEEE                          nsEEEEEEEEE",
"EEEEEEE                           9Z EEEEEEEE",
"EEEEEEE               E           #T=EEEEEEEE",
"EEEEEE               EE            DyEEEEEEEE",
"EEEEEE  55          EE             mbEEEEEEEE",
"EEEEEE  PL         EEE             fV EEEEEEE",
"EEEEEE  55        EEEE             rI.EEEEEEE",
"EEEEEE          EEEEE              0R-EEEEEEE",
"EEEEEE         EEEEEE              4R3EEEEEEE",
"EEEEEE        EEEEEE               1RwEEEEEEE",
"EEEEEEEE     EEEEEE                :RpEEEEEEE",
"EEEEEEEEEEEEEEEEEE                 *RdEEEEEEE",
"EEEEEEEEEEEEEEEEE                  +RjEEEEEEE",
"EEEEEEEEEEEEEEEE                   %RzEEEEEEE",
"EEEEEEEEEEEEEEEE                   =RcEEEEEEE",
"EEEEEEEEEEEEEEE                    =Rc EEEEEE",
"EEEEEEEEEEEEEEE                    ;Rz EEEEEE",
"EEEEEEEEEEEEEEE                    ,Rh EEEEEE",
"EEEEEEEEEEEEEEE                    ,Rh EEEEEE",
"EEEEEEEEEEEEEEE                    1MuEEEEEEE",
"EEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEE",
"EEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEE",
"EEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEE",
"EEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEE",
"EEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEE"
};

dragndrop.lisp

;;; -*- Mode: Lisp; Package: CLIM-DEMO -*-

;;;  (c) copyright 2004 by 
;;;           Tim Moore ([email protected])

;;; This library is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU Library General Public
;;; License as published by the Free Software Foundation; either
;;; version 2 of the License, or (at your option) any later version.
;;;
;;; This library is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;;; Library General Public License for more details.
;;;
;;; You should have received a copy of the GNU Library General Public
;;; License along with this library; if not, write to the 
;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, 
;;; Boston, MA  02111-1307  USA.

(in-package :clim-demo)

(define-application-frame dragndrop ()
  ()
  (:pointer-documentation t)
  (:panes
   (interactor :interactor)
   (scratchpad :application :display-time nil :height 600 :scroll-bars nil))
  (:layouts
    (default
      (vertically ()
	(scrolling (:height 300)
	  scratchpad)
	interactor))))
(defvar *image*)
(defclass shape ()
  ((x :accessor x :initarg :x)
   (y :accessor y :initarg :y)))

(defclass circle (shape)
  ())

(define-dragndrop-command (com-add-circle)
    ((x real :prompt "x")
     (y real :prompt "y"))
  (with-output-as-presentation
      (t (make-instance 'circle :x x :y y) 'circle)
    (draw-pattern* *standard-output* *image*
                   x y)))

(define-dragndrop-command (com-quit-dragndrop :name "Quit")
    ()
  (frame-exit *application-frame*))

(define-presentation-to-command-translator translator-draw-circle
    (blank-area com-add-circle dragndrop
                :documentation "Add a circle")
    (object x y)
  (list x y))

(define-dragndrop-command (com-clone-circle)
    ((original circle)
     (start-x real)
     (start-y real))
  ;; Track the pointer offset from the center of the original object
  (let ((x-offset (- (x original) start-x))
	(y-offset (- (y original) start-y)))
    (multiple-value-bind (final-x final-y)
	(dragging-output (t :finish-on-release t)
          (draw-pattern* *standard-output* *image*
                         (x original) (y original)))
      (com-add-circle (+ final-x x-offset)
		      (+ final-y y-offset)))))

(define-presentation-to-command-translator translator-clone-circle
    (circle com-clone-circle dragndrop)
    (object x y)
  `(,object ,x ,y))

(defun drag-circles ()
  (let ((*image* (make-pattern-from-bitmap-file "bn.xpm" :format :xpm)))
   (run-frame-top-level (make-application-frame 'dragndrop))))