├── 6502 ├── COPYRIGHT.txt ├── _FOSSIL_ ├── common.reds ├── cpu.reds ├── examples │ └── 6502.reds └── machine.reds ├── .gitattributes ├── .gitignore ├── C-library ├── ANSI.red ├── ANSI.reds ├── BSD.reds ├── COPYRIGHT.txt ├── _FOSSIL_ ├── examples │ ├── Fibonacci │ │ ├── Fibonacci-fast.red │ │ ├── Fibonacci.b │ │ ├── Fibonacci.c │ │ ├── Fibonacci.orca │ │ ├── Fibonacci.r │ │ ├── Fibonacci.red │ │ ├── Fibonacci.reds │ │ ├── Fibonacci.ruby │ │ └── Fibonacci.w │ └── Mandelbrot │ │ ├── Complex-Mandelbrot.w │ │ ├── Mandelbrot.b │ │ ├── Mandelbrot.c │ │ ├── Mandelbrot.orca │ │ ├── Mandelbrot.r │ │ ├── Mandelbrot.red │ │ ├── Mandelbrot.reds │ │ ├── Mandelbrot.ruby │ │ └── Mandelbrot.w ├── input-output.red └── math.reds ├── GLib ├── COPYRIGHT.txt ├── GLib.reds └── _FOSSIL_ ├── GTK-Champlain ├── COPYRIGHT.txt ├── GTK-Champlain.reds ├── _FOSSIL_ └── examples │ └── Champlain-map-browser.reds ├── GTK-WebKit ├── COPYRIGHT.txt ├── GTK-WebKit.reds ├── _FOSSIL_ └── examples │ └── LazySundayAfternoon-Browser.reds ├── GTK ├── COPYRIGHT.txt ├── GDK.reds ├── GTK.red ├── GTK.reds ├── _FOSSIL_ └── examples │ ├── GTK-IDE.red │ ├── GTK-browser.red │ ├── GTK-input-field.red │ ├── GTK-input-field.reds │ ├── GTK-live-coding.red │ ├── GTK-text-editor.red │ ├── GTK-widgets.red │ ├── GTK-widgets.reds │ ├── Red-48x48.png │ ├── dressed-up-hello-GTK-world.red │ ├── dressed-up-hello-GTK-world.reds │ ├── goodbye-cruel-GTK-world.reds │ ├── hello-GTK-world-with-title.red │ ├── hello-GTK-world-with-title.reds │ ├── hello-GTK-world.red │ └── hello-GTK-world.reds ├── JSON ├── COPYRIGHT.txt ├── JSON.red ├── _FOSSIL_ └── examples │ └── JSON.red ├── Java ├── COPYRIGHT.txt ├── JNI-library.reds ├── JNI.reds ├── JVM.reds ├── _FOSSIL_ └── examples │ ├── hello-JNI.java │ └── hello-JNI.reds ├── OSM-GPS-Map ├── COPYRIGHT.txt ├── OSM-GPS-Map.reds ├── _FOSSIL_ └── examples │ └── OSM-GPS-Map-browser.reds ├── OpenGL ├── COPYRIGHT.txt ├── GL-common.reds ├── GL.reds ├── OS-Mesa.reds ├── OpenGL.reds ├── TinyGL.reds ├── _FOSSIL_ ├── common.reds ├── examples │ ├── GL-spin.reds │ └── GL-textures.reds └── platforms │ ├── PicoGL.reds │ ├── SDL-OS-Mesa.reds │ └── SDL.reds ├── README.md ├── REBOL-3 ├── COPYRIGHT.txt ├── _FOSSIL_ ├── common.reds ├── examples │ ├── hello-REBOL-3-extension.red │ └── hello-REBOL-3-extension.reds ├── extension.reds └── host.reds ├── SDL ├── COPYRIGHT.txt ├── SDL.reds ├── _FOSSIL_ └── examples │ ├── PeterPaint-SDL.reds │ ├── play-SDL-WAV.reds │ ├── sample.bmp │ └── sample.wav ├── SQLite ├── COPYRIGHT.txt ├── SQLite.red ├── SQLite.reds ├── _FOSSIL_ └── examples │ ├── do-sql.red │ └── do-sql.reds ├── TNetStrings ├── COPYRIGHT.txt ├── TNetStrings.red ├── _FOSSIL_ └── examples │ └── TNetStrings.red ├── ZeroMQ-binding ├── COPYRIGHT.txt ├── ZeroMQ-binding.red ├── ZeroMQ-binding.reds ├── _FOSSIL_ └── examples │ ├── 0MQ-reply-server.red │ ├── 0MQ-reply-server.reds │ ├── 0MQ-request-client.red │ ├── 0MQ-request-client.reds │ ├── 0MQ-ventilator-sink.red │ ├── 0MQ-ventilator-worker.red │ └── 0MQ-ventilator.red ├── cURL ├── COPYRIGHT.txt ├── _FOSSIL_ ├── cURL.reds └── examples │ └── read-web-page.reds ├── common ├── COPYRIGHT.txt ├── FPU-configuration.reds ├── _FOSSIL_ ├── common.red ├── common.reds ├── examples │ ├── console.red │ ├── empty.red │ ├── hello-Unicode.reds │ ├── red-base.red │ ├── red-core-message.red │ ├── red-core.red │ ├── red-message.red │ └── red.red ├── input-output.red └── input-output.reds └── download.r /.gitattributes: -------------------------------------------------------------------------------- 1 | # Auto detect text files and perform LF normalization 2 | * text=auto 3 | 4 | # Custom for Visual Studio 5 | *.cs diff=csharp 6 | *.sln merge=union 7 | *.csproj merge=union 8 | *.vbproj merge=union 9 | *.fsproj merge=union 10 | *.dbproj merge=union 11 | 12 | # Standard to msysgit 13 | *.doc diff=astextplain 14 | *.DOC diff=astextplain 15 | *.docx diff=astextplain 16 | *.DOCX diff=astextplain 17 | *.dot diff=astextplain 18 | *.DOT diff=astextplain 19 | *.pdf diff=astextplain 20 | *.PDF diff=astextplain 21 | *.rtf diff=astextplain 22 | *.RTF diff=astextplain 23 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | ################# 2 | ## Eclipse 3 | ################# 4 | 5 | *.pydevproject 6 | .project 7 | .metadata 8 | bin/ 9 | tmp/ 10 | *.tmp 11 | *.bak 12 | *.swp 13 | *~.nib 14 | local.properties 15 | .classpath 16 | .settings/ 17 | .loadpath 18 | 19 | # External tool builders 20 | .externalToolBuilders/ 21 | 22 | # Locally stored "Eclipse launch configurations" 23 | *.launch 24 | 25 | # CDT-specific 26 | .cproject 27 | 28 | # PDT-specific 29 | .buildpath 30 | 31 | 32 | ################# 33 | ## Visual Studio 34 | ################# 35 | 36 | ## Ignore Visual Studio temporary files, build results, and 37 | ## files generated by popular Visual Studio add-ons. 38 | 39 | # User-specific files 40 | *.suo 41 | *.user 42 | *.sln.docstates 43 | 44 | # Build results 45 | 46 | [Dd]ebug/ 47 | [Rr]elease/ 48 | x64/ 49 | build/ 50 | [Bb]in/ 51 | [Oo]bj/ 52 | 53 | # MSTest test Results 54 | [Tt]est[Rr]esult*/ 55 | [Bb]uild[Ll]og.* 56 | 57 | *_i.c 58 | *_p.c 59 | *.ilk 60 | *.meta 61 | *.obj 62 | *.pch 63 | *.pdb 64 | *.pgc 65 | *.pgd 66 | *.rsp 67 | *.sbr 68 | *.tlb 69 | *.tli 70 | *.tlh 71 | *.tmp 72 | *.tmp_proj 73 | *.log 74 | *.vspscc 75 | *.vssscc 76 | .builds 77 | *.pidb 78 | *.log 79 | *.scc 80 | 81 | # Visual C++ cache files 82 | ipch/ 83 | *.aps 84 | *.ncb 85 | *.opensdf 86 | *.sdf 87 | *.cachefile 88 | 89 | # Visual Studio profiler 90 | *.psess 91 | *.vsp 92 | *.vspx 93 | 94 | # Guidance Automation Toolkit 95 | *.gpState 96 | 97 | # ReSharper is a .NET coding add-in 98 | _ReSharper*/ 99 | *.[Rr]e[Ss]harper 100 | 101 | # TeamCity is a build add-in 102 | _TeamCity* 103 | 104 | # DotCover is a Code Coverage Tool 105 | *.dotCover 106 | 107 | # NCrunch 108 | *.ncrunch* 109 | .*crunch*.local.xml 110 | 111 | # Installshield output folder 112 | [Ee]xpress/ 113 | 114 | # DocProject is a documentation generator add-in 115 | DocProject/buildhelp/ 116 | DocProject/Help/*.HxT 117 | DocProject/Help/*.HxC 118 | DocProject/Help/*.hhc 119 | DocProject/Help/*.hhk 120 | DocProject/Help/*.hhp 121 | DocProject/Help/Html2 122 | DocProject/Help/html 123 | 124 | # Click-Once directory 125 | publish/ 126 | 127 | # Publish Web Output 128 | *.Publish.xml 129 | *.pubxml 130 | 131 | # NuGet Packages Directory 132 | ## TODO: If you have NuGet Package Restore enabled, uncomment the next line 133 | #packages/ 134 | 135 | # Windows Azure Build Output 136 | csx 137 | *.build.csdef 138 | 139 | # Windows Store app package directory 140 | AppPackages/ 141 | 142 | # Others 143 | sql/ 144 | *.Cache 145 | ClientBin/ 146 | [Ss]tyle[Cc]op.* 147 | ~$* 148 | *~ 149 | *.dbmdl 150 | *.[Pp]ublish.xml 151 | *.pfx 152 | *.publishsettings 153 | 154 | # RIA/Silverlight projects 155 | Generated_Code/ 156 | 157 | # Backup & report files from converting an old project file to a newer 158 | # Visual Studio version. Backup files are not needed, because we have git ;-) 159 | _UpgradeReport_Files/ 160 | Backup*/ 161 | UpgradeLog*.XML 162 | UpgradeLog*.htm 163 | 164 | # SQL Server files 165 | App_Data/*.mdf 166 | App_Data/*.ldf 167 | 168 | ############# 169 | ## Windows detritus 170 | ############# 171 | 172 | # Windows image file caches 173 | Thumbs.db 174 | ehthumbs.db 175 | 176 | # Folder config file 177 | Desktop.ini 178 | 179 | # Recycle Bin used on file shares 180 | $RECYCLE.BIN/ 181 | 182 | # Mac crap 183 | .DS_Store 184 | 185 | 186 | ############# 187 | ## Python 188 | ############# 189 | 190 | *.py[co] 191 | 192 | # Packages 193 | *.egg 194 | *.egg-info 195 | dist/ 196 | build/ 197 | eggs/ 198 | parts/ 199 | var/ 200 | sdist/ 201 | develop-eggs/ 202 | .installed.cfg 203 | 204 | # Installer logs 205 | pip-log.txt 206 | 207 | # Unit test / coverage reports 208 | .coverage 209 | .tox 210 | 211 | #Translations 212 | *.mo 213 | 214 | #Mr Developer 215 | .mr.developer.cfg 216 | 217 | test/ 218 | *.fossil 219 | *.fossil-journal 220 | `_fossil_` 221 | 6502/_FOSSIL_ 222 | C-library/_FOSSIL_ 223 | common/_FOSSIL_ 224 | cURL/_FOSSIL_ 225 | GLib/_FOSSIL_ 226 | GTK/_FOSSIL_ 227 | GTK-Champlain/_FOSSIL_ 228 | GTK-WebKit/_FOSSIL_ 229 | Java/_FOSSIL_ 230 | JSON/_FOSSIL_ 231 | OpenGL/_FOSSIL_ 232 | OSM-GPS-Map/_FOSSIL_ 233 | REBOL-3/_FOSSIL_ 234 | SDL/_FOSSIL_ 235 | SQLite/_FOSSIL_ 236 | TNetStrings/_FOSSIL_ 237 | ZeroMQ-binding/_FOSSIL_ 238 | -------------------------------------------------------------------------------- /6502/COPYRIGHT.txt: -------------------------------------------------------------------------------- 1 | 6502 CPU Emulator 2 | 3 | Copyright (c) 1995,1996,2012-2014 Kaj de Vos 4 | All rights reserved. 5 | 6 | Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright notice, 9 | this list of conditions and the following disclaimer. 10 | * Redistributions in binary form must reproduce the above copyright 11 | notice, this list of conditions and the following disclaimer in the 12 | documentation and/or other materials provided with the distribution. 13 | 14 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 15 | -------------------------------------------------------------------------------- /6502/_FOSSIL_: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/kealist/RS-fossil-mirror/81e8dfc901d5273e78383b9a3dd959b6fd47edd3/6502/_FOSSIL_ -------------------------------------------------------------------------------- /6502/common.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "6502 Emulator Common Definitions" 3 | Author: "Kaj de Vos" 4 | Rights: "Copyright (c) 1995,1996,2012,2013 Kaj de Vos. All rights reserved." 5 | License: { 6 | Redistribution and use in source and binary forms, with or without modification, 7 | are permitted provided that the following conditions are met: 8 | 9 | * Redistributions of source code must retain the above copyright notice, 10 | this list of conditions and the following disclaimer. 11 | * Redistributions in binary form must reproduce the above copyright notice, 12 | this list of conditions and the following disclaimer in the documentation 13 | and/or other materials provided with the distribution. 14 | 15 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 16 | ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 17 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 18 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 19 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 20 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 21 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 22 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 23 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 24 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | } 26 | Needs: { 27 | Red/System 28 | %C-library/ANSI.reds 29 | } 30 | Purpose: { 31 | Common definitions for 6502 emulator. 32 | } 33 | Tabs: 4 34 | ] 35 | 36 | 37 | #include %../C-library/ANSI.reds 38 | 39 | #define word! unsigned16! 40 | -------------------------------------------------------------------------------- /6502/examples/6502.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "6502 CPU emulator example" 3 | Author: "Kaj de Vos" 4 | Rights: "Copyright (c) 1995,1996,2012 Kaj de Vos" 5 | License: { 6 | PD/CC0 7 | http://creativecommons.org/publicdomain/zero/1.0/ 8 | } 9 | Needs: { 10 | Red/System 11 | %machine.reds 12 | %cpu.reds 13 | } 14 | Purpose: { 15 | This is a simple example of a main loop using the 6502 emulator. 16 | } 17 | Example: { 18 | 6502 19 | } 20 | Tabs: 4 21 | ] 22 | 23 | 24 | #include %../machine.reds 25 | 26 | #define do-events [ 27 | forever [tick] 28 | ] 29 | 30 | #include %../cpu.reds 31 | -------------------------------------------------------------------------------- /6502/machine.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "Skeletal Abstracted Machine for CPU Emulator" 3 | Author: "Kaj de Vos" 4 | Rights: "Copyright (c) 1995,1996,2012-2014 Kaj de Vos. All rights reserved." 5 | License: { 6 | Redistribution and use in source and binary forms, with or without modification, 7 | are permitted provided that the following conditions are met: 8 | 9 | * Redistributions of source code must retain the above copyright notice, 10 | this list of conditions and the following disclaimer. 11 | * Redistributions in binary form must reproduce the above copyright notice, 12 | this list of conditions and the following disclaimer in the documentation 13 | and/or other materials provided with the distribution. 14 | 15 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 16 | ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 17 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 18 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 19 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 20 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 21 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 22 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 23 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 24 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | } 26 | Needs: { 27 | Red/System 28 | %6502/common.reds 29 | } 30 | Purpose: { 31 | Machine emulation abstracted away from CPU emulator, 32 | so they can be implemented separately. 33 | } 34 | Tabs: 4 35 | ] 36 | 37 | 38 | #include %common.reds 39 | 40 | 41 | #define IRQ? no 42 | 43 | memory: context [ 44 | 45 | ; Memory management 46 | 47 | map!: alias struct! [item [binary!]] 48 | 49 | read-map: as map! allocate 20h * size? map! 50 | 51 | if null? read-map [ 52 | print-line "Failed to allocate read memory map!" 53 | quit 1 54 | ] 55 | 56 | write-map: as map! allocate 20h * size? map! 57 | 58 | if null? write-map [ 59 | print-line "Failed to allocate write memory map!" 60 | quit 2 61 | ] 62 | 63 | 64 | ; Main memory 65 | 66 | RAM: allocate 00010000h 67 | 68 | if null? RAM [ 69 | print-line "Failed to allocate RAM memory!" 70 | quit 10 71 | ] 72 | 73 | read-list: read-map 74 | write-list: write-map 75 | segment: RAM 76 | 77 | until [ 78 | read-list/item: segment 79 | write-list/item: segment 80 | 81 | read-list: read-list + 1 82 | write-list: write-list + 1 83 | segment: segment + 0800h 84 | RAM + 00010000h = segment 85 | ] 86 | 87 | ; Dummy block to catch write attempts to ROM 88 | 89 | dummy: allocate 0800h 90 | 91 | if null? dummy [ 92 | print-line "Failed to allocate dummy memory block!" 93 | quit 11 94 | ] 95 | 96 | 97 | ; ROM 98 | 99 | ROM: as-binary 0 100 | size: 0 101 | argument: get-argument 1 102 | 103 | either null? argument [ 104 | argument: get-argument 0 105 | print-wide ["Usage:" argument "" newline] 106 | ][ 107 | ROM: read-file-binary argument :size 108 | 109 | if null? ROM [ 110 | print-line "Error reading ROM file!" 111 | quit 20 112 | ] 113 | if size and 07FFh <> 0 [ 114 | print-line "ROM file needs to be a multiple of 2 KB." 115 | free ROM 116 | quit 21 117 | ] 118 | if size >= 00010000h [ 119 | print-line "ROM file cannot be larger than 62 KB." 120 | free ROM 121 | quit 22 122 | ] 123 | 124 | ; WARN: use read-list & write-list from RAM setup 125 | segment: ROM + size 126 | 127 | until [ 128 | read-list: read-list - 1 129 | write-list: write-list - 1 130 | segment: segment - 0800h 131 | 132 | read-list/item: segment 133 | write-list/item: dummy ; Read-only 134 | 135 | segment = ROM 136 | ] 137 | ] 138 | end-argument argument 139 | 140 | 141 | ; Access 142 | 143 | block: function [ 144 | address [word!] 145 | return: [binary!] 146 | /local block 147 | ][ 148 | block: read-map + (address >>> 11) 149 | block/item 150 | ] 151 | pointer: function [ 152 | address [word!] 153 | return: [binary!] 154 | /local block 155 | ][ 156 | block: read-map + (address >>> 11) 157 | block/item + (address and 07FFh) 158 | ] 159 | 160 | read: function [ 161 | address [word!] 162 | return: [byte!] 163 | /local block pointer 164 | ][ 165 | block: read-map + (address >>> 11) 166 | pointer: block/item + (address and 07FFh) 167 | pointer/value 168 | ] 169 | write: function [ 170 | address [word!] 171 | value [byte!] 172 | /local block pointer 173 | ][ 174 | block: write-map + (address >>> 11) 175 | pointer: block/item + (address and 07FFh) 176 | pointer/value: value 177 | ] 178 | 179 | ] 180 | -------------------------------------------------------------------------------- /C-library/BSD.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "C Library BSD extensions" 3 | Author: "Kaj de Vos" 4 | Rights: "Copyright (c) 2013 Kaj de Vos. All rights reserved." 5 | License: { 6 | Redistribution and use in source and binary forms, with or without modification, 7 | are permitted provided that the following conditions are met: 8 | 9 | * Redistributions of source code must retain the above copyright notice, 10 | this list of conditions and the following disclaimer. 11 | * Redistributions in binary form must reproduce the above copyright notice, 12 | this list of conditions and the following disclaimer in the documentation 13 | and/or other materials provided with the distribution. 14 | 15 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 16 | ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 17 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 18 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 19 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 20 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 21 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 22 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 23 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 24 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | } 26 | Needs: { 27 | Red/System >= 0.3.2 28 | %ANSI.reds 29 | } 30 | Tabs: 4 31 | ] 32 | 33 | 34 | #include %ANSI.reds 35 | 36 | 37 | #import [LIBC-file cdecl [ 38 | 39 | ; Floating point 40 | 41 | is-NaN: "isnan" [ "Test for Not-a-Number." 42 | number [float!] 43 | return: [integer!] 44 | ] 45 | is-finite: "finite" [ "Test if number is finite (or NaN)." 46 | number [float!] 47 | return: [integer!] 48 | ] 49 | infinity-sign-of: "isinf" [ "Test for infinity and return its sign, or 0." 50 | number [float!] 51 | return: [integer!] "0: finite, 1: infinite, -1: negative infinity" 52 | ] 53 | 54 | ]] 55 | 56 | 57 | ; Higher level interface 58 | 59 | 60 | ; Floating point 61 | 62 | NaN?: function [ "Test for Not-a-Number." 63 | number [float!] 64 | return: [logic!] 65 | ][ 66 | as-logic is-NaN number 67 | ] 68 | finite?: function [ "Test if number is finite (or NaN)." 69 | number [float!] 70 | return: [logic!] 71 | ][ 72 | as-logic is-finite number 73 | ] 74 | infinite?: function [ "Test for infinity." 75 | number [float!] 76 | return: [logic!] 77 | ][ 78 | as-logic infinity-sign-of number 79 | ] 80 | -------------------------------------------------------------------------------- /C-library/COPYRIGHT.txt: -------------------------------------------------------------------------------- 1 | C Library Binding for Red 2 | 3 | Copyright (c) 2011-2014 Kaj de Vos 4 | All rights reserved. 5 | 6 | Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright notice, 9 | this list of conditions and the following disclaimer. 10 | * Redistributions in binary form must reproduce the above copyright 11 | notice, this list of conditions and the following disclaimer in the 12 | documentation and/or other materials provided with the distribution. 13 | 14 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 15 | -------------------------------------------------------------------------------- /C-library/_FOSSIL_: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/kealist/RS-fossil-mirror/81e8dfc901d5273e78383b9a3dd959b6fd47edd3/C-library/_FOSSIL_ -------------------------------------------------------------------------------- /C-library/examples/Fibonacci/Fibonacci-fast.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | Title: "Fibonacci numbers in fast inlined Red/System" 3 | Author: "Kaj de Vos" 4 | Rights: "Copyright (c) 2012,2013 Kaj de Vos" 5 | License: { 6 | PD/CC0 7 | http://creativecommons.org/publicdomain/zero/1.0/ 8 | } 9 | Needs: { 10 | Red >= 0.3.2 11 | %C-library/ANSI.red 12 | } 13 | Tabs: 4 14 | ] 15 | 16 | #include %../../ANSI.red 17 | 18 | parameter: 40 19 | 20 | start: now/precise 21 | 22 | fibonacci: routine [ 23 | n [integer!] 24 | return: [integer!] 25 | ][ 26 | either n < 2 [n] [(fibonacci n - 1) + fibonacci n - 2] 27 | ] 28 | 29 | prin ["Fibonacci" parameter] print [":" fibonacci parameter newline 30 | "Elapsed seconds:" subtract-time now/precise start newline 31 | "Process time:" get-process-seconds 32 | ] 33 | -------------------------------------------------------------------------------- /C-library/examples/Fibonacci/Fibonacci.b: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env boron 2 | /* 3 | Fibonacci numbers 4 | Copyright (c) 2012 Kaj de Vos 5 | License: PD/CC0 6 | http://creativecommons.org/publicdomain/zero/1.0/ 7 | */ 8 | 9 | parameter: 40 10 | 11 | fibonacci: func [n int!] [ 12 | either lt? n 2 [n] [add fibonacci sub n 1 fibonacci sub n 2] 13 | ] 14 | 15 | start: now 16 | 17 | prin ["Fibonacci" parameter] print [":" fibonacci parameter] 18 | print ["Elapsed time:" sub now start] 19 | -------------------------------------------------------------------------------- /C-library/examples/Fibonacci/Fibonacci.c: -------------------------------------------------------------------------------- 1 | /* 2 | Fibonacci numbers 3 | Copyright (c) 2012 Kaj de Vos 4 | License: PD/CC0 5 | http://creativecommons.org/publicdomain/zero/1.0/ 6 | */ 7 | 8 | #include 9 | #include 10 | 11 | #define parameter 40 12 | 13 | int fibonacci (int n) { 14 | return n < 2 ? n : fibonacci (n - 1) + fibonacci (n - 2); 15 | } 16 | 17 | int main (int argc, const char * argv []) { 18 | time_t start = time (NULL); 19 | int f = fibonacci (parameter); 20 | 21 | printf ("Fibonacci %i: %i\nElapsed time: %f\nProcess time: %f\n", 22 | parameter, f, 23 | difftime (time (NULL), start), 24 | (double) clock () / CLOCKS_PER_SEC 25 | ); 26 | } 27 | -------------------------------------------------------------------------------- /C-library/examples/Fibonacci/Fibonacci.orca: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env orca 2 | ORCA [ 3 | Title: "Fibonacci numbers" 4 | Author: "Kaj de Vos" 5 | Rights: "Copyright (c) 2012 Kaj de Vos" 6 | License: { 7 | PD/CC0 8 | http://creativecommons.org/publicdomain/zero/1.0/ 9 | } 10 | Needs: "ORCA" 11 | Tabs: 4 12 | ] 13 | 14 | parameter: 40 15 | 16 | fibonacci: func [n [integer!]] [ 17 | either n < 2 [n] [(fibonacci n - 1) + fibonacci n - 2] 18 | ] 19 | 20 | start: now/time 21 | 22 | prin ["Fibonacci" parameter] print [":" fibonacci parameter] 23 | print ["Elapsed time:" now/time - start] 24 | -------------------------------------------------------------------------------- /C-library/examples/Fibonacci/Fibonacci.r: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env rebol 2 | REBOL [ 3 | Title: "Fibonacci numbers" 4 | Author: "Kaj de Vos" 5 | Rights: "Copyright (c) 2012 Kaj de Vos" 6 | License: { 7 | PD/CC0 8 | http://creativecommons.org/publicdomain/zero/1.0/ 9 | } 10 | ; Needs: "REBOL 3 or 2" 11 | Tabs: 4 12 | ] 13 | 14 | parameter: 40 15 | 16 | fibonacci: func [n [integer!]] [ 17 | either n < 2 [n] [(fibonacci n - 1) + fibonacci n - 2] 18 | ] 19 | 20 | start: now/time/precise 21 | 22 | prin ["Fibonacci" parameter] print [":" fibonacci parameter] 23 | print ["Elapsed time:" now/time/precise - start] 24 | -------------------------------------------------------------------------------- /C-library/examples/Fibonacci/Fibonacci.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | Title: "Fibonacci numbers" 3 | Author: "Kaj de Vos" 4 | Rights: "Copyright (c) 2012,2013 Kaj de Vos" 5 | License: { 6 | PD/CC0 7 | http://creativecommons.org/publicdomain/zero/1.0/ 8 | } 9 | Needs: { 10 | Red >= 0.3.2 11 | %C-library/ANSI.red 12 | } 13 | Tabs: 4 14 | ] 15 | 16 | #include %../../ANSI.red 17 | 18 | parameter: 40 19 | 20 | start: now/precise 21 | 22 | fibonacci: function [ 23 | n [integer!] 24 | return: [integer!] 25 | ][ 26 | either n < 2 [n] [(fibonacci n - 1) + fibonacci n - 2] 27 | ] 28 | 29 | prin ["Fibonacci" parameter] print [":" fibonacci parameter newline 30 | "Elapsed seconds:" subtract-time now/precise start newline 31 | "Process time:" get-process-seconds 32 | ] 33 | -------------------------------------------------------------------------------- /C-library/examples/Fibonacci/Fibonacci.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "Fibonacci numbers" 3 | Author: "Kaj de Vos" 4 | Rights: "Copyright (c) 2012,2013 Kaj de Vos" 5 | License: { 6 | PD/CC0 7 | http://creativecommons.org/publicdomain/zero/1.0/ 8 | } 9 | Needs: { 10 | Red/System >= 0.2.5 11 | %C-library/ANSI.reds 12 | } 13 | Tabs: 4 14 | ] 15 | 16 | #include %../../ANSI.reds 17 | 18 | #define parameter 40 19 | 20 | fibonacci: function [ 21 | n [integer!] 22 | return: [integer!] 23 | ][ 24 | either n < 2 [n] [(fibonacci n - 1) + fibonacci n - 2] 25 | ] 26 | 27 | start: now-time null 28 | f: fibonacci parameter 29 | 30 | print-line [ 31 | "Fibonacci " parameter ": " f newline 32 | "Elapsed time: " subtract-time now-time null start newline 33 | "Process time: " get-process-seconds 34 | ] 35 | -------------------------------------------------------------------------------- /C-library/examples/Fibonacci/Fibonacci.ruby: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env ruby 2 | 3 | # Fibonacci numbers 4 | # Copyright (c) 2012 Kaj de Vos 5 | # License: PD/CC0 6 | # http://creativecommons.org/publicdomain/zero/1.0/ 7 | 8 | Parameter = 40 9 | 10 | def fibonacci n 11 | n < 2 ? n : fibonacci(n - 1) + fibonacci(n - 2) 12 | end 13 | 14 | start = Time.now 15 | 16 | puts "Fibonacci #{Parameter}: #{fibonacci Parameter}" 17 | puts "Elapsed time: #{Time.now - start}" 18 | -------------------------------------------------------------------------------- /C-library/examples/Fibonacci/Fibonacci.w: -------------------------------------------------------------------------------- 1 | World [ 2 | Title: "Fibonacci numbers" 3 | Author: "Kaj de Vos" 4 | Rights: "Copyright (c) 2012 Kaj de Vos" 5 | License: { 6 | PD/CC0 7 | http://creativecommons.org/publicdomain/zero/1.0/ 8 | } 9 | Needs: "World" 10 | Tabs: 4 11 | ] 12 | 13 | parameter: 40 14 | 15 | fibonacci: func [n [integer!]] [ 16 | either n < 2 [n] [(fibonacci n - 1) + fibonacci n - 2] 17 | ] 18 | 19 | start: now/time/precise 20 | 21 | prin ["Fibonacci" parameter] print [":" fibonacci parameter] 22 | print ["Elapsed time:" now/time/precise - start] 23 | -------------------------------------------------------------------------------- /C-library/examples/Mandelbrot/Complex-Mandelbrot.w: -------------------------------------------------------------------------------- 1 | World [ 2 | Title: "Mandelbrot fractal ASCII renderer" 3 | Author: { 4 | Kaj de Vos 5 | Adapted from Erik Wrenholt and John Niclasen 6 | http://www.timestretch.com/article/mandelbrot_fractal_benchmark 7 | } 8 | Rights: "Copyright (c) 2012 Kaj de Vos" 9 | License: { 10 | PD/CC0 11 | http://creativecommons.org/publicdomain/zero/1.0/ 12 | } 13 | Needs: "World" 14 | Tabs: 4 15 | ] 16 | 17 | threshold: 4.0 18 | max-iterations: 50'000 19 | 20 | mandelbrot: func [ 21 | c [complex!] 22 | /local i z 23 | ][ 24 | z: 0i 25 | 26 | repeat i max-iterations [ 27 | z: z * z + c 28 | 29 | if threshold < abs z [return i] 30 | ] 31 | 0 32 | ] 33 | 34 | start: now/time/precise 35 | 36 | for y -59 19 1 [ 37 | for x -39 39 1 [ 38 | prin either zero? mandelbrot x * 1i + y / 40 [#"*"] [#" "] 39 | ] 40 | print "" 41 | ] 42 | 43 | print ["Elapsed time:" now/time/precise - start] 44 | -------------------------------------------------------------------------------- /C-library/examples/Mandelbrot/Mandelbrot.b: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env boron 2 | /* 3 | Mandelbrot fractal ASCII renderer 4 | Copyright (c) 2012 Kaj de Vos 5 | License: PD/CC0 6 | http://creativecommons.org/publicdomain/zero/1.0/ 7 | */ 8 | 9 | threshold: 16.0 10 | max-iterations: 50000 11 | 12 | mandelbrot: func [ 13 | x decimal! 14 | y decimal! 15 | | i cr ci zr zi zr2 zi2 value 16 | ][ 17 | cr: sub y 0.5 18 | ci: x 19 | zr: zi: 0.0 20 | i: 1 21 | 22 | loop max-iterations [ 23 | value: mul zr zi 24 | zr: add sub zr2: mul zr zr zi2: mul zi zi cr 25 | zi: add add value value ci 26 | 27 | if gt? add zr2 zi2 threshold [return i] 28 | 29 | ++ i 30 | ] 31 | 0 32 | ] 33 | 34 | start: now 35 | y: -39 36 | 37 | while [lt? y 40] [ 38 | x: -39 39 | 40 | while [lt? x 40] [ 41 | prin either zero? mandelbrot div x 40.0 div y 40.0 ['*'] [' '] 42 | 43 | ++ x 44 | ] 45 | print "" 46 | 47 | ++ y 48 | ] 49 | 50 | print ["Elapsed time:" sub now start] 51 | -------------------------------------------------------------------------------- /C-library/examples/Mandelbrot/Mandelbrot.c: -------------------------------------------------------------------------------- 1 | /* 2 | Mandelbrot fractal ASCII renderer 3 | Copyright (c) 2012 Kaj de Vos 4 | Adapted from Erik Wrenholt 5 | http://www.timestretch.com/article/mandelbrot_fractal_benchmark 6 | License: PD/CC0 7 | http://creativecommons.org/publicdomain/zero/1.0/ 8 | */ 9 | 10 | #include 11 | #include 12 | 13 | #define threshold 16.0 14 | #define max_iterations 50000 15 | 16 | int mandelbrot ( 17 | double x, 18 | double y 19 | ){ 20 | double cr = y - 0.5; 21 | double ci = x; 22 | double zr = 0.0, zi = 0.0; 23 | int i = 1; 24 | 25 | do { 26 | double value = zr * zi; 27 | double zr2 = zr * zr; 28 | double zi2 = zi * zi; 29 | zr = zr2 - zi2 + cr; 30 | zi = value + value + ci; 31 | 32 | if (zr2 + zi2 > threshold) return i; 33 | } while (++i <= max_iterations); 34 | 35 | return 0; 36 | } 37 | 38 | int main (int argc, const char * argv []) { 39 | time_t start = time (NULL); 40 | 41 | for (int y = -39; y <= 39; y++) { 42 | for (int x = -39; x <= 39; x++) { 43 | putchar (mandelbrot (x / 40.0, y / 40.0) == 0 ? '*' : ' '); 44 | } 45 | putchar ('\n'); 46 | } 47 | 48 | printf ("Elapsed time: %f\nProcessor time: %f\n", 49 | difftime (time (NULL), start), 50 | (double) clock () / CLOCKS_PER_SEC 51 | ); 52 | } 53 | -------------------------------------------------------------------------------- /C-library/examples/Mandelbrot/Mandelbrot.orca: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env orca 2 | ORCA [ 3 | Title: "Mandelbrot fractal ASCII renderer" 4 | Author: "Kaj de Vos" 5 | Rights: "Copyright (c) 2012 Kaj de Vos" 6 | License: { 7 | PD/CC0 8 | http://creativecommons.org/publicdomain/zero/1.0/ 9 | } 10 | Needs: "ORCA" 11 | Tabs: 4 12 | ] 13 | 14 | threshold: 16.0 15 | max-iterations: 50000 16 | 17 | mandelbrot: func [ 18 | x [decimal!] 19 | y [decimal!] 20 | /local i cr ci zr zi zr2 zi2 value 21 | ][ 22 | cr: y - 0.5 23 | ci: x 24 | zi: zr: 0.0 25 | 26 | repeat i max-iterations [ 27 | value: zr * zi 28 | zr: (zr2: zr * zr) - (zi2: zi * zi) + cr 29 | zi: value + value + ci 30 | 31 | if zr2 + zi2 > threshold [return i] 32 | ] 33 | 0 34 | ] 35 | 36 | start: now/time 37 | 38 | y: -39 39 | 40 | until [ 41 | x: -39 42 | 43 | until [ 44 | prin either 0 = mandelbrot x / 40.0 y / 40.0 [#"*"] [#" "] 45 | 46 | 39 < x: x + 1 47 | ] 48 | print "" 49 | 50 | 39 < y: y + 1 51 | ] 52 | 53 | print ["Elapsed time:" now/time - start] 54 | -------------------------------------------------------------------------------- /C-library/examples/Mandelbrot/Mandelbrot.r: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env rebol 2 | REBOL [ 3 | Title: "Mandelbrot fractal ASCII renderer" 4 | Author: "Kaj de Vos" 5 | Rights: "Copyright (c) 2012 Kaj de Vos" 6 | License: { 7 | PD/CC0 8 | http://creativecommons.org/publicdomain/zero/1.0/ 9 | } 10 | ; Needs: "REBOL 3 or 2" 11 | Tabs: 4 12 | ] 13 | 14 | threshold: 16.0 15 | max-iterations: 50'000 16 | 17 | mandelbrot: func [ 18 | x [decimal!] 19 | y [decimal!] 20 | /local i cr ci zr zi zr2 zi2 value 21 | ][ 22 | cr: y - 0.5 23 | ci: x 24 | zr: zi: 0.0 25 | 26 | repeat i max-iterations [ 27 | value: zr * zi 28 | zr: (zr2: zr * zr) - (zi2: zi * zi) + cr 29 | zi: value + value + ci 30 | 31 | if zr2 + zi2 > threshold [return i] 32 | ] 33 | 0 34 | ] 35 | 36 | start: now/time/precise 37 | 38 | for y -39 39 1 [ 39 | for x -39 39 1 [ 40 | prin either zero? mandelbrot x / 40.0 y / 40.0 [#"*"] [#" "] 41 | ] 42 | print "" 43 | ] 44 | 45 | print ["Elapsed time:" now/time/precise - start] 46 | -------------------------------------------------------------------------------- /C-library/examples/Mandelbrot/Mandelbrot.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | Title: "Mandelbrot fractal ASCII renderer" 3 | Author: "Kaj de Vos" 4 | Rights: "Copyright (c) 2012 Kaj de Vos" 5 | License: { 6 | PD/CC0 7 | http://creativecommons.org/publicdomain/zero/1.0/ 8 | } 9 | Needs: { 10 | Red >= 0.3.0 11 | } 12 | Tabs: 4 13 | ] 14 | 15 | #system [ 16 | #define threshold 16.0 17 | #define max-iterations 50'000 18 | 19 | mandelbrot: function [ 20 | x [float!] 21 | y [float!] 22 | return: [integer!] 23 | /local i cr ci zr zi zr2 zi2 value 24 | ][ 25 | cr: y - 0.5 26 | ci: x 27 | zr: 0.0 28 | zi: 0.0 29 | i: 1 30 | 31 | until [ 32 | value: zr * zi 33 | zr2: zr * zr 34 | zi2: zi * zi 35 | zr: zr2 - zi2 + cr 36 | zi: value + value + ci 37 | 38 | if zr2 + zi2 > threshold [return i] 39 | 40 | i: i + 1 41 | i > max-iterations 42 | ] 43 | 0 44 | ] 45 | 46 | x: 0.0 47 | y: -39.0 48 | 49 | until [ 50 | x: -39.0 51 | 52 | until [ 53 | print either zero? mandelbrot x / 40.0 y / 40.0 [#"*"] [#" "] 54 | 55 | x: x + 1.0 56 | x > 39.0 57 | ] 58 | print newline 59 | 60 | y: y + 1.0 61 | y > 39.0 62 | ] 63 | ] 64 | -------------------------------------------------------------------------------- /C-library/examples/Mandelbrot/Mandelbrot.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "Mandelbrot fractal ASCII renderer" 3 | Author: "Kaj de Vos" 4 | Rights: "Copyright (c) 2012,2013 Kaj de Vos" 5 | License: { 6 | PD/CC0 7 | http://creativecommons.org/publicdomain/zero/1.0/ 8 | } 9 | Needs: { 10 | Red/System >= 0.2.5 11 | %C-library/ANSI.reds 12 | } 13 | Tabs: 4 14 | ] 15 | 16 | #include %../../ANSI.reds 17 | 18 | #define threshold 16.0 19 | #define max-iterations 50'000 20 | 21 | mandelbrot: function [ 22 | x [float!] 23 | y [float!] 24 | return: [integer!] 25 | /local i cr ci zr zi zr2 zi2 value 26 | ][ 27 | cr: y - 0.5 28 | ci: x 29 | zr: 0.0 30 | zi: 0.0 31 | i: 1 32 | 33 | until [ 34 | value: zr * zi 35 | zr2: zr * zr 36 | zi2: zi * zi 37 | zr: zr2 - zi2 + cr 38 | zi: value + value + ci 39 | 40 | if zr2 + zi2 > threshold [return i] 41 | 42 | i: i + 1 43 | i > max-iterations 44 | ] 45 | 0 46 | ] 47 | 48 | start: now-time null 49 | 50 | x: 0.0 51 | y: -39.0 52 | 53 | until [ 54 | x: -39.0 55 | 56 | until [ 57 | either zero? mandelbrot x / 40.0 y / 40.0 [print #"*"] [print #" "] 58 | 59 | x: x + 1.0 60 | x > 39.0 61 | ] 62 | print newline 63 | 64 | y: y + 1.0 65 | y > 39.0 66 | ] 67 | 68 | print-line [ 69 | "Elapsed time: " subtract-time now-time null start newline 70 | "Process time: " get-process-seconds 71 | ] 72 | -------------------------------------------------------------------------------- /C-library/examples/Mandelbrot/Mandelbrot.ruby: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env ruby 2 | 3 | # Mandelbrot fractal ASCII renderer 4 | # Copyright (c) 2012 Kaj de Vos 5 | # Adapted from Erik Wrenholt 6 | # http://www.timestretch.com/article/mandelbrot_fractal_benchmark 7 | # License: PD/CC0 8 | # http://creativecommons.org/publicdomain/zero/1.0/ 9 | 10 | Threshold = 16.0 11 | MaxIterations = 50000 12 | 13 | def mandelbrot x, y 14 | cr = y - 0.5 15 | ci = x 16 | zr = zi = 0.0 17 | i = 1 18 | 19 | begin 20 | value = zr * zi 21 | zr = (zr2 = zr * zr) - (zi2 = zi * zi) + cr 22 | zi = value + value + ci 23 | 24 | return i if zr2 + zi2 > Threshold 25 | 26 | i += 1 27 | end until i > MaxIterations 28 | 0 29 | end 30 | 31 | start = Time.now 32 | 33 | for y in -39..39 do 34 | for x in -39..39 do 35 | print mandelbrot(x / 40.0, y / 40.0) == 0 ? '*' : ' ' 36 | end 37 | 38 | puts 39 | end 40 | 41 | puts "Elapsed time: #{Time.now - start}" 42 | -------------------------------------------------------------------------------- /C-library/examples/Mandelbrot/Mandelbrot.w: -------------------------------------------------------------------------------- 1 | World [ 2 | Title: "Mandelbrot fractal ASCII renderer" 3 | Author: "Kaj de Vos" 4 | Rights: "Copyright (c) 2012 Kaj de Vos" 5 | License: { 6 | PD/CC0 7 | http://creativecommons.org/publicdomain/zero/1.0/ 8 | } 9 | Needs: "World" 10 | Tabs: 4 11 | ] 12 | 13 | threshold: 16.0 14 | max-iterations: 50'000 15 | 16 | mandelbrot: func [ 17 | x [decimal!] 18 | y [decimal!] 19 | /local i cr ci zr zi zr2 zi2 value 20 | ][ 21 | cr: y - 0.5 22 | ci: x 23 | zr: zi: 0.0 24 | 25 | repeat i max-iterations [ 26 | value: zr * zi 27 | zr: (zr2: zr * zr) - (zi2: zi * zi) + cr 28 | zi: value + value + ci 29 | 30 | if zr2 + zi2 > threshold [return i] 31 | ] 32 | 0 33 | ] 34 | 35 | start: now/time/precise 36 | 37 | for y -39 39 1 [ 38 | for x -39 39 1 [ 39 | prin either zero? mandelbrot x / 40 y / 40 [#"*"] [#" "] 40 | ] 41 | print "" 42 | ] 43 | 44 | print ["Elapsed time:" now/time/precise - start] 45 | -------------------------------------------------------------------------------- /C-library/input-output.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | Title: "Local file Input/Output" 3 | Author: "Kaj de Vos" 4 | Rights: "Copyright (c) 2013,2014 Kaj de Vos. All rights reserved." 5 | License: { 6 | Redistribution and use in source and binary forms, with or without modification, 7 | are permitted provided that the following conditions are met: 8 | 9 | * Redistributions of source code must retain the above copyright notice, 10 | this list of conditions and the following disclaimer. 11 | * Redistributions in binary form must reproduce the above copyright notice, 12 | this list of conditions and the following disclaimer in the documentation 13 | and/or other materials provided with the distribution. 14 | 15 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 16 | ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 17 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 18 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 19 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 20 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 21 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 22 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 23 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 24 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | } 26 | Needs: { 27 | Red > 0.4.3 28 | %common/common.red 29 | } 30 | Tabs: 4 31 | ] 32 | 33 | 34 | #include %../common/common.red 35 | 36 | 37 | read: routine ["Read file." 38 | name [string!] ; [file! url!] 39 | ; return: [string! none!] 40 | /local file data 41 | ][ 42 | file: to-local-file name 43 | 44 | data: read-file either zero? compare-string-part file "file:" 5 [ 45 | file + 5 46 | ][ 47 | file 48 | ] 49 | free-any file 50 | 51 | either none? data [ 52 | RETURN_NONE 53 | ][ 54 | SET_RETURN ((string/load data (length? data) + 1 UTF-8)) 55 | ; free data 56 | ] 57 | ] 58 | 59 | write: routine ["Write file." 60 | name [string!] ; [file! url!] 61 | data [string!] 62 | return: [logic!] 63 | /local file out ok? 64 | ][ 65 | file: to-local-file name 66 | out: to-UTF8 data 67 | 68 | ok?: write-file either zero? compare-string-part file "file:" 5 [ 69 | file + 5 70 | ][ 71 | file 72 | ] out 73 | 74 | free-any out 75 | free-any file 76 | ok? 77 | ] 78 | 79 | 80 | comment { 81 | 82 | load**: :load 83 | 84 | load: function ["Return a value or block of values by loading a source." 85 | source [string! file!] 86 | /all "Always return a block." 87 | /into "Insert result into existing block." 88 | out [block!] "Result buffer" 89 | ][ 90 | if file? source [source: read source] 91 | 92 | either source [ 93 | either all [ 94 | either into [ 95 | do [load**/all/into source out] 96 | ][ 97 | do [load**/all source] 98 | ] 99 | ][ 100 | either into [ 101 | do [load**/into source out] 102 | ][ 103 | do [load** source] 104 | ] 105 | ] 106 | ][ 107 | none 108 | ] 109 | ] 110 | 111 | } 112 | 113 | context [ 114 | do*: :do 115 | result: make block! 1 ; WARN: not thread safe 116 | 117 | set 'do function ["Execute code from a source." 118 | source 119 | ][ 120 | if any [file? source url? source] [source: read source] 121 | 122 | first head reduce/into dummy: [do* source] clear result ; Force use of interpreter 123 | ] 124 | ] 125 | -------------------------------------------------------------------------------- /C-library/math.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "C Math Library Binding" 3 | Author: "Kaj de Vos" 4 | Rights: "Copyright (c) 2011-2013 Kaj de Vos. All rights reserved." 5 | License: { 6 | Redistribution and use in source and binary forms, with or without modification, 7 | are permitted provided that the following conditions are met: 8 | 9 | * Redistributions of source code must retain the above copyright notice, 10 | this list of conditions and the following disclaimer. 11 | * Redistributions in binary form must reproduce the above copyright notice, 12 | this list of conditions and the following disclaimer in the documentation 13 | and/or other materials provided with the distribution. 14 | 15 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 16 | ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 17 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 18 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 19 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 20 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 21 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 22 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 23 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 24 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | } 26 | Needs: { 27 | Red/System >= 0.3.2 28 | %common/FPU-configuration.reds 29 | } 30 | Tabs: 4 31 | ] 32 | 33 | 34 | #include %../common/FPU-configuration.reds 35 | 36 | 37 | #import [LIBM-file cdecl [ 38 | fraction: "modf" [ "Integral and fractional parts" 39 | number [float!] 40 | integral [pointer! [float!]] 41 | return: [float!] 42 | ] 43 | 44 | round-ceiling: "ceil" [ "Smallest integer not less" 45 | number [float!] 46 | return: [float!] 47 | ] 48 | round-floor: "floor" [ "Largest integer not greater" 49 | number [float!] 50 | return: [float!] 51 | ] 52 | 53 | float-absolute: "fabs" [ 54 | number [float!] 55 | return: [float!] 56 | ] 57 | float-remainder: "fmod" [ 58 | dividend [float!] 59 | divisor [float!] 60 | return: [float!] 61 | ] 62 | 63 | float-power: "pow" [ "Number raised to exponent" 64 | number [float!] 65 | exponent [float!] 66 | return: [float!] 67 | ] 68 | square-root: "sqrt" [ 69 | number [float!] 70 | return: [float!] 71 | ] 72 | 73 | exp: "exp" [ "Exponential" 74 | power [float!] 75 | return: [float!] 76 | ] 77 | log-e: "log" [ "Natural logarithm" 78 | number [float!] 79 | return: [float!] 80 | ] 81 | log-10: "log10" [ "Base 10 logarithm" 82 | number [float!] 83 | return: [float!] 84 | ] 85 | 86 | sine-radians: "sin" [ 87 | number [float!] 88 | return: [float!] 89 | ] 90 | cosine-radians: "cos" [ 91 | number [float!] 92 | return: [float!] 93 | ] 94 | tangent-radians: "tan" [ 95 | number [float!] 96 | return: [float!] 97 | ] 98 | 99 | arcsine-radians: "asin" [ 100 | number [float!] 101 | return: [float!] 102 | ] 103 | arccosine-radians: "acos" [ 104 | number [float!] 105 | return: [float!] 106 | ] 107 | arctangent-radians: "atan" [ 108 | number [float!] 109 | return: [float!] 110 | ] 111 | arctangent-2-radians: "atan2" [ 112 | y [float!] 113 | x [float!] 114 | return: [float!] 115 | ] 116 | 117 | hyper-sine-radians: "sinh" [ "Hyperbolic sine" 118 | number [float!] 119 | return: [float!] 120 | ] 121 | hyper-cosine-radians: "cosh" [ "Hyperbolic cosine" 122 | number [float!] 123 | return: [float!] 124 | ] 125 | hyper-tangent-radians: "tanh" [ "Hyperbolic tangent" 126 | number [float!] 127 | return: [float!] 128 | ] 129 | 130 | ld-exp: "ldexp" [ "x * 2**n" 131 | significand [float!] 132 | exponent [integer!] 133 | return: [float!] 134 | ] 135 | fraction-exponent: "frexp" [ "Split into normalised fraction (significand) and power of 2." 136 | number [float!] 137 | exponent [pointer! [integer!]] 138 | return: [float!] 139 | ] 140 | ]] 141 | -------------------------------------------------------------------------------- /GLib/COPYRIGHT.txt: -------------------------------------------------------------------------------- 1 | GLib Binding for Red 2 | 3 | Copyright (c) 2011-2013 Kaj de Vos 4 | All rights reserved. 5 | 6 | Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright notice, 9 | this list of conditions and the following disclaimer. 10 | * Redistributions in binary form must reproduce the above copyright 11 | notice, this list of conditions and the following disclaimer in the 12 | documentation and/or other materials provided with the distribution. 13 | 14 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 15 | -------------------------------------------------------------------------------- /GLib/GLib.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "GLib Binding" 3 | Author: "Kaj de Vos" 4 | Rights: "Copyright (c) 2011-2013 Kaj de Vos. All rights reserved." 5 | License: { 6 | Redistribution and use in source and binary forms, with or without modification, 7 | are permitted provided that the following conditions are met: 8 | 9 | * Redistributions of source code must retain the above copyright notice, 10 | this list of conditions and the following disclaimer. 11 | * Redistributions in binary form must reproduce the above copyright notice, 12 | this list of conditions and the following disclaimer in the documentation 13 | and/or other materials provided with the distribution. 14 | 15 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 16 | ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 17 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 18 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 19 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 20 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 21 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 22 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 23 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 24 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | } 26 | Needs: { 27 | Red/System >= 0.3.2 28 | GLib 29 | %FPU-configuration.reds 30 | } 31 | Tabs: 4 32 | ] 33 | 34 | 35 | #include %../common/FPU-configuration.reds 36 | 37 | 38 | #define g-size! unsigned-long! ; size! 39 | #define g-type! g-size! 40 | #define g-logic! integer! 41 | #define g-symbol! unsigned32! ; GQuark 42 | 43 | 44 | g: context [ 45 | 46 | g-list!: alias struct! [ 47 | data [handle!] 48 | next [g-list!] 49 | back [g-list!] 50 | ] 51 | #define g-callback! [function! []] 52 | 53 | g-error!: alias struct! [ 54 | domain [g-symbol!] 55 | code [integer!] 56 | message [c-string!] 57 | ] 58 | g-error-reference!: alias struct! [value [g-error!]] 59 | 60 | g-type-class!: alias struct! [ 61 | type [g-type!] 62 | ] 63 | 64 | g-type-instance!: alias struct! [ 65 | class [g-type-class!] 66 | ] 67 | 68 | g-object!: alias struct! [ 69 | ; type [g-type-instance!] 70 | class [g-type-class!] 71 | 72 | reference-count [unsigned!] 73 | ; data [g-data!] ; TODO 74 | ] 75 | 76 | #define g-initially-unowned! g-object! 77 | 78 | g-closure!: alias opaque! 79 | 80 | #define g-closure-notify! [ 81 | function! [ 82 | data [handle!] 83 | closure [g-closure!] 84 | ] 85 | ] 86 | 87 | ; Signals 88 | 89 | #enum connect-flags! [ 90 | connect-after: 1 91 | connect-swapped 92 | ] 93 | 94 | 95 | #switch OS [ 96 | Windows [#define GThreads-library "libgthread-2.0-0.dll"] 97 | MacOSX [#define GThreads-library "libgthread-2.0.dylib"] ; TODO: check this 98 | #default [#define GThreads-library "libgthread-2.0.so.0"] 99 | ] 100 | #import [GThreads-library cdecl [ 101 | ; Global setup 102 | 103 | begin-threads: "g_thread_init" [ "Set up threading." 104 | functions [handle!] 105 | ] 106 | ]] 107 | 108 | 109 | #switch OS [ 110 | Windows [#define GLib-library "libglib-2.0-0.dll"] 111 | MacOSX [#define GLib-library "libglib-2.0.dylib"] ; TODO: check this 112 | #default [#define GLib-library "libglib-2.0.so.0"] 113 | ] 114 | #import [GLib-library cdecl [ 115 | ; Memory management 116 | 117 | g-free: "g_free" [ "Release previously allocated memory." 118 | memory [binary!] 119 | ] 120 | g-free-error: "g_error_free" [ "Clean up error." 121 | error [g-error!] 122 | ] 123 | ]] 124 | 125 | 126 | #switch OS [ 127 | Windows [#define GObject-library "libgobject-2.0-0.dll"] 128 | MacOSX [#define GObject-library "libgobject-2.0.dylib"] ; TODO: check this 129 | #default [#define GObject-library "libgobject-2.0.so.0"] 130 | ] 131 | #import [GObject-library cdecl [ 132 | check-instance-type: "g_type_check_instance_is_a" [ "Check type of an object instance." 133 | instance [g-type-instance!] 134 | type [g-type!] 135 | return: [g-logic!] 136 | ] 137 | 138 | ; Signals 139 | 140 | connect-signal-data: "g_signal_connect_data" [ "Hook up a callback to a signal." 141 | instance [handle!] 142 | detailed-signal [c-string!] 143 | handler [integer!] "g-callback!" 144 | data [handle!] 145 | clear-data [integer!] "g-closure-notify!" 146 | flags [connect-flags!] 147 | return: [unsigned-long!] 148 | ] 149 | ]] 150 | 151 | 152 | ; Higher level interface 153 | 154 | 155 | ; Signals 156 | 157 | connect-signal: function ["Hook up a callback to a signal." 158 | instance [handle!] 159 | detailed-signal [c-string!] 160 | handler [integer!] "g-callback!" 161 | data [handle!] 162 | return: [unsigned-long!] 163 | ][ 164 | connect-signal-data instance detailed-signal handler data null 0 165 | ] 166 | connect-signal-swapped: function ["Hook up a callback to a signal." 167 | instance [handle!] 168 | detailed-signal [c-string!] 169 | handler [integer!] "g-callback!" 170 | data [handle!] 171 | return: [unsigned-long!] 172 | ][ 173 | connect-signal-data instance detailed-signal handler data null connect-swapped 174 | ] 175 | 176 | ] 177 | 178 | 179 | ; Global setup 180 | 181 | g/begin-threads null ; Set up threading 182 | -------------------------------------------------------------------------------- /GLib/_FOSSIL_: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/kealist/RS-fossil-mirror/81e8dfc901d5273e78383b9a3dd959b6fd47edd3/GLib/_FOSSIL_ -------------------------------------------------------------------------------- /GTK-Champlain/COPYRIGHT.txt: -------------------------------------------------------------------------------- 1 | Champlain GTK+ Binding for Red 2 | 3 | Copyright (c) 2011-2013 Kaj de Vos 4 | All rights reserved. 5 | 6 | Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright notice, 9 | this list of conditions and the following disclaimer. 10 | * Redistributions in binary form must reproduce the above copyright 11 | notice, this list of conditions and the following disclaimer in the 12 | documentation and/or other materials provided with the distribution. 13 | 14 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 15 | -------------------------------------------------------------------------------- /GTK-Champlain/GTK-Champlain.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "Champlain GTK+ Binding" 3 | Author: "Kaj de Vos" 4 | Rights: "Copyright (c) 2011-2013 Kaj de Vos. All rights reserved." 5 | License: { 6 | Redistribution and use in source and binary forms, with or without modification, 7 | are permitted provided that the following conditions are met: 8 | 9 | * Redistributions of source code must retain the above copyright notice, 10 | this list of conditions and the following disclaimer. 11 | * Redistributions in binary form must reproduce the above copyright notice, 12 | this list of conditions and the following disclaimer in the documentation 13 | and/or other materials provided with the distribution. 14 | 15 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 16 | ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 17 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 18 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 19 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 20 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 21 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 22 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 23 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 24 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | } 26 | Needs: { 27 | Red/System >= 0.3.2 28 | Champlain-GTK 29 | } 30 | Tabs: 4 31 | ] 32 | 33 | 34 | #include %../GTK/GTK.reds 35 | 36 | 37 | #switch OS [ 38 | Windows [#define Clutter-GTK-library "libclutter-gtk-0.10-0.dll"] ; TODO: check this 39 | MacOSX [#define Clutter-GTK-library "libclutter-gtk-0.10.dylib"] ; TODO: check this 40 | #default [#define Clutter-GTK-library "libclutter-gtk-0.10.so.0"] ; Ubuntu 10.10 41 | ] 42 | #import [Clutter-GTK-library cdecl [ 43 | ; Global setup 44 | 45 | begin-clutter-gtk: "gtk_clutter_init" [ "Set up Clutter GTK+ library." 46 | argc-reference [pointer! [integer!]] 47 | argv-reference [handle-reference!] "Triple reference!" 48 | ] 49 | ]] 50 | 51 | 52 | ; Map views 53 | 54 | champlain-view!: alias opaque! 55 | 56 | 57 | #switch OS [ 58 | Windows [#define Champlain-GTK-library "libchamplain-gtk-0.4-0.dll"] ; TODO: check this 59 | MacOSX [#define Champlain-GTK-library "libchamplain-gtk-0.4.dylib"] ; TODO: check this 60 | #default [#define Champlain-GTK-library "libchamplain-gtk-0.4.so.0"] ; Ubuntu 10.10 61 | ] 62 | #import [Champlain-GTK-library cdecl [ 63 | ; Map views 64 | 65 | champlain-new-view: "gtk_champlain_embed_new" [ "Return new Champlain map view." 66 | return: [champlain-view!] 67 | ] 68 | ]] 69 | 70 | 71 | ; Dialect constructors 72 | 73 | 74 | champlain-map: function ["Build a Champlain map widget." 75 | ; [typed] 76 | ; count [integer!] 77 | ; list [typed-value!] 78 | return: [champlain-view!] 79 | /local view 80 | ][ 81 | view: champlain-new-view 82 | 83 | unless as-logic view [ 84 | gtk/log-error "Failed to create Champlain map view." 85 | ] 86 | view 87 | ] 88 | 89 | 90 | ; Global setup 91 | 92 | begin-clutter-gtk :argc argv-reference ; Set up Clutter GTK+ library 93 | -------------------------------------------------------------------------------- /GTK-Champlain/_FOSSIL_: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/kealist/RS-fossil-mirror/81e8dfc901d5273e78383b9a3dd959b6fd47edd3/GTK-Champlain/_FOSSIL_ -------------------------------------------------------------------------------- /GTK-Champlain/examples/Champlain-map-browser.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "Champlain map browser example" 3 | Author: "Kaj de Vos" 4 | Rights: "Copyright (c) 2011,2013 Kaj de Vos" 5 | License: { 6 | PD/CC0 7 | http://creativecommons.org/publicdomain/zero/1.0/ 8 | } 9 | Needs: { 10 | Red/System >= 0.3.1 11 | %GTK-Champlain.reds 12 | } 13 | Tabs: 4 14 | ] 15 | 16 | #include %../GTK-Champlain.reds 17 | 18 | with gtk [ 19 | view [ 20 | maximize 21 | "Champlain Map Browser" 22 | champlain-map 23 | ] 24 | ] 25 | -------------------------------------------------------------------------------- /GTK-WebKit/COPYRIGHT.txt: -------------------------------------------------------------------------------- 1 | WebKitGTK+ Binding for Red 2 | 3 | Copyright (c) 2011-2013 Kaj de Vos 4 | All rights reserved. 5 | 6 | Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright notice, 9 | this list of conditions and the following disclaimer. 10 | * Redistributions in binary form must reproduce the above copyright 11 | notice, this list of conditions and the following disclaimer in the 12 | documentation and/or other materials provided with the distribution. 13 | 14 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 15 | -------------------------------------------------------------------------------- /GTK-WebKit/GTK-WebKit.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "WebKitGTK+ Binding" 3 | Author: "Kaj de Vos" 4 | Rights: "Copyright (c) 2011-2013 Kaj de Vos. All rights reserved." 5 | License: { 6 | Redistribution and use in source and binary forms, with or without modification, 7 | are permitted provided that the following conditions are met: 8 | 9 | * Redistributions of source code must retain the above copyright notice, 10 | this list of conditions and the following disclaimer. 11 | * Redistributions in binary form must reproduce the above copyright notice, 12 | this list of conditions and the following disclaimer in the documentation 13 | and/or other materials provided with the distribution. 14 | 15 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 16 | ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 17 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 18 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 19 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 20 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 21 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 22 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 23 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 24 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | } 26 | Needs: { 27 | Red/System >= 0.3.2 28 | WebKitGTK+ 29 | } 30 | Tabs: 4 31 | ] 32 | 33 | 34 | #include %../GTK/GTK.reds 35 | 36 | 37 | ; Web views 38 | 39 | web-view!: alias opaque! 40 | 41 | 42 | #switch OS [ 43 | Windows [#define GTK-WebKit-library "libwebkit-win32-1.0-2.dll"] ; TODO: check this 44 | MacOSX [#define GTK-WebKit-library "libwebkit-x11-1.0.dylib"] ; TODO: check this 45 | #default [#define GTK-WebKit-library "libwebkit-1.0.so.2"] ; Old WebKit 46 | ] 47 | #import [GTK-WebKit-library cdecl [ 48 | ; Web views 49 | 50 | web-new-view: "webkit_web_view_new" [ "Return new web view widget." 51 | return: [web-view!] 52 | ] 53 | 54 | web-browse: "webkit_web_view_load_uri" [ "Load URI in web view." 55 | view [web-view!] 56 | uri [c-string!] 57 | ] 58 | ]] 59 | 60 | 61 | ; Higher level interface 62 | 63 | 64 | with gtk [ 65 | 66 | web-get-view: function ["Get web view from BROWSE widget." 67 | browser [scrolled-window!] 68 | return: [web-view!] 69 | /local list 70 | ][ 71 | list: get-container-children as container! browser 72 | 73 | either as-logic list [ 74 | as web-view! list/data 75 | ][ 76 | null 77 | ] 78 | ] 79 | 80 | 81 | ; Dialect constructors 82 | 83 | 84 | browse: function ["Build a web view." 85 | [typed] 86 | count [integer!] 87 | list [typed-value!] 88 | return: [scrolled-window!] 89 | /local view 90 | ][ 91 | view: web-new-view 92 | 93 | either as-logic view [ 94 | while [as-logic count] [ 95 | either list/type = type-c-string! [ 96 | either as-logic list/value [ 97 | web-browse view as-c-string list/value 98 | ][ 99 | log-error "Web view: skipping missing URI." 100 | ] 101 | ][ 102 | log-error "Web view: skipping unknown element." 103 | ] 104 | count: count - 1 105 | list: list + 1 106 | ] 107 | ][ 108 | log-error "Failed to create web view." 109 | ] 110 | scroll view 111 | ] 112 | 113 | ] 114 | -------------------------------------------------------------------------------- /GTK-WebKit/_FOSSIL_: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/kealist/RS-fossil-mirror/81e8dfc901d5273e78383b9a3dd959b6fd47edd3/GTK-WebKit/_FOSSIL_ -------------------------------------------------------------------------------- /GTK-WebKit/examples/LazySundayAfternoon-Browser.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "WebKitGTK+ browser example" 3 | Author: "Kaj de Vos" 4 | Rights: "Copyright (c) 2011,2013 Kaj de Vos" 5 | License: { 6 | PD/CC0 7 | http://creativecommons.org/publicdomain/zero/1.0/ 8 | } 9 | Needs: { 10 | Red/System >= 0.3.1 11 | %GTK-WebKit.reds 12 | } 13 | Tabs: 4 14 | ] 15 | 16 | #include %../GTK-WebKit.reds 17 | 18 | home: "http://www.red-lang.org/" 19 | 20 | with gtk [ 21 | address: function [ 22 | [cdecl] 23 | field [entry!] 24 | browser [scrolled-window!] 25 | ][ 26 | web-browse web-get-view browser get-entry-text field 27 | ] 28 | 29 | browser: browse home 30 | 31 | view [ 32 | maximize 33 | "Lazy Sunday Afternoon Browser" 34 | vbox [0 35 | field [home :address browser] 0 36 | browser full 0 37 | ] 38 | ] 39 | ] 40 | -------------------------------------------------------------------------------- /GTK/COPYRIGHT.txt: -------------------------------------------------------------------------------- 1 | GTK+ Binding for Red 2 | 3 | Copyright (c) 2011-2014 Kaj de Vos 4 | All rights reserved. 5 | 6 | Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright notice, 9 | this list of conditions and the following disclaimer. 10 | * Redistributions in binary form must reproduce the above copyright 11 | notice, this list of conditions and the following disclaimer in the 12 | documentation and/or other materials provided with the distribution. 13 | 14 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 15 | -------------------------------------------------------------------------------- /GTK/GDK.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "GDK Binding" 3 | Author: "Kaj de Vos" 4 | Rights: "Copyright (c) 2011-2013 Kaj de Vos. All rights reserved." 5 | License: { 6 | Redistribution and use in source and binary forms, with or without modification, 7 | are permitted provided that the following conditions are met: 8 | 9 | * Redistributions of source code must retain the above copyright notice, 10 | this list of conditions and the following disclaimer. 11 | * Redistributions in binary form must reproduce the above copyright notice, 12 | this list of conditions and the following disclaimer in the documentation 13 | and/or other materials provided with the distribution. 14 | 15 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 16 | ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 17 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 18 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 19 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 20 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 21 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 22 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 23 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 24 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | } 26 | Needs: { 27 | Red/System >= 0.3.2 28 | GDK 29 | %GLib.reds 30 | } 31 | Tabs: 4 32 | ] 33 | 34 | 35 | #include %../GLib/GLib.reds 36 | 37 | 38 | with g [gdk: context [ 39 | 40 | gdk-window!: alias opaque! 41 | 42 | image!: alias struct! [ 43 | ; parent [g-object!] 44 | class [g-type-class!] 45 | reference-count [unsigned!] 46 | ; data [g-data!] ; TODO 47 | 48 | ; ... TODO 49 | ] 50 | 51 | rectangle!: alias struct! [ 52 | x [integer!] 53 | y [integer!] 54 | width [integer!] 55 | height [integer!] 56 | ] 57 | 58 | 59 | #switch OS [ 60 | Windows [#define GDK-library "libgdk-win32-2.0-0.dll"] 61 | MacOSX [#define GDK-library "libgdk-x11-2.0.dylib"] ; TODO: check this 62 | #default [#define GDK-library "libgdk-x11-2.0.so.0"] 63 | ] 64 | #import [GDK-library cdecl [ 65 | image-type: "gdk_image_get_type" [ "Image type." 66 | return: [g-type!] 67 | ] 68 | ]] 69 | 70 | 71 | #switch OS [ 72 | Windows [#define GDK-pixbuf-library "libgdk_pixbuf-2.0-0.dll"] 73 | MacOSX [#define GDK-pixbuf-library "libgdk_pixbuf-2.0.dylib"] ; TODO: check this 74 | #default [#define GDK-pixbuf-library "libgdk_pixbuf-2.0.so.0"] 75 | ] 76 | #import [GDK-pixbuf-library cdecl [ 77 | load-image: "gdk_pixbuf_new_from_file" [ "Load image file." 78 | file [c-string!] 79 | error [g-error-reference!] 80 | return: [image!] 81 | ] 82 | ]] 83 | 84 | 85 | ; Higher level interface 86 | 87 | 88 | ; WARN: doesn't work at least in GTK 2.18.5 89 | gdk-image?: function ["Test for GDK image type." 90 | instance [g-object!] 91 | return: [logic!] 92 | ][ 93 | any [ 94 | all [as-logic instance/class instance/class/type = image-type] 95 | as-logic check-instance-type as g-type-instance! instance image-type 96 | ] 97 | ] 98 | 99 | ]] 100 | -------------------------------------------------------------------------------- /GTK/_FOSSIL_: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/kealist/RS-fossil-mirror/81e8dfc901d5273e78383b9a3dd959b6fd47edd3/GTK/_FOSSIL_ -------------------------------------------------------------------------------- /GTK/examples/GTK-IDE.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | Title: "Very simple GTK+ IDE" 3 | Author: "Kaj de Vos" 4 | Rights: "Copyright (c) 2013 Kaj de Vos" 5 | License: { 6 | PD/CC0 7 | http://creativecommons.org/publicdomain/zero/1.0/ 8 | } 9 | Needs: { 10 | Red >= 0.3.2 11 | %GTK.red 12 | 13 | %common.red 14 | %C-library/ANSI.red 15 | %input-output.red 16 | %TNetStrings/TNetStrings.red 17 | %JSON/JSON.red 18 | } 19 | Tabs: 4 20 | ] 21 | 22 | #include %../GTK.red 23 | 24 | ; Extras 25 | #include %../../common/common.red 26 | #include %../../C-library/ANSI.red 27 | #include %../../common/input-output.red 28 | #include %../../TNetStrings/TNetStrings.red 29 | #include %../../JSON/JSON.red 30 | ;#include %../../SQLite/SQLite.red 31 | ;#include %../../ZeroMQ-binding/ZeroMQ-binding.red 32 | 33 | view-area: function [ 34 | area [integer!] ; "widget!" 35 | ][ 36 | all [ 37 | script: get-area-text area 38 | not empty? code: load/all script 39 | view/only code 40 | ] 41 | ] 42 | 43 | execute: has [text script result] [ 44 | view/title [ 45 | text: area 46 | hbox [ 47 | button "Do" [ 48 | if all [ 49 | script: get-area-text text 50 | not unset? set/any 'result do script 51 | ][ 52 | print ["==" mold :result] 53 | ] 54 | ] 55 | button "View" [view-area text] 56 | button "Quit" close 57 | ] 58 | ] "Red GTK+ IDE" 59 | ] 60 | 61 | q: :quit 62 | 63 | execute 64 | -------------------------------------------------------------------------------- /GTK/examples/GTK-browser.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | Title: "GTK+ GUI browser" 3 | Author: "Kaj de Vos" 4 | Rights: "Copyright (c) 2013 Kaj de Vos" 5 | License: { 6 | PD/CC0 7 | http://creativecommons.org/publicdomain/zero/1.0/ 8 | } 9 | Needs: { 10 | Red >= 0.3.2 11 | %input-output.red 12 | %GTK.red 13 | 14 | %common.red 15 | %C-library/ANSI.red 16 | %TNetStrings/TNetStrings.red 17 | %JSON/JSON.red 18 | } 19 | Notes: { 20 | Of course, this simple example is totally unsafe, 21 | except in trusted network environments. 22 | } 23 | Tabs: 4 24 | ] 25 | 26 | #include %../../common/input-output.red 27 | #include %../GTK.red 28 | 29 | ; Extras 30 | #include %../../common/common.red 31 | #include %../../C-library/ANSI.red 32 | #include %../../TNetStrings/TNetStrings.red 33 | #include %../../JSON/JSON.red 34 | ;#include %../../SQLite/SQLite.red 35 | ;#include %../../ZeroMQ-binding/ZeroMQ-binding.red 36 | 37 | home: "http://red.esperconsultancy.nl/index.red" 38 | 39 | go-view: function [ 40 | spec [block!] 41 | ][ 42 | unless zero? box: parse-vbox window: actions/2 spec [ 43 | unless zero? display [ 44 | remove-face window display 45 | ] 46 | set 'display box 47 | append-face window box 48 | show box 49 | ] 50 | ] 51 | go: function [ 52 | face [integer!] ; "widget!" 53 | window [integer!] ; "box!" 54 | ][ 55 | all [ 56 | link: either button? face [get-button-text face] [get-field-text face] 57 | not empty? link 58 | script: read link 59 | either empty? code: load/all script [go-view []] [do code] 60 | ] 61 | ] 62 | 63 | execute: function [] [ 64 | link: get-argument 1 65 | 66 | if window: view/only/title compose/deep [ 67 | [ 68 | "File/URL:" address: field (any [link home]) go 69 | button "Go" [go address window] 70 | button "Quit" close 71 | ] 72 | ] "Red GTK+ Browser" 73 | [ 74 | actions/2: window 75 | set 'view :go-view 76 | go address window 77 | do-events 78 | ] 79 | ] 80 | 81 | display: 0 82 | execute 83 | -------------------------------------------------------------------------------- /GTK/examples/GTK-input-field.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | Title: "GTK+ input field example" 3 | Author: "Kaj de Vos" 4 | Rights: "Copyright (c) 2011,2013 Kaj de Vos" 5 | License: { 6 | PD/CC0 7 | http://creativecommons.org/publicdomain/zero/1.0/ 8 | } 9 | Needs: { 10 | Red >= 0.3.2 11 | %GTK.red 12 | } 13 | Tabs: 4 14 | ] 15 | 16 | #include %../GTK.red 17 | 18 | engage: function [ 19 | field [integer!] ; "entry!" 20 | ][ 21 | print ["Input:" get-field-text field] 22 | ] 23 | view/title [ 24 | "Input:" line: field "Here" [engage face] 25 | button "Print" [engage line] 26 | ] "Red GTK+ Input Field" 27 | -------------------------------------------------------------------------------- /GTK/examples/GTK-input-field.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "GTK+ input field example" 3 | Author: "Kaj de Vos" 4 | Rights: "Copyright (c) 2011,2013 Kaj de Vos" 5 | License: { 6 | PD/CC0 7 | http://creativecommons.org/publicdomain/zero/1.0/ 8 | } 9 | Needs: { 10 | Red/System >= 0.3.1 11 | %GTK.reds 12 | } 13 | Tabs: 4 14 | ] 15 | 16 | #include %../GTK.reds 17 | 18 | with gtk [ 19 | action: function [ 20 | [cdecl] 21 | widget [widget!] 22 | data [entry!] 23 | ][ 24 | print ["Input: " get-entry-text data newline] 25 | ] 26 | 27 | line: field ["Here" :action] 28 | 29 | view [ 30 | 170 90 position-center 31 | "Red/System GTK+ Input Field" 32 | vbox [ 33 | "Input:" 34 | line 35 | fixed button [50 25 "Print" :action line] 36 | ] 37 | ] 38 | ] 39 | -------------------------------------------------------------------------------- /GTK/examples/GTK-live-coding.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | Title: "GTK+ live coding example" 3 | Author: "Kaj de Vos" 4 | Rights: "Copyright (c) 2013 Kaj de Vos" 5 | License: { 6 | PD/CC0 7 | http://creativecommons.org/publicdomain/zero/1.0/ 8 | } 9 | Needs: { 10 | Red >= 0.3.2 11 | %GTK.red 12 | 13 | %common.red 14 | %C-library/ANSI.red 15 | %input-output.red 16 | %TNetStrings/TNetStrings.red 17 | %JSON/JSON.red 18 | } 19 | Tabs: 4 20 | ] 21 | 22 | #include %../GTK.red 23 | 24 | ; Extras 25 | #include %../../common/common.red 26 | #include %../../C-library/ANSI.red 27 | #include %../../common/input-output.red 28 | #include %../../TNetStrings/TNetStrings.red 29 | #include %../../JSON/JSON.red 30 | ;#include %../../SQLite/SQLite.red 31 | ;#include %../../ZeroMQ-binding/ZeroMQ-binding.red 32 | 33 | execute: function [] [ 34 | if window: view/only/title [ 35 | text: area 36 | hbox [ 37 | button "View" [ 38 | any [ 39 | none? script: get-area-text text 40 | empty? code: load/all script 41 | zero? box: parse-vbox window code 42 | ( 43 | unless zero? stage [ 44 | remove-face window stage 45 | ] 46 | append-face window stage: box 47 | show stage 48 | ) 49 | ] 50 | ] 51 | button "Quit" close 52 | ] 53 | ] "Red GTK+ Live Coding" 54 | [ 55 | stage: 0 56 | do-events 57 | ] 58 | ] 59 | 60 | execute 61 | -------------------------------------------------------------------------------- /GTK/examples/GTK-text-editor.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | Title: "GTK+ text editor" 3 | Author: "Kaj de Vos" 4 | Rights: "Copyright (c) 2013 Kaj de Vos" 5 | License: { 6 | PD/CC0 7 | http://creativecommons.org/publicdomain/zero/1.0/ 8 | } 9 | Needs: { 10 | Red >= 0.3.2 11 | %input-output.red 12 | %GTK.red 13 | } 14 | Tabs: 4 15 | ] 16 | 17 | #include %../../common/input-output.red 18 | #include %../GTK.red 19 | 20 | link: get-argument 1 21 | 22 | load-file: function [ 23 | field [integer!] ; "entry!" 24 | area [integer!] ; "widget!" 25 | ][ 26 | all [ 27 | link: get-field-text field 28 | not empty? link 29 | data: read link 30 | set-area-text area data 31 | ] 32 | ] 33 | view/title compose/deep [ 34 | [ 35 | "File/URL:" address: field (any [link ""]) [load-file face text] 36 | button "Load" [load-file address text] 37 | button "Save" [ 38 | all [ 39 | link: get-field-text address 40 | not empty? link 41 | data: get-area-text text 42 | write link data 43 | ] 44 | ] 45 | button "Quit" close 46 | ] 47 | text: area (any [ 48 | all [ 49 | link 50 | not empty? link 51 | read link 52 | ] 53 | "" 54 | ]) 55 | ] "Red GTK+ Text Editor" 56 | -------------------------------------------------------------------------------- /GTK/examples/GTK-widgets.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | Title: "GTK+ widgets overview" 3 | Author: "Kaj de Vos" 4 | Rights: "Copyright (c) 2011,2013 Kaj de Vos" 5 | License: { 6 | PD/CC0 7 | http://creativecommons.org/publicdomain/zero/1.0/ 8 | } 9 | Needs: { 10 | Red >= 0.3.2 11 | %GTK.red 12 | } 13 | Tabs: 4 14 | ] 15 | 16 | #include %../GTK.red 17 | 18 | do-line: function [ 19 | field [integer!] ; "entry!" 20 | ][ 21 | print ["Input:" get-field-text field] 22 | ] 23 | 24 | text: "Quit" 25 | 26 | view/title compose [ 27 | "Label" 28 | {Multi-line 29 | label.} 30 | [ 31 | "Implicit Horizontal Box" 32 | line: field "Input Field" [do-line face] 33 | button "Print" [do-line line] 34 | ] 35 | 36 | lines: area 37 | {Multi-line 38 | input field.} 39 | hbox [ 40 | "Explicit Horizontal Box" 41 | button "Print" [print ["Input:" get-area-text lines]] 42 | ] 43 | 44 | button (text) close 45 | ] "Red Widgets Overview" 46 | -------------------------------------------------------------------------------- /GTK/examples/GTK-widgets.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "GTK+ widgets overview" 3 | Author: "Kaj de Vos" 4 | Rights: "Copyright (c) 2011,2013 Kaj de Vos" 5 | License: { 6 | PD/CC0 7 | http://creativecommons.org/publicdomain/zero/1.0/ 8 | } 9 | Needs: { 10 | Red/System >= 0.3.1 11 | %GTK.reds 12 | } 13 | Tabs: 4 14 | ] 15 | 16 | #include %../GTK.reds 17 | 18 | with gtk [ 19 | get-line: function [ 20 | [cdecl] 21 | widget [widget!] 22 | data [entry!] 23 | ][ 24 | print ["Input: " get-entry-text data newline] 25 | ] 26 | 27 | get-lines: function [ 28 | [cdecl] 29 | widget [widget!] 30 | data [scrolled-window!] 31 | /local lines 32 | ][ 33 | lines: get-area-text data 34 | print ["Input: " lines newline] 35 | g/g-free as-binary lines 36 | ] 37 | 38 | line: field [15 "Input Field" :get-line] 39 | 40 | lines: area 41 | {Multi-line 42 | input field.} 43 | 44 | view [ 45 | position-center 46 | "Red/System Widgets Overview" 47 | icon "Red-48x48.png" 48 | vbox [ 49 | "Vertical Box" 50 | hbox [ 51 | {Multi-line 52 | label.} 53 | text 54 | {Multi-line 55 | text.} 56 | info [10 "Info"] 57 | scroll text "The long and scrolling road..." 58 | ] 59 | hbox [ 60 | "Horizontal Box" 61 | button "Tight" 62 | button "Expanded" wide 63 | button "Filled" full 64 | ] 65 | hbox [ 66 | vbox [ 67 | "Vertical Box" 68 | button "Tight" 69 | button "Expanded" wide 70 | button "Filled" full 71 | ] wide 72 | fixed [ 73 | "Fixed Layout" 74 | 5 25 button [50 25 "Quit" :quit] 75 | ] wide 76 | vbox [ 77 | "Table" 78 | table [2 2 5 5 79 | button "X" button "O" 80 | button "O" button "X" 81 | ] 82 | ] wide 83 | ] full 84 | hbox [ 85 | vbox [ 86 | line 87 | fixed button [50 25 "Print" :get-line line] 88 | ] 89 | vbox [ 90 | "Hidden Input" 91 | secret [10 "Secret" :get-line] 92 | ] 93 | vbox [ 94 | lines full 95 | fixed button [50 25 "Print" :get-lines lines] 96 | ] full 97 | ] full 98 | ] 99 | ] 100 | ] 101 | -------------------------------------------------------------------------------- /GTK/examples/Red-48x48.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/kealist/RS-fossil-mirror/81e8dfc901d5273e78383b9a3dd959b6fd47edd3/GTK/examples/Red-48x48.png -------------------------------------------------------------------------------- /GTK/examples/dressed-up-hello-GTK-world.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | Title: "Hello GTK+ example, with title, icon and close button" 3 | Author: "Kaj de Vos" 4 | Rights: "Copyright (c) 2011-2013 Kaj de Vos" 5 | License: { 6 | PD/CC0 7 | http://creativecommons.org/publicdomain/zero/1.0/ 8 | } 9 | Needs: { 10 | Red >= 0.3.2 11 | %GTK.red 12 | } 13 | Tabs: 4 14 | ] 15 | 16 | #include %../GTK.red 17 | 18 | view/title [ 19 | "Hello, Red GTK+ world!" 20 | button "Quit" close 21 | ] "Hello World" 22 | -------------------------------------------------------------------------------- /GTK/examples/dressed-up-hello-GTK-world.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "Hello GTK+ example, with title, icon and close button" 3 | Author: "Kaj de Vos" 4 | Rights: "Copyright (c) 2011-2013 Kaj de Vos" 5 | License: { 6 | PD/CC0 7 | http://creativecommons.org/publicdomain/zero/1.0/ 8 | } 9 | Needs: { 10 | Red/System >= 0.3.1 11 | %GTK.reds 12 | } 13 | Tabs: 4 14 | ] 15 | 16 | #include %../GTK.reds 17 | 18 | with gtk [ 19 | status: version-mismatch 2 0 0 20 | 21 | unless as-logic status [status: "sufficient"] 22 | print ["GTK version: " status newline] 23 | 24 | 25 | view [ 26 | 170 90 position-center 27 | "Hello World" 28 | icon "Red-48x48.png" 29 | vbox [ 30 | "Hello, Red/System GTK+ world!" 31 | hbox button [50 25 "Quit" :quit] 32 | ] 33 | ] 34 | ] 35 | -------------------------------------------------------------------------------- /GTK/examples/goodbye-cruel-GTK-world.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "Hello GTK+ example, traditional version" 3 | Author: "Kaj de Vos" 4 | Rights: "Copyright (c) 2011-2013 Kaj de Vos" 5 | License: { 6 | PD/CC0 7 | http://creativecommons.org/publicdomain/zero/1.0/ 8 | } 9 | Needs: { 10 | Red/System >= 0.3.1 11 | %GTK.reds 12 | } 13 | Purpose: { 14 | This is the traditional Hello World example, showing 15 | the smallest possible program to output a message, 16 | in the GTK+ binding for Red/System. 17 | This is the version similar to how it would be written 18 | in other bindings for other programming languages. 19 | } 20 | Tabs: 4 21 | ] 22 | 23 | #include %../GTK.reds 24 | 25 | with gtk [ 26 | comment { ; Already taken care of by %GTK.reds 27 | argc: system/args-count 28 | argv-reference: declare handle-reference! 29 | argv-reference/value: as-handle system/args-list 30 | 31 | begin :argc argv-reference 32 | } 33 | 34 | window*: make-window window-top-level 35 | label*: as label! 0 36 | 37 | either as-logic window* [ 38 | set-container-border as container! window* 10 39 | 40 | label*: make-label "Good riddens!" 41 | 42 | either as-logic label* [ 43 | container-append as container! window* as widget! label* 44 | ][ 45 | print-line "Failed to create label." 46 | ] 47 | 48 | g/connect-signal as-handle window* "destroy" as-integer :quit null 49 | show-all as widget! window* 50 | do-events 51 | ][ 52 | print-line "Failed to create window." 53 | ] 54 | ] 55 | -------------------------------------------------------------------------------- /GTK/examples/hello-GTK-world-with-title.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | Title: "Hello GTK+ example, with window title" 3 | Author: "Kaj de Vos" 4 | Rights: "Copyright (c) 2011-2013 Kaj de Vos" 5 | License: { 6 | PD/CC0 7 | http://creativecommons.org/publicdomain/zero/1.0/ 8 | } 9 | Needs: { 10 | Red >= 0.3.2 11 | %GTK.red 12 | } 13 | Purpose: { 14 | This is the traditional Hello World example, showing 15 | the smallest possible program to output a message, 16 | in the GTK+ binding for Red. 17 | This is the version for if you insist on a window title. 18 | } 19 | Tabs: 4 20 | ] 21 | 22 | #include %../GTK.red 23 | 24 | view/title "Hello, Red GTK+ world!" "Hello World" 25 | -------------------------------------------------------------------------------- /GTK/examples/hello-GTK-world-with-title.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "Hello GTK+ example, with window title" 3 | Author: "Kaj de Vos" 4 | Rights: "Copyright (c) 2011-2013 Kaj de Vos" 5 | License: { 6 | PD/CC0 7 | http://creativecommons.org/publicdomain/zero/1.0/ 8 | } 9 | Needs: { 10 | Red/System >= 0.3.1 11 | %GTK.reds 12 | } 13 | Purpose: { 14 | This is the traditional Hello World example, showing 15 | the smallest possible program to output a message, 16 | in the GTK+ binding for Red/System. 17 | This is the version for if you insist on a window title. 18 | } 19 | Tabs: 4 20 | ] 21 | 22 | #include %../GTK.reds 23 | 24 | with gtk [ 25 | view [ 26 | "Hello World" 27 | label "Hello, Red/System GTK+ world!" 28 | ] 29 | ] 30 | -------------------------------------------------------------------------------- /GTK/examples/hello-GTK-world.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | Title: "Hello GTK+ example" 3 | Author: "Kaj de Vos" 4 | Rights: "Copyright (c) 2011-2013 Kaj de Vos" 5 | License: { 6 | PD/CC0 7 | http://creativecommons.org/publicdomain/zero/1.0/ 8 | } 9 | Needs: { 10 | Red >= 0.3.2 11 | %GTK.red 12 | } 13 | Purpose: { 14 | This is the traditional Hello World example, showing 15 | the smallest possible program to output a message, 16 | in the GTK+ binding for Red. 17 | } 18 | Tabs: 4 19 | ] 20 | 21 | #include %../GTK.red 22 | 23 | view "Hello, Red GTK+ world!" 24 | -------------------------------------------------------------------------------- /GTK/examples/hello-GTK-world.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "Hello GTK+ example" 3 | Author: "Kaj de Vos" 4 | Rights: "Copyright (c) 2011-2013 Kaj de Vos" 5 | License: { 6 | PD/CC0 7 | http://creativecommons.org/publicdomain/zero/1.0/ 8 | } 9 | Needs: { 10 | Red/System >= 0.3.1 11 | %GTK.reds 12 | } 13 | Purpose: { 14 | This is the traditional Hello World example, showing 15 | the smallest possible program to output a message, 16 | in the GTK+ binding for Red/System. 17 | } 18 | Tabs: 4 19 | ] 20 | 21 | #include %../GTK.reds 22 | 23 | with gtk [view label "Hello, Red/System GTK+ world!"] 24 | -------------------------------------------------------------------------------- /JSON/COPYRIGHT.txt: -------------------------------------------------------------------------------- 1 | JSON for Red 2 | 3 | Copyright (c) 2013,2014 Kaj de Vos 4 | All rights reserved. 5 | 6 | Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright notice, 9 | this list of conditions and the following disclaimer. 10 | * Redistributions in binary form must reproduce the above copyright 11 | notice, this list of conditions and the following disclaimer in the 12 | documentation and/or other materials provided with the distribution. 13 | 14 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 15 | -------------------------------------------------------------------------------- /JSON/_FOSSIL_: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/kealist/RS-fossil-mirror/81e8dfc901d5273e78383b9a3dd959b6fd47edd3/JSON/_FOSSIL_ -------------------------------------------------------------------------------- /JSON/examples/JSON.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | Title: "JSON examples" 3 | Author: "Kaj de Vos" 4 | Rights: "Copyright (c) 2013 Kaj de Vos" 5 | License: { 6 | PD/CC0 7 | http://creativecommons.org/publicdomain/zero/1.0/ 8 | } 9 | Needs: { 10 | Red >= 0.4.3 11 | %common/input-output.red 12 | %JSON.red 13 | } 14 | Tabs: 4 15 | ] 16 | 17 | #include %../../common/input-output.red 18 | #include %../JSON.red 19 | 20 | print to-JSON "Example" 21 | probe load-JSON {"Example"} 22 | print to-JSON {Controls: "\/^(line)^M^(tab)^(back)^(page)^(null)^(1F)} 23 | probe load-JSON {"Escapes: \"\\\/\n\r\t\b\f\u0000\u0020"} 24 | print to-JSON 9 25 | probe load-JSON "9" 26 | probe load-JSON "6.28" 27 | probe load-JSON/values {["#issue", "%file", "{string}"]} 28 | print to-JSON [a 9 b] 29 | print to-JSON context [a: 9 b: 42] 30 | print to-JSON/map [a 9 b 42] 31 | print to-JSON/map/deep [a 9 [b 9 c 42]] 32 | print to-JSON/map [a 9 b [9] c 42] 33 | print to-JSON/flat/map [a 9 b [9] c 42] 34 | probe load-JSON {["a", 9, "bc", 42]} 35 | probe load-JSON {{"a": 9, "bc": 42}} 36 | probe load-JSON/keys {{"a": 9, "bc": 42}} 37 | probe load-JSON/objects {{"a": 9, "bc": 42}} 38 | print to-JSON/flat s: charset [#"0" - #"9"] 39 | print to-JSON complement s 40 | print to-JSON/flat blank 41 | print to-JSON charset [100 1000] 42 | 43 | print headers: read http://headers.jsontest.com 44 | print to-JSON/map probe load-JSON/keys headers 45 | -------------------------------------------------------------------------------- /Java/COPYRIGHT.txt: -------------------------------------------------------------------------------- 1 | Java Native Interface binding for Red 2 | 3 | Copyright (c) 2013 Kaj de Vos 4 | All rights reserved. 5 | 6 | Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright notice, 9 | this list of conditions and the following disclaimer. 10 | * Redistributions in binary form must reproduce the above copyright 11 | notice, this list of conditions and the following disclaimer in the 12 | documentation and/or other materials provided with the distribution. 13 | 14 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 15 | -------------------------------------------------------------------------------- /Java/JNI-library.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "Java Native Interface library" 3 | Type: 'library 4 | Author: "Kaj de Vos" 5 | Rights: "Copyright (c) 2013 Kaj de Vos. All rights reserved." 6 | License: { 7 | Redistribution and use in source and binary forms, with or without modification, 8 | are permitted provided that the following conditions are met: 9 | 10 | * Redistributions of source code must retain the above copyright notice, 11 | this list of conditions and the following disclaimer. 12 | * Redistributions in binary form must reproduce the above copyright notice, 13 | this list of conditions and the following disclaimer in the documentation 14 | and/or other materials provided with the distribution. 15 | 16 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 17 | ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 18 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 19 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 20 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 21 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 22 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 23 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 24 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 25 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 26 | } 27 | Needs: { 28 | Red/System >= 0.4.1 29 | %Java/JNI.reds 30 | } 31 | Tabs: 4 32 | ] 33 | 34 | 35 | #include %JNI.reds 36 | 37 | 38 | ; Global setup 39 | 40 | with JNI [ 41 | JNI_OnLoad: function [ 42 | vm-reference [vm-reference!] 43 | dummy [handle!] 44 | return: [version!] 45 | /local status vm java-double-reference java-reference java 46 | ][ 47 | if none? vm-reference [return 0] 48 | 49 | vm: vm-reference/interface 50 | if none? vm [return 0] 51 | 52 | java-double-reference: declare java-double-reference! ; WARN: not thread safe 53 | status: vm/get-context vm-reference java-double-reference version-1.6 54 | 55 | if negative? status [ ; Red/System FIXME: can't inline 56 | return 0 ; No use loading our library 57 | ] 58 | java-reference: java-double-reference/value 59 | if none? java-reference [return 0] 60 | 61 | java: java-reference/interface 62 | if none? java [return 0] 63 | 64 | do-on-load (vm java-reference java) ; User setup code 65 | 66 | version-1.6 ; Needed JNI version 67 | ] 68 | ] 69 | 70 | #export call! [JNI_OnLoad] 71 | -------------------------------------------------------------------------------- /Java/JVM.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "Java Virtual Machine binding" 3 | Author: "Kaj de Vos" 4 | Rights: "Copyright (c) 2013 Kaj de Vos. All rights reserved." 5 | License: { 6 | Redistribution and use in source and binary forms, with or without modification, 7 | are permitted provided that the following conditions are met: 8 | 9 | * Redistributions of source code must retain the above copyright notice, 10 | this list of conditions and the following disclaimer. 11 | * Redistributions in binary form must reproduce the above copyright notice, 12 | this list of conditions and the following disclaimer in the documentation 13 | and/or other materials provided with the distribution. 14 | 15 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 16 | ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 17 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 18 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 19 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 20 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 21 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 22 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 23 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 24 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | } 26 | Needs: { 27 | Red/System 28 | %Java/JNI.reds 29 | } 30 | Tabs: 4 31 | ] 32 | 33 | 34 | #include %JNI.reds 35 | 36 | 37 | JVM: context [with JNI [ 38 | 39 | vm-double-reference!: alias struct! [value [vm-reference!]] 40 | 41 | option!: alias struct! [ 42 | option [c-string!] 43 | data [binary!] 44 | ] 45 | begin-arguments!: alias struct! [ 46 | version [version!] 47 | option-count [integer!] 48 | options [option!] 49 | ignore-unknown? [j-logic!] 50 | ] 51 | 52 | #switch OS [ 53 | Windows [#define JVM-library "JVM.dll"] ; TODO: check this 54 | MacOSX [#define JVM-library "libjvm.dylib"] ; TODO: check this 55 | #default [#define JVM-library "libjvm.so"] 56 | ] 57 | #import [JVM-library call! [ 58 | 59 | get-default-arguments: "JNI_GetDefaultJavaVMInitArgs" [ "Get default arguments for a new Virtual Machine." 60 | arguments [begin-arguments!] 61 | return: [status!] 62 | ] 63 | make-vm: "JNI_CreateJavaVM" [ "Create a new Virtual Machine." 64 | vm-double-reference [vm-double-reference!] 65 | java-double-reference [java-double-reference!] 66 | arguments [begin-arguments!] 67 | return: [status!] 68 | ] 69 | get-VMs: "JNI_GetCreatedJavaVMs" [ "List Virtual Machines." 70 | vm-double-reference [vm-double-reference!] 71 | size [size!] 72 | count [pointer! [size!]] 73 | return: [status!] 74 | ] 75 | 76 | ]] 77 | ]] 78 | -------------------------------------------------------------------------------- /Java/_FOSSIL_: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/kealist/RS-fossil-mirror/81e8dfc901d5273e78383b9a3dd959b6fd47edd3/Java/_FOSSIL_ -------------------------------------------------------------------------------- /Java/examples/hello-JNI.java: -------------------------------------------------------------------------------- 1 | /* 2 | Java Native Interface example 3 | 4 | Copyright (c) 2013 Nenad Rakocevic, Kaj de Vos 5 | License: PD/CC0 6 | http://creativecommons.org/publicdomain/zero/1.0/ 7 | 8 | Needs 32-bit Java. 9 | 10 | This is a minimal Java launcher program for an example 11 | of a native library for Java through the JNI interface. 12 | */ 13 | 14 | class helloJNI { 15 | static { 16 | System.loadLibrary ("hello-JNI"); 17 | } 18 | 19 | public static void main (String [] args) { 20 | } 21 | } 22 | -------------------------------------------------------------------------------- /Java/examples/hello-JNI.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "Java Native Interface library example" 3 | Type: 'library 4 | Author: "Kaj de Vos" 5 | Rights: "Copyright (c) 2013 Kaj de Vos" 6 | License: { 7 | PD/CC0 8 | http://creativecommons.org/publicdomain/zero/1.0/ 9 | } 10 | Needs: { 11 | Red/System 12 | %Java/JNI-library.reds 13 | } 14 | Purpose: { 15 | This is a simple example of a native library for Java through the JNI interface, 16 | written in Red/System. 17 | } 18 | Tabs: 4 19 | ] 20 | 21 | 22 | #define do-on-load (vm java-reference java) [ 23 | version: java/version-of java-reference ; WARN: variable will be global 24 | print [ 25 | "Hello from JNI!" newline 26 | "JNI version: " version >>> 16 #"." version and FFFFh newline 27 | ] 28 | ] 29 | 30 | #include %../JNI-library.reds 31 | 32 | 33 | with JNI [ 34 | JNI_OnUnload: function [ 35 | vm-reference [vm-reference!] 36 | dummy [handle!] 37 | ][ 38 | print-line "Goodbye JNI!" 39 | ] 40 | ] 41 | 42 | #export call! [JNI_OnUnload] 43 | -------------------------------------------------------------------------------- /OSM-GPS-Map/COPYRIGHT.txt: -------------------------------------------------------------------------------- 1 | OSM GPS Map Binding for Red 2 | 3 | Copyright (c) 2011-2013 Kaj de Vos 4 | All rights reserved. 5 | 6 | Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright notice, 9 | this list of conditions and the following disclaimer. 10 | * Redistributions in binary form must reproduce the above copyright 11 | notice, this list of conditions and the following disclaimer in the 12 | documentation and/or other materials provided with the distribution. 13 | 14 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 15 | -------------------------------------------------------------------------------- /OSM-GPS-Map/OSM-GPS-Map.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "OSM GPS Map Binding" 3 | Author: "Kaj de Vos" 4 | Rights: "Copyright (c) 2011-2013 Kaj de Vos. All rights reserved." 5 | License: { 6 | Redistribution and use in source and binary forms, with or without modification, 7 | are permitted provided that the following conditions are met: 8 | 9 | * Redistributions of source code must retain the above copyright notice, 10 | this list of conditions and the following disclaimer. 11 | * Redistributions in binary form must reproduce the above copyright notice, 12 | this list of conditions and the following disclaimer in the documentation 13 | and/or other materials provided with the distribution. 14 | 15 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 16 | ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 17 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 18 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 19 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 20 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 21 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 22 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 23 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 24 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | } 26 | Needs: { 27 | Red/System > 0.3.2 28 | OSM-GPS-Map 29 | } 30 | Tabs: 4 31 | ] 32 | 33 | 34 | #include %../GTK/GTK.reds 35 | 36 | 37 | ; Map views 38 | 39 | ogm-view!: alias opaque! 40 | 41 | 42 | ; Layers 43 | 44 | ogm-layer!: alias opaque! 45 | ogm-osd!: alias opaque! 46 | 47 | 48 | #switch OS [ 49 | Windows [#define OSM-GPS-Map-library "libosmgpsmap-2.dll"] ; TODO: check this 50 | MacOSX [#define OSM-GPS-Map-library "libosmgpsmap.dylib"] ; TODO: check this 51 | #default [#define OSM-GPS-Map-library "libosmgpsmap.so.2"] ; Ubuntu 10.10 52 | ] 53 | #import [OSM-GPS-Map-library cdecl [ 54 | ; Map views 55 | 56 | ogm-new-view: "osm_gps_map_new" [ "Return new OSM GPS Map view." 57 | return: [ogm-view!] 58 | ] 59 | ogm-add-layer: "osm_gps_map_layer_add" [ "Add layer to OSM GPS Map." 60 | view [ogm-view!] 61 | layer [ogm-layer!] 62 | ] 63 | 64 | 65 | ; OSD layer 66 | 67 | ogm-new-osd: "osm_gps_map_osd_new" [ "Return new OSD layer." 68 | return: [ogm-osd!] 69 | ] 70 | ]] 71 | 72 | 73 | ; Dialect constructors 74 | 75 | 76 | with gtk [ 77 | osm-gps-map: function ["Build an OSM GPS Map widget." 78 | [typed] 79 | count [integer!] 80 | list [typed-value!] 81 | return: [ogm-view!] 82 | /local view 83 | ][ 84 | view: ogm-new-view 85 | 86 | either as-logic view [ 87 | while [as-logic count] [ 88 | either any-struct? list/type [ 89 | either as-logic list/value [ 90 | ogm-add-layer view as ogm-layer! list/value 91 | ][ 92 | log-error "OSM GPS Map: skipping missing layer." 93 | ] 94 | ][ 95 | log-error "OSM GPS Map: skipping unknown element." 96 | ] 97 | count: count - 1 98 | list: list + 1 99 | ] 100 | ][ 101 | log-error "Failed to create OSM GPS Map view." 102 | ] 103 | view 104 | ] 105 | ] 106 | -------------------------------------------------------------------------------- /OSM-GPS-Map/_FOSSIL_: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/kealist/RS-fossil-mirror/81e8dfc901d5273e78383b9a3dd959b6fd47edd3/OSM-GPS-Map/_FOSSIL_ -------------------------------------------------------------------------------- /OSM-GPS-Map/examples/OSM-GPS-Map-browser.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "OSM GPS Map browser example" 3 | Author: "Kaj de Vos" 4 | Rights: "Copyright (c) 2011,2013 Kaj de Vos" 5 | License: { 6 | PD/CC0 7 | http://creativecommons.org/publicdomain/zero/1.0/ 8 | } 9 | Needs: { 10 | Red/System >= 0.3.1 11 | %OSM-GPS-Map.reds 12 | } 13 | Tabs: 4 14 | ] 15 | 16 | #include %../OSM-GPS-Map.reds 17 | 18 | with gtk [ 19 | view [ 20 | maximize 21 | "OSM GPS Map Browser" 22 | osm-gps-map ogm-new-osd 23 | ] 24 | ] 25 | -------------------------------------------------------------------------------- /OpenGL/COPYRIGHT.txt: -------------------------------------------------------------------------------- 1 | OpenGL Binding for Red 2 | 3 | Copyright (c) 2012,2013 Kaj de Vos 4 | All rights reserved. 5 | 6 | Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright notice, 9 | this list of conditions and the following disclaimer. 10 | * Redistributions in binary form must reproduce the above copyright 11 | notice, this list of conditions and the following disclaimer in the 12 | documentation and/or other materials provided with the distribution. 13 | 14 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 15 | -------------------------------------------------------------------------------- /OpenGL/GL-common.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "Common part of OpenGL bindings" 3 | Author: "Kaj de Vos" 4 | Rights: "Copyright (c) 2012,2013 Kaj de Vos. All rights reserved." 5 | License: { 6 | Redistribution and use in source and binary forms, with or without modification, 7 | are permitted provided that the following conditions are met: 8 | 9 | * Redistributions of source code must retain the above copyright notice, 10 | this list of conditions and the following disclaimer. 11 | * Redistributions in binary form must reproduce the above copyright notice, 12 | this list of conditions and the following disclaimer in the documentation 13 | and/or other materials provided with the distribution. 14 | 15 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 16 | ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 17 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 18 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 19 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 20 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 21 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 22 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 23 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 24 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | } 26 | Needs: { 27 | Red/System >= 0.3.2 28 | %OpenGL/common.reds 29 | } 30 | Tabs: 4 31 | ] 32 | 33 | 34 | #enum type! [ 35 | gl-signed-byte!: 1400h 36 | gl-byte! 37 | gl-integer16! 38 | gl-unsigned16! 39 | gl-integer! 40 | gl-unsigned! 41 | gl-float32! 42 | gl-2-bytes! 43 | gl-3-bytes! 44 | gl-4-bytes! 45 | gl-float64! 46 | ] 47 | 48 | 49 | #include %common.reds 50 | 51 | 52 | #enum primitive! [ 53 | points' 54 | lines' 55 | line-loop' 56 | line-strip' 57 | triangles' 58 | triangle-strip' 59 | triangle-fan' 60 | quads' 61 | quad-strip' 62 | polygon' 63 | ] 64 | 65 | #enum attribute! [ 66 | current-bit: 00000001h 67 | point-bit: 00000002h 68 | line-bit: 00000004h 69 | polygon-bit: 00000008h 70 | polygon-stipple-bit: 00000010h 71 | pixel-mode-bit: 00000020h 72 | lighting-bit: 00000040h 73 | fog-bit: 00000080h 74 | depth-buffer-bit: 00000100h 75 | accum-buffer-bit: 00000200h 76 | stencil-buffer-bit: 00000400h 77 | view-port-bit: 00000800h 78 | transform-bit: 00001000h 79 | enable-bit: 00002000h 80 | color-buffer-bit: 00004000h 81 | hint-bit: 00008000h 82 | eval-bit: 00010000h 83 | list-bit: 00020000h 84 | texture-bit: 00040000h 85 | scissor-bit: 00080000h 86 | all-attributes-bits: 000FFFFFh 87 | ] 88 | 89 | 90 | #import [GL-library call! [ 91 | 92 | begin: "glBegin" [ 93 | type [primitive!] 94 | ] 95 | end: "glEnd" [] 96 | 97 | 98 | shade-model: "glShadeModel" [ 99 | mode [enum!] 100 | ] 101 | polygon-mode: "glPolygonMode" [ 102 | face [integer!] 103 | mode [enum!] 104 | ] 105 | 106 | 107 | ; Vertexes 108 | 109 | vertex-2D-32: "glVertex2f" [ 110 | x [float32!] 111 | y [float32!] 112 | ] 113 | 114 | vertex-3D-32: "glVertex3f" [ 115 | x [float32!] 116 | y [float32!] 117 | z [float32!] 118 | ] 119 | 120 | 121 | ; Colours 122 | 123 | color-3D-32: "glColor3f" [ 124 | red [float32!] 125 | green [float32!] 126 | blue [float32!] 127 | ] 128 | 129 | 130 | ; Matrix 131 | 132 | matrix-mode: "glMatrixMode" [ 133 | mode [enum!] 134 | ] 135 | load-identity: "glLoadIdentity" [] 136 | 137 | push-matrix: "glPushMatrix" [] 138 | pop-matrix: "glPopMatrix" [] 139 | 140 | translate-32: "glTranslatef" [ 141 | x [float32!] 142 | y [float32!] 143 | z [float32!] 144 | ] 145 | scale-32: "glScalef" [ 146 | x [float32!] 147 | y [float32!] 148 | z [float32!] 149 | ] 150 | rotate-32: "glRotatef" [ 151 | angle [float32!] 152 | x [float32!] 153 | y [float32!] 154 | z [float32!] 155 | ] 156 | 157 | frustum: "glFrustum" [ 158 | left [float!] 159 | right [float!] 160 | bottom [float!] 161 | top [float!] 162 | near [float!] 163 | far [float!] 164 | ] 165 | 166 | 167 | ; Lists 168 | 169 | make-lists: "glGenLists" [ 170 | range [integer!] 171 | return: [unsigned!] 172 | ] 173 | list?: "glIsList" [ 174 | object [unsigned!] 175 | return: [logic!] 176 | ] 177 | 178 | begin-list: "glNewList" [ 179 | list [unsigned!] 180 | mode [enum!] 181 | ] 182 | end-list: "glEndList" [] 183 | 184 | call-list: "glCallList" [ 185 | list [unsigned!] 186 | ] 187 | 188 | 189 | ; Textures 190 | 191 | texture-place-2D-32: "glTexCoord2f" [ 192 | x [float32!] 193 | y [float32!] 194 | ] 195 | 196 | texture-env-i: "glTexEnvi" [ 197 | target [enum!] 198 | name [enum!] 199 | value [integer!] 200 | ] 201 | 202 | ]] 203 | 204 | 205 | ; Higher level interface 206 | 207 | 208 | ; Matrix 209 | 210 | translate: function [ 211 | x [float!] 212 | y [float!] 213 | z [float!] 214 | ][ 215 | translate-32 as-float32 x as-float32 y as-float32 z 216 | ] 217 | 218 | scale: function [ 219 | x [float!] 220 | y [float!] 221 | z [float!] 222 | ][ 223 | scale-32 as-float32 x as-float32 y as-float32 z 224 | ] 225 | 226 | rotate: function [ 227 | angle [float!] 228 | x [float!] 229 | y [float!] 230 | z [float!] 231 | ][ 232 | rotate-32 as-float32 angle as-float32 x as-float32 y as-float32 z 233 | ] 234 | -------------------------------------------------------------------------------- /OpenGL/GL.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "OpenGL Binding" 3 | Author: "Kaj de Vos" 4 | Rights: "Copyright (c) 2012,2013 Kaj de Vos. All rights reserved." 5 | License: { 6 | Redistribution and use in source and binary forms, with or without modification, 7 | are permitted provided that the following conditions are met: 8 | 9 | * Redistributions of source code must retain the above copyright notice, 10 | this list of conditions and the following disclaimer. 11 | * Redistributions in binary form must reproduce the above copyright notice, 12 | this list of conditions and the following disclaimer in the documentation 13 | and/or other materials provided with the distribution. 14 | 15 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 16 | ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 17 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 18 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 19 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 20 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 21 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 22 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 23 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 24 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | } 26 | Needs: { 27 | Red/System >= 0.3.2 28 | %OpenGL/GL-common.reds 29 | } 30 | Tabs: 4 31 | ] 32 | 33 | 34 | #include %GL-common.reds 35 | 36 | 37 | #import [GL-library call! [ 38 | 39 | finish: "glFinish" [] 40 | 41 | 42 | ; Vertexes 43 | 44 | vertex-2D: "glVertex2d" [ 45 | x [float!] 46 | y [float!] 47 | ] 48 | vertex-3D: "glVertex3d" [ 49 | x [float!] 50 | y [float!] 51 | z [float!] 52 | ] 53 | 54 | 55 | ; Colours 56 | 57 | color-3D: "glColor3d" [ 58 | red [float!] 59 | green [float!] 60 | blue [float!] 61 | ] 62 | 63 | 64 | ; Textures 65 | 66 | texture-place-2D: "glTexCoord2d" [ 67 | x [float!] 68 | y [float!] 69 | ] 70 | 71 | ]] 72 | -------------------------------------------------------------------------------- /OpenGL/OS-Mesa.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "OSMesa Binding" 3 | Author: "Kaj de Vos" 4 | Rights: "Copyright (c) 2012,2013 Kaj de Vos. All rights reserved." 5 | License: { 6 | Redistribution and use in source and binary forms, with or without modification, 7 | are permitted provided that the following conditions are met: 8 | 9 | * Redistributions of source code must retain the above copyright notice, 10 | this list of conditions and the following disclaimer. 11 | * Redistributions in binary form must reproduce the above copyright notice, 12 | this list of conditions and the following disclaimer in the documentation 13 | and/or other materials provided with the distribution. 14 | 15 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 16 | ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 17 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 18 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 19 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 20 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 21 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 22 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 23 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 24 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | } 26 | Needs: { 27 | Red/System >= 0.3.2 28 | %common/common.reds 29 | %OpenGL/GL-common.reds 30 | } 31 | Tabs: 4 32 | ] 33 | 34 | 35 | #include %../common/common.reds 36 | 37 | 38 | osmesa: context [with gl [ 39 | 40 | osmesa-context!: alias opaque! 41 | 42 | #enum pixel-store! [ 43 | row-length': 10h 44 | y-up' 45 | ] 46 | 47 | 48 | #import [OS-Mesa-library cdecl [ 49 | 50 | ; Off Screen rendering 51 | 52 | make-context: "OSMesaCreateContext" [ 53 | format [enum!] 54 | share-list [osmesa-context!] 55 | return: [osmesa-context!] 56 | ] 57 | make-context-with: "OSMesaCreateContextExt" [ 58 | format [enum!] 59 | depth-bits [integer!] 60 | stencil-bits [integer!] 61 | accum-bits [integer!] 62 | share-list [osmesa-context!] 63 | return: [osmesa-context!] 64 | ] 65 | end-context: "OSMesaDestroyContext" [ 66 | context [osmesa-context!] 67 | ] 68 | make-current: "OSMesaMakeCurrent" [ 69 | context [osmesa-context!] 70 | buffer [binary!] 71 | type [type!] 72 | width [size!] 73 | height [size!] 74 | return: [logic!] 75 | ] 76 | 77 | pixel-store: "OSMesaPixelStore" [ 78 | name [pixel-store!] 79 | value [variant!] 80 | ] 81 | 82 | ]] 83 | ]] 84 | -------------------------------------------------------------------------------- /OpenGL/OpenGL.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "OpenGL Binding" 3 | Author: "Kaj de Vos" 4 | Rights: "Copyright (c) 2013 Kaj de Vos. All rights reserved." 5 | License: { 6 | Redistribution and use in source and binary forms, with or without modification, 7 | are permitted provided that the following conditions are met: 8 | 9 | * Redistributions of source code must retain the above copyright notice, 10 | this list of conditions and the following disclaimer. 11 | * Redistributions in binary form must reproduce the above copyright notice, 12 | this list of conditions and the following disclaimer in the documentation 13 | and/or other materials provided with the distribution. 14 | 15 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 16 | ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 17 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 18 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 19 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 20 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 21 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 22 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 23 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 24 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | } 26 | Needs: { 27 | Red/System >= 0.3.2 28 | %OpenGL/platforms/SDL.reds 29 | %OpenGL/platforms/SDL-OS-Mesa.reds 30 | ;%OpenGL/platforms/PicoGL.reds 31 | ; %OpenGL/platforms/RaspberryPi.reds 32 | } 33 | Tabs: 4 34 | ] 35 | 36 | #switch OS [ 37 | Syllable [ 38 | #define call! cdecl 39 | #include %platforms/SDL-OS-Mesa.reds 40 | ] 41 | Windows [ 42 | #define call! stdcall 43 | #include %platforms/SDL.reds 44 | ] 45 | #default [ 46 | #define call! cdecl 47 | #include %platforms/SDL.reds 48 | ; #include %platforms/RaspberryPi.reds 49 | ] 50 | ] 51 | -------------------------------------------------------------------------------- /OpenGL/TinyGL.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "TinyGL Binding" 3 | Author: "Kaj de Vos" 4 | Rights: "Copyright (c) 2012,2013 Kaj de Vos. All rights reserved." 5 | License: { 6 | Redistribution and use in source and binary forms, with or without modification, 7 | are permitted provided that the following conditions are met: 8 | 9 | * Redistributions of source code must retain the above copyright notice, 10 | this list of conditions and the following disclaimer. 11 | * Redistributions in binary form must reproduce the above copyright notice, 12 | this list of conditions and the following disclaimer in the documentation 13 | and/or other materials provided with the distribution. 14 | 15 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 16 | ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 17 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 18 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 19 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 20 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 21 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 22 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 23 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 24 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | } 26 | Needs: { 27 | Red/System >= 0.3.2 28 | %OpenGL/GL-common.reds 29 | } 30 | Tabs: 4 31 | ] 32 | 33 | 34 | #include %GL-common.reds 35 | 36 | 37 | ; Higher level interface 38 | 39 | 40 | ; Vertexes 41 | 42 | vertex-2D: function [ 43 | x [float!] 44 | y [float!] 45 | ][ 46 | vertex-2D-32 as-float32 x as-float32 y 47 | ] 48 | vertex-3D: function [ 49 | x [float!] 50 | y [float!] 51 | z [float!] 52 | ][ 53 | vertex-3D-32 as-float32 x as-float32 y as-float32 z 54 | ] 55 | 56 | 57 | ; Colours 58 | 59 | color-3D: function [ 60 | red [float!] 61 | green [float!] 62 | blue [float!] 63 | ][ 64 | color-3D-32 as-float32 red as-float32 green as-float32 blue 65 | ] 66 | 67 | 68 | ; Textures 69 | 70 | texture-place-2D: function [ 71 | x [float!] 72 | y [float!] 73 | ][ 74 | texture-place-2D-32 as-float32 x as-float32 y 75 | ] 76 | -------------------------------------------------------------------------------- /OpenGL/_FOSSIL_: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/kealist/RS-fossil-mirror/81e8dfc901d5273e78383b9a3dd959b6fd47edd3/OpenGL/_FOSSIL_ -------------------------------------------------------------------------------- /OpenGL/common.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "Common part of OpenGL and GLES bindings" 3 | Author: "Kaj de Vos" 4 | Rights: "Copyright (c) 2012,2013 Kaj de Vos. All rights reserved." 5 | License: { 6 | Redistribution and use in source and binary forms, with or without modification, 7 | are permitted provided that the following conditions are met: 8 | 9 | * Redistributions of source code must retain the above copyright notice, 10 | this list of conditions and the following disclaimer. 11 | * Redistributions in binary form must reproduce the above copyright notice, 12 | this list of conditions and the following disclaimer in the documentation 13 | and/or other materials provided with the distribution. 14 | 15 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 16 | ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 17 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 18 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 19 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 20 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 21 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 22 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 23 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 24 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | } 26 | Needs: { 27 | Red/System >= 0.3.2 28 | %common/FPU-configuration.reds 29 | } 30 | Tabs: 4 31 | ] 32 | 33 | 34 | #include %../common/FPU-configuration.reds 35 | 36 | 37 | ; Types 38 | 39 | 40 | #define bit-field! unsigned! 41 | #define clamp! float32! 42 | 43 | 44 | #enum matrix! [ 45 | matrix-mode': 0BA0h 46 | model-view': 1700h 47 | projection' 48 | texture' 49 | ] 50 | #enum polygons! [ 51 | ; front': 0404h 52 | ; back' 53 | cw': 0900h 54 | ccw' 55 | polygon-mode': 0B40h 56 | polygon-smooth' 57 | polygon-stipple' 58 | edge-flag' 59 | cull-face' 60 | cull-face-mode' 61 | front-face' 62 | point': 1B00h 63 | line' 64 | fill' 65 | polygon-offset-units': 2A00h 66 | polygon-offset-point' 67 | polygon-offset-line' 68 | polygon-offset-fill': 8037h 69 | polygon-offset-factor' 70 | ] 71 | #enum display-lists! [ 72 | list-mode': 0B30h 73 | list-base': 0B32h 74 | list-index' 75 | compile': 1300h 76 | compile-and-execute' 77 | ] 78 | #enum depth-buffer! [ 79 | never': 0200h 80 | less' 81 | equal' 82 | less-or-equal' 83 | greater' 84 | not-equal' 85 | greater-or-equal' 86 | always' 87 | depth-range': 0B70h 88 | depth-test' 89 | depth-write-mask' 90 | depth-clear-value' 91 | depth-function' 92 | depth-bits': 0D56h 93 | depth-component': 1902h 94 | ] 95 | #enum lighting! [ 96 | ; front-and-back': 0408h 97 | lighting': 0B50h 98 | light-model-local-viewer' 99 | light-model-two-side' 100 | light-model-ambient' 101 | shade-model' 102 | color-material-face' 103 | color-material-parameter' 104 | color-material' 105 | normalize': 0BA1h 106 | ambient': 1200h 107 | diffuse' 108 | specular' 109 | position' 110 | spot-direction' 111 | spot-exponent' 112 | spot-cutoff' 113 | constant-attenuation' 114 | linear-attenuation' 115 | quadratic-attenuation' 116 | emission': 1600h 117 | shininess' 118 | ambient-and-diffuse' 119 | color-indexes' 120 | flat': 1D00h 121 | smooth' 122 | light0': 4000h 123 | light1' 124 | light2' 125 | light3' 126 | light4' 127 | light5' 128 | light6' 129 | light7' 130 | ] 131 | #enum buffers! [ 132 | none' 133 | front-left': 0400h 134 | front-right' 135 | back-left' 136 | back-right' 137 | front' 138 | back' 139 | left' 140 | right' 141 | front-and-back' 142 | aux0' 143 | aux1' 144 | aux2' 145 | aux3' 146 | dither': 0BD0h 147 | aux-buffers': 0C00h 148 | draw-buffer' 149 | read-buffer' 150 | double-buffer': 0C32h 151 | stereo' 152 | subpixel-bits': 0D50h 153 | index-bits' 154 | red-bits' 155 | green-bits' 156 | blue-bits' 157 | alpha-bits' 158 | color': 1800h 159 | depth' 160 | stencil' 161 | color-index': 1900h 162 | red': 1903h 163 | green' 164 | blue' 165 | alpha' 166 | RGB' 167 | RGBA' 168 | luminance' 169 | luminance-alpha' 170 | bitmap': 1A00h 171 | ] 172 | #enum hints! [ 173 | perspective-correction-hint': 0C50h 174 | point-smooth-hint' 175 | line-smooth-hint' 176 | polygon-smooth-hint' 177 | fog-hint' 178 | don't-care': 1100h 179 | fastest' 180 | nicest' 181 | ] 182 | #enum textures! [ 183 | texture-gen-s': 0C60h 184 | texture-gen-t' 185 | texture-gen-r' 186 | texture-gen-q' 187 | texture-1D': 0DE0h 188 | texture-2D' 189 | texture-width': 1000h 190 | texture-height' 191 | texture-components': 1003h 192 | texture-border-color' 193 | texture-border' 194 | s': 2000h 195 | t' 196 | r' 197 | q' 198 | modulate': 2100h 199 | decal' 200 | texture-env-mode': 2200h 201 | texture-env-color' 202 | texture-env': 2300h 203 | eye-linear': 2400h 204 | object-linear' 205 | sphere-map' 206 | texture-gen-mode': 2500h 207 | object-plane' 208 | eye-plane' 209 | nearest': 2600h 210 | nearest-mipmap-nearest': 2700h 211 | linear-mipmap-nearest' 212 | nearest-mipmap-linear' 213 | linear-mipmap-linear' 214 | texture-mag-filter': 2800h 215 | texture-min-filter' 216 | texture-wrap-s' 217 | texture-wrap-t' 218 | clamp': 2900h 219 | repeat' 220 | ] 221 | 222 | 223 | #import [GL-library call! [ 224 | 225 | enable: "glEnable" [ 226 | code [enum!] 227 | ] 228 | disable: "glDisable" [ 229 | code [enum!] 230 | ] 231 | 232 | flush: "glFlush" [] 233 | 234 | 235 | cull-face: "glCullFace" [ 236 | mode [enum!] 237 | ] 238 | 239 | 240 | ; Matrix 241 | 242 | view-port: "glViewport" [ 243 | x [integer!] 244 | y [integer!] 245 | width [size!] 246 | height [size!] 247 | ] 248 | 249 | 250 | ; Clearing 251 | 252 | clear: "glClear" [ 253 | mask [bit-field!] 254 | ] 255 | clear-color: "glClearColor" [ 256 | red [clamp!] 257 | green [clamp!] 258 | blue [clamp!] 259 | alpha [clamp!] 260 | ] 261 | 262 | 263 | ; Textures 264 | 265 | make-textures: "glGenTextures" [ 266 | count [size!] 267 | textures [pointer! [unsigned!]] 268 | ] 269 | remove-textures: "glDeleteTextures" [ 270 | count [size!] 271 | textures [pointer! [unsigned!]] 272 | ] 273 | 274 | bind-texture: "glBindTexture" [ 275 | target [enum!] 276 | texture [unsigned!] 277 | ] 278 | texture-image-2D: "glTexImage2D" [ 279 | target [enum!] 280 | level [integer!] 281 | components [integer!] ; Internal format 282 | width [size!] 283 | height [size!] 284 | border [integer!] 285 | format [enum!] 286 | type [type!] 287 | pixels [binary!] 288 | ] 289 | texture-parameter-i: "glTexParameteri" [ 290 | target [enum!] 291 | name [enum!] 292 | value [integer!] 293 | ] 294 | pixel-store-i: "glPixelStorei" [ 295 | name [enum!] 296 | value [integer!] 297 | ] 298 | 299 | 300 | ; Various 301 | 302 | hint: "glHint" [ 303 | target [enum!] 304 | mode [enum!] 305 | ] 306 | 307 | ]] 308 | -------------------------------------------------------------------------------- /OpenGL/examples/GL-spin.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "Spinning box OpenGL example" 3 | Author: "Kaj de Vos" 4 | Rights: { 5 | Copyright (c) 2012,2013 Kaj de Vos 6 | Ported from the C program written by Brian Paul. 7 | } 8 | License: { 9 | PD/CC0 10 | http://creativecommons.org/publicdomain/zero/1.0/ 11 | } 12 | Needs: { 13 | Red/System >= 0.2.5 14 | %OpenGL/OpenGL.reds 15 | } 16 | Purpose: { 17 | This is a simple OpenGL example. 18 | It shows a spinning box drawn with coloured lines. 19 | } 20 | Tabs: 4 21 | ] 22 | 23 | 24 | #include %../OpenGL.reds 25 | 26 | #define display-size [640 480] ; 320 240 27 | 28 | 29 | step: 5.0 30 | scaling: 1.0 31 | 32 | x-rotation: 0.0 33 | x-step: 0.0 34 | y-rotation: 0.0 35 | y-step: 0.0 36 | z-rotation: 0.0 37 | z-step: 0.0 38 | 39 | 40 | object: 0 ; unsigned! 41 | 42 | with gl [ 43 | 44 | make-object: function [ 45 | return: [unsigned!] 46 | /local list 47 | ][ 48 | list: make-lists 1 49 | 50 | begin-list list compile' 51 | 52 | begin line-loop' 53 | color-3D 1.0 1.0 1.0 54 | vertex-3D 1.0 0.5 -0.4 55 | color-3D 1.0 0.0 0.0 56 | vertex-3D 1.0 -0.5 -0.4 57 | color-3D 0.0 1.0 0.0 58 | vertex-3D -1.0 -0.5 -0.4 59 | color-3D 0.0 0.0 1.0 60 | vertex-3D -1.0 0.5 -0.4 61 | end 62 | 63 | color-3D 1.0 1.0 1.0 64 | 65 | begin line-loop' 66 | vertex-3D 1.0 0.5 0.4 67 | vertex-3D 1.0 -0.5 0.4 68 | vertex-3D -1.0 -0.5 0.4 69 | vertex-3D -1.0 0.5 0.4 70 | end 71 | 72 | begin lines' 73 | vertex-3D 1.0 0.5 -0.4 vertex-3D 1.0 0.5 0.4 74 | vertex-3D 1.0 -0.5 -0.4 vertex-3D 1.0 -0.5 0.4 75 | vertex-3D -1.0 -0.5 -0.4 vertex-3D -1.0 -0.5 0.4 76 | vertex-3D -1.0 0.5 -0.4 vertex-3D -1.0 0.5 0.4 77 | end 78 | 79 | end-list 80 | 81 | list 82 | ] 83 | 84 | setup: does [ 85 | object: make-object 86 | 87 | cull-face back' 88 | ; enable cull-face' 89 | disable dither' 90 | shade-model flat' 91 | ; enable depth-test' 92 | 93 | x-rotation: 0.0 94 | y-rotation: 0.0 95 | z-rotation: 0.0 96 | 97 | x-step: step 98 | y-step: 0.0 99 | z-step: 0.0 100 | ] 101 | 102 | reshape: function [ 103 | width [integer!] 104 | height [integer!] 105 | ][ 106 | view-port 0 0 width height 107 | matrix-mode projection' 108 | load-identity 109 | frustum -1.0 1.0 -1.0 1.0 5.0 15.0 110 | matrix-mode model-view' 111 | ] 112 | 113 | draw: does [ 114 | clear color-buffer-bit 115 | 116 | push-matrix 117 | 118 | translate 0.0 0.0 -10.0 119 | scale scaling scaling scaling 120 | 121 | case [ 122 | x-step <> 0.0 [rotate x-rotation 1.0 0.0 0.0] 123 | y-step <> 0.0 [rotate y-rotation 0.0 1.0 0.0] 124 | yes [rotate z-rotation 0.0 0.0 1.0] 125 | ] 126 | 127 | call-list object 128 | 129 | pop-matrix 130 | ] 131 | 132 | ] 133 | 134 | on-key: function [ 135 | key [integer!] 136 | mask [enum!] 137 | return: [logic!] 138 | ][ 139 | yes 140 | ] 141 | 142 | with three-D [ 143 | 144 | idle: does [ 145 | x-rotation: x-rotation + x-step 146 | y-rotation: y-rotation + y-step 147 | z-rotation: z-rotation + z-step 148 | 149 | either x-rotation >= 360.0 [ 150 | x-rotation: 0.0 151 | x-step: 0.0 152 | y-step: step 153 | ][ 154 | either y-rotation >= 360.0 [ 155 | y-rotation: 0.0 156 | y-step: 0.0 157 | z-step: step 158 | ][ 159 | if z-rotation >= 360.0 [ 160 | z-rotation: 0.0 161 | z-step: 0.0 162 | x-step: step 163 | ] 164 | ] 165 | ] 166 | 167 | draw 168 | three-D/swap 169 | ] 170 | 171 | view display-size "Spin" 172 | 173 | ] 174 | -------------------------------------------------------------------------------- /OpenGL/examples/GL-textures.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "Textures OpenGL example" 3 | Author: "Kaj de Vos" 4 | Rights: { 5 | Copyright (c) 2012,2013 Kaj de Vos 6 | Ported from the C program written by Brian Paul. 7 | } 8 | License: { 9 | PD/CC0 10 | http://creativecommons.org/publicdomain/zero/1.0/ 11 | } 12 | Needs: { 13 | Red/System >= 0.2.5 14 | %C-library/ANSI.reds 15 | %OpenGL/OpenGL.reds 16 | } 17 | Purpose: { 18 | This is a simple OpenGL example. It shows two spinning textures. 19 | } 20 | Tabs: 4 21 | ] 22 | 23 | 24 | #include %../../C-library/ANSI.reds 25 | #include %../OpenGL.reds 26 | 27 | #define display-size [640 480] ; 320 240 28 | 29 | 30 | width: 8 31 | height: 8 32 | 33 | 34 | colors: declare struct! [ 35 | part-1-1 [integer!] 36 | part-1-2 [integer!] 37 | part-1-3 [integer!] 38 | part-2-1 [integer!] 39 | part-2-2 [integer!] 40 | part-2-3 [integer!] 41 | ] 42 | array: as pointer! [integer!] colors 43 | array/1: FFh 44 | array/5: FFh 45 | 46 | 47 | chars: make 2 width * height 48 | 49 | chars/13: as-byte 1 50 | chars/20: as-byte 1 51 | chars/21: as-byte 1 52 | chars/29: as-byte 1 53 | chars/37: as-byte 1 54 | chars/45: as-byte 1 55 | chars/52: as-byte 1 56 | chars/53: as-byte 1 57 | chars/54: as-byte 1 58 | 59 | chars/76: as-byte 2 60 | chars/77: as-byte 2 61 | chars/83: as-byte 2 62 | chars/86: as-byte 2 63 | chars/94: as-byte 2 64 | chars/101: as-byte 2 65 | chars/108: as-byte 2 66 | chars/115: as-byte 2 67 | chars/116: as-byte 2 68 | chars/117: as-byte 2 69 | chars/118: as-byte 2 70 | 71 | 72 | objects: declare struct! [ 73 | texture-1 [unsigned!] 74 | texture-2 [unsigned!] 75 | ] 76 | textures: as pointer! [integer!] objects 77 | 78 | 79 | angle: 5.0 80 | count: 0 81 | which: 1 82 | 83 | 84 | with gl [ 85 | 86 | bind-image: function [ 87 | object [integer!] 88 | image [integer!] 89 | /local texture color char cell i j 90 | ][ 91 | texture: allocate width * height * 3 92 | 93 | bind-texture texture-2D' object 94 | 95 | color: (as pointer! [integer!] colors) + (image * 3) 96 | image: image * width * height 97 | i: 0 98 | 99 | until [ 100 | j: 0 101 | char: chars + image + (height - i - 1 * width) 102 | cell: texture + (i * width * 3) 103 | 104 | until [ 105 | either char/value = as-byte 0 [ ; White 106 | cell/1: as-byte FFh 107 | cell/2: as-byte FFh 108 | cell/3: as-byte FFh 109 | ][ 110 | cell/1: as-byte color/1 111 | cell/2: as-byte color/2 112 | cell/3: as-byte color/3 113 | ] 114 | char: char + 1 115 | cell: cell + 3 116 | j: j + 1 117 | j = width 118 | ] 119 | i: i + 1 120 | i = height 121 | ] 122 | texture-image-2D texture-2D' 0 3 width height 0 RGB' gl-byte! texture 123 | texture-parameter-i texture-2D' texture-min-filter' nearest' 124 | texture-parameter-i texture-2D' texture-mag-filter' nearest' 125 | texture-parameter-i texture-2D' texture-wrap-s' repeat' 126 | texture-parameter-i texture-2D' texture-wrap-t' repeat' 127 | ] 128 | 129 | setup: does [ 130 | enable depth-test' 131 | 132 | ; Set up texturing 133 | texture-env-i texture-env' texture-env-mode' decal' 134 | hint perspective-correction-hint' fastest' 135 | 136 | ; Generate texture object IDs 137 | make-textures 2 textures 138 | bind-image textures/1 0 139 | bind-image textures/2 1 140 | ] 141 | 142 | reshape: function ["New window size or exposure" 143 | width [integer!] 144 | height [integer!] 145 | ][ 146 | view-port 0 0 width height 147 | matrix-mode projection' 148 | load-identity 149 | ; ortho -3.0 3.0 -3.0 3.0 -10.0 10.0 150 | frustum -2.0 2.0 -2.0 2.0 6.0 20.0 151 | matrix-mode model-view' 152 | load-identity 153 | translate 0.0 0.0 -8.0 154 | ] 155 | 156 | draw: function [ 157 | /local index 158 | ][ 159 | clear color-buffer-bit or depth-buffer-bit 160 | 161 | color-3D 1.0 1.0 1.0 162 | 163 | ; Draw first polygon 164 | 165 | push-matrix 166 | 167 | translate -1.0 0.0 0.0 168 | rotate angle 0.0 0.0 1.0 169 | bind-texture texture-2D' textures/which 170 | 171 | enable texture-2D' 172 | begin quads' 173 | texture-place-2D 0.0 0.0 174 | vertex-2D -1.0 -1.0 175 | texture-place-2D 1.0 0.0 176 | vertex-2D 1.0 -1.0 177 | texture-place-2D 1.0 1.0 178 | vertex-2D 1.0 1.0 179 | texture-place-2D 0.0 1.0 180 | vertex-2D -1.0 1.0 181 | end 182 | disable texture-2D' 183 | 184 | pop-matrix 185 | 186 | ; Draw second polygon 187 | 188 | push-matrix 189 | 190 | translate 1.0 0.0 0.0 191 | rotate angle - 90.0 0.0 1.0 0.0 192 | index: which xor 3 193 | bind-texture texture-2D' textures/index 194 | 195 | enable texture-2D' 196 | begin quads' 197 | texture-place-2D 0.0 0.0 198 | vertex-2D -1.0 -1.0 199 | texture-place-2D 1.0 0.0 200 | vertex-2D 1.0 -1.0 201 | texture-place-2D 1.0 1.0 202 | vertex-2D 1.0 1.0 203 | texture-place-2D 0.0 1.0 204 | vertex-2D -1.0 1.0 205 | end 206 | disable texture-2D' 207 | 208 | pop-matrix 209 | ] 210 | 211 | ] 212 | 213 | on-key: function [ 214 | key [integer!] 215 | mask [enum!] 216 | return: [logic!] 217 | ][ 218 | yes 219 | ] 220 | 221 | with three-D [ 222 | 223 | idle: does [ 224 | angle: angle + 2.0 225 | count: count + 1 226 | 227 | if count = 5 [ 228 | count: 0 229 | which: which xor 3 ; 2#{11} 230 | ] 231 | 232 | draw 233 | three-D/swap 234 | ] 235 | 236 | view display-size "Textures" 237 | 238 | ] 239 | -------------------------------------------------------------------------------- /OpenGL/platforms/PicoGL.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "PicoGL framework for OpenGL" 3 | Author: "Kaj de Vos" 4 | Rights: "Copyright (c) 2012,2013 Kaj de Vos. All rights reserved." 5 | License: { 6 | Redistribution and use in source and binary forms, with or without modification, 7 | are permitted provided that the following conditions are met: 8 | 9 | * Redistributions of source code must retain the above copyright notice, 10 | this list of conditions and the following disclaimer. 11 | * Redistributions in binary form must reproduce the above copyright notice, 12 | this list of conditions and the following disclaimer in the documentation 13 | and/or other materials provided with the distribution. 14 | 15 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 16 | ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 17 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 18 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 19 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 20 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 21 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 22 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 23 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 24 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | } 26 | Needs: { 27 | Red/System >= 0.3.2 28 | PicoGL 29 | %SDL/SDL.reds 30 | %OpenGL/TinyGL.reds 31 | %OpenGL/OS-Mesa.reds 32 | } 33 | Tabs: 4 34 | ] 35 | 36 | 37 | #include %../../SDL/SDL.reds 38 | 39 | 40 | #switch OS [ 41 | Windows [#define GL-library "libPicoGL-0.dll"] ; TODO: check this 42 | MacOSX [#define GL-library "libPicoGL.dylib"] ; TODO: check this 43 | #default [#define GL-library "libPicoGL.so.0"] 44 | ] 45 | gl: context [#include %../TinyGL.reds] 46 | 47 | #define OS-Mesa-library GL-library 48 | 49 | 50 | three-D: context [with sdl [ 51 | 52 | ; Types 53 | 54 | context-3D!: alias opaque! 55 | 56 | 57 | #import [GL-library cdecl [ 58 | make-context: "sdl_glXCreateContext" [ 59 | return: [context-3D!] 60 | ] 61 | end-context: "sdl_glXDestroyContext" [ 62 | context [context-3D!] 63 | ] 64 | make-current: "sdl_glXMakeCurrent" [ 65 | surface [surface!] 66 | context [context-3D!] 67 | return: [integer!] 68 | ] 69 | 70 | ; _do-events: "ui_loop" [ "Enter event loop." 71 | ; argc [integer!] 72 | ; argv [string-reference!] 73 | ; name [c-string!] 74 | ; return: [integer!] 75 | ; ] 76 | 77 | swap: "sdl_glXSwapBuffers" [ "Swap OpenGL screen content." 78 | ] 79 | ]] 80 | 81 | 82 | ; Higher level interface 83 | 84 | 85 | log-error: function ["Log current SDL error." 86 | ][ 87 | print-wide ["Error:" form-error newline] 88 | ] 89 | 90 | view: function ["Make and show a screen, start event loop." 91 | width [integer!] 92 | height [integer!] 93 | title [c-string!] ; "UTF-8" 94 | return: [logic!] 95 | /local ok? screen context event continue? 96 | ][ 97 | ok?: no ; Presume failure 98 | 99 | either begin with-video [ 100 | screen: set-video-mode width height 16 hardware-surface or double-buffer 101 | 102 | either as-logic screen [ 103 | set-window-caption title title 104 | context: make-context 105 | 106 | either as-logic context [ 107 | either zero? make-current screen context [ 108 | setup 109 | reshape width height 110 | 111 | ; Enter the rendering loop until the window close button is activated 112 | 113 | event: declare event! 114 | continue?: yes 115 | ok?: yes ; So far so good 116 | 117 | while [ 118 | while [poll-event event] [ 119 | switch as-integer event/type [ 120 | quit! [ 121 | continue?: no 122 | ] 123 | default [] 124 | ] 125 | ] 126 | continue? 127 | ][ 128 | idle 129 | ] 130 | ][ 131 | print-line "Error: failed to activate GL context" 132 | ] 133 | end-context context 134 | ][ 135 | print-line "Error: failed to create GL context" 136 | ] 137 | ][ 138 | log-error 139 | ] 140 | end 141 | ][ 142 | log-error 143 | ] 144 | ok? 145 | ] 146 | 147 | ]] 148 | -------------------------------------------------------------------------------- /OpenGL/platforms/SDL-OS-Mesa.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "SDL framework for OpenGL through OS-Mesa" 3 | Author: "Kaj de Vos" 4 | Rights: "Copyright (c) 2012,2013 Kaj de Vos. All rights reserved." 5 | License: { 6 | Redistribution and use in source and binary forms, with or without modification, 7 | are permitted provided that the following conditions are met: 8 | 9 | * Redistributions of source code must retain the above copyright notice, 10 | this list of conditions and the following disclaimer. 11 | * Redistributions in binary form must reproduce the above copyright notice, 12 | this list of conditions and the following disclaimer in the documentation 13 | and/or other materials provided with the distribution. 14 | 15 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 16 | ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 17 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 18 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 19 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 20 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 21 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 22 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 23 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 24 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | } 26 | Needs: { 27 | Red/System >= 0.2.5 28 | SDL 29 | Mesa3D 30 | %SDL/SDL.reds 31 | %OpenGL/GL.reds 32 | %OpenGL/OS-Mesa.reds 33 | } 34 | Tabs: 4 35 | ] 36 | 37 | 38 | #include %../../SDL/SDL.reds 39 | 40 | 41 | #switch OS [ 42 | Windows [ 43 | #define GL-library "opengl32.dll" 44 | #define OS-Mesa-library "OSMesa32.dll" ; TODO: check this 45 | ] 46 | MacOSX [ 47 | #define GL-library "libGL.dylib" 48 | #define OS-Mesa-library "libOSMesa.dylib" ; TODO: check this 49 | ] 50 | Syllable [ 51 | #define OS-Mesa-library "libOSMesa.so.7" 52 | #define GL-library OS-Mesa-library 53 | ] 54 | #default [ ; Ubuntu 55 | #define GL-library "libGL.so.1" 56 | #define OS-Mesa-library "libOSMesa.so.6" 57 | ] 58 | ] 59 | 60 | gl: context [#include %../GL.reds] 61 | 62 | #include %../OS-Mesa.reds 63 | 64 | 65 | three-D: context [with [osmesa sdl] [ 66 | 67 | log-error: function ["Log current SDL error." 68 | ][ 69 | print-wide ["Error:" form-error newline] 70 | ] 71 | 72 | 73 | screen: as surface! 0 74 | buffer: as surface! 0 75 | ok?: yes 76 | 77 | 78 | ; Public interface 79 | 80 | swap: function ["Swap OpenGL screen content." 81 | ][ 82 | gl/finish 83 | 84 | unless all [ 85 | blit buffer null screen null 86 | flip screen 87 | ][ 88 | ok?: no ; Failure 89 | ] 90 | ] 91 | 92 | view: function ["Make and show a screen, start event loop." 93 | width [integer!] 94 | height [integer!] 95 | title [c-string!] ; "UTF-8" 96 | return: [logic!] 97 | /local context event continue? 98 | ][ 99 | ok?: no ; Presume failure 100 | 101 | either begin with-video [ 102 | screen: set-video-mode width height 0 software-surface 103 | 104 | either as-logic screen [ 105 | set-window-caption title title 106 | context: make-context-with gl/RGBA' 16 0 0 null 107 | 108 | either as-logic context [ 109 | buffer: make-RGB-surface software-surface width height 32 FFh FF00h 00FF0000h 0 110 | 111 | either as-logic buffer [ 112 | either make-current context buffer/pixels gl/gl-byte! width height [ 113 | pixel-store y-up' as variant! no 114 | 115 | setup 116 | reshape width height 117 | 118 | ; Enter the rendering loop until the window close button is activated 119 | 120 | event: declare event! 121 | continue?: yes 122 | ok?: yes ; So far so good 123 | 124 | while [ 125 | while [poll-event event] [ 126 | switch as-integer event/type [ 127 | quit! [ 128 | continue?: no 129 | ] 130 | default [] 131 | ] 132 | ] 133 | continue? 134 | ][ 135 | idle 136 | ] 137 | ][ 138 | print-line "Error: failed to activate OS-Mesa context" 139 | ] 140 | free-surface buffer 141 | ][ 142 | print-line "Error: failed to create SDL buffer surface" 143 | ] 144 | end-context context 145 | ][ 146 | print-line "Error: failed to create OS-Mesa context" 147 | ] 148 | ][ 149 | log-error 150 | ] 151 | end 152 | ][ 153 | log-error 154 | ] 155 | ok? 156 | ] 157 | 158 | ]] 159 | -------------------------------------------------------------------------------- /OpenGL/platforms/SDL.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "SDL framework for OpenGL" 3 | Author: "Kaj de Vos" 4 | Rights: "Copyright (c) 2012,2013 Kaj de Vos. All rights reserved." 5 | License: { 6 | Redistribution and use in source and binary forms, with or without modification, 7 | are permitted provided that the following conditions are met: 8 | 9 | * Redistributions of source code must retain the above copyright notice, 10 | this list of conditions and the following disclaimer. 11 | * Redistributions in binary form must reproduce the above copyright notice, 12 | this list of conditions and the following disclaimer in the documentation 13 | and/or other materials provided with the distribution. 14 | 15 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 16 | ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 17 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 18 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 19 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 20 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 21 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 22 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 23 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 24 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | } 26 | Needs: { 27 | Red/System >= 0.2.5 28 | SDL 29 | OpenGL 30 | %SDL/SDL.reds 31 | %OpenGL/GL.reds 32 | } 33 | Tabs: 4 34 | ] 35 | 36 | 37 | #include %../../SDL/SDL.reds 38 | 39 | #switch OS [ 40 | Windows [ 41 | #define GL-library "opengl32.dll" 42 | #define OS-Mesa-library "OSMesa32.dll" ; TODO: check this 43 | ] 44 | MacOSX [ 45 | #define GL-library "libGL.dylib" ; /opt/X11/lib/ 46 | #define OS-Mesa-library "libOSMesa.dylib" ; TODO: check this 47 | ] 48 | #default [ ; Ubuntu 49 | #define GL-library "libGL.so.1" 50 | #define OS-Mesa-library "libOSMesa.so.6" 51 | ] 52 | ] 53 | gl: context [#include %../GL.reds] 54 | 55 | 56 | three-D: context [with sdl [ 57 | 58 | log-error: function ["Log current SDL error." 59 | ][ 60 | print-wide ["Error:" form-error newline] 61 | ] 62 | 63 | 64 | ; Public interface 65 | 66 | swap: function ["Swap OpenGL screen content." 67 | ][ 68 | gl/flush 69 | ; gl/finish ; Causes CPU monopolisation on Linux 70 | sdl/swap 71 | ] 72 | 73 | view: function ["Make and show a screen, start event loop." 74 | width [integer!] 75 | height [integer!] 76 | title [c-string!] ; "UTF-8" 77 | return: [logic!] 78 | /local ok? screen event continue? 79 | ][ 80 | ok?: no ; Presume failure 81 | 82 | either begin with-video [ 83 | ; Seems not to be needed on Linux, and not to work on Windows... 84 | ; set-gl swap-control 1 85 | ; set-gl gl-double-buffer as variant! yes 86 | 87 | screen: set-video-mode width height 0 opengl 88 | 89 | either as-logic screen [ 90 | set-window-caption title title 91 | setup 92 | reshape width height 93 | 94 | ; Enter the rendering loop until the window close button is activated 95 | 96 | event: declare event! 97 | continue?: yes 98 | ok?: yes ; So far so good 99 | 100 | while [ 101 | while [poll-event event] [ 102 | switch as-integer event/type [ 103 | quit! [ 104 | continue?: no 105 | ] 106 | default [] 107 | ] 108 | ] 109 | continue? 110 | ][ 111 | idle 112 | ] 113 | ][ 114 | log-error 115 | ] 116 | end 117 | ][ 118 | log-error 119 | ] 120 | ok? 121 | ] 122 | 123 | ]] 124 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Historical Mirror of Red Extensions 2 | This repo contains a mirror of the Fossil repositories that were originally hosted at http://red.esperconsultancy.nl. The original repos are gone. Unfortunately most of these are no longer compatible with the current version of Red as well. I recommend looking at the [Red Community Repo](https://github.com/red/community) to find options for extension at this point in time. 3 | -------------------------------------------------------------------------------- /REBOL-3/COPYRIGHT.txt: -------------------------------------------------------------------------------- 1 | REBOL 3 Binding for Red 2 | 3 | Copyright (c) 2012,2013 Kaj de Vos 4 | All rights reserved. 5 | 6 | Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright notice, 9 | this list of conditions and the following disclaimer. 10 | * Redistributions in binary form must reproduce the above copyright 11 | notice, this list of conditions and the following disclaimer in the 12 | documentation and/or other materials provided with the distribution. 13 | 14 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 15 | -------------------------------------------------------------------------------- /REBOL-3/_FOSSIL_: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/kealist/RS-fossil-mirror/81e8dfc901d5273e78383b9a3dd959b6fd47edd3/REBOL-3/_FOSSIL_ -------------------------------------------------------------------------------- /REBOL-3/examples/hello-REBOL-3-extension.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | Title: "REBOL 3 extension example" 3 | Type: 'library 4 | Author: "Kaj de Vos" 5 | Rights: "Copyright (c) 2012,2013 Kaj de Vos" 6 | License: { 7 | PD/CC0 8 | http://creativecommons.org/publicdomain/zero/1.0/ 9 | } 10 | Needs: { 11 | Red >= 0.4.1 12 | REBOL 3 > 2.101 13 | %REBOL-3/extension.reds 14 | } 15 | Purpose: { 16 | This is a simple example of a REBOL 3 extension, written in Red. 17 | } 18 | Example: { 19 | r3 20 | ; Windows: 21 | import %hello-REBOL-3-extension.dll 22 | ; Other: 23 | import %./hello-REBOL-3-extension.so 24 | hello 25 | } 26 | Tabs: 4 27 | ] 28 | 29 | 30 | do-hello: does [ 31 | print "Hello Red REBOL extension!" 32 | ] 33 | 34 | 35 | #system-global [ 36 | 37 | #include %../extension.reds 38 | 39 | 40 | with rebol [ 41 | 42 | RX_Init: function [ 43 | options [integer!] 44 | library [rebol!] 45 | return: [c-string!] 46 | ][ 47 | interface/value: library 48 | { 49 | REBOL [ 50 | Title: "Hello REBOL Extension" 51 | Name: hello-extension 52 | Type: extension 53 | ] 54 | export hello: command ["Print hello from a Red REBOL extension."] 55 | } 56 | ] 57 | 58 | RX_Quit: function [ 59 | options [integer!] 60 | return: [integer!] 61 | ][ 62 | 0 63 | ] 64 | 65 | RX_Call: function [ 66 | command [integer!] 67 | arguments [arguments!] 68 | data [binary!] 69 | return: [result!] 70 | ][ 71 | switch command [ 72 | 0 [ ; hello 73 | #call [do-hello] 74 | 75 | result-unset 76 | ] 77 | default [ 78 | error-no-command 79 | ]] 80 | ] 81 | 82 | ] 83 | 84 | #export cdecl [RX_Init RX_Quit RX_Call] 85 | 86 | ] 87 | -------------------------------------------------------------------------------- /REBOL-3/examples/hello-REBOL-3-extension.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "REBOL 3 extension example" 3 | Type: 'library 4 | Author: "Kaj de Vos" 5 | Rights: "Copyright (c) 2012,2013 Kaj de Vos" 6 | License: { 7 | PD/CC0 8 | http://creativecommons.org/publicdomain/zero/1.0/ 9 | } 10 | Needs: { 11 | Red/System >= 0.4.1 12 | REBOL 3 > 2.101 13 | %REBOL-3/extension.reds 14 | } 15 | Purpose: { 16 | This is a simple example of a REBOL 3 extension, written in Red/System. 17 | } 18 | Example: { 19 | r3 20 | ; Windows: 21 | import %hello-REBOL-3-extension.dll 22 | ; Other: 23 | import %./hello-REBOL-3-extension.so 24 | version 25 | platform 26 | hello-symbol 27 | hello 28 | do-hello 29 | increment 2 30 | i: 0 do-increment-i 31 | } 32 | Tabs: 4 33 | ] 34 | 35 | 36 | #include %../extension.reds 37 | 38 | 39 | with rebol [ 40 | 41 | RX_Init: function [ 42 | options [integer!] 43 | library [rebol!] 44 | return: [c-string!] 45 | ][ 46 | interface/value: library 47 | { 48 | REBOL [ 49 | Title: "Hello REBOL Extension" 50 | Name: hello-extension 51 | Type: extension 52 | ] 53 | export version: command ["Return REBOL version."] 54 | export platform: command ["Return operating platform."] 55 | export hello-symbol: command [{Find symbol ID of the word "hello".}] 56 | export hello: command ["Print hello from a Red/System REBOL extension."] 57 | export do-hello: command ["Let REBOL print hello from a Red/System REBOL extension."] 58 | export increment: command ["Return incremented integer." 59 | number [integer!] 60 | ] 61 | export do-increment-i: command ["Increment variable i."] 62 | } 63 | ] 64 | 65 | RX_Quit: function [ 66 | options [integer!] 67 | return: [integer!] 68 | ][ 69 | 0 70 | ] 71 | 72 | RX_Call: function [ 73 | command [integer!] 74 | arguments [arguments!] 75 | data [binary!] 76 | return: [result!] 77 | /local rebol types argument tuple integer 78 | ][ 79 | rebol: interface/value 80 | 81 | types: as tuple! arguments 82 | argument: (as pointer! [value!] arguments) + 1 83 | tuple: as tuple! argument 84 | integer: as rebol-integer! argument 85 | 86 | switch command [ 87 | 0 [ ; version 88 | ; integer/high: 0 89 | ; WARN: REBOL should never return more than 8 bytes: 90 | rebol/get-version tuple 91 | 92 | types/first: as-byte type-tuple 93 | result-value 94 | ] 95 | 1 [ ; platform 96 | ; WARN: REBOL should never return more than 8 bytes: 97 | rebol/get-version tuple 98 | 99 | tuple/count: as-byte 2 100 | tuple/first: tuple/fourth 101 | tuple/second: tuple/fifth 102 | 103 | types/first: as-byte type-tuple 104 | result-value 105 | ] 106 | 2 [ ; hello-symbol 107 | integer/low: rebol/map-word "hello" 108 | integer/high: 0 109 | 110 | types/first: as-byte type-integer 111 | result-value 112 | ] 113 | 3 [ ; hello 114 | rebol/print "Hello Red/System REBOL extension!^/" 115 | result-unset 116 | ] 117 | 4 [ ; do-hello 118 | types/first: as-byte rebol/do-string {print "Hello"} 0 argument 119 | result-value 120 | ] 121 | 5 [ ; increment 122 | integer/low: integer/low + 1 123 | result-value 124 | ] 125 | 6 [ ; do-increment-i 126 | types/first: as-byte rebol/do-string "i: i + 1" 0 argument 127 | result-value 128 | ] 129 | default [ 130 | error-no-command 131 | ]] 132 | ] 133 | 134 | ] 135 | 136 | #export cdecl [RX_Init RX_Quit RX_Call] 137 | -------------------------------------------------------------------------------- /REBOL-3/extension.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "REBOL 3 Extension" 3 | Type: 'library 4 | Author: "Kaj de Vos" 5 | Rights: "Copyright (c) 2012,2013 Kaj de Vos. All rights reserved." 6 | License: { 7 | Redistribution and use in source and binary forms, with or without modification, 8 | are permitted provided that the following conditions are met: 9 | 10 | * Redistributions of source code must retain the above copyright notice, 11 | this list of conditions and the following disclaimer. 12 | * Redistributions in binary form must reproduce the above copyright notice, 13 | this list of conditions and the following disclaimer in the documentation 14 | and/or other materials provided with the distribution. 15 | 16 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 17 | ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 18 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 19 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 20 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 21 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 22 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 23 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 24 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 25 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 26 | } 27 | Needs: { 28 | Red/System > 0.3.2 29 | %common/common.reds 30 | %REBOL-3/common.reds 31 | } 32 | Tabs: 4 33 | ] 34 | 35 | 36 | #include %../common/common.reds 37 | 38 | rebol: context [ 39 | #include %common.reds 40 | 41 | rebol-reference!: alias struct! [value [rebol!]] 42 | interface: declare rebol-reference! 43 | ] 44 | -------------------------------------------------------------------------------- /REBOL-3/host.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "REBOL 3 Interpreter Library" 3 | Author: "Kaj de Vos" 4 | Rights: "Copyright (c) 2012,2013 Kaj de Vos. All rights reserved." 5 | License: { 6 | Redistribution and use in source and binary forms, with or without modification, 7 | are permitted provided that the following conditions are met: 8 | 9 | * Redistributions of source code must retain the above copyright notice, 10 | this list of conditions and the following disclaimer. 11 | * Redistributions in binary form must reproduce the above copyright notice, 12 | this list of conditions and the following disclaimer in the documentation 13 | and/or other materials provided with the distribution. 14 | 15 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 16 | ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 17 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 18 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 19 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 20 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 21 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 22 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 23 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 24 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | } 26 | Needs: { 27 | Red/System >= 0.3.2 28 | %common/common.reds 29 | %REBOL-3/common.reds 30 | } 31 | Tabs: 4 32 | ] 33 | 34 | 35 | #include %../common/common.reds 36 | 37 | rebol: context [ 38 | 39 | #include %common.reds 40 | 41 | 42 | #switch OS [ 43 | Windows [#define R3-library "r3lib.dll"] 44 | MacOSX [#define R3-library "libr3.so.2.5"] 45 | #default [#define R3-library "libr3.so"] 46 | ] 47 | #import [R3-library cdecl [ 48 | 49 | get-version: "RL_Version" [ "Get REBOL version." 50 | array [tuple!] 51 | ] 52 | 53 | begin: "RL_Init" [ "Set up REBOL interpreter." 54 | arguments [options!] 55 | host [handle!] 56 | return: [integer!] 57 | ] 58 | start: "RL_Start" [ "Start REBOL interpreter." 59 | program [binary!] "Compressed startup code, or NULL" 60 | size [integer!] 61 | flags [unsigned!] 62 | return: [integer!] 63 | ] 64 | ; Not implemented: 65 | ;reset: "RL_Reset" [ "Reset REBOL interpreter." 66 | ;] 67 | extend: "RL_Extend" [ "Register embedded extension." 68 | interface [c-string!] 69 | call [call!] 70 | return: [rebol!] 71 | ] 72 | escape: "RL_Escape" [ "Signal execution interruption." 73 | reserved [integer!] "0" 74 | ] 75 | 76 | do-string: "RL_Do_String" [ "Execute text as REBOL program." 77 | text [c-string!] 78 | flags [unsigned!] "0" 79 | result [pointer! [value!]] 80 | return: [type!] 81 | ] 82 | do-binary: "RL_Do_Binary" [ "Execute binary REBOL program." 83 | program [binary!] "REBOL compressed text" 84 | size [integer!] 85 | flags [unsigned!] "0" 86 | key [unsigned!] 87 | result [pointer! [value!]] 88 | return: [type!] "0: encoding error" 89 | ] 90 | ; Not implemented: 91 | ;do: "RL_Do_Block" [ "Execute REBOL block." 92 | ; block [series!] 93 | ; flags [unsigned!] "0" 94 | ; result [pointer! [value!]] 95 | ; return: [type!] "0: encoding error" 96 | ;] 97 | do-commands: "RL_Do_Commands" [ "Execute REBOL extension commands." 98 | block [series!] 99 | flags [unsigned!] "0" 100 | context [context!] "Or NULL" 101 | ] 102 | 103 | print-form: "RL_Print" [ "Print formatted data to the console." 104 | [variadic] 105 | ; format [c-string!] 106 | ; value [variant!] 107 | ; ... 108 | ] 109 | print-last: "RL_Print_TOS" [ "Print top REBOL stack value." 110 | flags [unsigned!] "0" 111 | marker [c-string!] "Console output line indicator" 112 | ] 113 | 114 | do-event: "RL_Event" [ "Add an event." 115 | event [event!] "Copied" 116 | return: [integer!] "FALSE: queue full" 117 | ] 118 | 119 | make-block: "RL_Make_Block" [ "Return a new REBOL block." 120 | length [unsigned32!] 121 | return: [series!] 122 | ] 123 | make-string: "RL_Make_String" [ "Return a new REBOL string." 124 | length [unsigned32!] 125 | unicode? [logic!] 126 | return: [series!] 127 | ] 128 | make-image: "RL_Make_Image" [ "Return a new REBOL image." 129 | width [unsigned32!] 130 | height [unsigned32!] 131 | return: [series!] "NULL: too large" 132 | ] 133 | 134 | protect-recycle: "RL_Protect_GC" [ "Prevent garbage collection." 135 | series [series!] 136 | protect? [logic!] 137 | ] 138 | 139 | get-string: "RL_Get_String" [ "Get pointer into REBOL string." 140 | string [series!] 141 | index [unsigned32!] "0 based" 142 | pointer [binary-reference!] 143 | return: [integer!] "Length, > 0: Unicode, < 0: bytes" 144 | ] 145 | 146 | map-word: "RL_Map_Word" [ "Map word name to symbol ID." 147 | string [c-string!] "UTF-8" 148 | return: [symbol!] 149 | ] 150 | map-words: "RL_Map_Words" [ "Convert word values in block to array of symbol ID's." 151 | block [series!] 152 | return: [symbol-array!] "First is length" 153 | ] 154 | name-of: "RL_Word_String" [ "Return word name for symbol ID." 155 | word [symbol!] 156 | return: [c-string!] "UTF-8 copy" 157 | ] 158 | find-word: "RL_Find_Word" [ "Find index of symbol in array." 159 | words [symbol-array!] "First is length" 160 | word [symbol!] 161 | return: [unsigned32!] "0: not found" 162 | ] 163 | 164 | get-series: "RL_Series" [ "Get series properties." 165 | series [series!] 166 | what [property!] 167 | return: [variant!] "0: invalid property" 168 | ] 169 | 170 | pick-char: "RL_Get_Char" [ "Return a character from a REBOL string." 171 | string [series!] 172 | index [unsigned32!] "0 based" 173 | return: [integer!] "Unicode, -1: out of range" 174 | ] 175 | poke-char: "RL_Set_Char" [ "Set a character in a REBOL string." 176 | string [series!] 177 | index [unsigned32!] "0 based, out of range: append" 178 | char [unsigned32!] "Unicode" 179 | return: [unsigned32!] "Index" 180 | ] 181 | 182 | pick: "RL_Get_Value" [ "Get a value from a REBOL series." 183 | series [series!] 184 | index [unsigned32!] "0 based" 185 | result [pointer! [value!]] 186 | return: [type!] "0: out of range" 187 | ] 188 | poke: "RL_Set_Value" [ "Set a value in a REBOL series." 189 | series [series!] 190 | index [unsigned32!] "0 based, out of range: append" 191 | value [value!] 192 | type [type!] 193 | return: [integer!] "TRUE: out of range and appended" 194 | ] 195 | 196 | words-of: "RL_Words_Of_Object" [ "Return words local to object as array of symbol ID's." 197 | object [series!] 198 | return: [symbol-array!] "First is length" 199 | ] 200 | get-in: "RL_Get_Field" [ "Get a field value from a REBOL object." 201 | object [series!] 202 | word [symbol!] 203 | result [pointer! [value!]] 204 | return: [type!] "0: not found" 205 | ] 206 | set-in: "RL_Set_Field" [ "Set a field value in a REBOL object." 207 | object [series!] 208 | word [symbol!] 209 | value [value!] 210 | type [type!] 211 | return: [type!] "0: not found or protected" 212 | ] 213 | 214 | callback: "RL_Callback" [ "Execute REBOL callback." 215 | callback [callback!] 216 | return: [variant!] "Sync: result type; async: TRUE: queued" 217 | ] 218 | 219 | ]] 220 | ] 221 | -------------------------------------------------------------------------------- /SDL/COPYRIGHT.txt: -------------------------------------------------------------------------------- 1 | SDL Binding for Red 2 | 3 | Copyright (c) 2011-2014 Kaj de Vos 4 | All rights reserved. 5 | 6 | Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright notice, 9 | this list of conditions and the following disclaimer. 10 | * Redistributions in binary form must reproduce the above copyright 11 | notice, this list of conditions and the following disclaimer in the 12 | documentation and/or other materials provided with the distribution. 13 | 14 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 15 | -------------------------------------------------------------------------------- /SDL/_FOSSIL_: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/kealist/RS-fossil-mirror/81e8dfc901d5273e78383b9a3dd959b6fd47edd3/SDL/_FOSSIL_ -------------------------------------------------------------------------------- /SDL/examples/PeterPaint-SDL.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "PeterPaint SDL example" 3 | Author: "Kaj de Vos" 4 | Rights: "Copyright (c) 2011-2014 Kaj de Vos" 5 | License: { 6 | PD/CC0 7 | http://creativecommons.org/publicdomain/zero/1.0/ 8 | } 9 | Needs: { 10 | Red/System >= 0.2.5 11 | %C-library/ANSI.reds 12 | %SDL/SDL.reds 13 | } 14 | Purpose: { 15 | This is a very simple drawing program. It is written on top of SDL, 16 | so it is very portable to multiple operating platforms. 17 | It can load an existing BMP image if you pass it as a parameter 18 | on the command line. 19 | The first version of PeterPaint was written shortly before the 20 | birthday of my friend Peter Busser and is named in his honour. 21 | } 22 | Example: "PeterPaint-SDL sample.bmp" 23 | Tabs: 4 24 | ] 25 | 26 | 27 | #include %../../C-library/ANSI.reds 28 | #include %../SDL.reds 29 | 30 | 31 | with sdl [ 32 | 33 | current: version 34 | print-line ["SDL version: " 35 | as-integer current/major #"." 36 | as-integer current/minor #"." 37 | as-integer current/patch 38 | ] 39 | 40 | 41 | log-error: does [ ; Log current SDL error. 42 | print-line ["Error: " form-error] 43 | ] 44 | 45 | 46 | ; Colour to draw with: 47 | 48 | red: #"^(FF)" 49 | green: #"^(FF)" 50 | blue: #"^(FF)" 51 | 52 | 53 | argument: get-argument 1 54 | file: as-handle 0 55 | 56 | screen: as surface! 0 57 | 58 | image: as surface! 0 59 | rectangle: declare rectangle! 60 | 61 | event: declare event! 62 | mouse-event: as mouse-motion-event! 0 63 | 64 | either begin with-video [ 65 | screen: set-video-mode 640 480 32 software-surface 66 | 67 | either null? screen [ 68 | log-error 69 | ][ 70 | ; If a program parameter is given, load it as a BitMaP file 71 | 72 | if as-logic argument [ 73 | ; file: open-read-binary argument ; FIXME 74 | file: open argument "rb" 75 | end-argument argument 76 | 77 | either null? file [ 78 | log-error 79 | ][ 80 | image: load-bmp file yes 81 | 82 | either null? image [ 83 | log-error 84 | ][ 85 | ; Squash two 16 bits values in 32 bits space 86 | rectangle/x-y: 10 << 16 or 20 87 | rectangle/width-height: image/height << 16 or image/width 88 | 89 | either blit image null screen rectangle [ 90 | update-rectangle screen 20 10 image/width image/height 91 | ][ 92 | log-error 93 | ] 94 | free-surface image 95 | ] 96 | ] 97 | ] 98 | 99 | ; Enter the drawing loop until the window close button is clicked 100 | 101 | while [all [ 102 | await-event event 103 | event/type <> as-byte quit! 104 | ]][ 105 | ; Look for mouse events 106 | 107 | if event/type = as-byte mouse-moved! [ 108 | mouse-event: as mouse-motion-event! event 109 | 110 | ; Draw when a mouse button is pressed 111 | 112 | if as-logic mouse-event/pressed [ 113 | unless plot screen 114 | mouse-event/x-y and FFFFh ; Clean 16 bits value 115 | mouse-event/x-y >>> 16 ; Extract 16 bits value 116 | red green blue 117 | [ 118 | log-error 119 | ] 120 | ] 121 | ] 122 | ] 123 | ] 124 | 125 | end 126 | ][ 127 | log-error 128 | ] 129 | 130 | ] 131 | -------------------------------------------------------------------------------- /SDL/examples/play-SDL-WAV.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "Play a WAV sound file" 3 | Author: "Kaj de Vos" 4 | Rights: "Copyright (c) 2011-2014 Kaj de Vos" 5 | License: { 6 | PD/CC0 7 | http://creativecommons.org/publicdomain/zero/1.0/ 8 | } 9 | Needs: { 10 | Red/System >= 0.2.6 11 | %C-library/ANSI.reds 12 | %SDL/SDL.reds 13 | } 14 | Example: "play-SDL-WAV sample.wav" 15 | Tabs: 4 16 | ] 17 | 18 | 19 | #include %../../C-library/ANSI.reds 20 | #include %../SDL.reds 21 | 22 | 23 | with sdl [ 24 | 25 | log-error: does [ ; Log current SDL error. 26 | print-line ["Error: " form-error] 27 | ] 28 | 29 | 30 | argument: get-argument 1 31 | file: as-handle 0 32 | 33 | screen: as surface! 0 34 | 35 | wanted: declare audio-spec! 36 | actual: declare audio-spec! 37 | 38 | sound: declare audio-spec! 39 | data: declare binary-reference! 40 | size: declare integer! 41 | 42 | conversion: declare audio-conversion! 43 | stream: declare stream! 44 | 45 | either null? argument [ 46 | argument: get-argument 0 47 | print-wide ["Usage:" argument "" newline] 48 | ][ 49 | ; Open audio output in the preferred format and get the actual hardware format 50 | 51 | either begin with-audio 52 | #if OS = 'Syllable [or with-video] 53 | #if OS = 'Windows [or with-video] 54 | [ 55 | wanted/format-1: as-byte audio-s16 and FFh 56 | wanted/format-2: as-byte audio-s16 >>> 8 57 | wanted/channels: as-byte 2 58 | wanted/frequency: 22'050 59 | wanted/samples: 0200h 60 | wanted/user-data: as-handle stream 61 | wanted/callback: as-integer :fetch-audio 62 | 63 | #if OS = 'Windows [ ; DirectSound needs a window handle 64 | screen: set-video-mode 1 1 0 no-frame 65 | 66 | if null? screen [log-error] 67 | ] 68 | either open-audio wanted actual [ 69 | ; Load the audio file 70 | 71 | ; file: open-read-binary argument ; FIXME 72 | file: open argument "rb" 73 | 74 | either null? file [ 75 | log-error 76 | ][ 77 | either null? load-wav file yes sound data :size [ 78 | log-error 79 | ][ 80 | ; Convert audio to the hardware format 81 | 82 | either make-audio-conversion conversion 83 | (as-integer sound/format-2) << 8 or as-integer sound/format-1 84 | sound/channels 85 | sound/frequency 86 | (as-integer actual/format-2) << 8 or as-integer actual/format-1 87 | actual/channels 88 | actual/frequency 89 | [ 90 | conversion/data: allocate conversion/size-multiple * size 91 | 92 | either null? conversion/data [ 93 | print-line "Error: sound conversion memory allocation failed" 94 | ][ 95 | copy-part data/value conversion/data size 96 | conversion/source-size: size 97 | 98 | either convert-audio conversion [ 99 | ; Play the converted audio 100 | 101 | stream/index: conversion/data 102 | stream/rest: conversion/target-size 103 | 104 | pause-audio no 105 | 106 | until [ 107 | ; wait 1 108 | zero? stream/rest 109 | ] 110 | ][ 111 | log-error 112 | ] 113 | free conversion/data 114 | ] 115 | ][ 116 | log-error 117 | ] 118 | free-wav data/value 119 | ] 120 | ] 121 | close-audio 122 | ][ 123 | log-error 124 | ] 125 | end 126 | ][ 127 | log-error 128 | ] 129 | ] 130 | end-argument argument 131 | 132 | ] 133 | -------------------------------------------------------------------------------- /SDL/examples/sample.bmp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/kealist/RS-fossil-mirror/81e8dfc901d5273e78383b9a3dd959b6fd47edd3/SDL/examples/sample.bmp -------------------------------------------------------------------------------- /SDL/examples/sample.wav: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/kealist/RS-fossil-mirror/81e8dfc901d5273e78383b9a3dd959b6fd47edd3/SDL/examples/sample.wav -------------------------------------------------------------------------------- /SQLite/COPYRIGHT.txt: -------------------------------------------------------------------------------- 1 | SQLite Binding for Red 2 | 3 | Copyright (c) 2011-2014 Kaj de Vos 4 | All rights reserved. 5 | 6 | Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright notice, 9 | this list of conditions and the following disclaimer. 10 | * Redistributions in binary form must reproduce the above copyright 11 | notice, this list of conditions and the following disclaimer in the 12 | documentation and/or other materials provided with the distribution. 13 | 14 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 15 | -------------------------------------------------------------------------------- /SQLite/_FOSSIL_: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/kealist/RS-fossil-mirror/81e8dfc901d5273e78383b9a3dd959b6fd47edd3/SQLite/_FOSSIL_ -------------------------------------------------------------------------------- /SQLite/examples/do-sql.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | Title: "Quick start SQLite example" 3 | Author: "Kaj de Vos" 4 | Rights: "Copyright (c) 2011-2013 Kaj de Vos" 5 | License: { 6 | PD/CC0 7 | http://creativecommons.org/publicdomain/zero/1.0/ 8 | } 9 | Needs: { 10 | %SQLite.red 11 | } 12 | Purpose: { 13 | Show a simple way to start programming SQLite, similar to this 14 | introductory documentation: 15 | http://sqlite.org/quickstart.html 16 | } 17 | Example: { 18 | do-sql database.sqlite "SELECT name FROM sqlite_master WHERE type='table' ORDER BY name" 19 | } 20 | Tabs: 4 21 | ] 22 | 23 | 24 | #include %../SQLite.red 25 | 26 | 27 | log-error: function ["Log SQLite error." 28 | db [sqlite!] 29 | ][ 30 | print ["Error:" form-error db] 31 | ] 32 | 33 | #system-global [ 34 | with sqlite [ 35 | 36 | data!: alias struct! [ 37 | count [integer!] 38 | ] 39 | data: declare data! 40 | 41 | handle-row: function [ "Process a result row." 42 | [cdecl] 43 | data [data!] 44 | columns [integer!] 45 | values [string-reference!] 46 | names [string-reference!] 47 | return: [integer!] "0: OK" 48 | ][ 49 | data/count: data/count + 1 50 | print ["Row number: " data/count newline] 51 | 52 | ; Print all name/value pairs of the columns that have values 53 | 54 | while [as-logic columns] [ 55 | if as-logic values/value [ 56 | print [names/value ": " values/value newline] 57 | ] 58 | columns: columns - 1 59 | names: names + 1 60 | values: values + 1 61 | ] 62 | print newline 63 | 64 | status-ok ; Keep processing 65 | ] 66 | 67 | ] 68 | ] 69 | 70 | handler: routine [ 71 | return: [integer!] "function!" 72 | ][ 73 | as-integer :handle-row 74 | ] 75 | counter: routine [ 76 | return: [integer!] "data!" 77 | ][ 78 | as-integer data 79 | ] 80 | 81 | begin: routine [] [ 82 | data/count: 0 83 | ] 84 | count: routine [ 85 | return: [integer!] 86 | ][ 87 | data/count 88 | ] 89 | 90 | 91 | switch/default get-args-count [ 92 | 0 [ 93 | print ["SQLite version:" version] 94 | print ["SQLite version number:" version-number] 95 | print ["SQLite source ID:" source-version] 96 | ] 97 | 2 [ 98 | ; Open (or create) the database 99 | db: open-database get-argument 1 100 | 101 | either zero? status: status-of db [ 102 | ; Execute the SQL statements 103 | 104 | begin 105 | 106 | either error: do-sql db get-argument 2 handler counter [ 107 | status: status-of db 108 | 109 | print ["SQL error:" error] 110 | ;log-error db 111 | ][ 112 | print [count "rows processed"] 113 | ] 114 | ][ 115 | log-error db 116 | ] 117 | 118 | ; Close the database 119 | end: close-database db 120 | 121 | ; Return the first occurred error code, if any 122 | unless zero? end [ 123 | log-error db 124 | if zero? status [quit/return end] 125 | ] 126 | quit/return status 127 | ]][ 128 | print ["Usage:" get-argument 0 " "] 129 | 130 | quit/return 1 131 | ] 132 | -------------------------------------------------------------------------------- /SQLite/examples/do-sql.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "Quick start SQLite example" 3 | Author: "Kaj de Vos" 4 | Rights: "Copyright (c) 2011-2013 Kaj de Vos" 5 | License: { 6 | PD/CC0 7 | http://creativecommons.org/publicdomain/zero/1.0/ 8 | } 9 | Needs: { 10 | %C-library/ANSI.reds 11 | %SQLite.reds 12 | } 13 | Purpose: { 14 | Show a simple way to start programming SQLite, similar to this 15 | introductory documentation: 16 | http://sqlite.org/quickstart.html 17 | } 18 | Example: { 19 | do-sql database.sqlite "SELECT name FROM sqlite_master WHERE type='table' ORDER BY name" 20 | } 21 | Tabs: 4 22 | ] 23 | 24 | 25 | #include %../../C-library/ANSI.reds 26 | #include %../SQLite.reds 27 | 28 | 29 | with sqlite [ 30 | 31 | log-error: function ["Log SQLite error." 32 | db [sqlite!] 33 | ][ 34 | print ["Error: " form-error db newline] 35 | ] 36 | 37 | data!: alias struct! [ 38 | count [integer!] 39 | ] 40 | 41 | handle-row: function [[cdecl] 42 | "Process a result row." 43 | data [data!] 44 | columns [integer!] 45 | values [string-reference!] 46 | names [string-reference!] 47 | return: [integer!] "0: OK" 48 | ][ 49 | data/count: data/count + 1 50 | print ["Row number: " data/count newline] 51 | 52 | ; Print all name/value pairs of the columns that have values 53 | 54 | while [as-logic columns] [ 55 | if as-logic values/value [ 56 | print [names/value ": " values/value newline] 57 | ] 58 | columns: columns - 1 59 | names: names + 1 60 | values: values + 1 61 | ] 62 | print newline 63 | 64 | status-ok ; Keep processing 65 | ] 66 | 67 | argument: as-c-string 0 68 | 69 | db-reference: declare sqlite-reference! 70 | db: as sqlite! 0 71 | status: status-ok 72 | end: status-ok 73 | error: declare string-reference! 74 | data: declare data! 75 | 76 | switch get-args-count [ 77 | 0 [ 78 | print-line [ 79 | "SQLite version: " version newline 80 | "SQLite version number: " version-number newline 81 | "SQLite source ID: " source-version 82 | ] 83 | ] 84 | 2 [ 85 | ; Open (or create) the database 86 | argument: get-argument 1 87 | status: open-database argument db-reference 88 | end-argument argument 89 | db: db-reference/value 90 | 91 | either as-logic status [ 92 | log-error db 93 | ][ 94 | ; Execute the SQL statements 95 | argument: get-argument 2 96 | data/count: 0 97 | status: do db 98 | argument 99 | as-integer :handle-row 100 | as-handle data 101 | error 102 | end-argument argument 103 | 104 | either as-logic status [ 105 | print ["SQL error: " error/value newline] 106 | sqlite-free as-binary error/value 107 | ;log-error db 108 | ][ 109 | print [data/count " rows processed" newline] 110 | ] 111 | ] 112 | 113 | ; Close the database 114 | end: close-database db 115 | 116 | ; Return the first occurred error code, if any 117 | if as-logic end [ 118 | log-error db 119 | if zero? status [quit end] 120 | ] 121 | quit status 122 | ] 123 | default [ 124 | argument: get-argument 0 125 | print-wide ["Usage:" argument " " newline] 126 | end-argument argument 127 | 128 | quit 1 129 | ]] 130 | 131 | ] 132 | -------------------------------------------------------------------------------- /TNetStrings/COPYRIGHT.txt: -------------------------------------------------------------------------------- 1 | Tagged NetStrings for Red 2 | 3 | Copyright (c) 2013,2014 Kaj de Vos 4 | All rights reserved. 5 | 6 | Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright notice, 9 | this list of conditions and the following disclaimer. 10 | * Redistributions in binary form must reproduce the above copyright 11 | notice, this list of conditions and the following disclaimer in the 12 | documentation and/or other materials provided with the distribution. 13 | 14 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 15 | -------------------------------------------------------------------------------- /TNetStrings/_FOSSIL_: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/kealist/RS-fossil-mirror/81e8dfc901d5273e78383b9a3dd959b6fd47edd3/TNetStrings/_FOSSIL_ -------------------------------------------------------------------------------- /TNetStrings/examples/TNetStrings.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | Title: "Tagged NetStrings examples" 3 | Author: "Kaj de Vos" 4 | Rights: "Copyright (c) 2013,2014 Kaj de Vos" 5 | License: { 6 | PD/CC0 7 | http://creativecommons.org/publicdomain/zero/1.0/ 8 | } 9 | Needs: { 10 | Red > 0.4.1 11 | %C-library/input-output.red 12 | %TNetStrings.red 13 | } 14 | Tabs: 4 15 | ] 16 | 17 | #include %../../C-library/input-output.red 18 | #include %../TNetStrings.red 19 | 20 | print to-TNetString "Example" 21 | probe load-TNetString "7:Example," 22 | print to-TNetString/only [9] 23 | probe load-TNetString/all "1:9#" 24 | probe load-TNetString "4:6.28^^" 25 | probe load-TNetString/values {6:#issue,5:%file,8:"string",} 26 | print to-TNetString context [a: 9 b: 42] 27 | print to-TNetString/map [a 9 b 42] 28 | probe load-TNetString "17:1:a,1:9#1:b,2:42#}" 29 | probe load-TNetString/keys "17:1:a,1:9#1:b,2:42#}" 30 | probe load-TNetString/objects "17:1:a,1:9#1:b,2:42#}" 31 | print to-TNetString s: charset [#"0" - #"9"] 32 | print to-TNetString complement s 33 | print to-TNetString charset [100 1000] 34 | -------------------------------------------------------------------------------- /ZeroMQ-binding/COPYRIGHT.txt: -------------------------------------------------------------------------------- 1 | 0MQ Binding for Red 2 | 3 | Copyright (c) 2011-2014 Kaj de Vos 4 | All rights reserved. 5 | 6 | Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright notice, 9 | this list of conditions and the following disclaimer. 10 | * Redistributions in binary form must reproduce the above copyright 11 | notice, this list of conditions and the following disclaimer in the 12 | documentation and/or other materials provided with the distribution. 13 | 14 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 15 | -------------------------------------------------------------------------------- /ZeroMQ-binding/_FOSSIL_: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/kealist/RS-fossil-mirror/81e8dfc901d5273e78383b9a3dd959b6fd47edd3/ZeroMQ-binding/_FOSSIL_ -------------------------------------------------------------------------------- /ZeroMQ-binding/examples/0MQ-reply-server.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | Title: "ZeroMQ request/reply server example" 3 | Author: "Kaj de Vos" 4 | Rights: "Copyright (c) 2011-2014 Kaj de Vos" 5 | License: { 6 | PD/CC0 7 | http://creativecommons.org/publicdomain/zero/1.0/ 8 | } 9 | Needs: { 10 | Red >= 0.4.3 11 | %ZeroMQ-binding.red 12 | } 13 | Tabs: 4 14 | ] 15 | 16 | 17 | #include %../ZeroMQ-binding.red 18 | 19 | 20 | prin ["0MQ version:" major-version] 21 | prin #"." prin minor-version 22 | prin #"." print patch-version 23 | prin newline 24 | 25 | 26 | ; Hello World client/server 27 | 28 | address: any [get-argument 1 tcp://*:5555] 29 | reply: "World" 30 | 31 | log-error: does [ ; FIXME: should go to stderr 32 | print form-error system-error 33 | ] 34 | 35 | server: function [] [ 36 | either zero? pool: make-pool 1 [ 37 | log-error 38 | ][ 39 | either zero? socket: open-socket pool reply! [ 40 | log-error 41 | ][ 42 | either serve socket address [ 43 | print ["Awaiting requests on" address] 44 | data: "" 45 | 46 | ; forever [ 47 | while [yes] [ 48 | unless all [ 49 | receive/into socket data 50 | ( 51 | print ["Received request:" data] 52 | send socket reply 53 | ) 54 | ][ 55 | log-error 56 | ] 57 | ] 58 | ][ 59 | log-error 60 | ] 61 | unless close-socket socket [log-error] 62 | ] 63 | unless end-pool pool [log-error] 64 | ] 65 | ] 66 | 67 | server 68 | -------------------------------------------------------------------------------- /ZeroMQ-binding/examples/0MQ-reply-server.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "ZeroMQ request/reply server example" 3 | Author: "Kaj de Vos" 4 | Rights: "Copyright (c) 2011-2014 Kaj de Vos" 5 | License: { 6 | PD/CC0 7 | http://creativecommons.org/publicdomain/zero/1.0/ 8 | } 9 | Needs: { 10 | Red/System >= 0.3.1 11 | %C-library/ANSI.reds 12 | %ZeroMQ-binding.reds 13 | } 14 | Tabs: 4 15 | ] 16 | 17 | 18 | #include %../../C-library/ANSI.reds 19 | #include %../ZeroMQ-binding.reds 20 | 21 | 22 | with zmq [ 23 | 24 | major: 0 minor: 0 patch: 0 25 | 26 | version :major :minor :patch 27 | print-line [ 28 | "0MQ version: " major #"." minor #"." patch 29 | newline 30 | ] 31 | 32 | 33 | ; Hello World client/server 34 | 35 | log-error: does [ ; FIXME: should go to stderr 36 | print-line form-error system-error 37 | ] 38 | 39 | server: function [ 40 | /local pool socket message reply data size 41 | ][ 42 | pool: make-pool 1 43 | ; For 0MQ <= 2.0.6: 44 | ; pool: make-pool 1 1 0 45 | 46 | either none? pool [ 47 | log-error 48 | ][ 49 | socket: open-socket pool reply! 50 | 51 | either none? socket [ 52 | log-error 53 | ][ 54 | either serve socket "tcp://*:5555" [ 55 | print-line "Awaiting requests..." 56 | 57 | message: declare message! 58 | reply: "World" 59 | size: (length? reply) + 1 60 | 61 | forever [ 62 | either receive socket message zmq-none [ 63 | data: message-data-of message 64 | 65 | either none? data [ 66 | print-line "Error: no message content available" 67 | 68 | ; unless end-message message [log-error] 69 | ][ 70 | ; WARN: assume null tail marker is included 71 | print-line ["Received request: " as-c-string data] 72 | 73 | either end-message message [ 74 | ;wait 1 75 | 76 | data: allocate size 77 | 78 | either none? data [ 79 | print-line "Error: out of memory!" 80 | ][ 81 | unless send socket message 82 | copy-part as-binary reply data size 83 | size 84 | zmq-none 85 | [log-error] 86 | ] 87 | ][ 88 | log-error 89 | ] 90 | ] 91 | ][ 92 | log-error 93 | ] 94 | ] 95 | ][ 96 | log-error 97 | ] 98 | unless close-socket socket [log-error] 99 | ] 100 | unless end-pool pool [log-error] 101 | ] 102 | ] 103 | 104 | ] 105 | 106 | server 107 | -------------------------------------------------------------------------------- /ZeroMQ-binding/examples/0MQ-request-client.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | Title: "ZeroMQ request/reply client example" 3 | Author: "Kaj de Vos" 4 | Rights: "Copyright (c) 2011-2014 Kaj de Vos" 5 | License: { 6 | PD/CC0 7 | http://creativecommons.org/publicdomain/zero/1.0/ 8 | } 9 | Needs: { 10 | Red >= 0.4.3 11 | %ZeroMQ-binding.red 12 | } 13 | Tabs: 4 14 | ] 15 | 16 | 17 | #include %../ZeroMQ-binding.red 18 | 19 | 20 | prin ["0MQ version:" major-version] 21 | prin #"." prin minor-version 22 | prin #"." print patch-version 23 | prin newline 24 | 25 | 26 | ; Hello World client/server 27 | 28 | address: any [get-argument 1 tcp://localhost:5555] 29 | request: "Hello" 30 | 31 | log-error: does [ ; FIXME: should go to stderr 32 | print form-error system-error 33 | ] 34 | 35 | client: function [] [ 36 | either zero? pool: make-pool 1 [ 37 | log-error 38 | ][ 39 | print ["Connecting to Hello World server at" address] 40 | 41 | either zero? socket: open-socket pool request! [ 42 | log-error 43 | ][ 44 | either connect socket address [ 45 | data: "" 46 | 47 | repeat count 10 [ 48 | print ["Sending request" count] 49 | 50 | either all [ 51 | send socket request 52 | receive/into socket data 53 | ][ 54 | prin ["Received reply" count] print [":" data] 55 | ][ 56 | log-error 57 | ] 58 | ] 59 | ][ 60 | log-error 61 | ] 62 | unless close-socket socket [log-error] 63 | ] 64 | unless end-pool pool [log-error] 65 | ] 66 | ] 67 | 68 | client 69 | -------------------------------------------------------------------------------- /ZeroMQ-binding/examples/0MQ-request-client.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "ZeroMQ request/reply client example" 3 | Author: "Kaj de Vos" 4 | Rights: "Copyright (c) 2011-2014 Kaj de Vos" 5 | License: { 6 | PD/CC0 7 | http://creativecommons.org/publicdomain/zero/1.0/ 8 | } 9 | Needs: { 10 | Red/System >= 0.3.1 11 | %C-library/ANSI.reds 12 | %ZeroMQ-binding.reds 13 | } 14 | Tabs: 4 15 | ] 16 | 17 | 18 | #include %../../C-library/ANSI.reds 19 | #include %../ZeroMQ-binding.reds 20 | 21 | 22 | with zmq [ 23 | 24 | major: 0 minor: 0 patch: 0 25 | 26 | version :major :minor :patch 27 | print-line [ 28 | "0MQ version: " major #"." minor #"." patch 29 | newline 30 | ] 31 | 32 | 33 | ; Hello World client/server 34 | 35 | log-error: does [ ; FIXME: should go to stderr 36 | print-line form-error system-error 37 | ] 38 | 39 | client: function [ 40 | /local pool socket count message request data size 41 | ][ 42 | pool: make-pool 1 43 | ; For 0MQ <= 2.0.6: 44 | ; pool: make-pool 1 1 0 45 | 46 | either none? pool [ 47 | log-error 48 | ][ 49 | print-line "Connecting to Hello World server..." 50 | 51 | socket: open-socket pool request! 52 | 53 | either none? socket [ 54 | log-error 55 | ][ 56 | either connect socket "tcp://localhost:5555" [ 57 | message: declare message! 58 | 59 | request: "Hello" 60 | size: (length? request) + 1 61 | 62 | count: 0 63 | 64 | until [ 65 | count: count + 1 66 | 67 | print-line ["Sending request " count] 68 | data: allocate size 69 | 70 | either none? data [ 71 | print-line "Error: out of memory!" 72 | ][ 73 | either all [ 74 | send socket message 75 | copy-part as-binary request data size 76 | size 77 | zmq-none 78 | receive socket message zmq-none 79 | ][ 80 | data: message-data-of message 81 | 82 | either none? data [ 83 | print-line "Error: no message content available" 84 | ][ 85 | ; WARN: assume null tail marker is included 86 | print-line ["Received reply " count ": " as-c-string data] 87 | ] 88 | unless end-message message [log-error] 89 | ][ 90 | log-error 91 | ] 92 | ] 93 | 94 | count = 10 95 | ] 96 | ][ 97 | log-error 98 | ] 99 | unless close-socket socket [log-error] 100 | ] 101 | unless end-pool pool [log-error] 102 | ] 103 | ] 104 | 105 | ] 106 | 107 | client 108 | -------------------------------------------------------------------------------- /ZeroMQ-binding/examples/0MQ-ventilator-sink.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | Title: "ZeroMQ ventilator sink example" 3 | Author: "Kaj de Vos" 4 | Rights: "Copyright (c) 2012-2014 Kaj de Vos" 5 | License: { 6 | PD/CC0 7 | http://creativecommons.org/publicdomain/zero/1.0/ 8 | } 9 | Needs: { 10 | Red >= 0.4.3 11 | %C-library/ANSI.red 12 | %ZeroMQ-binding.red 13 | } 14 | Tabs: 4 15 | ] 16 | 17 | #include %../../C-library/ANSI.red 18 | #include %../ZeroMQ-binding.red 19 | 20 | address: any [get-argument 1 tcp://*:5558] 21 | 22 | log-error: does [ ; FIXME: should go to stderr 23 | print form-error system-error 24 | ] 25 | 26 | either zero? pool: make-pool 1 [ 27 | log-error 28 | ][ 29 | print ["Setting up ventilator sink server on" address] 30 | 31 | either zero? sink: open-socket pool pull! [ 32 | log-error 33 | ][ 34 | either all [ 35 | serve sink address 36 | ( 37 | print "Awaiting start of batch..." 38 | dummy: receive sink ; Signal message: discard 39 | ) 40 | end-message dummy 41 | ][ 42 | time: now/precise 43 | print "Pulling processed tasks from workers..." 44 | 45 | message: "" 46 | total: 0 47 | 48 | loop 100 [ 49 | either receive/into sink message [ 50 | set [platform version result] probe load message 51 | 52 | if integer? result [total: total + result] 53 | ][ 54 | log-error 55 | ] 56 | ] 57 | print [ 58 | "Result total:" total newline 59 | "Elapsed seconds:" subtract-time now/precise time 60 | ] 61 | ][ 62 | log-error 63 | ] 64 | unless close-socket sink [log-error] 65 | ] 66 | unless end-pool pool [log-error] 67 | ] 68 | -------------------------------------------------------------------------------- /ZeroMQ-binding/examples/0MQ-ventilator-worker.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | Title: "ZeroMQ ventilator worker example" 3 | Author: "Kaj de Vos" 4 | Rights: "Copyright (c) 2012-2014 Kaj de Vos" 5 | License: { 6 | PD/CC0 7 | http://creativecommons.org/publicdomain/zero/1.0/ 8 | } 9 | Needs: { 10 | Red >= 0.4.3 11 | %C-library/ANSI.red 12 | %ZeroMQ-binding.red 13 | } 14 | Tabs: 4 15 | ] 16 | 17 | ;#include %../../C-library/ANSI.red 18 | #include %../ZeroMQ-binding.red 19 | 20 | source-address: any [get-argument 1 tcp://localhost:5557] 21 | sink-address: any [get-argument 2 tcp://localhost:5558] 22 | 23 | log-error: does [ ; FIXME: should go to stderr 24 | print form-error system-error 25 | ] 26 | 27 | print ["Worker:" system/platform system/version] 28 | 29 | either zero? pool: make-pool 1 [ 30 | log-error 31 | ][ 32 | print ["Connecting to ventilator at" source-address] 33 | 34 | either zero? source: open-socket pool pull! [ 35 | log-error 36 | ][ 37 | either all [ 38 | connect source source-address 39 | ( 40 | print ["Connecting to sink at" sink-address] 41 | not zero? sink: open-socket pool push! 42 | ) 43 | ][ 44 | either connect sink sink-address [ 45 | print "Pulling tasks from ventilator source..." 46 | 47 | ; random/seed/secure 0 48 | work: "" 49 | task: 0 50 | 51 | ; forever [ 52 | while [yes] [ 53 | unless all [ 54 | receive/into source work 55 | ( 56 | print ["Task" task: task + 1 ":" work] 57 | send sink mold reduce [ 58 | system/platform 59 | system/version 60 | probe do work 61 | ] 62 | ) 63 | ][ 64 | log-error 65 | ] 66 | ] 67 | ][ 68 | log-error 69 | ] 70 | unless close-socket sink [log-error] 71 | ][ 72 | log-error 73 | ] 74 | unless close-socket source [log-error] 75 | ] 76 | unless end-pool pool [log-error] 77 | ] 78 | -------------------------------------------------------------------------------- /ZeroMQ-binding/examples/0MQ-ventilator.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | Title: "ZeroMQ ventilator source example" 3 | Author: "Kaj de Vos" 4 | Rights: "Copyright (c) 2012-2014 Kaj de Vos" 5 | License: { 6 | PD/CC0 7 | http://creativecommons.org/publicdomain/zero/1.0/ 8 | } 9 | Needs: { 10 | Red >= 0.4.3 11 | %C-library/ANSI.red 12 | %ZeroMQ-binding.red 13 | } 14 | Tabs: 4 15 | ] 16 | 17 | #include %../../C-library/ANSI.red 18 | #include %../ZeroMQ-binding.red 19 | 20 | work: any [get-argument 1 "random 100"] 21 | source-address: any [get-argument 2 tcp://*:5557] 22 | sink-address: any [get-argument 3 tcp://localhost:5558] 23 | 24 | log-error: does [ ; FIXME: should go to stderr 25 | print form-error system-error 26 | ] 27 | 28 | either zero? pool: make-pool 1 [ 29 | log-error 30 | ][ 31 | print ["Setting up ventilator server on" source-address] 32 | 33 | either zero? source: open-socket pool push! [ 34 | log-error 35 | ][ 36 | either all [ 37 | serve source source-address 38 | ( 39 | print ["Connecting to sink at" sink-address] 40 | not zero? sink: open-socket pool push! 41 | ) 42 | ][ 43 | either all [ 44 | connect sink sink-address 45 | ( 46 | ask "Press Enter when the workers and sink are ready: " 47 | send sink none ; Start of batch 48 | ) 49 | ][ 50 | print "Pushing tasks to workers..." 51 | 52 | repeat task 100 [ 53 | print ["Pushing task" task] 54 | 55 | unless send source work [log-error] 56 | ] 57 | ][ 58 | log-error 59 | ] 60 | unless close-socket sink [log-error] 61 | ][ 62 | log-error 63 | ] 64 | unless close-socket source [log-error] 65 | ] 66 | unless end-pool pool [log-error] 67 | ] 68 | -------------------------------------------------------------------------------- /cURL/COPYRIGHT.txt: -------------------------------------------------------------------------------- 1 | cURL Binding for Red 2 | 3 | Copyright (c) 2010-2013 Kaj de Vos 4 | All rights reserved. 5 | 6 | Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright notice, 9 | this list of conditions and the following disclaimer. 10 | * Redistributions in binary form must reproduce the above copyright 11 | notice, this list of conditions and the following disclaimer in the 12 | documentation and/or other materials provided with the distribution. 13 | 14 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 15 | -------------------------------------------------------------------------------- /cURL/_FOSSIL_: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/kealist/RS-fossil-mirror/81e8dfc901d5273e78383b9a3dd959b6fd47edd3/cURL/_FOSSIL_ -------------------------------------------------------------------------------- /cURL/examples/read-web-page.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "cURL example: reading a web page" 3 | Author: "Kaj de Vos" 4 | Rights: "Copyright (c) 2011-2013 Kaj de Vos" 5 | License: { 6 | PD/CC0 7 | http://creativecommons.org/publicdomain/zero/1.0/ 8 | } 9 | Needs: { 10 | Red/System >= 0.3.1 11 | %cURL.reds 12 | } 13 | Purpose: { 14 | Show how to read a network URL with the cURL binding for Red/System. 15 | } 16 | Tabs: 4 17 | ] 18 | 19 | 20 | #include %../cURL.reds 21 | 22 | 23 | argument: get-argument 1 24 | text: as-c-string 0 25 | 26 | either none? argument [ 27 | argument: get-argument 0 28 | print-line [ 29 | "Usage: " argument " " newline 30 | "cURL version: " curl/version 31 | ] 32 | ][ 33 | text: read-url argument 34 | 35 | either none? text [ 36 | print-line "Failed to read URL" 37 | ][ 38 | print-line text 39 | free-any text 40 | ] 41 | ] 42 | end-argument argument 43 | -------------------------------------------------------------------------------- /common/COPYRIGHT.txt: -------------------------------------------------------------------------------- 1 | Common Definitions for Red 2 | 3 | Copyright (c) 2011-2015 Kaj de Vos 4 | All rights reserved. 5 | 6 | Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright notice, 9 | this list of conditions and the following disclaimer. 10 | * Redistributions in binary form must reproduce the above copyright 11 | notice, this list of conditions and the following disclaimer in the 12 | documentation and/or other materials provided with the distribution. 13 | 14 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 15 | -------------------------------------------------------------------------------- /common/FPU-configuration.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "FPU configuration for C functions" 3 | Author: "Kaj de Vos" 4 | Rights: "Copyright (c) 2012,2013 Kaj de Vos. All rights reserved." 5 | License: { 6 | Redistribution and use in source and binary forms, with or without modification, 7 | are permitted provided that the following conditions are met: 8 | 9 | * Redistributions of source code must retain the above copyright notice, 10 | this list of conditions and the following disclaimer. 11 | * Redistributions in binary form must reproduce the above copyright notice, 12 | this list of conditions and the following disclaimer in the documentation 13 | and/or other materials provided with the distribution. 14 | 15 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 16 | ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 17 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 18 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 19 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 20 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 21 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 22 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 23 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 24 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | } 26 | Needs: %common/common.reds 27 | Tabs: 4 28 | ] 29 | 30 | ; FPU configuration 31 | ; All exceptions need to be disabled when entering C functions 32 | 33 | #if target = 'IA-32 [ 34 | system/fpu/mask/overflow: on 35 | system/fpu/mask/underflow: on 36 | system/fpu/mask/zero-divide: on 37 | system/fpu/mask/invalid-op: on 38 | system/fpu/update 39 | ] 40 | 41 | #include %common.reds 42 | -------------------------------------------------------------------------------- /common/_FOSSIL_: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/kealist/RS-fossil-mirror/81e8dfc901d5273e78383b9a3dd959b6fd47edd3/common/_FOSSIL_ -------------------------------------------------------------------------------- /common/common.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "Common Definitions" 3 | Author: "Kaj de Vos" 4 | Rights: "Copyright (c) 2011,2012 Kaj de Vos. All rights reserved." 5 | License: { 6 | Redistribution and use in source and binary forms, with or without modification, 7 | are permitted provided that the following conditions are met: 8 | 9 | * Redistributions of source code must retain the above copyright notice, 10 | this list of conditions and the following disclaimer. 11 | * Redistributions in binary form must reproduce the above copyright notice, 12 | this list of conditions and the following disclaimer in the documentation 13 | and/or other materials provided with the distribution. 14 | 15 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 16 | ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 17 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 18 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 19 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 20 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 21 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 22 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 23 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 24 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | } 26 | Tabs: 4 27 | ] 28 | 29 | 30 | #define integer32! integer! 31 | 32 | ; FIXME: 33 | #define unsigned32! integer! 34 | #define integer16! integer! 35 | #define unsigned16! integer! 36 | #define integer64! float! 37 | 38 | integer16-reference!: alias struct! [ 39 | low [byte!] ; FIXME: reversed for big-endian 40 | high [byte!] 41 | ] 42 | integer64-reference!: alias struct! [ 43 | low [unsigned32!] ; FIXME: reversed for big-endian 44 | high [integer32!] 45 | ] 46 | 47 | #define variant! integer! 48 | #define opaque! [struct! [dummy [variant!]]] 49 | handle!: alias opaque! 50 | #define as-handle [as handle! ] 51 | #define binary! [pointer! [byte!]] 52 | #define as-binary [as binary! ] 53 | 54 | handle-reference!: alias struct! [value [handle!]] 55 | binary-reference!: alias struct! [value [binary!]] 56 | string-reference!: alias struct! [value [c-string!]] 57 | 58 | 59 | #define none? [null = ] 60 | 61 | #define free-any [free as-binary ] 62 | 63 | 64 | ; C types 65 | 66 | #define unsigned! integer! 67 | #define long! integer! 68 | #define unsigned-long! integer! 69 | #define enum! integer! 70 | #define double! float! 71 | 72 | #define size! integer! 73 | file!: alias opaque! 74 | 75 | argument-list!: alias struct! [item [integer!]] 76 | 77 | 78 | ; Limits for GNU (Syllable, Linux) 79 | ; TODO: check for other systems 80 | 81 | ; 32 bits 82 | #define min-long -2147483648 ; LONG_MIN 83 | #define max-long 7FFFFFFFh ; 2147483647, LONG_MAX 84 | #define max-unsigned-long FFFFFFFFh ; 4294967295, ULONG_MAX 85 | 86 | ; 64 bits 87 | ;#define min-long -9223372036854775808 ; LONG_MIN 88 | ;#define max-long 9223372036854775807 ; 7FFFFFFFFFFFFFFFh, LONG_MAX 89 | ;#define max-unsigned-long 18446744073709551615 ; FFFFFFFFFFFFFFFFh, ULONG_MAX 90 | -------------------------------------------------------------------------------- /common/examples/empty.red: -------------------------------------------------------------------------------- 1 | Red [] 2 | -------------------------------------------------------------------------------- /common/examples/hello-Unicode.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "Minimal test script" 3 | Author: "Nenad Rakocevic" 4 | Rights: "Copyright (c) 2012 Nenad Rakocevic. All rights reserved." 5 | License: { 6 | Distributed under the Boost Software License, version 1.0. 7 | See https://github.com/dockimbel/Red/blob/master/red-system/runtime/BSL-License.txt 8 | } 9 | Needs: "Red/System" 10 | Tabs: 4 11 | ] 12 | 13 | print-line "Hello, world!" 14 | print-line "Χαῖρε, κόσμε!" 15 | print-line "你好, 世界" 16 | print-line "Dobrý den světe" 17 | -------------------------------------------------------------------------------- /common/examples/red-base.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | Title: "Baseline Red distribution" 3 | Author: ["Nenad Rakocevic" "Kaj de Vos"] 4 | Rights: "Copyright (c) 2012-2013 Nenad Rakocevic. All rights reserved." 5 | License: { 6 | Distributed under the Boost Software License, Version 1.0. 7 | See https://github.com/dockimbel/Red/blob/master/BSL-License.txt 8 | } 9 | Needs: { 10 | %C-library/input-output.red 11 | %console.red 12 | %C-library/ANSI.red 13 | %TNetStrings/TNetStrings.red 14 | %JSON/JSON.red 15 | } 16 | Tabs: 4 17 | ] 18 | 19 | 20 | #include %../../C-library/input-output.red 21 | 22 | ; Extras 23 | #include %../../C-library/ANSI.red 24 | #include %../../TNetStrings/TNetStrings.red 25 | #include %../../JSON/JSON.red 26 | 27 | #include %console.red 28 | -------------------------------------------------------------------------------- /common/examples/red-core-message.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | Title: "Core command-line/server Red distribution with messaging" 3 | Author: ["Nenad Rakocevic" "Kaj de Vos"] 4 | Rights: "Copyright (c) 2012-2013 Nenad Rakocevic. All rights reserved." 5 | License: { 6 | Distributed under the Boost Software License, Version 1.0. 7 | See https://github.com/dockimbel/Red/blob/master/BSL-License.txt 8 | } 9 | Needs: { 10 | %common/input-output.red 11 | %console.red 12 | %C-library/ANSI.red 13 | %SQLite/SQLite.red 14 | %ZeroMQ-binding/ZeroMQ-binding.red 15 | %TNetStrings/TNetStrings.red 16 | %JSON/JSON.red 17 | } 18 | Tabs: 4 19 | ] 20 | 21 | 22 | #include %../input-output.red 23 | 24 | ; Extras 25 | #include %../../C-library/ANSI.red 26 | #include %../../SQLite/SQLite.red 27 | #include %../../ZeroMQ-binding/ZeroMQ-binding.red 28 | #include %../../TNetStrings/TNetStrings.red 29 | #include %../../JSON/JSON.red 30 | 31 | #include %console.red 32 | -------------------------------------------------------------------------------- /common/examples/red-core.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | Title: "Core command-line/server Red distribution" 3 | Author: ["Nenad Rakocevic" "Kaj de Vos"] 4 | Rights: "Copyright (c) 2012-2013 Nenad Rakocevic. All rights reserved." 5 | License: { 6 | Distributed under the Boost Software License, Version 1.0. 7 | See https://github.com/dockimbel/Red/blob/master/BSL-License.txt 8 | } 9 | Needs: { 10 | %common/input-output.red 11 | %console.red 12 | %C-library/ANSI.red 13 | %SQLite/SQLite.red 14 | %TNetStrings/TNetStrings.red 15 | %JSON/JSON.red 16 | } 17 | Tabs: 4 18 | ] 19 | 20 | 21 | #include %../input-output.red 22 | 23 | ; Extras 24 | #include %../../C-library/ANSI.red 25 | #include %../../SQLite/SQLite.red 26 | #include %../../TNetStrings/TNetStrings.red 27 | #include %../../JSON/JSON.red 28 | 29 | #include %console.red 30 | -------------------------------------------------------------------------------- /common/examples/red-message.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | Title: "Graphical Red distribution with messaging" 3 | Author: ["Nenad Rakocevic" "Kaj de Vos"] 4 | Rights: "Copyright (c) 2012-2013 Nenad Rakocevic. All rights reserved." 5 | License: { 6 | Distributed under the Boost Software License, Version 1.0. 7 | See https://github.com/dockimbel/Red/blob/master/BSL-License.txt 8 | } 9 | Needs: { 10 | %common/input-output.red 11 | %console.red 12 | %C-library/ANSI.red 13 | %SQLite/SQLite.red 14 | %ZeroMQ-binding/ZeroMQ-binding.red 15 | %GTK/GTK.red 16 | %TNetStrings/TNetStrings.red 17 | %JSON/JSON.red 18 | } 19 | Tabs: 4 20 | ] 21 | 22 | 23 | #include %../input-output.red 24 | 25 | ; Extras 26 | #include %../../C-library/ANSI.red 27 | #include %../../SQLite/SQLite.red 28 | #include %../../ZeroMQ-binding/ZeroMQ-binding.red 29 | #include %../../GTK/GTK.red 30 | #include %../../TNetStrings/TNetStrings.red 31 | #include %../../JSON/JSON.red 32 | 33 | #include %console.red 34 | -------------------------------------------------------------------------------- /common/examples/red.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | Title: "Graphical Red distribution" 3 | Author: ["Nenad Rakocevic" "Kaj de Vos"] 4 | Rights: "Copyright (c) 2012-2013 Nenad Rakocevic. All rights reserved." 5 | License: { 6 | Distributed under the Boost Software License, Version 1.0. 7 | See https://github.com/dockimbel/Red/blob/master/BSL-License.txt 8 | } 9 | Needs: { 10 | %common/input-output.red 11 | %console.red 12 | %C-library/ANSI.red 13 | %SQLite/SQLite.red 14 | %GTK/GTK.red 15 | %TNetStrings/TNetStrings.red 16 | %JSON/JSON.red 17 | } 18 | Tabs: 4 19 | ] 20 | 21 | 22 | #include %../input-output.red 23 | 24 | ; Extras 25 | #include %../../C-library/ANSI.red 26 | #include %../../SQLite/SQLite.red 27 | #include %../../GTK/GTK.red 28 | #include %../../TNetStrings/TNetStrings.red 29 | #include %../../JSON/JSON.red 30 | 31 | #include %console.red 32 | -------------------------------------------------------------------------------- /common/input-output.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | Title: "Input/Output" 3 | Author: "Kaj de Vos" 4 | Rights: "Copyright (c) 2013,2014 Kaj de Vos. All rights reserved." 5 | License: { 6 | Redistribution and use in source and binary forms, with or without modification, 7 | are permitted provided that the following conditions are met: 8 | 9 | * Redistributions of source code must retain the above copyright notice, 10 | this list of conditions and the following disclaimer. 11 | * Redistributions in binary form must reproduce the above copyright notice, 12 | this list of conditions and the following disclaimer in the documentation 13 | and/or other materials provided with the distribution. 14 | 15 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 16 | ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 17 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 18 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 19 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 20 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 21 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 22 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 23 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 24 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | } 26 | Needs: { 27 | Red > 0.4.3 28 | %common/input-output.reds 29 | %common/common.red 30 | } 31 | Tabs: 4 32 | ] 33 | 34 | 35 | #system-global [#include %input-output.reds] 36 | #include %common.red 37 | 38 | 39 | read: routine ["Read file." 40 | name [string!] ; [file! url!] 41 | ; return: [string! none!] 42 | /local file data 43 | ][ 44 | file: to-local-file name 45 | data: system/words/read file 46 | free-any file 47 | 48 | either none? data [ 49 | RETURN_NONE 50 | ][ 51 | SET_RETURN ((string/load data (length? data) + 1 UTF-8)) 52 | ; free data 53 | ] 54 | ] 55 | 56 | write: routine ["Write file." 57 | name [string!] ; [file! url!] 58 | data [string!] 59 | return: [logic!] 60 | /local file out ok? 61 | ][ 62 | file: to-local-file name 63 | out: to-UTF8 data 64 | 65 | ok?: write-string file out 66 | 67 | free-any out 68 | free-any file 69 | ok? 70 | ] 71 | 72 | 73 | comment { 74 | 75 | load**: :load 76 | 77 | load: function ["Return a value or block of values by loading a source." 78 | source [string! file!] 79 | /all "Always return a block." 80 | /into "Insert result into existing block." 81 | out [block!] "Result buffer" 82 | ][ 83 | if file? source [source: read source] 84 | 85 | either source [ 86 | either all [ 87 | either into [ 88 | do [load**/all/into source out] 89 | ][ 90 | do [load**/all source] 91 | ] 92 | ][ 93 | either into [ 94 | do [load**/into source out] 95 | ][ 96 | do [load** source] 97 | ] 98 | ] 99 | ][ 100 | none 101 | ] 102 | ] 103 | 104 | } 105 | 106 | context [ 107 | do*: :do 108 | result: make block! 1 ; WARN: not thread safe 109 | 110 | set 'do function ["Execute code from a source." 111 | source 112 | ][ 113 | if any [file? source url? source] [source: read source] 114 | 115 | first head reduce/into dummy: [do* source] clear result ; Force use of interpreter 116 | ] 117 | ] 118 | -------------------------------------------------------------------------------- /common/input-output.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "Input/Output" 3 | Author: "Kaj de Vos" 4 | Rights: "Copyright (c) 2013 Kaj de Vos. All rights reserved." 5 | License: { 6 | Redistribution and use in source and binary forms, with or without modification, 7 | are permitted provided that the following conditions are met: 8 | 9 | * Redistributions of source code must retain the above copyright notice, 10 | this list of conditions and the following disclaimer. 11 | * Redistributions in binary form must reproduce the above copyright notice, 12 | this list of conditions and the following disclaimer in the documentation 13 | and/or other materials provided with the distribution. 14 | 15 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 16 | ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 17 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 18 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 19 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 20 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 21 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 22 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 23 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 24 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | } 26 | Needs: { 27 | %C-library/ANSI.reds 28 | %cURL/cURL.reds 29 | } 30 | Tabs: 4 31 | ] 32 | 33 | 34 | #include %../C-library/ANSI.reds 35 | #include %../cURL/cURL.reds 36 | 37 | 38 | read: function ["Read text file." 39 | name [c-string!] 40 | return: [c-string!] 41 | ][ 42 | case [ 43 | none? name [ 44 | null 45 | ] 46 | zero? compare-string-part name "file:" 5 [ 47 | read-file name + 5 48 | ] 49 | as-logic find-string name "://" [ 50 | read-url name 51 | ] 52 | yes [ 53 | read-file name 54 | ] 55 | ] 56 | ] 57 | 58 | write-string: function ["Write text file." 59 | name [c-string!] 60 | text [c-string!] 61 | return: [logic!] 62 | ][ 63 | case [ 64 | none? name [ 65 | no 66 | ] 67 | zero? compare-string-part name "file:" 5 [ 68 | write-file name + 5 text 69 | ] 70 | as-logic find-string name "://" [ 71 | write-url name text 72 | ] 73 | yes [ 74 | write-file name text 75 | ] 76 | ] 77 | ] 78 | -------------------------------------------------------------------------------- /download.r: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env rebol 2 | REBOL [ 3 | Title: "Download or update all Red(/System) extensions" 4 | Author: "Kaj de Vos" 5 | Rights: "Copyright (c) 2013,2014 Kaj de Vos" 6 | License: { 7 | PD/CC0 8 | http://creativecommons.org/publicdomain/zero/1.0/ 9 | } 10 | _Needs: { 11 | REBOL 2.7.8 or 3 (http://www.rebolsource.net) 12 | Fossil (http://www.fossil-scm.org/download.html) 13 | } 14 | Tabs: 4 15 | ] 16 | 17 | credentials: "" ; Anonymous access / "check+out+user[:password]" 18 | user: "" ; Anonymous access / "check-in user" 19 | 20 | fossil: either any [exists? %fossil exists? %fossil.exe] [ 21 | to-local-file append what-dir %fossil 22 | ][ 23 | "fossil" 24 | ] 25 | 26 | foreach target [ 27 | %test 28 | %common 29 | %C-library 30 | %cURL 31 | %ZeroMQ-binding 32 | %REBOL-3 33 | %Java 34 | %SQLite 35 | %SDL 36 | %OpenGL 37 | %GLib 38 | %GTK 39 | %GTK-WebKit 40 | %OSM-GPS-Map 41 | %GTK-Champlain 42 | %TNetStrings 43 | %JSON 44 | %6502 45 | ][ 46 | print [newline "Target" target] 47 | 48 | either exists? target [ 49 | change-dir target 50 | 51 | unless zero? call/wait probe join fossil " update" [ 52 | print ["Updating" target "failed"] 53 | ] 54 | change-dir %.. 55 | ][ 56 | either any [ 57 | exists? archive: join name: join %Red- target %.fossil 58 | ( 59 | link: rejoin [http:// 60 | either empty? credentials [""] [join credentials "@"] 61 | %red.esperconsultancy.nl/ name 62 | ] 63 | zero? call/wait probe reform [ 64 | fossil "clone" 65 | either empty? user [""] [rejoin ["--admin-user '" user "'"]] 66 | link archive 67 | ] 68 | )( 69 | print ["Downloading" link "failed"] 70 | no 71 | ) 72 | ][ 73 | make-dir target 74 | change-dir target 75 | 76 | unless zero? call/wait probe rejoin [fossil " open ../" archive] [ 77 | print ["Opening" archive "failed"] 78 | ] 79 | change-dir %.. 80 | ][ 81 | print ["Database" archive "not available"] 82 | ] 83 | ] 84 | ] 85 | --------------------------------------------------------------------------------