agar

Check-in [b31d8954f0]
Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Access to child objects
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1:b31d8954f0fa5f972ec3e31edb548b3de6bb9cce
User & Date: murphy 2016-09-25 12:05:17
Context
2016-09-25
12:54
Fixed documentation of :object-child and object-children check-in: 4239c87528 user: murphy tags: trunk
12:05
Access to child objects check-in: b31d8954f0 user: murphy tags: trunk
10:50
Indirect variable support check-in: e08bcf4470 user: murphy tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to agar.scm.

3
4
5
6
7
8
9
10

11
12
13
14
15
16
17
...
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
...
154
155
156
157
158
159
160
































161
162
163
164
165
166
167
(require-library
  lolevel data-structures ports srfi-42 srfi-69)

(module agar
  (agar-condition? make-agar-condition current-agar-condition check-agar-condition
   init-agar!
   pointer->object object->pointer pointer->class class->pointer
   object? lookup-object make-object destroy-object! object-class object-name object-name-set!

   class? lookup-class class-hierarchy class-version
   object-ref object-set! event-add!
   widget-expand! widget-position-set! widget-size-set!
   make-window window-caption window-caption-set! window-visible? window-visible-set!
   make-box make-button make-checkbox make-radio
   make-textbox textbox-string textbox-string-set!
   event-loop terminate!)
................................................................................

(define (class? v)
  (tagged-pointer? v *class-tag*))

(include
  "agar-types.scm")

(define lookup-object
  (foreign-safe-lambda object "AG_ObjectFindS" nonnull-object nonnull-c-string))

(define (make-object class #!key parent name)
  ((foreign-safe-lambda nonnull-object "AG_ObjectNew" object c-string nonnull-class)
   parent name class))

(define destroy-object!
  (foreign-safe-lambda void "AG_ObjectDestroy" nonnull-object))

................................................................................
         (foreign-lambda* c-string ([nonnull-object obj]) "C_return(obj->name);")]
        [object-name-set!
         (foreign-safe-lambda void "AG_ObjectSetNameS" nonnull-object c-string)])
    (values
      (getter-with-setter object-name object-name-set!)
      object-name-set!)))

































(define lookup-class
  (foreign-safe-lambda class "AG_LookupClass" nonnull-c-string))

(define class-hierarchy
  (foreign-lambda* c-string ([nonnull-class cls]) "C_return(cls->hier);"))

(define class-version







|
>







 







<
<
<







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
...
133
134
135
136
137
138
139



140
141
142
143
144
145
146
...
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
(require-library
  lolevel data-structures ports srfi-42 srfi-69)

(module agar
  (agar-condition? make-agar-condition current-agar-condition check-agar-condition
   init-agar!
   pointer->object object->pointer pointer->class class->pointer
   object? make-object destroy-object! object-class object-name object-name-set!
   lookup-object object-first-child object-last-child object-next-sibling :object-child object-children
   class? lookup-class class-hierarchy class-version
   object-ref object-set! event-add!
   widget-expand! widget-position-set! widget-size-set!
   make-window window-caption window-caption-set! window-visible? window-visible-set!
   make-box make-button make-checkbox make-radio
   make-textbox textbox-string textbox-string-set!
   event-loop terminate!)
................................................................................

(define (class? v)
  (tagged-pointer? v *class-tag*))

(include
  "agar-types.scm")




(define (make-object class #!key parent name)
  ((foreign-safe-lambda nonnull-object "AG_ObjectNew" object c-string nonnull-class)
   parent name class))

(define destroy-object!
  (foreign-safe-lambda void "AG_ObjectDestroy" nonnull-object))

................................................................................
         (foreign-lambda* c-string ([nonnull-object obj]) "C_return(obj->name);")]
        [object-name-set!
         (foreign-safe-lambda void "AG_ObjectSetNameS" nonnull-object c-string)])
    (values
      (getter-with-setter object-name object-name-set!)
      object-name-set!)))

(define lookup-object
  (foreign-safe-lambda object "AG_ObjectFindS" nonnull-object nonnull-c-string))

(define object-first-child
  (foreign-lambda* object ([nonnull-object parent])
    "C_return(AG_TAILQ_FIRST(&AGOBJECT(parent)->children));"))

(define object-last-child
  (foreign-lambda* object ([nonnull-object parent])
    "C_return(AG_TAILQ_END(&AGOBJECT(parent)->children));"))

(define object-next-sibling
  (foreign-lambda* object ([nonnull-object obj])
    "C_return(AG_TAILQ_NEXT(AGOBJECT(obj), cobjs));"))

(define-syntax :object-child
  (syntax-rules ()
    [(:object-child cc child parent-expr)
     (:do cc
       (let ([parent parent-expr] [first #f] [last #f])
         (when parent
           (set! first (object-first-child parent)))
           (set! last (object-last-child parent)))
       ([child first])
       (not (equal? child last))
       (let ())
       #t
       ((object-next-sibling child)))]))

(define (object-children parent)
  (list-ec (:object-child child parent) child))

(define lookup-class
  (foreign-safe-lambda class "AG_LookupClass" nonnull-c-string))

(define class-hierarchy
  (foreign-lambda* c-string ([nonnull-class cls]) "C_return(cls->hier);"))

(define class-version

Changes to agar.wiki.

52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
..
77
78
79
80
81
82
83













84
85
86
87
88
89
90

<h2>Object System</h2>

<h3><a id="object_">procedure: <code><nowiki>(object? ANY [CLASS]) → BOOLEAN</nowiki></code></a></h3>

Checks whether the given value is an Agar object (of the given class).

<h3><a id="lookup-object">procedure: <code><nowiki>(lookup-object OBJECT PATH) → OBJECT</nowiki></code></a></h3>

Locates an object by its name and the names of its parents, starting at a given
root object.

<h3><a id="make-object">procedure: <code><nowiki>(make-object CLASS [parent: OBJECT] [name: STRING]) → OBJECT</nowiki></code></a></h3>

Creates a new object of the given class, optionally attached to the given
parent and identified by the given name.

<h3><a id="destroy-object_">procedure: <code><nowiki>(destroy-object! OBJECT) → UNSPECIFIED</nowiki></code></a></h3>

................................................................................
<h3><a id="object-name">procedure: <code><nowiki>(object-name OBJECT) → STRING</nowiki></code></a></h3>
<h3><a id="object-name-set_">procedure: <code><nowiki>(object-name-set! OBJECT STRING) → UNSPECIFIED</nowiki></code></a></h3>

Accessors for the name identifying an Agar object within the context of the
parent it is attached to.

<tt>object-name</tt> has <tt>object-name-set!</tt> attached as a setter.














<h3><a id="class_">procedure: <code><nowiki>(class? ANY) → BOOLEAN</nowiki></code></a></h3>

Checks whether the given value is an Agar class descriptor.

<h3><a id="lookup-class">procedure: <code><nowiki>(lookup-class NAME) → CLASS</nowiki></code></a></h3>








<
<
<
<
<







 







>
>
>
>
>
>
>
>
>
>
>
>
>







52
53
54
55
56
57
58





59
60
61
62
63
64
65
..
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98

<h2>Object System</h2>

<h3><a id="object_">procedure: <code><nowiki>(object? ANY [CLASS]) → BOOLEAN</nowiki></code></a></h3>

Checks whether the given value is an Agar object (of the given class).






<h3><a id="make-object">procedure: <code><nowiki>(make-object CLASS [parent: OBJECT] [name: STRING]) → OBJECT</nowiki></code></a></h3>

Creates a new object of the given class, optionally attached to the given
parent and identified by the given name.

<h3><a id="destroy-object_">procedure: <code><nowiki>(destroy-object! OBJECT) → UNSPECIFIED</nowiki></code></a></h3>

................................................................................
<h3><a id="object-name">procedure: <code><nowiki>(object-name OBJECT) → STRING</nowiki></code></a></h3>
<h3><a id="object-name-set_">procedure: <code><nowiki>(object-name-set! OBJECT STRING) → UNSPECIFIED</nowiki></code></a></h3>

Accessors for the name identifying an Agar object within the context of the
parent it is attached to.

<tt>object-name</tt> has <tt>object-name-set!</tt> attached as a setter.

<h3><a id="lookup-object">procedure: <code><nowiki>(lookup-object OBJECT PATH) → OBJECT</nowiki></code></a></h3>

Locates an object by its name and the names of its parents, starting at a given
root object.

<h3><a id="_object-child">syntax: <code><nowiki>(:object-child <VARIABLE> OBJECT)</nowiki></code></a></h3>

Generator for the children of a given Agar object.

<h3><a id="object-children">syntax: <code><nowiki>(object-children OBJECT) → LIST</nowiki></code></a></h3>

Returns the children of a given Agar object as a list.

<h3><a id="class_">procedure: <code><nowiki>(class? ANY) → BOOLEAN</nowiki></code></a></h3>

Checks whether the given value is an Agar class descriptor.

<h3><a id="lookup-class">procedure: <code><nowiki>(lookup-class NAME) → CLASS</nowiki></code></a></h3>