I saw you got a reply to this, but thought you might be interested
in some of my code to do something that is somewhat similar.
It draws boxes with pointers that automatically adjust themselves
when others move around--box and pointer diagrams for scheme. The
source is available at
ftp://paris.cs.berkeley.edu/pub/EnvDraw/
-josh
> 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 Thu Feb 29 1996 - 05:46:16 CET