A tool for managing file systems
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

1767 lines
80 KiB

(set-cakelisp-option use-c-linkage true)
(set-cakelisp-option cakelisp-src-dir "Dependencies/cakelisp/src")
(add-cakelisp-search-directory "Dependencies/gamelib/src")
(add-cakelisp-search-directory "Dependencies/cakelisp/runtime")
(add-cakelisp-search-directory "Dependencies/auto-color/src")
(add-cakelisp-search-directory "src")
;; From GameLib
"Introspection.cake" "SDL.cake" "ImGui.cake" "DynamicArray.cake" "Dictionary.cake" "Math.cake"
;; From File Helper
"FileSystem.cake" "LoadSave.cake" "Export.cake" "Utilities.cake"
"Treemap.cake" "TreemapOpenGL.cake" "TreemapFileSystem.cake" "License.cake"
"Help.cake" "ImGuiAutoColor.cake" "Time.cake"
;; From cakelisp
(c-import "SDL.h" "SDL_syswm.h" "SDL_timer.h" "<stdio.h>")
;; TODO: Somehow inherit this from SDL.cake?
(import "Tracy.cake")
(import "ProfilerNull.cake")))
;; Types, config, and stuff
(var-global g-is-first-time-run bool true) ;; Pops Help window on first run
(var c-check-save-userdata-interval-seconds (const float) 5.f)
;; (var g-should-save-load-imgui-config bool true)
(var g-should-save-load-imgui-config bool false)
(var g-should-save-load-user-config bool true)
;; (var g-should-save-load-user-config bool false)
(var g-treemap-multithreaded-state (* treemap-file-system-multithreaded-state) null)
(var g-treemap-request-refresh-time Uint64 0)
(defun-local treemap-request-refresh ()
(set g-treemap-request-refresh-time (SDL_GetPerformanceCounter)))
(defun-local imgui-print-shortcut (key-text (* (const char)))
;; (var shortcut-color ImVec4 (array 0.5f 0.5f 0.5f 1.f))
(imgui-call TextDisabled "Shortcuts: %s" key-text))
(def-type-alias-global category-key (unsigned char))
(var-global g-category-last-used-key category-key 0)
(def-introspect-struct directory-entry-userdata
key (* char)
category category-key (override 'category-key))
(var-global g-userdata-dict (* directory-entry-userdata) null)
(var-global g-treemap-use-theme-for-colorization bool true)
(var-global g-auto-theme-from-background bool true)
;; Is SDL_Scancode, but I don't want to have to include SDL in every file that wants these
(def-type-alias-global category-keybind (unsigned int))
(defstruct category-available-keybind
name (* (const char))
keybind category-keybind
in-use-by-category category-key)
(var category-available-keybinds ([] category-available-keybind)
(array "<none>" (type-cast 0 category-keybind) 0)
(array "Ctrl+1" (type-cast SDL_SCANCODE_1 (unsigned int)) 0)
(array "Ctrl+2" (type-cast SDL_SCANCODE_2 (unsigned int)) 0)
(array "Ctrl+3" (type-cast SDL_SCANCODE_3 (unsigned int)) 0)
(array "Ctrl+4" (type-cast SDL_SCANCODE_4 (unsigned int)) 0)
(array "Ctrl+5" (type-cast SDL_SCANCODE_5 (unsigned int)) 0)
(array "Ctrl+6" (type-cast SDL_SCANCODE_6 (unsigned int)) 0)
(array "Ctrl+7" (type-cast SDL_SCANCODE_7 (unsigned int)) 0)
(array "Ctrl+8" (type-cast SDL_SCANCODE_8 (unsigned int)) 0)
(array "Ctrl+9" (type-cast SDL_SCANCODE_9 (unsigned int)) 0)))
(def-introspect-struct category-spec
key category-key (override 'category-key) ;; TODO Support typedefs...
name ([] 32 char)
color ([] 3 float)
keybind category-keybind (override 'keybind)
;; TODO: Should I carry deleted categories around?
is-deleted bool)
(var-global g-categories-dict (* category-spec) null)
(defun-local create-category-spec (&return category-key)
(var new-category category-spec (array 0))
(var new-category-key category-key (incr g-category-last-used-key))
(set (field new-category key) new-category-key)
(var default-color ([] 3 float) (array 0.7f 0.25f 0.25f))
(each-in-range 3 i
(set (at i (field new-category color)) (at i default-color)))
(set (field new-category is-deleted) false)
(dict-set-struct g-categories-dict new-category)
(return new-category-key))
(defun-local mark-category-for-deletion (category (* category-spec))
(set (path category > is-deleted) true)
;; Unset any existing binds for this category
(each-in-array category-available-keybinds i
(var current-keybind (* category-available-keybind) (addr (at i category-available-keybinds)))
(when (= (path category > key) (path current-keybind > in-use-by-category))
(set (path current-keybind > in-use-by-category) (type-cast 0 category-keybind)))))
(defun category-claim-keybind (category (* category-spec) keybind category-keybind)
(each-in-array category-available-keybinds i
(var current-keybind (* category-available-keybind) (addr (at i category-available-keybinds)))
;; Unset any existing binds for this category
(when (= (path category > key) (path current-keybind > in-use-by-category))
(set (path current-keybind > in-use-by-category) (type-cast 0 category-keybind)))
;; Set bind to category
(when (= keybind (path current-keybind > keybind))
;; Unset the other category
(when (and (path current-keybind > in-use-by-category)
(!= (path current-keybind > in-use-by-category) (path category > key)))
(var other-category (* category-spec)
(dict-ptr-at g-categories-dict (path current-keybind > in-use-by-category)))
(assert other-category)
(set (path other-category > keybind) (type-cast 0 category-keybind)))
(set (path current-keybind > in-use-by-category) (path category > key))
(set (path category > keybind) keybind))))
(defun-local categorize-directory-entry (current-dir dynstring
entry (* directory-entry)
category category-key)
(var full-path dynstring (full-path-for-entry current-dir entry))
(var existing-entry (* directory-entry-userdata) (strdict-ptr-at g-userdata-dict full-path))
(when (or
;; Never been categorized and clearing category - ignore
(and (not existing-entry) (not category))
;; Already categorized with this category - ignore
(and existing-entry (= category (path existing-entry > category))))
(dynarray-free full-path)
(var new-entry directory-entry-userdata
(array full-path category))
(strdict-set-struct g-userdata-dict new-entry)
(dynarray-free full-path))
(def-introspect-struct file-colorizer
;; Note: Keep POD to make copying fast and easy for TreemapFileSystem.cake
group-name ([] 32 char)
ends-with ([] 128 char)
color ([] 3 float))
(var-global g-file-colorizers (* file-colorizer)) ;; dynarray
(defstruct-local entry-cached-category
name (* (const char))
key category-key
color ([] 3 float)
is-inherited bool)
(defstruct-local imgui-directory-listing-state
current-dir dynstring
needs-update bool
previous-visited-child-entry dynstring
read-directory-error ([] 1024 char)
directory-entries (* directory-entry)
selected-entries (* bool)
entry-categories (* entry-cached-category)
filtered-entries (* int) ;; Indices into directory-entries and other arrays
on-activate-index int
directory-filter ImGuiTextFilter
focus-filter bool
was-window-focused bool
is-deleting-filter-text bool
should-scroll-to-entry bool
should-scroll-to-entry-delay-counter int
history-go-back bool
history-go-forwards bool
last-used-category category-key
mouse-last-frame Uint32
keys-last-frame (* (unsigned char)))
;; TODO Auto-generate this
(defun-local destroy-directory-state (state (* imgui-directory-listing-state))
(dynarray-free (path state > keys-last-frame))
(dynarray-free (path state > current-dir))
(dynarray-free (path state > previous-visited-child-entry))
(directory-entries-destroy (path state > directory-entries))
(dynarray-free (path state > selected-entries))
(dynarray-free (path state > filtered-entries))
(dynarray-free (path state > directory-entries))
(dynarray-free (path state > entry-categories)))
;; TODO: Mark parent directories with "various" when there are children with different categories.
;; This is important so that I can easily tell if /any/ subdirectories are important just by
;; looking at the parent dir
;; Note that this pointer will be invalidated if changes to the userdata dict occur
(defun-local find-inherited-userdata (start-directory (* (const char))
&return (* directory-entry-userdata))
(var inherited-userdata (* directory-entry-userdata) null)
(var current-path dynstring null)
(dynstring-append (addr current-path) start-directory)
(while true
(set inherited-userdata (strdict-ptr-at g-userdata-dict current-path))
;; Do not inherit userdata from this directory unless something is actually set for it (e.g., it
;; actually has a category and isn't supposed to inherit from its parent)
(when (and inherited-userdata (path inherited-userdata > category))
(var next-path dynstring null)
(get-parent-of-path current-path (addr next-path))
;; Break once parent no longer changes (root)
;; May get stuck in symlink infinite loop if get-parent-of-path is modified to follows links
(when (= (dynstring-strlen next-path) (dynstring-strlen current-path))
(dynarray-free next-path)
(dynarray-free current-path)
(set current-path next-path))
(dynarray-free current-path)
(return inherited-userdata))
(defun-local copy-category-to-entry (entry (* entry-cached-category) category (* category-spec))
(set (path entry > name) (path category > name))
(set (path entry > key) (path category > key))
(memcpy (path entry > color) (path category > color)
(sizeof (path category > color))))
(defun-local compare-directory-entry (a (* (const void)) b (* (const void))
&return int)
(var-cast-to entry-a (* (const directory-entry)) a)
(var-cast-to entry-b (* (const directory-entry)) b)
(when (!= (path entry-a > is-directory)
(path entry-b > is-directory))
(return (? (path entry-a > is-directory) -1 1)))
(return (strcmp-case-insensitive (path entry-a > name) (path entry-b > name))))
(defun-local update-directory-entries (state (* imgui-directory-listing-state))
(set (at 0 (path state > read-directory-error)) 0)
(read-directory (path state > current-dir) (addr (path state > directory-entries))
(path state > read-directory-error) (sizeof (path state > read-directory-error)))
(quicksort (path state > directory-entries)
(dynarray-length (path state > directory-entries))
(sizeof (type directory-entry))
;; Selection
(var num-entries size_t (dynarray-length (path state > directory-entries)))
(dynarray-set-length (path state > selected-entries) num-entries)
(memset (path state > selected-entries) 0
(dynarray-length-sizeof (path state > selected-entries)))
;; When going up a directory, auto-select the now child dir
(when (dynarray-length (path state > previous-visited-child-entry))
(each-item-addr-in-dynarray (path state > directory-entries)
i current-entry (* directory-entry)
(when (= 0 (strcmp (path state > previous-visited-child-entry)
(path current-entry > name)))
(set (path state > on-activate-index) i)
;; Prevent weird auto-focusing of directories which coincidentally match the child
(dynarray-clear (path state > previous-visited-child-entry)))
;; Categories
;; Determine inherited category
(var inherited-userdata (* directory-entry-userdata)
(find-inherited-userdata (path state > current-dir)))
(var inherited-category (* category-spec) null)
(when inherited-userdata
(set inherited-category (dict-ptr-at g-categories-dict (path inherited-userdata > category)))
(when (and inherited-category (path inherited-category > is-deleted))
(set inherited-category null)))
(dynarray-set-length (path state > entry-categories) num-entries)
(memset (type-cast (path state > entry-categories) (* void)) 0
(dynarray-length-sizeof (path state > entry-categories)))
;; Copy categories for quick UI access
(each-item-addr-in-dynarray (path state > directory-entries)
i current-entry (* directory-entry)
(var full-path dynstring (full-path-for-entry (path state > current-dir) current-entry))
(var userdata (* directory-entry-userdata) (strdict-ptr-at g-userdata-dict full-path))
(dynarray-free full-path)
(var this-entry-cached-category (* entry-cached-category) (addr (at i (path state > entry-categories))))
(unless (and userdata (path userdata > category))
(when (and inherited-userdata inherited-category)
(copy-category-to-entry this-entry-cached-category inherited-category)
(set (path this-entry-cached-category > is-inherited) true))
;; It isn't inherited, save a hash lookup by continuing here
(unless (path userdata > category) (continue))
(var category (* category-spec) (dict-ptr-at g-categories-dict (path userdata > category)))
(when (and category (not (path category > is-deleted)))
(copy-category-to-entry this-entry-cached-category category)))
(set (path state > needs-update) false))
(defun-local path-append-divider-if-necessary (path-dynstring (* dynstring))
(unless (or (= '/' (at (- (dynstring-strlen (deref path-dynstring)) 1)
(deref path-dynstring)))
(is-root-path (deref path-dynstring)))
(dynstring-append path-dynstring "/")))
;; TODO Remember past selection position?
(defun-local imgui-directory-listing-activated (activated-entry (* directory-entry)
state (* imgui-directory-listing-state))
(if (path activated-entry > is-directory)
(set (path state > focus-filter) true)
(path-append-divider-if-necessary (addr (path state > current-dir)))
(dynstring-append (addr (path state > current-dir)) (path activated-entry > name))
(set (path state > needs-update) true)
(set (path state > should-scroll-to-entry) true)
(set (path state > on-activate-index) 0))
(scope (set (path state > focus-filter) true))))
(defun-local set-auto-focus-child-entry (state (* imgui-directory-listing-state)
auto-select-entry-start (* (const char)))
(when (= '/' (at 0 auto-select-entry-start))
(incr auto-select-entry-start))
(dynarray-clear (path state > previous-visited-child-entry))
(dynstring-append (addr (path state > previous-visited-child-entry))
(defun-local goto-parent-directory (state (* imgui-directory-listing-state))
(set (path state > focus-filter) true)
(set (path state > on-activate-index) 0)
(var next-path dynstring null)
(get-parent-of-path (path state > current-dir) (addr next-path))
;; Determine previous-visited-child-entry
(when (< (dynstring-strlen next-path) (dynstring-strlen (path state > current-dir)))
(var next-path-length int (dynstring-strlen next-path))
(var auto-select-entry-start (* char) (+ (path state > current-dir)
(set-auto-focus-child-entry state auto-select-entry-start))
(dynarray-free (path state > current-dir))
(set (path state > current-dir) next-path)
(set (path state > needs-update) true)
(set (path state > should-scroll-to-entry) true))
(defmacro each-filtered-directory-entry (entries-dynarray any filter any
index symbol entry-it symbol entry-type any
&rest body any)
(tokenize-push output
(each-item-addr-in-dynarray (token-splice entries-dynarray)
(token-splice index) (token-splice entry-it) (* directory-entry)
(unless (call-on PassFilter (token-splice filter)
(path (token-splice entry-it) > name))
(token-splice-rest body tokens)))
(return true))
(defun-local get-category-keybind-name (category (* category-spec)
&return (* (const char)))
(each-in-array category-available-keybinds keybind-option
(when (= (field (at keybind-option category-available-keybinds) keybind)
(path category > keybind))
(return (field (at keybind-option category-available-keybinds) name))))
(return "None"))
(defun-local wrap-activate-index-to-visible-entries (state (* imgui-directory-listing-state))
(var num-visible-entries int (dynarray-length (path state > filtered-entries)))
(when (>= (path state > on-activate-index) num-visible-entries)
(set (path state > on-activate-index) 0))
(when (< (path state > on-activate-index) 0)
(set (path state > on-activate-index) (- num-visible-entries 1))))
;; TODO: Only do this when state is dirty?
(defun-local update-filtered-entry-list (state (* imgui-directory-listing-state))
(dynarray-clear (path state > filtered-entries))
(dynarray-set-capacity (path state > filtered-entries)
(dynarray-length (path state > directory-entries)))
(each-filtered-directory-entry (path state > directory-entries)
(path state > directory-filter)
i current-entry (* directory-entry)
(dynarray-push (path state > filtered-entries) i)))
(defun-local filtered-entry-index-to-entry (filtered-index int state (* imgui-directory-listing-state)
&return (* directory-entry))
(return (addr
(at (at filtered-index (path state > filtered-entries))
(path state > directory-entries)))))
;; All values specified are relative to the viewport, from 0 to 1 proportionally
(defun-local imgui-first-time-window-size (x float y float width float height float)
(var main-viewport (* (const ImGuiViewport)) (imgui-call GetMainViewport))
(var imgui-style (& ImGuiStyle) (imgui-call GetStyle))
(var menu-bar-approx-offset float (+ (* 2 (field imgui-style FramePadding y))
(imgui-call GetFontSize)))
(imgui-call SetNextWindowPos (ImVec2 (+ (path main-viewport > WorkPos . x)
(* x (path main-viewport > WorkSize . x)))
(+ (path main-viewport > WorkPos . y)
(* y (- (path main-viewport > WorkSize . y)
(imgui-call SetNextWindowSize (ImVec2 (* (path main-viewport > WorkSize . x) width)
(* (- (path main-viewport > WorkSize . y)
(defun-local imgui-draw-color-icon-internal (color (* float)
name (* (const char)))
(var draw-list (* ImDrawList) (imgui-call GetWindowDrawList))
(var converted-color ImVec4
(array (at 0 color)
(at 1 color)
(at 2 color)
(var color-flags ImGuiColorEditFlags 0)
(var font-size float (imgui-call GetTextLineHeight))
(var circle-size ImVec2 (array font-size font-size))
(var cursor-position ImVec2 (imgui-call GetCursorScreenPos))
(var circle-position ImVec2 (array (+ (field cursor-position x) (/ (field circle-size x) 2))
(+ (field cursor-position y) (/ (field circle-size y) 2))))
(var num-segments int 6)
(call-on-ptr AddCircleFilled draw-list circle-position ;; center
(/ (field circle-size x) 2) ;; radius
(imgui-call GetColorU32 converted-color) num-segments)
(var circle-space ImVec2
(array (* 0.8f (field circle-size x))
(* 0.8f (field circle-size y))))
(imgui-call Dummy circle-space))
(defun-local imgui-draw-cached-category-color-icon (cached-category (* entry-cached-category))
(imgui-draw-color-icon-internal (path cached-category > color)
(path cached-category > name)))
(defun-local imgui-draw-category-color-icon (category (* category-spec))
(imgui-draw-color-icon-internal (path category > color)
(path category > name)))
(defun-local imgui-draw-colorizer-color-icon (colorizer (* file-colorizer))
(imgui-draw-color-icon-internal (path colorizer > color)
(path colorizer > ends-with)))
(defun-local is-key-tapped-this-frame (key category-keybind
current-key-states (* (const (unsigned char)))
last-frame-key-states (* (const (unsigned char)))
&return bool)
(return (and key
(at key current-key-states)
(not (at key last-frame-key-states)))))
(defun-local is-ctrl-key-pressed (current-key-states (* (const (unsigned char)))
&return bool)
(return (or (at SDL_SCANCODE_LCTRL current-key-states)
(at SDL_SCANCODE_RCTRL current-key-states))))
;; TODO: How should this sort of thing be handled? It sucks to have to typedef things again
(def-type-alias-global dynstring (* char))
(defun append-file-entry-to-path (path (* dynstring)
file-or-dir-name (* (const char)))
(path-append-divider-if-necessary path)
(dynstring-append path file-or-dir-name))
(defun open-system-file-explorer (in-directory (* (const char)))
(var url-current-directory ([] 1024 char) (array 0))
(snprintf url-current-directory (sizeof url-current-directory) "file://%s"
(SDL_OpenURL url-current-directory))
(defstruct-local imgui-approximate-wrap-state
;; Used to guess at how wide text will be. Very rough guess!
font-size float
wrap-cursor-position ImVec2
frame-size ImVec2)
(defun-local imgui-approximate-wrap-initialize (state (* imgui-approximate-wrap-state))
(set (path state > font-size) (imgui-call GetTextLineHeight))
(set (path state > wrap-cursor-position) (imgui-call GetCursorPos))
(set (path state > frame-size) (imgui-call GetContentRegionAvail)))
;; ImGui doesn't seem to be able to wrap discrete elements (or I'm missing something).
;; This function guesses when to wrap based on the number of characters in the next element, the
;; size of the frame, and the current cursor position
(defun-local imgui-approximate-wrap-before-element (state (* imgui-approximate-wrap-state)
num-characters-in-element size_t)
;; Approximate because font is variable-width
(when (< (* num-characters-in-element (path state > font-size) 0.25f)
(- (path state > frame-size . x)
(path state > wrap-cursor-position . x)))
(imgui-call SameLine)))
(defun-local imgui-approximate-wrap-after-element (state (* imgui-approximate-wrap-state))
;; Update cursor pos by recording what it will be on same line, without using same line for sure
(var temp-cursor-pos ImVec2 (imgui-call GetCursorPos))
(imgui-call SameLine)
(set (path state > wrap-cursor-position) (imgui-call GetCursorPos))
;; Undo SameLine
(imgui-call SetCursorPos temp-cursor-pos))
(defun-local imgui-refresh-button (state (* imgui-directory-listing-state)) ;; Optional
(when (imgui-call Button "Refresh")
(when state
(set (path state > needs-update) true))
(when (imgui-call IsItemHovered)
(imgui-call BeginTooltip)
(imgui-call Text "Re-scan current directory")
(imgui-print-shortcut "F5")
(imgui-call EndTooltip)))
(defun-local format-size-string (buffer (* char) buffer-size size_t size-to-format size_t)
((> size-to-format (* 1024 1024 1024))
(snprintf buffer buffer-size "%.1f GiB" (/ size-to-format (* 1024.f 1024.f 1024.f))))
((> size-to-format (* 1024 1024))
(snprintf buffer buffer-size "%.1f MiB" (/ size-to-format (* 1024.f 1024.f))))
((> size-to-format 1024)
(snprintf buffer buffer-size "%.1f KiB" (/ size-to-format 1024.f)))
(snprintf buffer buffer-size "%d B" (type-cast size-to-format int)))))
(defun-local imgui-directory-listing (state (* imgui-directory-listing-state)
current-key-states (* (const (unsigned char)))
should-show (* bool))
(var imgui-io (& ImGuiIO) (imgui-call GetIO))
(imgui-first-time-window-size 0.f 0.f 0.5f 0.7f)
(unless (imgui-call Begin "Current Directory" should-show)
(imgui-call End)
(var is-window-focused bool (imgui-call IsWindowFocused))
(var imgui-io (& ImGuiIO) (imgui-call GetIO))
;; Disable keyboard navigation while focused, because we need control of up/down arrow keys
(if (and is-window-focused
(not (at SDL_SCANCODE_LCTRL current-key-states))
(not (at SDL_SCANCODE_RCTRL current-key-states)))
(set (field imgui-io ConfigFlags)
(bit-xor (field imgui-io ConfigFlags)
(set (field imgui-io ConfigFlags)
(bit-or (field imgui-io ConfigFlags)
;; Latch filter focus based on whether the window was just re-focused
(unless (path state > was-window-focused)
(when is-window-focused
(set (path state > focus-filter) true)))
(set (path state > was-window-focused) is-window-focused)
(scope ;; History buttons
(when (imgui-call ArrowButton "Back" ImGuiDir_Left)
(set (path state > history-go-back) true))
(when (imgui-call IsItemHovered)
(imgui-call BeginTooltip)
(imgui-call Text "Go backwards in directory visited history")
(imgui-print-shortcut "Alt+Left, Mouse Button Back")
(imgui-call EndTooltip))
(imgui-call SameLine)
(when (imgui-call ArrowButton "Forwards" ImGuiDir_Right)
(set (path state > history-go-forwards) true))
(when (imgui-call IsItemHovered)
(imgui-call BeginTooltip)
(imgui-call Text "Go forwards in directory visited history")
(imgui-print-shortcut "Alt+Right, Mouse Button Forwards")
(imgui-call EndTooltip)))
;; Windows drive selection
(var drives ([] 26 char) (array 0))
(get-file-drives drives)
(var current-dir-drive char (at 0 (path state > current-dir)))
(var drive-label ([] 3 char) (array 0))
(set (at 0 drive-label) current-dir-drive)
(set (at 1 drive-label) ':')
(imgui-call SameLine)
(imgui-call SetNextItemWidth (* 3 (imgui-call GetTextLineHeight)))
(when (imgui-call BeginCombo "" drive-label)
(each-in-range 26 i
(var drive char (at i drives))
(unless drive (break))
(set (at 0 drive-label) drive)
(when (and (imgui-call Selectable drive-label)
;; Prevent unnecessary updating if they pick the same dir
(!= drive current-dir-drive))
;; TODO: Select drive
(dynstring-printf (addr (path state > current-dir)) "%c:" drive)
(set (path state > needs-update) true)
(set (path state > focus-filter) true))
(when (= drive current-dir-drive)
(imgui-call SetItemDefaultFocus)))
(imgui-call EndCombo)))))
(scope ;; Jump to directory in current path
(imgui-call SameLine) ;; Same line as back/forward
(var wrap-state imgui-approximate-wrap-state (array 0))
(imgui-approximate-wrap-initialize (addr wrap-state))
(var divided-path (* divided-path-dir) null)
(divide-path (path state > current-dir) (addr divided-path))
(each-in-dynarray-reverse divided-path i
(var subpath (* divided-path-dir) (addr (at i divided-path)))
(var abridged-path (* (const char)) (+ (path subpath > full-path)
(path subpath > innermost-dir-offset)))
(imgui-approximate-wrap-before-element (addr wrap-state) (strlen abridged-path))
(imgui-call PushID i)
(when (imgui-call Button abridged-path)
(dynarray-clear (path state > current-dir))
(dynstring-append (addr (path state > current-dir)) (path subpath > full-path))
(set (path state > needs-update) true)
(set (path state > focus-filter) true))
(imgui-call PopID)
(imgui-approximate-wrap-after-element (addr wrap-state)))
(dynarray-free divided-path))
(when (imgui-call ArrowButton "UpDirectory" ImGuiDir_Up)
(goto-parent-directory state))
(when (imgui-call IsItemHovered)
(imgui-call BeginTooltip)
(imgui-call Text "Go to the parent directory")
(imgui-print-shortcut "Backspace")
(imgui-call EndTooltip))
(imgui-call SameLine)
(imgui-refresh-button state)
(scope ;; Open system file explorer
(imgui-call SameLine) ;; Same line as Up directory
(when (or (imgui-call Button "Explorer Here")
(is-key-tapped-this-frame SDL_SCANCODE_F10 current-key-states
(path state > keys-last-frame))
(is-key-tapped-this-frame SDL_SCANCODE_E current-key-states
(path state > keys-last-frame))
(field imgui-io KeyCtrl)))
(open-system-file-explorer (path state > current-dir)))
(when (imgui-call IsItemHovered)
(imgui-call BeginTooltip)
(imgui-call Text "Open the system file explorer in the current directory")
(imgui-print-shortcut "F10, Ctrl+E")
(imgui-call EndTooltip)))
(scope ;; Help
(imgui-call SameLine)
(imgui-call TextDisabled "(?)")
(when (imgui-call IsItemHovered)
(imgui-call BeginTooltip)
(imgui-call Text "Categorize your files by selecting the row and pressing the key for the desired category.")
(imgui-call Text "Categories are inherited from parent directories. You may override inherited categories.")
(imgui-print-shortcut "Down, Ctrl+n, Ctrl+j (next row)")
(imgui-print-shortcut "Up, Ctrl+p, Ctrl+k (previous row)")
(imgui-print-shortcut "Enter (enter directory)")
(imgui-print-shortcut "Backspace (Go to parent directory)")
(imgui-call EndTooltip)))
(when is-window-focused ;; Backspace to exit directories, up/down selection navigation
;; Note that this scope must come *before* Draw on the filter, otherwise this code won't know
;; that the most recent backspace pressed deleted the final character in the filter
(var backspace-released bool
(imgui-call IsKeyReleased (at ImGuiKey_Backspace (field imgui-io KeyMap))))
;; If the user pressed backspace but they weren't deleting filters, go to the parent directory
(var backspace-pressed bool ;; Need to store this because pressed gets sent once
(imgui-call IsKeyPressed (at ImGuiKey_Backspace (field imgui-io KeyMap))))
(when (and backspace-pressed
(not (path state > is-deleting-filter-text)))
(set (path state > is-deleting-filter-text)
(call-on IsActive (path state > directory-filter)))
(when (not (path state > is-deleting-filter-text))
(goto-parent-directory state)))
(when backspace-released
(set (path state > is-deleting-filter-text) false))
;; Arrow navigation
(var on-activate-index-before-input int (path state > on-activate-index))
(when (or (imgui-call IsKeyPressed
(at ImGuiKey_DownArrow (field imgui-io KeyMap)))
(and (field imgui-io KeyCtrl)
(or (is-key-tapped-this-frame SDL_SCANCODE_N current-key-states
(path state > keys-last-frame))
(is-key-tapped-this-frame SDL_SCANCODE_J current-key-states
(path state > keys-last-frame)))))
(incr (path state > on-activate-index)))
(when (or (imgui-call IsKeyPressed
(at ImGuiKey_UpArrow (field imgui-io KeyMap)))
(and (field imgui-io KeyCtrl)
(or (is-key-tapped-this-frame SDL_SCANCODE_P current-key-states
(path state > keys-last-frame))
(is-key-tapped-this-frame SDL_SCANCODE_K current-key-states
(path state > keys-last-frame)))))
(decr (path state > on-activate-index)))
;; TODO: Calculate this based on visible position vs. num entries displayed
(var paging-num-entries int 10)
(when (imgui-call IsKeyPressed
(at ImGuiKey_PageUp (field imgui-io KeyMap)))
(set (path state > on-activate-index) (- (path state > on-activate-index)
;; Don't wrap on page up/down
(when (< (path state > on-activate-index) 0)
(set (path state > on-activate-index) 0)))
(when (imgui-call IsKeyPressed
(at ImGuiKey_PageDown (field imgui-io KeyMap)))
(set (path state > on-activate-index) (+ paging-num-entries
(path state > on-activate-index)))
(var num-filtered-entries int (dynarray-length (path state > filtered-entries)))
(when (>= (path state > on-activate-index) num-filtered-entries)
(set (path state > on-activate-index) (- num-filtered-entries 1))))
;; TODO: These overlap with the filter home/end
(when (and (is-key-tapped-this-frame SDL_SCANCODE_HOME current-key-states
(path state > keys-last-frame))
(field imgui-io KeyCtrl))
(set (path state > on-activate-index) 0))
(when (and (is-key-tapped-this-frame SDL_SCANCODE_END current-key-states
(path state > keys-last-frame))
(field imgui-io KeyCtrl))
(set (path state > on-activate-index)
(- (dynarray-length (path state > filtered-entries)) 1)))
(when (!= on-activate-index-before-input (path state > on-activate-index))
(set (path state > should-scroll-to-entry) true)))
;; TODO: This doesn't play nice with up/down keyboard navigation. Use SDL input to separate those out?
;; (if (or (path state > is-deleting-filter-text)
;; (not is-window-focused))
;; ;; Key repeat is a bit too fast for directory browsing
;; (set (field imgui-io KeyRepeatRate) 0.05f)
;; (set (field imgui-io KeyRepeatRate) 0.3f))
(when (and (field imgui-io KeyCtrl)
(is-key-tapped-this-frame SDL_SCANCODE_F current-key-states
(path state > keys-last-frame)))
(set (path state > focus-filter) true))
(when (path state > focus-filter)
(unless (or g-is-first-time-run (imgui-call IsAnyItemActive))
(imgui-call SetKeyboardFocusHere))
(set (path state > focus-filter) false))
(call-on Draw (path state > directory-filter))
(when (imgui-call IsItemHovered)
(imgui-call BeginTooltip)
(imgui-call Text "Filter items in the current directory. This is a fast way to navigate.")
(imgui-print-shortcut "Ctrl+F to focus filter from any window")
(imgui-call EndTooltip))
;; Update the actual list immediately after the filter
(update-filtered-entry-list state)
(wrap-activate-index-to-visible-entries state)
(scope ;; Entering directories via keyboard
(when (and (imgui-call IsItemDeactivated)
(imgui-call IsKeyPressed
(at ImGuiKey_Enter (field imgui-io KeyMap))))
(scope (set (path state > focus-filter) true))
(filtered-entry-index-to-entry (path state > on-activate-index) state)
;; TODO: Categorize next entry when pressing keybind again on entry with same category
(scope ;; Categorization
(var wrap-state imgui-approximate-wrap-state (array 0))
(imgui-approximate-wrap-initialize (addr wrap-state))
(var keybind-prompt ([] 128 char) (array 0))
(snprintf keybind-prompt (sizeof keybind-prompt) "Clear category%s (Ctrl+0)"
(? (= 0 (path state > last-used-category)) "*" ""))
(when (imgui-call SmallButton keybind-prompt)
(set (path state > last-used-category) 0)))
(imgui-approximate-wrap-after-element (addr wrap-state))
(when (imgui-call IsItemHovered)
(imgui-call BeginTooltip)
(imgui-call Text "Set this category to apply when clicking Use *")
(imgui-call EndTooltip))
(when (and is-window-focused ;; Handle clear category input
(is-key-tapped-this-frame SDL_SCANCODE_0 current-key-states
(path state > keys-last-frame))
(field imgui-io KeyCtrl))
(var entry-to-change (* directory-entry)
(filtered-entry-index-to-entry (path state > on-activate-index) state))
(categorize-directory-entry (path state > current-dir)
entry-to-change 0)
(set (path state > needs-update) true)
(incr (path state > on-activate-index))
(wrap-activate-index-to-visible-entries state))
(var keybind-prompt-index int 0)
(each-item-in-dict g-categories-dict category-index category (* category-spec)
(unless (and (path category > keybind)
(not (path category > is-deleted)))
(var category-keybind-name (* (const char)) (get-category-keybind-name category))
(var keybind-prompt ([] 128 char) (array 0))
(var num-printed size_t (snprintf keybind-prompt (sizeof keybind-prompt) "%s%s (%s)"
(path category > name)
(? (= (path category > key)
(path state > last-used-category)) "*" "")
;; Add some extra characters to account for color icon. I'm not sure why this is so high.
;; There must be something I'm not accounting for
(imgui-approximate-wrap-before-element (addr wrap-state) (+ 21 num-printed))
(imgui-draw-category-color-icon category)
(imgui-call SameLine)
(when (imgui-call SmallButton keybind-prompt)
(set (path state > last-used-category) (path category > key)))
(imgui-approximate-wrap-after-element (addr wrap-state))
(when (imgui-call IsItemHovered)
(imgui-call BeginTooltip)
(imgui-call Text "Set this category to apply when clicking Use *")
(imgui-call EndTooltip))
(incr keybind-prompt-index)
(when (and is-window-focused
(is-key-tapped-this-frame (path category > keybind) current-key-states
(path state > keys-last-frame))
(field imgui-io KeyCtrl))
(categorize-directory-entry (path state > current-dir)
(filtered-entry-index-to-entry (path state > on-activate-index) state)
(path category > key))
(set (path state > last-used-category) (path category > key))
(incr (path state > on-activate-index))
(wrap-activate-index-to-visible-entries state)
(set (path state > needs-update) true))))
(imgui-call Separator)
;; TODO: Tell the user what the error was
(when (at 0 (path state > read-directory-error))
(imgui-call TextDisabled "Could not read directory: %s" (path state > read-directory-error)))
(unless (dynarray-length (path state > filtered-entries))
(imgui-call TextDisabled "No entries in directory match filter"))
;; Use a child window so that the filter is still visible even after scrolling entries
(imgui-call BeginChild "Directory Listing Child")
(unless (imgui-call BeginTable "Directory Listing" 5 ImGuiTableFlags_SizingStretchProp)
(imgui-call EndChild)
(imgui-call End)
(imgui-call TableSetupColumn "Name" ImGuiTableColumnFlags_WidthStretch)
(imgui-call TableSetupColumn "Size" ImGuiTableColumnFlags_WidthFixed)
(imgui-call TableSetupColumn "Type" ImGuiTableColumnFlags_WidthFixed)
(imgui-call TableSetupColumn "Category" ImGuiTableColumnFlags_WidthFixed)
(imgui-call TableSetupColumn "Category controls" ImGuiTableColumnFlags_WidthFixed)
(var colors (* ImVec4) (field (imgui-call GetStyle) Colors))
(each-item-in-dynarray (path state > filtered-entries)
filtered-entry-index entry-index int
(imgui-call PushID entry-index)
(var current-entry (* directory-entry)
(addr (at entry-index (path state > directory-entries))))
(imgui-call TableNextRow)
(imgui-call TableNextColumn)
(var directory-row-color ImU32 (imgui-call GetColorU32 (at ImGuiCol_PopupBg colors)))
(when (path current-entry > is-directory)
(imgui-call TableSetBgColor ImGuiTableBgTarget_RowBg0 directory-row-color))
(var entry-name (* (const char)) (path current-entry > name))
(if (path current-entry > is-directory)
(when (imgui-call Selectable entry-name (= entry-index (path state > on-activate-index))
;;(bit-or ImGuiSelectableFlags_SpanAllColumns
ImGuiSelectableFlags_AllowDoubleClick) ;;)
(set (path state > focus-filter) true)
(set (path state > on-activate-index) entry-index)
(when (imgui-call IsMouseDoubleClicked 0)
(set (path state > focus-filter) true)
(append-file-entry-to-path (addr (path state > current-dir)) (path current-entry > name))
(set (path state > needs-update) true)))
;; File
(when (imgui-call Selectable entry-name (= entry-index (path state > on-activate-index)))
(set (path state > focus-filter) true)
(set (path state > on-activate-index) entry-index)))
(var selected-row-color ImU32 (imgui-call GetColorU32 (at ImGuiCol_FrameBg colors)))
(when (= (path state > on-activate-index) filtered-entry-index)
(imgui-call TableSetBgColor ImGuiTableBgTarget_RowBg0 selected-row-color)
(when (path state > should-scroll-to-entry)
;; Unfortunately, this fails on items that require scrolling all the way to the bottom
;; See https://github.com/ocornut/imgui/issues/1804
(imgui-call SetScrollHereY 0.25f)
(incr (path state > should-scroll-to-entry-delay-counter))
;; Scrolling can take multiple frames. Don't toggle the flag until it's actually visible
;; Related: https://github.com/ocornut/imgui/issues/1526
(when (> (path state > should-scroll-to-entry-delay-counter) 1)
(set (path state > should-scroll-to-entry-delay-counter) 0)
(set (path state > should-scroll-to-entry) false))))
(imgui-call TableNextColumn)
(if (path current-entry > is-directory)
(when (imgui-call Button "dir")
(set (path state > focus-filter) true)
(append-file-entry-to-path (addr (path state > current-dir)) (path current-entry > name))
(set (path state > needs-update) true))
(imgui-call TextDisabled "file"))
(imgui-call TableNextColumn)
(if (path current-entry > is-directory)
(imgui-call Text "-") ;; TODO: Item counts
(var buffer ([] 64 char) (array 0))
(format-size-string buffer (sizeof buffer)
(path current-entry > size))
(imgui-call Text "%s" buffer)))
(imgui-call TableNextColumn)
(var this-entry-cached-category (* entry-cached-category)
(addr (at entry-index (path state > entry-categories))))
((path this-entry-cached-category > is-inherited)
(imgui-draw-cached-category-color-icon this-entry-cached-category)
(imgui-call SameLine)
(imgui-call PushStyleColor ImGuiCol_Text (at ImGuiCol_TextDisabled colors))
(imgui-call Selectable (path this-entry-cached-category > name))
(imgui-call PopStyleColor)
(when (imgui-call IsItemHovered)
(imgui-call BeginTooltip)
(imgui-call Text "Category is inherited from a parent directory. Click to override")
(imgui-call EndTooltip)))
((path this-entry-cached-category > name)
(imgui-draw-cached-category-color-icon this-entry-cached-category)
(imgui-call SameLine)
(imgui-call Selectable (path this-entry-cached-category > name)))
(imgui-call PushStyleColor ImGuiCol_Text (at ImGuiCol_TextDisabled colors))
(imgui-call Selectable "uncategorized")
(imgui-call PopStyleColor)))
(when (imgui-call IsItemClicked)
(imgui-call OpenPopup "categorize"))
(scope ;; Categorization controls
(imgui-call TableNextColumn)
(when (imgui-call ArrowButton "##ChangeCategory" ImGuiDir_Down)
(imgui-call OpenPopup "categorize"))
(when (imgui-call BeginPopup "categorize")
(when (imgui-call Selectable "Clear category")
(path state > current-dir)
(filtered-entry-index-to-entry entry-index state) 0)
(set (path state > last-used-category) 0)
(set (path state > needs-update) true))
(each-item-in-dict g-categories-dict category-index category (* category-spec)
(unless (not (path category > is-deleted))
(imgui-draw-category-color-icon category)
(imgui-call SameLine)
(when (imgui-call Selectable (path category > name))
(path state > current-dir)
(filtered-entry-index-to-entry entry-index state)
(path category > key))
(set (path state > last-used-category) (path category > key))
(set (path state > needs-update) true)))
(imgui-call EndPopup))
(imgui-call SameLine)
(when (imgui-call Button "Use *")
(path state > current-dir)
(filtered-entry-index-to-entry entry-index state)
(path state > last-used-category))
(set (path state > needs-update) true))
(when (imgui-call IsItemHovered)
(imgui-call BeginTooltip)
(imgui-call Text "Use last selected category (marked with a * in key)")
(imgui-call EndTooltip)))
(imgui-call PopID))
(imgui-call EndTable)
(imgui-call EndChild)
(imgui-call End)
(when (path state > needs-update)
(call-on Clear (path state > directory-filter))
(update-directory-entries state)))
(var delete-without-prompt bool false)
;; Returns whether categories are changed in any way
(defun-local imgui-category-editor (should-show (* bool) &return bool)
(imgui-first-time-window-size 0.f 0.7f 0.5f 0.3f)
(var categories-changed bool false)
(unless (imgui-call Begin "Categories" should-show)
(imgui-call End)
(return categories-changed))
(imgui-call TextWrapped "Create categories to organize your files.")
(var-static open-explorer-on-export bool true)
(when (imgui-call Button "Export all to text")
(export-category-paths-start g-userdata-dict g-categories-dict open-explorer-on-export))
(when (imgui-call IsItemHovered)
(imgui-call BeginTooltip)
(imgui-call Text "Export a list of all files and directories in each category.")
(imgui-call Text "List includes entries with only that category, so they can be simply copied.")
(imgui-call Text "A file explorer will open in the export directory.")
(imgui-call Text "You can use these files as inputs into your backup systems, for example.")
(imgui-call EndTooltip))
(imgui-call SameLine) (imgui-call Checkbox "Open Explorer on Export" (addr open-explorer-on-export))
(imgui-call Separator)
(each-in-strdict g-categories-dict current-category-index
(var category (* category-spec)
(addr (at current-category-index g-categories-dict)))
(when (path category > is-deleted)
;; Note that using the category here as the ID is important to preserve open/closed state, as
;; well as to give inputs a separate ID stack
(var is-category-expanded bool
(imgui-call TreeNode category
"%s" "")) ;; Weird thing to silence -Wformat-zero-length
;; A bit hacky, but it works! Draw the color next to the name
(imgui-call SameLine)
(imgui-draw-category-color-icon category)
(imgui-call SameLine)
(imgui-call Text "%s" (? (at 0 (path category > name)) (path category > name) "<unnamed>"))
(unless is-category-expanded
;; TODO Backup #1 won't be renamed on save if you are still editing the field and close the window
(when (imgui-call InputTextWithHint "Name" "e.g. Critical Backup"
(path category > name) (sizeof (path category > name)))
(set categories-changed true))
(when (imgui-call ColorEdit3 "Color" (path category > color))
(set categories-changed true))
(var preview-keybind (* (const char)) "<none>")
(var selected-keybind-option int 0)
(each-in-array category-available-keybinds keybind-option
(when (= (field (at keybind-option category-available-keybinds) keybind)
(path category > keybind))
(set preview-keybind
(field (at keybind-option category-available-keybinds) name))
(set selected-keybind-option keybind-option)))
(when (imgui-call BeginCombo "Keybind" preview-keybind)
(each-in-array category-available-keybinds keybind-option
(var current-keybind (* category-available-keybind)
(addr (at keybind-option category-available-keybinds)))
(var is-selected bool (= selected-keybind-option keybind-option))
(var keybind-text ([] 128 char) (array 0))
(if (path current-keybind > in-use-by-category)
keybind-text (sizeof keybind-text) (assert 0)
"%s (%s)" (path current-keybind > name)
(path (dict-ptr-at g-categories-dict (path current-keybind > in-use-by-category))
> name))
(sprintf-to-char-array keybind-text (sizeof keybind-text) (assert 0)
"%s" (path current-keybind > name)))
(when (imgui-call Selectable keybind-text
(category-claim-keybind category
(path current-keybind > keybind)))
(when is-selected (imgui-call SetItemDefaultFocus)))
(imgui-call EndCombo))
(when (imgui-call Button "X Delete")
(if delete-without-prompt
(scope (set categories-changed true)
(mark-category-for-deletion category))
(imgui-call OpenPopup "Delete?"))))
(when (imgui-call BeginPopupModal "Delete?" null ImGuiWindowFlags_AlwaysAutoResize)
(imgui-call Text "The category will be deleted and removed from any entries which were in it.
\nThis operation cannot be undone!\n\n")
(imgui-call Separator)
(imgui-call PushStyleVar ImGuiStyleVar_FramePadding (ImVec2 0 0))
(imgui-call Checkbox "Don't ask me next time" (addr delete-without-prompt))
(imgui-call PopStyleVar)
(when (imgui-call Button "OK" (ImVec2 120 0))
(mark-category-for-deletion category)
(set categories-changed true)
(imgui-call CloseCurrentPopup))
(imgui-call SetItemDefaultFocus)
(imgui-call SameLine)
(when (imgui-call Button "Cancel" (ImVec2 120 0))
(imgui-call CloseCurrentPopup))
(imgui-call EndPopup))
(imgui-call TreePop))
(when (imgui-call Button "+ Add new")
;; TODO: Auto expand tree of new category
(set categories-changed true))
(imgui-call End)
(return categories-changed))
(defun-local imgui-file-colorizer-editor (should-show (* bool) &return bool)
(imgui-first-time-window-size 0.5f 0.7f 0.5f 0.3f)
(var colorizers-changed bool false)
(unless (imgui-call Begin "File Colorizers" should-show)
(imgui-call End)
(return colorizers-changed))
(imgui-call TextWrapped "Change file colors in Treemap based on extensions. Does not affect categorization.")
(imgui-refresh-button null)
(imgui-call SameLine)
(imgui-call Text "to see changes")
(imgui-call SameLine)
(imgui-call Checkbox "Use colors from theme" (addr g-treemap-use-theme-for-colorization))
(when (imgui-call IsItemHovered)
(imgui-call BeginTooltip)
(imgui-call Text "Category colors will match the automatic theme.")
(imgui-call Text "You will not be able to customize the colors while this is enabled.")
(imgui-call EndTooltip))
(imgui-call Separator)
(each-item-addr-in-dynarray g-file-colorizers i colorizer (* file-colorizer)
;; Note that using the category here as the ID is important to preserve open/closed state, as
;; well as to give inputs a separate ID stack
(var is-colorizer-expanded bool
(imgui-call TreeNode colorizer "%s" "")) ;; Weird thing to silence -Wformat-zero-length
(var is-default-entry bool (= 0 i))
;; A bit hacky, but it works! Draw the color next to the name
(imgui-call SameLine)
(? g-treemap-use-theme-for-colorization
(at i current-interpolate-base16-colors)
(path colorizer > color))
(path colorizer > ends-with))
(imgui-call SameLine)
(if is-default-entry
(imgui-call Text "Default")
(imgui-call Text "%s" (? (at 0 (path colorizer > group-name)) (path colorizer > group-name) "<unset>")))
(unless is-colorizer-expanded
(unless is-default-entry
(when (imgui-call InputTextWithHint "Group name" "e.g. Media"
(path colorizer > group-name) (sizeof (path colorizer > group-name)))
(set colorizers-changed true)))
(unless is-default-entry
(when (imgui-call InputTextWithHint "Files that end with" ".jpg .mp4 .png"
(path colorizer > ends-with) (sizeof (path colorizer > ends-with)))
(set colorizers-changed true))
(when (imgui-call IsItemHovered)
(imgui-call BeginTooltip)
(imgui-call Text "Separate file extensions with a single space")
(imgui-call EndTooltip)))
(when g-treemap-use-theme-for-colorization
(imgui-call BeginDisabled))
(when (imgui-call ColorEdit3 "Color" (path colorizer > color))
(set colorizers-changed true))
(when g-treemap-use-theme-for-colorization
(imgui-call EndDisabled))
(unless is-default-entry
(when (imgui-call Button "X Delete")
(set colorizers-changed true)
(dynarray-delete g-file-colorizers i)
(set i (- 1 i))))
(imgui-call TreePop))
(if (>= (dynarray-length g-file-colorizers) (- g-max-num-classification-colors 1))
(imgui-call TextDisabled "Max num classifications reached")
(when (imgui-call Button "+ Add new")
(dynarray-set-length g-file-colorizers (+ 1 (dynarray-length g-file-colorizers)))
(memset (addr (at (- (dynarray-length g-file-colorizers) 1 ) g-file-colorizers)) 0
(sizeof (type file-colorizer)))
(set colorizers-changed true)))
(imgui-call End)
(return colorizers-changed))
(defmacro sprintf-to-char-array (buffer-name symbol buffer-size any on-buffer-full any
format-string string &optional &rest format-arguments any)
(tokenize-push output
(var auto-num-printed int
(snprintf (token-splice buffer-name) (sizeof (token-splice buffer-name))
(token-splice format-string) (token-splice-rest format-arguments tokens)))
(unless (< auto-num-printed (- (token-splice buffer-size) 1))
(token-splice on-buffer-full))
;; Make absolutely sure we set the null terminator
(set (at auto-num-printed (token-splice buffer-name)) 0)))
(return true))
(defun-local mouse-button-tapped (current-button-state Uint32
last-frame-button-state Uint32
button-to-check Uint32
&return bool)
(return (and (bit-and current-button-state button-to-check)
(not (bit-and last-frame-button-state button-to-check)))))
;; Main
(var-global g-userdata-output-dir dynstring null)
;; Must stick around after (user) shutdown
(var g-imgui-output-file ([] 1024 char) (array 0))
(comptime-cond ('Windows
(c-preprocessor-define WIN32_LEAN_AND_MEAN)
(c-import "windows.h")))
(defun wait-for-debugger ()
(comptime-cond ('Windows
(while (not (IsDebuggerPresent))
(Sleep 100)))))
;; TODO Need infect
(add-c-search-directory-module "Dependencies/enkiTS/src")
"File Helper"
(body ;; Initialization
(timing-zone-start initialize-zone "User initialization")
(SDL_Log "%s" g-copyright-string)
;; Kick off auto-theming
(var pref-path (* char) (SDL_GetPrefPath "Macoy Madson Software" "File Helper"))
(dynarray-clear g-userdata-output-dir)
(dynstring-append (addr g-userdata-output-dir) pref-path)
(SDL_free pref-path)
(SDL_Log "Userdata directory: %s\n" g-userdata-output-dir)
;; Make sure imgui saves preferences to pref dir as well. The first load happens in the main loop
(var imgui-io (& ImGuiIO) (imgui-call GetIO))
(snprintf g-imgui-output-file (sizeof g-imgui-output-file) "%simgui.ini"
(if g-should-save-load-imgui-config
(scope (SDL_Log "Imgui output to: %s\n" g-imgui-output-file)
(set (field imgui-io IniFilename) g-imgui-output-file))
;; Temporarily disable save/load
(scope (SDL_Log "Imgui will not save configuration (it is disabled)\n")
(set (field imgui-io IniFilename) null))))
(var current-dir (* (const char)) (make-absolute-path-allocated null "."))
(unless current-dir
(SDL_Log "error: failed to make absolute path")
(timing-zone-stop initialize-zone)
(return 1))
(var listing-state imgui-directory-listing-state (array 0))
(dynstring-append (addr (field listing-state current-dir)) current-dir)
(free (type-cast current-dir (* void)))
(set (field listing-state focus-filter) true)
(set (field listing-state was-window-focused) true)
;; (strdict-use-key-arena g-userdata-dict)
(strdict-use-key-strdup g-userdata-dict)
(if g-should-save-load-user-config
(unless (load-state-s-expr)
(SDL_Log "Did not load UserData\n"))
;; Ensure the default colorizer exists
(unless (dynarray-length g-file-colorizers)
(dynarray-set-length g-file-colorizers 1)
(memset (addr (at 0 g-file-colorizers)) 0 (dynarray-length-sizeof g-file-colorizers))
(set (at 0 (field (at 0 g-file-colorizers) color)) 0.6f)
(set (at 1 (field (at 0 g-file-colorizers) color)) 0.2f)
(set (at 2 (field (at 0 g-file-colorizers) color)) 0.2f))
(unless (dict-length g-categories-dict)
(var new-category-key category-key (create-category-spec))
(var new-category (* category-spec) (dict-ptr-at g-categories-dict new-category-key))
(set (path new-category > keybind) (field (at 1 category-available-keybinds) keybind))
(category-claim-keybind (dict-ptr-at g-categories-dict (path new-category > key))
(path new-category > keybind))
(var name-buffer (* char) (path new-category > name))
(sprintf-to-char-array name-buffer (sizeof (path new-category > name))
(return 1) "Backup"))
(set g-treemap-multithreaded-state (create-treemap-file-system-multithreaded-state))
;; Start treemap scanning as soon as possible. It runs on a separate thread so we might as well
;; start scanning while still setting up
;; This is a ratio so doesn't need to be exact. TODO: Get window size from config
(var treemap-initial-display-size vec3 (array 1000.f 1000.f 0.f))
(treemap-update-state g-treemap-multithreaded-state
(field listing-state current-dir) g-treemap-request-refresh-time
treemap-initial-display-size null)
(var window-width int 0)
(var window-height int 0)
(SDL_GetWindowSize window (addr window-width) (addr window-height))
;; TODO: Not necessary to make the texture this big!
(unless (treemap-opengl-initialize window-width window-height)
(SDL_Log "Failed to initialize OpenGL")
(timing-zone-stop initialize-zone)
(return 1))
(scope ;; Window icon
(var icon-filename (* (const char)) "data/Icon.bmp")
(var icon-surface (* SDL_Surface) (SDL_LoadBMP icon-filename))
(if icon-surface
(scope (SDL_SetWindowIcon window icon-surface)
(SDL_FreeSurface icon-surface))
(scope ;; No icon isn't the end of the world
(SDL_Log "warning: failed to load surface from BMP %s\n" icon-filename)
(scope ;; ImGui style customizations
(var imgui-style (& ImGuiStyle) (imgui-call GetStyle))
(set (field imgui-style FrameRounding) 6.f))
(var directory-history (* dynstring) null)
(dynarray-set-capacity directory-history 64)
(var directory-history-index int 0)
(var new-history-entry dynstring null)
(dynstring-append (addr new-history-entry) (field listing-state current-dir))
(dynarray-push directory-history new-history-entry))
(update-directory-entries (addr listing-state))
(var show-imgui-demo-window bool false)
(var show-help-window bool g-is-first-time-run)
(var show-copyright-window bool false)
(var show-license-window bool false)
(var show-directory-browser bool true)
(var show-categories-editor bool true)
(var show-colorizers-editor bool true)
(var show-treemap bool true)
(var show-error-window bool g-save-disabled-due-to-error)
(var last-time-saved Uint64 (SDL_GetPerformanceCounter))
(timing-zone-stop initialize-zone))
(body ;; Once per frame
(time-this-scope scope-6 "User Frame")
(when (and g-should-save-load-user-config
(> (/ (- (SDL_GetPerformanceCounter) last-time-saved)
(type-cast (SDL_GetPerformanceFrequency) float))
(unless (save-state-s-expr)
(SDL_Log "error: failed to save state"))
(set last-time-saved (SDL_GetPerformanceCounter)))
(when g-auto-theme-from-background
;; Get keyboard input
(var num-sdl-keys int 0)
(var key-states (* (const (unsigned char)))
(SDL_GetKeyboardState (addr num-sdl-keys)))
(unless (field listing-state keys-last-frame)
(dynarray-set-length (field listing-state keys-last-frame) num-sdl-keys))
(when (imgui-call BeginMainMenuBar)
(when (imgui-call BeginMenu "File")
(when (imgui-call MenuItem "Open User Data directory")
(open-system-file-explorer g-userdata-output-dir))
(when (imgui-call MenuItem "Exit" "Ctrl+Q")
(set exit-reason "Exited from main menu"))
(imgui-call EndMenu))
(when (imgui-call BeginMenu "Tools")
(imgui-call MenuItem "Directory Browser" null (addr show-directory-browser))
(imgui-call MenuItem "Categories" null (addr show-categories-editor))
(imgui-call MenuItem "File Colorizers" null (addr show-colorizers-editor))
(imgui-call MenuItem "Treemap" null (addr show-treemap))
(imgui-call Separator)
(imgui-call MenuItem "UI" null (addr show-imgui-demo-window))
(imgui-call MenuItem "Theme from desktop background" null
(addr g-auto-theme-from-background))
(imgui-call EndMenu))
(when (imgui-call BeginMenu "About")
(imgui-call MenuItem "Help" "F1, Ctrl+H" (addr show-help-window))
(when (imgui-call MenuItem "Website")
(SDL_OpenURL "https://macoy.me"))
(imgui-call MenuItem "Author & Copyright" null (addr show-copyright-window))
(imgui-call MenuItem "Licenses" null (addr show-license-window))
(imgui-call EndMenu))
(imgui-call EndMainMenuBar))
(scope ;; Keyboard shortcuts for menu items
(when (or (is-key-tapped-this-frame SDL_SCANCODE_F1 key-states
(field listing-state keys-last-frame))
(and (is-ctrl-key-pressed key-states)
(is-key-tapped-this-frame SDL_SCANCODE_H key-states
(field listing-state keys-last-frame))))
(set show-help-window true))
(when (and (is-ctrl-key-pressed key-states)
(is-key-tapped-this-frame SDL_SCANCODE_Q key-states
(field listing-state keys-last-frame)))
(set exit-reason "Keyboard shortcut quit")))
(when show-imgui-demo-window
(imgui-call ShowDemoWindow))
(when show-directory-browser
(imgui-directory-listing (addr listing-state) key-states (addr show-directory-browser)))
(when show-categories-editor
(var categories-changed bool (imgui-category-editor (addr show-categories-editor)))
(when categories-changed (update-directory-entries (addr listing-state))))
(when show-colorizers-editor
(var colorizers-changed bool (imgui-file-colorizer-editor (addr show-colorizers-editor))))
(when show-copyright-window
(imgui-first-time-window-size 0.2f 0.1f 0.7f 0.7f)
(when (imgui-call Begin "Copyright" (addr show-copyright-window))
(imgui-call TextUnformatted g-copyright-string))
(imgui-call End))
(when show-license-window
(imgui-first-time-window-size 0.2f 0.1f 0.7f 0.7f)
(when (imgui-call Begin "Licenses" (addr show-license-window))
(when (imgui-call CollapsingHeader "File Helper")
(imgui-call TextUnformatted g-license-string))
(when (imgui-call CollapsingHeader "Ubuntu Font")
(imgui-call TextUnformatted g-font-license-string))
(when (imgui-call CollapsingHeader "3rd party code licenses")
(each-in-array g-code-license-strings i
(var current-code-license (* code-license) (addr (at i g-code-license-strings)))
(when (imgui-call TreeNode current-code-license
"%s" (path current-code-license > dependency-name))
(imgui-call TextUnformatted (path current-code-license > license))
(imgui-call TreePop)))))
(imgui-call End))
(when show-error-window
(imgui-first-time-window-size 0.01f 0.01f 0.3f 0.18f)
(when (imgui-call Begin "Error" (addr show-error-window))
(imgui-call PushStyleColor ImGuiCol_Text (type-cast (call (in ImColor HSV) 1.f 1.f 1.f)
(imgui-call TextWrapped "%s" g-save-disabled-due-to-error-string)
(imgui-call PopStyleColor)
(imgui-call TextWrapped "You will not be able to save any changes until this problem is resolved.\n
Your UserData is not lost.\n
Depending on the error, open the UserData.cakedata file in a text editor and see if you notice any format
issues. Contact macoy@macoy.me for help.")
(when (imgui-call Button "Open UserData directory")
(open-system-file-explorer g-userdata-output-dir)))
(imgui-call End))
(var mouse-x int 0)
(var mouse-y int 0)
(var mouse-button-state Uint32 (SDL_GetMouseState (addr mouse-x) (addr mouse-y)))
(scope ;; History and forward/back navigation
;; Rather than tracking every place that could possibly change current-dir, passively watch it
;; and record changes
(when (or (not (dynarray-length directory-history))
(!= 0 (strcmp (at directory-history-index directory-history)
(field listing-state current-dir))))
(incr directory-history-index)
(if (= directory-history-index (dynarray-length directory-history))
(var new-history-entry dynstring null)
(dynstring-append (addr new-history-entry) (field listing-state current-dir))
(dynarray-push directory-history new-history-entry))
(dynarray-clear (at directory-history-index directory-history))
(dynstring-append (addr (at directory-history-index directory-history))
(field listing-state current-dir))
;; When writing new history entries, all future entries are invalidated
(each-in-range (- (dynarray-length directory-history) 1 directory-history-index) i
(dynarray-free (at (+ directory-history-index i 1) directory-history)))
(dynarray-set-length directory-history (+ 1 directory-history-index)))))
(scope ;; Forward/back navigation
(var history-used bool false)
;; Back
(when (or (mouse-button-tapped mouse-button-state
(field listing-state mouse-last-frame)
(and (or (at SDL_SCANCODE_LALT key-states)
(at SDL_SCANCODE_RALT key-states))
(is-key-tapped-this-frame SDL_SCANCODE_LEFT key-states
(field listing-state keys-last-frame)))
(field listing-state history-go-back))
(when directory-history-index
(decr directory-history-index)
(dynarray-clear (field listing-state current-dir))
(dynstring-append (addr (field listing-state current-dir))
(at directory-history-index directory-history))
(set history-used true)))
;; Forwards
(when (or (mouse-button-tapped mouse-button-state
(field listing-state mouse-last-frame)
(and (or (at SDL_SCANCODE_LALT key-states)
(at SDL_SCANCODE_RALT key-states))
(is-key-tapped-this-frame SDL_SCANCODE_RIGHT key-states
(field listing-state keys-last-frame)))
(field listing-state history-go-forwards))
(when (< directory-history-index (- (dynarray-length directory-history) 1))
(incr directory-history-index)
(dynarray-clear (field listing-state current-dir))
(dynstring-append (addr (field listing-state current-dir))
(at directory-history-index directory-history))
(set history-used true)))
;; No matter what, we handled these
(set (field listing-state history-go-back) false)
(set (field listing-state history-go-forwards) false)
(when history-used
(set (field listing-state on-activate-index) 0)
(set (field listing-state should-scroll-to-entry) true)
(set (field listing-state focus-filter) true)
(set (field listing-state needs-update) true))))
(when (is-key-tapped-this-frame SDL_SCANCODE_F5 key-states
(field listing-state keys-last-frame)) ;; Refresh display
(set (field listing-state needs-update) true))
(when show-treemap
(time-this-scope treemap-scope "Treemap")
(imgui-first-time-window-size 0.5f 0.f 0.5f 0.7f)
(when (imgui-call Begin "Treemap" (addr show-treemap))
(imgui-call Text "File:") ;; Here to make room for hovered for GetContentRegionAvail
(imgui-call SameLine)
(var path-output-position ImVec2 (imgui-call GetCursorScreenPos))
(imgui-call Text "%s" "") ;; Only to advance to the next line
(var treemap-texture-size ImVec2 (imgui-call GetContentRegionAvail))
;; Give the texture some margin
(set (field treemap-texture-size x) (- (field treemap-texture-size x) 0.f))
(set (field treemap-texture-size y) (- (field treemap-texture-size y) 0.f))
(var treemap-display-size vec3 (array (field treemap-texture-size x)
(field treemap-texture-size y) 0.f))
(var num-entries-scanned (unsigned int) 0)
(var treemap-status treemap-running-state
(treemap-update-state g-treemap-multithreaded-state
(field listing-state current-dir)
(addr num-entries-scanned)))
;; Have button for checking hovered status
(var treemap-cursor-pos ImVec2 (imgui-call GetCursorScreenPos))
(imgui-call InvisibleButton "Treemap" treemap-texture-size ImGuiButtonFlags_MouseButtonLeft)
(var is-treemap-hovered bool (imgui-call IsItemHovered))
;; Reset position because button advanced layout cursor, but we want it to overlap treemap
(imgui-call SetCursorScreenPos treemap-cursor-pos)
;; Picking and input
(var picked-rectangle-index int -1)
(when is-treemap-hovered ;; Picking
(var layout-size vec3 (get-current-treemap-layout-size g-treemap-multithreaded-state))
(var hover-path (* (const char))
(pick-directory-from-coordinates g-treemap-multithreaded-state
;; Mouse relative to origin
(- mouse-x (field treemap-cursor-pos x))
(- mouse-y (field treemap-cursor-pos y))
(field treemap-texture-size x)
(field treemap-texture-size y)
(addr picked-rectangle-index)))
(var print-path (* (const char)) hover-path)
(when hover-path ;; Trim the current dir
(set print-path (+ hover-path (strlen (field listing-state current-dir)))))
(when print-path
;; Some weird cursor stuff: Warp back to the path line, add the path, then go back to treemap
(imgui-call SetCursorScreenPos path-output-position)
(imgui-call Text ".%s" print-path)
(imgui-call SetCursorScreenPos treemap-cursor-pos))
;; On click, jump straight to file
(when (and hover-path (mouse-button-tapped mouse-button-state
(field listing-state mouse-last-frame)
(get-parent-of-path hover-path (addr (field listing-state current-dir)))
(var auto-select-entry-start (* (const char))
(+ hover-path (strlen (field listing-state current-dir))))
(set-auto-focus-child-entry (addr listing-state) auto-select-entry-start)
(set (field listing-state should-scroll-to-entry) true)
(set (field listing-state focus-filter) true)
(set (field listing-state needs-update) true)))
(var application-window-width int 0)
(var application-window-height int 0)
(SDL_GetWindowSize window (addr application-window-width) (addr application-window-height))
(assert (and application-window-width application-window-height))
(var treemap-color-palette (* float)
(type-cast current-interpolate-base16-colors (* float)))
(var colorizer-user-palette ([] (* 16 3) float) (array 0)) ;; TODO hardcoded
(unless g-treemap-use-theme-for-colorization
(each-item-addr-in-dynarray g-file-colorizers i colorizer (* file-colorizer)
(memcpy (addr (at (* i 3) colorizer-user-palette))
(path colorizer > color)
(sizeof (path colorizer > color))))
(set treemap-color-palette (type-cast colorizer-user-palette (* float))))
treemap-texture ImTextureID
application-window-width ;; For resetting viewport
(field treemap-texture-size x)
(field treemap-texture-size y)
(get-treemap-transform (get-current-treemap-layout-size g-treemap-multithreaded-state))
;; TODO: Only dim after some threshold of time
(= treemap-running-state-done treemap-status)
;; Invert the V
(imgui-call Image treemap-texture treemap-texture-size (ImVec2 0 1) (ImVec2 1 0))
(when (= treemap-status treemap-running-state-working)
(imgui-call SetCursorScreenPos treemap-cursor-pos)
(imgui-call Text "Scanning... (%d entries)" num-entries-scanned)
(imgui-call SetCursorScreenPos treemap-cursor-pos)))
(imgui-call End)) ;; End Treemap
;; Annoying: Put down here to show up on top if it's the user's first time running the app
(when show-help-window
(when g-is-first-time-run
(imgui-call SetNextWindowFocus)
(set g-is-first-time-run false))
(imgui-first-time-window-size 0.3f 0.1f 0.4f 0.5f)
(when (imgui-call Begin "Help" (addr show-help-window))
(imgui-call End))
(set (field listing-state mouse-last-frame) mouse-button-state)
(memcpy (field listing-state keys-last-frame) key-states
(dynarray-length (field listing-state keys-last-frame))))
(body ;; Shut down
(time-this-scope scope-7 "User shut down")
(when g-should-save-load-user-config
(unless (save-state-s-expr)
(SDL_Log "error: failed to save state")))
;; We need to wait for all tasks to complete before we start destroying things they might be using
(destroy-directory-state (addr listing-state))
(strdict-free g-userdata-dict)
(dict-free g-categories-dict)
(each-item-in-dynarray directory-history i history-entry dynstring
(dynarray-free history-entry))
(dynarray-free directory-history)
(dynarray-free g-file-colorizers)
(free-treemap-file-system-multithreaded-state g-treemap-multithreaded-state)
(dynarray-free g-userdata-output-dir)))
;; Introspection helpers
(introspect-override-register-handler 'write-s-expr
(metadata-field-has-tag field "'category-key")
(var key-write (* category-key)
(offset-pointer-to-type struct-to-write value-offset (* category-key)))
(fprintf out-file " %d" (deref key-write))
(return true))
(introspect-override-register-handler 'read-s-expr
(metadata-field-has-tag field "'category-key")
(var key-read (* category-key)
(offset-pointer-to-type struct-out value-offset (* category-key)))
(set (deref key-read) (atoi value-argument-start))
(return true))
(introspect-override-register-handler 'compare
(metadata-field-has-tag field "'category-key")
(var key-a (* category-key)
(offset-pointer-to-type struct-a value-offset (* category-key)))
(var key-b (* category-key)
(offset-pointer-to-type struct-b value-offset (* category-key)))
(return (- (deref key-a) (deref key-b))))
;; TODO: Write the keybind name rather than the scancode
(introspect-override-register-handler 'write-s-expr
(metadata-field-has-tag field "'keybind")
(var keybind-write (* category-keybind)
(offset-pointer-to-type struct-to-write value-offset (* category-keybind)))
(fprintf out-file " %d" (deref keybind-write))
(return true))
(introspect-override-register-handler 'read-s-expr
(metadata-field-has-tag field "'keybind")
(var keybind-read (* category-keybind)
(offset-pointer-to-type struct-out value-offset (* category-keybind)))
(set (deref keybind-read) (atoi value-argument-start))
(return true))
(introspect-override-register-handler 'compare
(metadata-field-has-tag field "'keybind")
(var keybind-a (* category-keybind)
(offset-pointer-to-type struct-a value-offset (* category-keybind)))
(var keybind-b (* category-keybind)
(offset-pointer-to-type struct-b value-offset (* category-keybind)))
(return (- (deref keybind-a) (deref keybind-b))))
(introspect-override-register-handler 'free
(or (metadata-field-has-tag field "'category-key")
(metadata-field-has-tag field "'keybind"))
;; Building
;; Why didn't this work? C-linkage?
;; (defun main (argc int argv ([] (* char)) &return int)
;; (file-helper)
;; (return 0))
;; Hack to get around SDL2 main weirdness
(add-c-build-dependency "FileHelperMain.cpp")
(add-linker-options "/DEBUG:FASTLINK")
;; (add-build-options "/Zi" "/FS" "/DEBUG:FASTLINK")
;; (add-build-options-global #"#/DIMGUI_USER_CONFIG=ImGuiConfig.h#"#)
(set-cakelisp-option executable-output "file-helper.exe"))
(add-c-search-directory-global "src") ;; For ImGuiConfig.h
;; Set config in order to set ImGui texture handle to OpenGL format
(add-build-options-global #"#-DIMGUI_USER_CONFIG="ImGuiConfig.h"#"#)
(set-cakelisp-option executable-output "file-helper")))