在CLIM中,如何以正确的方式在应用程序窗格上显示图像?

时间:2015-07-02 17:05:20

标签: common-lisp sbcl clim

我尝试了用" image-viewer"写的方法。例如,但是当我运行该示例时,程序会泄漏内存。每次调用函数draw-pattern *时,(room)报告的内存都会增加,最终SBCL会耗尽内存,所以游戏结束了。

我使用make-pattern-from-bitmap-file创建模式,然后用draw-pattern *显示它。代码如下:

(ql:quickload 'mcclim)
(ql:quickload 'mcclim-gif-bitmaps)

(defpackage #:display-image
  (:use #:clim #:clim-lisp))

(in-package #:display-image)

(define-application-frame img-viewer ()
  ((img-pattern :initform 'nil))
  (:panes
   (int-pane (make-clim-interactor-pane :name 'interactor))
   (canvas-pane (make-clim-application-pane
         :name 'canvas
         :scroll-bars t
         :display-time :command-loop
         :display-function #'draw-image)))
  (:layouts
   (default
       (vertically (:min-height 650 :max-height 800)
         (3/4 (labelling (:label "Image") canvas-pane))
         (1/4 int-pane))))
  (:menu-bar t))

(defmethod draw-image ((frame img-viewer) stream)
  (with-slots (img-pattern) *application-frame*
    (if img-pattern
        (draw-pattern* stream img-pattern
               (/ (- (bounding-rectangle-width stream)
                     (pattern-width img-pattern)) 2)
               0))))

(define-img-viewer-command (com-quit :name t :menu t) ()
  (frame-exit *application-frame*))

(define-img-viewer-command (com-change-img :name t :menu t)
    ((img-pathname 'pathname
           :default (user-homedir-pathname)
           :insert-default t))
  (if (and (probe-file img-pathname)
           (string= "GIF" (string-upcase (pathname-type img-pathname))))
      (with-slots (img-pattern) *application-frame*
        (setf img-pattern
              (make-pattern-from-bitmap-file img-pathname
                                             :format :gif)))))

(run-frame-top-level (make-application-frame 'img-viewer)

0 个答案:

没有答案