[lnkForumImage]
TotalShareware - Download Free Software

Confronta i prezzi di migliaia di prodotti.
Asp Forum
 Home | Login | Register | Search 


 

Forums >

comp.lang.lisp

bring code to run

Jens Kallup

6/1/2016 5:53:00 AM

Hello communit,

I have the following code; but it will not execute - why?
It would be great, if somebody can help me out.
The code self, should be run in SBCL.

TIA
Jens


(ql:quickload '(:cl-opengl :cl-glu :cl-glut :zpng))

(defclass hello-window (glut:window) ()
(:default-initargs :pos-x 100 :pos-y 100 :width 250 :height 250
:mode '(:single :rgba) :title "hello"))

(defmethod glut:display-window :before ((w hello-window))
;; Select clearing color.
(gl:clear-color 0 0 0 0)
;; Initialize viewing values.
(gl:matrix-mode :projection)
(gl:load-identity)
(gl:ortho 0 1 0 1 -1 1))

(defmethod glut:display ((w hello-window))
(gl:clear :color-buffer)
(gl:color 0.4 1 0.6)
(gl:with-primitive :polygon
(gl:vertex 0.25 0.25 0)
(gl:vertex 0.75 0.25 0)
(gl:vertex 0.25 0.55 0))
(gl:flush))

(defmethod glut:keyboard ((w hello-window) key x y)
(declare (ignore x y))
(when (eql key #\Esc)
(glut:destroy-current-window))
(when (eql key #\r)
(let* ((mypng (make-instance 'zpng:png :width 250 :height 250))
(imagedata (zpng:data-array mypng))
(sample1 (gl:read-pixels 0 0 250 250 :bgra :unsigned-byte)))
(format t "read~%")
(dotimes (i (expt 250 2))
(multiple-value-bind (h w) (floor i 250)
(setf (aref imagedata (- 249 h) w 0) (aref sample1 (+ 2
(* i 4))))
(setf (aref imagedata (- 249 h) w 1) (aref sample1 (+ 1
(* i 4))))
(setf (aref imagedata (- 249 h) w 2) (aref sample1 (+ 0
(* i 4))))))
(zpng:write-png mypng #p"/tmp/readpixels.png"))
(format t "written~%")))

(defun rb-hello ()
(glut:display-window (make-instance 'hello-window)))
2 Answers

taruss

6/2/2016 12:52:00 AM

0

On Tuesday, May 31, 2016 at 10:53:42 PM UTC-7, Jens Kallup wrote:
[Snip]
What happens when you try to run it?
What sort of error messages do you get?

Jens Kallup

6/2/2016 6:43:00 PM

0

Hello taruss,

I forget to manually compile a lib.

Jens