├── .github └── workflows │ ├── build-macos.yml │ ├── build-ubuntu.yml │ └── build-windows.yml ├── .gitignore ├── README.md ├── build-macos ├── Info.plist └── build ├── example ├── clickable.janet └── minimal-hiccup.janet ├── freja ├── assets.janet ├── checkpoint.janet ├── code_api.janet ├── collision.janet ├── custom.janet ├── default-hotkeys.janet ├── default-layout.janet ├── defonce.janet ├── dumb.janet ├── echoer.janet ├── editor.janet ├── evaling.janet ├── event │ ├── callback.janet │ ├── default-subscriptions.janet │ ├── jaylib-to-events.janet │ └── subscribe.janet ├── file-explorer.janet ├── file-handling.janet ├── find-file.janet ├── find_row_etc.janet ├── flow.janet ├── fonts.janet ├── fonts │ ├── EBGaramond12-Regular.otf │ ├── EBGaramond12-Regular_LICENSE │ ├── FantasqueSansMono-Regular.otf │ ├── FantasqueSansMono-Regular_LICENSE │ ├── MplusCodeLatin60-Medium.otf │ ├── MplusCodeLatin60-Medium_LICENSE │ ├── Poppins-Regular.otf │ ├── Poppins-Regular_LICENSE │ ├── TamzenForPowerline10x20b.ttf │ └── TamzenForPowerline10x20b_LICENSE ├── handle-ext │ ├── init.janet │ └── janet.janet ├── hiccup.janet ├── highlighting.janet ├── input.janet ├── introspection.janet ├── keyboard.janet ├── main.janet ├── new_gap_buffer.janet ├── new_gap_buffer_util.janet ├── newest-menu.janet ├── open-file.janet ├── rainbow.janet ├── render_new_gap_buffer.janet ├── state.janet ├── text_rendering.c ├── text_rendering.janet ├── textarea.janet ├── textfield_api.janet ├── theme.janet ├── vector-math.janet └── version.janet ├── project.janet ├── test └── lul.janet └── usages ├── new_gap_buffer.janet ├── sample.janet ├── test_undo_redo.janet └── textual_representation_of_gap_buffer.janet /.github/workflows/build-macos.yml: -------------------------------------------------------------------------------- 1 | name: macOS Build 2 | on: [push] 3 | jobs: 4 | test: 5 | runs-on: macos-latest 6 | steps: 7 | - name: Install homebrew 8 | run: /bin/bash -c "$(curl -fsSL https://raw.githubusercontent.com/Homebrew/install/HEAD/install.sh)" 9 | - name: Install glfw 10 | run: brew install glfw 11 | - run: echo "🎉 The job was automatically triggered by a ${{ github.event_name }} event." 12 | - run: echo "🐧 This job is now running on a ${{ runner.os }} server hosted by GitHub!" 13 | - run: echo "🔎 The name of your branch is ${{ github.ref }} and your repository is ${{ github.repository }}." 14 | - run: cd ${{ github.workspace }} 15 | - name: Check out repository code 16 | uses: actions/checkout@v2 17 | - run: echo "💡 The ${{ github.repository }} repository has been cloned to the runner." 18 | - run: echo "🖥️ The workflow is now ready to test your code on the runner." 19 | - name: List files in the repository 20 | run: | 21 | ls ${{ github.workspace }} 22 | - name: Install janet 23 | run: cd ${{ github.workspace }} && git clone https://github.com/janet-lang/janet && cd janet && make && make test && sudo make install && sudo make install-jpm-git 24 | - name: test 25 | run: cd ${{ github.workspace }} && sudo FREJA_TEST=true jpm deps && jpm test 26 | build: 27 | needs: test 28 | runs-on: macos-latest 29 | steps: 30 | - name: Install homebrew 31 | run: /bin/bash -c "$(curl -fsSL https://raw.githubusercontent.com/Homebrew/install/HEAD/install.sh)" 32 | - name: Install glfw 33 | run: brew install glfw 34 | - run: echo "🎉 The job was automatically triggered by a ${{ github.event_name }} event." 35 | - run: echo "🐧 This job is now running on a ${{ runner.os }} server hosted by GitHub!" 36 | - run: echo "🔎 The name of your branch is ${{ github.ref }} and your repository is ${{ github.repository }}." 37 | - run: cd ${{ github.workspace }} 38 | - name: Check out repository code 39 | uses: actions/checkout@v2 40 | - run: echo "💡 The ${{ github.repository }} repository has been cloned to the runner." 41 | - run: echo "🖥️ The workflow is now ready to test your code on the runner." 42 | - name: List files in the repository 43 | run: | 44 | ls ${{ github.workspace }} 45 | - name: Install janet 46 | run: cd ${{ github.workspace }} && git clone https://github.com/janet-lang/janet && cd janet && make && make test && sudo make install && sudo make install-jpm-git 47 | - run: cd ${{ github.workspace }} && sudo FREJA_TEST=false jpm deps 48 | - name: jpm build 49 | run: cd ${{ github.workspace }} && jpm build 50 | - run: cd ${{ github.workspace }} && ./build-macos/build 51 | - run: echo "🍏 This job's status is ${{ job.status }}." 52 | - name: Remove release 53 | run: gh release delete -y macos-prerelease 54 | continue-on-error: true 55 | env: 56 | GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }} 57 | - name: Create release 58 | run: gh release create macos-prerelease freja.zip 59 | env: 60 | GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }} 61 | -------------------------------------------------------------------------------- /.github/workflows/build-ubuntu.yml: -------------------------------------------------------------------------------- 1 | name: Ubuntu Build 2 | on: [push] 3 | jobs: 4 | test: 5 | runs-on: ubuntu-latest 6 | steps: 7 | - run: sudo apt-get update 8 | - run: sudo apt-get -y install libglfw3-dev libasound2-dev mesa-common-dev libx11-dev libxrandr-dev libxi-dev xorg-dev libgl1-mesa-dev libglu1-mesa-dev 9 | - run: echo "🎉 The job was automatically triggered by a ${{ github.event_name }} event." 10 | - run: echo "🐧 This job is now running on a ${{ runner.os }} server hosted by GitHub!" 11 | - run: echo "🔎 The name of your branch is ${{ github.ref }} and your repository is ${{ github.repository }}." 12 | - run: cd ${{ github.workspace }} 13 | - name: Check out repository code 14 | uses: actions/checkout@v2 15 | - run: echo "💡 The ${{ github.repository }} repository has been cloned to the runner." 16 | - run: echo "🖥️ The workflow is now ready to test your code on the runner." 17 | - name: List files in the repository 18 | run: | 19 | ls ${{ github.workspace }} 20 | - name: Install janet 21 | run: cd ${{ github.workspace }} && git clone https://github.com/janet-lang/janet && cd janet && make && make test && sudo make install && sudo make install-jpm-git 22 | - name: test 23 | run: cd ${{ github.workspace }} && sudo FREJA_TEST=true jpm deps && jpm test 24 | build: 25 | needs: test 26 | runs-on: ubuntu-latest 27 | steps: 28 | - run: sudo apt-get update 29 | - run: sudo apt-get -y install libglfw3-dev libasound2-dev mesa-common-dev libx11-dev libxrandr-dev libxi-dev xorg-dev libgl1-mesa-dev libglu1-mesa-dev 30 | - run: echo "🎉 The job was automatically triggered by a ${{ github.event_name }} event." 31 | - run: echo "🐧 This job is now running on a ${{ runner.os }} server hosted by GitHub!" 32 | - run: echo "🔎 The name of your branch is ${{ github.ref }} and your repository is ${{ github.repository }}." 33 | - run: cd ${{ github.workspace }} 34 | - name: Check out repository code 35 | uses: actions/checkout@v2 36 | - run: echo "💡 The ${{ github.repository }} repository has been cloned to the runner." 37 | - run: echo "🖥️ The workflow is now ready to test your code on the runner." 38 | - name: List files in the repository 39 | run: | 40 | ls ${{ github.workspace }} 41 | - name: Install janet 42 | run: cd ${{ github.workspace }} && git clone https://github.com/janet-lang/janet && cd janet && make && make test && sudo make install && sudo make install-jpm-git 43 | - name: jpm deps 44 | run: cd ${{ github.workspace }} && sudo jpm deps 45 | - name: jpm build 46 | run: jpm build 47 | - name: run --help 48 | run: cd ${{ github.workspace }} && ./build/freja --help 49 | - name: Remove release 50 | run: gh release delete -y ubuntu-prerelease 51 | continue-on-error: true 52 | env: 53 | GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }} 54 | - name: Create release 55 | run: gh release create ubuntu-prerelease build/freja 56 | env: 57 | GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }} 58 | -------------------------------------------------------------------------------- /.github/workflows/build-windows.yml: -------------------------------------------------------------------------------- 1 | name: Windows Build 2 | on: [push] 3 | jobs: 4 | test: 5 | runs-on: windows-latest 6 | steps: 7 | - name: Setup MSVC 8 | uses: ilammy/msvc-dev-cmd@v1 9 | - run: echo "🎉 The job was automatically triggered by a ${{ github.event_name }} event." 10 | - run: echo "🐧 This job is now running on a ${{ runner.os }} server hosted by GitHub!" 11 | - run: echo "🔎 The name of your branch is ${{ github.ref }} and your repository is ${{ github.repository }}." 12 | - run: cd ${{ github.workspace }} 13 | - name: Check out repository code 14 | uses: actions/checkout@v2 15 | - run: echo "💡 The ${{ github.repository }} repository has been cloned to the runner." 16 | - run: echo "🖥️ The workflow is now ready to test your code on the runner." 17 | - name: List files in the repository 18 | run: | 19 | ls ${{ github.workspace }} 20 | - name: Clone janet 21 | run: cd ${{ github.workspace }} && git clone https://github.com/janet-lang/janet && cd janet 22 | #- run: cd ${{ github.workspace }}/janet && build_win all 23 | # shell: cmd 24 | - run: cd ${{ github.workspace }}/janet && build_win all 25 | shell: cmd 26 | #- run: cd ${{ github.workspace }}/janet && build_win test 27 | # shell: cmd 28 | - name: List files in janet build 29 | run: | 30 | ls ${{ github.workspace }}/janet/build 31 | - run: mkdir ${{ github.workspace }}\janet\bin 32 | - run: mv ${{ github.workspace }}\janet\janet.exe ${{ github.workspace }}\janet\bin 33 | - run: "echo \"${{ github.workspace }}\\janet\\bin\" | Out-File -FilePath $env:GITHUB_PATH -Encoding utf8 -Append" 34 | # might be we could use this instead... 35 | #- run: "echo \"$env:USERPROFILE\\janet\\bin\" | Out-File -FilePath $env:GITHUB_PATH -Encoding utf8 -Append" 36 | - run: echo %PATH% 37 | shell: cmd 38 | - run: echo %PATH% 39 | shell: cmd 40 | - run: dir ${{ github.workspace }}\janet\dist 41 | continue-on-error: true 42 | shell: cmd 43 | - run: dir ${{ github.workspace }}\janet\build 44 | continue-on-error: true 45 | shell: cmd 46 | - run: dir ${{ github.workspace }}\janet 47 | continue-on-error: true 48 | shell: cmd 49 | - run: echo %PATH% 50 | shell: cmd 51 | - run: janet -v 52 | continue-on-error: true 53 | - name: Install jpm 54 | run: cd ${{ github.workspace }} && git clone https://github.com/janet-lang/jpm 55 | shell: cmd 56 | - run: cd ${{ github.workspace }}\jpm && set JANET_HEADERPATH=${{ github.workspace }}\janet\dist&& set JANET_BINPATH=${{ github.workspace }}\janet\bin&& set JANET_LIBPATH=${{ github.workspace }}\janet\dist&& set JANET_PATH=${{ github.workspace }}\janet&& janet bootstrap.janet 57 | shell: cmd 58 | - name: test 59 | run: cd ${{ github.workspace }} && set FREJA_TEST=true&& jpm deps && jpm test 60 | build: 61 | needs: test 62 | runs-on: windows-latest 63 | steps: 64 | - name: Setup MSVC 65 | uses: ilammy/msvc-dev-cmd@v1 66 | - run: echo "🎉 The job was automatically triggered by a ${{ github.event_name }} event." 67 | - run: echo "🐧 This job is now running on a ${{ runner.os }} server hosted by GitHub!" 68 | - run: echo "🔎 The name of your branch is ${{ github.ref }} and your repository is ${{ github.repository }}." 69 | - run: cd ${{ github.workspace }} 70 | - name: Check out repository code 71 | uses: actions/checkout@v2 72 | - run: echo "💡 The ${{ github.repository }} repository has been cloned to the runner." 73 | - run: echo "🖥️ The workflow is now ready to test your code on the runner." 74 | - name: List files in the repository 75 | run: | 76 | ls ${{ github.workspace }} 77 | - name: Clone janet 78 | run: cd ${{ github.workspace }} && git clone https://github.com/janet-lang/janet && cd janet 79 | #- run: cd ${{ github.workspace }}/janet && build_win all 80 | # shell: cmd 81 | - run: cd ${{ github.workspace }}/janet && build_win all 82 | shell: cmd 83 | #- run: cd ${{ github.workspace }}/janet && build_win test 84 | # shell: cmd 85 | - name: List files in janet build 86 | run: | 87 | ls ${{ github.workspace }}/janet/build 88 | - run: mkdir ${{ github.workspace }}\janet\bin 89 | - run: mv ${{ github.workspace }}\janet\janet.exe ${{ github.workspace }}\janet\bin 90 | - run: "echo \"${{ github.workspace }}\\janet\\bin\" | Out-File -FilePath $env:GITHUB_PATH -Encoding utf8 -Append" 91 | # might be we could use this instead... 92 | #- run: "echo \"$env:USERPROFILE\\janet\\bin\" | Out-File -FilePath $env:GITHUB_PATH -Encoding utf8 -Append" 93 | - run: echo %PATH% 94 | shell: cmd 95 | - run: echo %PATH% 96 | shell: cmd 97 | - run: dir ${{ github.workspace }}\janet\dist 98 | continue-on-error: true 99 | shell: cmd 100 | - run: dir ${{ github.workspace }}\janet\build 101 | continue-on-error: true 102 | shell: cmd 103 | - run: dir ${{ github.workspace }}\janet 104 | continue-on-error: true 105 | shell: cmd 106 | - run: echo %PATH% 107 | shell: cmd 108 | - run: janet -v 109 | continue-on-error: true 110 | - name: Install jpm 111 | run: cd ${{ github.workspace }} && git clone https://github.com/janet-lang/jpm 112 | shell: cmd 113 | - run: cd ${{ github.workspace }}\jpm && set JANET_HEADERPATH=${{ github.workspace }}\janet\dist&& set JANET_BINPATH=${{ github.workspace }}\janet\bin&& set JANET_LIBPATH=${{ github.workspace }}\janet\dist&& set JANET_PATH=${{ github.workspace }}\janet&& janet bootstrap.janet 114 | shell: cmd 115 | - name: jpm deps 116 | run: cd ${{ github.workspace }} && jpm deps 117 | shell: cmd 118 | - name: jpm build 119 | run: jpm build 120 | shell: cmd 121 | - run: echo "🍏 This job's status is ${{ job.status }}." 122 | - name: Remove release 123 | run: gh release delete -y windows-prerelease 124 | continue-on-error: true 125 | env: 126 | GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }} 127 | - name: Create release 128 | run: gh release create windows-prerelease build/freja.exe 129 | env: 130 | GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }} 131 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | /build 2 | /judge 3 | 4 | /text_experiment_dump 5 | 6 | .DS_Store 7 | /.janet-usages 8 | /.judge 9 | /init.janet 10 | /janet_libs 11 | /jpm_tree -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # freja 2 | 3 | Self-modifiable text editor implemented in Janet. 4 | 5 | ## social 6 | 7 | [![image](https://user-images.githubusercontent.com/2477927/138828275-273ca9a8-b531-41ba-b387-0918c19b5489.png) 8 | Join us on Discord!](https://discord.gg/YYKr25uDhj) 9 | 10 | ## status 11 | 12 | Freja is in beta. 13 | It's stable, and crashes are rare. Files are backed up on opening / closing, so it's hard to lose work. 14 | 15 | Some functions are missing (autocomplete when opening files, changing between files quickly). 16 | There is currently an issue on Windows that makes it hard to evaluate code inside Freja. 17 | 18 | Currently mostly usable for Janet, no other language specific tooling. 19 | It works as a regular text editor, so I write C in Freja. 20 | 21 | ## try it 22 | 23 | ### prerequisites 24 | 25 | * Janet -- https://janet-lang.org/ 26 | * needs to use this commit or later: `04ca945ecf0598e069caadb35a3c3089187a8186` 27 | * on newer versions of janet, you need to install jpm separately: 28 | * https://github.com/janet-lang/jpm 29 | * libglfw3-dev 30 | * (X)ubuntu: `sudo apt-get install libglfw3-dev` 31 | * Raylib dependencies -- https://github.com/raysan5/raylib#installing-and-building-raylib-on-multiple-platforms 32 | 33 | ### installation 34 | 35 | ``` 36 | [sudo] jpm install https://github.com/Saikyun/freja 37 | ``` 38 | 39 | If you get an old version, try running `[sudo] jpm clear-cache` before re-running the above command. 40 | 41 | ### steps to run from source 42 | 43 | ``` 44 | git clone https://github.com/Saikyun/freja 45 | cd freja 46 | sudo jpm deps 47 | jpm build 48 | janet freja/main.janet 49 | ``` 50 | 51 | NOTE: When running freja from source, you must start it from the project directory. 52 | If you start it from another directory, you will get errors like: 53 | `could not open file fonts/MplusCodeLatin60-Medium.otf` 54 | 55 | If you want to run freja anywhere, it's better to `jpm install` it, or `jpm build` it. 56 | 57 | If you want to use PREFIX as to not litter system wide libs, check out [sogaiu's post about it](https://github.com/saikyun/freja/issues/30#issuecomment-907937626). 58 | 59 | ### Some examples 60 | 61 | ``` 62 | # | is the cursor 63 | 1 2| 3 64 | # hit Ctrl+Enter 65 | #=> 2 66 | 67 | "a b c"| 68 | # Ctrl+Enter 69 | #=> "a b c" 70 | 71 | "a b| c" 72 | # Ctrl+Enter 73 | #=> b is undefined 74 | 75 | (+ 1 2 3)| 76 | # Ctrl+Enter 77 | #=> 6 78 | ``` 79 | This can be very useful when trying to run example code in files, 80 | or just play around with the code. 81 | 82 | The main way to use this is to open a file, hit `Ctrl+L` 83 | which will make Freja look at the environment of that file. 84 | Successive calls to `Ctrl+Enter` and `Ctrl+L` will then act in that environment. 85 | 86 | 87 | ## Evaluation environment 88 | 89 | Whenever you run hit `Ctrl+L` you run `freja/file_handling/save-and-dofile`. 90 | This saves the file, and then runs the file using a variant of janet's `dofile`. 91 | This leads to a new environment table being created (using `make-env`). 92 | This environment table is then used whenever you hit `Ctrl+Enter`, 93 | which calls `freja/input/eval-it`. 94 | `eval-it` will run the code to the left of the cursor, specifically, 95 | a symbol, keyword, string, number, struct, table, tuple (including a function call), or array. 96 | 97 | ## Thanks 98 | 99 | Thanks to sogaiu and rhine for initial testing. <3 100 | 101 | ## License 102 | 103 | Copyright 2020 Jona Ekenberg 104 | 105 | Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: 106 | 107 | The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. 108 | 109 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 110 | -------------------------------------------------------------------------------- /build-macos/Info.plist: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | CFBundleDisplayName 6 | Freja 7 | CFBundleExecutable 8 | freja 9 | CFBundleIdentifier 10 | saikyun.freja 11 | CFBundleName 12 | Freja 13 | 14 | 15 | -------------------------------------------------------------------------------- /build-macos/build: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | mkdir Freja.app 3 | mkdir Freja.app/Contents 4 | mkdir Freja.app/Contents/MacOS 5 | cp build/freja Freja.app/Contents/MacOS 6 | chmod 755 Freja.app/Contents/MacOS/freja 7 | cp build-macos/Info.plist Freja.app/Contents/ 8 | ditto -c -k --keepParent Freja.app freja.zip 9 | -------------------------------------------------------------------------------- /example/clickable.janet: -------------------------------------------------------------------------------- 1 | (import freja/frp) 2 | (import freja/hiccup :as h) 3 | (import freja/events :as e) 4 | (use freja/defonce) 5 | 6 | (def props @{:label "Click me"}) 7 | 8 | (defn hiccup 9 | [props & _] 10 | [:padding {:left 600 11 | :top 30} 12 | [:background {:color :white} 13 | [:clickable 14 | {:on-click (fn [_] 15 | (e/put! props :label 16 | (string "Different label " (math/random))))} 17 | (props :label)]]]) 18 | 19 | (h/new-layer :pixel-editor 20 | hiccup 21 | props 22 | :text/size 22) 23 | -------------------------------------------------------------------------------- /example/minimal-hiccup.janet: -------------------------------------------------------------------------------- 1 | (import freja/hiccup :as h) 2 | (use freja/defonce) 3 | 4 | (defonce props @{}) 5 | 6 | (defn hiccup 7 | [props & _] 8 | [:padding {:left 600 9 | :top 30} 10 | [:background {:color :white} 11 | "hello"]]) 12 | 13 | (setdyn :pretty-format "%.40M") 14 | 15 | (h/new-layer :pixel-editor 16 | hiccup 17 | props 18 | :text/size 22) 19 | -------------------------------------------------------------------------------- /freja/assets.janet: -------------------------------------------------------------------------------- 1 | (use freja-jaylib) 2 | (import spork/path) 3 | (import ./fonts :as f) 4 | 5 | # TODO: probably should be defonce 6 | (def assets @{}) 7 | 8 | # TODO: probably should be defonce 9 | (def fonts @{}) 10 | 11 | (comment 12 | fonts 13 | #=> 14 | @{"Texturina" @{20 ... 15 | 22 ... 16 | :path "..." 17 | :data "..."}} 18 | # 19 | ) 20 | 21 | (defn asset 22 | ``` 23 | Gets asset if it's loaded, 24 | or loads the asset, puts it in assets, then returns it. 25 | ``` 26 | [path] 27 | (if-let [a (assets path)] 28 | a 29 | (let [data (slurp path)] 30 | (put assets path data) 31 | data))) 32 | 33 | (defn register-font 34 | `` 35 | Puts a font in the fonts assets, 36 | this makes it available for usage with a simple font name, 37 | rather than having to load the font manually. 38 | `` 39 | [name &keys {:path path 40 | :data data 41 | :ext ext 42 | 43 | :style style 44 | :default-style default-style}] 45 | 46 | (assert (or path (and data ext)) "Need :path or :data and :ext") 47 | 48 | (default style :unspecified) 49 | (default default-style (get-in fonts 50 | [name :default-style] 51 | style)) 52 | 53 | (def data (if data data (asset path))) 54 | 55 | (update fonts name 56 | |(-> (or $ @{}) 57 | (update style |(-> (or $ @{}) 58 | (put :ext (or ext (path/ext path))) 59 | (put :path path) 60 | (put :data data))) 61 | (put :default-style default-style) 62 | (update :styles |(put (or $ @{}) style style))))) 63 | 64 | (defn load-font-with-size 65 | `` 66 | Loads a font with a registered name and a size. 67 | Puts the loaded font into the `assets/fonts` table. 68 | Returns the loaded font. 69 | 70 | The font must already be registered using `register-font`. 71 | `` 72 | [name size &keys {:style style}] 73 | (def font-info (fonts name)) 74 | 75 | (assert font-info (string "font with name " name " is not registered, use `register-font` first")) 76 | 77 | (default style (font-info :default-style)) 78 | 79 | (assert (font-info style) 80 | (string "font with name " name 81 | " does not have style " style 82 | " registered, use `register-font` first.\n" 83 | "the currently available styles are: " 84 | (string/format "%.40M" (keys (font-info :styles))) 85 | "\nthe default style is: " 86 | (font-info :default-style))) 87 | 88 | # if the fonts exists, unload it 89 | (when-let [existing-font (get-in font-info [style size])] 90 | (unload-font existing-font)) 91 | 92 | (def lf (f/default-load-font-from-memory 93 | (get-in font-info [style :ext]) 94 | (get-in font-info [style :data]) 95 | size)) 96 | 97 | (put-in fonts [name style size] lf) 98 | (put-in fonts [name style :glyph-sizes size] 99 | (f/default-glyphs->size-struct lf size)) 100 | (update-in fonts [name style :sizes] |(array/push (or $ @[]) size)) 101 | 102 | lf) 103 | 104 | (defn font-info 105 | [name] 106 | `` 107 | Shows information about a font, such as which styles are loaded and at which sizes. 108 | `` 109 | (var info @{}) 110 | (def styles (get-in fonts [name :styles])) 111 | (loop [[k v] :in (pairs (fonts name))] 112 | 113 | (if (styles k) 114 | (->> (from-pairs (seq [[k v] :in (pairs v) 115 | :when (not= k :data)] # we hide the data since it's so much bloat 116 | [k v])) 117 | (put info k)) 118 | (put info k v))) 119 | info) 120 | 121 | (import spork/test) 122 | 123 | (defn font 124 | `` 125 | Given a font `name` and `size`, returns the loaded font to be used with jaylib font rendering. 126 | 127 | To get information about a font (e.g. loaded styles), use `font-info`. 128 | 129 | ## Optional keys 130 | 131 | `:style` -- choose style such as `:regular` or `:italic` 132 | Leaving `:style` empty will use the `:default-style` for the font. 133 | `` 134 | [name size &keys {:style style}] 135 | (def font (fonts name)) 136 | 137 | (assert font 138 | (string "font with name " name " is not registered, use `register-font` first")) 139 | 140 | (default style (font :default-style)) 141 | 142 | (or (get-in font [style size]) 143 | (load-font-with-size name size :style style))) 144 | 145 | (defn glyph-sizes 146 | `` 147 | Given a font `name` and `size`, returns a table with each glyph and their size for the given font. 148 | 149 | To get information about a font (e.g. loaded styles), use `font-info`. 150 | 151 | ## Optional keys 152 | 153 | `:style` -- choose style such as `:regular` or `:italic` 154 | Leaving `:style` empty will use the `:default-style` for the font. 155 | `` 156 | [name size &keys {:style style}] 157 | (def font (fonts name)) 158 | 159 | (assert font 160 | (string "font with name " name " is not registered, use `register-font` first")) 161 | 162 | (default style (font :default-style)) 163 | 164 | (or (get-in font [style :glyph-sizes size]) 165 | (do (load-font-with-size name size :style style) 166 | (get-in font [style :glyph-sizes size])))) 167 | 168 | (comment 169 | (do 170 | (register-font "Poppins" 171 | :style :regular 172 | :path "../freja/fonts/Poppins-Regular.otf") 173 | (font "Poppins" 22 :style :regular)) 174 | 175 | (get-in @{:regular @{22 "a"}} [:regular 22] "b") 176 | 177 | (font-info "Poppins") 178 | # 179 | ) 180 | 181 | 182 | (defn register-default-fonts 183 | [] 184 | (register-font "Poppins" 185 | :style :regular 186 | :ext ".otf" 187 | :data f/poppins) 188 | 189 | (register-font "MplusCode" 190 | :style :regular 191 | :ext ".otf" 192 | :data f/mplus) 193 | 194 | (register-font "EBGaramond" 195 | :style :regular 196 | :ext ".otf" 197 | :data f/ebgaramond)) 198 | 199 | -------------------------------------------------------------------------------- /freja/checkpoint.janet: -------------------------------------------------------------------------------- 1 | (import spork/path) 2 | (import ./file-handling) 3 | (import freja/state) 4 | (import freja/event/subscribe :as s) 5 | (import freja/theme) 6 | (import freja/file-handling :as fh) 7 | (import freja/render_new_gap_buffer :as rgb) 8 | 9 | (varfn checkpoint-date 10 | [] 11 | (let [{:year year 12 | :month month 13 | :month-day month-day} (os/date)] 14 | (string/format "%04d-%02d-%02d" year month month-day))) 15 | 16 | (varfn checkpoint-time 17 | [] 18 | (let [{:hours hours 19 | :minutes minutes 20 | :seconds seconds} (os/date)] 21 | (string/format "%02d_%02d_%02d" hours minutes seconds))) 22 | 23 | (varfn path->checkpoint-dir 24 | [path] 25 | (let [path (path/abspath path) 26 | # need to do this on windows for e.g. `C:` 27 | path (string/replace-all ":" "_COLON_" path) 28 | parts (path/parts path) 29 | root-checkpoints-dir (file-handling/data-path "checkpoints") 30 | checkpoint-dir 31 | (path/join root-checkpoints-dir 32 | ;(array/slice parts 0 -2) 33 | (string ".freja-checkpoint-" (last parts)))] 34 | checkpoint-dir)) 35 | 36 | (comment 37 | # 38 | (path->checkpoint-dir "aoeu") 39 | # 40 | ) 41 | 42 | (varfn save-checkpoint 43 | [path note] 44 | # only allow characters that are OK in a path 45 | # TODO: remove more non-ok characters 46 | (let [note (string/replace-all path/sep "_SLASH_" note) 47 | note (string/replace-all ":" "_COLON_" note) 48 | checkpoint-dir (path->checkpoint-dir path) 49 | day-dir (string checkpoint-dir path/sep (checkpoint-date)) 50 | checkpoint-path (string day-dir path/sep (checkpoint-time) " " note)] 51 | 52 | (reduce (fn [acc cur] 53 | (if-not acc 54 | cur 55 | (let [new (string acc path/sep cur)] 56 | (os/mkdir new) 57 | new))) 58 | nil 59 | (string/split path/sep day-dir)) 60 | 61 | (with [f (file/open checkpoint-path :wn)] 62 | (with [org-f (file/open path :rn)] 63 | (def content (file/read org-f :all)) 64 | (file/write f content))) 65 | 66 | (printf "Saved checkpoint: %s" (last (string/split path/sep path))))) 67 | 68 | (varfn list-checkpoints 69 | [path] 70 | (let [checkpoint-dir (path->checkpoint-dir path)] 71 | (var days-times @[]) 72 | (loop [dir :in (os/dir checkpoint-dir) 73 | :let [full-dir (string checkpoint-dir path/sep dir)]] 74 | (array/push days-times [dir 75 | (seq [file :in (os/dir full-dir)] 76 | (string full-dir path/sep file))])) 77 | days-times)) 78 | 79 | 80 | (comment 81 | 82 | (use freja/state) 83 | (-> 84 | (get-in state/editor-state [:stack 0 1 :editor :gb :path]) 85 | list-checkpoints) 86 | # 87 | ) 88 | 89 | (varfn format-filename 90 | [filename] 91 | (def peg 92 | ~{:time (/ (* ':d ':d "_") 93 | ,(fn [d1 d2] (string d1 d2 ":"))) 94 | :main (* :time :time ':d ':d '(any 1))}) 95 | (string ;(peg/match peg filename))) 96 | 97 | (comment 98 | (format-filename "15_56_56 ueoh") 99 | 100 | # 101 | ) 102 | 103 | 104 | (defn save-file-with-checkpoint 105 | [props &opt note] 106 | (def path (props :path)) 107 | (default note "manual save") 108 | 109 | (fh/save-file props) 110 | (save-checkpoint path note)) 111 | 112 | (varfn load-file-with-checkpoints 113 | [props path] 114 | # this happens on first opening freja, so there might not be a preexisting path 115 | (when (get-in props [:gb :path]) 116 | (save-file-with-checkpoint (props :gb) (string "before opening " path))) 117 | 118 | (fh/load-file props path) 119 | 120 | # only save a checkpoint if there actually was a file here 121 | (when (os/stat path) 122 | (save-checkpoint path "after opening"))) 123 | 124 | (varfn checkpoint-list 125 | [props] 126 | (def {:path path 127 | :textarea textarea 128 | :selected selected 129 | :close close} props) 130 | 131 | [:background {:color (theme/colors :background)} 132 | [:padding {:all 6} 133 | [:block {} 134 | [:padding {:bottom 6} 135 | [:block {} 136 | [:clickable {:on-click (fn [_] (close))} 137 | [:text {:text "Close" 138 | :color (theme/colors :text)}]]] 139 | [:text {:text "Checkpoints" 140 | :color (theme/colors :text) 141 | :size 28}]]] 142 | 143 | (try 144 | (let [checkpoints (or (-?> path list-checkpoints) [])] 145 | [:block {} 146 | [:block {} 147 | [:padding {:bottom 12} 148 | [:text {:text (string 149 | "Click on checkpoints below to restore earlier versions of:\n" 150 | (path/abspath (tracev path))) 151 | :color (theme/colors :text) 152 | :size 18}]]] 153 | ;(seq [[day times] :in (reverse (sort-by first checkpoints))] 154 | [:padding {:bottom 12} 155 | [:block {} 156 | [:text {:size 22 157 | :color (theme/colors :text) 158 | :text (string day)}] 159 | ;(seq [fullpath :in (reverse (sort times))] 160 | [:clickable {:on-click 161 | (fn [_] 162 | (when (props :needs-save) 163 | (save-file-with-checkpoint (in textarea :gb) "before moving to checkpoint") 164 | (:put props :needs-save false)) 165 | (fh/load-file textarea 166 | fullpath) 167 | (put-in textarea [:gb :path] path) 168 | (:put props :selected fullpath))} 169 | [:block {} 170 | [:background {:color (when (= selected fullpath) 171 | (theme/colors :text))} 172 | [:text {:size 18 173 | :color (if (= selected fullpath) 174 | (theme/colors :background) 175 | (theme/colors :text)) 176 | :text (format-filename (path/basename fullpath))}]]]])]])]) 177 | ([err fib] 178 | (debug/stacktrace fib err "") 179 | (if (and (string? err) 180 | (peg/find "cannot open directory" err)) 181 | (string err "\n\nthis might be due to no checkpoints existing") 182 | err)))]]) 183 | 184 | (defn checkpoint-component 185 | [props] 186 | (unless (props :checkpoint-props) 187 | (let [left-state (get-in state/editor-state [:stack 0 1]) 188 | checkpoint-props 189 | @{:path (get-in left-state [:editor :gb :path]) 190 | :textarea (left-state :editor) 191 | :needs-save true 192 | :close (fn [] 193 | (put props :checkpoint-props nil) 194 | (s/put! state/editor-state :right nil))}] 195 | 196 | (put checkpoint-props :put 197 | (fn [self k v] 198 | (s/update! props :checkpoint-props put k v))) 199 | 200 | (put props :checkpoint-props checkpoint-props))) 201 | 202 | [:block {} [checkpoint-list (props :checkpoint-props)]]) 203 | 204 | (varfn show-checkpoints 205 | [] 206 | (if-not (= (state/editor-state :right) checkpoint-component) 207 | (s/put! state/editor-state :right checkpoint-component) 208 | (do (put state/editor-state :checkpoint-props nil) 209 | (s/put! state/editor-state :right nil)))) 210 | 211 | #(save-checkpoint "checkpoint.janet") 212 | (comment 213 | # 214 | (do 215 | (show-checkpoints) 216 | :ok) 217 | (list-checkpoints "freja/checkpoint.janet") 218 | # 219 | ) 220 | #(overwrite-checkpoint "checkpoint.janet") 221 | 222 | -------------------------------------------------------------------------------- /freja/code_api.janet: -------------------------------------------------------------------------------- 1 | (import spork/fmt) 2 | (import ./new_gap_buffer :prefix "") 3 | 4 | (varfn format-code 5 | [gb] 6 | (-> gb commit!) 7 | (def {:caret caret 8 | :text text} gb) 9 | (def new-text (fmt/format text)) 10 | (replace-content gb new-text) 11 | (put-caret gb caret)) 12 | -------------------------------------------------------------------------------- /freja/collision.janet: -------------------------------------------------------------------------------- 1 | (varfn in-rec? 2 | [[px py] [x y w h]] 3 | (and 4 | (>= px x) 5 | (<= px (+ x w)) 6 | (>= py y) 7 | (<= py (+ y h)))) 8 | -------------------------------------------------------------------------------- /freja/custom.janet: -------------------------------------------------------------------------------- 1 | (import freja-layout/default-tags :as dt) 2 | (import freja/state) 3 | (import freja/events :as e) 4 | (import freja/assets :as a) 5 | (import freja/text_rendering :as tr) 6 | 7 | (defn draw-text 8 | [text pos &keys {:size size 9 | :font font 10 | :spacing spacing 11 | :color color}] 12 | (default size 22) 13 | (default font "EBGaramond") 14 | (default spacing 1) 15 | (default color 0x000000ee) 16 | (keys a/fonts) 17 | (def font (if (keyword? font) 18 | (case font 19 | :monospace "MplusCode" 20 | :serif "EBGaramond" 21 | :sans-serif "Poppins" 22 | (error (string/format `` 23 | font must either be: 24 | * keyword :monospace, :serif or :sans-serif 25 | * string corresponding to a loaded font: %p 26 | `` 27 | (keys a/fonts)))) 28 | font)) 29 | 30 | (def font (a/font font size)) 31 | (tr/draw-text* font 32 | (if (string? text) 33 | text 34 | (string/format "%p" text)) 35 | pos 36 | size 37 | spacing 38 | color)) 39 | 40 | (defn custom 41 | [props] 42 | (def {:render render 43 | :on-event on-event} props) 44 | 45 | (-> (dyn :element) 46 | (dt/add-default-props props) 47 | (merge-into 48 | @{:children [] 49 | 50 | :relative-sizing 51 | (fn [el max-width max-height] 52 | (-> el 53 | (put :width (max (or (el :preset-width) max-width))) 54 | (put :height (or (el :preset-height) 55 | max-height)) 56 | (put :content-width (el :width)) 57 | (put :layout/lines nil)) 58 | 59 | el) 60 | 61 | :render (fn [self parent-x parent-y] 62 | (put self :focused? (= self (in state/focus :focus))) 63 | 64 | (put self :render-x parent-x) 65 | (put self :render-y parent-y) 66 | 67 | (render self)) 68 | 69 | :on-event (fn [self ev] 70 | (defn unfocus 71 | [] 72 | (put-in state/editor-state 73 | [:left-state :editor :gb :blink] 0) 74 | (e/put! state/focus :focus 75 | (get-in state/editor-state 76 | [:left-state :editor]))) 77 | 78 | (match ev 79 | [:key-down :escape] 80 | (unfocus) 81 | 82 | [(_ (or (= (ev 0) :press) 83 | (= (ev 0) :mouse-move))) 84 | _] 85 | (do 86 | (e/put! state/focus :focus self) 87 | (e/put! state/editor-state :right-focus true))) 88 | 89 | (when on-event 90 | (on-event ev)))}))) 91 | -------------------------------------------------------------------------------- /freja/default-hotkeys.janet: -------------------------------------------------------------------------------- 1 | (import freja/new_gap_buffer :as gb) 2 | (import freja/render_new_gap_buffer :as render-gb) 3 | (import ./code_api) 4 | (import freja/state) 5 | (import freja/file-handling :as fh) 6 | (import freja/input) 7 | (import freja/checkpoint) 8 | (import ./echoer) 9 | (import ./evaling) 10 | (import ./open-file) 11 | (import ./find-file) 12 | (import ./file-explorer) 13 | 14 | (import freja/event/subscribe :as s) 15 | 16 | (varfn reset-blink 17 | [props] 18 | (put props :blink 0)) 19 | 20 | (def undo!2 (comp reset-blink gb/undo!)) 21 | (def paste! (comp reset-blink gb/paste!)) 22 | (def cut! (comp reset-blink gb/cut!)) 23 | (def redo! (comp reset-blink gb/redo!)) 24 | (def format! (comp reset-blink code_api/format-code)) 25 | (def select-backward-word (comp reset-blink gb/select-backward-word)) 26 | (def select-forward-word (comp reset-blink gb/select-forward-word)) 27 | (def delete-word-backward! (comp reset-blink gb/delete-word-backward!)) 28 | (def delete-word-forward! (comp reset-blink gb/delete-word-forward!)) 29 | (def backward-word (comp reset-blink gb/backward-word)) 30 | (def forward-word (comp reset-blink gb/forward-word)) 31 | (def select-backward-char (comp reset-blink gb/select-backward-char)) 32 | (def select-forward-char (comp reset-blink gb/select-forward-char)) 33 | (def backward-char (comp reset-blink gb/backward-char)) 34 | (def forward-char (comp reset-blink gb/forward-char)) 35 | (def move-to-start-of-line (comp reset-blink render-gb/move-to-start-of-line)) 36 | (def move-to-end-of-line (comp reset-blink render-gb/move-to-end-of-line)) 37 | (def delete-after-caret! (comp reset-blink gb/delete-after-caret!)) 38 | (def delete-before-caret! (comp reset-blink gb/delete-before-caret!)) 39 | (def move-up! (comp reset-blink |(render-gb/move-up! $))) 40 | (def move-down! (comp reset-blink render-gb/move-down!)) 41 | (def page-up! render-gb/page-up!) 42 | (def page-down! render-gb/page-down!) 43 | (def beginning-of-buffer gb/beginning-of-buffer) 44 | (def end-of-buffer gb/end-of-buffer) 45 | 46 | (defn show-checkpoints 47 | [_] 48 | (checkpoint/show-checkpoints)) 49 | 50 | (var global-keys 51 | @{:alt @{:shift @{:left select-backward-word 52 | :right select-forward-word 53 | # 54 | } 55 | 56 | :backspace delete-word-backward! 57 | :delete delete-word-forward! 58 | 59 | :left backward-word 60 | :right forward-word 61 | # 62 | } 63 | 64 | :control @{:shift @{:left select-backward-word 65 | :right select-forward-word 66 | # 67 | 68 | 69 | :l echoer/toggle-console 70 | :c echoer/clear-console} 71 | 72 | :alt @{:c show-checkpoints 73 | :e file-explorer/toggle} 74 | 75 | :backspace delete-word-backward! 76 | :delete delete-word-forward! 77 | 78 | :left backward-word 79 | :right forward-word 80 | 81 | :p find-file/find-file-dialog 82 | 83 | :a gb/select-all 84 | :x cut! 85 | :c gb/copy 86 | :v paste! 87 | :z undo!2 88 | :y redo! 89 | :home beginning-of-buffer 90 | :end end-of-buffer} 91 | 92 | :shift @{:home render-gb/select-to-start-of-line 93 | :end render-gb/select-to-end-of-line 94 | :left select-backward-char 95 | :right select-forward-char 96 | :up render-gb/select-move-up! 97 | :down render-gb/select-move-down! 98 | 99 | # 100 | } 101 | 102 | :left backward-char 103 | :right forward-char 104 | :up move-up! 105 | :down move-down! 106 | 107 | :page-up page-up! 108 | :page-down page-down! 109 | 110 | :home move-to-start-of-line 111 | :end move-to-end-of-line 112 | 113 | :delete delete-after-caret! 114 | :backspace delete-before-caret! 115 | 116 | # 117 | }) 118 | 119 | (defn quit 120 | [props] 121 | (set state/quit true)) 122 | 123 | (defn open-file-dialog [props] 124 | (:open-file props)) 125 | 126 | (defn goto-line-dialog 127 | [props] 128 | (:goto-line props)) 129 | 130 | (defn save-file 131 | [props &opt note] 132 | (checkpoint/save-file-with-checkpoint props note)) 133 | 134 | (defn search-dialog 135 | [props] 136 | (:search props)) 137 | 138 | (defn replace-dialog 139 | [props] 140 | (:replace props)) 141 | 142 | (defn eval-it 143 | [props] 144 | (evaling/eval-it state/user-env 145 | (evaling/gb-get-last-sexp props))) 146 | 147 | (defn eval-expr-dialog 148 | [props] 149 | (:eval-expr props)) 150 | 151 | (defn close-buffer 152 | [_] 153 | (if (>= 1 (length (state/editor-state :stack))) 154 | (print "Can't close a lonely buffer.") 155 | (let [comp (last (state/editor-state :stack)) 156 | state (in comp 1)] 157 | (defn cb 158 | [] 159 | (state/remove-buffer-stack comp) 160 | (when-let [[_ top-state] (last (state/editor-state :stack))] 161 | (when (top-state :freja/focus) 162 | (:freja/focus top-state)))) 163 | (when (state :freja/quit) 164 | (:freja/quit state cb))))) 165 | 166 | (defn swap-top-two-buffers 167 | [_] 168 | (cond (and (get-in state/editor-state [:other 1 :freja/focus]) 169 | (:freja/focus? (in (last (state/editor-state :stack)) 1))) 170 | (:freja/focus ((state/editor-state :other) 1)) 171 | 172 | (>= 1 (length (state/editor-state :stack))) 173 | (if (get-in state/editor-state [:other 1 :freja/focus]) 174 | (:freja/focus (in (last (state/editor-state :stack)) 1)) 175 | (print "Can't swap, only one buffer open.")) 176 | 177 | (let [s (state/editor-state :stack)] 178 | (state/push-buffer-stack (s (- (length s) 2))) 179 | (when-let [[_ top-state] (last (state/editor-state :stack))] 180 | (when (:freja/focus top-state) 181 | (:freja/focus top-state)))))) 182 | 183 | # if you want to add more binds, it's preferable to use `set-key`, see at the end of this file 184 | (var gb-binds @{:control @{:shift @{:f format! 185 | :e eval-expr-dialog 186 | # 187 | } 188 | 189 | :w close-buffer 190 | :tab swap-top-two-buffers 191 | 192 | :f search-dialog 193 | :r replace-dialog 194 | :g goto-line-dialog 195 | :o open-file-dialog 196 | :l fh/save-and-dofile 197 | :s save-file 198 | :q quit 199 | :enter eval-it} 200 | :enter (comp reset-blink |(gb/insert-char! $ (chr "\n")))}) 201 | 202 | # might want to solve this differently... 203 | (set state/gb-binds gb-binds) 204 | 205 | (table/setproto gb-binds global-keys) 206 | 207 | (def file-open-binds 208 | @{:load-file 209 | (fn [props path] 210 | (open-file/open-file ;(fh/string->path-line-column path))) 211 | # checkpoint/load-file-with-checkpoints 212 | :escape (fn [props] (:escape props)) 213 | :enter (fn [props] (:enter props))}) 214 | 215 | (table/setproto file-open-binds global-keys) 216 | 217 | (def eval-binds 218 | @{:escape |(:escape $) 219 | :enter |(:eval-expr $)}) 220 | 221 | (table/setproto eval-binds global-keys) 222 | 223 | (def search-binds 224 | @{:escape |(:escape $) 225 | :enter |(:search $) 226 | :control @{:f |(:search $) 227 | :b |(:search-backwards $)}}) 228 | 229 | (def replace-binds 230 | @{:escape |(:escape $) 231 | :enter |(:replace $) 232 | :tab |(:next-field $) 233 | :control @{:f |(:replace $) 234 | :b |(:replace-backwards $)}}) 235 | 236 | (table/setproto search-binds global-keys) 237 | (table/setproto replace-binds global-keys) 238 | 239 | (def global-set-key (partial input/set-key global-keys)) 240 | 241 | # re-exporting 242 | 243 | # sets keys without being dependend on having the modifiers in the right order 244 | # if you were to do `put-in gb-binds` you'd need to be aware of the order 245 | # modifiers are sorted, i.e. [:control :shift] is not the same as [:shift :control] 246 | (def set-key input/set-key) 247 | 248 | (comment 249 | # example usage 250 | (set-key gb-binds [:control :shift :f] format!)) 251 | -------------------------------------------------------------------------------- /freja/default-layout.janet: -------------------------------------------------------------------------------- 1 | (import freja/editor :as ed) 2 | (import freja/theme :as t) 3 | (import freja/hiccup :as h) 4 | (import freja/file-handling :as fh) 5 | (import freja/new_gap_buffer :as gb) 6 | (import freja/state) 7 | (import freja/event/subscribe :as s) 8 | (import freja/open-file) 9 | (use freja/defonce) 10 | 11 | (defn default-left-editor 12 | [props & _] 13 | (def {:bottom bottom 14 | :bottom-h bottom-h} props) 15 | [:background {:color (if (props :left-focus) 16 | (t/comp-cols :background) 17 | :blank)} 18 | [:padding {:all 2} 19 | [ed/editor {:state props 20 | :id :left 21 | :focus-on-init true 22 | :initial-file state/initial-file 23 | :open (props :open) 24 | :set-open |(do # TODO: remove 25 | (s/put! state/editor-state :force-refresh true) 26 | (s/put! props :open $))}]]]) 27 | 28 | (defn default-right-editor 29 | [props & _] 30 | (def {:bottom bottom 31 | :bottom-h bottom-h} props) 32 | [:block {:height 100 33 | :width 100} 34 | [:background {:color (if (props :right-focus) 35 | (t/comp-cols :background) 36 | :blank)} 37 | [:padding {:all 2} 38 | [ed/editor @{:state (props :right-state) 39 | :id :right 40 | :open (props :right-open) 41 | :set-open |(s/put! props :right-open $)}]]]]) 42 | 43 | (defn other-row 44 | [{:hiccup hiccup}] 45 | (def [_ state] hiccup) 46 | [:block {} 47 | [:row {} 48 | [:clickable 49 | {:weight 1 50 | :on-click (fn [_] 51 | (when (state :freja/focus) 52 | (:freja/focus state)))} 53 | [:padding {:all 4} 54 | [:text {:size 16 55 | :color :white 56 | :text (state :freja/label)}]]] 57 | 58 | [:clickable 59 | {:on-click (fn [_] 60 | (state/push-buffer-stack hiccup) 61 | (s/put! state/editor-state :other nil) 62 | (when (state :freja/focus) 63 | (:freja/focus state)))} 64 | [:padding {:all 4} 65 | [:text {:size 16 66 | :color :white 67 | :text "O"}]]] 68 | 69 | [:clickable 70 | {:on-click (fn [_] 71 | (s/put! state/editor-state :other nil) 72 | (when-let [[_ top-state] (last (state/editor-state :stack))] 73 | (when (:freja/focus top-state) 74 | (:freja/focus top-state))))} 75 | [:padding {:all 4} 76 | [:text {:size 16 77 | :color :white 78 | :text "X"}]]] 79 | # 80 | ]]) 81 | 82 | (defn menu-column 83 | [{:hiccup hiccup}] 84 | (def [_ state] hiccup) 85 | [:block {} 86 | [:row {} 87 | [:clickable 88 | {:weight 1 89 | :on-click (fn [_] 90 | (when (state :freja/focus) 91 | (:freja/focus state)))} 92 | [:padding {:all 4} 93 | [:text {:size 16 94 | :color :white 95 | :text (state :freja/label)}]]] 96 | 97 | [:clickable 98 | {:on-click (fn [_] 99 | (s/put! state/editor-state :menu-column nil) 100 | (when-let [[_ top-state] (last (state/editor-state :stack))] 101 | (when (:freja/focus top-state) 102 | (:freja/focus top-state))))} 103 | [:padding {:all 4} 104 | [:text {:size 16 105 | :color :white 106 | :text "X"}]]] 107 | # 108 | ]]) 109 | 110 | (defn stack-row 111 | [{:hiccup hiccup 112 | :put-in-other put-in-other 113 | :cant-close cant-close}] 114 | (def [_ state] hiccup) 115 | 116 | [:block {} 117 | [:row {} 118 | [:clickable 119 | {:weight 1 120 | :on-click (fn [_] 121 | (if put-in-other 122 | (do 123 | (when-let [o (state/editor-state :other)] 124 | (state/push-buffer-stack o)) 125 | (state/remove-buffer-stack hiccup) 126 | (s/put! state/editor-state :other hiccup)) 127 | (state/push-buffer-stack hiccup)) 128 | (when (state :freja/focus) 129 | (:freja/focus state)))} 130 | [:padding {:all 4} 131 | [:text {:size 16 132 | :color :white 133 | :text (state :freja/label)}]]] 134 | 135 | [:clickable 136 | {:on-click (fn [_] 137 | (when-let [o (state/editor-state :other)] 138 | (state/push-buffer-stack o)) 139 | (state/remove-buffer-stack hiccup) 140 | (s/put! state/editor-state :other hiccup))} 141 | [:padding {:all 4} 142 | [:text {:size 16 143 | :color :white 144 | :text "->"}]]] 145 | 146 | (when-let [o (state/editor-state :other)] 147 | [:clickable 148 | {:on-click (fn [_] 149 | (state/remove-buffer-stack hiccup) 150 | (state/push-buffer-stack o) 151 | (state/push-buffer-stack hiccup) 152 | (s/put! state/editor-state :other nil) 153 | (when (state :freja/focus) 154 | (:freja/focus state)))} 155 | [:padding {:all 4} 156 | [:text {:size 16 157 | :color :white 158 | :text "O"}]]]) 159 | 160 | (unless cant-close 161 | [:clickable 162 | {:on-click (fn [_] 163 | (def quit-fn? (state :freja/quit)) 164 | 165 | (if quit-fn? 166 | (:freja/quit state 167 | (fn [] 168 | 169 | (state/remove-buffer-stack hiccup) 170 | (when-let [[_ top-state] (last (state/editor-state :stack))] 171 | (when (:freja/focus top-state) 172 | (:freja/focus top-state))))) 173 | 174 | (do 175 | (state/remove-buffer-stack hiccup) 176 | (when-let [[_ top-state] (last (state/editor-state :stack))] 177 | (when (:freja/focus top-state) 178 | (:freja/focus top-state))))))} 179 | [:padding {:all 4} 180 | [:text {:size 16 181 | :color :white 182 | :text "X"}]]]) 183 | # 184 | ]]) 185 | 186 | (defn text-area-hc 187 | [props & _] 188 | 189 | (def {:bottom bottom 190 | :bottom-h bottom-h} props) 191 | 192 | (unless (props :right-state) 193 | (put props :right-state @{})) 194 | 195 | [:padding {:left 0 :top 30} 196 | [:background {:color (t/colors :background)} 197 | [:column {} 198 | [:row {:weight 1} 199 | # 200 | (when-let [o (props :menu-column)] 201 | [:column {:weight 0.3} 202 | [menu-column {:hiccup o}] 203 | [:block {:weight 1} o]]) 204 | # 205 | (unless (empty? (props :stack)) 206 | (let [s (reverse (props :stack)) 207 | top (first s) 208 | rest (take 3 (drop 1 s))] 209 | [:column {:weight 1} 210 | [stack-row {:hiccup top 211 | :put-in-other true 212 | :cant-close (empty? rest)}] 213 | [:block {:weight 1} 214 | top] 215 | ;(seq [hiccup :in rest 216 | :let [[compo state] hiccup]] 217 | [stack-row {:hiccup hiccup}])])) 218 | 219 | (when-let [o (props :other)] 220 | [:column {:weight 1} 221 | [other-row {:hiccup o}] 222 | [:block {:weight 1} o]]) 223 | 224 | #[:block {:width 2}] 225 | 226 | (when (or (props :right) 227 | (props :bottom-right)) 228 | [:block {:weight 1} 229 | [:column {} 230 | (when (props :right) 231 | (if (or (not (props :bottom-right)) 232 | (props :right-focus)) 233 | [:block {:weight 1} 234 | [(props :right) props]] 235 | [(props :right) props])) 236 | 237 | (when (props :bottom-right) 238 | [(props :bottom-right) props])]]) 239 | 240 | # 241 | ] 242 | 243 | (when bottom 244 | [:block {} 245 | [bottom props]])] 246 | 247 | # 248 | ]]) 249 | 250 | # exposing the hiccup layer for debugging purposes 251 | (var hiccup-layer nil) 252 | 253 | (defn init 254 | [] 255 | (unless (state/editor-state :stack) 256 | (put state/editor-state :stack @[])) 257 | 258 | (set hiccup-layer (h/new-layer 259 | :text-area 260 | text-area-hc 261 | state/editor-state))) 262 | 263 | (comment 264 | (use freja-layout/compile-hiccup) 265 | 266 | # here we can print the element tree 267 | # in a decently readable form 268 | (-> (get-in hiccup-layer [:root]) 269 | print-tree) 270 | 271 | # 272 | ) 273 | 274 | 275 | # 276 | # this will only be true when running load-file inside freja 277 | (when (dyn :freja/loading-file) 278 | (print "reiniting :)") 279 | (init)) 280 | -------------------------------------------------------------------------------- /freja/defonce.janet: -------------------------------------------------------------------------------- 1 | (defmacro defonce 2 | "Define a value once. 3 | Useful when repling and not wanting to replace a definition." 4 | [name & more] 5 | (when (nil? (dyn name)) 6 | ~(upscope 7 | (def ,name ,;more) 8 | (put (dyn ',name) :defonce true) 9 | ,name))) 10 | 11 | (defmacro varonce 12 | "Var a value once. 13 | Useful when repling and not wanting to replace a definition." 14 | [name & more] 15 | (when (nil? (dyn name)) 16 | ~(upscope 17 | (var ,name ,;more) 18 | (put (dyn ',name) :defonce true) 19 | ,name))) 20 | -------------------------------------------------------------------------------- /freja/dumb.janet: -------------------------------------------------------------------------------- 1 | ## doing this because GetWindowScaleDPI crashes on macos 2 | # this is mutated in freja/main.janet 3 | (def screen-scale @[1 1]) 4 | -------------------------------------------------------------------------------- /freja/echoer.janet: -------------------------------------------------------------------------------- 1 | (import freja-jaylib) 2 | (import freja/state) 3 | (import freja/textarea :as ta) 4 | (use freja/defonce) 5 | (import freja/theme :as t) 6 | (import freja/new_gap_buffer :as gb) 7 | (import freja/input) 8 | (import freja/event/subscribe :as s) 9 | 10 | (defmacro curry 11 | [f-sym curried-arg] 12 | ~(let [v ,curried-arg] 13 | (fn ,(symbol (string "curried-" f-sym)) 14 | [& args] 15 | (,f-sym v ;args)))) 16 | 17 | (defonce state (ta/default-textarea-state)) 18 | 19 | (defonce state-big (ta/default-textarea-state)) 20 | 21 | (def text-size 20) 22 | 23 | (defn bottom 24 | [props & _] 25 | [:background {:color 0x444444ff} 26 | [:padding {:all 2} 27 | [ta/textarea {#:height (min 120 (get props :bottom-size 200)) # 55 28 | :min-height (min (+ 12 (* text-size 5)) 29 | (+ 6 (get props :bottom-size 55))) 30 | #:height 300 31 | :state state 32 | :text/spacing 0.5 33 | :text/size text-size 34 | :text/font "MplusCode" 35 | :text/color (t/colors :text)}]]]) 36 | 37 | (defn big 38 | [_ & _] 39 | [:background {:color 0x444444ff} 40 | [:padding {:all 2} 41 | [ta/textarea {:state state-big 42 | :text/spacing 0.5 43 | :text/size text-size 44 | :text/font "MplusCode" 45 | :text/color (t/colors :text)}]]]) 46 | 47 | (varfn append 48 | [state s] 49 | (-> (state :gb) 50 | (gb/append-string! "\n") 51 | (gb/append-string! s) 52 | (gb/end-of-buffer))) 53 | 54 | (varfn replace 55 | [state s] 56 | (def s (string/trim s)) 57 | (def nof-rows (inc (length (string/find-all "\n" s)))) 58 | 59 | (comment 60 | 61 | (def gb (state :gb)) 62 | 63 | (update gb :printing-delay 64 | (fn [fib] 65 | (when fib 66 | (try 67 | (when (fiber/can-resume? fib) 68 | (cancel fib :print/canceled)) 69 | ([err fib] 70 | (xprint stdout "canceled fib")))) 71 | 72 | (ev/spawn 73 | (do 74 | (gb/replace-content gb "") 75 | 76 | (gb/beginning-of-buffer gb) 77 | (put gb :scroll 0) 78 | 79 | (var wait 0) 80 | (loop [c :in s] 81 | (gb/append-char* gb c) 82 | (put gb :changed true) 83 | (+= wait (/ 0.002 nof-rows)) 84 | (when (> wait 0.01) 85 | (try (ev/sleep wait) 86 | ([err fib] 87 | (unless (= err :print/canceled) 88 | (propagate err fib)))) 89 | (set wait 0)))))))) 90 | (-> (state :gb) 91 | (gb/replace-content s) 92 | (gb/beginning-of-buffer) 93 | (put :scroll 0))) 94 | 95 | (varfn handle-eval-results 96 | [res] 97 | (when-let [code (res :code)] 98 | (print "=> " (string/trim code))) 99 | 100 | (if (res :error) 101 | (if-let [fib (res :fiber)] 102 | (debug/stacktrace fib 103 | (or (res :msg) (res :error)) 104 | "") 105 | (do (print "no fiber") 106 | (eprintf "%p" (res :error)))) 107 | (printf "%p" (res :value)))) 108 | 109 | (defn init 110 | [] 111 | (s/put! state/editor-state 112 | :bottom bottom) 113 | 114 | (put state/editor-state 115 | :toggle-console 116 | (fn [self] 117 | (def curr (self :right)) 118 | (if (= curr big) 119 | (s/put! self :right (self :last-right)) 120 | (-> self 121 | (s/put! :last-right curr) 122 | (s/put! :right big))))) 123 | 124 | (s/subscribe! state/eval-results (fn [res] (handle-eval-results res))) 125 | (s/subscribe! state/out-events (curry replace state)) 126 | (s/subscribe! state/out-events (curry append state-big))) 127 | 128 | (defn toggle-console 129 | [_] 130 | (:toggle-console state/editor-state)) 131 | 132 | (defn clear-console 133 | [_] 134 | (gb/replace-content (state-big :gb) @"")) 135 | -------------------------------------------------------------------------------- /freja/editor.janet: -------------------------------------------------------------------------------- 1 | (import ./textarea :as ta :fresh true) 2 | (import ./theme :as t) 3 | (import ./default-hotkeys :as dh) 4 | (import freja/state) 5 | (import freja/file-handling :as fh) 6 | (import freja/new_gap_buffer :as gb) 7 | (import freja/render_new_gap_buffer :as rgb) 8 | (import ./evaling) 9 | (import freja/event/subscribe :as s) 10 | 11 | (defn eval-expr 12 | [props] 13 | (evaling/eval-it state/user-env 14 | (string ((gb/commit! props) :text)))) 15 | 16 | (defn search 17 | [props] 18 | (let [search-term (string (gb/content props)) 19 | gb (props :search-target)] 20 | (gb/put-caret gb (if (gb :selection) 21 | (max (gb :selection) 22 | (gb :caret)) 23 | (gb :caret))) 24 | 25 | (let [[pos matches] (gb/gb-find2! gb search-term) 26 | pos 27 | (if (= pos (length matches)) # if too far, wrap 28 | 0 29 | pos)] 30 | (:put props :nof-matches (length matches)) 31 | (:put props :match-index -1) 32 | (unless (empty? matches) 33 | 34 | (:put props :match-index pos) 35 | 36 | (-> gb 37 | (gb/put-caret (in (in matches pos) 1)) 38 | (put :selection (gb/gb-find-backward! gb search-term)) 39 | (put :changed-selection true)))))) 40 | 41 | 42 | (defn search-backwards 43 | [props] 44 | (let [search-term (string (gb/content props)) 45 | gb (props :search-target)] 46 | (gb/put-caret gb (if (gb :selection) 47 | (min (gb :selection) 48 | (gb :caret)) 49 | (gb :caret))) 50 | (let [[pos matches] (gb/gb-find2! gb search-term) 51 | pos (dec pos) 52 | pos 53 | (if (neg? pos) # if too far, wrap 54 | (dec (length matches)) 55 | pos)] 56 | (:put props :nof-matches (length matches)) 57 | (:put props :match-index -1) 58 | (unless (empty? matches) 59 | 60 | (:put props :match-index pos) 61 | 62 | (-> gb 63 | (gb/put-caret (in (in matches pos) 0)) 64 | (put :selection (gb/gb-find-forward! gb search-term)) 65 | (put :changed-selection true)))))) 66 | 67 | (defn replace 68 | [gb-search gb-replace] 69 | (let [search-term (string (gb/content gb-search)) 70 | replace-term (string (gb/content gb-replace)) 71 | gb (gb-search :replace-target)] 72 | 73 | (when (and (gb :selection) 74 | (= search-term (string (gb/get-selection gb)))) 75 | (gb/delete-region! gb ;(gb/selection-tuple gb)) 76 | (def start (gb :caret)) 77 | (gb/insert-string-at-caret! gb replace-term) 78 | (gb/select-region gb start (gb :caret))) 79 | 80 | (gb/put-caret gb (if (gb :selection) 81 | (max (gb :selection) 82 | (gb :caret)) 83 | (gb :caret))) 84 | 85 | (let [[pos matches] (gb/gb-find2! gb search-term) 86 | pos 87 | (if (= pos (length matches)) # if too far, wrap 88 | 0 89 | pos)] 90 | (:put gb-search :nof-matches (length matches)) 91 | (:put gb-search :match-index -1) 92 | (unless (empty? matches) 93 | 94 | (:put gb-search :match-index pos) 95 | 96 | (-> gb 97 | (gb/put-caret (in (in matches pos) 1)) 98 | (put :selection (gb/gb-find-backward! gb search-term)) 99 | (put :changed-selection true)))))) 100 | 101 | (def file-open-binds 102 | (-> @{} 103 | (table/setproto dh/file-open-binds))) 104 | 105 | (def eval-binds 106 | (-> @{} 107 | (table/setproto dh/eval-binds))) 108 | 109 | (def search-binds 110 | (-> @{} 111 | (table/setproto dh/search-binds))) 112 | 113 | (def replace-binds 114 | (-> @{} 115 | (table/setproto dh/replace-binds))) 116 | 117 | (defn editor 118 | [props & children] 119 | (def {:open open 120 | :set-open set-open 121 | :state state 122 | :initial-path initial-path 123 | :initial-file initial-file 124 | :id id 125 | :text/size text/size 126 | :focus-on-init focus-on-init 127 | # TODO: remove when :vertical is added 128 | :space-in-bottom space-in-bottom} props) 129 | 130 | (assert state "Must define :state") 131 | 132 | (default text/size (dyn :text/size 20)) 133 | 134 | (unless (state :file-open) 135 | (put state :file-open (ta/default-textarea-state :binds file-open-binds))) 136 | 137 | (unless (state :eval-expr) 138 | (put state :eval-expr (ta/default-textarea-state :binds eval-binds))) 139 | 140 | (unless (state :search) 141 | (put state :search (ta/default-textarea-state :binds search-binds))) 142 | 143 | (unless (state :replace) 144 | (put state :replace (ta/default-textarea-state :binds replace-binds))) 145 | 146 | (unless (state :replace2) 147 | (put state :replace2 (ta/default-textarea-state :binds replace-binds))) 148 | 149 | (var editor-new? false) 150 | 151 | (unless (state :editor) 152 | (put state :editor (ta/default-textarea-state)) 153 | 154 | # (when initial-path 155 | # ((file-open-binds :load-file) (state :editor) initial-path)) 156 | 157 | (set editor-new? true)) 158 | 159 | (def {:file-open file-open 160 | :eval-expr eval-state 161 | :search search-state 162 | :replace replace-state 163 | :replace2 replace-state2 164 | :editor editor-state} state) 165 | 166 | (when id 167 | (put editor-state :id id) 168 | (put-in editor-state [:gb :id] id)) 169 | 170 | (put-in editor-state [:gb :open-file] 171 | (fn [_] 172 | (set-open :file-open) 173 | (s/put! state/focus :focus file-open))) 174 | 175 | (put-in editor-state [:gb :eval-expr] 176 | (fn [_] 177 | (set-open :eval-expr) 178 | (s/put! state/focus :focus eval-state))) 179 | 180 | (put-in editor-state [:gb :search] 181 | (fn [_] 182 | (set-open :search) 183 | (s/put! state/focus :focus search-state) 184 | (gb/select-all (search-state :gb)))) 185 | 186 | (put-in editor-state [:gb :replace] 187 | (fn [_] 188 | (set-open :replace) 189 | (s/put! state/focus :focus replace-state) 190 | (gb/select-all (replace-state :gb)))) 191 | 192 | (put-in editor-state [:gb :goto-line] 193 | (fn [_] 194 | (set-open :goto-line))) 195 | 196 | (put-in file-open [:gb :escape] 197 | (fn [props] 198 | (set-open false) 199 | (s/put! state/focus :focus editor-state))) 200 | 201 | (put-in file-open [:gb :enter] 202 | (fn [props] 203 | (set-open false) 204 | ((file-open-binds :load-file) editor-state (string ((gb/commit! props) :text))) 205 | (s/put! state/focus :focus editor-state))) 206 | 207 | (put-in eval-state [:gb :escape] 208 | (fn [props] 209 | (set-open false) 210 | (s/put! state/focus :focus editor-state))) 211 | 212 | (put-in eval-state [:gb :eval-expr] eval-expr) 213 | 214 | (put-in search-state [:gb :search-target] (editor-state :gb)) 215 | 216 | (put-in search-state [:gb :escape] 217 | (fn [props] 218 | (set-open false) 219 | (s/put! state/focus :focus editor-state))) 220 | 221 | (put-in search-state [:gb :search] search) 222 | (put-in search-state [:gb :search-backwards] search-backwards) 223 | (put-in search-state [:gb :put] (fn [self k v] 224 | (put self k v) 225 | (set-open open))) 226 | 227 | ## replace 228 | (put-in replace-state [:gb :replace-target] (editor-state :gb)) 229 | 230 | (put-in replace-state [:gb :escape] 231 | (fn [props] 232 | (set-open false) 233 | (s/put! state/focus :focus editor-state))) 234 | 235 | (put-in replace-state [:gb :next-field] 236 | (fn [props] 237 | (s/put! state/focus :focus replace-state2))) 238 | 239 | (put-in replace-state2 [:gb :next-field] 240 | (fn [props] 241 | (s/put! state/focus :focus replace-state))) 242 | 243 | (put-in replace-state [:gb :replace] |(replace $ (replace-state2 :gb))) 244 | (put-in replace-state [:gb :put] (fn [self k v] 245 | (put self k v) 246 | (set-open open))) 247 | 248 | (put-in replace-state2 [:gb :replace-target] (editor-state :gb)) 249 | 250 | (put-in replace-state2 [:gb :escape] 251 | (fn [props] 252 | (set-open false) 253 | (s/put! state/focus :focus editor-state))) 254 | 255 | (put-in replace-state2 [:gb :replace] |(replace (replace-state :gb) $)) 256 | (put-in replace-state2 [:gb :put] (fn [self k v] 257 | (put self k v) 258 | (set-open open))) 259 | 260 | [:block {} 261 | [:column {} 262 | (when-let [c (props :open)] 263 | [:background {:color (t/comp-cols :background)} 264 | [:padding {:all 4} 265 | (case c 266 | :goto-line 267 | [:row {} 268 | [:text {:size 22 269 | :color (t/comp-cols :text/color) 270 | :text "Go to line: "}] 271 | [ta/textarea {:weight 1 272 | :text/size 22 273 | :height 28 274 | 275 | :text/color (t/colors :text) 276 | 277 | :init (defn focus-textarea-on-init [self _] 278 | (s/put! state/focus :focus (self :state))) 279 | 280 | :extra-binds 281 | 282 | @{:escape (fn [props] 283 | (set-open false) 284 | (s/put! state/focus :focus editor-state)) 285 | :enter (fn [props] 286 | (set-open false) 287 | (s/put! state/focus :focus editor-state) 288 | (rgb/goto-line-number (editor-state :gb) 289 | (scan-number (gb/content props))))}}]] 290 | 291 | :file-open 292 | [:row {} 293 | [:text {:size 22 294 | :color (t/comp-cols :text/color) 295 | :text "Open: "}] 296 | [ta/textarea {:weight 1 297 | :text/size 22 298 | :height 28 299 | :text/color (t/colors :text) 300 | :state file-open}]] 301 | 302 | :eval-expr 303 | [:row {} 304 | [:text {:size 22 305 | :color (t/comp-cols :text/color) 306 | :text "Eval: "}] 307 | [ta/textarea {:weight 1 308 | :text/size 22 309 | :height 28 310 | :text/color (t/colors :text) 311 | :state eval-state}]] 312 | 313 | :search 314 | [:row {} 315 | [:text {:size 22 316 | :color (t/comp-cols :text/color) 317 | :text (string "Search " 318 | (when-let [mi (get-in search-state [:gb :match-index])] 319 | (string 320 | (inc mi) 321 | "/" 322 | (get-in search-state [:gb :nof-matches]))) 323 | " ")}] 324 | [ta/textarea {:weight 1 325 | :text/size 22 326 | :height 28 327 | :text/color (t/colors :text) 328 | :state search-state}]] 329 | 330 | :replace 331 | [:block {} 332 | [:row {} 333 | [:text {:size 22 334 | :color (t/comp-cols :text/color) 335 | :text (string "Replace " 336 | (when-let [mi (get-in replace-state [:gb :match-index])] 337 | (string 338 | (inc mi) 339 | "/" 340 | (get-in replace-state [:gb :nof-matches]))) 341 | " ")}] 342 | [ta/textarea {:weight 1 343 | :text/size 22 344 | :height 28 345 | :text/color (t/colors :text) 346 | :state replace-state}]] 347 | [:padding {:top 2} 348 | [:row {} 349 | [ta/textarea {:weight 1 350 | :text/size 22 351 | :height 28 352 | :text/color (t/colors :text) 353 | :state replace-state2}]]]])]] 354 | # 355 | ) 356 | 357 | [:background {:weight 1 358 | :color (t/colors :background)} 359 | [:padding {:left 6 :top 6} 360 | [ta/textarea {:init 361 | (fn [self _] 362 | (when editor-new? 363 | (def gb (get-in state [:editor :gb])) 364 | (when-let [[path line column] initial-file] 365 | ((file-open-binds :load-file) (state :editor) path) 366 | (when line 367 | (rgb/goto-line-number gb line)) 368 | (when column 369 | (gb/move-n gb column)))) 370 | 371 | (when focus-on-init 372 | (s/put! state/focus :focus editor-state))) 373 | :text/spacing 0.5 374 | :text/size text/size 375 | :text/font "MplusCode" 376 | :text/color (t/colors :text) 377 | :state editor-state 378 | :show-line-numbers true 379 | :space-in-bottom space-in-bottom}]]] 380 | 381 | # 382 | ]]) 383 | -------------------------------------------------------------------------------- /freja/evaling.janet: -------------------------------------------------------------------------------- 1 | (import freja/state) 2 | (import bounded-queue :as queue) 3 | (import ./new_gap_buffer :as gb) 4 | 5 | (def grammar 6 | ~{:ws (set " \t\r\f\n\0\v") 7 | :readermac (set "';~,|") 8 | :symchars (+ (range "09" "AZ" "az" "\x80\xFF") (set "!$%&*+-./:@^_")) 9 | :token (some :symchars) 10 | :hex (range "09" "af" "AF") 11 | :escape (* "\\" (+ (set "ntrzfev0\"\\") 12 | (* "x" :hex :hex) 13 | (* "u" [4 :hex]) 14 | (* "U" [6 :hex]) 15 | (error (constant "bad escape")))) 16 | :comment (<- (* (opt "\n") (any (if-not (+ "#" "\n") 1)) "#")) 17 | :symbol :token 18 | :keyword (* ":" (any :symchars)) 19 | :constant (* (+ "true" "false" "nil") (not :symchars)) 20 | :bytes (* "\"" (any (+ :escape (if-not "\"" 1))) "\"") 21 | :string :bytes 22 | :buffer (* "@" :bytes) 23 | :long-bytes {:delim (some "`") 24 | :open (capture :delim :n) 25 | :close (cmt (* (not (> -1 "`")) (-> :n) ':delim) ,=) 26 | :main (drop (* :open (any (if-not :close 1)) :close))} 27 | :long-string :long-bytes 28 | :long-buffer (* "@" :long-bytes) 29 | :number (drop (cmt (<- :token) ,scan-number)) 30 | :raw-value (+ :comment :constant :number :keyword 31 | :string :buffer :long-string :long-buffer 32 | :parray :barray :ptuple :btuple :dict :struct :symbol) 33 | :raw-value-ignore-comment (+ :constant :number :keyword 34 | :string :buffer :long-string :long-buffer 35 | :parray :barray :ptuple :btuple :dict :struct :symbol) 36 | :value (* (any (* (not :comment) (+ :ws :readermac))) :raw-value (any :ws)) 37 | :value-ignore-comment (* (any (+ :ws :readermac)) :raw-value-ignore-comment (any :ws)) 38 | :root (any :value) 39 | :root2 (any (* :value :value)) 40 | :ptuple (* ")" :root "(") 41 | :btuple (* "]" :root "[") 42 | :struct (* "}" :root "{") 43 | :parray (* :ptuple "@") 44 | :barray (* :btuple "@") 45 | :dict (* :struct "@") 46 | #:dict (* "}" :root "{@") 47 | :main (<- :value-ignore-comment)}) 48 | 49 | (def s (-> `` 50 | (* 05 5) 51 | ouae 52 | @{:a (+ 01 10)} 53 | (+ 1 1) 54 | (* 5 1) 55 | {:a} 56 | @{:a (+ 1 "hej" # 123 57 | )} 58 | `` 59 | string/reverse)) 60 | 61 | (def s (-> `` 62 | 123 63 | # 123 64 | (:a # 123) 65 | ) 66 | 67 | {:a 10 # 123 68 | :b 20} 69 | ``)) 70 | 71 | (varfn get-last-sexp 72 | [s] 73 | (-?>> s 74 | string/reverse 75 | (peg/match grammar) 76 | last 77 | string/reverse)) 78 | 79 | 80 | (varfn gb-get-last-sexp 81 | [gb] 82 | (-> gb 83 | gb/commit! 84 | (get :text) 85 | (string/slice 0 (gb :caret)) 86 | get-last-sexp)) 87 | 88 | (defn eval-it 89 | [env code] 90 | (print "=> " (string/trim code)) 91 | 92 | (def last-env (curenv)) 93 | (def out state/out) 94 | (try 95 | (do 96 | (fiber/setenv (fiber/current) env) 97 | (put env :out out) 98 | (put env :err out) 99 | (put env :redef true) 100 | (def res (eval-string code)) 101 | (fiber/setenv (fiber/current) last-env) 102 | (queue/push state/eval-results {:value res 103 | :fiber (fiber/current)})) 104 | ([err fib] 105 | (fiber/setenv (fiber/current) last-env) 106 | (queue/push state/eval-results {:error err 107 | :fiber fib})))) 108 | -------------------------------------------------------------------------------- /freja/event/callback.janet: -------------------------------------------------------------------------------- 1 | (import bounded-queue :as queue) 2 | (import freja/state) 3 | (import ./subscribe :as s) 4 | 5 | (defn put! 6 | `` 7 | Tells the callback handler that callback wants 8 | to be called due to the event `ev`. 9 | Only the last callback put this way will be called by `handle`. 10 | By default, this is used to make sure that only the topmost graphical element 11 | gets to do something with an event. 12 | `` 13 | [ev cb] 14 | (s/update! state/callbacks 15 | ev 16 | (fn [chan] 17 | # only the last callback will be called 18 | (default chan (queue/new 1)) 19 | (queue/push chan cb) 20 | chan))) 21 | 22 | (defn handle 23 | `` 24 | Calls the callbacks for each event. 25 | Then clears all stored callbacks. 26 | 27 | Is normally called once per frame. 28 | `` 29 | [callbacks] 30 | (loop [[ev cbs] :pairs state/callbacks 31 | :when (not= ev :event/changed)] 32 | (s/pull-all cbs [apply])) 33 | 34 | (table/clear callbacks)) 35 | 36 | -------------------------------------------------------------------------------- /freja/event/default-subscriptions.janet: -------------------------------------------------------------------------------- 1 | (import bounded-queue :as queue) 2 | (import freja/state) 3 | (import ./callback) 4 | (import ./jaylib-to-events :as jaylib->events) 5 | 6 | (defn init 7 | [] 8 | (let [subscriptions 9 | @{state/mouse @[] 10 | state/keyboard @[jaylib->events/handle-key-events |(:on-event (state/focus :focus) $)] 11 | state/chars @[|(:on-event (state/focus :focus) $)] 12 | state/focus @[] 13 | state/callbacks @[callback/handle] 14 | state/out-events @[|(with-dyns [:out stdout] 15 | (print $))]} 16 | 17 | # subscribers to `frame-events will 18 | # be invoked whenever a new frame should be rendered 19 | # freja uses this mostly by having `freja/hiccup` 20 | # subscribe to `state/frame-events` 21 | # 22 | # this empty list won't actually do anything 23 | finally @{state/frame-events @[]}] 24 | 25 | # the subscriptions are used in `freja/main/internal-frame` 26 | # when `events/pull-and-push` is called 27 | (merge-into state/subscriptions @{:regular subscriptions 28 | :finally finally}))) 29 | -------------------------------------------------------------------------------- /freja/event/jaylib-to-events.janet: -------------------------------------------------------------------------------- 1 | (import freja-jaylib :as jay) 2 | (import bounded-queue :as queue) 3 | (import ./subscribe :as s) 4 | (import freja/state :as state) 5 | (import ../keyboard :as kb) 6 | (import ../vector-math :as v) 7 | (import ../theme) 8 | (import ../fonts) 9 | (import ../input :as i) 10 | (import ../collision :prefix "") 11 | (import ../render_new_gap_buffer :prefix "") 12 | (import ../new_gap_buffer :prefix "") 13 | 14 | (defn key-handler 15 | [key scancode kind mods] 16 | # (pp [key scancode kind mods]) 17 | (queue/push 18 | state/keyboard 19 | @{(case kind 20 | :press :key/down 21 | :repeat :key/repeat 22 | :release :key/release) 23 | key 24 | :key/mods mods})) 25 | 26 | (defn char-handler 27 | [key] 28 | (queue/push state/chars @{:key/char key})) 29 | 30 | (defn scroll-handler 31 | [x y] 32 | (queue/push state/mouse @{:mouse/scroll y 33 | :mouse/scroll-x x 34 | :mouse/scroll-y y 35 | :mouse/pos (jay/get-mouse-position)})) 36 | 37 | (def delay-left @{}) 38 | 39 | (defn handle-keys 40 | [dt] 41 | (break) 42 | (var k (jay/get-char-pressed)) 43 | 44 | (while (not= 0 k) 45 | (queue/push state/chars @{:key/char k}) 46 | (set k (jay/get-char-pressed))) 47 | 48 | # must release keys before... 49 | (loop [k :in kb/possible-keys] 50 | (when (jay/key-released? k) 51 | (queue/push state/keyboard @{:key/release k}) 52 | 53 | # not sure why, but sometimes I feel like when pressing 54 | # right alt on windows, left-control is pressed on the same frame 55 | # and then when I release right-alt, left-control is still being held 56 | # this is a desperate attempt to fix that 57 | # WARNING: might occur strangeness since events 58 | (when (and (= k :right-alt) 59 | (not (jay/key-pressed? :left-control)) 60 | (state/keys-down :left-control)) 61 | (print "strange left-control situation occurred") 62 | (queue/push state/keyboard @{:key/release :left-control})))) 63 | 64 | # ...checking for held keys 65 | (loop [[k dl] :pairs state/keys-down 66 | # might just have been released 67 | :when (not (jay/key-released? k)) 68 | :let [left ((update state/keys-down k - dt) k)]] 69 | (when (<= left 0) 70 | (queue/push state/keyboard @{:key/repeat k}))) 71 | 72 | (loop [k :in kb/possible-keys] 73 | (when (jay/key-pressed? k) 74 | (queue/push state/keyboard @{:key/down k})))) 75 | 76 | (varfn handle-scroll 77 | [] 78 | (let [move (jay/get-mouse-wheel-move)] 79 | (when (not= move 0) 80 | (queue/push state/mouse @{:mouse/scroll (* move 30) 81 | :mouse/pos (jay/get-mouse-position)})))) 82 | 83 | (varfn handle-resize 84 | [] 85 | (when (jay/window-resized?) 86 | (-> state/screen-size 87 | (s/put! :screen/width (jay/get-screen-width)) 88 | (s/put! :screen/height (jay/get-screen-height))))) 89 | 90 | (def mouse-data (i/new-mouse-data)) 91 | 92 | (varfn handle-mouse 93 | [mouse-data] 94 | (def mouse-pos (jay/get-mouse-position)) 95 | (def [x y] mouse-pos) 96 | 97 | (put mouse-data :just-double-clicked false) 98 | (put mouse-data :just-triple-clicked false) 99 | 100 | (when (jay/mouse-button-released? 0) 101 | (put mouse-data :just-down nil) 102 | (put mouse-data :recently-double-clicked nil) 103 | (put mouse-data :recently-triple-clicked nil) 104 | (put mouse-data :up-pos [x y]) 105 | 106 | (queue/push state/mouse @{:mouse/pos mouse-pos 107 | :mouse/release mouse-pos})) 108 | 109 | (when (jay/mouse-button-pressed? 0) 110 | (cond (and (mouse-data :down-time2) 111 | # max time to pass for triple click 112 | (> 0.4 (- (jay/get-time) (mouse-data :down-time2))) 113 | # max distance to travel for triple click 114 | (> 200 (v/dist-sqr mouse-pos (mouse-data :down-pos)))) 115 | (do (put mouse-data :just-triple-clicked true) 116 | (put mouse-data :recently-triple-clicked true)) 117 | 118 | (and (mouse-data :down-time) 119 | # max time to pass for double click 120 | (> 0.25 (- (jay/get-time) (mouse-data :down-time))) 121 | # max distance to travel for double click 122 | (> 100 (v/dist-sqr mouse-pos (mouse-data :down-pos)))) 123 | (do (put mouse-data :just-double-clicked true) 124 | (put mouse-data :recently-double-clicked true) 125 | (put mouse-data :down-time2 (jay/get-time))))) 126 | 127 | (cond (mouse-data :just-triple-clicked) 128 | (queue/push state/mouse @{:mouse/pos mouse-pos 129 | :mouse/down mouse-pos 130 | :mouse/triple-click mouse-pos}) 131 | 132 | (and (mouse-data :just-double-clicked) 133 | (not (jay/key-down? :left-shift)) 134 | (not (jay/key-down? :right-shift))) 135 | (queue/push state/mouse @{:mouse/pos mouse-pos 136 | :mouse/down mouse-pos 137 | :mouse/double-click mouse-pos}) 138 | 139 | (or (mouse-data :recently-double-clicked) 140 | (mouse-data :recently-triple-clicked)) 141 | nil # don't start selecting until mouse is released again 142 | 143 | (jay/mouse-button-down? 0) 144 | (do 145 | (put mouse-data :down-time (jay/get-time)) 146 | 147 | (if (= nil (mouse-data :just-down)) 148 | (do (put mouse-data :just-down true) 149 | (put mouse-data :last-pos mouse-pos) 150 | (put mouse-data :down-pos mouse-pos) 151 | (queue/push state/mouse @{:mouse/pos mouse-pos 152 | :mouse/down mouse-pos})) 153 | (do (put mouse-data :just-down false) 154 | (unless (= mouse-pos (mouse-data :last-pos)) 155 | (put mouse-data :last-pos mouse-pos) 156 | (queue/push state/mouse @{:mouse/pos mouse-pos 157 | :mouse/drag mouse-pos}))))) 158 | 159 | # no mouse button down 160 | (not= mouse-pos (mouse-data :last-pos)) 161 | (do (put mouse-data :last-pos mouse-pos) 162 | (queue/push state/mouse @{:mouse/pos mouse-pos 163 | :mouse/move mouse-pos})))) 164 | 165 | (defn handle-key-events 166 | [ev] 167 | (match ev 168 | {:key/release k} 169 | (put state/keys-down k nil) 170 | 171 | {:key/repeat k} 172 | (put state/keys-down k i/repeat-delay) 173 | 174 | {:key/down k} 175 | (put state/keys-down k i/initial-delay))) 176 | 177 | (varfn convert 178 | [dt] 179 | (handle-keys dt) 180 | #(handle-scroll) 181 | (handle-resize) 182 | 183 | (queue/push state/frame-events @{:frame/delta-time dt}) 184 | 185 | (handle-mouse mouse-data)) 186 | -------------------------------------------------------------------------------- /freja/event/subscribe.janet: -------------------------------------------------------------------------------- 1 | (import bounded-queue :as queue) 2 | (import freja/state) 3 | 4 | # a push-pull system 5 | # events are pushed to queues 6 | # then things can pull from the queues 7 | 8 | # we want to be able to pull. 9 | # multiple things should be able to pull from it, 10 | # essentially splitting/copying the value 11 | 12 | (defn pull 13 | [pullable pullers] 14 | (when-let [v (cond 15 | # is a queue -- kind of wishing for a way to define custom types 16 | (pullable :items) 17 | (queue/pop pullable) 18 | 19 | # regular table 20 | :else 21 | (when (pullable :event/changed) 22 | (put pullable :event/changed false)))] 23 | 24 | (loop [puller :in pullers] 25 | (try 26 | (case (type puller) 27 | :function (puller v) 28 | :table (cond 29 | (puller :items) 30 | (queue/push puller v) 31 | 32 | :else 33 | (:on-event puller v)) 34 | (error (string "Pulling not implemented for " (type puller)))) 35 | ([err fib] 36 | (queue/push state/eval-results (if (and (dictionary? err) (err :error)) 37 | err 38 | {:error err 39 | :fiber fib 40 | :msg (string/format `` 41 | %s 42 | event: 43 | %p 44 | subscriber: 45 | %p 46 | `` 47 | err 48 | (if (dictionary? v) 49 | (string/format "dictionary with keys: %p" (keys v)) 50 | v) 51 | (if (dictionary? puller) 52 | (string/format "dictionary with keys: %p" (keys puller)) 53 | puller)) 54 | :cause [v puller]}))))) 55 | v) # if there was a value, we return it 56 | ) 57 | 58 | (defn pull-all 59 | [pullable pullers] 60 | (while 61 | (pull pullable pullers) 62 | nil)) 63 | 64 | (defn put! 65 | ``` 66 | Same as `put` but also puts `:event/changed` to true. 67 | ``` 68 | [state k v] 69 | (-> state 70 | (put k v) 71 | (put :event/changed true))) 72 | 73 | (defn update! 74 | ``` 75 | Same as `update` but also puts `:event/changed` to true. 76 | ``` 77 | [state k f & args] 78 | (-> state 79 | (update k f ;args) 80 | (put :event/changed true))) 81 | 82 | (defn fresh? 83 | [pullable] 84 | (cond 85 | (pullable :items) (not (queue/empty? pullable)) 86 | :else (pullable :event/changed))) 87 | 88 | (defn call-subscribers 89 | `` 90 | Loops through all subscriptions, pulls from the emitters. 91 | When events are pulled, they are pushed onto the subscribers. 92 | `` 93 | [subscriptions &opt finally] 94 | # as long as dependencies have changed (are `fresh?`) 95 | # keep looping through them and tell dependees 96 | # that changes have happened (`pull-all`) 97 | # this is important since laters subscriptions might add 98 | # events to earlier emitters 99 | (while (some fresh? (keys subscriptions)) 100 | (loop [[pullable pullers] :pairs subscriptions] 101 | (pull-all pullable pullers))) 102 | 103 | # then when all is done, run the things in `finally` 104 | (loop [[pullable pullers] :pairs (or finally {})] 105 | (pull-all pullable pullers))) 106 | 107 | 108 | ### functions used to add / remove subscriptions after init-subscriptions has been called 109 | 110 | (defn subscribe-first! 111 | "Take an event emitter (e.g. a queue) 112 | and a callback (e.g. single arity function). 113 | Creates a regular subscription." 114 | [emitter cb] 115 | (unless (find |(= $ cb) (get-in state/subscriptions [:regular emitter] [])) 116 | (update-in state/subscriptions [:regular emitter] (fn [$] @[cb ;(or $ [])])))) 117 | 118 | 119 | (defn subscribe! 120 | "Take an event emitter (e.g. a queue) 121 | and a callback (e.g. single arity function). 122 | Creates a regular subscription." 123 | [emitter cb] 124 | (unless (find |(= $ cb) (get-in state/subscriptions [:regular emitter] [])) 125 | (update-in state/subscriptions [:regular emitter] |(array/push (or $ @[]) cb)) 126 | :ok)) 127 | 128 | (defn unsubscribe! 129 | "Take an event emitter (e.g. a queue) 130 | and a callback (e.g. single arity function). 131 | Removes a regular subscription." 132 | [emitter cb] 133 | (update-in state/subscriptions [:regular emitter] 134 | (fn [subs] (filter |(not= $ cb) subs))) 135 | :ok) 136 | 137 | (defn subscribe-finally! 138 | "Take an event emitter (e.g. a queue) 139 | and a callback (e.g. single arity function). 140 | Creates a finally subscription." 141 | [emitter cb] 142 | (unless (find |(= $ cb) (get-in state/subscriptions [:finally emitter] [])) 143 | (update-in state/subscriptions [:finally emitter] |(array/push (or $ @[]) cb)) 144 | :ok)) 145 | 146 | 147 | (defn unsubscribe-finally! 148 | "Take an event emitter (e.g. a queue) 149 | and a callback (e.g. single arity function). 150 | Removes a finFally subscription." 151 | [emitter cb] 152 | (update-in state/subscriptions [:finally emitter] 153 | (fn [subs] (filter |(not= $ cb) subs))) 154 | :ok) 155 | -------------------------------------------------------------------------------- /freja/file-explorer.janet: -------------------------------------------------------------------------------- 1 | (import ./state) 2 | (import ./event/subscribe :as s) 3 | (import ./open-file) 4 | 5 | (defn split 6 | [f arr] 7 | (def arr1 @[]) 8 | (def arr2 @[]) 9 | 10 | (loop [v :in arr] 11 | (if (f v) 12 | (array/push arr1 v) 13 | (array/push arr2 v))) 14 | 15 | [arr1 arr2]) 16 | 17 | (defn file-explorer 18 | [props] 19 | [:block {} 20 | [:padding {:all 6} 21 | ;(let [paths (os/dir (props :path)) 22 | [dirs files] (->> (split |(= :directory ((or (os/stat (string (props :path) "/" $)) (errorf "path %p not found" $)) :mode)) paths) 23 | (map sort))] 24 | [;(seq [path :in dirs 25 | :let [expanded? (get-in props [:expanded (string (props :path) "/" path)])]] 26 | [:block {} 27 | [:clickable 28 | {:on-click 29 | (fn [_] 30 | (s/put! state/editor-state :force-refresh true) 31 | (s/update! props :expanded |(update (or $ @{}) (string (props :path) "/" path) not)))} 32 | [:text {:color :gray 33 | :size 16 34 | :text path}]] 35 | 36 | (when expanded? 37 | (file-explorer @{:expanded (props :expanded) 38 | :path (string (props :path) "/" path)}) 39 | #"hello" 40 | )]) 41 | ;(seq [path :in files] 42 | [:block {} 43 | [:clickable 44 | {:on-click 45 | (fn [_] (open-file/open-file (string (props :path) "/" path)))} 46 | [:text {:color :white 47 | :size 16 48 | :text path}]]])])]]) 49 | 50 | (defn toggle 51 | [& _] 52 | (if (state/editor-state :menu-column) 53 | (s/put! state/editor-state :menu-column nil) 54 | (s/put! state/editor-state 55 | :menu-column 56 | [file-explorer 57 | @{:freja/label "File Explorer" 58 | :path "."}]))) -------------------------------------------------------------------------------- /freja/find-file.janet: -------------------------------------------------------------------------------- 1 | # I want to: 2 | # - show a text field 3 | # - when I write in it, search project for files matching the string 4 | 5 | # I need to: 6 | # - get a list of all files 7 | # - search through those 8 | 9 | (import spork/path) 10 | (import freja/theme) 11 | (import freja/hiccup :as h) 12 | (import freja/textarea :as t) 13 | (import freja/open-file) 14 | (import freja/file-handling :as fh) 15 | (import freja/state) 16 | (import freja/event/subscribe :as s) 17 | 18 | (defn get-files 19 | [root] 20 | (try 21 | (let [paths (os/dir root)] 22 | (def res @[]) 23 | (loop [p :in paths 24 | :let [p (string root path/sep p) 25 | {:mode mode} (os/stat p) 26 | dir? (= mode :directory)]] 27 | (array/push res p) 28 | (when dir? 29 | (array/concat res (get-files p)))) 30 | res) 31 | 32 | ([err fib] 33 | (debug/stacktrace fib err "")))) 34 | 35 | (defn get-files-relative 36 | [full-root &opt root] 37 | (try 38 | (let [paths (os/dir full-root)] 39 | (def res @[]) 40 | (loop [p :in paths 41 | :let [fp (string full-root path/sep p) 42 | {:mode mode} (os/stat fp) 43 | dir? (= mode :directory) 44 | relpath 45 | (if-not root 46 | p 47 | (path/join root p))]] 48 | (if dir? 49 | (array/concat res (get-files-relative fp relpath)) 50 | (array/push res relpath))) 51 | res) 52 | 53 | ([err fib] 54 | (debug/stacktrace fib err "")))) 55 | 56 | (comment 57 | # 58 | (loop [v :in (get-files (os/cwd))] (print v)) 59 | 60 | (loop [v :in (get-files-relative (os/cwd))] (print v)) 61 | 62 | (let [peg ~{:main (any (+ (* ($) "freja") 63 | 1))}] 64 | (pp (->> 65 | (map (fn [p] (unless (empty? (peg/match peg p)) 66 | p)) 67 | (get-files-relative (os/cwd))) 68 | (filter (comp not nil?))))) 69 | 70 | # 71 | ) 72 | 73 | (defn case-insensitive-peg 74 | [s] 75 | ~(* ,;(map (fn [c] 76 | ~(+ ,(string/ascii-upper (string/from-bytes c)) 77 | ,(string/ascii-lower (string/from-bytes c)))) s))) 78 | 79 | (comment 80 | # 81 | (peg/match (case-insensitive-peg "cat") "CAT") 82 | #=> @[] 83 | 84 | (peg/match (case-insensitive-peg "cAT") "Cat") 85 | #=> @[] 86 | # 87 | ) 88 | 89 | (defn search-peg 90 | `` 91 | Takes a string, returns a peg finding start positions of that string. 92 | Matches by splitting the string by spaces, and where each space was, 93 | anything matches. 94 | 95 | (peg/match (search-peg "fi do") "fine dog") 96 | #=> @[0] 97 | `` 98 | [search] 99 | (let [parts (string/split " " search)] 100 | (var parts-peg @[]) 101 | (loop [i :range [0 (length parts)] 102 | :let [p (in parts i) 103 | p-peg (case-insensitive-peg p) 104 | p2 (get parts (inc i)) 105 | p2-peg (when p2 106 | (case-insensitive-peg p2))]] 107 | (array/push parts-peg p-peg) 108 | (array/push parts-peg 109 | (if p2-peg 110 | ~(any (if-not ,p2-peg 1)) 111 | ~(any 1)))) 112 | ~{:parts (* ($) ,;parts-peg) 113 | :main (any (+ :parts 114 | 1))})) 115 | 116 | (comment 117 | # 118 | (peg/match (search-peg "fi do") "fine dog") 119 | #=> @[0] 120 | # 121 | ) 122 | 123 | (defn list-files-component 124 | [props] 125 | (def {:search search 126 | :files files 127 | :offset offset} 128 | props) 129 | 130 | (default offset 0) 131 | 132 | (def peg 133 | (if (or (nil? search) 134 | (empty? search)) 135 | ~'(any 1) 136 | (search-peg search))) 137 | 138 | (def filtered-files (->> files 139 | (map (fn [p] (unless (empty? (peg/match peg p)) p))) 140 | (filter (comp not nil?)) 141 | (take 10))) 142 | 143 | (def offset (-> offset 144 | (max 0) 145 | (min (dec (length filtered-files))))) 146 | 147 | (def selected-file (get filtered-files offset)) 148 | 149 | (defn open 150 | [path] 151 | (open-file/open-file ;(fh/string->path-line-column path)) 152 | (h/remove-layer :list-files props)) 153 | 154 | [:padding {:all 0} 155 | [:column {} 156 | [:block {:weight 0.05}] 157 | [:row {} 158 | [:block {:weight 0.5}] 159 | [:block {:weight 1} 160 | [:clickable {:on-click (fn [_] # only done to stop clicks from passing through 161 | )} 162 | [:background {:color (theme/comp-cols :background)} 163 | [:padding {:all 4} 164 | [:block {} [:text {:size 24 165 | :color (theme/comp-cols :text/color) 166 | :text "Find file"}]] 167 | [:padding {:top 6 :bottom 6} 168 | [t/textarea 169 | @{:text/color :white 170 | :init 171 | (fn [self _] 172 | (s/put! state/focus :focus (self :state))) 173 | 174 | :text/size 20 175 | :height 22 176 | :extra-binds 177 | @{:escape (fn [_] 178 | (h/remove-layer :list-files props) 179 | (:freja/focus (in (last (state/editor-state :stack)) 1))) 180 | :down (fn [_] (let [new (inc offset) 181 | new (if (>= new (length filtered-files)) 182 | 0 183 | new)] 184 | (s/put! props :offset new))) 185 | :up (fn [_] (let [new (dec offset) 186 | new (if (< new 0) 187 | (dec (length filtered-files)) 188 | new)] 189 | (s/put! props :offset new))) 190 | :enter (fn [_] (open selected-file))} 191 | :on-change |(s/put! props :search $)}]] 192 | [:background {:color (theme/comp-cols :bar-bg)} 193 | ;(seq [f :in filtered-files 194 | :let [selected (= f selected-file)]] 195 | [:clickable {:on-click (fn [_] (open f))} 196 | (if selected 197 | [:background {:color 0xffffff99} 198 | [:block {} 199 | [:padding {:all 2} 200 | [:text {:color 0x111111ff :size 16 :text (or selected-file "")}]]]] 201 | [:block {} 202 | [:padding {:all 2} 203 | [:text {:text f :size 16 :color :white}]]])])]]]]] 204 | [:block {:weight 0.5}]] 205 | [:block {:weight 1}]]]) 206 | 207 | (defn find-file-dialog 208 | [_] 209 | (def state @{:files (get-files-relative (os/cwd))}) 210 | 211 | (h/new-layer :list-files 212 | list-files-component 213 | state)) 214 | 215 | (comment 216 | # 217 | (do 218 | (find-file-dialog nil) 219 | :ok) 220 | # 221 | ) 222 | -------------------------------------------------------------------------------- /freja/find_row_etc.janet: -------------------------------------------------------------------------------- 1 | (varfn binary-search-closest* 2 | [vs bottom top c] 3 | (if (>= bottom top) 4 | top 5 | (let [i (math/floor (/ (- top bottom) 2)) 6 | v (vs (+ i bottom))] 7 | (case (c v) 8 | -1 (binary-search-closest* 9 | vs 10 | bottom 11 | (+ bottom i) 12 | c) 13 | 0 (+ i bottom) 14 | 1 (binary-search-closest* 15 | vs 16 | (inc (+ bottom i)) 17 | top 18 | c))))) 19 | 20 | (varfn binary-search-closest 21 | `` 22 | Binary searches sorted array `vs` using single arity function `c`. 23 | `c` is called on elements of `vs`, and is expected to return `-1`, `0` or `1` (like `compare`). 24 | Returns index of match. 25 | If an exact match can't be found, return the closest index, rounded upwards. 26 | 27 | (binary-search-closest [0 1 2] (partial compare 1)) #=> 1 28 | (binary-search-closest [0 1 2] (partial compare 2)) #=> 2 29 | (binary-search-closest [0 1 2] (partial compare 1.5)) #=> 2 30 | `` 31 | [vs c] 32 | (binary-search-closest* vs 0 (length vs) c)) 33 | -------------------------------------------------------------------------------- /freja/flow.janet: -------------------------------------------------------------------------------- 1 | (import freja/event/default-subscriptions) 2 | (import freja/event/subscribe) 3 | (import freja/event/jaylib-to-events :as jaylib->events) 4 | (import freja/hiccup) 5 | (import freja/theme) 6 | (import freja/state) 7 | (import ./input) 8 | (import freja-layout/default-tags :as dt) 9 | (import freja/default-hotkeys :prefix "" :export true) 10 | (import freja-jaylib :prefix "" :export true) 11 | (import freja/defonce :prefix "" :export true) 12 | (import ./vector-math :as v :export true) 13 | (import freja/text_rendering :as tr) 14 | (import freja/assets :as a) 15 | (import freja/event/subscribe :as s) 16 | 17 | (defn measure-text 18 | [text &keys {:size size 19 | :font font 20 | :spacing spacing}] 21 | (default size 22) 22 | (default font "EBGaramond") 23 | (default spacing 1) 24 | (def font (if (keyword? font) 25 | (case font 26 | :monospace "MplusCode" 27 | :serif "EBGaramond" 28 | :sans-serif "Poppins" 29 | (error (string/format `` 30 | font must either be: 31 | * keyword :monospace, :serif or :sans-serif 32 | * string corresponding to a loaded font: %p 33 | `` 34 | (keys a/fonts)))) 35 | font)) 36 | 37 | (def font (a/font font size)) 38 | (tr/measure-text* font 39 | (if (or (buffer? text) (string? text)) 40 | text 41 | (string/format "%p" text)) 42 | size 43 | spacing)) 44 | 45 | (defn draw-text 46 | `` 47 | Draws `text` as [x y] `pos`. 48 | Returns `text` which means it can be used as `tracev`. 49 | `` 50 | [text pos &keys {:size size 51 | :font font 52 | :spacing spacing 53 | :center center 54 | :color color}] 55 | (default size 22) 56 | (default font "EBGaramond") 57 | (default spacing 1) 58 | (default color 0x000000ee) 59 | 60 | (def font (if (keyword? font) 61 | (case font 62 | :monospace "MplusCode" 63 | :serif "EBGaramond" 64 | :sans-serif "Poppins" 65 | (error (string/format `` 66 | font must either be: 67 | * keyword :monospace, :serif or :sans-serif 68 | * string corresponding to a loaded font: %p 69 | `` 70 | (keys a/fonts)))) 71 | font)) 72 | 73 | (def pos 74 | (if-not center 75 | pos 76 | (let [[x y] pos 77 | [w h] (measure-text text 78 | :size size 79 | :font font 80 | :spacing spacing 81 | :color color)] 82 | [(- x (* 0.5 w)) 83 | (- y (* 0.5 h))]))) 84 | 85 | (def font (a/font font size)) 86 | (tr/draw-text* font 87 | (if (or (buffer? text) (string? text)) 88 | text 89 | (string/format "%p" text)) 90 | pos 91 | size 92 | spacing 93 | color) 94 | 95 | # return the input so `draw-text` can be used as tracev 96 | text) 97 | 98 | (defn fill 99 | [el color] 100 | (draw-rectangle 0 0 (el :width) (el :height) color)) 101 | 102 | (defn custom-on-event 103 | [self ev] 104 | (let [ev (input/offset-event-pos ev (dyn :offset-x) 105 | (dyn :offset-y) 106 | :scale (get-in self [:props :scale] 1))] 107 | (match ev 108 | # unfocus game panel 109 | {:key/down :escape} 110 | (let [top-stack-state (in (last (state/editor-state :stack)) 1)] 111 | (show-cursor) 112 | (put-in top-stack-state [:editor :gb :blink] 0) 113 | (:freja/focus top-stack-state)) 114 | 115 | # focus game panel 116 | ({:mouse/release _ 117 | :mouse/pos p} 118 | (and (not (= self (state/focus :focus))) 119 | (dt/in-rec? p 0 0 (self :width) (self :height)))) 120 | (state/focus! self)) 121 | 122 | (when-let [on-event (get-in self [:props :on-event])] 123 | (on-event self ev)))) 124 | 125 | (defn custom 126 | [props] 127 | (def {:render render 128 | :on-event on-event 129 | :state state} props) 130 | 131 | (-> (dyn :element) 132 | (dt/add-default-props props) 133 | (merge-into 134 | @{:init 135 | (fn [self _] 136 | (when state 137 | (put state :element self))) 138 | 139 | :children [] 140 | 141 | :relative-sizing 142 | (fn [el max-width max-height] 143 | (-> el 144 | (put :width (or (el :preset-width) max-width)) 145 | (put :height (or (el :preset-height) max-height)) 146 | (put :content-width (el :width)) 147 | (put :layout/lines nil)) 148 | 149 | el) 150 | 151 | :render (fn [self parent-x parent-y] 152 | (try 153 | (do 154 | (def scale (get props :scale 1)) 155 | (put self :focused? (= self (in state/focus :focus))) 156 | 157 | (put self :render-x parent-x) 158 | (put self :render-y parent-y) 159 | 160 | (unless (props :render-anywhere) 161 | (begin-scissor-mode parent-x parent-y (self :width) (self :height))) 162 | 163 | (defer (do (rl-pop-matrix) 164 | (unless (props :render-anywhere) 165 | (end-scissor-mode))) 166 | 167 | (rl-push-matrix) 168 | (rl-scalef scale scale 1) 169 | (render self))) 170 | ([err fib] 171 | (debug/stacktrace fib err "")))) 172 | 173 | :on-event custom-on-event}))) 174 | 175 | (defn start-game-f 176 | [props] 177 | (def props 178 | (if (function? props) 179 | {:render props} 180 | props)) 181 | 182 | (assert (props :render) "start-game needs :render") 183 | 184 | (def state (get props :state @{})) 185 | # copy the props 186 | (def props (from-pairs (pairs props))) 187 | (put props :state state) 188 | 189 | (update state :freja/label |(or $ "Game")) 190 | (update state :freja/focus |(or $ (fn [{:element el}] 191 | (state/focus! el)))) 192 | (update state :freja/focus? |(or $ (fn [{:element el}] (= el (state/focus :focus))))) 193 | 194 | (defn component 195 | [outer-props] 196 | (let [size (props :size) 197 | scale (get props :scale 1) 198 | bg (get props :border :blank)] 199 | [:background {:color bg} 200 | (if size 201 | # crazy way to center something 202 | [:column {} 203 | [:block {:weight 1}] 204 | [:row {} 205 | [:block {:weight 1}] 206 | [:block {:width (* scale (get-in props [:size 0])) 207 | :height (* scale (get-in props [:size 1]))} 208 | [custom props]] 209 | [:block {:weight 1}]] 210 | [:block {:weight 1}]] 211 | 212 | [custom props])])) 213 | 214 | (if (props :new-layer) 215 | (hiccup/new-layer :game component state) 216 | 217 | (s/put! state/editor-state :other 218 | [component 219 | state]))) 220 | 221 | 222 | (defmacro start-game 223 | `` 224 | When running from Freja, starts the game in a panel. 225 | When running from janet or when building an exe, will generate a main-function. 226 | 227 | props allows following keys: 228 | :render (mandatory) -- called every frame, with &keys :width & :height 229 | :width / :height has width / height of the game 230 | :on-event -- function that takes arguments `self` and `event`. 231 | if present it is called every time an event occurs, 232 | e.g. `:key-down`. 233 | `self` is the element doing the rendering. 234 | :state -- table that will be populated with information about 235 | the component, e.g. `:element` will be inserted, 236 | containing a reference to the element 237 | :render-anywhere -- set to true to disable scissor-mode, 238 | i.e. render outside element bounds 239 | :size -- takes tuple/array `[width height]` where width and height are integers. 240 | game will be this size in pixels. if not set, game will cover whole panel. 241 | :scale -- scale factor of the game. 242 | affects both rendering and events (e.g. :mouse/pos). 243 | :border -- color of area surrounding the game 244 | 245 | Optionally, props can be a function. In this case, that function will be used as `:render` above. 246 | `` 247 | [props] 248 | (cond (dyn :freja/web-build) 249 | ~(upscope 250 | (defn desktop 251 | [] 252 | (set-config-flags :msaa-4x-hint) 253 | (set-target-fps 60)) 254 | 255 | (var update-draw-frame nil) 256 | (var main-fiber nil) 257 | (defn render-f 258 | [& _] 259 | (while (not (window-should-close)) 260 | (begin-drawing) 261 | 262 | (clear-background :white) 263 | 264 | (,jaylib->events/convert (get-frame-time)) 265 | 266 | (let [{:regular regular 267 | :finally finally} 268 | ',state/subscriptions] 269 | (,subscribe/call-subscribers regular finally)) 270 | 271 | (end-drawing)) 272 | 273 | (close-window)) 274 | 275 | (defn common-startup 276 | [] 277 | (print "main?") 278 | 279 | (def {:size size 280 | :scale scale 281 | :render render} ,props) 282 | 283 | (default scale 1) 284 | 285 | (,default-subscriptions/init) 286 | # 287 | (init-window ;(v/v* size scale) "Cross") 288 | # 289 | (when (,props :init) 290 | ((,props :init))) 291 | # 292 | 293 | (start-game-f (-> (from-pairs (pairs ,props)) 294 | (put :new-layer true) 295 | (put :size nil))) 296 | # 297 | #(j/init-audio-device) 298 | # to facilitate calling from main.c 299 | (set update-draw-frame |(render-f)) 300 | # XXX 301 | (setdyn :frame 0) 302 | # this fiber is used repeatedly by the c code, partly to maintain 303 | # dynamic variables (as those are per-fiber), but also because reusing 304 | # a fiber with a function is likely faster than parsing and compiling 305 | # code each time the game loop performs one iteration 306 | (print "setting main fiber") 307 | (set main-fiber 308 | (fiber/new 309 | (fn [] 310 | # XXX: this content only gets used when main.c uses janet_continue 311 | (while (not (window-should-close)) 312 | (print "inner") 313 | (render-f) 314 | (yield))) 315 | # important for inheriting existing dynamic variables 316 | :i)))) 317 | 318 | # running inside freja 319 | (dyn :freja/loading-file) 320 | ~(do (when (,props :init) 321 | ((,props :init))) 322 | (start-game-f ,props)) 323 | 324 | # standalone janet script 325 | ~(upscope 326 | (defn main 327 | [& _] 328 | (print "main?") 329 | 330 | (def {:size size 331 | :scale scale 332 | :render render} ,props) 333 | 334 | (default scale 1) 335 | 336 | (,default-subscriptions/init) 337 | 338 | (init-window ;(v/v* size scale) "Cross") 339 | 340 | (when (,props :init) 341 | ((,props :init))) 342 | 343 | (start-game-f (-> (from-pairs (pairs ,props)) 344 | (put :new-layer true) 345 | (put :size nil))) 346 | 347 | (set-target-fps 60) 348 | 349 | (var last-mp nil) 350 | 351 | (with-dyns [:offset-x 0 :offset-y 0] 352 | (while (not (window-should-close)) 353 | (begin-drawing) 354 | 355 | (clear-background :white) 356 | 357 | (,jaylib->events/convert (get-frame-time)) 358 | 359 | (let [{:regular regular 360 | :finally finally} 361 | ',state/subscriptions] 362 | (,subscribe/call-subscribers regular finally)) 363 | 364 | (end-drawing))) 365 | 366 | (close-window))))) 367 | 368 | (comment 369 | (start-game {:render (fn render [{:width width :height height}] 370 | #(clear-background :white) 371 | (draw-rectangle 0 0 200 200 :green) 372 | (draw-rectangle 100 100 100 100 :red)) 373 | :on-event (fn on-event [self ev] (printf "example on-event: %p" ev)) 374 | :size [200 200] 375 | :scale 2 376 | :border [0.3 0 0.3 1]})) 377 | -------------------------------------------------------------------------------- /freja/fonts.janet: -------------------------------------------------------------------------------- 1 | (use freja-jaylib) 2 | (import ./state) 3 | (import spork/path) 4 | (import ./dumb :prefix "") 5 | (import ./text_rendering :as tr) 6 | 7 | (def default-font-conf @{}) 8 | 9 | (varfn glyphs->size-struct 10 | [conf glyphs] 11 | (table ;(interleave 12 | glyphs 13 | (tr/measure-each-char conf glyphs)))) 14 | 15 | (def default-glyphs (string/bytes " !\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHI\nJKLMNOPQRSTUVWXYZ[]^_`abcdefghijklmn\nopqrstuvwxyz{|}~\\\r")) 16 | 17 | (defn default-glyphs->size-struct 18 | [font size] 19 | (def [x-scale _] screen-scale) 20 | (glyphs->size-struct 21 | {:size (* size x-scale) 22 | :mult (/ 1 x-scale) 23 | :spacing 1 24 | :font font} 25 | default-glyphs)) 26 | 27 | (defn default-load-font 28 | [font-path size] 29 | (def [x-scale _] screen-scale) 30 | (load-font-ex font-path (* x-scale size) default-glyphs)) 31 | 32 | (defn default-load-font-from-memory 33 | [kind font-data size] 34 | (def [x-scale _] screen-scale) 35 | (load-font-from-memory kind 36 | font-data 37 | (length font-data) 38 | (math/round (* x-scale size)) 39 | default-glyphs)) 40 | 41 | (defn load-font 42 | [text-data opts] 43 | (let [font (load-font-ex (opts :font-path) (opts :size) (opts :glyphs))] 44 | 45 | (put opts :font font) 46 | 47 | (def t (freeze opts)) 48 | 49 | (put text-data :conf t) 50 | (put text-data :sizes (glyphs->size-struct t (t :glyphs))) 51 | 52 | t)) 53 | 54 | (defn load-font-from-mem 55 | [text-data opts] 56 | 57 | (let [font (load-font-from-memory (opts :ext) 58 | (opts :font-data) 59 | (length (opts :font-data)) 60 | (opts :size) 61 | (opts :glyphs))] 62 | 63 | (put opts :font font) 64 | 65 | (def t (freeze opts)) 66 | 67 | (put text-data :conf t) 68 | (put text-data :sizes (glyphs->size-struct t (t :glyphs))) 69 | 70 | t)) 71 | 72 | # these are slurped on top level in order 73 | # to be included in the binary when 74 | # running `jpm build` 75 | 76 | # convert "/" to "\\" on windows 77 | # current-file always uses "/" 78 | (def extra-path 79 | (if (= (os/which) :windows) 80 | (string/replace-all "/" "\\" (dyn :current-file)) 81 | (dyn :current-file))) 82 | 83 | (var mplus nil) 84 | (var poppins nil) 85 | (var ebgaramond nil) 86 | 87 | (defn init-fonts 88 | [] 89 | (def extra-path2 90 | (or 91 | (-?> extra-path 92 | path/dirname 93 | path/parts 94 | (slice 0 -2)) 95 | [])) 96 | 97 | (set mplus (slurp (path/join ;extra-path2 98 | "fonts" 99 | "MplusCodeLatin60-Medium.otf"))) 100 | (set poppins (slurp (path/join ;extra-path2 101 | "fonts" 102 | "Poppins-Regular.otf"))) 103 | (set ebgaramond (slurp (path/join ;extra-path2 104 | "fonts" 105 | "EBGaramond12-Regular.otf")))) 106 | 107 | 108 | (try (init-fonts) 109 | ([err fib] 110 | (eprint "couldn't load fonts in top level"))) 111 | 112 | # storage for loaded fonts 113 | (def fonts @{}) 114 | 115 | (defn init-default-font 116 | [] 117 | (def [x-scale _] screen-scale) 118 | 119 | (def opts 120 | @{:font-data mplus 121 | :ext ".otf" 122 | :size (* 20 x-scale) 123 | :line-height 1.2 124 | :mult (/ 1 x-scale) 125 | :glyphs default-glyphs 126 | :spacing 0.5}) 127 | 128 | (put opts :font (load-font-from-memory (opts :ext) 129 | (opts :font-data) 130 | (length (opts :font-data)) 131 | (opts :size) 132 | (opts :glyphs))) 133 | 134 | (put opts :sizes (glyphs->size-struct opts (opts :glyphs))) 135 | 136 | (merge-into default-font-conf opts)) 137 | -------------------------------------------------------------------------------- /freja/fonts/EBGaramond12-Regular.otf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/saikyun/freja/068deb7a3ac1ce405443ebf889b9ed0a643c28e0/freja/fonts/EBGaramond12-Regular.otf -------------------------------------------------------------------------------- /freja/fonts/EBGaramond12-Regular_LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2010-2013 Georg Duffner (http://www.georgduffner.at) 2 | 3 | All "EB Garamond" Font Software is licensed under the SIL Open Font License, Version 1.1. 4 | This license is copied below, and is also available with a FAQ at: 5 | http://scripts.sil.org/OFL 6 | 7 | 8 | ----------------------------------------------------------- 9 | SIL OPEN FONT LICENSE Version 1.1 - 26 February 2007 10 | ----------------------------------------------------------- 11 | 12 | PREAMBLE 13 | The goals of the Open Font License (OFL) are to stimulate worldwide 14 | development of collaborative font projects, to support the font creation 15 | efforts of academic and linguistic communities, and to provide a free and 16 | open framework in which fonts may be shared and improved in partnership 17 | with others. 18 | 19 | The OFL allows the licensed fonts to be used, studied, modified and 20 | redistributed freely as long as they are not sold by themselves. The 21 | fonts, including any derivative works, can be bundled, embedded, 22 | redistributed and/or sold with any software provided that any reserved 23 | names are not used by derivative works. The fonts and derivatives, 24 | however, cannot be released under any other type of license. The 25 | requirement for fonts to remain under this license does not apply 26 | to any document created using the fonts or their derivatives. 27 | 28 | DEFINITIONS 29 | "Font Software" refers to the set of files released by the Copyright 30 | Holder(s) under this license and clearly marked as such. This may 31 | include source files, build scripts and documentation. 32 | 33 | "Reserved Font Name" refers to any names specified as such after the 34 | copyright statement(s). 35 | 36 | "Original Version" refers to the collection of Font Software components as 37 | distributed by the Copyright Holder(s). 38 | 39 | "Modified Version" refers to any derivative made by adding to, deleting, 40 | or substituting -- in part or in whole -- any of the components of the 41 | Original Version, by changing formats or by porting the Font Software to a 42 | new environment. 43 | 44 | "Author" refers to any designer, engineer, programmer, technical 45 | writer or other person who contributed to the Font Software. 46 | 47 | PERMISSION & CONDITIONS 48 | Permission is hereby granted, free of charge, to any person obtaining 49 | a copy of the Font Software, to use, study, copy, merge, embed, modify, 50 | redistribute, and sell modified and unmodified copies of the Font 51 | Software, subject to the following conditions: 52 | 53 | 1) Neither the Font Software nor any of its individual components, 54 | in Original or Modified Versions, may be sold by itself. 55 | 56 | 2) Original or Modified Versions of the Font Software may be bundled, 57 | redistributed and/or sold with any software, provided that each copy 58 | contains the above copyright notice and this license. These can be 59 | included either as stand-alone text files, human-readable headers or 60 | in the appropriate machine-readable metadata fields within text or 61 | binary files as long as those fields can be easily viewed by the user. 62 | 63 | 3) No Modified Version of the Font Software may use the Reserved Font 64 | Name(s) unless explicit written permission is granted by the corresponding 65 | Copyright Holder. This restriction only applies to the primary font name as 66 | presented to the users. 67 | 68 | 4) The name(s) of the Copyright Holder(s) or the Author(s) of the Font 69 | Software shall not be used to promote, endorse or advertise any 70 | Modified Version, except to acknowledge the contribution(s) of the 71 | Copyright Holder(s) and the Author(s) or with their explicit written 72 | permission. 73 | 74 | 5) The Font Software, modified or unmodified, in part or in whole, 75 | must be distributed entirely under this license, and must not be 76 | distributed under any other license. The requirement for fonts to 77 | remain under this license does not apply to any document created 78 | using the Font Software. 79 | 80 | TERMINATION 81 | This license becomes null and void if any of the above conditions are 82 | not met. 83 | 84 | DISCLAIMER 85 | THE FONT SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 86 | EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO ANY WARRANTIES OF 87 | MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT 88 | OF COPYRIGHT, PATENT, TRADEMARK, OR OTHER RIGHT. IN NO EVENT SHALL THE 89 | COPYRIGHT HOLDER BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, 90 | INCLUDING ANY GENERAL, SPECIAL, INDIRECT, INCIDENTAL, OR CONSEQUENTIAL 91 | DAMAGES, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING 92 | FROM, OUT OF THE USE OR INABILITY TO USE THE FONT SOFTWARE OR FROM 93 | OTHER DEALINGS IN THE FONT SOFTWARE. 94 | -------------------------------------------------------------------------------- /freja/fonts/FantasqueSansMono-Regular.otf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/saikyun/freja/068deb7a3ac1ce405443ebf889b9ed0a643c28e0/freja/fonts/FantasqueSansMono-Regular.otf -------------------------------------------------------------------------------- /freja/fonts/FantasqueSansMono-Regular_LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2013-2017, Jany Belluz (jany.belluz@hotmail.fr) 2 | 3 | This Font Software is licensed under the SIL Open Font License, Version 1.1. 4 | This license is copied below, and is also available with a FAQ at: 5 | http://scripts.sil.org/OFL 6 | 7 | 8 | ----------------------------------------------------------- 9 | SIL OPEN FONT LICENSE Version 1.1 - 26 February 2007 10 | ----------------------------------------------------------- 11 | 12 | PREAMBLE 13 | The goals of the Open Font License (OFL) are to stimulate worldwide 14 | development of collaborative font projects, to support the font creation 15 | efforts of academic and linguistic communities, and to provide a free and 16 | open framework in which fonts may be shared and improved in partnership 17 | with others. 18 | 19 | The OFL allows the licensed fonts to be used, studied, modified and 20 | redistributed freely as long as they are not sold by themselves. The 21 | fonts, including any derivative works, can be bundled, embedded, 22 | redistributed and/or sold with any software provided that any reserved 23 | names are not used by derivative works. The fonts and derivatives, 24 | however, cannot be released under any other type of license. The 25 | requirement for fonts to remain under this license does not apply 26 | to any document created using the fonts or their derivatives. 27 | 28 | DEFINITIONS 29 | "Font Software" refers to the set of files released by the Copyright 30 | Holder(s) under this license and clearly marked as such. This may 31 | include source files, build scripts and documentation. 32 | 33 | "Reserved Font Name" refers to any names specified as such after the 34 | copyright statement(s). 35 | 36 | "Original Version" refers to the collection of Font Software components as 37 | distributed by the Copyright Holder(s). 38 | 39 | "Modified Version" refers to any derivative made by adding to, deleting, 40 | or substituting -- in part or in whole -- any of the components of the 41 | Original Version, by changing formats or by porting the Font Software to a 42 | new environment. 43 | 44 | "Author" refers to any designer, engineer, programmer, technical 45 | writer or other person who contributed to the Font Software. 46 | 47 | PERMISSION & CONDITIONS 48 | Permission is hereby granted, free of charge, to any person obtaining 49 | a copy of the Font Software, to use, study, copy, merge, embed, modify, 50 | redistribute, and sell modified and unmodified copies of the Font 51 | Software, subject to the following conditions: 52 | 53 | 1) Neither the Font Software nor any of its individual components, 54 | in Original or Modified Versions, may be sold by itself. 55 | 56 | 2) Original or Modified Versions of the Font Software may be bundled, 57 | redistributed and/or sold with any software, provided that each copy 58 | contains the above copyright notice and this license. These can be 59 | included either as stand-alone text files, human-readable headers or 60 | in the appropriate machine-readable metadata fields within text or 61 | binary files as long as those fields can be easily viewed by the user. 62 | 63 | 3) No Modified Version of the Font Software may use the Reserved Font 64 | Name(s) unless explicit written permission is granted by the corresponding 65 | Copyright Holder. This restriction only applies to the primary font name as 66 | presented to the users. 67 | 68 | 4) The name(s) of the Copyright Holder(s) or the Author(s) of the Font 69 | Software shall not be used to promote, endorse or advertise any 70 | Modified Version, except to acknowledge the contribution(s) of the 71 | Copyright Holder(s) and the Author(s) or with their explicit written 72 | permission. 73 | 74 | 5) The Font Software, modified or unmodified, in part or in whole, 75 | must be distributed entirely under this license, and must not be 76 | distributed under any other license. The requirement for fonts to 77 | remain under this license does not apply to any document created 78 | using the Font Software. 79 | 80 | TERMINATION 81 | This license becomes null and void if any of the above conditions are 82 | not met. 83 | 84 | DISCLAIMER 85 | THE FONT SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 86 | EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO ANY WARRANTIES OF 87 | MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT 88 | OF COPYRIGHT, PATENT, TRADEMARK, OR OTHER RIGHT. IN NO EVENT SHALL THE 89 | COPYRIGHT HOLDER BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, 90 | INCLUDING ANY GENERAL, SPECIAL, INDIRECT, INCIDENTAL, OR CONSEQUENTIAL 91 | DAMAGES, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING 92 | FROM, OUT OF THE USE OR INABILITY TO USE THE FONT SOFTWARE OR FROM 93 | OTHER DEALINGS IN THE FONT SOFTWARE. 94 | -------------------------------------------------------------------------------- /freja/fonts/MplusCodeLatin60-Medium.otf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/saikyun/freja/068deb7a3ac1ce405443ebf889b9ed0a643c28e0/freja/fonts/MplusCodeLatin60-Medium.otf -------------------------------------------------------------------------------- /freja/fonts/MplusCodeLatin60-Medium_LICENSE: -------------------------------------------------------------------------------- 1 | Copyright 2021 The M+ FONTS Project Authors (https://github.com/coz-m/MPLUS_FONTS) 2 | 3 | This Font Software is licensed under the SIL Open Font License, Version 1.1. 4 | This license is copied below, and is also available with a FAQ at: 5 | https://scripts.sil.org/OFL 6 | 7 | 8 | ----------------------------------------------------------- 9 | SIL OPEN FONT LICENSE Version 1.1 - 26 February 2007 10 | ----------------------------------------------------------- 11 | 12 | PREAMBLE 13 | The goals of the Open Font License (OFL) are to stimulate worldwide 14 | development of collaborative font projects, to support the font creation 15 | efforts of academic and linguistic communities, and to provide a free and 16 | open framework in which fonts may be shared and improved in partnership 17 | with others. 18 | 19 | The OFL allows the licensed fonts to be used, studied, modified and 20 | redistributed freely as long as they are not sold by themselves. The 21 | fonts, including any derivative works, can be bundled, embedded, 22 | redistributed and/or sold with any software provided that any reserved 23 | names are not used by derivative works. The fonts and derivatives, 24 | however, cannot be released under any other type of license. The 25 | requirement for fonts to remain under this license does not apply 26 | to any document created using the fonts or their derivatives. 27 | 28 | DEFINITIONS 29 | "Font Software" refers to the set of files released by the Copyright 30 | Holder(s) under this license and clearly marked as such. This may 31 | include source files, build scripts and documentation. 32 | 33 | "Reserved Font Name" refers to any names specified as such after the 34 | copyright statement(s). 35 | 36 | "Original Version" refers to the collection of Font Software components as 37 | distributed by the Copyright Holder(s). 38 | 39 | "Modified Version" refers to any derivative made by adding to, deleting, 40 | or substituting -- in part or in whole -- any of the components of the 41 | Original Version, by changing formats or by porting the Font Software to a 42 | new environment. 43 | 44 | "Author" refers to any designer, engineer, programmer, technical 45 | writer or other person who contributed to the Font Software. 46 | 47 | PERMISSION & CONDITIONS 48 | Permission is hereby granted, free of charge, to any person obtaining 49 | a copy of the Font Software, to use, study, copy, merge, embed, modify, 50 | redistribute, and sell modified and unmodified copies of the Font 51 | Software, subject to the following conditions: 52 | 53 | 1) Neither the Font Software nor any of its individual components, 54 | in Original or Modified Versions, may be sold by itself. 55 | 56 | 2) Original or Modified Versions of the Font Software may be bundled, 57 | redistributed and/or sold with any software, provided that each copy 58 | contains the above copyright notice and this license. These can be 59 | included either as stand-alone text files, human-readable headers or 60 | in the appropriate machine-readable metadata fields within text or 61 | binary files as long as those fields can be easily viewed by the user. 62 | 63 | 3) No Modified Version of the Font Software may use the Reserved Font 64 | Name(s) unless explicit written permission is granted by the corresponding 65 | Copyright Holder. This restriction only applies to the primary font name as 66 | presented to the users. 67 | 68 | 4) The name(s) of the Copyright Holder(s) or the Author(s) of the Font 69 | Software shall not be used to promote, endorse or advertise any 70 | Modified Version, except to acknowledge the contribution(s) of the 71 | Copyright Holder(s) and the Author(s) or with their explicit written 72 | permission. 73 | 74 | 5) The Font Software, modified or unmodified, in part or in whole, 75 | must be distributed entirely under this license, and must not be 76 | distributed under any other license. The requirement for fonts to 77 | remain under this license does not apply to any document created 78 | using the Font Software. 79 | 80 | TERMINATION 81 | This license becomes null and void if any of the above conditions are 82 | not met. 83 | 84 | DISCLAIMER 85 | THE FONT SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 86 | EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO ANY WARRANTIES OF 87 | MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT 88 | OF COPYRIGHT, PATENT, TRADEMARK, OR OTHER RIGHT. IN NO EVENT SHALL THE 89 | COPYRIGHT HOLDER BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, 90 | INCLUDING ANY GENERAL, SPECIAL, INDIRECT, INCIDENTAL, OR CONSEQUENTIAL 91 | DAMAGES, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING 92 | FROM, OUT OF THE USE OR INABILITY TO USE THE FONT SOFTWARE OR FROM 93 | OTHER DEALINGS IN THE FONT SOFTWARE. 94 | -------------------------------------------------------------------------------- /freja/fonts/Poppins-Regular.otf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/saikyun/freja/068deb7a3ac1ce405443ebf889b9ed0a643c28e0/freja/fonts/Poppins-Regular.otf -------------------------------------------------------------------------------- /freja/fonts/Poppins-Regular_LICENSE: -------------------------------------------------------------------------------- 1 | Copyright 2020 The Poppins Project Authors (https://github.com/itfoundry/Poppins) 2 | 3 | This Font Software is licensed under the SIL Open Font License, Version 1.1. 4 | This license is copied below, and is also available with a FAQ at: 5 | http://scripts.sil.org/OFL 6 | 7 | 8 | ----------------------------------------------------------- 9 | SIL OPEN FONT LICENSE Version 1.1 - 26 February 2007 10 | ----------------------------------------------------------- 11 | 12 | PREAMBLE 13 | The goals of the Open Font License (OFL) are to stimulate worldwide 14 | development of collaborative font projects, to support the font creation 15 | efforts of academic and linguistic communities, and to provide a free and 16 | open framework in which fonts may be shared and improved in partnership 17 | with others. 18 | 19 | The OFL allows the licensed fonts to be used, studied, modified and 20 | redistributed freely as long as they are not sold by themselves. The 21 | fonts, including any derivative works, can be bundled, embedded, 22 | redistributed and/or sold with any software provided that any reserved 23 | names are not used by derivative works. The fonts and derivatives, 24 | however, cannot be released under any other type of license. The 25 | requirement for fonts to remain under this license does not apply 26 | to any document created using the fonts or their derivatives. 27 | 28 | DEFINITIONS 29 | "Font Software" refers to the set of files released by the Copyright 30 | Holder(s) under this license and clearly marked as such. This may 31 | include source files, build scripts and documentation. 32 | 33 | "Reserved Font Name" refers to any names specified as such after the 34 | copyright statement(s). 35 | 36 | "Original Version" refers to the collection of Font Software components as 37 | distributed by the Copyright Holder(s). 38 | 39 | "Modified Version" refers to any derivative made by adding to, deleting, 40 | or substituting -- in part or in whole -- any of the components of the 41 | Original Version, by changing formats or by porting the Font Software to a 42 | new environment. 43 | 44 | "Author" refers to any designer, engineer, programmer, technical 45 | writer or other person who contributed to the Font Software. 46 | 47 | PERMISSION & CONDITIONS 48 | Permission is hereby granted, free of charge, to any person obtaining 49 | a copy of the Font Software, to use, study, copy, merge, embed, modify, 50 | redistribute, and sell modified and unmodified copies of the Font 51 | Software, subject to the following conditions: 52 | 53 | 1) Neither the Font Software nor any of its individual components, 54 | in Original or Modified Versions, may be sold by itself. 55 | 56 | 2) Original or Modified Versions of the Font Software may be bundled, 57 | redistributed and/or sold with any software, provided that each copy 58 | contains the above copyright notice and this license. These can be 59 | included either as stand-alone text files, human-readable headers or 60 | in the appropriate machine-readable metadata fields within text or 61 | binary files as long as those fields can be easily viewed by the user. 62 | 63 | 3) No Modified Version of the Font Software may use the Reserved Font 64 | Name(s) unless explicit written permission is granted by the corresponding 65 | Copyright Holder. This restriction only applies to the primary font name as 66 | presented to the users. 67 | 68 | 4) The name(s) of the Copyright Holder(s) or the Author(s) of the Font 69 | Software shall not be used to promote, endorse or advertise any 70 | Modified Version, except to acknowledge the contribution(s) of the 71 | Copyright Holder(s) and the Author(s) or with their explicit written 72 | permission. 73 | 74 | 5) The Font Software, modified or unmodified, in part or in whole, 75 | must be distributed entirely under this license, and must not be 76 | distributed under any other license. The requirement for fonts to 77 | remain under this license does not apply to any document created 78 | using the Font Software. 79 | 80 | TERMINATION 81 | This license becomes null and void if any of the above conditions are 82 | not met. 83 | 84 | DISCLAIMER 85 | THE FONT SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 86 | EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO ANY WARRANTIES OF 87 | MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT 88 | OF COPYRIGHT, PATENT, TRADEMARK, OR OTHER RIGHT. IN NO EVENT SHALL THE 89 | COPYRIGHT HOLDER BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, 90 | INCLUDING ANY GENERAL, SPECIAL, INDIRECT, INCIDENTAL, OR CONSEQUENTIAL 91 | DAMAGES, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING 92 | FROM, OUT OF THE USE OR INABILITY TO USE THE FONT SOFTWARE OR FROM 93 | OTHER DEALINGS IN THE FONT SOFTWARE. 94 | -------------------------------------------------------------------------------- /freja/fonts/TamzenForPowerline10x20b.ttf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/saikyun/freja/068deb7a3ac1ce405443ebf889b9ed0a643c28e0/freja/fonts/TamzenForPowerline10x20b.ttf -------------------------------------------------------------------------------- /freja/fonts/TamzenForPowerline10x20b_LICENSE: -------------------------------------------------------------------------------- 1 | 2 | _____ __ _ 3 | |_ _|_ _ _ __ ___ ___ _ _ _ __ / _| ___ _ __ | |_ 4 | | |/ _` | '_ ` _ \/ __| | | | '_ \ | |_ / _ \| '_ \| __| 5 | | | (_| | | | | | \__ \ |_| | | | | | _| (_) | | | | |_ 6 | |_|\__,_|_| |_| |_|___/\__, |_| |_| |_| \___/|_| |_|\__| 7 | |___/ 8 | 9 | 10 | Copyright 2010 Scott Fial 11 | 12 | Tamsyn font is free. You are hereby granted permission to use, copy, modify, 13 | and distribute it as you see fit. 14 | 15 | Tamsyn font is provided "as is" without any express or implied warranty. 16 | 17 | The author makes no representations about the suitability of this font for 18 | a particular purpose. 19 | 20 | In no event will the author be held liable for damages arising from the use 21 | of this font. 22 | 23 | _____ __ _ 24 | |_ _|_ _ _ __ ___ _______ _ __ / _| ___ _ __ | |_ 25 | | |/ _` | '_ ` _ \|_ / _ \ '_ \ | |_ / _ \| '_ \| __| 26 | | | (_| | | | | | |/ / __/ | | | | _| (_) | | | | |_ 27 | |_|\__,_|_| |_| |_/___\___|_| |_| |_| \___/|_| |_|\__| 28 | 29 | 30 | Copyright 2011 Suraj N. Kurapati 31 | 32 | Tamzen font is free. You are hereby granted permission to use, copy, modify, 33 | and distribute it as you see fit. 34 | 35 | Tamzen font is provided "as is" without any express or implied warranty. 36 | 37 | The author makes no representations about the suitability of this font for 38 | a particular purpose. 39 | 40 | In no event will the author be held liable for damages arising from the use 41 | of this font. -------------------------------------------------------------------------------- /freja/handle-ext/init.janet: -------------------------------------------------------------------------------- 1 | (import ./janet) 2 | -------------------------------------------------------------------------------- /freja/handle-ext/janet.janet: -------------------------------------------------------------------------------- 1 | (import ../state) 2 | (import freja/checkpoint) 3 | (import freja/textarea) 4 | (import freja/theme) 5 | (import freja/editor) 6 | (import ../open-file) 7 | (import ../file-handling :as fh) 8 | (import freja/event/subscribe :as s) 9 | 10 | (defn new-editor-state 11 | [{:path path}] 12 | (def state @{}) 13 | 14 | (put state :editor (textarea/default-textarea-state)) 15 | (put state :freja/label path) 16 | (put state :freja/focus (fn [{:editor editor}] 17 | (state/focus! editor))) 18 | (put state :freja/focus? (fn [{:editor editor}] 19 | (= editor (state/focus :focus)))) 20 | (put state :freja/quit (fn [{:editor editor} cb] 21 | (checkpoint/save-checkpoint (get-in editor [:gb :path]) "before quitting") 22 | 23 | (def path (get-in editor [:gb :path])) 24 | (if (get-in editor [:gb :ever-modified]) 25 | (do 26 | (fh/save-before-closing (editor :gb) 27 | |(do (cb) 28 | (open-file/close-file path)))) 29 | (do 30 | (open-file/close-file path) 31 | (cb))))) 32 | 33 | (checkpoint/load-file-with-checkpoints (state :editor) path) 34 | 35 | state) 36 | 37 | (defn default-editor 38 | [props & _] 39 | (def {:bottom bottom 40 | :bottom-h bottom-h} props) 41 | [:background {:color (if (= (state/focus :focus) 42 | (props :editor)) 43 | (theme/comp-cols :background) 44 | :blank)} 45 | [:padding {:all 2} 46 | [editor/editor {:state props 47 | :text/size (get state/editor-state :text/size) 48 | :id :left 49 | :focus-on-init true 50 | #:initial-file state/initial-file 51 | :open (props :left-open) 52 | :set-open |(do #TODO: REMOVE 53 | (s/put! state/editor-state :force-refresh true) 54 | (s/put! props :left-open $))}]]]) 55 | 56 | (state/add-ext-handling 57 | ".janet" 58 | (fn [_] 59 | default-editor) 60 | new-editor-state) 61 | -------------------------------------------------------------------------------- /freja/hiccup.janet: -------------------------------------------------------------------------------- 1 | (use ./defonce) 2 | 3 | (import ./state) 4 | (import ./event/subscribe :as s) 5 | (import ./event/callback) 6 | (import ./assets :as a) 7 | 8 | (import freja-layout/sizing/definite :as def-siz) 9 | (import freja-layout/sizing/relative :as rel-siz) 10 | (import freja-layout/compile-hiccup :as ch) 11 | (import freja-layout/jaylib-tags :as jt) 12 | 13 | (defonce render-tree @{}) 14 | 15 | (var children-on-event nil) 16 | 17 | (use profiling/profile) 18 | 19 | (defn elem-on-event 20 | [e ev] 21 | # traverse children first 22 | # will return true if the event is taken 23 | (with-dyns [:offset-x (+ (dyn :offset-x) 24 | (get e :left 0) 25 | (get-in e [:offset 3] 0)) 26 | :offset-y (+ (dyn :offset-y) 27 | (get e :top 0) 28 | (get-in e [:offset 0] 0))] 29 | (if 30 | (children-on-event e ev) 31 | true 32 | 33 | (when (e :on-event) 34 | (:on-event e ev))))) 35 | 36 | (varfn children-on-event 37 | [{:children cs 38 | :content-width content-width} ev] 39 | (var taken false) 40 | 41 | (var x 0) 42 | (var y 0) 43 | (var row-h 0) 44 | 45 | (def max-h (dyn :event-max-h)) 46 | 47 | (loop [c :in cs 48 | :let [{:width w 49 | :height h 50 | :left x 51 | :top y} c] 52 | :until (or taken (> y max-h))] 53 | (set taken (elem-on-event c ev))) 54 | 55 | taken) 56 | 57 | 58 | (defn handle-ev 59 | [tree ev] 60 | # only run events if no one else has already taken the event 61 | (unless (state/callbacks ev) 62 | # offset is the top left corner of each element 63 | (with-dyns [:offset-x 0 64 | :offset-y 0 65 | :event-max-h (tree :height)] 66 | (when (elem-on-event tree ev) 67 | (callback/put! ev (fn [])))))) 68 | 69 | (defn compile-tree 70 | [hiccup props &keys {:max-width max-width 71 | :max-height max-height 72 | :tags tags 73 | :text/font text/font 74 | :text/size text/size 75 | :old-root old-root}] 76 | (let [to-init @[]] 77 | (put props :compilation/changed true) 78 | 79 | (with-dyns [:text/font text/font 80 | :text/size text/size 81 | :text/get-font a/font] 82 | (def root #(test/timeit 83 | (ch/compile [hiccup props] 84 | :tags tags 85 | :element old-root 86 | :to-init to-init)) 87 | 88 | (def root-with-sizes 89 | (-> root 90 | (def-siz/set-definite-sizes max-width max-height) 91 | (rel-siz/set-relative-size max-width max-height))) 92 | 93 | (put props :compilation/changed false) 94 | 95 | (ch/init-all to-init) 96 | 97 | root-with-sizes)) 98 | 99 | # 100 | ) 101 | 102 | 103 | # table with all layers that have names 104 | # if a new layer is created with a name 105 | # it is added to named-layers 106 | # if it already exists in named-layers, 107 | # instead the layer to be added replaces 108 | # the layer already existing 109 | (defonce named-layers @{}) 110 | 111 | (defn remove-layer 112 | [name props] 113 | (when-let [l (named-layers name)] 114 | (put l :on-event (fn [& _]))) 115 | (put named-layers name nil)) 116 | 117 | (def default-hiccup-renderer 118 | {:draw (fn [self dt] 119 | (with-dyns [:text/get-font a/font] 120 | ((self :render) 121 | (self :root)))) 122 | :compile (defn compile 123 | [self props] 124 | (compile-tree 125 | (self :hiccup) 126 | props 127 | :tags (self :tags) 128 | :max-width (self :max-width) 129 | :max-height (self :max-height) 130 | :text/font (self :text/font) 131 | :text/size (self :text/size) 132 | :old-root (self :root))) 133 | 134 | :on-event (defnp hiccup-on-event [self ev] 135 | (try 136 | (match ev 137 | {:screen/width w 138 | :screen/height h} 139 | (do 140 | (put self :max-width w) 141 | (put self :max-height h) 142 | 143 | (put self :root (:compile self (self :props)))) 144 | 145 | {:frame/delta-time dt} 146 | (:draw self dt) 147 | 148 | # new props 149 | {:compilation/changed _} 150 | (-> self 151 | (put :props ev) 152 | (put :root (:compile self ev))) 153 | 154 | (handle-ev (self :root) ev)) 155 | 156 | ([err fib] 157 | (eprint "Error during event:") 158 | (eprintf "%P" ev) 159 | 160 | (propagate err fib) 161 | 162 | (when (self :remove-layer-on-error) 163 | (printf "Removing layer: %s" (self :name)) 164 | (remove-layer (self :name) (self :props))))))}) 165 | 166 | (defn new-layer 167 | [name 168 | hiccup 169 | props 170 | &keys {:render render 171 | :max-width max-width 172 | :max-height max-height 173 | :tags tags 174 | :text/font text/font 175 | :text/size text/size 176 | :remove-layer-on-error remove-layer-on-error}] 177 | 178 | (def render-tree (or (named-layers name) 179 | (let [c @{}] 180 | (put named-layers name c) 181 | c))) 182 | 183 | # reset the component 184 | (loop [k :keys render-tree] 185 | (put render-tree k nil)) 186 | 187 | (put render-tree :hiccup hiccup) 188 | 189 | (put render-tree :remove-layer-on-error remove-layer-on-error) 190 | 191 | (put render-tree :name name) 192 | (put render-tree :props props) 193 | 194 | (default render jt/render) 195 | (put render-tree :render |(render $ 0 0)) 196 | 197 | (default max-width (state/screen-size :screen/width)) 198 | (put render-tree :max-width max-width) 199 | 200 | (default max-height (state/screen-size :screen/height)) 201 | (put render-tree :max-height max-height) 202 | 203 | (default tags jt/tags) 204 | (put render-tree :tags tags) 205 | 206 | (put render-tree :text/font text/font) 207 | (put render-tree :text/size text/size) 208 | 209 | (merge-into 210 | render-tree 211 | default-hiccup-renderer) 212 | 213 | #(put props :event/changed true) 214 | 215 | (put render-tree :root (:compile render-tree props)) 216 | 217 | (s/subscribe! props render-tree) 218 | (s/subscribe-finally! state/frame-events render-tree) 219 | (s/subscribe-first! state/mouse render-tree) 220 | (s/subscribe! state/screen-size render-tree) 221 | 222 | render-tree) 223 | -------------------------------------------------------------------------------- /freja/highlighting.janet: -------------------------------------------------------------------------------- 1 | (use ./new_gap_buffer) 2 | 3 | (defn styling 4 | [k patt] 5 | ['/ ['* ['$] patt ['$]] 6 | (fn [start stop] 7 | #{:kind k :start start :stop stop} 8 | [start stop k])]) 9 | 10 | (var styling-grammar 11 | ~{:ws (set " \t\r\f\n\0\v") 12 | :readermac (set "';~,|") 13 | :symchars (+ (range "09" "AZ" "az" "\x80\xFF") (set "!$%&*+-./:@^_")) 14 | :token (some :symchars) 15 | :hex (range "09" "af" "AF") 16 | :escape (* "\\" (+ (set "ntrzfev0\"\\") 17 | (* "x" :hex :hex) 18 | (* "u" [4 :hex]) 19 | (* "U" [6 :hex]) 20 | (error (constant "bad escape")))) 21 | :comment ,(styling :comment ~(* "#" (any (if-not (+ "\n" -1) 1)))) 22 | :special-symbol ,(styling :special-symbol '(* (+ "defn" "varfn" "var" "set" "def") 23 | (not :symchars))) 24 | :symbol ,(styling :symbol :token) 25 | :keyword ,(styling :keyword ~(* ":" (any :symchars))) 26 | :constant (* (+ "true" "false" "nil") (not :symchars)) 27 | :bytes (* "\"" (any (+ :escape (if-not "\"" 1))) (opt "\"")) 28 | :string ,(styling :string :bytes) 29 | :buffer ,(styling :string ~(* "@" :bytes)) 30 | :long-bytes {:delim (some "`") 31 | :open (capture :delim :n) 32 | :close (drop (cmt (* (not (> -1 "`")) (-> :n) ':delim) ,=)) 33 | :main (drop (* :open (any (if-not :close 1)) :close))} 34 | :long-string ,(styling :long-string :long-bytes) 35 | :long-buffer ,(styling :long-string ~(* "@" :long-bytes)) 36 | :number ,(styling :number ~(drop (cmt (<- :token) ,scan-number))) 37 | :raw-value (+ :comment :constant :number :keyword 38 | :string :buffer :long-string :long-buffer 39 | :parray :barray :call 40 | :ptuple :btuple :struct :dict :special-symbol :symbol) 41 | :value (* (any (+ :ws :readermac)) :raw-value (any :ws)) 42 | :root (any :value) 43 | :root2 (any (* :value :value)) 44 | :call (* "(" ,(styling :call '(drop (if-not :special-symbol :symbol))) :root (+ ")" 0)) 45 | :ptuple (* "(" :root (+ ")" 0)) 46 | :btuple (* "[" :root (+ "]" 0)) 47 | :struct (* "{" :root2 (+ "}" 0)) 48 | :parray (* "@" :ptuple) 49 | :barray (* "@" :btuple) 50 | :dict (* "@" :struct) 51 | :main :root}) 52 | 53 | (def colors {:symbol :green}) 54 | 55 | (defn gb->styling 56 | [gb] 57 | (peg/match styling-grammar (content gb))) 58 | 59 | # (pp (gb->styling gb-data)) 60 | 61 | -------------------------------------------------------------------------------- /freja/input.janet: -------------------------------------------------------------------------------- 1 | (use freja-jaylib) 2 | (import freja/state) 3 | (import ./dumb :prefix "") 4 | (import ./new_gap_buffer :as gb) 5 | (import ./render_new_gap_buffer :as render-gb) 6 | (import ./code_api :prefix "") 7 | (import ./text_rendering :prefix "") 8 | (import ./find_row_etc :prefix "") 9 | (import ./collision :prefix "") 10 | 11 | (def mouse-events {:mouse/down :mouse/press 12 | :mouse/move :mouse/move 13 | :mouse/drag :mouse/drag 14 | :mouse/release :mouse/release 15 | :mouse/double-click :mouse/double-click 16 | :mouse/triple-click :mouse/triple-click 17 | :mouse/scroll :mouse/scroll}) 18 | 19 | (defn new-mouse-data 20 | [] 21 | @{:just-down nil 22 | :just-double-clicked nil 23 | :just-triple-clicked nil 24 | :recently-double-clicked nil 25 | :recently-triple-clicked nil 26 | :down-pos nil 27 | :down-time nil 28 | :down-time2 nil 29 | :up-pos nil 30 | :selected-pos nil 31 | :last-text-pos nil}) 32 | 33 | (defn key-down? 34 | [k] 35 | (state/keys-down k)) 36 | 37 | ## delay before first repetition of held keys 38 | # TODO: if these delays are set to super low, frp bugs and wont release keys 39 | (var initial-delay 0.2) 40 | 41 | ## delay of each repetition thereafter 42 | (var repeat-delay 0.03) 43 | 44 | ## stores held keys and the delay until they should trigger 45 | (var delay-left @{}) 46 | 47 | (def modifiers [:caps-lock :control :right-control :alt :shift :super :right-super 48 | :right-alt #:meta 49 | ]) 50 | 51 | (def check-modifiers 52 | {:caps-lock |(and (not= $ :caps-lock) 53 | (key-down? :caps-lock)) 54 | #:control |(and (not= $ :left-control) 55 | # (not= $ :right-control) 56 | # (or (key-down? :left-control) 57 | # (key-down? :right-control))) 58 | 59 | :control |(and (not= $ :left-control) 60 | (key-down? :left-control)) 61 | 62 | :super |(and (not= $ :left-super) 63 | (key-down? :left-super)) 64 | 65 | :right-super |(and (not= $ :right-super) 66 | (key-down? :right-super)) 67 | 68 | :right-control |(and (not= $ :right-control) 69 | (key-down? :right-control)) 70 | 71 | :shift |(and (not= $ :left-shift) 72 | (not= $ :right-shift) 73 | (or (key-down? :left-shift) 74 | (key-down? :right-shift))) 75 | 76 | :alt |(and (not= $ :left-alt) 77 | (key-down? :left-alt)) 78 | :right-alt |(and (not= $ :right-alt) 79 | (key-down? :right-alt))}) 80 | 81 | (defn set-key 82 | [kmap ks f] 83 | (var key (last ks)) 84 | (var mods @[]) 85 | 86 | # this ensures mods are ordered the same way 87 | (def mod-keys (take (dec (length ks)) ks)) 88 | (loop [m :in modifiers] 89 | (loop [k :in mod-keys] 90 | (var found false) 91 | (when (= k m) 92 | (array/push mods k) 93 | (break)))) 94 | 95 | (unless (= (length mods) (length mod-keys)) 96 | (errorf "mod-keys %p contains keys not available in modifiers: %p" mod-keys mods)) 97 | 98 | (array/push mods key) 99 | (put-in kmap mods f)) 100 | 101 | (defn hotkey-triggered 102 | [kmap key-code kind] 103 | (def mods (seq [m :in modifiers 104 | :when ((in check-modifiers m) key-code)] 105 | m)) 106 | 107 | # (printf "%p %p" mods key-code) 108 | 109 | (var ret-f nil) 110 | (loop [[k f] :pairs (or (get-in kmap mods) []) 111 | :when (= k key-code)] 112 | (if-let [specific-f (and (table? f) 113 | (in f kind))] 114 | (do 115 | (set ret-f specific-f) 116 | (break)) 117 | 118 | (when (and (or (= kind :key-down) 119 | (= kind :key-repeat) 120 | (= kind :char)) 121 | (function? f)) 122 | (set ret-f f) 123 | (break)))) 124 | 125 | (if ret-f 126 | ret-f 127 | (when-let [p (and (not ret-f) 128 | (table/getproto kmap))] 129 | (hotkey-triggered p key-code kind)))) 130 | 131 | (defn get-hotkey 132 | [kmap f &opt keys] 133 | (default keys []) 134 | 135 | (var ret-ks nil) 136 | 137 | (loop [[k f2] :pairs kmap] 138 | (cond (and (function? f2) 139 | (= f f2)) 140 | (do (set ret-ks [;keys k]) 141 | (break)) 142 | 143 | (or (table? f2) (struct? f2)) 144 | (set ret-ks (get-hotkey f2 f [;keys k])) 145 | (when ret-ks (break)))) 146 | 147 | (if ret-ks ret-ks 148 | (when-let [p (table/getproto kmap)] 149 | (get-hotkey p f keys)))) 150 | 151 | (comment 152 | (= global-keys (table/getproto (gb-data :binds))) 153 | (get-hotkey (gb-data :binds) redo!) 154 | (get-hotkey global-keys redo!) 155 | (get-hotkey global-keys gb/copy) 156 | # 157 | ) 158 | 159 | 160 | (defn handle-keyboard2 161 | [props k kind] 162 | (def {:binds binds} props) 163 | 164 | # TODO: Need to add get-char-pressed 165 | 166 | (when-let [f (hotkey-triggered (props :binds) k kind)] 167 | (f props)) 168 | 169 | (comment 170 | (when-let [f (binds k)] 171 | (reset-blink props) 172 | (f props) 173 | 174 | (scroll-to-focus props)))) 175 | 176 | (defn handle-keyboard-char 177 | [props k] 178 | 179 | (def {:binds binds} props) 180 | 181 | # TODO: Need to add get-char-pressed 182 | 183 | (reset-blink props) 184 | 185 | (let [f (hotkey-triggered (props :binds) k :char)] 186 | (cond 187 | f (f props) 188 | 189 | (or (key-down? :left-shift) 190 | (key-down? :right-shift)) 191 | (gb/insert-char-upper! props k) 192 | 193 | (gb/insert-char! props k)) 194 | 195 | (scroll-to-focus props))) 196 | 197 | (defn handle-scroll-event 198 | [props move] 199 | (if-let [max-y (-?> (props :y-poses) 200 | last 201 | - 202 | (* (screen-scale 1)))] 203 | (update props :scroll |(max max-y (min 0 (+ $ (* move 20))))) 204 | (update props :scroll |(min 0 (+ $ (* move 20))))) 205 | 206 | (put props :changed-scroll true)) 207 | 208 | (defn get-mouse-pos 209 | [props [mx my]] 210 | 211 | (def {:lines lines 212 | :y-poses y-poses 213 | :line-flags line-flags 214 | :position position 215 | :offset offset 216 | :width-of-last-line-number width-of-last-line-number 217 | :scroll scroll} props) 218 | 219 | (def [x-pos y-pos] position) 220 | (def [ox oy] offset) 221 | 222 | (def y-offset (+ oy y-pos (* # (conf :mult) 223 | scroll))) 224 | 225 | (def [x-scale _] screen-scale) 226 | 227 | (unless (empty? lines) 228 | (let [line-index (-> (binary-search-closest 229 | y-poses 230 | |(compare my (+ $ y-offset))) 231 | dec 232 | (max 0)) 233 | row-start-pos (if (= 0 line-index) 234 | 0 235 | (lines (dec line-index))) 236 | row-end-pos (lines line-index) 237 | char-i (render-gb/index-passing-middle-max-width 238 | props 239 | row-start-pos 240 | row-end-pos 241 | # take mouse x in absolute space 242 | # and remove the stuff left of 243 | # the beginning of the row (e.g. line number width) 244 | (- mx 245 | (render-gb/abs-text-x props 0))) 246 | 247 | flag (line-flags (max 0 (dec line-index)))] 248 | 249 | (min 250 | (gb/gb-length props) 251 | (cond 252 | (zero? char-i) char-i 253 | 254 | (and (= flag :regular) 255 | (= row-start-pos char-i)) ## to the left of \n 256 | (inc char-i) 257 | 258 | char-i))))) 259 | 260 | (defn get-mouse-pos-line 261 | [props [mx my]] 262 | 263 | (def {:lines lines 264 | :y-poses y-poses 265 | :line-flags line-flags 266 | :position position 267 | :offset offset 268 | :width-of-last-line-number width-of-last-line-number 269 | :scroll scroll} props) 270 | 271 | (def [x-pos y-pos] position) 272 | (def [ox oy] offset) 273 | 274 | (def y-offset (+ oy y-pos (* # (conf :mult) 275 | scroll))) 276 | 277 | (def [x-scale _] screen-scale) 278 | 279 | (unless (empty? lines) 280 | (let [line-index (-> (binary-search-closest 281 | y-poses 282 | |(compare my (+ $ y-offset))) 283 | dec 284 | (max 0)) 285 | row-start-pos (if (= 0 line-index) 286 | 0 287 | (lines (dec line-index))) 288 | row-end-pos (lines line-index) 289 | char-i (render-gb/index-passing-middle-max-width 290 | props 291 | row-start-pos 292 | row-end-pos 293 | # take mouse x in absolute space 294 | # and remove the stuff left of 295 | # the beginning of the row (e.g. line number width) 296 | (- mx 297 | (render-gb/abs-text-x props 0))) 298 | 299 | flag (line-flags (max 0 (dec line-index)))] 300 | 301 | [(max 0 (dec line-index)) 302 | (min 303 | (gb/gb-length props) 304 | (cond 305 | (zero? char-i) char-i 306 | 307 | (and (= flag :regular) 308 | (= row-start-pos char-i)) ## to the left of \n 309 | (inc char-i) 310 | 311 | char-i))]))) 312 | 313 | 314 | (defn handle-shift-mouse-down 315 | [props {:mouse/pos mouse-pos} cb] 316 | (def {:lines lines 317 | :offset offset 318 | :position position 319 | :y-poses y-poses 320 | :sizes sizes 321 | :scroll scroll} props) 322 | 323 | (def [ox oy] offset) 324 | (def [x-pos y-pos] position) 325 | 326 | (def [x y] mouse-pos) 327 | 328 | (def y-offset (+ y-pos oy (* #(conf :mult) 329 | scroll))) 330 | (def x-offset (+ x-pos ox)) 331 | 332 | (if (nil? (props :selection)) 333 | (cb |(-> props 334 | (put :selection (props :caret)) 335 | (gb/put-caret (get-mouse-pos props mouse-pos)) 336 | (put :stickiness (if (< x x-offset) :down :right)) 337 | (put :changed-selection true))) 338 | 339 | (cb |(let [curr-pos (get-mouse-pos props mouse-pos) 340 | start (min (props :selection) (props :caret)) 341 | stop (max (props :selection) (props :caret))] 342 | (-> props 343 | (put :selection 344 | (if (> curr-pos start) 345 | start 346 | stop)) 347 | (gb/put-caret curr-pos) 348 | (put :stickiness (if (< x x-offset) :down :right)) 349 | (put :changed-selection true)))))) 350 | 351 | (defn gb-rec 352 | [{:offset offset 353 | :position position 354 | :size size 355 | :scroll scroll}] 356 | 357 | (def [ox oy] offset) 358 | (def [x-pos y-pos] position) 359 | 360 | (def y-offset 0) # (+ y-pos oy)) # (* (conf :mult) scroll))) 361 | (def x-offset 0) #(+ x-pos ox)) 362 | 363 | [x-offset 364 | y-offset 365 | (size 0) 366 | (size 1)]) 367 | 368 | (defn handle-mouse-event 369 | [props event cb] 370 | (def {:lines lines 371 | :offset offset 372 | :position position 373 | :y-poses y-poses 374 | :size size 375 | :sizes sizes 376 | :scroll scroll 377 | :width-of-last-line-number width-of-last-line-number} props) 378 | (def {:mouse/pos mouse-pos} event) 379 | (def [x y] mouse-pos) 380 | 381 | (def [ox oy] offset) 382 | (def [x-pos y-pos] position) 383 | 384 | (def y-offset (+ y-pos oy (* 1 #mult 385 | scroll))) 386 | (def x-offset (+ x-pos ox)) 387 | 388 | (when (in-rec? mouse-pos 389 | (gb-rec props)) 390 | (match event 391 | {:mouse/release _} 392 | (cb |(put props :down-index nil)) 393 | 394 | {:mouse/triple-click _} 395 | (cb |(gb/select-region props ;(gb/find-surrounding-paragraph! 396 | props 397 | (get-mouse-pos props mouse-pos)))) 398 | # should maybe remember original pos 399 | 400 | ({:mouse/double-click _} 401 | (and (not (key-down? :left-shift)) 402 | (not (key-down? :right-shift)))) 403 | (cb |(gb/select-region props ;(gb/word-at-index props 404 | (get-mouse-pos props mouse-pos)))) 405 | # should maybe remember original pos 406 | 407 | ({:mouse/down _} 408 | (and (or (key-down? :left-shift) 409 | (key-down? :right-shift)))) 410 | (handle-shift-mouse-down props event cb) 411 | 412 | {:mouse/down _} 413 | (if-let [f (get-in props [:binds :press])] 414 | (cb |(f (get-mouse-pos-line props mouse-pos))) 415 | (cb |(let [[line cur-index] (get-mouse-pos-line props mouse-pos) 416 | # # if true, this means cur-index is at the start of the line 417 | stickiness (if (= cur-index (lines line)) 418 | :down 419 | :right)] 420 | (-> props 421 | reset-blink 422 | (put :down-index cur-index) 423 | (put :selection nil) 424 | (put :changed-selection true) 425 | (put :caret cur-index) 426 | (put :changed-x-pos true) 427 | (put :stickiness stickiness) 428 | (put :changed-nav true))))) 429 | 430 | ({:mouse/drag _} 431 | # if this is nil, the press happened outside the textarea 432 | (props :down-index)) 433 | (cb |(let [down-pos (props :down-index) 434 | curr-pos (get-mouse-pos props mouse-pos)] 435 | 436 | (if (not= down-pos curr-pos) 437 | (-> props 438 | (put :selection down-pos) 439 | (put :changed-selection true)) 440 | (-> props 441 | (put :selection nil) 442 | (put :changed-selection true))) 443 | 444 | (-> props 445 | (put :caret curr-pos) 446 | (put :stickiness (if (< x x-offset) :down :right)) 447 | (put :changed-nav true))))))) 448 | 449 | # table containing all positions that should be 450 | # offset by `offset-event-pos` 451 | (def event-positions 452 | @{:mouse/down :mouse/press 453 | :mouse/drag :mouse/drag 454 | :mouse/move :mouse/move 455 | :mouse/release :mouse/release 456 | :mouse/double-click :mouse/double-click 457 | :mouse/triple-click :mouse/triple-click 458 | :mouse/pos :mouse/pos}) 459 | 460 | (defn offset-event-pos 461 | `` 462 | Offsets all (known) positions in an event. 463 | This is used to transform an event from global positions, 464 | to local positions, e.g. the top left of a textarea being [0 0]. 465 | `` 466 | [ev ox oy &keys {:scale scale}] 467 | (default scale 1) 468 | 469 | (let [new-ev (table/clone ev)] 470 | (loop [[k v] :pairs new-ev 471 | :when (event-positions k)] 472 | (let [[x y] v] 473 | (put new-ev k [(math/floor (/ (- x ox) scale)) 474 | (math/floor (/ (- y oy) scale))]))) 475 | new-ev)) 476 | -------------------------------------------------------------------------------- /freja/introspection.janet: -------------------------------------------------------------------------------- 1 | (import freja/open-file) 2 | 3 | (defn jump-to-def 4 | [symbol &keys {:env env}] 5 | (def old-env (curenv)) 6 | (when env 7 | (fiber/setenv (fiber/current) env)) 8 | (let [sm (get (dyn symbol) :source-map)] 9 | (tracev sm) 10 | (open-file/open-file 11 | (first sm) 12 | ;(map dec (drop 1 sm)))) 13 | (fiber/setenv (fiber/current) old-env)) 14 | 15 | (comment 16 | (jump-to-def 'jump-to-def) 17 | (dyn 'jump-to-def) 18 | ) -------------------------------------------------------------------------------- /freja/keyboard.janet: -------------------------------------------------------------------------------- 1 | (def possible-keys 2 | [# I put modifiers first, since they need to be noticed 3 | # before other keys 4 | # this might not be the cleanest way to do this 5 | :right-alt 6 | :right-bracket 7 | :right-control 8 | :right-shift 9 | :right-super 10 | :left-alt 11 | :left-bracket 12 | :left-control 13 | :left-shift 14 | :left-super 15 | :caps-lock 16 | 17 | (keyword "'") 18 | (keyword ",") 19 | :- 20 | :. 21 | :/ 22 | :0 23 | :1 24 | :2 25 | :3 26 | :4 27 | :5 28 | :6 29 | :7 30 | :8 31 | :9 32 | (keyword ";") 33 | := 34 | :a 35 | :b 36 | :backslash 37 | :backspace 38 | :c 39 | :d 40 | :delete 41 | :down 42 | :e 43 | :end 44 | :enter 45 | :escape 46 | :f 47 | :f1 48 | :f10 49 | :f11 50 | :f12 51 | :f2 52 | :f3 53 | :f4 54 | :f5 55 | :f6 56 | :f7 57 | :f8 58 | :f9 59 | :g 60 | :grave 61 | :h 62 | :home 63 | :i 64 | :insert 65 | :j 66 | :k 67 | :kb-menu 68 | :kp-* 69 | :kp-+ 70 | :kp-- 71 | :kp-. 72 | :kp-/ 73 | :kp-0 74 | :kp-1 75 | :kp-2 76 | :kp-3 77 | :kp-4 78 | :kp-5 79 | :kp-6 80 | :kp-7 81 | :kp-8 82 | :kp-9 83 | :kp-= 84 | :kp-enter 85 | :l 86 | :left 87 | :m 88 | :n 89 | :num-lock 90 | :o 91 | :p 92 | :page-down 93 | :page-up 94 | :pause 95 | :print-screen 96 | :q 97 | :r 98 | :right 99 | :s 100 | :scroll-lock 101 | :space 102 | :t 103 | :tab 104 | :u 105 | :up 106 | :v 107 | :w 108 | :x 109 | :y 110 | :z]) 111 | -------------------------------------------------------------------------------- /freja/new_gap_buffer_util.janet: -------------------------------------------------------------------------------- 1 | (comment "Various functions not strictly needed, but useful while debugging.") 2 | 3 | (varfn ez-gb 4 | [{:text text 5 | :gap-start gap-start 6 | :gap-stop gap-stop 7 | :gap gap 8 | :caret caret 9 | :selection selection 10 | :changed changed 11 | :changed-nav changed-nav 12 | :changed-selection changed-selection}] 13 | @{:text text 14 | :gap-start gap-start 15 | :gap-stop gap-stop 16 | :gap gap 17 | :caret caret 18 | :selection selection 19 | :changed changed 20 | :changed-nav changed-nav 21 | :changed-selection changed-selection}) 22 | 23 | (defn string->gb 24 | [s] 25 | (def gb-text 26 | ~{:caret (replace (* ($) "|") ,(fn [pos] [:caret pos])) 27 | :selection (replace (* ($) "*") ,(fn [pos] [:selection pos])) 28 | :gap-content (* (/ ($) ,(fn [start] [:content-start start])) 29 | "[" 30 | (any (+ :markers 31 | (/ (<- :string) ,(fn [v] [:gap v])))) 32 | "]" 33 | (/ ($) ,(fn [stop] [:content-stop stop]))) 34 | 35 | :gap-eat (* (/ ($) ,(fn [start] 36 | [:gap-start start])) 37 | "(" 38 | (any (+ :markers 39 | (/ (<- :string) ,(fn [v] [:gap-eat v])))) 40 | ")" 41 | (/ ($) ,(fn [stop] [:gap-stop stop]))) 42 | 43 | :string (any (+ :w :s)) 44 | :markers (+ :caret :selection :gap-content) 45 | :main (any (+ :gap-eat :markers (<- :string)))}) 46 | 47 | (var i-to-remove 0) 48 | (def gap-eat @"") 49 | (def gb @{:gap @"" 50 | :text @"" 51 | :actions @[] 52 | :redo-queue @[]}) 53 | (loop [v :in (peg/match gb-text s)] 54 | (if (string? v) 55 | (update gb :text buffer/push-string v) 56 | (let [[kind i] v] 57 | (case kind 58 | :gap (update gb :gap buffer/push-string i) 59 | 60 | :gap-eat (do (buffer/push-string gap-eat i) 61 | (+= i-to-remove (length i)) 62 | (update gb :text buffer/push-string i)) 63 | 64 | :gap-stop (do (put gb :gap-stop (dec (+ 65 | (length gap-eat) 66 | (- (length (gb :gap))) 67 | (- i 68 | i-to-remove)))) 69 | (++ i-to-remove)) 70 | 71 | :content-start 72 | (do (when (not (gb :gap-start)) 73 | (put gb :gap-start (- i i-to-remove)) 74 | (put gb :gap-stop (- i i-to-remove))) 75 | (++ i-to-remove)) 76 | 77 | :content-stop 78 | (++ i-to-remove) 79 | 80 | (do 81 | (put gb kind (- i i-to-remove)) 82 | (++ i-to-remove)))))) 83 | 84 | (when (not (gb :caret)) 85 | (put gb :caret (- (+ (length (gb :text)) 86 | (length (gb :gap))) 87 | (- (get gb :gap-stop 0) 88 | (get gb :gap-start 0))))) 89 | 90 | (when (not (gb :gap-start)) 91 | (put gb :gap-start (gb :caret)) 92 | (put gb :gap-stop (gb :caret))) 93 | 94 | (update gb :gap buffer) 95 | 96 | gb) 97 | 98 | 99 | -------------------------------------------------------------------------------- /freja/newest-menu.janet: -------------------------------------------------------------------------------- 1 | (import freja-layout/sizing/relative :as rs) 2 | (use freja-layout/put-many) 3 | 4 | (import freja/open-file) 5 | (import freja/file-handling) 6 | (import freja/echoer) 7 | (import freja/hiccup :as h) 8 | (import freja/event/subscribe :as s) 9 | (import freja/state) 10 | (import freja/input :as i) 11 | (import freja/default-hotkeys :as dh) 12 | (import freja/new_gap_buffer :as gb) 13 | (import freja/theme) 14 | (import ./find-file) 15 | (import ./file-explorer) 16 | 17 | (use freja/defonce) 18 | (use freja-jaylib) 19 | 20 | (defonce my-props @{}) 21 | (defonce state @{}) 22 | 23 | (put state :on-event (fn [self {:focus f}] 24 | (when (get (f :gb) :open-file) 25 | (put self :focused-text-area (f :gb))))) 26 | 27 | (def {:label-color label-color 28 | :hotkey-color hotkey-color 29 | :damp-color damp-color 30 | :highlight-color highlight-color 31 | :bar-bg bar-bg 32 | :dropdown-bg dropdown-bg} 33 | theme/comp-cols) 34 | 35 | (def kws {:control "Ctrl" 36 | :shift "Shift" 37 | :right-super "Right CMD"}) 38 | 39 | (defn kw->string 40 | [kw] 41 | (get kws 42 | kw 43 | (let [s (string kw)] 44 | (if (one? (length s)) 45 | (string/ascii-upper s) 46 | s)))) 47 | 48 | (defn hotkey->string 49 | [hk] 50 | (string/join (map kw->string hk) "+")) 51 | 52 | (defn open-scratch 53 | [& args] 54 | (unless (os/stat file-handling/scratch-path) 55 | (spit file-handling/scratch-path `` 56 | # This is your personal scratch file 57 | # if you want to try it out, just hit Ctrl/Cmd + L 58 | 59 | (print "Welcome to your personal scratch file!") 60 | ``)) 61 | 62 | (open-file/open-file file-handling/scratch-path)) 63 | 64 | (defn line 65 | [props & cs] 66 | [:padding {:all 8} 67 | @{:render (fn [{:width w :height h} parent-x parent-y] 68 | (draw-rectangle 0 0 (math/floor w) (math/floor (inc h)) 0xffffff22)) 69 | :relative-sizing rs/block-sizing 70 | :children [] 71 | :props {}}]) 72 | 73 | (defn menu-row 74 | [{:f f 75 | :label label 76 | :hotkey hotkey}] 77 | 78 | (default hotkey (or 79 | (-?> (i/get-hotkey ((state :focused-text-area) :binds) f) 80 | hotkey->string) 81 | "")) 82 | (unless hotkey (string "no hotkey for " f)) 83 | 84 | [:clickable {:on-click (fn [_] 85 | (s/put! my-props :open-menu nil) 86 | (f (state :focused-text-area)))} 87 | [:row {} 88 | [:align {:horizontal :left 89 | :weight 1} 90 | [:padding {:right 40} 91 | [:text {:color label-color 92 | :size 22 93 | :text label}]]] 94 | 95 | [:align {:horizontal :right 96 | :weight 1} 97 | [:text {:color hotkey-color 98 | :size 22 99 | :text hotkey}]]]]) 100 | 101 | (defn file-menu 102 | [props] 103 | [:shrink {} 104 | [menu-row 105 | {:f find-file/find-file-dialog 106 | :label "Find file"}] 107 | [menu-row 108 | {:f dh/open-file-dialog 109 | :label "Open"}] 110 | [menu-row 111 | {:f dh/save-file 112 | :label "Save"}] 113 | 114 | [line {}] 115 | 116 | [menu-row 117 | {:f open-scratch 118 | :label "Open Scratch"}] 119 | 120 | [line {}] 121 | 122 | [menu-row 123 | {:f dh/quit 124 | :label "Quit"}]]) 125 | 126 | (defn edit-menu 127 | [props] 128 | [:shrink {} 129 | [menu-row 130 | {:f dh/undo!2 131 | :label "Undo"}] 132 | [menu-row 133 | {:f dh/redo! 134 | :label "Redo"}] 135 | [menu-row 136 | {:f dh/cut! 137 | :label "Cut"}] 138 | [menu-row 139 | {:f gb/copy 140 | :label "Copy"}] 141 | [menu-row 142 | {:f dh/paste! 143 | :label "Paste"}] 144 | 145 | [line {}] 146 | 147 | [menu-row 148 | {:f dh/search-dialog 149 | :label "Search"}] 150 | 151 | [menu-row 152 | {:f dh/replace-dialog 153 | :label "Replace"}]]) 154 | 155 | 156 | (defn view-menu 157 | [props] 158 | [:shrink {} 159 | [menu-row 160 | {:f file-explorer/toggle 161 | :label "Toggle File Explorer"}] 162 | [menu-row 163 | {:f echoer/toggle-console 164 | :label "Toggle Log"}] 165 | [menu-row 166 | {:f echoer/clear-console 167 | :label "Clear Log"}]]) 168 | 169 | (defn hiccup 170 | [props & children] 171 | [:event-handler {:on-event 172 | (fn [self ev] 173 | (when (my-props :open-menu) 174 | (when (ev :mouse/release) 175 | (s/put! my-props :open-menu nil))))} 176 | 177 | [:padding {:left 0 :top 0} 178 | [:background {:color bar-bg} 179 | [:padding {:all 8 :top 4 :bottom 4} 180 | [:block {} 181 | [:row {} 182 | [:padding {:right 8} 183 | [:clickable {:on-click (fn [_] 184 | (s/put! props :open-menu :file))} 185 | [:text {:color (if (= (props :open-menu) :file) 186 | highlight-color 187 | damp-color) 188 | :size 22 189 | :text "File"}]]] 190 | 191 | [:padding {:right 8} 192 | [:clickable {:on-click (fn [_] 193 | (s/put! props :open-menu :edit))} 194 | [:text {:color (if (= (props :open-menu) :edit) 195 | highlight-color 196 | damp-color) 197 | :size 22 198 | :text "Edit"}]]] 199 | 200 | [:padding {:right 8} 201 | [:clickable {:on-click (fn [_] 202 | (s/put! props :open-menu :view))} 203 | [:text {:color (if (= (props :open-menu) :view) 204 | highlight-color 205 | damp-color) 206 | :size 22 207 | :text "View"}]]]]]]] 208 | 209 | (when-let [om (props :open-menu)] 210 | (case om 211 | :file 212 | [:background {:color dropdown-bg} 213 | [:padding {:all 8 214 | :top 3} 215 | [file-menu props]]] 216 | 217 | :edit 218 | [:block {} 219 | [:padding {:right 8} 220 | [:text {:color 0x00000000 :size 22 :text "File"}]] 221 | [:background {:color dropdown-bg} 222 | [:padding {:all 8 223 | :top 3} 224 | [edit-menu props]]]] 225 | 226 | :view 227 | [:block {} 228 | [:padding {:right 8} 229 | [:text {:color 0x00000000 :size 22 :text "File"}]] 230 | [:padding {:right 8} 231 | [:text {:color 0x00000000 :size 22 :text "Edit"}]] 232 | [:background {:color dropdown-bg} 233 | [:padding {:all 8 234 | :top 3} 235 | [view-menu props]]]]))]]) 236 | 237 | (defn init 238 | [] 239 | (h/new-layer :menu hiccup 240 | my-props 241 | :remove-layer-on-error true) 242 | 243 | (s/subscribe! state/focus state)) 244 | 245 | # 246 | # this will only be true when running load-file inside freja 247 | (when ((curenv) :freja/loading-file) 248 | (printf "reiniting :)") 249 | (init)) 250 | -------------------------------------------------------------------------------- /freja/open-file.janet: -------------------------------------------------------------------------------- 1 | (import freja/state) 2 | (import freja/new_gap_buffer :as gb) 3 | (import spork/path) 4 | 5 | (defn open-file* 6 | [compo-state] 7 | (def [_ state] compo-state) 8 | (state/push-buffer-stack compo-state) 9 | (when (state :freja/focus) 10 | (:freja/focus state))) 11 | 12 | (defn open-file 13 | [path &opt line column] 14 | 15 | (def abspath (path/abspath path)) 16 | 17 | (if-let [comp-state (state/open-files abspath)] 18 | (open-file* comp-state) 19 | (let [new-state (state/ext->editor (path/ext path) {:path path})] 20 | (put state/open-files abspath new-state) 21 | (open-file* new-state))) 22 | 23 | (let [gb (get-in state/open-files [abspath 1 :editor :gb])] 24 | # ^ state 25 | (when line 26 | (gb/put-caret 27 | gb 28 | (gb/index-of-line gb line))) 29 | 30 | (when column 31 | (gb/move-n gb column)))) 32 | 33 | (defn close-file 34 | [path] 35 | (put state/open-files (path/abspath path) nil)) 36 | 37 | (comment 38 | (open-file "freja/main.janet") 39 | # 40 | ) 41 | -------------------------------------------------------------------------------- /freja/rainbow.janet: -------------------------------------------------------------------------------- 1 | (import ./new_gap_buffer :as gb) 2 | 3 | (defn rgba->f 4 | [r g b & [a]] 5 | [(/ r 255) 6 | (/ g 255) 7 | (/ b 255) 8 | (or a 1)]) 9 | 10 | (def colors 11 | @{1 0xff8c00ff # dark orange 12 | 2 0xff1493ff # deep pink 13 | 3 0x7fff00ff # chartreuse 14 | 4 0x00bfffff # deep sky blue 15 | 5 0xffff00ff # yellow 16 | 6 0xda70d6ff # orchid 17 | 7 0x00ff7fff # spring green 18 | 8 0xff8247ff # siennal 19 | # repeat 20 | # I thought the dark orange was too similar to siennal 21 | 9 :blue # 0xff8c00ff # dark orange 22 | 10 0xff1493ff # deep pink 23 | 11 0x7fff00ff # chartreuse 24 | 12 0x00bfffff # deep sky blue 25 | 13 0xffff00ff # yellow 26 | 14 0xda70d6ff # orchid 27 | 15 0x00ff7fff # spring green 28 | 16 0xff8247ff # siennal 29 | }) 30 | 31 | (comment 32 | (((((((((())))))))))) 33 | 34 | 35 | (var depth 0) 36 | 37 | (varfn inc-depth 38 | [pos] 39 | (++ depth) 40 | [pos depth :open-paren]) 41 | 42 | (varfn dec-depth 43 | [pos] 44 | (let [res [pos depth :close-paren]] 45 | (-= depth 1) 46 | res)) 47 | 48 | (def jg 49 | ~{:main (some :input) 50 | # 51 | :input (choice :non-form 52 | :form) 53 | # 54 | :non-form (choice :whitespace 55 | :comment) 56 | # 57 | :whitespace (set " \0\f\n\r\t\v") 58 | # 59 | :comment (sequence "#" 60 | (any (if-not (set "\r\n") 1))) 61 | # 62 | :form (choice :reader-macro 63 | :collection 64 | :literal) 65 | # 66 | :reader-macro (choice :fn 67 | :quasiquote 68 | :quote 69 | :splice 70 | :unquote) 71 | # 72 | :fn (sequence "|" 73 | (any :non-form) 74 | :form) 75 | # 76 | :quasiquote (sequence "~" 77 | (any :non-form) 78 | :form) 79 | # 80 | :quote (sequence "'" 81 | (any :non-form) 82 | :form) 83 | # 84 | :splice (sequence ";" 85 | (any :non-form) 86 | :form) 87 | # 88 | :unquote (sequence "," 89 | (any :non-form) 90 | :form) 91 | # 92 | :literal (choice :number 93 | :constant 94 | :buffer 95 | :string 96 | :long-buffer 97 | :long-string 98 | :keyword 99 | :symbol) 100 | # 101 | :collection (choice :array 102 | :bracket-array 103 | :tuple 104 | :bracket-tuple 105 | :table 106 | :struct) 107 | # 108 | :number (drop (cmt 109 | (capture (some :name-char)) 110 | ,scan-number)) 111 | # 112 | :name-char (choice (range "09" "AZ" "az" "\x80\xFF") 113 | (set "!$%&*+-./:@^_")) 114 | # 115 | :constant (sequence (choice "false" "nil" "true") 116 | (not :name-char)) 117 | # 118 | :buffer (sequence "@\"" 119 | (any (choice :escape 120 | (if-not "\"" 1))) 121 | "\"") 122 | # 123 | :escape (sequence "\\" 124 | (choice (set "0efnrtvz\"\\") 125 | (sequence "x" [2 :hex]) 126 | (sequence "u" [4 :hex]) 127 | (sequence "U" [6 :hex]) 128 | #(error (constant "bad escape")) 129 | )) 130 | # 131 | :hex (range "09" "af" "AF") 132 | # 133 | :string (sequence "\"" 134 | (any (choice :escape 135 | (if-not "\"" 1))) 136 | "\"") 137 | # 138 | :long-string :long-bytes 139 | # 140 | :long-bytes {:main (drop (sequence :open 141 | (any (if-not :close 1)) 142 | :close)) 143 | :open (capture :delim :n) 144 | :delim (some "`") 145 | :close (cmt (sequence (not (look -1 "`")) 146 | (backref :n) 147 | (capture :delim)) 148 | ,=)} 149 | # 150 | :long-buffer (sequence "@" 151 | :long-bytes) 152 | # 153 | :keyword (sequence ":" 154 | (any :name-char)) 155 | # 156 | :symbol (some :name-char) 157 | 158 | :ptuple (* (cmt (* ($) "(") ,inc-depth) :root (opt (cmt (* ($) ")") ,dec-depth))) 159 | :btuple (* (cmt (* ($) "[") ,inc-depth) :root (opt (cmt (* ($) "]") ,dec-depth))) 160 | :struct (* (cmt (* ($) "{") ,inc-depth) :root2 (opt (cmt (* ($) "}") ,dec-depth))) 161 | 162 | # 163 | :array #(sequence "@(" 164 | # (any :input) 165 | # (choice ")" 166 | # (error (constant "missing )")))) 167 | (* (cmt (* "@" ($) "(") ,inc-depth) (any :input) (opt (cmt (* ($) ")") ,dec-depth))) 168 | 169 | # 170 | :tuple #(sequence "(" 171 | # (any :input) 172 | # (choice ")" 173 | # (error (constant "missing )")))) 174 | (* (cmt (* ($) "(") ,inc-depth) (any :input) (opt (cmt (* ($) ")") ,dec-depth))) 175 | # 176 | :bracket-array #(sequence "@[" 177 | # (any :input) 178 | # (choice "]" 179 | # (error (constant "missing ]")))) 180 | (* (cmt (* "@" ($) "[") ,inc-depth) (any :input) (opt (cmt (* ($) "]") ,dec-depth))) 181 | # 182 | :bracket-tuple #(sequence "[" 183 | # (any :input) 184 | # (choice "]" 185 | # (error (constant "missing ]")))) 186 | (* (cmt (* ($) "[") ,inc-depth) (any :input) (opt (cmt (* ($) "]") ,dec-depth))) 187 | 188 | :table #(sequence "@{" 189 | # (any :input) 190 | # (choice "}" 191 | # (error (constant "missing }")))) 192 | (* (cmt (* "@" ($) "{") ,inc-depth) (any :input) (opt (cmt (* ($) "}") ,dec-depth))) 193 | # 194 | :struct #(sequence "{" 195 | # (any :input) 196 | # (choice "}" 197 | # (error (constant "missing }")))) 198 | 199 | (* (cmt (* ($) "{") ,inc-depth) (any :input) (opt (cmt (* ($) "}") ,dec-depth)))}) 200 | 201 | (comment 202 | 203 | (peg/match jg "") 204 | # => nil 205 | 206 | (peg/match jg "@\"i am a buffer\"") 207 | # => @[] 208 | 209 | (peg/match jg "# hello") 210 | # => @[] 211 | 212 | (peg/match jg "nil") 213 | # => @[] 214 | 215 | (peg/match jg ":a") 216 | # => @[] 217 | 218 | (peg/match jg "@``i am a long buffer``") 219 | # => @[] 220 | 221 | (peg/match jg "``hello``") 222 | # => @[] 223 | 224 | (peg/match jg "8") 225 | # => @[] 226 | 227 | (peg/match jg "-2.0") 228 | # => @[] 229 | 230 | (peg/match jg "\"\\u0001\"") 231 | # => @[] 232 | 233 | (peg/match jg "a") 234 | # => @[] 235 | 236 | (peg/match jg " ") 237 | # => @[] 238 | 239 | (peg/match jg "|(+ $ 2)") 240 | # => @[] 241 | 242 | (peg/match jg "~a") 243 | # => @[] 244 | 245 | (peg/match jg "'a") 246 | # => @[] 247 | 248 | (peg/match jg ";a") 249 | # => @[] 250 | 251 | (peg/match jg ",a") 252 | # => @[] 253 | 254 | (peg/match jg "@(:a)") 255 | # => @[] 256 | 257 | (peg/match jg "@[:a]") 258 | # => @[] 259 | 260 | (peg/match jg "[:a]") 261 | # => @[] 262 | 263 | (peg/match jg "[1 2]") 264 | # => @[] 265 | 266 | (peg/match jg "@{:a 1}") 267 | # => @[] 268 | 269 | (peg/match jg "{:a 1}") 270 | # => @[] 271 | 272 | (peg/match jg "(:a)") 273 | # => @[] 274 | 275 | (peg/match jg "(def a 1)") 276 | # => @[] 277 | 278 | (peg/match jg "[:a :b] 1") 279 | # => @[] 280 | 281 | (try 282 | (peg/match jg "[:a :b)") 283 | ([e] e)) 284 | # => "missing ]" 285 | 286 | (try 287 | (peg/match jg "(def a # hi 1)") 288 | ([e] e)) 289 | # => "missing )" 290 | 291 | (try 292 | (peg/match jg "\"\\u001\"") 293 | ([e] e)) 294 | # => "bad escape" 295 | ) 296 | 297 | (defn gb->delim-ps 298 | [gb] 299 | (set depth 0) 300 | (peg/match jg 301 | (gb/content gb))) 302 | -------------------------------------------------------------------------------- /freja/state.janet: -------------------------------------------------------------------------------- 1 | (import bounded-queue :as queue) 2 | 3 | (setdyn :freja/ns "freja/state") 4 | 5 | (var quit false) 6 | 7 | (var gb-binds nil) 8 | 9 | (var quit-hook nil) 10 | 11 | (def freja-dir @"") 12 | 13 | (var initial-file nil) 14 | 15 | (def open-files 16 | @{}) 17 | 18 | (def focus @{}) 19 | 20 | (def keys-down @{}) 21 | 22 | (def out @"") 23 | (def err @"") 24 | 25 | (def editor-state @{}) 26 | 27 | (var user-env (make-env)) 28 | 29 | ##### event queues 30 | 31 | (def mouse (queue/new 100)) 32 | (def chars (queue/new 100)) 33 | (def keyboard (queue/new 100)) 34 | (def frame-events (queue/new 1)) 35 | (def rerender (queue/new 1)) 36 | (def out-events (queue/new 100)) 37 | (def eval-results (queue/new 100)) 38 | (def callbacks @{:event/changed false}) 39 | (def screen-size @{}) 40 | 41 | (def subscriptions @{}) 42 | 43 | ##### handle different extenions 44 | 45 | (def editor-components 46 | @{}) 47 | 48 | (def editor-state-creators 49 | @{}) 50 | 51 | (defn ext->editor 52 | [ext &opt data] 53 | (default ext ".janet") 54 | (def compo (get editor-components ext)) 55 | (default compo (editor-components ".janet")) 56 | (def state-creator (get editor-state-creators ext)) 57 | (default state-creator (editor-state-creators ".janet")) 58 | [(compo data) (state-creator data)]) 59 | 60 | (defn add-ext-handling 61 | [ext component creator] 62 | (put editor-components ext component) 63 | (put editor-state-creators ext creator)) 64 | 65 | (defn push-buffer-stack 66 | [o] 67 | (def new-stack (-> (filter |(not= o $) (editor-state :stack)) 68 | (array/push o))) 69 | (-> editor-state 70 | (put :stack new-stack) 71 | (put :event/changed true))) 72 | 73 | (defn remove-buffer-stack 74 | [o] 75 | (def len-before (length (editor-state :stack))) 76 | (def new-stack (filter |(not= o $) (editor-state :stack))) 77 | 78 | (when (= len-before (length new-stack)) 79 | (error "no buffer removed")) 80 | 81 | (-> editor-state 82 | (put :stack new-stack) 83 | (put :event/changed true))) 84 | 85 | (defn focus! 86 | `` 87 | Sets global focus to x. 88 | `` 89 | [x] 90 | (-> focus 91 | (put :last-focus (focus :focus)) 92 | (put :focus x) 93 | (put :event/changed true))) 94 | -------------------------------------------------------------------------------- /freja/text_rendering.c: -------------------------------------------------------------------------------- 1 | #include 2 | 3 | static Janet cfun_backward_lines_until_limit(int32_t argc, Janet *argv) { 4 | janet_fixarity(argc, 7); 5 | JanetArray *lines = janet_getarray(argv, 0); 6 | JanetTable *sizes = janet_gettable(argv, 1); 7 | int32_t width = janet_getinteger(argv, 2); 8 | int32_t top_y = janet_getinteger(argv, 3); 9 | int32_t x = janet_getinteger(argv, 4); 10 | int32_t y = janet_getinteger(argv, 5); 11 | JanetBuffer *chars = janet_getbuffer(argv, 6); 12 | 13 | //janet_array_push(lines, janet_wrap_integer(chars->count)); 14 | 15 | int should_be_wrapped = 0; 16 | 17 | int needs_wrapping = -1; 18 | 19 | int32_t h = janet_unwrap_integer(janet_unwrap_tuple(janet_table_get(sizes, janet_wrap_integer('a')))[1]); 20 | 21 | int i = chars->count - 1; 22 | 23 | for (; i >= 0; i--) { 24 | uint8_t c = chars->data[i]; 25 | if ('\n' == c) { 26 | y -= h; 27 | 28 | if (y < top_y) { 29 | break; 30 | } 31 | 32 | if (should_be_wrapped == 1) { 33 | janet_array_push(lines, janet_wrap_integer(needs_wrapping)); 34 | should_be_wrapped = 0; 35 | } 36 | 37 | x = width; 38 | janet_array_push(lines, janet_wrap_integer(i + 1)); 39 | } else { 40 | Janet v = janet_table_get(sizes, janet_wrap_integer(c)); 41 | if (janet_checktype(v, JANET_NIL)) { 42 | janet_panicf("GOT NIL! for %d", c); 43 | } 44 | 45 | const Janet *t = janet_unwrap_tuple(v); 46 | int32_t new_x = x - janet_unwrap_integer(t[0]); 47 | 48 | if (new_x <= 0) { 49 | y -= h; 50 | should_be_wrapped = 1; 51 | x = width; 52 | } else { 53 | x = new_x; 54 | } 55 | } 56 | } 57 | 58 | if (should_be_wrapped == 1) { 59 | janet_array_push(lines, janet_wrap_integer(needs_wrapping)); 60 | should_be_wrapped = 0; 61 | } 62 | 63 | 64 | if (i == -1) { 65 | janet_array_push(lines, janet_wrap_integer(0)); 66 | } 67 | 68 | return janet_wrap_array(lines); 69 | } 70 | 71 | static const JanetReg cfuns[] = { 72 | {"backward-lines-until-limit", cfun_backward_lines_until_limit, "(yeboi)."}, 73 | {NULL, NULL, NULL} 74 | }; 75 | 76 | JANET_MODULE_ENTRY(JanetTable *env) { 77 | janet_cfuns (env, "text-rendering", cfuns); 78 | } 79 | -------------------------------------------------------------------------------- /freja/textfield_api.janet: -------------------------------------------------------------------------------- 1 | (use freja-jaylib) 2 | 3 | (defn content 4 | "Returns a big string of all the pieces in the text data." 5 | [{:selected selected :text text :after after}] 6 | (string text selected (string/reverse after))) 7 | 8 | (defn select-until-beginning 9 | "Selects all text from cursor to beginning of buffer." 10 | [text] 11 | (def {:selected selected :text text} text) 12 | (put text :dir :left) 13 | (buffer/push-string selected text) 14 | (buffer/clear text)) 15 | 16 | (defn select-until-end 17 | "Selects all text from cursor to end of buffer." 18 | [{:selected selected :text text :after after}] 19 | (put text :dir :right) 20 | (buffer/push-string selected (string/reverse after)) 21 | (buffer/clear after)) 22 | 23 | (defn select-region 24 | "Selects text between index start and index end." 25 | [text-data start end] 26 | (let [{:after after} text-data 27 | both (content text-data) 28 | [start end] (if (> start end) 29 | (do (put text-data :dir :left) 30 | [end start]) 31 | (do (put text-data :dir :right) 32 | [start end]))] 33 | (put text-data :text (buffer/slice both 0 start)) 34 | (put text-data :selected (buffer/slice both start end)) 35 | (buffer/clear after) 36 | (buffer/push-string after (string/reverse (buffer/slice both end))))) 37 | 38 | (defn move-to-pos 39 | "Selects text between index start and index end." 40 | [text-data pos] 41 | (select-region text-data pos pos)) 42 | 43 | (defn move-to-beginning 44 | "Moves cursor to beginning of buffer." 45 | [text-data] 46 | (def {:selected selected :text text :after after} text-data) 47 | (buffer/push-string after (string/reverse selected)) 48 | (buffer/push-string after (string/reverse text)) 49 | (buffer/clear selected) 50 | (buffer/clear text)) 51 | 52 | (defn move-to-end 53 | "Moves cursor to end of buffer." 54 | [text-data] 55 | (def {:selected selected :text text :after after} text-data) 56 | (buffer/push-string text selected) 57 | (buffer/push-string text (string/reverse after)) 58 | (buffer/clear selected) 59 | (buffer/clear after)) 60 | 61 | (defn copy 62 | "Copies selected text into clipboard." 63 | [text-data] 64 | (def {:selected selected :text text :after after} text-data) 65 | (set-clipboard-text (string selected))) 66 | 67 | (defn delete-selected 68 | "Deletes selected text. 69 | Always run when inserting (e.g. writing chars or when pasting). 70 | Returns previously selected text. 71 | Returns `nil` if no text was selected." 72 | [text-data] 73 | (def {:selected selected :text text :after after} text-data) 74 | (def old selected) 75 | (put text-data :selected @"") 76 | (when (not (empty? old)) 77 | old)) 78 | 79 | (defn cut 80 | "Cuts selected text into clipboard." 81 | [text-data] 82 | (def {:selected selected :text text :after after} text-data) 83 | (set-clipboard-text (string selected)) 84 | (delete-selected text-data)) 85 | 86 | (defn paste 87 | "Pastes from clipboard." 88 | [text-data] 89 | (def {:selected selected :text text :after after} text-data) 90 | (delete-selected text-data) 91 | (buffer/push-string text (get-clipboard-text))) 92 | 93 | (defn select-surrounding-word 94 | "Selects the word surrounding the cursor." 95 | [text-data] 96 | (def {:selected selected :text text :after after :dir dir} text-data) 97 | (if (= dir :right) 98 | (buffer/push-string text selected) 99 | (buffer/push-string after (string/reverse selected))) 100 | (buffer/clear selected) 101 | 102 | (def t-l (first (peg/match '(* (any :S) ($)) (string/reverse text)))) 103 | (def at-l (first (peg/match '(* (any :S) ($)) (string/reverse after)))) 104 | 105 | (buffer/push-string selected (string/slice text (dec (- t-l)))) 106 | (buffer/push-string selected (string/reverse (string/slice after (dec (- at-l))))) 107 | (buffer/popn text t-l) 108 | (buffer/popn after at-l) 109 | 110 | (put text-data :dir :right)) 111 | 112 | (defn select-all 113 | "Selects all text in buffer." 114 | [text-data] 115 | (def {:selected selected :text text :after after} text-data) 116 | (put text-data :dir :right) 117 | (def new-selected (buffer/new (+ (length text) 118 | (length selected) 119 | (length after)))) 120 | (buffer/push-string new-selected text) 121 | (buffer/push-string new-selected selected) 122 | (buffer/push-string new-selected (string/reverse after)) 123 | (put text-data :selected new-selected) 124 | (buffer/clear text) 125 | (buffer/clear after)) 126 | 127 | (defn delete-word-before 128 | "Deletes the word before the cursor. 129 | If text is selected deletes the selection instead." 130 | [text-data] 131 | (def {:selected selected :text text :after after} text-data) 132 | ## TODO: Try putting the exact position modified into changed instead 133 | ## In order to only rerender a single line 134 | (put text-data :changed true) 135 | 136 | (when (not (delete-selected text-data)) 137 | (when-let [l (first (peg/match '(* (any :s) (any :S) ($)) (string/reverse text)))] 138 | (buffer/popn text l)))) 139 | 140 | (defn delete-word-after 141 | "Deletes the word after the cursor. 142 | If text is selected deletes the selection instead." 143 | [text-data] 144 | (def {:selected selected :text text :after after} text-data) 145 | (put text-data :changed true) 146 | (when (not (delete-selected text-data)) 147 | (when-let [l (first (peg/match '(* (any :s) (any :S) ($)) (string/reverse after)))] 148 | (buffer/popn after l)))) 149 | 150 | (defn backspace 151 | "Deletes a single character before the cursor. 152 | If text is selected deletes the selection instead." 153 | [text-data] 154 | (def {:selected selected :text text :after after} text-data) 155 | (put text-data :changed true) 156 | (when (not (delete-selected text-data)) 157 | (buffer/popn text 1))) 158 | 159 | (defn forward-delete 160 | "Deletes a single character after the cursor. 161 | If text is selected deletes the selection instead." 162 | [text-data] 163 | (def {:selected selected :text text :after after} text-data) 164 | (put text-data :changed true) 165 | (when (not (delete-selected text-data)) 166 | (buffer/popn after 1))) 167 | 168 | (defn select-word-before 169 | "Selects a word before the cursor." 170 | [text-data] 171 | (def {:selected selected :text text :after after :dir dir} text-data) 172 | (if (and (not (empty? selected)) # when text is selected and the direction is right 173 | (= dir :right)) # we deselect rather than select 174 | (when-let [l (first (peg/match '(* (any :s) (any :S) ($)) (string/reverse selected)))] 175 | (buffer/push-string after (string/reverse (buffer/slice selected (dec (- l))))) 176 | (buffer/popn selected l)) 177 | (when-let [l (first (peg/match '(* (any :s) (any :S) ($)) (string/reverse text)))] 178 | (put text-data :dir :left) 179 | (put text-data :selected (buffer (buffer/slice text (dec (- l))) selected)) 180 | (buffer/popn text l)))) 181 | 182 | (defn select-word-after 183 | "Selects a word after the cursor." 184 | [text-data] 185 | (def {:selected selected :text text :after after :dir dir} text-data) 186 | (if (and (not (empty? selected)) # when text is selected and the direction is left 187 | (= dir :left)) # we deselect rather than select 188 | (when-let [l (first (peg/match '(* (any :s) (any :S) ($)) selected))] 189 | (buffer/push-string text (buffer/slice selected 0 l)) 190 | (put text-data :selected (buffer/slice selected l))) 191 | (when-let [l (first (peg/match '(* (any :s) (any :S) ($)) (string/reverse after)))] 192 | (put text-data :dir :right) 193 | (buffer/push-string selected (string/reverse (buffer/slice after (dec (- l))))) 194 | (buffer/popn after l)))) 195 | 196 | (defn move-word-before 197 | "Moves the cursor one word to the left." 198 | [text-data] 199 | (def {:selected selected :text text :after after} text-data) 200 | (when-let [l (first (peg/match '(* (any :s) (any :S) ($)) (string/reverse text)))] 201 | (when (not (empty? selected)) 202 | (buffer/push-string after (string/reverse selected)) 203 | (buffer/clear selected)) 204 | (buffer/push-string after (string/reverse (buffer/slice text (dec (- l))))) 205 | (buffer/popn text l))) 206 | 207 | (defn move-word-after 208 | "Moves the cursor one word to the right." 209 | [text-data] 210 | (def {:selected selected :text text :after after} text-data) 211 | (when-let [l (first (peg/match '(* (any :s) (any :S) ($)) (string/reverse after)))] 212 | (when (not (empty? selected)) 213 | (buffer/push-string text selected) 214 | (buffer/clear selected)) 215 | (buffer/push-string text (string/reverse (buffer/slice after (dec (- l))))) 216 | (buffer/popn after l))) 217 | 218 | (defn select-char-before 219 | "Selects the char before the cursor." 220 | [text-data] 221 | (def {:selected selected :text text :after after :dir dir} text-data) 222 | (if (and (= dir :right) 223 | (not (empty? selected))) 224 | (do (put after (length after) (last selected)) 225 | (buffer/popn selected 1)) 226 | (when (not (empty? text)) 227 | (put text-data :dir :left) 228 | (let [o selected] 229 | (put text-data :selected (buffer/new (inc (length o)))) 230 | (put (text-data :selected) 0 (last text)) 231 | (buffer/push-string (text-data :selected) o)) 232 | (buffer/popn text 1)))) 233 | 234 | (defn select-char-after 235 | "Selects the char after the cursor." 236 | [text-data] 237 | (def {:selected selected :text text :after after :dir dir} text-data) 238 | (if (and (= dir :left) 239 | (not (empty? selected))) 240 | (do (put text (length text) (first selected)) 241 | (put text-data :selected (buffer/slice selected 1))) 242 | (when (not (empty? after)) 243 | (put text-data :dir :right) 244 | (put selected (length selected) (last after)) 245 | (buffer/popn after 1)))) 246 | 247 | (defn move-char-before 248 | "Moves the cursor one char to the left." 249 | [text-data] 250 | (def {:selected selected :text text :after after} text-data) 251 | (if (not (empty? selected)) 252 | (do (buffer/push-string after (string/reverse selected)) 253 | (buffer/clear selected)) 254 | (when (not (empty? text)) 255 | (put after (length after) (last text)) 256 | (buffer/popn text 1)))) 257 | 258 | (defn move-char-after 259 | "Moves the cursor one char to the right." 260 | [text-data] 261 | (def {:selected selected :text text :after after} text-data) 262 | (if (not (empty? selected)) 263 | (do (buffer/push-string text selected) 264 | (buffer/clear selected)) 265 | (when (not (empty? after)) 266 | (put text (length text) (last after)) 267 | (buffer/popn after 1)))) 268 | 269 | (defn insert-char 270 | "Inserts a single char." 271 | [{:selected selected :text text :after after} k] 272 | (case k 273 | :space (buffer/push-string text " ") 274 | :grave (buffer/push-string text "`") 275 | :left-bracket (buffer/push-string text "[") 276 | :right-bracket (buffer/push-string text "]") 277 | (do (buffer/clear selected) 278 | (if (keyword? k) 279 | (buffer/push-string text (string k)) 280 | (put text (length text) k))))) 281 | 282 | (defn insert-char-upper 283 | "Inserts a single uppercase char." 284 | [{:selected selected :text text :after after} k] 285 | (case k 286 | :space (buffer/push-string text " ") 287 | :grave (buffer/push-string text "`") 288 | :left-bracket (buffer/push-string text "[") 289 | :right-bracket (buffer/push-string text "]") 290 | (do (buffer/clear selected) 291 | (if (keyword? k) 292 | (buffer/push-string text (string/ascii-upper (string k))) 293 | (put text (length text) k))))) 294 | -------------------------------------------------------------------------------- /freja/theme.janet: -------------------------------------------------------------------------------- 1 | (defn rgba 2 | [r g b & [a]] 3 | [(/ r 255) 4 | (/ g 255) 5 | (/ b 255) 6 | (or a 1)]) 7 | 8 | (comment 9 | # lighter mode 10 | (def colors 11 | @{:text (rgba 71 93 101) 12 | :border [0.396 0.478 0.514] 13 | :background (rgba 253 246 227) 14 | :textarea [0.992 0.965 0.89] 15 | :selected-text [0.992 0.965 0.89] 16 | :selected-text-background :blue 17 | :caret [0.396 0.478 0.514] 18 | 19 | :game-bg (rgba 134 173 173) 20 | 21 | :call (rgba 38 139 210) 22 | :special-symbol (rgba 133 153 0) 23 | :string (rgba 42 161 151) 24 | :keyword (rgba 181 137 0)}) 25 | # 26 | ) 27 | 28 | (def colors 29 | @{:text (rgba 248 248 243) 30 | :border [0.396 0.478 0.513] 31 | :background (rgba 39 40 33) 32 | :textarea [0.992 0.965 0.88] 33 | :selected-text [0.992 0.965 0.88] 34 | :selected-text-background :blue 35 | :caret [0.396 0.478 0.513] 36 | 37 | :game-bg (rgba 134 173 172) 38 | 39 | :call (rgba 166 226 45) 40 | :special-symbol (rgba 102 217 238) 41 | :string (rgba 230 219 115) 42 | :keyword (rgba 174 128 255)}) 43 | 44 | (def font-size 22) 45 | 46 | (def comp-cols {:background 0x882491ff 47 | :text/color 0xffffffee 48 | :caret/color 0xffffff80 49 | :label-color 0xffffffee 50 | :hotkey-color 0xffffffbb 51 | :damp-color 0xffffff88 52 | :highlight-color 0xffffffee 53 | :bar-bg 0x2D2D2Dff 54 | :dropdown-bg 0x3E3E3Eff}) 55 | -------------------------------------------------------------------------------- /freja/vector-math.janet: -------------------------------------------------------------------------------- 1 | (varfn v-op 2 | [op v1 v2] 3 | (if (number? v2) 4 | (seq [v :in v1] 5 | (op v v2)) 6 | (seq [i :range [0 (min (length v1) (length v2))]] 7 | (op (v1 i) (v2 i))))) 8 | 9 | (var v+ (partial v-op +)) 10 | (var v- (partial v-op -)) 11 | (var v* (partial v-op *)) 12 | 13 | (varfn mag 14 | [v] 15 | (case (length v) 16 | 2 17 | (let [[x y] v] 18 | (math/sqrt (+ (math/pow x 2) 19 | (math/pow y 2)))) 20 | 21 | 3 22 | (let [[x y z] v] 23 | (math/sqrt (+ (math/pow x 2) 24 | (math/pow y 2) 25 | (math/pow z 2)))) 26 | 27 | (error "mag only works on v2 / v3"))) 28 | 29 | (varfn mag-sqr 30 | [v] 31 | (case (length v) 32 | 2 33 | (let [[x y] v] 34 | (+ (math/pow x 2) 35 | (math/pow y 2))) 36 | 37 | 3 38 | (let [[x y z] v] 39 | (+ (math/pow x 2) 40 | (math/pow y 2) 41 | (math/pow z 2))) 42 | 43 | (error "mag-sqr only works on v2 / v3"))) 44 | 45 | (varfn dist-sqr 46 | [v1 v2] 47 | (math/abs 48 | (mag-sqr (v- v1 v2)))) 49 | 50 | (varfn dist 51 | [v1 v2] 52 | (math/abs 53 | (mag (v- v1 v2)))) 54 | 55 | (varfn normalize 56 | [v] 57 | (def m (mag v)) 58 | (if (> m 0) 59 | (seq [p :in v] 60 | (/ p m)) 61 | (seq [_ :in v] 62 | 0))) 63 | -------------------------------------------------------------------------------- /freja/version.janet: -------------------------------------------------------------------------------- 1 | (var ver-str nil) -------------------------------------------------------------------------------- /project.janet: -------------------------------------------------------------------------------- 1 | # freja-jaylib-shim doesn't need opengl etc 2 | # which makes it easier to run in CI 3 | (def freja-jaylib-dep 4 | (if (= "true" (os/getenv "FREJA_TEST")) 5 | "https://github.com/saikyun/freja-jaylib-shim" 6 | "https://github.com/saikyun/freja-jaylib")) 7 | 8 | (declare-project 9 | :name "freja" 10 | :author "Jona Ekenberg " 11 | :license "MIT" 12 | :description "Extendable text editor with a focus on quick game development and GUI creation. Like a minimal emacs with easy opengl access." 13 | :url "https://github.com/saikyun/freja" 14 | :repo "git+https://github.com/saikyun/freja" 15 | :dependencies ["https://github.com/janet-lang/spork" 16 | 17 | {:repo "https://github.com/saikyun/janet-bounded-queue" :tag "main"} 18 | 19 | {:repo "https://github.com/saikyun/janet-whereami" :tag "main"} 20 | 21 | {:repo "https://github.com/saikyun/freja-layout" :tag "main"} 22 | 23 | {:repo "https://github.com/Saikyun/janet-profiling" :tag "main"} 24 | 25 | ## using my own fork due to additions to jaylib 26 | {:repo freja-jaylib-dep} 27 | 28 | # example of how to use `:tag` 29 | # {:repo "https://...." :tag "abcdcbdc"} 30 | ]) 31 | 32 | 33 | (def lflags 34 | (case (os/which) 35 | :windows '[] 36 | :macos '["-Wl,-export_dynamic"] # need to test this 37 | :linux '["-rdynamic"] # I want this for more OSes, needed to load native modules from freja binary 38 | #default 39 | '["-lpthread"])) 40 | 41 | (def proj-root 42 | (os/cwd)) 43 | 44 | (def sep (if (= (os/which) :windows) "\\" "/")) 45 | 46 | (def src-root 47 | (string proj-root sep "freja")) 48 | 49 | (declare-source 50 | :source @["freja"]) 51 | 52 | (declare-executable 53 | :name "freja" 54 | :entry (string src-root sep "main.janet") 55 | :lflags lflags 56 | :install true) 57 | 58 | (phony "judge" ["build"] 59 | (os/execute ["jg-verdict" 60 | "-p" proj-root 61 | "-s" src-root] :p)) 62 | -------------------------------------------------------------------------------- /test/lul.janet: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/saikyun/freja/068deb7a3ac1ce405443ebf889b9ed0a643c28e0/test/lul.janet -------------------------------------------------------------------------------- /usages/sample.janet: -------------------------------------------------------------------------------- 1 | # this comment block has tests 2 | (comment 3 | 4 | # 1) a comment block test has two pieces: 5 | # 6 | # 1) the form 7 | # 2) the expected value comment 8 | # 9 | (+ 1 1) 10 | # => 2 11 | 12 | # 2) another example 13 | 14 | # the following form is executed, as it has no expected value, but its 15 | # effects will remain valid for subsequent portions 16 | (def my-value 1) 17 | 18 | # note the use of `my-value` here 19 | (struct :a my-value :b 2) 20 | # => {:a 1 :b 2} 21 | 22 | # 3. below shows one way to express nested content more readably 23 | (let [i 2] 24 | (deep= 25 | # 26 | (struct :a (/ i i) 27 | :b [i (+ i 1) (+ i 3) (+ i 5)] 28 | :c {:x (math/pow 2 3)}) 29 | # 30 | {:a 1 31 | :b [2 3 5 7] 32 | :c {:x 8}})) 33 | # => true 34 | 35 | # 4. one way to express expected values involving tuples, is to use 36 | # square bracket tuples... 37 | (tuple :a :b) 38 | # => [:a :b] 39 | 40 | # 5. alternatively, quote ordinary tuples in the expected value comment 41 | (tuple :x :y :z) 42 | # => '(:x :y :z) 43 | 44 | ) 45 | 46 | # this comment block does not have tests because there are 47 | # no expected values expressed as line comments 48 | (comment 49 | 50 | (print "hi") 51 | 52 | (each x (range 3) 53 | (print x)) 54 | 55 | ) 56 | -------------------------------------------------------------------------------- /usages/test_undo_redo.janet: -------------------------------------------------------------------------------- 1 | (import ../freja/new_gap_buffer :prefix "") 2 | (import ../freja/new_gap_buffer_util :prefix "") 3 | 4 | (comment 5 | (-> (string->gb "abcd|") 6 | (delete-region! 0 2) 7 | undo! 8 | render) 9 | #=> "abcd|" 10 | ) 11 | -------------------------------------------------------------------------------- /usages/textual_representation_of_gap_buffer.janet: -------------------------------------------------------------------------------- 1 | (import ../freja/new_gap_buffer :prefix "") 2 | (import ../freja/new_gap_buffer_util :prefix "") 3 | (import spork/test) 4 | 5 | (comment 6 | ### Structure of a gap buffer 7 | (def wat @{:text @"" ## the last committed string 8 | :gap-start 0 ## position relative to `:text` that marks the beginning of the gap 9 | :gap-stop 0 ## position relative to `:text` that marks the end of the gap 10 | :caret 0 ## absolute position of caret 11 | :selection 0 ## absolute position of caret 12 | :gap @"" ## contents of the gap 13 | }) 14 | 15 | ### Example 16 | 17 | ## string representation of the gap 18 | (def gb-s "ab|[c]") 19 | 20 | # | means :caret 21 | # [ means :gap-start 22 | # ] means :gap-end 23 | 24 | 25 | (deep= (string->gb gb-s) 26 | @{:actions @[] 27 | :caret 2 28 | :gap @"c" 29 | :gap-start 2 30 | :gap-stop 2 31 | :redo-queue @[] 32 | :text @"ab"}) 33 | #=> true 34 | 35 | 36 | ## More details about string representation of gap buffer below 37 | 38 | 39 | ### ----- Caret 40 | 41 | ### | means "caret" 42 | (deep= (string->gb "ab|c") 43 | @{:actions @[] 44 | :caret 2 45 | :gap @"" 46 | :gap-start 2 47 | :gap-stop 2 48 | :redo-queue @[] 49 | :text @"abc"}) 50 | #=> true 51 | 52 | ### if there is no |, assume the caret is at the end of the string 53 | (-> (string->gb "abc") 54 | render) 55 | #=> "abc|" 56 | 57 | 58 | ### ----- Selection 59 | 60 | # * means "start of selection" 61 | # in this case, we select from right to left 62 | (deep= (string->gb "ab|c*") 63 | @{:actions @[] 64 | :caret 2 65 | :gap @"" 66 | :gap-start 2 67 | :gap-stop 2 68 | :redo-queue @[] 69 | :selection 3 70 | :text @"abc"}) 71 | #=> true 72 | 73 | #...and select from left to right 74 | (deep= (string->gb "ab*c|") 75 | @{:actions @[] 76 | :caret 3 77 | :gap @"" 78 | :gap-start 3 79 | :gap-stop 3 80 | :redo-queue @[] 81 | :selection 2 82 | :text @"abc"}) 83 | #=> true 84 | 85 | 86 | ### ----- Gap 87 | 88 | ### [xyz] means "xyz is currently in the gap 89 | (deep= (string->gb "a[xyz]b|") 90 | @{:actions @[] 91 | :caret 5 92 | :gap @"xyz" 93 | :gap-start 1 94 | :gap-stop 1 95 | :redo-queue @[] 96 | :text @"ab"}) 97 | #=> true 98 | 99 | ### if there is no |, but there is a gap, assume the caret is at the end of the gap 100 | (deep= (string->gb "a[xyz]b") 101 | @{:actions @[] 102 | :caret 5 103 | :gap @"xyz" 104 | :gap-start 1 105 | :gap-stop 1 106 | :redo-queue @[] 107 | :text @"ab"}) 108 | #=> true 109 | 110 | ### if there is no [] but there is a |, that means there's an empty gap at the position of the caret 111 | (string->gb "ab|c") 112 | #=> (string->gb "ab[]|c") 113 | 114 | ### (ab) means that "ab has been deleted" (e.g. using backspace) 115 | (deep= (string->gb "(ab)|") 116 | @{:actions @[] 117 | :caret 0 118 | :gap @"" 119 | :gap-start 0 120 | :gap-stop 2 121 | :redo-queue @[] 122 | :text @"ab"}) 123 | #=> true 124 | 125 | # this is more apparent when running `commit!` and `render` 126 | (-> (string->gb "(ab)|") 127 | commit! 128 | render) 129 | #=> "|" 130 | 131 | ### (ab[123]cd) means ab and cd has been deleted, while 123 is in the buffer 132 | (deep= (string->gb "(ab[123]cd)") 133 | @{:actions @[] 134 | :caret 3 135 | :gap @"123" 136 | :gap-start 0 137 | :gap-stop 4 138 | :redo-queue @[] 139 | :text @"abcd"}) 140 | #=> true 141 | 142 | 143 | (-> (string->gb "(ab[123]cd)") 144 | commit! 145 | render) 146 | #=> "123|" 147 | 148 | 149 | ### ----- More examples 150 | 151 | # we can combine the notation to create more complicated buffers 152 | 153 | (deep= (string->gb "ab*[ca|ca]") 154 | @{:actions @[] 155 | :caret 4 156 | :gap @"caca" 157 | :gap-start 2 158 | :gap-stop 2 159 | :redo-queue @[] 160 | :selection 2 161 | :text @"ab"}) 162 | #=> true 163 | 164 | # running commit and render can make it easier to understand 165 | (-> (string->gb "ab*[ca|ca]") 166 | commit! 167 | render) 168 | #=> "ab*ca|ca" 169 | 170 | (deep= (string->gb "1(ignored[23|45]ignored)6*") 171 | @{:actions @[] 172 | :caret 3 173 | :gap @"2345" 174 | :gap-start 1 175 | :gap-stop 15 176 | :redo-queue @[] 177 | :selection 6 178 | :text @"1ignoredignored6"}) 179 | #=> true 180 | 181 | 182 | ## spaces hould work 183 | (deep= (string->gb "a b|") 184 | @{:actions @[] 185 | :caret 3 186 | :gap @"" 187 | :gap-start 3 188 | :gap-stop 3 189 | :redo-queue @[] 190 | :text @"a b"}) 191 | #=> true 192 | ) 193 | 194 | --------------------------------------------------------------------------------