├── Apps └── README.md ├── Library ├── 3D-math │ ├── matrix-float32.reds │ └── vector-float32.reds ├── Bass │ ├── README.md │ ├── bass-record-test.reds │ ├── bass-test.red │ ├── bass-test.reds │ ├── bass.red │ └── bass.reds ├── Curses │ ├── README.md │ ├── curses-linux.reds │ ├── curses-win32.reds │ ├── curses.reds │ ├── examples │ │ ├── curses-example.reds │ │ └── panel-example.reds │ └── panel.reds ├── FMOD │ ├── FMOD-test.reds │ ├── FMOD.reds │ └── README.md ├── GLFW │ ├── README.md │ └── glfw3.reds ├── ImageMagick │ ├── ImageMagick-test.red │ ├── ImageMagick.red │ ├── ImageMagick.reds │ └── README.md ├── Julia │ ├── Julia-test.red │ ├── Julia-test.reds │ ├── Julia.red │ └── Julia.reds ├── LZMA │ ├── README.md │ ├── lzma-test.reds │ └── lzma.reds ├── OpenGL │ ├── examples │ │ ├── common.reds │ │ ├── gl-clipboard.reds │ │ ├── gl-info.reds │ │ ├── gl-triangle.reds │ │ ├── gl-windows.reds │ │ ├── gl3-cube-colored-2.reds │ │ ├── gl3-cube-colored.reds │ │ ├── gl3-triangle-2.reds │ │ ├── gl3-triangle-3.reds │ │ ├── gl3-triangle-4.reds │ │ └── gl3-triangle.reds │ ├── extensions │ │ ├── egl.reds │ │ ├── gl-3DFX.reds │ │ ├── gl-AMD.reds │ │ ├── gl-ANDROID.reds │ │ ├── gl-ANGLE.reds │ │ ├── gl-APPLE.reds │ │ ├── gl-ARB.reds │ │ ├── gl-ARM.reds │ │ ├── gl-ATI.reds │ │ ├── gl-ATIX.reds │ │ ├── gl-EGL.reds │ │ ├── gl-EXT.reds │ │ ├── gl-GREMEDY.reds │ │ ├── gl-HP.reds │ │ ├── gl-IBM.reds │ │ ├── gl-INGR.reds │ │ ├── gl-INTEL.reds │ │ ├── gl-KHR.reds │ │ ├── gl-KTX.reds │ │ ├── gl-MESA.reds │ │ ├── gl-MESAX.reds │ │ ├── gl-NV.reds │ │ ├── gl-NVX.reds │ │ ├── gl-OES.reds │ │ ├── gl-OML.reds │ │ ├── gl-OVR.reds │ │ ├── gl-PGI.reds │ │ ├── gl-QCOM.reds │ │ ├── gl-REGAL.reds │ │ ├── gl-REND.reds │ │ ├── gl-S3.reds │ │ ├── gl-SGI.reds │ │ ├── gl-SGIS.reds │ │ ├── gl-SGIX.reds │ │ ├── gl-SUN.reds │ │ ├── gl-SUNX.reds │ │ ├── gl-WIN.reds │ │ ├── glx.reds │ │ └── wgl.reds │ ├── gl-extensions.reds │ ├── gl.reds │ └── gl3-common.reds ├── Portaudio │ ├── examples │ │ ├── pa-info.reds │ │ ├── pa-record.reds │ │ ├── pa-saw-synth.reds │ │ ├── pa-saw.reds │ │ ├── pa-sine.reds │ │ └── pa-write-sine.reds │ └── portaudio.reds ├── README.md ├── Red │ ├── libred-test.reds │ └── red.reds ├── SQLite │ ├── README.md │ ├── SQLite3-test-basic.reds │ ├── SQLite3-test.red │ ├── SQLite3-test.reds │ ├── SQLite3.red │ └── SQLite3.reds ├── SWF │ ├── swf-io.red │ ├── swf-io.reds │ ├── swf-tool.red │ └── swf-tool.reds ├── Sockets │ ├── examples │ │ ├── get-local-ip.reds │ │ ├── read-url.reds │ │ ├── tcp-client.reds │ │ ├── tcp-server.reds │ │ ├── udp-client.reds │ │ └── udp-server.reds │ ├── sockets-core.reds │ └── sockets.reds ├── Steam │ ├── README.md │ ├── Steam-test.red │ ├── Steam-test.reds │ ├── Steam.red │ ├── Steam.reds │ └── SteamAPI │ │ ├── Steam-API.reds │ │ ├── Steam-AppList.reds │ │ ├── Steam-Apps.reds │ │ ├── Steam-Client.reds │ │ ├── Steam-Controller.reds │ │ ├── Steam-Friends.reds │ │ ├── Steam-GameServer.reds │ │ ├── Steam-GameServerStats.reds │ │ ├── Steam-HTMLSurface.reds │ │ ├── Steam-HTTP.reds │ │ ├── Steam-Inventory.reds │ │ ├── Steam-Matchmaking.reds │ │ ├── Steam-MatchmakingServers.reds │ │ ├── Steam-Music.reds │ │ ├── Steam-MusicRemote.reds │ │ ├── Steam-Networking.reds │ │ ├── Steam-RemoteStorage.reds │ │ ├── Steam-Screenshots.reds │ │ ├── Steam-UGC.reds │ │ ├── Steam-UnifiedMessages.reds │ │ ├── Steam-User.reds │ │ ├── Steam-UserStats.reds │ │ ├── Steam-Utils.reds │ │ ├── Steam-Video.reds │ │ └── Steam-enums.reds ├── Stream-IO │ ├── Stream-IO-carry.reds │ ├── Stream-IO-core.reds │ ├── Stream-IO-read.reds │ ├── Stream-IO-skip.reds │ ├── Stream-IO-write.reds │ ├── Stream-IO.reds │ ├── examples │ │ └── Stream-IO-test.reds │ └── simple-io-minimal.reds ├── Vorbis │ ├── examples │ │ └── vorbis-decoder.reds │ └── vorbis.reds ├── Vulkan │ ├── README.md │ ├── examples │ │ ├── common.reds │ │ └── vk-info.reds │ └── vulkan.reds ├── ZLib │ ├── README.md │ ├── examples │ │ ├── zlib-disk-example.reds │ │ └── zlib-mem-example.reds │ └── zlib.reds ├── ZeroMQ │ ├── ZeroMQ-Hello-client.reds │ ├── ZeroMQ-Hello-server.red │ ├── ZeroMQ-Hello-server.reds │ └── ZeroMQ.reds ├── dotNET │ ├── README.md │ ├── bridge.red │ ├── test-svg.red │ ├── test-wpf.red │ └── test.svg ├── dtoa │ ├── README.md │ ├── dtoa-test.red │ └── dtoa.reds ├── mpg123 │ ├── mpg123-info.reds │ └── mpg123.reds ├── ogg │ ├── examples │ │ └── ogg-decode.reds │ └── ogg.reds └── os │ ├── datatypes │ ├── c-string.reds │ ├── typed-array.reds │ └── url.reds │ ├── definitions.reds │ ├── key-hit.reds │ ├── linux.reds │ ├── time-elapsed.red │ ├── time-elapsed.reds │ ├── wait.reds │ └── windows.reds ├── README.md ├── Screenshots ├── scripts.png └── showcase.png ├── Scripts ├── README.md ├── a-an │ ├── a-an-grammatical.red │ └── cs.txt ├── analog-clock.red ├── bubbles.red ├── cadadaverous.red ├── capture-demo.red ├── clock.red ├── gradient-lab.red ├── lexer │ ├── README.md │ ├── count-types.red │ ├── flatten.red │ ├── get-comments.red │ ├── load-commas.red │ ├── longest.red │ └── unique-words.red ├── mandelbrot-fast.red ├── mandelbrot.red ├── palette.red ├── particles.red ├── perlin.red ├── reactive │ ├── bmr-calc.red │ ├── color-sliders-mini.red │ ├── color-sliders.red │ ├── spline.red │ └── worm.red ├── resize-image.red ├── resize-image2.red ├── spiral.red ├── starfield.red └── tiger.red └── Showcase ├── README.md ├── ballots ├── ballots.red └── images │ ├── ballot_approval.png │ ├── ballot_box.png │ ├── ballot_fptp.png │ ├── ballot_range.png │ ├── ballot_ranked.png │ └── ballot_rate.png ├── calculator.red ├── ellipse.red ├── eve-clock.red ├── last-commits.red ├── last-commits2.red ├── last-commits3.red ├── livecode.red ├── picosheet.red ├── puppy-finder.red └── tile-game.red /Apps/README.md: -------------------------------------------------------------------------------- 1 | # Apps 2 | 3 | Complete applications, any domain accepted (tools, games, demos,...). -------------------------------------------------------------------------------- /Library/3D-math/vector-float32.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "Red/System 3D-math - vector related code (float32! version)" 3 | Author: "Oldes" 4 | File: %vector-float32.reds 5 | Rights: "Copyright (C) 2017 David 'Oldes' Oliva. All rights reserved." 6 | License: "BSD-3 - https:;//github.com/red/red/blob/master/BSD-3-License.txt" 7 | ] 8 | #define TO_RADIANS(value) [pi * value / 180.0] 9 | 10 | #define FLOAT32_NEGATE [(as float32! 0.0) -] 11 | #define FLOAT32_ZERO? [(as float32! 0.0) =] 12 | 13 | vec3f!: alias struct! [x [float32!] y [float32!] z [float32!]] 14 | vec4f!: alias struct! [x [float32!] y [float32!] z [float32!] w [float32!]] 15 | 16 | vec3f: context [ 17 | make: func[ 18 | x [float!] 19 | y [float!] 20 | z [float!] 21 | return: [vec3f!] 22 | /local v 23 | ][ 24 | v: as vec3f! allocate size? vec3f! 25 | v/x: as float32! x 26 | v/y: as float32! y 27 | v/z: as float32! z 28 | v 29 | ] 30 | 31 | assign: func[ 32 | out [vec3f!] 33 | in [vec3f!] 34 | return: [vec3f!] 35 | ][ 36 | out/x: in/x out/y: in/y out/z: in/z 37 | out 38 | ] 39 | 40 | length: func[ 41 | in [vec3f!] 42 | return: [float32!] 43 | ][ 44 | as float32! sqrt as float! ((in/x * in/x) + (in/y * in/y) + (in/z * in/z)) 45 | ] 46 | 47 | add: func[ 48 | out [vec3f!] 49 | v1 [vec3f!] 50 | v2 [vec3f!] 51 | return: [vec3f!] 52 | ][ 53 | out/x: v1/x + v2/x 54 | out/y: v1/y + v2/y 55 | out/z: v1/z + v2/z 56 | out 57 | ] 58 | 59 | subtract: func[ 60 | out [vec3f!] 61 | v1 [vec3f!] 62 | v2 [vec3f!] 63 | return: [vec3f!] 64 | ][ 65 | out/x: v1/x - v2/x 66 | out/y: v1/y - v2/y 67 | out/z: v1/z - v2/z 68 | out 69 | ] 70 | 71 | normalize: func[ 72 | out [vec3f!] 73 | in [vec3f!] 74 | return: [vec3f!] 75 | /local len tmp 76 | ][ 77 | len: length in 78 | print-line ["len: " len " " in/x in/y in/z] 79 | either len < as float32! 0.00001 [ 80 | assign out in 81 | ][ 82 | ;len: as float32! 1.0 / len 83 | out/x: in/x / len 84 | out/y: in/y / len 85 | out/z: in/z / len 86 | ] 87 | out 88 | ] 89 | 90 | cross: func[ 91 | out [vec3f!] 92 | v1 [vec3f!] 93 | v2 [vec3f!] 94 | return: [vec3f!] 95 | /local tmp 96 | ][ 97 | tmp: declare vec3f! ;used because `out` may be same lake one of the input vectors 98 | tmp/x: (v1/y * v2/z) - (v1/z * v2/y) 99 | tmp/y: (v1/z * v2/x) - (v1/x * v2/z) 100 | tmp/z: (v1/x * v2/y) - (v1/y * v2/x) 101 | copy-memory (as byte-ptr! out) (as byte-ptr! tmp) size? vec3f! 102 | out 103 | ] 104 | 105 | dot: func[ 106 | v1 [vec3f!] 107 | v2 [vec3f!] 108 | return: [float32!] 109 | ][ 110 | (v1/x * v2/x) + (v1/y * v2/y) + (v1/z * v2/z) 111 | ] 112 | 113 | trace: func[ 114 | v [vec3f!] 115 | ][ 116 | ;printf needs C decimal values, so we must cast float32! to float! 117 | printf ["%.3f^-%.3f^-%.3f^/" as float! v/x as float! v/y as float! v/z] 118 | ] 119 | ] -------------------------------------------------------------------------------- /Library/Bass/README.md: -------------------------------------------------------------------------------- 1 | # BASS audio library binding for Red/System 2 | 3 | Purpose of the file [bass.reds](Bass/bass.reds) is to provide low level access to [BASS Audio API](http://www.un4seen.com/bass.html) functions from Red/System. 4 | 5 | So far there is just simple Red/System test script [bass-test.reds](Bass/bass-test.reds) 6 | 7 | This Binding was created using semi-automatic script, so not everything is guaranteed to work. Also I never used BASS API yet, so 8 | this is a new playground for me (Oldes). 9 | 10 | So far there is support only for Windows. Tested with version 2.4.12. -------------------------------------------------------------------------------- /Library/Bass/bass-record-test.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "Red/System BASS binding - recording test" 3 | Author: "Oldes" 4 | File: %bass-record-test.reds 5 | Rights: "Copyright (C) 2017 David 'Oldes' Oliva. All rights reserved." 6 | License: "BSD-3 - https://github.com/red/red/blob/master/BSD-3-License.txt" 7 | 8 | ] 9 | 10 | #include %../os/wait.reds 11 | #include %../os/key-hit.reds 12 | 13 | BASS: context [ 14 | 15 | #include %bass.reds 16 | 17 | if false = BASS_Init -1 44100 BASS_DEVICE_3D 0 null [ 18 | print ["BASS Error [" BASS_ErrorGetCode "]: Can't initialize device!" lf] 19 | quit 1 20 | ] 21 | 22 | i: 0 n: 0 23 | 24 | di: declare BASS_DEVICEINFO! 25 | 26 | print-line "^/BASS_RecordGetDeviceInfo:" 27 | while [BASS_RecordGetDeviceInfo n di][ 28 | print ["Device " n lf] 29 | print [" name__: " di/name lf] 30 | print [" driver: " di/driver lf] 31 | print [" flags_: " as byte-ptr! di/flags lf] 32 | print [" enabled? " as logic! (di/flags and BASS_DEVICE_ENABLED) lf] 33 | print [" microphone? " ((di/flags and BASS_DEVICE_TYPE_MASK) = BASS_DEVICE_TYPE_MICROPHONE) lf] 34 | n: n + 1 35 | ] 36 | 37 | print lf 38 | 39 | 40 | MyRecordProc: function [[stdcall] 41 | handle [HRECORD!] 42 | buffer [byte-ptr!] 43 | length [integer!] 44 | user [int-ptr!] 45 | return: [BOOL!] 46 | ][ 47 | print-line ["recording data " length] 48 | ;do something with data here 49 | true ;continue recording 50 | ] 51 | 52 | record: declare HRECORD! 53 | is-recording?: no 54 | 55 | if BASS_RecordInit -1 [ ; -1 = default device 56 | print-line ["Recording possible... devices: " n] 57 | 58 | ;Start recording at 44100 Hz stereo 16-bit. 59 | record: BASS_RecordStart 44100 2 0 :MyRecordProc null 60 | if 0 <> record [ 61 | print "recording started" 62 | is-recording?: yes 63 | ] 64 | ] 65 | 66 | print "^/Press ENTER to quit^/" 67 | print "Press '1' to toggle recording^/" 68 | 69 | print lf 70 | 71 | key: 0 72 | err: 0 73 | 74 | forever [ ;Main loop 75 | if key-hit [ 76 | key: key-hit-char 77 | switch key [ 78 | 13 [ break ] ;pressed ENTER 79 | #"1" [ 80 | either is-recording? [ 81 | BASS_ChannelPause record 82 | print-line "Recording paused..." 83 | ][ 84 | BASS_ChannelPlay record yes 85 | print-line "Recording resumed..." 86 | ] 87 | is-recording?: not is-recording? 88 | ] 89 | default [true] 90 | ] 91 | err: BASS_ErrorGetCode 92 | if err > 0 [ print-line ["BASS Error [" err "]"] ] 93 | ] 94 | wait 10 95 | ] 96 | BASS_Stop 97 | BASS_RecordFree 98 | BASS_Free 99 | ] 100 | -------------------------------------------------------------------------------- /Library/Bass/bass-test.red: -------------------------------------------------------------------------------- 1 | Red [] 2 | 3 | #include %bass.red 4 | 5 | ;-- here are media files used in the test 6 | media: [%jaguar.wav %drumloop.wav] 7 | ;-- download them if not exists... 8 | foreach file media [ 9 | unless exists? file [ 10 | url: rejoin [https://github.com/Oldes/media/blob/master/ file] 11 | print ["Downloading file:" mold file "from:" url] 12 | write/binary file read/binary rejoin [url %?raw=true] 13 | ] 14 | ] 15 | ;-- downloading MOD file if not exists.. 16 | unless exists? file: %feroness_-_sun.mod [ 17 | url: https://api.modarchive.org/downloads.php?moduleid=179764#feroness_-_sun.mod 18 | print ["Downloading file:" mold file "from:" url] 19 | write/binary file read/binary url 20 | ] 21 | 22 | 23 | 24 | bass/init ;Initializes a sound output device using default values 25 | 26 | bass/do [ 27 | sound: load %jaguar.wav ;sound can be loaded from file 28 | drum: load %drumloop.wav [loop fx volume: 0] ;optional default settings can be specified 29 | music: load %feroness_-_sun.mod ;loads MOD file 30 | channel: play music [volume: 0] ;channel can be stored for later use, optional block with settings can be used 31 | fade channel [volume: 0.3] 0:0:20 ;it is possible to fade some values in time 32 | play sound [volume: 0.4 pan: -1] ;or not if not needed 33 | loop: play drum [volume: 1] 0:0:10 ;fade is possible to set even during 'play' command 34 | ] 35 | wait 10 36 | bass/do [ 37 | ;handles can be passed also as get-words 38 | play :sound [pan: 1] 39 | fade :loop [pan: -1] 2000 ;fade time can be specified also using integer! (number of ms) or float! (number of seconds) 40 | fade channel [volume: 0] 0.5 41 | 42 | ] 43 | wait 3 44 | bass/do [ 45 | pause channel 46 | fade :loop [pan: 1] 2000 47 | ] 48 | wait 3 49 | bass/do [ 50 | fade :loop [pan: 0 volume: 0 freq: 6000] 0:0:6 51 | ] 52 | wait 6 53 | bass/do [ 54 | resume channel [volume: 1 bpm: 90] 0:0:5 55 | ] 56 | wait 4 57 | 58 | effects: [ 59 | chorus 60 | compressor 61 | distortion 62 | echo 63 | flanger 64 | gargle 65 | parameq 66 | reverb 67 | reverb-3D 68 | ] 69 | 70 | foreach effect effects [ 71 | print ["Enabling effect:" effect] 72 | bass/do compose [ 73 | fx: (effect) channel 74 | ] 75 | wait 6 76 | print ["Disabling effect:" effect] 77 | bass/do [stop fx] 78 | wait 4 79 | ] 80 | 81 | bass/do [ 82 | play sound 83 | fade channel [volume: 0 bpm: 125] 3000 84 | ] 85 | wait 3 86 | 87 | 88 | bass/free ;Frees all resources used by the output device, including all its samples, streams and MOD musics. 89 | 90 | print "end of test" 91 | wait 1 -------------------------------------------------------------------------------- /Library/Curses/README.md: -------------------------------------------------------------------------------- 1 | Curses library for Red/System 2 | ------------------------ 3 | 4 | This is a low level binding for Curses and Panel libraries. 5 | 6 | Curses for Red/System now uses wide-characters library (libncursesw.so). 7 | 8 | Requirements 9 | ------------ 10 | 11 | * **Linux** 12 | 13 | *libncursesw 5.9* : available with your favorite distro. 14 | 15 | *libpanelw 5.9* : available with your favorite distro. 16 | 17 | * **Windows** 18 | 19 | *pdcurses.dll* : [Public Domain Curses for windows](http://sourceforge.net/projects/pdcurses/files/), version 3.4 : [pdc34dllu.zip](http://sourceforge.net/projects/pdcurses/files/pdcurses/3.4/pdc34dllu.zip/download) 20 | 21 | The panel library is include in PDCurses. 22 | 23 | * **MacOSX** 24 | 25 | Help needed to check the right library name, write `%curses-macosx.reds` (may be identical to `%curses-linux.reds`) and test. 26 | 27 | Running the Red/System curses examples 28 | ------------------------ 29 | 30 | 1. This binding is provided with two examples for curses and panel libraries. 31 | 32 | 1. Compile with Red 33 | `$ red -c system/library/curses/examples/curses-example.reds` 34 | 35 | `$ red -c system/library/curses/examples/panel-example.reds` 36 | 37 | 1. From the REBOL console type : 38 | 39 | `do/args %red.r "%system/library/curses/examples/curses-example.reds"`, the compilation process should finish with a `...output file size` message. 40 | 41 | `do/args %red.r "%system/library/curses/examples/panel-example.reds"`, the compilation process should finish with a `...output file size` message. 42 | 43 | 1. The resulting binaries are in Red main directory, go try them! 44 | 45 | Linux users run `curses-example` or `panel-example` from command line. 46 | 47 | Windows users need to open a DOS console and run `curses-example.exe` or `panel-example.exe` from there. 48 | 49 | -------------------------------------------------------------------------------- /Library/Curses/panel.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "panel Binding" 3 | Author: "Bruno Anselme" 4 | EMail: "be.red@free.fr" 5 | File: %panel.reds 6 | Rights: "Copyright (c) 2013-2015 Bruno Anselme" 7 | License: { 8 | Distributed under the Boost Software License, Version 1.0. 9 | See https://github.com/red/red/blob/master/BSL-License.txt 10 | } 11 | Needs: { 12 | Red/System >= 0.3.1 13 | panel >= 5.9 (Linux) 14 | pdcurses >= 3.4 (Windows) 15 | } 16 | ] 17 | 18 | panel: context [ 19 | 20 | #define window! integer! 21 | #define panel! integer! 22 | 23 | #switch OS [ 24 | Windows [ #define panel-library "pdcurses.dll" ] 25 | macOS [ #define panel-library "panelw.dylib" ] ;-- TODO: check this 26 | #default [ #define panel-library "libpanelw.so.5" ] 27 | ] 28 | 29 | #import [panel-library cdecl [ 30 | new-panel: "new_panel" [ ;-- Allocates a PANEL structure, places the panel on the top of the stack. 31 | win [window!] 32 | return: [panel!] 33 | ] 34 | update-panels: "update_panels" [ ;-- Refreshes the virtual screen to reflect the panels in the stack, but does not call doupdate to refresh the physical screen. 35 | return: [integer!] 36 | ] 37 | hide-panel: "hide_panel" [ ;-- Removes the given panel from the panel stack and thus hides it from view. 38 | pan [panel!] 39 | return: [integer!] 40 | ] 41 | show-panel: "show_panel" [ ;-- Makes a hidden panel visible by placing it on top of the panels in the panel stack. 42 | pan [panel!] 43 | return: [integer!] 44 | ] 45 | del-panel: "del_panel" [ ;-- Removes the given panel from the stack and deallocates the PANEL structure (but not its associated window). 46 | pan [panel!] 47 | return: [integer!] 48 | ] 49 | top-panel: "top_panel" [ ;-- Puts the given visible panel on top of all panels in the stack. 50 | pan [panel!] 51 | return: [integer!] 52 | ] 53 | bottom-panel: "bottom_panel" [ ;-- Puts panel at the bottom of all panels. 54 | pan [panel!] 55 | return: [integer!] 56 | ] 57 | panel-window: "panel_window" [ ;-- Returns a pointer to the window of the given panel. 58 | pan [panel!] 59 | return: [window!] 60 | ] 61 | panel-above: "panel_above" [ ;-- Returns a pointer to the panel above pan. 62 | pan [panel!] 63 | return: [panel!] 64 | ] 65 | panel-below: "panel_below" [ ;-- Returns a pointer to the panel just below pan. 66 | pan [panel!] 67 | return: [panel!] 68 | ] 69 | move-panel: "move_panel" [ ;-- Moves the given panel window so that its upper-left corner is at starty, startx. 70 | pan [panel!] 71 | starty [integer!] 72 | startx [integer!] 73 | return: [integer!] 74 | ] 75 | replace-panel: "replace_panel" [ ;-- Replaces the current window of panel with window. 76 | pan [panel!] 77 | win [window!] 78 | return: [integer!] 79 | ] 80 | panel-hidden: "panel_hidden" [ ;-- Returns TRUE if the panel is in the panel stack 81 | pan [panel!] 82 | return: [integer!] 83 | ] 84 | set-panel-userptr: "set_panel_userptr" [ ;-- Sets the panel’s user pointer. 85 | pan [panel!] 86 | data [int-ptr!] 87 | return: [integer!] 88 | ] 89 | panel-userptr: "panel_userptr" [ ;-- Returns the user pointer for a given panel. 90 | pan [panel!] 91 | return: [int-ptr!] 92 | ] 93 | ] ; cdecl 94 | ] ; #import [panel-library 95 | ] ; context panel 96 | -------------------------------------------------------------------------------- /Library/FMOD/README.md: -------------------------------------------------------------------------------- 1 | # FMOD Studio API binding for Red/System 2 | 3 | Purpose of the file [FMOD.reds](FMOD/FMOD.reds) is to provide low level access to [FMOD Studio API](http://www.fmod.com/api) functions from Red/System. 4 | 5 | 6 | So far there is just simple Red/System test script [FMOD-test.reds](FMOD/FMOD-test.reds) 7 | 8 | This Binding was created using semi-automatic script, so not everything is guaranteed to work. Also I never used FMOD API yet, so 9 | this is a new playground for me (Oldes). 10 | 11 | So far there is support only for Windows with **FMOD Studio API** version 1.09.01, which may be downloaded here http://www.fmod.org/download/#StudioAPI (requires registration) -------------------------------------------------------------------------------- /Library/GLFW/README.md: -------------------------------------------------------------------------------- 1 | # GLFW library binding for Red/System 2 | 3 | GLFW is a free, Open Source, multi-platform library for OpenGL, OpenGL ES and Vulkan application development. It provides a simple, platform-independent API for creating windows, contexts and surfaces, reading input, handling events, etc. 4 | 5 | More info: www.glfw.org 6 | 7 | For Red/System usage see [OpenGL examples](../OpenGL/examples/) or [Vulkan examples](../Vulkan/examples/) -------------------------------------------------------------------------------- /Library/ImageMagick/README.md: -------------------------------------------------------------------------------- 1 | # ImageMagick binding for Red and Red/System 2 | 3 | Purpose of file [ImageMagic.reds](ImageMagick/ImageMagick.reds) is to provide low level access to ImageMagick's functions in Red/System. 4 | Including file [ImageMagic.red](ImageMagick/ImageMagick.red) you get simple _Domain Specific Language_ (DSL) to access these functions 5 | in higher level _Red_ coding. Here is very basic example how it can be used: 6 | 7 | ```Red 8 | Red [] 9 | #include %ImageMagick.red 10 | iMagick [ 11 | read %opice.png ;-- loads PNG image with size 200x200 into MagicWand 12 | liquid-rescale 300x300 3.0 0.3 ;-- rescales image with seam carving. 13 | resize 200x200 lanczos 1 ;-- resize it back to original size using Lanczos filter 14 | write %opice.jpg ;-- save content of the MagicWand as JPG file 15 | ] 16 | ``` 17 | More examples can be found in this test file: [ImageMagick-test.red](ImageMagick/ImageMagick-test.red) 18 | 19 | #### Todo 20 | This is still work in progress... not all MagicWand functions have equivalent in `Red` binding and I still have to figure out, 21 | how to integrate `PixelWand` and `DrawingWand` functions. 22 | 23 | I should note, that I have actually no need to use this binding at this moment. I'm writing it mostly to learn some internals of 24 | Red - Red/System coding. So I'm pretty sure many things in this binding could be done better, so if you find something, feel free 25 | to improve it or let me know. 26 | 27 | #### Note 28 | Although original work started with ImageMagick v6, I started using the latest version 7, which is unfortunately *not backward compatible*. 29 | Code is so far tested on `Windows 7 & 10` with `ImageMagick-7.0.4-Q16`. 30 | -------------------------------------------------------------------------------- /Library/Julia/Julia-test.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | Title: "Red libjulia binding - test" 3 | Author: "Oldes" 4 | File: %Julia-test.red 5 | Tabs: 4 6 | Rights: "Copyright (C) 2017 Oldes. All rights reserved." 7 | License: { 8 | Distributed under the Boost Software License, Version 1.0. 9 | See https://github.com/red/red/blob/master/BSL-License.txt 10 | } 11 | Comment: { 12 | This script needs external library, which can be downloaded from this site: 13 | https://julialang.org/downloads/ 14 | } 15 | ] 16 | 17 | #include %Julia.red 18 | 19 | julia/init "c:\dev\Julia-0.5.2\bin\" ;change this line and compile! 20 | 21 | ;NOTE: print from Julia is not visible in Red's GUI-console 22 | result: julia/do { 23 | println("Hello Red, I'm Julia"); 24 | a = 6; b = 7; 25 | println("I can count: $(a) * $(b) = $(a * b)"); 26 | a * b; 27 | } 28 | 29 | print result 30 | print "Test end." -------------------------------------------------------------------------------- /Library/Julia/Julia-test.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "Red/System libjulia binding test" 3 | Author: "Oldes" 4 | File: %Julia-test.reds 5 | Tabs: 4 6 | Rights: "Copyright (C) 2017 Oldes. All rights reserved." 7 | License: { 8 | Distributed under the Boost Software License, Version 1.0. 9 | See https://github.com/red/red/blob/master/BSL-License.txt 10 | } 11 | Comment: { 12 | This script needs external library, which can be downloaded from this site: 13 | https://julialang.org/downloads/ 14 | } 15 | ] 16 | 17 | #include %Julia.reds 18 | 19 | main: func [ 20 | /local 21 | argument [str-array!] 22 | home-dir [c-string!] 23 | ret [jl-value!] 24 | ][ 25 | switch system/args-count [ 26 | 1 [ home-dir: "c:\dev\Julia-0.5.2\bin\"] 27 | 2 [ 28 | argument: system/args-list + 1 29 | home-dir: argument/item 30 | ] 31 | default [ 32 | print-line "Invalid number of arguments!" 33 | quit 0 34 | ] 35 | ] 36 | 37 | print-line ["Julia home dir: " home-dir] 38 | 39 | with julia [ 40 | print-line "Starting Julia..." 41 | jl_init home-dir ;julia's home dir (bin folder) 42 | if 1 <> jl_is_initialized [ 43 | print-line "Initialization failed!" 44 | quit 0 45 | ] 46 | ;jl_eval_string "versioninfo()" 47 | 48 | ;this is print from Julia: 49 | ret: jl_eval_string {println(string("sqrt(2.0) = ",sqrt(2.0)))} 50 | ;ret will be something like `unset` julia type in this case 51 | 52 | ;this will create string in Julia: 53 | ret: jl_eval_string {"sqrt(2.0) = $(sqrt(2.0))"} 54 | if ret/0 = jl_string_type [ 55 | print-line ["returned string: " as c-string! jl_unbox_voidpointer as int-ptr! ret/1] 56 | ] 57 | 58 | ret: jl_eval_string {a = 2;b = 3; c = a * b} 59 | if ret/0 = jl_int32_type [ 60 | print-line ["returned integer: " jl_unbox_int32 ret] 61 | ] 62 | 63 | ret: jl_eval_string {c} 64 | print-line ["c is: " jl_unbox_int32 ret] 65 | 66 | 67 | jl_atexit_hook 0 68 | ] 69 | ] 70 | 71 | main 72 | -------------------------------------------------------------------------------- /Library/Julia/Julia.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | Title: "Red libjulia binding" 3 | Author: "Oldes" 4 | File: %Julia.red 5 | Tabs: 4 6 | Rights: "Copyright (C) 2017 Oldes. All rights reserved." 7 | License: { 8 | Distributed under the Boost Software License, Version 1.0. 9 | See https://github.com/red/red/blob/master/BSL-License.txt 10 | } 11 | Comment: { 12 | This script needs external library, which can be downloaded from this site: 13 | https://julialang.org/downloads/ 14 | } 15 | ] 16 | 17 | #system [ 18 | #include %Julia.reds 19 | ] 20 | 21 | julia: context [ 22 | init: routine [ 23 | "Init Julia" 24 | home-dir [string!] 25 | return: [logic!] 26 | /local dir 27 | ][ 28 | either 1 = julia/jl_is_initialized [ 29 | return true 30 | ][ 31 | dir: as c-string! string/rs-head home-dir 32 | print-line ["dir: " dir] 33 | julia/jl_init dir 34 | ] 35 | 1 = julia/jl_is_initialized 36 | ] 37 | do: routine [ 38 | "Evaluate Julia's code" 39 | code [string!] 40 | /local 41 | jl-value 42 | cstr [c-string!] 43 | str [red-string!] 44 | result [red-value!] 45 | hnd [red-handle!] 46 | int [red-integer!] 47 | fl [red-float!] 48 | type [integer!] 49 | ][ 50 | with julia [ 51 | jl-value: jl_eval_string as c-string! string/rs-head code 52 | type: jl-value/0 and FFFFFFF0h 53 | case [ 54 | type = jl_string_type [ 55 | cstr: as c-string! jl_unbox_voidpointer as int-ptr! jl-value/1 56 | str: string/load cstr length? cstr UTF-8 57 | SET_RETURN(str) 58 | ] 59 | type = jl_int32_type [ 60 | int: integer/box jl_unbox_int32 jl-value 61 | SET_RETURN(int) 62 | ] 63 | type = jl_float64_type [ 64 | fl: float/box jl_unbox_float64 jl-value 65 | SET_RETURN(fl) 66 | ] 67 | true [ 68 | hnd: handle/box as integer! jl-value 69 | SET_RETURN(hnd) 70 | ] 71 | ] 72 | ] 73 | ] 74 | end: routine [ 75 | "Notify Julia that the program is about to terminate." 76 | exit-code [integer!] 77 | ][ 78 | julia/jl_atexit_hook exit-code 79 | ] 80 | ] 81 | -------------------------------------------------------------------------------- /Library/Julia/Julia.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "Red/System libjulia binding" 3 | Author: "Oldes" 4 | File: %Julia.reds 5 | Tabs: 4 6 | Rights: "Copyright (C) 2017 Oldes. All rights reserved." 7 | License: { 8 | Distributed under the Boost Software License, Version 1.0. 9 | See https://github.com/red/red/blob/master/BSL-License.txt 10 | } 11 | Comment: { 12 | This script needs external library, which can be downloaded from this site: 13 | https://julialang.org/downloads/ 14 | } 15 | ] 16 | 17 | #enum jl-image-search! [ 18 | JL_IMAGE_CWD 19 | JL_IMAGE_JULIA_HOME 20 | ;JL_IMAGE_LIBJULIA 21 | ] 22 | 23 | #define jl-value! int-ptr! 24 | jl-tagged-value!: alias struct! [ 25 | header [int-ptr!] 26 | next [int-ptr!] 27 | type [int-ptr!] 28 | whatever [int-ptr!] 29 | ] 30 | 31 | 32 | julia: context [ 33 | 34 | #switch OS [ 35 | Windows [ #define libjulia "libjulia.dll" ] 36 | macOS [ #define libjulia "libjulia.dylib" ] ;@@ FIXME: use real file name 37 | #default [ #define libjulia "libjulia.so" ] ;@@ FIXME: use real file name 38 | ] 39 | 40 | 41 | #import [ 42 | libjulia cdecl [ 43 | julia_init: "julia_init" [ 44 | ret [jl-image-search!] 45 | ] 46 | jl_init: "jl_init" [ 47 | julia_home_dir [c-string!] 48 | ] 49 | jl_init_with_image: "jl_init_with_image" [ 50 | julia_home_dir [c-string!] 51 | image_relative_path [c-string!] 52 | ] 53 | jl_is_initialized: "jl_is_initialized" [ 54 | return: [integer!] 55 | ] 56 | jl_atexit_hook: "jl_atexit_hook" [ 57 | status [integer!] 58 | ] 59 | jl_eval_string: "jl_eval_string" [ 60 | str [c-string!] 61 | return: [jl-value!] 62 | ] 63 | 64 | jl_unbox_int32: "jl_unbox_int32" [ 65 | v [jl-value!] 66 | return: [integer!] 67 | ] 68 | jl_unbox_voidpointer: "jl_unbox_voidpointer" [ 69 | v [jl-value!] 70 | return: [byte-ptr!] 71 | ] 72 | jl_unbox_float64: "jl_unbox_float64" [ 73 | v [jl-value!] 74 | return: [float!] 75 | ] 76 | ;@@TODO: add more import functions 77 | 78 | jl_any_type: "jl_any_type" [integer!] 79 | jl_slotnumber_type: "jl_slotnumber_type" [integer!] 80 | jl_string_type: "jl_string_type" [integer!] 81 | jl_int32_type: "jl_int32_type" [integer!] 82 | jl_uint32_type: "jl_uint32_type" [integer!] 83 | jl_float64_type: "jl_float64_type" [integer!] 84 | jl_char_type: "jl_char_type" [integer!] 85 | ;@@TODO: add more types 86 | 87 | ]; libjulia 88 | ]; #import 89 | 90 | 91 | probe-jl-value: func[ 92 | jval [jl-value!] 93 | ][ 94 | print-line [ 95 | "VAL " jval " has: " 96 | as int-ptr! jval/0 " " as int-ptr! jval/1 " " as int-ptr! jval/2 " " as int-ptr! jval/3 97 | " " as int-ptr! jval/4 " " as int-ptr! jval/5 " " as int-ptr! jval/6 " " as int-ptr! jval/7 98 | " " as int-ptr! jval/8 99 | ] 100 | ] 101 | ] ; context julia 102 | -------------------------------------------------------------------------------- /Library/LZMA/README.md: -------------------------------------------------------------------------------- 1 | # LZMA 2 | 3 | libLZMA binding for Red/System 4 | 5 | --- 6 | This script provide basic compression/decompression using LZMA encoding. For usage check `lzma-test.reds` file. 7 | 8 | 9 | Requirements 10 | ------------ 11 | 12 | This script needs external library, which can be downloaded from this site: 13 | https://tukaani.org/xz/ 14 | 15 | So far tested on Windows 10 with `xz-5.2.3-windows\[bin_i686|bin_i686-sse2]\liblzma.dll` -------------------------------------------------------------------------------- /Library/OpenGL/examples/common.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "Common code for OpenGL examples" 3 | Author: "Oldes" 4 | File: %common.reds 5 | Rights: "Copyright (C) 2017 David 'Oldes' Oliva. All rights reserved." 6 | License: "BSD-3 - https://github.com/red/red/blob/master/BSD-3-License.txt" 7 | ] 8 | 9 | #include %../../GLFW/glfw3.reds 10 | #include %../gl.reds 11 | 12 | window: declare GLFWwindow! 13 | 14 | on-gl-error: func [ 15 | [GLFW3_CALLING] 16 | error [integer!] 17 | description [c-string!] 18 | ][ 19 | print-line [ "!!! OpenGL error[" error "] - " description] 20 | ] 21 | 22 | on-resize: func [ 23 | [GLFW3_CALLING] 24 | window [GLFWwindow!] 25 | width [integer!] 26 | height [integer!] 27 | ][ 28 | print-line ["resize: " width #"x" height] 29 | glViewport 0 0 width height 30 | render-scene ;redraw the scene 31 | ] 32 | 33 | GL-init: func[][ 34 | glfwSetErrorCallback :on-gl-error 35 | if GL_TRUE <> glfwInit [print-line "Failed to initialize GLFW library!" quit -1] 36 | ] 37 | 38 | GL-window: func[ 39 | title [c-string!] 40 | width [integer!] 41 | height [integer!] 42 | return: [GLFWwindow!] 43 | ][ 44 | window: glfwCreateWindow width height title NULL NULL 45 | 46 | if NULL = window [ 47 | print-line "Failed to open GLFW window." 48 | glfwTerminate 49 | quit -1 50 | ] 51 | 52 | glfwSetInputMode window GLFW_STICKY_KEYS GL_TRUE 53 | 54 | window 55 | ] 56 | 57 | GL-context: does [ 58 | glfwMakeContextCurrent window 59 | glfwSetFramebufferSizeCallback window :on-resize 60 | glfwSwapInterval 1 61 | ] 62 | 63 | GL-close: func[][ 64 | if null <> window [glfwDestroyWindow window] 65 | glfwTerminate 66 | ] 67 | 68 | ;this define can be used to quit the main GL loop 69 | #define GL-exit-test [ 70 | if any [ 71 | 0 <> glfwWindowShouldClose window 72 | GLFW_PRESS = glfwGetKey window GLFW_KEY_ESCAPE 73 | ][ 74 | break 75 | ] 76 | ] -------------------------------------------------------------------------------- /Library/OpenGL/examples/gl-clipboard.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "GLFW Binding: clipboard" 3 | Purpose: { 4 | This program is used to test the clipboard functionality. 5 | Orginal program by Camilla Berglund 6 | } 7 | Author: "François Jouen, Oldes" 8 | File: %gl-windows.reds 9 | Rights: "Copyright (C) 2017 David 'Oldes' Oliva. All rights reserved." 10 | License: "BSD-3 - https://github.com/red/red/blob/master/BSD-3-License.txt" 11 | Note: {Based on François Jouen's: 12 | https://github.com/ldci/glfw-red/blob/master/Samples/redS/clipboard.reds} 13 | ] 14 | 15 | #include %common.reds 16 | 17 | on-key: func [ 18 | [GLFW3_CALLING] 19 | window [GLFWwindow!] 20 | key [integer!] 21 | scancode [integer!] 22 | action [integer!] 23 | mods [integer!] 24 | /local string 25 | ] [ 26 | if action <> GLFW_PRESS [exit] 27 | switch key [ 28 | GLFW_KEY_ESCAPE [ 29 | glfwSetWindowShouldClose window GL_TRUE 30 | ] 31 | GLFW_KEY_V [ 32 | if mods = GLFW_MOD_CONTROL [ 33 | string: glfwGetClipboardString window 34 | either 0 < length? string [ 35 | print-line["Clipboard contains " string] 36 | ][ print-line "Clipboard does not contain a string" ] 37 | ] 38 | ] 39 | GLFW_KEY_C [ 40 | if mods = GLFW_MOD_CONTROL [ 41 | string: "Hello GLFW World!" 42 | glfwSetClipboardString window string 43 | print-line ["Setting clipboard to " string] 44 | ] 45 | ] 46 | default [0] ;do nothing 47 | ] 48 | ] 49 | 50 | GL-init 51 | GL-window "Clipboard Test [CTRL-C CTRL-V]" 320 240 52 | GL-context 53 | 54 | glfwSetKeyCallback window :on-key 55 | 56 | glMatrixMode GL_PROJECTION 57 | glOrtho -1.0 1.0 -1.0 1.0 -1.0 1.0 58 | glMatrixMode GL_MODELVIEW 59 | glClearColor 0.5 0.5 0.5 0.0 60 | 61 | render-scene: does [ 62 | glClear GL_COLOR_BUFFER_BIT 63 | glColor3d 0.8 0.2 0.4 64 | glRectd -0.5 -0.5 0.5 0.5 65 | glfwSwapBuffers window 66 | ] 67 | 68 | forever [ 69 | render-scene 70 | glfwWaitEvents 71 | GL-exit-test 72 | ] 73 | 74 | GL-close 75 | -------------------------------------------------------------------------------- /Library/OpenGL/examples/gl-triangle.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "Red/System OpenGL triangle example" 3 | Purpose: "Displaying triangle using old way." 4 | Author: "Oldes" 5 | File: %gl-triangle.reds 6 | Rights: "Copyright (C) 2017 David 'Oldes' Oliva. All rights reserved." 7 | License: "BSD-3 - https://github.com/red/red/blob/master/BSD-3-License.txt" 8 | Note: {Based on François Jouen's: 9 | https://github.com/ldci/glfw-red/blob/master/Samples/redS/triangle.reds} 10 | ] 11 | 12 | #include %common.reds 13 | 14 | GL-init 15 | GL-window "GL triangle" 800 600 16 | GL-context 17 | 18 | render-scene: does [ 19 | glClear GL_COLOR_BUFFER_BIT 20 | 21 | glBegin GL_TRIANGLES 22 | glColor3ub 255 0 0 glVertex2d -0.75 -0.75 23 | glColor3ub 0 255 0 glVertex2d 0.0 0.75 24 | glColor3ub 0 0 255 glVertex2d 0.75 -0.75 25 | glEnd 26 | glFlush 27 | 28 | glfwSwapBuffers window 29 | ] 30 | 31 | forever [ 32 | render-scene 33 | glfwPollEvents 34 | GL-exit-test 35 | ] 36 | 37 | GL-close -------------------------------------------------------------------------------- /Library/OpenGL/examples/gl-windows.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "Simple multi-window GLFW/OpenGL test" 3 | Purpose: { 4 | This test creates four windows and clears each in a different color 5 | Orginal program by Camilla Berglund 6 | } 7 | Author: "François Jouen, Oldes" 8 | File: %gl-windows.reds 9 | Rights: "Copyright (C) 2017 David 'Oldes' Oliva. All rights reserved." 10 | License: "BSD-3 - https://github.com/red/red/blob/master/BSD-3-License.txt" 11 | Note: {Based on François Jouen's: 12 | https://github.com/ldci/glfw-red/blob/master/Samples/redS/windows.reds} 13 | ] 14 | 15 | #include %common.reds 16 | 17 | GL-init 18 | 19 | titles: ["Foo" "Bar" "Baz" "Quux"] ; An array with 4 windows title 20 | windows: [0 0 0 0] ; An array to 4 window pointers 21 | 22 | i: 0 23 | while [i < 4] [ 24 | i: i + 1 25 | windows/i: as integer! glfwCreateWindow 200 200 as c-string! titles/i NULL NULL 26 | window: as int-ptr! windows/i 27 | glfwMakeContextCurrent window 28 | glClearColor 29 | as float32! ((i - 1) and 1) 30 | as float32! ((i - 1) >> 1) 31 | as float32! either i = 1 [1.0][0.0] 32 | as float32! 1.0 33 | glfwSetWindowPos window 100 + ((i - 1 AND 1) * 300) 100 + ((i - 1 >> 1) * 300) 34 | glfwShowWindow window 35 | ] 36 | 37 | running: true 38 | 39 | while [running][ 40 | i: 0 41 | while [i < 4][ 42 | i: i + 1 43 | window: as int-ptr! windows/i 44 | glfwMakeContextCurrent window 45 | glClear GL_COLOR_BUFFER_BIT 46 | glfwSwapBuffers window 47 | if GL_TRUE = glfwWindowShouldClose window [running: false] ; Closing any window quits app 48 | ] 49 | glfwPollEvents 50 | ] 51 | 52 | ;Let's be nice and destroy all windows before exit 53 | i: 0 54 | while [i < 4] [ 55 | i: i + 1 56 | glfwDestroyWindow as int-ptr! windows/i 57 | ] 58 | 59 | glfwTerminate -------------------------------------------------------------------------------- /Library/OpenGL/examples/gl3-triangle.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "Red/System OpenGL basic triangle example using new OpenGL" 3 | Author: "Oldes" 4 | File: %gl3-triangle.reds 5 | Rights: "Copyright (C) 2017 David 'Oldes' Oliva. All rights reserved." 6 | License: "BSD-3 - https://github.com/red/red/blob/master/BSD-3-License.txt" 7 | Note: { 8 | This code is Red/System port of tutorial from: 9 | http://www.opengl-tutorial.org/beginners-tutorials/tutorial-1-opening-a-window/ 10 | http://www.opengl-tutorial.org/beginners-tutorials/tutorial-2-the-first-triangle/ 11 | } 12 | ] 13 | 14 | #include %common.reds 15 | #include %../../os/datatypes/typed-array.reds 16 | 17 | ;some functions used in this example are defined as ARB extensions 18 | #include %../extensions/gl-ARB.reds ;(Extensions officially approved by the OpenGL Architecture Review Board) 19 | ;to use these functions, you must manually load them.. see bellow in code. 20 | 21 | GL-init 22 | 23 | glfwWindowHint GLFW_SAMPLES 4 ;4x antialiasing 24 | glfwWindowHint GLFW_CONTEXT_VERSION_MAJOR 3 ;We want OpenGL 3.3 25 | glfwWindowHint GLFW_CONTEXT_VERSION_MINOR 3 ; 26 | glfwWindowHint GLFW_OPENGL_FORWARD_COMPAT GL_TRUE ;To make MacOS happy; should not be needed 27 | glfwWindowHint GLFW_OPENGL_PROFILE GLFW_OPENGL_CORE_PROFILE ;We don't want the old OpenGL 28 | 29 | GL-window "GL3 triangle" 800 600 30 | 31 | GL-context 32 | 33 | #include %../gl3-common.reds ;imports common GL3 functions 34 | 35 | ;background color: 36 | glClearColor .0 .0 .6 .0 37 | 38 | VertexArrayID: 0 39 | glGenVertexArrays 1 :VertexArrayID 40 | glBindVertexArray VertexArrayID 41 | 42 | 43 | vertexData: make-f32-buffer [ 44 | -1.0 -1.0 0.0 45 | 1.0 -1.0 0.0 46 | 0.0 1.0 0.0 47 | ] 48 | 49 | ;This will identify our vertex buffer 50 | vertexbuffer: 0 51 | ;Generate 1 buffer, put the resulting identifier in vertexbuffer 52 | glGenBuffers 1 :vertexbuffer 53 | ;The following commands will talk about our 'vertexbuffer' buffer 54 | glBindBuffer GL_ARRAY_BUFFER vertexbuffer 55 | ;Give our vertices to OpenGL. 56 | glBufferData GL_ARRAY_BUFFER (size? float32!) * vertexData/size vertexData/head GL_STATIC_DRAW 57 | 58 | vertex-source: {#version 330 core 59 | // Input vertex data, different for all executions of this shader. 60 | layout(location = 0) in vec3 vertexPosition_modelspace; 61 | void main() { 62 | gl_Position.xyz = vertexPosition_modelspace; 63 | gl_Position.w = 1.0; 64 | }} 65 | 66 | fragment-source: {#version 330 core 67 | // Ouput data 68 | out vec3 color; 69 | void main() { 70 | // Output color = red 71 | color = vec3(1,0,0); 72 | }} 73 | 74 | programID: GL-compile-program vertex-source fragment-source 75 | 76 | 77 | render-scene: does [ 78 | glClear GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT 79 | 80 | glUseProgram programID 81 | 82 | glEnableVertexAttribArray 0 83 | glBindBuffer GL_ARRAY_BUFFER vertexbuffer 84 | glVertexAttribPointer 0 3 GL_FLOAT GL_FALSE 0 NULL 85 | 86 | ;Draw the triangle! 87 | glDrawArrays GL_TRIANGLES 0 3 ;Starting from vertex 0; 3 vertices total -> 1 triangle 88 | glDisableVertexAttribArray 0 89 | ;Swap buffers 90 | glfwSwapBuffers window 91 | ] 92 | 93 | forever [ 94 | render-scene 95 | glfwPollEvents 96 | 97 | GL-exit-test 98 | ] 99 | 100 | GL-close -------------------------------------------------------------------------------- /Library/OpenGL/extensions/gl-3DFX.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "Red/System OpenGL 3DFX extension binding" 3 | Author: "Oldes" 4 | File: %gl-3DFX.reds 5 | Rights: "Copyright (C) 2017 David 'Oldes' Oliva. All rights reserved." 6 | License: "BSD-3 - https://github.com/red/red/blob/master/BSD-3-License.txt" 7 | Note: { 8 | This source was made from glew.h file. 9 | Commented definitions are there because the definition was already defined with the same value. 10 | } 11 | ] 12 | 13 | 14 | 15 | ;------------------------------------------- 16 | ;-- GL_3DFX_multisample 17 | ;------------------------------------------- 18 | 19 | #define GL_3DFX_multisample 1 20 | #define GL_MULTISAMPLE_3DFX 86B2h 21 | #define GL_SAMPLE_BUFFERS_3DFX 86B3h 22 | #define GL_SAMPLES_3DFX 86B4h 23 | #define GL_MULTISAMPLE_BIT_3DFX 20000000h 24 | 25 | 26 | ;------------------------------------------- 27 | ;-- GL_3DFX_tbuffer 28 | ;------------------------------------------- 29 | 30 | #define GL_3DFX_tbuffer 1 31 | ;@@ void ( GLuint mask ); 32 | glTbufferMask3DFX!: alias function! [ 33 | mask [ GLuint! ] 34 | ] 35 | 36 | 37 | ;------------------------------------------- 38 | ;-- GL_3DFX_texture_compression_FXT1 39 | ;------------------------------------------- 40 | 41 | #define GL_3DFX_texture_compression_FXT1 1 42 | #define GL_COMPRESSED_RGB_FXT1_3DFX 86B0h 43 | #define GL_COMPRESSED_RGBA_FXT1_3DFX 86B1h 44 | -------------------------------------------------------------------------------- /Library/OpenGL/extensions/gl-ANDROID.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "Red/System OpenGL ANDROID extension binding" 3 | Author: "Oldes" 4 | File: %gl-ANDROID.reds 5 | Rights: "Copyright (C) 2017 David 'Oldes' Oliva. All rights reserved." 6 | License: "BSD-3 - https://github.com/red/red/blob/master/BSD-3-License.txt" 7 | Note: { 8 | This source was made from glew.h file. 9 | Commented definitions are there because the definition was already defined with the same value. 10 | } 11 | ] 12 | 13 | 14 | 15 | ;------------------------------------------- 16 | ;-- GL_ANDROID_extension_pack_es31a 17 | ;------------------------------------------- 18 | 19 | #define GL_ANDROID_extension_pack_es31a 1 20 | -------------------------------------------------------------------------------- /Library/OpenGL/extensions/gl-ARM.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "Red/System OpenGL ARM extension binding" 3 | Author: "Oldes" 4 | File: %gl-ARM.reds 5 | Rights: "Copyright (C) 2017 David 'Oldes' Oliva. All rights reserved." 6 | License: "BSD-3 - https://github.com/red/red/blob/master/BSD-3-License.txt" 7 | Note: { 8 | This source was made from glew.h file. 9 | Commented definitions are there because the definition was already defined with the same value. 10 | } 11 | ] 12 | 13 | 14 | 15 | ;------------------------------------------- 16 | ;-- GL_ARM_mali_program_binary 17 | ;------------------------------------------- 18 | 19 | #define GL_ARM_mali_program_binary 1 20 | #define GL_MALI_PROGRAM_BINARY_ARM 8F61h 21 | 22 | 23 | ;------------------------------------------- 24 | ;-- GL_ARM_mali_shader_binary 25 | ;------------------------------------------- 26 | 27 | #define GL_ARM_mali_shader_binary 1 28 | #define GL_MALI_SHADER_BINARY_ARM 8F60h 29 | 30 | 31 | ;------------------------------------------- 32 | ;-- GL_ARM_rgba8 33 | ;------------------------------------------- 34 | 35 | #define GL_ARM_rgba8 1 36 | #define GL_RGBA8_OES 8058h 37 | 38 | 39 | ;------------------------------------------- 40 | ;-- GL_ARM_shader_framebuffer_fetch 41 | ;------------------------------------------- 42 | 43 | #define GL_ARM_shader_framebuffer_fetch 1 44 | #define GL_FETCH_PER_SAMPLE_ARM 8F65h 45 | #define GL_FRAGMENT_SHADER_FRAMEBUFFER_FETCH_MRT_ARM 8F66h 46 | 47 | 48 | ;------------------------------------------- 49 | ;-- GL_ARM_shader_framebuffer_fetch_depth_stencil 50 | ;------------------------------------------- 51 | 52 | #define GL_ARM_shader_framebuffer_fetch_depth_stencil 1 53 | -------------------------------------------------------------------------------- /Library/OpenGL/extensions/gl-ATIX.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "Red/System OpenGL ATIX extension binding" 3 | Author: "Oldes" 4 | File: %gl-ATIX.reds 5 | Rights: "Copyright (C) 2017 David 'Oldes' Oliva. All rights reserved." 6 | License: "BSD-3 - https://github.com/red/red/blob/master/BSD-3-License.txt" 7 | Note: { 8 | This source was made from glew.h file. 9 | Commented definitions are there because the definition was already defined with the same value. 10 | } 11 | ] 12 | 13 | 14 | 15 | ;------------------------------------------- 16 | ;-- GL_ATIX_point_sprites 17 | ;------------------------------------------- 18 | 19 | #define GL_ATIX_point_sprites 1 20 | #define GL_TEXTURE_POINT_MODE_ATIX 60B0h 21 | #define GL_TEXTURE_POINT_ONE_COORD_ATIX 60B1h 22 | #define GL_TEXTURE_POINT_SPRITE_ATIX 60B2h 23 | #define GL_POINT_SPRITE_CULL_MODE_ATIX 60B3h 24 | #define GL_POINT_SPRITE_CULL_CENTER_ATIX 60B4h 25 | #define GL_POINT_SPRITE_CULL_CLIP_ATIX 60B5h 26 | 27 | 28 | ;------------------------------------------- 29 | ;-- GL_ATIX_texture_env_combine3 30 | ;------------------------------------------- 31 | 32 | #define GL_ATIX_texture_env_combine3 1 33 | #define GL_MODULATE_ADD_ATIX 8744h 34 | #define GL_MODULATE_SIGNED_ADD_ATIX 8745h 35 | #define GL_MODULATE_SUBTRACT_ATIX 8746h 36 | 37 | 38 | ;------------------------------------------- 39 | ;-- GL_ATIX_texture_env_route 40 | ;------------------------------------------- 41 | 42 | #define GL_ATIX_texture_env_route 1 43 | #define GL_SECONDARY_COLOR_ATIX 8747h 44 | #define GL_TEXTURE_OUTPUT_RGB_ATIX 8748h 45 | #define GL_TEXTURE_OUTPUT_ALPHA_ATIX 8749h 46 | 47 | 48 | ;------------------------------------------- 49 | ;-- GL_ATIX_vertex_shader_output_point_size 50 | ;------------------------------------------- 51 | 52 | #define GL_ATIX_vertex_shader_output_point_size 1 53 | #define GL_OUTPUT_POINT_SIZE_ATIX 610Eh 54 | -------------------------------------------------------------------------------- /Library/OpenGL/extensions/gl-EGL.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "Red/System OpenGL EGL extension binding" 3 | Author: "Oldes" 4 | File: %gl-EGL.reds 5 | Rights: "Copyright (C) 2017 David 'Oldes' Oliva. All rights reserved." 6 | License: "BSD-3 - https://github.com/red/red/blob/master/BSD-3-License.txt" 7 | Note: { 8 | This source was made from glew.h file. 9 | Commented definitions are there because the definition was already defined with the same value. 10 | } 11 | ] 12 | 13 | 14 | 15 | ;------------------------------------------- 16 | ;-- GL_EGL_KHR_context_flush_control 17 | ;------------------------------------------- 18 | 19 | #define GL_EGL_KHR_context_flush_control 1 20 | 21 | 22 | ;------------------------------------------- 23 | ;-- GL_EGL_NV_robustness_video_memory_purge 24 | ;------------------------------------------- 25 | 26 | #define GL_EGL_NV_robustness_video_memory_purge 1 27 | #define GL_EGL_GENERATE_RESET_ON_VIDEO_MEMORY_PURGE_NV 334Ch 28 | #define GL_PURGED_CONTEXT_RESET_NV 92BBh 29 | -------------------------------------------------------------------------------- /Library/OpenGL/extensions/gl-GREMEDY.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "Red/System OpenGL GREMEDY extension binding" 3 | Author: "Oldes" 4 | File: %gl-GREMEDY.reds 5 | Rights: "Copyright (C) 2017 David 'Oldes' Oliva. All rights reserved." 6 | License: "BSD-3 - https://github.com/red/red/blob/master/BSD-3-License.txt" 7 | Note: { 8 | This source was made from glew.h file. 9 | Commented definitions are there because the definition was already defined with the same value. 10 | } 11 | ] 12 | 13 | 14 | 15 | ;------------------------------------------- 16 | ;-- GL_GREMEDY_frame_terminator 17 | ;------------------------------------------- 18 | 19 | #define GL_GREMEDY_frame_terminator 1 20 | ;@@ void ( void ); 21 | glFrameTerminatorGREMEDY!: alias function! [ 22 | ] 23 | 24 | 25 | ;------------------------------------------- 26 | ;-- GL_GREMEDY_string_marker 27 | ;------------------------------------------- 28 | 29 | #define GL_GREMEDY_string_marker 1 30 | ;@@ void ( GLsizei len, const void *string ); 31 | glStringMarkerGREMEDY!: alias function! [ 32 | len [ GLsizei! ] 33 | string [ pointer! [byte!] ] 34 | ] 35 | -------------------------------------------------------------------------------- /Library/OpenGL/extensions/gl-HP.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "Red/System OpenGL HP extension binding" 3 | Author: "Oldes" 4 | File: %gl-HP.reds 5 | Rights: "Copyright (C) 2017 David 'Oldes' Oliva. All rights reserved." 6 | License: "BSD-3 - https://github.com/red/red/blob/master/BSD-3-License.txt" 7 | Note: { 8 | This source was made from glew.h file. 9 | Commented definitions are there because the definition was already defined with the same value. 10 | } 11 | ] 12 | 13 | 14 | 15 | ;------------------------------------------- 16 | ;-- GL_HP_convolution_border_modes 17 | ;------------------------------------------- 18 | 19 | #define GL_HP_convolution_border_modes 1 20 | 21 | 22 | ;------------------------------------------- 23 | ;-- GL_HP_image_transform 24 | ;------------------------------------------- 25 | 26 | #define GL_HP_image_transform 1 27 | ;@@ void ( GLenum target, GLenum pname, const GLfloat* params ); 28 | glGetImageTransformParameterfvHP!: alias function! [ 29 | target [ GLenum! ] 30 | pname [ GLenum! ] 31 | params [ pointer! [GLfloat!] ] 32 | ] 33 | ;@@ void ( GLenum target, GLenum pname, const GLint* params ); 34 | glGetImageTransformParameterivHP!: alias function! [ 35 | target [ GLenum! ] 36 | pname [ GLenum! ] 37 | params [ pointer! [GLint!] ] 38 | ] 39 | ;@@ void ( GLenum target, GLenum pname, const GLfloat param ); 40 | glImageTransformParameterfHP!: alias function! [ 41 | target [ GLenum! ] 42 | pname [ GLenum! ] 43 | param [ GLfloat! ] 44 | ] 45 | ;@@ void ( GLenum target, GLenum pname, const GLfloat* params ); 46 | glImageTransformParameterfvHP!: alias function! [ 47 | target [ GLenum! ] 48 | pname [ GLenum! ] 49 | params [ pointer! [GLfloat!] ] 50 | ] 51 | ;@@ void ( GLenum target, GLenum pname, const GLint param ); 52 | glImageTransformParameteriHP!: alias function! [ 53 | target [ GLenum! ] 54 | pname [ GLenum! ] 55 | param [ GLint! ] 56 | ] 57 | ;@@ void ( GLenum target, GLenum pname, const GLint* params ); 58 | glImageTransformParameterivHP!: alias function! [ 59 | target [ GLenum! ] 60 | pname [ GLenum! ] 61 | params [ pointer! [GLint!] ] 62 | ] 63 | 64 | 65 | ;------------------------------------------- 66 | ;-- GL_HP_occlusion_test 67 | ;------------------------------------------- 68 | 69 | #define GL_HP_occlusion_test 1 70 | 71 | 72 | ;------------------------------------------- 73 | ;-- GL_HP_texture_lighting 74 | ;------------------------------------------- 75 | 76 | #define GL_HP_texture_lighting 1 77 | -------------------------------------------------------------------------------- /Library/OpenGL/extensions/gl-INGR.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "Red/System OpenGL INGR extension binding" 3 | Author: "Oldes" 4 | File: %gl-INGR.reds 5 | Rights: "Copyright (C) 2017 David 'Oldes' Oliva. All rights reserved." 6 | License: "BSD-3 - https://github.com/red/red/blob/master/BSD-3-License.txt" 7 | Note: { 8 | This source was made from glew.h file. 9 | Commented definitions are there because the definition was already defined with the same value. 10 | } 11 | ] 12 | 13 | 14 | 15 | ;------------------------------------------- 16 | ;-- GL_INGR_color_clamp 17 | ;------------------------------------------- 18 | 19 | #define GL_INGR_color_clamp 1 20 | #define GL_RED_MIN_CLAMP_INGR 8560h 21 | #define GL_GREEN_MIN_CLAMP_INGR 8561h 22 | #define GL_BLUE_MIN_CLAMP_INGR 8562h 23 | #define GL_ALPHA_MIN_CLAMP_INGR 8563h 24 | #define GL_RED_MAX_CLAMP_INGR 8564h 25 | #define GL_GREEN_MAX_CLAMP_INGR 8565h 26 | #define GL_BLUE_MAX_CLAMP_INGR 8566h 27 | #define GL_ALPHA_MAX_CLAMP_INGR 8567h 28 | 29 | 30 | ;------------------------------------------- 31 | ;-- GL_INGR_interlace_read 32 | ;------------------------------------------- 33 | 34 | #define GL_INGR_interlace_read 1 35 | #define GL_INTERLACE_READ_INGR 8568h 36 | -------------------------------------------------------------------------------- /Library/OpenGL/extensions/gl-KTX.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "Red/System OpenGL KTX extension binding" 3 | Author: "Oldes" 4 | File: %gl-KTX.reds 5 | Rights: "Copyright (C) 2017 David 'Oldes' Oliva. All rights reserved." 6 | License: "BSD-3 - https://github.com/red/red/blob/master/BSD-3-License.txt" 7 | Note: { 8 | This source was made from glew.h file. 9 | Commented definitions are there because the definition was already defined with the same value. 10 | } 11 | ] 12 | 13 | 14 | 15 | ;------------------------------------------- 16 | ;-- GL_KTX_buffer_region 17 | ;------------------------------------------- 18 | 19 | #define GL_KTX_buffer_region 1 20 | #define GL_KTX_FRONT_REGION 00h 21 | #define GL_KTX_BACK_REGION 01h 22 | #define GL_KTX_Z_REGION 02h 23 | #define GL_KTX_STENCIL_REGION 03h 24 | ;@@ GLuint ( void ); 25 | glBufferRegionEnabled!: alias function! [ 26 | return: [ GLuint! ] 27 | 28 | ] 29 | ;@@ void ( GLenum region ); 30 | glDeleteBufferRegion!: alias function! [ 31 | region [ GLenum! ] 32 | ] 33 | ;@@ void ( GLuint region, GLint x, GLint y, GLsizei width, GLsizei height, GLint xDest, GLint yDest ); 34 | glDrawBufferRegion!: alias function! [ 35 | region [ GLuint! ] 36 | x [ GLint! ] 37 | y [ GLint! ] 38 | width [ GLsizei! ] 39 | height [ GLsizei! ] 40 | xDest [ GLint! ] 41 | yDest [ GLint! ] 42 | ] 43 | ;@@ GLuint ( GLenum region ); 44 | glNewBufferRegion!: alias function! [ 45 | region [ GLenum! ] 46 | return: [ GLuint! ] 47 | 48 | ] 49 | ;@@ void ( GLuint region, GLint x, GLint y, GLsizei width, GLsizei height ); 50 | glReadBufferRegion!: alias function! [ 51 | region [ GLuint! ] 52 | x [ GLint! ] 53 | y [ GLint! ] 54 | width [ GLsizei! ] 55 | height [ GLsizei! ] 56 | ] 57 | -------------------------------------------------------------------------------- /Library/OpenGL/extensions/gl-MESAX.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "Red/System OpenGL MESAX extension binding" 3 | Author: "Oldes" 4 | File: %gl-MESAX.reds 5 | Rights: "Copyright (C) 2017 David 'Oldes' Oliva. All rights reserved." 6 | License: "BSD-3 - https://github.com/red/red/blob/master/BSD-3-License.txt" 7 | Note: { 8 | This source was made from glew.h file. 9 | Commented definitions are there because the definition was already defined with the same value. 10 | } 11 | ] 12 | 13 | 14 | 15 | ;------------------------------------------- 16 | ;-- GL_MESAX_texture_stack 17 | ;------------------------------------------- 18 | 19 | #define GL_MESAX_texture_stack 1 20 | #define GL_TEXTURE_1D_STACK_MESAX 8759h 21 | #define GL_TEXTURE_2D_STACK_MESAX 875Ah 22 | #define GL_PROXY_TEXTURE_1D_STACK_MESAX 875Bh 23 | #define GL_PROXY_TEXTURE_2D_STACK_MESAX 875Ch 24 | #define GL_TEXTURE_1D_STACK_BINDING_MESAX 875Dh 25 | #define GL_TEXTURE_2D_STACK_BINDING_MESAX 875Eh 26 | -------------------------------------------------------------------------------- /Library/OpenGL/extensions/gl-NVX.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "Red/System OpenGL NVX extension binding" 3 | Author: "Oldes" 4 | File: %gl-NVX.reds 5 | Rights: "Copyright (C) 2017 David 'Oldes' Oliva. All rights reserved." 6 | License: "BSD-3 - https://github.com/red/red/blob/master/BSD-3-License.txt" 7 | Note: { 8 | This source was made from glew.h file. 9 | Commented definitions are there because the definition was already defined with the same value. 10 | } 11 | ] 12 | 13 | 14 | 15 | ;------------------------------------------- 16 | ;-- GL_NVX_blend_equation_advanced_multi_draw_buffers 17 | ;------------------------------------------- 18 | 19 | #define GL_NVX_blend_equation_advanced_multi_draw_buffers 1 20 | 21 | 22 | ;------------------------------------------- 23 | ;-- GL_NVX_conditional_render 24 | ;------------------------------------------- 25 | 26 | #define GL_NVX_conditional_render 1 27 | ;@@ void ( GLuint id ); 28 | glBeginConditionalRenderNVX!: alias function! [ 29 | id [ GLuint! ] 30 | ] 31 | ;@@ void ( void ); 32 | glEndConditionalRenderNVX!: alias function! [ 33 | ] 34 | 35 | 36 | ;------------------------------------------- 37 | ;-- GL_NVX_gpu_memory_info 38 | ;------------------------------------------- 39 | 40 | #define GL_NVX_gpu_memory_info 1 41 | #define GL_GPU_MEMORY_INFO_DEDICATED_VIDMEM_NVX 9047h 42 | #define GL_GPU_MEMORY_INFO_TOTAL_AVAILABLE_MEMORY_NVX 9048h 43 | #define GL_GPU_MEMORY_INFO_CURRENT_AVAILABLE_VIDMEM_NVX 9049h 44 | #define GL_GPU_MEMORY_INFO_EVICTION_COUNT_NVX 904Ah 45 | #define GL_GPU_MEMORY_INFO_EVICTED_MEMORY_NVX 904Bh 46 | 47 | 48 | ;------------------------------------------- 49 | ;-- GL_NVX_linked_gpu_multicast 50 | ;------------------------------------------- 51 | 52 | #define GL_NVX_linked_gpu_multicast 1 53 | #define GL_LGPU_SEPARATE_STORAGE_BIT_NVX 0800h 54 | #define GL_MAX_LGPU_GPUS_NVX 92BAh 55 | ;@@ void ( GLuint sourceGpu, GLbitfield destinationGpuMask, GLuint srcName, GLenum srcTarget, GLint srcLevel, GLint srcX, GLint srxY, GLint srcZ, GLuint dstName, GLenum dstTarget, GLint dstLevel, GLint dstX, GLint dstY, GLint dstZ, GLsizei width, GLsizei height, GLsizei depth ); 56 | glLGPUCopyImageSubDataNVX!: alias function! [ 57 | sourceGpu [ GLuint! ] 58 | destinationGpuMask [ GLbitfield! ] 59 | srcName [ GLuint! ] 60 | srcTarget [ GLenum! ] 61 | srcLevel [ GLint! ] 62 | srcX [ GLint! ] 63 | srxY [ GLint! ] 64 | srcZ [ GLint! ] 65 | dstName [ GLuint! ] 66 | dstTarget [ GLenum! ] 67 | dstLevel [ GLint! ] 68 | dstX [ GLint! ] 69 | dstY [ GLint! ] 70 | dstZ [ GLint! ] 71 | width [ GLsizei! ] 72 | height [ GLsizei! ] 73 | depth [ GLsizei! ] 74 | ] 75 | ;@@ void ( void ); 76 | glLGPUInterlockNVX!: alias function! [ 77 | ] 78 | ;@@ void ( GLbitfield gpuMask, GLuint buffer, GLintptr offset, GLsizeiptr size, const void *data ); 79 | glLGPUNamedBufferSubDataNVX!: alias function! [ 80 | gpuMask [ GLbitfield! ] 81 | buffer [ GLuint! ] 82 | offset [ GLintptr! ] 83 | size [ GLsizeiptr! ] 84 | data [ pointer! [byte!] ] 85 | ] 86 | -------------------------------------------------------------------------------- /Library/OpenGL/extensions/gl-OES.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "Red/System OpenGL OES extension binding" 3 | Author: "Oldes" 4 | File: %gl-OES.reds 5 | Rights: "Copyright (C) 2017 David 'Oldes' Oliva. All rights reserved." 6 | License: "BSD-3 - https://github.com/red/red/blob/master/BSD-3-License.txt" 7 | Note: { 8 | This source was made from glew.h file. 9 | Commented definitions are there because the definition was already defined with the same value. 10 | } 11 | ] 12 | 13 | 14 | 15 | ;------------------------------------------- 16 | ;-- GL_OES_byte_coordinates 17 | ;------------------------------------------- 18 | 19 | #define GL_OES_byte_coordinates 1 20 | -------------------------------------------------------------------------------- /Library/OpenGL/extensions/gl-OML.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "Red/System OpenGL OML extension binding" 3 | Author: "Oldes" 4 | File: %gl-OML.reds 5 | Rights: "Copyright (C) 2017 David 'Oldes' Oliva. All rights reserved." 6 | License: "BSD-3 - https://github.com/red/red/blob/master/BSD-3-License.txt" 7 | Note: { 8 | This source was made from glew.h file. 9 | Commented definitions are there because the definition was already defined with the same value. 10 | } 11 | ] 12 | 13 | 14 | 15 | ;------------------------------------------- 16 | ;-- GL_OML_interlace 17 | ;------------------------------------------- 18 | 19 | #define GL_OML_interlace 1 20 | #define GL_INTERLACE_OML 8980h 21 | #define GL_INTERLACE_READ_OML 8981h 22 | 23 | 24 | ;------------------------------------------- 25 | ;-- GL_OML_resample 26 | ;------------------------------------------- 27 | 28 | #define GL_OML_resample 1 29 | #define GL_PACK_RESAMPLE_OML 8984h 30 | #define GL_UNPACK_RESAMPLE_OML 8985h 31 | #define GL_RESAMPLE_REPLICATE_OML 8986h 32 | #define GL_RESAMPLE_ZERO_FILL_OML 8987h 33 | #define GL_RESAMPLE_AVERAGE_OML 8988h 34 | #define GL_RESAMPLE_DECIMATE_OML 8989h 35 | 36 | 37 | ;------------------------------------------- 38 | ;-- GL_OML_subsample 39 | ;------------------------------------------- 40 | 41 | #define GL_OML_subsample 1 42 | #define GL_FORMAT_SUBSAMPLE_24_24_OML 8982h 43 | #define GL_FORMAT_SUBSAMPLE_244_244_OML 8983h 44 | -------------------------------------------------------------------------------- /Library/OpenGL/extensions/gl-OVR.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "Red/System OpenGL OVR extension binding" 3 | Author: "Oldes" 4 | File: %gl-OVR.reds 5 | Rights: "Copyright (C) 2017 David 'Oldes' Oliva. All rights reserved." 6 | License: "BSD-3 - https://github.com/red/red/blob/master/BSD-3-License.txt" 7 | Note: { 8 | This source was made from glew.h file. 9 | Commented definitions are there because the definition was already defined with the same value. 10 | } 11 | ] 12 | 13 | 14 | 15 | ;------------------------------------------- 16 | ;-- GL_OVR_multiview 17 | ;------------------------------------------- 18 | 19 | #define GL_OVR_multiview 1 20 | #define GL_FRAMEBUFFER_ATTACHMENT_TEXTURE_NUM_VIEWS_OVR 9630h 21 | #define GL_MAX_VIEWS_OVR 9631h 22 | #define GL_FRAMEBUFFER_ATTACHMENT_TEXTURE_BASE_VIEW_INDEX_OVR 9632h 23 | #define GL_FRAMEBUFFER_INCOMPLETE_VIEW_TARGETS_OVR 9633h 24 | ;@@ void ( GLenum target, GLenum attachment, GLuint texture, GLint level, GLint baseViewIndex, GLsizei numViews ); 25 | glFramebufferTextureMultiviewOVR!: alias function! [ 26 | target [ GLenum! ] 27 | attachment [ GLenum! ] 28 | texture [ GLuint! ] 29 | level [ GLint! ] 30 | baseViewIndex [ GLint! ] 31 | numViews [ GLsizei! ] 32 | ] 33 | 34 | 35 | ;------------------------------------------- 36 | ;-- GL_OVR_multiview2 37 | ;------------------------------------------- 38 | 39 | #define GL_OVR_multiview2 1 40 | 41 | 42 | ;------------------------------------------- 43 | ;-- GL_OVR_multiview_multisampled_render_to_texture 44 | ;------------------------------------------- 45 | 46 | #define GL_OVR_multiview_multisampled_render_to_texture 1 47 | ;@@ void ( GLenum target, GLenum attachment, GLuint texture, GLint level, GLsizei samples, GLint baseViewIndex, GLsizei numViews ); 48 | glFramebufferTextureMultisampleMultiviewOVR!: alias function! [ 49 | target [ GLenum! ] 50 | attachment [ GLenum! ] 51 | texture [ GLuint! ] 52 | level [ GLint! ] 53 | samples [ GLsizei! ] 54 | baseViewIndex [ GLint! ] 55 | numViews [ GLsizei! ] 56 | ] 57 | -------------------------------------------------------------------------------- /Library/OpenGL/extensions/gl-PGI.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "Red/System OpenGL PGI extension binding" 3 | Author: "Oldes" 4 | File: %gl-PGI.reds 5 | Rights: "Copyright (C) 2017 David 'Oldes' Oliva. All rights reserved." 6 | License: "BSD-3 - https://github.com/red/red/blob/master/BSD-3-License.txt" 7 | Note: { 8 | This source was made from glew.h file. 9 | Commented definitions are there because the definition was already defined with the same value. 10 | } 11 | ] 12 | 13 | 14 | 15 | ;------------------------------------------- 16 | ;-- GL_PGI_misc_hints 17 | ;------------------------------------------- 18 | 19 | #define GL_PGI_misc_hints 1 20 | #define GL_PREFER_DOUBLEBUFFER_HINT_PGI 107000 21 | #define GL_CONSERVE_MEMORY_HINT_PGI 107005 22 | #define GL_RECLAIM_MEMORY_HINT_PGI 107006 23 | #define GL_NATIVE_GRAPHICS_HANDLE_PGI 107010 24 | #define GL_NATIVE_GRAPHICS_BEGIN_HINT_PGI 107011 25 | #define GL_NATIVE_GRAPHICS_END_HINT_PGI 107012 26 | #define GL_ALWAYS_FAST_HINT_PGI 107020 27 | #define GL_ALWAYS_SOFT_HINT_PGI 107021 28 | #define GL_ALLOW_DRAW_OBJ_HINT_PGI 107022 29 | #define GL_ALLOW_DRAW_WIN_HINT_PGI 107023 30 | #define GL_ALLOW_DRAW_FRG_HINT_PGI 107024 31 | #define GL_ALLOW_DRAW_MEM_HINT_PGI 107025 32 | #define GL_STRICT_DEPTHFUNC_HINT_PGI 107030 33 | #define GL_STRICT_LIGHTING_HINT_PGI 107031 34 | #define GL_STRICT_SCISSOR_HINT_PGI 107032 35 | #define GL_FULL_STIPPLE_HINT_PGI 107033 36 | #define GL_CLIP_NEAR_HINT_PGI 107040 37 | #define GL_CLIP_FAR_HINT_PGI 107041 38 | #define GL_WIDE_LINE_HINT_PGI 107042 39 | #define GL_BACK_NORMALS_HINT_PGI 107043 40 | 41 | 42 | ;------------------------------------------- 43 | ;-- GL_PGI_vertex_hints 44 | ;------------------------------------------- 45 | 46 | #define GL_PGI_vertex_hints 1 47 | #define GL_VERTEX23_BIT_PGI 00000004h 48 | #define GL_VERTEX4_BIT_PGI 00000008h 49 | #define GL_COLOR3_BIT_PGI 00010000h 50 | #define GL_COLOR4_BIT_PGI 00020000h 51 | #define GL_EDGEFLAG_BIT_PGI 00040000h 52 | #define GL_INDEX_BIT_PGI 00080000h 53 | #define GL_MAT_AMBIENT_BIT_PGI 00100000h 54 | #define GL_VERTEX_DATA_HINT_PGI 107050 55 | #define GL_VERTEX_CONSISTENT_HINT_PGI 107051 56 | #define GL_MATERIAL_SIDE_HINT_PGI 107052 57 | #define GL_MAX_VERTEX_HINT_PGI 107053 58 | #define GL_MAT_AMBIENT_AND_DIFFUSE_BIT_PGI 00200000h 59 | #define GL_MAT_DIFFUSE_BIT_PGI 00400000h 60 | #define GL_MAT_EMISSION_BIT_PGI 00800000h 61 | #define GL_MAT_COLOR_INDEXES_BIT_PGI 01000000h 62 | #define GL_MAT_SHININESS_BIT_PGI 02000000h 63 | #define GL_MAT_SPECULAR_BIT_PGI 04000000h 64 | #define GL_NORMAL_BIT_PGI 08000000h 65 | #define GL_TEXCOORD1_BIT_PGI 10000000h 66 | #define GL_TEXCOORD2_BIT_PGI 20000000h 67 | #define GL_TEXCOORD3_BIT_PGI 40000000h 68 | #define GL_TEXCOORD4_BIT_PGI 80000000h 69 | -------------------------------------------------------------------------------- /Library/OpenGL/extensions/gl-REND.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "Red/System OpenGL REND extension binding" 3 | Author: "Oldes" 4 | File: %gl-REND.reds 5 | Rights: "Copyright (C) 2017 David 'Oldes' Oliva. All rights reserved." 6 | License: "BSD-3 - https://github.com/red/red/blob/master/BSD-3-License.txt" 7 | Note: { 8 | This source was made from glew.h file. 9 | Commented definitions are there because the definition was already defined with the same value. 10 | } 11 | ] 12 | 13 | 14 | 15 | ;------------------------------------------- 16 | ;-- GL_REND_screen_coordinates 17 | ;------------------------------------------- 18 | 19 | #define GL_REND_screen_coordinates 1 20 | #define GL_SCREEN_COORDINATES_REND 8490h 21 | #define GL_INVERTED_SCREEN_W_REND 8491h 22 | -------------------------------------------------------------------------------- /Library/OpenGL/extensions/gl-S3.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "Red/System OpenGL S3 extension binding" 3 | Author: "Oldes" 4 | File: %gl-S3.reds 5 | Rights: "Copyright (C) 2017 David 'Oldes' Oliva. All rights reserved." 6 | License: "BSD-3 - https://github.com/red/red/blob/master/BSD-3-License.txt" 7 | Note: { 8 | This source was made from glew.h file. 9 | Commented definitions are there because the definition was already defined with the same value. 10 | } 11 | ] 12 | 13 | 14 | 15 | ;------------------------------------------- 16 | ;-- GL_S3_s3tc 17 | ;------------------------------------------- 18 | 19 | #define GL_S3_s3tc 1 20 | #define GL_RGB_S3TC 83A0h 21 | #define GL_RGB4_S3TC 83A1h 22 | #define GL_RGBA_S3TC 83A2h 23 | #define GL_RGBA4_S3TC 83A3h 24 | #define GL_RGBA_DXT5_S3TC 83A4h 25 | #define GL_RGBA4_DXT5_S3TC 83A5h 26 | -------------------------------------------------------------------------------- /Library/OpenGL/extensions/gl-SUNX.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "Red/System OpenGL SUNX extension binding" 3 | Author: "Oldes" 4 | File: %gl-SUNX.reds 5 | Rights: "Copyright (C) 2017 David 'Oldes' Oliva. All rights reserved." 6 | License: "BSD-3 - https://github.com/red/red/blob/master/BSD-3-License.txt" 7 | Note: { 8 | This source was made from glew.h file. 9 | Commented definitions are there because the definition was already defined with the same value. 10 | } 11 | ] 12 | 13 | 14 | 15 | ;------------------------------------------- 16 | ;-- GL_SUNX_constant_data 17 | ;------------------------------------------- 18 | 19 | #define GL_SUNX_constant_data 1 20 | #define GL_UNPACK_CONSTANT_DATA_SUNX 81D5h 21 | #define GL_TEXTURE_CONSTANT_DATA_SUNX 81D6h 22 | ;@@ void ( void ); 23 | glFinishTextureSUNX!: alias function! [ 24 | ] 25 | -------------------------------------------------------------------------------- /Library/OpenGL/extensions/gl-WIN.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "Red/System OpenGL WIN extension binding" 3 | Author: "Oldes" 4 | File: %gl-WIN.reds 5 | Rights: "Copyright (C) 2017 David 'Oldes' Oliva. All rights reserved." 6 | License: "BSD-3 - https://github.com/red/red/blob/master/BSD-3-License.txt" 7 | Note: { 8 | This source was made from glew.h file. 9 | Commented definitions are there because the definition was already defined with the same value. 10 | } 11 | ] 12 | 13 | 14 | 15 | ;------------------------------------------- 16 | ;-- GL_WIN_phong_shading 17 | ;------------------------------------------- 18 | 19 | #define GL_WIN_phong_shading 1 20 | #define GL_PHONG_WIN 80EAh 21 | #define GL_PHONG_HINT_WIN 80EBh 22 | 23 | 24 | ;------------------------------------------- 25 | ;-- GL_WIN_scene_markerXXX 26 | ;------------------------------------------- 27 | 28 | #define GL_WIN_scene_markerXXX 1 29 | 30 | 31 | ;------------------------------------------- 32 | ;-- GL_WIN_specular_fog 33 | ;------------------------------------------- 34 | 35 | #define GL_WIN_specular_fog 1 36 | #define GL_FOG_SPECULAR_TEXTURE_WIN 80ECh 37 | 38 | 39 | ;------------------------------------------- 40 | ;-- GL_WIN_swap_hint 41 | ;------------------------------------------- 42 | 43 | #define GL_WIN_swap_hint 1 44 | ;@@ void ( GLint x, GLint y, GLsizei width, GLsizei height ); 45 | glAddSwapHintRectWIN!: alias function! [ 46 | x [ GLint! ] 47 | y [ GLint! ] 48 | width [ GLsizei! ] 49 | height [ GLsizei! ] 50 | ] 51 | -------------------------------------------------------------------------------- /Library/OpenGL/gl-extensions.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "Red/System OpenGL complete extensions include" 3 | Author: "Oldes" 4 | File: %gl-extensions.reds 5 | Rights: "Copyright (C) 2017 David 'Oldes' Oliva. All rights reserved." 6 | License: "BSD-3 - https://github.com/red/red/blob/master/BSD-3-License.txt" 7 | Note: {You probably don't need to include all extensions and so use this file.} 8 | ] 9 | 10 | #include %extensions/gl-3DFX.reds 11 | #include %extensions/gl-AMD.reds 12 | #include %extensions/gl-ANDROID.reds 13 | #include %extensions/gl-ANGLE.reds 14 | #include %extensions/gl-APPLE.reds 15 | #include %extensions/gl-ARB.reds 16 | #include %extensions/gl-ARM.reds 17 | #include %extensions/gl-ATIX.reds 18 | #include %extensions/gl-ATI.reds 19 | #include %extensions/gl-EGL.reds 20 | #include %extensions/gl-EXT.reds 21 | #include %extensions/gl-GREMEDY.reds 22 | #include %extensions/gl-HP.reds 23 | #include %extensions/gl-IBM.reds 24 | #include %extensions/gl-INGR.reds 25 | #include %extensions/gl-INTEL.reds 26 | #include %extensions/gl-KHR.reds 27 | #include %extensions/gl-KTX.reds 28 | #include %extensions/gl-MESAX.reds 29 | #include %extensions/gl-MESA.reds 30 | #include %extensions/gl-NVX.reds 31 | #include %extensions/gl-NV.reds 32 | #include %extensions/gl-OES.reds 33 | #include %extensions/gl-OML.reds 34 | #include %extensions/gl-OVR.reds 35 | #include %extensions/gl-PGI.reds 36 | #include %extensions/gl-QCOM.reds 37 | #include %extensions/gl-REGAL.reds 38 | #include %extensions/gl-REND.reds 39 | #include %extensions/gl-S3.reds 40 | #include %extensions/gl-SGIS.reds 41 | #include %extensions/gl-SGIX.reds 42 | #include %extensions/gl-SGI.reds 43 | #include %extensions/gl-SUNX.reds 44 | #include %extensions/gl-SUN.reds 45 | #include %extensions/gl-WIN.reds 46 | -------------------------------------------------------------------------------- /Library/Portaudio/examples/pa-info.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "Red/System Portaudio info" 3 | Author: "Oldes" 4 | File: %pa-info.reds 5 | Rights: "Copyright (C) 2017 David 'Oldes' Oliva. All rights reserved." 6 | License: "BSD-3 - https:;//github.com/red/red/blob/master/BSD-3-License.txt" 7 | ] 8 | 9 | #include %../portaudio.reds 10 | 11 | print-line ["version: " Pa_GetVersion " => " Pa_GetVersionText] 12 | paInfo: Pa_GetVersionInfo 13 | print-line [paInfo/versionMajor #"." paInfo/versionMinor #"." paInfo/versionSubMinor] 14 | 15 | res: Pa_Initialize 16 | 17 | if paNoError <> res [ 18 | print-line ["PA initialization failed: " res " - " Pa_GetErrorText res] 19 | quit -1 20 | ] 21 | 22 | apiCount: Pa_GetHostApiCount 23 | print-line ["Pa_GetHostApiCount: " apiCount " default: " Pa_GetDefaultHostApi] 24 | 25 | apiInfo: declare PaHostApiInfo! 26 | deviceInfo: declare PaDeviceInfo! 27 | 28 | n: 0 m: 0 i: 0 num: 0 29 | while [n < apiCount][ 30 | apiInfo: Pa_GetHostApiInfo n 31 | print-line ["### HostApiInfo [" n #"]"] 32 | print-line ["^-structVersion: " apiInfo/structVersion] 33 | print-line ["^-type: " apiInfo/type] 34 | print-line ["^-name: " apiInfo/name] 35 | num: apiInfo/deviceCount 36 | print-line ["^-deviceCount: " num] 37 | print-line ["^-defaultInputDevice: " apiInfo/defaultInputDevice] 38 | print-line ["^-defaultOutputDevice: " apiInfo/defaultOutputDevice] 39 | 40 | ;list device infos: 41 | m: 0 42 | while [m < num][ 43 | i: Pa_HostApiDeviceIndexToDeviceIndex n m 44 | deviceInfo: Pa_GetDeviceInfo i 45 | 46 | print-line ["^-### DeviceInfo [" m " / " i #"]"] 47 | print-line ["^-^-name: " deviceInfo/name] 48 | print-line ["^-^-maxInputChannels: " deviceInfo/maxInputChannels] 49 | print-line ["^-^-maxOutputChannels: " deviceInfo/maxOutputChannels] 50 | print-line ["^-^-defaultLowInputLatency: " deviceInfo/defaultLowInputLatency] 51 | print-line ["^-^-defaultLowOutputLatency: " deviceInfo/defaultLowOutputLatency] 52 | print-line ["^-^-defaultHighInputLatency: " deviceInfo/defaultHighInputLatency] 53 | print-line ["^-^-defaultHighOutputLatency: " deviceInfo/defaultHighOutputLatency] 54 | print-line ["^-^-defaultSampleRate: " deviceInfo/defaultSampleRate] 55 | m: m + 1 56 | print lf 57 | ] 58 | 59 | n: n + 1 60 | print lf 61 | ] 62 | 63 | print-line ["DirectSound API index: " Pa_HostApiTypeIdToHostApiIndex paDirectSound lf] 64 | 65 | deviceCount: Pa_GetDeviceCount 66 | print-line ["Pa_GetDeviceCount: " deviceCount 67 | " defaultIn: " Pa_GetDefaultInputDevice 68 | " defaultOut: " Pa_GetDefaultOutputDevice 69 | ] 70 | 71 | Pa_Terminate -------------------------------------------------------------------------------- /Library/Portaudio/examples/pa-saw.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "Red/System Portaudio play a simple (aliasing) sawtooth wave example" 3 | Purpose: "Play a simple (aliasing) sawtooth wave." 4 | Author: "Oldes" 5 | File: %pa-saw.reds 6 | Rights: "Copyright (C) 2017 David 'Oldes' Oliva. All rights reserved." 7 | License: "BSD-3 - https:;//github.com/red/red/blob/master/BSD-3-License.txt" 8 | Comment: { 9 | This code is port of original work: 10 | @file paex_saw.c 11 | @ingroup examples_src 12 | @brief Play a simple (aliasing) sawtooth wave. 13 | @author Phil Burk http://www.softsynth.com 14 | } 15 | ] 16 | 17 | #define NUM_SECONDS 5 18 | #define SAMPLE_RATE 44100 19 | #define FRAMES_PER_BUFFER 64 20 | 21 | #include %../portaudio.reds 22 | 23 | if paNoError <> Pa_Initialize [ 24 | "Portaudio failed to initialize!" 25 | quit -1 26 | ] 27 | 28 | onError: func[err [integer!]][ 29 | print-line ["Portaudio ERROR[" err "]: " Pa_GetErrorText err] 30 | Pa_Terminate 31 | quit -1 32 | ] 33 | 34 | testData!: alias struct! [ 35 | phase-left [float32!] 36 | phase-right [float32!] 37 | pitch-left [float32!] 38 | pitch-right [float32!] 39 | ] 40 | 41 | paTestCallback: func[[cdecl] 42 | inputBuffer [int-ptr!] 43 | outputBuffer [int-ptr!] 44 | frameCount [integer!] 45 | timeInfo [PaStreamCallbackTimeInfo!] 46 | statusFlags [PaStreamCallbackFlags!] 47 | userData [byte-ptr!] 48 | return: [integer!] 49 | /local data out i pl pr 50 | ][ 51 | data: as testData! userData 52 | out: as pointer! [float32!] outputBuffer 53 | i: 0 54 | pl: data/phase-left 55 | pr: data/phase-right 56 | while [i < frameCount][ 57 | out/1: pl 58 | out/2: pr 59 | pl: pl + data/pitch-left 60 | pr: pr + data/pitch-right 61 | if pl >= as float32! 1.0 [ pl: pl - as float32! 2.0 ] 62 | if pr >= as float32! 1.0 [ pr: pr - as float32! 2.0 ] 63 | out: out + 2 64 | i: i + 1 65 | ] 66 | data/phase-left: pl 67 | data/phase-right: pr 68 | paContinue 69 | ] 70 | 71 | playSound: func[ 72 | /local 73 | userData 74 | err 75 | stream-ref stream 76 | ][ 77 | userData: as testData! allocate size? testData! 78 | userData/phase-left: as float32! 0.0 79 | userData/phase-right: as float32! 0.0 80 | userData/pitch-left: as float32! 0.01 81 | userData/pitch-right: as float32! 0.03 82 | 83 | stream-ref: declare PaStream-ptr! 84 | 85 | err: Pa_OpenDefaultStream 86 | stream-ref 87 | 0 ;no inputchannels 88 | 2 ;stereo output 89 | paFloat32 ;32 bit floating point output 90 | as float! SAMPLE_RATE 91 | FRAMES_PER_BUFFER 92 | :paTestCallback 93 | as byte-ptr! userData 94 | if err <> paNoError [ onError err ] 95 | 96 | stream: stream-ref/value 97 | 98 | err: Pa_StartStream stream 99 | if err <> paNoError [ onError err ] 100 | 101 | print-line ["Play for " NUM_SECONDS " seconds."] 102 | Pa_Sleep NUM_SECONDS * 1000 103 | 104 | err: Pa_StopStream stream 105 | if err <> paNoError [ onError err ] 106 | 107 | err: Pa_CloseStream stream 108 | if err <> paNoError [ onError err ] 109 | 110 | ] 111 | 112 | playSound 113 | 114 | Pa_Terminate 115 | -------------------------------------------------------------------------------- /Library/README.md: -------------------------------------------------------------------------------- 1 | # Library 2 | 3 | This is a collection of useful Library functions and modules that can be included in Red programs. Its two sub-sections are Red and Red/System. All library functions and modules have API documentation. 4 | -------------------------------------------------------------------------------- /Library/Red/libred-test.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "Red/System Red binding" 3 | Author: "Oldes" 4 | File: %red.reds 5 | Rights: "Copyright (C) 2017 David 'Oldes' Oliva. All rights reserved." 6 | License: "BSD-3 - https://github.com/red/red/blob/master/BSD-3-License.txt" 7 | ] 8 | 9 | #include %red.reds 10 | 11 | print-line "libred test started" 12 | 13 | my-add: func[ 14 | [cdecl] 15 | "Test libRed routine" 16 | a [red_integer!] 17 | b [red_integer!] 18 | return: [red_integer!] 19 | /local ca cb 20 | ][ 21 | ca: redCInt32 a 22 | cb: redCInt32 b 23 | redPrint redString "my-add called" 24 | redPrint a ;@@ prints: integer ?! 25 | redPrint b ;@@ prints: false ?! 26 | printf ["add called! %ld %ld^/" ca cb] ;@@ this is not visible either:/ 27 | return redInteger (ca + cb) 28 | ] 29 | 30 | redOpen 31 | 32 | print-line "redOpen done" ;@@ this is not visible, why? 33 | 34 | ;some cryptic code from libred's test.c file 35 | a: redSymbol "a" 36 | o_b_2: redSymbol "o_b_2" 37 | o_b: redSymbol "o_b" 38 | b: redSymbol "b" 39 | 40 | redSet o_b redLoadPath "o/b" 41 | redDo "?? o_b" 42 | redSet o_b_2 redPath redWord "o" redWord "b" redInteger 2 0 43 | 44 | redSet a redBlock [redInteger 42 redString "hello" 0] 45 | redDo "?? a foreach v a [probe v]" 46 | redPrint redGet a 47 | 48 | redProbe redCall [redWord "what-dir" 0] 49 | redCall [redWord "print" redDo "system/version" 0] 50 | 51 | redPrint redString "This is test of error in redDo:" 52 | value: redDo "$%$" 53 | if RED_TYPE_ERROR = redTypeOf value [ redProbe value ] 54 | 55 | redRoutine redWord "my-add" "[a [integer!] b [integer!]]" as integer! :my-add 56 | err: redHasError 57 | either null <> err [ 58 | redPrint err 59 | ][ 60 | redDo "probe my-add 2 3 probe :my-add" 61 | ] 62 | 63 | 64 | rb: redBinary "hello" 5 65 | redProbe rb 66 | redSet b rb 67 | redDo {probe to-string b} 68 | 69 | ;more fancy code: 70 | redDo {view layout [button "hello" [print now] button "quit" [unview]]} 71 | 72 | redClose 73 | 74 | print-line "done" -------------------------------------------------------------------------------- /Library/SQLite/README.md: -------------------------------------------------------------------------------- 1 | # Red-SQLite 2 | SQLite binding for Red and Red/System 3 | 4 | --- 5 | SQLite is an in-process library that implements a self-contained, serverless, zero-configuration, transactional SQL database engine. 6 | 7 | Purpose of this project is to provide access to **SQLite API** from Red/System and Red language. 8 | 9 | [SQLite3.reds](SQLite3.reds) is full low level API for **Red/System** made by parsing of SQLite3 header file (v3.20.1) with manual review. 10 | [SQLite3.red](SQLite3.red) is minimal binding with dialect for **Red** level and could be used as a starting point for more complex work. 11 | 12 | It's possible that more actual version could be found in [this standalone GitHub project](https://github.com/Oldes/Red-SQLite). 13 | -------------------------------------------------------------------------------- /Library/SQLite/SQLite3-test-basic.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "Red/System SQLite3 binding - test file - with minimal" 3 | Purpose: "This test does not use any calls which are in recent SQLite versions" 4 | Author: "Oldes" 5 | File: %SQLite3-test-basic.reds 6 | Rights: "Copyright (C) 2017 David 'Oldes' Oliva. All rights reserved." 7 | License: "BSD-3 - https:;//github.com/red/red/blob/master/BSD-3-License.txt" 8 | ] 9 | 10 | #include %SQLite3.reds 11 | 12 | db: declare sqlite3! 13 | db-ptr: declare sqlite3-ptr! 14 | errmsg: declare string-ptr! 15 | data: declare int-ptr! 16 | str: declare c-string! 17 | 18 | status: 0 19 | 20 | ptr: declare int-ptr! 21 | 22 | #define TEST_ERROR(db sql) [ 23 | if SQLITE_OK <> status [ 24 | print-line ["^/***ERROR: " sqlite3_errmsg db] 25 | print-line ["In query: " sql] 26 | ] 27 | ] 28 | 29 | #define DO_SQL(db sql) [ 30 | data/value: 0 31 | status: sqlite3_exec db sql :on-row data errmsg 32 | TEST_ERROR(db sql) 33 | ] 34 | 35 | on-row: function [[cdecl] 36 | "Process a result row." 37 | data [int-ptr!] 38 | columns [integer!] 39 | values [string-ptr!] 40 | names [string-ptr!] 41 | return: [integer!] 42 | ][ 43 | data/value: data/value + 1 44 | print ["ROW[" data/value "]: "] 45 | 46 | ; Print all name/value pairs of the columns that have values 47 | 48 | while [columns > 0] [ 49 | if as-logic values/value [ 50 | print [names/value ": " values/value #"^-"] 51 | ] 52 | columns: columns - 1 53 | names: names + 1 54 | values: values + 1 55 | ] 56 | print newline 57 | 58 | SQLITE_OK ; Keep processing 59 | ] 60 | 61 | on-trace: function [[cdecl] 62 | data [int-ptr!] 63 | name [c-string!] 64 | ][ 65 | print-line ["TRACE[" name "]"] 66 | ] 67 | 68 | 69 | print-line ["sqlite3_libversion: " sqlite3_libversion] 70 | print-line ["sqlite3_sourceid: " sqlite3_sourceid] 71 | print-line ["sqlite3_libversion_number: " sqlite3_libversion_number] 72 | 73 | status: sqlite3_initialize 74 | either SQLITE_OK <> status [ 75 | print-line ["SQLite init failed with status: " status] 76 | ][ 77 | status: sqlite3_open "test.db" db-ptr 78 | if SQLITE_OK = status [ 79 | db: db-ptr/value 80 | print-line ["DB: " db] 81 | 82 | sqlite3_trace db :on-trace null 83 | 84 | DO_SQL(db { 85 | BEGIN TRANSACTION; 86 | DROP TABLE IF EXISTS Cars; 87 | CREATE TABLE Cars(Id INTEGER PRIMARY KEY, Name TEXT, Price INTEGER); 88 | INSERT INTO "Cars" VALUES(1,'Audi',52642); 89 | INSERT INTO "Cars" VALUES(2,'Mercedes',57127); 90 | INSERT INTO "Cars" VALUES(3,'Skoda',9000); 91 | }) 92 | DO_SQL(db { 93 | INSERT INTO "Cars" VALUES(4,'Volvo',29000); 94 | INSERT INTO "Cars" VALUES(5,'Bentley',350000); 95 | INSERT INTO "Cars" VALUES(6,'Citroen',21000); 96 | INSERT INTO "Cars" VALUES(7,'Hummer',41400); 97 | COMMIT; 98 | }) 99 | DO_SQL(db {INSERT INTO "Cars" VALUES(null,'Hummer',41400);}) 100 | 101 | print-line ["=== " data/value] 102 | 103 | DO_SQL(db {INSERT INTO "Cars" VALUES(43,'zHummer','100');}) 104 | DO_SQL(db {INSERT INTO "Cars" VALUES(null,'zHummer',0);}) 105 | print-line ["=== " data/value] 106 | 107 | DO_SQL(db "SELECT last_insert_rowid();") 108 | 109 | DO_SQL(db "SELECT name FROM sqlite_master WHERE type='table' ORDER BY name") 110 | print-line ["=== " data/value] 111 | DO_SQL(db "SELECT * FROM Cars ORDER BY name") 112 | print-line ["=== " data/value] 113 | 114 | print-line "^/Testing errors:" 115 | DO_SQL(db "SELECT * FROM Foo ORDER BY name") 116 | DO_SQL(db "CREATE TABLE Cars();") 117 | 118 | print-line "^/^/Formating SQL:" 119 | str: sqlite3_mprintf ["INSERT INTO table VALUES(%Q, %d)" "Fo'o" 42] 120 | print-line str 121 | 122 | sqlite3_close db 123 | ] 124 | 125 | sqlite3_shutdown 126 | ] 127 | -------------------------------------------------------------------------------- /Library/SQLite/SQLite3-test.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | Title: "Red SQLite3 binding test" 3 | Author: "Oldes" 4 | File: %SQLite3-test.red 5 | Rights: "Copyright (C) 2017 David 'Oldes' Oliva. All rights reserved." 6 | License: "BSD-3 - https:;//github.com/red/red/blob/master/BSD-3-License.txt" 7 | ] 8 | 9 | #include %SQLite3.red 10 | 11 | result: make block! 32 ;preallocating block for results 12 | 13 | SQLite/do [ 14 | db1: open %test.db 15 | trace 3 ;0 = nothing, 0Fh = trace everything, 3 = SQLITE_TRACE_STMT or SQLITE_TRACE_PROFILE 16 | db2: open %test2.db trace 0Fh ;opening second db just for test purposes 17 | use :db1 ;this is just a test if the "current db" is not corrupted... 18 | close :db2 ;... by closing another db 19 | exec { 20 | BEGIN TRANSACTION; 21 | DROP TABLE IF EXISTS Cars; 22 | CREATE TABLE Cars(Id INTEGER PRIMARY KEY, Name TEXT, Price INTEGER); 23 | INSERT INTO "Cars" VALUES(1,'Audi',52642); 24 | INSERT INTO "Cars" VALUES(2,'Mercedes',57127); 25 | INSERT INTO "Cars" VALUES(3,'Skoda',9000); 26 | INSERT INTO "Cars" VALUES(4,'Volvo',29000); 27 | INSERT INTO "Cars" VALUES(5,'Bentley',350000); 28 | INSERT INTO "Cars" VALUES(6,'Citroen',21000); 29 | INSERT INTO "Cars" VALUES(7,'Hummer',41400); 30 | COMMIT; 31 | } 32 | exec {INSERT INTO "Cars" VALUES(null,'Hummer',null);} 33 | exec "SELECT last_insert_rowid();" 34 | exec "SELECT name FROM sqlite_master WHERE type='table' ORDER BY name" 35 | result: exec "SELECT * FROM Cars ORDER BY name" 36 | ] 37 | 38 | print ["^/Raw data result:" mold result lf] 39 | 40 | 41 | print " ID | NAME | PRICE" 42 | print " ########################" 43 | foreach [row id name price] result [ 44 | print [ 45 | #" " 46 | pad id 2 #"|" 47 | pad name 8 #"|" 48 | price 49 | ] 50 | ] 51 | 52 | ;`exec` command appends data into given block, so we clear old data now: 53 | clear result 54 | 55 | ;just a test to show that multiple execs appends data into result: 56 | SQLite/do [ 57 | result: exec "SELECT random();" 58 | result: exec "SELECT hex(randomblob(16));" 59 | ] 60 | 61 | print ["^/Raw data result:" mold result lf] 62 | print rejoin ["Random number: " result/2 " blob: #{" result/4 #"}"] 63 | 64 | ;it is also possible to use just: 65 | print ["^/Tables:" mold SQLite/query "SELECT name FROM sqlite_master WHERE type='table' ORDER BY name"] 66 | 67 | SQLite/free ;closes all opened DBs and frees SQLite resources 68 | 69 | -------------------------------------------------------------------------------- /Library/SWF/swf-tool.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | Title: "SWF-tool" 3 | Purpose: "Simple gui tool for investigating SWF files" 4 | Author: "Oldes" 5 | File: %swf-tool.red 6 | Tabs: 4 7 | Rights: "Copyright (C) 2017 Oldes. All rights reserved." 8 | License: { 9 | Distributed under the Boost Software License, Version 1.0. 10 | See https://github.com/red/red/blob/master/BSL-License.txt 11 | } 12 | Needs: View 13 | ] 14 | 15 | #include %swf-io.red 16 | 17 | fixed-font: make font! [ 18 | name: pick ["Fixedsys" "Consolas"] make logic! find [5.1.0 5.0.0] system/view/platform/version 19 | size: 10 20 | anti-alias?: no 21 | ] 22 | 23 | swf-tool: func[ 24 | /local tag-line offset list detail 25 | ][ 26 | swf/open %mlok.swf 27 | tags: swf/query/tags/verbose 2 28 | tags: split tags #"^/" 29 | 30 | view main: layout [ 31 | list: text-list 450x600 data :tags font fixed-font [ 32 | swf/set-verbose 4 33 | swf/set-actions FFFFFFFFh 34 | offset: load/part pick tags face/selected 9 35 | clear detail/text 36 | swf/parse-tag offset detail/text 37 | detail/text: detail/text ;forcing update 38 | ] 39 | detail: area 650x600 "" font fixed-font 40 | ] 41 | ] 42 | 43 | swf-tool 44 | -------------------------------------------------------------------------------- /Library/SWF/swf-tool.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "SWF tool - Red/System version" 3 | Purpose: "Just a simple test. So far it displays some info about given SWF file" 4 | Author: "Oldes" 5 | File: %swf-tool.reds 6 | Tabs: 4 7 | Rights: "Copyright (C) 2017 Oldes. All rights reserved." 8 | License: { 9 | Distributed under the Boost Software License, Version 1.0. 10 | See https://github.com/red/red/blob/master/BSL-License.txt 11 | } 12 | ] 13 | 14 | #include %../os/time-elapsed.reds 15 | #include %swf-io.reds 16 | 17 | #include %../os/definitions.reds ;common aliases and defines 18 | 19 | #import [ 20 | LIBC-file cdecl [ 21 | strtol: "strtol" [ 22 | ;converts the initial part of the string to integer 23 | string [c-string!] 24 | endptr [string-ptr!] 25 | base [integer!] 26 | return: [integer!] 27 | ] 28 | strcmp: "strcmp" [ 29 | ;Return string comparison. 30 | string-1 [c-string!] 31 | string-2 [c-string!] 32 | return: [integer!] 33 | ] 34 | ] 35 | ] 36 | 37 | #define IS_ARG?(arg) [0 = strcmp value arg] 38 | 39 | help-text: { 40 | Usage: swf-tool [OPTIONS] file [file]... 41 | Extracts information and/or data from given Flash (SWF) file. 42 | 43 | -h, --help Prints this info 44 | -v, --verbose NUM Level of output verbosity (0-2) default: 2 45 | 46 | Extract action displays: 47 | --header SWF file header info 48 | --tags List of tags [tagID offset bytes] 49 | --exports List of exported names [id name] 50 | --bitmaps Bitmaps related tags info (TODO) 51 | --sounds Sounds related tags info (TODO) 52 | 53 | } 54 | 55 | do-input: func [ 56 | /local 57 | argument [str-array!] 58 | value [c-string!] 59 | file-name [c-string!] 60 | result [c-string!] 61 | i [integer!] 62 | str* actions n 63 | ][ 64 | n: 1 65 | str*: declare string-ptr! 66 | actions: 0 67 | file-name: null 68 | 69 | while [n < system/args-count][ 70 | argument: system/args-list + n 71 | value: argument/item 72 | case [ 73 | any [ 74 | IS_ARG?("-h") 75 | IS_ARG?("--help") 76 | ][ 77 | print-line help-text 78 | quit 0 79 | ] 80 | any [ 81 | IS_ARG?("-v") 82 | IS_ARG?("--verbose") 83 | ][ 84 | n: n + 1 85 | argument: system/args-list + n 86 | swf/verbose: strtol argument/item str* 10 87 | if 0 < length? str*/value [ 88 | print-line ["Invalid verbose level: " argument/item] 89 | quit 1 90 | ] 91 | ] 92 | IS_ARG?("--header") [ actions: actions or swf/EXTRACT_HEADER ] 93 | IS_ARG?("--tags") [ actions: actions or swf/EXTRACT_TAGS ] 94 | IS_ARG?("--exports") [ actions: actions or swf/EXTRACT_EXPORTS ] 95 | IS_ARG?("--bitmaps") [ actions: actions or swf/EXTRACT_BITMAPS ] 96 | IS_ARG?("--sounds") [ actions: actions or swf/EXTRACT_SOUNDS ] 97 | true [ 98 | break ;continue processing file names 99 | ] 100 | ] 101 | n: n + 1 102 | ] 103 | 104 | swf/tag-actions: either actions > 0 [actions][FFFFFFFFh] 105 | i: 0 106 | while [n < system/args-count][ 107 | argument: system/args-list + n 108 | value: argument/item 109 | print-line [";##### Input file: " value lf] 110 | if 1 = swf/open value [ 111 | result: swf/parse 112 | print-line result 113 | swf/close 114 | i: i + 1 115 | ] 116 | n: n + 1 117 | ] 118 | 119 | print ["Processed " i ] 120 | either i = 1 [print " file"][print " files"] 121 | print [" in time: " time-elapsed " seconds" lf] 122 | ] 123 | 124 | do-input 125 | -------------------------------------------------------------------------------- /Library/Sockets/examples/get-local-ip.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "Red/System - Get source IP of system" 3 | Author: "Oldes" 4 | File: %get-local-ip.reds 5 | Rights: "Copyright (C) 2017 David 'Oldes' Oliva. All rights reserved." 6 | License: "BSD-3 - https://github.com/red/red/blob/master/BSD-3-License.txt" 7 | ] 8 | 9 | #include %../sockets.reds 10 | 11 | get-local-ip: func[ 12 | return: [c-string!] 13 | /local sock serv name len ip 14 | ][ 15 | sock: sockets/make-socket AF_INET SOCK_DGRAM 0 16 | serv: declare sockaddr! 17 | name: declare sockaddr! 18 | len: size? sockaddr! 19 | 20 | sockets/init-address serv inet_addr "8.8.8.8" 53 21 | 22 | connect sock serv len 23 | ip: either 0 > getsockname sock name :len [0][name/ip] 24 | closesocket sock 25 | 26 | inet_ntoa ip ;converts numeric IP value into doted string 27 | ] 28 | 29 | print-line ["Your local IP address is: " get-local-ip ] 30 | sockets/dispose -------------------------------------------------------------------------------- /Library/Sockets/examples/read-url.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "Red/System - Read URL example" 3 | Purpose: {Decodes input argument as URL and tries to read it using HTTP request} 4 | Author: "Oldes" 5 | File: %read-url.reds 6 | Rights: "Copyright (C) 2017 David 'Oldes' Oliva. All rights reserved." 7 | License: "BSD-3 - https://github.com/red/red/blob/master/BSD-3-License.txt" 8 | ] 9 | 10 | #include %../../os/datatypes/url.reds ;includes Sockets 11 | 12 | main: func [ 13 | /local bytes arg url result data tmp 14 | ][ 15 | either system/args-count = 2 [ 16 | arg: system/args-list + 1 17 | bytes: 0 18 | url: declare url! 19 | 20 | print-line ["Input url: " arg/item] 21 | 22 | decode-url arg/item url 23 | probe-url url 24 | result: read-url url :bytes 25 | print-line ["^/Read finished, received bytes: " bytes] 26 | 27 | print "---------------------------------------------------^/" 28 | 29 | if result = null [ exit ] 30 | 31 | data: strstr as c-string! result "^M^/^M^/" ;finds HTTP header end 32 | if data = null [ 33 | print-line ["*** Result does not contain valid HTTP response!"] 34 | exit 35 | ] 36 | data/1: #"^@" data: data + 4 ;marks header tail and moves data at proper start position 37 | print-line as c-string! result ;prints header 38 | 39 | print "---------------------------------------------------^/" 40 | 41 | ;just a naive test if result is a text. 42 | tmp: strstr as c-string! result "^M^/Content-Type: text/" 43 | either tmp = null [ 44 | print-line "Result seems not to be in text format." 45 | ][ 46 | either bytes > (1024 * 20) [ 47 | print-line "Result quite large to print." 48 | ][ print-line data ] 49 | ] 50 | ][ 51 | print-line "Usage: read-url " 52 | ] 53 | ] 54 | 55 | main 56 | 57 | sockets/dispose -------------------------------------------------------------------------------- /Library/Sockets/examples/tcp-client.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "Red/System - tcp-client sockets example" 3 | Author: "Oldes" 4 | File: %tcp-client.reds 5 | Rights: "Copyright (C) 2017 David 'Oldes' Oliva. All rights reserved." 6 | License: "BSD-3 - https://github.com/red/red/blob/master/BSD-3-License.txt" 7 | Note: {Based on tutorial: http://www.binarytides.com/udp-socket-programming-in-winsock/} 8 | ] 9 | 10 | #include %../sockets.reds 11 | 12 | buffer-bytes: 512 13 | buffer: allocate buffer-bytes 14 | 15 | bytes: 0 ;will hold number of bytes to send/receive 16 | received: 0 ;will hold number of received bytes 17 | n: 0 ;message counter 18 | 19 | ;- Define main communication functions 20 | 21 | receive-message: func[return: [logic!]] [ 22 | received: recv s buffer buffer-bytes - 1 0 ;buffer bytes decreesed so I can add null char to mark a string end 23 | either received < 0 [ 24 | either sockets/get-error = 10054 [ 25 | print-line "Connection reset by peer." 26 | ][ 27 | print-line ["`recv` failed with error: " sockets/get-error] 28 | ] 29 | false 30 | ][ 31 | bytes: received + 1 buffer/bytes: #"^@" ;mark end of received string 32 | print-line ["Server reply with: " as c-string! buffer] 33 | true 34 | ] 35 | ] 36 | send-message: func[text [byte-ptr!] bytes [integer!]][ 37 | print-line ["Sending message: " as c-string! text] 38 | send s buffer bytes 0 39 | ] 40 | 41 | ;- Create a socket 42 | 43 | s: sockets/make-socket AF_INET SOCK_STREAM 0 44 | if s = null [ 45 | print-line ["Could not create socket: " sockets/get-error] 46 | quit 1 47 | ] 48 | print "Socket created.^/" 49 | 50 | ;- Connect to specified adress 51 | 52 | address: sockets/make-address inet_addr "127.0.0.1" 8080 53 | address-bytes: size? address 54 | 55 | if 0 > connect s address address-bytes [ 56 | print-line ["`connect` failed with error: " sockets/get-error] 57 | quit 1 58 | ] 59 | 60 | print "Connected^/" 61 | 62 | ;- Send first message 63 | 64 | message: "Is anybody at home?" 65 | send-message as byte-ptr! message length? message 66 | either receive-message [ 67 | ;server answered, so lets send him something more 68 | n: 0 69 | while[n < 10] [ ;try to send 10 messages 70 | n: n + 1 71 | 72 | ;- send message to specified address: 73 | 74 | bytes: sprintf [buffer "Hello Red n.%i" n ] 75 | send-message buffer bytes 76 | 77 | ;- receive a reply and print it: 78 | 79 | if not receive-message [ 80 | break 81 | ] 82 | ] 83 | ][ 84 | print-line "Something went wrong!" 85 | ] 86 | 87 | ;- Clean resources 88 | 89 | FREE_MEMORY(buffer) 90 | FREE_MEMORY(address) 91 | 92 | closesocket s 93 | sockets/dispose 94 | -------------------------------------------------------------------------------- /Library/Sockets/examples/udp-client.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "Red/System - udp-client sockets example" 3 | Author: "Oldes" 4 | File: %udp-client.reds 5 | Rights: "Copyright (C) 2017 David 'Oldes' Oliva. All rights reserved." 6 | License: "BSD-3 - https://github.com/red/red/blob/master/BSD-3-License.txt" 7 | Note: {Based on tutorial: http://www.binarytides.com/udp-socket-programming-in-winsock/} 8 | ] 9 | 10 | #include %../sockets.reds 11 | 12 | s: sockets/make-socket AF_INET SOCK_DGRAM IPPROTO_UDP 13 | if s = null [ 14 | print-line ["Could not create socket: " sockets/get-error] 15 | quit 1 16 | ] 17 | print "Socket created.^/" 18 | 19 | address: sockets/make-address inet_addr "127.0.0.1" 8888 20 | address-bytes: size? address 21 | 22 | buffer-bytes: 512 23 | buffer: allocate buffer-bytes 24 | 25 | bytes: 0 ;will hold number of bytes to send 26 | received: 0 ;will hold number of received bytes 27 | 28 | n: 0 29 | while[n < 10] [ 30 | n: n + 1 31 | 32 | ;- send message to specified address: 33 | 34 | ZERO_MEMORY(buffer buffer-bytes) ;clears output buffer 35 | 36 | bytes: sprintf [buffer "Hello Red n.%i" n ] 37 | 38 | print-line ["Sending message[" n "]: " as c-string! buffer] 39 | 40 | if SOCKET_ERROR = sendto s buffer bytes 0 address address-bytes [ 41 | print-line ["`sendto` failed with error: " sockets/get-error] 42 | quit 1 43 | ] 44 | 45 | ;- receive a reply and print it: 46 | 47 | ZERO_MEMORY(buffer buffer-bytes) ;clears input buffer 48 | 49 | received: recvfrom s buffer buffer-bytes 0 address :address-bytes 50 | if received < 0 [ 51 | print-line ["`recvfrom` failed with error: " sockets/get-error] 52 | quit 1 53 | ] 54 | print-line ["Received packet with: " as c-string! buffer] 55 | 56 | ] 57 | 58 | FREE_MEMORY(buffer) 59 | FREE_MEMORY(address) 60 | 61 | closesocket s 62 | sockets/dispose 63 | -------------------------------------------------------------------------------- /Library/Sockets/examples/udp-server.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "Red/System - udp-server example" 3 | Author: "Oldes" 4 | File: %udp-server.reds 5 | Rights: "Copyright (C) 2017 David 'Oldes' Oliva. All rights reserved." 6 | License: "BSD-3 - https://github.com/red/red/blob/master/BSD-3-License.txt" 7 | Note: {Based on tutorial: http://www.binarytides.com/udp-socket-programming-in-winsock/} 8 | ] 9 | 10 | #include %../sockets.reds 11 | 12 | s: sockets/make-socket AF_INET SOCK_DGRAM 0 13 | if s = null [ 14 | print-line ["Could not create socket: " sockets/get-error] 15 | quit 1 16 | ] 17 | print "Socket created.^/" 18 | 19 | server: sockets/make-server s INADDR_ANY 8888 20 | 21 | if server = null [ 22 | print-line ["Bind failed with error: " sockets/get-error] 23 | quit 1 24 | ] 25 | 26 | print "Bind done^/" 27 | 28 | address: sockets/make-address inet_addr "127.0.0.1" 8888 29 | address-bytes: size? address 30 | 31 | buffer-bytes: 512 32 | buffer: allocate buffer-bytes 33 | 34 | bytes: 0 ;will hold number of bytes to send 35 | received: 0 ;will hold number of received bytes 36 | error: 0 37 | forever [ 38 | ZERO_MEMORY(buffer buffer-bytes) 39 | 40 | received: recvfrom s buffer buffer-bytes 0 address :address-bytes 41 | either received < 0 [ 42 | error: sockets/get-error 43 | switch error [ 44 | 10054 [ 45 | print-line "Connection reset by peer." 46 | ] 47 | default [ 48 | print-line ["`recvfrom` failed with error: " error " received: " received] 49 | ] 50 | ] 51 | 52 | ][ 53 | print-line [ 54 | "Received packet from: " inet_ntoa address/ip #":" ntohs (server/family-port >> 16) 55 | " with: " as c-string! buffer 56 | ] 57 | 58 | if SOCKET_ERROR = sendto s buffer received 0 address address-bytes [ 59 | print-line ["`sendto` failed with error: " sockets/get-error] 60 | ] 61 | ] 62 | ] 63 | 64 | FREE_MEMORY(buffer) 65 | FREE_MEMORY(server) 66 | FREE_MEMORY(address) 67 | 68 | closesocket s 69 | sockets/dispose -------------------------------------------------------------------------------- /Library/Sockets/sockets.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "Red/System - crossplaform Sockets binding" 3 | Author: "Oldes" 4 | File: %sockets.reds 5 | Rights: "Copyright (C) 2017 David 'Oldes' Oliva. All rights reserved." 6 | License: "BSD-3 - https://github.com/red/red/blob/master/BSD-3-License.txt" 7 | Note: {Based on tutorial: http://www.binarytides.com/udp-socket-programming-in-winsock/} 8 | ] 9 | 10 | #include %sockets-core.reds 11 | 12 | sockets: context [ 13 | error: 0 ;just a variable to hold last returned error code 14 | 15 | #if OS = 'Windows [ 16 | 17 | wsa: as WSAData! allocate 400 ;= declare WSAData! 18 | wsa/version: 0 ; not initialized yet 19 | 20 | init: func[ 21 | major [integer!] 22 | minor [integer!] 23 | return: [logic!] 24 | /local version 25 | ][ 26 | version: declare integer16! ;@@ TODO: change once we will have real int16! type 27 | version/lo: as byte! major 28 | version/hi: as byte! minor 29 | ;print "Initialising Winsock... " 30 | error: WSAStartup version wsa 31 | error = 0 32 | ] 33 | ;automatic initialization... 34 | if not init 2 2 [;version 2.2 35 | print-line ["*** Failed Winsock initialization. Error: " error] 36 | ] 37 | ] 38 | 39 | make-socket: func[ 40 | "Create socket of specified type" 41 | family [integer!] 42 | type [integer!] 43 | protocol [integer!] 44 | return: [SOCKET!] 45 | ][ 46 | #either OS = 'Windows [ 47 | WSASocket family type protocol NULL 0 0 48 | ][ 49 | socket family type protocol 50 | ] 51 | ] 52 | 53 | make-address: func[ 54 | "Allocates a new socket address struct and fills it with ip and port info values" 55 | ip [ip-address!] 56 | port [integer!] 57 | return: [sockaddr!] 58 | ][ 59 | init-address ALLOCATE_AS(sockaddr!) ip port 60 | ] 61 | 62 | init-address: func[ 63 | "Fills existing socket address struct with ip and port info values" 64 | address [sockaddr!] 65 | ip [ip-address!] 66 | port [integer!] 67 | return: [sockaddr!] 68 | ][ 69 | address/family-port: (AF_INET and FFFFh) or ((htons port) << 16) ;@@ TODO: change once we will have real int16! type 70 | address/ip: ip 71 | address/zero: 0.0 ;just clearing these padding bytes 72 | address 73 | ] 74 | 75 | make-server: func[ 76 | "Creates sockaddress and binds it to provided socket" 77 | s [SOCKET!] 78 | ip [ip-address!] 79 | port [integer!] 80 | return: [sockaddr!] 81 | /local server 82 | ][ 83 | server: make-address ip port 84 | if 0 <> bind s server size? sockaddr! [ 85 | ;failed! 86 | FREE_MEMORY(server) 87 | return null 88 | ] 89 | server 90 | ] 91 | 92 | get-error: func[return: [integer!]][ 93 | #either OS = 'Windows [WSAGetLastError][error] 94 | ] 95 | 96 | host-to-ip: func[ 97 | host [c-string!] 98 | return: [ip-address!] 99 | /local h [hostent!] 100 | ][ 101 | h: gethostbyname host 102 | if h = null [return 0] 103 | h/list/ips/1 104 | ] 105 | 106 | dispose: does[ 107 | #if OS = 'Windows [ 108 | WSACleanup 109 | wsa/version: 0 110 | ] 111 | ] 112 | ] 113 | -------------------------------------------------------------------------------- /Library/Steam/README.md: -------------------------------------------------------------------------------- 1 | # Steam API binding for Red and Red/System 2 | 3 | Steam is a pioneering online gaming platform that provides the ability to distribute games and other content directly to a community of more than 25 million gamers around the world. 4 | 5 | Purpose of this project is to provide access to **Steam API**, which is part of the [Steamworks SDK](https://partner.steamgames.com/). 6 | 7 | [Steam.reds](Steam.reds) is full low level API for **Red/System** made by parsing of Steam header files (SDK v1.39) with manual review. 8 | [Steam.red](Steam.red) is minimal binding for **Red** level and could be used as a starting point for more complex work. 9 | 10 | Current test files are only basic console applications, which prints some info (must be compiled!). To get the info, you must also have **Steam** installed and running and get Steam's library file for your OS in the same location like compiled test executables. Red version now automatically creates `steam_appid.txt` file with Valve's sample game ID. 11 | 12 | It's possible that more actual version could be found in [this standalone GitHub project](https://github.com/Oldes/Red-Steam). -------------------------------------------------------------------------------- /Library/Steam/Steam-test.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | Title: "Red Steam API binding test" 3 | Author: "Oldes" 4 | File: %Steam-test.red 5 | Rights: "Copyright (C) 2017 David 'Oldes' Oliva. All rights reserved." 6 | License: "BSD-3 - https://github.com/red/red/blob/master/BSD-3-License.txt" 7 | 8 | ] 9 | 10 | #include %Steam.red 11 | 12 | if not exists? %steam_appid.txt [ 13 | write %steam_appid.txt 480 ;using Valve's sample application ID 14 | ] 15 | 16 | Steam/init 17 | 18 | file: %hello.txt 19 | data: to binary! "Hello Red!" 20 | Steam/file-write file data 21 | 22 | Steam/info 23 | 24 | either Steam/file-exists? file [ 25 | print ["From" mold file ":" mold to string! Steam/file-read file] 26 | ][ 27 | print [mold file "not found!"] 28 | ] 29 | Steam/shutdown 30 | -------------------------------------------------------------------------------- /Library/Steam/Steam-test.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "Red/System Steam API binding test" 3 | Author: "Oldes" 4 | File: %Steam-test.reds 5 | Rights: "Copyright (C) 2017 David 'Oldes' Oliva. All rights reserved." 6 | License: "BSD-3 - https://github.com/red/red/blob/master/BSD-3-License.txt" 7 | 8 | ] 9 | 10 | #include %Steam.reds 11 | 12 | init 13 | info 14 | 15 | data: declare binary-ptr! 16 | 17 | print-line ["exists hell.txt? " file-exists? "hell.txt"] 18 | print-line ["exists hello.txt? " file-exists? "hello.txt"] 19 | 20 | bytes: file-read "hell.txt" data 21 | print-line ["read: " bytes " bytes at: " data/value] 22 | 23 | bytes: file-read "hello.txt" data 24 | print-line ["read: " bytes " bytes at: " data/value] 25 | 26 | SteamAPI_Shutdown 27 | 28 | -------------------------------------------------------------------------------- /Library/Steam/Steam.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | Title: "Red Steam API binding" 3 | Author: "Oldes" 4 | File: %Steam.red 5 | Rights: "Copyright (C) 2017 David 'Oldes' Oliva. All rights reserved." 6 | License: "BSD-3 - https://github.com/red/red/blob/master/BSD-3-License.txt" 7 | 8 | ] 9 | #system [ 10 | binary-ptr!: alias struct! [value [byte-ptr!]] 11 | 12 | Steam: context [ 13 | #include %Steam.reds 14 | ] 15 | ] 16 | 17 | Steam: context [ 18 | init: routine [ 19 | "Initialize Steam API. Must be called before using any other API functions." 20 | return: [logic!] 21 | ][ 22 | Steam/init 23 | ] 24 | info: routine ["Prints some SteamAPI related info"][ 25 | Steam/info 26 | ] 27 | shutdown: routine ["Should be called during process shutdown if possible"][ 28 | Steam/SteamAPI_Shutdown 29 | ] 30 | 31 | file-write: routine [ 32 | "Writes data on Steam Cloud" 33 | file [file!] 34 | data [binary!] 35 | /local 36 | c-file [c-string!] 37 | len [integer!] 38 | ][ 39 | len: -1 40 | c-file: unicode/to-utf8 file :len 41 | len: binary/rs-length? data 42 | Steam/file-write c-file binary/rs-head data len 43 | ] 44 | file-exists?: routine [ 45 | "Determines if a file exists on Steam Cloud" 46 | file [file!] 47 | /local 48 | c-file [c-string!] 49 | len [integer!] 50 | ][ 51 | len: -1 52 | c-file: unicode/to-utf8 file :len 53 | logic/box Steam/file-exists? c-file 54 | ] 55 | file-read: routine [ 56 | "Reads data from Steam Cloud" 57 | file [file!] 58 | ;return: [binary!] 59 | /local 60 | c-file [c-string!] 61 | len [integer!] 62 | bytes [integer!] 63 | data [binary-ptr!] 64 | bin [red-binary!] 65 | ][ 66 | len: -1 67 | data: declare binary-ptr! 68 | c-file: unicode/to-utf8 file :len 69 | 70 | bytes: Steam/file-read c-file data 71 | ;print-line ["file-read " bytes " bytes"] 72 | if bytes < 0 [fire [TO_ERROR(access cannot-open) file]] 73 | bin: binary/load data/value bytes 74 | free data/value 75 | SET_RETURN(bin) 76 | ] 77 | ] 78 | 79 | -------------------------------------------------------------------------------- /Library/Steam/SteamAPI/Steam-AppList.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "Red/System SteamAppList API binding" 3 | Author: "Oldes" 4 | File: %Steam-AppList.reds 5 | Rights: "Copyright (C) 2017 David 'Oldes' Oliva. All rights reserved." 6 | License: "BSD-3 - https://github.com/red/red/blob/master/BSD-3-License.txt" 7 | ] 8 | 9 | ISteamAppList: declare ISteamAppList! 10 | 11 | #import [ 12 | STEAM_LIBRARY STEAM_CALL [ 13 | SteamAPI_ISteamAppList_GetNumInstalledApps: "SteamAPI_ISteamAppList_GetNumInstalledApps" [ 14 | instancePtr [ISteamAppList!] ;intptr_t 15 | return: [integer!] 16 | ] 17 | SteamAPI_ISteamAppList_GetInstalledApps: "SteamAPI_ISteamAppList_GetInstalledApps" [ 18 | instancePtr [ISteamAppList!] ;intptr_t 19 | pvecAppID [int-ptr!] ;AppId_t * 20 | unMaxAppIDs [integer!] ;uint32 21 | return: [integer!] 22 | ] 23 | SteamAPI_ISteamAppList_GetAppName: "SteamAPI_ISteamAppList_GetAppName" [ 24 | instancePtr [ISteamAppList!] ;intptr_t 25 | nAppID [integer!] ;AppId_t 26 | pchName [c-string!] ;char * 27 | cchNameMax [integer!] ;int 28 | return: [integer!] 29 | ] 30 | SteamAPI_ISteamAppList_GetAppInstallDir: "SteamAPI_ISteamAppList_GetAppInstallDir" [ 31 | instancePtr [ISteamAppList!] ;intptr_t 32 | nAppID [integer!] ;AppId_t 33 | pchDirectory [c-string!] ;char * 34 | cchNameMax [integer!] ;int 35 | return: [integer!] 36 | ] 37 | SteamAPI_ISteamAppList_GetAppBuildId: "SteamAPI_ISteamAppList_GetAppBuildId" [ 38 | instancePtr [ISteamAppList!] ;intptr_t 39 | nAppID [integer!] ;AppId_t 40 | return: [integer!] 41 | ] 42 | ] 43 | ] 44 | 45 | -------------------------------------------------------------------------------- /Library/Steam/SteamAPI/Steam-GameServerStats.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "Red/System SteamGameServerStats API binding" 3 | Author: "Oldes" 4 | File: %Steam-GameServerStats.reds 5 | Rights: "Copyright (C) 2017 David 'Oldes' Oliva. All rights reserved." 6 | License: "BSD-3 - https://github.com/red/red/blob/master/BSD-3-License.txt" 7 | ] 8 | 9 | ISteamGameServerStats: declare ISteamGameServerStats! 10 | 11 | #import [ 12 | STEAM_LIBRARY STEAM_CALL [ 13 | SteamAPI_ISteamGameServerStats_RequestUserStats: "SteamAPI_ISteamGameServerStats_RequestUserStats" [ 14 | instancePtr [ISteamGameServerStats!];intptr_t 15 | steamIDUser [CSteamID!] ;class CSteamID 16 | return: [uint64-value!] 17 | ] 18 | SteamAPI_ISteamGameServerStats_GetUserStat: "SteamAPI_ISteamGameServerStats_GetUserStat" [ 19 | instancePtr [ISteamGameServerStats!];intptr_t 20 | steamIDUser [CSteamID!] ;class CSteamID 21 | pchName [c-string!] ;const char * 22 | pData [int-ptr!] ;int32 * 23 | return: [logic!] 24 | ] 25 | SteamAPI_ISteamGameServerStats_GetUserStat0: "SteamAPI_ISteamGameServerStats_GetUserStat0" [ 26 | instancePtr [ISteamGameServerStats!];intptr_t 27 | steamIDUser [CSteamID!] ;class CSteamID 28 | pchName [c-string!] ;const char * 29 | pData [pointer! [float32!]] ;float * 30 | return: [logic!] 31 | ] 32 | SteamAPI_ISteamGameServerStats_GetUserAchievement: "SteamAPI_ISteamGameServerStats_GetUserAchievement" [ 33 | instancePtr [ISteamGameServerStats!];intptr_t 34 | steamIDUser [CSteamID!] ;class CSteamID 35 | pchName [c-string!] ;const char * 36 | pbAchieved [logic-ptr!] ;bool * 37 | return: [logic!] 38 | ] 39 | SteamAPI_ISteamGameServerStats_SetUserStat: "SteamAPI_ISteamGameServerStats_SetUserStat" [ 40 | instancePtr [ISteamGameServerStats!];intptr_t 41 | steamIDUser [CSteamID!] ;class CSteamID 42 | pchName [c-string!] ;const char * 43 | nData [integer!] ;int32 44 | return: [logic!] 45 | ] 46 | SteamAPI_ISteamGameServerStats_SetUserStat0: "SteamAPI_ISteamGameServerStats_SetUserStat0" [ 47 | instancePtr [ISteamGameServerStats!];intptr_t 48 | steamIDUser [CSteamID!] ;class CSteamID 49 | pchName [c-string!] ;const char * 50 | fData [float32!] ;float 51 | return: [logic!] 52 | ] 53 | SteamAPI_ISteamGameServerStats_UpdateUserAvgRateStat: {SteamAPI_ISteamGameServerStats_UpdateUserAvgRateStat} [ 54 | instancePtr [ISteamGameServerStats!];intptr_t 55 | steamIDUser [CSteamID!] ;class CSteamID 56 | pchName [c-string!] ;const char * 57 | flCountThisSession [float32!] ;float 58 | dSessionLength [float!] ;double 59 | return: [logic!] 60 | ] 61 | SteamAPI_ISteamGameServerStats_SetUserAchievement: "SteamAPI_ISteamGameServerStats_SetUserAchievement" [ 62 | instancePtr [ISteamGameServerStats!];intptr_t 63 | steamIDUser [CSteamID!] ;class CSteamID 64 | pchName [c-string!] ;const char * 65 | return: [logic!] 66 | ] 67 | SteamAPI_ISteamGameServerStats_ClearUserAchievement: {SteamAPI_ISteamGameServerStats_ClearUserAchievement} [ 68 | instancePtr [ISteamGameServerStats!];intptr_t 69 | steamIDUser [CSteamID!] ;class CSteamID 70 | pchName [c-string!] ;const char * 71 | return: [logic!] 72 | ] 73 | SteamAPI_ISteamGameServerStats_StoreUserStats: "SteamAPI_ISteamGameServerStats_StoreUserStats" [ 74 | instancePtr [ISteamGameServerStats!];intptr_t 75 | steamIDUser [CSteamID!] ;class CSteamID 76 | return: [uint64-value!] 77 | ] 78 | ] 79 | ] 80 | 81 | -------------------------------------------------------------------------------- /Library/Steam/SteamAPI/Steam-Music.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "Red/System SteamMusic API binding" 3 | Author: "Oldes" 4 | File: %Steam-Music.reds 5 | Rights: "Copyright (C) 2017 David 'Oldes' Oliva. All rights reserved." 6 | License: "BSD-3 - https://github.com/red/red/blob/master/BSD-3-License.txt" 7 | ] 8 | 9 | ISteamMusic: declare ISteamMusic! 10 | 11 | #enum AudioPlayback_Status! [ 12 | AudioPlayback_Undefined 13 | AudioPlayback_Playing 14 | AudioPlayback_Paused 15 | AudioPlayback_Idle 16 | ] 17 | 18 | #import [ 19 | STEAM_LIBRARY STEAM_CALL [ 20 | SteamAPI_ISteamMusic_BIsEnabled: "SteamAPI_ISteamMusic_BIsEnabled" [ 21 | instancePtr [ISteamMusic!] ;intptr_t 22 | return: [logic!] 23 | ] 24 | SteamAPI_ISteamMusic_BIsPlaying: "SteamAPI_ISteamMusic_BIsPlaying" [ 25 | instancePtr [ISteamMusic!] ;intptr_t 26 | return: [logic!] 27 | ] 28 | SteamAPI_ISteamMusic_GetPlaybackStatus: "SteamAPI_ISteamMusic_GetPlaybackStatus" [ 29 | instancePtr [ISteamMusic!] ;intptr_t 30 | return: [AudioPlayback_Status!] 31 | ] 32 | SteamAPI_ISteamMusic_Play: "SteamAPI_ISteamMusic_Play" [ 33 | instancePtr [ISteamMusic!] ;intptr_t 34 | ] 35 | SteamAPI_ISteamMusic_Pause: "SteamAPI_ISteamMusic_Pause" [ 36 | instancePtr [ISteamMusic!] ;intptr_t 37 | ] 38 | SteamAPI_ISteamMusic_PlayPrevious: "SteamAPI_ISteamMusic_PlayPrevious" [ 39 | instancePtr [ISteamMusic!] ;intptr_t 40 | ] 41 | SteamAPI_ISteamMusic_PlayNext: "SteamAPI_ISteamMusic_PlayNext" [ 42 | instancePtr [ISteamMusic!] ;intptr_t 43 | ] 44 | SteamAPI_ISteamMusic_SetVolume: "SteamAPI_ISteamMusic_SetVolume" [ 45 | instancePtr [ISteamMusic!] ;intptr_t 46 | flVolume [float32!] ;float 47 | ] 48 | SteamAPI_ISteamMusic_GetVolume: "SteamAPI_ISteamMusic_GetVolume" [ 49 | instancePtr [ISteamMusic!] ;intptr_t 50 | return: [float32!] 51 | ] 52 | ] 53 | ] 54 | 55 | -------------------------------------------------------------------------------- /Library/Steam/SteamAPI/Steam-Screenshots.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "Red/System SteamScreenshots API binding" 3 | Author: "Oldes" 4 | File: %Steam-Screenshots.reds 5 | Rights: "Copyright (C) 2017 David 'Oldes' Oliva. All rights reserved." 6 | License: "BSD-3 - https:;github.com/red/red/blob/master/BSD-3-License.txt" 7 | ] 8 | 9 | ISteamScreenshots: declare ISteamScreenshots! 10 | 11 | #define k_nScreenshotMaxTaggedUsers 32 12 | #define k_nScreenshotMaxTaggedPublishedFiles 32 13 | #define k_cubUFSTagTypeMax 255 14 | #define k_cubUFSTagValueMax 255 15 | 16 | ; Required with of a thumbnail provided to AddScreenshotToLibrary. If you do not provide a thumbnail 17 | ; one will be generated. 18 | #define k_ScreenshotThumbWidth 200 19 | 20 | ; Handle is valid for the lifetime of your process and no longer 21 | #define INVALID_SCREENSHOT_HANDLE 0 22 | 23 | #enum EVRScreenshotType! [ 24 | k_EVRScreenshotType_None: 0 25 | k_EVRScreenshotType_Mono: 1 26 | k_EVRScreenshotType_Stereo: 2 27 | k_EVRScreenshotType_MonoCubemap: 3 28 | k_EVRScreenshotType_MonoPanorama: 4 29 | k_EVRScreenshotType_StereoPanorama: 5 30 | ] 31 | 32 | #import [ 33 | STEAM_LIBRARY STEAM_CALL [ 34 | SteamAPI_ISteamScreenshots_WriteScreenshot: "SteamAPI_ISteamScreenshots_WriteScreenshot" [ 35 | instancePtr [ISteamScreenshots!] ;intptr_t 36 | pubRGB [byte-ptr!] ;void * 37 | cubRGB [integer!] ;uint32 38 | nWidth [integer!] ;int 39 | nHeight [integer!] ;int 40 | return: [integer!] 41 | ] 42 | SteamAPI_ISteamScreenshots_AddScreenshotToLibrary: "SteamAPI_ISteamScreenshots_AddScreenshotToLibrary" [ 43 | instancePtr [ISteamScreenshots!];intptr_t 44 | pchFilename [c-string!] ;const char * 45 | pchThumbnailFilename[c-string!] ;const char * 46 | nWidth [integer!] ;int 47 | nHeight [integer!] ;int 48 | return: [integer!] 49 | ] 50 | SteamAPI_ISteamScreenshots_TriggerScreenshot: "SteamAPI_ISteamScreenshots_TriggerScreenshot" [ 51 | instancePtr [ISteamScreenshots!] ;intptr_t 52 | ] 53 | SteamAPI_ISteamScreenshots_HookScreenshots: "SteamAPI_ISteamScreenshots_HookScreenshots" [ 54 | instancePtr [ISteamScreenshots!] ;intptr_t 55 | bHook [logic!] ;bool 56 | ] 57 | SteamAPI_ISteamScreenshots_SetLocation: "SteamAPI_ISteamScreenshots_SetLocation" [ 58 | instancePtr [ISteamScreenshots!] ;intptr_t 59 | hScreenshot [integer!] ;ScreenshotHandle 60 | pchLocation [c-string!] ;const char * 61 | return: [logic!] 62 | ] 63 | SteamAPI_ISteamScreenshots_TagUser: "SteamAPI_ISteamScreenshots_TagUser" [ 64 | instancePtr [ISteamScreenshots!] ;intptr_t 65 | hScreenshot [integer!] ;ScreenshotHandle 66 | steamID [CSteamID!] ;class CSteamID 67 | return: [logic!] 68 | ] 69 | SteamAPI_ISteamScreenshots_TagPublishedFile: "SteamAPI_ISteamScreenshots_TagPublishedFile" [ 70 | instancePtr [ISteamScreenshots!];intptr_t 71 | hScreenshot [integer!] ;ScreenshotHandle 72 | unPublishedFileID [uint64-value!] ;PublishedFileId_t 73 | return: [logic!] 74 | ] 75 | SteamAPI_ISteamScreenshots_IsScreenshotsHooked: "SteamAPI_ISteamScreenshots_IsScreenshotsHooked" [ 76 | instancePtr [ISteamScreenshots!] ;intptr_t 77 | return: [logic!] 78 | ] 79 | SteamAPI_ISteamScreenshots_AddVRScreenshotToLibrary: {SteamAPI_ISteamScreenshots_AddVRScreenshotToLibrary} [ 80 | instancePtr [ISteamScreenshots!] ;intptr_t 81 | eType [EVRScreenshotType!] ;EVRScreenshotType 82 | pchFilename [c-string!] ;const char * 83 | pchVRFilename [c-string!] ;const char * 84 | return: [integer!] 85 | ] 86 | ] 87 | ] 88 | 89 | -------------------------------------------------------------------------------- /Library/Steam/SteamAPI/Steam-UnifiedMessages.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "Red/System SteamUnifiedMessages API binding" 3 | Author: "Oldes" 4 | File: %Steam-UnifiedMessages.reds 5 | Rights: "Copyright (C) 2017 David 'Oldes' Oliva. All rights reserved." 6 | License: "BSD-3 - https://github.com/red/red/blob/master/BSD-3-License.txt" 7 | ] 8 | 9 | ISteamUnifiedMessages: declare ISteamUnifiedMessages! 10 | 11 | #import [ 12 | STEAM_LIBRARY STEAM_CALL [ 13 | SteamAPI_ISteamUnifiedMessages_SendMethod: "SteamAPI_ISteamUnifiedMessages_SendMethod" [ 14 | instancePtr [ISteamUnifiedMessages!];intptr_t 15 | pchServiceMethod [c-string!] ;const char * 16 | pRequestBuffer [byte-ptr!] ;const void * 17 | unRequestBufferSize [integer!] ;uint32 18 | unContext [uint64-value!];uint64 19 | return: [uint64-value!] 20 | ] 21 | SteamAPI_ISteamUnifiedMessages_GetMethodResponseInfo: {SteamAPI_ISteamUnifiedMessages_GetMethodResponseInfo} [ 22 | instancePtr [ISteamUnifiedMessages!];intptr_t 23 | hHandle [uint64-value!] ;ClientUnifiedMessageHandle 24 | punResponseSize [int-ptr!] ;uint32 * 25 | peResult [int-ptr!] ;EResult * 26 | return: [logic!] 27 | ] 28 | SteamAPI_ISteamUnifiedMessages_GetMethodResponseData: {SteamAPI_ISteamUnifiedMessages_GetMethodResponseData} [ 29 | instancePtr [ISteamUnifiedMessages!];intptr_t 30 | hHandle [uint64-value!];ClientUnifiedMessageHandle 31 | pResponseBuffer [byte-ptr!] ;void * 32 | unResponseBufferSize[integer!] ;uint32 33 | bAutoRelease [logic!] ;bool 34 | return: [logic!] 35 | ] 36 | SteamAPI_ISteamUnifiedMessages_ReleaseMethod: "SteamAPI_ISteamUnifiedMessages_ReleaseMethod" [ 37 | instancePtr [ISteamUnifiedMessages!];intptr_t 38 | hHandle [uint64-value!] ;ClientUnifiedMessageHandle 39 | return: [logic!] 40 | ] 41 | SteamAPI_ISteamUnifiedMessages_SendNotification: "SteamAPI_ISteamUnifiedMessages_SendNotification" [ 42 | instancePtr [ISteamUnifiedMessages!];intptr_t 43 | pchServiceNotification[c-string!] ;const char * 44 | pNotificationBuffer [byte-ptr!] ;const void * 45 | unNotificationBufferSize[integer!] ;uint32 46 | return: [logic!] 47 | ] 48 | ] 49 | ] 50 | 51 | -------------------------------------------------------------------------------- /Library/Steam/SteamAPI/Steam-Video.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "Red/System SteamVideo API binding" 3 | Author: "Oldes" 4 | File: %Steam-Video.reds 5 | Rights: "Copyright (C) 2017 David 'Oldes' Oliva. All rights reserved." 6 | License: "BSD-3 - https://github.com/red/red/blob/master/BSD-3-License.txt" 7 | ] 8 | 9 | ISteamVideo: declare ISteamVideo! 10 | 11 | #import [ 12 | STEAM_LIBRARY STEAM_CALL [ 13 | SteamAPI_ISteamVideo_GetVideoURL: "SteamAPI_ISteamVideo_GetVideoURL" [ 14 | instancePtr [ISteamVideo!] ;intptr_t 15 | unVideoAppID [integer!] ;AppId_t 16 | ] 17 | SteamAPI_ISteamVideo_IsBroadcasting: "SteamAPI_ISteamVideo_IsBroadcasting" [ 18 | instancePtr [ISteamVideo!] ;intptr_t 19 | pnNumViewers [int-ptr!] ;int * 20 | return: [logic!] 21 | ] 22 | ] 23 | ] 24 | 25 | -------------------------------------------------------------------------------- /Library/Stream-IO/Stream-IO-carry.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "Stream IO - raw data reader/writer" 3 | Author: "Oldes" 4 | File: %Stream-IO-carry.reds 5 | Tabs: 4 6 | Rights: "Copyright (C) 2017 Oldes. All rights reserved." 7 | License: { 8 | Distributed under the Boost Software License, Version 1.0. 9 | See https://github.com/red/red/blob/master/BSL-License.txt 10 | } 11 | ] 12 | 13 | carryCount: func[return: [integer!] /local i [integer!]][ 14 | i: readUI8 15 | either 255 > i [ 16 | writeUI8 i 17 | ][ 18 | writeUI8 FFh 19 | i: readUI16 20 | writeUI16 i 21 | ] 22 | i 23 | ] 24 | ;carryBytes: func[num][writeBytes readBytes num] 25 | ;carryBitLogic: has[b][writeBit b: readBitLogic b] 26 | ;carrySBPair: carryPair: has[nBits][ 27 | ; nBits: readUB 5 28 | ; writeUB nBits 5 29 | ; loop (2 * nBits) [ 30 | ; writeBit readBitLogic 31 | ; ] 32 | ;] 33 | ; 34 | ;carryBits: func[num][ loop num [ writeBit readBitLogic ] ] 35 | ;carryUI8: has[v][writeUI8 v: readUI8 v] 36 | ;carryUI16: has[v][writeUI16 v: readUI16 v] 37 | ;carryUB: func[nBits /local v][writeUB v: readUB nBits nBits v] 38 | ;carrySB: func[nBits /local v][writeSB v: readSB nBits nBits v] 39 | ; 40 | ;carryString: does [writeString readString] 41 | -------------------------------------------------------------------------------- /Library/Stream-IO/Stream-IO-skip.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "Stream IO - raw data reader/writer" 3 | Author: "Oldes" 4 | File: %Stream-IO-skip.reds 5 | Tabs: 4 6 | Rights: "Copyright (C) 2017 Oldes. All rights reserved." 7 | License: { 8 | Distributed under the Boost Software License, Version 1.0. 9 | See https://github.com/red/red/blob/master/BSL-License.txt 10 | } 11 | ] 12 | 13 | skipBytes: func[ 14 | bytes [integer!] 15 | return: [integer!] 16 | ][ 17 | SIO_ASSERT_IN_SPACE(bytes) 18 | in/pos: in/pos + bytes 19 | bytes 20 | ] 21 | 22 | ;@@ TODO if needed -------------------------------------------------------------------------------- /Library/Stream-IO/Stream-IO.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "Stream IO - raw data reader/writer" 3 | Author: "Oldes" 4 | File: %Stream-IO.reds 5 | Tabs: 4 6 | Rights: "Copyright (C) 2017 Oldes. All rights reserved." 7 | License: { 8 | Distributed under the Boost Software License, Version 1.0. 9 | See https://github.com/red/red/blob/master/BSL-License.txt 10 | } 11 | ] 12 | 13 | #include %Stream-IO-core.reds 14 | #include %Stream-IO-read.reds 15 | #include %Stream-IO-write.reds 16 | #include %Stream-IO-carry.reds 17 | #include %Stream-IO-skip.reds -------------------------------------------------------------------------------- /Library/Stream-IO/examples/Stream-IO-test.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "Stream IO - raw data reader/writer - test" 3 | Author: "Oldes" 4 | File: %Stream-IO-test.reds 5 | Tabs: 4 6 | Rights: "Copyright (C) 2017 Oldes. All rights reserved." 7 | License: { 8 | Distributed under the Boost Software License, Version 1.0. 9 | See https://github.com/red/red/blob/master/BSL-License.txt 10 | } 11 | Note: { 12 | Don't use code like: 13 | print-line [readString readUI8] 14 | as "Arguments are pushed in reverse order in the C calling convention for IA-32" 15 | so the result would not be in correct order. 16 | Instead use: 17 | print readString print readUI8 18 | or something like that! 19 | } 20 | ] 21 | 22 | #include %../Stream-IO-core.reds 23 | #include %../Stream-IO-read.reds 24 | #include %../Stream-IO-write.reds 25 | 26 | name: #u16 "test-io.bin" 27 | file: simple-io/open-file name 0 true 28 | print-line ["file handle: " as int-ptr! file] 29 | 30 | writeBit false 31 | writeBit true 32 | writeBitAlign 33 | writeUI8 1 34 | writeUI16 2 35 | writeUI32 3 36 | writeFloat32 4.5 37 | writeFloat64 6.7 38 | writeUI8 127 39 | writeUI8 129 40 | writeUI8 255 41 | writeSB 42 7 42 | writeSB 43 7 43 | writeBitAlign 44 | 45 | writeBit true 46 | writeBit false 47 | writeBit false 48 | writeBit false 49 | writeBit false 50 | writeBit false 51 | writeBit false 52 | writeBit false 53 | writeBitAlign 54 | writeUB FFh 8 55 | 56 | writeSB -1 8 57 | writeUB -1 8 58 | writeFB 1.2 18 59 | writeBitAlign 60 | writeString "Hello Red" 61 | writeUI8 10 62 | 63 | 64 | writeFormated ["Integer: " 42 " float: " 3.14] ;NOTE: writeFormated does not add ending NULL char.. 65 | writeFormated [" pos: " (out/pos - out/head) " logic: " true] ;so multiple calls to it will be treated like one c-string! 66 | writeUI8 0 ;closes above formated string as a c-string! 67 | 68 | writeString "ending?" 69 | 70 | print-line "^/-- end writing --^/" 71 | 72 | simple-io/write-data file out/head as integer! (out/pos - out/head) 73 | 74 | simple-io/close-file file 75 | 76 | in/head: out/head 77 | in/tail: out/end 78 | in/end: out/end 79 | in/pos: in/head 80 | 81 | print-line readUI8 82 | print-line readUI8 83 | print-line readUI16 84 | print-line readUI32 85 | print-line readFloat32 86 | print-line readFloat64 87 | print-line readSI8 ;should be 127 88 | print-line readSI8 ;should be -127 89 | print-line readSI8 ;should be -1 90 | print-line readSB 7 91 | print-line readSB 7 92 | readBitAlign 93 | 94 | print-line readUI8 95 | print-line readUB 8 96 | 97 | print-line readSB 8 98 | print-line readUB 8 99 | print-line readFB 18 100 | 101 | print-line readString ;= Hello Red 102 | print-line readUI8 ;=10 103 | 104 | print-line readString ;= Integer: 42 float: 3.14 pos: 00000042h logic: true 105 | 106 | print-line readString ;= ending? 107 | 108 | print-line "^/-- end reading --^/" -------------------------------------------------------------------------------- /Library/Vulkan/README.md: -------------------------------------------------------------------------------- 1 | # Vulkan library binding for Red/System 2 | 3 | Vulkan is a new generation graphics and compute API that provides high-efficiency, cross-platform access to modern GPUs used in a wide variety of devices from PCs and consoles to mobile phones and embedded platforms. 4 | 5 | More info: https://www.khronos.org/vulkan/ 6 | 7 | Current Red/System binding was generated from `vulkan.h` from Vulkan SDK v1.0.57.0 8 | -------------------------------------------------------------------------------- /Library/Vulkan/examples/common.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "Common code for OpenGL examples" 3 | Author: "Oldes" 4 | File: %common.reds 5 | Rights: "Copyright (C) 2017 David 'Oldes' Oliva. All rights reserved." 6 | License: "BSD-3 - https://github.com/red/red/blob/master/BSD-3-License.txt" 7 | ] 8 | 9 | #include %../../GLFW/glfw3.reds 10 | #include %../vulkan.reds 11 | 12 | 13 | 14 | 15 | ;-- global variables! 16 | window: declare GLFWwindow! 17 | instance: 0 18 | appInfo: declare VkApplicationInfo! 19 | ;----------- 20 | 21 | 22 | VK-init: func[][ 23 | if GLFW_TRUE <> glfwInit [print-line "Failed to initialize GLFW library!" quit -1] 24 | ] 25 | 26 | VK-window: func[ 27 | title [c-string!] 28 | width [integer!] 29 | height [integer!] 30 | return: [GLFWwindow!] 31 | ][ 32 | glfwWindowHint GLFW_CLIENT_API GLFW_NO_API 33 | glfwWindowHint GLFW_RESIZABLE GLFW_FALSE 34 | 35 | window: glfwCreateWindow width height title NULL NULL 36 | 37 | if NULL = window [ 38 | print-line "Failed to open GLFW window." 39 | glfwTerminate 40 | quit -1 41 | ] 42 | 43 | glfwSetInputMode window GLFW_STICKY_KEYS GLFW_TRUE 44 | 45 | window 46 | ] 47 | 48 | VK-close: func[][ 49 | vkDestroyInstance instance null 50 | glfwDestroyWindow window 51 | glfwTerminate 52 | ] 53 | 54 | VK-instance: func[ 55 | /local createInfo num i p extensions ext 56 | ][ 57 | appInfo/sType: VK_STRUCTURE_TYPE_APPLICATION_INFO 58 | appInfo/pApplicationName: "Hello Triangle" 59 | appInfo/applicationVersion: VK_MAKE_VERSION(1 0 0) 60 | appInfo/pEngineName: "No Engine" 61 | appInfo/engineVersion: VK_MAKE_VERSION(1 0 0) 62 | appInfo/apiVersion: VK_MAKE_VERSION(1 0 0) 63 | 64 | createInfo: declare VkInstanceCreateInfo! 65 | createInfo/sType: VK_STRUCTURE_TYPE_INSTANCE_CREATE_INFO 66 | createInfo/pApplicationInfo: appInfo 67 | 68 | num: 0 69 | extensions: glfwGetRequiredInstanceExtensions :num 70 | 71 | print-line ["Vulkan extensions: " num] 72 | i: 0 p: as int-ptr! extensions 73 | while [i < num] [ 74 | ext: as string-ref! p 75 | i: i + 1 76 | p: p + 1 77 | print-line [#" " i ".^-" ext/value] 78 | ] 79 | 80 | createInfo/enabledExtensionCount: num 81 | createInfo/ppEnabledExtensionNames: extensions 82 | createInfo/enabledLayerCount: 0 83 | 84 | if VK_SUCCESS <> vkCreateInstance createInfo null :instance [ 85 | print-line "Failed to create Vulkan instance!" 86 | VK-close 87 | quit -1 88 | ] 89 | print-line ["Vulkan instance: " as int-ptr! instance] 90 | ] 91 | 92 | ;this define can be used to quit the main Vulkan loop 93 | #define VK-exit-test [ 94 | if any [ 95 | 0 <> glfwWindowShouldClose window 96 | GLFW_PRESS = glfwGetKey window GLFW_KEY_ESCAPE 97 | ][ 98 | break 99 | ] 100 | ] -------------------------------------------------------------------------------- /Library/Vulkan/examples/vk-info.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "Red/System Vulkan info" 3 | Purpose: "Prints some informations about supported Vulkan driver" 4 | Author: "Oldes" 5 | File: %vk-info.reds 6 | Rights: "Copyright (C) 2017 David 'Oldes' Oliva. All rights reserved." 7 | License: "BSD-3 - https://github.com/red/red/blob/master/BSD-3-License.txt" 8 | ] 9 | 10 | #include %common.reds 11 | 12 | VK-init 13 | 14 | VK-window "Vulkan" 800 600 15 | 16 | glfwMakeContextCurrent window 17 | 18 | VK-instance 19 | 20 | 21 | 22 | 23 | 24 | 25 | ;no main loop in this example 26 | 27 | VK-close -------------------------------------------------------------------------------- /Library/ZLib/examples/zlib-disk-example.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "ZLib, gzip example" 3 | Author: "Bruno Anselme" 4 | EMail: "be.red@free.fr" 5 | File: %zlib-disk-example.reds 6 | Rights: "Copyright (c) 2013-2015 Bruno Anselme" 7 | License: { 8 | Distributed under the Boost Software License, Version 1.0. 9 | See https://github.com/red/red/blob/master/BSL-License.txt 10 | } 11 | Needs: { 12 | Red/System >= 0.3.2 13 | zlib >= 1.2.6 14 | } 15 | ] 16 | 17 | 18 | #include %../zlib.reds 19 | 20 | print [ "Gzip example" lf ] 21 | print [ "Zlib version : " zlib/version lf ] 22 | 23 | file-to-zip: "red.r" 24 | zipped-file: "red.r.gz" 25 | unzipped-file: "unzipped-red.r" 26 | 27 | print [ "Gzip " file-to-zip " into " zipped-file lf ] 28 | retval: zlib/gzip file-to-zip zipped-file 29 | 30 | if retval = Z_OK [ 31 | print [ "Gunzip " zipped-file " into " unzipped-file lf ] 32 | zlib/gunzip zipped-file unzipped-file 33 | ] -------------------------------------------------------------------------------- /Library/ZLib/examples/zlib-mem-example.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "ZLib, memory compression example" 3 | Author: "Bruno Anselme" 4 | EMail: "be.red@free.fr" 5 | File: %zlib-mem-example.reds 6 | Rights: "Copyright (c) 2013-2015 Bruno Anselme" 7 | License: { 8 | Distributed under the Boost Software License, Version 1.0. 9 | See https://github.com/red/red/blob/master/BSL-License.txt 10 | } 11 | Needs: { 12 | Red/System >= 0.3.2 13 | zlib >= 1.2.6 14 | } 15 | ] 16 | 17 | #include %../zlib.reds 18 | 19 | print [ "Memory compression example" lf ] 20 | print [ "Zlib version : " zlib/version lf ] 21 | 22 | test-mem-compress: func [ 23 | text [c-string!] 24 | /local byte-count buffer decomp-text 25 | ][ 26 | print [ lf "----------------------------------------" lf ] 27 | byte-count: 0 28 | buffer: zlib/compress (as byte-ptr! text) ((length? text) + 1) :byte-count Z_DEFAULT_COMPRESSION ;-- length + 1 to include ending null char 29 | 30 | either buffer = NULL [ 31 | print [ "Error compressing..." lf ] 32 | ][ 33 | decomp-text: as c-string! zlib/decompress buffer byte-count 34 | print [ "Original text : " lf text lf ] 35 | print [ "Compressed data : " lf zlib/bin-to-str buffer byte-count lf ] 36 | print [ "Text size : " length? text " bytes" lf ] 37 | print [ "Compressed size : " byte-count " bytes" lf ] 38 | print [ "Compression ratio : " (100 * byte-count / (length? text)) "%" lf ] 39 | print [ "Decompressed text : " lf decomp-text lf ] 40 | free as byte-ptr! decomp-text 41 | free buffer 42 | ] 43 | ] 44 | 45 | test-mem-compress {Lorem ipsum dolor sit amet, consectetur adipisicing elit, sed do eiusmod tempor incididunt ut labore et dolore magna aliqua. 46 | Ut enim ad minim veniam, quis nostrud exercitation ullamco laboris nisi ut aliquip ex ea commodo consequat. 47 | Duis aute irure dolor in reprehenderit in voluptate velit esse cillum dolore eu fugiat nulla pariatur. 48 | Excepteur sint occaecat cupidatat non proident, sunt in culpa qui officia deserunt mollit anim id est laborum.} 49 | 50 | ;-- Repeated string, highly compressible 51 | test-mem-compress {Hello Red world, Hello Red world, Hello Red world, Hello Red world, 52 | Hello Red world, Hello Red world, Hello Red world, Hello Red world, 53 | Hello Red world, Hello Red world, Hello Red world, Hello Red world, 54 | Hello Red world, Hello Red world, Hello Red world, Hello Red world, 55 | Hello Red world, Hello Red world, Hello Red world, Hello Red world, 56 | Hello Red world, Hello Red world, Hello Red world, Hello Red world, 57 | Hello Red world, Hello Red world, Hello Red world, Hello Red world, 58 | Hello Red world, Hello Red world, Hello Red world, Hello Red world, 59 | Hello Red world, Hello Red world, Hello Red world, Hello Red world, 60 | Hello Red world, Hello Red world, Hello Red world, Hello Red world.} 61 | -------------------------------------------------------------------------------- /Library/ZeroMQ/ZeroMQ-Hello-client.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "Red/System ZeroMQ (0MQ) binding - Hello client example" 3 | Author: "Oldes" 4 | File: %ZeroMQ-Hello-client.reds 5 | Tabs: 4 6 | Rights: "Copyright (C) 2017 Oldes. All rights reserved." 7 | License: { 8 | Distributed under the Boost Software License, Version 1.0. 9 | See https://github.com/red/red/blob/master/BSL-License.txt 10 | } 11 | Comment: { 12 | This script needs external library, which can be downloaded from this site: 13 | http://zeromq.org/area:download 14 | (tested with libzmq-v120-mt-4_0_4.dll - renamed to libzmq.dll - on Win10) 15 | } 16 | ] 17 | 18 | #include %ZeroMQ.reds 19 | #include %../os/wait.reds 20 | 21 | #define ZMQ_ASSERT(r) [ 22 | if r < 0 [print-line ["ZMQ [" zmq/errno "]: " zmq/strerror zmq/errno]] 23 | ] 24 | 25 | a: 0 b: 0 c: 0 26 | zmq/version :a :b :c 27 | print-line ["ZMQ version: " a "." b "." c] 28 | 29 | print-line "Connecting to hello world server..." 30 | 31 | ctx: zmq/ctx_new 32 | requester: zmq/socket ctx ZMQ_REQ 33 | 34 | print-line ["ZMQ Context: " ctx] 35 | print-line ["ZMQ Requester: " requester] 36 | 37 | r: zmq/connect requester "tcp://127.0.0.1:5556" 38 | ZMQ_ASSERT(r) 39 | 40 | buffer: allocate 256 41 | 42 | n: 0 43 | bytes: 0 44 | 45 | while [n < 10][ 46 | n: n + 1 47 | print-line ["Sending Hello " n] 48 | bytes: zmq/send requester as byte-ptr! "Hello" 5 0 49 | if bytes < 0 [ 50 | ZMQ_ASSERT(bytes) 51 | break 52 | ] 53 | bytes: zmq/recv requester buffer 255 0 54 | either bytes < 0 [ 55 | ZMQ_ASSERT(bytes) 56 | break 57 | ][ 58 | if bytes > 255 [bytes: 255] 59 | bytes: bytes + 1 60 | buffer/bytes: #"^@" ;to create valid c-string ending just in case 61 | ] 62 | print-line ["Received " n ": " as c-string! buffer] 63 | wait 500 64 | ] 65 | 66 | zmq/close requester 67 | zmq/ctx_destroy ctx 68 | free buffer 69 | -------------------------------------------------------------------------------- /Library/ZeroMQ/ZeroMQ-Hello-server.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | Title: "Red/System ZeroMQ (0MQ) binding - Hello server example (Red)" 3 | Author: "Intey" 4 | File: %ZeroMQ-Hello-server.red 5 | Tabs: 4 6 | Rights: "Copyright (C) 2017 Intey. All rights reserved." 7 | License: { 8 | Distributed under the Boost Software License, Version 1.0. 9 | See https://github.com/red/red/blob/master/BSL-License.txt 10 | } 11 | Comment: { 12 | This script needs external library, which can be downloaded from this site: 13 | http://zeromq.org/area:download 14 | (tested with libzmq-v120-mt-4_0_4.dll - renamed to libzmq.dll - on Win10) 15 | 16 | As ZeroMQ-Hello-server.reds, this provides same server example, but written 17 | in Red, not Red/System. 18 | 19 | Also, this can be used as test for API interfaces from Red/System of ZeroMQ 20 | } 21 | ] 22 | 23 | #system [ 24 | #define ZMQ_ASSERT(r) [ 25 | if r < 0 [print-line ["ZMQ [" zmq/errno "]: " zmq/strerror zmq/errno ]] 26 | ] 27 | #include %ZeroMQ.reds 28 | ] 29 | 30 | start-server: routine [ 31 | /local 32 | ctx [zmq-context!] 33 | socket [zmq-socket!] 34 | r [integer!] 35 | buffer [byte-ptr!] 36 | bytes [integer!] 37 | ][ 38 | ctx: zmq/ctx_new 39 | socket: zmq/socket ctx ZMQ_REP 40 | print-line ["ZMQ Context: " ctx] 41 | print-line ["ZMQ Responder: " socket] 42 | r: zmq/bind socket "tcp://*:5556" 43 | ZMQ_ASSERT(r) 44 | if r <> 0 [ 45 | print-line "ZMQ bind failed!" 46 | quit -1 47 | ] 48 | r: zmq/setsockopt socket ZMQ_SUB as byte-ptr! "" 0 49 | ZMQ_ASSERT(r) 50 | 51 | buffer: allocate 256 52 | bytes: 0 53 | forever [ 54 | print-line "Waiting for request..." 55 | bytes: zmq/recv socket buffer 255 0 56 | ZMQ_ASSERT(bytes) 57 | if bytes >= 0 [ 58 | if bytes > 255 [bytes: 255] 59 | bytes: bytes + 1 60 | buffer/bytes: #"^@" ;to create valid c-string ending just in case 61 | ] 62 | print-line ["Received request: " as c-string! buffer] 63 | r: zmq/send socket as byte-ptr! "World" 5 0 64 | ZMQ_ASSERT(r) 65 | ] 66 | ] 67 | 68 | start-server 69 | -------------------------------------------------------------------------------- /Library/ZeroMQ/ZeroMQ-Hello-server.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "Red/System ZeroMQ (0MQ) binding - Hello server example" 3 | Author: "Oldes" 4 | File: %ZeroMQ-Hello-server.reds 5 | Tabs: 4 6 | Rights: "Copyright (C) 2017 Oldes. All rights reserved." 7 | License: { 8 | Distributed under the Boost Software License, Version 1.0. 9 | See https://github.com/red/red/blob/master/BSL-License.txt 10 | } 11 | Comment: { 12 | This script needs external library, which can be downloaded from this site: 13 | http://zeromq.org/area:download 14 | (tested with libzmq-v120-mt-4_0_4.dll - renamed to libzmq.dll - on Win10) 15 | } 16 | ] 17 | 18 | #include %ZeroMQ.reds 19 | #include %../os/wait.reds 20 | 21 | #define ZMQ_ASSERT(r) [ 22 | if r < 0 [print-line ["ZMQ [" zmq/errno "]: " zmq/strerror zmq/errno ]] 23 | ] 24 | 25 | a: 0 b: 0 c: 0 26 | zmq/version :a :b :c 27 | print-line ["ZMQ version: " a "." b "." c] 28 | 29 | ctx: zmq/ctx_new 30 | responder: zmq/socket ctx ZMQ_REP 31 | 32 | print-line ["ZMQ Context: " ctx] 33 | print-line ["ZMQ Responder: " responder] 34 | 35 | 36 | r: zmq/bind responder "tcp://*:5556" 37 | ZMQ_ASSERT(r) 38 | 39 | if r <> 0 [ 40 | print-line "ZMQ bind failed!" 41 | quit -1 42 | ] 43 | 44 | r: zmq/setsockopt responder ZMQ_SUB as byte-ptr! "" 0 45 | ZMQ_ASSERT(r) 46 | 47 | buffer: allocate 256 48 | bytes: 0 49 | forever [ 50 | print-line "Waiting for request..." 51 | bytes: zmq/recv responder buffer 255 0 52 | ZMQ_ASSERT(bytes) 53 | if bytes >= 0 [ 54 | if bytes > 255 [bytes: 255] 55 | bytes: bytes + 1 56 | buffer/bytes: #"^@" ;to create valid c-string ending just in case 57 | ] 58 | print-line ["Received request: " as c-string! buffer] 59 | r: zmq/send responder as byte-ptr! "World" 5 0 60 | ZMQ_ASSERT(r) 61 | wait 1 62 | ] 63 | 64 | 65 | 66 | -------------------------------------------------------------------------------- /Library/dotNET/README.md: -------------------------------------------------------------------------------- 1 | Red/.NET Bridge 2 | ------------------------ 3 | 4 | This is a prototype of a higher-level Red to .NET bridge. 5 | 6 | * Red -> .NET (Implemented) 7 | * .Net -> Red (Not Implemented) 8 | 9 | Red/.NET bridge current API 10 | ---------------------------- 11 | 12 | * clr-start: start the default CLR runtime. 13 | * clr-stop: close the default CRL runtime. 14 | * clr-load: load assembly into CLR. 15 | * clr-new: instantiate a CLR class, returns a CLR object. 16 | * clr-do: invoke an object's method with arguments. 17 | 18 | ## clr-load 19 | 20 | clr-load file! : load an external assembly. 21 | clr-load path! : load an assembly from .NET framework. 22 | 23 | ## clr-new 24 | 25 | clr-new [word! arg1 arg2 ...] 26 | 27 | word!: fullname of the class (including namespace) 28 | 29 | e.g. 30 | btn: clr-new [System.Windows.Controls.Button] 31 | 32 | ## clr-do 33 | 34 | clr-do [path! arg1 arg2 ...] : call instance method 35 | clr-do [lit-path! arg1 arg2 ...] : call static method 36 | clr-do [set-path! arg] : set a property 37 | clr-do [get-path!] : get a property 38 | 39 | e.g. 40 | clr-do ['System/Console/WriteLine "Hello!"] ;-- static method 41 | clr-do [win/Show] ;-- instance method 42 | clr-do [btn/Width: 100] ;-- set a property 43 | probe clr-do [:btn/Width] ;-- get a property 44 | 45 | Compile and Run the tests 46 | ---------------------------- 47 | The tests need to be compiled in release mode (-r). 48 | 49 | D:\>red-latest.exe -c -r test-wpf.red 50 | -------------------------------------------------------------------------------- /Library/dotNET/test-svg.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | Title: "Red .NET bridge" 3 | Author: "Xie Qingtian" 4 | File: %test-svg.red 5 | Tabs: 4 6 | Rights: "Copyright (C) 2016 Xie Qingtian. All rights reserved." 7 | License: { 8 | Distributed under the Boost Software License, Version 1.0. 9 | See https://github.com/red/red/blob/master/BSL-License.txt 10 | } 11 | ] 12 | 13 | #include %bridge.red 14 | 15 | clr-start 16 | 17 | clr-load 'WPF/PresentationFramework.dll 18 | 19 | ;-- Lib download from http://sharpvectors.codeplex.com/ 20 | clr-load %./SvgConverter/SharpVectors.Converters.Wpf.dll 21 | clr-load %./SvgConverter/SharpVectors.Rendering.Wpf.dll 22 | 23 | settings: clr-new [SharpVectors.Renderers.Wpf.WpfDrawingSettings] 24 | clr-do [settings/IncludeRuntime: yes] 25 | clr-do [settings/TextAsGeometry: no] 26 | 27 | converter: clr-new [SharpVectors.Converters.FileSvgReader settings] 28 | drawing: clr-do [converter/Read "test.svg"] 29 | 30 | image: clr-new [System.Windows.Media.DrawingImage drawing] 31 | 32 | svgImage: clr-new [System.Windows.Controls.Image] 33 | clr-do [svgImage/Source: image] 34 | 35 | win: clr-new [System.Windows.Window] 36 | clr-do [win/Title: "Red SVG Viewer"] 37 | clr-do [win/Height: 500] 38 | clr-do [win/Width: 500] 39 | clr-do [win/Content: svgImage] 40 | clr-do [win/ShowDialog] 41 | 42 | clr-stop 43 | 44 | probe "end" -------------------------------------------------------------------------------- /Library/dotNET/test-wpf.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | Title: "Red .NET bridge HelloWorld" 3 | Author: "Xie Qingtian" 4 | File: %test-wpf.red 5 | Tabs: 4 6 | Rights: "Copyright (C) 2016 Xie Qingtian. All rights reserved." 7 | License: { 8 | Distributed under the Boost Software License, Version 1.0. 9 | See https://github.com/red/red/blob/master/BSL-License.txt 10 | } 11 | ] 12 | 13 | #include %bridge.red 14 | 15 | clr-start 16 | 17 | clr-do ['System/Console/WriteLine "{0}{1} -- {2}" "Hello" ".NET" 123] 18 | 19 | clr-load 'WPF/PresentationFramework.dll 20 | 21 | btn: clr-new [System.Windows.Controls.Button] 22 | clr-do [btn/Height: 48] 23 | clr-do [btn/Width: 100] 24 | clr-do [btn/Content: "OK"] 25 | 26 | area: clr-new [System.Windows.Controls.TextBox] 27 | clr-do [area/AcceptsReturn: yes] 28 | clr-do [area/Height: 450] 29 | clr-do [area/AppendText "WPF window created by Red.^M^/^M^/"] 30 | clr-do [area/AppendText "Red生成的.NET WPF窗口。"] 31 | 32 | panel: clr-new [System.Windows.Controls.StackPanel] 33 | container: clr-do [:panel/Children] 34 | clr-do [container/Add btn] 35 | clr-do [container/Add area] 36 | 37 | win: clr-new [System.Windows.Window] 38 | clr-do [win/Title: "Red WPF Window"] 39 | clr-do [win/Height: 500] 40 | clr-do [win/Width: 500] 41 | clr-do [win/Content: panel] 42 | clr-do [win/ShowDialog] 43 | 44 | clr-stop 45 | 46 | probe "end" -------------------------------------------------------------------------------- /Library/dtoa/README.md: -------------------------------------------------------------------------------- 1 | Double conversion library for Red/System 2 | ------------------------ 3 | 4 | This file partially port dtoa.c (by David M. Gay, downloaded from http://www.netlib.org/fp/dtoa.c) to the Red runtime. 5 | 6 | Please remember to check http://www.netlib.org/fp regularly (and especially before any Red release) for bugfixes and updates. 7 | 8 | FYI: a more readable version from Python, in %Python/dtoa.c (http://hg.python.org/cpython) 9 | 10 | !! For `dtoa`, only support mode 0 (the most commonly used mode) now !! 11 | 12 | Functions 13 | ------------------------ 14 | 15 | * `float-to-ascii` which corresponding to `dtoa` in dtoa.c 16 | * `string-to-float` which corresponding to `strtod` in dtoa.c 17 | * `form-float` a wrapper for `float-to-ascii` for human-friendly output. 18 | 19 | Examples 20 | ------------------------ 21 | Please check the tests file (dtoa-test.red) to see how to use it. ;-) 22 | 23 | Running tests 24 | ------------------------ 25 | 1. Compile with Red 26 | `$ red -c tests/source/library/dtoa-test.red` 27 | 28 | 1. From the REBOL console type : 29 | 30 | `do/args %red.r "%../Red-code/Library/dtoa/dtoa-test.red"`, the compilation process should finish with a `...output file size` message. 31 | 32 | 1. The resulting binaries are in Red main directory, go try them! 33 | 34 | Linux users run `dtoa-test` from command line. 35 | 36 | Windows users need to open a DOS console and run `dtoa-test.exe` from there. 37 | -------------------------------------------------------------------------------- /Library/mpg123/mpg123-info.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "Red/System MPG123 binding simple test - lib info output" 3 | Author: "Oldes" 4 | File: %mpg123-info.reds 5 | Rights: "Copyright (C) 2017 David 'Oldes' Oliva. All rights reserved." 6 | License: "BSD-3 - https://github.com/red/red/blob/master/BSD-3-License.txt" 7 | Note: {Based on libmpg123 source of version: 1.25.6} 8 | ] 9 | 10 | #include %mpg123.reds 11 | 12 | if MPG123_OK <> mpg123_init [ 13 | print-line "Unable to init libmpg123!" 14 | quit -1 15 | ] 16 | 17 | show-mpg132-info: func[ 18 | /local 19 | err mh decoders 20 | rates count rate encodings p encoding 21 | ][ 22 | err: 0 23 | mh: mpg123_new null :err 24 | 25 | either mh = null [ 26 | print-line ["Unable to create mpg123 handle! Error: " err] 27 | ][ 28 | print-line "Supported mpg123 features:" 29 | print-line ["^-ABI_UTF8OPEN: " 1 = mpg123_feature MPG123_FEATURE_ABI_UTF8OPEN] 30 | print-line ["^-OUTPUT_8BIT: " 1 = mpg123_feature MPG123_FEATURE_OUTPUT_8BIT] 31 | print-line ["^-OUTPUT_16BIT: " 1 = mpg123_feature MPG123_FEATURE_OUTPUT_16BIT] 32 | print-line ["^-OUTPUT_32BIT: " 1 = mpg123_feature MPG123_FEATURE_OUTPUT_32BIT] 33 | print-line ["^-INDEX: " 1 = mpg123_feature MPG123_FEATURE_INDEX] 34 | print-line ["^-PARSE_ID3V2: " 1 = mpg123_feature MPG123_FEATURE_PARSE_ID3V2] 35 | print-line ["^-DECODE_LAYER1: " 1 = mpg123_feature MPG123_FEATURE_DECODE_LAYER1 ] 36 | print-line ["^-DECODE_LAYER2: " 1 = mpg123_feature MPG123_FEATURE_DECODE_LAYER2 ] 37 | print-line ["^-DECODE_LAYER3: " 1 = mpg123_feature MPG123_FEATURE_DECODE_LAYER3 ] 38 | print-line ["^-DECODE_ACCURATE: " 1 = mpg123_feature MPG123_FEATURE_DECODE_ACCURATE] 39 | print-line ["^-DECODE_DOWNSAMPLE: " 1 = mpg123_feature MPG123_FEATURE_DECODE_DOWNSAMPLE] 40 | print-line ["^-DECODE_NTOM: " 1 = mpg123_feature MPG123_FEATURE_DECODE_NTOM] 41 | print-line ["^-PARSE_ICY: " 1 = mpg123_feature MPG123_FEATURE_PARSE_ICY] 42 | print-line ["^-TIMEOUT_READ: " 1 = mpg123_feature MPG123_FEATURE_TIMEOUT_READ] 43 | print-line ["^-EQUALIZER: " 1 = mpg123_feature MPG123_FEATURE_EQUALIZER] 44 | 45 | print-line "Available decoders:" 46 | decoders: mpg123_decoders 47 | 48 | while [null <> as c-string! decoders/1][ 49 | print-line [#"^-" as c-string! decoders/1] 50 | decoders: decoders + 1 51 | ] 52 | 53 | print-line "Supported decoders:" 54 | decoders: mpg123_supported_decoders 55 | 56 | while [null <> as c-string! decoders/1][ 57 | print-line [#"^-" as c-string! decoders/1] 58 | decoders: decoders + 1 59 | ] 60 | 61 | print-line ["Current decoder: " mpg123_current_decoder mh lf] 62 | 63 | rates: 0 64 | count: 0 65 | mpg123_rates :rates :count 66 | print-line "Supported sample rates:" 67 | p: as int-ptr! rates 68 | while [count > 0][ 69 | print-line [#"^-" p/1 and FFFFh] 70 | p: p + 1 71 | count: count - 1 72 | ] 73 | 74 | encodings: 0 75 | mpg123_encodings :encodings :count 76 | print-line "Supported encodings:" 77 | p: as int-ptr! encodings 78 | while [count > 0][ 79 | encoding: p/1 80 | print-line [#"^-" as int-ptr! encoding #" " get-encoding-name encoding " (" mpg123_encsize encoding " bytes)"] 81 | p: p + 1 82 | count: count - 1 83 | ] 84 | ] 85 | ] 86 | 87 | show-mpg132-info 88 | mpg123_exit 89 | -------------------------------------------------------------------------------- /Library/ogg/examples/ogg-decode.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "Red/System libogg binding - decode example" 3 | Author: "Oldes" 4 | File: %ogg-decode.reds 5 | Rights: "Copyright (C) 2017 David 'Oldes' Oliva. All rights reserved." 6 | License: "BSD-3 - https://github.com/red/red/blob/master/BSD-3-License.txt" 7 | Note: {Based on libogg source of version: 1.3.2 from www.xiph.org/ogg/} 8 | ] 9 | 10 | #if red-pass? = no [ 11 | ;No Red runtime embedded, so import stand alone dependencies 12 | #include %../../Stream-IO/simple-io-minimal.reds 13 | ] 14 | 15 | #include %../ogg.reds 16 | 17 | #define OGG_BLOCK_SIZE 4096 18 | 19 | ogg-decode: func[ 20 | filename [c-string!] 21 | /local 22 | file [integer!] ;opened file handle 23 | oy [ogg_sync_state!] 24 | og [ogg_page!] 25 | os [ogg_stream_state!] 26 | op [ogg_packet!] 27 | serialno 28 | buffer size bytes processed 29 | ][ 30 | file: simple-io/open-file filename simple-io/RIO_READ no 31 | if file = 0 [ 32 | print-line ["Cannot open file: " filename] 33 | quit -1 34 | ] 35 | print-line ["filename: " filename " size: " simple-io/file-size? file] 36 | 37 | oy: as ogg_sync_state! allocate size? ogg_sync_state! 38 | og: as ogg_page! allocate size? ogg_page! 39 | os: as ogg_stream_state! allocate 1024 ;@@ don't have full struct spec, so cannot use `size?` 40 | op: as ogg_packet! allocate size? ogg_packet! 41 | 42 | ogg_sync_init oy 43 | 44 | serialno: 0 45 | processed: 0 46 | 47 | forever [ 48 | buffer: ogg_sync_buffer oy OGG_BLOCK_SIZE 49 | bytes: simple-io/read-data file buffer OGG_BLOCK_SIZE 50 | ogg_sync_wrote oy bytes 51 | 52 | if 1 <> ogg_sync_pageout oy og [ 53 | print-line ["^/bytes left: " bytes] 54 | 55 | if bytes < OGG_BLOCK_SIZE [ break ] ;out of data 56 | 57 | print-line ["Not an Ogg stream!"] 58 | break 59 | ] 60 | 61 | if serialno = 0 [ 62 | serialno: ogg_page_serialno og 63 | print-line ["ogg_stream_init: " 0 = ogg_stream_init os serialno " serial: " serialno] 64 | ] 65 | 66 | 67 | ogg_stream_pagein os og 68 | print-line ["^/next packet valid: " 1 = ogg_stream_packetpeek os null] 69 | while [1 = ogg_stream_packetout os op] [ 70 | processed: processed + op/bytes 71 | print-line ["packet bytes: " op/bytes " total: " processed] 72 | ] 73 | ] 74 | 75 | ogg_stream_clear os 76 | ogg_sync_clear oy 77 | free as byte-ptr! os 78 | free as byte-ptr! oy 79 | free as byte-ptr! op 80 | free as byte-ptr! og 81 | 82 | simple-io/close-file file 83 | ] 84 | 85 | ogg-decode "stereo.ogg" -------------------------------------------------------------------------------- /Library/os/datatypes/c-string.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "C-string utils" 3 | Purpose: "C-string related functions" 4 | Exports: [ 5 | copy-c-string [function! [src [c-string!] size [integer!] return: [c-string!]]] 6 | ] 7 | Author: "Oldes" 8 | File: %c-string.reds 9 | Rights: "Copyright (C) 2017 David 'Oldes' Oliva. All rights reserved." 10 | License: "BSD-3 - https://github.com/red/red/blob/master/BSD-3-License.txt" 11 | ] 12 | 13 | #import [ 14 | LIBC-file cdecl [ 15 | strnchr: "memchr" [ ;using memchr but with c-string! types 16 | ptr [c-string!] 17 | value [byte!] 18 | num [integer!] 19 | return: [c-string!] 20 | ] 21 | strncmp: "strncmp" [ 22 | str1 [c-string!] 23 | str2 [c-string!] 24 | num [integer!] 25 | return: [integer!] 26 | ] 27 | strstr: "strstr" [ 28 | str1 [c-string!] 29 | str2 [c-string!] 30 | return: [c-string!] 31 | ] 32 | strncpy: "strncpy" [ 33 | str1 [c-string!] 34 | str2 [c-string!] 35 | num [integer!] 36 | return: [c-string!] 37 | ] 38 | ] 39 | ] 40 | 41 | copy-c-string: func[ 42 | "Creates copy of given string or its part" 43 | src [c-string!] 44 | size [integer!] ;if size < 0 function will copy full source string 45 | return: [c-string!] ;call `free` on returned string once not needed! 46 | /local sz result 47 | ][ 48 | sz: size? src 49 | if all [size > 0 size <= sz][ sz: size ] 50 | result: as c-string! allocate (sz + 1) 51 | strncpy result src sz 52 | sz: sz + 1 result/sz: #"^@" ;mark tail of c-string 53 | result 54 | ] -------------------------------------------------------------------------------- /Library/os/datatypes/typed-array.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "Typed array" 3 | Purpose: "Low level struct for holding typed data" 4 | Author: "Oldes" 5 | File: %typed-array.reds 6 | Rights: "Copyright (C) 2017 David 'Oldes' Oliva. All rights reserved." 7 | License: "BSD-3 - https://github.com/red/red/blob/master/BSD-3-License.txt" 8 | ] 9 | 10 | #enum typed-array-types! [ 11 | TYPE_FLOAT32!: 1 12 | ] 13 | 14 | typed-array!: alias struct! [ 15 | type [typed-array-types!] 16 | size [integer!] 17 | head [byte-ptr!] ;always points to node 18 | data [integer!] ;real data starts here 19 | ] 20 | 21 | 22 | make-f32-buffer: func[ 23 | [variadic] 24 | count [integer!] 25 | list [pointer! [float!]] 26 | return: [typed-array!] 27 | /local pad array bytes buffer n 28 | ][ 29 | ;pading result size to multiplies of 4 30 | pad: count // 4 31 | if pad > 0 [pad: 4 - pad] 32 | bytes: 12 + 4 * (count + pad) 33 | 34 | array: as typed-array! allocate bytes 35 | array/type: TYPE_FLOAT32! 36 | array/size: count 37 | array/head: as byte-ptr! :array/data 38 | buffer: as pointer! [float32!] :array/data 39 | 40 | ;conver float values into float32 and write them to buffer 41 | n: 0 42 | while [n < count][ 43 | n: n + 1 44 | buffer/n: as float32! list/n 45 | ] 46 | ;zero the padded bytes if needed 47 | print-line ["pad: " pad] 48 | while [pad > 0][ 49 | n: n + 1 50 | buffer/n: as float32! 0.0 51 | pad: pad - 1 52 | ] 53 | array 54 | ] 55 | -------------------------------------------------------------------------------- /Library/os/definitions.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "Red runtime independent definitions" 3 | Author: "Oldes" 4 | File: %definitions.reds 5 | Rights: "Copyright (C) 2017 David 'Oldes' Oliva. All rights reserved." 6 | License: "BSD-3 - https:;//github.com/red/red/blob/master/BSD-3-License.txt" 7 | ] 8 | 9 | 10 | 11 | ;use this code only when Red runtime is not embedded 12 | #if red-pass? = no [ 13 | ;place code which is part of the Red runtime here 14 | #define handle! [pointer! [integer!]] 15 | ] 16 | 17 | ;some useful macros: 18 | 19 | #define ZERO_MEMORY(pointer bytes) [set-memory pointer #"^@" bytes] 20 | #define FREE_MEMORY(pointer) [free as byte-ptr! pointer] 21 | #define ALLOCATE_AS(type) [as type allocate size? type] 22 | ;note: there is function zero-memory defined in Red\modules\view\backends\windows\win32.reds ! 23 | 24 | 25 | ;this code is not part of the Red runtime, but is common in multiple libraries 26 | 27 | ;integer64! type is not supported by Red yet, so these are just temp workaround! 28 | int64!: alias struct! [lo [integer!] hi [integer!]] 29 | #define uint64! int64! 30 | 31 | #define int64-value! [int64! value] 32 | #define uint64-value! [int64! value] 33 | #define int64-ptr! int64! 34 | #define uint64-ptr! uint64! 35 | 36 | 37 | ;@@ !!! it is not possible to use int16! as compiler refuses it. 38 | integer16!: alias struct! [lo [byte!] hi [byte!]] ;@@ must be changed once we will get real integer16! type 39 | #define uint16! integer16! ;@@ this is probably not safe! Check Steam binding where it was originaly used! 40 | 41 | #define int16-value! [integer16! value] 42 | #define uint16-value! [integer16! value] 43 | #define int16-ptr! integer16! 44 | #define uint16-ptr! integer16! 45 | 46 | #define TWO-SHORTS! integer! ;again - temp workaround - used for 2 int16 values in structs 47 | 48 | binary-ptr!: alias struct! [value [pointer! [byte!]]] 49 | string-ptr!: alias struct! [value [c-string!]] 50 | string-ptr-ptr!: alias struct! [value [string-ptr!]] 51 | handle-ptr!: alias struct! [value [pointer! [integer!]]] 52 | logic-ptr!: alias struct! [value [logic!]] 53 | int64-ptr!: alias struct! [value [int64-value!]] 54 | float32-ptr-ptr!: alias struct! [value [float32-ptr!]] 55 | 56 | #if OS = 'Windows [ 57 | #define HDC! handle! 58 | #define HGLRC! handle! 59 | #define HGPUNV! handle! 60 | #define HPBUFFERARB! handle! 61 | #define HPBUFFEREXT! handle! 62 | #define HPVIDEODEV! handle! 63 | #define HVIDEOINPUTDEVICENV! handle! 64 | #define HVIDEOOUTPUTDEVICENV! handle! 65 | #define PGPU_DEVICE! handle! 66 | 67 | #define HGPUNV-ptr! handle-ptr! 68 | #define HPVIDEODEV-ptr! handle-ptr! 69 | #define HVIDEOINPUTDEVICENV-ptr! handle-ptr! 70 | #define HVIDEOOUTPUTDEVICENV-ptr! handle-ptr! 71 | ] -------------------------------------------------------------------------------- /Library/os/key-hit.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "Key-hit and key-hit-char" 3 | Purpose: "Red/System function to determine if a key has been pressed or not" 4 | Author: "Oldes" 5 | File: %key-hit.reds 6 | Rights: "Copyright (C) 2017 David 'Oldes' Oliva. All rights reserved." 7 | License: "BSD-3 - https:;//github.com/red/red/blob/master/BSD-3-License.txt" 8 | Usage: [ 9 | key: 0 10 | print-line "Press Q to quit." 11 | forever [ 12 | if key-hit [ 13 | key: key-hit-char 14 | switch key [ 15 | #"q" #"Q" [ break ] 16 | default [ 17 | print-line ["pressed key with code: " key] 18 | ] 19 | ] 20 | ] 21 | ] 22 | ] 23 | ] 24 | 25 | #import [ 26 | LIBC-file cdecl [ 27 | _kbhit: "_kbhit" [ return: [integer!] ] 28 | _getch: "_getch" [ return: [integer!] ] 29 | ] 30 | ] 31 | 32 | #define key-hit [0 <> _kbhit] 33 | #define key-hit-char _getch 34 | 35 | -------------------------------------------------------------------------------- /Library/os/time-elapsed.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | Title: "Time elapsed" 3 | Purpose: "Function for measuring time between each call in seconds" 4 | Author: "Oldes" 5 | File: %time-elapsed.red 6 | Rights: "Copyright (C) 2017 David 'Oldes' Oliva. All rights reserved." 7 | License: "BSD-3 - https:;//github.com/red/red/blob/master/BSD-3-License.txt" 8 | Usage: [ 9 | time-elapsed ;initial call if you don't want to count since app start 10 | ;do some code here, where you want to count how long it takes 11 | print ["time elapsed:" time-elapsed "seconds"] 12 | ] 13 | ] 14 | 15 | #system [#include %time-elapsed.reds] 16 | 17 | time-elapsed: routine [ 18 | "Returns number of seconds since last call (or application start for the first call)" 19 | return: [float!] 20 | ][ 21 | _time-elapsed 22 | ] 23 | -------------------------------------------------------------------------------- /Library/os/time-elapsed.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "Time elapsed" 3 | Purpose: "Red/System (runtime independent) function for measuring time between each call in seconds" 4 | Author: "Oldes" 5 | File: %time-elapsed.reds 6 | Rights: "Copyright (C) 2017 David 'Oldes' Oliva. All rights reserved." 7 | License: "BSD-3 - https:;//github.com/red/red/blob/master/BSD-3-License.txt" 8 | Usage: [ 9 | time-elapsed ;initial call if you don't want to count since app start 10 | ;do some code here, where you want to count how long it takes 11 | print-line ["time elapsed: " time-elapsed " seconds"] 12 | ] 13 | ] 14 | 15 | ctx-timing: context [ 16 | time: 0.0 17 | #switch OS [ 18 | Windows [ 19 | #import [ 20 | "kernel32.dll" stdcall [ 21 | GetTickCount: "GetTickCount" [ 22 | return: [integer!] 23 | ] 24 | ] 25 | ] 26 | ] 27 | #default [ 28 | timespec!: alias struct! [ 29 | seconds [integer!] ;time_t 30 | nanoseconds [integer!] ;long 31 | ] 32 | #define CLOCK_MONOTONIC 1 33 | #import [ 34 | LIBC-file cdecl [ 35 | clock_gettime: "clock_gettime" [ 36 | clk_id [integer!] 37 | time [timespec!] 38 | return: [integer!] 39 | ] 40 | ] 41 | ] 42 | ts: declare timespec! 43 | ] 44 | ] 45 | update: func[][ 46 | #either OS = 'Windows [ 47 | time: 1E-3 * as float! GetTickCount 48 | ][ 49 | clock_gettime CLOCK_MONOTONIC ts 50 | time: as float! ts/seconds + (1E-9 * as float! ts/nanoseconds) 51 | ] 52 | ] 53 | update ;does the initial update (application starts) 54 | ] 55 | 56 | #either red-pass? = no [time-elapsed:][_time-elapsed:] func [ 57 | "Returns number of seconds since last call (or application start for the first call)" 58 | return: [float!] 59 | /local time 60 | ][ 61 | time: ctx-timing/time 62 | ctx-timing/update 63 | ctx-timing/time - time 64 | ] 65 | -------------------------------------------------------------------------------- /Library/os/wait.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "Red/System (runtime independent) wait function" 3 | Author: "Oldes" 4 | File: %wait.reds 5 | Rights: "Copyright (C) 2017 David 'Oldes' Oliva. All rights reserved." 6 | License: "BSD-3 - https:;//github.com/red/red/blob/master/BSD-3-License.txt" 7 | ] 8 | 9 | ;use this code only when Red runtime is not embedded 10 | #if red-pass? = no [ 11 | #switch OS [ 12 | Windows [ 13 | #import [ 14 | "kernel32.dll" stdcall [ 15 | sleep: "Sleep" [ 16 | dwMilliseconds [integer!] 17 | ] 18 | ] 19 | ] 20 | wait: func [ms [integer!]][sleep ms] 21 | ] 22 | #default [ 23 | #import [ 24 | LIBC-file cdecl [ 25 | usleep: "usleep" [ 26 | microseconds [integer!] 27 | return: [integer!] 28 | ] 29 | ] 30 | ] 31 | wait: func [ms [integer!]][usleep 1000 * ms] 32 | ] 33 | ] 34 | ] 35 | 36 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Red/Code 2 | 3 | This repository contains code written in Red and its dialects by the Red team and community. There are four sections in the repository, Apps, Scripts, ShowCase and Library. This repository is curated in the sense that contributions are included when they meet the applicable criteria of higher code quality, completeness and relevancy. For a place where to find general user scripts, see the [red/community](https://github.com/red/community) repository. 4 | 5 | ## Apps 6 | 7 | Complete applications, any domain accepted (tools, games, demos,...). 8 | 9 | ## Scripts 10 | 11 | This section of the repository contains short scripts which demonstrate both features of Red and its expressiveness. These scripts can be run from the Red console or require compilation in case of scripts including Red/System parts. 12 | 13 | ![Scripts](Screenshots/scripts.png) 14 | 15 | ## Showcase 16 | 17 | This is a collection of scripts or apps which show both the breadth and depth of Red and its wide applicability. Every one is complete with no external dependencies. 18 | 19 | ![Scripts](Screenshots/showcase.png) 20 | 21 | ## Library 22 | 23 | This is a collection of useful Library functions and modules that can be included in Red programs. Its two sub-sections are Red and Red/System. All library functions and modules have API documentation. Bear in mind that modules support in Red is not yet there, so libraries are currently just simple scripts. 24 | 25 | 26 | ## Contributing 27 | 28 | Quality contributions are always most welcome. If you would like to have an entry included in Red/Code, please read The (Red/Code Contributors' Guideline). Please provide also a proper Red header with at least the following fields: Title, Author, Date, Purpose, Rights (license name/URL for your code, by default it will be public domain). If applicable, also provide a short explanation of how to use your app/code in the header. 29 | 30 | 31 | -------------------------------------------------------------------------------- /Screenshots/scripts.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/red/code/82b7bce0c4d0febd42f5179a7b2ad2792f3037b0/Screenshots/scripts.png -------------------------------------------------------------------------------- /Screenshots/showcase.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/red/code/82b7bce0c4d0febd42f5179a7b2ad2792f3037b0/Screenshots/showcase.png -------------------------------------------------------------------------------- /Scripts/README.md: -------------------------------------------------------------------------------- 1 | # Scripts 2 | 3 | This section of the repository contains short scripts which demonstrate both features of Red and its expressiveness. These scripts can be run from the Red console or require compilation in case of scripts including Red/System parts. 4 | 5 | -------------------------------------------------------------------------------- /Scripts/a-an/a-an-grammatical.red: -------------------------------------------------------------------------------- 1 | Red [] 2 | 3 | a-an: func [ 4 | "Returns the appropriate variant of a or an" 5 | str [string!] 6 | /pre "Prepend to str" 7 | /local 8 | lst "List of words that start with a vowel which sounds like a consonant" 9 | tmp 10 | ][ 11 | lst: do load %cs.txt ;-- consonant sounds 12 | tmp: case [ 13 | find lst load str ["a"] 14 | find "aeiou" str/1 ["an"] 15 | 'else ["a"] 16 | ] 17 | either pre [rejoin [tmp #" " str]] [tmp] 18 | ] -------------------------------------------------------------------------------- /Scripts/a-an/cs.txt: -------------------------------------------------------------------------------- 1 | use 2 | union 3 | university 4 | unit 5 | user 6 | unity 7 | universe 8 | uniform 9 | usage 10 | utility 11 | urine 12 | uranium 13 | unison 14 | euphoria 15 | utopia 16 | unanimity 17 | uterus 18 | euthanasia 19 | ewe 20 | ufo 21 | unicorn 22 | urea 23 | urethra 24 | euphemism 25 | eugenics 26 | usurper 27 | usability 28 | eunuch 29 | uni 30 | eucalyptus 31 | usury 32 | eulogy 33 | ubiquity 34 | universalism 35 | urinal 36 | universal 37 | ewer 38 | euro 39 | utensil 40 | ufology 41 | uniformitarianism 42 | upsilon 43 | ukulele 44 | urinalysis 45 | usurer 46 | ureter 47 | uridine 48 | ute 49 | eugenist 50 | eutectic 51 | eukaryote 52 | ufologist 53 | ululation 54 | usufruct 55 | eustasy 56 | unary 57 | uvula 58 | urus 59 | eucatastrophe 60 | uraeus 61 | ouabain 62 | one 63 | using 64 | Ucalegon 65 | oncer 66 | Usanian 67 | usufruction 68 | Eusebius 69 | USAR 70 | usufructuary 71 | Amazigh 72 | usuress 73 | euouae 74 | ukase 75 | euclidianness 76 | uke 77 | uke 78 | Uke 79 | Ukie 80 | ureteroureterostomy 81 | usurping 82 | eustress 83 | Unakas 84 | eudaemon 85 | Ukrainian 86 | unidirectionality 87 | Utahn 88 | unite 89 | uranism 90 | uranist 91 | eudemonia 92 | euth 93 | Ute 94 | European bison 95 | uranophobia 96 | euphoriant 97 | uvular 98 | Ouija 99 | uropygium 100 | eugarie 101 | eugenesis 102 | UW 103 | Iatmul 104 | eutripsia 105 | uey 106 | eugeny 107 | euglena 108 | UFO 109 | unigeniture 110 | univalence 111 | univalent 112 | utile 113 | utilitarian 114 | ubac 115 | eulachon 116 | unique 117 | Usonian 118 | Utonian 119 | ubicity 120 | Euboean 121 | Uniate 122 | euro 123 | utopographer 124 | Euro-American 125 | Eumenides 126 | Eucharist 127 | univocal 128 | euchologion 129 | euchre 130 | eunoia 131 | Unix -------------------------------------------------------------------------------- /Scripts/analog-clock.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | Title: "Red O'clock" 3 | Author: "Gregg Irwin" 4 | Needs: View 5 | File: %analog-clock.red 6 | Tabs: 4 7 | ] 8 | 9 | degree-to-xy: func [rad "radius" deg "degrees"] [ 10 | as-pair (rad * sine deg) (rad * negate cosine deg) 11 | ] 12 | 13 | sex-to-degree: func ["Sexagesimal to degrees" n] [n * 6] 14 | 15 | ; Positioning the hour hand isn't as easy as using the hour value 16 | ; directly, because it's not sexagesimal and we only have 12 hours 17 | ; on the clock for a 24 hour period. It's also nice if it doesn't 18 | ; just jump from one hour mark (= 5 ticks) to the next, but moves 19 | ; gradually between them based on the number of minutes. 20 | hour-to-tick: func [ 21 | t [time!]] [5 * ((t/hour // 12) + ((to float! t/minute) / 60)) 22 | ] 23 | 24 | 25 | outer-wd: 4 ; thickness of outer ring 26 | size: 200x200 ; overall clock size 27 | radius: first size / 2 28 | center: size / 2 29 | 30 | hand-len: reduce ['hour radius * .65 'min radius * .85 'sec radius * .8] 31 | 32 | ; Start with the outer circle 33 | draw-blk: compose [ 34 | pen red line-cap round 35 | line-width (outer-wd) fill-pen white circle (center) (radius - outer-wd) 36 | line-width 2 ; tick mark width 37 | ] 38 | 39 | ; Add tick marks 40 | repeat i 60 [ 41 | tick-len: switch/default i [ ; Could do modulos here of course 42 | 15 30 45 60 [25] 43 | 5 10 20 25 35 40 50 55 [15] 44 | ][7] 45 | p1: center + (degree-to-xy (radius - outer-wd) (sex-to-degree i)) 46 | p2: center + (degree-to-xy (radius - tick-len - outer-wd) (sex-to-degree i)) 47 | repend draw-blk ['line p1 p2] 48 | ] 49 | 50 | ; This is how we'll draw the hands. We just update line commands for them 51 | ; in the draw block each time. 52 | update-hand: function [ 53 | hand [word!] "Maps to position in draw block" 54 | tick [number!] "0-60" 55 | ][ 56 | ; Position in draw block 57 | pos: get select [hour hour-idx min min-idx sec sec-idx] hand 58 | change pos reduce [ 59 | 'line center (center + (degree-to-xy hand-len/:hand (sex-to-degree tick))) 60 | ] 61 | ] 62 | 63 | t: now/time 64 | hour-idx: min-idx: sec-idx: none 65 | 66 | ; This is a little funky. We add the setup for each hand to the draw 67 | ; block, mark that position, and then update the hand, which will add 68 | ; the line command for the hands the first time it is run. After that 69 | ; update-hand will modify the draw block rather than adding to it. 70 | hour-idx: tail append draw-blk [pen crimson line-cap round line-width 4] 71 | update-hand 'hour hour-to-tick t 72 | min-idx: tail append draw-blk [line-width 3] 73 | update-hand 'min t/minute 74 | sec-idx: tail append draw-blk compose [line-width 1 pen brick fill-pen brick circle (center) 3] 75 | update-hand 'sec t/second 76 | 77 | view compose/only [ 78 | title "Clock" 79 | size (size) 80 | origin 0x0 81 | clock: base (size) draw (draw-blk) rate 1 on-time [ 82 | t: now/time 83 | update-hand 'hour hour-to-tick t 84 | update-hand 'min t/minute + ((to float! t/second) / 60) 85 | update-hand 'sec t/second 86 | ] 87 | do [ 88 | clock/color: none 89 | ] 90 | ] -------------------------------------------------------------------------------- /Scripts/bubbles.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | Title: "Bubbles" 3 | Author: [REBOL version "Gabriele Santilli" Red port "Gregg Irwin"] 4 | File: %bubbles.red 5 | Tabs: 4 6 | Needs: View 7 | ] 8 | 9 | bubbles: make block! 1500 10 | d: [ 11 | pen 80.80.255.175 12 | fill-pen linear 0x0 0 400 90 1 1 10.10.255 0.0.100 13 | box 0x0 400x400 14 | ] 15 | 16 | t: now/time/precise 17 | random/seed to integer! t/second 18 | 19 | rand: func [v] [random v] 20 | rnd-pair: does [as-pair rand 400 rand 400] 21 | 22 | move-bubble: func [bubble] [ 23 | bubble/1/x: bubble/1/x - 3 + rand 5 24 | bubble/1/y: bubble/1/y - 2 - rand 6 25 | if bubble/1/y < 24 [bubble/1/y: 428] 26 | bubble/-10: bubble/1 - (bubble/2 / 3) 27 | ] 28 | 29 | loop 100 [ 30 | insert insert bbl: insert tail d [ 31 | fill-pen radial 150x150 30 450 0 1 1 128.128.255.105 90.90.255.165 80.80.255.175 32 | circle 33 | ] rnd-pair 4 + rand 20 34 | 35 | ; Take these adjustments out for flat, cartoonish bubbles 36 | bbl/-8: bbl/2 * 2 ; gradient end = circle radius 37 | ;!! R2 version does not use * 2 here 38 | bbl/-9: to integer! bbl/2 * 0.2 ; gradient start = 20% of radius ; decimal! chokes draw right now 39 | bbl/-10: (bbl/1 - (bbl/2 / 3)) ; gradient offset = offset - 1/3 radius 40 | 41 | append/only bubbles bbl 42 | ] 43 | 44 | view/no-sync [ 45 | title "Bubbles" 46 | size 400x400 47 | origin 0x0 48 | canvas: base 400x400 10.10.255 draw d rate 60 49 | on-time [ 50 | foreach bubble bubbles [move-bubble bubble] 51 | show canvas 52 | ] 53 | 54 | ] -------------------------------------------------------------------------------- /Scripts/cadadaverous.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | Title: "My other car is CDR" 3 | Author: @9214 4 | Date: 24-Aug-2017 5 | File: %cadadaverous.red 6 | Purpose: { 7 | A variation on Lisp's compositions of CAR and CDR primitives 8 | implemented as a "reader macro". 9 | Demonstrates the use of Parse and lexer's pre-loading. 10 | } 11 | ] 12 | 13 | system/lexer/pre-load: function [source][ 14 | chain: make block! 16 15 | composition: [ 16 | "c" 17 | some [ 18 | "a" (append chain 'first) 19 | | "d" (append chain 'next) 20 | ] 21 | "r" 22 | ] 23 | 24 | parse source [ 25 | any [ 26 | change composition (form chain) (clear chain) 27 | | skip 28 | ] 29 | ] 30 | ] 31 | 32 | example: reduce load { 33 | "SICP, exercise 2.25" 34 | 35 | cadaddr [1 3 [5 7] 9] 36 | caar [[7]] 37 | cadadadadadadr [1 [2 [3 [4 [5 [6 7]]]]]] 38 | } 39 | -------------------------------------------------------------------------------- /Scripts/capture-demo.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | Title: "Red window & screen capture VID demo" 3 | Author: "Qingtian Xie" 4 | File: %face-to-image-vid.red 5 | Tabs: 4 6 | Needs: 'View 7 | Rights: "Copyright (C) 2016 Qingtian Xie. All rights reserved." 8 | License: { 9 | Distributed under the Boost Software License, Version 1.0. 10 | See https://github.com/red/red/blob/master/BSL-License.txt 11 | } 12 | ] 13 | 14 | view [ 15 | title "Simple Capturing demo" 16 | style btn: button 100x40 17 | pad 30x0 18 | btn "Capture Self" [ 19 | img: to-image face 20 | canvas/draw: reduce ['image img canvas/size - img/size / 2] 21 | ] 22 | btn "Capture Window" [ 23 | canvas/draw: reduce ['image to-image face/parent 0x0 canvas/size] 24 | ] 25 | btn "Capture Screen" [ 26 | canvas/draw: reduce [ 27 | 'image to-image system/view/screens/1 28 | 0x0 canvas/size 29 | ] 30 | ] 31 | btn "Save to PNG" [ 32 | save/as request-file/save canvas/draw/image 'png 33 | ] 34 | return 35 | canvas: image 550x400 36 | ] 37 | -------------------------------------------------------------------------------- /Scripts/lexer/README.md: -------------------------------------------------------------------------------- 1 | # Red's lexer event system and callbacks 2 | 3 | Those scripts show how to use the lexer events and callback function to modify its behavior and achieve some transformations or analysis on Red files without having to fully `load` the files first. 4 | 5 | 6 | `%count-type.red`: Analyzing one or more Red/Rebol source code in text formats by counting the number of values present per-datatype. 7 | 8 | `%flatten.red`: Customized Red values loader that will flatten all nested container structures (except for paths) and return a one-dimensional list of all the loaded values. 9 | 10 | `%get-comments`: Extracts all the line comments from a Red file. 11 | 12 | `%load-commas`: Toy extension for Red syntax allowing commas to be used as separator between values. 13 | 14 | `%longest.red`: Reports some stats about longest/biggest values in a Red source file. 15 | 16 | `%unique-words.red`: Counts unique words occurences in a given Red source file. 17 | 18 | 19 | -------------------------------------------------------------------------------- /Scripts/lexer/count-types.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | Title: "Lexer-based datatypes counter" 3 | Author: "Nenad Rakocevic" 4 | File: %count-types.red 5 | Date: 22/04/2020 6 | License: "MIT" 7 | Notes: { 8 | This script allows analyzing one or more Red/Rebol source code in text formats 9 | by counting the number of values present per-datatype. This analysis is conducted 10 | using a customized lexer that counts recognized tokens without loading them. 11 | } 12 | ] 13 | 14 | context [ 15 | list: none 16 | 17 | lex: function [ 18 | event [word!] ;-- event name 19 | input [string! binary!] ;-- input series at current loading position 20 | type [datatype! word! none!] ;-- type of token or value currently processed. 21 | line [integer!] ;-- current input line number 22 | token ;-- current token as an input slice (pair!) or a loaded value. 23 | return: [logic!] ;-- YES: continue to next lexing stage, NO: cancel current token lexing 24 | ][ 25 | [scan load error open close] ;-- exclude 'prescan event for faster processing 26 | switch event [ 27 | scan open [ ;-- only counts scanned tokens and any-block! series 28 | unless pos: find/only list type [repend pos: tail list [type 0]] 29 | pos/2: pos/2 + 1 30 | event = 'open ;-- return TRUE for OPEN event, so that nested containers 31 | ] ;-- can be counted properly. 32 | close load [no] ;-- do not load values, do not store any-block containers. 33 | error [input: next input no] ;-- skip over syntax errors silently 34 | ] 35 | ] 36 | 37 | set 'count-types function [ 38 | "Return the count of all values per-datatype in the input file, or in-memory source code" 39 | src [file! string! binary!] "Source file or in-memory buffer to analyze" 40 | /cumul "Cumulate the stats with previous calls" 41 | /extern list 42 | ][ 43 | if file? src [src: read/binary src] 44 | unless cumul [list: make block! 100] 45 | transcode/trace src :lex 46 | list: new-line/skip (sort/skip/compare/all list 2 func [a b][a/2 > b/2]) yes 2 47 | ] 48 | ] 49 | 50 | ;-- Usage example 51 | probe count-types %count-types.red -------------------------------------------------------------------------------- /Scripts/lexer/flatten.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | Title: "Lexer-based data-structures flattening loader" 3 | Author: "Nenad Rakocevic" 4 | File: %flatten.red 5 | Date: 22/04/2020 6 | License: "MIT" 7 | Notes: { 8 | This script provides a customized Red values loader that will flatten all nested 9 | container structures (expect for paths) and return a one-dimensional list of all 10 | the loaded values. 11 | } 12 | ] 13 | 14 | context [ 15 | lex: function [ 16 | event [word!] ;-- event name 17 | input [string! binary!] ;-- input series at current loading position 18 | type [datatype! word! none!] ;-- type of token or value currently processed. 19 | line [integer!] ;-- current input line number 20 | token ;-- current token as an input slice (pair!) or a loaded value. 21 | return: [logic!] ;-- YES: continue to next lexing stage, NO: cancel current token lexing 22 | ][ 23 | [open close] ;-- only intercept containers construction events 24 | find any-path! type ;-- return YES for paths, else drop the container 25 | ] 26 | 27 | set 'load-flat function [ 28 | "Return a flattened list of all values from an input file, or in-memory source code" 29 | src [file! string! binary!] "Source file or in-memory buffer to load" 30 | ][ 31 | if file? src [src: read/binary src] 32 | transcode/trace src :lex 33 | ] 34 | ] 35 | 36 | ;-- Usage example 37 | probe load-flat {[ 38 | [1 2 3] 39 | [4 5 6] 40 | [7 8 9] 41 | ]} -------------------------------------------------------------------------------- /Scripts/lexer/get-comments.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | Title: "Lexer-based " 3 | Author: "Nenad Rakocevic" 4 | File: %get-comments.red 5 | Date: 18/05/2020 6 | License: "MIT" 7 | Notes: { 8 | Extracts all the line comments from a Red file. Could be used to process some special 9 | type of comments (like "@@" "FIXME" "TBD"...), or save comments with their line number 10 | to be eventually saved back with the original code if needed. 11 | } 12 | ] 13 | 14 | context [ 15 | list: none 16 | 17 | lex: func [ 18 | event [word!] ;-- event name 19 | input [string! binary!] ;-- input series at current loading position 20 | type [datatype! word! none!] ;-- type of token or value currently processed. 21 | line [integer!] ;-- current input line number 22 | token ;-- current token as an input slice (pair!) or a loaded value. 23 | return: [logic!] ;-- YES: continue to next lexing stage, NO: cancel current token lexing 24 | ][ 25 | [scan] ;-- only scan events 26 | if type = 'comment [ 27 | repend list [line trim/tail to-string copy/part head input token] 28 | ] 29 | no ;-- do not load values 30 | ] 31 | 32 | set 'get-comments func [ 33 | "Return a list of words and their respective occurences count" 34 | src [file! string! binary!] "Source file or in-memory buffer to load" 35 | ][ 36 | if file? src [src: read/binary src] 37 | list: make block! 50 38 | transcode/trace src :lex 39 | new-line/skip list on 2 40 | ] 41 | ] 42 | 43 | ;-- Usage example 44 | probe get-comments %unique-words.red -------------------------------------------------------------------------------- /Scripts/lexer/load-commas.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | Title: "Simple example of Red syntax extension" 3 | Author: "Nenad Rakocevic" 4 | File: %load-commas.red 5 | Date: 18/05/2020 6 | License: "MIT" 7 | Notes: { 8 | This script allows you to load list of values separated by commas as blocks 9 | without any error. Note that commas are disabled from float literals (by overloading 10 | the `scan` event for float literals). 11 | } 12 | ] 13 | 14 | context [ 15 | lex: func [ 16 | event [word!] ;-- event name 17 | input [string! binary!] ;-- input series at current loading position 18 | type [datatype! word! none!] ;-- type of token or value currently processed. 19 | line [integer!] ;-- current input line number 20 | token ;-- current token as an input slice (pair!) or a loaded value. 21 | return: [logic!] ;-- YES: continue to next lexing stage, NO: cancel current token lexing 22 | /local inp pos 23 | ][ 24 | [scan error] ;-- only error events 25 | 26 | inp: head input 27 | switch event [ 28 | scan [ 29 | if type = float! [ ;-- catch the float literals with commas 30 | if pos: find/part at inp token/1 #"," at inp token/2 [ 31 | pos/1: #" " ;-- replace the comma in float literal by a whitespace 32 | input: at inp token/1 ;-- reposition input to try loading the token again 33 | return no ;-- cancel loading and rescan the token 34 | ] 35 | ] 36 | yes ;-- let it go through loading stage 37 | ] 38 | error [ 39 | pos: at inp token/2 ;-- comma is at end of current token 40 | either pos/1 = #"," [ 41 | pos/1: #" " ;-- replace the comma in input by a whitespace 42 | input: at inp token/1 ;-- reposition input to try loading the token again 43 | no ;-- continue without reporting any error 44 | ][yes] ;-- let other syntax errors pop up 45 | ] 46 | ] 47 | ] 48 | 49 | set 'load-commas func [ 50 | "Loads a Red file or buffer, ignoring eventual commas between values" 51 | src [file! string! binary!] "Source file or in-memory buffer to load" 52 | ][ 53 | if file? src [src: read/binary src] 54 | unless binary? src [src: to-binary src] 55 | transcode/trace src :lex 56 | ] 57 | ] 58 | 59 | ;-- Usage example 60 | probe load-commas "1,2,a,b,c,d,3,4,hello,world" -------------------------------------------------------------------------------- /Scripts/lexer/longest.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | Title: "Lexer-based longest/biggest values analyzing tool" 3 | Author: "Nenad Rakocevic" 4 | File: %longest.red 5 | Date: 22/04/2020 6 | License: "MIT" 7 | Notes: { 8 | Analyze the content of a given Red/Rebol source code file and report 9 | some stats about longest/biggest values. 10 | } 11 | ] 12 | 13 | context [ 14 | template: [ 15 | integer: 0 16 | float: 0.0 17 | word: "" 18 | string: "" 19 | issue: 0 20 | file: 0 21 | deepest: 0 22 | ] 23 | descriptions: [ 24 | "biggest integer value" 25 | "biggest float value" 26 | "longest word" 27 | "longest string" 28 | "longest issue" 29 | "longest filename" 30 | "deepest nesting level" 31 | ] 32 | depth: 0 33 | list: none 34 | 35 | lex: function [ 36 | event [word!] ;-- event name 37 | input [string! binary!] ;-- input series at current loading position 38 | type [datatype! word! none!] ;-- type of token or value currently processed. 39 | line [integer!] ;-- current input line number 40 | token ;-- current token as an input slice (pair!) or a loaded value. 41 | return: [logic!] ;-- YES: continue to next lexing stage, NO: cancel current token lexing 42 | /extern list depth 43 | ][ 44 | [scan load open close] 45 | switch event [ 46 | scan [ 47 | either any [str?: type = string! attempt [find any-word! type]][ 48 | entry: pick [string word] str? 49 | if token/2 - token/1 > length? list/:entry [ 50 | list/:entry: to-string copy/part head input token 51 | ] 52 | no 53 | ][yes] 54 | ] 55 | load [ 56 | switch to-word type [ 57 | integer! [if token > list/integer [list/integer: token]] 58 | float! [if token > list/float [list/float: token]] 59 | ] 60 | no 61 | ] 62 | open [ 63 | either find any-path! type [yes][ 64 | depth: depth + 1 65 | if depth > list/deepest [list/deepest: depth] 66 | no 67 | ] 68 | ] 69 | close [ 70 | either find any-path! type [yes][depth: depth - 1 no] 71 | ] 72 | ] 73 | ] 74 | 75 | set 'show-biggest func [ 76 | "Displays a list of longest or biggest values from a source file" 77 | src [file! string! binary!] "Source file to process" 78 | /local n v 79 | ][ 80 | if file? src [src: read/binary src] 81 | list: copy template 82 | transcode/trace src :lex 83 | desc: descriptions 84 | foreach [n v] list [print rejoin ["- " desc/1 ": " all [v <> 0 mold v]] desc: next desc] 85 | () ;-- no extra output in console 86 | ] 87 | ] 88 | 89 | ;-- Usage example 90 | show-biggest %count-types.red -------------------------------------------------------------------------------- /Scripts/lexer/unique-words.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | Title: "Lexer-based words stats tool" 3 | Author: "Nenad Rakocevic" 4 | File: %unique-words.red 5 | Date: 15/05/2020 6 | License: "MIT" 7 | Notes: {Counts unique words occurences in a given Red source file.} 8 | ] 9 | 10 | context [ 11 | list: none 12 | 13 | lex: func [ 14 | event [word!] ;-- event name 15 | input [string! binary!] ;-- input series at current loading position 16 | type [datatype! word! none!] ;-- type of token or value currently processed. 17 | line [integer!] ;-- current input line number 18 | token ;-- current token as an input slice (pair!) or a loaded value. 19 | return: [logic!] ;-- YES: continue to next lexing stage, NO: cancel current token lexing 20 | ][ 21 | [scan] ;-- only scan events 22 | if all [datatype? type find any-word! type][ 23 | token: copy/part head input token 24 | token: trim/with to-string token "':" 25 | list/:token: 1 + any [list/:token 0] 26 | ] 27 | no ;-- do not load values 28 | ] 29 | 30 | set 'count-unique func [ 31 | "Return a list of words and their respective occurences count" 32 | src [file! string! binary!] "Source file or in-memory buffer to load" 33 | ][ 34 | if file? src [src: read/binary src] 35 | list: make map! 1000 36 | transcode/trace src :lex 37 | new-line/skip (sort/skip/compare/all body-of list 2 func [a b][a/2 > b/2]) yes 2 38 | ] 39 | ] 40 | 41 | ;-- Usage example 42 | probe count-unique %unique-words.red -------------------------------------------------------------------------------- /Scripts/mandelbrot-fast.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | Title: "Mandelbrot (fast)" 3 | Author: "Fullstack Technologies team" 4 | Needs: 'View 5 | Tabs: 4 6 | Notes: { 7 | Ported from http://rebol2.blogspot.com/2013/03/mandelbrot.html 8 | 9 | /// This script requires compilation, it cannot run from the console /// 10 | 11 | This version is using Red/System DSL for doing the calculations and 12 | poking colors in the bitmap. It is still sub-optimal, and will be 13 | way faster once the integer/float conversions will be properly supported 14 | in Red/System. Also, the current RGB buffer imposes a byte-level access, 15 | this will be replaced with a RGBA buffer with direct 32-bit accesses. 16 | } 17 | ] 18 | 19 | mandelbrot-iter: routine [ 20 | cx [float!] cy [float!] max-iter [integer!] return: [integer!] 21 | /local x y xx yy xy i 22 | ][ 23 | x: 0.0 y: 0.0 xx: 0.0 yy: 0.0 xy: 0.0 24 | i: max-iter 25 | 26 | while [all [i > 0 xx + yy <= 4.0]][ 27 | i: i - 1 28 | xy: x * y 29 | xx: x * x 30 | yy: y * y 31 | x: xx - yy + cx 32 | y: xy + xy + cy 33 | ] 34 | i: i - 1 35 | max-iter - i 36 | ] 37 | 38 | fast-mandelbrot: routine [ 39 | img [image!] iterations [integer!] width [float!] height [float!] 40 | xmin [float!] xmax [float!] ymin [float!] ymax [float!] 41 | /local 42 | i [integer!] c [float!] pix [int-ptr!] ix iy x y handle b p 43 | ][ 44 | iy: 0.0 45 | handle: 0 46 | pix: image/acquire-buffer img :handle 47 | 48 | while [iy < height][ 49 | ix: 0.0 50 | while [ix < width][ 51 | x: xmin + ((xmax - xmin) * ix / (width - 1.0)) 52 | y: ymin + ((ymax - ymin) * iy / (height - 1.0)) 53 | 54 | i: mandelbrot-iter x y iterations 55 | 56 | pix/value: either i > iterations [FF000000h][ 57 | c: 3.0 * (log-e as-float i) / log-e as-float (iterations - 1) 58 | case [ 59 | c < 1.0 [FF000000h or (FFh and (as-integer 255.0 * c) << 16)] 60 | c < 2.0 [FFFF0000h or (FFh and (as-integer 255.0 * (c - 1.0)) << 8)] 61 | true [FFFFFF00h or (FFh and (as-integer 255.0 * (c - 2.0)))] 62 | ] 63 | ] 64 | pix: pix + 1 65 | ix: ix + 1.0 66 | ] 67 | iy: iy + 1.0 68 | ] 69 | image/release-buffer img handle yes 70 | ] 71 | 72 | mandelbrot: function [image xmin xmax ymin ymax iterations][ 73 | width: to float! image/size/x 74 | height: to float! image/size/y 75 | 76 | image/rgb: white 77 | fast-mandelbrot image iterations width height xmin xmax ymin ymax 78 | ] 79 | 80 | view [ 81 | title "Red Mandelbrot (fast)" 82 | style txt: text 60 right font-size 10 83 | below 84 | group-box 2 [ 85 | style fld: field 60 86 | txt "x-min" xmin: fld "-2.0" 87 | txt "x-max" xmax: fld "1.0" 88 | txt "y-min" ymin: fld "-1.0" 89 | txt "y-max" ymax: fld "1.0" 90 | txt "iterations" iterations: fld "100" 91 | ] 92 | button "Draw" 150x40 [ 93 | t0: now/time/precise 94 | mandelbrot canvas/image xmin/data xmax/data ymin/data ymax/data iterations/data 95 | dt/data: third now/time/precise - t0 96 | ] 97 | panel [origin 0x0 across txt "time(s):" dt: txt left 100] 98 | return 99 | canvas: image 900x600 100 | ] -------------------------------------------------------------------------------- /Scripts/mandelbrot.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | Title: "Mandelbrot" 3 | Author: "Fullstack Technologies team" 4 | Needs: 'View 5 | Tabs: 4 6 | Notes: { 7 | Ported from http://rebol2.blogspot.com/2013/03/mandelbrot.html 8 | 9 | This version is in pure Red, see the mandelbrot-fast.red script 10 | for a Red + Red/System fast version. 11 | } 12 | ] 13 | 14 | mandelIter: function [cx cy maxIter][ 15 | x: y: xx: yy: xy: 0.0 16 | i: maxIter 17 | while [all [i > 0 xx + yy <= 4]] [ 18 | i: i - 1 19 | xy: x * y 20 | xx: x * x 21 | yy: y * y 22 | x: xx - yy + cx 23 | y: xy + xy + cy 24 | ] i: i - 1 25 | maxIter - i 26 | ] 27 | 28 | mandelbrot: function [img xmin xmax ymin ymax iterations][ 29 | img/image/argb: white 30 | width: img/image/size/x 31 | height: img/image/size/y 32 | pix: img/image/rgb 33 | 34 | iy: 0 35 | while [iy < height] [ 36 | ix: 0 37 | while [ix < width] [ 38 | x: xmin + ((xmax - xmin) * ix / (width - 1)) 39 | y: ymin + ((ymax - ymin) * iy / (height - 1)) 40 | i: mandelIter x y iterations 41 | 42 | change pix either i > iterations [as-color 0 0 0][ 43 | c: 3 * (log-e i) / log-e (iterations - 1.0) 44 | case [ 45 | c < 1 [as-color to integer! 255 * c 0 0] 46 | c < 2 [as-color 255 to integer! 255 * (c - 1) 0] 47 | true [as-color 255 255 to integer! 255 * (c - 2)] 48 | ] 49 | ] 50 | pix: skip pix 3 51 | ix: ix + 1 52 | ] 53 | unless img/state [exit] 54 | img/image/rgb: head pix 55 | show img 56 | do-events/no-wait ;-- allow GUI msgs to be processed 57 | iy: iy + 1 58 | ] 59 | ] 60 | 61 | view [ 62 | title "Red Mandelbrot" 63 | below 64 | style txt: text 60 right font-size 10 65 | 66 | group-box 2 [ 67 | style fld: field 60 68 | txt "x-min" xmin: fld "-2.0" 69 | txt "x-max" xmax: fld "1.0" 70 | txt "y-min" ymin: fld "-1.0" 71 | txt "y-max" ymax: fld "1.0" 72 | txt "iterations" iterations: fld "100" 73 | ] 74 | button "Draw" 150x40 [ 75 | t0: now/time/precise 76 | face/enabled?: no 77 | mandelbrot img xmin/data xmax/data ymin/data ymax/data iterations/data 78 | dt/data: round now/time/precise - t0 79 | face/enabled?: yes 80 | ] 81 | across txt "time (s):" dt: txt 82 | below return 83 | img: image 900x600 84 | ] -------------------------------------------------------------------------------- /Scripts/palette.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | Title: "Palette" 3 | Author: @9214 4 | Date: 27-Dec-2017 5 | File: %palette.red 6 | Needs: View 7 | Purpose: { 8 | Shows a 4x11 palette of all built-in colors. 9 | Features an inscrutable one-liner that fetches all the color names 10 | and programmatic generation of VID code. 11 | } 12 | ] 13 | 14 | colors: exclude sort extract load help-string tuple! 2 [transparent glass] 15 | 16 | view/tight collect [ 17 | keep [title "Palette"] 18 | until [ 19 | foreach color take/part colors 4 [ 20 | keep reduce [ 21 | 'base 70x40 22 | lowercase form color 23 | get color 24 | pick [white black] gray > get color 25 | ] 26 | ] 27 | keep 'return 28 | empty? colors 29 | ] 30 | ] 31 | -------------------------------------------------------------------------------- /Scripts/particles.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | Title: "Particles demo" 3 | Author: "Qingtian Xie" 4 | File: %particles.red 5 | Tabs: 4 6 | Note: "Ported from http://www.rebol.com/view/demos/particles.r" 7 | Needs: View 8 | ] 9 | 10 | context [ 11 | screen-size: 600x500 12 | particles-count: 100 13 | slots: 7 14 | particles: make block! 100 * slots 15 | fps: rot: bx: 0 16 | 17 | to-text: func [val][ 18 | particles-count: to integer! val * 200 19 | append copy "number of particles: " particles-count 20 | ] 21 | 22 | view/no-wait [ 23 | title "Particles demo" 24 | txt: text "number of particles: 100" 25 | text "FPS: 0" rate 1 on-time [ 26 | append clear skip face/text 5 fps 27 | show face 28 | fps: 0 29 | ] 30 | slider 50% [ 31 | txt/text: to-text face/data 32 | show txt 33 | ] 34 | return 35 | bx: base black screen-size 36 | ] 37 | bx/draw: make block! particles-count * 14 38 | system/view/auto-sync?: no 39 | 40 | while [bx/state][ 41 | particles: head particles 42 | loop 10 [ 43 | if (length? particles) / slots < particles-count [ 44 | rot: (rot + 2) // 360 45 | center: screen-size / 2 46 | reduce/into [ 47 | color: random 255.255.255.0 48 | color + 0.0.0.255 49 | (center/x + (center/x / 3.0 * sine rot)) 50 | (center/y + (center/y / 3.0 * cosine rot)) 51 | (random 25) + 10 52 | (random 200) / 10.0 - 10 53 | (random 200) / 10.0 - 10 54 | ] tail particles 55 | ] 56 | ] 57 | 58 | clear fx: bx/draw 59 | insert fx [pen off] 60 | 61 | while [not tail? particles] [ 62 | p: particles 63 | p/3: p/3 + p/6 64 | p/4: p/4 + p/7 65 | pos: as-pair p/3 p/4 66 | either not within? pos 0x0 - p/5 screen-size + p/5 [ 67 | remove/part particles slots 68 | ][ 69 | reduce/into [ 70 | 'fill-pen 'radial pos 0 p/5 p/2 p/2 p/1 * 2 71 | p/2 - 0.0.0.128 p/2 - 0.0.0.64 p/2 'circle pos p/5 72 | ] tail fx 73 | particles: skip particles slots 74 | ] 75 | ] 76 | show bx 77 | fps: fps + 1 78 | loop 5 [do-events/no-wait] 79 | ] 80 | system/view/auto-sync?: yes 81 | ] 82 | 83 | -------------------------------------------------------------------------------- /Scripts/reactive/color-sliders-mini.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | Title: "RGB sliders mini demo" 3 | Author: "Nenad Rakocevic" 4 | File: %color-sliders-mini.red 5 | Needs: 'View 6 | Notes: { 7 | Demo of chained reactive programming, moving the sliders changes the box's color. 8 | This demo is reduced to the bare minimum. 9 | } 10 | ] 11 | 12 | to-int: function [value [percent!]][to-integer 255 * value] 13 | 14 | view [ 15 | below 16 | R: slider 17 | G: slider 18 | B: slider 19 | base react [ 20 | face/color: as-color to-int R/data to-int G/data to-int B/data 21 | ] 22 | ] -------------------------------------------------------------------------------- /Scripts/reactive/color-sliders.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | Title: "Red VID reactive script" 3 | Author: "Nenad Rakocevic" 4 | File: %color-sliders.red 5 | Needs: 'View 6 | License: "MIT" 7 | Notes: { 8 | Demo of chained reactive programming, moving the sliders changes the box's color 9 | which in return, changes the bottom text font color. 10 | } 11 | ] 12 | 13 | to-color: function [r g b][ 14 | color: 0.0.0 15 | if r [color/1: to integer! 256 * r] 16 | if g [color/2: to integer! 256 * g] 17 | if b [color/3: to integer! 256 * b] 18 | color 19 | ] 20 | 21 | to-text: function [val][form to integer! 0.5 + 255 * any [val 0]] 22 | 23 | view [ 24 | title "Color sliders reactive demo" 25 | style txt: text 40 right 26 | style value: text "0" 30 right bold 27 | 28 | across 29 | txt "Red:" R: slider 256 value react [face/text: to-text R/data] return 30 | txt "Green:" G: slider 256 value react [face/text: to-text G/data] return 31 | txt "Blue:" B: slider 256 value react [face/text: to-text B/data] 32 | 33 | pad 0x-65 box: base react [face/color: to-color R/data G/data B/data] return 34 | 35 | pad 0x20 text "The quick brown fox jumps over the lazy dog." 36 | font [size: 14] 37 | react [face/font/color: box/color] 38 | ] 39 | 40 | -------------------------------------------------------------------------------- /Scripts/reactive/spline.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | Title: "Spline demo" 3 | Author: "Xie Qingtian, Nenad Rakocevic" 4 | File: %spline.red 5 | Needs: 'View 6 | Date: "22/06/2016" 7 | License: "MIT" 8 | Notes: { 9 | This simple spline tool allows you to drag the control points position 10 | using the mouse, and see the spline's shape change accordingly. 11 | 12 | Note: there is a minor bug with circles drawing, which should be fixed soon, so 13 | no need to report it. 14 | } 15 | ] 16 | 17 | light-blue: 102.148.179.36 18 | 19 | view/tight [ 20 | title "Spline demo" 21 | style nub: base glass 12x12 loose draw [pen pink fill-pen 255.20.147.128 circle 6x6 5.5] 22 | 23 | canvas: base white 600x600 react [ 24 | face/draw: reduce [ 25 | 'line-width 2 26 | 'pen black 27 | 'spline 28 | p1/offset + 5 29 | p2/offset + 5 30 | p3/offset + 5 31 | p4/offset + 5 32 | p5/offset + 5 33 | p6/offset + 5 34 | ] 35 | ] 36 | 37 | at 240x400 p1: nub 38 | at 240x320 p2: nub 39 | at 120x100 p3: nub 40 | at 500x100 p4: nub 41 | at 460x500 p5: nub 42 | at 100x500 p6: nub 43 | ] -------------------------------------------------------------------------------- /Scripts/reactive/worm.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | Author: ["Didier Cadieu" "Nenad Rakocevic"] 3 | File: %worm.red 4 | Needs: 'View 5 | Notes: { 6 | Drag the red ball using left mouse button, all the other balls 7 | will follow it. This demonstrates the "dynamic" reactions usage 8 | from Red's reactive framework. 9 | 10 | See more about reactive programming in Red here: 11 | http://www.red-lang.org/2016/06/061-reactive-programming.html 12 | } 13 | ] 14 | 15 | system/reactivity/eat-events?: no ;-- make it as smooth as possible 16 | 17 | win: layout [ 18 | size 400x500 19 | across 20 | style ball: base 30x30 transparent draw [fill-pen blue circle 15x15 14] 21 | ball ball ball ball ball ball ball ball return 22 | ball ball ball ball ball ball ball ball return 23 | ball ball ball ball ball ball ball ball return 24 | b: ball loose 25 | do [b/draw/2: red] 26 | ] 27 | 28 | follow: func [left right /local old][ 29 | all [point2D? old: left/extra left/offset: left/offset + old / 2] 30 | left/extra: right/offset 31 | ] 32 | 33 | faces: win/pane 34 | while [not tail? next faces][ 35 | react/link/later :follow [faces/1 faces/2] 36 | faces: next faces 37 | ] 38 | view win -------------------------------------------------------------------------------- /Scripts/resize-image.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | Title: "Draw Image Resizing Test" 3 | Author: "Nenad Rakocevic" 4 | History: [REBOL version "Carl Sassenrath" Orginal Red port "Gregg Irwin"] 5 | File: %resize-image.red 6 | Needs: View 7 | ] 8 | 9 | url: https://pbs.twimg.com/profile_images/501701094032941056/R-a4YJ5K.png 10 | radius: 5x5 ;-- grab-size 11 | 12 | view compose/deep [ 13 | title "Draw Image Resizing Test" 14 | backdrop water 15 | text bold water white "Red resize image test" 16 | text bold water yellow "Drag the grab handles" 17 | return 18 | panel 960x720 black [ 19 | style nub: base (radius * 2) transparent loose draw [fill-pen yellow circle (radius) (radius/x)] 20 | 21 | img: image url 100x100 react [ 22 | face/offset: left/offset + radius 23 | face/size: right/offset - left/offset 24 | ] 25 | at img/offset left: nub 26 | at img/offset + img/size right: nub 27 | ] 28 | ] -------------------------------------------------------------------------------- /Scripts/resize-image2.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | Title: "Draw Image Resizing Test" 3 | Author: "Nenad Rakocevic" 4 | History: [REBOL version "Carl Sassenrath" Orginal Red port "Gregg Irwin"] 5 | File: %resize-image2.red 6 | Needs: View 7 | Notes: { 8 | Improves the %resize-image.red script in several ways: 9 | - bounds the handles movements when dragging to the visible area. 10 | - allows the image to be moved by dragging it with the mouse, limiting it to the 11 | visible area. 12 | } 13 | ] 14 | 15 | url: https://pbs.twimg.com/profile_images/501701094032941056/R-a4YJ5K.png 16 | radius: 5x5 ;-- grab-size 17 | 18 | view compose/deep [ 19 | title "Draw Image Resizing Test" 20 | backdrop water 21 | text bold water white "Red resize image test" 22 | text bold water yellow "Drag the grab handles" 23 | return 24 | panel 960x720 black [ 25 | style nub: base (radius * 2) transparent loose draw [fill-pen yellow circle (radius) (radius/x)] 26 | 27 | img: image url 100x100 loose on-drag [ 28 | no-react [ 29 | left/offset: img/offset - radius 30 | right/offset: img/offset + img/size - radius 31 | show [left right] 32 | ] 33 | ] react [ 34 | face/offset: left/offset + radius 35 | face/size: right/offset - left/offset 36 | ] 37 | at img/offset left: nub on-drag-start [object [min: negate radius max: right/offset]] 38 | at img/offset + img/size right: nub on-drag-start [object [min: left/offset max: face/parent/size - right/size + radius]] 39 | ] 40 | ] -------------------------------------------------------------------------------- /Scripts/spiral.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | Title: "Spiral tides" 3 | Author: "Cyphre" 4 | Needs: 'View 5 | Date: "25/03/2016" 6 | License: "MIT" 7 | Notes: "Ported from Rebol to Red by Pekr, optimized by Nenad Rakocevic. Modified by DideC" 8 | ] 9 | 10 | size: 700x700 11 | ff: 0 12 | mod: 1 13 | 14 | make-spiral: func [wd angle buffer /local offset][ 15 | ff: ff + 20 16 | offset: as-pair 17 | to integer! size/x / 2 + (10 * sine ff) 18 | to integer! size/y / 2 + (10 * cosine ff) 19 | 20 | repeat i 360 [ 21 | append buffer as-pair 22 | offset/x + (i * sine angle + (wd * i)) 23 | offset/y + (i * cosine angle + (wd * I)) 24 | ] 25 | ] 26 | 27 | tv: angle: 0 28 | color: random 255.255.255 29 | op: :- 30 | xx: random 20.20.20 31 | 32 | view/no-sync [ 33 | title "Spiral" 34 | canvas: base size all-over white rate 60 on-time [ 35 | if color < 30.30.30 [op: :+ xx: random 20.20.20] 36 | if color > 200.200.200 [op: :- xx: random 20.20.20] 37 | color: color op xx 38 | tv: tv - 0.2 39 | angle: angle - 1 40 | 41 | buffer: clear any [canvas/draw canvas/draw: make block! 400] 42 | compose/into [line-width 2 pen (color) line] buffer 43 | 44 | make-spiral tv angle buffer 45 | show canvas 46 | ] 47 | ] 48 | -------------------------------------------------------------------------------- /Scripts/starfield.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | Title: "Starfield" 3 | Author: "Nenad Rakocevic" 4 | File: %starfield.red 5 | Needs: 'View 6 | Notes: { 7 | This is a Red port of a Starfield coding challenge for Processing language: 8 | https://github.com/CodingTrain/Coding-Challenges/tree/main/001_StarField/Processing/CC_001_StarField 9 | 10 | The Red port is about the same number of lines of code, despite not having 11 | all the implicit framework for animations that Processing has. Also, the 12 | `in-range` and `rescale` functions are built-in in Processing while we need 13 | to define them in Red. 14 | } 15 | ] 16 | 17 | num: 800 ;-- number of stars 18 | speed: 12 ;-- initial speed 19 | size: 900x900 ;-- canvas size 20 | stars: make block! num ;-- star objects list 21 | 22 | pts: as-point2D 0 size/y 23 | hsx: as-point2D 0 size/x / 2 24 | hsy: as-point2D 0 size/y / 2 25 | 26 | in-range: function [low [number!] high [number!]][r: high - low (random r) - (r / 2)] 27 | 28 | rescale: func [value [float!] low [point2D!] high [point2D!] return: [float!]][ 29 | (value - low/x) / (low/y - low/x) * (high/y - high/x) + high/x 30 | ] 31 | 32 | get-new-location: func [/init return: [point3D!]][ 33 | as-point3D 34 | in-range negate size/x / 2 size/x / 2 ;-- -sx/2 < center/x < sx/2 35 | in-range negate size/y / 2 size/y / 2 ;-- -sy/2 < center/y < sy/2 36 | either init [random size/x / 2][size/x / 2] ;-- radius 37 | ] 38 | 39 | make-stars: func [return: [block!] /local list][ 40 | list: make block! num * 10 41 | loop num [ 42 | append stars object [ 43 | pos: get-new-location/init 44 | pz: pos/z 45 | circle: tail list ;-- store reference to 'circle command 46 | ] 47 | ;-- indexes: 1 2 3 7 8 48 | append list [circle (0,0) 0 pen white line (0, 0) (0, 0) pen off] 49 | ] 50 | list 51 | ] 52 | 53 | move-stars: function [face event][ 54 | foreach star stars [ 55 | star/pos/z: star/pos/z - speed 56 | if star/pos/z < 1 [ ;-- when star exits 57 | star/pos: get-new-location 58 | star/pz: star/pos/z 59 | ] 60 | s: star/pos 61 | canvas: star/circle 62 | canvas/2/x: rescale s/x / s/z (0, 1) hsx ;-- center/x 63 | canvas/2/y: rescale s/y / s/z (0, 1) hsy ;-- center/y 64 | canvas/3: rescale s/z hsx (6, 0) ;-- radius 65 | canvas/7: as-point2D 66 | rescale s/x / star/pz (0, 1) hsx ;-- line begin/x 67 | rescale s/y / star/pz (0, 1) hsy ;-- line begin/y 68 | canvas/8: to-point2D canvas/2 ;-- line end (center) 69 | star/pz: star/pos/z ;-- save center 70 | ] 71 | show face ;-- update whole canvas on screen 72 | ] 73 | 74 | view/no-sync compose/deep/only [ 75 | title "Starfield" 76 | base size black rate 60 all-over 77 | draw [pen off fill-pen white translate (size / 2) (make-stars)] 78 | on-over [speed: rescale event/offset/x pts (0, 50)] 79 | on-time :move-stars 80 | ] -------------------------------------------------------------------------------- /Showcase/README.md: -------------------------------------------------------------------------------- 1 | # Showcase 2 | 3 | This is a collection of scripts or apps which show both the breadth and depth of Red and its wide applicability. Every one is complete with no external dependencies. -------------------------------------------------------------------------------- /Showcase/ballots/images/ballot_approval.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/red/code/82b7bce0c4d0febd42f5179a7b2ad2792f3037b0/Showcase/ballots/images/ballot_approval.png -------------------------------------------------------------------------------- /Showcase/ballots/images/ballot_box.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/red/code/82b7bce0c4d0febd42f5179a7b2ad2792f3037b0/Showcase/ballots/images/ballot_box.png -------------------------------------------------------------------------------- /Showcase/ballots/images/ballot_fptp.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/red/code/82b7bce0c4d0febd42f5179a7b2ad2792f3037b0/Showcase/ballots/images/ballot_fptp.png -------------------------------------------------------------------------------- /Showcase/ballots/images/ballot_range.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/red/code/82b7bce0c4d0febd42f5179a7b2ad2792f3037b0/Showcase/ballots/images/ballot_range.png -------------------------------------------------------------------------------- /Showcase/ballots/images/ballot_ranked.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/red/code/82b7bce0c4d0febd42f5179a7b2ad2792f3037b0/Showcase/ballots/images/ballot_ranked.png -------------------------------------------------------------------------------- /Showcase/ballots/images/ballot_rate.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/red/code/82b7bce0c4d0febd42f5179a7b2ad2792f3037b0/Showcase/ballots/images/ballot_rate.png -------------------------------------------------------------------------------- /Showcase/calculator.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | Title: "Calculator demo" 3 | Author: "Nick Antonaccio" 4 | File: %calculator.red 5 | License: "Public domain" 6 | Needs: 'View 7 | Notes: "Very simple calculator app. More from Nick at http://redprogramming.com" 8 | ] 9 | 10 | view [ 11 | title "Calculator" 12 | style b: button 60x60 bold font-size 18 [append f/text face/text] 13 | b "C" 60x50 [clear f/text] 14 | f: text 200x50 right white font-size 18 "" return 15 | b "1" b "2" b "3" b " + " return 16 | b "4" b "5" b "6" b " - " return 17 | b "7" b "8" b "9" b " * " return 18 | b "0" b "." b " / " b "=" [attempt [f/data: math load f/text]] 19 | ] -------------------------------------------------------------------------------- /Showcase/ellipse.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | Author: "Toomas Vooglaid" 3 | Date: 2018-03-26 4 | Purpose: "Study of ellipse" 5 | Based-on: https://en.wikipedia.org/wiki/Ellipse 6 | ] 7 | 8 | tick: 0 9 | view/tight [ 10 | title "Ellipse" 11 | box 300x300 rate 90 draw [ 12 | translate 150x150 13 | circle 0x0 100 14 | pen blue line 0x-100 0x100 circle 0x-100 2 circle 0x100 2 15 | pen green line -100x0 100x0 circle -100x0 2 circle 100x0 2 16 | circ: transform 0x0 0 1 1 0x0 [ 17 | rot: rotate 0 50x0 [ 18 | pen black circle 50x0 50 19 | line-cap round 20 | pen gray line-width 8 line 0x0 100x0 21 | pen blue line-width 1 circle 0x0 1 22 | pen green circle 100x0 1 23 | pen red circle 66x0 1 24 | pen cyan circle 88x0 1 25 | ] 26 | ] 27 | pen cyan ellipse -88x-12 176x24 28 | pen red ellipse -66x-34 132x68 29 | ] 30 | on-time [ 31 | tick: tick + 1 32 | circ/3: negate tick 33 | rot/2: 2 * tick 34 | ] 35 | ] -------------------------------------------------------------------------------- /Showcase/eve-clock.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | Title: "Simple Eve-style clock livecoding demo" 3 | Author: "Nenad Rakocevic" 4 | Date: "16/07/2016" 5 | File: %simple-clock.red 6 | Needs: 'View 7 | Purpose: { 8 | This demo is a port of the Eve clock demo by Chris Granger to Red, adding 9 | livecoding abilities, turning a few lines of code into a livecoding environment. 10 | 11 | Original Eve demo: https://twitter.com/ibdknox/status/751169352632668160 12 | 13 | For more information about this demo see the related article: 14 | http://www.red-lang.org/2016/07/eve-style-clock-demo-in-red-livecoded.html 15 | } 16 | ] 17 | 18 | clock-demo: { 19 | base 200x200 transparent rate 1 now draw [ 20 | scale 2 2 21 | fill-pen #0B79CE pen off 22 | circle 50x50 45 23 | line-width 2 24 | hour: rotate 0 50x50 [pen #023963 line 50x50 50x20] 25 | min: rotate 0 50x50 [pen #023963 line 50x50 50x10] 26 | sec: rotate 0 50x50 [pen #CE0B46 line 50x50 50x10] 27 | ] on-time [ 28 | time: now/time 29 | hour/2: 30 * time/hour 30 | min/2: 6 * time/minute 31 | sec/2: 6 * time/second 32 | ] 33 | } 34 | 35 | system/view/silent?: yes 36 | 37 | view [ 38 | title "Eve clock demo" 39 | backdrop #2C3339 40 | across 41 | 42 | source: area #13181E 410x300 no-border clock-demo font [ 43 | name: font-fixed 44 | size: 9 45 | color: hex-to-rgb #9EBACB 46 | ] 47 | 48 | panel 200x300 #2C3339 react [ 49 | attempt/safer [face/pane: layout/tight/only load source/text] 50 | ] 51 | ] 52 | -------------------------------------------------------------------------------- /Showcase/last-commits.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | Title: "Last commits on red/red" 3 | Author: "Nenad Rakocevic" 4 | File: %last-commits.red 5 | Needs: 'View 6 | Purpose: { 7 | Retrieves last commits on red/red repo from Github and displays their log 8 | messages in a scrollable list. (Takes almost as much text to describe 9 | it, as code to implement it. ;-)) 10 | 11 | This example does not need any "variable", nor does define any function. 12 | It combines two declarative DSLs (VID and Parse) to achieve optimal 13 | expressiveness. 14 | } 15 | ] 16 | 17 | view [ 18 | text-list data parse 19 | read https://api.github.com/repos/red/red/commits 20 | [collect [any [thru {"message":"} keep to [{"} | "\n"]]]] 21 | ] -------------------------------------------------------------------------------- /Showcase/last-commits2.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | Title: "Last commits on red/red" 3 | Author: "Dave Andersen" 4 | File: %last-commits2.red 5 | Needs: 'View 6 | Purpose: { 7 | Retrieves last commits on red/red repo from Github and displays their log 8 | messages in a scrollable list. (Takes almost as much text to describe 9 | it, as code to implement it. ;-)) 10 | 11 | This is a variant of %last-commit.red script. It relies on the powerful 12 | LOAD function which can recognize different data formats and apply the right 13 | decoder automatically (JSON codec in this case). The output is a Red tree 14 | that can then be easily navigated through using path accessors. 15 | } 16 | ] 17 | 18 | view [ 19 | text-list data collect [ 20 | foreach event load https://api.github.com/repos/red/red/commits [ 21 | keep event/commit/message 22 | ] 23 | ] 24 | ] -------------------------------------------------------------------------------- /Showcase/last-commits3.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | Title: "Last commits on red/red" 3 | Author: "Dave Andersen, Nenad Rakocevic" 4 | File: %last-commits3.red 5 | Needs: 'View 6 | Purpose: { 7 | Retrieves last commits on red/red repo from Github and displays their log 8 | messages in a scrollable list. (Takes almost as much text to describe 9 | it, as code to implement it. ;-)) 10 | 11 | This is an extended version of %last-commit2.red script. It also retrieves 12 | the web URL for the commit, stores it in the text-list (encoding them as 13 | issue! values to not be displayed). On double-clicking one of the commit 14 | log, the corresponding webpage on Github will get opened. 15 | } 16 | ] 17 | 18 | view [ 19 | text-list data collect [ 20 | foreach event load https://api.github.com/repos/red/red/commits [ 21 | keep event/commit/message 22 | keep to-issue event/html_url 23 | ] 24 | ] on-dbl-click [browse to-url face/data/(event/picked * 2)] 25 | ] -------------------------------------------------------------------------------- /Showcase/livecode.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | Title: "Simple GUI livecoding demo" 3 | Author: "Nenad Rakocevic" 4 | File: %livecode.red 5 | Needs: 'View 6 | Usage: { 7 | Type VID code in the right area, you will see the resulting GUI components 8 | rendered live on the left side and fully functional (events/actors/reactors working live). 9 | } 10 | ] 11 | 12 | view [ 13 | title "Red Livecoding" 14 | output-panel: panel 600x800 15 | source-area: area 600x800 wrap font-name "Consolas" on-key-up [ 16 | attempt [output-panel/pane: layout/only load source-area/text] 17 | ] 18 | ] 19 | -------------------------------------------------------------------------------- /Showcase/picosheet.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | Title: "Picosheet demo" 3 | Author: "Nenad Rakocevic" 4 | Date: "07/07/2016" 5 | File: %picosheet.red 6 | Needs: 'View 7 | Purpose: { 8 | Shows how to implement a native reactive spreadsheet in a single page 9 | of code. 10 | 11 | For more information about this demo see the related article: 12 | http://www.red-lang.org/2016/07/native-reactive-spreadsheet-in-17-loc.html 13 | 14 | This version is "unrolled", so it is more easily readable and contains some 15 | demo values for the sheet. 16 | } 17 | ] 18 | 19 | L: charset "ABCDEFGHI" 20 | N: charset "123456789" 21 | D: union N charset "0" 22 | p: [] 23 | 24 | repeat y 9 [ 25 | repeat x 9 [ 26 | col: either x = 1 [#"^(202F)"][#"A" + (x - 2)] 27 | ref: to word! append form col y - 1 28 | header?: (y = 1) or (x = 1) 29 | 30 | append p set ref make face! [ 31 | size: 90x24 32 | type: pick [text field] header? 33 | options: compose [sync: (any-type!)] 34 | 35 | offset: -20x10 + as-pair 36 | ((x - 1) * size/x + 2) 37 | ((y - 1) * size/y + 1) 38 | 39 | text: form case [ 40 | y = 1 [col] 41 | x = 1 [y - 1] 42 | 'else [copy ""] 43 | ] 44 | para: make para! [ 45 | align: pick [center right] header? 46 | ] 47 | extra: object [ 48 | name: form ref 49 | formula: old: none 50 | ] 51 | actors: context [ 52 | on-create: on-unfocus: function [f e][ 53 | f/color: none 54 | if rel: f/extra/old [react/unlink rel 'all] 55 | 56 | text: copy f/text 57 | f/extra/formula: copy text 58 | 59 | if #"=" = f/extra/formula/1 [ 60 | if rel: f/extra/old [react/unlink rel 'all] 61 | parse remove text [ 62 | any [ 63 | p: L N not ["/" skip not N] insert p " " insert "/data " 64 | | L skip 65 | | p: some D opt [dot some D] insert p " " insert " " 66 | | skip 67 | ] 68 | ] 69 | f/text: rejoin [f/extra/name "/data: any [math/safe [" text {] "#UND"]}] 70 | if f/data [any [react f/extra/old: f/data do f/data]] 71 | ] 72 | ] 73 | on-focus: function [f e][ 74 | f/text: any [f/extra/formula f/text] 75 | f/color: yello 76 | ] 77 | ] 78 | ] 79 | ] 80 | ] 81 | 82 | demo-sheet: [ 83 | A1: "Designation" 84 | B1: "Quantity" 85 | C1: "Price $" 86 | D1: "Total $" 87 | E1: "Tax rate:" 88 | F1: "12%" 89 | A2: "PC" 90 | B2: "1" 91 | C2: "500" 92 | D2: "=B2*C2" 93 | E2: "Average price:" 94 | F2: "=(C2+C3+C4)/3" 95 | A3: "Monitor" 96 | B3: "2" 97 | C3: "250" 98 | D3: "=B3*C3" 99 | E3: "Nb of items :" 100 | F3: "=B2+B3+B4" 101 | A4: "Desk" 102 | B4: "1" 103 | C4: "120" 104 | D4: "=B4*C4" 105 | E4: "Avg price / items:" 106 | F4: "=F2/F3" 107 | C5: "TOTAL $" 108 | D5: "=D2+D3+D4" 109 | C6: "VAT" 110 | D6: "=D5*F1" 111 | ] 112 | 113 | ;-- Set the formulas to face objects /text property 114 | foreach [name value] demo-sheet [ 115 | set in (get to word! form name) 'text value 116 | ] 117 | 118 | ;-- Open a window and fill its /pane list with all the created widgets 119 | view make face! [type: 'window text: "PicoSheets demo" size: 840x250 pane: p] 120 | 121 | -------------------------------------------------------------------------------- /Showcase/puppy-finder.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | Title: "Puppy Finder" 3 | Author: @9214 4 | Date: 26-Apr-2020 5 | File: %puppy-finder.red 6 | Needs: View 7 | Purpose: { 8 | This demo is a port of Matthew Carter's "Puny GUI Puppy Finder", 9 | showcasing the conjoint use of View, VID, and JSON/JPEG codecs. 10 | 11 | Original: https://ahungry.com/blog/2020-04-24-Puny-GUI-Puppy-Finder.html 12 | } 13 | ] 14 | 15 | view [ 16 | title "Puppy Finder" 17 | below center 18 | button "Find a new dog" [ 19 | puppy/image: load to-url select 20 | load https://dog.ceo/api/breeds/image/random 21 | 'message 22 | ] 23 | text "Click the button to see a new dog.^/Click the dog to close the app." 24 | puppy: image 300x300 [unview] 25 | ] 26 | -------------------------------------------------------------------------------- /Showcase/tile-game.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | Title: "Tile game" 3 | Purpose: {An implementation in Red of the 4x4 sliding tile puzzle} 4 | Author: "Rudolf W. MEIJER (meijeru)" 5 | File: %tile-game.red 6 | Needs: 'View 7 | Usage: { 8 | Click on any tile that is adjacent to the empty space 9 | and it will shift to that space. 10 | Try to obtain a given configuration, e.g. 1 to 15 in order. 11 | } 12 | Note: { 13 | See also http://www.tilepuzzles.com. 14 | Original R2 code (with helpful comments) found in 15 | http://re-bol.com/rebol.html#section-6.3 16 | (thanks Nick Antonaccio!). 17 | This minimal version starts in the ordered configuration, 18 | so preferably have someone else "mess it up" for you first. 19 | A version which allows to randomize the order of the tiles 20 | is available at https://gist.github.com/meijeru/00c1693a00418481b90b 21 | } 22 | ] 23 | 24 | view/tight [ 25 | title "Tile game" 26 | style piece: button 60x60 font-size 12 bold [ 27 | delta: absolute face/offset - empty/offset 28 | if delta/x + delta/y > 90 [exit] 29 | pos: face/offset face/offset: empty/offset empty/offset: pos 30 | ] 31 | piece "1" piece "2" piece "3" piece "4" return 32 | piece "5" piece "6" piece "7" piece "8" return 33 | piece "9" piece "10" piece "11" piece "12" return 34 | piece "13" piece "14" piece "15" empty: piece "" 35 | ] --------------------------------------------------------------------------------