gl-texbuf.k

(require "libgl.k")

(define-structure <texbuf> (texture bits x y w h stride texheight))

(define-function next-higher-power-of-two (n)
  (decr n)
  (set n (| n (>> n 32)))
  (set n (| n (>> n 16)))
  (set n (| n (>> n  8)))
  (set n (| n (>> n  4)))
  (set n (| n (>> n  2)))
  (set n (| n (>> n  1)))
  (+ n 1))

(define-method resize <texbuf> (width height)
  (let ((w2 (next-higher-power-of-two width))
	(h2 (next-higher-power-of-two height)))
    (glViewport 0 0 width height)
    (glMatrixMode GL_PROJECTION)
    (glLoadIdentity)
    (glOrtho 0.0 (long->double width) 0.0 (long->double height) -1.0 1.0)
    (glMatrixMode GL_MODELVIEW)
    (set self.w width)    (set self.stride w2)
    (set self.h height)   (set self.texheight h2)
    (set self.bits (data (* sizeof-int (* w2 h2))))
    (println "texture "self.texture" "self.w"x"self.h" ["self.stride"x"self.texheight"] "self.bits)
    (glBindTexture   GL_TEXTURE_2D self.texture)
    (glTexImage2D    GL_TEXTURE_2D 0 GL_RGBA self.stride self.texheight 0 GL_RGBA GL_UNSIGNED_BYTE self.bits)
    (glBindTexture   GL_TEXTURE_2D 0)
    self))

(define-function texbuf (w h . optxy)
  (let ((tmp  (data sizeof-int))
	(id   0)
	;;(bits (data (* sizeof-int (* w h))))
	)
    (glEnable GL_TEXTURE_2D)
    (glGenTextures 1 tmp)
    (set id (long-at tmp 0))
    (println "texture "id" "w"x"h)
    (glBindTexture GL_TEXTURE_2D id)
    ;;(glTexImage2D    GL_TEXTURE_2D 0 GL_RGBA w h 0 GL_RGBA GL_UNSIGNED_BYTE bits)
    (glTexParameteri GL_TEXTURE_2D GL_TEXTURE_WRAP_S GL_CLAMP_TO_EDGE)
    (glTexParameteri GL_TEXTURE_2D GL_TEXTURE_WRAP_T GL_CLAMP_TO_EDGE)
    (glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER GL_LINEAR)
    (glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER GL_LINEAR)
    (glBindTexture   GL_TEXTURE_2D 0)
    ;;(resize (new <texbuf> id bits (or (car optxy) 0) (or (cadr optxy) 0) w h) w h)
    (resize (new <texbuf> id () (or (car optxy) 0) (or (cadr optxy) 0) w h) w h)
    ))

(define-method flush <texbuf> ()
  (glBindTexture   GL_TEXTURE_2D self.texture)
  ;;(glTexImage2D    GL_TEXTURE_2D 0 GL_RGBA self.stride self.texheight 0 GL_RGBA GL_UNSIGNED_BYTE self.bits)
  (glTexSubImage2D GL_TEXTURE_2D 0 0 0 self.stride self.h GL_RGBA GL_UNSIGNED_BYTE self.bits)
  (glBindTexture   GL_TEXTURE_2D 0))

(define-method gl-render <texbuf> ()
  (flush self)
  (let ((x1  (long->double    self.x        ))
	(x2  (long->double (+ self.x self.w)))
	(y1  (long->double    self.y        ))
	(y2  (long->double (+ self.y self.h)))
	(txw (/ (long->double self.w) (long->double self.stride)))
	(txh (/ (long->double self.h) (long->double self.texheight)))
	)
    (glBindTexture GL_TEXTURE_2D self.texture)
    (glBegin GL_QUADS)
    (glTexCoord2f 0.0 txh)	(glVertex3f x1 y1 0.0)
    (glTexCoord2f 0.0 0.0)	(glVertex3f x1 y2 0.0)
    (glTexCoord2f txw 0.0)	(glVertex3f x2 y2 0.0)
    (glTexCoord2f txw txh)	(glVertex3f x2 y1 0.0)
    (glEnd)
    ;;(glBegin GL_TRIANGLE_STRIP)
    ;;(glTexCoord2f 0.0 txh)	(glVertex3f x1 y1 0.0)
    ;;(glTexCoord2f 0.0 0.0)	(glVertex3f x1 y2 0.0)
    ;;(glTexCoord2f txw txh)	(glVertex3f x2 y1 0.0)
    ;;(glTexCoord2f txw 0.0)	(glVertex3f x2 y2 0.0)
    ;;(glEnd)
    (glBindTexture GL_TEXTURE_2D 0)))

(define clip-line list)

(define-function fabs (x) (if (< x 0.0) (- x) x))
(define-function abs (x) (if (< x 0) (- x) x))
(define-function sgn (x) (if (< x 0) -1 1))

(define-method fill <texbuf> (p)
  (for (i 0 (/ (data-length self.bits) sizeof-long))
    (set-int-at self.bits i p)))

(define-method fill-rect <texbuf> (x1 y1 x2 y2 p)
  (for (x x1 x2)
    (for (y y1 y2)
      (set-int-at self.bits (+ (* y self.stride) x) p))))

(define-method draw-line <texbuf> (ix1 iy1 ix2 iy2 pixel)
  (let* (((x1 y1 x2 y2) (clip-line ix1 iy1 ix2 iy2))
	 (nx (- x2 x1))	 (ax (abs nx))
	 (ny (- y2 y1))	 (ay (abs ny)))
    (if (>= ax ay)
	(let ((x x1)  (dx (sgn nx))
	      (y (long->double y1))  (dy (/ (long->double (- y2 y1)) (long->double ax))))
	  (while (>= ax 0)
	    (decr ax)
	    (set-int-at self.bits (+ (* self.stride (double->long y)) x) pixel)
	    (incr x dx)
	    (incr y dy)))
      (let ((y y1)  (dy (sgn ny))
	    (x (long->double x1))  (dx (/ (long->double (- x2 x1)) (long->double ay))))
	(while (>= ay 0)
	  (decr ay)
	  (set-int-at self.bits (+ (* self.stride y) (double->long x)) pixel)
	  (incr y dy)
	  (incr x dx))))))