cl-imgui/imgui.lisp

(defpackage :imgui
  (:use :cl))

(in-package :imgui)

(pushnew "/home/eta/common-lisp/imgui/" cffi:*foreign-library-directories*
         :test #'equal)

(cffi:define-foreign-library cimgui
  (t (:default "cimgui")))

(cffi:define-foreign-library cimgui-sdl
  (t (:default "libcimgui_sdl")))

(cffi:define-foreign-library gl3w
  (t (:default "libgl3w")))

(cffi:define-foreign-library sdl
  (t (:default "libSDL2")))

(cffi:use-foreign-library cimgui)
(cffi:use-foreign-library gl3w)
(cffi:use-foreign-library sdl)
(cffi:use-foreign-library cimgui-sdl)

(defparameter +sdl2-init-video+ #x00000020)
(defparameter +sdl2-windowpos-centred+ #x2FFF0000)
(defparameter +sdl2-window-opengl+ #x00000002)
(defparameter +sdl2-window-resizable+ #x00000020)

(cffi:defcfun "SDL_Init" :int
  (flags :uint32))

(cffi:defcenum sdl2-glattr
  :red-size
  :green-size
  :blue-size
  :alpha-size
  :buffer-size
  :doublebuffer
  :depth-size
  :stencil-size
  :accum-red-size
  :accum-green-size
  :accum-blue-size
  :accum-alpha-size
  :stereo
  :multisamplebuffers
  :multisamplesamples
  :accelerated-visual
  :retained-backing
  :context-major-version
  :context-minor-version
  :context-egl
  :context-flags
  :context-profile-mask
  :share-with-current-context
  :framebuffer-srgb-capable
  :context-release-behavior
  :context-reset-notification
  :context-no-error)

(cffi:defcfun "SDL_GetError" :string)

(defun sdlcall (value)
  (when (< value 0)
    (error "SDL error ~A: ~A" value (sdl-geterror)))
  value)

(cffi:defcfun "SDL_GL_SetAttribute" :int
  (attr sdl2-glattr)
  (value :int))

(cffi:defctype sdl-window :pointer)

(cffi:defcfun "SDL_CreateWindow" sdl-window
  (title :string)
  (x :int)
  (y :int)
  (w :int)
  (h :int)
  (flags :uint32))

(cffi:defctype sdl-glcontext :pointer)

(cffi:defcfun "SDL_GL_CreateContext" sdl-glcontext
  (window sdl-window))

(cffi:defctype imgui-ctx :pointer)
(cffi:defctype imgui-io :pointer)

(cffi:defcfun "igCreateContext" imgui-ctx
  (font-atlas :pointer))

(cffi:defcfun "igGetIO" imgui-io)

(cffi:defcfun "ImGui_ImplSDL2_InitForOpenGL" :bool
  (window sdl-window)
  (gl-context sdl-glcontext))

(cffi:defcfun "ImGui_ImplOpenGL3_Init" :bool
  (glsl-version :string))

(cffi:defcfun "igStyleColorsDark" :void
  (style :pointer))

(cffi:defcfun "SDL_PollEvent" :int
  (event :pointer))

(cffi:defcfun "ImGui_ImplSDL2_ProcessEvent" :bool
  (event :pointer))

;; HACK: copied from SDL_Event->padding in SDL_events.h
(defparameter +sdl-event-size+
  (let ((pointer-size (cffi:foreign-type-size :pointer)))
    (cond
      ((<= pointer-size 8) 56)
      ((eql pointer-size 16) 64)
      (t (* 3 pointer-size)))))

(defparameter *sdl-window-ptr* nil)
(defparameter *sdl-gl-context-ptr* nil)
(defparameter *imgui-context-ptr* nil)
(defparameter *imgui-io-ptr* nil)
(defparameter *last-sdl-event-ptr* nil)

(defparameter *frames-per-second* 60)

(defun process-one-sdl-event ()
  (when (eql (sdlcall (sdl-pollevent *last-sdl-event-ptr*)) 1)
    (imgui-implsdl2-processevent *last-sdl-event-ptr*)))

(cffi:defcfun "ImGui_ImplOpenGL3_NewFrame" :void)

(cffi:defcfun "ImGui_ImplSDL2_NewFrame" :void
  (window sdl-window))

(cffi:defcfun "igNewFrame" :void)

(cffi:defcfun "glClearColor" :void
  (red :float)
  (green :float)
  (blue :float)
  (alpha :float))

(cffi:defcfun "glClear" :void
  (mask :uint))

(cffi:defcfun "glEnable" :void
  (capab :uint32))

(cffi:defcfun "glDepthFunc" :void
  (func :uint32))

(defparameter +gl-color-buffer-bit+ #x00004000)
(defparameter +gl-depth-buffer-bit+ #x00000100)
(defparameter +gl-depth-test+ #x0B71)
(defparameter +gl-less+ #x0201)

(defun start-new-frame ()
  (glclearcolor 0.1 0.3 0.4 0.1)
  (glclear (logior +gl-color-buffer-bit+
                   +gl-depth-buffer-bit+))
  (glenable +gl-depth-test+)
  (gldepthfunc +gl-less+)
  (imgui-implopengl3-newframe)
  (imgui-implsdl2-newframe *sdl-window-ptr*)
  (ignewframe))

(cffi:defcfun "igRender" :void)

(cffi:defcfun "ImGui_ImplOpenGL3_RenderDrawData" :void
  (draw-data :pointer))

(cffi:defcfun "igGetDrawData" :pointer)

(cffi:defcfun "SDL_GL_SwapWindow" :void
  (window sdl-window))

(cffi:defcfun "SDL_RaiseWindow" :void
  (window sdl-window))

(defun end-frame ()
  (igrender)
  (let ((drawdata (iggetdrawdata)))
    (if (cffi:null-pointer-p drawdata)
        (warn "Draw data empty!")
        (progn
          (imgui-implopengl3-renderdrawdata drawdata))))
  (sdl-gl-swapwindow *sdl-window-ptr*))

(defun imgui-init ()
  (sdlcall (sdl-init +sdl2-init-video+))
  (sdlcall (sdl-gl-setattribute :context-major-version 3))
  (sdlcall (sdl-gl-setattribute :context-minor-version 2))
  (setf
   *sdl-window-ptr*
   (sdl-createwindow "wiggly donkers"
                     +sdl2-windowpos-centred+
                     +sdl2-windowpos-centred+
                     1024 768
                     (logior +sdl2-window-opengl+ +sdl2-window-resizable+)))
  (when (cffi:null-pointer-p *sdl-window-ptr*)
    (error "SDL_CreateWindow failed: ~A" (sdl-geterror)))
  (setf
   *sdl-gl-context-ptr*
   (sdl-gl-createcontext *sdl-window-ptr*))
  (when (cffi:null-pointer-p *sdl-gl-context-ptr*)
    (error "SDL_GL_CreateContext failed: ~A" (sdl-geterror)))
  (setf *imgui-context-ptr* (igcreatecontext (cffi:null-pointer)))
  (when (cffi:null-pointer-p *imgui-context-ptr*)
    (error "igCreateContext failed"))
  (setf *imgui-io-ptr* (iggetio))
  (imgui-implsdl2-initforopengl *sdl-window-ptr* *sdl-gl-context-ptr*)
  (imgui-implopengl3-init "#version 150")
  (igstylecolorsdark (cffi:null-pointer))
  (setf
   *last-sdl-event-ptr*
   (cffi:foreign-alloc :char :count +sdl-event-size+)))

(cffi:defcfun "igBegin" :bool
  (name :string)
  (p-open :pointer)
  (flags :int))

(cffi:defcfun "igEnd" :void)

(cffi:defcfun "igText" :void
  (fmt :string))

(cffi:defcfun "igSmallButton" :bool
  (label :string))

(cffi:defcfun "igShowDemoWindow" :void
  (p-open :pointer))

(cffi:defcstruct vec2
  (x :float)
  (y :float))

(cffi:defcfun "igButton" :bool
  (label :string)
  (size (:struct vec2)))

(defparameter *win-opened* (cffi:foreign-alloc :bool))

(defmacro with-window ((name &key (flags 0)) &body body)
  `(unwind-protect
        (when (igbegin ,name (cffi:null-pointer) ,flags)
          (progn ,@body))
     (igend)))

(defparameter *wiggled* nil)

(defun render-func ()
  (with-window ("wiggly donkers?")
    (igtext (format nil "time = ~F" (/ (get-internal-real-time)
                                       internal-time-units-per-second))))
  (with-window ("macro donkers?")
    (when (igbutton "big wiggle" '(x 100.0f0 y 40.0f0))
      (setf *wiggled* (not *wiggled*)))
    (when *wiggled*
      (igtext "w i g g l e"))))

(declaim (notinline render-func))

(defun render-one-frame ()
  (loop
    while (process-one-sdl-event))
  (start-new-frame)
  (unwind-protect
       (render-func)
    (end-frame)))

(defun render-loop ()
  (loop
    (let ((frame-start (get-internal-real-time)))
      (render-one-frame)
      (let* ((frame-end (get-internal-real-time))
             (frame-time (/ (- frame-end frame-start)
                            internal-time-units-per-second))
             (diff (- (/ 1 *frames-per-second*) frame-time)))
        (when (plusp diff)
          (sleep diff))))))

(defun start-backgrounded-ui ()
  (bt:make-thread
   (lambda ()
     (imgui-init)
     (render-loop))
   :name "background renderer thread"))