如何使用ltk显示图像?

时间:2008-09-16 22:28:51

标签: lisp tcl tk sbcl ltk

我已编写代码来读取windows位图,现在想用ltk显示它。我该如何构造一个合适的对象?在ltk中有这样的功能吗?如果不是,我怎么能直接连接到tk?

2 个答案:

答案 0 :(得分:3)

我使用LTK已经有一段时间了,但使用LTK显示图像的最简单方法如下:

(defpackage #:ltk-image-example
  (:use #:cl #:ltk))

(in-package #:ltk-image-example)

(defun image-example ()
  (with-ltk ()
    (let ((image (make-image)))
      (image-load image "testimage.gif")
      (let ((canvas (make-instance 'canvas)))
        (create-image canvas 0 0 :image image)
        (configure canvas :width 800)
        (configure canvas :height 640)
        (pack canvas)))))

不幸的是,默认情况下你可以对图像做些相当有限,而且你只能使用gif或ppm图像 - 但ppm file format非常简单,你可以轻松地从你的位图创建一个ppm图像。但是,您说您想要操纵显示的图像,并查看定义图像对象的代码:

(defclass photo-image(tkobject)
  ((data :accessor data :initform nil :initarg :data)
   )
  )

(defmethod widget-path ((photo photo-image))
  (name photo))

(defmethod initialize-instance :after ((p photo-image)
                                       &key width height format grayscale data)
  (check-type data (or null string))
  (setf (name p) (create-name))
  (format-wish "image create photo ~A~@[ -width ~a~]~@[ -height ~a~]~@[ -format \"~a\"~]~@[ -grayscale~*~]~@[ -data ~s~]"
               (name p) width height format grayscale data))

(defun make-image ()
  (let* ((name (create-name))
     (i (make-instance 'photo-image :name name)))
    ;(create i)
    i))

(defgeneric image-load (p filename))
(defmethod image-load((p photo-image) filename)
  ;(format t "loading file ~a~&" filename)
  (send-wish (format nil "~A read {~A} -shrink" (name p) filename))
  p)

看起来图像的实际数据由Tcl / Tk解释器存储,无法从lisp中访问。如果您想访问它,您可能需要使用 format-wish send-wish 编写自己的函数。

当然你可以简单地在画布对象上单独渲染每个像素,但我认为你不会在这方面取得很好的性能,一旦你试图显示超过几千个画布小部件就会有点慢不同的东西就可以了。总而言之 - 如果你不关心实时做任何事情,你可以在每次想要显示它时将你的位图保存为.ppm图像,然后只需使用上面的代码加载它 - 这将是最简单的。否则,您可以尝试从tk本身访问数据(在将其作为ppm映像加载一次之后),最后如果这些都不起作用,您可以切换到另一个工具包。大多数体面的lisp GUI工具包都是针对linux的,所以如果你使用的是windows,你可能会运气不好。

答案 1 :(得分:2)

Tk本身不支持Windows位图文件。但是,“Img”扩展功能可以在几乎所有平台上免费使用。您不需要读取数据,可以直接从磁盘上的文件创建映像。在简单的tcl / tk中,您的代码可能如下所示:

package require Img
set image [image create photo -file /path/to/image.bmp]
label .l -image $image
pack .l

可以在http://wiki.tcl.tk/6165

找到更多信息