/[cells]/Celtk/canvas.lisp
ViewVC logotype

Contents of /Celtk/canvas.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.9 - (show annotations)
Mon Jan 29 06:48:41 2007 UTC (7 years, 2 months ago) by ktilton
Branch: MAIN
CVS Tags: HEAD
Changes since 1.8: +2 -1 lines
Rough Tile support and first primitive QuickTimeTcl stuff.
1 ;; -*- mode: Lisp; Syntax: Common-Lisp; Package: cells; -*-
2 #|
3
4 Celtk -- Cells, Tcl, and Tk
5
6 Copyright (C) 2006 by Kenneth Tilton
7
8 This library is free software; you can redistribute it and/or
9 modify it under the terms of the Lisp Lesser GNU Public License
10 (http://opensource.franz.com/preamble.html), known as the LLGPL.
11
12 This library is distributed WITHOUT ANY WARRANTY; without even
13 the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
14
15 See the Lisp Lesser GNU Public License for more details.
16
17 |#
18
19 (in-package :Celtk)
20
21 (deftk canvas (widget)
22 ((active :initarg :active :accessor active :initform (c-in t))
23 )
24 (:tk-spec canvas
25 -background -borderwidth -cursor
26 -highlightbackground -highlightcolor -highlightthickness
27 -insertbackground -insertborderwidth -insertofftime -insertontime -insertwidth
28 -relief -selectbackground -selectborderwidth -selectforeground
29 -state -takefocus -xscrollcommand -yscrollcommand
30 -closeenough -confine -height (scroll-region -scrollregion) -width
31 -xscrollincrement -yscrollincrement)
32 (:default-initargs
33 :xscrollcommand (c-in nil)
34 :yscrollcommand (c-in nil)
35 :id (gentemp "CV")
36 :tile? nil))
37
38 (defun focusIn->active ()
39 (list '|<FocusIn>| (lambda (self event &rest args)
40 (declare (ignorable event))
41 (trc "focus in activating" self event args)
42 (setf (^active) t))))
43
44 (defun focusOut->active ()
45 (list '|<FocusOut>| (lambda (self event &rest args)
46 (declare (ignorable event))
47 (trc "focus out de-activating" self event args)
48 (setf (^active) nil))))
49
50 (deftk arc (item)
51 ()
52 (:tk-spec arc
53 -dash
54 -activedash
55 -disableddash
56 -dashoffset
57 (tk-fill -fill)
58 -activefill
59 -disabledfill
60 -offset
61 -outline
62 -activeoutline
63 -disabledoutline
64 -outlinestipple
65 -activeoutlinestipple
66 -disabledoutlinestipple
67 -stipple
68 -activestipple
69 -disabledstipple
70 -state
71 -tags
72 -width
73 -activewidth
74 -disabledwidth
75 -extent -start -style))
76
77 (deftk line (item)
78 ()
79 (:tk-spec line
80 -dash
81 -activedash
82 -disableddash
83 -dashoffset
84 (tk-fill -fill)
85 -activefill
86 -disabledfill
87 -stipple
88 -activestipple
89 -disabledstipple
90 -state
91 -tags
92 -width
93 -activewidth
94 -disabledwidth
95 -arrow -arrowshape -capstyle -joinstyle -smooth -splinesteps))
96

  ViewVC Help
Powered by ViewVC 1.1.5