Hi,
I've been back at trying to write a REPL for my game lately, taking the
on-screen approach to avoid multi-threading issues.
I had the idea of writing a stream class (extending trivial gray streams) to
automatically draw text to a surface, but my code crashes under Windows/SBCL
for reasons which I can't determine. Annoyingly, the same code runs
perfectly under Allegro CL. I wasn't sure whether to post the crash here, or
in sbcl-devel, but I figured I'd try here first to see if anyone has any
ideas.
I have attached the source code for people to read and test.
This is the error message I get using Windows XP SP 3, SBCL 1.0.13, and
Lispbuilder r747. I recently broke my Linux box, so I can't test this under
Linux right now.
* (main)
idle loop start
fatal error encountered in SBCL pid 1412:
GC invariant lost, file "gencgc.c", line 833
Welcome to LDB, a low-level debugger for the Lisp runtime environment.
If you want any information from ldb would be useful, let me know.
Any help would be appreciated. Thanks in advance.
--
Elliott Slaughter
"Any road followed precisely to its end leads precisely nowhere." - Frank
Herbert
(asdf:oos 'asdf:load-op :lispbuilder-sdl)
(asdf:oos 'asdf:load-op :trivial-gray-streams)
(defgeneric handle-key-down (key)
(:method (key) (format t "Key Pressed: ~a.~%" key))
(:method ((key (eql :sdl-key-escape))) (sdl:push-quit-event)))
(defgeneric handle-key-up (key)
(:method (key)))
(defgeneric font-definition (object))
(defgeneric font (object))
(defclass surface-stream (trivial-gray-streams:trivial-gray-stream-mixin)
((surface :accessor surface :initarg :surface)
(font-definition :accessor font-definition :initarg :font-definition
:initform sdl:*font-8x13*)
(font :reader font)
(color :accessor color :initarg :color
:initform (sdl:any-color-but-this sdl:*default-color*))
(background-color :accessor background-color :initarg :background-color
:initform sdl:*default-color*)
(contents :initform "")))
(defmethod initialize-instance :after
((stream surface-stream)
&rest initargs &key (font-definition sdl:*font-8x13*) &allow-other-keys)
(declare (ignore initargs))
(setf (slot-value stream 'font) (sdl:initialise-font font-definition)))
(defmethod (setf font-definition)
:after (font-definition (stream surface-stream))
(setf (slot-value stream 'font) (sdl:initialise-font font-definition)))
(defmethod trivial-gray-streams:stream-write-sequence
((stream surface-stream) sequence start end &key)
(setf (slot-value stream 'contents)
(with-output-to-string (string)
(write-sequence sequence string :start start :end end))))
(defmethod draw-stream-at-* ((stream surface-stream) x y
&key (surface sdl:*default-surface*))
(sdl:fill-surface (background-color stream) :surface (surface stream))
(with-input-from-string (string (slot-value stream 'contents))
(do ((x 0) (y 0 (incf y))
(line (read-line string nil nil)
(read-line string nil nil)))
((not line))
(sdl:draw-string-solid-*
line
x (* y (sdl:char-height (font stream)))
:surface (surface stream) :font (font stream) :color (color stream))))
(sdl:draw-surface-at-* (surface stream) x y :surface surface))
(defun main ()
(sdl:with-init (sdl:sdl-init-video)
(sdl:window 200 100)
(sdl:initialise-default-font)
(let* ((red (sdl:create-surface 100 100 :alpha 127))
(blue (sdl:create-surface 100 100 :alpha 127))
(stream (make-instance 'surface-stream :surface red :background-color sdl:*red* :color sdl:*white*)))
(sdl:with-events ()
(:quit-event () t) ; t for quit, (return-from main) for toplevel
(:key-down-event (:key key)
(handle-key-down key))
(:key-up-event (:key key)
(handle-key-up key))
(:idle ()
(format t "idle loop start~%")
(sdl:fill-surface sdl:*black*)
(format t "after first fill~%")
(sdl:fill-surface sdl:*blue* :surface blue)
(format t "before stream write~%")
(trivial-gray-streams:stream-write-sequence stream "Hello World!" 0 nil)
(format t "before stream draw~%")
(draw-stream-at-* stream 0 0)
(sdl:draw-surface-at-* blue 50 0)
(sdl:update-display)
(format t "idle loop end~%")))))
(#-allegro quit #+allegro exit))_______________________________________________
application-builder mailing list
[email protected]
http://www.lispniks.com/mailman/listinfo/application-builder
