2ca6ee06 |
1 | ;; Common Lisp bindings for GTK+ v2.0 |
2 | ;; Copyright (C) 2000 Espen S. Johnsen <esj@stud.cs.uit.no> |
3 | ;; |
4 | ;; This library is free software; you can redistribute it and/or |
5 | ;; modify it under the terms of the GNU Lesser General Public |
6 | ;; License as published by the Free Software Foundation; either |
7 | ;; version 2 of the License, or (at your option) any later version. |
8 | ;; |
9 | ;; This library is distributed in the hope that it will be useful, |
10 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
11 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
12 | ;; Lesser General Public License for more details. |
13 | ;; |
14 | ;; You should have received a copy of the GNU Lesser General Public |
15 | ;; License along with this library; if not, write to the Free Software |
16 | ;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA |
17 | |
18 | ;; $Id: gparam.lisp,v 1.1 2001/01/28 14:18:44 espen Exp $ |
19 | |
20 | (in-package "GLIB") |
21 | |
22 | (deftype gvalue () 'pointer) |
23 | |
24 | (defconstant +gvalue-size+ (+ (size-of 'type-number) (* 4 (size-of 'double-float)))) |
25 | (defconstant +gvalue-value-offset+ (size-of 'type-number)) |
26 | |
27 | (define-foreign ("g_value_init" gvalue-init) () nil |
28 | (type type-number)) |
29 | |
30 | (defun gvalue-new (type) |
31 | (let ((gvalue (allocate-memory +gvalue-size+))) |
32 | (setf (system:sap-ref-32 gvalue 0) type) |
33 | ; (gvalue-init (type-number-of type)) |
34 | gvalue)) |
35 | |
36 | (defun gvalue-free (gvalue free-content) |
37 | (unless (null-pointer-p gvalue) |
38 | (when free-content |
39 | (funcall |
40 | (get-destroy-function (gvalue-type gvalue)) |
41 | gvalue +gvalue-value-offset+)) |
42 | (deallocate-memory gvalue))) |
43 | |
44 | (defun gvalue-type (gvalue) |
45 | (type-from-number (system:sap-ref-32 gvalue 0))) |
46 | |
47 | (defun gvalue-get (gvalue) |
48 | (funcall |
49 | (get-reader-function (gvalue-type gvalue)) |
50 | gvalue +gvalue-value-offset+)) |
51 | |
52 | (defun gvalue-set (gvalue value) |
53 | (funcall |
54 | (get-writer-function (gvalue-type gvalue)) |
55 | value gvalue +gvalue-value-offset+) |
56 | value) |
57 | |