我尝试了用" 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)