#!/usr/local/bin/stk -f
;;;;
;;;; s t k l o s - d e m o 2 . s t k 	  --  A demo which use some STklos classes
;;;;
;;;; Copyright (C) 1993,1994,1995 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
;;;; 
;;;; Permission to use, copy, and/or distribute this software and its
;;;; documentation for any purpose and without fee is hereby granted, provided
;;;; that both the above copyright notice and this permission notice appear in
;;;; all copies and derived works.  Fees for distribution or use of this
;;;; software or derived works may only be charged with express written
;;;; permission of the copyright holder.  
;;;; This software is provided ``as is'' without express or implied warranty.
;;;;
;;;;           Author: Erick Gallesio [eg@unice.fr]
;;;;    Creation date: 24-Aug-1993 19:55
;;;; Last file update: 11-Jul-1995 22:11

(require "Canvas")

(format #t "
This demo file illustrates the use of bind-for-dragging with various 
parameters. 

Button 1 permits to drag any kind of object
Button 2 permits to drag any kind of object and executes user hooks
Button 3 with Shift button pressed permits to move red objects only.\n")


(define c (make <Canvas>))
(pack c)


(define r1 (make <rectangle> :coords '(0 0 50 50) 
		 	     :parent c 
			     :fill "red"
			     :tags "red"))
(define r2 (make <rectangle> :coords '(100 100 150 150) 
		 	     :parent c 
			      :fill "blue"))
(define t  (make <Canvas-Text> :coords '(80 80) 
		 	       :parent c 
			       :fill "red"
			       :tags "red"
			       :text "Hello world!"))

;; Button 1 for dragging objects
(bind-for-dragging c)

;; Button 2 for dragging objects (with user hooks)
(bind-for-dragging c :tag 'all
		     :button 2 
		     :start  (lambda (w x y) (format #t "Start to drag ~S\n" w))
		     :motion (lambda (w x y) (format #t "Move ~A ~A ~A\n" w x y))
		     :stop   (lambda (w x y) (format #t "Stop with ~S\n" w)))

;; Button 3 with Shift for dragging red objects (i.e. r1 and t)

(bind-for-dragging c :tag 'red
		     :button 3
		     :modifier "Shift")