-
Notifications
You must be signed in to change notification settings - Fork 0
/
png-texture.lisp
57 lines (48 loc) · 2.14 KB
/
png-texture.lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
;; png-texture.lisp
;;
;; Copyright (c) 2023 Jeremiah LaRocco <jeremiah_larocco@fastmail.com>
(in-package #:simple-gl)
(defclass png-texture (texture)
((file-name :initarg :filename
:type (or string path))
(png-data :initform nil)))
(defmethod initialize ((tex png-texture) &key)
(format t "Initializing texture!~%")
(with-slots (textures tex-type size png-data file-name) tex
(when textures
(error "Initializing texture twice ~a" tex))
(setf textures (gl:gen-textures 1))
(bind tex)
(setf png-data (simple-png:read-png file-name))
(setf size (subseq (array-dimensions png-data) 0 2))
(%gl:tex-storage-2d tex-type 1 (if (= 4 (array-dimension png-data 2))
:rgba8
:rgb8)
(array-dimension png-data 0)
(array-dimension png-data 1) )
(fill-texture tex)))
(defmethod fill-texture ((object png-texture))
(with-slots (size tex-type png-data file-name) object
(when (null png-data)
(setf png-data (simple-png:read-png file-name))
(when (null png-data)
(error "Could not read ~a" file-name))
(setf size (subseq (array-dimensions png-data) 0 2)))
(when (not (null png-data))
(gl:tex-sub-image-2d tex-type 0
0 0
(array-dimension png-data 0)
(array-dimension png-data 1)
(if (= 3 (array-dimension png-data 2))
:rgb
:rgba)
:unsigned-byte
(make-array (apply #'* (array-dimensions png-data))
:element-type '(unsigned-byte 8)
:displaced-to png-data))
(gl:generate-mipmap tex-type))))
(defun png-quad (file-name)
(make-instance 'sgl:quad
:styles (list (cons :blt
(sgl:make-style-from-files "texture.frag" "texture.vert")))
:textures (list (make-instance 'sgl:png-texture :filename file-name))))