85 lines
3.2 KiB
Common Lisp
85 lines
3.2 KiB
Common Lisp
;;; Implementation of smooth pixelart scaling.
|
|
;;; This is basically the equivalent of CSS `image-rendering: pixelated`
|
|
|
|
;; native render resolution
|
|
(defvar *render-width* 384)
|
|
(defvar *render-height* 256)
|
|
|
|
;; window resolution
|
|
(defvar *window-width* 1200)
|
|
(defvar *window-height* 800)
|
|
|
|
(defvar *render-tex* (gl:gen-texture))
|
|
(defvar *render-fb* (gl:gen-framebuffer))
|
|
|
|
(defvar *upscale-tex* (gl:gen-texture))
|
|
(defvar *upscale-fb* (gl:gen-framebuffer))
|
|
(defvar *upscale-width*)
|
|
(defvar *upscale-height*)
|
|
|
|
(defmacro with-bind-texture ((target texture) &body body)
|
|
`(progn
|
|
(gl:bind-texture ,target ,texture)
|
|
,@body
|
|
(gl:bind-texture ,target 0)))
|
|
(defmacro with-bind-framebuffer ((target framebuffer) &body body)
|
|
`(progn
|
|
(gl:bind-framebuffer ,target ,framebuffer)
|
|
,@body
|
|
(gl:bind-framebuffer ,target 0)))
|
|
|
|
(defun init-textures ()
|
|
"Initialize textures. Call this whenever the window or render resolution changes."
|
|
;; generate the render texture
|
|
(with-bind-texture (:texture-2d *render-tex*)
|
|
(gl:tex-image-2d
|
|
:texture-2d 0 :rgba
|
|
*render-width* *render-height*
|
|
0 :rgba :unsigned-byte (cffi:null-pointer))
|
|
(gl:tex-parameter :texture-2d :texture-wrap-s :clamp-to-edge)
|
|
(gl:tex-parameter :texture-2d :texture-wrap-t :clamp-to-edge)
|
|
(gl:tex-parameter :texture-2d :texture-min-filter :nearest)
|
|
(gl:tex-parameter :texture-2d :texture-mag-filter :nearest))
|
|
(with-bind-framebuffer (:framebuffer *render-fb*)
|
|
(gl:framebuffer-texture-2d :framebuffer :color-attachment0 :texture-2d *render-tex* 0))
|
|
|
|
;; generate the upscale texture, which is scaled to an integer multiple of the render size
|
|
(setf
|
|
*upscale-width* (* (ceiling *window-width* *render-width*) *render-width*)
|
|
*upscale-height* (* (ceiling *window-height* *render-height*) *render-height*))
|
|
(with-bind-texture (:texture-2d *upscale-tex*)
|
|
(gl:tex-image-2d
|
|
:texture-2d 0 :rgba
|
|
*upscale-width* *upscale-height*
|
|
0 :rgba :unsigned-byte (cffi:null-pointer))
|
|
(gl:tex-parameter :texture-2d :texture-wrap-s :clamp-to-edge)
|
|
(gl:tex-parameter :texture-2d :texture-wrap-t :clamp-to-edge)
|
|
(gl:tex-parameter :texture-2d :texture-min-filter :linear)
|
|
(gl:tex-parameter :texture-2d :texture-mag-filter :linear))
|
|
(with-bind-framebuffer (:framebuffer *upscale-fb*)
|
|
(gl:framebuffer-texture-2d :framebuffer :color-attachment0 :texture-2d *upscale-tex* 0)))
|
|
|
|
(defun before-render ()
|
|
(gl:bind-framebuffer :framebuffer *render-fb*)
|
|
(gl:viewport 0 0 *render-width* *render-height*))
|
|
|
|
(defun after-render ()
|
|
;; upscale with nearest-neighbour
|
|
(gl:bind-framebuffer :framebuffer *upscale-fb*)
|
|
(gl:viewport 0 0 *upscale-width* *upscale-height*)
|
|
(gl:disable :depth-test)
|
|
(gl:enable :texture-2d)
|
|
(gl:bind-texture :texture-2d *render-tex*)
|
|
(draw-full-screen-quad)
|
|
|
|
;; downscale with linear, render to window
|
|
(gl:bind-framebuffer :framebuffer 0)
|
|
(gl:viewport 0 0 *window-width* *window-height*)
|
|
(gl:bind-texture :texture-2d *upscale-tex*)
|
|
(draw-full-screen-quad)
|
|
(gl:bind-texture :texture-2d 0))
|
|
|
|
(defun draw-full-screen-quad ()
|
|
"Draw a quad from (-1,-1) to (1,1). Essentially draw a texture stretched across the entire viewport."
|
|
(not-implemented))
|