(in-package #:cl-user)

(defpackage #:sdl-intro (:use #:common-lisp))

(in-package #:sdl-intro)

(ql:quickload "sdl2")

(defun null-ptr? (alien-val)
  (cffi:null-pointer-p (autowrap:ptr alien-val)) )

(defun render-then-quit (&aux (w 800) (h 600)
                           sz screen renderer texture buffer buffer-ptr)
  (setf sz (* w h))

  (unless (zerop (sdl2-ffi.functions:sdl-init sdl2-ffi:+sdl-init-video+))
    (error "Coudl not init video"))

  (setf screen
    (sdl2-ffi.functions:sdl-create-window
     "Tiny Renderer"
     ;; the OS positions the window
     sdl2-ffi:+sdl-windowpos-undefined+ sdl2-ffi:+sdl-windowpos-undefined+
     w h
     sdl2-ffi:+sdl-window-opengl+) )

  (when (null-ptr? screen)
    (error "No window screen") )

  ;; default monitor, no flags like vsync
  (setf renderer
    (sdl2-ffi.functions:sdl-create-renderer screen -1 0))

  (when (null-ptr? renderer)
    (error "Could not make renderer") )
  (setf texture
    (sdl2-ffi.functions:sdl-create-texture
     renderer
     sdl2-ffi:+sdl-pixelformat-argb8888+
     sdl2-ffi:+sdl-textureaccess-streaming+
     w h) )

  (when (null-ptr? texture)
    (error "Could not make texture") )
  (setf buffer (make-array sz :initial-element 0
                           :element-type '(unsigned-byte 32)) )
  (loop for x from (* w 150) to (* w 250) do
    (setf (aref buffer x) #xFFFF0000)) ; red

  (loop for x from (* w 250) to (* w 350) do
    (setf (aref buffer x) #xFF00FF00)) ; green

  (loop for x from (* w 350) to (* w 450) do
    (setf (aref buffer x) #xFF0000FF)) ; blue

  (setf buffer-ptr (cffi:foreign-array-alloc buffer `(:array :uint32 ,sz)))
                ;; if ptr allocated separately
                ;; (cffi:lisp-array-to-foreign buffer buffer-ptr `(:array :uint32 ,sz))

  (unless (zerop (sdl2-ffi.functions:sdl-update-texture
                  texture nil buffer-ptr
                  (* w (cffi:foreign-type-size :uint32)) ))
    (error "Could not update texture"))

  (cffi:foreign-array-free buffer-ptr)

  ;; technically clearing is not needed since the texture is the
  ;; size of the screen, but if another program drew over the
  ;; display (like steam overlay) it doesn't hang around

  (sdl2-ffi.functions:sdl-set-render-draw-color renderer 0 0 0 255)

  (sdl2-ffi.functions:sdl-render-clear renderer)

  ;; copy the whole thing
  (sdl2-ffi.functions:sdl-render-copy renderer texture nil nil)

  (sdl2-ffi.functions:sdl-render-present renderer)

  (sleep 5)

  (sdl2-ffi.functions:sdl-destroy-texture texture)

  (sdl2-ffi.functions:sdl-destroy-renderer renderer)

  (sdl2-ffi.functions:sdl-destroy-window screen)

  (sdl2-ffi.functions:sdl-quit))
(render-then-quit)