commit
375d170c07
1 changed files with 291 additions and 0 deletions
@ -0,0 +1,291 @@
@@ -0,0 +1,291 @@
|
||||
(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")) |
Loading…
Reference in new issue