├── CHANGELOG.org ├── LICENSE ├── README.org ├── cl-liballegro.asd ├── examples ├── 001-simple-window.lisp ├── 002-lispy-interface.lisp ├── 003-modern-opengl-triangle.lisp ├── 004-glkit-shakey-cube.lisp ├── 005-glkit-shakey-texture-cube.lisp ├── 005-play-video.lisp ├── 006-state-polling-macros.lisp ├── 007-file-streams.lisp ├── 008-native-dialog.lisp └── test.png └── src ├── constants ├── addons │ ├── audio.lisp │ ├── font.lisp │ ├── native-dialogs.lisp │ └── video-streaming.lisp ├── display.lisp ├── events.lisp ├── file-io.lisp ├── filesystem.lisp ├── fixed-point-math.lisp ├── graphics.lisp ├── haptic.lisp ├── joystick.lisp ├── keyboard.lisp ├── misc.lisp ├── mouse.lisp ├── opengl.lisp ├── shader.lisp ├── state.lisp ├── system.lisp └── touch-input.lisp ├── ffi-functions ├── addons │ ├── audio-codecs.lisp │ ├── audio.lisp │ ├── color.lisp │ ├── font.lisp │ ├── image-io.lisp │ ├── memfile.lisp │ ├── native-dialogs.lisp │ ├── physicsfs.lisp │ ├── primatives.lisp │ └── video-streaming.lisp ├── configuration-files.lisp ├── direct3d.lisp ├── display.lisp ├── events.lisp ├── file-io.lisp ├── filesystem.lisp ├── fixed-point-math.lisp ├── fullscreen-modes.lisp ├── graphics.lisp ├── haptic.lisp ├── joystick.lisp ├── keyboard.lisp ├── memory.lisp ├── misc.lisp ├── monitor.lisp ├── mouse.lisp ├── opengl.lisp ├── path.lisp ├── platform-specific.lisp ├── shader.lisp ├── state.lisp ├── system.lisp ├── threads.lisp ├── time.lisp ├── timer.lisp ├── touch-input.lisp ├── transformations.lisp └── utf-8.lisp ├── interface ├── interface.lisp └── streams.lisp ├── library.lisp ├── package.lisp └── types ├── addons ├── audio.lisp ├── font.lisp └── native-dialogs.lisp ├── events.lisp ├── file-io.lisp ├── filesystem.lisp ├── fixed-point-math.lisp ├── fullscreen-modes.lisp ├── graphics.lisp ├── haptic.lisp ├── joystick.lisp ├── keyboard.lisp ├── memory.lisp ├── monitor.lisp ├── mouse.lisp ├── shader.lisp ├── state.lisp ├── threads.lisp ├── time.lisp ├── timer.lisp ├── touch-input.lisp ├── transformations.lisp ├── types.lisp └── utf-8.lisp /CHANGELOG.org: -------------------------------------------------------------------------------- 1 | * Changelog 2 | ** 0.2.28 3 | Convenience macros for accessing slots (thanks to @lockie) 4 | ** 0.2.27 5 | Add links to readme, Fixed and added definitions, Added missing package symbols 6 | ** 0.2.26 7 | Fix and add missing color addon functions. Added stream-file-position accesors for binary-stream 8 | ** 0.2.25 9 | Add new keycodes. Cleanup the interface a little and add joystick initialization 10 | ** 0.2.24 11 | Fix for the interface running crossplatform. Issue with the GUI code needing to run in the main thread on Darwin machines 12 | ** 0.2.23 13 | Fix for audio system init and export initialize-system 14 | ** 0.2.22 15 | Add missing export and remove nonexistent export related to ~Display~ 16 | ** 0.2.21 17 | Quick release, forgot to add missing package symbol exports 18 | ** 0.2.20 19 | Adds new functionality from Allegro 5.2.9 and few other missing functions 20 | ** 0.2.19 21 | Added Gray streams for filestreams (PR #36 by @lockie) 22 | 23 | Added example for native message box 24 | 25 | Fix bug with the (optional) interface with threading 26 | 27 | ** 0.2.18 28 | Upgrading for the release of Allegro 5.2.8. Along with adding new definitions, added older ones never added and exported symbols to package accidentally left out. 29 | 30 | *** Graphics 31 | ~al_set_new_bitmap_depth~ 32 | ~al_get_new_bitmap_depth~ 33 | ~al_set_new_bitmap_samples~ 34 | ~al_get_new_bitmap_samples~ 35 | ~al_set_new_bitmap_wrap~ 36 | ~al_get_new_bitmap_wrap~ 37 | ~ALLEGRO_BITMAP_WRAP~ 38 | 39 | *** Shader 40 | ~ALLEGRO_SHADER_AUTO_MINIMAL~ 41 | ~ALLEGRO_SHADER_GLSL_MINIMAL~ 42 | ~ALLEGRO_SHADER_HLSL_MINIMAL~ 43 | ~ALLEGRO_SHADER_HLSL_SM_3_0~ 44 | 45 | *** Audio addon 46 | ~ALLEGRO_AUDIO_RECORDER~ 47 | ~ALLEGRO_AUDIO_RECORDER_EVENT~ 48 | ~ALLEGRO_AUDIO_DEVICE~ 49 | ~ALLEGRO_PLAYMODE_LOOP_ONCE~ 50 | ~al_play_audio_stream~ 51 | ~al_play_audio_stream_f~ 52 | ~al_register_sample_identifier~ 53 | ~al_identify_sample~ 54 | ~al_identify_sample_f~ 55 | ~al_lock_sample_id~ 56 | ~al_unlock_sample_id~ 57 | ~al_set_sample_instance_channel_matrix~ 58 | ~al_set_audio_stream_channel_matrix~ 59 | ~al_get_audio_stream_played_samples~ 60 | ~al_create_audio_recorder~ 61 | ~al_start_audio_recorder~ 62 | ~al_stop_audio_recorder~ 63 | ~al_is_audio_recorder_recording~ 64 | ~al_get_audio_recorder_event~ 65 | ~al_get_audio_recorder_event_source~ 66 | ~al_destroy_audio_recorder~ 67 | ~al_get_num_audio_output_devices~ 68 | ~al_get_audio_output_device~ 69 | ~al_get_audio_device_name~ 70 | ~al_fill_silence~ 71 | 72 | *** Video addon 73 | ~al_identify_video~ 74 | ~al_identify_video_f~ 75 | 76 | *** Color addon 77 | ~al_is_color_valid~ 78 | ~al_color_rgb_to_oklab~ 79 | ~al_color_oklab~ 80 | ~al_color_oklab_to_rgb~ 81 | ~al_color_rgb_to_linear~ 82 | ~al_color_linear~ 83 | ~al_color_linear_to_rgb~ 84 | 85 | ** 0.2.17 86 | - Add Allegro 5 Threads 87 | 88 | ** 0.2.16 89 | - Add projects to readme using cl-liballegro 90 | - Add changelog file to help devs keep track of changes 91 | - Fix return value of ~init-font-addon~ 92 | - Add Allegro 5 Memory 93 | 94 | ** 0.2.15 95 | - Add audio event type 96 | - Fix incorrect function parameter for ~set-audio-stream-playing~ 97 | 98 | ** 0.2.13 99 | - Add Allegro 5 UTF-8 100 | - Add additional documentation: https://resttime.github.io/cl-liballegro/ 101 | - Fix ~run-system~ on OSX 102 | 103 | ** 0.2.11 104 | - Add Allegro 5 Video addon 105 | - Add Allegro 5 Filesystem 106 | - Fix compatibility for OSX requiring GUI code in main thread 107 | - Fix variadic function definitions for ~al_draw_textf~ and ~al_draw_justified_textf~ 108 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2022 resttime 2 | 3 | This software is provided 'as-is', without any express or implied 4 | warranty. In no event will the authors be held liable for any damages 5 | arising from the use of this software. 6 | 7 | Permission is granted to anyone to use this software for any purpose, 8 | including commercial applications, and to alter it and redistribute it 9 | freely, subject to the following restrictions: 10 | 11 | 1. The origin of this software must not be misrepresented; you must not 12 | claim that you wrote the original software. If you use this software 13 | in a product, an acknowledgment in the product documentation would be 14 | appreciated but is not required. 15 | 2. Altered source versions must be plainly marked as such, and must not be 16 | misrepresented as being the original software. 17 | 3. This notice may not be removed or altered from any source distribution. -------------------------------------------------------------------------------- /README.org: -------------------------------------------------------------------------------- 1 | #+TITLE: cl-liballegro 2 | #+OPTIONS: ^:nil 3 | #+HTML_HEAD_EXTRA: 4 | 5 | [[http://liballeg.github.io/images/logo.png]] 6 | 7 | Interface and complete bindings to the [[https://liballeg.github.io/][Allegro 5 game programming library]]. 8 | 9 | Check out how the [[./src][source code]] is organized and compare it to the [[https://liballeg.github.io/a5docs/trunk/][API 10 | reference]]. 11 | 12 | * Requires 13 | - [[https://sourceware.org/libffi/][libffi]] 14 | - [[https://liballeg.github.io/][liballegro5]] 15 | 16 | * Quickstart 17 | 1. ~al_*~ becomes ~al:*~ 18 | 2. [[./src/constants/][Constants]] and [[./src/types][types]] are shortened too, check the source code if you need help finding them 19 | 3. ~(al:rest secs)~ is ~(al:rest-time secs)~ because of symbol clash with ~#'cl:rest~ 20 | 4. To access slots from a C struct, you can use ~CFFI:MEM-REF~ generate a plist 21 | #+BEGIN_SRC lisp 22 | (cffi:defcstruct display-mode 23 | (width :int) 24 | (height :int) 25 | (format :int) 26 | (refresh-rate :int)) 27 | 28 | (cffi:with-foreign-object (test '(:struct display-mode)) 29 | (let ((plist (cffi:mem-ref test '(:struct display-mode)))) 30 | (print plist) 31 | (print (getf plist 'width)))) 32 | #+END_SRC 33 | 5. I've got a neat *OPTIONAL* [[./src/interface/interface.lisp][lispy interface]] which provides an entire fixed timestep game loop 34 | 6. Everything else is pretty much 1-to-1 35 | 7. If you're getting crashes on Mac OS X, put all your code into [[https://common-lisp.net/project/cffi/manual/html_node/defcallback.html][callback]] and pass it to [[https://www.allegro.cc/manual/5/al_run_main][al:run-main]] 36 | 8. [[./examples][Examples]] exist if you get lost 37 | 38 | * Projects 39 | Various projects I've found using cl-liballegro. Feel free to add items onto the list! 40 | 41 | ** GUI / UI 42 | - [[https://github.com/lockie/cl-liballegro-nuklear][cl-liballegro-nuklear]] - Bindings to the [[https://github.com/Immediate-Mode-UI/Nuklear][nuklear]] immediate mode GUI library 43 | 44 | ** Games 45 | - [[https://awkravchuk.itch.io/cycle-of-evil][Cycle of Evil]] - A fantasy-themed strategy/simulation with indirect player control 46 | - [[https://awkravchuk.itch.io/mana-break][Mana Break]] - Indirect colony simulator 47 | - [[https://awkravchuk.itch.io/thoughtbound][Thoughtbound]] - Post-modern dungeon crawler in fantasy setting 48 | - [[https://awkravchuk.itch.io/darkness-looming-the-dawn][Darkness Looming: The Dawn]] - Old school hack n' slash 49 | - [[https://github.com/xFA25E/simple-asteroids][simple-asteroids]] - Simple asteroids 50 | - [[https://github.com/VyacheslavMik/tanks][tanks]] - Tanks 51 | 52 | ** Engine 53 | - [[https://github.com/lockie/d2clone-kit][d2clone-kit]] - Diablo 2 clone game engine 54 | 55 | ** Templates 56 | - [[https://github.com/lockie/cookiecutter-lisp-game][cookiecutter-lisp-game]] - Cookiecutter template for a game 57 | 58 | ** Tutorials 59 | - [[https://gitlab.com/lockie/cl-fast-ecs/-/wikis/tutorial-1][Gamedev in Lisp part 1]], [[https://gitlab.com/lockie/cl-fast-ecs/-/wikis/tutorial-2][part 2]] - Tutorials on ECS game architecture featuring cl-liballegro 60 | 61 | * General 62 | [[https://user-images.githubusercontent.com/2598904/96662425-f3c4cf00-1313-11eb-9e59-807e27697c20.png]] 63 | 64 | The most basic usage is 1-to-1 just uses the bindings "as is" such as 65 | in this [[./examples/001-simple-window.lisp][example]]. 66 | 67 | Names have been changed to use a more lispy convention in which ~_~ is 68 | converted to ~-~. In most cases function names match like 69 | ~al_flip_display(display);~ becomes ~(al:flip-display display)~ 70 | 71 | However types, constants, and structures have been shortened for user 72 | convenience. There's no exact rules for it, but usually any prefix 73 | with ~ALLEGRO_*~ or ~al_*~ is truncated because Common Lisp has 74 | multiple namespaces to handle naming clashes. For the rare edge 75 | cases, check the source code definitions for [[./src/constants/][constants]] and [[./src/types][types]]. 76 | 77 | Another change is that certain constants have been changed to Common 78 | Lisp keywords. Keyboard functions in C use an enum values 79 | corresponding to the key but cl-liballegro uses keywords instead. An 80 | example is ~ALLEGRO_KEY_K~ becoming ~:K~. CFFI takes care of 81 | translating the value to the keyword and vice-versa. Using keywords 82 | over constants tends to be convenient in practice. 83 | 84 | ** CFFI 85 | Occasionally dropping down to a level lower using CFFI is necessary. 86 | One of these situations is passing a non-opaque data structure by 87 | reference. 88 | 89 | Consider this block of C: 90 | #+begin_src c 91 | { 92 | ALLEGRO_EVENT event; 93 | bool running = true; 94 | while (running) process_event(&event); 95 | } 96 | #+end_src 97 | 98 | In Common Lisp we will use CFFI to allocate the structure for the 99 | corresponding Allegro 5 functions. Remember to free up the memory 100 | afterwards! 101 | 102 | #+begin_src lisp 103 | (defparameter *running-p* t) 104 | (let ((event (cffi:foreign-alloc '(:union al:event))) 105 | (loop while *running-p* do (process-event event)) 106 | (cffi:foreign-free event)) 107 | #+end_src 108 | 109 | ** Orphaned Windows / Cleaning up Windows 110 | At times when something goes wrong the debugger pops up and a new 111 | window is created without the previous one being destroyed. This is 112 | due to how Common Lisp debugger restarts execution. One of the ways 113 | to handle this is wrapping things in an ~UNWIND-PROTECT~ or using the 114 | condition handlers in Common Lisp. Errors should be handled in such a 115 | way that restarts do not re-execute certain s-exps to create a new 116 | display. Errors can also be handled by cleaning up resources. 117 | 118 | ** Optional Lisp Interface 119 | An optional lisp interface is included with cl-liballegro which 120 | provides a full game loop with a fixed timestep and Entity Component 121 | System (ECS) implemented on the CLOS. Note that it is provided as is 122 | and not optimized. If performance is a concern, it is recommended to 123 | implement your own game loop while avoiding multiple dispatch and I 124 | will look forward to seeing your AAA game in the future. 125 | 126 | 1. Define system which holds state 127 | #+begin_src lisp 128 | ;; Creates a 800x600 resizable OpenGL display titled "Simple" 129 | ;; Fixed timestep loop runs logic at 1 FPS 130 | ;; The remaining time is spent on render 131 | ;; 132 | ;; The PREVIOUS-KEY slot is user-defined state for this example 133 | (defclass window (al:system) 134 | ((previous-key :initform "Nothing" :accessor previous-key)) 135 | (:default-initargs 136 | :title "Simple" 137 | :width 800 :height 600 138 | :logic-fps 1 139 | :display-flags '(:windowed :opengl :resizable) 140 | :display-options '((:sample-buffers 1 :suggest) 141 | (:samples 4 :suggest)))) 142 | #+end_src 143 | 144 | 2. Implement Method for Logic Step 145 | #+begin_src lisp 146 | (defmethod al:update ((sys window)) 147 | (print 'one-logic-frame)) 148 | #+end_src 149 | 150 | 3. Implement Method for Render Step 151 | #+begin_src lisp 152 | (defmethod al:render ((sys window)) 153 | (al:clear-to-color (al:map-rgb 20 150 100)) 154 | (al:flip-display)) 155 | #+end_src 156 | 157 | 4. Implement Methods(s) for Event Handling 158 | #+begin_src lisp 159 | ;; The lisp interface runs handlers during the logic step 160 | ;; Handlers are defined according to allegro events 161 | (defmethod al:key-down-handler ((sys window)) 162 | (let ((keyboard (cffi:mem-ref (al:event sys) '(:struct al:keyboard-event)))) 163 | (print (getf keyboard 'al::keycode)) 164 | (setf (previous-key sys) (getf keyboard 'al::keycode)))) 165 | #+end_src 166 | 167 | 5. Run system 168 | #+begin_src lisp 169 | (al:run-system (make-instance 'window))) 170 | #+end_src 171 | 172 | ** Mac OS X - Main UI Thread 173 | Running on Mac OS X tends to behave oddly with threads because it 174 | requires GUI related code to run in the main thread (affects programs 175 | outside of Common Lisp too). The Allegro 5 library has a solution 176 | with [[https://liballeg.github.io/a5docs/trunk/misc.html#al_run_main][al_run_main]]. Define a callback with [[https://common-lisp.net/project/cffi/manual/html_node/defcallback.html][defcallback]] and pass it to 177 | ~AL:RUN-MAIN~. 178 | 179 | #+begin_src lisp 180 | ;; First define a callback 181 | (cffi:defcallback my-main :void () 182 | ;; Code goes in here 183 | (function-with-gui-code)) 184 | 185 | ;; Second execute by passing the callback to AL:RUN-MAIN 186 | (al:run-main 0 (cffi:null-pointer) (cffi:callback my-main)) 187 | #+end_src 188 | 189 | ** Ignoring Floating Point Calculation Errors / Traps 190 | Common Lisp implementations tend to throw floating point calculation 191 | errors such as ~FLOATING-POINT-OVERFLOW~ and 192 | ~FLOATING-POINT-INVALID-OPERATION~ by default (called traps) to be 193 | explicitly handled rather than ignored. There are situations where 194 | this is valid behaviour but sometimes such errors get thrown despite 195 | valid code being called through the foreign function interface (FFI). 196 | 197 | In this case it should be safe to ignore using implementation specific 198 | routines or the [[https://github.com/Shinmera/float-features/][float-features]] portability library: 199 | 200 | #+begin_src lisp 201 | ;; SBCL 202 | ;; Sets traps globally 203 | (sb-int:set-floating-point-modes :traps (:invalid :inexact :overflow)) 204 | 205 | ;; SBCL 206 | ;; Code wrapped in the macro ignores floating point errors in the list 207 | (sb-int:with-float-traps-masked (:invalid :inexact :overflow) 208 | (function-with-floating-point-errors)) 209 | 210 | ;; float-features (portability library) 211 | ;; Code wrapped in the macro ignores floating point errors in the list 212 | (float-features:with-float-traps-masked (:divide-by-zero 213 | :invalid 214 | :inexact 215 | :overflow 216 | :underflow) 217 | (function-with-floating-point-errors)) 218 | #+end_src 219 | 220 | ** Windows - Library Paths 221 | There are path problems in Windows because the Allegro 5 library files 222 | which contain all the functions the CFFI calls upon do not have a 223 | default location unlike Unix environments. When the library is loaded 224 | under Windows, CFFI will look for the library files in the *current 225 | folder* of the FILE.LISP that evaluates ~(ql:quickload 226 | "cl-liballegro")~. This means a copy of the library files must be in 227 | the directory of FILE.LISP, not in the cl-liballegro directory unless 228 | the FILE.LISP is in there. SLIME however, likes to change the default 229 | search folder to the one Emacs is in when it starts. 230 | 231 | *** With SBCL 232 | #+BEGIN_SRC 233 | ;; Open command prompt in the folder that contains both the DLL and game.lisp 234 | > sbcl 235 | > (load "game.lisp") ; File contains (ql:quickload "cl-liballegro") 236 | #+END_SRC 237 | 238 | *** With Emacs + SLIME 239 | /game.lisp contains (ql:quickload :cl-liballegro)/ 240 | #+BEGIN_SRC 241 | ;; Looks for the DLL at /path/to/Desktop/allegro.dll 242 | C-x C-f /path/to/Desktop/file9.lisp 243 | M-x slime 244 | C-x C-f /path/to/Desktop/game/game.lisp 245 | C-c C-l 246 | #+END_SRC 247 | 248 | #+BEGIN_SRC 249 | ;; Looks for the DLL at /path/to/Desktop/game/allegro.dll 250 | C-x C-f /path/to/Desktop/file9.lisp 251 | C-x C-f /path/to/Desktop/game/game.lisp 252 | M-x slime 253 | C-c C-l 254 | #+END_SRC 255 | 256 | #+BEGIN_SRC 257 | ;; Looks for the DLL at /whatever/default/emacs/directory/allegro.dll 258 | M-x slime 259 | C-x C-f /path/to/Desktop/game/game.lisp 260 | C-c C-l 261 | #+END_SRC 262 | 263 | ** File streams 264 | There are [[https://www.cliki.net/gray%20streams][Gray streams]] wrapping liballegro [[https://liballeg.github.io/a5docs/trunk/file.html][file IO APIs]]: 265 | #+begin_src lisp 266 | ;; text stream 267 | (with-open-stream (stream (al:make-character-stream "credits.txt")) 268 | (uiop:slurp-stream-lines stream)) 269 | 270 | ;; binary stream 271 | (with-open-stream (stream (al:make-binary-stream "loot.ase")) 272 | (let ((result (make-array (al:stream-size stream) 273 | :element-type '(unsigned-byte 8)))) 274 | (read-sequence result stream) 275 | result)) 276 | #+end_src 277 | 278 | Note: those can be particularly useful when combined with the [[https://liballeg.github.io/a5docs/trunk/physfs.html][liballegro 279 | PhysicsFS addon]], which can help with reading files located within game 280 | archives, such as Quake PAK files, zip archives [[https://icculus.org/physfs][etc]]. 281 | 282 | To mount such an archive as a folder, use the [[https://icculus.org/physfs/docs/html/physfs_8h.html#a8eb320e9af03dcdb4c05bbff3ea604d4][PHYSFS_mount]] function from 283 | =libphysfs= library (usually dynamically linked to =liballegro=, except in official 284 | Windows builds, where it is statically linked): 285 | #+begin_src lisp 286 | #-win32 (progn 287 | (cffi:define-foreign-library libphysfs 288 | (:darwin (:or "libphysfs.3.0.2.dylib" "libphysfs.1.dylib")) 289 | (:unix (:or "libphysfs.so.3.0.2" "libphysfs.so.1")) 290 | (t (:default "libphysfs"))) 291 | (cffi:use-foreign-library libphysfs)) 292 | 293 | (cffi:defcfun ("PHYSFS_mount" physfs-mount) :int 294 | (new-dir :string) (mount-point :string) (append-to-path :int)) 295 | 296 | (assert (not (zerop (physfs-mount "archive.zip" (cffi:null-pointer) 1)))) 297 | ;; now al:make-character-stream and al:make-binary-stream are able to 298 | ;; open files from archive.zip 299 | #+end_src 300 | 301 | * Contributing / Developing / Hacking 302 | cl-liballegro is organized according to the [[https://liballeg.github.io/a5docs/trunk/][Allegro 5 Documentation]] 303 | with functions, types, and constants separated. 304 | 305 | [[https://cffi.common-lisp.dev/][CFFI]] is used and its [[https://cffi.common-lisp.dev/manual/index.html][manual]] recommended to understand more advanced 306 | uses though not required for most cases. 307 | 308 | Naming conventions has a preference for truncating ~ALLEGRO~ or ~al~ 309 | for user convenience since Common Lisp has multiple namespaces for 310 | resolving symbol names. For the rare edge cases, check the [[./src/types/][types]] and 311 | [[./src/constants/][constants]] 312 | 313 | Usage of keywords over enums preferred for user convenience. 314 | 315 | ** Project Structure 316 | - [[./src/constants/]]: Allegro 5 constants, enums, and flag definitions 317 | - [[./src/ffi-functions/]]: Allegro 5 function definitions 318 | - [[./src/types/]]: Allegro 5 type definitions 319 | - [[./src/interface/]]: Common Lisp interface definition, optional fixed timestep 320 | game loop implemented with CLOS, Gray streams wrapping file APIs. 321 | - [[./src/package.lisp]]: Common Lisp package definition, exports usable symbols 322 | - [[./src/library.lisp]]: CFFI library definition, loads Allegro 5 library files into memory 323 | - [[./cl-liballegro.asd]]: ASDF project definition, specifies source files to be loaded 324 | 325 | ** Checklist 326 | - [ ] New bindings added for export to [[./src/package.lisp][package defintion]] 327 | - [ ] New source files added for loading to the [[./cl-liballegro.asd][project definition]] 328 | - [ ] Bump version and add description of changes 329 | 330 | * [[./CHANGELOG.org][CHANGELOG]] 331 | FYI these bindings are so stable it can make the repo look dead 332 | 333 | * [[https://github.com/resttime/cl-liballegro/issues][Support / Help / Bug Reports]] 334 | 335 | * License 336 | Project under zlib license 337 | -------------------------------------------------------------------------------- /cl-liballegro.asd: -------------------------------------------------------------------------------- 1 | (in-package #:cl-user) 2 | (asdf:defsystem cl-liballegro 3 | :description "Allegro 5 game programming library bindings for Common Lisp" 4 | :license "zlib" 5 | :version "0.2.28" 6 | :author "resttime" 7 | :depends-on (:cffi 8 | :cffi-libffi 9 | :trivial-garbage 10 | :trivial-gray-streams 11 | :trivial-main-thread 12 | :float-features) 13 | :serial t 14 | :components 15 | ((:module "src" 16 | :components 17 | ((:file "package") 18 | (:file "library") 19 | (:module "constants" 20 | :components 21 | ((:file "display") 22 | (:file "events") 23 | (:file "file-io") 24 | (:file "filesystem") 25 | (:file "fixed-point-math") 26 | (:file "graphics") 27 | (:file "haptic") 28 | (:file "joystick") 29 | (:file "keyboard") 30 | (:file "misc") 31 | (:file "mouse") 32 | (:file "opengl") 33 | (:file "touch-input") 34 | (:file "shader") 35 | (:file "state") 36 | (:file "system") 37 | (:module "addons" 38 | :components 39 | ((:file "audio") 40 | (:file "font") 41 | (:file "native-dialogs") 42 | (:file "video-streaming"))))) 43 | (:module "types" 44 | :components 45 | ((:file "events") 46 | (:file "filesystem") 47 | (:file "file-io") 48 | (:file "fixed-point-math") 49 | (:file "fullscreen-modes") 50 | (:file "graphics") 51 | (:file "haptic") 52 | (:file "joystick") 53 | (:file "keyboard") 54 | (:file "memory") 55 | (:file "monitor") 56 | (:file "mouse") 57 | (:file "shader") 58 | (:file "state") 59 | (:file "threads") 60 | (:file "time") 61 | (:file "timer") 62 | (:file "touch-input") 63 | (:file "transformations") 64 | (:file "utf-8") 65 | (:file "types") 66 | (:module "addons" 67 | :components 68 | ((:file "audio") 69 | (:file "font") 70 | (:file "native-dialogs"))))) 71 | (:module "ffi-functions" 72 | :components 73 | ((:file "configuration-files") 74 | (:file "display") 75 | (:file "events") 76 | (:file "file-io") 77 | (:file "filesystem") 78 | (:file "fixed-point-math") 79 | (:file "fullscreen-modes") 80 | (:file "graphics") 81 | (:file "haptic") 82 | (:file "joystick") 83 | (:file "keyboard") 84 | (:file "memory") 85 | (:file "monitor") 86 | (:file "mouse") 87 | (:file "path") 88 | (:file "shader") 89 | (:file "state") 90 | (:file "system") 91 | (:file "threads") 92 | (:file "time") 93 | (:file "timer") 94 | (:file "touch-input") 95 | (:file "transformations") 96 | (:file "utf-8") 97 | (:file "misc") 98 | (:file "platform-specific") 99 | (:file "direct3d") 100 | (:file "opengl") 101 | (:module "addons" 102 | :components 103 | ((:file "audio") 104 | (:file "audio-codecs") 105 | (:file "color") 106 | (:file "font") 107 | (:file "image-io") 108 | (:file "memfile") 109 | (:file "native-dialogs") 110 | (:file "physicsfs") 111 | (:file "primatives") 112 | (:file "video-streaming"))))) 113 | ;; Higher Level Lisp API 114 | (:module "interface" 115 | :components 116 | ((:file "interface") 117 | (:file "streams"))))))) 118 | -------------------------------------------------------------------------------- /examples/001-simple-window.lisp: -------------------------------------------------------------------------------- 1 | ;;; Creates a grey background display window, draws a white rectangle, 2 | ;;; and waits 2 seconds before closing. 3 | (ql:quickload "cl-liballegro") ; Load the system 4 | 5 | (defvar display) ; Make a variable that holds the ALLEGRO_DISPLAY pointer 6 | (defun main () 7 | (al:init) ; al_init(); 8 | (al:init-primitives-addon) ; al_init_primitives_addon() 9 | (al:set-new-display-flags '(:windowed :resizable :opengl)) ; al_set_new_display_flags(ALLEGRO_WINDOWED | ALLEGRO_RESIZABLE); 10 | (al:set-new-display-option :vsync 0 :require) ; al_set_new_display_option(ALLEGRO_VSYNC, 1, ALLEGRO_REQUIRE); 11 | (setf display (al:create-display 800 600)) ; display = al_create_display(800, 600); 12 | (al:clear-to-color (al:map-rgb 128 128 128)) ; al_clear_to_color(al_map_rgb(128 128 128); 13 | (al:draw-filled-rectangle 14 | 100 110 400 450 15 | (al:map-rgb 255 255 255)) ; al_draw_filled_rectangle(100, 110, 400, 450, al_map_rgb(128 128 128)); 16 | (al:flip-display) ; al_flip_display(); 17 | (al:rest-time 2) ; al_rest(2); 18 | (al:destroy-display display) ; al_destroy_display(display); 19 | (al:uninstall-system)) ; al_uninstall_system(); 20 | -------------------------------------------------------------------------------- /examples/002-lispy-interface.lisp: -------------------------------------------------------------------------------- 1 | ;; Example demonstrating the optional lisp interface built on CLOS 2 | (ql:quickload "cl-liballegro") 3 | 4 | (defclass window (al:system) 5 | ((previous-key :initform "Nothing" :accessor previous-key)) 6 | (:default-initargs 7 | :title "Simple" 8 | :width 800 9 | :height 600 10 | :logic-fps 1 11 | :display-flags '(:windowed :opengl :resizable) 12 | :display-options '((:sample-buffers 1 :suggest) 13 | (:samples 4 :suggest)))) 14 | 15 | (defmethod al:update ((sys window)) 16 | (print 'one-logic-frame)) 17 | 18 | (defmethod al:render ((sys window)) 19 | (al:clear-to-color (al:map-rgb 20 150 100)) 20 | (al:flip-display)) 21 | 22 | (defmethod al:key-down-handler ((sys window)) 23 | (let ((keyboard (cffi:mem-ref (al:event sys) '(:struct al:keyboard-event)))) 24 | (print (getf keyboard 'al::keycode)) 25 | (setf (previous-key sys) (getf keyboard 'al::keycode)))) 26 | 27 | (defun main () 28 | (al:run-system (make-instance 'window))) 29 | -------------------------------------------------------------------------------- /examples/003-modern-opengl-triangle.lisp: -------------------------------------------------------------------------------- 1 | (ql:quickload "cl-liballegro") 2 | (ql:quickload "cl-opengl") 3 | 4 | (defparameter *vert-shader* 5 | "#version 300 es 6 | 7 | layout(location = 0) in vec3 vertexPosition_modelspace; 8 | 9 | void main() { 10 | gl_Position.xyz = vertexPosition_modelspace; 11 | gl_Position.w = 1.0; 12 | }") 13 | (defparameter *frag-shader* 14 | "#version 300 es 15 | precision highp float; 16 | 17 | out vec3 color; 18 | 19 | void main() { 20 | color = vec3(0.5,0.5,0.5); 21 | }") 22 | 23 | (defclass game (al:system) 24 | ((vao :accessor vao) 25 | (vb :accessor vb) 26 | (vertex-shader :accessor vertex-shader) 27 | (fragment-shader :accessor fragment-shader) 28 | (program :accessor program)) 29 | (:default-initargs 30 | :width 800 :height 600 31 | :title "Tutorial 2" 32 | :logic-fps 1 33 | :display-flags '(:opengl :opengl-3-0) 34 | :display-options '((:sample-buffers 1 :suggest) 35 | (:samples 8 :suggest)) 36 | )) 37 | 38 | (defgeneric load-shaders (sys &key vertex fragment)) 39 | (defmethod load-shaders ((sys game) &key vertex fragment) 40 | (let ((vs (gl:create-shader :vertex-shader)) 41 | (fs (gl:create-shader :fragment-shader))) 42 | (setf (vertex-shader sys) vs) 43 | (setf (fragment-shader sys) fs) 44 | (gl:shader-source vs vertex) 45 | (gl:compile-shader vs) 46 | (gl:shader-source fs fragment) 47 | (gl:compile-shader fs) 48 | ;;(print (gl:get-shader-info-log vs)) 49 | ;;(print (gl:get-shader-info-log fs)) 50 | (setf (program sys) (gl:create-program)) 51 | (gl:attach-shader (program sys) vs) 52 | (gl:attach-shader (program sys) fs) 53 | (gl:link-program (program sys)))) 54 | 55 | (defmethod al:system-loop :before ((sys game)) 56 | (setf (vb sys) (gl:gen-buffers 1)) 57 | (setf (vao sys) (gl:gen-vertex-arrays 1)) 58 | (gl:bind-vertex-array (first (vao sys))) 59 | (gl:bind-buffer :array-buffer (first (vb sys))) 60 | (let ((vert-data #(-1.0 -1.0 0.0 61 | 1.0 -1.0 0.0 62 | 0.0 1.0 0.0)) 63 | (arr (gl:alloc-gl-array :float 9))) 64 | (dotimes (i (length vert-data)) 65 | (setf (gl:glaref arr i) (aref vert-data i))) 66 | (gl:buffer-data :array-buffer :static-draw arr) 67 | (gl:free-gl-array arr)) 68 | (format t "OpenGL Version: 0x~x~%" (al:get-opengl-version)) 69 | (format t "OpenGL Variant: ~a~%" (al:get-opengl-variant))) 70 | 71 | (defmethod al:render ((sys game)) 72 | (load-shaders sys :vertex *vert-shader* :fragment *frag-shader*) 73 | (gl:clear-color 0.0 0.0 0.0 1.0) 74 | (gl:clear :color-buffer-bit) 75 | (gl:matrix-mode :projection) 76 | (gl:load-identity) 77 | (gl:use-program (program sys)) 78 | (gl:enable-vertex-attrib-array 0) 79 | (gl:bind-buffer :array-buffer (first (vb sys))) 80 | (gl:vertex-attrib-pointer 0 3 :float :false 0 (cffi:null-pointer)) 81 | (gl:draw-arrays :triangles 0 3) 82 | (gl:disable-vertex-attrib-array 0) 83 | (gl:use-program 0) 84 | (al:flip-display)) 85 | 86 | (defun main () 87 | (al:run-system (make-instance 'game))) 88 | -------------------------------------------------------------------------------- /examples/004-glkit-shakey-cube.lisp: -------------------------------------------------------------------------------- 1 | (ql:quickload "cl-liballegro") 2 | (ql:quickload "cl-opengl") 3 | (ql:quickload "glkit") 4 | 5 | (kit.gl.shader:defdict all-shaders () 6 | (kit.gl.shader:shader vertex :vertex-shader " 7 | #version 300 es 8 | precision highp float; 9 | 10 | layout(location = 0) in vec3 vertexPosition_modelspace; 11 | layout(location = 1) in vec3 vertexColor; 12 | 13 | out vec3 fragmentColor; 14 | 15 | uniform mat4 MVP; 16 | 17 | void main() { 18 | gl_Position = MVP * vec4(vertexPosition_modelspace, 1); 19 | fragmentColor = vertexColor; 20 | }") 21 | 22 | (kit.gl.shader:shader fragment :fragment-shader " 23 | #version 300 es 24 | precision highp float; 25 | 26 | in vec3 fragmentColor; 27 | 28 | out vec3 color; 29 | 30 | void main() { 31 | color = fragmentColor; 32 | }") 33 | (kit.gl.shader:program :simple-prog ((:mvp "MVP")) 34 | (:vertex-shader vertex) 35 | (:fragment-shader fragment))) 36 | (defparameter *cube-data* #( 37 | -1.0 -1.0 -1.0 38 | -1.0 -1.0 1.0 39 | -1.0 1.0 1.0 40 | 1.0 1.0 -1.0 41 | -1.0 -1.0 -1.0 42 | -1.0 1.0 -1.0 43 | 1.0 -1.0 1.0 44 | -1.0 -1.0 -1.0 45 | 1.0 -1.0 -1.0 46 | 1.0 1.0 -1.0 47 | 1.0 -1.0 -1.0 48 | -1.0 -1.0 -1.0 49 | -1.0 -1.0 -1.0 50 | -1.0 1.0 1.0 51 | -1.0 1.0 -1.0 52 | 1.0 -1.0 1.0 53 | -1.0 -1.0 1.0 54 | -1.0 -1.0 -1.0 55 | -1.0 1.0 1.0 56 | -1.0 -1.0 1.0 57 | 1.0 -1.0 1.0 58 | 1.0 1.0 1.0 59 | 1.0 -1.0 -1.0 60 | 1.0 1.0 -1.0 61 | 1.0 -1.0 -1.0 62 | 1.0 1.0 1.0 63 | 1.0 -1.0 1.0 64 | 1.0 1.0 1.0 65 | 1.0 1.0 -1.0 66 | -1.0 1.0 -1.0 67 | 1.0 1.0 1.0 68 | -1.0 1.0 -1.0 69 | -1.0 1.0 1.0 70 | 1.0 1.0 1.0 71 | -1.0 1.0 1.0 72 | 1.0 -1.0 1.0 73 | )) 74 | (defparameter *color-data* #( 75 | 0.583 0.771 0.014 76 | 0.609 0.115 0.436 77 | 0.327 0.483 0.844 78 | 0.822 0.569 0.201 79 | 0.435 0.602 0.223 80 | 0.310 0.747 0.185 81 | 0.597 0.770 0.761 82 | 0.559 0.436 0.730 83 | 0.359 0.583 0.152 84 | 0.483 0.596 0.789 85 | 0.559 0.861 0.639 86 | 0.195 0.548 0.859 87 | 0.014 0.184 0.576 88 | 0.771 0.328 0.970 89 | 0.406 0.615 0.116 90 | 0.676 0.977 0.133 91 | 0.971 0.572 0.833 92 | 0.140 0.616 0.489 93 | 0.997 0.513 0.064 94 | 0.945 0.719 0.592 95 | 0.543 0.021 0.978 96 | 0.279 0.317 0.505 97 | 0.167 0.620 0.077 98 | 0.347 0.857 0.137 99 | 0.055 0.953 0.042 100 | 0.714 0.505 0.345 101 | 0.783 0.290 0.734 102 | 0.722 0.645 0.174 103 | 0.302 0.455 0.848 104 | 0.225 0.587 0.040 105 | 0.517 0.713 0.338 106 | 0.053 0.959 0.120 107 | 0.393 0.621 0.362 108 | 0.673 0.211 0.457 109 | 0.820 0.883 0.371 110 | 0.982 0.099 0.879 111 | )) 112 | 113 | (defclass game (al:system) 114 | ((vao :accessor vao) 115 | (vb :accessor vb) 116 | (shader-dict :accessor shader-dict)) 117 | (:default-initargs 118 | :width 800 :height 600 119 | :title "Shakey Cube" 120 | :logic-fps 30 121 | :display-flags '(:opengl :opengl-3-0 :resizable) 122 | :display-options '((:sample-buffers 1 :suggest) 123 | (:samples 8 :suggest)))) 124 | 125 | (defun model-view-projection-matrix (width height) 126 | (let ((view (kit.glm:perspective-matrix 45 (/ width height) 0.1 100)) 127 | (projection (kit.glm:look-at 128 | (kit.glm:vec (* 0.5 (abs (cos (/ (get-internal-real-time) 900)))) 129 | (1+ (* 3.0 (abs (cos (/ (get-internal-real-time) 500))))) 130 | (1+ (* 5 (abs (sin (/ (get-internal-real-time) 1000)))))) 131 | (kit.glm:vec 0.0 0.0 0.0) 132 | (kit.glm:vec 0.0 1.0 0.0)))) 133 | (kit.glm:matrix* kit.glm:+identity-matrix+ view projection))) 134 | 135 | (defmethod al:system-loop :before ((sys game)) 136 | (gl:enable :depth-test) 137 | (gl:depth-func :less) 138 | (setf (vao sys) (gl:gen-vertex-arrays 1)) 139 | (gl:bind-vertex-array (first (vao sys))) 140 | 141 | (setf (vb sys) (gl:gen-buffers 2)) 142 | (let* ((vert-data *cube-data*) 143 | (arr (gl:alloc-gl-array :float (length vert-data)))) 144 | (dotimes (i (length vert-data)) 145 | (setf (gl:glaref arr i) (aref vert-data i))) 146 | (gl:bind-buffer :array-buffer (first (vb sys))) 147 | (gl:buffer-data :array-buffer :static-draw arr) 148 | (gl:free-gl-array arr)) 149 | (let* ((vert-data *color-data*) 150 | (arr (gl:alloc-gl-array :float (length vert-data)))) 151 | (dotimes (i (length vert-data)) 152 | (setf (gl:glaref arr i) (aref vert-data i))) 153 | (gl:bind-buffer :array-buffer (second (vb sys))) 154 | (gl:buffer-data :array-buffer :static-draw arr) 155 | (gl:free-gl-array arr)) 156 | (format t "OpenGL Version: 0x~x~%" (al:get-opengl-version)) 157 | (format t "OpenGL Variant: ~a~%" (al:get-opengl-variant))) 158 | 159 | (defmethod al:render ((sys game)) 160 | (setf (shader-dict sys) 161 | (kit.gl.shader:compile-shader-dictionary (kit.gl.shader:dict all-shaders))) 162 | (gl:clear-color 0.0 0.0 0.0 1.0) 163 | (gl:clear :color-buffer-bit :depth-buffer-bit) 164 | (kit.gl.shader:use-program (shader-dict sys) :simple-prog) 165 | (kit.gl.shader:uniform-matrix (shader-dict sys) :mvp 4 166 | (vector (model-view-projection-matrix (al:get-display-width (al:display sys)) 167 | (al:get-display-height (al:display sys))))) 168 | (gl:enable-vertex-attrib-array 0) 169 | (gl:bind-buffer :array-buffer (first (vb sys))) 170 | (gl:vertex-attrib-pointer 0 3 :float :false 0 (cffi:null-pointer)) 171 | 172 | (gl:enable-vertex-attrib-array 1) 173 | (gl:bind-buffer :array-buffer (second (vb sys))) 174 | (gl:vertex-attrib-pointer 1 3 :float :false 0 (cffi:null-pointer)) 175 | (gl:draw-arrays :triangles 0 (* 12 3)) 176 | (gl:disable-vertex-attrib-array 0) 177 | (gl:disable-vertex-attrib-array 1) 178 | (gl:use-program 0) 179 | (al:flip-display)) 180 | 181 | (defun main () 182 | (al:run-system (make-instance 'game))) 183 | -------------------------------------------------------------------------------- /examples/005-glkit-shakey-texture-cube.lisp: -------------------------------------------------------------------------------- 1 | (ql:quickload "cl-liballegro") 2 | (ql:quickload "cl-opengl") 3 | (ql:quickload "glkit") 4 | 5 | (kit.gl.shader:defdict *all-shaders* () 6 | (kit.gl.shader:shader vertex :vertex-shader " 7 | #version 300 es 8 | precision highp float; 9 | 10 | layout(location = 0) in vec3 vertexPosition_modelspace; 11 | layout(location = 1) in vec2 vertexUV; 12 | 13 | out vec2 UV; 14 | 15 | uniform mat4 MVP; 16 | 17 | void main() { 18 | gl_Position = MVP * vec4(vertexPosition_modelspace, 1); 19 | UV = vertexUV; 20 | }") 21 | 22 | (kit.gl.shader:shader fragment :fragment-shader " 23 | #version 300 es 24 | precision highp float; 25 | 26 | in vec2 UV; 27 | 28 | out vec3 color; 29 | 30 | uniform sampler2D textureSampler; 31 | 32 | void main() { 33 | color = texture(textureSampler, UV).rgb; 34 | }") 35 | (kit.gl.shader:program :simple-prog ((:mvp "MVP") (:ts "textureSampler")) 36 | (:vertex-shader vertex) 37 | (:fragment-shader fragment))) 38 | (defparameter *cube-data* #(-1.0 -1.0 -1.0 39 | -1.0 -1.0 1.0 40 | -1.0 1.0 1.0 41 | 1.0 1.0 -1.0 42 | -1.0 -1.0 -1.0 43 | -1.0 1.0 -1.0 44 | 1.0 -1.0 1.0 45 | -1.0 -1.0 -1.0 46 | 1.0 -1.0 -1.0 47 | 1.0 1.0 -1.0 48 | 1.0 -1.0 -1.0 49 | -1.0 -1.0 -1.0 50 | -1.0 -1.0 -1.0 51 | -1.0 1.0 1.0 52 | -1.0 1.0 -1.0 53 | 1.0 -1.0 1.0 54 | -1.0 -1.0 1.0 55 | -1.0 -1.0 -1.0 56 | -1.0 1.0 1.0 57 | -1.0 -1.0 1.0 58 | 1.0 -1.0 1.0 59 | 1.0 1.0 1.0 60 | 1.0 -1.0 -1.0 61 | 1.0 1.0 -1.0 62 | 1.0 -1.0 -1.0 63 | 1.0 1.0 1.0 64 | 1.0 -1.0 1.0 65 | 1.0 1.0 1.0 66 | 1.0 1.0 -1.0 67 | -1.0 1.0 -1.0 68 | 1.0 1.0 1.0 69 | -1.0 1.0 -1.0 70 | -1.0 1.0 1.0 71 | 1.0 1.0 1.0 72 | -1.0 1.0 1.0 73 | 1.0 -1.0 1.0)) 74 | (defparameter *uv-data* `#(0.000059 ,(1- 0.000004) 75 | 0.000103 ,(1- 0.336048) 76 | 0.335973 ,(1- 0.335903) 77 | 1.000023 ,(1- 0.000013) 78 | 0.667979 ,(1- 0.335851) 79 | 0.999958 ,(1- 0.336064) 80 | 0.667979 ,(1- 0.335851) 81 | 0.336024 ,(1- 0.671877) 82 | 0.667969 ,(1- 0.671889) 83 | 1.000023 ,(1- 0.000013) 84 | 0.668104 ,(1- 0.000013) 85 | 0.667979 ,(1- 0.335851) 86 | 0.000059 ,(1- 0.000004) 87 | 0.335973 ,(1- 0.335903) 88 | 0.336098 ,(1- 0.000071) 89 | 0.667979 ,(1- 0.335851) 90 | 0.335973 ,(1- 0.335903) 91 | 0.336024 ,(1- 0.671877) 92 | 1.000004 ,(1- 0.671847) 93 | 0.999958 ,(1- 0.336064) 94 | 0.667979 ,(1- 0.335851) 95 | 0.668104 ,(1- 0.000013) 96 | 0.335973 ,(1- 0.335903) 97 | 0.667979 ,(1- 0.335851) 98 | 0.335973 ,(1- 0.335903) 99 | 0.668104 ,(1- 0.000013) 100 | 0.336098 ,(1- 0.000071) 101 | 0.000103 ,(1- 0.336048) 102 | 0.000004 ,(1- 0.671870) 103 | 0.336024 ,(1- 0.671877) 104 | 0.000103 ,(1- 0.336048) 105 | 0.336024 ,(1- 0.671877) 106 | 0.335973 ,(1- 0.335903) 107 | 0.667969 ,(1- 0.671889) 108 | 1.000004 ,(1- 0.671847) 109 | 0.667979 ,(1- 0.335851))) 110 | 111 | (defclass game (al:system) 112 | ((vao :accessor vao) 113 | (vb :initform '() :accessor vb) 114 | (texture :accessor texture) 115 | (shader-dict :accessor shader-dict)) 116 | (:default-initargs 117 | :width 800 :height 600 118 | :title "Shakey Texture Cube" 119 | :logic-fps 30 120 | :display-flags '(:opengl :opengl-3-0 :resizable) 121 | :display-options '((:sample-buffers 1 :suggest) 122 | (:samples 8 :suggest)))) 123 | 124 | (defun model-view-projection-matrix (width height) 125 | (let ((view (kit.glm:perspective-matrix 45 (/ width height) 0.1 100)) 126 | (projection (kit.glm:look-at 127 | (kit.glm:vec (+ 3 (* 3.0 (cos (/ (get-internal-real-time) 300)))) 128 | (1+ (* 5.0 (cos (/ (get-internal-real-time) 200)))) 129 | (+ 3 (* 3.0 (sin (/ (get-internal-real-time) 1000))))) 130 | (kit.glm:vec 0.0 0.0 0.0) 131 | (kit.glm:vec 0.0 1.0 0.0)))) 132 | (kit.glm:matrix* kit.glm:+identity-matrix+ view projection))) 133 | 134 | (defgeneric add-buffer-data (sys buffer-data)) 135 | (defmethod add-buffer-data ((sys game) buffer-data) 136 | (let ((new-buffer (gl:gen-buffers 1)) 137 | (arr (gl:alloc-gl-array :float (length buffer-data)))) 138 | (dotimes (i (length buffer-data)) 139 | (setf (gl:glaref arr i) (aref buffer-data i))) 140 | (gl:bind-buffer :array-buffer (first new-buffer)) 141 | (gl:buffer-data :array-buffer :static-draw arr) 142 | (gl:free-gl-array arr) 143 | (setf (vb sys) (append (vb sys) new-buffer)))) 144 | 145 | (defmethod al:system-loop :before ((sys game)) 146 | (let ((texture-path (namestring (asdf:system-relative-pathname 147 | "cl-liballegro" "examples/test.png")))) 148 | (gl:clear-color 0.0 0.0 0.0 1.0) 149 | (gl:enable :depth-test) 150 | (gl:depth-func :less) 151 | 152 | (setf (vao sys) (gl:gen-vertex-arrays 1)) 153 | 154 | (gl:bind-vertex-array (first (vao sys))) 155 | 156 | (setf (shader-dict sys) 157 | (kit.gl.shader:compile-shader-dictionary (kit.gl.shader:dict *all-shaders*))) 158 | 159 | (setf (texture sys) 160 | (al:get-opengl-texture (al:load-bitmap texture-path))) 161 | 162 | (add-buffer-data sys *cube-data*) 163 | (add-buffer-data sys *uv-data*) 164 | 165 | (gl:bind-texture :texture-2d (texture sys)) 166 | (gl:tex-parameter :texture-2d :texture-mag-filter :linear) 167 | (gl:tex-parameter :texture-2d :texture-min-filter :linear-mipmap-linear) 168 | (gl:tex-parameter :texture-2d :texture-wrap-s :repeat) 169 | (gl:tex-parameter :texture-2d :texture-wrap-t :repeat) 170 | (gl:generate-mipmap :texture-2d))) 171 | 172 | (defmethod al:render ((sys game)) 173 | (gl:clear :color-buffer-bit :depth-buffer-bit) 174 | (kit.gl.shader:use-program (shader-dict sys) :simple-prog) 175 | (kit.gl.shader:uniform-matrix 176 | (shader-dict sys) :mvp 4 177 | (vector (model-view-projection-matrix (al:get-display-width (al:display sys)) 178 | (al:get-display-height (al:display sys))))) 179 | 180 | (gl:active-texture :texture0) 181 | (gl:bind-texture :texture-2d (texture sys)) 182 | (kit.gl.shader:uniformi (shader-dict sys) "textureSampler" 0) 183 | 184 | (gl:enable-vertex-attrib-array 0) 185 | (gl:bind-buffer :array-buffer (first (vb sys))) 186 | (gl:vertex-attrib-pointer 0 3 :float :false 0 (cffi:null-pointer)) 187 | 188 | (gl:enable-vertex-attrib-array 1) 189 | (gl:bind-buffer :array-buffer (second (vb sys))) 190 | (gl:vertex-attrib-pointer 1 2 :float :false 0 (cffi:null-pointer)) 191 | (gl:draw-arrays :triangles 0 (* 12 3)) 192 | (gl:disable-vertex-attrib-array 0) 193 | (gl:disable-vertex-attrib-array 1) 194 | (gl:use-program 0) 195 | (al:flip-display)) 196 | 197 | (defun main () 198 | (al:run-system (make-instance 'game))) 199 | -------------------------------------------------------------------------------- /examples/005-play-video.lisp: -------------------------------------------------------------------------------- 1 | ;;; Video player for .ogv files 2 | (ql:quickload "cl-liballegro") 3 | 4 | (defvar *screen*) 5 | (defvar *font*) 6 | (defvar *filename* "") 7 | (defparameter *zoom* nil) 8 | 9 | (defun video-display (video) 10 | (let (;; Videos often do not use square pixels - these return the 11 | ;; scaled dimensions of the video frame. 12 | (scaled-w (al:get-video-scaled-width video)) 13 | (scaled-h (al:get-video-scaled-height video)) 14 | ;; Get the currently visible frame of the video, based on clock 15 | ;; time. 16 | (frame (al:get-video-frame video)) 17 | (w) (h) (x) (y) 18 | (tc (al:map-rgba-f 0 0 0 0.5)) 19 | (bc (al:map-rgba-f 0.5 0.5 0.5 0.5)) 20 | (p)) 21 | 22 | ;; Return if there's no frame 23 | (when (cffi:null-pointer-p frame) 24 | (return-from video-display)) 25 | 26 | ;; Set width and height depending on zoom 27 | (if (eq *zoom* nil) 28 | (progn 29 | (setf h (al:get-display-height *screen*)) 30 | (setf w (/ (* h scaled-w) scaled-h)) 31 | (if (> w (al:get-display-width *screen*)) 32 | (setf w (al:get-display-width *screen*)) 33 | (setf h (/ (* w scaled-h) scaled-w)))) 34 | (progn 35 | (setf w scaled-w) 36 | (setf h scaled-h))) 37 | 38 | ;; Coordinates we're drawing to 39 | (setf x (/ (- (al:get-display-width *screen*) w) 2)) 40 | (setf y (/ (- (al:get-display-height *screen*) h) 2)) 41 | 42 | ;; Display the frame 43 | (al:draw-scaled-bitmap frame 0 0 44 | (al:get-bitmap-width frame) 45 | (al:get-bitmap-height frame) 46 | x y w h 0) 47 | ;; Show video info 48 | (al:draw-filled-rounded-rectangle 4 4 49 | (- (al:get-display-width *screen*) 4) (+ 4 (* 14 4)) 50 | 8 8 bc) 51 | (setf p (al:get-video-position video :actual)) 52 | (al:draw-text *font* tc 8 8 0 *filename*) 53 | (al:draw-text *font* tc 8 (+ 8 13) 0 54 | (format nil "~3d:~2,'0d (V: ~5,2@f A: ~5,2@f)" 55 | (floor (/ p 60)) (floor (mod p 60)) 56 | (- (al:get-video-position video :video-decode) p) 57 | (- (al:get-video-position video :audio-decode) p))) 58 | (al:draw-text *font* tc 8 (+ 8 (* 13 2)) 0 59 | (format nil "video rate ~,2f (~dx~d, aspect ~,1f) audio rate ~,0f" 60 | (al:get-video-fps video) 61 | (al:get-bitmap-width frame) 62 | (al:get-bitmap-height frame) 63 | (/ scaled-w scaled-h) 64 | (al:get-video-audio-rate video))) 65 | (al:draw-text *font* tc 8 (+ 8 (* 13 3)) 0 66 | (format nil "playing: ~:[true~;false~]" (al:is-video-playing video))) 67 | 68 | ;; Render to *screen* 69 | (al:flip-display) 70 | (al:clear-to-color (al:map-rgb 0 0 0)))) 71 | 72 | (defun play (f) 73 | (setf *filename* f) 74 | (format t "usage: (play FILENAME)~% only supports ogv files~%~%") 75 | (format t "space: play/pause~%z: zoom~%esc/q: quit~%") 76 | ;; Initialize allegro 77 | (al:init) 78 | (al:init-font-addon) 79 | (al:init-primitives-addon) 80 | (al:init-video-addon) 81 | (al:install-keyboard) 82 | (al:install-audio) 83 | (al:reserve-samples 1) 84 | 85 | ;; Create display 86 | (al:set-new-display-flags '(:resizable)) 87 | (al:set-new-display-option :vsync 1 :suggest) 88 | (setf *screen* (al:create-display 800 600)) 89 | 90 | ;; Create font 91 | (setf *font* (al:create-builtin-font)) 92 | 93 | ;; Set bitmap flags 94 | (al:set-new-bitmap-flags '(:min-linear :mag-linear)) 95 | (let ((video (al:open-video "output.ogv")) 96 | (queue (al:create-event-queue)) 97 | (event (cffi:foreign-alloc '(:union al:event))) 98 | (redraw t)) 99 | ;; Register events 100 | (al:register-event-source queue (al:get-video-event-source video)) 101 | (al:register-event-source queue (al:get-display-event-source *screen*)) 102 | (al:register-event-source queue (al:get-keyboard-event-source)) 103 | ;; Start video 104 | (al:start-video video (al:get-default-mixer)) 105 | (loop (when (and redraw (al:is-event-queue-empty queue)) 106 | (video-display video) 107 | (setf redraw nil)) 108 | (al:wait-for-event queue event) 109 | (case (cffi:foreign-slot-value event '(:union al:event) 'al::type) 110 | (:key-down 111 | (case (cffi:foreign-slot-value event '(:struct al:keyboard-event) 112 | 'al::keycode) 113 | (:space (al:set-video-playing video (not (al:is-video-playing video)))) 114 | ((:q :escape) (return)) 115 | (:z (setf *zoom* (not *zoom*))))) 116 | (:display-resize 117 | (al:acknowledge-resize *screen*) 118 | (al:clear-to-color (al:map-rgb 0 0 0))) 119 | (:display-close (return)) 120 | (:video-frame-show (setf redraw t)) 121 | (:finished))) 122 | (al:close-video video) 123 | (cffi:foreign-free event)) 124 | ;; All done! 125 | (al:destroy-display *screen*) 126 | (al:uninstall-system)) 127 | -------------------------------------------------------------------------------- /examples/006-state-polling-macros.lisp: -------------------------------------------------------------------------------- 1 | ;;; Example demonstrating how to use the state macros for convinience 2 | (ql:quickload :cl-liballegro) 3 | 4 | (defvar display) 5 | 6 | (defun main () 7 | ;; Create the display and load the input drivers 8 | (al:init) 9 | (al:install-keyboard) 10 | (al:install-mouse) 11 | (setf display (al:create-display 800 600)) 12 | ;; This macro will initialize STATE by calling 13 | ;; (al:get-keyboard-state STATE) for you before the body code. Use 14 | ;; WITH-KEYBOARD-STATE to leave uninitialized. 15 | (al:with-current-keyboard-state state 16 | (do () ((al:key-down state :escape)) ;; ESC terminates the loop 17 | (sleep 0.1) 18 | ;; Mouse state works like the keyboard state macros 19 | (al:with-current-mouse-state state 20 | ;; The mouse state can be exploded into a plist 21 | (let ((plist (cffi:mem-ref state '(:struct al:mouse-state)))) 22 | (format t "X:~a Y:~a~%" (getf plist 'al:x) (getf plist 'al:y)))) 23 | (al:get-keyboard-state state))) 24 | ;; All done let's cleanup 25 | (al:destroy-display display) 26 | (al:uninstall-system)) 27 | -------------------------------------------------------------------------------- /examples/007-file-streams.lisp: -------------------------------------------------------------------------------- 1 | ;;; Optional file streams interface example 2 | (ql:quickload "cl-liballegro") 3 | 4 | ;; Text files 5 | (with-open-stream (stream (al:make-character-stream "007-file-streams.lisp")) 6 | (princ "Here's the first Lisp form from this file:") 7 | ;; the result of (al:make-character-stream) is just a regular CL stream 8 | (print (read stream)) 9 | (terpri)) 10 | 11 | (let ((stream (al:make-character-stream "007-file-streams.lisp"))) 12 | (princ "Here's the first line from this file:") 13 | (princ (read-line stream)) 14 | (terpri) 15 | ;; remember to close the stream when finished if not using with-open-stream 16 | (close stream)) 17 | 18 | ;; Binary files 19 | (with-open-stream (stream (al:make-binary-stream "test.png")) 20 | ;; the binary stream does not perform any implicit newline conversions 21 | (let ((sequence (make-array 4 :element-type '(unsigned-byte 8)))) 22 | (read-sequence sequence stream) 23 | (princ "Here's the test.png file signature: ") 24 | (loop :for c :across sequence :do (format t "~:c " (code-char c))))) 25 | -------------------------------------------------------------------------------- /examples/008-native-dialog.lisp: -------------------------------------------------------------------------------- 1 | (ql:quickload :cl-liballegro) 2 | 3 | (defun display-msg-box () 4 | "View the function definition for more details: 5 | https://liballeg.github.io/a5docs/trunk/native_dialog.html#al_show_native_message_box 6 | 7 | Flags are defined in src/constants/addons/native-dialogs.lisp" 8 | (al:init) 9 | (al:init-native-dialog-addon) 10 | (let ((display (al:create-display 800 600))) 11 | (al:show-native-message-box display "Title" "Heading" "Text" (cffi:null-pointer) 0) 12 | (al:destroy-display display)) 13 | (al:shutdown-native-dialog-addon) 14 | (al:uninstall-system)) 15 | -------------------------------------------------------------------------------- /examples/test.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/resttime/cl-liballegro/219402ee3df810b5353a8154eff37bad3bdf6b3a/examples/test.png -------------------------------------------------------------------------------- /src/constants/addons/audio.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-liballegro) 2 | 3 | ;;; Audio addon 4 | (defcenum audio-depth 5 | (:int8 #x00) 6 | (:int16 #x01) 7 | (:int24 #x02) 8 | (:float32 #x03) 9 | 10 | (:unsigned #x08) 11 | 12 | (:uint8 #x08) 13 | (:uint16 #x09) 14 | (:uint24 #x0A)) 15 | 16 | (defconstant +audio-pan-none+ -1000.0) 17 | 18 | (defcenum channel-conf 19 | (:1 #x10) 20 | (:2 #x20) 21 | (:3 #x30) 22 | (:4 #x40) 23 | (:5-1 #x51) 24 | (:6-1 #x61) 25 | (:7-1 #x71)) 26 | 27 | (defcenum mixer-quality 28 | (:point #x110) 29 | (:linear #x111) 30 | (:cubic #x112)) 31 | 32 | (defcenum playmode 33 | (:once #x100) 34 | (:loop #x101) 35 | (:bidir #x102) 36 | (:-stream-once #x103) 37 | (:-stream-onedir #x104) 38 | (:loop-once #x105) 39 | (:-stream-loop-once #x106)) 40 | -------------------------------------------------------------------------------- /src/constants/addons/font.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-liballegro) 2 | 3 | (defcenum align-flags 4 | (:left 0) 5 | (:centre 1) 6 | (:center 1) 7 | (:right 2) 8 | (:integer 4)) 9 | 10 | (defbitfield ttf-flags 11 | :no-kerning 12 | :monochrome 13 | :no-autohint) 14 | -------------------------------------------------------------------------------- /src/constants/addons/native-dialogs.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-liballegro) 2 | 3 | (defbitfield filechooser-modes 4 | :file-must-exist 5 | :save 6 | :folder 7 | :pictures 8 | :show-hidden 9 | :multiple) 10 | 11 | (defcenum messagebox-flags 12 | (:warn 1) 13 | (:error 2) 14 | (:ok-cancel 4) 15 | (:yes-no 8) 16 | (:question 16)) 17 | 18 | (defbitfield textlog-flags 19 | (:no-close 1) 20 | (:monospace 2)) 21 | -------------------------------------------------------------------------------- /src/constants/addons/video-streaming.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-liballegro) 2 | 3 | (defcenum video-event-type 4 | (:frame-show 550) 5 | (:finished 551) 6 | (:-seek 552)) 7 | 8 | (defcenum video-position-type 9 | :actual 10 | :video-decode 11 | :audio-decode) 12 | -------------------------------------------------------------------------------- /src/constants/display.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-liballegro) 2 | 3 | ;; Flags 4 | (defbitfield display-flags 5 | :windowed 6 | :fullscreen 7 | :opengl 8 | :direct3d-internal 9 | :resizable 10 | :frameless 11 | (:noframe 32) 12 | :generate-expose-events 13 | :opengl-3-0 14 | :opengl-forward-compatible 15 | :fullscreen-window 16 | :minimized 17 | :programmable-pipeline 18 | :gtk-toplevel-internal 19 | :maximized 20 | :opengl-es-profile) 21 | 22 | ;; Display Options 23 | (defcenum display-options 24 | :red-size 25 | :green-size 26 | :blue-size 27 | :alpha-size 28 | :red-shift 29 | :green-shift 30 | :blue-shift 31 | :alpha-shift 32 | :acc-red-size 33 | :acc-green-size 34 | :acc-blue-size 35 | :acc-alpha-size 36 | :stereo 37 | :aux-buffers 38 | :color-size 39 | :depth-size 40 | :stencil-size 41 | :sample-buffers 42 | :samples 43 | :render-method 44 | :float-color 45 | :float-depth 46 | :single-buffer 47 | :swap-method 48 | :compatible-display 49 | :update-display-region 50 | :vsync 51 | :max-bitmap-size 52 | :support-npot-bitmap 53 | :can-draw-into-bitmap 54 | :support-separate-alpha 55 | :auto-convert-bitmaps 56 | :supported-orientations 57 | :opengl-major-version 58 | :opengl-minor-version 59 | :display-options-count) 60 | 61 | ;; Importance 62 | (defcenum importance 63 | :dontcare 64 | :require 65 | :suggest) 66 | 67 | ;; Display Orientation 68 | (defcenum display-orientation 69 | (:unknown 0) 70 | (:0-degrees 1) 71 | (:90-degrees 2) 72 | (:180-degrees 4) 73 | (:270-degrees 8) 74 | (:portrait 5) 75 | (:landscape 10) 76 | (:all 15) 77 | (:face-up 16) 78 | (:face-down 32)) 79 | 80 | (defconstant +new-window-title-max-size+ 255) 81 | -------------------------------------------------------------------------------- /src/constants/events.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-liballegro) 2 | 3 | (defcenum event-types 4 | (:joystick-axis 1) 5 | (:joystick-button-down 2) 6 | (:joystick-button-up 3) 7 | (:joystick-configuration 4) 8 | 9 | (:key-down 10) 10 | (:key-char 11) 11 | (:key-up 12) 12 | 13 | (:mouse-axis 20) 14 | (:mouse-button-down 21) 15 | (:mouse-button-up 22) 16 | (:mouse-enter-display 23) 17 | (:mouse-leave-display 24) 18 | (:mouse-warped 25) 19 | 20 | (:timer 30) 21 | 22 | (:display-expose 40) 23 | (:display-resize 41) 24 | (:display-close 42) 25 | (:display-lost 43) 26 | (:display-found 44) 27 | (:display-switch-in 45) 28 | (:display-switch-out 46) 29 | (:display-orientation 47) 30 | (:display-halt-drawing 48) 31 | (:display-resume-drawing 49) 32 | 33 | (:touch-begin 50) 34 | (:touch-end 51) 35 | (:touch-move 52) 36 | (:touch-cancel 53) 37 | 38 | (:display-connected 60) 39 | (:display-disconnected 61) 40 | 41 | ;; Audio event type (addon) 42 | (:-kcm-stream-feeder-quit-event-type 512) 43 | (:audio-stream-fragment 513) 44 | (:audio-stream-finished 514) 45 | (:audio-recorder-fragment 515) 46 | 47 | ;; Video event type (addon) 48 | (:video-frame-show 550) 49 | (:video-finished 551) 50 | (:-video-seek 552) 51 | 52 | ;; For user events (interface) 53 | (:wakeup 999)) 54 | -------------------------------------------------------------------------------- /src/constants/file-io.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-liballegro) 2 | 3 | (defcenum seek 4 | (:seek-set 0) 5 | (:seek-cur) 6 | (:seek-end)) 7 | -------------------------------------------------------------------------------- /src/constants/filesystem.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:cl-liballegro) 2 | 3 | (defbitfield file-mode 4 | :read 5 | :write 6 | :execute 7 | :hidden 8 | :isfile 9 | :isdir) 10 | 11 | (defcenum for-each-fs-entry-result 12 | (:error -1) 13 | (:ok 0) 14 | (:skip 1) 15 | (:stop 2)) 16 | -------------------------------------------------------------------------------- /src/constants/fixed-point-math.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-liballegro) 2 | 3 | (defconstant +fixtorad-r+ 1608) 4 | (defconstant +radtofix-r+ 2670177) 5 | 6 | -------------------------------------------------------------------------------- /src/constants/graphics.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-liballegro) 2 | 3 | ;; Bitmap flags 4 | (defbitfield bitmap-flags 5 | (:memory-bitmap #x0001) 6 | (:keep-bitmap-format #x0002) 7 | (:force-locking #x0004) 8 | (:no-preserve-texture #x0008) 9 | (:alpha-test #x0010) 10 | (:internal-opengl #x0020) 11 | (:min-linear #x0040) 12 | (:mag-linear #x0080) 13 | (:mipmap #x0100) 14 | (:no-premultiplied-alpha #x0200) 15 | (:video-bitmap #x0400) 16 | (:convert-bitmap #x1000)) 17 | 18 | ;; Loader flags 19 | (defbitfield bitmap-loader-flags 20 | (:keep-bitmap-format #x0002) 21 | (:no-premultiplied-alpha #x0200) 22 | (:keep-index #x0800)) 23 | 24 | ;; Flags for blitting functions 25 | (defbitfield draw-flags 26 | (:flip-horizontal #x00001) 27 | (:flip-vertical #x00002)) 28 | ;; Locking flags 29 | (defcenum locking-flags 30 | :readwrite 31 | :readonly 32 | :writeonly) 33 | ;; Locking and pixel formats 34 | (defcenum pixel-format 35 | (:any 0) 36 | :any-no-alpha 37 | :any-with-alpha 38 | :any-15-no-alpha 39 | :any-16-no-alpha 40 | :any-16-with-alpha 41 | :any-24-no-alpha 42 | :any-32-no-alpha 43 | :any-32-with-alpha 44 | :argb-8888 45 | :rgba-8888 46 | :argb-4444 47 | :rgb-888 48 | :rgb-565 49 | :rgb-555 50 | :rgba-5551 51 | :argb-1555 52 | :abgr-8888 53 | :xbgr-8888 54 | :bgr-888 55 | :bgr-565 56 | :bgr-555 57 | :rgbx-8888 58 | :xrgb-8888 59 | :abgr-f32 60 | :abgr-8888-le 61 | :rgba-4444 62 | :single-channel-8 63 | :compressed-rgba-dxt1 64 | :compressed-rgba-dxt3 65 | :compressed-rgba-dxt5 66 | :num-pixel-formats) 67 | (defcenum blend-mode 68 | :zero 69 | :one 70 | :alpha 71 | :inverse-alpha 72 | :src-color 73 | :dest-color 74 | :inverse-src-color 75 | :inverse-dest-color 76 | :const-color 77 | :inverse-cons-color 78 | :num-blend-modes) 79 | (defcenum blend-operations 80 | :add 81 | :src-minus-dest 82 | :dest-minus-src 83 | :num-blend-operations) 84 | 85 | (defcenum render-state 86 | (:alpha-test #x0010) 87 | :write-mask 88 | :depth-test 89 | :depth-function 90 | :alpha-function 91 | :alpha-test-value) 92 | 93 | (defcenum render-function 94 | :never 95 | :always 96 | :less 97 | :equal 98 | :less-equal 99 | :greater 100 | :not-equal 101 | :greater-equal) 102 | 103 | (defbitfield write-mask-flags 104 | :red 105 | :green 106 | :blue 107 | :alpha 108 | :depth 109 | (:rgb #x0007) ; RED | GREEN | BLUE 110 | (:rgba #x000F)) ; RGB | ALPHA 111 | 112 | ;; Bitmap Creation 113 | (defcenum bitmap-wrap 114 | :bitmap-wrap-default 115 | :bitmap-wrap-repeat 116 | :bitmap-wrap-clamp 117 | :bitmap-wrap-mirror) 118 | -------------------------------------------------------------------------------- /src/constants/haptic.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-liballegro) 2 | 3 | (defbitfield haptic-constants 4 | :rumble 5 | :periodic 6 | :constant 7 | :spring 8 | :friction 9 | :damper 10 | :inertia 11 | :ramp 12 | :square 13 | :triangle 14 | :sine 15 | :saw-up 16 | :saw-down 17 | :custom 18 | :gain 19 | :angle 20 | :raduis 21 | :azimuth 22 | :autocenter) 23 | -------------------------------------------------------------------------------- /src/constants/joystick.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-liballegro) 2 | 3 | (defcenum joyflags 4 | (:digital #x01) 5 | (:analogue #x02)) 6 | -------------------------------------------------------------------------------- /src/constants/keyboard.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-liballegro) 2 | 3 | ;; Keycodes 4 | (defcenum keycodes 5 | (:|none| 0) 6 | (:a 1) 7 | (:b 2) 8 | (:c 3) 9 | (:d 4) 10 | (:e 5) 11 | (:f 6) 12 | (:g 7) 13 | (:h 8) 14 | (:i 9) 15 | (:j 10) 16 | (:k 11) 17 | (:l 12) 18 | (:m 13) 19 | (:n 14) 20 | (:o 15) 21 | (:p 16) 22 | (:q 17) 23 | (:r 18) 24 | (:s 19) 25 | (:t 20) 26 | (:u 21) 27 | (:v 22) 28 | (:w 23) 29 | (:x 24) 30 | (:y 25) 31 | (:z 26) 32 | 33 | (:0 27) 34 | (:1 28) 35 | (:2 29) 36 | (:3 30) 37 | (:4 31) 38 | (:5 32) 39 | (:6 33) 40 | (:7 34) 41 | (:8 35) 42 | (:9 36) 43 | 44 | (:pad-0 37) 45 | (:pad-1 38) 46 | (:pad-2 39) 47 | (:pad-3 40) 48 | (:pad-4 41) 49 | (:pad-5 42) 50 | (:pad-6 43) 51 | (:pad-7 44) 52 | (:pad-8 45) 53 | (:pad-9 46) 54 | 55 | (:f1 47) 56 | (:f2 48) 57 | (:f3 49) 58 | (:f4 50) 59 | (:f5 51) 60 | (:f6 52) 61 | (:f7 53) 62 | (:f8 54) 63 | (:f9 55) 64 | (:f10 56) 65 | (:f11 57) 66 | (:f12 58) 67 | 68 | (:escape 59) 69 | (:tilde 60) 70 | (:minus 61) 71 | (:equals 62) 72 | (:backspace 63) 73 | (:tab 64) 74 | (:openbrace 65) 75 | (:closebrace 66) 76 | (:enter 67) 77 | (:semicolon 68) 78 | (:quote 69) 79 | (:backslash 70) 80 | (:backslash2 71) 81 | (:comma 72) 82 | (:fullstop 73) 83 | (:slash 74) 84 | (:space 75) 85 | 86 | (:insert 76) 87 | (:delete 77) 88 | (:home 78) 89 | (:end 79) 90 | (:pgup 80) 91 | (:pgdn 81) 92 | (:left 82) 93 | (:right 83) 94 | (:up 84) 95 | (:down 85) 96 | 97 | (:pad-slash 86) 98 | (:pad-asterisk 87) 99 | (:pad-minus 88) 100 | (:pad-plus 89) 101 | (:pad-delete 90) 102 | (:pad-enter 91) 103 | 104 | (:printscreen 92) 105 | (:pause 93) 106 | 107 | (:abnt-c1 94) 108 | (:yen 95) 109 | (:kana 96) 110 | (:convert 97) 111 | (:noconvert 98) 112 | (:at 99) 113 | (:circumflex 100) 114 | (:colon2 101) 115 | (:kanji 102) 116 | 117 | (:pad_equals 103) 118 | (:backquote 104) 119 | (:semicolon2 105) 120 | (:command 106) 121 | 122 | (:back 107) 123 | (:volume_up 108) 124 | (:volume_down 109) 125 | (:search 110) 126 | (:dpad_center 111) 127 | (:button_x 112) 128 | (:button_y 113) 129 | (:dpad_up 114) 130 | (:dpad_down 115) 131 | (:dpad_left 116) 132 | (:dpad_right 117) 133 | (:select 118) 134 | (:start 119) 135 | (:button_l1 120) 136 | (:button_r1 121) 137 | (:button_l2 122) 138 | (:button_r2 123) 139 | (:button_a 124) 140 | (:button_b 125) 141 | (:thumbl 126) 142 | (:thumbr 127) 143 | 144 | (:unknown 128) 145 | 146 | (:modifiers 215) 147 | (:lshift 215) 148 | (:rshift 216) 149 | (:lctrl 217) 150 | (:rctrl 218) 151 | (:alt 219) 152 | (:altgr 220) 153 | (:lwin 221) 154 | (:rwin 222) 155 | (:menu 223) 156 | (:scrolllock 224) 157 | (:numlock 225) 158 | (:capslock 226) 159 | 160 | (:key-max 227)) 161 | 162 | ;; Keyboard modifier flags 163 | (defbitfield keymods 164 | (:shift #x00001) 165 | (:ctrl #x00002) 166 | (:alt #x00004) 167 | (:lwin #x00008) 168 | (:rwin #x00010) 169 | (:menu #x00020) 170 | (:altgr #x00040) 171 | (:command #x00080) 172 | (:scrolllock #x00100) 173 | (:numlock #x00200) 174 | (:capslock #x00400) 175 | (:inaltseq #x00800) 176 | (:accent1 #x01000) 177 | (:accent2 #x02000) 178 | (:accent3 #x04000) 179 | (:accent4 #x08000)) 180 | -------------------------------------------------------------------------------- /src/constants/misc.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-liballegro) 2 | 3 | (defconstant +pi+ 3.14159265358979323846) 4 | -------------------------------------------------------------------------------- /src/constants/mouse.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-liballegro) 2 | 3 | (defconstant +mouse-max-extra-axes+ 4 4 | "Allow up to four extra axes for future expansion.") 5 | 6 | ;; Mouse cursors 7 | (defcenum system-mouse-cursor 8 | (:none 0) 9 | (:default 1) 10 | (:arrow 2) 11 | (:busy 3) 12 | (:question 4) 13 | (:edit 5) 14 | (:move 6) 15 | (:resize-n 7) 16 | (:resize-w 8) 17 | (:resize-s 9) 18 | (:resize-e 10) 19 | (:resize-nw 11) 20 | (:resize-sw 12) 21 | (:resize-se 13) 22 | (:resize-ne 14) 23 | (:progress 15) 24 | (:precision 16) 25 | (:link 17) 26 | (:alt-select 18) 27 | (:unavailable 19) 28 | :num-system-mouse-cursors) 29 | -------------------------------------------------------------------------------- /src/constants/opengl.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-liballegro) 2 | 3 | (defcenum opengl-variant 4 | :desktop-opengl 5 | :opengl-es) 6 | -------------------------------------------------------------------------------- /src/constants/shader.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:cl-liballegro) 2 | 3 | (defcenum shader-type 4 | (:vertex 1) 5 | (:pixel 2)) 6 | (defcenum shader-platform 7 | :auto 8 | :glsl 9 | :hlsl 10 | :auto-minimal 11 | :glsl-minimal 12 | :hlsl-minimal 13 | :hlsl-sm-3-0) 14 | -------------------------------------------------------------------------------- /src/constants/state.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-liballegro) 2 | 3 | (defbitfield state-flags 4 | (:new-display-parameters #x0001) 5 | (:new-bitmap-parameters #x0002) 6 | (:display #x0004) 7 | (:target-bitmap #x0008) 8 | (:blender #x0010) 9 | (:new-file-interface #x0020) 10 | (:transform #x0040) 11 | 12 | (:bitmap 10) 13 | 14 | (:all #xffff)) 15 | 16 | -------------------------------------------------------------------------------- /src/constants/system.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-liballegro) 2 | 3 | (defcenum path-id 4 | :resources-path 5 | :temp-path 6 | :user-data-path 7 | :user-home-path 8 | :user-settings-path 9 | :user-documents-path 10 | :exename-path 11 | :last-path) 12 | 13 | -------------------------------------------------------------------------------- /src/constants/touch-input.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:cl-liballegro) 2 | 3 | (defconstant +touch-input-max-touch-count+ 16) 4 | -------------------------------------------------------------------------------- /src/ffi-functions/addons/audio-codecs.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:cl-liballegro) 2 | 3 | ;;; Audio codecs addon 4 | (defcfun ("al_init_acodec_addon" init-acodec-addon) :boolean) 5 | (defcfun ("al_get_allegro_acodec_version" get-allegro-acodec-version) :uint32) 6 | -------------------------------------------------------------------------------- /src/ffi-functions/addons/audio.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:cl-liballegro) 2 | 3 | ;;; Audio addon 4 | ;; Basic audio 5 | (defcfun ("al_install_audio" install-audio) :boolean) 6 | (defcfun ("al_uninstall_audio" uninstall-audio) :void) 7 | (defcfun ("al_is_audio_installed" is-audio-installed) :boolean) 8 | (defcfun ("al_reserve_samples" reserve-samples) :boolean (reserve-samples :int)) 9 | (defcfun ("al_play_sample" play-sample) :boolean 10 | (spl :pointer) 11 | (gain c-float) (pan c-float) (speed c-float) 12 | (playmode playmode) 13 | (ret-id :pointer)) 14 | (defcfun ("al_stop_sample" stop-sample) :void (spl-id :pointer)) 15 | (defcfun ("al_stop_samples" stop-samples) :void) 16 | (defcfun ("al_lock_sample_id" lock-sample-id) :pointer (spl-id :pointer)) 17 | (defcfun ("al_unlock_sample_id" unlock-sample-id) :void (spl-id :pointer)) 18 | (defcfun ("al_play_audio_stream" play-audio-stream) :pointer (filename :string)) 19 | (defcfun ("al_play_audio_stream_f" play-audio-stream-f) :pointer 20 | (fp :pointer) (ident :string)) 21 | 22 | ;; Samples 23 | (defcfun ("al_create_sample" create-sample) :pointer 24 | (buf :pointer) (sample :uint) (freq :uint) 25 | (depth audio-depth) (chan-conf channel-conf) 26 | (free-buf :boolean)) 27 | (defcfun ("al_load_sample" load-sample) :pointer (filename :string)) 28 | (defcfun ("al_load_sample_f" load-sample-f) :pointer (fp :pointer) (ident :string)) 29 | (defcfun ("al_save_sample" save-sample) :boolean 30 | (filename :string) (spl :pointer)) 31 | (defcfun ("al_save_sample_f" save-sample-f) :boolean 32 | (fp :pointer) (ident :string) (spl :pointer)) 33 | (defcfun ("al_destroy_sample" destroy-sample) :void (spl :pointer)) 34 | (defcfun ("al_get_sample_channels" get-sample-channels) channel-conf 35 | (spl :pointer)) 36 | (defcfun ("al_get_sample_depth" get-sample-depth) audio-depth 37 | (spl :pointer)) 38 | (defcfun ("al_get_sample_frequency" get-sample-frequency) :uint (spl :pointer)) 39 | (defcfun ("al_get_sample_length" get-sample-length) :uint (spl :pointer)) 40 | (defcfun ("al_get_sample_data" get-sample-data) :void (spl :pointer)) 41 | 42 | ;; Sample instances 43 | (defcfun ("al_create_sample_instance" create-sample-instance) :pointer 44 | (sample-data :pointer)) 45 | (defcfun ("al_destroy_sample_instance" destroy-sample-instance) :void 46 | (sample-data :pointer)) 47 | (defcfun ("al_play_sample_instance" play-sample-instance) :boolean (spl :pointer)) 48 | (defcfun ("al_stop_sample_instance" stop-sample-instance) :boolean (spl :pointer)) 49 | (defcfun ("al_get_sample_instance_channels" get-sample-instance-channels) 50 | channel-conf 51 | (spl :pointer)) 52 | (defcfun ("al_get_sample_instance_depth" get-sample-instance-depth) 53 | audio-depth 54 | (spl :pointer)) 55 | (defcfun ("al_get_sample_instance_frequency" get-sample-instance-frequency) :uint 56 | (spt :pointer)) 57 | (defcfun ("al_get_sample_instance_length" get-sample-instance-length) :uint 58 | (spt :pointer)) 59 | (defcfun ("al_set_sample_instance_length" set-sample-instance-length) :boolean 60 | (spt :pointer) (val :uint)) 61 | (defcfun ("al_get_sample_instance_position" get-sample-instance-position) :uint 62 | (spl :pointer)) 63 | (defcfun ("al_set_sample_instance_position" set-sample-instance-position) :boolean 64 | (spl :pointer) (val :uint)) 65 | (defcfun ("al_get_sample_instance_speed" get-sample-instance-speed) c-float 66 | (spl :pointer)) 67 | (defcfun ("al_set_sample_instance_speed" set-sample-instance-speed) :boolean 68 | (spl :pointer) (val c-float)) 69 | (defcfun ("al_get_sample_instance_gain" get-sample-instance-gain) c-float 70 | (spl :pointer)) 71 | (defcfun ("al_set_sample_instance_gain" set-sample-instance-gain) :boolean 72 | (spl :pointer) (val c-float)) 73 | (defcfun ("al_get_sample_instance_pan" get-sample-instance-pan) c-float 74 | (spl :pointer)) 75 | (defcfun ("al_set_sample_instance_pan" set-sample-instance-pan) :boolean 76 | (spl :pointer) (val c-float)) 77 | (defcfun ("al_get_sample_instance_time" get-sample-instance-time) c-float 78 | (spl :pointer)) 79 | (defcfun ("al_get_sample_instance_playmode" get-sample-instance-playmode) 80 | playmode 81 | (spl :pointer)) 82 | (defcfun ("al_set_sample_instance_playmode" set-sample-instance-playmode) :boolean 83 | (spl :pointer) (val playmode)) 84 | (defcfun ("al_get_sample_instance_playing" get-sample-instance-playing) :boolean 85 | (spl :pointer)) 86 | (defcfun ("al_set_sample_instance_playing" set-sample-instance-playing) :boolean 87 | (spl :pointer) (val :boolean)) 88 | (defcfun ("al_get_sample_instance_attached" get-sample-instance-attached) :boolean 89 | (spl :pointer)) 90 | (defcfun ("al_detach_sample_instance" detach-sample-instance) :boolean 91 | (spl :pointer)) 92 | (defcfun ("al_get_sample" get-sample) :pointer (spl :pointer)) 93 | (defcfun ("al_set_sample" set-sample) :boolean (spl :pointer) (data :pointer)) 94 | (defcfun ("al_set_sample_instance_channel_matrix" set-sample-instance-channel-matrix) :bool 95 | (spl :pointer) (matrix :pointer)) 96 | 97 | ;; Audio streams 98 | (defcfun ("al_create_audio_stream" create-audio-stream) :pointer 99 | (fragment-count :uint) (frag-samples :uint) (freq :uint) 100 | (depth audio-depth) (chan-conf channel-conf)) 101 | (defcfun ("al_load_audio_stream" load-audio-stream) :pointer 102 | (filename :string) (buffer-count :int) (sample :uint)) 103 | (defcfun ("al_load_audio_stream_f" load-audio-stream-f) :pointer 104 | (fp :pointer) (ident :string) (buffer-count :int) (sample :uint)) 105 | (defcfun ("al_destroy_audio_stream" destroy-audio-stream) :void (stream :pointer)) 106 | (defcfun ("al_get_audio_stream_event_source" get-audio-stream-event-source) :pointer 107 | (stream :pointer)) 108 | (defcfun ("al_drain_audio_stream" drain-audio-stream) :void (stream :pointer)) 109 | (defcfun ("al_rewind_audio_stream" rewind-audio-stream) :boolean (stream :pointer)) 110 | (defcfun ("al_get_audio_stream_frequency" get-audio-stream-frequency) :uint 111 | (stream :pointer)) 112 | (defcfun ("al_get_audio_stream_channels" get-audio-stream-channels) 113 | channel-conf 114 | (stream :pointer)) 115 | (defcfun ("al_get_audio_stream_depth" get-audio-stream-depth) audio-depth 116 | (stream :pointer)) 117 | (defcfun ("al_get_audio_stream_length" get-audio-stream-length) :uint 118 | (stream :pointer)) 119 | (defcfun ("al_get_audio_stream_speed" get-audio-stream-speed) c-float 120 | (stream :pointer)) 121 | (defcfun ("al_set_audio_stream_speed" set-audio-stream-speed) :boolean 122 | (stream :pointer) (val c-float)) 123 | (defcfun ("al_get_audio_stream_gain" get-audio-stream-gain) c-float 124 | (stream :pointer)) 125 | (defcfun ("al_set_audio_stream_gain" set-audio-stream-gain) :boolean 126 | (stream :pointer) (val c-float)) 127 | (defcfun ("al_get_audio_stream_pan" get-audio-stream-pan) c-float 128 | (stream :pointer)) 129 | (defcfun ("al_set_audio_stream_pan" set-audio-stream-pan) :boolean 130 | (stream :pointer) (val c-float)) 131 | (defcfun ("al_get_audio_stream_playing" get-audio-stream-playing) :boolean 132 | (stream :pointer)) 133 | (defcfun ("al_set_audio_stream_playing" set-audio-stream-playing) :boolean 134 | (stream :pointer) (val :boolean)) 135 | (defcfun ("al_get_audio_stream_playmode" get-audio-stream-playmode) playmode 136 | (stream :pointer)) 137 | (defcfun ("al_set_audio_stream_playmode" set-audio-stream-playmode) :boolean 138 | (stream :pointer) (val playmode)) 139 | (defcfun ("al_get_audio_stream_attached" get-audio-stream-attached) :boolean 140 | (stream :pointer)) 141 | (defcfun ("al_detach_audio_stream" detach-audio-stream) :boolean 142 | (stream :pointer)) 143 | (defcfun ("al_get_audio_stream_played_samples" get-audio-stream-played-samples) :uint64 144 | (stream :pointer)) 145 | (defcfun ("al_get_audio_stream_fragment" get-audio-stream-fragment) :pointer 146 | (stream :pointer)) 147 | (defcfun ("al_set_audio_stream_fragment" set-audio-stream-fragment) :boolean 148 | (stream :pointer) (val :pointer)) 149 | (defcfun ("al_get_audio_stream_fragments" get-audio-stream-fragments) :uint 150 | (stream :pointer)) 151 | (defcfun ("al_get_available_audio_stream_fragments" 152 | get-available-audio-stream-fragments) :uint 153 | (stream :pointer)) 154 | (defcfun ("al_seek_audio_stream_secs" seek-audio-stream-secs) :boolean 155 | (stream :pointer) (time c-double)) 156 | (defcfun ("al_get_audio_stream_position_secs" 157 | get-audio-stream-position-secs) c-double 158 | (stream :pointer)) 159 | (defcfun ("al_get_audio_stream_length_secs" get-audio-stream-length-secs) c-double 160 | (stream :pointer)) 161 | (defcfun ("al_set_audio_stream_loop_secs" set-audio-stream-loop-secs) :boolean 162 | (stream :pointer) (start c-double) (end c-double)) 163 | (defcfun ("al_set_audio_stream_channel_matrix" set-audio-stream-channel-matrix) :bool 164 | (stream :pointer) (matrix :pointer)) 165 | 166 | ;; Advanced audio file I/O 167 | (defcfun ("al_register_sample_loader" register-sample-loader) :boolean 168 | (ext :string) (loader :pointer)) 169 | (defcfun ("al_register_sample_loader_f" register-sample-loader-f) :boolean 170 | (ext :string) (loader :pointer)) 171 | (defcfun ("al_register_sample_saver" register-sample-saver) :boolean 172 | (ext :string) (saver :boolean)) 173 | (defcfun ("al_register_sample_saver_f" register-sample-saver-f) :boolean 174 | (ext :string) (saver :boolean)) 175 | (defcfun ("al_register_audio_stream_loader" register-audio-stream-loader) :boolean 176 | (ext :string) (stream-loader :pointer)) 177 | (defcfun ("al_register_audio_stream_loader_f" register-audio-stream-loader-f) 178 | :boolean 179 | (ext :string) (stream-loader :pointer)) 180 | 181 | (defcfun ("al_register_sample_identifier" register-sample-identifier) :bool 182 | (ext :string) (fp :pointer)) 183 | (defcfun ("al_identify_sample" identify-sample) :string (filename :string)) 184 | (defcfun ("al_identify_sample_f" identify-sample-f) :string (fp :pointer)) 185 | 186 | ;; Audio recording 187 | (defcfun ("al_create_audio_recorder" create-audio-recorder) :pointer 188 | (fragment-count :uint) 189 | (samples :uint) 190 | (frequency :uint) 191 | (depth audio-depth) 192 | (chan-conf channel-conf)) 193 | (defcfun ("al_start_audio_recorder" start-audio-recorder) :bool (r :pointer)) 194 | (defcfun ("al_stop_audio_recorder" stop-audio-recorder) :void (r :pointer)) 195 | (defcfun ("al_is_audio_recorder_recording" is-audio-recorder-recording) :bool (r :pointer)) 196 | (defcfun ("al_get_audio_recorder_event" get-audio-recorder-event) :pointer (event :pointer)) 197 | (defcfun ("al_get_audio_recorder_event_source" get-audio-recorder-event-source) :pointer (r :pointer)) 198 | (defcfun ("al_destroy_audio_recorder" destroy-audio-recorder) :void (r :pointer)) 199 | 200 | ;; Audio devices 201 | (defcfun ("al_get_num_audio_output_devices" get-num-audio-output-devices) :int) 202 | (defcfun ("al_get_audio_output_device" get-audio-output-device) :pointer (index :int)) 203 | (defcfun ("al_get_audio_device_name" get-audio-device-name) :string (device :pointer)) 204 | 205 | ;; Voices 206 | (defcfun ("al_create_voice" create-voice) :pointer 207 | (freq :uint) (depth audio-depth) (chan-conf channel-conf)) 208 | (defcfun ("al_destroy_voice" destory-voice) :void (voice :pointer)) 209 | (defcfun ("al_detach_voice" detach-voice) :void (voice :pointer)) 210 | (defcfun ("al_attach_audio_stream_to_voice" attach-audio-stream-to-voice) :boolean 211 | (stream :pointer) (voice :pointer)) 212 | (defcfun ("al_attach_mixer_to_voice" attach-mixer-to-voice) :boolean 213 | (mixer :pointer) (voice :pointer)) 214 | (defcfun ("al_attach_sample_instance_to_voice" attach-sample-instance-to-voice) 215 | :boolean 216 | (spl :pointer) (voice :pointer)) 217 | (defcfun ("al_get_voice_frequency" get-voice-frequency) :uint (voice :pointer)) 218 | (defcfun ("al_get_voice_channels" get-voice-channels) channel-conf 219 | (voice :pointer)) 220 | (defcfun ("al_get_voice_depth" get-voice-depth) audio-depth 221 | (voice :pointer)) 222 | (defcfun ("al_get_voice_playing" get-voice-playing) :boolean (voice :pointer)) 223 | (defcfun ("al_set_voice_playing" set-voice-playing) :boolean 224 | (voice :pointer) (val :boolean)) 225 | (defcfun ("al_get_voice_position" get-voice-position) :uint (voice :pointer)) 226 | (defcfun ("al_set_voice_position" set-voice-position) :boolean 227 | (voice :pointer) (val :int)) 228 | (defcfun ("al_voice_has_attachments" voice-has-attachments) :boolean (voice :pointer)) 229 | 230 | ;; Mixers 231 | (defcfun ("al_create_mixer" create-mixer) :pointer 232 | (freq :uint) (depth audio-depth) (chan-conf channel-conf)) 233 | (defcfun ("al_destroy_mixer" destroy-mixer) :void (mixer :pointer)) 234 | (defcfun ("al_get_default_mixer" get-default-mixer) :pointer) 235 | (defcfun ("al_set_default_mixer" set-default-mixer) :boolean (mixer :pointer)) 236 | (defcfun ("al_restore_default_mixer" restore-default-mixer) :boolean) 237 | (defcfun ("al_attach_mixer_to_mixer" attach-mixer-to-mixer) :boolean 238 | (stream :pointer) (mixer :pointer)) 239 | (defcfun ("al_attach_sample_instance_to_mixer" attach-sample-instance-to-mixer) 240 | :boolean 241 | (spl :pointer) (mixer :pointer)) 242 | (defcfun ("al_attach_audio_stream_to_mixer" attach-audio-stream-to-mixer) :boolean 243 | (stream :pointer) (mixer :pointer)) 244 | (defcfun ("al_get_mixer_frequency" get-mixer-frequency) :uint (mixer :pointer)) 245 | (defcfun ("al_set_mixer_frequency" set-mixer-frequency) :boolean 246 | (mixer :pointer) (val :uint)) 247 | (defcfun ("al_get_mixer_channels" get-mixer-channels) channel-conf 248 | (mixer :pointer)) 249 | (defcfun ("al_get_mixer_depth" get-mixer-depth) audio-depth 250 | (mixer :pointer)) 251 | (defcfun ("al_get_mixer_gain" get-mixer-gain) c-float 252 | (mixer :pointer)) 253 | (defcfun ("al_set_mixer_gain" set-mixer-gain) :boolean 254 | (mixer :pointer) (new-gain c-float)) 255 | (defcfun ("al_get_mixer_quality" get-mixer-quality) mixer-quality 256 | (mixer :pointer)) 257 | (defcfun ("al_set_mixer_quality" set-mixer-quality) :boolean 258 | (mixer :pointer) (new-quality mixer-quality)) 259 | (defcfun ("al_get_mixer_playing" get-mixer-playing) :boolean 260 | (mixer :pointer)) 261 | (defcfun ("al_set_mixer_playing" set-mixer-playing) :boolean 262 | (mixer :pointer) (val :boolean)) 263 | (defcfun ("al_get_mixer_attached" get-mixer-attached) :boolean (mixer :pointer)) 264 | (defcfun ("al_mixer_has_attachments" mixer-has-attachments) :boolean (mixer :pointer)) 265 | (defcfun ("al_detach_mixer" detach-mixer) :boolean (mixer :pointer)) 266 | (defcfun ("al_set_mixer_postprocess_callback" set-mixer-postprocess-callback) 267 | :boolean 268 | (mixer :pointer) (pp-callback :pointer) (pp-callback-userdata :pointer)) 269 | 270 | ;; Miscellaneous 271 | (defcfun ("al_get_allegro_audio_version" get-allegro-audio-version) :uint32) 272 | (defcfun ("al_get_audio_depth_size" get-audio-depth-size) :uint 273 | (depth audio-depth)) 274 | (defcfun ("al_get_channel_count" get-channel-count) :uint 275 | (conf channel-conf)) 276 | (defcfun ("al_fill_silence" fill-silence) :void 277 | (buf :pointer) (samples :uint) (depth audio-depth) (chan-conf channel-conf)) 278 | -------------------------------------------------------------------------------- /src/ffi-functions/addons/color.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:cl-liballegro) 2 | 3 | ;;; Color addon 4 | (defcfun ("al_color_cmyk" color-cmyk) (:struct color) 5 | (c c-float) (m c-float) (y c-float) (k c-float)) 6 | (defcfun ("al_color_cmyk_to_rgb" color-cmyk-to-rgb) :void 7 | (cyan c-float) (magenta c-float) (yellow c-float) (key c-float) 8 | (red :pointer) (green :pointer) (blue :pointer)) 9 | (defcfun ("al_color_hsl" color-hsl) (:struct color) 10 | (h c-float) (s c-float) (l c-float)) 11 | (defcfun ("al_color_hsl_to_rgb" color-hsl-to-rgb) :void 12 | (hue c-float) (saturation c-float) (lightness c-float) 13 | (red :pointer) (green :pointer) (blue :pointer)) 14 | (defcfun ("al_color_hsv" color-hsv) (:struct color) 15 | (h c-float) (s c-float) (r c-float)) 16 | (defcfun ("al_color_hsv_to_rgb" color-hsv-to-rgb) :void 17 | (hue c-float) (saturation c-float) (value c-float) 18 | (red :pointer) (green :pointer) (blue :pointer)) 19 | (defcfun ("al_color_html" color-html) (:struct color) (string :string)) 20 | (defcfun ("al_color_html_to_rgb" color-html-to-rgb) :void 21 | (string :string) (red :pointer) (green :pointer) (blue :pointer)) 22 | (defcfun ("al_color_rgb_to_html" color-rgb-to-html) :void 23 | (red c-float) (green c-float) (blue c-float) (string :string)) 24 | (defcfun ("al_color_name" color-name) (:struct color) (name :string)) 25 | (defcfun ("al_color_name_to_rgb" color-name-to-rgb) :boolean 26 | (name :string) (r :pointer) (g :pointer) (b :pointer)) 27 | (defcfun ("al_color_rgb_to_cmyk" color-rgb-to-cmyk) :void 28 | (red c-float) (green c-float) (blue c-float) 29 | (cyan :pointer) (magenta :pointer) (yellow :pointer) (key :pointer)) 30 | (defcfun ("al_color_rgb_to_hsl" color-rgb-to-hsl) :void 31 | (red c-float) (green c-float) (blue c-float) 32 | (hue :pointer) (saturation :pointer) (lightness :pointer)) 33 | (defcfun ("al_color_rgb_to_hsv" color-rgb-to-hsv) :void 34 | (red c-float) (green c-float) (blue c-float) 35 | (hue :pointer) (saturation :pointer) (value :pointer)) 36 | (defcfun ("al_color_rgb_to_name" color-rgb-to-name) :string 37 | (r c-float) (g c-float) (b c-float)) 38 | (defcfun ("al_color_rgb_to_xyz" color-rgb-to-xyz) :void 39 | (r c-float) (g c-float) (b c-float) 40 | (x :pointer) (y :pointer) (z :pointer)) 41 | (defcfun ("al_color_xyz" color-xyz) (:struct color) 42 | (x c-float) (y c-float) (z c-float)) 43 | (defcfun ("al_color_xyz_to_rgb" color-xyz-to-rgb) :void 44 | (x c-float) (y c-float) (z c-float) 45 | (red :pointer) (green :pointer) (blue :pointer)) 46 | (defcfun ("al_color_rgb_to_xyy" color-rgb-to-xyy) :void 47 | (r c-float) (g c-float) (b c-float) 48 | (x :pointer) (y :pointer) (y2 :pointer)) 49 | (defcfun ("al_color_xyy" color-xyy) (:struct color) 50 | (x c-float) (y c-float) (y2 c-float)) 51 | (defcfun ("al_color_xyy_to_rgb" color-xyy-to-rgb) :void 52 | (x c-float) (y c-float) (y2 c-float) 53 | (red :pointer) (green :pointer) (blue :pointer)) 54 | (defcfun ("al_color_rgb_to_lab" color-rgb-to-lab) :void 55 | (red c-float) (green c-float) (blue c-float) 56 | (l :pointer) (a :pointer) (b :pointer)) 57 | (defcfun ("al_color_lab" color-lab) (:struct color) 58 | (l c-float) (a c-float) (b c-float)) 59 | (defcfun ("al_color_lab_to_rgb" color-lab-to-rgb) :void 60 | (l c-float) (a c-float) (b c-float) 61 | (red :pointer) (green :pointer) (blue :pointer)) 62 | (defcfun ("al_color_rgb_to_lch" color-rgb-to-lch) :void 63 | (r c-float) (g c-float) (b c-float) 64 | (l :pointer) (c :pointer) (h :pointer)) 65 | (defcfun ("al_color_lch" color-lch) (:struct color) 66 | (l c-float) (c c-float) (h c-float)) 67 | (defcfun ("al_color_lch_to_rgb" color-lch-to-rgb) :void 68 | (l c-float) (c c-float) (h c-float) 69 | (red :pointer) (green :pointer) (blue :pointer)) 70 | (defcfun ("al_color_distance_ciede2000" color-distance-ciede2000) :double 71 | (color1 (:struct color)) (color2 (:struct color))) 72 | (defcfun ("al_color_rgb_to_yuv" color-rgb-to-yuv) :void 73 | (red c-float) (green c-float) (blue c-float) 74 | (y :pointer) (u :pointer) (v :pointer)) 75 | (defcfun ("al_color_yuv" color-yuv) (:struct color) 76 | (y c-float) (u c-float) (v c-float)) 77 | (defcfun ("al_color_yuv_to_rgb" color-yuv-to-rgb) :void 78 | (y c-float) (u c-float) (v c-float) 79 | (red :pointer) (green :pointer) (blue :pointer)) 80 | (defcfun ("al_get_allegro_color_version" get-allegro-color-version) :uint32) 81 | (defcfun ("al_is_color_valid" is-color-valid) :bool (color (:struct color))) 82 | (defcfun ("al_color_rgb_to_oklab" color-rgb-to-oklab) :void 83 | (red :float) (green :float) (blue :float) 84 | (ol (:pointer :float)) (oa (:pointer :float)) (ob (:pointer :float))) 85 | (defcfun ("al_color_oklab" color-oklab) (:struct color) 86 | (l :float) (a :float) (b :float)) 87 | (defcfun ("al_color_oklab_to_rgb" color-oklab-to-rgb) :void 88 | (ol :float) (oa :float) (ob :float) 89 | (red (:pointer :float)) (green (:pointer :float)) (blue (:pointer :float))) 90 | (defcfun ("al_color_rgb_to_linear" color-rgb-to-linear) :void 91 | (red :float) (green :float) (blue :float) 92 | (r (:pointer :float)) (g (:pointer :float)) (b (:pointer :float))) 93 | (defcfun ("al_color_linear" color-linear) (:struct color) 94 | (r (:pointer :float)) (g (:pointer :float)) (b (:pointer :float))) 95 | (defcfun ("al_color_linear_to_rgb" color-linear-to-rgb) :void 96 | (r :float) (g :float) (b :float) 97 | (red (:pointer :float)) (green (:pointer :float)) (blue (:pointer :float))) 98 | -------------------------------------------------------------------------------- /src/ffi-functions/addons/font.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:cl-liballegro) 2 | 3 | ;;; Font addons 4 | ;; General font routinues 5 | (defcfun ("al_init_font_addon" init-font-addon) :boolean) 6 | (defcfun ("al_shutdown_font_addon" shutdown-font-addon) :void) 7 | (defcfun ("al_load_font" load-font) :pointer 8 | (filename :string) (size :int) (flags :int)) 9 | (defcfun ("al_destroy_font" destroy-font) :void (f :pointer)) 10 | (defcfun ("al_register_font_loader" register-font-loader) :boolean 11 | (extension :string) (load-font :pointer)) 12 | (defcfun ("al_get_font_line_height" get-font-line-height) :int (f :pointer)) 13 | (defcfun ("al_get_font_ascent" get-font-ascent) :int (f :pointer)) 14 | (defcfun ("al_get_font_descent" get-font-descent) :int (f :pointer)) 15 | (defcfun ("al_get_text_width" get-text-width) :int (f :pointer) (str :string)) 16 | (defcfun ("al_get_ustr_width" get-ustr-width) :int (f :pointer) (ustr :pointer)) 17 | (defcfun ("al_draw_text" draw-text) :void 18 | (font :pointer) 19 | (color (:struct color)) 20 | (x c-float) (y c-float) 21 | (flags :int) 22 | (text :string)) 23 | (defcfun ("al_draw_ustr" draw-ustr) :void 24 | (font :pointer) 25 | (color (:struct color)) 26 | (x c-float) (y c-float) 27 | (flags :int) 28 | (ustr :pointer)) 29 | (defcfun ("al_draw_justified_text" draw-justified-text) :void 30 | (font :pointer) 31 | (color (:struct color)) 32 | (x1 c-float) (x2 c-float) (y c-float) (diff c-float) 33 | (flags :int) 34 | (text :string)) 35 | (defcfun ("al_draw_justified_ustr" draw-justified-ustr) :void 36 | (font :pointer) 37 | (color (:struct color)) 38 | (x1 c-float) (x2 c-float) (y c-float) (diff c-float) 39 | (flags :int) 40 | (ustr :pointer)) 41 | (defcfun ("al_draw_textf" draw-textf) :void 42 | (font :pointer) 43 | (color (:struct color)) 44 | (x c-float) (y c-float) 45 | (flags :int) 46 | (format :string) 47 | &rest) 48 | (defcfun ("al_draw_justified_textf" draw-justified-textf) :void 49 | (font :pointer) 50 | (color (:struct color)) 51 | (x1 c-float) (x2 c-float) (y c-float) (diff c-float) 52 | (flags :int) 53 | (format :string) 54 | &rest) 55 | (defcfun ("al_get_text_dimensions" get-text-dimensions) :void 56 | (f :pointer) (text :string) 57 | (bbx :pointer) (bby :pointer) 58 | (bbw :pointer) (bbh :pointer)) 59 | (defcfun ("al_get_ustr_dimensions" get-ustr-dimensions) :void 60 | (f :pointer) (ustr :pointer) 61 | (bbx :pointer) (bby :pointer) 62 | (bbw :pointer) (bbh :pointer)) 63 | (defcfun ("al_get_allegro_font_version" get-allegro-font-version) :uint32) 64 | 65 | ;; Per glyph text handling 66 | (defcfun ("al_draw_glyph" draw-glyph) :void 67 | (font :pointer) 68 | (color (:struct color)) 69 | (x c-float) (y c-float) 70 | (codepoint :int)) 71 | (defcfun ("al_get_glyph_width" get-glyph-width) :int 72 | (font :pointer) (codepoint :int)) 73 | (defcfun ("al_get_glyph_dimensions" get-glyph-dimensions) :boolean 74 | (f :pointer) (codepoint :int) 75 | (bbx :pointer) (bby :pointer) 76 | (bbw :pointer) (bbh :pointer)) 77 | (defcfun ("al_get_glyph_advance" get-glyph-advance) :int 78 | (font :pointer) (codepoint1 :int) (codepoint2 :int)) 79 | 80 | ;; Multiline text drawing 81 | (defcfun ("al_draw_multiline_text" draw-multiline-text) :void 82 | (font :pointer) 83 | (color (:struct color)) 84 | (x c-float) (y c-float) 85 | (max-width c-float) (line-height c-float) 86 | (flags :int) 87 | (text :string)) 88 | (defcfun ("al_draw_multiline_ustr" draw-multiline-ustr) :void 89 | (font :pointer) 90 | (color (:struct color)) 91 | (x c-float) (y c-float) 92 | (max-width c-float) (line-height c-float) 93 | (flags :int) 94 | (ustr :pointer)) 95 | (defcfun ("al_draw_multiline_textf" draw-multiline-textf) :void 96 | (font :pointer) 97 | (color (:struct color)) 98 | (x c-float) (y c-float) 99 | (max-width c-float) (line-height c-float) 100 | (flags :int) 101 | (format :string) 102 | &rest) 103 | (defcfun ("al_do_multiline_text" do-multiline-text) :void 104 | (font :pointer) 105 | (max-width c-float) 106 | (text :string) 107 | (cb :pointer) 108 | (extra :pointer)) 109 | (defcfun ("al_do_multiline_ustr" do-multiline-ustr) :void 110 | (font :pointer) 111 | (max-width c-float) 112 | (ustr :pointer) 113 | (cb :pointer) 114 | (extra :pointer)) 115 | 116 | ;; Bitmap fonts 117 | (defcfun ("al_grab_font_from_bitmap" grab-font-from-bitmap) :pointer 118 | (bmp :pointer) (ranges-n :int) (range :pointer)) 119 | (defcfun ("al_load_bitmap_font" load-bitmap-font) :pointer (fname :string)) 120 | (defcfun ("al_create_builtin_font" create-builtin-font) :pointer) 121 | 122 | ;; TTF fonts 123 | (defcfun ("al_init_ttf_addon" init-ttf-addon) :boolean) 124 | (defcfun ("al_shutdown_ttf_addon" shutdown-ttf-addon) :void) 125 | (defcfun ("al_load_ttf_font" load-ttf-font) :pointer 126 | (filename :string) (size :int) (flags :int)) 127 | (defcfun ("al_load_ttf_font_f" load-ttf-font-f) :pointer 128 | (file :pointer) (filename :string) (size :int) (flags :int)) 129 | (defcfun ("al_load_ttf_font_stretch" load-ttf-font-stretch) :pointer 130 | (filename :string) (w :int) (h :int) (flags :int)) 131 | (defcfun ("al_load_ttf_font_stretch_f" load-ttf-font-stretch-f) :pointer 132 | (file :pointer) (filename :string) (w :int) (h :int) (flags :int)) 133 | (defcfun ("al_get_allegro_ttf_version" get-allegro-ttf-version) :uint32) 134 | -------------------------------------------------------------------------------- /src/ffi-functions/addons/image-io.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:cl-liballegro) 2 | 3 | ;;; Image I/O addon 4 | (defcfun ("al_init_image_addon" init-image-addon) :boolean) 5 | (defcfun ("al_shutdown_image_addon" shutdown-image-addon) :void) 6 | (defcfun ("al_get_allegro_image_version" get-allegro-image-version) :uint32) 7 | -------------------------------------------------------------------------------- /src/ffi-functions/addons/memfile.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:cl-liballegro) 2 | 3 | ;;; Memfile addon 4 | (defcfun ("al_open_memfile" open-memfile) :pointer 5 | (mem :pointer) (size :int64) (mode :pointer)) 6 | (defcfun ("al_get_allegro_memfile_version" get-allegro-memfile-version) :uint32) 7 | -------------------------------------------------------------------------------- /src/ffi-functions/addons/native-dialogs.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:cl-liballegro) 2 | 3 | ;;; Native dialogs support 4 | (defcfun ("al_init_native_dialog_addon" init-native-dialog-addon) :boolean) 5 | (defcfun ("al_shutdown_native_dialog_addon" shutdown-native-dialog-addon) :void) 6 | (defcfun ("al_create_native_file_dialog" create-native-file-dialog) :pointer 7 | (initial-path :string) (title :string) (patterns :string) (modes filechooser-modes)) 8 | (defcfun ("al_show_native_file_dialog" show-native-file-dialog) :boolean 9 | (display :pointer) (dialog :pointer)) 10 | (defcfun ("al_get_native_file_dialog_count" get-native-file-dialog-count) :int 11 | (dialog :pointer)) 12 | (defcfun ("al_get_native_file_dialog_path" get-native-file-dialog-path) :string 13 | (dialog :pointer) (i :uint)) 14 | (defcfun ("al_destroy_native_file_dialog" destroy-native-file-dialog) :void 15 | (dialog :pointer)) 16 | (defcfun ("al_show_native_message_box" show-native-message-box) :int 17 | (display :pointer) (title :string) (heading :string) 18 | (text :string) (buttons :string) (flags messagebox-flags)) 19 | (defcfun ("al_open_native_text_log" open-native-text-log) :pointer 20 | (title :string) (flags :int)) 21 | (defcfun ("al_close_native_text_log" close-native-text-log) :void 22 | (textlog :pointer)) 23 | (defcfun ("al_append_native_text_log" append-native-text-log) :void 24 | (textlog :pointer) (format :string) &rest) 25 | (defcfun ("al_get_native_text_log_event_source" get-native-text-log-event-source) 26 | :pointer 27 | (textlog :pointer)) 28 | (defcfun ("al_get_allegro_native_dialog_version" get-allegro-native-dialog-version) 29 | :uint32) 30 | -------------------------------------------------------------------------------- /src/ffi-functions/addons/physicsfs.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:cl-liballegro) 2 | 3 | ;;; PhysicsFS addon 4 | (defcfun ("al_set_physfs_file_interface" set-physfs-file-interface) :void) 5 | (defcfun ("al_get_allegro_physfs_version" get-allegro-physfs-version) :uint32) 6 | -------------------------------------------------------------------------------- /src/ffi-functions/addons/primatives.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:cl-liballegro) 2 | 3 | ;;; Primitives addon 4 | ;; General 5 | (defcfun ("al_get_allegro_primitives_version" get-allegro-primitives-version) 6 | :uint32) 7 | (defcfun ("al_init_primitives_addon" init-primitives-addon) :boolean) 8 | (defcfun ("al_shutdown_primitives_addon" shutdown-primitives-addon) :boolean) 9 | 10 | ;; High level drawing routines 11 | (defcfun ("al_draw_line" draw-line) :void 12 | (x1 c-float) (y1 c-float) (x2 c-float) (y2 c-float) 13 | (color (:struct color)) 14 | (thickness c-float)) 15 | (defcfun ("al_draw_triangle" draw-triangle) :void 16 | (x1 c-float) (y1 c-float) 17 | (x2 c-float) (y2 c-float) 18 | (x3 c-float) (y3 c-float) 19 | (color (:struct color)) 20 | (thickness c-float)) 21 | (defcfun ("al_draw_filled_triangle" draw-filled-triangle) :void 22 | (x1 c-float) (y1 c-float) 23 | (x2 c-float) (y2 c-float) 24 | (x3 c-float) (y3 c-float) 25 | (color (:struct color))) 26 | (defcfun ("al_draw_rectangle" draw-rectangle) :void 27 | (x1 c-float) (y1 c-float) 28 | (x2 c-float) (y2 c-float) 29 | (color (:struct color)) 30 | (thickness c-float)) 31 | (defcfun ("al_draw_filled_rectangle" draw-filled-rectangle) :void 32 | (x1 c-float) (y1 c-float) 33 | (x2 c-float) (y2 c-float) 34 | (color (:struct color))) 35 | (defcfun ("al_draw_rounded_rectangle" draw-rounded-rectangle) :void 36 | (x1 c-float) (y1 c-float) 37 | (x2 c-float) (y2 c-float) 38 | (rx c-float) (ry c-float) 39 | (color (:struct color)) 40 | (thickness c-float)) 41 | (defcfun ("al_draw_filled_rounded_rectangle" draw-filled-rounded-rectangle) :void 42 | (x1 c-float) (y1 c-float) 43 | (x2 c-float) (y2 c-float) 44 | (rx c-float) (ry c-float) 45 | (color (:struct color))) 46 | (defcfun ("al_calculate_arc" calculate-arc) :void 47 | (dest :pointer) (stride :int) 48 | (cx c-float) (cy c-float) 49 | (rx c-float) (ry c-float) 50 | (start-theta c-float) (delta-theta c-float) 51 | (thickness c-float) (num-segments :int)) 52 | (defcfun ("al_draw_pieslice" draw-pieslice) :void 53 | (cx c-float) (cy c-float) (radius c-float) 54 | (start-theta c-float) (delta-theta c-float) 55 | (color (:struct color)) 56 | (thickness c-float)) 57 | (defcfun ("al_draw_filled_pieslice" draw-filled-pieslice) :void 58 | (cx c-float) (cy c-float) (radius c-float) 59 | (start-theta c-float) (delta-theta c-float) 60 | (color (:struct color))) 61 | (defcfun ("al_draw_ellipse" draw-ellipse) :void 62 | (cx c-float) (cy c-float) (rx c-float) (ry c-float) 63 | (color (:struct color)) 64 | (thickness c-float)) 65 | (defcfun ("al_draw_filled_ellipse" draw-filled-ellipse) :void 66 | (cx c-float) (cy c-float) (rx c-float) (ry c-float) 67 | (color (:struct color))) 68 | (defcfun ("al_draw_circle" draw-circle) :void 69 | (cx c-float) (cy c-float) (radius c-float) 70 | (color (:struct color)) 71 | (thickness c-float)) 72 | (defcfun ("al_draw_filled_circle" draw-filled-circle) :void 73 | (cx c-float) (cy c-float) (radius c-float) 74 | (color (:struct color))) 75 | (defcfun ("al_draw_arc" draw-arc) :void 76 | (cx c-float) (cy c-float) (radius c-float) 77 | (start-theta c-float) (delta-theta c-float) 78 | (color (:struct color)) 79 | (thickness c-float)) 80 | (defcfun ("al_draw_elliptical_arc" draw-elliptical-arc) :void 81 | (cx c-float) (cy c-float) (rx c-float) (ry c-float) 82 | (start-theta c-float) (delta-theta c-float) 83 | (color (:struct color)) 84 | (thickness c-float)) 85 | (defcfun ("al_calculate_spline" calculate-spline) :void 86 | (dest :pointer) (stride :int) (points :pointer) 87 | (thickness c-float) (num-segments :int)) 88 | (defcfun ("al_draw_spline" draw-spline) :void 89 | (points :pointer) 90 | (color (:struct color)) 91 | (thickness c-float)) 92 | (defcfun ("al_calculate_ribbon" calculate-ribbon) :void 93 | (dest :pointer) (dest-stride :int) 94 | (points :pointer) (points-stride :int) 95 | (thickness c-float) (num-segments :int)) 96 | (defcfun ("al_draw_ribbon" draw-ribbon) :void 97 | (points :pointer) (points-stride :int) 98 | (color (:struct color)) 99 | (thickness c-float) (num-segments :int)) 100 | 101 | ;; Low level drawing routines 102 | (defcfun ("al_draw_prim" draw-prim) :int 103 | (vtxs :pointer) (decl :pointer) (texture :pointer) 104 | (start :int) (end :int) (type :int)) 105 | (defcfun ("al_draw_indexed_prim" draw-indexed-prim) :int 106 | (vtxs :pointer) (decl :pointer) (texture :pointer) 107 | (indices :pointer) (num-vtx :int) (type :int)) 108 | (defcfun ("al_create_vertex_decl" create-vertex-decl) :pointer 109 | (elements :pointer) (stride :int)) 110 | (defcfun ("al_destroy_vertex_decl" destroy-vertex-decl) :void) 111 | (defcfun ("al_draw_soft_triangle" draw-soft-triangle) :void 112 | (v1 :pointer) (v2 :pointer) (v3 :pointer) (state :pointer) 113 | (init :pointer) (first :pointer) (step :pointer) (draw :pointer)) 114 | (defcfun ("al_draw_soft_line" draw-soft-line) :void 115 | (v1 :pointer) (v2 :pointer) (state :pointer) 116 | (first :pointer) (step :pointer) (draw :pointer)) 117 | -------------------------------------------------------------------------------- /src/ffi-functions/addons/video-streaming.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:cl-liballegro) 2 | 3 | (defcfun ("al_init_video_addon" init-video-addon) :bool) 4 | (defcfun ("al_is_video_addon_initialized" is-init-video-addon-initialized) :bool) 5 | (defcfun ("al_shutdown_video_addon" shutdown-video-addon) :void) 6 | (defcfun ("al_get_allegro_video_version" get-allegro-video-version) :uint32) 7 | (defcfun ("al_open_video" open-video) :pointer (filename :string)) 8 | (defcfun ("al_identify_video" identify-video) :string (filename :string)) 9 | (defcfun ("al_identify_video_f" identify-video-f) :string (fp :pointer)) 10 | (defcfun ("al_close_video" close-video) :void (video :pointer)) 11 | (defcfun ("al_start_video" start-video) :void (video :pointer) (mixer :pointer)) 12 | (defcfun ("al_start_video_with_voice" start-video-with-voice) :void 13 | (video :pointer) (voice :pointer) ) 14 | (defcfun ("al_get_video_event_source" get-video-event-source) :pointer 15 | (video :pointer)) 16 | (defcfun ("al_set_video_playing" set-video-playing) :void 17 | (video :pointer) (play :bool)) 18 | (defcfun ("al_is_video_playing" is-video-playing) :bool (video :pointer)) 19 | (defcfun ("al_get_video_audio_rate" get-video-audio-rate) :double 20 | (video :pointer)) 21 | (defcfun ("al_get_video_fps" get-video-fps) :double (video :pointer)) 22 | (defcfun ("al_get_video_scaled_width" get-video-scaled-width) :float 23 | (video :pointer)) 24 | (defcfun ("al_get_video_scaled_height" get-video-scaled-height) :float 25 | (video :pointer)) 26 | (defcfun ("al_get_video_frame" get-video-frame) :pointer (video :pointer)) 27 | (defcfun ("al_get_video_position" get-video-position) :double 28 | (video :pointer) (which video-position-type)) 29 | (defcfun ("al_seek_video" seek-video) :bool 30 | (video :pointer) (pos-in-seconds :double)) 31 | -------------------------------------------------------------------------------- /src/ffi-functions/configuration-files.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:cl-liballegro) 2 | 3 | (defcfun ("al_create_config" create-config) :pointer) 4 | (defcfun ("al_destroy_config" destroy-config) :void (config :pointer)) 5 | (defcfun ("al_load_config_file" load-config-file) :pointer (filename :string)) 6 | (defcfun ("al_load_config_file_f" load-config-file-f) :pointer (file :pointer)) 7 | (defcfun ("al_save_config_file" save-config-file) :boolean 8 | (filename :string) (config :pointer)) 9 | (defcfun ("al_save_config_file_f" save-config-file-f) :boolean 10 | (file :pointer) (config :pointer)) 11 | (defcfun ("al_add_config_section" add-config-section) :void 12 | (config :pointer) (name :string)) 13 | (defcfun ("al_remove_config_section" remove-config-section) :void 14 | (config :pointer) (section :string)) 15 | (defcfun ("al_add_config_comment" add_config_comment) :void 16 | (config :pointer) (section :string) (comment :string)) 17 | (defcfun ("al_get_config_value" get-config-value) :string 18 | (config :pointer) (section :string) (key :string)) 19 | (defcfun ("al_set_config_value" set-config-value) :void 20 | (config :pointer) (section :string) (key :string) (value :string)) 21 | (defcfun ("al_remove_config_key" remove-config-key) :bool 22 | (config :pointer) (section :string) (key :string)) 23 | (defcfun ("al_get_first_config_section" get-first-config-section) :string 24 | (config :pointer) (iterator :pointer)) 25 | (defcfun ("al_get_next_config_section" get-next-config-section) :string 26 | (iterator :pointer)) 27 | (defcfun ("al_get_first_config_entry" get-first-config-entry) :string 28 | (config :pointer) (section :string) (iterator :pointer)) 29 | (defcfun ("al_get_next_config_entry" get-next-config-entry) :pointer 30 | (iterator :pointer)) 31 | (defcfun ("al_merge_config" merge-config) :pointer 32 | (cfg1 :pointer) (cfg2 :pointer)) 33 | (defcfun ("al_merge_config_into" merge-config-into) :void 34 | (master :pointer) (add :pointer)) 35 | -------------------------------------------------------------------------------- /src/ffi-functions/direct3d.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:cl-liballegro) 2 | 3 | ;;; Direct3D 4 | (defcfun ("al_get_d3d_device" get-d3d-device) :pointer (display :pointer)) 5 | (defcfun ("al_get_d3d_system_texture" get-d3d-system-texture) :pointer (bitmap :pointer)) 6 | (defcfun ("al_get_d3d_video_texture" get-d3d-video-texture) :pointer (bitmap :pointer)) 7 | (defcfun ("al_have_d3d_non_pow2_texture_support" have-d3d-non-pow2-texture-support) :boolean) 8 | (defcfun ("al_have_d3d_non_square_texture_support" have-d3d-non-square-texture-support) :boolean) 9 | (defcfun ("al_get_d3d_texture_position" get-d3d-texutre-positioner) :void 10 | (bitmap :pointer) (u :pointer) (v :pointer)) 11 | (defcfun ("al_is_d3d_device_lost" is-d3d-device-lost) :boolean (display :pointer)) 12 | -------------------------------------------------------------------------------- /src/ffi-functions/display.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:cl-liballegro) 2 | 3 | ;;; Display 4 | ;; Display Creation 5 | (defcfun ("al_create_display" create-display) :pointer (width :int) (height :int)) 6 | (defcfun ("al_destroy_display" destroy-display) :void (display :pointer)) 7 | (defcfun ("al_get_new_display_flags" get-new-display-flags) display-flags) 8 | (defcfun ("al_set_new_display_flags" set-new-display-flags) :void (flags display-flags)) 9 | (defcfun ("al_get_new_display_option" get-new-display-option) :int 10 | (option display-options) (importance :pointer)) 11 | (defcfun ("al_set_new_display_option" set-new-display-option) :void 12 | (option display-options) (value :int) (importance importance)) 13 | (defcfun ("al_reset_new_display_options" reset-new-display-options) :void) 14 | (defcfun ("al_get_new_window_position" get-new-window-position) :void 15 | (x :pointer) (y :pointer)) 16 | (defcfun ("al_set_new_window_position" set-new-window-position) :void 17 | (x :int) (y :int)) 18 | (defcfun ("al_get_new_display_refresh_rate" get-new-display-refresh-rate) :int) 19 | (defcfun ("al_set_new_display_refresh_rate" set-new-display-refresh-rate) :void 20 | (refresh-rate :int)) 21 | 22 | 23 | ;; Display Operations 24 | (defcfun ("al_get_display_event_source" get-display-event-source) :pointer 25 | (display :pointer)) 26 | (defcfun ("al_get_backbuffer" get-backbuffer) :pointer (display :pointer)) 27 | (defcfun ("al_flip_display" flip-display) :void) 28 | (defcfun ("al_update_display_region" update-display-region) :void 29 | (x :int) (y :int) (width :int) (height :int)) 30 | (defcfun ("al_wait_for_vsync" wait-for-vsync) :boolean) 31 | 32 | ;; Display size and position 33 | (defcfun ("al_get_display_width" get-display-width) :int (display :pointer)) 34 | (defcfun ("al_get_display_height" get-display-height) :int (display :pointer)) 35 | (defcfun ("al_resize_display" resize-display) :boolean 36 | (display :pointer) (width :int) (height :int)) 37 | (defcfun ("al_acknowledge_resize" acknowledge-resize) :boolean (display :pointer)) 38 | (defcfun ("al_get_window_position" get-window-position) :void 39 | (display :pointer) (x :pointer) (y :pointer)) 40 | (defcfun ("al_set_window_position" set-window-position) :void 41 | (display :pointer) (x :int) (y :int)) 42 | (defcfun ("al_get_window_constraints" get-window-constraints) :bool 43 | (display :pointer) (min-w :pointer) (min-h :pointer) (max-w :pointer) (max-h :pointer)) 44 | (defcfun ("al_set_window_constraints" set-window-constraints) :bool 45 | (display :pointer) (min-w :pointer) (min-h :pointer) (max-w :pointer) (max-h :pointer)) 46 | 47 | ;; Display settings 48 | (defcfun ("al_get_display_flags" get-display-flags) display-flags (display :pointer)) 49 | (defcfun ("al_set_display_flag" set-display-flag) :boolean 50 | (display :pointer) (flag display-flags) (onoff :boolean)) 51 | (defcfun ("al_get_display_option" get-display-option) :int 52 | (display :pointer) (option display-options)) 53 | (defcfun ("al_set_display_option" set-display-option) :void 54 | (display :pointer) (option display-options) (value :int)) 55 | (defcfun ("al_get_display_format" get-display-format) pixel-format (display :pointer)) 56 | (defcfun ("al_get_display_refresh_rate" get-display-refresh-rate) :int 57 | (display :pointer)) 58 | (defcfun ("al_get_display_orientation" get-display-orientation) display-orientation 59 | (display :pointer)) 60 | (defcfun ("al_set_window_title" set-window-title) :void 61 | (display :pointer) (title :string)) 62 | (defcfun ("al_set_new_window_title" set-new-window-title) :void 63 | (title :string)) 64 | (defcfun ("al_get_new_window_title" get-new-window-title) :string) 65 | (defcfun ("al_set_display_icon" set-display-icon) :void 66 | (display :pointer) (icon :pointer)) 67 | (defcfun ("al_set_display_icons" set-display-icons) :void 68 | (display :pointer) (num-icons :int) (icons :pointer)) 69 | 70 | ;; Drawing halts 71 | (defcfun ("al_acknowledge_drawing_halt" acknowledge-drawing-halt) :void (display :pointer)) 72 | (defcfun ("al_acknowledge_drawing_resume" acknowledge-drawing-resume) :void (display :pointer)) 73 | 74 | ;; Screensaver 75 | (defcfun ("al_inhibit_screensaver" inhibit-screensaver) :boolean (inhibit :boolean)) 76 | 77 | ;; Clipboard 78 | (defcfun ("al_get_clipboard_text" get-clipboard-text) :string (display :pointer)) 79 | (defcfun ("al_set_clipboard_text" set-clipboard-text) :bool (display :pointer) (text :string)) 80 | (defcfun ("al_clipboard_has_text" clipboard-has-text) :bool (display :pointer)) 81 | -------------------------------------------------------------------------------- /src/ffi-functions/events.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:cl-liballegro) 2 | 3 | ;;; Events 4 | (defcfun ("al_create_event_queue" create-event-queue) :pointer) 5 | (defcfun ("al_destroy_event_queue" destroy-event-queue) :void (queue :pointer)) 6 | (defcfun ("al_register_event_source" register-event-source) :void 7 | (queue :pointer) (source :pointer)) 8 | (defcfun ("al_unregister_event_source" unregister-event-source) :void 9 | (queue :pointer) (source :pointer)) 10 | (defcfun ("al_is_event_source_registered" is-event-source-registered) :bool 11 | (queue :pointer) (source :pointer)) 12 | (defcfun ("al_pause_event_queue" pause-event-queue) :void 13 | (queue :pointer) (pause :bool)) 14 | (defcfun ("al_is_event_queue_paused" is-event-queue-paused) :bool (queue :pointer)) 15 | (defcfun ("al_is_event_queue_empty" is-event-queue-empty) :boolean (queue :pointer)) 16 | (defcfun ("al_get_next_event" get-next-event) :boolean 17 | (queue :pointer) (ret-event :pointer)) 18 | (defcfun ("al_peek_next_event" peek-next-event) :boolean 19 | (queue :pointer) (ret-event :pointer)) 20 | (defcfun ("al_drop_next_event" drop-next-event) :boolean (queue :pointer)) 21 | (defcfun ("al_flush_event_queue" flush-event-queue) :void (queue :pointer)) 22 | (defcfun ("al_wait_for_event" wait-for-event) :void 23 | (queue :pointer) (ret-event :pointer)) 24 | (defcfun ("al_wait_for_event_timed" wait-for-event-timed) :boolean 25 | (queue :pointer) (ret-event :pointer) (secs c-float)) 26 | (defcfun ("al_wait_for_event_until" wait-for-event-until) :boolean 27 | (queue :pointer) (ret-event :pointer) (timeout :pointer)) 28 | (defcfun ("al_init_user_event_source" init-user-event-source) :void (src :pointer)) 29 | (defcfun ("al_destroy_user_event_source" destroy-user-event-source) :void 30 | (src :pointer)) 31 | (defcfun ("al_emit_user_event" emit-user-event) :boolean 32 | (src :pointer) (event :pointer) (dtor :pointer)) 33 | (defcfun ("al_unref_user_event" unref-user-event) :void (event :pointer)) 34 | (defcfun ("al_get_event_source_data" get-event-source-data) :pointer 35 | (source :pointer)) 36 | (defcfun ("al_set_event_source_data" set-event-source-data) :void 37 | (source :pointer) (data :pointer)) 38 | -------------------------------------------------------------------------------- /src/ffi-functions/file-io.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:cl-liballegro) 2 | 3 | (defcfun ("al_fopen" fopen) :pointer (path :string) (mode :string)) 4 | (defcfun ("al_fopen_interface" fopen-interface) :pointer (drv :pointer) (path :string) (mode :string)) 5 | (defcfun ("al_fopen_slice" fopen-slice) :pointer (file :pointer) (size :uint) (mode :string)) 6 | (defcfun ("al_fclose" fclose) :void (file :pointer)) 7 | (defcfun ("al_fread" fread) :uint (file :pointer) (ptr :pointer) (size :uint)) 8 | (defcfun ("al_fwrite" fwrite) :uint (file :pointer) (ptr :pointer) (size :uint)) 9 | (defcfun ("al_fflush" fflush) :boolean (file :pointer)) 10 | (defcfun ("al_ftell" ftell) :uint64 (file :pointer)) 11 | (defcfun ("al_fseek" fseek) :boolean (file :pointer) (offset :uint64) (whence seek)) 12 | (defcfun ("al_feof" feof) :boolean (file :pointer)) 13 | (defcfun ("al_ferror" ferror) :boolean (file :pointer)) 14 | (defcfun ("al_ferrmsg" ferrmsg) :string (file :pointer)) 15 | (defcfun ("al_fclearerr" fclearerr) :void (file :pointer)) 16 | (defcfun ("al_fungetc" fungetc) :int (file :pointer) (c :int)) 17 | (defcfun ("al_fsize" fsize) :uint64 (file :pointer)) 18 | (defcfun ("al_fgetc" fgetc) :int (file :pointer)) 19 | (defcfun ("al_fputc" fputc) :int (file :pointer) (c :int)) 20 | (defcfun ("al_fread16le" fread16le) :uint16 (file :pointer)) 21 | (defcfun ("al_fread16be" fread16be) :uint16 (file :pointer)) 22 | (defcfun ("al_fwrite16le" fwrite16le) :uint (file :pointer) (w :uint16)) 23 | (defcfun ("al_fwrite16be" fwrite16be) :uint (file :pointer) (w :uint16)) 24 | (defcfun ("al_fread32le" fread32le) :uint32 (file :pointer)) 25 | (defcfun ("al_fread32be" fread32be) :uint32 (file :pointer)) 26 | (defcfun ("al_fwrite32le" fwrite32le) :uint (file :pointer) (l :uint32)) 27 | (defcfun ("al_fwrite32be" fwrite32be) :uint (file :pointer) (l :uint32)) 28 | (defcfun ("al_fgets" fgets) :pointer (file :pointer) (buf :pointer) (max :uint)) 29 | (defcfun ("al_fget_ustr" fget_ustr) :pointer (file :pointer)) 30 | (defcfun ("al_fputs" fputs) :int (file :pointer) (str :string)) 31 | 32 | ;; Standard I/O specific routines 33 | (defcfun ("al_fopen_fd" fopen-fd) :pointer (fd c-int) (mode :string)) 34 | (defcfun ("al_make_temp_file" make-temp-file) :pointer (template :string) (ret-path :pointer)) 35 | 36 | ;; Alternative file streams 37 | (defcfun ("al_set_new_file_interface" set-new-file-interface) :void (file-interface :pointer)) 38 | (defcfun ("al_set_standard_file_interface" set-standard-file-interface) :void) 39 | (defcfun ("al_get_new_file_interface" get-new-file-interface) :pointer) 40 | (defcfun ("al_create_file_handle" create-file-handle) :pointer (drv :pointer) (userdarat :pointer)) 41 | (defcfun ("al_get_file_userdata" get-file-userdata) :pointer (file :pointer)) 42 | -------------------------------------------------------------------------------- /src/ffi-functions/filesystem.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:cl-liballegro) 2 | 3 | (defcfun ("al_create_fs_entry" create-fs-entry) (:pointer (:struct fs-entry)) 4 | (path :string)) 5 | (defcfun ("al_destroy_fs_entry" destroy-fs-entry) :void 6 | (fh (:pointer (:struct fs-entry)))) 7 | (defcfun ("al_get_fs_entry_name" get-fs-entry-name) :string 8 | (e (:pointer (:struct fs-entry)))) 9 | (defcfun ("al_update_fs_entry" update-fs-entry) :bool 10 | (e (:pointer (:struct fs-entry)))) 11 | (defcfun ("al_get_fs_entry_mode" get-fs-entry-mode) :uint32 12 | (e (:pointer (:struct fs-entry)))) 13 | (defcfun ("al_get_fs_entry_atime" get-fs-entry-atime) time_t 14 | (e (:pointer (:struct fs-entry)))) 15 | (defcfun ("al_get_fs_entry_ctime" get-fs-entry-ctime) time_t 16 | (e (:pointer (:struct fs-entry)))) 17 | (defcfun ("al_get_fs_entry_mtime" get-fs-entry-mtime) time_t 18 | (e (:pointer (:struct fs-entry)))) 19 | (defcfun ("al_get_fs_entry_size" get-fs-entry-size) off_t 20 | (e (:pointer (:struct fs-entry)))) 21 | (defcfun ("al_fs_entry_exists" fs-entry-exists) :bool 22 | (e (:pointer (:struct fs-entry)))) 23 | (defcfun ("al_remove_fs_entry" remove-fs-entry) :bool 24 | (e (:pointer (:struct fs-entry)))) 25 | (defcfun ("al_filename_exists" filename-exists) :bool 26 | (path :string)) 27 | (defcfun ("al_remove_filename" remove-filename) :bool 28 | (path :string)) 29 | 30 | ;; Directory functions 31 | (defcfun ("al_open_directory" open-directory) :bool 32 | (e (:pointer (:struct fs-entry)))) 33 | (defcfun ("al_read_directory" read-directory) (:pointer (:struct fs-entry)) 34 | (e (:pointer (:struct fs-entry)))) 35 | (defcfun ("al_close_directory" close-directory) :bool 36 | (e (:pointer (:struct fs-entry)))) 37 | (defcfun ("al_get_current_directory" get-current-directory) :string) 38 | (defcfun ("al_change_directory" change-directory) :bool 39 | (path :string)) 40 | (defcfun ("al_make_directory" make-directory) :bool 41 | (path :string)) 42 | (defcfun ("al_open_fs_entry" open-fs-entry) (:pointer (:struct file)) 43 | (e (:pointer (:struct fs-entry))) (mode :string)) 44 | (defcfun ("al_for_each_fs_entry" for-each-fs-entry) :int 45 | (dir (:pointer (:struct fs-entry))) 46 | (callback :pointer) 47 | (extra :pointer)) 48 | 49 | ;; Alternative filesystem functions 50 | (defcfun ("al_set_fs_interface" set-fs-interface) :void 51 | (fs-interface (:pointer (:struct fs-interface)))) 52 | (defcfun ("al_set_standard_fs_interface" set-standard-fs-interface) :void) 53 | (defcfun ("al_get_fs_interface" get-fs-interface) (:pointer (:struct fs-interface))) 54 | -------------------------------------------------------------------------------- /src/ffi-functions/fixed-point-math.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:cl-liballegro) 2 | 3 | ;;; Fixed point math 4 | (defcfun ("al_itofix" itofix) fixed (x :int)) 5 | (defcfun ("al_fixtoi" fixtoi) :int (x fixed)) 6 | (defcfun ("al_fixfloor" fixfloor) :int (x fixed)) 7 | (defcfun ("al_fixceil" fixceil) :int (x fixed)) 8 | (defcfun ("al_ftofix" ftofix) fixed (x c-double)) 9 | (defcfun ("al_fixtof" fixtof) c-double (x fixed)) 10 | (defcfun ("al_fixmul" fixmul) fixed (x fixed) (y fixed)) 11 | (defcfun ("al_fixdiv" fixdiv) fixed (x fixed) (y fixed)) 12 | (defcfun ("al_fixadd" fixadd) fixed (x fixed) (y fixed)) 13 | (defcfun ("al_fixsub" fixsub) fixed (x fixed) (y fixed)) 14 | 15 | ;; Fixed point trig 16 | (defcfun ("al_fixsin" fixsin) fixed (x fixed)) 17 | (defcfun ("al_fixcos" fixcos) fixed (x fixed)) 18 | (defcfun ("al_fixtan" fixtan) fixed (x fixed)) 19 | (defcfun ("al_fixasin" fixasin) fixed (x fixed)) 20 | (defcfun ("al_fixacos" fixacos) fixed (x fixed)) 21 | (defcfun ("al_fixatan" fixatan) fixed (x fixed)) 22 | (defcfun ("al_fixatan2" fixatan2) fixed (y fixed) (x fixed)) 23 | (defcfun ("al_fixsqrt" fixsqrt) fixed (x fixed)) 24 | (defcfun ("al_fixhypot" fixhypot) fixed (x fixed) (y fixed)) 25 | -------------------------------------------------------------------------------- /src/ffi-functions/fullscreen-modes.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:cl-liballegro) 2 | 3 | ;;; Fullscreen modes 4 | (defcfun ("al_get_display_mode" get-display-mode) :pointer 5 | (index :int) (mode :pointer)) 6 | (defcfun ("al_get_num_display_modes" get-num-display-modes) :int) 7 | -------------------------------------------------------------------------------- /src/ffi-functions/graphics.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:cl-liballegro) 2 | 3 | ;;; Graphics 4 | ;; Colors 5 | (defcfun ("al_map_rgb" map-rgb) (:struct color) 6 | (r :uchar) (g :uchar) (b :uchar)) 7 | (defcfun ("al_map_rgb_f" map-rgb-f) (:struct color) 8 | (r c-float) (g c-float) (b c-float)) 9 | (defcfun ("al_map_rgba" map-rgba) (:struct color) 10 | (r :uchar) (g :uchar) (b :uchar) (a :uchar)) 11 | (defcfun ("al_premul_rgba" premul-rgba) (:struct color) 12 | (r :uchar) (g :uchar) (b :uchar) (a :uchar)) 13 | (defcfun ("al_map_rgba_f" map-rgba-f) (:struct color) 14 | (r c-float) (g c-float) (b c-float) (a c-float)) 15 | (defcfun ("al_premul_rgba_f" premul-rgba-f) (:struct color) 16 | (r :uchar) (g :uchar) (b :uchar) (a :uchar)) 17 | (defcfun ("al_unmap_rgb" unmap-rgb) (:struct color) 18 | (r :pointer) (g :pointer) (b :pointer) (a :pointer)) 19 | (defcfun ("al_unmap_rgb_f" unmap-rgb-f) (:struct color) 20 | (r :pointer) (g :pointer) (b :pointer)) 21 | (defcfun ("al_unmap_rgba" unmap-rgba) (:struct color) 22 | (r :pointer) (g :pointer) (b :pointer) (a :pointer)) 23 | (defcfun ("al_unmap_rgba_f" unmap-rgba-f) (:struct color) 24 | (r :pointer) (g :pointer) (b :pointer) (a :pointer)) 25 | 26 | ;; Locking and pixel formats 27 | (defcfun ("al_get_pixel_size" get-pixel-size) :int (format pixel-format)) 28 | (defcfun ("al_get_pixel_format_bits" get-pixel-format-bits) :int 29 | (format pixel-format)) 30 | (defcfun ("al_get_pixel_block_size" get-pixel-block-size) :int (format pixel-format)) 31 | (defcfun ("al_get_pixel_block_width" get-pixel-block-width) :int (format pixel-format)) 32 | (defcfun ("al_get_pixel_block_height" get-pixel-block-height) :int (format pixel-format)) 33 | (defcfun ("al_lock_bitmap" lock-bitmap) :pointer 34 | (bitmap :pointer) (format pixel-format) (flags locking-flags)) 35 | (defcfun ("al_lock_bitmap_region" lock-bitmap-region) :pointer 36 | (bitmap :pointer) (x :int) (y :int) (width :int) (height :int) 37 | (format pixel-format) (flags locking-flags)) 38 | (defcfun ("al_unlock_bitmap" unlock-bitmap) :void (bitmap :pointer)) 39 | (defcfun ("al_lock_bitmap_blocked" lock-bitmap-blocked) :pointer 40 | (bitmap :pointer) (flags locking-flags)) 41 | (defcfun ("al_lock_bitmap_region_blocked" lock-bitmap-region-blocked) :pointer 42 | (bitmap :pointer) (x-block :int) (y-block :int) (width-block :int) (height-block :int) 43 | (flags locking-flags)) 44 | 45 | ;; Bitmap Creation 46 | (defcfun ("al_create_bitmap" create-bitmap) :pointer (w :int) (h :int)) 47 | (defcfun ("al_create_sub_bitmap" create-sub-bitmap) :pointer 48 | (parent :pointer) (x :int) (y :int) (w :int) (h :int)) 49 | (defcfun ("al_clone_bitmap" clone-bitmap) :pointer (bitmap :pointer)) 50 | (defcfun ("al_convert_bitmap" convert-bitmap) :void (bitmap :pointer)) 51 | (defcfun ("al_convert_memory_bitmaps" convert-memory-bitmaps) :void) 52 | (defcfun ("al_destroy_bitmap" destroy-bitmap) :void (bitmap :pointer)) 53 | (defcfun ("al_get_new_bitmap_flags" get-new-bitmap-flags) bitmap-flags) 54 | (defcfun ("al_get_new_bitmap_format" get-new-bitmap-format) pixel-format) 55 | (defcfun ("al_set_new_bitmap_flags" set-new-bitmap-flags) :void (flags bitmap-flags)) 56 | (defcfun ("al_add_new_bitmap_flag" add-new-bitmap-flag) :void (flag bitmap-flags)) 57 | (defcfun ("al_set_new_bitmap_format" set-new-bitmap-format) :void 58 | (pixel-format pixel-format)) 59 | (defcfun ("al_set_new_bitmap_depth" set-new-bitmap-depth) :void (depth :int)) 60 | (defcfun ("al_get_new_bitmap_depth" get-new-bitmap-depth) :int) 61 | (defcfun ("al_set_new_bitmap_samples" set-new-bitmap-samples) :void (samples :int)) 62 | (defcfun ("al_get_new_bitmap_samples" get-new-bitmap-samples) :int) 63 | (defcfun ("al_set_new_bitmap_wrap" set-new-bitmap-wrap) :void (u bitmap-wrap) (v bitmap-wrap)) 64 | (defcfun ("al_get_new_bitmap_wrap" get-new-bitmap-wrap) :void (u :pointer) (v :pointer)) 65 | 66 | ;; Bitmap properties 67 | (defcfun ("al_get_bitmap_flags" get-bitmap-flags) bitmap-flags (bitmap :pointer)) 68 | (defcfun ("al_get_bitmap_format" get-bitmap-format) pixel-format (bitmap :pointer)) 69 | (defcfun ("al_get_bitmap_height" get-bitmap-height) :int (bitmap :pointer)) 70 | (defcfun ("al_get_bitmap_width" get-bitmap-width) :int (bitmap :pointer)) 71 | (defcfun ("al_is_bitmap_locked" is-bitmap-locked) :boolean (bitmap :pointer)) 72 | (defcfun ("al_get_pixel" get-pixel) (:struct color) (bitmap :pointer) (x c-int) (y c-int)) 73 | (defcfun ("al_is_compatible_bitmap" is-compatible-bitmap) :boolean (bitmap :pointer)) 74 | (defcfun ("al_is_sub_bitmap" is-sub-bitmap) :boolean (bitmap :pointer)) 75 | (defcfun ("al_get_parent_bitmap" get-parent-bitmap) :pointer (bitmap :pointer)) 76 | (defcfun ("al_get_bitmap_x" get-bitmap-x) :int (bitmap :pointer)) 77 | (defcfun ("al_get_bitmap_y" get-bitmap-y) :int (bitmap :pointer)) 78 | (defcfun ("al_reparent_bitmap" reparent-bitmap) :void 79 | (bitmap :pointer) (parent :pointer) (x c-int) (y c-int) (w c-int) (h c-int)) 80 | 81 | ;; Drawing Operations 82 | (defcfun ("al_clear_to_color" clear-to-color) :void (color (:struct color))) 83 | (defcfun ("al_clear_depth_buffer" clear-depth-buffer) :void (z c-float)) 84 | (defcfun ("al_draw_bitmap" draw-bitmap) :void 85 | (bitmap :pointer) (dx c-float) (dy c-float) (flags draw-flags)) 86 | (defcfun ("al_draw_tinted_bitmap" draw-tinted-bitmap) :void 87 | (bitmap :pointer) 88 | (color (:struct color)) 89 | (dx c-float) (dy c-float) 90 | (flags draw-flags)) 91 | (defcfun ("al_draw_bitmap_region" draw-bitmap-region) :void 92 | (bitmap :pointer) 93 | (sx c-float) (sy c-float) (sw c-float) (sh c-float) (dx c-float) (dy c-float) 94 | (flags draw-flags)) 95 | (defcfun ("al_draw_tinted_bitmap_region" draw-tinted-bitmap-region) :void 96 | (bitmap :pointer) 97 | (color (:struct color)) 98 | (sx c-float) (sy c-float) (sw c-float) (sh c-float) (dx c-float) (dy c-float) 99 | (flags draw-flags)) 100 | (defcfun ("al_draw_pixel" draw-pixel) :void 101 | (x c-float) (y c-float) 102 | (color (:struct color))) 103 | (defcfun ("al_draw_rotated_bitmap" draw-rotated-bitmap) :void 104 | (bitmap :pointer) 105 | (cx c-float) (cy c-float) 106 | (dx c-float) (dy c-float) 107 | (angle c-float) 108 | (flags draw-flags)) 109 | (defcfun ("al_draw_tinted_rotated_bitmap" draw-tinted-rotated-bitmap) :void 110 | (bitmap :pointer) 111 | (color (:struct color)) 112 | (cx c-float) (cy c-float) 113 | (dx c-float) (dy c-float) 114 | (angle c-float) 115 | (flags draw-flags)) 116 | (defcfun ("al_draw_scaled_rotated_bitmap" draw-scaled-rotated-bitmap) :void 117 | (bitmap :pointer) 118 | (cx c-float) (cy c-float) 119 | (dx c-float) (dy c-float) 120 | (xscale c-float) (yscale c-float) 121 | (angle c-float) 122 | (flags draw-flags)) 123 | (defcfun ("al_draw_tinted_scaled_rotated_bitmap" draw-tinted-scaled-rotated-bitmap) 124 | :void 125 | (bitmap :pointer) 126 | (color (:struct color)) 127 | (cx c-float) (cy c-float) 128 | (dx c-float) (dy c-float) 129 | (xscale c-float) (yscale c-float) 130 | (angle c-float) 131 | (flags draw-flags)) 132 | (defcfun ("al_draw_tinted_scaled_rotated_bitmap_region" 133 | draw-tinted-scaled-rotated-bitmap-region) :void 134 | (bitmap :pointer) 135 | (sx c-float) (sy c-float) (sw c-float) (sh c-float) 136 | (color (:struct color)) 137 | (cx c-float) (cy c-float) 138 | (dx c-float) (dy c-float) 139 | (xscale c-float) (yscale c-float) 140 | (angle c-float) 141 | (flags draw-flags)) 142 | (defcfun ("al_draw_scaled_bitmap" draw-scaled-bitmap) :void 143 | (bitmap :pointer) 144 | (sx c-float) (sy c-float) (sw c-float) (sh c-float) 145 | (dx c-float) (dy c-float) (dw c-float) (dh c-float) 146 | (flags draw-flags)) 147 | (defcfun ("al_draw_tinted_scaled_bitmap" draw-tinted-scaled-bitmap) :void 148 | (bitmap :pointer) 149 | (color (:struct color)) 150 | (sx c-float) (sy c-float) (sw c-float) (sh c-float) 151 | (dx c-float) (dy c-float) (dw c-float) (dh c-float) 152 | (flags draw-flags)) 153 | (defcfun ("al_get_target_bitmap" get-target-bitmap) :pointer) 154 | (defcfun ("al_put_pixel" put-pixel) :void 155 | (x :int) (y :int) 156 | (color (:struct color))) 157 | (defcfun ("al_put_blended_pixel" put-blended-pixel) :void 158 | (x :int) (y :int) 159 | (color (:struct color))) 160 | (defcfun ("al_set_target_bitmap" set-target-bitmap) :void (bitmap :pointer)) 161 | (defcfun ("al_set_target_backbuffer" set-target-backbuffer) :void (display :pointer)) 162 | (defcfun ("al_get_current_display" get-current-display) :pointer) 163 | 164 | ;; Blending modes 165 | (defcfun ("al_get_blender" get-blender) :void 166 | (op :pointer) (src :pointer) (dst :pointer)) 167 | (defcfun ("al_get_separate_blender" get-separate-blender) :void 168 | (op :pointer) (src :pointer) (dst :pointer) 169 | (alpha-op :pointer) (alpha-src :pointer) (alpha-dst :pointer)) 170 | (defcfun ("al_get_blend_color" get-blend-color) (:struct color)) 171 | (defcfun ("al_set_blend_color" set-blend-color) :void (color (:struct color))) 172 | (defcfun ("al_set_blender" set-blender) :void 173 | (op :int) (src :int) (dst :int)) 174 | (defcfun ("al_set_separate_blender" set-separate-blender) :void 175 | (op :int) (src :int) (dst :int) 176 | (alpha-op :int) (alpha-src :int) (alpha-dst :int)) 177 | 178 | ;; Clipping 179 | (defcfun ("al_get_clipping_rectangle" get-clipping-rectangle) :void 180 | (x :pointer) (y :pointer) (w :pointer) (h :pointer)) 181 | (defcfun ("al_set_clipping_rectangle" set-clipping-rectangle) :void 182 | (x :int) (y :int) (w :int) (h :int)) 183 | (defcfun ("al_reset_clipping_rectangle" reset-clipping-rectangle) :void) 184 | 185 | ;; Graphics utility functions 186 | (defcfun ("al_convert_mask_to_alpha" convert-mask-to-alpha) :void 187 | (bitmap :pointer) (color (:struct color))) 188 | 189 | ;; Deferred drawing 190 | (defcfun ("al_hold_bitmap_drawing" hold-bitmap-drawing) :void (hold :boolean)) 191 | (defcfun ("al_is_bitmap_drawing_held" is-bitmap-drawing-held) :boolean) 192 | 193 | ;; Images I/O 194 | (defcfun ("al_register_bitmap_loader" register-bitmap-loader) :boolean 195 | (extension :string) (loader :pointer)) 196 | (defcfun ("al_register_bitmap_saver" register-bitmap-saver) :boolean 197 | (extension :string) (saver :boolean)) 198 | (defcfun ("al_register_bitmap_loader_f" register-bitmap-loader-f) :boolean 199 | (extension :string) (loader-f :pointer)) 200 | (defcfun ("al_register_bitmap_saver_f" register-bitmap-saver-f) :boolean 201 | (extension :string) (loader-f :pointer)) 202 | (defcfun ("al_load_bitmap" load-bitmap) :pointer (filename :string)) 203 | (defcfun ("al_load_bitmap_flags" load-bitmap-flags) :pointer 204 | (filename :string) (flags bitmap-loader-flags)) 205 | (defcfun ("al_load_bitmap_f" load-bitmap-f) :pointer (fp :pointer) (ident :string)) 206 | (defcfun ("al_load_bitmap_flags_f" load-bitmap-flags-f) :pointer 207 | (fp :pointer) (ident :string) (flags bitmap-loader-flags)) 208 | (defcfun ("al_save_bitmap" save-bitmap) :boolean 209 | (filename :string) (bitmap :pointer)) 210 | (defcfun ("al_save_bitmap_f" save-bitmap-f) :boolean 211 | (fp :pointer) (ident :string) (bitmap :pointer)) 212 | (defcfun ("al_register_bitmap_identifier" register-bitmap-identifier) :bool 213 | (extension :string) (identifier :bool)) 214 | (defcfun ("al_identify_bitmap" identify-bitmap) :string (filename :string)) 215 | (defcfun ("al_identify_bitmap_f" identify-bitmap-f) :string (fp :string)) 216 | 217 | ;; Render State 218 | (defcfun ("al_set_render_state" set-render-state) :void 219 | (state render-state) (value c-int)) 220 | -------------------------------------------------------------------------------- /src/ffi-functions/haptic.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:cl-liballegro) 2 | 3 | (defcfun ("al_install_haptic" install-haptic) :bool) 4 | (defcfun ("al_uninstall_haptic" uninstall-haptic) :void) 5 | (defcfun ("al_is_haptic_installed" is-haptic-installed) :void) 6 | (defcfun ("al_is_mouse_haptic" is-mouse-haptic) :bool (dev :pointer)) 7 | (defcfun ("al_is_keyboard_haptic" is-keyboard-haptic) :bool (dev :pointer)) 8 | (defcfun ("al_is_display_haptic" is-display-haptic) :bool (dev :pointer)) 9 | (defcfun ("al_is_joystick_haptic" is-joystick-haptic) :bool (dev :pointer)) 10 | (defcfun ("al_is_touch_input_haptic" is-touch-input-haptic) :bool (dev :pointer)) 11 | (defcfun ("al_get_haptic_from_mouse" get-haptic-from-mouse) (:pointer (:struct haptic)) 12 | (dev :pointer)) 13 | (defcfun ("al_get_haptic_from_keyboard" get-haptic-from-keyboard) (:pointer (:struct haptic)) 14 | (dev :pointer)) 15 | (defcfun ("al_get_haptic_from_display" get-haptic-from-display) (:pointer (:struct haptic)) 16 | (dev :pointer)) 17 | (defcfun ("al_get_haptic_from_joystick" get-haptic-from-joystick) (:pointer (:struct haptic)) 18 | (dev :pointer)) 19 | (defcfun ("al_get_haptic_from_touch_input" get-haptic-from-touch-input) (:pointer (:struct haptic)) 20 | (dev :pointer)) 21 | (defcfun ("al_release_haptic" release-haptic) :bool (hap (:pointer (:struct haptic)))) 22 | (defcfun ("al_is_haptic_active" is-haptic-active) :bool (hap (:pointer (:struct haptic)))) 23 | (defcfun ("al_get_haptic_capabilities" get-haptic-capabilities) :int (hap (:pointer (:struct haptic))) ) 24 | (defcfun ("al_is_haptic_capable" is-haptic-capable) :bool 25 | (hap (:pointer (:struct haptic))) (query :int)) 26 | (defcfun ("al_set_haptic_gain" set-haptic-gain) :bool 27 | (hap (:pointer (:struct haptic))) (gain :double)) 28 | (defcfun ("al_get_haptic_gain" get-haptic-gain) :double (hap (:pointer (:struct haptic)))) 29 | (defcfun ("al_set_haptic_autocenter" set-haptic-autocenter) :bool 30 | (hap (:pointer (:struct haptic))) (intensity :double)) 31 | (defcfun ("al_get_haptic_autocenter" get-haptic-autocenter) :double 32 | (hap (:pointer (:struct haptic)))) 33 | (defcfun ("al_get_max_haptic_effects" get-max-haptic-effects) :int 34 | (hap (:pointer (:struct haptic)))) 35 | (defcfun ("al_is_haptic_effect_ok" is-haptic-effect-ok) :bool 36 | (hap (:pointer (:struct haptic))) (effect (:pointer (:struct haptic-effect)))) 37 | (defcfun ("al_upload_haptic_effect" upload-haptic-effect) :bool 38 | (hap (:pointer (:struct haptic))) (effect (:pointer (:struct haptic-effect))) 39 | (id (:pointer (:struct haptic-effect-id)))) 40 | (defcfun ("al_play_haptic_effect" play-haptic-effect) :bool 41 | (id (:pointer (:struct haptic-effect-id))) (loop :int)) 42 | (defcfun ("al_upload_and_play_haptic_effect" upload-and-play-haptic-effect) :bool 43 | (hap (:pointer (:struct haptic))) (effect (:pointer (:struct haptic-effect))) 44 | (id (:pointer (:struct haptic-effect-id))) (loop :int)) 45 | (defcfun ("al_stop_haptic_effect" stop-haptic-effect) :bool 46 | (id (:pointer (:struct haptic-effect-id)))) 47 | (defcfun ("al_is_haptic_effect_playing" is-haptic-effect-playing) :bool 48 | (id (:pointer (:struct haptic-effect-id)))) 49 | (defcfun ("al_get_haptic_effect_duration" get-haptic-effect-duration) :double 50 | (effect (:pointer (:struct haptic-effect)))) 51 | (defcfun ("al_release_haptic_effect" release-haptic-effect) :bool 52 | (id (:pointer (:struct haptic-effect-id)))) 53 | (defcfun ("al_rumble_haptic" rumble-haptic) :bool 54 | (hap (:pointer (:struct haptic))) 55 | (intensity :double) 56 | (duration :double) 57 | (id (:pointer (:struct haptic-effect-id)))) 58 | -------------------------------------------------------------------------------- /src/ffi-functions/joystick.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:cl-liballegro) 2 | 3 | ;;; Joystick 4 | (defcfun ("al_install_joystick" install-joystick) :boolean) 5 | (defcfun ("al_uninstall_joystick" uninstall-joystick) :void) 6 | (defcfun ("al_is_joystick_installed" is-joystick-installed) :boolean) 7 | (defcfun ("al_reconfigure_joysticks" reconfigure-joysticks) :boolean) 8 | (defcfun ("al_get_num_joysticks" get-num-joysticks) :int) 9 | (defcfun ("al_get_joystick" get-joystick) :pointer (num :int)) 10 | (defcfun ("al_release_joystick" release-joystick) :void (joy :pointer)) 11 | (defcfun ("al_get_joystick_active" get-joystick-active) :boolean (joy :pointer)) 12 | (defcfun ("al_get_joystick_name" get-joystick-name) :string (joy :pointer)) 13 | (defcfun ("al_get_joystick_stick_name" get-joystick-stick-name) :string 14 | (joy :pointer) (stick :int)) 15 | (defcfun ("al_get_joystick_axis_name" get-joystick-axis-name) :string 16 | (joy :pointer) (stick :int) (axis :int)) 17 | (defcfun ("al_get_joystick_button_name" get-joystick-button-name) :string 18 | (joy :pointer) (button :int)) 19 | (defcfun ("al_get_joystick_stick_flags" get-joystick-stick-flags) :int 20 | (joy :pointer) (stick joyflags)) 21 | (defcfun ("al_get_joystick_num_sticks" get-joystick-num-sticks) :int (joy :pointer)) 22 | (defcfun ("al_get_joystick_num_axes" get-joystick-num-axes) :int 23 | (joy :pointer) (stick :int)) 24 | (defcfun ("al_get_joystick_num_buttons" get-joystick-num-buttons) :int 25 | (joy :pointer)) 26 | (defcfun ("al_get_joystick_state" get-joystick-state) :void 27 | (joy :pointer) (ret-state :pointer)) 28 | (defcfun ("al_get_joystick_event_source" get-joystick-event-source) :pointer) 29 | -------------------------------------------------------------------------------- /src/ffi-functions/keyboard.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-liballegro) 2 | 3 | ;;; Keyboard 4 | (defcfun ("al_install_keyboard" install-keyboard) :boolean) 5 | (defcfun ("al_is_keyboard_installed" is-keyboard-installed) :boolean) 6 | (defcfun ("al_uninstall_keyboard" uninstall-keyboard) :void) 7 | (defcfun ("al_get_keyboard_state" get-keyboard-state) :void (ret-state :pointer)) 8 | (defcfun ("al_key_down" key-down) :boolean (state :pointer) (keycode keycodes)) 9 | (defcfun ("al_keycode_to_name" keycode-to-name) :string (keycode keycodes)) 10 | (defcfun ("al_can_set_keyboard_leds" can-set-keyboard-leds) :boolean) 11 | (defcfun ("al_set_keyboard_leds" set-keyboard-leds) :boolean (leds keymods)) 12 | (defcfun ("al_get_keyboard_event_source" get-keyboard-event-source) :pointer) 13 | -------------------------------------------------------------------------------- /src/ffi-functions/memory.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:cl-liballegro) 2 | 3 | ;; Memory 4 | 5 | ;; #define al_malloc(n) (al_malloc_with_context((n), __LINE__, __FILE__, __func__)) 6 | ;; #define al_free(p) (al_free_with_context((p), __LINE__, __FILE__, __func__)) 7 | 8 | (defun malloc (n) (malloc-with-context n 0 "" "")) 9 | (defun free (p) (free-with-context p 0 "" "")) 10 | (defcfun ("al_malloc_with_context" malloc-with-context) :pointer 11 | (n :uint) (line :int) (file :string) (func :string)) 12 | (defcfun ("al_free_with_context" free-with-context) :void 13 | (ptr :pointer) (line :int) (file :string) (func :string)) 14 | (defcfun ("al_realloc_with_context" realloc-with-context) :pointer 15 | (ptr :pointer) (n :uint) (line :int) (file :string) (func :string)) 16 | (defcfun ("al_calloc_with_context" calloc-with-context) :pointer 17 | (count :uint) (n :uint) (line :int) (file :string) (func :string)) 18 | (defcfun ("al_set_memory_interface" set-memory-interface) :void 19 | (memory-interface (:pointer (:struct memory-interface)))) 20 | -------------------------------------------------------------------------------- /src/ffi-functions/misc.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:cl-liballegro) 2 | 3 | ;; Miscellaneous routines 4 | (defcfun ("al_run_main" run-main) :int 5 | (argc :int) (argv :pointer) (user-main :pointer)) 6 | -------------------------------------------------------------------------------- /src/ffi-functions/monitor.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:cl-liballegro) 2 | 3 | ;;; Monitor 4 | (defcfun ("al_get_new_display_adapter" get-new-display-adapter) :int) 5 | (defcfun ("al_set_new_display_adapter" set-new-display-adapter) :void (adapter :int)) 6 | (defcfun ("al_get_monitor_info" get-monitor-info) :boolean 7 | (adapter :int) (info :pointer)) 8 | (defcfun ("al_get_monitor_dpi" get-monitor-dpi) :int 9 | (adapter :int)) 10 | (defcfun ("al_get_num_video_adapters" get-num-video-adapters) :int) 11 | (defcfun ("al_get_monitor_refresh_rate" get-monitor-refresh-rate) :int 12 | (adapter :int)) 13 | -------------------------------------------------------------------------------- /src/ffi-functions/mouse.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:cl-liballegro) 2 | 3 | ;;; Mouse 4 | (defcfun ("al_install_mouse" install-mouse) :boolean) 5 | (defcfun ("al_is_mouse_installed" is-mouse-installed) :boolean) 6 | (defcfun ("al_uninstall_mouse" uninstall-mouse) :void) 7 | (defcfun ("al_get_mouse_num_axes" get-mouse-num-axes) :uint) 8 | (defcfun ("al_get_mouse_num_buttons" get-mouse-num-buttons) :uint) 9 | (defcfun ("al_get_mouse_state" get-mouse-state) :void (ret-state :pointer)) 10 | (defcfun ("al_get_mouse_state_axis" get-mouse-state-axis) :int 11 | (state :pointer) (axis :int)) 12 | (defcfun ("al_mouse_button_down" mouse-button-down) :boolean 13 | (state :pointer) (button :int)) 14 | (defcfun ("al_set_mouse_xy" set-mouse-xy) :boolean 15 | (display :pointer) (x :int) (y :int)) 16 | (defcfun ("al_set_mouse_z" set-mouse-z) :boolean 17 | (z :int)) 18 | (defcfun ("al_set_mouse_w" set-mouse-w) :boolean 19 | (w :int)) 20 | (defcfun ("al_set_mouse_axis" set-mouse-axis) :boolean (which :int) (value :int)) 21 | (defcfun ("al_get_mouse_event_source" get-mouse-event-source) :pointer) 22 | (defcfun ("al_set_mouse_wheel_precision" set-mouse-wheel-precision) :void 23 | (precision :int)) 24 | (defcfun ("al_get_mouse_wheel_precision" get-mouse-wheel-precision) :int) 25 | 26 | ;; Mouse cursors 27 | (defcfun ("al_create_mouse_cursor" create-mouse-cursor) :pointer 28 | (bmp :pointer) (x_focus :int) (y_focus :int)) 29 | (defcfun ("al_destroy_mouse_cursor" destroy-mouse-cursor) :void (cursor :pointer)) 30 | (defcfun ("al_set_mouse_cursor" set-mouse-cursor) :boolean 31 | (display :pointer) (cursor :pointer)) 32 | (defcfun ("al_set_system_mouse_cursor" set-system-mouse-cursor) :boolean 33 | (display :pointer) (cursor-id system-mouse-cursor)) 34 | (defcfun ("al_can_get_mouse_cursor_position" can-get-mouse-cursor-position) :boolean) 35 | (defcfun ("al_get_mouse_cursor_position" get-mouse-cursor-position) :boolean 36 | (ret-x :pointer) (ret-y :pointer)) 37 | (defcfun ("al_hide_mouse_cursor" hide-mouse-cursor) :boolean (display :pointer)) 38 | (defcfun ("al_show_mouse_cursor" show-mouse-cursor) :boolean (display :pointer)) 39 | (defcfun ("al_grab_mouse" grab-mouse) :boolean (display :pointer)) 40 | (defcfun ("al_ungrab_mouse" ungrab-mouse) :boolean) 41 | -------------------------------------------------------------------------------- /src/ffi-functions/opengl.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:cl-liballegro) 2 | 3 | ;;; OpenGL 4 | (defcfun ("al_get_opengl_extension_list" get-opengl-extension-list) :pointer) 5 | (defcfun ("al_get_opengl_proc_address" get-opengl-proc-address) :pointer 6 | (name :string)) 7 | (defcfun ("al_get_opengl_texture" get-opengl-texture) :uint (bitmap :pointer)) 8 | (defcfun ("al_get_opengl_texture_size" get-opengl-texture-size) :void 9 | (bitmap :pointer) (width :pointer) (height :pointer)) 10 | (defcfun ("al_get_opengl_texture_position" get-opengl-texture-position) :void 11 | (bitmap :pointer) (u :pointer) (v :pointer)) 12 | (defcfun ("al_get_opengl_program_object" get-opengl-program-object) :uint (shader :pointer)) 13 | (defcfun ("al_get_opengl_fbo" get-opengl-fbo) :uint 14 | (bitmap :pointer)) 15 | (defcfun ("al_remove_opengl_fbo" remove-opengl-fbo) :uint 16 | (bitmap :pointer)) 17 | (defcfun ("al_have_opengl_extension" have-opengl-extension) :boolean 18 | (extension :string)) 19 | (defcfun ("al_get_opengl_version" get-opengl-version) :uint32) 20 | (defcfun ("al_get_opengl_variant" get-opengl-variant) opengl-variant) 21 | (defcfun ("al_set_current_opengl_context" set-current-opengl-context) :void 22 | (display :pointer)) 23 | -------------------------------------------------------------------------------- /src/ffi-functions/path.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:cl-liballegro) 2 | 3 | ;;; Path 4 | (defcfun ("al_create_path" create-path) :pointer (str :string)) 5 | (defcfun ("al_create_path_for_directory" create-path-for-directory) :pointer 6 | (str :string)) 7 | (defcfun ("al_destroy_path" destroy-path) :void (path :pointer)) 8 | (defcfun ("al_clone_path" clone-path) :pointer (path :pointer)) 9 | (defcfun ("al_join_paths" join-paths) :boolean (path :pointer) (tail :pointer)) 10 | (defcfun ("al_rebase_path" rebase-path) :boolean (heard :pointer) (tail :pointer)) 11 | (defcfun ("al_get_path_drive" get-path-drive) :string (path :pointer)) 12 | (defcfun ("al_get_path_num_components" get-path-num-components) :int (path :pointer)) 13 | (defcfun ("al_get_path_component" get-path-component) :string 14 | (path :pointer) (i :int)) 15 | (defcfun ("al_get_path_tail" get-path-tail) :string (path :pointer)) 16 | (defcfun ("al_get_path_filename" get-path-filename) :string (path :pointer)) 17 | (defcfun ("al_get_path_basename" get-path-basename) :string (path :pointer)) 18 | (defcfun ("al_get_path_extension" get-path-extension) :string (path :pointer)) 19 | (defcfun ("al_set_path_drive" set-path-drive) :void 20 | (path :pointer) (drive :string)) 21 | (defcfun ("al_append_path_component" append-path-component) :void 22 | (path :pointer) (s :string)) 23 | (defcfun ("al_insert_path_component" insert-path-component) :void 24 | (path :pointer) (i :int) (s :string)) 25 | (defcfun ("al_replace_path_component" replace-path-component) :void 26 | (path :pointer) (i :int) (s :string)) 27 | (defcfun ("al_remove_path_component" remove-path-component) :void 28 | (path :pointer) (i :int)) 29 | (defcfun ("al_drop_path_tail" drop-path-tail) :void (path :pointer)) 30 | (defcfun ("al_set_path_filename" set-path-filename) :void 31 | (path :pointer) (filename :string)) 32 | (defcfun ("al_set_path_extension" set-path-extension) :boolean 33 | (path :pointer) (extension :string)) 34 | (defcfun ("al_path_cstr" path-cstr) :string (path :pointer) (delim :char)) 35 | (defcfun ("al_make_path_canonical" make-path-canonical) :boolean (path :pointer)) 36 | -------------------------------------------------------------------------------- /src/ffi-functions/platform-specific.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:cl-liballegro) 2 | 3 | ;;; Platform-specific 4 | ;; Windows 5 | #+windows 6 | (progn 7 | (defcfun ("al_get_win_window_handle" get-win-window-handle) :pointer (display :pointer)) 8 | (defcfun ("al_win_add_window_callback" win-add-window-callback) :boolean 9 | (display :pointer) (callback :pointer) (userdata :pointer)) 10 | (defcfun ("al_win_remove_window_callback" win-remove-window-callback) :boolean 11 | (display :pointer) (callback :pointer) (userdata :pointer))) 12 | 13 | ;; Mac OS X 14 | #+(or darwin macos macosx) 15 | (defcfun ("al_osx_get_window" osx-get-window) :pointer (display :pointer)) 16 | 17 | ;; iPhone 18 | #+ios 19 | (progn 20 | (defcfun ("al_iphone_program_has_halted" iphone-program-has-halted) :void) 21 | (defcfun ("al_iphone_override_screen_scale" iphone-override-screen-scale) :void 22 | (scale c-float))) 23 | 24 | #+android 25 | (progn 26 | (defcfun ("al_android_set_apk_file_interface" android-set-apk-file-interface) :void) 27 | (defcfun ("al_android_set_apk_file_fs_interface" android-set-apk-file-fs-interface) :void) 28 | (defcfun ("al_android_get_os_version" android-get-os-version) :string)) 29 | 30 | #+unix 31 | (defcfun ("al_get_x_window_id" get-x-window-id) :ulong (display :pointer)) 32 | -------------------------------------------------------------------------------- /src/ffi-functions/shader.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:cl-liballegro) 2 | 3 | ;; Shader 4 | (defcfun ("al_create_shader" create-shader) :pointer 5 | (platform shader-platform)) 6 | (defcfun ("al_attach_shader_source" attach-shader-source) :bool 7 | (shader (:pointer (:struct shader))) (type shader-type) (source :string)) 8 | (defcfun ("al_attach_shader_source_file" attach-shader-source-file) :bool 9 | (shader (:pointer (:struct shader))) (type shader-type) (filename :string)) 10 | (defcfun ("al_build_shader" build-shader) :bool 11 | (shader (:pointer (:struct shader)))) 12 | (defcfun ("al_get_shader_log" get-shader-log) :string 13 | (shader (:pointer (:struct shader)))) 14 | (defcfun ("al_get_shader_platform" get-shader-platform) shader-platform 15 | (shader (:pointer (:struct shader)))) 16 | (defcfun ("al_use_shader" use-shader) :bool (shader :pointer)) 17 | (defcfun ("al_get_current_shader" get-current-shader) :pointer) 18 | (defcfun ("al_destroy_shader" destroy-shader) :void (shader :pointer)) 19 | (defcfun ("al_set_shader_sampler" set-shader-sampler) :bool 20 | (name :string) (bitmap :pointer) (unit :int)) 21 | (defcfun ("al_set_shader_matrix" set-shader-matrix) :bool 22 | (name :string) (matrix :pointer)) 23 | (defcfun ("al_set_shader_int" set-shader-int) :bool 24 | (name :string) (i :int)) 25 | (defcfun ("al_set_shader_float" set-shader-float) :bool 26 | (name :string) (f :float)) 27 | (defcfun ("al_set_shader_bool" set-shader-bool) :bool 28 | (name :string) (b :bool)) 29 | (defcfun ("al_set_shader_int_vector" set-shader-int-vector) :bool 30 | (name :string) (num-components :int) (i (:pointer :int)) (num-elems :int)) 31 | (defcfun ("al_set_shader_float_vector" set-shader-float-vector) :bool 32 | (name :string) (num-components :int) (f (:pointer :float)) (num-elems :int)) 33 | (defcfun ("al_get_default_shader_source" get-default-shader-source) :string 34 | (platform shader-platform) (type shader-type)) 35 | -------------------------------------------------------------------------------- /src/ffi-functions/state.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:cl-liballegro) 2 | 3 | ;;; State 4 | (defcfun ("al_restore_state" restore-state) :void (state :pointer)) 5 | (defcfun ("al_store_state" store-state) :void 6 | (state :pointer) (flags state-flags)) 7 | (defcfun ("al_get_errno" get-errno) :int) 8 | (defcfun ("al_set_errno" set-errno) :void (errnum :int)) 9 | -------------------------------------------------------------------------------- /src/ffi-functions/system.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:cl-liballegro) 2 | 3 | ;;; System 4 | (defcfun ("al_install_system" install-system) :boolean 5 | (version :int) (atexit-ptr :pointer)) 6 | (defun init () (install-system (get-allegro-version) (null-pointer))) 7 | (defcfun ("al_uninstall_system" uninstall-system) :void) 8 | (defcfun ("al_is_system_installed" is-system-installed) :boolean) 9 | (defcfun ("al_get_allegro_version" get-allegro-version) :uint32) 10 | (defcfun ("al_get_standard_path" get-standard-path) :pointer (id path-id)) 11 | (defcfun ("al_set_exe_name" set-exe-name) :void (path :string)) 12 | (defcfun ("al_set_app_name" set-app-name) :void (app-name :string)) 13 | (defcfun ("al_set_org_name" set-org-name) :void (org-name :string)) 14 | (defcfun ("al_get_app_name" get-app-name) :string) 15 | (defcfun ("al_get_org_name" get-org-name) :string) 16 | (defcfun ("al_get_system_config" get-system-config) :pointer) 17 | (defcfun ("al_register_assert_handler" register-assert-handler) :void 18 | (handler :pointer)) 19 | (defcfun ("al_register_trace_handler" register-trace-handler) :void 20 | (handler :pointer)) 21 | (defcfun ("al_get_cpu_count" get-cpu-count) :int) 22 | (defcfun ("al_get_ram_size" get-ram-size) :int) 23 | -------------------------------------------------------------------------------- /src/ffi-functions/threads.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:cl-liballegro) 2 | 3 | (defcfun ("al_create_thread" create-thread) (:pointer (:struct thread)) 4 | (proc :pointer) (arg :pointer)) 5 | (defcfun ("al_create_thread_with_stacksize" create-thread-with-stacksize) (:pointer (:struct thread)) 6 | (proc :pointer) (arg :pointer) (stacksize :uint)) 7 | (defcfun ("al_start_thread" start-thread) :void 8 | (thread :pointer (:struct thread))) 9 | (defcfun ("al_join_thread" join-thread) :void 10 | (thread (:pointer (:struct thread))) (ret-value :pointer)) 11 | (defcfun ("al_set_thread_should_stop" set-thread-should-stop) :void 12 | (thread (:pointer (:struct thread)))) 13 | (defcfun ("al_get_thread_should_stop" get-thread-should-stop) :bool 14 | (thread (:pointer (:struct thread)))) 15 | (defcfun ("al_destroy_thread" destroy-thread) :void 16 | (thread (:pointer (:struct thread)))) 17 | (defcfun ("al_run_detached_thread" run-detached-thread) :void 18 | (proc :pointer) (arg :pointer)) 19 | (defcfun ("al_create_mutex" create-mutex) (:pointer (:struct mutex))) 20 | (defcfun ("al_create_mutex_recursive" create-mutex-recursive) (:pointer (:struct mutex))) 21 | (defcfun ("al_lock_mutex" lock-mutex) :void 22 | (mutex (:pointer (:struct mutex)))) 23 | (defcfun ("al_unlock_mutex" unlock-mutex) :void 24 | (mutex (:pointer (:struct mutex)))) 25 | (defcfun ("al_destroy_mutex" destroy-mutex) :void 26 | (mutex (:pointer (:struct mutex)))) 27 | (defcfun ("al_create_cond" create-cond) (:pointer (:struct thread-condition))) 28 | (defcfun ("al_destroy_cond" destroy-cond) :void 29 | (cond (:pointer (:struct thread-condition)))) 30 | (defcfun ("al_wait_cond" wait-cond) :void 31 | (cond (:pointer (:struct thread-condition))) (mutex (:pointer (:struct mutex)))) 32 | (defcfun ("al_wait_cond_until" wait-cond-until) :int 33 | (cond (:pointer (:struct thread-condition))) (mutex (:pointer (:struct mutex))) 34 | (timeout (:pointer (:struct timeout)))) 35 | (defcfun ("al_broadcast_cond" broadcast-cond) :void 36 | (cond (:pointer (:struct thread-condition)))) 37 | (defcfun ("al_signal_cond" signal-cond) :void 38 | (cond (:pointer (:struct thread-condition)))) 39 | -------------------------------------------------------------------------------- /src/ffi-functions/time.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:cl-liballegro) 2 | 3 | ;;; Time 4 | (defcfun ("al_get_time" get-time) c-double) 5 | (defun current-time () (get-time)) 6 | (defcfun ("al_init_timeout" init-timeout) :void 7 | (timeout :pointer) (seconds c-double)) 8 | (defcfun ("al_rest" rest-time) :void (seconds c-double)) 9 | -------------------------------------------------------------------------------- /src/ffi-functions/timer.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:cl-liballegro) 2 | 3 | ;;; Timer 4 | (defcfun ("al_create_timer" create-timer) :pointer (speed-secs c-double)) 5 | (defcfun ("al_start_timer" start-timer) :void (timer :pointer)) 6 | (defcfun ("al_stop_timer" stop-timer) :void (timer :pointer)) 7 | (defcfun ("al_get_timer_started" get-timer-started) :boolean (timer :pointer)) 8 | (defcfun ("al_destroy_timer" destroy-timer) :void (timer :pointer)) 9 | (defcfun ("al_get_timer_count" get-timer-count) :int64 (timer :pointer)) 10 | (defcfun ("al_set_timer_count" set-timer-count) :void 11 | (timer :pointer) (new-count :int64)) 12 | (defcfun ("al_add_timer_count" add-timer-count) :void 13 | (timer :pointer) (diff :int64)) 14 | (defcfun ("al_get_timer_speed" get-timer-speed) c-double (timer :pointer)) 15 | (defcfun ("al_set_timer_speed" set-timer-speed) :void 16 | (timer :pointer) (new-speed-secs c-double)) 17 | (defcfun ("al_get_timer_event_source" get-timer-event-source) :pointer 18 | (timer :pointer)) 19 | -------------------------------------------------------------------------------- /src/ffi-functions/touch-input.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:cl-liballegro) 2 | 3 | ;; Touch input 4 | (defcfun ("al_install_touch_input" install-touch-input) :bool) 5 | (defcfun ("al_uninstall_touch_input" uninstall-touch-input) :void) 6 | (defcfun ("al_is_touch_input_installed" is-touch-input-installed) :bool) 7 | (defcfun ("al_get_touch_input_state" get-touch-input-state) :void 8 | (ret-state :pointer)) 9 | (defcfun ("al_set_mouse_emulation_mode" set-mouse-emulation-mode) :void 10 | (mode :int)) 11 | (defcfun ("al_get_mouse_emulation_mode" get-mouse-emulation-mode) :int) 12 | (defcfun ("al_get_touch_input_event_source" get-touch-input-event-source) :pointer) 13 | (defcfun ("al_get_touch_input_mouse_emulation_event_source" get-touch-input-mouse-emulation-event-source) :pointer) 14 | -------------------------------------------------------------------------------- /src/ffi-functions/transformations.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:cl-liballegro) 2 | 3 | ;;; Transformations 4 | (defcfun ("al_copy_transform" copy-transform) :void (dest :pointer) (src :pointer)) 5 | (defcfun ("al_use_transform" use-transform) :void (trans :pointer)) 6 | (defcfun ("al_get_current_transform" get-current-transform) :pointer) 7 | (defcfun ("al_use_projection_transform" use-projection-transform) :void (trans :pointer)) 8 | (defcfun ("al_get_current_projection_transform" get-current-projection-transform) :pointer) 9 | (defcfun ("al_get_current_inverse_transform" get-current-inverse-transform) :pointer) 10 | (defcfun ("al_invert_transform" invert-transform) :void (trans :pointer)) 11 | (defcfun ("al_check_inverse" check-inverse) :int (trans :pointer) (tol c-float)) 12 | (defcfun ("al_identity_transform" identity-transform) :void (trans :pointer)) 13 | (defcfun ("al_build_transform" build-transform) :void 14 | (trans :pointer) (x c-float) (y c-float) (sx c-float) (sy c-float) (theta c-float)) 15 | (defcfun ("al_build_camera_transform" build-camera-transform) :void 16 | (trans :pointer) 17 | (position-x c-float) (position-y c-float) (position-z c-float) 18 | (look-x c-float) (look-y c-float) (look-z c-float) 19 | (up-x c-float) (up-y c-float) (up-z c-float)) 20 | (defcfun ("al_translate_transform" translate-transform) :void 21 | (trans :pointer) (x c-float) (y c-float)) 22 | (defcfun ("al_rotate_transform" rotate-transform) :void 23 | (trans :pointer) (theta c-float)) 24 | (defcfun ("al_scale_transform" scale-transform) :void 25 | (trans :pointer) (sx c-float) (sy c-float)) 26 | (defcfun ("al_transform_coordinates" transform-coordinates) :void 27 | (trans :pointer) (x (:pointer :float)) (y (:pointer :float))) 28 | (defcfun ("al_transform_coordinates_3d" transform-coordinates-3d) :void 29 | (trans :pointer) (x (:pointer :float)) (y (:pointer :float)) (z (:pointer :float))) 30 | (defcfun ("al_compose_transform" compose-transform) :void 31 | (trans :pointer) (other :pointer)) 32 | (defcfun ("al_orthographic_transform" ortohographic-transform) :void 33 | (trans :pointer) 34 | (left c-float) (top c-float) (n c-float) 35 | (leftright c-float) (bottom c-float) (f c-float)) 36 | (defcfun ("al_perspective_transform" perspective-transform) :void 37 | (trans :pointer) 38 | (left c-float) (top c-float) (n c-float) 39 | (leftright c-float) (bottom c-float) (f c-float)) 40 | (defcfun ("al_translate_transform_3d" translate-transform-3d) :void 41 | (trans :pointer) (x c-float) (y c-float) (z c-float)) 42 | (defcfun ("al_scale_transform_3d" scale-transform-3d) :void 43 | (trans :pointer) (sx c-float) (sy c-float) (sz c-float)) 44 | (defcfun ("al_rotate_transform_3d" rotate-transform-3d) :void 45 | (trans :pointer) (x c-float) (y c-float) (z c-float) (angle c-float)) 46 | (defcfun ("al_horizontal_shear_transform" horizontal-shear-transform) :void 47 | (trans :pointer) (theta :float)) 48 | (defcfun ("al_vertical_shear_transform" vertical-shear-transform) :void 49 | (trans :pointer) (theta :float)) 50 | -------------------------------------------------------------------------------- /src/ffi-functions/utf-8.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:cl-liballegro) 2 | 3 | ;;; UTF-8 4 | 5 | ;; Creating and destroying strings 6 | (defcfun ("al_ustr_new" ustr-new) (:pointer (:struct ustr)) (s :string)) 7 | (defcfun ("al_ustr_new_from_buffer" ustr-new-from-buffer) (:pointer (:struct ustr)) (s :string) (size :uint)) 8 | (defcfun ("al_ustr_newf" ustr-newf) (:pointer (:struct ustr)) (fmt :string) &rest) 9 | (defcfun ("al_ustr_free" ustr-free) :void (us (:pointer (:struct ustr)))) 10 | (defcfun ("al_cstr" cstr) :string (us (:pointer (:struct ustr)))) 11 | (defcfun ("al_ustr_to_buffer" ustr_to_buffer) :void (us (:pointer (:struct ustr))) (buffer :string) (size :int)) 12 | (defcfun ("al_cstr_dup" cstr_dup) :string (us (:pointer (:struct ustr)))) 13 | (defcfun ("al_ustr_dup" ustr_dup) (:pointer (:struct ustr)) (us (:pointer (:struct ustr)))) 14 | (defcfun ("al_ustr_dup_substr" ustr_dup_substr) (:pointer (:struct ustr)) (us (:pointer (:struct ustr))) (start-pos :int) (end-pos :int)) 15 | 16 | ;; Predefined strings 17 | (defcfun ("al_ustr_empty_string" ustr_empty_string) (:pointer (:struct ustr))) 18 | 19 | ;; Creating strings by referencing other data 20 | (defcfun ("al_ref_cstr" ref_cstr) (:pointer (:struct ustr)) (info (:pointer (:struct ustr-info))) (s :string)) 21 | (defcfun ("al_ref_buffer" ref_buffer) (:pointer (:struct ustr)) (info (:pointer (:struct ustr-info))) (s :string) (size :uint)) 22 | (defcfun ("al_ref_ustr" ref_ustr) (:pointer (:struct ustr)) (info (:pointer (:struct ustr-info))) (us :pointer) (start-pos :int) (end-pos :int)) 23 | 24 | ;; Sizes and offsets 25 | (defcfun ("al_ustr_size" ustr_size) :uint (us (:pointer (:struct ustr)))) 26 | (defcfun ("al_ustr_length" ustr_length) :uint (us (:pointer (:struct ustr)))) 27 | (defcfun ("al_ustr_offset" ustr_offset) :int (us (:pointer (:struct ustr))) (index :int)) 28 | (defcfun ("al_ustr_next" ustr_next) :bool (us (:pointer (:struct ustr))) (pos (:pointer :int))) 29 | (defcfun ("al_ustr_prev" ustr_prev) :bool (us (:pointer (:struct ustr))) (pos (:pointer :int))) 30 | 31 | ;; Getting code points 32 | (defcfun ("al_ustr_get" ustr_get) :int32 (ub (:pointer (:struct ustr))) (pos :int)) 33 | (defcfun ("al_ustr_get_next" ustr_get_next) :int32 (us (:pointer (:struct ustr))) (pos (:pointer :int))) 34 | (defcfun ("al_ustr_prev_get" ustr_prev_get) :int32 (us (:pointer (:struct ustr))) (pos (:pointer :int))) 35 | 36 | ;; Inserting into strings 37 | (defcfun ("al_ustr_insert" ustr_insert) :bool (us1 (:pointer (:struct ustr))) (pos :int) (us2 (:pointer (:struct ustr)))) 38 | (defcfun ("al_ustr_insert_cstr" ustr_insert_cstr) :bool (us (:pointer (:struct ustr))) (pos :int) (us2 :string)) 39 | (defcfun ("al_ustr_insert_chr" ustr_insert_chr) :uint (us (:pointer (:struct ustr))) (pos :int) (c :int32)) 40 | 41 | ;; Appending to strings 42 | (defcfun ("al_ustr_append" ustr_append) :bool (us1 (:pointer (:struct ustr))) (us2 (:pointer (:struct ustr)))) 43 | (defcfun ("al_ustr_append_cstr" ustr_append_cstr) :bool (us (:pointer (:struct ustr))) (s :string)) 44 | (defcfun ("al_ustr_append_chr" ustr_append_chr) :uint (us (:pointer (:struct ustr))) (c :int32)) 45 | (defcfun ("al_ustr_appendf" ustr_appendf) :bool 46 | (us (:pointer (:struct ustr))) (fmt :string) &rest) 47 | ;; The ap function parameter is type va_list? 48 | ;; (defcfun ("al_ustr_vappendf" ustr_vappendf) :bool 49 | ;; (us (:pointer (:struct ustr))) (fmt :string) (ap (:struct va-list))) 50 | 51 | ;; Removing parts of strings 52 | (defcfun ("al_ustr_remove_chr" ustr_remove_chr) :bool (us (:pointer (:struct ustr))) (pos :int)) 53 | (defcfun ("al_ustr_remove_range" ustr_remove_range) :bool (us (:pointer (:struct ustr))) (start-pos :int) (end-pos :int)) 54 | (defcfun ("al_ustr_truncate" ustr_truncate) :bool (us (:pointer (:struct ustr))) (start-pos :int)) 55 | (defcfun ("al_ustr_ltrim_ws" ustr_ltrim_ws) :bool (us (:pointer (:struct ustr)))) 56 | (defcfun ("al_ustr_rtrim_ws" ustr_rtrim_ws) :bool (us (:pointer (:struct ustr)))) 57 | (defcfun ("al_ustr_trim_ws" ustr_trim_ws) :bool (us (:pointer (:struct ustr)))) 58 | 59 | ;; Assigning one string to another 60 | (defcfun ("al_ustr_assign" ustr_assign) :bool 61 | (us1 (:pointer (:struct ustr))) (us2 (:pointer (:struct ustr)))) 62 | (defcfun ("al_ustr_assign_substr" ustr_assign_substr) :bool 63 | (us1 (:pointer (:struct ustr))) (us2 (:pointer (:struct ustr))) (start-pos :int) (end-pos :int)) 64 | (defcfun ("al_ustr_assign_cstr" ustr_assign_cstr) :bool (us1 (:pointer (:struct ustr))) (s :string)) 65 | 66 | ;; Replacing parts of string 67 | (defcfun ("al_ustr_set_chr" ustr_set_chr) :uint 68 | (us (:pointer (:struct ustr))) (start-pos :int) (c :int32)) 69 | (defcfun ("al_ustr_replace_range" ustr_replace_range) :bool 70 | (us1 (:pointer (:struct ustr))) 71 | (start-pos1 :int) 72 | (end-pos1 :int) 73 | (us2 (:pointer (:struct ustr)))) 74 | 75 | ;; Searching 76 | (defcfun ("al_ustr_find_chr" ustr_find_chr) :int 77 | (us (:pointer (:struct ustr))) (start-pos :int) (c :int32)) 78 | (defcfun ("al_ustr_rfind_chr" ustr_rfind_chr) :int 79 | (us (:pointer (:struct ustr))) (end-pos :int) (c :int32)) 80 | (defcfun ("al_ustr_find_set" ustr_find_set) :int 81 | (us (:pointer (:struct ustr))) (start-pos :int) (accept (:pointer (:struct ustr)))) 82 | (defcfun ("al_ustr_find_set_cstr" ustr_find_set_cstr) :int 83 | (us (:pointer (:struct ustr))) (start-pos :int) (accept :string)) 84 | (defcfun ("al_ustr_find_cset" ustr_find_cset) :int 85 | (us (:pointer (:struct ustr))) (start-pos :int) (accept (:pointer (:struct ustr)))) 86 | (defcfun ("al_ustr_find_cset_cstr" ustr_find_cset_cstr) :int 87 | (us (:pointer (:struct ustr))) (start-pos :int) (reject :string)) 88 | (defcfun ("al_ustr_find_str" ustr_find_str) :int 89 | (haystack (:pointer (:struct ustr))) 90 | (start-pos :int) 91 | (needle (:pointer (:struct ustr)))) 92 | (defcfun ("al_ustr_find_cstr" ustr_find_cstr) :int 93 | (haystack (:pointer (:struct ustr))) 94 | (start-pos :int) 95 | (needle :string)) 96 | (defcfun ("al_ustr_rfind_str" ustr_rfind_str) :int 97 | (haystack (:pointer (:struct ustr))) 98 | (end-pos :int) 99 | (needle (:pointer (:struct ustr)))) 100 | (defcfun ("al_ustr_rfind_cstr" ustr_rfind_cstr) :int 101 | (haystack (:pointer (:struct ustr))) 102 | (end-pos :int) 103 | (needle :string)) 104 | (defcfun ("al_ustr_find_replace" ustr_find_replace) :bool 105 | (us (:pointer (:struct ustr))) 106 | (start-pos :int) 107 | (find (:pointer (:struct ustr))) 108 | (replace (:pointer (:struct ustr)))) 109 | (defcfun ("al_ustr_find_replace_cstr" ustr_find_replace_cstr) :bool 110 | (us (:pointer (:struct ustr))) 111 | (start-pos :int) 112 | (find :string) 113 | (replace :string)) 114 | 115 | ;; Comparing 116 | (defcfun ("al_ustr_equal" ustr_equal) :bool (us1 (:pointer (:struct ustr))) (us2 (:pointer (:struct ustr)))) 117 | (defcfun ("al_ustr_compare" ustr_compare) :int (us1 (:pointer (:struct ustr))) (us2 (:pointer (:struct ustr)))) 118 | (defcfun ("al_ustr_ncompare" ustr_ncompare) :int (us1 (:pointer (:struct ustr))) (us2 (:pointer (:struct ustr))) (n :int)) 119 | (defcfun ("al_ustr_has_prefix" ustr_has_prefix) :bool (us1 (:pointer (:struct ustr))) (us2 (:pointer (:struct ustr)))) 120 | (defcfun ("al_ustr_has_prefix_cstr" ustr_has_prefix_cstr) :bool (us1 :string) (us2 :string)) 121 | (defcfun ("al_ustr_has_suffix" ustr_has_suffix) :bool (us1 (:pointer (:struct ustr))) (us2 (:pointer (:struct ustr)))) 122 | (defcfun ("al_ustr_has_suffix_cstr" ustr_has_suffix_cstr) :bool (us1 (:pointer (:struct ustr))) (us2 :string)) 123 | 124 | ;; UTF-16 conversion 125 | (defcfun ("al_ustr_new_from_utf16" ustr_new_from_utf16) (:pointer (:struct ustr)) (s (:pointer :uint16))) 126 | (defcfun ("al_ustr_size_utf16" ustr_size_utf16) :uint (us (:pointer (:struct ustr)))) 127 | (defcfun ("al_ustr_encode_utf16" ustr_encode_utf16) :uint 128 | (us (:pointer (:struct ustr))) 129 | (s (:pointer :uint16)) 130 | (n :uint)) 131 | 132 | ;; Low-level UTF-8 routines 133 | (defcfun ("al_utf8_width" utf8_width) :uint (c :int32)) 134 | (defcfun ("al_utf8_encode" utf8_encode) :uint (s (:pointer :uint8)) (c :int32)) 135 | 136 | ;; Low-level UTF-16 routines 137 | (defcfun ("al_utf16_width" utf16_width) :uint (c :int32)) 138 | (defcfun ("al_utf16_encode" utf16_encode) :uint (s (:pointer :uint16)) (c :int32)) 139 | -------------------------------------------------------------------------------- /src/interface/interface.lisp: -------------------------------------------------------------------------------- 1 | ;;;; Higher Level Interface 2 | (in-package #:cl-liballegro) 3 | 4 | (defclass display-settings () 5 | ((width :initform 800 :initarg :width :reader width) 6 | (height :initform 600 :initarg :height :reader height) 7 | (title :initarg :title :initform "Allegro5 Window" :reader title) 8 | (display-flags :initarg :display-flags :initform 0 :reader display-flags) 9 | (display-options :initarg :display-options :initform '() :reader display-options))) 10 | 11 | (defclass system (display-settings) 12 | ((event-queue :accessor event-queue) 13 | (display :accessor display) 14 | (event :reader event :initform (cffi:foreign-alloc '(:union al:event))) 15 | (system-loop-running-p :accessor system-loop-running-p :initform t) 16 | (system-time :accessor system-time) 17 | (new-time :accessor new-time) 18 | (frame-time :accessor frame-time) 19 | (accumulator :accessor accumulator :initform 0.0) 20 | (logic-fps :accessor logic-fps :initarg :logic-fps :initform 30))) 21 | 22 | ;;; Initializations 23 | (defgeneric initialize-event-queue (system) 24 | (:method (system) 25 | (setf (event-queue system) (al:create-event-queue)))) 26 | (defgeneric initialize-display (system) 27 | (:method (system) 28 | (al:set-new-display-flags (display-flags system)) 29 | (loop for (option val importance) in (display-options system) do 30 | (al:set-new-display-option option val importance)) 31 | (setf (display system) (al:create-display (width system) (height system))) 32 | (al:set-window-title (display system) (title system)) 33 | (al:register-event-source (event-queue system) 34 | (al:get-display-event-source (display system))))) 35 | (defgeneric initialize-mouse (system) 36 | (:method (system) 37 | (al:install-mouse) 38 | (al:register-event-source (event-queue system) (al:get-mouse-event-source)))) 39 | (defgeneric initialize-keyboard (system) 40 | (:method (system) 41 | (al:install-keyboard) 42 | (al:register-event-source (event-queue system) (al:get-keyboard-event-source)))) 43 | (defgeneric initialize-joystick (system) 44 | (:method (system) 45 | (al:install-joystick) 46 | (al:register-event-source (event-queue system) (al:get-joystick-event-source)))) 47 | 48 | ;;; Generic Handlers 49 | (defgeneric joystick-axis-handler (system) (:method (system))) 50 | (defgeneric joystick-button-down-handler (system) (:method (system))) 51 | (defgeneric joystick-button-up-handler (system) (:method (system))) 52 | (defgeneric joystick-configuration-handler (system) (:method (system))) 53 | (defgeneric key-down-handler (system) 54 | (:method (system) 55 | (print (cffi:foreign-slot-value (al:event system) 56 | '(:struct al:keyboard-event) 57 | 'al::keycode)))) 58 | (defgeneric key-char-handler (system) (:method (system))) 59 | (defgeneric key-up-handler (system) (:method (system))) 60 | (defgeneric mouse-axis-handler (system) (:method (system))) 61 | (defgeneric mouse-button-down-handler (system) (:method (system))) 62 | (defgeneric mouse-button-up-handler (system) (:method (system))) 63 | (defgeneric mouse-enter-display-handler (system) (:method (system))) 64 | (defgeneric mouse-leave-display-handler (system) (:method (system))) 65 | (defgeneric mouse-warped-handler (system) (:method (system))) 66 | (defgeneric timer-handler (system) (:method (system))) 67 | (defgeneric display-expose-handler (system) (:method (system))) 68 | (defgeneric display-resize-handler (system) 69 | (:method (system) 70 | (al:acknowledge-resize (display system)))) 71 | (defgeneric display-close-handler (system) 72 | (:method (system) 73 | (setf (system-loop-running-p system) nil))) 74 | (defgeneric display-lost-handler (system) (:method (system))) 75 | (defgeneric display-found-handler (system) (:method (system))) 76 | (defgeneric display-switch-in-handler (system) (:method (system))) 77 | (defgeneric display-switch-out-handler (system) (:method (system))) 78 | (defgeneric display-switch-orientation-handler (system) (:method (system))) 79 | (defgeneric event-handler (system) 80 | (:method (system) 81 | (case (cffi:foreign-slot-value (event system) '(:union al:event) 'al::type) 82 | (:joystick-axis (joystick-axis-handler system)) 83 | (:joystick-button-down (joystick-button-down-handler system)) 84 | (:joystick-button-up (joystick-button-up-handler system)) 85 | (:joystick-configuration (joystick-configuration-handler system)) 86 | (:key-down (key-down-handler system)) 87 | (:key-char (key-char-handler system)) 88 | (:key-up (key-up-handler system)) 89 | (:mouse-axis (mouse-axis-handler system)) 90 | (:mouse-button-down (mouse-button-down-handler system)) 91 | (:mouse-button-up (mouse-button-up-handler system)) 92 | (:mouse-enter-display (mouse-enter-display-handler system)) 93 | (:mouse-leave-display (mouse-leave-display-handler system)) 94 | (:mouse-warped (mouse-warped-handler system)) 95 | (:timer (timer-handler system)) 96 | (:display-expose (display-expose-handler system)) 97 | (:display-resize (display-resize-handler system)) 98 | (:display-close (display-close-handler system)) 99 | (:display-lost (display-lost-handler system)) 100 | (:display-found (display-found-handler system)) 101 | (:display-switch-in (display-switch-in-handler system)) 102 | (:display-switch-out (display-switch-out-handler system)) 103 | (:display-switch-orientation (display-switch-orientation-handler system))))) 104 | 105 | (defgeneric process-event-queue (system) 106 | (:method (system) 107 | (loop while (al:get-next-event (event-queue system) (event system)) do 108 | (event-handler system)))) 109 | 110 | (defgeneric update (system) (:method (system))) 111 | (defgeneric render (system) 112 | (:method (system) 113 | (al:clear-to-color (al:map-rgb 0 0 0)) 114 | (al:flip-display))) 115 | 116 | (defgeneric system-loop (system) 117 | (:method (system) 118 | (with-slots (system-time new-time frame-time accumulator logic-fps) system 119 | (loop while (system-loop-running-p system) 120 | with lpt = (/ 1.0 logic-fps) 121 | do (setf new-time (get-time)) 122 | (setf frame-time (- new-time system-time)) 123 | (when (> frame-time lpt) 124 | (setf frame-time lpt)) 125 | (setf system-time new-time) 126 | (incf accumulator frame-time) 127 | (loop while (>= accumulator lpt) 128 | do (process-event-queue system) 129 | (update system) 130 | (decf accumulator lpt)) 131 | (render system))))) 132 | 133 | (defgeneric initialize-system (system) 134 | (:method (system) 135 | (trivial-garbage:gc :full t) 136 | (al:install-system (al:get-allegro-version) (null-pointer)) 137 | (setf (system-time system) (al:get-time)) 138 | (al:init-image-addon) 139 | (al:init-font-addon) 140 | (al:init-ttf-addon) 141 | (al:install-audio) 142 | (al:restore-default-mixer) 143 | (al:init-acodec-addon) 144 | (initialize-event-queue system) 145 | (initialize-display system) 146 | (initialize-mouse system) 147 | (initialize-keyboard system) 148 | (initialize-joystick system))) 149 | 150 | (defgeneric shutdown-system (system) 151 | (:method (system) 152 | (al:destroy-display (display system)) 153 | (al:destroy-event-queue (event-queue system)) 154 | (al:stop-samples) 155 | (cffi:foreign-free (event system)) 156 | (trivial-garbage:gc :full t))) 157 | 158 | (defun %run-system (system) 159 | (initialize-system system) 160 | (unwind-protect (system-loop system) 161 | (shutdown-system system))) 162 | 163 | #-darwin 164 | (defgeneric run-system (system) 165 | (:method (system) 166 | (float-features:with-float-traps-masked t 167 | (%run-system system)))) 168 | 169 | ;; OS X requires GUI related code to run in the main thread (not 170 | ;; specific to Common Lisp). The arrived solution is a simple closure 171 | ;; to pass the system to a callback that will run in the main thread. 172 | ;; 173 | ;; Also see: https://liballeg.org/a5docs/trunk/misc.html#al_run_main 174 | #+darwin 175 | (let ((main-system)) 176 | (defcallback run-system-main :void ((argc :int) (argv :pointer)) 177 | (declare (ignore argc argv)) 178 | (%run-system main-system)) 179 | 180 | (defgeneric run-system (system) 181 | (:method (system) 182 | (setf main-system system) 183 | (trivial-main-thread:with-body-in-main-thread () 184 | (float-features:with-float-traps-masked t 185 | (run-main 0 (null-pointer) (callback run-system-main))))))) 186 | -------------------------------------------------------------------------------- /src/interface/streams.lisp: -------------------------------------------------------------------------------- 1 | ;;;; Gray streams for file APIs 2 | (in-package #:cl-liballegro) 3 | 4 | ;;; Condition helpers 5 | (declaim (ftype (function (string) string) prompt-for-string)) 6 | (defun prompt-for-string (prompt) 7 | "Prompts for a string value from *QUERY-IO*. To be used with interactive 8 | restarts." 9 | (format *query-io* prompt) 10 | (force-output *query-io*) 11 | (read-line *query-io*)) 12 | 13 | (declaim (ftype (function (function string &rest t) cffi:foreign-pointer) 14 | ensure-loaded)) 15 | (defun ensure-loaded (load-fn file-name &rest rest) 16 | "Calls LOAD-FN (which can be #'FOPEN, #'LOAD-BITMAP, #'LOAD-SAMPLE or similar) 17 | with the FILE-NAME argument and REST arguments, if any. If LOAD-FN returns 18 | non-null pointer, it is returned. Otherwise the error is raised, with 19 | interactive restart allowing to specify another filename." 20 | (values 21 | (restart-case 22 | (let ((file (apply load-fn file-name rest))) 23 | (declare (type cffi:foreign-pointer file)) 24 | (if (cffi:null-pointer-p file) 25 | (error "Failed to load '~a'" file-name) 26 | file)) 27 | (retry-loading () 28 | :report "Retry loading" 29 | (apply #'ensure-loaded load-fn file-name rest)) 30 | (specify-filename (new-file-name) 31 | :report "Specify another file name" 32 | :interactive (lambda () 33 | (list 34 | (prompt-for-string 35 | "Please specify another file name: "))) 36 | (apply #'ensure-loaded load-fn new-file-name rest))))) 37 | 38 | ;;; CHARACTER-STREAM class 39 | (defclass character-stream 40 | (trivial-gray-streams:fundamental-character-input-stream) 41 | ((path :initarg :path :initform (error "Missing required PATH argument")) 42 | (file)) 43 | (:documentation 44 | "Wrapper around liballegro file IO to manipulate read-only text file.")) 45 | 46 | (declaim (ftype (function ((or string pathname)) 47 | (values character-stream &optional)) 48 | make-character-stream)) 49 | (defun make-character-stream (path) 50 | "Convenience constructor function for CHARACTER-STREAM." 51 | (make-instance 'character-stream 52 | :path (if (typep path 'pathname) 53 | (namestring path) 54 | path))) 55 | 56 | (defmethod initialize-instance :after ((stream character-stream) &key) 57 | (with-slots (path file) stream 58 | (setf file (ensure-loaded #'fopen path "r")))) 59 | 60 | (defmethod trivial-gray-streams:stream-read-char ((stream character-stream)) 61 | (with-slots (path file) stream 62 | (let ((char (fgetc file))) 63 | (declare (type fixnum char)) 64 | (if (minusp char) 65 | (if (feof file) 66 | :eof 67 | (error "Error reading '~a'. ~a" path (ferrmsg file))) 68 | (code-char char))))) 69 | 70 | (defmethod trivial-gray-streams:stream-read-sequence ((stream character-stream) 71 | sequence start end 72 | &key &allow-other-keys) 73 | (declare (type fixnum start end)) 74 | (with-slots (path file) stream 75 | (let* ((length (- end start)) 76 | actual-length 77 | (result 78 | (cffi:with-foreign-pointer-as-string (buffer length 79 | :count actual-length) 80 | (setf actual-length (fread file buffer length)) 81 | (when (ferror file) 82 | (error "Error reading '~a'. ~a" path (ferrmsg file)))))) 83 | (replace sequence result :start1 start :end1 end) 84 | actual-length))) 85 | 86 | (defmethod trivial-gray-streams:stream-unread-char ((stream character-stream) 87 | char) 88 | (with-slots (file) stream 89 | (fungetc file (char-code char)))) 90 | 91 | (defmethod trivial-gray-streams:stream-file-position ((stream character-stream)) 92 | (with-slots (file) stream 93 | (ftell file))) 94 | 95 | (defmethod (setf trivial-gray-streams:stream-file-position) 96 | (newval (stream character-stream)) 97 | (with-slots (file) stream 98 | (fseek file newval 0))) 99 | 100 | (defmethod trivial-gray-streams::close ((stream character-stream) &key abort) 101 | (declare (ignore abort)) 102 | (with-slots (file) stream 103 | (fclose file) 104 | (setf file (cffi:null-pointer)))) 105 | 106 | ;;; BINARY-STREAM class 107 | (defclass binary-stream (trivial-gray-streams:fundamental-binary-input-stream) 108 | ((path :initarg :path :initform (error "Missing required PATH argument")) 109 | (file)) 110 | (:documentation 111 | "Wrapper around liballegro file IO to manipulate read-only binary file.")) 112 | 113 | (declaim (ftype (function ((or string pathname)) 114 | (values binary-stream &optional)) 115 | make-binary-stream)) 116 | (defun make-binary-stream (path) 117 | "Convenience constructor function for BINARY-STREAM." 118 | (make-instance 'binary-stream 119 | :path (if (typep path 'pathname) 120 | (namestring path) 121 | path))) 122 | 123 | (defmethod initialize-instance :after ((stream binary-stream) &key) 124 | (with-slots (path file) stream 125 | (setf file (ensure-loaded #'fopen path "rb")))) 126 | 127 | (defmethod trivial-gray-streams::stream-element-type ((stream binary-stream)) 128 | '(unsigned-byte)) 129 | 130 | (defmethod trivial-gray-streams:stream-read-byte ((stream binary-stream)) 131 | (with-slots (path file) stream 132 | (let ((char (fgetc file))) 133 | (declare (type fixnum char)) 134 | (if (minusp char) 135 | (if (feof file) 136 | :eof 137 | (error "Error reading '~a'. ~a" path (ferrmsg file))) 138 | char)))) 139 | 140 | (defmethod trivial-gray-streams:stream-read-sequence ((stream binary-stream) 141 | sequence start end 142 | &key &allow-other-keys) 143 | (declare (type fixnum start end)) 144 | (with-slots (path file) stream 145 | (cffi:with-pointer-to-vector-data (buffer sequence) 146 | (let ((pointer (cffi:inc-pointer buffer start))) 147 | (+ start (fread file pointer (- end start))))))) 148 | 149 | (defmethod trivial-gray-streams:stream-file-position ((stream binary-stream)) 150 | (with-slots (file) stream 151 | (ftell file))) 152 | 153 | (defmethod (setf trivial-gray-streams:stream-file-position) 154 | (newval (stream binary-stream)) 155 | (with-slots (file) stream 156 | (fseek file newval 0))) 157 | 158 | (defmethod trivial-gray-streams::close ((stream binary-stream) &key abort) 159 | (declare (ignore abort)) 160 | (with-slots (file) stream 161 | (fclose file) 162 | (setf file (cffi:null-pointer)))) 163 | 164 | ;;; STREAM-SIZE helper 165 | (declaim (ftype (function ((or character-stream binary-stream)) fixnum) 166 | stream-size)) 167 | (defun stream-size (stream) 168 | "Returns the file size for BINARY-STREAM and CHARACTER-STREAM." 169 | (with-slots (file) stream 170 | (fsize file))) 171 | -------------------------------------------------------------------------------- /src/library.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:cl-liballegro) 2 | 3 | (defmacro define-allegro-library (lib) 4 | "Use macro for easier versioning. Debug using MACROEXPAND-1" 5 | `(define-foreign-library ,(intern (string-upcase lib)) 6 | (:windows ,(concatenate 'string (subseq lib 3) "-5.2.dll")) 7 | (:darwin (:or ,(concatenate 'string lib ".5.2.9.dylib") 8 | ,(concatenate 'string lib ".5.2.dylib") 9 | ,(concatenate 'string lib ".dylib"))) 10 | (:unix (:or ,(concatenate 'string lib ".so.5.2.9") 11 | ,(concatenate 'string lib ".so.5.2") 12 | ,(concatenate 'string lib ".so"))) 13 | (t (:default ,(concatenate 'string lib))))) 14 | ;; ;; Example 15 | ;; (macroexpand-1 '(define-allegro-library "liballegro")) 16 | ;; 17 | ;; (DEFINE-FOREIGN-LIBRARY LIBALLEGRO 18 | ;; (:WINDOWS "allegro-5.2.dll") 19 | ;; (:UNIX (:OR "liballegro.so.5.2" "liballegro.so")) 20 | ;; (T (:DEFAULT "liballegro"))) 21 | 22 | 23 | (define-allegro-library "liballegro") 24 | (use-foreign-library liballegro) 25 | 26 | (define-allegro-library "liballegro_acodec") 27 | (use-foreign-library liballegro_acodec) 28 | 29 | (define-allegro-library "liballegro_audio") 30 | (use-foreign-library liballegro_audio) 31 | 32 | (define-allegro-library "liballegro_color") 33 | (use-foreign-library liballegro_color) 34 | 35 | (define-allegro-library "liballegro_dialog") 36 | (use-foreign-library liballegro_dialog) 37 | 38 | (define-allegro-library "liballegro_font") 39 | (use-foreign-library liballegro_font) 40 | 41 | (define-allegro-library "liballegro_image") 42 | (use-foreign-library liballegro_image) 43 | 44 | (define-allegro-library "liballegro_memfile") 45 | (use-foreign-library liballegro_memfile) 46 | 47 | (define-allegro-library "liballegro_physfs") 48 | (handler-case (use-foreign-library liballegro_physfs) 49 | (error (condition) (print "physfs library not found") condition)) 50 | 51 | (define-allegro-library "liballegro_primitives") 52 | (use-foreign-library liballegro_primitives) 53 | 54 | (define-allegro-library "liballegro_ttf") 55 | (use-foreign-library liballegro_ttf) 56 | 57 | (define-allegro-library "liballegro_video") 58 | (handler-case (use-foreign-library liballegro_video) 59 | (error (condition) (print "Video Addon Available only in versions >=5.1.0") condition)) 60 | -------------------------------------------------------------------------------- /src/types/addons/audio.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-liballegro) 2 | 3 | (defcstruct mixer) 4 | (defcstruct audio-stream) 5 | (defcstruct voice) 6 | -------------------------------------------------------------------------------- /src/types/addons/font.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-liballegro) 2 | 3 | (defcstruct font) 4 | -------------------------------------------------------------------------------- /src/types/addons/native-dialogs.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-liballegro) 2 | 3 | (defcstruct filechooser) 4 | (defcstruct textlog) 5 | -------------------------------------------------------------------------------- /src/types/events.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:cl-liballegro) 2 | 3 | (defctype event-type event-types) 4 | 5 | (defcstruct any-event 6 | (type event-type) (source :pointer) (timestamp :double)) 7 | (defcstruct display-event 8 | (type event-type) (source :pointer) (timestamp :double) 9 | (x :int) 10 | (y :int) 11 | (width :int) 12 | (height :int) 13 | (orientation :int)) 14 | (defcstruct joystick-event 15 | (type event-type) (source :pointer) (timestamp :double) 16 | (id :pointer) 17 | (stick :int) 18 | (axis :int) 19 | (pos :float) 20 | (button :int)) 21 | (defcstruct keyboard-event 22 | (type event-type) (source :pointer) (timestamp :double) 23 | (display :pointer) 24 | (keycode keycodes) 25 | (unichar :int) 26 | (modifiers keymods) 27 | (repeat :boolean)) 28 | (defcstruct mouse-event 29 | (type event-type) (source :pointer) (timestamp :double) 30 | (display :pointer) 31 | (x :int) 32 | (y :int) 33 | (z :int) 34 | (w :int) 35 | (dx :int) 36 | (dy :int) 37 | (dz :int) 38 | (dw :int) 39 | (button :uint) 40 | (pressure :float)) 41 | (defcstruct timer-event 42 | (type event-type) (source :pointer) (timestamp :double) 43 | (count :int64) 44 | (error :double)) 45 | (defcstruct touch-event 46 | (type event-type) (source :pointer) (timestamp :double) 47 | (display :pointer) 48 | (id :int) 49 | (x :int) 50 | (y :int) 51 | (dx :int) 52 | (dy :int) 53 | (primary :bool)) 54 | (defcstruct user-event 55 | (type event-type) (source :pointer) (timestamp :double) 56 | (--internal--descr :pointer) 57 | (data1 (:pointer :int)) 58 | (data2 (:pointer :int)) 59 | (data3 (:pointer :int)) 60 | (data4 (:pointer :int))) 61 | (defcstruct audio-recorder-event 62 | (type event-type) (source :pointer) (timestamp :double) 63 | (--internal--desc :pointer) 64 | (buffer :pointer) 65 | (samples :uint)) 66 | (defcunion event 67 | (type event-type) 68 | (any (:struct any-event)) 69 | (display (:struct display-event)) 70 | (joystick (:struct joystick-event)) 71 | (keyboard (:struct keyboard-event)) 72 | (mouse (:struct mouse-event)) 73 | (timer (:struct timer-event)) 74 | (touch (:struct touch-event)) 75 | (user (:struct user-event)) 76 | (audio-record-event (:struct audio-recorder-event))) 77 | 78 | (defcstruct (event-source :size 128)) 79 | (defcstruct event-queue) 80 | 81 | (defmacro with-event (event &body body) 82 | `(with-foreign-object (,event '(:union event)) 83 | ,@body)) 84 | 85 | (defun %foreign-slot-spec (requested-slots all-slots) 86 | (if requested-slots 87 | (loop :for slot :in requested-slots 88 | :collecting 89 | (etypecase slot 90 | (symbol 91 | `(,slot ,(intern (string slot) :cl-liballegro))) 92 | (cons 93 | (destructuring-bind (variable-name slot-name) slot 94 | `(,variable-name 95 | ,(intern (string slot-name) :cl-liballegro)))))) 96 | (mapcar 97 | (lambda (slot) 98 | `(,(intern (string slot) *package*) ,slot)) 99 | all-slots))) 100 | 101 | (defmacro with-event-slots ((&rest slots) event &body body) 102 | `(with-foreign-slots 103 | (,(%foreign-slot-spec slots '(type source timestamp)) 104 | ,event (:struct any-event)) 105 | ,@body)) 106 | 107 | (defmacro with-display-event-slots ((&rest slots) event &body body) 108 | `(with-foreign-slots 109 | (,(%foreign-slot-spec slots '(x y width height orientation)) 110 | ,event (:struct display-event)) 111 | ,@body)) 112 | 113 | (defmacro with-joystick-event-slots ((&rest slots) event &body body) 114 | `(with-foreign-slots 115 | (,(%foreign-slot-spec slots '(id stick axis pos button)) 116 | ,event (:struct joystick-event)) 117 | ,@body)) 118 | 119 | (defmacro with-keyboard-event-slots ((&rest slots) event &body body) 120 | `(with-foreign-slots 121 | (,(%foreign-slot-spec slots '(display keycode unichar modifiers repeat)) 122 | ,event (:struct keyboard-event)) 123 | ,@body)) 124 | 125 | (defmacro with-mouse-event-slots ((&rest slots) event &body body) 126 | `(with-foreign-slots 127 | (,(%foreign-slot-spec slots '(x y z w dx dy dz dw button pressure)) 128 | ,event (:struct mouse-event)) 129 | ,@body)) 130 | 131 | (defmacro with-timer-event-slots ((&rest slots) event &body body) 132 | `(with-foreign-slots 133 | (,(%foreign-slot-spec slots '(count error)) 134 | ,event (:struct timer-event)) 135 | ,@body)) 136 | 137 | (defmacro with-touch-event-slots ((&rest slots) event &body body) 138 | `(with-foreign-slots 139 | (,(%foreign-slot-spec slots '(display id x y dx dy primary)) 140 | ,event (:struct touch-event)) 141 | ,@body)) 142 | 143 | (defmacro with-user-event-slots ((&rest slots) event &body body) 144 | `(with-foreign-slots 145 | (,(%foreign-slot-spec slots '(data1 data2 data3 data4)) 146 | ,event (:struct user-event)) 147 | ,@body)) 148 | 149 | (defmacro with-audio-recorder-event-slots ((&rest slots) event &body body) 150 | `(with-foreign-slots 151 | (,(%foreign-slot-spec slots '(buffer samples)) 152 | ,event (:struct audio-recorder-event)) 153 | ,@body)) 154 | -------------------------------------------------------------------------------- /src/types/file-io.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:cl-liballegro) 2 | 3 | (defcstruct file) 4 | (defcstruct file-interface) 5 | -------------------------------------------------------------------------------- /src/types/filesystem.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:cl-liballegro) 2 | 3 | (defcstruct fs-entry) 4 | 5 | ;; Alternatic filesystem functions 6 | (defcstruct fs-interface 7 | (fs-create-entry :pointer) 8 | (fs-destroy-entry :pointer) 9 | (fs-entry-name :pointer) 10 | (fs-update-entry :pointer) 11 | (fs-entry-mode :pointer) 12 | (fs-entry-atime :pointer) 13 | (fs-entry-mtime :pointer) 14 | (fs-entry-ctime :pointer) 15 | (fs-entry-size :pointer) 16 | (fs-entry-exists :pointer) 17 | (fs-remove-entry :pointer) 18 | (fs-open-directory :pointer) 19 | (fs-read-directory :pointer) 20 | (fs-close-directory :pointer) 21 | (fs-filename-exists :pointer) 22 | (fs-remove-filename :pointer) 23 | (fs-get-current-directory :pointer) 24 | (fs-change-directory :pointer) 25 | (fs-make-directory :pointer) 26 | (fs-open-file :pointer)) 27 | -------------------------------------------------------------------------------- /src/types/fixed-point-math.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:cl-liballegro) 2 | 3 | (defctype fixed :int32) 4 | -------------------------------------------------------------------------------- /src/types/fullscreen-modes.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-liballegro) 2 | 3 | (defcstruct display-mode 4 | (width :int) 5 | (height :int) 6 | (format :int) 7 | (refresh-rate :int)) 8 | -------------------------------------------------------------------------------- /src/types/graphics.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:cl-liballegro) 2 | 3 | ;; Colors 4 | (defcstruct color 5 | (r :float) 6 | (g :float) 7 | (b :float) 8 | (a :float)) 9 | 10 | ;; Locking and Pixel Formats 11 | (defcstruct locked-region 12 | (data :pointer) 13 | (format :int) 14 | (pitch :int) 15 | (pixel-size :int)) 16 | 17 | ;; Bitmap Creation 18 | (defcstruct bitmap 19 | (vt :pointer) 20 | (display :pointer) 21 | (format :int) 22 | (flags :int) 23 | (w :int) 24 | (h :int) 25 | (pitch :int) 26 | (cl :int) 27 | (cr-excl :int) 28 | (ct :int) 29 | (cb-excl :int) 30 | (locked :boolean) 31 | (lock-x :int) 32 | (lock-y :int) 33 | (lock-w :int) 34 | (lock-h :int) 35 | (lock-flags :int) 36 | ;(locked-region locked-region) 37 | ;(transform transform) 38 | (parent :pointer) 39 | (xofs :int) 40 | (yofs :int) 41 | (memory :pointer) 42 | (size :uint) 43 | (preserve-texture :boolean)) 44 | 45 | -------------------------------------------------------------------------------- /src/types/haptic.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:cl-liballegro) 2 | 3 | (defcstruct haptic) 4 | 5 | (defcstruct haptic-direction 6 | (angle :double) 7 | (radius :double) 8 | (azimuth :double)) 9 | (defcstruct haptic-replay 10 | (length :double) 11 | (delay :double)) 12 | (defcstruct haptic-envelope 13 | (attack-length :double) 14 | (attack-level :double) 15 | (fade-length :double) 16 | (fade-level :double)) 17 | 18 | (defcstruct haptic-constant-effect 19 | (level :double) 20 | (envelope (:struct haptic-envelope))) 21 | (defcstruct haptic-ramp-effect 22 | (start-level :double) 23 | (end-level :double) 24 | (envelope (:struct haptic-envelope))) 25 | (defcstruct haptic-condition-effect 26 | (right-saturation :double) 27 | (left-saturation :double) 28 | (right-coeff :double) 29 | (left-coeff :double) 30 | (deadband :double) 31 | (center :double)) 32 | (defcstruct haptic-periodic-effect 33 | (waveform :int) 34 | (period :double) 35 | (magnitude :double) 36 | (offset :double) 37 | (phase :double) 38 | 39 | (envelope (:struct haptic-envelope)) 40 | (custom-len :int) 41 | (custom-data (:pointer :double))) 42 | (defcstruct haptic-rumble-effect 43 | (strong-magnitude :double) 44 | (weak-magnitude :double)) 45 | (defcunion haptic-effect-union 46 | (constant (:struct haptic-constant-effect)) 47 | (ramp (:struct haptic-ramp-effect)) 48 | (periodic (:struct haptic-periodic-effect)) 49 | (condition (:struct haptic-condition-effect)) 50 | (rumble (:struct haptic-rumble-effect))) 51 | 52 | (defcstruct haptic-effect 53 | (type :int) 54 | (direction (:struct haptic-direction)) 55 | (replay (:struct haptic-replay)) 56 | (data (:union haptic-effect-union))) 57 | (defcstruct haptic-effect-id 58 | (-haptic :pointer) 59 | (-id :int) 60 | (-handle :int) 61 | (-pointer :pointer) 62 | (-effect-duration :double) 63 | (-playing :bool) 64 | (-start-time :double) 65 | (-end-time :double) 66 | (driver :pointer)) 67 | -------------------------------------------------------------------------------- /src/types/joystick.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:cl-liballegro) 2 | 3 | (defcstruct joystick) 4 | (defcstruct joystick-state) 5 | -------------------------------------------------------------------------------- /src/types/keyboard.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-liballegro) 2 | 3 | (defcstruct keyboard-state 4 | (display :pointer) 5 | (--key-down--internal-- 6 | :uint :count #.(floor (/ (+ (foreign-enum-value 'keycodes :key-max) 31) 7 | 32)))) 8 | 9 | (defmacro with-keyboard-state (state &body body) 10 | `(with-foreign-object (,state '(:struct keyboard-state)) 11 | ,@body)) 12 | 13 | (defmacro with-current-keyboard-state (state &body body) 14 | `(with-keyboard-state ,state 15 | (al:get-keyboard-state ,state) 16 | ,@body)) 17 | -------------------------------------------------------------------------------- /src/types/memory.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:cl-liballegro) 2 | 3 | (defcstruct memory-interface 4 | (mi-alloc :pointer) 5 | (mi-free :pointer) 6 | (mi-realloc :pointer) 7 | (mi-calloc :pointer)) 8 | -------------------------------------------------------------------------------- /src/types/monitor.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-liballegro) 2 | 3 | (defcstruct monitor-info 4 | (x1 :int) 5 | (y1 :int) 6 | (x2 :int) 7 | (y2 :int)) 8 | -------------------------------------------------------------------------------- /src/types/mouse.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-liballegro) 2 | 3 | (defcstruct mouse-state 4 | (x :int) 5 | (y :int) 6 | (z :int) 7 | (w :int) 8 | (more-axis :int :count #.+mouse-max-extra-axes+) 9 | (buttons :int) 10 | (pressure :float) 11 | (display :pointer)) 12 | 13 | (defmacro with-mouse-state (state &body body) 14 | `(with-foreign-object (,state '(:struct mouse-state)) 15 | ,@body)) 16 | 17 | (defmacro with-current-mouse-state (state &body body) 18 | `(with-mouse-state ,state 19 | (al:get-mouse-state ,state) 20 | ,@body)) 21 | 22 | (defmacro with-mouse-state-slots ((&rest slots) state &body body) 23 | `(with-foreign-slots 24 | (,(%foreign-slot-spec 25 | slots '(x y z w more-axis buttons pressure display)) 26 | ,state (:struct mouse-state)) 27 | ,@body)) 28 | -------------------------------------------------------------------------------- /src/types/shader.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:cl-liballegro) 2 | 3 | (defcstruct shader) 4 | -------------------------------------------------------------------------------- /src/types/state.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-liballegro) 2 | 3 | (defcstruct state) 4 | -------------------------------------------------------------------------------- /src/types/threads.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:cl-liballegro) 2 | 3 | (defcstruct thread) 4 | (defcstruct mutex) 5 | (defcstruct thread-condition) 6 | -------------------------------------------------------------------------------- /src/types/time.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-liballegro) 2 | 3 | (defcstruct timeout) 4 | -------------------------------------------------------------------------------- /src/types/timer.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-liballegro) 2 | 3 | (defcstruct timer) 4 | -------------------------------------------------------------------------------- /src/types/touch-input.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:cl-liballegro) 2 | 3 | (defcstruct touch-input) 4 | (defcstruct touch-state 5 | (id :int) 6 | (x :float) 7 | (y :float) 8 | (dx :float) 9 | (dy :float) 10 | (primary :bool) 11 | (display :pointer)) 12 | (defcstruct touch-input-state 13 | (touches (:struct touch-state) :count #.+touch-input-max-touch-count+)) 14 | -------------------------------------------------------------------------------- /src/types/transformations.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-liballegro) 2 | 3 | (defcstruct transform 4 | (m (:pointer :float))) 5 | -------------------------------------------------------------------------------- /src/types/types.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:cl-liballegro) 2 | 3 | ;;; Default 4 | (define-foreign-type c-float () 5 | () 6 | (:actual-type :float) 7 | (:simple-parser c-float)) 8 | (defmethod translate-to-foreign (value (type c-float)) (float value 0f0)) 9 | (defmethod translate-into-foreign-memory (value (type c-float) pointer) 10 | (translate-into-foreign-memory (translate-to-foreign value type) 11 | (make-instance 'cffi::foreign-built-in-type 12 | :type-keyword :float) 13 | pointer)) 14 | 15 | (define-foreign-type c-double () 16 | () 17 | (:actual-type :double) 18 | (:simple-parser c-double)) 19 | (defmethod translate-to-foreign (value (type c-double)) (float value 0d0)) 20 | (defmethod translate-into-foreign-memory (value (type c-double) pointer) 21 | (translate-into-foreign-memory (translate-to-foreign value type) 22 | (make-instance 'cffi::foreign-built-in-type 23 | :type-keyword :double) 24 | pointer)) 25 | 26 | (define-foreign-type c-int () 27 | () 28 | (:actual-type :int) 29 | (:simple-parser c-int)) 30 | (defmethod translate-to-foreign (value (type c-int)) (truncate value)) 31 | (defmethod translate-into-foreign-memory (value (type c-int) pointer) 32 | (translate-into-foreign-memory (translate-to-foreign value type) 33 | (make-instance 'cffi::foreign-built-in-type 34 | :type-keyword :int) 35 | pointer)) 36 | 37 | (define-foreign-type c-ptr () 38 | () 39 | (:actual-type :pointer) 40 | (:simple-parser c-ptr)) 41 | (defmethod translate-to-foreign (value (type c-ptr)) 42 | (if (or (eql value 0) (eq value nil)) 43 | (null-pointer) 44 | value)) 45 | (defmethod translate-into-foreign-memory (value (type c-ptr) pointer) 46 | (translate-into-foreign-memory (translate-to-foreign value type) 47 | (make-instance 'cffi::foreign-built-in-type 48 | :type-keyword :pointer) 49 | pointer)) 50 | 51 | (defctype time_t :long) 52 | (defctype off_t :int) 53 | -------------------------------------------------------------------------------- /src/types/utf-8.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:cl-liballegro) 2 | 3 | (defcstruct ustr) 4 | (defcstruct ustr-info) 5 | --------------------------------------------------------------------------------