canvas.lisp

   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