1 ;; Common Lisp bindings for GTK+ v2.0
2 ;; Copyright (C) 2004 Espen S. Johnsen <espen@users.sf.net>
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.
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.
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
18 ;; $Id: pixbuf.lisp,v 1.1 2004-12-28 20:26:01 espen Exp $
23 (defbinding pixbuf-get-option () (copy-of string)
27 (defbinding %pixbuf-new-from-file () (referenced pixbuf)
31 (defbinding %pixbuf-new-from-file-at-size () (referenced pixbuf)
38 (defbinding %pixbuf-new-from-file-at-scale () (referenced pixbuf)
42 (preserve-aspect-ratio boolean)
45 (defun pixbuf-load (filename &key width height size (preserve-aspect-ratio t))
47 (unless preserve-aspect-ratio
48 (warn ":preserve-aspect-ratio not supported with this version of Gtk"))
52 #-gtk2.6(%pixbuf-new-from-file-at-size filename size size)
53 #+gtk2.6(%pixbuf-new-from-file-at-scale filename size size preserve-aspect-ratio))
55 #-gtk2.6(%pixbuf-new-from-file-at-size filename width height)
56 #+gtk2.6(%pixbuf-new-from-file-at-scale filename width height preserve-aspect-ratio))
58 (error "Both :width and :height must be specified"))
59 ((%pixbuf-new-from-file filename))))
62 ;; (defbinding pixbuf-get-file-info () (copy-of pixbuf-format)
63 ;; (filename pathname)
67 (defbinding %pixbuf-savev () boolean
71 (keys (vector (or null string)))
72 (values (vector (or null string)))
75 (defun pixbuf-save (pixbuf filename type &rest options)
76 (let ((keys (make-array 0 :adjustable t :fill-pointer t))
77 (values (make-array 0 :adjustable t :fill-pointer t)))
79 as (key value . rest) = options then rest
80 do (vector-push-extend (string-downcase key) keys)
84 (symbol (string-downcase value))
85 (number (format nil "~A" value)))
87 (vector-push-extend nil keys)
88 (vector-push-extend nil values)
89 (%pixbuf-savev pixbuf filename type keys values)))
91 (defbinding pixbuf-new-from-xpm-data () (referenced pixbuf)
92 (data (vector string)))
94 (defbinding %pixbuf-new-subpixbuf () pixbuf ;; or (referenced pixbuf)?
96 (x int) (y int) (width int) (height int))
98 (defbinding %pixbuf-copy () (referenced pixbuf)
101 (defun copy-pixbuf (pixbuf &optional x y width height)
102 (if (and (not x) (not y) (not width) (not height))
103 (%pixbuf-copy pixbuf)
104 (%pixbuf-new-subpixbuf pixbuf x y width height)))
109 (defbinding pixbuf-add-alpha
110 (pixbuf &optional substitute-color (red 255) (green 255) (blue 255))
113 (substitute-color boolean)