├── .cproject ├── .gitignore ├── .project ├── dev-log.org ├── dev.org ├── docs ├── imgui.org ├── ns-doc.el ├── ns-doc.md ├── s7.org └── scheme-cpp-ffi.org ├── examples ├── audio_player.scm ├── ex_audio_player.cpp ├── ex_imgui.cpp ├── ex_tcp_server.cpp ├── meson.build ├── nng-tcp-socket.c ├── s7-repl.cpp ├── scheme │ ├── cload.scm │ ├── hi.scm │ ├── libc.scm │ ├── libdl.scm │ └── repl.scm ├── sdl-net-tcp-socket.c └── sdl_opengl.c ├── img └── youtube-preview.png ├── meson.build ├── readme.org ├── src ├── aod │ ├── colors.cpp │ ├── colors.hpp │ ├── gl │ │ ├── gl.cpp │ │ └── gl.hpp │ ├── img │ │ ├── core.cpp │ │ └── core.hpp │ ├── imgui │ │ ├── addons.cpp │ │ └── addons.hpp │ ├── meson.build │ ├── midi │ │ ├── midi.cpp │ │ └── midi.hpp │ ├── nfd.cpp │ ├── nfd.hpp │ ├── path.hpp │ ├── s7.cpp │ ├── s7.hpp │ ├── s7 │ │ ├── colors.cpp │ │ ├── colors.hpp │ │ ├── foreign_primitives.cpp │ │ ├── foreign_primitives.hpp │ │ ├── foreign_primitives_arr.cpp │ │ ├── foreign_primitives_arr.hpp │ │ ├── foreign_types.org │ │ ├── gl.cpp │ │ ├── gl.hpp │ │ ├── img.cpp │ │ ├── img.hpp │ │ ├── imgui │ │ │ ├── addons.cpp │ │ │ ├── addons.hpp │ │ │ ├── enums.cpp │ │ │ ├── enums.hpp │ │ │ ├── imgui.cpp │ │ │ └── imgui.hpp │ │ ├── imgui_sdl.cpp │ │ ├── imgui_sdl.hpp │ │ ├── midi.cpp │ │ ├── midi.hpp │ │ ├── nfd.cpp │ │ ├── nfd.hpp │ │ ├── repl.cpp │ │ ├── repl.hpp │ │ ├── sdl.cpp │ │ └── sdl.hpp │ ├── sdl.cpp │ ├── sdl.hpp │ ├── sdl │ │ ├── audio.cpp │ │ └── audio.hpp │ └── tcp_server.hpp ├── gui_repl.cpp ├── lib │ ├── meson.build │ └── stb │ │ ├── stb.c │ │ ├── stb_image.h │ │ └── stb_image_write.h ├── main.cpp ├── meson.build ├── repl.cpp └── scheme │ ├── aod │ ├── autoloads.scm │ ├── benchmark.scm │ ├── clj.scm │ ├── colors.scm │ ├── components │ │ ├── input.scm │ │ ├── piano-wheel.scm │ │ └── sxs-wheel.scm │ ├── core.scm │ ├── geom.scm │ ├── imgui │ │ ├── helpers.scm │ │ └── macros.scm │ ├── imgui_macros.scm │ ├── io.scm │ ├── layout.scm │ ├── midi.scm │ ├── ns.scm │ ├── scales.scm │ ├── string.scm │ ├── sxs.scm │ └── test.scm │ ├── examples │ ├── text-editor.scm │ └── text-input.scm │ ├── fib.scm │ ├── hello.scm │ ├── imgui_scratch.scm │ ├── main.scm │ ├── main_2020-07-02.scm │ ├── ns-bar.scm │ ├── ns-bar2.scm │ ├── s7 │ ├── .gitignore │ ├── cload.scm │ ├── debug.scm │ ├── libc.scm │ ├── r7rs.scm │ └── s7.h │ ├── scratch.scm │ ├── test │ ├── c_foreign_test.scm │ ├── ns_test.scm │ └── partial_test.scm │ ├── todo_r7rs.scm │ └── user.scm ├── subprojects ├── gtest.wrap ├── imgui.wrap ├── nfd.wrap ├── nng.wrap ├── s7.wrap ├── sdl2.wrap ├── sdl_net.wrap └── socket-cpp.wrap └── test ├── aod ├── colors_test.cpp ├── img_test.cpp └── s7 │ ├── environments_test.cpp │ ├── ffi_test_raw.cpp │ ├── foreign_primitives_arr_test.cpp │ ├── foreign_primitives_test.cpp │ └── repl_test.cpp ├── meson.build └── scheme ├── assets ├── .gitignore ├── sxs-wheel-highlight-048-snapshot.png ├── sxs-wheel-offset.png └── sxs-wheel-snapshot.png ├── gen-doc.scm ├── test-all.scm ├── test-benchmark.scm └── test-core.scm /.cproject: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | imgui.ini 2 | build*/ 3 | .wg/ 4 | subprojects/* 5 | !subprojects/*.wrap 6 | .settings/ 7 | 8 | # kdevelop files 9 | *.kdev4 10 | *.kate-swp 11 | -------------------------------------------------------------------------------- /.project: -------------------------------------------------------------------------------- 1 | 2 | 3 | s7-imgui 4 | 5 | 6 | 7 | 8 | 9 | org.eclipse.cdt.core.cBuilder 10 | clean,full,incremental, 11 | 12 | 13 | 14 | 15 | 16 | org.eclipse.cdt.meson.core.mesonNature 17 | org.eclipse.cdt.core.cnature 18 | org.eclipse.cdt.core.ccnature 19 | 20 | 21 | -------------------------------------------------------------------------------- /docs/ns-doc.el: -------------------------------------------------------------------------------- 1 | ((aod.imgui.macros "Some macros to make life easier while working with ImGui. 2 | The usual syntax is (args . body) 3 | - args are applied to corresponding raw imgui function 4 | - body is executed either in a when block (eg when a menu items is active) 5 | or wrapped between the begin/end calls" (window . "(window args . body) 6 | applies args to imgui/begin, executes body and calls imgui/end") (maximized . "") (child . "") (group . "") (main-menu-bar . "") (menu-bar . "") (menu . "") (menu-item . "") (horizontal . "(horizontal . body) 7 | executes first element of body and then inserts any next element with the same-line called before")) (aod.imgui.helpers "" (draw-circle . "") (draw-arc . "") (draw-lines . "") (frgb->u32 . "")) (aod.c.imgui "ImGui bindings. The majority of the bindings are a one-to-one relationship with the underlying ImGui::foo calls" (begin . "(begin name &optional *bool window-flags) 8 | - name: the name of the window, a scheme string 9 | - *bool: a pointer to bool, from aod.c.foreign. Closing the window modifies the pointer value") (begin-maximized . "(begin-maximized title &optional window-flags) NOT PART OF IMGUI: A convenient way to do a maximized window 10 | window-flags is just one int with bit flags set. There are already plenty set like NoTitleBar, NoResize etc.") (end . "(end)") (spacing . "(spacing)") (text . "(text text) displays a text. the argument is just a scheme string") (label . "(label ...) NOT DONE") (align-text-to-frame-padding . "(align-text-to-frame-padding)") (button . "Button") (small-button . "(small-button text)") (checkbox . "(checkbox label *value) *value is *bool pointer") (begin-menu-bar . "(begin-menu-bar)") (end-menu-bar . "(end-menu-bar)") (begin-main-menu-bar . "(begin-main-menu-bar)") (end-main-menu-bar . "(end-main-menu-bar)") (begin-menu . "(begin-menu label) label could be \"File\" for example") (end-menu . "(end-menu)") (separator . "(separator)") (menu-item . "(menu-item label) TODO add more arguments (&optional shortcut selected)") (same-line . "(same-line) puts the next element in the same line as the previously drawn element") (begin-child . "(begin-child id) (string?)") (end-child . "(end-child)") (begin-group . "(begin-group)") (end-group . "(end-group)") (dummy . "(dummy width height)") (draw-circle . "(draw-circle cx cy r col &optional segments thickness)") (draw-arc . "(cx cy r a-min a-max col &optional segments thickness)") (draw-circle-filled . "(cx cy r col &optional segments)") (draw-line . "(x1 y1 x2 y2 col &optional thickness)") (draw-text . "(x y text color)") (color32 . "(color32 r g b &optional alpha) input ranging from 0 to 255 11 | Returns a u32 representation of the color 0xRRGGBBAA") (set-color . "(set-color color-index color-u32)") (color-edit-3 . "(color-edit-3 label *values) *values: aod.c.foreign float[] array") (slider-float . "(slider-float label *value min max &optional (format \"%.3f\"))") (slider-int . "(label *value min max) value: *int pointer from aod.c.foreign/new-int") (input-text . "(input-text label *buffer buffer-size) *buffer is c-pointer to *char from aod.c.foreign/new-char[]") (input-text-multiline . "(input-text-multiline label *buffer buffer-size) *buffer is c-pointer to char* from aod.c.foreign/new-char[]") (combo . "(combo name *index labels) 12 | - *index as returned from aod.c.foreign/new-int 13 | - labels is a 0 separated string. eg \"labelA\\0labelB\\0\\0\"") (is-item-deactivated-after-edit . "IsItemDeactivatedAfterEdit") (is-item-deactivated . "IsItemDeactivated") (set-item-default-focus . "SetItemDefaultFocus") (is-item-focused . "IsItemFocused") (set-keyboard-focus-here . "SetKeyboardFocusHere (&optional offset) 14 | focus keyboard on the next widget. Use positive 'offset' to access sub components of a multiple component widget. Use -1 to access previous widget")) (aod.c.imgui.window-flags "One-to-one relation between ImGuiWindowFlags_* int values. 15 | To use perform bitwise-or and pass the imgui begin as window flags" (None . "") (NoTitleBar . "") (NoResize . "") (NoMove . "") (NoScrollbar . "") (NoScrollWithMouse . "") (NoCollapse . "") (AlwaysAutoResize . "") (NoBackground . "") (NoSavedSettings . "") (NoMouseInputs . "") (MenuBar . "") (HorizontalScrollbar . "") (NoFocusOnAppearing . "") (NoBringToFrontOnFocus . "") (AlwaysVerticalScrollbar . "") (AlwaysHorizontalScrollbar . "") (AlwaysUseWindowPadding . "") (NoNavInputs . "") (NoNavFocus . "") (UnsavedDocument . "") (NoNav . "") (NoDecoration . "") (NoInputs . "")) (aod.c.foreign "Provides a way to create heap allocated primitives like int* float*, int* array, char* array etc. For example, to create a c string call `(new-char[] size)`" (type-bool . "") (new-bool . "creates a heap allocated bool (c-object)") (type-int . "") (new-int . "creates a heap allocated int (c-object)") (type-float . "") (new-float . "creates a heap allocated float (c-object)") (type-bool[] . "") (new-bool[] . "creates a heap allocated bool[] (c-object)") (type-int[] . "") (new-int[] . "creates a heap allocated int[] (c-object)") (type-float[] . "") (new-float[] . "creates a heap allocated float[] (c-object)") (type-char[] . "") (new-char[] . "creates a heap allocated char[] (c-object)")) (aod.c.gl "" (save-screenshot . "(save-screenshot filename) Saves a screenshot of the current gl context")) (aod.c.nfd "Some [nativefiledialog](https://github.com/mlabbe/nativefiledialog) bindings " (open . "(open) Open file dialog. Returns either the selected filename or #f") (save . "(save) Save file dialog. Returns either the selected target filename or #f")) (aod.c.imgui-sdl "Bindings to manually create an SDL_Window and draw to it with imgui. This is to use directly from a simple repl. 16 | ie when no (draw) function is to be called by anyone." (setup . "(setup width height) returns *window 17 | Creates a new SDL_Window, setups opengl, inits imgui") (prepare . "(prepare void*) To be called before calling any ImGui draw functionality") (flush . "(flush void*) To be called after having called any ImGui draw functionality. Paints the window") (destroy . "(destroy *window) Destroys the window & the opengl context")) (aod.c.midi "" (note-on? . "(note-on? status data1 data2)") (note-off? . "(note-off? status data1 data2)") (note-number . "(note-number status data1 data2) Returns either the note or -1"))) -------------------------------------------------------------------------------- /docs/ns-doc.md: -------------------------------------------------------------------------------- 1 | # `aod.imgui.macros` 2 | Some macros to make life easier while working with ImGui. 3 | The usual syntax is (args . body) 4 | - args are applied to corresponding raw imgui function 5 | - body is executed either in a when block (eg when a menu items is active) 6 | or wrapped between the begin/end calls 7 | ## window 8 | (window args . body) 9 | applies args to imgui/begin, executes body and calls imgui/end 10 | ## maximized 11 | 12 | ## child 13 | 14 | ## group 15 | 16 | ## main-menu-bar 17 | 18 | ## menu-bar 19 | 20 | ## menu 21 | 22 | ## menu-item 23 | 24 | ## horizontal 25 | (horizontal . body) 26 | executes first element of body and then inserts any next element with the same-line called before 27 | # `aod.imgui.helpers` 28 | 29 | ## draw-circle 30 | 31 | ## draw-arc 32 | 33 | ## draw-lines 34 | 35 | ## frgb->u32 36 | 37 | # `aod.c.imgui` 38 | ImGui bindings. The majority of the bindings are a one-to-one relationship with the underlying ImGui::foo calls 39 | ## begin 40 | (begin name &optional *bool window-flags) 41 | - name: the name of the window, a scheme string 42 | - *bool: a pointer to bool, from aod.c.foreign. Closing the window modifies the pointer value 43 | ## begin-maximized 44 | (begin-maximized title &optional window-flags) NOT PART OF IMGUI: A convenient way to do a maximized window 45 | window-flags is just one int with bit flags set. There are already plenty set like NoTitleBar, NoResize etc. 46 | ## end 47 | (end) 48 | ## spacing 49 | (spacing) 50 | ## text 51 | (text text) displays a text. the argument is just a scheme string 52 | ## label 53 | (label ...) NOT DONE 54 | ## align-text-to-frame-padding 55 | (align-text-to-frame-padding) 56 | ## button 57 | Button 58 | ## small-button 59 | (small-button text) 60 | ## checkbox 61 | (checkbox label *value) *value is *bool pointer 62 | ## begin-menu-bar 63 | (begin-menu-bar) 64 | ## end-menu-bar 65 | (end-menu-bar) 66 | ## begin-main-menu-bar 67 | (begin-main-menu-bar) 68 | ## end-main-menu-bar 69 | (end-main-menu-bar) 70 | ## begin-menu 71 | (begin-menu label) label could be "File" for example 72 | ## end-menu 73 | (end-menu) 74 | ## separator 75 | (separator) 76 | ## menu-item 77 | (menu-item label) TODO add more arguments (&optional shortcut selected) 78 | ## same-line 79 | (same-line) puts the next element in the same line as the previously drawn element 80 | ## begin-child 81 | (begin-child id) (string?) 82 | ## end-child 83 | (end-child) 84 | ## begin-group 85 | (begin-group) 86 | ## end-group 87 | (end-group) 88 | ## dummy 89 | (dummy width height) 90 | ## draw-circle 91 | (draw-circle cx cy r col &optional segments thickness) 92 | ## draw-arc 93 | (cx cy r a-min a-max col &optional segments thickness) 94 | ## draw-circle-filled 95 | (cx cy r col &optional segments) 96 | ## draw-line 97 | (x1 y1 x2 y2 col &optional thickness) 98 | ## draw-text 99 | (x y text color) 100 | ## color32 101 | (color32 r g b &optional alpha) input ranging from 0 to 255 102 | Returns a u32 representation of the color 0xRRGGBBAA 103 | ## set-color 104 | (set-color color-index color-u32) 105 | ## color-edit-3 106 | (color-edit-3 label *values) *values: aod.c.foreign float[] array 107 | ## slider-float 108 | (slider-float label *value min max &optional (format "%.3f")) 109 | ## slider-int 110 | (label *value min max) value: *int pointer from aod.c.foreign/new-int 111 | ## input-text 112 | (input-text label *buffer buffer-size) *buffer is c-pointer to *char from aod.c.foreign/new-char[] 113 | ## input-text-multiline 114 | (input-text-multiline label *buffer buffer-size) *buffer is c-pointer to char* from aod.c.foreign/new-char[] 115 | ## combo 116 | (combo name *index labels) 117 | - *index as returned from aod.c.foreign/new-int 118 | - labels is a 0 separated string. eg "labelA\0labelB\0\0" 119 | ## is-item-deactivated-after-edit 120 | IsItemDeactivatedAfterEdit 121 | ## is-item-deactivated 122 | IsItemDeactivated 123 | ## set-item-default-focus 124 | SetItemDefaultFocus 125 | ## is-item-focused 126 | IsItemFocused 127 | ## set-keyboard-focus-here 128 | SetKeyboardFocusHere (&optional offset) 129 | focus keyboard on the next widget. Use positive 'offset' to access sub components of a multiple component widget. Use -1 to access previous widget 130 | # `aod.c.imgui.window-flags` 131 | One-to-one relation between ImGuiWindowFlags_* int values. 132 | To use perform bitwise-or and pass the imgui begin as window flags 133 | ## None 134 | 135 | ## NoTitleBar 136 | 137 | ## NoResize 138 | 139 | ## NoMove 140 | 141 | ## NoScrollbar 142 | 143 | ## NoScrollWithMouse 144 | 145 | ## NoCollapse 146 | 147 | ## AlwaysAutoResize 148 | 149 | ## NoBackground 150 | 151 | ## NoSavedSettings 152 | 153 | ## NoMouseInputs 154 | 155 | ## MenuBar 156 | 157 | ## HorizontalScrollbar 158 | 159 | ## NoFocusOnAppearing 160 | 161 | ## NoBringToFrontOnFocus 162 | 163 | ## AlwaysVerticalScrollbar 164 | 165 | ## AlwaysHorizontalScrollbar 166 | 167 | ## AlwaysUseWindowPadding 168 | 169 | ## NoNavInputs 170 | 171 | ## NoNavFocus 172 | 173 | ## UnsavedDocument 174 | 175 | ## NoNav 176 | 177 | ## NoDecoration 178 | 179 | ## NoInputs 180 | 181 | # `aod.c.foreign` 182 | Provides a way to create heap allocated primitives like int* float*, int* array, char* array etc. For example, to create a c string call `(new-char[] size)` 183 | ## type-bool 184 | 185 | ## new-bool 186 | creates a heap allocated bool (c-object) 187 | ## type-int 188 | 189 | ## new-int 190 | creates a heap allocated int (c-object) 191 | ## type-float 192 | 193 | ## new-float 194 | creates a heap allocated float (c-object) 195 | ## type-bool[] 196 | 197 | ## new-bool[] 198 | creates a heap allocated bool[] (c-object) 199 | ## type-int[] 200 | 201 | ## new-int[] 202 | creates a heap allocated int[] (c-object) 203 | ## type-float[] 204 | 205 | ## new-float[] 206 | creates a heap allocated float[] (c-object) 207 | ## type-char[] 208 | 209 | ## new-char[] 210 | creates a heap allocated char[] (c-object) 211 | # `aod.c.gl` 212 | 213 | ## save-screenshot 214 | (save-screenshot filename) Saves a screenshot of the current gl context 215 | # `aod.c.nfd` 216 | Some [nativefiledialog](https://github.com/mlabbe/nativefiledialog) bindings 217 | ## open 218 | (open) Open file dialog. Returns either the selected filename or #f 219 | ## save 220 | (save) Save file dialog. Returns either the selected target filename or #f 221 | # `aod.c.imgui-sdl` 222 | Bindings to manually create an SDL_Window and draw to it with imgui. This is to use directly from a simple repl. 223 | ie when no (draw) function is to be called by anyone. 224 | ## setup 225 | (setup width height) returns *window 226 | Creates a new SDL_Window, setups opengl, inits imgui 227 | ## prepare 228 | (prepare void*) To be called before calling any ImGui draw functionality 229 | ## flush 230 | (flush void*) To be called after having called any ImGui draw functionality. Paints the window 231 | ## destroy 232 | (destroy *window) Destroys the window & the opengl context 233 | # `aod.c.midi` 234 | 235 | ## note-on? 236 | (note-on? status data1 data2) 237 | ## note-off? 238 | (note-off? status data1 data2) 239 | ## note-number 240 | (note-number status data1 data2) Returns either the note or -1 241 | -------------------------------------------------------------------------------- /docs/scheme-cpp-ffi.org: -------------------------------------------------------------------------------- 1 | * Primitives (bool*, int*, bool[], int[], etc..) 2 | See [[file:../src/aod/s7/foreign_types.org]] and the generated =hpp= and =cpp= files 3 | 4 | These primitives are available in the =aod.c.foreign= named evnironment. 5 | 6 | Example usage: 7 | 8 | #+BEGIN_SRC scheme 9 | (define *some-float ((aod.c.foreign 'new-float) 10)) 10 | (*some-float) 11 | ;; => 10 12 | (set! (*some-float) 20) 13 | (*some-float) 14 | ;; => 20 15 | #+END_SRC 16 | 17 | For arrays: 18 | 19 | #+BEGIN_SRC scheme 20 | (define *some-floats ((aod.c.foreign 'new-float[]) 2)) 21 | (*some-floats 0) 22 | ;; => 0 23 | (*some-floats 1) 24 | ;; => 0 25 | (set! (*some-floats 0) 10) 26 | (*some-floats 0) 27 | ;; => 10 28 | (*some-floats 1) 29 | ;; => 0 30 | 31 | 32 | ;; another trick.. getting the reference of an index 33 | ;; this is by sending an extra param. it doesn't matter the value 34 | ;; a personal style preference is '& to denote that we take the address 35 | ;; so, yes, the following statements are equievalent 36 | (define *some-float (*some-floats 0 'yes-reference-please)) 37 | (define *some-float (*some-floats 0 '&)) 38 | 39 | ;; and it's the same as before 40 | (*some-float) 41 | ;; => 10 42 | (set! (*some-float) 20) 43 | (*some-float) 44 | ;; => 20 45 | 46 | #+END_SRC 47 | -------------------------------------------------------------------------------- /examples/audio_player.scm: -------------------------------------------------------------------------------- 1 | (display "hi from audio player\n") 2 | (require aod.core) 3 | (aod/require aod.imgui.macros :as igm) 4 | (aod/require aod.c.imgui :as ig) 5 | 6 | (define audio-file #f) 7 | 8 | (define (setup) 9 | (sdl/set-window-size! 500 300)) 10 | 11 | (define (draw-menu) 12 | (igm/menu-bar 13 | () 14 | (igm/menu 15 | ("File") 16 | (igm/menu-item ("Open") 17 | (set! audio-file ((*nfd* 'open))))))) 18 | 19 | #; 20 | (format *stderr* "Expanded: ~A\n" (macroexpand (igm/maximized ("test") 21 | (ig/text "hi")))) 22 | 23 | (define (draw) 24 | 25 | (igm/maximized 26 | ("s7 audio") 27 | (draw-menu) 28 | (ig/text (format #f "Audio file: ~A" audio-file)) 29 | (when (ig/button "Play") 30 | (audio/play) 31 | ) 32 | (when (ig/button "Stop") 33 | (audio/stop) 34 | ) 35 | (when (ig/button "Glitch!") 36 | (audio/glitch) 37 | )) 38 | 39 | (igm/window ("test window 2") 40 | ;; no menu flags.. gotta work on the flags thing 41 | '(igm/menu-bar () 42 | (igm/menu ("file"))) 43 | (ig/text "hi there!"))) 44 | -------------------------------------------------------------------------------- /examples/ex_imgui.cpp: -------------------------------------------------------------------------------- 1 | // dear imgui: standalone example application for SDL2 + OpenGL 2 | // If you are new to dear imgui, see examples/README.txt and documentation at the top of imgui.cpp. 3 | // (SDL is a cross-platform general purpose library for handling windows, inputs, OpenGL/Vulkan/Metal graphics context creation, etc.) 4 | 5 | // **DO NOT USE THIS CODE IF YOUR CODE/ENGINE IS USING MODERN OPENGL (SHADERS, VBO, VAO, etc.)** 6 | // **Prefer using the code in the example_sdl_opengl3/ folder** 7 | // See imgui_impl_sdl.cpp for details. 8 | 9 | #include "imgui.h" 10 | #include "imgui_impl_sdl.h" 11 | #include "imgui_impl_opengl2.h" 12 | #include 13 | #include "SDL.h" 14 | #include "SDL_opengl.h" 15 | #include 16 | #include 17 | 18 | // Main code 19 | int main(int, char**) { 20 | char *path = SDL_GetBasePath(); 21 | printf("base path is %s\n", path); 22 | 23 | /* 24 | * Initializing sdl etc 25 | */ 26 | 27 | 28 | 29 | // Setup SDL 30 | // (Some versions of SDL before <2.0.10 appears to have performance/stalling issues on a minority of Windows systems, 31 | // depending on whether SDL_INIT_GAMECONTROLLER is enabled or disabled.. updating to latest version of SDL is recommended!) 32 | if (SDL_Init(SDL_INIT_VIDEO | SDL_INIT_TIMER | SDL_INIT_GAMECONTROLLER) 33 | != 0) { 34 | printf("Error: %s\n", SDL_GetError()); 35 | return -1; 36 | } 37 | 38 | // Setup window 39 | SDL_GL_SetAttribute(SDL_GL_DOUBLEBUFFER, 1); 40 | SDL_GL_SetAttribute(SDL_GL_DEPTH_SIZE, 24); 41 | SDL_GL_SetAttribute(SDL_GL_STENCIL_SIZE, 8); 42 | SDL_GL_SetAttribute(SDL_GL_CONTEXT_MAJOR_VERSION, 2); 43 | SDL_GL_SetAttribute(SDL_GL_CONTEXT_MINOR_VERSION, 2); 44 | SDL_WindowFlags window_flags = (SDL_WindowFlags) (SDL_WINDOW_OPENGL 45 | | SDL_WINDOW_RESIZABLE | SDL_WINDOW_ALLOW_HIGHDPI); 46 | SDL_Window *window = SDL_CreateWindow("Dear ImGui SDL2+OpenGL example", 47 | SDL_WINDOWPOS_CENTERED, SDL_WINDOWPOS_CENTERED, 1280, 720, 48 | window_flags); 49 | SDL_GLContext gl_context = SDL_GL_CreateContext(window); 50 | SDL_GL_MakeCurrent(window, gl_context); 51 | SDL_GL_SetSwapInterval(1); // Enable vsync 52 | 53 | // Setup Dear ImGui context 54 | IMGUI_CHECKVERSION(); 55 | ImGui::CreateContext(); 56 | ImGuiIO &io = ImGui::GetIO(); 57 | (void) io; 58 | //io.ConfigFlags |= ImGuiConfigFlags_NavEnableKeyboard; // Enable Keyboard Controls 59 | //io.ConfigFlags |= ImGuiConfigFlags_NavEnableGamepad; // Enable Gamepad Controls 60 | 61 | // Setup Dear ImGui style 62 | ImGui::StyleColorsDark(); 63 | //ImGui::StyleColorsClassic(); 64 | 65 | // Setup Platform/Renderer bindings 66 | ImGui_ImplSDL2_InitForOpenGL(window, gl_context); 67 | ImGui_ImplOpenGL2_Init(); 68 | 69 | // Load Fonts 70 | // - If no fonts are loaded, dear imgui will use the default font. You can also load multiple fonts and use ImGui::PushFont()/PopFont() to select them. 71 | // - AddFontFromFileTTF() will return the ImFont* so you can store it if you need to select the font among multiple. 72 | // - If the file cannot be loaded, the function will return NULL. Please handle those errors in your application (e.g. use an assertion, or display an error and quit). 73 | // - The fonts will be rasterized at a given size (w/ oversampling) and stored into a texture when calling ImFontAtlas::Build()/GetTexDataAsXXXX(), which ImGui_ImplXXXX_NewFrame below will call. 74 | // - Read 'docs/FONTS.md' for more instructions and details. 75 | // - Remember that in C/C++ if you want to include a backslash \ in a string literal you need to write a double backslash \\ ! 76 | //io.Fonts->AddFontDefault(); 77 | //io.Fonts->AddFontFromFileTTF("../../misc/fonts/Roboto-Medium.ttf", 16.0f); 78 | //io.Fonts->AddFontFromFileTTF("../../misc/fonts/Cousine-Regular.ttf", 15.0f); 79 | //io.Fonts->AddFontFromFileTTF("../../misc/fonts/DroidSans.ttf", 16.0f); 80 | //io.Fonts->AddFontFromFileTTF("../../misc/fonts/ProggyTiny.ttf", 10.0f); 81 | //ImFont* font = io.Fonts->AddFontFromFileTTF("c:\\Windows\\Fonts\\ArialUni.ttf", 18.0f, NULL, io.Fonts->GetGlyphRangesJapanese()); 82 | //IM_ASSERT(font != NULL); 83 | 84 | // Our state 85 | bool show_demo_window = true; 86 | bool show_another_window = false; 87 | ImVec4 clear_color = ImVec4(0.45f, 0.55f, 0.60f, 1.00f); 88 | 89 | // Main loop 90 | bool done = false; 91 | while (!done) { 92 | // Poll and handle events (inputs, window resize, etc.) 93 | // You can read the io.WantCaptureMouse, io.WantCaptureKeyboard flags to tell if dear imgui wants to use your inputs. 94 | // - When io.WantCaptureMouse is true, do not dispatch mouse input data to your main application. 95 | // - When io.WantCaptureKeyboard is true, do not dispatch keyboard input data to your main application. 96 | // Generally you may always pass all inputs to dear imgui, and hide them from your application based on those two flags. 97 | SDL_Event event; 98 | while (SDL_PollEvent(&event)) { 99 | ImGui_ImplSDL2_ProcessEvent(&event); 100 | if (event.type == SDL_QUIT) 101 | done = true; 102 | } 103 | 104 | // Start the Dear ImGui frame 105 | ImGui_ImplOpenGL2_NewFrame(); 106 | ImGui_ImplSDL2_NewFrame(window); 107 | ImGui::NewFrame(); 108 | 109 | // 1. Show the big demo window (Most of the sample code is in ImGui::ShowDemoWindow()! You can browse its code to learn more about Dear ImGui!). 110 | if (show_demo_window) 111 | ImGui::ShowDemoWindow(&show_demo_window); 112 | 113 | // 2. Show a simple window that we create ourselves. We use a Begin/End pair to created a named window. 114 | { 115 | static float f = 0.0f; 116 | static int counter = 0; 117 | 118 | ImGui::Begin("Hello, world!"); // Create a window called "Hello, world!" and append into it. 119 | 120 | ImGui::Text("This is some useful text."); // Display some text (you can use a format strings too) 121 | ImGui::Checkbox("Demo Window", &show_demo_window); // Edit bools storing our window open/close state 122 | ImGui::Checkbox("Another Window", &show_another_window); 123 | 124 | ImGui::SliderFloat("float", &f, 0.0f, 1.0f); // Edit 1 float using a slider from 0.0f to 1.0f 125 | ImGui::ColorEdit3("clear color", (float*) &clear_color); // Edit 3 floats representing a color 126 | 127 | if (ImGui::Button("Button")) // Buttons return true when clicked (most widgets return true when edited/activated) 128 | counter++; 129 | ImGui::SameLine(); 130 | ImGui::Text("counter = %d", counter); 131 | 132 | ImGui::Text("Application average %.3f ms/frame (%.1f FPS)", 133 | 1000.0f / ImGui::GetIO().Framerate, 134 | ImGui::GetIO().Framerate); 135 | ImGui::End(); 136 | } 137 | 138 | // 3. Show another simple window. 139 | if (show_another_window) { 140 | ImGui::Begin("Another Window", &show_another_window); // Pass a pointer to our bool variable (the window will have a closing button that will clear the bool when clicked) 141 | ImGui::Text("Hello from another window!"); 142 | if (ImGui::Button("Close Me")) 143 | show_another_window = false; 144 | ImGui::End(); 145 | } 146 | 147 | // Rendering 148 | ImGui::Render(); 149 | glViewport(0, 0, (int) io.DisplaySize.x, (int) io.DisplaySize.y); 150 | glClearColor(clear_color.x, clear_color.y, clear_color.z, 151 | clear_color.w); 152 | glClear(GL_COLOR_BUFFER_BIT); 153 | //glUseProgram(0); // You may want this if using this code in an OpenGL 3+ context where shaders may be bound 154 | ImGui_ImplOpenGL2_RenderDrawData(ImGui::GetDrawData()); 155 | SDL_GL_SwapWindow(window); 156 | } 157 | 158 | // Cleanup 159 | ImGui_ImplOpenGL2_Shutdown(); 160 | ImGui_ImplSDL2_Shutdown(); 161 | ImGui::DestroyContext(); 162 | 163 | SDL_GL_DeleteContext(gl_context); 164 | SDL_DestroyWindow(window); 165 | SDL_Quit(); 166 | 167 | return 0; 168 | } 169 | -------------------------------------------------------------------------------- /examples/ex_tcp_server.cpp: -------------------------------------------------------------------------------- 1 | #include "aod/tcp_server.hpp" 2 | #include "SDL.h" 3 | #include 4 | #include 5 | #include 6 | 7 | int main(const int argc, const char **argv) { 8 | 9 | aod::TcpServer server; 10 | server.listen(1234, [](const char *data) -> std::string { 11 | printf("main: got data %s\n", data); 12 | 13 | std::ostringstream stream; 14 | stream << "Got " << strlen(data) << " chars" << std::endl; 15 | std::string str = stream.str(); 16 | 17 | return str; 18 | }); 19 | 20 | for (;;) { 21 | // printf("Main..\n"); 22 | SDL_Delay(1000); 23 | } 24 | 25 | } 26 | -------------------------------------------------------------------------------- /examples/meson.build: -------------------------------------------------------------------------------- 1 | includes = [include_directories('.')] 2 | 3 | includes += include_directories('../src') 4 | 5 | example_sdl_opengl = executable( 6 | 'example-sdl-opengl', 7 | sources: files ( 8 | 'sdl_opengl.c', 9 | ), 10 | dependencies: [ 11 | sdl2_dep, 12 | sdl2main_dep, 13 | ], 14 | install: true, 15 | gui_app: true, 16 | ) 17 | 18 | 19 | example_imgui = executable( 20 | 'example_imgui', 21 | sources: files ( 22 | 'ex_imgui.cpp', 23 | ), 24 | dependencies: [ 25 | sdl2_dep, 26 | sdl2main_dep, # note: this is not needed on linux, but on windows yes 27 | imgui_dep, 28 | ], 29 | install: true, 30 | gui_app: true, 31 | ) 32 | 33 | example_sdl_net = executable( 34 | 'example-sdl-net', 35 | sources: files ( 36 | 'sdl-net-tcp-socket.c', 37 | ), 38 | dependencies: [ 39 | sdl2_dep, 40 | sdl2main_dep, 41 | sdl_net_dep, 42 | ], 43 | install: true, 44 | ) 45 | 46 | example_audio_player = executable( 47 | 'ex_audio_player', 48 | sources: files ( 49 | 'ex_audio_player.cpp', 50 | ), 51 | dependencies: [ 52 | sdl2_dep, 53 | sdl2main_dep, 54 | sdl_net_dep, 55 | imgui_dep, 56 | aod_dep, 57 | s7_dep, 58 | ], 59 | install: true, 60 | ) 61 | 62 | 63 | example_repl = executable( 64 | 'repl', 65 | sources: files ( 66 | 's7-repl.cpp', 67 | ), 68 | dependencies: [ 69 | sdl2_dep, 70 | aod_dep, 71 | ], 72 | install: true, 73 | ) 74 | -------------------------------------------------------------------------------- /examples/nng-tcp-socket.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | #include 5 | #include 6 | 7 | #include "nng/nng.h" 8 | #include "nng/protocol/reqrep0/rep.h" 9 | #include "nng/protocol/reqrep0/req.h" 10 | 11 | void fatal(const char *func, int rv) 12 | { 13 | fprintf(stderr, "%s: %s\n", func, nng_strerror(rv)); 14 | exit(1); 15 | } 16 | 17 | int main(const int argc, const char **argv) 18 | { 19 | printf("here\n"); 20 | nng_socket sock; 21 | int rv; 22 | 23 | if ((rv = nng_rep0_open(&sock)) != 0) { 24 | fatal("nng_rep0_open", rv); 25 | } 26 | if ((rv = nng_listen(sock, "tcp://127.0.0.1:1234", NULL, 0)) != 0) { 27 | fatal("nng_listen", rv); 28 | } 29 | fprintf(stderr, "Listening..\n"); 30 | for (;;) { 31 | fprintf(stderr, "here..\n"); 32 | char * buf = NULL; 33 | size_t sz; 34 | uint64_t val; 35 | if ((rv = nng_recv(sock, &buf, &sz, NNG_FLAG_ALLOC)) != 0) { 36 | fprintf(stderr, "could not receive %d\n", rv); 37 | fatal("nng_recv", rv); 38 | } 39 | fprintf(stderr, "Got msg:\n%s\n", buf); 40 | printf("Got msg:%s\n", buf); 41 | // Unrecognized command, so toss the buffer. 42 | rv = nng_send(sock, buf, sz, NNG_FLAG_ALLOC); 43 | /* nng_free(buf, sz); */ 44 | } 45 | } 46 | -------------------------------------------------------------------------------- /examples/s7-repl.cpp: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | #include "s7.h" 5 | #include "aod/s7.hpp" 6 | #include "aod/s7/repl.hpp" 7 | #include 8 | #include 9 | 10 | namespace fs = std::filesystem; 11 | using std::cout, std::cerr, std::endl; 12 | 13 | int main(int argc, char **argv) { 14 | char buffer[512]; 15 | 16 | cout << "argv[0] " << argv[0] << " fs::current_path " << fs::current_path() << endl; 17 | fs::path base_path = (fs::current_path() / argv[0]).remove_filename(); 18 | cout << "base path " << base_path << endl; 19 | 20 | fs::path scheme_path = base_path / ".." / ".." / "src" / "scheme"; 21 | // cout << "scheme path " << scheme_path << endl; 22 | 23 | s7_scheme *sc = s7_init(); 24 | aod::s7::set_print_stderr(sc); 25 | aod::s7::set_autoloads(sc); 26 | aod::s7::bind_all(sc); 27 | 28 | s7_add_to_load_path(sc, scheme_path.string().c_str()); 29 | 30 | if (argc >= 2) { 31 | cout << "Passed custom scheme file " << argv[1] << endl; 32 | fs::path passed_file = argv[1]; 33 | if (!passed_file.is_absolute()) { 34 | passed_file = (fs::current_path() / passed_file); 35 | } 36 | std::string load_sexp = "(ns-load-file \"" + passed_file.string() +"\")"; 37 | 38 | // provides the ns-load-file 39 | aod::s7::load_file(sc, "aod/core.scm"); 40 | s7_eval_c_string(sc, load_sexp.c_str()); 41 | // s7_load(sc, passed_file.c_str()); 42 | } 43 | 44 | aod::s7::Repl repl(sc); 45 | 46 | cout << "S7 Example Repl " << endl << "> "; 47 | 48 | while (true) { 49 | fgets(buffer, 512, stdin); 50 | if (repl.handleInput(buffer)) { 51 | auto result = repl.evalLastForm(); 52 | cout << endl << result << endl << "> "; 53 | } 54 | 55 | } 56 | } 57 | -------------------------------------------------------------------------------- /examples/scheme/hi.scm: -------------------------------------------------------------------------------- 1 | (display "hi from scheme") 2 | (newline) 3 | 4 | (set! (hook-functions *error-hook*) 5 | (list (lambda (hook) 6 | (format *stderr* 7 | "~%~A: ~A~%~A:~A~%~A~%" 8 | (hook 'type) 9 | (apply format #f (hook 'data)) 10 | (port-filename) 11 | (port-line-number); error file location 12 | (stacktrace)) 13 | ))) 14 | 15 | 16 | (if (provided? 'linux) 17 | (display "have linux\n") 18 | (display "dont have linux\n")) 19 | 20 | (reader-cond ((provided? 'linux) 21 | (begin 22 | (display "line 1\n") 23 | (display "line 2\n") 24 | (display "line 3\n")))) 25 | 26 | (display "here\n") 27 | 28 | (load "repl.scm") 29 | -------------------------------------------------------------------------------- /examples/scheme/libdl.scm: -------------------------------------------------------------------------------- 1 | ;;; libdl.scm 2 | ;;; 3 | ;;; tie the dynamic loader library into the *libdl* environment 4 | 5 | (require cload.scm) 6 | (provide 'libdl.scm) 7 | 8 | ;; if loading from a different directory, pass that info to C 9 | (let ((directory (let ((current-file (port-filename))) 10 | (and (memv (current-file 0) '(#\/ #\~)) 11 | (substring current-file 0 (- (length current-file) 9)))))) 12 | (when (and directory (not (member directory *load-path*))) 13 | (set! *load-path* (cons directory *load-path*))) 14 | (with-let (rootlet) 15 | (require cload.scm)) 16 | (when (and directory (not (string-position directory *cload-cflags*))) 17 | (set! *cload-cflags* (string-append "-I" directory " " *cload-cflags*)))) 18 | 19 | 20 | (if (not (defined? '*libdl*)) 21 | (define *libdl* 22 | (with-let (unlet) 23 | (set! *libraries* (cons (cons "libdl.scm" (curlet)) *libraries*)) 24 | (c-define '((void* dlopen (char* int)) 25 | (int dlclose (void*)) 26 | (void* dlsym (void* char*)) 27 | (char* dlerror (void)) 28 | (C-macro (int (RTLD_LAZY RTLD_NOW RTLD_BINDING_MASK RTLD_NOLOAD RTLD_DEEPBIND RTLD_GLOBAL RTLD_LOCAL RTLD_NODELETE)))) 29 | "" "dlfcn.h" "" "" "libdl_s7") 30 | (curlet)))) 31 | 32 | *libdl* 33 | ;; the loader will return *libdl* 34 | -------------------------------------------------------------------------------- /examples/sdl-net-tcp-socket.c: -------------------------------------------------------------------------------- 1 | // from https://moddb.fandom.com/wiki/SDL:Tutorial:Using_SDL_net 2 | #include 3 | #include 4 | #include 5 | 6 | #include "SDL_net.h" 7 | #define PORT 1234 8 | #define BUF_SIZE 16 9 | 10 | int main(int argc, char **argv) { 11 | TCPsocket sd, csd; /* Socket descriptor, Client socket descriptor */ 12 | IPaddress ip, *remoteIP; 13 | int quit; 14 | char buffer[512]; 15 | 16 | if (SDLNet_Init() < 0) { 17 | fprintf(stderr, "SDLNet_Init: %s\n", SDLNet_GetError()); 18 | exit(EXIT_FAILURE); 19 | } 20 | 21 | /* Resolving the host using NULL make network interface to listen */ 22 | if (SDLNet_ResolveHost(&ip, NULL, 1234) < 0) { 23 | fprintf(stderr, "SDLNet_ResolveHost: %s\n", SDLNet_GetError()); 24 | exit(EXIT_FAILURE); 25 | } 26 | 27 | /* Open a connection with the IP provided (listen on the host's port) */ 28 | if (!(sd = SDLNet_TCP_Open(&ip))) { 29 | fprintf(stderr, "SDLNet_TCP_Open: %s\n", SDLNet_GetError()); 30 | exit(EXIT_FAILURE); 31 | } 32 | 33 | printf("listening on port %d\n", PORT); 34 | 35 | /* Wait for a connection, send data and term */ 36 | quit = 0; 37 | while (!quit) { 38 | /* This check the sd if there is a pending connection. * If there is one, accept that, and open a new socket for communicating */ 39 | if ((csd = SDLNet_TCP_Accept(sd))) { 40 | /* Now we can communicate with the client using csd socket * sd will remain opened waiting other connections */ 41 | 42 | /* Get the remote address */ 43 | if ((remoteIP = SDLNet_TCP_GetPeerAddress(csd))) { 44 | /* Print the address, converting in the host format */ 45 | printf("Host connected: %x %d\n", 46 | SDLNet_Read32(&remoteIP->host), 47 | SDLNet_Read16(&remoteIP->port)); 48 | } else { 49 | fprintf(stderr, "SDLNet_TCP_GetPeerAddress: %s\n", 50 | SDLNet_GetError()); 51 | } 52 | 53 | int countRecv = 0; 54 | for (;;) { 55 | countRecv = SDLNet_TCP_Recv(csd, buffer, BUF_SIZE); 56 | if (countRecv <= 0) { 57 | // disconnected or some other problem 58 | break; 59 | } 60 | // buffer[countRecv-1] should be ascii 10 : LF (line feed) 61 | /* printf("last char is %d\n", buffer[countRecv-1]); */ 62 | buffer[countRecv] = 0; // terminating what we read 63 | printf("Client say: %s\n", buffer); 64 | } 65 | /* Close the client socket */ 66 | SDLNet_TCP_Close(csd); 67 | } 68 | } 69 | 70 | SDLNet_TCP_Close(sd); 71 | SDLNet_Quit(); 72 | 73 | return EXIT_SUCCESS; 74 | } 75 | -------------------------------------------------------------------------------- /examples/sdl_opengl.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | #include 5 | #include 6 | #include 7 | 8 | typedef int32_t i32; 9 | typedef uint32_t u32; 10 | typedef int32_t b32; 11 | 12 | #define WinWidth 1000 13 | #define WinHeight 1000 14 | 15 | int main (int ArgCount, char **Args) 16 | { 17 | 18 | u32 WindowFlags = SDL_WINDOW_OPENGL; 19 | SDL_Window *Window = SDL_CreateWindow("OpenGL Test", 0, 0, WinWidth, WinHeight, WindowFlags); 20 | assert(Window); 21 | SDL_GLContext Context = SDL_GL_CreateContext(Window); 22 | 23 | b32 Running = 1; 24 | b32 FullScreen = 0; 25 | while (Running) 26 | { 27 | SDL_Event Event; 28 | while (SDL_PollEvent(&Event)) 29 | { 30 | if (Event.type == SDL_KEYDOWN) 31 | { 32 | switch (Event.key.keysym.sym) 33 | { 34 | case SDLK_ESCAPE: 35 | Running = 0; 36 | break; 37 | case 'f': 38 | FullScreen = !FullScreen; 39 | if (FullScreen) 40 | { 41 | SDL_SetWindowFullscreen(Window, WindowFlags | SDL_WINDOW_FULLSCREEN_DESKTOP); 42 | } 43 | else 44 | { 45 | SDL_SetWindowFullscreen(Window, WindowFlags); 46 | } 47 | break; 48 | default: 49 | break; 50 | } 51 | } 52 | else if (Event.type == SDL_QUIT) 53 | { 54 | Running = 0; 55 | } 56 | } 57 | 58 | glViewport(0, 0, WinWidth, WinHeight); 59 | glClearColor(1.f, 0.f, 1.f, 0.f); 60 | glClear(GL_COLOR_BUFFER_BIT); 61 | 62 | SDL_GL_SwapWindow(Window); 63 | } 64 | return 0; 65 | } 66 | -------------------------------------------------------------------------------- /img/youtube-preview.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/actondev/s7-imgui/7c5f0acc567ccd4dc4e4e1f1ff38a39aaa7b1875/img/youtube-preview.png -------------------------------------------------------------------------------- /meson.build: -------------------------------------------------------------------------------- 1 | project('s7-imgui', 'cpp', 'c', 2 | default_options: ['default_library=static', 3 | 'cpp_std=c++17', 4 | ], 5 | ) 6 | 7 | extra_args = [] 8 | system = host_machine.system() 9 | compiler_id = meson.get_compiler('cpp').get_id() 10 | if compiler_id == 'msvc' 11 | message('visual studio') 12 | # these flags are copied from an example project, don't know what's what 13 | # should comment later on what's what 14 | extra_args += ['/wd"4996"', '/wd"4250"', '/wd"4018"', '/wd"4267"', '/wd"4068"', '-D_DEBUG'] 15 | endif 16 | 17 | if system == 'windows' and compiler_id != 'msvc' 18 | error('Building on windows requires the MSVC compiler. Other compilers are not supported at the moment.') 19 | endif 20 | 21 | link_args = [] 22 | 23 | # host or build machine? 24 | 25 | # --- dependencies 26 | s7_proj = subproject('s7') 27 | s7_dep = s7_proj.get_variable('s7_dep') 28 | 29 | sdl2_proj = subproject('sdl2') 30 | sdl2_dep = sdl2_proj.get_variable('sdl2_dep') 31 | sdl2main_dep = sdl2_proj.get_variable('sdl2main_dep') 32 | 33 | # imgui looks for sdl 34 | # https://mesonbuild.com/Reference-manual.html#dependency 35 | meson.override_dependency('sdl', sdl2_dep) 36 | 37 | imgui = subproject('imgui', 38 | default_options: ['sdl=enabled', 39 | 'opengl2=enabled', 40 | ]) 41 | imgui_dep = imgui.get_variable('imgui_dep') 42 | 43 | sdl_net_proj = subproject('sdl_net') 44 | sdl_net_dep = sdl_net_proj.get_variable('sdl_net_dep') 45 | 46 | nfd_proj = subproject('nfd') 47 | nfd_dep = nfd_proj.get_variable('nfd_dep') 48 | 49 | # --- application 50 | meson.override_dependency('s7', s7_dep) 51 | meson.override_dependency('imgui', imgui_dep) 52 | 53 | subdir('src') 54 | 55 | if not meson.is_subproject() 56 | # hm probably remove the app 57 | app = executable( 58 | 's7-imgui', 59 | dependencies : [ 60 | sdl2_dep, # the core library 61 | sdl2main_dep, # abstracts out the main thing: windows needs WinMain 62 | sdl_net_dep, 63 | imgui_dep, 64 | s7_dep, 65 | app_dep, 66 | ], 67 | link_args: link_args, 68 | cpp_args: extra_args, 69 | gui_app: true, # needed on windows (int __cdecl invoke_main) : in VS /SUBSYSTEM windows 70 | install: true, 71 | ) 72 | 73 | gui_repl = executable( 74 | 'gui_repl', 75 | sources: files( 76 | 'src/gui_repl.cpp', 77 | ), 78 | dependencies : [ 79 | sdl2_dep, # the core library 80 | sdl2main_dep, # abstracts out the main thing: windows needs WinMain 81 | sdl_net_dep, 82 | imgui_dep, 83 | s7_dep, 84 | aod_dep, 85 | ], 86 | link_args: link_args, 87 | cpp_args: extra_args, 88 | gui_app: true, # needed on windows (int __cdecl invoke_main) : in VS /SUBSYSTEM windows 89 | install: true, 90 | ) 91 | 92 | repl = executable( 93 | 'repl', 94 | sources: files('src/repl.cpp'), 95 | dependencies : [ 96 | sdl2_dep, # the core library 97 | sdl_net_dep, 98 | imgui_dep, 99 | s7_dep, 100 | aod_dep, 101 | ], 102 | link_args: link_args, 103 | cpp_args: extra_args, 104 | install: true, 105 | ) 106 | 107 | # TODO switch building the examples with a definition option 108 | subdir('examples') 109 | # TODO not build test if building for release 110 | subdir('test') 111 | else 112 | s7_imgui_dep = declare_dependency( 113 | dependencies: [ 114 | sdl2_dep, 115 | sdl_net_dep, 116 | imgui_dep, 117 | s7_dep, 118 | aod_dep, 119 | ] 120 | ) 121 | endif 122 | -------------------------------------------------------------------------------- /readme.org: -------------------------------------------------------------------------------- 1 | *Deprecated* 2 | This project will not receive any updates! Glad if it helps as a skeleton to your own projects though 3 | 4 | * S7 & ImGui 5 | 6 | 7 | Using [[https://ccrma.stanford.edu/software/snd/snd/s7.html][s7 scheme]] alongside [[https://github.com/ocornut/imgui][Dear ImGui]] to (interactively) build (cross platform) GUI apps. 8 | 9 | You can see a video demonstration (of =0.1.0=) [[https://youtu.be/MgHsl0u26MY][here]]. 10 | 11 | [[https://youtu.be/MgHsl0u26MY][file:img/youtube-preview.png]] 12 | 13 | Cross platform build: linux & windows with [[https://mesonbuild.com/][meson]] build system 14 | 15 | Tested under 16 | - Windows 10 x64 \\ 17 | using =msys2= for =meson= & =ninja= but I guess normal windows builds exist 18 | - Ubuntu 20.04 19 | 20 | * Docs 21 | Some preliminary documentation of the provided namespaces is at [[file:docs/ns-doc.md]] \\ 22 | Auto-generated from the output of [[file:test/scheme/gen-doc.scm]] 23 | * Building 24 | See [[file:dev.org][dev.org]] 25 | 26 | If you use emacs I recommend the [[https://github.com/diadochos/org-babel-eval-in-repl][org-babel-eval-in-repl]] package to make the most out of the snippets in that file. 27 | 28 | ** Windows 29 | Meson can generate the =visual studio= project for you, so you can build/run/debug there. 30 | 31 | ** Linux 32 | Eclipse CDT has meson support which I got working without too much fuss. The [[file:.cproject][.cproject]] file is in the repo cause I couldn't get eclipse to generate it automatically. The [[file:.project][.project]] could be omitted. Generally, what was needed to be done was to manually add the following =natures= in the project: 33 | - meson 34 | - c 35 | - c++ 36 | 37 | Again, the =.cproject= was needed for the indexer to work. I copied it from a new generated meson project. 38 | 39 | Also I've found that =KDevelop= works quite well. This is what I'm using lately. 40 | 41 | ** TODO macOS 42 | Feel free to test it & make a PR. I don't have any mac/hackintosh. 43 | 44 | ** TODO Cross compiling 45 | Meson has cross compiling support. Haven't tested it at all though. 46 | 47 | * Rationale 48 | After discovering =clojure= and enjoying the satisfaction of working with a REPL, I wanted to have something like this for native desktop applications (and specifically with c/c++ for specific applications, so no java/clojure). 49 | 50 | Also, building things is still not fun for c/c++ projects. Some short-lived explorations with =Juce= got me scratching my head: you have to use a tool (named =projucer=) to generate the visual studio/xcode project files.. I didn't like this process, confused me. 51 | 52 | Recently I stumbled upon =meson= and, without usince c++ since 2013, I was glad to see how quickly I could use some libraries & even write build definitions for existing projects. It was a nice opportunity to see how things work & not use ready frameworks. 53 | 54 | So there you go. 55 | 56 | * Testing 57 | ** C++ (gtest) 58 | + [ ] fix/think about the needed =pwd= while running the tests (for loading scheme files & testing screenshots etc) 59 | 60 | right now you have to be in the =build/test= dir (assuming =build= is the directory you configured meson with) 61 | 62 | ** Scheme 63 | I'm running the =build/repl src/scheme/test-all.scm= command 64 | 65 | - tests normal scheme things (see [[file:src/scheme/aod/test.scm]] file for how it's impleneted) 66 | - tests also a GUI window against snapshots: see [[file:src/scheme/aod/components/sxs-wheel.scm]] which tests against 67 | [[file:test/scheme/assets/sxs-wheel-snapshot.png]] 68 | 69 | for example. 70 | 71 | * Roadmap 72 | - [X] proof of concept 73 | - embed =s7= and draw something with imgui from =s7= 74 | - use a REPL and work with =cmuscheme= in =emacs= 75 | - [X] (semi)complete the bindings of imgui for s7: checkboxes, lists, menubar etc 76 | - [X] video demonstration / getting started: windows and/or linux \\ 77 | I'm thinking of doing a really basic text editor (open - edit - save) with imgui/scheme etc. Live coding using the REPL 78 | see https://youtu.be/MgHsl0u26MY 79 | - [ ] create a documentation of the =namespaces= from C bindings but as well from provided scheme files. \\ 80 | - see the generated [[file:docs/ns-doc.el]] for now 81 | - the idea is to generate an =org= or =markadown= file from this 82 | - hide "private" things from the documentation (probably names that start with =-=) 83 | - [ ] Think (again) about the =namespaces=. See https://github.com/actonDev/s7-imgui/issues/3 . Any input from schemers would be greatly appreciated 84 | 85 | -------------------------------------------------------------------------------- /src/aod/colors.cpp: -------------------------------------------------------------------------------- 1 | #include 2 | namespace aod { 3 | namespace colors { 4 | 5 | // see https://github.com/bahamas10/ryb/blob/d81102f/js/RXB.js#L252-L330 6 | namespace ryb { 7 | 8 | const double magic[8][3] = { 9 | {1, 1, 1}, 10 | {1, 1, 0}, 11 | {1, 0, 0}, 12 | {1, 0.5, 0}, 13 | {0.163, 0.373, 0.6}, 14 | {0.0, 0.66, 0.2}, 15 | {0.5, 0.0, 0.5}, 16 | {0.2, 0.094, 0.0} 17 | }; 18 | 19 | double cubicInt(double t, double A, double B) { 20 | double weight = t * t * (3 - 2 * t); 21 | return A + weight * (B - A); 22 | } 23 | 24 | double getR(double iR, double iY, double iB) { 25 | // red 26 | double x0 = cubicInt(iB, magic[0][0], magic[4][0]); 27 | double x1 = cubicInt(iB, magic[1][0], magic[5][0]); 28 | double x2 = cubicInt(iB, magic[2][0], magic[6][0]); 29 | double x3 = cubicInt(iB, magic[3][0], magic[7][0]); 30 | double y0 = cubicInt(iY, x0, x1); 31 | double y1 = cubicInt(iY, x2, x3); 32 | return cubicInt(iR, y0, y1); 33 | } 34 | 35 | double getG(double iR, double iY, double iB) { 36 | double x0 = cubicInt(iB, magic[0][1], magic[4][1]); 37 | double x1 = cubicInt(iB, magic[1][1], magic[5][1]); 38 | double x2 = cubicInt(iB, magic[2][1], magic[6][1]); 39 | double x3 = cubicInt(iB, magic[3][1], magic[7][1]); 40 | double y0 = cubicInt(iY, x0, x1); 41 | double y1 = cubicInt(iY, x2, x3); 42 | return cubicInt(iR, y0, y1); 43 | } 44 | 45 | double getB(double iR, double iY, double iB) { 46 | // blue 47 | double x0 = cubicInt(iB, magic[0][2], magic[4][2]); 48 | double x1 = cubicInt(iB, magic[1][2], magic[5][2]); 49 | double x2 = cubicInt(iB, magic[2][2], magic[6][2]); 50 | double x3 = cubicInt(iB, magic[3][2], magic[7][2]); 51 | double y0 = cubicInt(iY, x0, x1); 52 | double y1 = cubicInt(iY, x2, x3); 53 | return cubicInt(iR, y0, y1); 54 | } 55 | 56 | /** 57 | * var ryb2rgb = (function() { 58 | // see http://threekings.tk/mirror/ryb_TR.pdf 59 | function cubicInt(t, A, B){ 60 | var weight = t * t * (3 - 2 * t); 61 | return A + weight * (B - A); 62 | } 63 | 64 | function getR(iR, iY, iB, magic) { 65 | magic = magic || MAGIC_COLORS; 66 | // red 67 | var x0 = cubicInt(iB, magic[0][0], magic[4][0]); 68 | var x1 = cubicInt(iB, magic[1][0], magic[5][0]); 69 | var x2 = cubicInt(iB, magic[2][0], magic[6][0]); 70 | var x3 = cubicInt(iB, magic[3][0], magic[7][0]); 71 | var y0 = cubicInt(iY, x0, x1); 72 | var y1 = cubicInt(iY, x2, x3); 73 | return cubicInt(iR, y0, y1); 74 | } 75 | 76 | function getG(iR, iY, iB, magic) { 77 | magic = magic || MAGIC_COLORS; 78 | // green 79 | var x0 = cubicInt(iB, magic[0][1], magic[4][1]); 80 | var x1 = cubicInt(iB, magic[1][1], magic[5][1]); 81 | var x2 = cubicInt(iB, magic[2][1], magic[6][1]); 82 | var x3 = cubicInt(iB, magic[3][1], magic[7][1]); 83 | var y0 = cubicInt(iY, x0, x1); 84 | var y1 = cubicInt(iY, x2, x3); 85 | return cubicInt(iR, y0, y1); 86 | } 87 | 88 | function getB(iR, iY, iB, magic) { 89 | magic = magic || MAGIC_COLORS; 90 | // blue 91 | var x0 = cubicInt(iB, magic[0][2], magic[4][2]); 92 | var x1 = cubicInt(iB, magic[1][2], magic[5][2]); 93 | var x2 = cubicInt(iB, magic[2][2], magic[6][2]); 94 | var x3 = cubicInt(iB, magic[3][2], magic[7][2]); 95 | var y0 = cubicInt(iY, x0, x1); 96 | var y1 = cubicInt(iY, x2, x3); 97 | return cubicInt(iR, y0, y1); 98 | } 99 | 100 | function ryb2rgb(color, limit, magic) { 101 | limit = limit || 255; 102 | magic = magic || MAGIC_COLORS; 103 | var R = color[0] / limit; 104 | var Y = color[1] / limit; 105 | var B = color[2] / limit; 106 | var R1 = getR(R, Y, B, magic); 107 | var G1 = getG(R, Y, B, magic); 108 | var B1 = getB(R, Y, B, magic); 109 | return [ 110 | Math.ceil(R1 * limit), 111 | Math.ceil(G1 * limit), 112 | Math.ceil(B1 * limit) 113 | ]; 114 | } 115 | return ryb2rgb; 116 | })(); 117 | 118 | */ 119 | } 120 | 121 | std::array ryb2rgb(std::array ryb) { 122 | 123 | double R = ryb[0]; 124 | double Y = ryb[1]; 125 | double B = ryb[2]; 126 | double R1 = ryb::getR(R, Y, B); 127 | double G1 = ryb::getG(R, Y, B); 128 | double B1 = ryb::getB(R, Y, B); 129 | return {R1, G1, B1}; 130 | } 131 | 132 | } // colors 133 | } // aod 134 | -------------------------------------------------------------------------------- /src/aod/colors.hpp: -------------------------------------------------------------------------------- 1 | #pragma once 2 | #include 3 | namespace aod { 4 | namespace colors { 5 | extern std::array ryb2rgb(std::array rgb); 6 | } 7 | } 8 | -------------------------------------------------------------------------------- /src/aod/gl/gl.cpp: -------------------------------------------------------------------------------- 1 | #define STB_IMAGE_WRITE_IMPLEMENTATION 2 | // we have it in this directory for now 3 | // will see later on if I need this in more places 4 | #include "stb_image_write.h" 5 | #ifdef _WIN32 6 | #include // gl.h errors if not (void should be preceded.. etc) 7 | #endif 8 | #include 9 | #include "./gl.hpp" 10 | 11 | namespace aod { 12 | namespace gl { 13 | 14 | void flipVertically(int width, int height, char *data) { 15 | char rgb[3]; 16 | 17 | for (int y = 0; y < height / 2; ++y) { 18 | for (int x = 0; x < width; ++x) { 19 | int top = (x + y * width) * 3; 20 | int bottom = (x + (height - y - 1) * width) * 3; 21 | 22 | memcpy(rgb, data + top, sizeof(rgb)); 23 | memcpy(data + top, data + bottom, sizeof(rgb)); 24 | memcpy(data + bottom, rgb, sizeof(rgb)); 25 | } 26 | } 27 | } 28 | 29 | // credit: https://github.com/vallentin/GLCollection/blob/master/screenshot.cpp 30 | int save_screenshot(const char *filename) { 31 | GLint viewport[4]; 32 | glGetIntegerv(GL_VIEWPORT, viewport); 33 | 34 | int x = viewport[0]; 35 | int y = viewport[1]; 36 | int width = viewport[2]; 37 | int height = viewport[3]; 38 | 39 | char *data = (char*) malloc((size_t) (width * height * 3)); // 3 components (R, G, B) 40 | 41 | if (!data) 42 | return 0; 43 | 44 | glPixelStorei(GL_PACK_ALIGNMENT, 1); 45 | glReadPixels(x, y, width, height, GL_RGB, GL_UNSIGNED_BYTE, data); 46 | 47 | flipVertically(width, height, data); 48 | 49 | int saved = stbi_write_png(filename, width, height, 3, data, 0); 50 | 51 | free(data); 52 | 53 | return saved; 54 | } 55 | } 56 | } 57 | -------------------------------------------------------------------------------- /src/aod/gl/gl.hpp: -------------------------------------------------------------------------------- 1 | namespace aod { 2 | namespace gl { 3 | int save_screenshot(const char* filename); 4 | } 5 | } 6 | -------------------------------------------------------------------------------- /src/aod/img/core.cpp: -------------------------------------------------------------------------------- 1 | #include "stb_image.h" 2 | #include "math.h" 3 | namespace aod { 4 | 5 | namespace img { 6 | 7 | /** 8 | * Refering stbi_image_free: 9 | * Could use something like.. 10 | * 11 | * 12 | auto deleter=[&](int* ptr){...}; 13 | std::unique_ptr ptr4(new int[4], deleter); 14 | 15 | */ 16 | 17 | double normalized_correlation_coefficient(unsigned char * X, unsigned char* Y, size_t n) { 18 | // implementation from https://www.geeksforgeeks.org/program-find-correlation-coefficient/ 19 | // https://en.wikipedia.org/wiki/Correlation_and_dependence Sample correlation coefficient 20 | // adjusted for math rounding errors 21 | double sum_X = 0, sum_Y = 0, sum_XY = 0; 22 | double squareSum_X = 0, squareSum_Y = 0; 23 | 24 | for (size_t i = 0; i < n; i++) { 25 | double xi = (double)X[i] / 255.0; 26 | double yi = (double)Y[i] / 255.0; 27 | 28 | // sum of elements of array X. 29 | sum_X = sum_X + xi; 30 | 31 | // sum of elements of array Y. 32 | sum_Y = sum_Y + yi; 33 | 34 | // sum of X[i] * Y[i]. 35 | sum_XY = sum_XY + xi * yi; 36 | 37 | // sum of square of array elements. 38 | squareSum_X = squareSum_X + xi * xi; 39 | squareSum_Y = squareSum_Y + yi * yi; 40 | } 41 | 42 | // use formula for calculating correlation coefficient. 43 | double numer = (n * sum_XY - sum_X * sum_Y); 44 | double denumer_sq = (n * squareSum_X - sum_X * sum_X) * (n * squareSum_Y - sum_Y * sum_Y); 45 | double corr = numer / sqrt(denumer_sq); 46 | 47 | return corr; 48 | } 49 | 50 | 51 | 52 | bool are_equivalent(const char* img1, const char* img2) { 53 | int w1, h1, bit_depth1; 54 | int w2, h2, bit_depth2; 55 | unsigned char *data1 = stbi_load(img1, &w1, &h1, &bit_depth1, 0); 56 | unsigned char *data2 = stbi_load(img2, &w2, &h2, &bit_depth2, 0); 57 | bool res = false; 58 | 59 | do { 60 | // inner comparison 61 | // quickly breaking out 62 | // this is cause we have to release the resources later on 63 | // could I use some std::unique_ptr thing? (with deleter) 64 | if (data1 == NULL || data2 == NULL) { 65 | break; 66 | } 67 | 68 | if (w1 == 0 || h1 == 0 || w2 == 0 || h2 == 0) { 69 | break; 70 | } 71 | 72 | if (w1 != w2 || h1 != h2) { 73 | break; 74 | } 75 | 76 | if (bit_depth1 != bit_depth2) { 77 | break; 78 | } 79 | 80 | double corr = normalized_correlation_coefficient(data1, data2, w1 * h1); 81 | // printf("corr is %f\n", corr); 82 | 83 | if (corr > 0.9) { 84 | res = true; 85 | } 86 | 87 | } while (false); 88 | stbi_image_free(data1); 89 | stbi_image_free(data2); 90 | return res; 91 | } 92 | 93 | } // img 94 | }// aod 95 | -------------------------------------------------------------------------------- /src/aod/img/core.hpp: -------------------------------------------------------------------------------- 1 | #pragma once 2 | 3 | namespace aod { 4 | 5 | namespace img { 6 | 7 | bool are_equivalent(const char* img1, const char* img2); 8 | 9 | } // img 10 | }// aod 11 | -------------------------------------------------------------------------------- /src/aod/imgui/addons.cpp: -------------------------------------------------------------------------------- 1 | #include "imgui.h" 2 | #include "imgui_internal.h" 3 | 4 | #ifdef _WIN32 5 | #ifndef M_PI 6 | #define M_PI 3.14159265358979323846264338327950288 /* pi */ 7 | #endif 8 | #endif 9 | 10 | namespace aod { 11 | namespace imgui { 12 | 13 | /** 14 | * as seen on https://github.com/ocornut/imgui/issues/942 15 | */ 16 | bool Knob(const char *label, float *value_p, float minv, float maxv) { 17 | ImGuiStyle &style = ImGui::GetStyle(); 18 | float line_height = ImGui::GetTextLineHeight(); 19 | 20 | ImVec2 p = ImGui::GetCursorScreenPos(); 21 | float sz = 36.0f; 22 | float radio = sz * 0.5f; 23 | ImVec2 center = ImVec2(p.x + radio, p.y + radio); 24 | float val1 = (value_p[0] - minv) / (maxv - minv); 25 | char textval[32]; 26 | ImFormatString(textval, IM_ARRAYSIZE(textval), "%04.1f", value_p[0]); 27 | 28 | // ImVec2 textpos = p; 29 | float gamma = M_PI / 4.0f; //0 value in knob 30 | float alpha = (M_PI - gamma) * val1 * 2.0f + gamma; 31 | 32 | float x2 = -sinf(alpha) * radio + center.x; 33 | float y2 = cosf(alpha) * radio + center.y; 34 | 35 | ImGui::InvisibleButton(label, 36 | ImVec2(sz, sz + line_height + style.ItemInnerSpacing.y)); 37 | 38 | bool is_active = ImGui::IsItemActive(); 39 | bool is_hovered = ImGui::IsItemHovered(); 40 | bool touched = false; 41 | 42 | if (is_active) { 43 | touched = true; 44 | ImVec2 mp = ImGui::GetIO().MousePos; 45 | alpha = atan2f(mp.x - center.x, center.y - mp.y) + M_PI; 46 | alpha = ImMax(gamma, ImMin((float) (2.0f * M_PI - gamma), alpha)); 47 | float value = 0.5f * (alpha - gamma) / (M_PI - gamma); 48 | value_p[0] = value * (maxv - minv) + minv; 49 | } 50 | 51 | ImU32 col32 = ImGui::GetColorU32( 52 | is_active ? ImGuiCol_FrameBgActive : 53 | is_hovered ? ImGuiCol_FrameBgHovered : ImGuiCol_FrameBg); 54 | ImU32 col32line = ImGui::GetColorU32(ImGuiCol_SliderGrabActive); 55 | ImU32 col32text = ImGui::GetColorU32(ImGuiCol_Text); 56 | ImDrawList *draw_list = ImGui::GetWindowDrawList(); 57 | draw_list->AddCircleFilled(center, radio, col32, 16); 58 | draw_list->AddLine(center, ImVec2(x2, y2), col32line, 1); 59 | // draw_list->AddText(textpos, col32text, textval); 60 | draw_list->AddText(ImVec2(p.x, p.y + sz + style.ItemInnerSpacing.y), 61 | col32text, label); 62 | 63 | return touched; 64 | } 65 | 66 | } 67 | } 68 | -------------------------------------------------------------------------------- /src/aod/imgui/addons.hpp: -------------------------------------------------------------------------------- 1 | #pragma once 2 | 3 | namespace aod { 4 | namespace imgui { 5 | bool Knob(const char *label, float *value_p, float minv, float maxv); 6 | } 7 | } 8 | -------------------------------------------------------------------------------- /src/aod/meson.build: -------------------------------------------------------------------------------- 1 | # TODO as this grows, I should add conditionals: 2 | # if s7 found, add these files 3 | # if imgui found, ... and so on 4 | aod_sources = files( 5 | # TODO move things in subfolders 6 | # eg s7/s7.cpp, s7/s7.hpp for the "core" functionality 7 | 's7.cpp', 8 | 's7/imgui/imgui.cpp', 9 | 's7/imgui/addons.cpp', 10 | 's7/imgui/enums.cpp', 11 | 's7/repl.cpp', 12 | 'imgui/addons.cpp', 13 | 's7/sdl.cpp', 14 | 'sdl.cpp', 15 | 'sdl/audio.cpp', 16 | 'nfd.cpp', 17 | 's7/nfd.cpp', 18 | 's7/imgui_sdl.cpp', 19 | 'colors.cpp', 20 | 's7/colors.cpp', 21 | 22 | # foreign types 23 | 's7/foreign_primitives.cpp', 24 | 's7/foreign_primitives_arr.cpp', 25 | 26 | # img (testing for similarity) 27 | # TODO rename to img/img.cpp 28 | 'img/core.cpp', 29 | 's7/img.cpp', 30 | 31 | # midi 32 | 'midi/midi.cpp', 33 | 's7/midi.cpp', 34 | ) 35 | 36 | gl_dep = dependency('gl', required : false) 37 | if gl_dep.found() 38 | message('aod: gl_dep found, adding gl/gl.cpp') 39 | aod_sources += files( 40 | 'gl/gl.cpp', # aod::gl::save_screenshot(const char* filename) 41 | 's7/gl.cpp', # (gl/save-screenshot filename) 42 | ) 43 | endif 44 | 45 | aod_lib = library( 46 | 'aod', 47 | # sources: aod_sources, 48 | include_directories: include_directories('..'), 49 | sources: aod_sources, 50 | dependencies : [ 51 | # dependency('s7', required: true), 52 | s7_dep, 53 | imgui_dep, 54 | gl_dep, 55 | sdl2_dep, 56 | nfd_dep, 57 | stb_dep, # (only for image read/write for now) 58 | ] 59 | ) 60 | 61 | aod_dep = declare_dependency( 62 | link_with: aod_lib, 63 | # include from parent dir: to include "aod/s7.cpp" for example 64 | include_directories: include_directories('..'), 65 | dependencies: [ 66 | # hm.. this is for the include_directories 67 | # solving errors like "SDL.h" not found etc 68 | s7_dep, 69 | imgui_dep, 70 | gl_dep, 71 | sdl2_dep, 72 | nfd_dep, 73 | ] 74 | ) 75 | -------------------------------------------------------------------------------- /src/aod/midi/midi.cpp: -------------------------------------------------------------------------------- 1 | #include "midi.hpp" 2 | 3 | namespace aod { 4 | namespace midi { 5 | 6 | // from iPlugMidi.h 7 | struct IMidiMsg { 8 | uint8_t mStatus, mData1, mData2; 9 | enum EStatusMsg { 10 | kNone = 0, 11 | kNoteOff = 8, 12 | kNoteOn = 9, 13 | kPolyAftertouch = 10, 14 | kControlChange = 11, 15 | kProgramChange = 12, 16 | kChannelAftertouch = 13, 17 | kPitchWheel = 14 18 | }; 19 | 20 | EStatusMsg StatusMsg() const { 21 | unsigned int e = mStatus >> 4; 22 | if (e < kNoteOff || e > kPitchWheel) { 23 | return kNone; 24 | } 25 | return (EStatusMsg) e; 26 | } 27 | /** @return [0, 127), -1 if NA. */ 28 | int NoteNumber() const { 29 | switch (StatusMsg()) { 30 | case kNoteOn: 31 | case kNoteOff: 32 | case kPolyAftertouch: 33 | return mData1; 34 | default: 35 | return -1; 36 | } 37 | } 38 | 39 | /** @return returns [0, 127), -1 if NA. */ 40 | int Velocity() const { 41 | switch (StatusMsg()) { 42 | case kNoteOn: 43 | case kNoteOff: 44 | return mData2; 45 | default: 46 | return -1; 47 | } 48 | } 49 | 50 | // some helpers 51 | 52 | bool is_note_on() const { 53 | return StatusMsg() == kNoteOn; 54 | } 55 | 56 | bool is_note_off() const { 57 | return StatusMsg() == kNoteOff; 58 | } 59 | 60 | }; 61 | 62 | bool is_note_on(uint8_t status, uint8_t data1, uint8_t data2) { 63 | IMidiMsg msg = {status, data1, data2}; 64 | return msg.is_note_on() && msg.Velocity() > 0; 65 | } 66 | 67 | bool is_note_off(uint8_t status, uint8_t data1, uint8_t data2) { 68 | IMidiMsg msg = {status, data1, data2}; 69 | // hm.. I noticed that with my KeystationMini32 and RtMidi, I don't get kNoteOff 70 | // but instead kNoteOn and velocity 0 71 | 72 | return msg.is_note_off() || msg.Velocity() == 0; 73 | } 74 | 75 | int note_number(uint8_t status, uint8_t data1, uint8_t data2) { 76 | IMidiMsg msg = {status, data1, data2}; 77 | return msg.NoteNumber(); 78 | } 79 | 80 | int note_velocity(uint8_t status, uint8_t data1, uint8_t data2) { 81 | IMidiMsg msg = {status, data1, data2}; 82 | return msg.Velocity(); 83 | } 84 | 85 | } 86 | } 87 | 88 | 89 | -------------------------------------------------------------------------------- /src/aod/midi/midi.hpp: -------------------------------------------------------------------------------- 1 | #pragma once 2 | #include 3 | 4 | namespace aod { 5 | namespace midi { 6 | 7 | bool is_note_on(uint8_t status, uint8_t data1, uint8_t data2); 8 | 9 | bool is_note_off(uint8_t status, uint8_t data1, uint8_t data2); 10 | 11 | int note_number(uint8_t status, uint8_t data1, uint8_t data2); 12 | 13 | int note_velocity(uint8_t status, uint8_t data1, uint8_t data2); 14 | 15 | } 16 | } 17 | 18 | 19 | -------------------------------------------------------------------------------- /src/aod/nfd.cpp: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | #include 5 | 6 | namespace aod { 7 | 8 | namespace nfd { 9 | 10 | std::optional open() { 11 | nfdchar_t *out_path = NULL; 12 | nfdresult_t nfd_result = NFD_OpenDialog(NULL, NULL, &out_path); 13 | 14 | if (nfd_result == NFD_OKAY) { 15 | std::string path = out_path; 16 | free(out_path); 17 | return path; 18 | } 19 | 20 | if (nfd_result == NFD_CANCEL) { 21 | // puts("User pressed cancel."); 22 | } else { 23 | std::cerr << "NFD Error: " << NFD_GetError() << std::endl; 24 | } 25 | 26 | return {}; 27 | } 28 | 29 | std::optional save() { 30 | nfdchar_t *out_path = NULL; 31 | nfdresult_t nfd_result = NFD_SaveDialog(NULL, NULL, &out_path); 32 | 33 | if (nfd_result == NFD_OKAY) { 34 | std::string path = out_path; 35 | free(out_path); 36 | return path; 37 | } 38 | 39 | if (nfd_result == NFD_CANCEL) { 40 | // puts("User pressed cancel."); 41 | } else { 42 | std::cerr << "NFD Error: " << NFD_GetError() << std::endl; 43 | } 44 | 45 | return {}; 46 | } 47 | 48 | } 49 | } 50 | 51 | -------------------------------------------------------------------------------- /src/aod/nfd.hpp: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | namespace aod { 4 | 5 | namespace nfd { 6 | 7 | std::optional open(); 8 | std::optional save(); 9 | 10 | } 11 | } 12 | -------------------------------------------------------------------------------- /src/aod/path.hpp: -------------------------------------------------------------------------------- 1 | /* 2 | * aod_path.h 3 | * 4 | * Created on: Jun 23, 2020 5 | * Author: actondev 6 | */ 7 | 8 | #pragma once 9 | 10 | #include 11 | #include 12 | //#include 13 | //#include 14 | 15 | #ifdef __linux__ 16 | #include 17 | #endif 18 | 19 | #ifdef __WIN32__ 20 | #include 21 | #endif 22 | 23 | namespace aod { 24 | 25 | namespace path { 26 | void set(std::string path) { 27 | #ifdef __linux__ 28 | fprintf(stderr, "setting path to %s\n", path.c_str()); 29 | chdir(path.c_str()); 30 | #else 31 | _chdir(path.c_str()); 32 | #endif 33 | } 34 | 35 | char* get() { 36 | #ifdef __linux__ 37 | /** 38 | * The GNU library version of this function also permits you to specify a null pointer for the buffer argument. 39 | Then getcwd allocates a buffer automatically, as with malloc . If the size is greater than zero, then the 40 | buffer is that large; otherwise, the buffer is as large as necessary to hold the result. 41 | */ 42 | return getcwd(NULL, 0); 43 | #else 44 | fprintf(stderr, "cwd not implemented\n"); 45 | exit(1); 46 | #endif 47 | } 48 | 49 | void print_cwd() { 50 | #ifdef __linux__ 51 | char cwd[512]; 52 | if (getcwd(cwd, sizeof(cwd)) != NULL) { 53 | printf("Current working dir: %s\n", cwd); 54 | } else { 55 | perror("getcwd() error"); 56 | } 57 | #else 58 | fprintf(stderr, "print_cwd not implemented\n"); 59 | #endif 60 | } 61 | 62 | } // path 63 | 64 | } // aod 65 | 66 | -------------------------------------------------------------------------------- /src/aod/s7.cpp: -------------------------------------------------------------------------------- 1 | #include "s7.hpp" 2 | 3 | #include "aod/s7/imgui/imgui.hpp" 4 | #include "aod/s7/foreign_primitives.hpp" 5 | #include "aod/s7/foreign_primitives_arr.hpp" 6 | #include "aod/s7/imgui/addons.hpp" 7 | #include "aod/s7/gl.hpp" 8 | #include "aod/s7/sdl.hpp" 9 | #include "aod/s7/nfd.hpp" 10 | #include "aod/s7/imgui_sdl.hpp" 11 | #include "aod/s7/repl.hpp" 12 | #include "aod/s7/colors.hpp" 13 | #include "aod/s7/img.hpp" 14 | #include "aod/s7/midi.hpp" 15 | 16 | #include 17 | #include 18 | using std::cout; 19 | using std::cerr; 20 | using std::endl; 21 | 22 | namespace aod { 23 | namespace s7 { 24 | 25 | namespace { 26 | std::ostringstream _out_stream; 27 | void _print_stderr(s7_scheme *sc, uint8_t c, s7_pointer port) { 28 | fprintf(stderr, "%c", c); 29 | } 30 | void _print_temp(s7_scheme *sc, uint8_t c, s7_pointer port) { 31 | _out_stream << c; 32 | } 33 | } // anonymous 34 | 35 | 36 | void set_print_stderr(s7_scheme *sc) { 37 | s7_set_current_output_port(sc, s7_open_output_function(sc, _print_stderr)); 38 | } 39 | 40 | void load_file(s7_scheme *sc, std::string file) { 41 | std::replace(file.begin(), file.end(), '\\', '/'); 42 | if (!s7_load(sc, file.c_str())) { 43 | cerr << "Cannot load " << file << endl; 44 | } 45 | } 46 | 47 | void ns_load_file(s7_scheme* sc, std::string file) { 48 | // fucking windows separators 49 | std::replace(file.begin(), file.end(), '\\', '/'); 50 | std::string sexp = "(ns-load-file \"" + file + "\")"; 51 | s7_eval_c_string(sc, sexp.c_str()); 52 | } 53 | 54 | /** 55 | * Wraps the passed sexp around a (write ..) call, 56 | * and returns the written output. 57 | */ 58 | std::string eval_write(s7_scheme *sc, const char *sexp) { 59 | std::ostringstream wrapped_sexp; 60 | // wrapping around begin as well to handle empty input (not enough arguments passed to write error) 61 | wrapped_sexp << "(write (begin " << sexp << "))"; 62 | 63 | s7_pointer old_port = s7_set_current_output_port(sc, 64 | s7_open_output_function(sc, _print_temp)); 65 | 66 | s7_pointer old_error_port = s7_set_current_error_port(sc, 67 | s7_open_output_function(sc, _print_temp)); 68 | 69 | _out_stream.clear(); 70 | _out_stream.str(""); 71 | s7_eval_c_string(sc, wrapped_sexp.str().c_str()); 72 | 73 | // reverting 74 | s7_set_current_output_port(sc, old_port); 75 | s7_set_current_error_port(sc, old_error_port); 76 | 77 | return _out_stream.str(); 78 | } 79 | 80 | 81 | #define AOD_S7_AUTOLOAD 1 82 | #define AOD_S7_AUTOLOAD_2 AOD_S7_AUTOLOAD*2 83 | void set_autoloads(s7_scheme *sc) { 84 | // s7_autoload_set_names(sc, NULL, 0); 85 | // hm.. if I don't set this to static, everything goes to shit 86 | static const char *autoloads[AOD_S7_AUTOLOAD_2] = { 87 | // each pair of entries is entity name + file name 88 | "aod.core", "aod/core.scm", 89 | // "aod.clj", "aod/clj.scm", // 90 | // "aod.imgui", "aod/imgui/macros.scm", 91 | // "imgui-macros.scm", "aod/imgui_macros.scm", // 92 | // "aod.libs.lib1", "aod/imgui/macros.scm", 93 | }; 94 | 95 | 96 | s7_autoload_set_names(sc, autoloads, AOD_S7_AUTOLOAD); 97 | } 98 | 99 | s7_scheme* init(std::filesystem::path init_load_path) { 100 | cout << "Initializing scheme in " << init_load_path << endl; 101 | s7_scheme *sc = s7_init(); 102 | set_print_stderr(sc); 103 | set_autoloads(sc); 104 | bind_all(sc); 105 | 106 | // note: path.c_str() returns const value_type* 107 | // in linux it's indeed char* but in windows it's wchar_t 108 | s7_add_to_load_path(sc, init_load_path.string().c_str()); 109 | aod::s7::load_file(sc, "aod/core.scm"); 110 | 111 | return sc; 112 | } 113 | 114 | void bind_all(s7_scheme *sc) { 115 | s7_pointer primitives_env = s7_inlet(sc, s7_nil(sc)); 116 | s7_gc_protect(sc, primitives_env); 117 | // eg ((aod.c.foreign 'new-bool) #t) for a bool* pointer with initial value true 118 | aod::s7::foreign::bind_primitives(sc, primitives_env); 119 | // eg ((aod.c.foreign 'new-bool[]) 4) for a bool[4] array 120 | aod::s7::foreign::bind_primitives_arr(sc, primitives_env); 121 | 122 | s7_define(sc, primitives_env, s7_make_symbol(sc, "*ns-doc*"), 123 | s7_make_string(sc, "Provides a way to create heap allocated primitives like int* float*, int* array, char* array etc. " 124 | "For example, to create a c string call `(new-char[] size)`")); 125 | 126 | // imgui bindings 127 | aod::s7::imgui::bind(sc); 128 | aod::s7::imgui::bind_knob(sc); 129 | 130 | // gl bindings (eg gl/save-screenshot) 131 | aod::s7::gl::bind(sc); 132 | 133 | // nfd: native file dialog (*nfd* 'open) 134 | aod::s7::nfd::bind(sc); 135 | 136 | aod::s7::imgui_sdl::bind(sc); 137 | // aod.c.repl : 138 | // *eval-hook* 139 | aod::s7::repl::bind(sc); 140 | 141 | aod::s7::colors::bind(sc); 142 | aod::s7::sdl::bind(sc); 143 | aod::s7::img::bind(sc); 144 | aod::s7::midi::bind(sc); 145 | } 146 | 147 | } // s7 148 | } // aod 149 | 150 | 151 | 152 | 153 | -------------------------------------------------------------------------------- /src/aod/s7.hpp: -------------------------------------------------------------------------------- 1 | #pragma once 2 | 3 | #include "s7.h" 4 | #include 5 | 6 | // these are for the bind_all functions 7 | // maybe have some definitions, eg 8 | // #ifdef AOD_S7_IMGUI 9 | // #ifdef AOD_S7_SDL etc ? 10 | #include 11 | #include 12 | 13 | namespace aod { 14 | namespace s7 { 15 | 16 | /** 17 | * Sets the stdout of s7 to stderr of the application 18 | */ 19 | void set_print_stderr(s7_scheme *sc); 20 | 21 | /** 22 | * Loads a file. Prints a warning if file could not be found. 23 | */ 24 | void load_file(s7_scheme *sc, std::string file); 25 | 26 | /** 27 | * Performs a (ns-load-file THE_FILE) call 28 | * Loads the file in its own namespace - if it has an (ns .. ) form 29 | */ 30 | void ns_load_file(s7_scheme* sc, std::string file); 31 | 32 | /** 33 | * Wraps the passed sexp around a (write ..) call, 34 | * and returns the written output. 35 | */ 36 | std::string eval_write(s7_scheme *sc, const char *sexp); 37 | 38 | /** 39 | * Adds the autoloading, loads aod.core, and binds all available bindings 40 | */ 41 | s7_scheme* init(std::filesystem::path init_load_path); 42 | 43 | inline s7_pointer make_env(s7_scheme *sc) { 44 | // either passing s7_curlet or s7_nil works.. 45 | // ..ugh still don't know what happens with environments 46 | s7_pointer env = s7_inlet(sc, s7_nil(sc)); 47 | s7_gc_protect(sc, env); 48 | 49 | return env; 50 | } 51 | 52 | void bind_all(s7_scheme *sc); 53 | 54 | void set_autoloads(s7_scheme *sc); 55 | 56 | } // ! s7 57 | } // ! aod 58 | -------------------------------------------------------------------------------- /src/aod/s7/colors.cpp: -------------------------------------------------------------------------------- 1 | #include "s7.h" 2 | #include 3 | #include "aod/colors.hpp" 4 | 5 | namespace aod { 6 | namespace s7 { 7 | namespace colors { 8 | 9 | s7_pointer ryb2rgb(s7_scheme* sc, s7_pointer args) { 10 | s7_pointer sc_ryb = s7_car(args); 11 | double r = s7_real(s7_list_ref(sc, sc_ryb, 0)); 12 | double y = s7_real(s7_list_ref(sc, sc_ryb, 1)); 13 | double b = s7_real(s7_list_ref(sc, sc_ryb, 2)); 14 | 15 | std::array ryb = {r, y, b}; 16 | auto rgb = aod::colors::ryb2rgb(ryb); 17 | 18 | return s7_list(sc, 3, 19 | s7_make_real(sc, rgb[0]), 20 | s7_make_real(sc, rgb[1]), 21 | s7_make_real(sc, rgb[2]) 22 | ); 23 | } 24 | 25 | void bind(s7_scheme* sc) { 26 | s7_pointer env = s7_inlet(sc, s7_nil(sc)); 27 | s7_gc_protect(sc, env); 28 | 29 | s7_define(sc, env, s7_make_symbol(sc, "ryb->rgb"), 30 | s7_make_function(sc, "ryb->rgb", ryb2rgb, 31 | 1, // req args 32 | 0, // optional args: thickness 33 | false, // rest args 34 | "Converts RYB to RGB")); 35 | 36 | 37 | s7_define_variable(sc, "aod.c.colors", env); 38 | 39 | } 40 | 41 | } // colors 42 | } // s7 43 | } // aod 44 | -------------------------------------------------------------------------------- /src/aod/s7/colors.hpp: -------------------------------------------------------------------------------- 1 | #pragma once 2 | 3 | #include "s7.h" 4 | 5 | namespace aod { 6 | namespace s7 { 7 | namespace colors { 8 | 9 | void bind(s7_scheme* sc); 10 | 11 | } // colors 12 | } // s7 13 | } // aod 14 | -------------------------------------------------------------------------------- /src/aod/s7/foreign_primitives.hpp: -------------------------------------------------------------------------------- 1 | #pragma once 2 | 3 | #include "s7.h" 4 | 5 | namespace aod { 6 | namespace s7 { 7 | namespace foreign { 8 | void bind_primitives(s7_scheme *sc, s7_pointer env); 9 | inline void bind_primitives(s7_scheme *sc){ 10 | s7_pointer env = s7_inlet(sc, s7_nil(sc)); 11 | s7_gc_protect(sc, env); 12 | bind_primitives(sc, env); 13 | } 14 | int tag_bool(s7_scheme* sc); 15 | int tag_int(s7_scheme* sc); 16 | int tag_float(s7_scheme* sc); 17 | } 18 | } 19 | } 20 | -------------------------------------------------------------------------------- /src/aod/s7/foreign_primitives_arr.hpp: -------------------------------------------------------------------------------- 1 | #pragma once 2 | 3 | #include "s7.h" 4 | #include 5 | 6 | namespace aod { 7 | namespace s7 { 8 | namespace foreign { 9 | // https://stackoverflow.com/a/17014793 10 | // template 11 | // inline 12 | // std::size_t arr_size(const T (&v)[S]) 13 | // { 14 | // return S; 15 | // } 16 | 17 | void bind_primitives_arr(s7_scheme *sc, s7_pointer env); 18 | inline void bind_primitives_arr(s7_scheme *sc){ 19 | s7_pointer env = s7_inlet(sc, s7_nil(sc)); 20 | s7_gc_protect(sc, env); 21 | bind_primitives_arr(sc, env); 22 | } 23 | int tag_bool_arr(s7_scheme* sc); 24 | int tag_int_arr(s7_scheme* sc); 25 | int tag_float_arr(s7_scheme* sc); 26 | int tag_char_arr(s7_scheme* sc); 27 | } 28 | } 29 | } 30 | -------------------------------------------------------------------------------- /src/aod/s7/gl.cpp: -------------------------------------------------------------------------------- 1 | #include "s7.h" 2 | #include "aod/gl/gl.hpp" 3 | #include 4 | 5 | namespace aod { 6 | namespace s7 { 7 | namespace gl { 8 | 9 | s7_pointer save_screenshot(s7_scheme *sc, s7_pointer args) { 10 | s7_pointer filename = s7_car(args); 11 | if (!s7_is_string(filename)) { 12 | return (s7_wrong_type_arg_error(sc, "save-screenshot", 1, filename, 13 | "Expecting string (filename)")); 14 | } 15 | const char *char_filename = s7_string(filename); 16 | int res = aod::gl::save_screenshot(char_filename); 17 | if (res != 1) { 18 | return s7_error(sc, s7_make_symbol(sc, "aod.c.gl"), 19 | s7_list(sc, 2, 20 | s7_make_string(sc, "Could not save screenshot at ~A\n"), 21 | filename 22 | )); 23 | 24 | } 25 | return s7_nil(sc); 26 | } 27 | 28 | void bind(s7_scheme *sc) { 29 | s7_pointer env = s7_inlet(sc, s7_nil(sc)); 30 | s7_gc_protect(sc, env); 31 | 32 | s7_define(sc, env, s7_make_symbol(sc, "save-screenshot"), 33 | s7_make_function(sc, "save-screenshot", save_screenshot, 1, 0, false, 34 | "(save-screenshot filename) Saves a screenshot of the current gl context")); 35 | 36 | s7_define_variable(sc, "aod.c.gl", env); 37 | } 38 | 39 | } // gl 40 | } // s7 41 | } // aod 42 | -------------------------------------------------------------------------------- /src/aod/s7/gl.hpp: -------------------------------------------------------------------------------- 1 | #include "s7.h" 2 | 3 | namespace aod { 4 | namespace s7 { 5 | namespace gl { 6 | 7 | void bind(s7_scheme *sc); 8 | 9 | } // gl 10 | } // s7 11 | } // aod 12 | -------------------------------------------------------------------------------- /src/aod/s7/img.cpp: -------------------------------------------------------------------------------- 1 | #include "s7.h" 2 | #include "aod/img/core.hpp" 3 | #include 4 | 5 | namespace aod { 6 | namespace s7 { 7 | namespace img { 8 | 9 | s7_pointer equivalent(s7_scheme* sc, s7_pointer args) { 10 | s7_pointer img1 = s7_car(args); 11 | if (!s7_is_string(img1)) 12 | return (s7_wrong_type_arg_error(sc, "equivalent?", 1, img1, 13 | "img1-filename string")); 14 | 15 | s7_pointer img2 = s7_cadr(args); 16 | if (!s7_is_string(img2)) 17 | return (s7_wrong_type_arg_error(sc, "equivalent?", 2, img2, 18 | "img2-filename string")); 19 | 20 | const char* img1_char = s7_string(img1); 21 | const char* img2_char = s7_string(img2); 22 | bool res = aod::img::are_equivalent(img1_char, img2_char); 23 | // fprintf(stderr, "tested %s against %s, result %d\n", img1_char, img2_char, res ? 1 : 0); 24 | 25 | return s7_make_boolean(sc, res); 26 | } 27 | 28 | void bind(s7_scheme* sc) { 29 | s7_pointer env = s7_inlet(sc, s7_nil(sc)); 30 | s7_gc_protect(sc, env); 31 | 32 | s7_define(sc, env, s7_make_symbol(sc, "equivalent?"), 33 | s7_make_function(sc, "equivalent?", equivalent, 2, 0, false, 34 | "(equivalent? img1-filename img2-filename) Returns true if the images are equivalent")); 35 | 36 | s7_define_variable(sc, "aod.c.img", env); 37 | 38 | } 39 | } //img 40 | } // s7 41 | } // aod 42 | -------------------------------------------------------------------------------- /src/aod/s7/img.hpp: -------------------------------------------------------------------------------- 1 | #pragma once 2 | #include "s7.h" 3 | 4 | namespace aod { 5 | namespace s7 { 6 | namespace img { 7 | 8 | void bind(s7_scheme* sc); 9 | 10 | } //img 11 | } // s7 12 | } // aod 13 | -------------------------------------------------------------------------------- /src/aod/s7/imgui/addons.cpp: -------------------------------------------------------------------------------- 1 | #include "aod/imgui/addons.hpp" 2 | #include "s7.h" 3 | 4 | namespace aod { 5 | namespace s7 { 6 | namespace imgui { 7 | 8 | s7_pointer knob(s7_scheme *sc, s7_pointer args) { 9 | s7_pointer title = s7_car(args); 10 | if (!s7_is_string(title)) { 11 | return (s7_wrong_type_arg_error(sc, "imgui/knob", 1, title, 12 | "First argument is title, should be a string")); 13 | } 14 | s7_pointer c_float = s7_cadr(args); 15 | if (!s7_is_c_object(c_float)) { 16 | return (s7_wrong_type_arg_error(sc, "imgui/knob", 2, c_float, 17 | "Expeting a c-type : float")); 18 | } 19 | 20 | const char *title_char = s7_string(title); 21 | float *value = (float*) s7_c_object_value(c_float); 22 | float min = s7_number_to_real(sc, s7_caddr(args)); 23 | float max = s7_number_to_real(sc, s7_cadddr(args)); 24 | aod::imgui::Knob(title_char, value, min, max); 25 | return s7_nil(sc); 26 | } 27 | 28 | void bind_knob(s7_scheme *sc) { 29 | s7_define_function(sc, "imgui/knob", knob, // .. 30 | 4, // req args 31 | 0, // optional args (the open boolean pointer) 32 | false, // rest args 33 | "Draws a knob. (string label, float* value, float min, float max)"); 34 | } 35 | 36 | } 37 | } 38 | } 39 | -------------------------------------------------------------------------------- /src/aod/s7/imgui/addons.hpp: -------------------------------------------------------------------------------- 1 | #pragma once 2 | 3 | #include "s7.h" 4 | 5 | namespace aod{ 6 | namespace s7{ 7 | namespace imgui{ 8 | 9 | void bind_knob(s7_scheme* sc); 10 | 11 | } 12 | } 13 | } 14 | -------------------------------------------------------------------------------- /src/aod/s7/imgui/enums.hpp: -------------------------------------------------------------------------------- 1 | #pragma once 2 | 3 | #include "s7.h" 4 | 5 | namespace aod { 6 | namespace s7 { 7 | namespace imgui { 8 | namespace enums { 9 | 10 | // binds all the color constants under aod.c.imgui.col 11 | void bind(s7_scheme *sc); 12 | } 13 | 14 | } // imgui 15 | } // s7 16 | } // aod 17 | -------------------------------------------------------------------------------- /src/aod/s7/imgui/imgui.hpp: -------------------------------------------------------------------------------- 1 | #pragma once 2 | 3 | #include "s7.h" 4 | 5 | namespace aod { 6 | namespace s7 { 7 | namespace imgui { 8 | 9 | void bind(s7_scheme *sc); 10 | 11 | } // imgui 12 | } // s7 13 | } // aod 14 | -------------------------------------------------------------------------------- /src/aod/s7/imgui_sdl.cpp: -------------------------------------------------------------------------------- 1 | // for creating the window and drawing ourselves 2 | // not having an event loop that calls us 3 | // this is meant for quick prototyping of drawing 4 | 5 | #include "./imgui_sdl.hpp" 6 | #include "imgui_impl_sdl.h" 7 | #include "imgui_impl_opengl2.h" 8 | #include "imgui.h" 9 | #include "SDL.h" 10 | #include "SDL_opengl.h" 11 | #include //fprintf 12 | 13 | namespace aod { 14 | namespace s7 { 15 | namespace imgui_sdl { 16 | 17 | struct Data { 18 | SDL_Window* window; 19 | SDL_GLContext gl_context; 20 | bool destroyed = false; 21 | bool should_quit = false; 22 | }; 23 | 24 | s7_pointer setup(s7_scheme* sc, s7_pointer args) { 25 | int w = s7_number_to_integer(sc, s7_list_ref(sc, args, 0)); 26 | int h = s7_number_to_integer(sc, s7_list_ref(sc, args, 1)); 27 | SDL_WindowFlags window_flags = (SDL_WindowFlags)(SDL_WINDOW_OPENGL 28 | | SDL_WINDOW_RESIZABLE | SDL_WINDOW_ALLOW_HIGHDPI); 29 | SDL_Window* window = SDL_CreateWindow("Dear ImGui SDL2+OpenGL example", 30 | SDL_WINDOWPOS_CENTERED, SDL_WINDOWPOS_CENTERED, w, h, 31 | window_flags); 32 | 33 | if (window == NULL) { 34 | fprintf(stderr, "Could not create SDL window"); 35 | return s7_error(sc, s7_make_symbol(sc, "sdl-error"), 36 | s7_cons(sc, s7_make_string(sc, "Could not create SDL window"), s7_nil(sc))); 37 | } 38 | 39 | SDL_GLContext gl_context = SDL_GL_CreateContext(window); 40 | SDL_GL_MakeCurrent(window, gl_context); 41 | SDL_GL_SetSwapInterval(1); // Enable vsync 42 | 43 | IMGUI_CHECKVERSION(); 44 | ImGui::CreateContext(); 45 | ImGuiIO &io = ImGui::GetIO(); 46 | io.IniFilename = NULL; // Disable imgui.ini 47 | (void) io; 48 | 49 | ImGui_ImplSDL2_InitForOpenGL(window, gl_context); 50 | ImGui_ImplOpenGL2_Init(); 51 | 52 | 53 | Data* data = new Data; 54 | data->window = window; 55 | data->gl_context = gl_context; 56 | 57 | return s7_make_c_pointer(sc, (void*)data); 58 | } 59 | 60 | s7_pointer prepare(s7_scheme* sc, s7_pointer args) { 61 | Data* data = (Data*) s7_c_pointer(s7_car(args)); 62 | if (data->destroyed) { 63 | return s7_error(sc, s7_make_symbol(sc, "imgui-sdl-error"), 64 | s7_cons(sc, s7_make_string(sc, "Already destroyed"), s7_nil(sc))); 65 | } 66 | ImGui_ImplOpenGL2_NewFrame(); 67 | ImGui_ImplSDL2_NewFrame(data->window); 68 | ImGui::NewFrame(); 69 | 70 | return s7_nil(sc); 71 | } 72 | 73 | s7_pointer destroy(s7_scheme* sc, s7_pointer args) { 74 | Data* data = (Data*) s7_c_pointer(s7_car(args)); 75 | if (data->destroyed) { 76 | return s7_error(sc, s7_make_symbol(sc, "imgui-sdl-error"), 77 | s7_cons(sc, s7_make_string(sc, "Already destroyed"), s7_nil(sc))); 78 | } 79 | 80 | ImGui_ImplOpenGL2_Shutdown(); 81 | ImGui_ImplSDL2_Shutdown(); 82 | ImGui::DestroyContext(); 83 | 84 | SDL_GL_DeleteContext(data->gl_context); 85 | SDL_DestroyWindow(data->window); 86 | SDL_Quit(); 87 | 88 | data->destroyed = true; 89 | 90 | return s7_nil(sc); 91 | } 92 | 93 | s7_pointer flush(s7_scheme* sc, s7_pointer args) { 94 | Data* data = (Data*) s7_c_pointer(s7_car(args)); 95 | if (data->destroyed) { 96 | return s7_error(sc, s7_make_symbol(sc, "imgui-sdl-error"), 97 | s7_cons(sc, s7_make_string(sc, "Already destroyed"), s7_nil(sc))); 98 | } 99 | ImGui::Render(); 100 | ImGuiIO &io = ImGui::GetIO(); 101 | 102 | SDL_Event event; 103 | while (SDL_PollEvent(&event)) { 104 | ImGui_ImplSDL2_ProcessEvent(&event); 105 | if (event.type == SDL_QUIT) { 106 | fprintf(stderr, "Got SDL quit signal\n"); 107 | data->should_quit = true; 108 | // should i destroy here, or after painting..? 109 | return destroy(sc, args); 110 | } 111 | } 112 | 113 | glViewport(0, 0, (int) io.DisplaySize.x, (int) io.DisplaySize.y); 114 | glClearColor(0, 0, 0, 0); 115 | glClear(GL_COLOR_BUFFER_BIT); 116 | //glUseProgram(0); // You may want this if using this code in an OpenGL 3+ context where shaders may be bound 117 | ImGui_ImplOpenGL2_RenderDrawData(ImGui::GetDrawData()); 118 | SDL_GL_SwapWindow(data->window); 119 | 120 | return s7_nil(sc); 121 | 122 | } 123 | 124 | void bind(s7_scheme* sc) { 125 | s7_pointer env = s7_inlet(sc, s7_nil(sc)); 126 | s7_gc_protect(sc, env); 127 | // other possible names: 128 | // imgui-proto (for prototype) 129 | // imgui-playground 130 | // imgui-scratch 131 | 132 | s7_define(sc, env, s7_make_symbol(sc, "setup"), 133 | s7_make_function(sc, "setup", setup, 2, 0, false, 134 | "(setup width height) returns *window\n" 135 | "Creates a new SDL_Window, setups opengl, inits imgui")); 136 | 137 | s7_define(sc, env, s7_make_symbol(sc, "prepare"), 138 | s7_make_function(sc, "prepare", prepare, 1, 0, false, 139 | "(prepare void*) To be called before calling any ImGui draw functionality")); 140 | 141 | s7_define(sc, env, s7_make_symbol(sc, "flush"), 142 | s7_make_function(sc, "flush", flush, 1, 0, false, 143 | "(flush void*) To be called after having called any ImGui draw functionality. Paints the window")); 144 | 145 | s7_define(sc, env, s7_make_symbol(sc, "destroy"), 146 | s7_make_function(sc, "destroy", destroy, 1, 0, false, 147 | "(destroy *window) Destroys the window & the opengl context")); 148 | 149 | s7_define(sc, env, s7_make_symbol(sc, "*ns-doc*"), 150 | s7_make_string(sc, "Bindings to manually create an SDL_Window and draw to it with imgui. This is to use directly from a simple repl.\n" 151 | "ie when no (draw) function is to be called by anyone.")); 152 | 153 | 154 | s7_define_variable(sc, "aod.c.imgui-sdl", env); 155 | } 156 | 157 | } // imgui_sdl 158 | } // s7 159 | } // aod 160 | -------------------------------------------------------------------------------- /src/aod/s7/imgui_sdl.hpp: -------------------------------------------------------------------------------- 1 | // for creating the window and drawing ourselves 2 | // not having an event loop that calls us 3 | // this is meant for quick prototyping of drawing 4 | 5 | #include "s7.h" 6 | namespace aod { 7 | namespace s7 { 8 | namespace imgui_sdl { 9 | 10 | void bind(s7_scheme* sc); 11 | 12 | } // imgui_sdl 13 | } // s7 14 | } // aod 15 | -------------------------------------------------------------------------------- /src/aod/s7/midi.cpp: -------------------------------------------------------------------------------- 1 | #include "s7.h" 2 | #include "aod/midi/midi.hpp" 3 | 4 | namespace aod { 5 | namespace s7 { 6 | namespace midi { 7 | 8 | s7_pointer is_note_on(s7_scheme* sc, s7_pointer args) { 9 | uint8_t status = s7_integer(s7_car(args)); 10 | uint8_t data1 = s7_integer(s7_cadr(args)); 11 | uint8_t data2 = s7_integer(s7_caddr(args)); 12 | 13 | return s7_make_boolean(sc, aod::midi::is_note_on(status, data1, data2)); 14 | } 15 | 16 | s7_pointer is_note_off(s7_scheme* sc, s7_pointer args) { 17 | uint8_t status = s7_integer(s7_car(args)); 18 | uint8_t data1 = s7_integer(s7_cadr(args)); 19 | uint8_t data2 = s7_integer(s7_caddr(args)); 20 | 21 | return s7_make_boolean(sc, aod::midi::is_note_off(status, data1, data2)); 22 | } 23 | 24 | s7_pointer note_number(s7_scheme* sc, s7_pointer args) { 25 | uint8_t status = s7_integer(s7_car(args)); 26 | uint8_t data1 = s7_integer(s7_cadr(args)); 27 | uint8_t data2 = s7_integer(s7_caddr(args)); 28 | 29 | return s7_make_integer(sc, aod::midi::note_number(status, data1, data2)); 30 | } 31 | 32 | void bind(s7_scheme* sc) { 33 | s7_pointer env = s7_inlet(sc, s7_nil(sc)); 34 | s7_gc_protect(sc, env); 35 | 36 | s7_define(sc, env, s7_make_symbol(sc, "note-on?"), 37 | s7_make_function(sc, "note-on?", is_note_on, 3, 0, 0, "(note-on? status data1 data2)") 38 | ); 39 | 40 | s7_define(sc, env, s7_make_symbol(sc, "note-off?"), 41 | s7_make_function(sc, "note-off?", is_note_off, 3, 0, 0, "(note-off? status data1 data2)") 42 | ); 43 | 44 | s7_define(sc, env, s7_make_symbol(sc, "note-number"), 45 | s7_make_function(sc, "note-number", note_number, 3, 0, 0, "(note-number status data1 data2) Returns either the note or -1") 46 | ); 47 | 48 | s7_define_constant(sc, "aod.c.midi", env); 49 | 50 | } 51 | } // midi 52 | } //s7 53 | }// aod 54 | -------------------------------------------------------------------------------- /src/aod/s7/midi.hpp: -------------------------------------------------------------------------------- 1 | #pragma once 2 | #include "s7.h" 3 | 4 | namespace aod { 5 | namespace s7 { 6 | namespace midi { 7 | void bind(s7_scheme* sc); 8 | } // midi 9 | } //s7 10 | }// aod 11 | -------------------------------------------------------------------------------- /src/aod/s7/nfd.cpp: -------------------------------------------------------------------------------- 1 | #include "./nfd.hpp" 2 | #include "aod/nfd.hpp" 3 | namespace aod { 4 | namespace s7 { 5 | namespace nfd { 6 | 7 | const char* help_open = "(open) Open file dialog. Returns either the selected filename or #f"; 8 | s7_pointer open(s7_scheme* sc, s7_pointer) { 9 | auto file = aod::nfd::open(); 10 | if (file) { 11 | std::string file_str = file.value(); 12 | return s7_make_string(sc, file_str.c_str()); 13 | } 14 | // NOTE: s7_nil(sc) behaves like #t in (if .. ) 15 | return s7_f(sc); 16 | } 17 | 18 | const char* help_save = "(save) Save file dialog. Returns either the selected target filename or #f"; 19 | s7_pointer save(s7_scheme* sc, s7_pointer) { 20 | auto file = aod::nfd::save(); 21 | if (file) { 22 | std::string file_str = file.value(); 23 | return s7_make_string(sc, file_str.c_str()); 24 | } 25 | // NOTE: s7_nil(sc) behaves like #t in (if .. ) 26 | return s7_f(sc); 27 | } 28 | 29 | void bind(s7_scheme* sc) { 30 | s7_pointer env = s7_inlet(sc, s7_nil(sc)); 31 | s7_gc_protect(sc, env); 32 | 33 | s7_define(sc, env, s7_make_symbol(sc, "open"), 34 | s7_make_function(sc, "open", open, 0, 0, false, 35 | help_open)); 36 | 37 | s7_define(sc, env, s7_make_symbol(sc, "save"), 38 | s7_make_function(sc, "save", save, 0, 0, false, 39 | help_save)); 40 | 41 | s7_define(sc, env, s7_make_symbol(sc, "*ns-doc*"), 42 | s7_make_string(sc, "Some [nativefiledialog](https://github.com/mlabbe/nativefiledialog) bindings ")); 43 | 44 | 45 | // or call it native-file-dialog? 46 | s7_define_constant(sc, "aod.c.nfd", env); 47 | } 48 | } 49 | } 50 | } 51 | -------------------------------------------------------------------------------- /src/aod/s7/nfd.hpp: -------------------------------------------------------------------------------- 1 | #include "s7.h" 2 | namespace aod { 3 | namespace s7 { 4 | namespace nfd { 5 | void bind(s7_scheme* sc); 6 | } 7 | } 8 | } 9 | -------------------------------------------------------------------------------- /src/aod/s7/repl.cpp: -------------------------------------------------------------------------------- 1 | #include "./repl.hpp" 2 | #include 3 | #include 4 | using std::cout; 5 | using std::cerr; 6 | using std::endl; 7 | 8 | namespace aod { 9 | namespace s7 { 10 | 11 | void repl_print_stderr(s7_scheme *sc, uint8_t c, s7_pointer port) { 12 | fprintf(stderr, "%c", c); 13 | } 14 | 15 | Repl::Repl(s7_scheme *sc) { 16 | this->sc = sc; 17 | last_form = s7_nil(sc); 18 | 19 | // debug 20 | s7_set_current_output_port(sc, 21 | s7_open_output_function(sc, repl_print_stderr)); 22 | } 23 | /** 24 | * Returns true if the input string could be read (valid form). 25 | * Otherwise returns false. 26 | * 27 | * In case where the input doesn't constitute a valid form, 28 | * the input is stored and any following with the clearPreviousInput flag 29 | * set to false, build up the stored input until it constitues a valid form. 30 | * 31 | * If the result is true, you can then call the 32 | */ 33 | bool Repl::handleInput(const char* str, bool clearPreviousInput) { 34 | 35 | if (clearPreviousInput) { 36 | input_buffer.clear(); 37 | } 38 | // completing previous input that could not be read 39 | input_buffer += str; 40 | 41 | // cerr << "input str " << str << "buffer " << input_buffer << endl; 42 | 43 | std::string wrapped; 44 | // clojure style namespace. 45 | if (s7_boolean(sc, s7_eval_c_string(sc, "(and (defined? '*ns*) (let? *ns*))"))) { 46 | if (std::regex_search(input_buffer, repl::NS_REGEXP)) { 47 | // if the input_buffer is "(ns ...)" then skip wrapping 48 | // that makes the eval-hook easy to recognize such eval'd forms 49 | // one just has to check (eq? 'ns (car (hook 'form))) 50 | wrapped = input_buffer; 51 | } else { 52 | wrapped = "(with-let *ns* (begin " + input_buffer + "))"; 53 | } 54 | } else { 55 | wrapped = "(begin " + input_buffer + ")"; 56 | } 57 | 58 | const char *c_str = wrapped.c_str(); 59 | s7_pointer port = s7_open_input_string(sc, c_str); 60 | 61 | s7_pointer err = s7_open_output_string(sc); 62 | s7_pointer err_prev = s7_set_current_error_port(sc, err); 63 | 64 | // shall raise error if input isn't valid 65 | s7_pointer form = s7_read(sc, port); 66 | s7_close_input_port(sc, port); 67 | s7_set_current_error_port(sc, err_prev); 68 | 69 | const char *errmsg = s7_get_output_string(sc, err); 70 | s7_close_output_port(sc, err); 71 | if ((errmsg) && (*errmsg)) { 72 | return false; 73 | } else { 74 | // cerr << "wrapped form " << wrapped << endl;; 75 | last_form = form; 76 | input_buffer.clear(); 77 | } 78 | 79 | return true; 80 | } 81 | 82 | /** 83 | * Should be called after handleInput returns true 84 | */ 85 | std::string Repl::evalLastForm() { 86 | 87 | s7_pointer out = s7_open_output_string(sc); 88 | s7_pointer out_prev = s7_set_current_output_port(sc, out); 89 | 90 | s7_pointer res = s7_eval(sc, last_form, s7_nil(sc)); 91 | char *res_str = s7_object_to_c_string(sc, res); // has to be freed 92 | 93 | const char *out_str = s7_get_output_string(sc, out); 94 | 95 | s7_pointer eval_hook = s7_eval_c_string(sc, "(and (defined? 'aod.c.repl) (aod.c.repl '*eval-hook*))"); 96 | 97 | if (eval_hook != s7_f(sc)) { 98 | // s7_is_function not working with the hook (returns false) 99 | // if (s7_is_function(eval_hook)) { 100 | s7_call(sc, eval_hook, 101 | s7_list(sc, 102 | 3, 103 | last_form, 104 | res, 105 | s7_make_string(sc, out_str) 106 | ) 107 | ); 108 | } else { 109 | // std::cerr << "No eval hook??\n"; 110 | } 111 | 112 | std::string str = res_str; 113 | s7_close_output_port(sc, out); 114 | s7_set_current_output_port(sc, out_prev); 115 | 116 | delete[] res_str; 117 | 118 | return str; 119 | } 120 | 121 | namespace repl { 122 | 123 | // aod.c.repl bindings 124 | // *eval-hook* etc 125 | const std::regex NS_REGEXP("^\\(ns [a-zA-Z.-]+\\)"); 126 | 127 | void bind(s7_scheme* sc) { 128 | s7_pointer env = s7_inlet(sc, s7_nil(sc)); 129 | s7_gc_protect(sc, env); 130 | 131 | // not sure about eval with evnironment or not 132 | s7_pointer eval_hook = s7_eval_c_string_with_environment(sc, "(make-hook 'form 'res 'out)", env); 133 | 134 | s7_define(sc, env, s7_make_symbol(sc, "*eval-hook*"), 135 | eval_hook); 136 | 137 | s7_define_variable(sc, "aod.c.repl", env); 138 | } 139 | } // repl 140 | 141 | } // s7 142 | 143 | } // aod 144 | 145 | -------------------------------------------------------------------------------- /src/aod/s7/repl.hpp: -------------------------------------------------------------------------------- 1 | #pragma once 2 | 3 | #include 4 | #include "s7.h" 5 | #include 6 | #include 7 | 8 | namespace aod { 9 | namespace s7 { 10 | 11 | class Repl { 12 | private: 13 | s7_scheme *sc; 14 | // holds the user input. it fills until a valid sexp is introduced 15 | std::string input_buffer; 16 | s7_pointer last_form; 17 | 18 | public: 19 | 20 | inline Repl() : 21 | Repl(s7_init()) { 22 | } 23 | Repl(s7_scheme *sc); 24 | 25 | /** 26 | * Returns true if the input string could be read (valid form). 27 | * Otherwise returns false. 28 | * 29 | * In case where the input doesn't constitute a valid form, 30 | * the input is stored and any following with the clearPreviousInput flag 31 | * set to false, build up the stored input until it constitues a valid form. 32 | * 33 | * If the result is true, you can then call the evalLastForm 34 | */ 35 | bool handleInput(const char* str, bool clearPreviousInput = false); 36 | 37 | /** 38 | * Should be called after handleInput returns true 39 | */ 40 | std::string evalLastForm(); 41 | }; 42 | 43 | namespace repl { 44 | extern const std::regex NS_REGEXP; 45 | // 46 | // aod.c.repl bindings 47 | // *eval-hook* etc 48 | extern void bind(s7_scheme* sc); 49 | } 50 | 51 | } // s7 52 | } // aod 53 | -------------------------------------------------------------------------------- /src/aod/s7/sdl.cpp: -------------------------------------------------------------------------------- 1 | #include "./sdl.hpp" 2 | #include "s7.h" 3 | 4 | namespace aod { 5 | namespace s7 { 6 | namespace sdl { 7 | 8 | s7_pointer set_window_size(s7_scheme *sc, s7_pointer args) { 9 | int w = s7_number_to_integer(sc, s7_car(args)); 10 | int h = s7_number_to_integer(sc, s7_cadr(args)); 11 | 12 | SDL_Window *win = (SDL_Window*) s7_c_pointer( 13 | s7_eval_c_string(sc, "sdl/*window*")); 14 | SDL_SetWindowSize(win, w, h); 15 | return s7_nil(sc); 16 | } 17 | 18 | s7_pointer delay(s7_scheme* sc, s7_pointer args) { 19 | SDL_Delay(s7_integer(s7_car(args))); 20 | 21 | return s7_nil(sc); 22 | } 23 | 24 | void bind_TODO_REMOVE(s7_scheme *sc, SDL_Window *window) { 25 | s7_pointer sc_sdl_window = s7_make_c_pointer(sc, window); 26 | // not sure if this is needed 27 | s7_gc_protect(sc, sc_sdl_window); 28 | s7_define(sc, s7_nil(sc), s7_make_symbol(sc, "sdl/*window*"), 29 | sc_sdl_window); 30 | 31 | s7_define_function(sc, "sdl/set-window-size!", set_window_size, 2, 0, false, 32 | "(w h) sets the size of the sdl window"); 33 | 34 | 35 | // hmm.. should clean up the old code 36 | 37 | s7_pointer env = s7_inlet(sc, s7_nil(sc)); 38 | s7_gc_protect(sc, env); 39 | s7_define(sc, env, s7_make_symbol(sc, "delay"), 40 | s7_make_function(sc, "delay", delay, 41 | 1, // req args 42 | 0, // optional args: thickness 43 | false, // rest args 44 | "SDL_Delay")); 45 | s7_define_variable(sc, "aod.c.sdl", env); 46 | } 47 | 48 | void bind(s7_scheme *sc) { 49 | s7_pointer env = s7_inlet(sc, s7_nil(sc)); 50 | s7_gc_protect(sc, env); 51 | 52 | s7_define(sc, env, s7_make_symbol(sc, "delay"), 53 | s7_make_function(sc, "delay", delay, 54 | 1, // req args 55 | 0, // optional args: thickness 56 | false, // rest args 57 | "SDL_Delay")); 58 | s7_define_variable(sc, "aod.c.sdl", env); 59 | } 60 | } 61 | } 62 | } 63 | -------------------------------------------------------------------------------- /src/aod/s7/sdl.hpp: -------------------------------------------------------------------------------- 1 | #pragma once 2 | 3 | #include "SDL.h" 4 | #include "s7.h" 5 | 6 | namespace aod { 7 | namespace s7 { 8 | namespace sdl { 9 | /** 10 | * Notice extra space to avoid c++ warning -Wcomment 11 | * defines under sdl/ *window* and (sdl/set-window-size! w h) 12 | */ 13 | void bind_TODO_REMOVE(s7_scheme *sc, SDL_Window *window); 14 | void bind(s7_scheme *sc); 15 | 16 | } 17 | } 18 | } 19 | -------------------------------------------------------------------------------- /src/aod/sdl.cpp: -------------------------------------------------------------------------------- 1 | // hm.. 2 | // apparently I need to include it first to have os specific SDL_SysWMinfo 3 | // that is to get the definition SDL_VIDEO_DRIVER_X11 for example 4 | // that is from meson include dir order...? anyway.. 5 | #include "SDL_config.h" 6 | #include "./sdl.hpp" 7 | #include "SDL_video.h" 8 | #include // sprintf 9 | 10 | #ifdef __linux__ 11 | #include "SDL_syswm.h" 12 | #include 13 | #include 14 | #include 15 | 16 | #endif 17 | 18 | /** 19 | * The problem was the SDL_CreateWindowFrom and the opengl flags. 20 | * In windows, the following snippet is the solution 21 | * 22 | * 23 | * 24 | SDL_Window *dummyWin = SDL_CreateWindow("", 0, 0, 1, 1, 25 | SDL_WINDOW_OPENGL | SDL_WINDOW_HIDDEN); 26 | 27 | char sBuf[32]; 28 | sprintf(sBuf, "%p", dummyWin); 29 | printf("dummy window %p\n", dummyWin); 30 | 31 | printf("Setting hint SDL_HINT_VIDEO_WINDOW_SHARE_PIXEL_FORMAT to %s\n", 32 | sBuf); 33 | SDL_SetHint(SDL_HINT_VIDEO_WINDOW_SHARE_PIXEL_FORMAT, sBuf); 34 | 35 | const char *hint = SDL_GetHint(SDL_HINT_VIDEO_WINDOW_SHARE_PIXEL_FORMAT); 36 | 37 | SDL_Window *window = SDL_CreateWindowFrom(that->pParent); 38 | SDL_SetHint(SDL_HINT_VIDEO_WINDOW_SHARE_PIXEL_FORMAT, nullptr); 39 | * 40 | * 41 | * 42 | * While on Windows that works, in Linux I had to use a fork of mine from SDL. 43 | * 44 | * So, I realized, it could be better to just be able to modify the flags of a window myself. 45 | * For that, the definition of SDL_Window is needed 46 | * 47 | */ 48 | 49 | #ifdef AOD_SDL_WINDOW_FLAGS_HACK 50 | /* 51 | Enables us to modify SDL_Window flags. 52 | This is to enable the opengl flag when using SDL_CreateWindowFrom. 53 | In windows there is way with the SDL_SetHint, but in linux this is not available. 54 | 2 solutions: 55 | - either include this code (but note: it's depending on the sdl version. I disabled 56 | this cause I changed version and it was no longer working) 57 | - or use my for of sdl that contains the linux fix 58 | see https://github.com/actonDev/SDL/commit/25bc95574808e140c794a6f0bbf84b8d159823e5 59 | */ 60 | 61 | /** \brief A union containing parameters for shaped windows. */ 62 | 63 | typedef union { 64 | /** \brief a cutoff alpha value for binarization of the window shape's alpha channel. */ 65 | Uint8 binarizationCutoff; 66 | SDL_Color colorKey; 67 | } SDL_WindowShapeParams; 68 | 69 | /** \brief An enum denoting the specific type of contents present in an SDL_WindowShapeParams union. */ 70 | typedef enum { 71 | /** \brief The default mode, a binarized alpha cutoff of 1. */ 72 | ShapeModeDefault, 73 | /** \brief A binarized alpha cutoff with a given integer value. */ 74 | ShapeModeBinarizeAlpha, 75 | /** \brief A binarized alpha cutoff with a given integer value, but with the opposite comparison. */ 76 | ShapeModeReverseBinarizeAlpha, 77 | /** \brief A color key is applied. */ 78 | ShapeModeColorKey 79 | } WindowShapeMode; 80 | 81 | typedef struct SDL_WindowShapeMode { 82 | /** \brief The mode of these window-shape parameters. */ 83 | WindowShapeMode mode; 84 | /** \brief Window-shape parameters. */ 85 | SDL_WindowShapeParams parameters; 86 | } SDL_WindowShapeMode; 87 | 88 | /* Define the SDL window-shaper structure */ 89 | struct SDL_WindowShaper { 90 | /* The window associated with the shaper */ 91 | SDL_Window *window; 92 | 93 | /* The user's specified coordinates for the window, for once we give it a shape. */ 94 | Uint32 userx, usery; 95 | 96 | /* The parameters for shape calculation. */ 97 | SDL_WindowShapeMode mode; 98 | 99 | /* Has this window been assigned a shape? */ 100 | SDL_bool hasshape; 101 | 102 | void *driverdata; 103 | }; 104 | 105 | typedef struct SDL_WindowUserData { 106 | char *name; 107 | void *data; 108 | struct SDL_WindowUserData *next; 109 | } SDL_WindowUserData; 110 | 111 | struct SDL_Window { 112 | const void *magic; 113 | Uint32 id; 114 | char *title; 115 | SDL_Surface *icon; 116 | int x, y; 117 | int w, h; 118 | int min_w, min_h; 119 | int max_w, max_h; 120 | Uint32 flags; 121 | Uint32 last_fullscreen_flags; 122 | 123 | /* Stored position and size for windowed mode */ 124 | SDL_Rect windowed; 125 | 126 | SDL_DisplayMode fullscreen_mode; 127 | 128 | float opacity; 129 | 130 | float brightness; 131 | Uint16 *gamma; 132 | Uint16 *saved_gamma; /* (just offset into gamma) */ 133 | 134 | SDL_Surface *surface; 135 | SDL_bool surface_valid; 136 | 137 | SDL_bool is_hiding; 138 | SDL_bool is_destroying; 139 | SDL_bool is_dropping; /* drag/drop in progress, expecting SDL_SendDropComplete(). */ 140 | 141 | SDL_WindowShaper *shaper; 142 | 143 | SDL_HitTest hit_test; 144 | void *hit_test_data; 145 | 146 | SDL_WindowUserData *data; 147 | 148 | void *driverdata; 149 | 150 | SDL_Window *prev; 151 | SDL_Window *next; 152 | }; 153 | 154 | #endif 155 | namespace aod { 156 | namespace sdl { 157 | 158 | #ifdef __linux__ 159 | namespace x11 { 160 | void fix_input(SDL_Window *window) { 161 | SDL_SysWMinfo info; 162 | SDL_VERSION(&info.version); /* initialize info structure with SDL version info */ 163 | if (!SDL_GetWindowWMInfo(window, &info)) { 164 | fprintf(stderr, 165 | "Could not get WM info. X11 input fix could not be applied!\n"); 166 | return; 167 | } 168 | Display *display = info.info.x11.display; 169 | Window w = info.info.x11.window; 170 | XSelectInput(display, w, 171 | (FocusChangeMask | EnterWindowMask | LeaveWindowMask | 172 | ExposureMask | ButtonPressMask | ButtonReleaseMask | 173 | PointerMotionMask | KeyPressMask | KeyReleaseMask | 174 | PropertyChangeMask | StructureNotifyMask | 175 | KeymapStateMask)); 176 | } 177 | 178 | } // x11 179 | #endif 180 | 181 | embedded_window embed_window(void *pParent, SDL_WindowFlags window_flags) { 182 | embedded_window emb; 183 | if (window_flags & SDL_WINDOW_OPENGL) { 184 | emb.dummy = SDL_CreateWindow("", 0, 0, 1, 1, 185 | SDL_WINDOW_OPENGL | SDL_WINDOW_HIDDEN); 186 | } else { 187 | emb.dummy = nullptr; 188 | } 189 | 190 | #ifdef AOD_SDL_WINDOW_FLAGS_HACK 191 | emb.window = SDL_CreateWindowFrom(pParent); 192 | emb.window->flags |= window_flags; 193 | #else 194 | // Note: for linux this needs my SDL fork 195 | // see https ://github.com/actonDev/SDL/commit/25bc95574808e140c794a6f0bbf84b8d159823e5 196 | char sBuf[32]; 197 | sprintf(sBuf, "%p", emb.dummy); 198 | SDL_SetHint(SDL_HINT_VIDEO_WINDOW_SHARE_PIXEL_FORMAT, sBuf); 199 | SDL_Window* window = SDL_CreateWindowFrom(pParent); 200 | // reverting the hint 201 | SDL_SetHint(SDL_HINT_VIDEO_WINDOW_SHARE_PIXEL_FORMAT, nullptr); 202 | emb.window = window; 203 | 204 | #endif 205 | 206 | #ifdef __linux__ 207 | x11::fix_input(emb.window); 208 | #endif 209 | 210 | return emb; 211 | } 212 | 213 | void destroy_embedded(embedded_window emb) { 214 | // that.. again needs a patch in SDL 215 | #if 0 216 | // SDL_DestroyWindow(SDL_Window * window) 217 | 218 | /* Restore video mode, etc. */ 219 | if (!(window->flags & SDL_WINDOW_FOREIGN)) { 220 | SDL_HideWindow(window); 221 | } 222 | #endif 223 | // if not.. it hangs (in windows at least) 224 | // in linux it wasn't, but I was having some errors now and then 225 | // maybe this solves it? 226 | SDL_DestroyWindow(emb.window); 227 | 228 | if (emb.dummy != nullptr) { 229 | SDL_DestroyWindow(emb.dummy); 230 | } 231 | } 232 | 233 | // Note: the original (working in Windows, not in linux) way to embed with opengl, is the following: 234 | 235 | // SDL_Window *dummyWin = SDL_CreateWindow("", 0, 0, 1, 1, 236 | // SDL_WINDOW_OPENGL | SDL_WINDOW_HIDDEN); 237 | 238 | // char sBuf[32]; 239 | // sprintf(sBuf, "%p", dummyWin); 240 | // printf("dummy window %p\n", dummyWin); 241 | // 242 | // printf("Setting hint SDL_HINT_VIDEO_WINDOW_SHARE_PIXEL_FORMAT to %s\n", 243 | // sBuf); 244 | // SDL_SetHint(SDL_HINT_VIDEO_WINDOW_SHARE_PIXEL_FORMAT, sBuf); 245 | // 246 | // const char *hint = SDL_GetHint(SDL_HINT_VIDEO_WINDOW_SHARE_PIXEL_FORMAT); 247 | // 248 | // SDL_Window *window = SDL_CreateWindowFrom(that->pParent); 249 | // SDL_SetHint(SDL_HINT_VIDEO_WINDOW_SHARE_PIXEL_FORMAT, nullptr); 250 | // 251 | // int flags = SDL_GetWindowFlags(window); 252 | // printf("old way window flags? %d\n", flags); 253 | // printf("window has opengl flag? %s\n", 254 | // (flags & SDL_WINDOW_OPENGL) ? "true" : "false"); 255 | 256 | } // sdl 257 | } // aod 258 | -------------------------------------------------------------------------------- /src/aod/sdl.hpp: -------------------------------------------------------------------------------- 1 | #pragma once 2 | #include "SDL.h" 3 | 4 | namespace aod { 5 | namespace sdl { 6 | 7 | typedef struct { 8 | SDL_Window *window; 9 | // dummy needed to initialize opengl properly apparently (at least in linux) 10 | SDL_Window *dummy; 11 | } embedded_window; 12 | 13 | embedded_window embed_window(void *pParent, SDL_WindowFlags window_flags); 14 | void destroy_embedded(embedded_window); 15 | 16 | } 17 | } 18 | -------------------------------------------------------------------------------- /src/aod/sdl/audio.cpp: -------------------------------------------------------------------------------- 1 | #include "./audio.hpp" 2 | 3 | namespace aod { 4 | namespace sdl { 5 | 6 | // https://gist.github.com/armornick/3447121 7 | // https://stackoverflow.com/questions/16838920/pointer-to-member-function-for-sdl-audio-callback 8 | 9 | // https://stackoverflow.com/questions/23844964/c-static-factory-constructor 10 | // could just return a raw pointer and let the caller put it in a unique_ptr, 11 | // but wanted to test this 12 | std::unique_ptr AudioObject::fromFile(const char* path) { 13 | 14 | std::unique_ptr obj(new AudioObject()); 15 | 16 | if (SDL_LoadWAV(path, &obj->wav_spec, &obj->wav_buffer, &obj->wav_length) == NULL) { 17 | fprintf(stderr, "Error: %s\n", SDL_GetError()); 18 | return std::unique_ptr {}; 19 | } 20 | 21 | obj->wav_spec.userdata = obj.get(); 22 | obj->wav_spec.callback = AudioObject::forwardCallback; 23 | 24 | obj->audio_pos = obj->wav_buffer; // copy sound buffer 25 | obj->audio_len = obj->wav_length; // copy file length 26 | return obj; 27 | // return std::move(obj); 28 | } 29 | 30 | AudioObject::~AudioObject() { 31 | fprintf(stderr, "AudioObject dtor\n"); 32 | freeWav(); 33 | } 34 | 35 | 36 | bool AudioObject::openAudio() { 37 | return SDL_OpenAudio(&wav_spec, NULL) >= 0; 38 | } 39 | 40 | void sdl::AudioObject::forwardCallback(void* userdata, Uint8* stream, int len) { 41 | static_cast(userdata)->onCallback(stream, len); 42 | } 43 | 44 | void AudioObject::onCallback(Uint8* stream, int len) { 45 | if (audio_len == 0) { 46 | stop(); 47 | return; 48 | } 49 | 50 | len = (len > audio_len ? audio_len : len); 51 | SDL_memcpy(stream, audio_pos, len); // simply copy from one buffer into the other 52 | // SDL_MixAudio(stream, audio_pos, len, SDL_MIX_MAXVOLUME);// mix from one buffer into another 53 | 54 | audio_pos += len; 55 | audio_len -= len; 56 | } 57 | 58 | bool AudioObject::finished() { 59 | return audio_len == 0; 60 | } 61 | 62 | void AudioObject::freeWav() { 63 | // if (wav_buffer != NULL) { 64 | if (!freed_wav) { 65 | SDL_FreeWAV(wav_buffer); 66 | freed_wav = true; 67 | } else { 68 | fprintf(stderr, "Have already freed\n"); 69 | } 70 | // having fun with glitch, not nulling the buffer pointer 71 | // wav_buffer = NULL; 72 | } 73 | 74 | void AudioObject::rewind() { 75 | audio_pos = wav_buffer; 76 | audio_len = wav_length; 77 | } 78 | 79 | void AudioObject::play() { 80 | openAudio(); 81 | rewind(); 82 | SDL_PauseAudio(0); 83 | } 84 | 85 | void AudioObject::glitch() { 86 | Uint8 *temp; 87 | // :o ! uninitialized hehe 88 | wav_buffer = temp; 89 | } 90 | 91 | 92 | void AudioObject::stop() { 93 | fprintf(stderr, "stop\n"); 94 | SDL_CloseAudio(); 95 | } 96 | 97 | } 98 | } 99 | -------------------------------------------------------------------------------- /src/aod/sdl/audio.hpp: -------------------------------------------------------------------------------- 1 | #include "SDL.h" 2 | #include "SDL_audio.h" 3 | #include 4 | 5 | namespace aod { 6 | namespace sdl { 7 | 8 | // experimental class, not really useful 9 | class AudioObject { 10 | private: 11 | bool freed_wav = false; 12 | inline AudioObject() {}; 13 | Uint32 wav_length; // length of our sample 14 | Uint8 *wav_buffer = nullptr; // buffer containing our audio file 15 | SDL_AudioSpec wav_spec; // the specs of our piece of music 16 | void onCallback(Uint8 *stream, int len); 17 | static void forwardCallback(void *userdata, Uint8 *stream, int len); 18 | Uint8 *audio_pos; 19 | Uint32 audio_len; 20 | int id = 0; 21 | 22 | public: 23 | ~AudioObject(); 24 | static std::unique_ptr fromFile(const char*); 25 | bool openAudio(); 26 | void play(); 27 | void stop(); 28 | bool finished(); 29 | void freeWav(); 30 | void rewind(); 31 | // sets the *wav_buffer to a new pointer. obviously, when played back it will be garbage 32 | // (hope it doesn't crash though) 33 | void glitch(); 34 | inline void setId(int id) { 35 | this->id = id; 36 | } 37 | }; 38 | } 39 | } 40 | -------------------------------------------------------------------------------- /src/aod/tcp_server.hpp: -------------------------------------------------------------------------------- 1 | #pragma once 2 | 3 | #include 4 | #include 5 | #include 6 | #include 7 | #include 8 | #include "SDL_net.h" 9 | #include "SDL.h" 10 | 11 | #define BUFFER_SIZE 512 12 | 13 | namespace aod { 14 | typedef std::function Callback; 15 | 16 | class TcpServer { 17 | private: 18 | bool running; 19 | IPaddress ip; 20 | TCPsocket sd; // Socket descriptor 21 | Callback cb; 22 | std::string init_msg; 23 | public: 24 | TcpServer() { 25 | running = false; 26 | } 27 | 28 | int listen(int port, Callback cb) { 29 | return listen(port, cb, ""); 30 | } 31 | 32 | int listen(int port, Callback cb, std::string init_msg) { 33 | fprintf(stderr, "tcp: listen\n"); 34 | if (running) { 35 | fprintf(stderr, "TCP server already running, skipping\n"); 36 | return -1; 37 | } 38 | this->cb = cb; 39 | this->init_msg = init_msg; 40 | 41 | int res = 0; 42 | if ((res = SDLNet_Init()) < 0) { 43 | fprintf(stderr, "SDLNet_Init: %s\n", SDLNet_GetError()); 44 | return res; 45 | } 46 | // jesus.. I cannot bind to "127.0.0.1" for listening.. this thing is open to the world 47 | char* host = NULL; // to listen, this has to be null 48 | if ((res = SDLNet_ResolveHost(&ip, host, 1234)) < 0) { 49 | fprintf(stderr, "SDLNet_ResolveHost: %s\n", SDLNet_GetError()); 50 | return res; 51 | } 52 | /* Open a connection with the IP provided (listen on the host's port) */ 53 | if (!(sd = SDLNet_TCP_Open(&ip))) { 54 | fprintf(stderr, "SDLNet_TCP_Open: %s\n", SDLNet_GetError()); 55 | return -1; 56 | } 57 | 58 | running = true; 59 | SDL_CreateThread(listenLoop, "AOD: TcpServer", (void*)this); 60 | fprintf(stderr, "listening on port %d\n", port); 61 | return 0; 62 | } 63 | 64 | private: 65 | static int listenLoop(void* data) { 66 | TcpServer* that = (TcpServer*)data; 67 | TCPsocket csd; /* Client socket descriptor */ 68 | 69 | // TODO grow if I get something that doesn't return in LF ? 70 | // but for now that will do 71 | char buffer[BUFFER_SIZE]; 72 | 73 | printf("started listening\n"); 74 | while (that->running) { 75 | // Check for pending connection. If there is one, accept & and open a new socket 76 | if ((csd = SDLNet_TCP_Accept(that->sd))) { 77 | SDLNet_TCP_Send(csd, that->init_msg.c_str(), 78 | that->init_msg.length()); 79 | // could I check SDLNet_Read32(&remoteIP->host) here to see if from allowed network? 80 | 81 | int countRcv = 0; 82 | for (;;) { 83 | countRcv = SDLNet_TCP_Recv(csd, buffer, BUFFER_SIZE - 1); 84 | if (countRcv <= 0) { 85 | // disconnected or some other problem 86 | break; 87 | } 88 | buffer[countRcv] = 0; // terminating what we read 89 | std::string response = that->cb(buffer); // calling the callback 90 | 91 | SDLNet_TCP_Send(csd, response.c_str(), response.length()); 92 | SDL_Delay(10); 93 | } 94 | SDLNet_TCP_Close(csd); 95 | } 96 | SDL_Delay(10); 97 | } 98 | return 0; 99 | } 100 | }; 101 | // class 102 | }// aod namespace 103 | -------------------------------------------------------------------------------- /src/gui_repl.cpp: -------------------------------------------------------------------------------- 1 | // dear imgui: standalone example application for SDL2 + OpenGL 2 | // If you are new to dear imgui, see examples/README.txt and documentation at the top of imgui.cpp. 3 | // (SDL is a cross-platform general purpose library for handling windows, inputs, OpenGL/Vulkan/Metal graphics context creation, etc.) 4 | 5 | // **DO NOT USE THIS CODE IF YOUR CODE/ENGINE IS USING MODERN OPENGL (SHADERS, VBO, VAO, etc.)** 6 | // **Prefer using the code in the example_sdl_opengl3/ folder** 7 | // See imgui_impl_sdl.cpp for details. 8 | 9 | #include "imgui.h" 10 | #include "imgui_impl_sdl.h" 11 | #include "imgui_impl_opengl2.h" 12 | #include 13 | #include "SDL.h" 14 | #include "SDL_opengl.h" 15 | #include "s7.h" 16 | #include "aod/s7.hpp" 17 | #include "aod/s7/repl.hpp" 18 | #include "aod/tcp_server.hpp" 19 | #include "aod/path.hpp" 20 | #include 21 | #include 22 | #include 23 | #include 24 | #include 25 | #include 26 | #include "SDL.h" 27 | 28 | #define DRAW_FN "draw" 29 | #define POST_DRAW_FN "post-draw" 30 | #define SETUP_FN "setup" 31 | 32 | #define SCREEN_WIDTH 400 33 | #define SCREEN_HEIGHT 400 34 | 35 | #define REPL_PORT 1234 36 | 37 | using std::cout; 38 | using std::cerr; 39 | using std::endl; 40 | namespace fs = std::filesystem; 41 | 42 | // globals, cause that's how we like it 43 | std::mutex g_gui_loop_mutex; 44 | s7_scheme* sc; 45 | bool running = true; 46 | bool g_force_redraw = false; 47 | 48 | 49 | int guiLoop() { 50 | 51 | 52 | if (SDL_Init(SDL_INIT_VIDEO) < 0) { 53 | printf("Error: %s\n", SDL_GetError()); 54 | return 1; 55 | } 56 | 57 | SDL_GL_SetAttribute(SDL_GL_DOUBLEBUFFER, 1); 58 | SDL_GL_SetAttribute(SDL_GL_DEPTH_SIZE, 24); 59 | SDL_GL_SetAttribute(SDL_GL_STENCIL_SIZE, 8); 60 | SDL_GL_SetAttribute(SDL_GL_CONTEXT_MAJOR_VERSION, 2); 61 | SDL_GL_SetAttribute(SDL_GL_CONTEXT_MINOR_VERSION, 2); 62 | 63 | 64 | SDL_Window* window = SDL_CreateWindow("s7imgui - Gui Repl", 100, 100, SCREEN_WIDTH, 65 | // SDL_WINDOWPOS_CENTERED caused the app to not show on linux. wtf 66 | SCREEN_HEIGHT, SDL_WINDOW_OPENGL | SDL_WINDOW_RESIZABLE); 67 | 68 | SDL_GLContext gl_context = SDL_GL_CreateContext(window); 69 | SDL_GL_MakeCurrent(window, gl_context); 70 | SDL_GL_SetSwapInterval(1); // Enable vsync 71 | 72 | // Setup Dear ImGui context 73 | IMGUI_CHECKVERSION(); 74 | ImGui::CreateContext(); 75 | 76 | ImGuiIO& io = ImGui::GetIO(); 77 | (void) io; 78 | ImGui::StyleColorsDark(); 79 | 80 | bool sdlInit = ImGui_ImplSDL2_InitForOpenGL(window, gl_context); 81 | ImGui_ImplOpenGL2_Init(); 82 | ImVec4 clear_color = ImVec4(0.45f, 0.55f, 0.60f, 1.00f); 83 | ImGui::PushStyleColor(ImGuiCol_WindowBg, IM_COL32(30, 30, 30, 255)); 84 | 85 | s7_pointer setup_fn = s7_name_to_value(sc, "setup"); 86 | if (setup_fn != s7_undefined(sc)) { 87 | s7_call(sc, setup_fn, s7_nil(sc)); 88 | } 89 | 90 | //While application is running 91 | // bool have_drawn = false; 92 | unsigned int redraws_after_no_events = 0; 93 | while (running) { 94 | 95 | bool have_events = false; 96 | std::unique_lock lock_loop(g_gui_loop_mutex); 97 | 98 | SDL_Event e; 99 | 100 | //Handle events on queue 101 | while (SDL_PollEvent(&e) != 0) { 102 | // printf("SDL event\n"); 103 | have_events = true; 104 | redraws_after_no_events = 0; 105 | //User requests quit 106 | switch (e.type) { 107 | case SDL_QUIT: 108 | printf("SDL_QUIT event\n"); 109 | running = false; 110 | break; 111 | case SDL_MOUSEBUTTONDOWN: 112 | case SDL_MOUSEBUTTONUP: 113 | // fprintf(stderr, "Mouse down/up at (%d,%d)\n", e.motion.x, 114 | // e.motion.y); 115 | break; 116 | } 117 | ImGui_ImplSDL2_ProcessEvent(&e); 118 | } 119 | if (!running) { 120 | break; 121 | } 122 | if (redraws_after_no_events > 2 && !g_force_redraw) { 123 | // no need to redraw! 124 | lock_loop.unlock(); 125 | std::this_thread::sleep_for(std::chrono::milliseconds(10)); 126 | continue; 127 | } 128 | g_force_redraw = false; 129 | 130 | if (!have_events) { 131 | redraws_after_no_events++; 132 | } 133 | 134 | ImGui_ImplOpenGL2_NewFrame(); 135 | ImGui_ImplSDL2_NewFrame(window); 136 | ImGui::NewFrame(); 137 | 138 | s7_eval_c_string(sc, "(draw)"); 139 | 140 | ImGui::Render(); 141 | 142 | glViewport(0, 0, (int) io.DisplaySize.x, (int) io.DisplaySize.y); 143 | // glClearColor is freezing if the window has been closed 144 | glClearColor((GLclampf) clear_color.x, (GLclampf) clear_color.y, 145 | (GLclampf) clear_color.z, (GLclampf) clear_color.w); 146 | glClear(GL_COLOR_BUFFER_BIT); 147 | //glUseProgram(0); // You may want this if using this code in an OpenGL 3+ context where shaders may be bound 148 | ImGui_ImplOpenGL2_RenderDrawData(ImGui::GetDrawData()); 149 | SDL_GL_SwapWindow(window); 150 | 151 | lock_loop.unlock(); 152 | std::this_thread::sleep_for(std::chrono::milliseconds(10)); 153 | } 154 | printf("guiLoop: quit gui event loop, cleaning up \n"); 155 | 156 | ImGui_ImplOpenGL2_Shutdown(); 157 | ImGui_ImplSDL2_Shutdown(); 158 | ImGui::DestroyContext(); 159 | 160 | SDL_GL_DeleteContext(gl_context); 161 | 162 | SDL_DestroyWindow(window); 163 | 164 | SDL_Quit(); 165 | 166 | printf("guiLoop: ----- gui loop quit ------\n"); 167 | // fgets is blocking, so we have to forcefully quit 168 | exit(0); 169 | return 0; 170 | } 171 | 172 | 173 | std::mutex g_s7_mutex; 174 | 175 | // Main code 176 | int main(int argc, char *argv[]) { 177 | fs::path cwd_launch = fs::current_path(); 178 | char *path_char = SDL_GetBasePath(); 179 | fs::path base_path = fs::path(path_char); 180 | fprintf(stderr, "argv[0] %s\n", argv[0]); 181 | 182 | fs::path scheme_path = base_path / "scheme"; 183 | std::cout << "scheme path is " << base_path / "scheme" << '\n'; 184 | sc = aod::s7::init(scheme_path); 185 | 186 | if (argc >= 2) { 187 | fprintf(stderr, "Passed custom scheme file %s\n", argv[1]); 188 | fs::path passed_file = cwd_launch / argv[1]; 189 | // passed_file.append() 190 | // passed_file.replace_filename(argv[1]); 191 | // std::cout << "cwd was " << cwd_launch << '\n'; 192 | // std::cout << "cwd is " << cwd_launch << " passed file " << passed_file << '\n'; 193 | std::cout << "path of passed file is " << passed_file.parent_path() 194 | << '\n'; 195 | s7_add_to_load_path(sc, passed_file.parent_path().string().c_str()); 196 | aod::s7::load_file(sc, passed_file.string().c_str()); 197 | } else { 198 | aod::s7::load_file(sc, "main.scm"); 199 | } 200 | 201 | new std::thread(guiLoop); 202 | 203 | aod::s7::Repl repl(sc); 204 | 205 | cout << "S7 Example Repl " << endl << "> "; 206 | 207 | char buffer[512]; 208 | while (running) { 209 | fgets(buffer, 512, stdin); 210 | std::unique_lock lock_loop(g_gui_loop_mutex); 211 | if (repl.handleInput(buffer)) { 212 | auto result = repl.evalLastForm(); 213 | cout << endl << result << endl << "> "; 214 | g_force_redraw = true; 215 | } 216 | } 217 | 218 | return 0; 219 | } 220 | 221 | -------------------------------------------------------------------------------- /src/lib/meson.build: -------------------------------------------------------------------------------- 1 | message('here, stb') 2 | stb_lib = library( 3 | 'stb', 4 | sources: files('stb/stb.c') 5 | ) 6 | stb_dep = declare_dependency( 7 | link_with: stb_lib, 8 | include_directories: include_directories('stb'), 9 | ) 10 | -------------------------------------------------------------------------------- /src/lib/stb/stb.c: -------------------------------------------------------------------------------- 1 | #define STB_IMAGE_IMPLEMENTATION 2 | #include "stb_image.h" 3 | #include "stb_image_write.h" 4 | -------------------------------------------------------------------------------- /src/meson.build: -------------------------------------------------------------------------------- 1 | sources = files( 2 | 'main.cpp', 3 | ) 4 | 5 | # can be filled by subdirs 6 | includes = [] 7 | 8 | includes += include_directories('.') 9 | 10 | subdir('lib') 11 | subdir('aod') 12 | 13 | app_dep = declare_dependency( 14 | include_directories: includes, 15 | sources: sources, 16 | dependencies: [aod_dep] 17 | ) 18 | -------------------------------------------------------------------------------- /src/repl.cpp: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | #include "s7.h" 5 | #include "aod/s7.hpp" 6 | #include "aod/s7/repl.hpp" 7 | #include 8 | #include 9 | 10 | namespace fs = std::filesystem; 11 | using std::cout, std::cerr, std::endl; 12 | 13 | int main(int argc, char **argv) { 14 | char buffer[512]; 15 | 16 | cout << "argv[0] " << argv[0] << " fs::current_path " << fs::current_path() << endl; 17 | fs::path base_path = (fs::current_path() / argv[0]).remove_filename(); 18 | cout << "base path " << base_path << endl; 19 | 20 | // we are in build/ directory probably 21 | // TODO fix this for redistribution. 22 | // eg providing repl executable, and then a relative scheme/ folder 23 | fs::path scheme_path = base_path / ".." / "src" / "scheme"; 24 | // cout << "scheme path " << scheme_path << endl; 25 | 26 | // s7_scheme *sc = s7_init(); 27 | // aod::s7::set_print_stderr(sc); 28 | // aod::s7::set_autoloads(sc); 29 | // aod::s7::bind_all(sc); 30 | // 31 | // s7_add_to_load_path(sc, scheme_path.c_str()); 32 | 33 | s7_scheme* sc = aod::s7::init(scheme_path); 34 | 35 | 36 | if (argc >= 2) { 37 | cout << "Passed custom scheme file " << argv[1] << endl; 38 | fs::path passed_file = argv[1]; 39 | if (!passed_file.is_absolute()) { 40 | passed_file = (fs::current_path() / passed_file); 41 | } 42 | fprintf(stderr, "Passed file %s\n", passed_file.string().c_str()); 43 | aod::s7::load_file(sc, "aod/core.scm"); 44 | // aod::s7::ns_load_file(sc, passed_file.string()); 45 | aod::s7::load_file(sc, passed_file.string()); 46 | // s7_load(sc, passed_file.c_str()); 47 | } 48 | 49 | aod::s7::Repl repl(sc); 50 | 51 | cout << "S7 Example Repl " << endl << "> "; 52 | 53 | while (true) { 54 | fgets(buffer, 512, stdin); 55 | if (repl.handleInput(buffer)) { 56 | auto result = repl.evalLastForm(); 57 | cout << endl << result << endl << "> "; 58 | } 59 | 60 | } 61 | } 62 | -------------------------------------------------------------------------------- /src/scheme/aod/autoloads.scm: -------------------------------------------------------------------------------- 1 | (autoload 'aod.ns "aod/ns.scm") 2 | (autoload 'aod.clj "aod/clj.scm") 3 | (autoload 'aod.test "aod/test.scm") 4 | (autoload 'aod.geom "aod/geom.scm") 5 | (autoload 'aod.layout "aod/layout.scm") 6 | (autoload 'aod.string "aod/string.scm") 7 | (autoload 'aod.io "aod/io.scm") 8 | (autoload 'imgui-macros.scm 9 | ;; fuck, the lambda is not working 10 | ;; aaaagggh 11 | 12 | ;; (lambda (e) 13 | ;; (display "WARNING! please use aod.imgui.macros") 14 | ;; (unless (provided? 'imgui-macros) 15 | ;; (load "aod/imgui_macros.scm"))) 16 | "aod/imgui_macros.scm" 17 | ) 18 | (autoload 'aod.imgui.macros "aod/imgui/macros.scm") 19 | (autoload 'aod.colors "aod/colors.scm") 20 | (autoload 'aod.midi "aod/midi.scm") 21 | (autoload 'aod.imgui.helpers "aod/imgui/helpers.scm") 22 | (autoload 'aod.sxs "aod/sxs.scm") 23 | (autoload 'debug.scm "s7/debug.scm") 24 | (autoload 'aod.benchmark "aod/benchmark.scm") 25 | (autoload 'aod.scales "aod/scales.scm") 26 | ;; gui Components 27 | (autoload 'aod.components.sxs-wheel "aod/components/sxs-wheel.scm") 28 | (autoload 'aod.components.piano-wheel "aod/components/piano-wheel.scm") 29 | (autoload 'aod.components.input "aod/components/input.scm") 30 | -------------------------------------------------------------------------------- /src/scheme/aod/benchmark.scm: -------------------------------------------------------------------------------- 1 | (ns aod.benchmark) 2 | (provide 'aod.benchmark) 3 | 4 | (define (fib n) 5 | (if (<= n 1) 1 6 | (+ (fib (- n 1)) 7 | (fib (- n 2))))) 8 | 9 | (define-macro (time expr) 10 | `(let ((start (*s7* 'cpu-time))) 11 | (let ((res (list ,expr))) ; expr might return multiple values 12 | (list (car res) 13 | (- (*s7* 'cpu-time) start))))) 14 | -------------------------------------------------------------------------------- /src/scheme/aod/clj.scm: -------------------------------------------------------------------------------- 1 | ;; some basic functionality that I miss from clojure 2 | (display "loading aod/clj.scm\n") 3 | (provide 'aod.clj) 4 | 5 | #; 6 | (define-macro (comment . body) 7 | `()) 8 | 9 | ;; # or () is better? 10 | (define-expansion (comment . body) #) 11 | 12 | ;; hm that fails 13 | ;; (define-expansion (comment . body) (values)) 14 | 15 | (define map-indexed 16 | (let ((+documentation+ "(map-indexed f coll) 17 | Applies f to the collection coll. 18 | f should accept to arguments, i and the element") 19 | (+signature+ '(f coll))) 20 | (lambda (f coll) 21 | (let ((i -1)) 22 | (map (lambda (el) 23 | (set! i (+ 1 i)) 24 | (f i el)) 25 | coll))))) 26 | 27 | (comment 28 | (map-indexed (lambda (i el) 29 | (format *stdout* "i ~A el ~A\n" i el)) 30 | '(a b c)) 31 | 32 | ;; i 0 el a 33 | ;; i 1 el b 34 | ;; i 2 el c 35 | ) 36 | 37 | ;; got from s7.. stuff.scm ? 38 | (define-macro (dotimes spec . body) ;; spec = (var end . return) 39 | (let ((e (gensym)) 40 | (n (car spec))) 41 | `(do ((,e ,(cadr spec)) 42 | (,n 0 (+ ,n 1))) 43 | ((>= ,n ,e) ,@(cddr spec)) 44 | ,@body))) 45 | 46 | (comment 47 | (dotimes (i 3) 48 | ;; (display "here") 49 | (format *stderr* "i is ~A\n" i) 50 | ) 51 | " 52 | i is 0 53 | i is 1 54 | i is 2 55 | " 56 | => #t 57 | 58 | (dotimes (i 3 (format #f "finished with i ~A" i)) ;; <= the 3rd i is the return statement. could be anything 59 | ;; (display "here") 60 | (format *stderr* "i is ~A\n" i) 61 | ) 62 | "i is 0 63 | i is 1 64 | i is 2 65 | " 66 | => "finished with i 3" 67 | ) 68 | 69 | (define iota 70 | (let ((+documentation+ "(iota n (start 0) (incr 1)) returns a list counting from start for n:\n\ 71 | (iota 3) -> '(0 1 2)")) 72 | (lambda* (n (start 0) (incr 1)) 73 | (if (or (not (integer? n)) 74 | (< n 0)) 75 | (error 'wrong-type-arg "iota length ~A should be a non-negative integer" n)) 76 | (let ((lst (make-list n))) 77 | (do ((p lst (cdr p)) 78 | (i start (+ i incr))) 79 | ((null? p) lst) 80 | (set! (car p) i)))))) 81 | 82 | (define range iota) 83 | (define mod modulo) 84 | 85 | (define-macro (not= . args) 86 | `(not (= ,@args))) 87 | 88 | #; 89 | (define-expansion (pow base power) 90 | (expt base power)) 91 | 92 | (define pow expt) 93 | 94 | (define-expansion (identity what) 95 | `,what) 96 | 97 | (define-macro (watch var fn) 98 | `(set! (setter ',var) 99 | (lambda (s v e) 100 | ;; calling fn with old and new value 101 | (,fn (e ',var) v) 102 | v))) 103 | 104 | (comment 105 | (define x 1) 106 | (watch x (lambda (old new) 107 | (print "x changed from" old "to" new))) 108 | ((curlet) 'x) 109 | (define x 2) 110 | ) 111 | 112 | (define (keys coll) 113 | (if (or (hash-table? coll) 114 | (let? coll)) 115 | (map (lambda (el) 116 | (car el)) 117 | coll) 118 | (error 'wrong-type-arg "keys arg ~A is not a hash-table nor a let" coll))) 119 | 120 | (define (inc x) 121 | (+ x 1)) 122 | 123 | (define (dec x) 124 | (- x 1)) 125 | 126 | (define (partial fn . args) 127 | (lambda rest-args 128 | (apply fn (append args rest-args)) 129 | )) 130 | -------------------------------------------------------------------------------- /src/scheme/aod/colors.scm: -------------------------------------------------------------------------------- 1 | (ns aod.colors) 2 | (ns-require aod.c.colors) 3 | ;; https://en.wikipedia.org/wiki/Hue#/media/File:HSV-RGB-comparison.svg 4 | ;; starts with the "red" 5 | (define (-triplet-ramp1 phase360) 6 | (let ((phase360 (mod phase360 360))) 7 | (cond 8 | ((< phase360 60) 1) 9 | ((< phase360 120) ;; falling 10 | (- 1 (/ (- phase360 60) 11 | 60))) 12 | ((< phase360 240) 0) 13 | ((< phase360 300) ;; rising 14 | (/ (- phase360 240) 15 | 60)) 16 | (else 1) 17 | ))) 18 | 19 | ;; phase is 0.0 .. 1.0 20 | (define (rgb-phase phase) 21 | (let* ((phase (mod phase 1)) 22 | (phase (* phase 360))) 23 | (map 24 | (lambda (phase3) 25 | (let ((phase (- phase phase3))) 26 | (-triplet-ramp1 phase))) 27 | '(0 120 240)))) 28 | 29 | (define (triplet-phase phase) 30 | (let* ((phase (mod phase 1)) 31 | (phase (* phase 360))) 32 | (map 33 | (lambda (phase3) 34 | (let ((phase (- phase phase3))) 35 | (-triplet-ramp1 phase))) 36 | '(0 120 240)))) 37 | 38 | (define (rgb-wheel steps) 39 | (map 40 | (lambda (x) 41 | (triplet-phase (/ x steps))) 42 | (range steps))) 43 | 44 | (test "RGB phase" 45 | (is (equivalent? '(1 0 0) 46 | (rgb-phase 0))) 47 | 48 | (is (equivalent? '(1 0 0) 49 | (rgb-phase 1))) 50 | ) 51 | (test "RGB wheel" 52 | (is (equivalent? '((1 0 0) (0 1 0) (0 0 1)) 53 | (rgb-wheel 3))) 54 | ;; see https://www.w3schools.com/colors/colors_wheels.asp 55 | ;; the RGB color wheel 56 | (is (equivalent? '((1 0 0) 57 | (1 1/2 0) 58 | (1 1 0) 59 | (1/2 1 0) 60 | (0 1 0) 61 | (0 1 1/2) 62 | (0 1 1) 63 | (0 1/2 1) 64 | (0 0 1) 65 | (1/2 0 1) 66 | (1 0 1) 67 | (1 0 1/2)) 68 | (rgb-wheel 12)))) 69 | 70 | (define (ryb->rgb ryb) 71 | (aod.c.colors/ryb->rgb ryb)) 72 | 73 | (test "RYB -> RGB" 74 | (is (equivalent? '(1 0 0) 75 | (ryb->rgb '(1 0 0)))) 76 | 77 | (is (equivalent? '(1 1 0) 78 | (ryb->rgb '(0 1 0)))) 79 | ) 80 | -------------------------------------------------------------------------------- /src/scheme/aod/components/input.scm: -------------------------------------------------------------------------------- 1 | (ns aod.components.input) 2 | (ns-require aod.c.foreign :as c) 3 | (ns-require aod.imgui.macros :as igm) 4 | 5 | (define char-size 128) 6 | 7 | (define* (new (init ())) 8 | (let ((*str (c/new-char[] char-size)) 9 | (value init) 10 | (editing? #f)) 11 | (set! (*str) (format #f "~A" value)) 12 | (curlet))) 13 | 14 | (define (draw state) 15 | (let ((ret #f)) 16 | (if (not (state 'editing?)) 17 | (begin 18 | (let ((text (format #f "~A" (state 'value)))) 19 | (igm/horizontal 20 | (begin 21 | (ig/align-text-to-frame-padding) 22 | (ig/text text)) 23 | (when (ig/button "Edit") 24 | (set! (state 'editing?) #t) 25 | (set! ((state '*str)) text) 26 | )))) 27 | (begin 28 | (ig/set-keyboard-focus-here) 29 | ;; TODO store an id in state? 30 | (ig/input-text "##text-input" (state '*str) char-size) 31 | (cond ((ig/is-item-deactivated-after-edit) 32 | (with-input-from-string ((state '*str)) 33 | (lambda () 34 | (set! (state 'value) (read)) 35 | (set! (state 'editing?) #f) 36 | (set! ret #t)))) 37 | ((ig/is-item-deactivated) 38 | (set! (state 'editing?) #f))))) 39 | ret)) 40 | -------------------------------------------------------------------------------- /src/scheme/aod/components/piano-wheel.scm: -------------------------------------------------------------------------------- 1 | (ns aod.components.piano-wheel) 2 | (ns-require aod.c.imgui :as ig) 3 | (ns-require aod.imgui.helpers :as igh) 4 | (ns-require aod.layout :as l) 5 | 6 | (define black-keys '(1 3 6 8 10)) 7 | (define color-black (igh/frgb->u32 '(0 0 0))) 8 | (define color-white (igh/frgb->u32 '(1 1 1))) 9 | 10 | (define* (new (R 150) (cx R) (cy R) (padding-factor 0.1)) 11 | (lambda* (x y (N 1) (n 0) (phase 0)) 12 | (let* ((d-theta (/ (* 2 pi) 13 | N)) 14 | (offset (* d-theta padding-factor)) 15 | (a1 (- (* n d-theta) 16 | (+ (/ pi 2) 17 | (/ d-theta 2)))) 18 | (a2 (+ a1 d-theta)) 19 | (color (if (member n black-keys) 20 | color-black 21 | color-white))) 22 | (igh/draw-arc (list cx cy R) 23 | (+ a1 offset) 24 | (- a2 offset) 25 | :color color 26 | :thickness 10)))) 27 | 28 | (define demo-element (new :R 50)) 29 | (define* (draw (element demo-element)) 30 | (l/circular element :N 12) 31 | ) 32 | -------------------------------------------------------------------------------- /src/scheme/aod/components/sxs-wheel.scm: -------------------------------------------------------------------------------- 1 | ;; A visualization/logo that I came up with 2 | ;; to be used for imgui drawing directly 3 | ;; 4 | ;; Also, the idea is to create components that have some tests of 5 | ;; their rendering. Input state => output a png image. I can then 6 | ;; compare the images 7 | 8 | (ns aod.components.sxs-wheel) 9 | 10 | (ns-require aod.c.imgui :as ig) 11 | (ns-require aod.imgui.macros :as igm) 12 | (ns-require aod.layout :as l) 13 | (ns-require aod.sxs :as sxs) 14 | (ns-require aod.imgui.helpers :as igh) 15 | (ns-require aod.colors :as colors) 16 | 17 | (define* (mk-sxs-element highlights (bg '(0 0 0)) (r 34) (r-internal 30)) 18 | (lambda* (cx cy (phase 0) (n 0) (N 1)) 19 | (let ((lines (sxs/lines `(,cx ,cy ,r-internal) :phase (* 4 phase))) 20 | (highlighted? (highlights n)) 21 | (rgb (colors/ryb->rgb (colors/triplet-phase phase))) 22 | (color32-bg (igh/frgb->u32 bg)) 23 | ) 24 | (let ((color32-normal-alpha (igh/frgb->u32 (append rgb '(0.3))));; alpha 25 | (color32-normal (igh/frgb->u32 rgb)) 26 | ) 27 | (igh/draw-circle `(,cx ,cy ,r) 28 | :color (if highlighted? 29 | color32-normal-alpha 30 | color32-bg 31 | ) 32 | :thickness 1 33 | :filled #t) 34 | (igh/draw-circle `(,cx ,cy ,r) 35 | :color color32-normal 36 | :thickness 1 37 | :segments 32) 38 | (igh/draw-lines lines 39 | :color color32-normal 40 | :thickness (if highlighted? 2 41 | 1)))))) 42 | 43 | ;; hm.. mk-state vs make vs new ?? 44 | ;; TODO calculate optima r if only R is passed 45 | (define* (new (N 12) (R 150) (r 30) (internal-fill 0.8)) 46 | (let* ((highlights (make-vector N #f)) 47 | (element (mk-sxs-element 48 | :highlights highlights 49 | :r r :r-internal (* internal-fill r)))) 50 | (curlet))) 51 | 52 | (define (draw state) 53 | (let* ((R (state 'R)) 54 | (center (+ R (state 'r))) 55 | (element (state 'element)) 56 | (N (state 'N))) 57 | ;; TODO.. not maximized 58 | (igm/maximized 59 | ("###") 60 | '(igh/draw-circle `( 100 100 100) 61 | :filled #t) 62 | (l/circular element :N N :center (list center center) :R R :gui #t)))) 63 | 64 | (define (set-highlight state index value) 65 | (set! ((state 'highlights) index) value)) 66 | 67 | (comment 68 | (with-let (rootlet) 69 | (provide 'aod.test.gui) 70 | (require aod.test)) 71 | 72 | (set! (hook-functions (aod.c.repl '*eval-hook*)) 73 | (cons (lambda (hook) 74 | (igsdl/prepare *ctx*) 75 | (draw test-element) 76 | (igsdl/flush *ctx*) 77 | ) 78 | (hook-functions (aod.c.repl '*eval-hook*)))) 79 | ) 80 | 81 | (testgui "SXS Color Wheel snapshot" 82 | (ns-require aod.c.imgui-sdl :as igsdl) 83 | (ns-require aod.c.gl :as gl) 84 | (ns-require aod.c.sdl :as sdl) 85 | (ns-require aod.c.img :as c.img) 86 | (define R 180) 87 | (define r 35) 88 | (define size (* 2 (+ R r))) 89 | (define test-element (new :R R :r r)) 90 | ;; the size should be 2*(R+r) 91 | ;; hm have to add 14.. I guess there is a padding of 7 92 | 93 | (define *ctx* (igsdl/setup (+ 14 size) (+ 14 size))) 94 | 95 | 96 | (define (paint) 97 | (igsdl/prepare *ctx*) 98 | (draw test-element) 99 | (igsdl/flush *ctx*)) 100 | ;; commenting out while developing :) 101 | (begin 102 | ;; aha.. on windows I had to call (paint) twice 103 | ;; to get the proper result 104 | ;; .. or maybe it's the sdl version that changed..? 105 | (paint) 106 | (paint) 107 | ;; in windows by painting twice it's ok 108 | ;; but in linux I have to wait.. 109 | ;; damn, first time have to wait >30ms? if not the screenshot is blank 110 | (sdl/delay 40) 111 | (gl/save-screenshot "test/scheme/assets/sxs-wheel.png") 112 | (set-highlight test-element 0 #t) 113 | (set-highlight test-element 4 #t) 114 | (set-highlight test-element 8 #t) 115 | (paint) 116 | (paint) 117 | (sdl/delay 10) 118 | (gl/save-screenshot "test/scheme/assets/sxs-wheel-highlight-048.png") 119 | (igsdl/destroy *ctx*) 120 | (is (c.img/equivalent? "test/scheme/assets/sxs-wheel.png" 121 | "test/scheme/assets/sxs-wheel-snapshot.png")) 122 | (is (c.img/equivalent? "test/scheme/assets/sxs-wheel-highlight-048.png" 123 | "test/scheme/assets/sxs-wheel-highlight-048-snapshot.png")) 124 | 125 | ;; test the it's not always true :) 126 | (is (not (c.img/equivalent? "test/scheme/assets/sxs-wheel-snaphost.png" 127 | "test/scheme/assets/sxs-wheel-offset.png")))) 128 | 129 | ) 130 | 131 | 132 | (comment 133 | ;; drawing it 134 | (igsdl/destroy *ctx*) 135 | (exit) 136 | 137 | 138 | (ns-require aod.c.gl :as gl) 139 | (define test-element (new)) 140 | (define *ctx* (igsdl/setup 420 420)) 141 | (igsdl/prepare *ctx*) 142 | (draw test-element) 143 | (igsdl/flush *ctx*) 144 | (gl/save-screenshot "sxs-color-wheel.png") 145 | 146 | 147 | ) 148 | 149 | -------------------------------------------------------------------------------- /src/scheme/aod/core.scm: -------------------------------------------------------------------------------- 1 | (display "loading aod/core\n") 2 | ;; putting the autload info here, among other necessary things (that I use often) 3 | (provide 'aod.core) 4 | 5 | (load "aod/autoloads.scm") 6 | ;; comment, map-indexed, dotimes, range, mod 7 | ;; on the (rootlet) 8 | (require aod.clj) 9 | 10 | ;; ignornig tests: test expansion/macro replaced in aod.test 11 | (define-expansion (test . body) #) 12 | (define-expansion (testgui . body) #) 13 | 14 | (define (filter pred col) 15 | (let loop ((res (list )) 16 | (s col)) 17 | (if (pair? s) 18 | (begin 19 | (when (pred (car s)) 20 | (set! res (append res (list (car s))))) 21 | (loop res (cdr s))) 22 | res))) 23 | 24 | (comment 25 | (filter (lambda (x) 26 | (> x 0)) 27 | '( 0 1 2 -1 -5 10)) 28 | ;; => (1 2 10) 29 | ) 30 | 31 | (define (print . args) 32 | (format *stderr* "~A\n" (apply string-append 33 | (map 34 | (lambda (x) 35 | (format #f "~A " x) 36 | ) 37 | args)))) 38 | 39 | ;; returns the last argument 40 | ;; useful for in-drop debugging, printing what we return 41 | (define (print-ret . args) 42 | (apply print args) 43 | (if (pair? args) 44 | (car (reverse args)) 45 | ())) 46 | 47 | (comment 48 | (print 'a 'b "aasa" '(a b c)) 49 | 50 | (let->list (curlet)) 51 | ((curlet) (string->symbol "lines")) 52 | geom/echo 53 | ) 54 | 55 | ;; hmm not sure how it's useful 56 | ;; from s7.html 57 | (define (concat . args) 58 | (apply append (map (lambda (arg) (map values arg)) args))) 59 | 60 | ;; aod.ns has tests and may make some use of the rest of 61 | ;; internal funtions, so requiring at the end 62 | (require aod.ns) 63 | 64 | (define (memoize fn) 65 | (let ((mem (make-hash-table))) 66 | (lambda args 67 | (or (mem args) 68 | (begin 69 | ;; (print "not found, fn" fn "args " args) 70 | (let ((ret (apply fn args))) 71 | ;; (print "ret " ret) 72 | (set! (mem args) ret) 73 | ret)))))) 74 | 75 | ;; if-let, when-let 76 | ;; only for one variable 77 | ;; TODO 78 | ;; - validate input? only one 79 | ;; syntax is clj like, passing one list (symbol val) 80 | ;; eg (when-let (x #f) ..) 81 | (define-macro (if-let binding then else) 82 | `(let ((,(car binding) ,(cadr binding))) 83 | (if ,(car binding) 84 | ,then 85 | ,else))) 86 | 87 | (define-macro (when-let binding . body) 88 | `(let ((,(car binding) ,(cadr binding))) 89 | (when ,(car bindings) 90 | ,@body))) 91 | 92 | ;; from s7 stuff.scm 93 | (define-macro (and-let* vars . body) ; bind vars, if any is #f stop, else evaluate body with those bindings 94 | (if (list? vars) 95 | `(let () (and ,@(map (lambda (v) (cons 'define v)) vars) (begin ,@body))) 96 | (error 'wrong-type-arg "and-let* var list is ~S" vars))) 97 | 98 | (define when-let* and-let*) 99 | 100 | (define-macro (if-let* vars then else) ; bind vars, if all are #t evaluate "then", otherwise "else" 101 | (if (list? vars) 102 | `(let () 103 | (if (and ,@(map (lambda (v) (cons 'define v)) vars)) 104 | ,then 105 | ,else)) 106 | (error 'wrong-type-arg "and-let* var list is ~S" vars))) 107 | 108 | (comment 109 | (if-let (x #t) 110 | 1 111 | 2) 112 | 113 | (when-let (x #f) 114 | (print "one") 115 | (print "two")) 116 | 117 | (if-let* ((x #t) 118 | (y #t)) 119 | (print "true?") 120 | (print "false?")) 121 | 122 | (when-let* ((x #f)) 123 | (print "this") 124 | (print "that")) 125 | ) 126 | -------------------------------------------------------------------------------- /src/scheme/aod/geom.scm: -------------------------------------------------------------------------------- 1 | (ns aod.geom) 2 | 3 | ;; TODO 4 | ;; working only for non-vertical lines 5 | ;; leaving that case for now, not needing it atm 6 | ;; 7 | ;; For the line - circle intersection see: 8 | ;; see 9 | ;; - https://rosettacode.org/wiki/Line_circle_intersection 10 | ;; - https://math.stackexchange.com/questions/228841/how-do-i-calculate-the-intersections-of-a-straight-line-and-a-circle 11 | (define *eps* 0.000001) 12 | 13 | (define (distance-sq p1 p2) 14 | (+ 15 | ;; using abs because for example 16 | ;; (expt -2.2321321321 2) return a complex number 17 | (pow (abs (- (p1 0) (p2 0))) 18 | 2) 19 | (pow (abs (- (p1 1) (p2 1))) 20 | 2))) 21 | (define (distance p1 p2) 22 | (sqrt (distance-sq p1 p2))) 23 | 24 | (comment 25 | (distance-sq '(0 0) '(1 1)) 26 | (distance-sq '(0 0) '(7.0710678118654755 -7.0710678118654755)) 27 | ;; => 2 28 | ) 29 | 30 | (define (point-in-circle? p circle) 31 | (let ((x (p 0)) 32 | (y (p 1)) 33 | (cx (circle 0)) 34 | (cy (circle 1)) 35 | (r (circle 2)) 36 | ) 37 | (< (distance p `(,cx ,cy)) 38 | (+ r *eps*)) 39 | )) 40 | 41 | (test "Point in circle" 42 | ;; contained 43 | (assert (eq? #t (point-in-circle? '(0 0) '(0 0 10)))) 44 | (assert (eq? #t (point-in-circle? '(10 0) '(0 0 10)))) 45 | (assert (eq? #t (point-in-circle? '(0 10) '(0 0 10)))) 46 | ;; not contained 47 | (assert (eq? #f (point-in-circle? '(11 0) '(0 0 10)))) 48 | (assert (eq? #f (point-in-circle? '(0 11) '(0 0 10)))) 49 | ;; the end 50 | ) 51 | 52 | (define (sq x) 53 | (* x x)) 54 | 55 | ;; needs cx cy x1 y1 x2 y2 r 56 | ;; binds A B C a b c d 57 | (define-macro (-expand-A-B-C-etc . body) 58 | `(let* ((A (- y2 y1)) 59 | (B (- x1 x2)) 60 | (C (- (* x2 y1) (* x1 y2))) 61 | (a (+ (sq A) (sq B))) 62 | (b ;; not vertical line.. 63 | (* 2 (+ (* A C) 64 | (* A B cy) 65 | (- 0 (* (sq B) 66 | cx))))) 67 | (c (- (+ (sq C) 68 | (* 2 B C cy)) 69 | (* (sq B) 70 | (- (sq r) 71 | (sq cx) 72 | (sq cy))))) 73 | (d-sq ;; discriminant 74 | (- (sq b) 75 | (* 4 a c))) 76 | (d (sqrt d-sq))) 77 | ,@body 78 | ) 79 | ) 80 | 81 | (define (-fx-intersect A B C x) 82 | (- 0 83 | (/ (+ (* A x) C) 84 | B))) 85 | 86 | ;; for vertical lines 87 | ;; (define (-fy-intersect A B C x) 88 | ;; (- 0 89 | ;; (/ (+ (* B y) C) 90 | ;; A))) 91 | 92 | (define (filter-points-in-circle points circle) 93 | (filter (lambda (p) 94 | (point-in-circle? p circle) 95 | ) 96 | points)) 97 | (test "Filter points in circle" 98 | (assert (equivalent? '((0 0) (10 0) (-10 0) (2 2)) 99 | (filter-points-in-circle '((0 0) ;; in 100 | (10 0) ;; in 101 | (-10 0) ;; in 102 | (-12 0) ;; out 103 | (0 11) ;; out 104 | (2 2) ;; in 105 | ) 106 | '(0 0 10)))) 107 | ) 108 | 109 | (define (point-in-segment? point segment) 110 | (let ((p1 (list (segment 0) (segment 1))) 111 | (p2 (list (segment 2) (segment 3)))) 112 | (let ((d1 (distance p1 p2)) 113 | (d2 (distance p1 point)) 114 | (d3 (distance p2 point))) 115 | (< (abs (- d1 d2 d3)) 116 | *eps*)))) 117 | 118 | (comment 119 | (eq? #t (point-in-segment? '(0 0) '(0 0 10 10))) 120 | (eq? #t (point-in-segment? '(10 10) '(0 0 10 10))) 121 | (eq? #t (point-in-segment? '(1 1) '(0 0 10 10))) 122 | (eq? #f (point-in-segment? '(0 1) '(0 0 10 10))) 123 | ) 124 | 125 | (define (filter-points-in-segment points segment) 126 | (filter (lambda (p) 127 | (point-in-segment? p segment)) 128 | points)) 129 | 130 | (define (clip-line-in-circle line circle) 131 | (let ((x1 (line 0)) 132 | (y1 (line 1)) 133 | (x2 (line 2)) 134 | (y2 (line 3)) 135 | (cx (circle 0)) 136 | (cy (circle 1)) 137 | (r (circle 2))) 138 | (let ((p1-in (point-in-circle? `(,x1 ,y1) circle)) 139 | (p2-in (point-in-circle? `(,x2 ,y2) circle))) 140 | (cond ((and p1-in p2-in) line) 141 | (else (-expand-A-B-C-etc 142 | ;; (print "d-sq " d-sq) 143 | ;; this makes the calculations.. 144 | ;; dirty but... will do for now 145 | (if (> d-sq 0) 146 | (let* ((px1 (/ (- d b) 147 | (* 2 a))) 148 | (py1 (-fx-intersect A B C px1)) 149 | (px2 (/ (- 0 b d) 150 | (* 2 a))) 151 | (py2 (-fx-intersect A B C px2))) 152 | (apply append (filter-points-in-circle 153 | (filter-points-in-segment `((,x1 ,y1) 154 | (,x2 ,y2) 155 | (,px1 ,py1) 156 | (,px2 ,py2)) 157 | line) 158 | circle))) 159 | ;; no intersection 160 | (begin 161 | ;; (print "no intersection????") 162 | (values) 163 | ) 164 | ) 165 | )))))) 166 | 167 | (test "Clip line in circle" 168 | (assert 169 | (equivalent? '(0.1 0.1 0.2 0.2) 170 | (clip-line-in-circle '(0.1 0.1 0.2 0.2) `(0 0 ,(* 2 (sqrt 2))))) 171 | "Contained line") 172 | (assert 173 | (equivalent? '(0 0 2.0 2.0) 174 | (clip-line-in-circle '(0 0 100 100) `(0 0 ,(* 2 (sqrt 2))))) 175 | "Line with one crossing") 176 | (assert 177 | (equivalent? '(0 0 -2.0 -2.0) 178 | (clip-line-in-circle '(-100 -100 0 0) `(0 0 ,(* 2 (sqrt 2))))) 179 | "Line with one crossing") 180 | (assert 181 | (equivalent? '(2.0 2.0 -2.0 -2.0) 182 | (clip-line-in-circle '(-100 -100 100 100) `(0 0 ,(* 2 (sqrt 2))))) 183 | "Line that exceeds in both ends")) 184 | 185 | (define (filter-empty args) 186 | (filter pair? args)) 187 | 188 | (define (clip-lines-in-circle lines circle) 189 | (filter-empty 190 | (map (lambda (line) 191 | (clip-line-in-circle line circle)) 192 | lines))) 193 | 194 | (define (rad->deg rad) 195 | (/ (* 180 rad) pi)) 196 | 197 | (test "Angle conversions" 198 | (assert (= 90 (rad->deg (/ pi 2))))) 199 | 200 | (define (line-offset line offs) 201 | (let ((offs-x (offs 0)) 202 | (offs-y (offs 1))) 203 | (list (+ offs-x (line 0)) 204 | (+ offs-y (line 1)) 205 | (+ offs-x (line 2)) 206 | (+ offs-y (line 3))))) 207 | 208 | (define (lines-offset lines offset) 209 | (map (lambda (line) 210 | (line-offset line offset) 211 | ) 212 | lines)) 213 | 214 | (test "Line(s) offset" 215 | (is (equivalent? '(1 1 2 2) 216 | (line-offset '(0 0 1 1) 217 | '(1 1)))) 218 | 219 | 220 | (is (equivalent? '((1 1 2 2) (1 1 11 11)) 221 | (lines-offset '((0 0 1 1) (0 0 10 10)) 222 | '(1 1))))) 223 | 224 | (define* (mk-circle cx cy r) 225 | (list cx cy r)) 226 | 227 | (define* (mk-line x1 x2 y1 y2) 228 | (list x1 y1 x2 y2)) 229 | 230 | (define (repeat-line line offsets) 231 | (map (lambda (offset) 232 | (line-offset line offset)) 233 | offsets)) 234 | 235 | (define (repeat-lines lines offsets) 236 | (apply append (map (lambda (line) 237 | (repeat-line line offsets)) 238 | lines))) 239 | 240 | (test "Repeat lines" 241 | (is (equivalent? '((-1 0 0 1) (0 0 1 1) (1 0 2 1)) 242 | (repeat-line '(0 0 1 1) 243 | '((-1 0) (0 0) (1 0))))) 244 | 245 | (is (equivalent? '((-1 0 0 1) (0 0 1 1) (1 0 2 1) (9 10 10 11) (10 10 11 11) (11 10 12 11)) 246 | (repeat-lines '((0 0 1 1) (10 10 11 11)) 247 | '((-1 0) (0 0) (1 0))))) 248 | ) 249 | 250 | (define (radius-line circle theta) 251 | (let* ((cx (circle 0)) 252 | (cy (circle 1)) 253 | (r (circle 2)) 254 | (x (* r (cos theta))) 255 | (y (* r (sin theta)))) 256 | (list cx cy 257 | (+ cx x) 258 | (+ cy y)))) 259 | 260 | (test "Radius lines" 261 | (assert (equivalent? '(0 0 10 0) 262 | (radius-line (mk-circle :cx 0 :cy 0 :r 10) 263 | 0))) 264 | (assert (equivalent? '(0 0 0 10) 265 | (radius-line (mk-circle :cx 0 :cy 0 :r 10) 266 | (/ pi 2)))) 267 | (assert (equivalent? '(0 0 1 1) 268 | (radius-line (mk-circle :cx 0 :cy 0 :r (sqrt 2)) 269 | (/ pi 4))) 270 | "Slope of 1, radius (sqrt 2) => x=y=1") 271 | 272 | (assert (equivalent? '(0 0 -1 -1) 273 | (radius-line (mk-circle :cx 0 :cy 0 :r (sqrt 2)) 274 | (+ pi (/ pi 4)))))) 275 | -------------------------------------------------------------------------------- /src/scheme/aod/imgui/helpers.scm: -------------------------------------------------------------------------------- 1 | (ns aod.imgui.helpers) 2 | (ns-require aod.c.imgui :as ig) 3 | 4 | (define* (draw-circle circle (color -1) (segments 0) (filled #f) (thickness 1)) 5 | (if filled 6 | (apply ig/draw-circle-filled (apply-values circle) 7 | color 8 | segments 9 | ()) 10 | (apply ig/draw-circle (apply-values circle) 11 | color 12 | segments 13 | thickness 14 | ()))) 15 | 16 | ;; hmm this draws clockwise from 3 o'clock 17 | (define* (draw-arc circle (a-min 0) (a-max 1) (color -1) (segments 32) (thickness 1)) 18 | (apply ig/draw-arc (apply-values circle) 19 | a-min 20 | a-max 21 | color 22 | segments 23 | thickness 24 | ())) 25 | 26 | ;; int -1 => white 27 | (define* (draw-lines lines (color -1) (thickness 1)) 28 | (map (lambda (line) 29 | (apply ig/draw-line 30 | (apply-values line) 31 | color 32 | thickness 33 | ())) 34 | lines)) 35 | 36 | (comment 37 | (apply ig/draw-line (append line 38 | (list color) 39 | (list thickness))) 40 | ;; vs 41 | (apply ig/draw-line 42 | (apply-values line) 43 | color 44 | thickness 45 | ()) 46 | 47 | ) 48 | 49 | (define (frgb->u32 color) 50 | (apply ig/color32 51 | (map (lambda (val) 52 | (* val 255)) 53 | color))) 54 | 55 | (test "frgb->u32 : input 0.0 .. 1.0" 56 | (is (= -1 (apply ig/color32 '(255 255 255)))) 57 | (is (= -1 (frgb->u32 '(1 1 1))))) 58 | -------------------------------------------------------------------------------- /src/scheme/aod/imgui/macros.scm: -------------------------------------------------------------------------------- 1 | (ns aod.imgui.macros 2 | :doc "Some macros to make life easier while working with ImGui. 3 | The usual syntax is (args . body) 4 | - args are applied to corresponding raw imgui function 5 | - body is executed either in a when block (eg when a menu items is active) 6 | or wrapped between the begin/end calls" 7 | :require 8 | ((aod.c.imgui :as ig))) 9 | 10 | (define-macro (-safe . body) 11 | `(catch #t 12 | (lambda () 13 | ,@body) 14 | (lambda (tag info) 15 | (format *stderr* "Exception occured inside ImGui body: ~A~%" tag) 16 | (apply format *stderr* info) 17 | (newline)))) 18 | (define window 19 | (let ((+documentation+ "(window args . body) 20 | applies args to imgui/begin, executes body and calls imgui/end")) 21 | (macro (args . body) 22 | `(begin 23 | (,ig/begin ,@args) 24 | (,-safe ,@body) 25 | (,ig/end))))) 26 | 27 | (define-macro (maximized args . body) 28 | `(begin 29 | (,ig/begin-maximized ,@args) 30 | (,-safe ,@body) 31 | (,ig/end))) 32 | 33 | (define-macro (child args . body) 34 | `(begin 35 | (,ig/begin-child ,@args) 36 | (,-safe ,@body) 37 | (,ig/end-child))) 38 | 39 | (define-macro (group args . body) 40 | `(begin 41 | (,ig/begin-group ,@args) 42 | (,-safe ,@body) 43 | (,ig/end-group))) 44 | 45 | ;; the top bar, full window, menu 46 | (define-macro (main-menu-bar args . body) 47 | ;; note: begin-main-menu doesn't take any args, 48 | ;; but for the sake of consistency we keep this calling format 49 | ;; (some-macro args . body) 50 | ;; where args are applied to that first call 51 | `(begin 52 | (,ig/begin-main-menu-bar) 53 | ;; ,@body 54 | (,-safe ,@body) 55 | (,ig/end-main-menu-bar) 56 | )) 57 | 58 | (define-macro (menu-bar args . body) 59 | `(begin 60 | (,ig/begin-menu-bar) 61 | (,-safe ,@body) 62 | (,ig/end-menu-bar) 63 | )) 64 | 65 | ;; a menu (eg File) 66 | (define-macro (menu args . body) 67 | `(when (,ig/begin-menu ,@args) 68 | ;; ,@body 69 | (,-safe ,@body) 70 | (,ig/end-menu))) 71 | 72 | (define-macro (menu-item args . body) 73 | `(when (,ig/menu-item ,@args) 74 | ,@body)) 75 | 76 | (comment "window (begin etc)" 77 | (macroexpand (window ("title") 78 | (imgui/text "hi") 79 | (imgui/text "scheme s7")) 80 | ) 81 | ;; => 82 | (begin (imgui/begin "title") (imgui/text "hi") (imgui/text "scheme s7") (imgui/end)) 83 | 84 | 85 | (macroexpand (window ("test" 'the-c-object) 86 | (imgui/text "hi") 87 | (imgui/text "scheme s7") 88 | )) 89 | ;; => 90 | (begin (imgui/begin "test" 'the-c-object) (imgui/text "hi") (imgui/text "scheme s7") (imgui/end)) 91 | 92 | 93 | (macroexpand (window2 :title "always open" 94 | (imgui/text "hi") 95 | (imgui/text "scheme s7") 96 | )) 97 | ;; => 98 | (begin (imgui/begin "always open" (imgui/text "hi")) (imgui/text "scheme s7") (imgui/end)) 99 | 100 | (macroexpand (window2 :title "always open" 101 | :*open 'the-c-object 102 | (imgui/text "hi") 103 | (imgui/text "scheme s7") 104 | )) 105 | ;; => 106 | (begin (imgui/begin "always open" 'the-c-object) (imgui/text "hi") (imgui/text "scheme s7") (imgui/end)) 107 | 108 | ) 109 | 110 | (comment ;; menus 111 | (macroexpand 112 | (main-menu-bar 113 | (menu ("File") 114 | (imgui/menu-item "Open") 115 | ))) 116 | ;; ! menus 117 | ) 118 | ;; layout 119 | (define horizontal 120 | (let ((+documentation+ "(horizontal . body) 121 | executes first element of body and then inserts any next element with the same-line called before")) 122 | (macro body 123 | (let ((with-same-line-prepended (map 124 | (lambda (el) 125 | `(begin 126 | (,ig/same-line) 127 | ,el)) 128 | (cdr body)))) 129 | `(begin 130 | ,(car body) 131 | ,@with-same-line-prepended))))) 132 | (comment 133 | (macroexpand (horizontal 134 | (imgui/text "text 1") 135 | (imgui/text "text 2") 136 | (imgui/text "text 3"))) 137 | ;; => 138 | (begin (imgui/text "text 1") (begin (imgui/same-line) (imgui/text "text 2")) (begin (imgui/same-line) (imgui/text "text 3"))) 139 | 140 | ) 141 | 142 | (comment 143 | (defined? 'imgui/same-line) 144 | (macroexpand (horizontal-old 145 | (imgui/text "text 1") 146 | (imgui/text "text 2") 147 | (imgui/text "text 3"))) 148 | ;; => 149 | (begin (imgui/text "text 1") (begin (imgui/same-line) (imgui/text "text 2")) (begin (imgui/same-line) (imgui/text "text 3"))) 150 | 151 | ) 152 | -------------------------------------------------------------------------------- /src/scheme/aod/imgui_macros.scm: -------------------------------------------------------------------------------- 1 | (require aod.clj) ;; the (comment) macro is there 2 | (display "loaded imgui_macros.scm\n") 3 | (provide 'imgui-macros.scm) 4 | (define-macro (imgui/m-safe . body) 5 | `(catch #t 6 | (lambda () 7 | ,@body) 8 | (lambda args 9 | (apply format #t (cadr args)) 10 | (newline)))) 11 | 12 | (define-macro (imgui/m-window args . body) 13 | `(begin 14 | (imgui/begin ,@args) 15 | (imgui/m-safe ,@body) 16 | (imgui/end))) 17 | 18 | (define-macro (imgui/m-maximized args . body) 19 | `(begin 20 | (imgui/begin-maximized ,@args) 21 | (imgui/m-safe ,@body) 22 | (imgui/end))) 23 | 24 | (define-macro (imgui/m-child args . body) 25 | `(begin 26 | (imgui/begin-child ,@args) 27 | (imgui/m-safe ,@body) 28 | (imgui/end-child))) 29 | 30 | (define-macro (imgui/m-group args . body) 31 | `(begin 32 | (imgui/begin-group ,@args) 33 | (imgui/m-safe ,@body) 34 | (imgui/end-group))) 35 | 36 | ;; Note: the menu bars don't need any argumnets 37 | ;; but keeping the samy style of call (imgui/m-some-macro args . body) 38 | (define-macro (imgui/m-main-menu-bar args . body) 39 | `(begin 40 | (imgui/begin-main-menu-bar) 41 | (imgui/m-safe ,@body) 42 | (imgui/end-main-menu-bar) 43 | )) 44 | (define-macro (imgui/m-menu-bar args . body) 45 | `(begin 46 | (imgui/begin-menu-bar) 47 | (imgui/m-safe ,@body) 48 | (imgui/end-menu-bar) 49 | )) 50 | 51 | ;; a menu (eg File) 52 | (define-macro (imgui/m-menu args . body) 53 | `(when (imgui/begin-menu ,@args) 54 | ;; ,@body 55 | (imgui/m-safe ,@body) 56 | (imgui/end-menu))) 57 | 58 | (define-macro (imgui/m-menu-item args . body) 59 | `(when (imgui/menu-item ,@args) 60 | ,@body)) 61 | 62 | (define-macro* (imgui/m-begin2 (title "") (*open #t) :rest body) 63 | (if (eq? #t *open) 64 | `(begin 65 | (imgui/begin ,title) 66 | ,@body 67 | (imgui/end)) 68 | `(begin 69 | (imgui/begin ,title ,*open) 70 | ,@body 71 | (imgui/end)))) 72 | 73 | (comment "window (begin etc)" 74 | (macroexpand (imgui/m-window ("title") 75 | (imgui/text "hi") 76 | (imgui/text "scheme s7")) 77 | ) 78 | ;; => 79 | (begin (imgui/begin "title") (imgui/text "hi") (imgui/text "scheme s7") (imgui/end)) 80 | 81 | 82 | (macroexpand (imgui/m-window ("test" 'the-c-object) 83 | (imgui/text "hi") 84 | (imgui/text "scheme s7") 85 | )) 86 | ;; => 87 | (begin (imgui/begin "test" 'the-c-object) (imgui/text "hi") (imgui/text "scheme s7") (imgui/end)) 88 | 89 | 90 | (macroexpand (imgui/m-window2 :title "always open" 91 | (imgui/text "hi") 92 | (imgui/text "scheme s7") 93 | )) 94 | ;; => 95 | (begin (imgui/begin "always open" (imgui/text "hi")) (imgui/text "scheme s7") (imgui/end)) 96 | 97 | (macroexpand (imgui/m-window2 :title "always open" 98 | :*open 'the-c-object 99 | (imgui/text "hi") 100 | (imgui/text "scheme s7") 101 | )) 102 | ;; => 103 | (begin (imgui/begin "always open" 'the-c-object) (imgui/text "hi") (imgui/text "scheme s7") (imgui/end)) 104 | 105 | ) 106 | 107 | (comment ;; menus 108 | (macroexpand 109 | (imgui/m-main-menu-bar 110 | (imgui/m-menu ("File") 111 | (imgui/menu-item "Open") 112 | ))) 113 | ;; ! menus 114 | ) 115 | ;; layout 116 | (define-macro (imgui/m-horizontal . body) 117 | (let ((with-same-line-prepended (map 118 | (lambda (el) 119 | `(begin 120 | (imgui/same-line) 121 | ,el)) 122 | (cdr body)))) 123 | `(begin 124 | ,(car body) 125 | ,@with-same-line-prepended)) 126 | ) 127 | (comment 128 | (macroexpand (imgui/m-horizontal 129 | (imgui/text "text 1") 130 | (imgui/text "text 2") 131 | (imgui/text "text 3"))) 132 | ;; => 133 | (begin (imgui/text "text 1") (begin (imgui/same-line) (imgui/text "text 2")) (begin (imgui/same-line) (imgui/text "text 3"))) 134 | 135 | ) 136 | 137 | (define-macro (imgui/m-horizontal-old . body) 138 | ;; (display "hi, body is") 139 | ;; (display body) 140 | (let ((with-same-line-prepended (map-indexed 141 | (lambda (i sexp) 142 | (if (eq? i 0) 143 | sexp 144 | `(begin 145 | (imgui/same-line) 146 | ,sexp)) 147 | ) 148 | body))) 149 | `(begin 150 | ,@with-same-line-prepended)) 151 | ) 152 | 153 | (comment 154 | (defined? 'imgui/same-line) 155 | (macroexpand (imgui/m-horizontal-old 156 | (imgui/text "text 1") 157 | (imgui/text "text 2") 158 | (imgui/text "text 3"))) 159 | ;; => 160 | (begin (imgui/text "text 1") (begin (imgui/same-line) (imgui/text "text 2")) (begin (imgui/same-line) (imgui/text "text 3"))) 161 | 162 | ) 163 | -------------------------------------------------------------------------------- /src/scheme/aod/io.scm: -------------------------------------------------------------------------------- 1 | (ns aod.io) 2 | 3 | (define (copy in out) 4 | (catch 'wrong-type-arg ; s7 raises this error if write-char gets # 5 | (lambda () 6 | (do () () ; read/write until # 7 | (write-char (read-char in) out))) 8 | (lambda err 9 | #))) 10 | 11 | (define (get-file-contents file) 12 | (call-with-input-file file 13 | (lambda (in) 14 | (call-with-output-string 15 | (lambda (out) 16 | (copy in out)))))) 17 | ;; clojure style 18 | (define slurp get-file-contents) 19 | 20 | (define (put-file-contents file contents) 21 | (call-with-output-file file 22 | (lambda (out) 23 | (call-with-input-string contents 24 | (lambda (in) 25 | (copy in out)))))) 26 | 27 | ;; clojure style 28 | (define spit put-file-contents) 29 | 30 | (comment 31 | (call-with-input-file "/home/actondev/Desktop/s7.txt" 32 | (lambda (in) 33 | (write-from-to in *stderr*))) 34 | 35 | (get-file-contents "/home/actondev/Desktop/s7.txt") 36 | (put-file-contents "/home/actondev/Desktop/s7.txt" 37 | "Erase & rewind, cause I've been changing my mind") 38 | ) 39 | -------------------------------------------------------------------------------- /src/scheme/aod/layout.scm: -------------------------------------------------------------------------------- 1 | (ns aod.layout) 2 | 3 | (define circular 4 | (let ((+documentation+ "Circular layout. 5 | Calls (cb x y :phase [0 .. (N-1)/N] :n [0 .. N] 6 | 7 | If the gui flag is passed (and indeed working with computer graphics) 8 | the elements will be drawn clock-wise starting from 12 o'clock. The 9 | theta-offset and clock-wise flags won't have any effect. Let's call it 10 | a known-issue")) 11 | (lambda* (cb (N 12) (R 100) (center '(0 0)) (clock-wise #f) (theta-offset 0) (gui #f)) 12 | (when gui 13 | (set! theta-offset (- (/ pi 2))) 14 | (set! clock-wise #f) ;; when in gui, with clock-wise #f the drawing is.. clock-wise 15 | ) 16 | (let ((d-theta (/ (* 2 pi) N))) 17 | (map (lambda (i) 18 | (let* ( 19 | (theta (+ theta-offset (* i d-theta ))) 20 | (theta (if clock-wise 21 | (- theta) 22 | theta)) 23 | (x (+ (center 0) (* R (cos theta)))) 24 | (y (+ (center 1) (* R (sin theta))))) 25 | (cb x y :phase (/ i N) :n i :N N))) 26 | (range N)))))) 27 | 28 | (test "Circular layout" 29 | (with-temp-ns 30 | (define* (el x y :allow-other-keys) 31 | `(el ,x ,y)) 32 | (is (equivalent? '((el 1.0 0.0) 33 | (el 0.0 1.0) 34 | (el -1.0 0.0) 35 | (el 0.0 -1.0)) 36 | (circular el :N 4 :R 1 ))) 37 | 38 | (is (equivalent? '((el 1.0 0.0) 39 | (el 0.0 -1.0) 40 | (el -1.0 0.0) 41 | (el 0.0 1.0)) 42 | (circular el :N 4 :R 1 :clock-wise #t))) 43 | )) 44 | 45 | -------------------------------------------------------------------------------- /src/scheme/aod/midi.scm: -------------------------------------------------------------------------------- 1 | (ns aod.midi) 2 | (ns-require aod.c.midi :as midi) 3 | 4 | (test "Basic midi" 5 | (define c1-note-on '(144 12 127)) 6 | (define c1-note-off '(128 12 0)) 7 | ;; note on message, but velocity 0 8 | ;; happens in my midi keyboard with RtMidi in linux 9 | (define c1-note-off-2 '(144 12 0)) 10 | 11 | (is (eq? #t (apply midi/note-on? c1-note-on))) 12 | (is (eq? #f (apply midi/note-off? c1-note-on))) 13 | (is (= 12 (apply midi/note-number c1-note-on))) 14 | ;; 15 | (is (eq? #f (apply midi/note-on? c1-note-off))) 16 | (is (eq? #t (apply midi/note-off? c1-note-off))) 17 | (is (= 12 (apply midi/note-number c1-note-off))) 18 | 19 | (is (eq? #f (apply midi/note-on? c1-note-off-2))) 20 | (is (eq? #t (apply midi/note-off? c1-note-off-2))) 21 | ) 22 | -------------------------------------------------------------------------------- /src/scheme/aod/scales.scm: -------------------------------------------------------------------------------- 1 | (ns aod.scales) 2 | 3 | ;; Scales given as a vector of semitones from the root 4 | ;; 5 | ;; - 0 denotes the root/tonic 6 | ;; - 0 -> 1 denotes a half step 7 | ;; - 3 -> 5 denotes a whole step 8 | ;; - 3 -> 4 denotes a half step 9 | ;; 10 | ;; Thanks to: 11 | ;; - https://learningmusic.ableton.com/advanced-topics/modes.html 12 | ;; - https://www.bandnotes.info/tidbits/scales/half-whl.htm 13 | 14 | (define chromatic (range 12)) 15 | ;; Whole - Whole - Half - Whole - Whole - Whole - Half 16 | (define major '(0 2 4 5 7 9 11)) 17 | 18 | ;; (natural minor) 19 | ;; Whole - Half - Whole - Whole - Half - Whole - Whole 20 | ;; Also called Aeolian 21 | (define minor '(0 2 3 5 7 8 10)) 22 | 23 | 24 | (comment 25 | ;; from my clojure app 26 | (def chromatic 27 | [0 1 2 3 4 5 6 7 8 9 10 11 #_12]) 28 | 29 | (def major 30 | "Whole - Whole - Half - Whole - Whole - Whole - Half" 31 | [0 2 4 5 7 9 11 #_12]) 32 | 33 | (def minor 34 | "(natural minor) 35 | Whole - Half - Whole - Whole - Half - Whole - Whole 36 | Also called Aeolian" 37 | [0 2 3 5 7 8 10 #_12]) 38 | 39 | (def minor-harmonic 40 | "R, W, H, W, W, H, 1 1/2, H" 41 | [0 2 3 5 7 8 11 #_12]) 42 | 43 | (def minor-melodic-up 44 | "R, W, H, W, W, W, W, H" 45 | [0 2 3 5 7 9 11 #_12]) 46 | 47 | (def minor-melodic-down 48 | "R, W, W, H, W, W, H, W" 49 | [0 2 4 5 7 9 10 #_12]) 50 | 51 | (def dorian 52 | "Whole - Half - Whole - Whole - Whole - Half - Whole" 53 | [0 2 3 5 7 9 10 #_12]) 54 | 55 | (def phrygian 56 | "Half - Whole - Whole - Whole - Half - Whole - Whole" 57 | [0 1 3 5 7 8 10 #_12]) 58 | 59 | (def lydian 60 | "Whole - Whole - Whole - Half - Whole - Whole - Half" 61 | [0 2 4 6 7 9 11 #_12]) 62 | 63 | (def mixolydian 64 | "Whole - Whole - Half - Whole - Whole - Half - Whole" 65 | [0 2 4 5 7 9 10 #_12] 66 | ) 67 | 68 | (def locrian 69 | "Half - Whole - Whole - Half - Whole - Whole - Whole" 70 | [0 1 3 5 6 8 10 #_12]) 71 | 72 | ) 73 | -------------------------------------------------------------------------------- /src/scheme/aod/string.scm: -------------------------------------------------------------------------------- 1 | (ns aod.string) 2 | 3 | (define* (count-char-occurs char string (limit +inf.0)) 4 | (let ((occurs -1)) 5 | (let loop ((pos -1)) 6 | (if (or 7 | (= occurs limit) 8 | (eq? #f pos)) 9 | occurs 10 | (begin 11 | (set! occurs (inc occurs)) 12 | (loop (char-position char string (inc pos)))))))) 13 | 14 | (test "Count char occurences in string" 15 | (is (= 4 (count-char-occurs #\. "1.2.3.4."))) 16 | (is (= 0 (count-char-occurs #\, "1.2.3.4."))) 17 | ) 18 | 19 | (test "Count char occurences in string, with stop limit" 20 | (is (= 2 (count-char-occurs #\. "1.2.3.4." :limit 2))) 21 | ) 22 | -------------------------------------------------------------------------------- /src/scheme/aod/sxs.scm: -------------------------------------------------------------------------------- 1 | (ns aod.sxs) 2 | (ns-require aod.geom :as geom) 3 | 4 | ;; note: if i direclty pass this file to the repl executable 5 | ;; i need to laod the aod.test in the (rootlet) in order for 6 | ;; the tests to run 7 | (comment 8 | (with-let (rootlet) 9 | (require aod.test)) 10 | ) 11 | 12 | ;; The needed length of the arrow in order to form a perfect square 13 | ;; Cause r*cos45 = sqrt(2)/2 .. we want it to be 2/3 14 | ;; x * sqrt(2)/2 = 2/3 * r 15 | ;; => x= 4/(3* sqrt(2)) * r 16 | (define (arrow-length r) 17 | (/ (* 4 r) 18 | (* 3 (sqrt 2)))) 19 | 20 | (define factor-arrow-length 21 | (/ 4 22 | (* 3 (sqrt 2)))) 23 | 24 | (define factor-clip-radius 25 | (/ 1 factor-arrow-length)) 26 | 27 | (define* (-arrow-angles (dir 'right)) 28 | ;; or.. I could just hardcode it.. wtf 29 | (let* ((angle-a (* 0.75 pi)) 30 | (angle-b (+ angle-a (/ pi 2)))) 31 | (cond ((eq? dir 'right) 32 | (list angle-a angle-b)) 33 | (else 34 | (list (- angle-a pi) 35 | (- angle-b pi)))))) 36 | 37 | (test "Arrow angles" 38 | (assert (equivalent? '(135.0 225.0) 39 | (map geom/rad->deg 40 | (-arrow-angles :dir 'right)))) 41 | (assert (equivalent? '(-45 45) 42 | (map geom/rad->deg 43 | (-arrow-angles :dir 'left))))) 44 | 45 | ;; like geom/radius-line, but we need to adjust r 46 | (define (sxs-radius-line circle theta) 47 | (let* ((cx (circle 0)) 48 | (cy (circle 1)) 49 | (r (* factor-arrow-length (circle 2))) 50 | (x (* r (cos theta))) 51 | (y (* r (sin theta)))) 52 | (list cx cy 53 | (+ cx x) 54 | (+ cy y)))) 55 | 56 | (define* (arrow-lines circle (dir 'right)) 57 | (map (lambda (theta) 58 | (sxs-radius-line circle theta)) 59 | (-arrow-angles :dir dir))) 60 | 61 | (test "Drawing arrows" 62 | (assert (equivalent? '((0 0 -0.9428090415820632 0.9428090415820634) (0 0 -0.9428090415820636 -0.9428090415820632)) 63 | (arrow-lines (geom/mk-circle :cx 0 :cy 0 :r (sqrt 2)) 64 | :dir 'right))) 65 | (assert (equivalent? '((0 0 0.9428090415820634 -0.9428090415820632) (0 0 0.9428090415820634 0.9428090415820632)) 66 | (arrow-lines (geom/mk-circle :cx 0 :cy 0 :r (sqrt 2)) 67 | :dir 'left))) 68 | ) 69 | 70 | (define (-arrow-right circle) 71 | (map (lambda (theta) 72 | (sxs-radius-line circle theta)) 73 | (-arrow-angles :dir 'right))) 74 | 75 | (define (-arrow-left circle) 76 | (map (lambda (theta) 77 | (sxs-radius-line circle theta)) 78 | (-arrow-angles :dir 'left))) 79 | 80 | (define (arrows-right circle) 81 | (let* ((r (circle 2)) 82 | (offset (* 2 r))) 83 | (geom/repeat-lines 84 | (-arrow-right circle) 85 | `((,(- offset) 0) 86 | (0 0) 87 | (,offset 0))))) 88 | 89 | (define (arrows-left circle) 90 | (let* ((r (circle 2)) 91 | (offset (* 2 r))) 92 | (geom/repeat-lines 93 | (-arrow-left circle) 94 | `((,(- offset) 0) 95 | (0 0) 96 | (,offset 0))))) 97 | 98 | (test "SXS repeat line" 99 | (assert (equivalent? '((0 2 10 12) (0 -2 10 8)) (geom/repeat-line '(0 0 10 10) '((0 2) (0 -2)))))) 100 | 101 | ;; The sigma-x-square lines to draw the logo 102 | ;; 103 | ;; Could make every other function "private" actually 104 | (define lines 105 | (let ((+documentation+ "(lines circle (phase 0) (clip #t)) 106 | Returns a list of the lines to be drawn to paint the sxs logo. 107 | 108 | The circle is of the (cx cy r) form. 109 | A line is of the (x1 y1 x2 y2) form.")) 110 | (lambda* (circle (phase 0) (clip #t)) 111 | (let* ((phase (mod (+ 112 | (/ 2 3) ;; 2/3 offset to start at sigma 113 | ;; if not, it starts with x 114 | phase) 1)) 115 | ;; offsets: (list offset-x offset-y) 116 | (offset-right (list (* 2 phase (circle 2)) 117 | 0)) 118 | (offset-left (list (- (* 2 phase (circle 2))) 119 | 0))) 120 | (let ((lines 121 | (append 122 | (geom/lines-offset (arrows-right circle) 123 | offset-right) 124 | (geom/lines-offset (arrows-left circle) 125 | offset-left) 126 | ))) 127 | (if clip 128 | ;; clipping with a slightly bigger circle 129 | ;; to show the complete sigma 130 | ;; should I use this here, or on the lines.. where? 131 | (let ((circle-modified `(,(circle 0) 132 | ,(circle 1) 133 | ,(* factor-clip-radius (circle 2) )) 134 | )) 135 | (geom/clip-lines-in-circle lines circle-modified)) 136 | lines)))))) 137 | 138 | ;; This is a good example of using memoize, 139 | ;; to save on computation. 140 | ;; However, this should be done in another place, 141 | ;; where it's being used 142 | ;; (set! lines (memoize lines)) 143 | 144 | (test "SXS lines non-clipped - X" 145 | (is (equivalent? 146 | '((-2.8284271247461903 0 -3.7712361663282534 0.9428090415820634) (0.0 0 -0.9428090415820632 0.9428090415820634) (2.8284271247461903 0 1.8856180831641272 0.9428090415820634) (-2.8284271247461903 0 -3.771236166328254 -0.9428090415820632) (0.0 0 -0.9428090415820636 -0.9428090415820632) (2.8284271247461903 0 1.8856180831641267 -0.9428090415820632) (-2.8284271247461903 0 -1.885618083164127 -0.9428090415820632) (0.0 0 0.9428090415820634 -0.9428090415820632) (2.8284271247461903 0 3.7712361663282534 -0.9428090415820632) (-2.8284271247461903 0 -1.885618083164127 0.9428090415820632) (0.0 0 0.9428090415820634 0.9428090415820632) (2.8284271247461903 0 3.7712361663282534 0.9428090415820632)) 147 | (lines (geom/mk-circle :cx 0 :cy 0 :r (sqrt 2)) 148 | :clip #f 149 | :phase (/ 1 3)) 150 | 151 | )) 152 | ) 153 | 154 | 155 | 156 | (test "SXS lines clipped - X" 157 | (is (equivalent? '((0.0 0 -0.9428090415820632 0.9428090415820634) (0.0 0 -0.9428090415820636 -0.9428090415820632) (0.0 0 0.9428090415820634 -0.9428090415820632) (0.0 0 0.9428090415820634 0.9428090415820632)) 158 | (lines (geom/mk-circle :cx 0 :cy 0 :r (sqrt 2)) 159 | :clip #t 160 | :phase (/ 1 3)))) 161 | ) 162 | (test "SXS lines clipped - <> (square)" 163 | (is (equivalent? '((0.9428090415820635 0 2.220446049250313e-16 0.9428090415820634) (0.9428090415820635 0 -1.1102230246251565e-16 -0.9428090415820632) (-0.9428090415820635 0 -1.1102230246251565e-16 -0.9428090415820632) (-0.9428090415820635 0 -1.1102230246251565e-16 0.9428090415820632)) 164 | (lines (geom/mk-circle :cx 0 :cy 0 :r (sqrt 2)) 165 | :clip #t 166 | :phase (/ 2 3)))) 167 | ) 168 | 169 | (comment 170 | ;; returns some empty lists inside 171 | ;; ..fixed 172 | (lines (geom/mk-circle :cx 0 :cy 0 :r 100) 173 | :phase 0.3555555555555 174 | :clip #t) 175 | ) 176 | 177 | 178 | ;; (print "loaded aod.sxs, *ns* " *ns*) 179 | -------------------------------------------------------------------------------- /src/scheme/aod/test.scm: -------------------------------------------------------------------------------- 1 | (provide 'aod.test) 2 | (define-macro* (assert assertion (msg "")) 3 | ;; hm msg is not used 4 | `(begin 5 | (if ,assertion 6 | (begin 7 | ;; (format *stderr* "~A: ok~%" ',assertion) 8 | #t) 9 | (begin 10 | ;; (format *stderr* "------ ~A: ~A failed~%" (*function*) ',assertion) 11 | (throw 'assertion-failed "~A: ~A~%" (*function*) ',assertion) 12 | #f)))) 13 | 14 | (define is assert) 15 | 16 | (define *aod.test* (let ((ht (make-hash-table))) 17 | (set! (ht 'fail) 0) 18 | (set! (ht 'pass) 0) 19 | ht)) 20 | 21 | (define-macro (test name . body) 22 | (let ((test-header (or (*ns* '*ns-name*) ""))) 23 | `(catch #t 24 | (lambda () 25 | (with-let (if (and (defined? '*ns*) 26 | (let? *ns*)) 27 | *ns* 28 | (curlet)) 29 | (let ((*test-env* (curlet))) 30 | (call-with-exit 31 | (lambda (return) 32 | (map (lambda (e) 33 | ;; (print "===> eval " e) 34 | (eval e *test-env*)) 35 | ',body) 36 | (set! (*aod.test* 'pass) (+ 1 (*aod.test* 'pass))) 37 | (format *stderr* "PASS: ~A \"~A\"~%" ',test-header ,name) 38 | #t 39 | ))))) 40 | (lambda (tag info) 41 | (set! (*aod.test* 'fail) (+ 1 (*aod.test* 'fail))) 42 | (format *stderr* "FAIL: ~A \"~A\" \n\t~A~%\t~A~%" 43 | ',test-header 44 | ,name 45 | tag 46 | (apply format #f info) 47 | ))))) 48 | 49 | ;; hmm.. have to think this more how it should be done 50 | (define testgui (if (provided? 'aod.test.gui) 51 | test 52 | comment)) 53 | -------------------------------------------------------------------------------- /src/scheme/examples/text-editor.scm: -------------------------------------------------------------------------------- 1 | ;; loading this into rootlet so that from c side I can direclty call 2 | ;; (draw) etc 3 | (ns rootlet 4 | :require ((aod.c.foreign :as c) 5 | (aod.c.imgui :as ig) 6 | (aod.imgui.macros :as igm) 7 | (aod.c.nfd) 8 | (aod.io :as io) 9 | (aod.c.imgui.window-flags :as igw))) 10 | 11 | (define buffer-size 2048) 12 | (define *buffer (c/new-char[] buffer-size)) 13 | 14 | (define (open) 15 | (and-let* ((file (aod.c.nfd/open)) 16 | (contents (io/slurp file))) 17 | (if (< buffer-size (length contents)) 18 | (print "text bigger than buffer-size!") 19 | (set! (*buffer) contents)))) 20 | 21 | (define (save) 22 | (if-let* ((file (aod.c.nfd/save))) 23 | (io/spit file (*buffer)) 24 | (print "User cancelled!"))) 25 | 26 | (define (draw-menu) 27 | (igm/menu-bar 28 | () 29 | (igm/menu 30 | ("File") 31 | (igm/menu-item ("Open") 32 | (print "Clicked open") 33 | (open)) 34 | (igm/menu-item ("Save") 35 | (print "Clicked save") 36 | (save))))) 37 | 38 | (define (draw) 39 | (igm/maximized 40 | ("s7 texxt editor" igw/MenuBar) 41 | (draw-menu) 42 | (ig/input-text-multiline "##text-input" *buffer buffer-size) 43 | ;; 44 | )) 45 | 46 | -------------------------------------------------------------------------------- /src/scheme/examples/text-input.scm: -------------------------------------------------------------------------------- 1 | (ns-require aod.imgui.macros :as igm) 2 | (ns-require aod.c.imgui :as ig) 3 | (ns-require aod.c.foreign :as c) 4 | (ns-require aod.components.input :as input) 5 | (ns-require aod.c.imgui.col :as igc) 6 | (ns-require aod.imgui.helpers :as igh) 7 | 8 | 9 | ;; the exposed functions 10 | (define (setup) 11 | (display "initializing main.scm: in setup\n") 12 | (ig/set-color igc/FrameBg (igh/frgb->u32 '(0.3 0.3 0.3))) 13 | ) 14 | 15 | (define str-size 128) 16 | (define *str (c/new-char[] str-size)) 17 | (define *str2 (c/new-char[] str-size)) 18 | 19 | (define form '(a b c)) 20 | 21 | (define input-data (input/new '(a b c))) 22 | 23 | (define (draw) 24 | (igm/maximized 25 | ("gui repl") 26 | (ig/input-text "Gimme some text 2" *str2 str-size) 27 | (ig/text "input component") 28 | (when (input/draw input-data) 29 | (let ((form (input-data 'value))) 30 | (print "changed form to " (input-data 'value)) 31 | (when (and (pair? form) 32 | (eq? 'eval (car form))) 33 | (set! (input-data 'value) (eval (cadr form))) 34 | ))))) 35 | 36 | -------------------------------------------------------------------------------- /src/scheme/fib.scm: -------------------------------------------------------------------------------- 1 | (define (fib n) 2 | (if (<= n 1) 1 3 | (+ (fib (- n 1)) 4 | (fib (- n 2))))) 5 | -------------------------------------------------------------------------------- /src/scheme/hello.scm: -------------------------------------------------------------------------------- 1 | (display "hello from s7 scheme") 2 | (newline) 3 | (display "(one more line)") 4 | (newline) 5 | 6 | (define-macro (time expr) 7 | `(let ((start (*s7* 'cpu-time))) 8 | (let ((res (list ,expr))) ; expr might return multiple values 9 | (list (car res) 10 | (- (*s7* 'cpu-time) start))))) 11 | 12 | 13 | (load "scheme/fib.scm") 14 | (display "fib 34\n") 15 | (display 16 | (time (fib 34)) 17 | ) 18 | (newline) 19 | -------------------------------------------------------------------------------- /src/scheme/imgui_scratch.scm: -------------------------------------------------------------------------------- 1 | ;; (ns imgui-sratch) 2 | 3 | (ns-require aod.c.imgui-sdl :as igsdl) 4 | (ns-require aod.c.imgui :as ig) 5 | (ns-require aod.imgui.macros :as igm) 6 | (ns-require aod.c.gl :as gl) ;; for screenshots 7 | (ns-require aod.layout :as l) 8 | (ns-require aod.imgui.helpers :as igh) 9 | (ns-require aod.colors :as colors) 10 | (ns-require aod.components.piano-wheel :as piano) 11 | (ns-require aod.components.sxs-wheel :as sxs) 12 | 13 | (define *ctx* (igsdl/setup 420 420)) 14 | 15 | (set! (hook-functions (aod.c.repl '*eval-hook*)) 16 | (cons (lambda (hook) 17 | (if (eq? 'ns (car (hook 'form))) 18 | (begin 19 | ;;(print "just an ns form" (hook 'form)) 20 | ) 21 | (begin 22 | (draw)) 23 | ) 24 | ) 25 | (hook-functions (aod.c.repl '*eval-hook*)))) 26 | 27 | (comment 28 | (set! (hook-functions (aod.c.repl '*eval-hook*)) ()) 29 | ) 30 | 31 | (define sxs (sxs/new :R 150)) 32 | (define piano (piano/new :R 80 :cx 180 :cy 180)) 33 | 34 | ;; upon redefining do-draw funcion 35 | ;; the (draw) will get called 36 | (define (do-draw) 37 | (print "Drawing!!!!!") 38 | (igm/maximized 39 | ("imgui scratch") 40 | (piano/draw piano) 41 | (sxs/draw sxs) 42 | )) 43 | 44 | (define (draw) 45 | (igsdl/prepare *ctx*) 46 | (do-draw) 47 | (igsdl/flush *ctx*) 48 | ) 49 | 50 | (draw) 51 | 52 | (comment 53 | (igsdl/destroy *ctx*) 54 | (exit) 55 | 56 | (gl/save-screenshot "test.png") 57 | 58 | ;; documentation 59 | (ns-doc 'aod.c.gl) 60 | (ns-doc 'aod.c.imgui) 61 | (ns-doc 'aod.c.imgui-sdl) 62 | (ns-doc 'aod.layout) 63 | (ns-doc 'aod.sxs) 64 | (ns-doc 'aod.imgui.helpers) 65 | 66 | (keys *nss*) 67 | (hash-table-entries *nss*) 68 | ) 69 | -------------------------------------------------------------------------------- /src/scheme/main.scm: -------------------------------------------------------------------------------- 1 | (ns-require aod.imgui.macros :as igm) 2 | (ns-require aod.c.imgui :as ig) 3 | (ns-require aod.c.foreign :as c) 4 | 5 | ;; the exposed functions 6 | (define (setup) 7 | (display "initializing main.scm: in setup\n")) 8 | 9 | (define (draw) 10 | (igm/maximized ("gui repl") 11 | (ig/text "hi there")) 12 | ) 13 | -------------------------------------------------------------------------------- /src/scheme/main_2020-07-02.scm: -------------------------------------------------------------------------------- 1 | (display "loading main.scm\n") 2 | 3 | ;; (load "imgui_macros.scm") 4 | 5 | 6 | (define click-counter 0) 7 | (define window1-open ((*c-primitives* 'bool) #t)) 8 | 9 | ;; the exposed functions 10 | (define (setup) 11 | (display "initializing main.scm: in setup\n")) 12 | 13 | (define color-4 ((*c-primitives* 'float-arr) 0.5 0.4 0.2)) 14 | 15 | (define (adjust-color!) 16 | (when (defined? 'imgui/clear-color) 17 | (let ((new-val (imgui/clear-color 0))) 18 | (if (>= new-val 1) 19 | (set! new-val 0)) 20 | (set! (imgui/clear-color 0) (+ 0.01 new-val))) 21 | ) 22 | ) 23 | 24 | (define (draw) 25 | (imgui/begin "s7 window") 26 | (imgui/text "I like scheme :)") 27 | (adjust-color!) 28 | 29 | (if (imgui/button (format #f "Click ~A times" click-counter)) 30 | (begin 31 | (set! click-counter (+ 1 click-counter)) 32 | (format *stdout* "new counter ~A\n" click-counter))) 33 | (when (not (window1-open)) 34 | (when (imgui/button "Open the closeable window") 35 | (set! (window1-open) #t))) 36 | 37 | (imgui/text "another one") 38 | (imgui/checkbox "show that other window" window1-open) 39 | 40 | 41 | 42 | 43 | (imgui/color-edit-3 "Here's a color" 44 | color-4) 45 | 46 | (imgui/end) 47 | 48 | (when (window1-open) 49 | 50 | (imgui/begin "s7 closable window" window1-open) 51 | (imgui/text "I like scheme as well :)") 52 | (imgui/end)) 53 | ;; done drawing 54 | ) 55 | 56 | -------------------------------------------------------------------------------- /src/scheme/ns-bar.scm: -------------------------------------------------------------------------------- 1 | (ns ns.bar) 2 | 3 | (define (-private-info) 4 | "ns.bar private info") 5 | 6 | (define echo 7 | (let ((+documentation+ "bar echo")) 8 | (lambda () 9 | (print "echo from bar " (-private-info))))) 10 | 11 | 12 | ;; (echo-doc) 13 | ;; (print (documentation echo-doc)) 14 | (print "--- ns.bar loaded, curlet " (curlet)) 15 | -------------------------------------------------------------------------------- /src/scheme/ns-bar2.scm: -------------------------------------------------------------------------------- 1 | (ns ns.bar2) 2 | 3 | (ns-require ns.bar :as bar-alias) 4 | 5 | ;; (print "bar2 after require curlet " (curlet)) 6 | 7 | (define echo 8 | (let ((+documentation+ "bar2 echo")) 9 | (lambda () 10 | (print "bar2: echo") 11 | ;; (print "curlet is " (curlet)) 12 | (bar-alias/echo))) 13 | ) 14 | 15 | -------------------------------------------------------------------------------- /src/scheme/s7/.gitignore: -------------------------------------------------------------------------------- 1 | # generated 2 | libc_s7* -------------------------------------------------------------------------------- /src/scheme/scratch.scm: -------------------------------------------------------------------------------- 1 | ;; Scratch file to pass as an argument to the repl executable 2 | ;; for playin around 3 | (require aod.test) 4 | (ns scratch) 5 | (ns-require aod.sxs) 6 | -------------------------------------------------------------------------------- /src/scheme/test/c_foreign_test.scm: -------------------------------------------------------------------------------- 1 | (ns aod.test.c.foreign) 2 | (ns-require aod.c.foreign :as c) 3 | 4 | (test "new bool" 5 | (with-temp-ns 6 | (is (not (defined? 'x))) 7 | (define x (c/new-bool #f)) 8 | (is (eq? #f (x))) 9 | (set! (x) #t) 10 | (is (eq? #t (x)))) 11 | ) 12 | 13 | (test "new bool[]" 14 | (with-temp-ns 15 | (is (not (defined? 'x))) 16 | (define x (c/new-bool[] 3)) 17 | (is (eq? #f (x 0))) 18 | (is (eq? #f (x 1))) 19 | (is (eq? #f (x 2))) 20 | (set! (x 1) #t) 21 | (is (eq? #t (x 1))) 22 | (is (eq? #f (x 2))) 23 | ;; 24 | )) 25 | 26 | (test "new int" 27 | (with-temp-ns 28 | (is (not (defined? 'x))) 29 | (define x (c/new-int 10)) 30 | (is (eq? 10 (x))) 31 | (set! (x) 20) 32 | (is (eq? 20 (x))) 33 | ;; 34 | )) 35 | 36 | (test "new int[]" 37 | (with-temp-ns 38 | (is (not (defined? 'x))) 39 | (define x (c/new-int[] 3)) 40 | (is (eq? 0 (x 0))) 41 | (is (eq? 0 (x 1))) 42 | (is (eq? 0 (x 2))) 43 | (set! (x 1) 11) 44 | (is (eq? 11 (x 1))) 45 | (is (eq? 0 (x 2)))) 46 | ) 47 | -------------------------------------------------------------------------------- /src/scheme/test/ns_test.scm: -------------------------------------------------------------------------------- 1 | (require aod.clj) 2 | (ns foo.bar) 3 | (ns-require aod.benchmark :as bench) 4 | 5 | (test "Normal required calls" 6 | (is (= 89 (bench/fib 10))) 7 | ) 8 | -------------------------------------------------------------------------------- /src/scheme/test/partial_test.scm: -------------------------------------------------------------------------------- 1 | (ns test.partial) 2 | 3 | (define (add-double a b) 4 | (+ a (* 2 b))) 5 | 6 | (define add1-double 7 | (partial add-double 1)) 8 | 9 | (add1-double 2) 10 | 11 | (define* (add-double* (a 0) (b 0)) 12 | (+ a (* 2 b))) 13 | 14 | (define add1-double* 15 | (partial add-double* :a 1)) 16 | 17 | (with-let (rootlet) 18 | (require aod.test)) 19 | (test "partial" 20 | (= 5 (add-double 1 2)) 21 | (= 5 (add1-double 2)) 22 | (= 5 (add-double* 1 2)) 23 | (= 5 (add-double* :a 1 :b 2)) 24 | (= 5 (add1-double* :b 2)) 25 | ) 26 | -------------------------------------------------------------------------------- /src/scheme/todo_r7rs.scm: -------------------------------------------------------------------------------- 1 | ;; let's see if I can get this to run on windows 2 | 3 | (require libc.scm) 4 | (require r7rs.scm) 5 | 6 | 7 | (define (box-inc! b) 8 | (display "box-inc!\n") 9 | (set-box! b (+ 1 (unbox b))) 10 | ) 11 | 12 | (define counter-box (box 0)) 13 | -------------------------------------------------------------------------------- /src/scheme/user.scm: -------------------------------------------------------------------------------- 1 | (begin (require aod.core) 2 | (autoload 'ns.bar "ns-bar.scm") 3 | (autoload 'ns.bar2 "ns-bar2.scm")) 4 | (ns user) 5 | (ns-require ns.bar2 :as bar2) 6 | ;; (ns-require ns.bar :as bar) 7 | 8 | 9 | 10 | (comment 11 | *nss* 12 | *ns* 13 | 14 | (map 15 | (lambda (binding) 16 | (print "binding " binding)) 17 | (*nss* 'ns.bar2)) 18 | 19 | (*nss* 'user) 20 | (*nss* 'ns.bar2) 21 | 22 | (with-ns ns.bar2 23 | (bar-alias/echo)) 24 | 25 | (with-ns user 26 | (bar2/echo)) 27 | 28 | (with-let (*nss* 'user) 29 | (bar/echo)) 30 | 31 | (with-ns user 32 | (bar/echo)) 33 | 34 | (with-ns ns.bar 35 | (echo)) 36 | 37 | (with-ns ns.bar2 38 | (echo)) 39 | 40 | (*nss* 'ns.bar2) 41 | ) 42 | 43 | ;; (print "user loaded, ns is " *ns* " curlet " (let->list (curlet))) 44 | -------------------------------------------------------------------------------- /subprojects/gtest.wrap: -------------------------------------------------------------------------------- 1 | [wrap-file] 2 | directory = googletest-release-1.10.0 3 | 4 | source_url = https://github.com/google/googletest/archive/release-1.10.0.zip 5 | source_filename = gtest-1.10.0.zip 6 | source_hash = 94c634d499558a76fa649edb13721dce6e98fb1e7018dfaeba3cd7a083945e91 7 | 8 | patch_url = https://wrapdb.mesonbuild.com/v1/projects/gtest/1.10.0/1/get_zip 9 | patch_filename = gtest-1.10.0-1-wrap.zip 10 | patch_hash = 04ff14e8880e4e465f6260221e9dfd56fea6bc7cce4c4aff0dc528e4a2c8f514 11 | -------------------------------------------------------------------------------- /subprojects/imgui.wrap: -------------------------------------------------------------------------------- 1 | [wrap-file] 2 | directory = imgui-1.76 3 | 4 | source_url = https://github.com/ocornut/imgui/archive/v1.76.tar.gz 5 | source_filename = v1.76.tar.gz 6 | source_hash = e482dda81330d38c87bd81597cacaa89f05e20ed2c4c4a93a64322e97565f6dc 7 | 8 | 9 | patch_url = https://wrapdb.mesonbuild.com/v1/projects/imgui/1.76/2/get_zip 10 | patch_filename = imgui-1.76-2-wrap.zip 11 | patch_hash = 1fb56f37e0890eac6ebfe6c8d9bb0bcda36c74231cbdcfbd3c7b1b65d8905b68 12 | -------------------------------------------------------------------------------- /subprojects/nfd.wrap: -------------------------------------------------------------------------------- 1 | [wrap-git] 2 | url = https://github.com/actonDev/nativefiledialog.git 3 | revision = feature/meson 4 | depth = 1 -------------------------------------------------------------------------------- /subprojects/nng.wrap: -------------------------------------------------------------------------------- 1 | [wrap-git] 2 | url = https://github.com/nanomsg/nng.git 3 | revision = v1.3.0 4 | depth = 1 5 | -------------------------------------------------------------------------------- /subprojects/s7.wrap: -------------------------------------------------------------------------------- 1 | [wrap-git] 2 | url = https://github.com/actonDev/s7.git 3 | revision = feature/meson 4 | depth = 1 -------------------------------------------------------------------------------- /subprojects/sdl2.wrap: -------------------------------------------------------------------------------- 1 | [wrap-git] 2 | url = https://github.com/actonDev/SDL.git 3 | revision = feature/2.0.3-x11-createWindowFrom 4 | depth = 1 -------------------------------------------------------------------------------- /subprojects/sdl_net.wrap: -------------------------------------------------------------------------------- 1 | [wrap-git] 2 | url = https://github.com/actonDev/SDL_net.git 3 | # WIP 4 | revision = feature/meson -------------------------------------------------------------------------------- /subprojects/socket-cpp.wrap: -------------------------------------------------------------------------------- 1 | [wrap-git] 2 | url = https://github.com/embeddedmz/socket-cpp.git 3 | # master as of 2020-06-22 4 | revision = a8478f89d919fce215db0d9f5e716fbd62539171 -------------------------------------------------------------------------------- /test/aod/colors_test.cpp: -------------------------------------------------------------------------------- 1 | #include "gtest/gtest.h" 2 | #include "aod/colors.hpp" 3 | #include 4 | 5 | TEST(aod_colors, ryb2rgb) { 6 | std::array ryb_r = {1, 0, 0}; 7 | std::array expected_rgb_r = {1,0,0}; 8 | ASSERT_EQ( expected_rgb_r, aod::colors::ryb2rgb(ryb_r)); 9 | 10 | std::array ryb_y = {0, 1, 0}; 11 | std::array expected_rgb_y = {1,1,0}; 12 | ASSERT_EQ( expected_rgb_y, aod::colors::ryb2rgb(ryb_y)); 13 | 14 | // just making it pass for now 15 | // std::array ryb_b = {0, 0, 1}; 16 | // std::array expected_rgb_b = {0.163, 0.373, 0.6}; 17 | // ASSERT_EQ( expected_rgb_b, aod::colors::ryb2rgb(ryb_b)); 18 | } 19 | -------------------------------------------------------------------------------- /test/aod/img_test.cpp: -------------------------------------------------------------------------------- 1 | #include "gtest/gtest.h" 2 | #include "aod/img/core.hpp" 3 | 4 | #include 5 | #include 6 | namespace fs = std::filesystem; 7 | using std::cout, std::cerr, std::endl; 8 | 9 | 10 | TEST(aod_img, equivalent) { 11 | // fs::path base_path = fs::current_path(); 12 | // cout << "base path " << base_path << endl; 13 | ASSERT_TRUE(aod::img::are_equivalent("../../test/scheme/assets/sxs-wheel-snapshot.png", "../../test/scheme/assets/sxs-wheel-snapshot.png"));; 14 | ASSERT_FALSE(aod::img::are_equivalent("../../test/scheme/assets/sxs-wheel-snapshot.png", "../../test/scheme/assets/sxs-wheel-offset.png"));; 15 | ASSERT_FALSE(aod::img::are_equivalent("../../test/scheme/assets/sxs-wheel-offset.png", "../../test/scheme/assets/sxs-wheel-snapshot.png"));; 16 | } 17 | 18 | -------------------------------------------------------------------------------- /test/aod/s7/environments_test.cpp: -------------------------------------------------------------------------------- 1 | #include "gtest/gtest.h" 2 | #include "s7.h" 3 | #include "aod/s7.hpp" 4 | #include 5 | #include 6 | #include 7 | #include 8 | namespace fs = std::filesystem; 9 | 10 | fs::path pwd = fs::current_path().remove_filename(); 11 | fs::path scheme_path = pwd / ".." / "src" / "scheme"; 12 | 13 | TEST(s7_environments, autoloads_bug) { 14 | GTEST_SKIP_("Waiting for s7 mailing list for this.."); 15 | const char *autoloads[6] = { 16 | // each pair of entries is entity name + file name 17 | "aod.lib1", "aod/lib1.scm", // 18 | "aod.lib2", "aod/lib2.scm", // 19 | "aod.extra.foo", "aod/extra/foo.scm", 20 | }; 21 | 22 | s7_scheme* sc1 = s7_init(); 23 | s7_autoload_set_names(sc1, autoloads, 3); 24 | const char* sexp = "(begin " 25 | "(require aod.lib1)" 26 | "(require aod.lib2)" 27 | "1)"; 28 | // ok that works 29 | ASSERT_EQ(1, s7_integer(s7_eval_c_string(sc1, sexp))); 30 | 31 | s7_scheme* sc2 = s7_init(); 32 | s7_autoload_set_names(sc2, autoloads, 3); 33 | const char* sexp2 = "(begin " 34 | "(require aod.extra.foo)" 35 | "2)"; 36 | // THAT FAILS!! 37 | ASSERT_EQ(2, s7_integer(s7_eval_c_string(sc2, sexp2))); 38 | /** 39 | * ---------- 40 | ;require: no autoload info for aod.extra.foo 41 | ; (require aod.extra.foo) 42 | ; ((lambda (hook lst) (if (do ((p lst (cdr ... 43 | ; (2) 44 | * ----------- 45 | */ 46 | } 47 | 48 | TEST(s7_environments, autoloads) { 49 | s7_scheme* sc = s7_init(); 50 | aod::s7::bind_all(sc); 51 | // s7_add_to_load_path(sc, scheme_path.c_str()); 52 | aod::s7::set_autoloads(sc); 53 | const char* sexp = "(begin " 54 | "(require aod.core)" 55 | // "(require aod.imgui)" 56 | // "(require imgui-macros.scm)" 57 | // "(require aod.libs.lib1)" 58 | "2)"; 59 | ASSERT_EQ(2, s7_integer(s7_eval_c_string(sc, sexp))); 60 | } 61 | 62 | TEST(s7_environments, require) { 63 | s7_scheme* sc = s7_init(); 64 | aod::s7::bind_all(sc); 65 | s7_add_to_load_path(sc, scheme_path.string().c_str()); 66 | aod::s7::set_autoloads(sc); 67 | 68 | const char* sexp = "(begin " 69 | "(require aod.core)" 70 | "(ns-require aod.c.foreign)" 71 | "(define i2 (aod.c.foreign/new-int 2))" 72 | "(i2)" 73 | ")" 74 | ; 75 | ASSERT_EQ(2, s7_integer(s7_eval_c_string(sc, sexp))); 76 | } 77 | 78 | TEST(s7_environments, require_as) { 79 | s7_scheme* sc = s7_init(); 80 | aod::s7::bind_all(sc); 81 | s7_add_to_load_path(sc, scheme_path.string().c_str()); 82 | aod::s7::set_autoloads(sc); 83 | 84 | const char* sexp1 = "(begin " 85 | "(require aod.core)" 86 | "(define i1 ((aod.c.foreign 'new-int) 1))" 87 | "(i1)" 88 | ")" 89 | ; 90 | ASSERT_EQ(1, s7_integer(s7_eval_c_string(sc, sexp1))); 91 | 92 | 93 | const char* sexp2 = "(begin " 94 | "(require aod.core)" 95 | "(comment aha)" 96 | "(ns-require aod.c.foreign :as c)" 97 | "(define i2 (c/new-int 2))" 98 | "(i2)" 99 | ")" 100 | ; 101 | ASSERT_EQ(2, s7_integer(s7_eval_c_string(sc, sexp2))); 102 | 103 | const char* sexp3 = "(begin " 104 | "(require aod.core)" 105 | "(comment YUP cause aod.clj is already normally required from aod.core)" 106 | "(ns-require aod.clj)" 107 | "(aod.clj/comment AHA clj style require with aod/require)" 108 | "(ns-require aod.clj :as my-clj-things)" 109 | "(my-clj-things/comment AHA 2! clj style require with aod/require)" 110 | "(ns-require aod.clj :as my-clj-things)" // should see a warning that it's already defined 111 | "3)" 112 | ; 113 | ASSERT_EQ(3, s7_integer(s7_eval_c_string(sc, sexp3))); 114 | 115 | } 116 | 117 | -------------------------------------------------------------------------------- /test/aod/s7/foreign_primitives_arr_test.cpp: -------------------------------------------------------------------------------- 1 | #include "gtest/gtest.h" 2 | #include "s7.h" 3 | #include "aod/s7/foreign_primitives.hpp" 4 | #include "aod/s7/foreign_primitives_arr.hpp" 5 | #include "aod/s7.hpp" 6 | #include 7 | #include 8 | 9 | TEST ( foreign_primitives_arr_gen, bool_arr ) { 10 | s7_scheme *sc = s7_init(); 11 | aod::s7::set_print_stderr(sc); 12 | 13 | s7_pointer env = aod::s7::make_env(sc); 14 | aod::s7::foreign::bind_primitives_arr(sc, env); 15 | aod::s7::foreign::bind_primitives(sc, env); // we also handle a bool* ref 16 | 17 | s7_pointer x = s7_eval_c_string(sc, 18 | "(define x ((aod.c.foreign 'new-bool[]) 3))"); 19 | 20 | bool *arr = (bool*) s7_c_object_value(x); 21 | ASSERT_EQ(false, arr[0]); 22 | ASSERT_EQ(false, arr[1]); 23 | ASSERT_EQ(false, arr[2]); 24 | 25 | ASSERT_EQ(false, s7_boolean(sc, s7_eval_c_string(sc, "(x 0)"))); 26 | ASSERT_EQ(false, s7_boolean(sc, s7_eval_c_string(sc, "(x 1)"))); 27 | ASSERT_EQ(false, s7_boolean(sc, s7_eval_c_string(sc, "(x 2)"))); 28 | 29 | 30 | 31 | arr[0] = true; 32 | arr[2] = true; 33 | 34 | ASSERT_EQ(true, s7_boolean(sc, s7_eval_c_string(sc, "(x 0)"))); 35 | ASSERT_EQ(false, s7_boolean(sc, s7_eval_c_string(sc, "(x 1)"))); 36 | ASSERT_EQ(true, s7_boolean(sc, s7_eval_c_string(sc, "(x 2)"))); 37 | 38 | s7_eval_c_string(sc, "(set! (x 1) #t)"); 39 | ASSERT_EQ(true, arr[1]); 40 | 41 | // now.. getting the bool* to &arr[2] ... 42 | s7_pointer x2_pointer = s7_eval_c_string(sc, "(x 2 '&)"); 43 | bool* x2 = (bool*) s7_c_object_value_checked(x2_pointer, aod::s7::foreign::tag_bool(sc)); 44 | ASSERT_EQ(true, *x2); 45 | *x2 = false; 46 | ASSERT_EQ(false, s7_boolean(sc, s7_eval_c_string(sc, "(x 2)"))); 47 | 48 | s7_eval_c_string(sc, "(let ((*x2 (x 2 'ref)))" 49 | "(set! (*x2) #t))"); 50 | ASSERT_EQ(true, *x2); 51 | 52 | // a different calling style 53 | s7_eval_c_string(sc, "(set! ((x 2 'ref)) #f))"); 54 | ASSERT_EQ(false, *x2); 55 | 56 | } 57 | 58 | TEST ( foreign_primitives_arr_gen, int_arr ) { 59 | s7_scheme *sc = s7_init(); 60 | aod::s7::set_print_stderr(sc); 61 | 62 | aod::s7::foreign::bind_primitives_arr(sc); 63 | 64 | s7_pointer x = s7_eval_c_string(sc, 65 | "(define x ((aod.c.foreign 'new-int[]) 3))"); 66 | 67 | int *arr = (int*) s7_c_object_value(x); 68 | arr[0] = 0; 69 | arr[1] = 1; 70 | arr[2] = 2; 71 | 72 | ASSERT_EQ(0, s7_number_to_integer(sc, s7_eval_c_string(sc, "(x 0)"))); 73 | ASSERT_EQ(1, s7_number_to_integer(sc, s7_eval_c_string(sc, "(x 1)"))); 74 | ASSERT_EQ(2, s7_number_to_integer(sc, s7_eval_c_string(sc, "(x 2)"))); 75 | 76 | s7_eval_c_string(sc, "(set! (x 0) 10)"); 77 | s7_eval_c_string(sc, "(set! (x 1) 11)"); 78 | s7_eval_c_string(sc, "(set! (x 2) 12)"); 79 | 80 | ASSERT_EQ(10, arr[0]); 81 | ASSERT_EQ(11, arr[1]); 82 | ASSERT_EQ(12, arr[2]); 83 | } 84 | 85 | TEST ( foreign_primitives_arr_gen, float_arr ) { 86 | s7_scheme *sc = s7_init(); 87 | aod::s7::set_print_stderr(sc); 88 | 89 | // can we bing all together in aod.c.foreign ? 90 | s7_pointer env = aod::s7::make_env(sc); 91 | aod::s7::foreign::bind_primitives_arr(sc, env); 92 | aod::s7::foreign::bind_primitives(sc, env); 93 | 94 | 95 | s7_pointer x = s7_eval_c_string(sc, 96 | "(define x ((aod.c.foreign 'new-float[]) 3))"); 97 | 98 | float *arr = (float*) s7_c_object_value(x); 99 | arr[0] = 0.0; 100 | arr[1] = 1.1; 101 | arr[2] = 2.2; 102 | 103 | ASSERT_EQ(0.0f, s7_number_to_real(sc, s7_eval_c_string(sc, "(x 0)"))); 104 | ASSERT_EQ(1.1f, s7_number_to_real(sc, s7_eval_c_string(sc, "(x 1)"))); 105 | ASSERT_EQ(2.2f, s7_number_to_real(sc, s7_eval_c_string(sc, "(x 2)"))); 106 | 107 | s7_eval_c_string(sc, "(set! (x 0) 10.0)"); 108 | s7_eval_c_string(sc, "(set! (x 1) 11.1)"); 109 | s7_eval_c_string(sc, "(set! (x 2) 12.2)"); 110 | 111 | ASSERT_EQ(10.0f, arr[0]); 112 | ASSERT_EQ(11.1f, arr[1]); 113 | ASSERT_EQ(12.2f, arr[2]); 114 | } 115 | 116 | TEST ( foreign_primitives_arr_gen, char_arr ) { 117 | s7_scheme *sc = s7_init(); 118 | aod::s7::set_print_stderr(sc); 119 | 120 | s7_pointer env = aod::s7::make_env(sc); 121 | aod::s7::foreign::bind_primitives_arr(sc, env); 122 | aod::s7::foreign::bind_primitives(sc, env); 123 | 124 | 125 | s7_pointer x = s7_eval_c_string(sc, 126 | "(define x ((aod.c.foreign 'new-char[]) 128))"); 127 | ASSERT_STREQ("", s7_string(s7_eval_c_string(sc, "(x)"))); 128 | 129 | s7_eval_c_string(sc, "(set! (x) \"Hi there\")"); 130 | ASSERT_STREQ("Hi there", s7_string(s7_eval_c_string(sc, "(x)"))); 131 | } 132 | -------------------------------------------------------------------------------- /test/aod/s7/foreign_primitives_test.cpp: -------------------------------------------------------------------------------- 1 | #include "gtest/gtest.h" 2 | #include "s7.h" 3 | #include "aod/s7/foreign_primitives.hpp" 4 | #include "aod/s7.hpp" 5 | #include 6 | #include 7 | 8 | TEST ( foreign_primitives_gen, boolean ) { 9 | s7_scheme *sc = s7_init(); 10 | aod::s7::set_print_stderr(sc); 11 | 12 | aod::s7::foreign::bind_primitives(sc); 13 | 14 | s7_pointer b = s7_eval_c_string(sc, // 15 | "(define b ((aod.c.foreign 'new-bool) #t))" // 16 | ); 17 | 18 | ASSERT_TRUE(s7_is_c_object(b)); 19 | 20 | ASSERT_TRUE(s7_boolean(sc, s7_eval_c_string(sc, "(b)"))); 21 | 22 | s7_eval_c_string(sc, "(set! (b) #f)"); 23 | ASSERT_FALSE(s7_boolean(sc, s7_eval_c_string(sc, "(b)"))); 24 | } 25 | 26 | TEST ( foreign_primitives_gen, integer ) { 27 | s7_scheme *sc = s7_init(); 28 | aod::s7::set_print_stderr(sc); 29 | 30 | aod::s7::foreign::bind_primitives(sc); 31 | 32 | s7_pointer x = s7_eval_c_string(sc, // 33 | "(define x ((aod.c.foreign 'new-int) 5))" // 34 | ); 35 | 36 | ASSERT_TRUE(s7_is_c_object(x)); 37 | 38 | ASSERT_EQ(5, s7_number_to_integer(sc, s7_eval_c_string(sc, "(x)"))); 39 | 40 | s7_eval_c_string(sc, "(set! (x) 10)"); 41 | ASSERT_EQ(10, s7_number_to_integer(sc, s7_eval_c_string(sc, "(x)"))); 42 | 43 | // changing value in c by changing the pointer reference 44 | int* p_x = (int*) s7_c_object_value(s7_eval_c_string(sc, "x")); 45 | *p_x = 15; 46 | ASSERT_EQ(15, s7_number_to_integer(sc, s7_eval_c_string(sc, "(x)"))); 47 | 48 | } 49 | -------------------------------------------------------------------------------- /test/aod/s7/repl_test.cpp: -------------------------------------------------------------------------------- 1 | #include "gtest/gtest.h" 2 | #include "aod/s7/repl.hpp" 3 | #include 4 | 5 | using namespace aod::s7; 6 | 7 | TEST(Repl, Init) { 8 | ASSERT_EQ(1,1); 9 | } 10 | 11 | TEST(Repl, read_simple_exp){ 12 | Repl repl = Repl(); 13 | ASSERT_TRUE(repl.handleInput("(define a (+ 1 2 3))")); 14 | ASSERT_EQ("6", repl.evalLastForm()); 15 | ASSERT_TRUE(repl.handleInput("(+ a 1)")); 16 | ASSERT_EQ("7", repl.evalLastForm()); 17 | } 18 | 19 | TEST(Repl, read_function){ 20 | Repl repl = Repl(); 21 | ASSERT_TRUE(repl.handleInput("(define (inc x) (+ 1 x))")); 22 | ASSERT_EQ("inc", repl.evalLastForm()); 23 | ASSERT_TRUE(repl.handleInput("(inc 1)")); 24 | ASSERT_EQ("2", repl.evalLastForm()); 25 | } 26 | 27 | TEST(Repl, ns_regexp){ 28 | // std::regex ns_regex("^\\(ns [a-zA-Z.-]+\\)"); 29 | std::regex ns_regex = aod::s7::repl::NS_REGEXP; 30 | ASSERT_FALSE(std::regex_search("ns aod.demo", ns_regex)); 31 | ASSERT_TRUE(std::regex_search("(ns aod.demo)", ns_regex)); 32 | ASSERT_FALSE(std::regex_search(";; (ns aod.demo)", ns_regex)); 33 | } 34 | 35 | 36 | TEST(Repl, read_incomplete_sexp){ 37 | Repl repl = Repl(); 38 | // missing closing paren 39 | ASSERT_FALSE(repl.handleInput("(write (+ 1 2 3)")); 40 | // adding the missing paren 41 | ASSERT_TRUE(repl.handleInput(")")); 42 | ASSERT_EQ("6", repl.evalLastForm()); 43 | } 44 | 45 | TEST(Repl, read_2_incomplete_sexps){ 46 | Repl repl = Repl(); 47 | ASSERT_FALSE(repl.handleInput("(+ 1 1")); // missing closing paren 48 | ASSERT_TRUE(repl.handleInput(")")); // adding the missing paren 49 | ASSERT_EQ("2", repl.evalLastForm()); 50 | 51 | ASSERT_FALSE(repl.handleInput("(+ 1 2")); // missing closing paren 52 | ASSERT_TRUE(repl.handleInput(")")); // adding the missing paren 53 | ASSERT_EQ("3", repl.evalLastForm()); 54 | } 55 | 56 | 57 | /** 58 | * Note: internally Repl wraps the input string around a (begin ..) statement 59 | * If we wouldn't do that 60 | * - "(+ 1 1" => cannot be read 61 | * - ")(+ 1 2" => can be read by completing the previous input that error'd 62 | * 63 | * thus inputting a ")" leads to "unexpected close paren" 64 | * 65 | * To wrap up, s7_read succeeds in the first complete form. 66 | * But if we wrap around a begin we get the expected behavior 67 | */ 68 | TEST(Repl, read_2_incomplete_sexps_joined){ 69 | Repl repl = Repl(); 70 | ASSERT_FALSE(repl.handleInput("(+ 1 1")); // note: missing closing paren 71 | ASSERT_FALSE(repl.handleInput(")(+ 1 2")); // closing missing paren, opening another form 72 | 73 | // closing the parenthesis now returns false (cause we have nothing in memory 74 | // unexpected close paren 75 | ASSERT_TRUE(repl.handleInput(")")); 76 | // last one is 3 77 | ASSERT_EQ("3", repl.evalLastForm()); 78 | 79 | // we should be able to handle correct input though 80 | ASSERT_TRUE(repl.handleInput("(+ 1 3)")); 81 | ASSERT_EQ("4", repl.evalLastForm()); 82 | } 83 | 84 | // aha.. this is .. weird? or expected? 85 | TEST(Repl, evaling_nonexisten_last_form){ 86 | Repl repl = Repl(); 87 | ASSERT_EQ("()", repl.evalLastForm()); 88 | } 89 | 90 | TEST(Repl, evaling_failed_last_form){ 91 | Repl repl = Repl(); 92 | ASSERT_FALSE(repl.handleInput("(+ 1 1")); 93 | ASSERT_EQ("()", repl.evalLastForm()); 94 | } 95 | -------------------------------------------------------------------------------- /test/meson.build: -------------------------------------------------------------------------------- 1 | test_src = [] 2 | 3 | gtest_proj = subproject('gtest') 4 | gtest_dep = gtest_proj.get_variable('gtest_dep') 5 | gtest_main_dep = gtest_proj.get_variable('gtest_main_dep') 6 | # gmock_dep = gtest_proj.get_variable('gmock_dep') 7 | test_src += files( 8 | 'aod/s7/repl_test.cpp', 9 | 'aod/s7/foreign_primitives_test.cpp', 10 | 'aod/s7/foreign_primitives_arr_test.cpp', 11 | 'aod/s7/environments_test.cpp', 12 | 'aod/colors_test.cpp', 13 | 'aod/img_test.cpp', 14 | # --- 15 | # getting to know how things work, maybe useful for later reference 16 | # 'aod/s7/ffi_test_raw.cpp', 17 | ) 18 | 19 | gtest_all = executable( 20 | 'gtest-all', 21 | test_src, 22 | dependencies : [ 23 | gtest_main_dep, 24 | aod_dep, 25 | s7_dep, 26 | ], 27 | ) 28 | test('gtest tests', gtest_all) 29 | -------------------------------------------------------------------------------- /test/scheme/assets/.gitignore: -------------------------------------------------------------------------------- 1 | *.png 2 | !*snapshot.png 3 | # used in a test, to make sure it's not equivalent with the snapshot 4 | !sxs-wheel-offset.png 5 | -------------------------------------------------------------------------------- /test/scheme/assets/sxs-wheel-highlight-048-snapshot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/actondev/s7-imgui/7c5f0acc567ccd4dc4e4e1f1ff38a39aaa7b1875/test/scheme/assets/sxs-wheel-highlight-048-snapshot.png -------------------------------------------------------------------------------- /test/scheme/assets/sxs-wheel-offset.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/actondev/s7-imgui/7c5f0acc567ccd4dc4e4e1f1ff38a39aaa7b1875/test/scheme/assets/sxs-wheel-offset.png -------------------------------------------------------------------------------- /test/scheme/assets/sxs-wheel-snapshot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/actondev/s7-imgui/7c5f0acc567ccd4dc4e4e1f1ff38a39aaa7b1875/test/scheme/assets/sxs-wheel-snapshot.png -------------------------------------------------------------------------------- /test/scheme/gen-doc.scm: -------------------------------------------------------------------------------- 1 | (ns rootlet 2 | :require ( 3 | ;; (aod.colors) 4 | ;; (aod.midi) ;; this contains only tests actually 5 | (aod.c.foreign) 6 | (aod.c.midi) 7 | (aod.c.imgui) 8 | (aod.c.imgui-sdl) 9 | (aod.c.imgui.window-flags) 10 | (aod.imgui.helpers) 11 | (aod.imgui.macros) 12 | ;; (aod.components.input) 13 | ;; (aod.components.piano-wheel) 14 | (aod.c.gl) 15 | (aod.c.nfd))) 16 | 17 | (print "Writing namespaces documentation to ns-doc.el") 18 | 19 | #| 20 | The output will be a list of 21 | ( 22 | the-ns-name 23 | the-ns-docstring 24 | ((fun . fun-docstring) 25 | ;; .. more functions 26 | )) 27 | |# 28 | 29 | (call-with-output-file "docs/ns-doc.el" 30 | (lambda (out) 31 | (let-temporarily (((*s7* 'print-length) 100000000000000000)) 32 | (format out "~A" 33 | (map (lambda (ns) 34 | (if (let? (cdr ns)) 35 | (cons (car ns) 36 | (cons 37 | ((cdr ns) '*ns-doc*) 38 | (ns-doc (car ns)))) 39 | (values))) 40 | *nss*))))) 41 | 42 | (exit) 43 | -------------------------------------------------------------------------------- /test/scheme/test-all.scm: -------------------------------------------------------------------------------- 1 | (with-let (rootlet) 2 | ;; aod.core already required by repl in cpp 3 | (require aod.core) 4 | ;; WIP: if providing aod.test.gui the (testgui .. ) blocks will be ran 5 | (provide 'aod.test.gui) 6 | (require aod.test)) 7 | 8 | (ns aod.test-all) 9 | 10 | ;; testing files: 11 | (ns-load 'aod.ns) 12 | (ns-load 'aod.geom) 13 | (ns-load 'aod.sxs) 14 | (ns-load 'aod.layout) 15 | (ns-load 'aod.colors) 16 | (ns-load 'aod.midi) 17 | (ns-load 'aod.imgui.helpers) 18 | (ns-load-file "test/c_foreign_test.scm") 19 | (ns-load-file "test/partial_test.scm") 20 | 21 | 22 | ;; Testing gui components? 23 | 24 | (ns-load 'aod.components.sxs-wheel) 25 | 26 | 27 | (print "======") 28 | (print "Passed:" (*aod.test* 'pass)) 29 | (print "Failed:" (*aod.test* 'fail)) 30 | 31 | (exit (*aod.test* 'fail)) 32 | 33 | (comment 34 | (map (lambda (ns) 35 | (print "ns" ns) 36 | (if (let? (cdr ns)) 37 | (cons (car ns) 38 | (car ns)) 39 | (cons (car ns) 40 | "not ns"))) 41 | *nss*) 42 | ) 43 | 44 | (comment 45 | (+ 1 2 3) 46 | *nss* 47 | (defined? 'environment?) 48 | (defined? 'let?) 49 | (let? aod.c.imgui) 50 | (defined? 'aod.c.foreign) 51 | aod.c.foreign 52 | (*nss* 'aod.all-tests) 53 | 54 | (let? ) 55 | () 56 | (print "hi") 57 | (defined? 'aod.c.foreign) 58 | ) 59 | -------------------------------------------------------------------------------- /test/scheme/test-benchmark.scm: -------------------------------------------------------------------------------- 1 | ;; testing performance of (ns-require) 2 | 3 | (with-let (rootlet) 4 | ;; aod.core already required by repl in cpp 5 | (require aod.core) 6 | ;; WIP: if providing aod.test.gui the (testgui .. ) blocks will be ran 7 | ;; (provide 'aod.test.gui) 8 | (require aod.test)) 9 | 10 | (ns aod.test-benchmark) 11 | 12 | (with-let (rootlet) 13 | ;; what fib to call 14 | (define bench-fib-n 5) 15 | ;; loops 16 | ;; 1M 17 | (define bench-fib-N 1000000) 18 | ;; that yields double time in the dynamic require 19 | ) 20 | 21 | (ns-require aod.benchmark :as b-dynamic) 22 | (test "Dynamic (ns-require)" 23 | (print 24 | "ns-require: Time fib" bench-fib-n "times x" bench-fib-N 25 | (b-dynamic/time 26 | (dotimes (i bench-fib-N) 27 | (b-dynamic/fib bench-fib-n))))) 28 | 29 | (require aod.benchmark) 30 | (test "Normally required" 31 | (with-let (unlet) 32 | (require aod.benchmark) 33 | (print 34 | "require: Time fib" bench-fib-n "times x" bench-fib-N 35 | (time 36 | (dotimes (i bench-fib-N) 37 | (fib bench-fib-n)))) 38 | )) 39 | 40 | (ns-require aod.benchmark :as b-non-dynamic :dynamic #f) 41 | (test "ns-require with dynamic #f" 42 | (print 43 | "ns-require :dynamic #f : Time fib" bench-fib-n "times x" bench-fib-N 44 | (b-non-dynamic/time 45 | (dotimes (i bench-fib-N) 46 | (b-non-dynamic/fib bench-fib-n)))) 47 | ) 48 | 49 | (set! *ns-require-dynamic* #f) 50 | (ns-require aod.benchmark :as b-non-dynamic2) 51 | (test "ns-require with dynamic #f - v2" 52 | (print 53 | "ns-require :dynamic #f v2 : Time fib" bench-fib-n "times x" bench-fib-N 54 | (b-non-dynamic2/time 55 | (dotimes (i bench-fib-N) 56 | (b-non-dynamic2/fib bench-fib-n)))) 57 | ) 58 | 59 | #| 60 | ns-require: Time fib 5 times x 1000000 (#t 1.686106) 61 | PASS: aod.test-benchmark "Dynamic (ns-require)" 62 | require: Time fib 5 times x 1000000 (#t 0.8520600000000003) 63 | PASS: aod.benchmark "Normally required" 64 | Skipping already ns-require'd aod.benchmark 65 | ns-require :dynamic #f : Time fib 5 times x 1000000 (#t 0.8458799999999997) 66 | PASS: aod.benchmark "ns-require with dynamic #f" 67 | Skipping already ns-require'd aod.benchmark 68 | ns-require :dynamic #f v2 : Time fib 5 times x 1000000 (#t 0.8527930000000001) 69 | PASS: aod.benchmark "ns-require with dynamic #f - v2" 70 | 71 | |# 72 | 73 | 74 | (exit (*aod.test* 'fail)) 75 | -------------------------------------------------------------------------------- /test/scheme/test-core.scm: -------------------------------------------------------------------------------- 1 | (ns test.core) 2 | 3 | (with-let (rootlet) 4 | (require aod.test)) 5 | 6 | (test "memoize" 7 | (with-let (unlet) 8 | (define x 1) 9 | (define (inc-x amount) 10 | (set! x (+ x amount))) 11 | (define inc-x-mem (memoize inc-x)) 12 | (is (= 3 (inc-x 2))) 13 | ;; first time we do the call 14 | (is (= 5 (inc-x-mem 2))) 15 | ;; then not 16 | (is (= 5 (inc-x-mem 2))) 17 | )) 18 | 19 | (exit (*aod.test* 'fail)) 20 | --------------------------------------------------------------------------------