stklos question relating to Tk-composite-item and the like.
This is a message for any STklos experts out there. I have a question
possibly relating to <Tk-composite-item> and generally relating to
initialize-item. Here is a current goal of mine: I would like a
canvas item class with the following attributes:
* a canvas figure derived from <oval>
* a <text-item> which will be associated to that figure & will
move around with it.
I would like the user to have complete access to the canvas figure,
without having to extract any slots. i.e. (set! (coords v) ...) etc.
In other words, I don't want to make the whole thing a <Tk-composite-item>
holding the figure and text (instances of such item are created with only
2 coords, not 4, at least if defined as in the tables and chairs STklos
example (E3.stklos)). I would also like the user to have as little
access as possible to the text.
My best attempt so far has been to do something similar. The class will
inherit from <Oval> and define a slot for the text. The following code
goes so far as to print the object on the screen, but the construction
process doesn't complete correctly.
This code is the result of some real blundering around in the dark
any suggestions will be welcomed!
thanks for any much-needed help,
Jon Berry
--------------------------------------------------------------------
(require "Tk-classes")
(define c (make <Canvas>))
(pack c)
;;**************************************************************************
(define-class <vertex> (<oval>)
( (label :initform "v" :getter label :init-keyword :label)
))
;;**************************************************************************
(define-method initialize-item ((self <vertex>) canvas coords args)
(next-method)
(let* ((parent (slot-ref self 'parent))
(x (car coords))
(y (cadr coords))
(txt (make <text-item> :parent parent :anchor "nw"
:coords (list (+ x 12) (+ y 12))
;;; the above seems to set the coords of the
;;; whole object (self)
:text "hello")))
;;; is there a function for extracting values
;;; from the args list?
(slot-set! self 'label txt)
(let* ((Cid (gensym "labeled-vertex")))
(slot-set! self 'Cid Cid)
(add-tag (slot-ref self 'label) Cid)
(bind-for-dragging parent :tag Cid :only-current #f))
(describe self)
;;;
;;; bomb - the coords of self are (22,22) - removing this line
;;; delays the crash until the first access the the
;;; constructed object
;;;
Cid)
)
;;**************************************************************************
(define v (make <vertex> :parent c :coords '(10 10 20 20) :label "v1"
:fill "blue"))
************************************stk 3.0b2 output**********************
STk> (define v (make <vertex> :parent c :coords '(10 10 20 20) :label "v1"
:fill "blue"))
#[<vertex> #p15017c] is an instance of class <vertex>
Slots are:
id = #[Tk-command .v1]
eid = #[Tk-command .v1]
parent = #[<canvas> #p15a310]
cid = labeled-vertex3
tags = ("labeled-vertex3")
coords = (22.0 22.0)
fill = "black"
*** Error:
unknown option "-outline"
Received on Mon Feb 26 1996 - 23:57:08 CET
This archive was generated by hypermail 2.3.0
: Mon Jul 21 2014 - 19:38:59 CEST