├── .editorconfig ├── .gitattributes ├── .github └── linguist │ └── dclang.tmLanguage.json ├── .gitignore ├── CHANGES.txt ├── LICENSE ├── Makefile.linux ├── Makefile.mac ├── README.md ├── cleanup_whitespace.sh ├── contrib ├── Dockerfile └── dclang.nanorc ├── dclang.h ├── examples ├── animal_words.dc ├── astronomy_tools │ ├── 100_double_stars.txt │ ├── colorful_double_stars.txt │ └── make_sky_safari_list.dc ├── change_ring.txt ├── chaos_study.dc ├── circle.dc ├── cl_script.dc ├── climate_change_graph.dc ├── climate_change_graph.html ├── contfrac.dc ├── digit_sum_study.dc ├── dsp_examples │ ├── Makefile │ ├── README.md │ ├── bassline.dc │ ├── bells_of_doom_example.dc │ ├── biquad_bp_example.dc │ ├── biquad_hp_example.dc │ ├── biquad_lp_example.dc │ ├── delay_example.dc │ ├── drum_machine.dc │ ├── ebow_example.dc │ ├── fm_example.dc │ ├── hc_bandpass_example.dc │ ├── hc_lowpass_example.dc │ ├── metronome_example.dc │ ├── midi_beating.dc │ ├── midi_trigger.dc │ ├── noise_example.dc │ ├── panning_example.dc │ ├── portamento_lead.dc │ ├── portaudio_stub.c │ ├── pw_mod_example.dc │ ├── randtrig_example.dc │ ├── reverb_example.dc │ ├── run-example-portaudio.sh │ ├── run-example.sh │ ├── simple_delay_example.dc │ ├── sineloop_example.dc │ └── sync.dc ├── edo_chart.dc ├── fibonacci.dc ├── fizzbuzz.dc ├── fractions_examples.dc ├── http_server_example.dc ├── kaleidoscope.dc ├── loop_bench.dc ├── math_operation_speed.dc ├── midi-ctrl-knobs │ ├── midi_ctrl_knobs.dc │ └── midi_ctrl_knobs.html ├── midi │ ├── README.md │ ├── change_ring.dc │ ├── digit_sum.dc │ ├── digit_sum_enharmonic.dc │ ├── midi_fractions.dc │ └── modulating_arpeggios.dc ├── nano_syntax_highlighting_test.dc ├── nested_import.dc ├── permutation_example.dc ├── redis_control.dc ├── redis_control.html ├── redis_example.dc ├── scl2hz.dc ├── shuffle_deck.dc ├── some_primes.dc ├── sorting.dc ├── stack_vs_var_speed.dc ├── stern_brocot_tree.dc ├── strings.dc ├── tcpclient.dc ├── tcpserver.dc ├── tetrachords.dc ├── timesquare.dc ├── tucson_airport.db.gz ├── waves.dc ├── word_count.dc └── word_nesting.dc ├── lib ├── clock_sleep.dc ├── csvlib.dc ├── deprecated_stack.dc ├── dsp.dc ├── fractions.dc ├── gcd.dc ├── http_server.dc ├── linked_list.dc ├── logging.dc ├── math.dc ├── midi.dc ├── music.dc ├── permutations.dc ├── primes.dc ├── redis.dc ├── redis_music.dc ├── sequencer.dc ├── shuffle.dc ├── sqlite3.dc └── string.dc ├── libdclang.c ├── libtest.c ├── libtest.dc ├── main.c ├── noheap ├── ht.c ├── ht.h ├── llist.c ├── llist.h ├── malloc.c ├── trees.c └── trees.h ├── syntaxes └── dclang.tmLanguage.json ├── tests ├── branch_test.dc ├── char_tests.dc ├── csvlib_test.dc ├── example.csv ├── file_tests.dc ├── fractions_tests.dc ├── list_tests.dc ├── logic_tests.dc ├── orion_double_stars.sql ├── regex_tests.dc ├── run_tests.sh ├── sqlite3_tests.dc ├── string_lib_tests.dc ├── trees_tests.dc └── variable_tests.dc └── token.c /.editorconfig: -------------------------------------------------------------------------------- 1 | [*] 2 | indent_style = tab 3 | indent_size = 2 4 | -------------------------------------------------------------------------------- /.gitattributes: -------------------------------------------------------------------------------- 1 | *.dc linguist-language=dclang 2 | -------------------------------------------------------------------------------- /.github/linguist/dclang.tmLanguage.json: -------------------------------------------------------------------------------- 1 | { 2 | "scopeName": "source.dclang", 3 | "name": "dclang", 4 | "patterns": [ 5 | { 6 | "name": "comment.line.dclang", 7 | "match": "#.*$", 8 | "settings": { 9 | "foreground": "#FFFFFF", 10 | "background": "#000000" 11 | } 12 | }, 13 | { 14 | "name": "constant.other.dclang", 15 | "match": "(^|\\s)([_:A-Z0-9]+)(?=\\s|$)", 16 | "settings": { 17 | "foreground": "#FF00FF" 18 | } 19 | }, 20 | { 21 | "name": "constant.language.dclang", 22 | "match": "(^|\\s)(null|false|true|pi|e)(?=\\s|$)", 23 | "settings": { 24 | "foreground": "#FF80FF" 25 | } 26 | }, 27 | { 28 | "name": "constant.numeric.dclang", 29 | "match": "(^|\\s)(-?[0-9]+\\.?[0-9]*|0[xX][0-9a-fA-F]+)(?=\\s|$)", 30 | "settings": { 31 | "foreground": "#FFFFFF", 32 | "background": "#000000" 33 | } 34 | }, 35 | { 36 | "name": "string.quoted.dclang", 37 | "begin": "\"", 38 | "end": "\"", 39 | "settings": { 40 | "foreground": "#FFFF00" 41 | } 42 | }, 43 | { 44 | "name": "keyword.operator.dclang", 45 | "match": "(^|\\s)(\\+|-|\\*|/|%|abs|min|max|<<|>>|=|<>|<|>|<=|>=|assert|and|or|not|xor|round|ceil|floor|pow|sqrt|log|log2|log10|sin|cos|tan|rand)(?=\\s|$)", 46 | "settings": { 47 | "foreground": "#FFFF80" 48 | } 49 | }, 50 | { 51 | "name": "support.function.stack.dclang", 52 | "match": "(^|\\s)(drop|dup|over|pick|swap|2drop|2dup|2over|depth|clear|\\.|\\.\\.|\\.rj|\\.s|svpush|svpop|svdrop|svpick|svdepth|svclear)(?=\\s|$)", 53 | "settings": { 54 | "foreground": "#0080FF" 55 | } 56 | }, 57 | { 58 | "name": "support.function.memory.dclang", 59 | "match": "(^|\\s)(!|@|const|var|allot|create|,|h@|h!|hkeys|sortnums|sortstrs|t!|t@|tmake|twalk|tdel|tdestroy|l!|l@|lmake|lpush|lpop|lins|lrem|ldel)(?=\\s|$)", 60 | "settings": { 61 | "foreground": "#FF0000" 62 | } 63 | }, 64 | { 65 | "name": "keyword.control.dclang", 66 | "match": "(^|\\s)(times|again|exittimes|for|next|exitfor|i|j|k|if|else|endif|return)(?=\\\\s|$)", 67 | "settings": { 68 | "foreground": "#80FF00" 69 | } 70 | }, 71 | { 72 | "name": "support.function.other.dclang", 73 | "match": "(^|\\s)(cr|print|emit|uemit|ord|tohex|bytes32|strlen|str=|str<|str>|strfind|strspn|strcspn|strtok|mempcpy|memset|mkbuf|free|isalnum|isalpha|iscntrl|isdigit|isgraph|islower|isprint|ispunct|isspace|isupper|isxdigit|tolower|toupper|regcomp|regexec|regread|fopen|fmemopen|fread|freadline|freadall|fseek|ftell|fwrite|fflush|fclose|redirect|resetout|open|read|write|flush|close|tcplisten|tcpaccept|tcpconnect|clock|sleep|epoch|dt->epoch|epoch->dt|block_sigint|unblock_sigint)(?=\\s|$)", 74 | "settings": { 75 | "foreground": "#00FFFF" 76 | } 77 | }, 78 | { 79 | "name": "punctuation.definition.dclang", 80 | "match": "(^|\\s)(:|;)(?=\\s|$)", 81 | "settings": { 82 | "foreground": "#FF0000" 83 | } 84 | }, 85 | { 86 | "name": "entity.name.function.dclang", 87 | "match": "(^|\\s)([^\\s]+)(?=\\s|$)", 88 | "settings": { 89 | "foreground": "#00FF00" 90 | } 91 | } 92 | ] 93 | } 94 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | dclang 2 | main.o 3 | 4 | -------------------------------------------------------------------------------- /CHANGES.txt: -------------------------------------------------------------------------------- 1 | 2021-11-27 2 | * Been a while since I've updated this. Big things I can remember having added since the last update 3 | (more available by looking at github diffs): 4 | * adding a bunch of words to use binary trees structures as avariable storage option. These work like 5 | hashes, but unlike `h@` and `h!`, you can create more than one (the `h` words only use a giant global 6 | common hash-space). They are only slightly slower than a hash; they have O(log n) performance. 7 | * tcp networking words: `tcpconnect`, `tcplisten`, `tcpaccept` 8 | * some library tweaks, including many MIDI examples and their dependent library code. 9 | * The addition (today) of `freadall`, to slurp an entire file into memory. 10 | 11 | 2020-05-01 12 | * Ok, maybe I'll be nice and announce: the `fread` word has changed API. The old parameter 13 | pattern was: , and an automatic buffer was created for the work. 14 | I then realized it would be better to make the user/caller supply the buffer, and return 15 | the end of the buffer on success, so that concats are easy like in `mempcpy`. In addition, `fread` 16 | could have a similar calling pattern that would allow easy "chaining" of the returns to repeatedly 17 | concat the read-in string from the . So now, the parameters on the stack are: 18 | , and it will return the new ENDING point of the 19 | buffer, which is essentially the input + 20 | 21 | 2020-03-06 22 | * refuse to update this file anymore when there is version control! 23 | 24 | 2019-05-11 25 | * logic_ops simplification/refactor. 26 | * adding 'true' and 'false' constants 27 | * adding a logic_ops test in the 'examples' folder 28 | 29 | 2019-05-07 30 | * 'do/redo' is now 'times/again' - again, distinguishing ourselves 31 | from Forth 32 | 33 | 2019-05-05 34 | * finished implementation of 'if-else-endif' 35 | 36 | 2019-04-14 37 | * big change: strings now just use "string" double-quotes, not their own 38 | `s"` token, which was the old way, derived from Forth. 39 | 40 | 2019-04-12 41 | * fix to an import string bug 42 | 43 | 2019-03-03 44 | * Got rid of `qdo` and `qredo` in favor of making `do` have that 45 | functionality. So, `do` is now a counted loop with `i`, `j`, `k` references. 46 | * Edited all examples to reflect this change. 47 | * changed the `stdin` catch logic to be better for cross-platform compiles 48 | in the `revertinput` function. 49 | * expanded the `fractions.dc` example to include multiplication and division 50 | of fractions. 51 | * adding this file. 52 | * add the `circle.dc` example. 53 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | The MIT License 2 | 3 | Copyright (c) 2020 Aaron Krister Johnson 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | 23 | -------------------------------------------------------------------------------- /Makefile.linux: -------------------------------------------------------------------------------- 1 | CC = gcc 2 | CFLAGS = -w -DHAS_TREEDESTROY -march=native -O3 -static -finline-functions 3 | LDFLAGS = -lm -lportmidi -lsqlite3 4 | LDDCLANG = -ldclang 5 | OBJECTS = main.o 6 | EXECUTABLE = dclang 7 | LIBOBJ = libdclang.o 8 | LIBSOOBJ = libdclang.so 9 | LIBTESTC = libtest.c 10 | HEADER = dclang.h 11 | PREFIX ?= /usr/local 12 | 13 | .PHONY: clean lib libtest 14 | 15 | default: dclang 16 | 17 | %.o: %.c 18 | $(CC) -c -o $@ $< $(CFLAGS) 19 | 20 | dclang: $(OBJECTS) 21 | $(CC) $(OBJECTS) -o $@ $(LDFLAGS) 22 | 23 | libdclang.o: 24 | $(CC) -c -fPIC -o $@ libdclang.c $(CFLAGS) 25 | 26 | lib: libdclang.o 27 | $(CC) -shared $(LIBOBJ) -o $(LIBSOOBJ) $(LDFLAGS) 28 | 29 | libtest: lib install 30 | $(CC) $(LIBTESTC) -o $@ $(LDDCLANG) 31 | 32 | install: lib dclang 33 | cp -a $(HEADER) $(PREFIX)/include 34 | cp -a $(LIBSOOBJ) $(PREFIX)/lib 35 | cp -a $(EXECUTABLE) $(PREFIX)/bin 36 | 37 | clean: 38 | rm -rf examples/*~ *~ dclang libtest *.o *.so 39 | -------------------------------------------------------------------------------- /Makefile.mac: -------------------------------------------------------------------------------- 1 | CC = clang 2 | CFLAGS = -w -O3 -static -finline-functions 3 | LDFLAGS = -lm -lportmidi -lsqlite3 4 | LDDCLANG = -ldclang 5 | OBJECTS = main.o 6 | EXECUTABLE = dclang 7 | LIBOBJ = libdclang.o 8 | LIBSOOBJ = libdclang.so 9 | LIBTESTC = libtest.c 10 | HEADER = dclang.h 11 | PREFIX ?= /usr/local 12 | 13 | .PHONY: clean lib libtest 14 | 15 | default: dclang 16 | 17 | %.o: %.c 18 | $(CC) -c -o $@ $< $(CFLAGS) 19 | 20 | dclang: $(OBJECTS) 21 | $(CC) $(OBJECTS) -o $@ $(LDFLAGS) 22 | 23 | libdclang.o: 24 | $(CC) -c -fPIC -o $@ libdclang.c $(CFLAGS) 25 | 26 | lib: libdclang.o 27 | $(CC) -shared $(LIBOBJ) -o $(LIBSOOBJ) $(LDFLAGS) 28 | 29 | libtest: lib install 30 | $(CC) $(LIBTESTC) -o $@ $(LDDCLANG) 31 | 32 | install: lib dclang 33 | cp -a $(HEADER) $(PREFIX)/include 34 | cp -a $(LIBSOOBJ) $(PREFIX)/lib 35 | ln -s $(shell pwd)/lib $(PREFIX)/lib/dclang 36 | cp -a $(EXECUTABLE) $(PREFIX)/bin 37 | 38 | clean: 39 | rm -rf examples/*~ *~ dclang libtest *.o *.so 40 | -------------------------------------------------------------------------------- /cleanup_whitespace.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | for f in `egrep -Rl "[ ]+$" | egrep ".dc" | egrep -v ".git"` 4 | do 5 | sed -E -i "s/[ \t]+$//g" $f 6 | done 7 | -------------------------------------------------------------------------------- /contrib/Dockerfile: -------------------------------------------------------------------------------- 1 | FROM alpine:latest 2 | WORKDIR /dclang 3 | COPY . ./ 4 | RUN apk add --no-cache build-base sqlite-dev portmidi-dev git rlwrap && \ 5 | cd / && \ 6 | cd /dclang && \ 7 | cp -a Makefile.linux Makefile && \ 8 | make clean && \ 9 | make dclang && \ 10 | make lib && \ 11 | make install && \ 12 | echo 'export DCLANG_LIBS="/dclang/lib"' >> /root/.profile && \ 13 | echo 'alias dclang="rlwrap dclang"' >> /root/.profile 14 | CMD /bin/bash 15 | 16 | FROM busybox:1.36-glibc 17 | WORKDIR / 18 | # system needs 19 | COPY --from=0 /lib/ld-musl-x86_64.so.1 /lib/ 20 | COPY --from=0 /usr/lib/libreadline* /usr/lib/ 21 | COPY --from=0 /usr/lib/libncursesw* /usr/lib/ 22 | COPY --from=0 /usr/lib/libasound* /usr/lib/ 23 | COPY --from=0 /usr/lib/libsqlite3* /usr/lib/ 24 | # immediate lib deps 25 | COPY --from=0 /usr/lib/libportmidi* /usr/lib/ 26 | COPY --from=0 /usr/local/lib/libdclang* /lib/ 27 | # binaries 28 | COPY --from=0 /usr/bin/rlwrap /usr/bin/ 29 | COPY --from=0 /usr/local/bin/dclang /usr/bin/ 30 | # environment 31 | COPY --from=0 /root/.profile /root/.profile 32 | COPY --from=0 /dclang* /dclang/ 33 | CMD sh -l 34 | -------------------------------------------------------------------------------- /contrib/dclang.nanorc: -------------------------------------------------------------------------------- 1 | ## Here is an example for Bourne shell scripts. 2 | 3 | syntax "dclang" "\.dc$" 4 | header "^#!.*(dclang[-0-9_]*)" 5 | comment "#" 6 | 7 | # general constants 8 | color magenta "(^|[[:space:]])(([_:A-Z0-9]+)($|[[:space:]]))*" 9 | # general names 10 | color green "(^|[[:space:]])(([^[:space:]]+)($|[[:space:]]))*" 11 | # decimal numeric 12 | color white,black "(^|[[:space:]])((-?[0-9]+\.?[0-9]*)($|[[:space:]]))*" 13 | # hexidecimal numeric 14 | color white,black "(^|[[:space:]])((-?0[x|X][0-9a-fA-F]+)($|[[:space:]]))*" 15 | # escaped chars 16 | color white,black "(^|[[:space:]])((\\.)($|[[:space:]]))*" 17 | # strings 18 | color yellow start="\"" end="\"" 19 | # defined primitive constants 20 | color brightmagenta "(^|[[:space:]])((null|false|true|pi|e)($|[[:space:]]))*" 21 | # math primitives 22 | color brightyellow "(^|[[:space:]])((\+|-|\*|\/|\%|abs|min|max|<<|>>)($|[[:space:]]))*" 23 | color brightyellow "(^|[[:space:]])((=|<>|<|>|<=|>=|assert|and|or|not|xor)($|[[:space:]]))*" 24 | color brightyellow "(^|[[:space:]])((round|ceil|floor|pow|sqrt|log|log2|log10|sin|cos|tan|rand)($|[[:space:]]))*" 25 | # stack manipulation 26 | color brightblue "(^|[[:space:]])((drop|dup|over|pick|swap|2drop|2dup|2over|depth|clear|\.|\.\.|\.rj|\.s|svpush|svpop|svdrop|svpick|svdepth|svclear)($|[[:space:]]))*" 27 | # memory words 28 | color brightred "(^|[[:space:]])((\!|\@|const|var|allot|create|\,|h\@|h\!|hkeys|sortnums|sortstrs)($|[[:space:]]))*" 29 | color brightred "(^|[[:space:]])((t\!|t\@|tmake|twalk|tdel|tdestroy)($|[[:space:]]))*" 30 | color brightred "(^|[[:space:]])((l\!|l\@|lmake|lpush|lpop|lins|lrem|ldel)($|[[:space:]]))*" 31 | # control words 32 | color brightgreen "(^|[[:space:]])((times|again|exittimes|for|next|exitfor|i|j|k|if|else|endif|return)($|[[:space:]]))*" 33 | # other words 34 | color cyan "(^|[[:space:]])((cr|print|emit|uemit|ord|tohex|bytes32)($|[[:space:]]))*" 35 | color cyan "(^|[[:space:]])((strlen|str=|str<|str>|strfind|strspn|strcspn|strtok|mempcpy|memset|mkbuf|free)($|[[:space:]]))*" 36 | color cyan "(^|[[:space:]])((isalnum|isalpha|iscntrl|isdigit|isgraph|islower|isprint|ispunct|isspace|isupper|isxdigit|tolower|toupper)($|[[:space:]]))*" 37 | color cyan "(^|[[:space:]])((regcomp|regexec|regread)($|[[:space:]]))*" 38 | color cyan "(^|[[:space:]])((fopen|fmemopen|fread|freadline|freadall|fseek|ftell|fwrite|fflush|fclose|redirect|seterr|setout|flush|open|mkbuf|read|write|close)($|[[:space:]]))*" 39 | color cyan "(^|[[:space:]])((tcplisten|tcpaccept|tcpconnect|clock|sleep|epoch|dt->epoch|epoch->dt|block_sigint|unblock_sigint)($|[[:space:]]))*" 40 | color yellow "(^|[[:space:]])((words|primitives|import|input)($|[[:space:]]))*" 41 | # definition delimiters 42 | color brightred "(^|[[:space:]])((\:|;)($|[[:space:]]))*" 43 | # comments 44 | color white,black "(^|[[:space:]])#.*$" 45 | # trailing whitespace. 46 | color ,red "[[:space:]]+$" 47 | -------------------------------------------------------------------------------- /examples/animal_words.dc: -------------------------------------------------------------------------------- 1 | # This example shows how to build up word logic 2 | 3 | # First we lay out some memory, reserving slot 0 as an 4 | # index tracker for an array of strings (string pointers) 5 | : idx 0 ; 6 | 7 | # Next, our string array itself starts at slot 1 8 | : str_arr_start 1 ; 9 | 10 | # Load the index tracker with slot 1 as a value to start with, 11 | # since our first string pointer should land at slot 1 12 | str_arr_start idx ! 13 | 14 | # Define a comma function as a way to iteratively load some strings 15 | : , idx @ swap over ! 1 + idx ! ; 16 | 17 | # A shortcut word for fetching and printing a string 18 | : getstr str_arr_start + @ print ; 19 | 20 | # Load strings into an array: 21 | "cat" , "dog" , "parrot" , "lizard" , "snake" , "ferret" , "parakeet" , "fish" , 22 | 23 | # Dynamically sense how many string we've loaded; create a value we 24 | # can multiply by to stay in range. 25 | : scale idx @ 1 - * floor ; 26 | 27 | # A "loop over the animals" function 28 | : rand_animals 29 | 1024 times rand scale getstr " " print again 30 | cr 31 | ; 32 | 33 | # Do it! 34 | rand_animals 35 | -------------------------------------------------------------------------------- /examples/astronomy_tools/100_double_stars.txt: -------------------------------------------------------------------------------- 1 | Eta Cassiopeiae 2 | 65 Piscium 3 | Psi1 Piscium 4 | Zeta Piscium 5 | Gamma Arietis 6 | Lambda Arietis 7 | Alpha Piscium 8 | Gamma2 And 9 | 6 Trianguli 10 | Alpha UMi 11 | Gamma Ceti 12 | Eta Persei 13 | Struve 331 14 | 32 Eridani 15 | Chi Tauri 16 | 1 Camelopardalis 17 | 55 Eridani 18 | Beta Orionis 19 | 118 Tauri 20 | Delta Orionis 21 | Struve 747 22 | Lambda Orionis 23 | Theta1 Orionis 24 | Iota Orionis 25 | Theta2 Orionis 26 | Sigma Orionis 27 | Zeta Orionis 28 | Gamma Leporis 29 | Theta Aurigae 30 | Epsilon Monocerotis 31 | Beta Monocerotis 32 | 12 Lyncis 33 | Epsilon Canis Majoris 34 | Delta Geminorum 35 | 19 Lyncis 36 | Alpha Geminorum 37 | HR2948 38 | Zeta2 Cancri 39 | Iota Cancri 40 | 38 Lyncis 41 | Alpha Leonis 42 | Gamma1 Leonis 43 | 54 Leonis 44 | 17 Crateris 45 | Delta Corvi 46 | 24 Comae Berenices 47 | Gamma Virginis 48 | HR 4893 49 | Alpha1 CVn 50 | Zeta UMa 51 | Kappa1 Bootis 52 | Iota Bootis 53 | Pi2 Boo 54 | Epsilon Bootis 55 | Alpha1 Lib 56 | Xi Bootis 57 | Delta Bootis 58 | Mu1 Bootis 59 | Delta Serpentis 60 | Zeta1 Coronae Borealis 61 | Xi Scorpii 62 | Struve 1999 63 | Beta1 Scorpii 64 | Kappa Herculis 65 | Nu Scorpii 66 | Sigma Coronae Borealis 67 | 16 Draconis 68 | Mu Draconis 69 | Alpha Herculis 70 | Delta Herculis 71 | 36 Ophiuchi 72 | Omicron Ophiuchi 73 | Rho Herculis 74 | Nu1 Draconis 75 | Psi1 Draconis 76 | 40/41 Draconis 77 | 95 Herculis 78 | 70 Ophiuchi 79 | Epsilon1 Lyrae 80 | Zeta1 Lyrae 81 | Beta Lyrae 82 | Struve 2404 83 | Struve 525 84 | Theta1 Serpentis 85 | Beta1 Cygni 86 | 57 Aquilae 87 | 31 Cygni 88 | Alpha1 Cap 89 | Beta1 Cap 90 | Gamma1 Delphini 91 | 61 Cygni 92 | Beta Cephei 93 | HR8281 94 | Epsilon Pegasi 95 | Xi Cephei 96 | Zeta1 Aquarii 97 | Delta Cephei 98 | 8 Lacerta 99 | 94 Aquarii 100 | Sigma Cassiopeiae 101 | -------------------------------------------------------------------------------- /examples/astronomy_tools/colorful_double_stars.txt: -------------------------------------------------------------------------------- 1 | STF 245 2 | STF 2532 3 | STF 2628 4 | HJ 3511 5 | STF 330 6 | STF 1615 7 | STF 2348 8 | STF 2573 9 | 65 Eri 10 | STF 830 11 | STF 2120 12 | STF 2306 13 | STF 680 14 | Dunlop 227 15 | HJ 4107 16 | STF 1616 17 | STF 1689 18 | SAO 308 19 | SAO 4810 20 | SAO 8890 21 | SAO 9540 22 | SAO 9665 23 | SAO 10057 24 | SAO 10938 25 | SAO 12006 26 | SAO 12738 27 | SAO 19922 28 | SAO 20554 29 | SAO 21732 30 | SAO 22442 31 | SAO 23655 32 | SAO 24064 33 | SAO 24672 34 | SAO 27861 35 | SAO 29045 36 | SAO 29071 37 | SAO 31218 38 | SAO 32114 39 | SAO 33817 40 | SAO 34508 41 | SAO 35947 42 | SAO 37734 43 | SAO 38288 44 | SAO 38700 45 | SAO 40924 46 | SAO 44097 47 | SAO 52753 48 | SAO 54033 49 | SAO 54255 50 | SAO 55330 51 | SAO 55347 52 | SAO 56840 53 | SAO 57799 54 | SAO 57998 55 | SAO 58280 56 | SAO 58904 57 | SAO 61202 58 | SAO 63256 59 | SAO 64834 60 | SAO 65165 61 | SAO 66000 62 | SAO 68827 63 | SAO 69238 64 | SAO 69335 65 | SAO 70467 66 | SAO 70919 67 | SAO 72228 68 | SAO 74182 69 | SAO 74966 70 | SAO 75051 71 | SAO 75471 72 | SAO 75510 73 | SAO 76573 74 | SAO 77201 75 | SAO 78395 76 | SAO 79294 77 | SAO 79376 78 | SAO 79653 79 | SAO 80162 80 | SAO 80415 81 | SAO 81101 82 | SAO 81583 83 | SAO 82123 84 | SAO 83500 85 | SAO 84951 86 | SAO 85397 87 | SAO 85648 88 | SAO 87301 89 | SAO 88275 90 | SAO 91866 91 | SAO 93611 92 | SAO 93939 93 | SAO 95795 94 | SAO 96265 95 | SAO 96746 96 | SAO 97645 97 | SAO 98614 98 | SAO 99647 99 | SAO 99673 100 | SAO 100160 101 | SAO 101250 102 | SAO 101437 103 | SAO 101725 104 | SAO 101951 105 | SAO 102680 106 | SAO 104332 107 | SAO 105104 108 | SAO 105298 109 | SAO 106475 110 | SAO 109087 111 | SAO 109643 112 | SAO 109666 113 | SAO 109739 114 | SAO 110635 115 | SAO 110707 116 | SAO 111291 117 | SAO 111659 118 | SAO 112304 119 | SAO 112528 120 | SAO 112921 121 | SAO 112921 122 | SAO 113810 123 | SAO 115981 124 | SAO 117640 125 | SAO 117751 126 | SAO 118449 127 | SAO 119360 128 | SAO 120946 129 | SAO 121895 130 | SAO 123107 131 | SAO 123497 132 | SAO 128791 133 | SAO 129752 134 | SAO 130805 135 | SAO 131807 136 | SAO 132323 137 | SAO 139189 138 | SAO 139951 139 | SAO 142606 140 | SAO 142996 141 | SAO 143898 142 | SAO 151401 143 | SAO 151694 144 | SAO 152123 145 | SAO 157323 146 | SAO 157798 147 | SAO 159549 148 | SAO 159682 149 | SAO 163592 150 | SAO 163626 151 | SAO 165298 152 | SAO 165624 153 | SAO 165867 154 | SAO 167882 155 | SAO 173246 156 | SAO 173349 157 | SAO 184336 158 | SAO 184382 159 | SAO 184415 160 | SAO 185238 161 | SAO 190986 162 | SAO 202691 163 | SAO 203877 164 | SAO 209553 165 | SAO 209957 166 | SAO 213883 167 | SAO 215208 168 | SAO 218190 169 | SAO 218755 170 | SAO 225062 171 | SAO 249009 172 | SAO 252853 173 | SAO 254226 174 | SAO 255222 175 | -------------------------------------------------------------------------------- /examples/astronomy_tools/make_sky_safari_list.dc: -------------------------------------------------------------------------------- 1 | "csvlib.dc" import 2 | 3 | # Here is the input file to read catalog numbers from. 4 | # One might also try '100_double_stars.txt' 5 | var objects_file 6 | "colorful_double_stars.txt" "r" fopen 7 | objects_file ! 8 | 9 | var sky_safari_file 10 | "skysafi.skylist" "w" fopen 11 | sky_safari_file ! 12 | 13 | var this_obj 0 this_obj ! 14 | 15 | : _writeblock 16 | dup strlen sky_safari_file @ fwrite drop 17 | ; 18 | 19 | : _writeheader 20 | "SkySafariObservingListVersion=3.0\n" _writeblock 21 | ; 22 | 23 | : _read_object 24 | objects_file @ freadline 25 | -1 = 26 | if 27 | -1 swap drop 28 | return 29 | endif 30 | ; 31 | 32 | : _do_record 33 | "SkyObject=BeginObject\n ObjectID=2,-1,-1\n" 34 | _writeblock 35 | " CatalogNumber=" 36 | _writeblock 37 | this_obj @ 38 | _writeblock 39 | "EndObject=SkyObject\n" 40 | _writeblock 41 | ; 42 | 43 | : _iterate_and_write 44 | _read_object dup 45 | -1 = 46 | if 47 | drop 48 | else 49 | this_obj ! 50 | _do_record 51 | _iterate_and_write 52 | endif 53 | ; 54 | 55 | : everything 56 | _writeheader 57 | _iterate_and_write 58 | sky_safari_file @ fclose 59 | objects_file @ fclose 60 | ; 61 | 62 | everything 63 | -------------------------------------------------------------------------------- /examples/change_ring.txt: -------------------------------------------------------------------------------- 1 | 1 2 3 4 5 2 | 2 1 3 4 5 3 | 3 1 2 4 5 4 | 1 3 2 4 5 5 | 2 3 1 4 5 6 | 3 2 1 4 5 7 | 4 2 1 3 5 8 | 2 4 1 3 5 9 | 1 4 2 3 5 10 | 4 1 2 3 5 11 | 2 1 4 3 5 12 | 1 2 4 3 5 13 | 1 3 4 2 5 14 | 3 1 4 2 5 15 | 4 1 3 2 5 16 | 1 4 3 2 5 17 | 3 4 1 2 5 18 | 4 3 1 2 5 19 | 4 3 2 1 5 20 | 3 4 2 1 5 21 | 2 4 3 1 5 22 | 4 2 3 1 5 23 | 3 2 4 1 5 24 | 2 3 4 1 5 25 | 5 3 4 1 2 26 | 3 5 4 1 2 27 | 4 5 3 1 2 28 | 5 4 3 1 2 29 | 3 4 5 1 2 30 | 4 3 5 1 2 31 | 1 3 5 4 2 32 | 3 1 5 4 2 33 | 5 1 3 4 2 34 | 1 5 3 4 2 35 | 3 5 1 4 2 36 | 5 3 1 4 2 37 | 5 4 1 3 2 38 | 4 5 1 3 2 39 | 1 5 4 3 2 40 | 5 1 4 3 2 41 | 4 1 5 3 2 42 | 1 4 5 3 2 43 | 1 4 3 5 2 44 | 4 1 3 5 2 45 | 3 1 4 5 2 46 | 1 3 4 5 2 47 | 4 3 1 5 2 48 | 3 4 1 5 2 49 | 2 4 1 5 3 50 | 4 2 1 5 3 51 | 1 2 4 5 3 52 | 2 1 4 5 3 53 | 4 1 2 5 3 54 | 1 4 2 5 3 55 | 5 4 2 1 3 56 | 4 5 2 1 3 57 | 2 5 4 1 3 58 | 5 2 4 1 3 59 | 4 2 5 1 3 60 | 2 4 5 1 3 61 | 2 1 5 4 3 62 | 1 2 5 4 3 63 | 5 2 1 4 3 64 | 2 5 1 4 3 65 | 1 5 2 4 3 66 | 5 1 2 4 3 67 | 5 1 4 2 3 68 | 1 5 4 2 3 69 | 4 5 1 2 3 70 | 5 4 1 2 3 71 | 1 4 5 2 3 72 | 4 1 5 2 3 73 | 3 1 5 2 4 74 | 1 3 5 2 4 75 | 5 3 1 2 4 76 | 3 5 1 2 4 77 | 1 5 3 2 4 78 | 5 1 3 2 4 79 | 2 1 3 5 4 80 | 1 2 3 5 4 81 | 3 2 1 5 4 82 | 2 3 1 5 4 83 | 1 3 2 5 4 84 | 3 1 2 5 4 85 | 3 5 2 1 4 86 | 5 3 2 1 4 87 | 2 3 5 1 4 88 | 3 2 5 1 4 89 | 5 2 3 1 4 90 | 2 5 3 1 4 91 | 2 5 1 3 4 92 | 5 2 1 3 4 93 | 1 2 5 3 4 94 | 2 1 5 3 4 95 | 5 1 2 3 4 96 | 1 5 2 3 4 97 | 4 5 2 3 1 98 | 5 4 2 3 1 99 | 2 4 5 3 1 100 | 4 2 5 3 1 101 | 5 2 4 3 1 102 | 2 5 4 3 1 103 | 3 5 4 2 1 104 | 5 3 4 2 1 105 | 4 3 5 2 1 106 | 3 4 5 2 1 107 | 5 4 3 2 1 108 | 4 5 3 2 1 109 | 4 2 3 5 1 110 | 2 4 3 5 1 111 | 3 4 2 5 1 112 | 4 3 2 5 1 113 | 2 3 4 5 1 114 | 3 2 4 5 1 115 | 3 2 5 4 1 116 | 2 3 5 4 1 117 | 5 3 2 4 1 118 | 3 5 2 4 1 119 | 2 5 3 4 1 120 | 5 2 3 4 1 121 | -------------------------------------------------------------------------------- /examples/chaos_study.dc: -------------------------------------------------------------------------------- 1 | "math.dc" import 2 | "string.dc" import 3 | "redis_music.dc" import 4 | 5 | ########################################################################### 6 | # To use the two functions here, `chaos_stats` and `draw_chaos_infinite`, # 7 | # make sure to call this module from the command line with: # 8 | # `dclang -i chaos_study.dc` # 9 | ########################################################################### 10 | 11 | # For saving the current value of 'x' 12 | var x 13 | 14 | ##################################################################### 15 | # statistical study of chaos values for the first wrap*2 iterations # 16 | ##################################################################### 17 | 14 const FIGURE_STORAGE_SIZE 18 | var figures FIGURE_STORAGE_SIZE allot 19 | 20 | var unique 21 | 0 unique ! 22 | 23 | # A chaos loop -- will be divided by 1000 24 | var chaos_start 25 | 1000 chaos_start ! 26 | 27 | var chaos_end 28 | 2001 chaos_end ! 29 | 30 | var wrap 31 | 14 wrap ! 32 | 33 | : _clear_figures 34 | 0 x ! 35 | FIGURE_STORAGE_SIZE times 36 | 0 figures i + ! 37 | again 38 | 0 unique ! 39 | ; 40 | 41 | : _show_figures 42 | FIGURE_STORAGE_SIZE times 43 | figures i + @ . 44 | again 45 | ; 46 | 47 | : chaos_stats 48 | chaos_end @ chaos_start @ 1 49 | for 50 | _clear_figures 51 | wrap @ 2 * 0 1 52 | for 53 | x @ 1 + j 1000 / * 1 % # get next result 54 | dup x ! # copy it for next iteration 55 | wrap @ * floor # convert and scale to int 56 | figures + dup @ 1 + swap ! 57 | next 58 | _show_figures " : " print i . cr 59 | next 60 | ; 61 | 62 | ###################################################### 63 | # redis-value driven 'animation' of a chaos equation # 64 | ###################################################### 65 | var drawchars 66 | "0123456789abcdefghijklmnopqrstuvwxyz" drawchars ! 67 | 68 | : _draw_row 69 | dup 70 | 0 > 71 | if 72 | dup 73 | times 74 | " " print 75 | again 76 | endif 77 | drawchars @ swap dup 1 + strslice print cr 78 | ; 79 | 80 | : _draw_chaos_infinite 81 | x @ 1 + redis_music.get_chaos * 1 % 82 | dup x ! 83 | redis_music.get_wrap 84 | * 85 | floor 86 | _draw_row 87 | redis_music.get_on_gate sleep 88 | _draw_chaos_infinite 89 | ; 90 | 91 | : draw_chaos_infinite 92 | 0 x ! 93 | _draw_chaos_infinite 94 | ; 95 | -------------------------------------------------------------------------------- /examples/circle.dc: -------------------------------------------------------------------------------- 1 | var mybuf 2 | 80 24 * mkbuf 3 | mybuf ! 4 | 5 | : bufadd 6 | over mybuf @ + swap 1 memset drop 7 | ; 8 | 9 | : circle-draw 10 | 1024 times 11 | 0 12 | 24 times 13 | 80 times 14 | i 80 1.666 / / 0.8 - dup * 15 | j 24 / 0.5 - dup * 16 | + sqrt 17 | # radius 18 | k 32 / pi * cos 0.5 * 0.5 + 19 | 0.46 * 20 | < if 42 else 32 endif bufadd 21 | 1 + 22 | again 23 | again 24 | mybuf @ 80 24 * + 0 1 memset drop 25 | mybuf @ print 26 | drop 27 | 0.0384 sleep 28 | again 29 | ; 30 | 31 | circle-draw 32 | -------------------------------------------------------------------------------- /examples/cl_script.dc: -------------------------------------------------------------------------------- 1 | #!/usr/local/bin/dclang 2 | 3 | "Hello, world!" print cr 4 | -------------------------------------------------------------------------------- /examples/climate_change_graph.dc: -------------------------------------------------------------------------------- 1 | "http_server.dc" import 2 | "sqlite3.dc" import 3 | "string.dc" import 4 | 5 | # place to hold our randomized values string 6 | var databuf 7 | 65536 mkbuf databuf ! 8 | 9 | # place we'll load the response string 10 | var climate_html 11 | 12 | # Now, let's set up vars for grabbing our SQL data 13 | var db 14 | var stmt 15 | var query_to_run 16 | var which_var 17 | 18 | # some string constants -- will help stop memory leaking 19 | "climate_change_graph.html" const :climate_change_graph_html 20 | "r" const :r 21 | "tucson_airport.db" const :tucson_airport_db 22 | "{{which}}" const :which 23 | "[" const :open_bracket 24 | "]" const :close_bracket 25 | "{x: '" const :x_element 26 | "', y: " const :y_element 27 | "}, " const :close_element 28 | "tmin" const :tmin 29 | "tmax" const :tmax 30 | "{{DATA_MIN}}" const :data_min 31 | "{{DATA_MAX}}" const :data_max 32 | "{{DATA_MIN_AVG}}" const :data_min_avg 33 | "{{DATA_MAX_AVG}}" const :data_max_avg 34 | 35 | # query string constants 36 | "SELECT year, avg(CAST({{which}} AS INT)) 37 | FROM tucson 38 | GROUP BY year;" const BASIC_SQL_QUERY 39 | 40 | "SELECT inner.year, 41 | avg(inner.{{which}}_avg) 42 | OVER (ORDER BY year ASC ROWS 5 PRECEDING) AS moving_avg 43 | FROM ( 44 | SELECT year, avg(CAST({{which}} AS INT)) AS {{which}}_avg 45 | FROM tucson 46 | GROUP BY year 47 | ) AS inner;" const RUNNING_AVG_QUERY 48 | 49 | # helper function for looping through rows and cols 50 | : _query_loop 51 | stmt @ sqlite3_step 52 | 100 = if 53 | :x_element str+ 54 | stmt @ 0 sqlite3_column str+ 55 | :y_element str+ 56 | stmt @ 1 sqlite3_column str+ 57 | :close_element str+ 58 | _query_loop 59 | else 60 | 2 - # rewind two characters to overwrite ", " from last iteration 61 | :close_bracket str+ # put closing bracket on string buffer 62 | 0 1 memset drop # close off string with a \0 null character 63 | stmt @ sqlite3_finalize 64 | db @ sqlite3_close 65 | return 66 | endif 67 | ; 68 | 69 | # This is where we hit the backend SQL and create a data string 70 | # that gets fed to our chart.js template eventually 71 | : make_data 72 | databuf @ 0 65536 memset drop # clear the data buffer 73 | :tucson_airport_db sqlite3_open db ! 74 | db @ 75 | query_to_run @ :which which_var @ strreplace 76 | dup svpush 77 | sqlite3_prepare 78 | stmt ! 79 | svpop free 80 | databuf @ 81 | :open_bracket str+ 82 | _query_loop 83 | ; 84 | 85 | : load_template 86 | # read in the HTML template 87 | :climate_change_graph_html :r fopen dup 88 | freadall drop swap fclose 89 | # load minimum temp avgs 90 | BASIC_SQL_QUERY query_to_run ! 91 | :tmin which_var ! make_data 92 | :data_min databuf @ strreplace 93 | climate_html ! 94 | # load maximum temp avgs 95 | :tmax which_var ! make_data 96 | climate_html @ dup 97 | :data_max databuf @ strreplace 98 | climate_html ! free 99 | # load 5-year running avg minimum 100 | RUNNING_AVG_QUERY query_to_run ! 101 | :tmin which_var ! make_data 102 | climate_html @ dup 103 | :data_min_avg databuf @ strreplace 104 | climate_html ! free 105 | # load 5-year running avg maximum 106 | :tmax which_var ! make_data 107 | climate_html @ dup 108 | :data_max_avg databuf @ strreplace 109 | climate_html ! free 110 | ; 111 | 112 | : custom_response 113 | # test of a basic chart.js response 114 | load_template 115 | zerobuf HTTP_HTML_HEADER str+ 116 | climate_html @ dup svpush str+ 117 | drop # we drop the pointer to the end of the buffer 118 | # b/c it's only useful as a place to dump more 119 | # new substrings onto the main growing string buffer. 120 | # The framework already has the 'head pointer' at `zerobuf` 121 | svpop free # free the accumulated string 122 | ; 123 | 124 | acceptloop 125 | -------------------------------------------------------------------------------- /examples/climate_change_graph.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | Tucson Airport Temperatures, 1948-2024 4 | 5 | 20 | 21 | 22 |
23 |

Tucson Airport Temperatures, 1948-2024

24 |
25 |
26 |
27 | 28 |
29 | 30 | 31 | 32 | 79 | 80 | 81 | -------------------------------------------------------------------------------- /examples/contfrac.dc: -------------------------------------------------------------------------------- 1 | " 2 | 0 1 2 2 2 2 2 2 3 | 0 1 1 3 7 17 41 99 4 | 1 0 1 2 5 12 29 70 5 | " 6 | drop 7 | 8 | # initial values of indices 9 | 3 0 ! 10 | 4 1 ! 11 | 5 2 ! 12 | # initial data values 13 | 0 3 ! 14 | 0 4 ! 15 | 1 5 ! 16 | 1 6 ! # <---- expansion proper starts here 17 | 1 7 ! 18 | 0 8 ! 19 | 20 | : expansion-index 0 ; 21 | : numerator-index 1 ; 22 | : denominator-index 2 ; 23 | : advance 24 | dup # ( addr addr ) 25 | @ 3 + # ( addr val ) 26 | swap # ( val addr ) 27 | ! 28 | ; 29 | : expansion-get expansion-index @ @ ; 30 | : expansion-put expansion-index @ ! ; 31 | : numerator-get numerator-index @ @ ; 32 | : numerator-lag numerator-index @ 3 - @ ; 33 | : numerator-lead-put numerator-index @ 3 + ! ; 34 | : denominator-get denominator-index @ @ ; 35 | : denominator-lag denominator-index @ 3 - @ ; 36 | : denominator-lead-put denominator-index @ 3 + ! ; 37 | : advance-indices 38 | expansion-index advance 39 | numerator-index advance 40 | denominator-index advance 41 | ; 42 | 43 | : show-frac 44 | # do numerator 45 | expansion-get 46 | numerator-get * 47 | numerator-lag + 48 | dup .. 49 | numerator-lead-put 50 | 51 | "/" print 52 | 53 | # do denominator 54 | expansion-get 55 | denominator-get * 56 | denominator-lag + 57 | dup . 58 | denominator-lead-put 59 | ; 60 | 61 | : continued-fraction 62 | 6 expansion-index ! 63 | 7 numerator-index ! 64 | 8 denominator-index ! 65 | # no. of times will be grabbed from the stack! 66 | times 67 | dup # ( num num ) 68 | floor dup # ( num fl fl ) 69 | expansion-put # ( num fl ) 70 | show-frac # ( num f1 ) 71 | - 1 swap / # ( newnum ) 72 | advance-indices 73 | again 74 | cr 75 | ; 76 | 77 | # show the expansion for pi 78 | "The continued fraction expansion of PI is: " print cr 79 | pi 7 continued-fraction 80 | 81 | # show the expansion for sqrt of 2 82 | "The continued fraction expansion of the square-root of 2 is: " print cr 83 | 2 sqrt 12 continued-fraction 84 | 85 | # show the expansion of phi 86 | "The continued fraction expansion of Phi is: " print cr 87 | : phi 1 5 sqrt + 2 / ; 88 | phi 16 continued-fraction 89 | 90 | "Expansion of a step of 5-edo: " print cr 91 | 2 1 5 / pow 12 continued-fraction 92 | -------------------------------------------------------------------------------- /examples/digit_sum_study.dc: -------------------------------------------------------------------------------- 1 | ############################################################################ 2 | # This module was written so that I could have a clearer understanding # 3 | # of the musical implications of the various variable settings involved # 4 | # in the midi_digit_sum* examples. # 5 | # # 6 | # There are 2 public words: `run_sample` and `range_sample` # 7 | # # 8 | # `run_sample` will show `end - start` (default 1024) iterations of # 9 | # the output of `digit_sum`, given the variables set by the user. # 10 | # These variables are defined below, but can be changed so various # 11 | # behaviors can be studied, and a new run kicked off with `run_sample`. # 12 | # Some documention of these variables is inline below, as comments. # 13 | # # 14 | # `mul_study` will vary the `mul` from 2 to `study_end` and do a # 15 | # `run_sample` on each iteration. It will output lines that represent: # 16 | # # 17 | # # 18 | # # 19 | # ....where is the digit_sum __least hit__ during the run, # 20 | # and represents the digit_sum __most hit__ during the run. # 21 | # This allow one to understand the "meta-features" of a given run of # 22 | # `digit_sum` given a certain `base`, `wrap`, `shift`, and `slots`, # 23 | # while the `mul` changes. Using the MIDI examples, this will have musical # 24 | # implications. # 25 | ############################################################################ 26 | 27 | "math.dc" import 28 | "string.dc" import 29 | "redis_music.dc" import 30 | 31 | 32 const FIGURE_STORAGE_SIZE 32 | var figures FIGURE_STORAGE_SIZE allot 33 | 34 | var start 35 | 0 start ! 36 | 37 | var end 38 | 1024 end ! 39 | 40 | var study_end 41 | 129 study_end ! 42 | 43 | # used by the `draw_sample_infinite` routines as a global index 44 | var x 45 | 0 x ! 46 | 47 | # `mul` and `base` are the core args consumed by `digit_sum` 48 | var mul 49 | 1 mul ! 50 | 51 | var base 52 | 2 base ! 53 | 54 | # `wrap` is the largest digit sum (prior to shifting) that you 55 | # want to "wrap" (AKA do a modulus operation) around. 56 | var wrap 57 | 32 wrap ! 58 | 59 | # `scale` is an experimental scaling extension 60 | var scale 61 | 1 scale ! 62 | 63 | # `shift` offsets the resulting digit_sum by the assigned amount. 64 | # If in a musical scale/gamut situation, this would be a "mode". 65 | var shift 66 | 0 shift ! 67 | 68 | # `slots` would, for example, represent the largest digit_sum 69 | # _after shifting_ that you'd want to "wrap" (AKA do an `absmod` modulus wrap) 70 | # around. If you set/keep `wrap` and `slots` to 32, and `shift` to 0, 71 | # the "natural behavior" of `digit_sum` is shown, which can be useful for 72 | # understanding. 73 | var slots 74 | 32 slots ! 75 | 76 | var drawchars 77 | "0123456789abcdefghijklmnopqrstuvwxyz" drawchars ! 78 | 79 | : _clear_figures 80 | FIGURE_STORAGE_SIZE times 81 | 0 figures i + ! 82 | again 83 | ; 84 | 85 | : _show_figures 86 | slots @ times 87 | i 2 0 .pz "\b: " print 88 | figures i + @ 5 0 .pz cr 89 | again 90 | ; 91 | 92 | : _run_sample_inner 93 | end @ start @ 1 94 | for 95 | mul @ i * base @ digit_sum 96 | wrap @ absmod shift @ + slots @ absmod 97 | figures + dup @ 1 + swap ! 98 | next 99 | ; 100 | 101 | : _draw_row 102 | dup 103 | 0 > 104 | if 105 | dup 106 | times 107 | " " print 108 | again 109 | endif 110 | drawchars @ swap dup 1 + strslice print cr 111 | ; 112 | 113 | : _draw_sample_inner 114 | end @ start @ 1 115 | for 116 | mul @ i * base @ digit_sum 117 | scale @ 118 | * round 119 | wrap @ absmod 120 | shift @ 121 | + 122 | slots @ absmod 123 | _draw_row 124 | next 125 | ; 126 | 127 | : _draw_sample_infinite 128 | redis_music.get_mul x @ * redis_music.get_base digit_sum 129 | redis_music.get_wrap absmod 130 | redis_music.get_mode 131 | + 132 | 14 absmod 133 | _draw_row 134 | redis_music.get_on_gate sleep 135 | x dup @ 1 + swap ! 136 | _draw_sample_infinite 137 | ; 138 | 139 | : _get_non_zero_size 140 | slots @ 1 - 141 | -1 over -1 142 | for 143 | figures i + @ 144 | 0 <> 145 | if 146 | i min 147 | endif 148 | next 149 | slots @ swap - 150 | ; 151 | 152 | : _get_lowest_figure 153 | slots @ 154 | _get_non_zero_size 155 | - 156 | figures 157 | + 158 | @ 159 | ; 160 | 161 | : _get_highest_figure 162 | figures 163 | slots @ 1 - 164 | + 165 | @ 166 | ; 167 | 168 | ################ 169 | # The main API # 170 | ################ 171 | 172 | : run_sample 173 | _clear_figures 174 | _run_sample_inner 175 | _show_figures 176 | ; 177 | 178 | : draw_sample 179 | _clear_figures 180 | _draw_sample_inner 181 | ; 182 | 183 | : draw_sample_infinite 184 | 0 x ! 185 | _clear_figures 186 | _draw_sample_infinite 187 | ; 188 | 189 | : mul_study 190 | "mul num_nz_slots min_cnt max_cnt max_cnt/min_cnt" print cr 191 | study_end @ 1 1 192 | for 193 | i mul ! 194 | _clear_figures 195 | _run_sample_inner 196 | figures slots @ sortnums 197 | i 3 0 .pz 198 | _get_non_zero_size 2 0 .pz 199 | _get_highest_figure _get_lowest_figure 200 | 2dup 201 | 4 0 .pz 202 | 4 0 .pz 203 | / . cr 204 | next 205 | ; 206 | 207 | : wrap_study 208 | "wrap num_nz_slots min_cnt max_cnt max_cnt/min_cnt" print cr 209 | slots @ 1 + 5 1 210 | for 211 | i wrap ! 212 | _clear_figures 213 | _run_sample_inner 214 | figures slots @ sortnums 215 | i 3 0 .pz 216 | _get_non_zero_size 2 0 .pz 217 | _get_highest_figure _get_lowest_figure 218 | 2dup 219 | 4 0 .pz 220 | 4 0 .pz 221 | / . cr 222 | next 223 | ; 224 | -------------------------------------------------------------------------------- /examples/dsp_examples/Makefile: -------------------------------------------------------------------------------- 1 | CC = gcc 2 | LDFLAGS = -lportaudio -lasound -lrt -pthread -ldclang 3 | 4 | portaudio_example: 5 | $(CC) portaudio_example.c -o $@ $(LDFLAGS) 6 | 7 | clean: 8 | rm _tmp_portaudio.dc portaudio_example.c portaudio_example 9 | -------------------------------------------------------------------------------- /examples/dsp_examples/README.md: -------------------------------------------------------------------------------- 1 | ## DSP examples 2 | 3 | There are 2 ways to run the examples. 4 | - `./run_example.sh 5 | - `./run_example-portaudio.sh 6 | 7 | For both: 8 | 9 | - Make sure that `DCLANG_LIBS` environment variable is defined in your `~/.bashrc` or equivalent, e.g: 10 | ``` 11 | export DCLANG_LIBS=/usr/local/lib/dclang 12 | ``` 13 | 14 | For the portaudio way: 15 | 16 | - Have `portaudio19-dev` installed on your machine: 17 | ``` 18 | sudo apt-get install portaudio19-dev # or similar 19 | ``` 20 | 21 | Have fun! 22 | -------------------------------------------------------------------------------- /examples/dsp_examples/bassline.dc: -------------------------------------------------------------------------------- 1 | "dsp.dc" import 2 | "music.dc" import 3 | "sequencer.dc" import 4 | 5 | var my_ampport 6 | var my_pitchport 7 | var my_fbport 8 | 9 | var tempo :BASS_TEMPO redis_music.get_x_tempo tempo ! 10 | var myvol redis_music.get_bass_vol myvol ! 11 | var pitch redis_music.get_base_pitch pitch ! 12 | var curtrig 13 | var lasttrig 14 | var sl 15 | var lpmem 16 | 17 | create my_iter 16 , 0 , 18 | 1 , 1 , 1 , 1 , 19 | 1 , 1 , 1 , 7 8 / , 20 | 1 , 1 , 1 , 4 3 / , 21 | 4 3 / , 3 2 / , 3 2 / , 3 4 / , 22 | 23 | : metronome_simple 24 | 0.1 tempo @ gate curtrig ! 25 | curtrig @ lasttrig @ > 26 | if 27 | # check if tempo changed 28 | :BASS_TEMPO redis_music.get_x_tempo dup tempo @ <> 29 | if tempo ! else drop endif 30 | # check if vol changed 31 | redis_music.get_bass_vol dup myvol @ <> 32 | if myvol ! else drop endif 33 | # simple pitch sequence using `iterator` 34 | redis_music.get_base_pitch 35 | my_iter iterator 36 | * 37 | pitch ! 38 | endif 39 | curtrig @ 40 | my_ampport 0.002 0.55 41 | port 42 | sl 43 | pitch @ 44 | my_pitchport 0.0005 0.01 45 | port 46 | curtrig @ 47 | my_fbport 0.0001 0.3 48 | port 49 | 0.47 0.2 rand * + * 50 | 0.2 0.1 rand * + + 51 | sineloop 52 | * 53 | lpmem 0.7 lowpass myvol @ * 54 | 0.5 panmix 55 | stereo_out 56 | t+ 57 | curtrig @ lasttrig ! 58 | metronome_simple 59 | ; 60 | 61 | metronome_simple 62 | -------------------------------------------------------------------------------- /examples/dsp_examples/bells_of_doom_example.dc: -------------------------------------------------------------------------------- 1 | "dsp.dc" import 2 | 3 | # portamento vars 4 | var myport 5 | var myport_two 6 | 7 | : mod_ratio_wobble 8 | 6.37 sine 0.015 * 0.5723 + 9 | ; 10 | 11 | : trigger_env-1 12 | # trigger for portamento envelope 13 | 0.2 metro 0.35 * 14 | # reference array for port and portamento call 15 | myport 0.04 2.5 port 16 | ; 17 | 18 | : trigger_env-2 19 | # trigger for 2nd portamento envelope 20 | 0.5 metro 0.4 * 21 | # reference array for port and portamento call 22 | myport_two 0.05 1.3 port 23 | ; 24 | 25 | : bells_of_doom_example 26 | inf times 27 | # FM oscillator: 28 | 230 mod_ratio_wobble 0.9 fm 29 | # amplitude envelope: 30 | trigger_env-1 * 31 | # moving pan signal 32 | 0.23 sine 1 + 0.15 * 0.75 + 33 | panmix 34 | 35 | # another FM oscillator: 36 | 164 0.7 0.9 fm 37 | # amplitude envelope: 38 | trigger_env-2 * 39 | # another moving pan signal: 40 | 0.1 sine 1 + 0.15 * 0.25 + 41 | panmix 42 | 43 | # send outputs: 44 | stereo_out 45 | # advance sample clock, clear channels 46 | t+ 47 | again 48 | ; 49 | 50 | bells_of_doom_example 51 | -------------------------------------------------------------------------------- /examples/dsp_examples/biquad_bp_example.dc: -------------------------------------------------------------------------------- 1 | "dsp.dc" import 2 | 3 | make_biquad myflt 4 | 5 | : biquad_bp_example 6 | inf times 7 | # some noise, scaled to 0.8 max amplitude 8 | noise 0.8 * 9 | myflt 10 | false 11 | 0.2 sine 12 | 500 * 13 | 1500 + 14 | 105.01 15 | biquad_bp 16 | # scale down, it's louder 17 | 0.001 * 18 | # mix into center 19 | 0.5 20 | panmix 21 | # put to output 22 | stereo_out 23 | # advance counter 24 | t+ 25 | again 26 | ; 27 | 28 | biquad_bp_example 29 | -------------------------------------------------------------------------------- /examples/dsp_examples/biquad_hp_example.dc: -------------------------------------------------------------------------------- 1 | "dsp.dc" import 2 | 3 | make_biquad myflt 4 | 5 | : biquad_hp_example 6 | inf times 7 | # some noise, scaled to 0.1 max amplitude 8 | noise 0.1 * 9 | myflt 10 | false 11 | 0.2 sine 12 | 500 * 13 | 1500 + 14 | 29.99 15 | biquad_hp 16 | # scale down, it's louder 17 | 0.07 * 18 | # mix into center 19 | 0.5 20 | panmix 21 | # put to output 22 | stereo_out 23 | # advance counter 24 | t+ 25 | again 26 | ; 27 | 28 | biquad_hp_example 29 | -------------------------------------------------------------------------------- /examples/dsp_examples/biquad_lp_example.dc: -------------------------------------------------------------------------------- 1 | "dsp.dc" import 2 | 3 | make_biquad myflt 4 | 5 | : biquad_lp_example 6 | inf times 7 | # some noise, scaled to 0.1 max amplitude 8 | noise 0.1 * 9 | myflt 10 | false 11 | 0.2 sine 12 | 500 * 13 | 1500 + 14 | 29.99 15 | biquad_lp 16 | # scale down, it's louder 17 | 0.07 * 18 | # mix into center 19 | 0.5 20 | panmix 21 | # put to output 22 | stereo_out 23 | # advance counter 24 | t+ 25 | again 26 | ; 27 | 28 | biquad_lp_example 29 | -------------------------------------------------------------------------------- /examples/dsp_examples/delay_example.dc: -------------------------------------------------------------------------------- 1 | "dsp.dc" import 2 | 3 | # a local constant for 'change_frequency' 4 | 0.7575 1.333333 * const CHANGE_FREQ 5 | 6 | # amp envelope stuff: 7 | var env_port 8 | var ampenv 9 | var pitch_port 10 | 11 | # a sineloop variable 12 | var mysl 13 | 14 | # filter setup: 15 | make_hc_filter mylp 16 | 17 | # delay setup: 18 | 1 make_delay_line mydelay 19 | 20 | # random pitch setup: 21 | # A Wilson CPS hexany (2, 3, 5, 9) 22 | create pitch_choices 0 , 5 , 13 , 18 , 23 , 31 , 36 , 41 , 23 | var current_pitch 0 current_pitch ! 24 | var trigval 25 | var lasttrig 26 | var curtrig 27 | var rntrg 28 | 29 | : octfac 31 / 2 swap pow ; 30 | 31 | : delay_example 32 | inf times 33 | # random trigger 34 | 0.01 trigval randtrig dup curtrig ! 35 | # reference array for port and portamento call 36 | env_port 0.04 0.9 port 37 | # route to 'ampenv' variable: 38 | ampenv ! 39 | # change the pitch variable randomly, in sync with the trigger: 40 | curtrig @ lasttrig @ > 41 | if 42 | pitch_choices 8 randint + @ current_pitch ! 43 | else 44 | endif 45 | # sineloop oscillator: 46 | mysl 47 | current_pitch @ octfac 256 * 48 | pitch_port 0.02 0.03 port 49 | ampenv @ 0.89 * 0.4 + sineloop ampenv @ * 50 | # boost amplitude 51 | 2.3 * 52 | # cut the highs a bit: 53 | mylp 2750 0.3 hc_lowpass 54 | # osc/filter amplification 55 | 1.8 * 56 | mydelay 0.95 delay_read 57 | # delay amplification 58 | 0.65 * 59 | 2dup 60 | 0.35 panmix 61 | 0.65 panmix 62 | # output 63 | stereo_out 64 | # 89% feedback 65 | + 0.5 * mydelay delay_write 66 | # update trigger state 67 | curtrig @ lasttrig ! 68 | # update clock 69 | t+ 70 | again 71 | ; 72 | 73 | delay_example 74 | -------------------------------------------------------------------------------- /examples/dsp_examples/drum_machine.dc: -------------------------------------------------------------------------------- 1 | "dsp.dc" import 2 | "redis_music.dc" import 3 | 4 | ############################ 5 | # Make a 32-step sequencer # 6 | ############################ 7 | var top_bit 1 31 << top_bit ! 8 | ############################################################ 9 | # A variable to track which bit in the sequence we are on. # 10 | # As the sequence progresses, the bit slot gets smaller # 11 | # by a factor of two, i.e. 1024, 512, 256, 128, .... # 12 | ############################################################ 13 | var seq_bit top_bit @ seq_bit ! 14 | 15 | ################# 16 | # Set the tempo # 17 | ################# 18 | var tempo :DRUM_TEMPO redis_music.get_x_tempo tempo ! 19 | 20 | ############### 21 | # Drum Volume # 22 | ############### 23 | var drum_vol redis_music.get_drum_vol drum_vol ! 24 | 25 | ##################################### 26 | # String constants for redis lookup # 27 | ##################################### 28 | "op_hihat" const :op_hihat 29 | "cl_hihat" const :cl_hihat 30 | "snare_drum" const :snare_drum 31 | "bass_drum" const :bass_drum 32 | 33 | ########################### 34 | # Bit patterns for beats! # 35 | ########################### 36 | var op_hihat 37 | var cl_hihat 38 | var snare_drum 39 | var bass_drum 40 | 41 | : _init_drum_parts 42 | :op_hihat redis_get 43 | 0 = if 44 | "0x00020002" :op_hihat redis_set 45 | endif 46 | :cl_hihat redis_get 47 | 0 = if 48 | "0x41413513" :cl_hihat redis_set 49 | endif 50 | :snare_drum redis_get 51 | 0 = if 52 | "0x0808080c" :snare_drum redis_set 53 | endif 54 | :bass_drum redis_get 55 | 0 = if 56 | "0x80818082" :bass_drum redis_set 57 | endif 58 | ; 59 | 60 | _init_drum_parts 61 | 62 | ################################## 63 | # Masking volumes for each sound # 64 | ################################## 65 | var op_hihat_mask 66 | var cl_hihat_mask 67 | var snare_drum_mask 68 | var bass_drum_mask 69 | 70 | ########################################## 71 | # Holding places for the trigger state # 72 | # Allows us to detect upward signal edge # 73 | ########################################## 74 | var curtrig 75 | var lasttrig 76 | 77 | ######################## 78 | # Portamento envelopes # 79 | ######################## 80 | var op_hihat_port 81 | var cl_hihat_port 82 | var snare_drum_port 83 | var bass_drum_port 84 | 85 | ########################################## 86 | # Hal Chamberlain filters for the hihats # 87 | ########################################## 88 | make_hc_filter cl_hihat_flt 89 | make_hc_filter op_hihat_flt 90 | 91 | ######################################################## 92 | # Every sequencer cycle, check redis for a new pattern # 93 | ######################################################## 94 | : _query_drum_parts 95 | :op_hihat redis_get tonum op_hihat ! 96 | :cl_hihat redis_get tonum cl_hihat ! 97 | :snare_drum redis_get tonum snare_drum ! 98 | :bass_drum redis_get tonum bass_drum ! 99 | ; 100 | 101 | _query_drum_parts 102 | 103 | ############################################################# 104 | # `_next_bit` r-shifts which bit in the hexbeat to inspect # 105 | # Also, conditionally resets back to the top bit if it # 106 | # reaches the right most extreme (typically 0, but we could # 107 | # do different meters by resetting earlier) # 108 | ############################################################# 109 | : _next_bit 110 | seq_bit @ 1 >> dup 111 | 0 = if 112 | drop 113 | top_bit @ seq_bit ! 114 | _query_drum_parts 115 | else 116 | seq_bit ! 117 | endif 118 | ; 119 | 120 | ############################################################### 121 | # `_bit_on?` answers the question if the bit we are looking at # 122 | # is "on" (or off) for the instrument line given on the stack # 123 | ############################################################### 124 | : _bit_on? { this_var } 125 | seq_bit @ 126 | dup 127 | this_var @ 128 | and 129 | = abs 130 | ; 131 | 132 | ######################################################################## 133 | # All `dsp.dc` central words are an infinite loop that return a single # 134 | # sample per iteration. # 135 | ######################################################################## 136 | : drum_machine 137 | inf times 138 | tempo @ metro curtrig ! 139 | curtrig @ lasttrig @ > if 140 | :DRUM_TEMPO redis_music.get_x_tempo dup tempo @ <> 141 | if 142 | tempo ! 143 | else 144 | drop 145 | endif 146 | redis_music.get_drum_vol dup drum_vol @ <> 147 | if 148 | drum_vol ! 149 | else 150 | drop 151 | endif 152 | bass_drum _bit_on? bass_drum_mask ! 153 | snare_drum _bit_on? snare_drum_mask ! 154 | cl_hihat _bit_on? cl_hihat_mask ! 155 | op_hihat _bit_on? op_hihat_mask ! 156 | _next_bit 157 | endif 158 | ################### 159 | # bass drum sound # 160 | ################### 161 | curtrig @ bass_drum_mask @ * 162 | bass_drum_port 0.001 0.06 163 | port 164 | dup 90 * 90 + sine 165 | * 166 | drum_vol @ * 167 | 0.5 panmix 168 | #################### 169 | # snare drum sound # 170 | #################### 171 | curtrig @ snare_drum_mask @ * 172 | snare_drum_port 0.001 0.06 173 | port 174 | noise 0.4 * 175 | 383 sine 0.3 * 176 | + 177 | * 178 | drum_vol @ * 179 | 0.3 panmix 180 | ###################### 181 | # closed hihat sound # 182 | ###################### 183 | curtrig @ cl_hihat_mask @ * 184 | cl_hihat_port 0.001 0.06 185 | port 186 | noise 0.2 * 187 | cl_hihat_flt 188 | 3610 0.6 189 | hc_bandpass 190 | * 191 | drum_vol @ * 192 | 0.7 panmix 193 | #################### 194 | # open hihat sound # 195 | #################### 196 | curtrig @ op_hihat_mask @ * 197 | op_hihat_port 0.001 0.18 198 | port 199 | noise 0.3 * 200 | op_hihat_flt 201 | 3800 0.7 202 | hc_bandpass 203 | * 204 | drum_vol @ * 205 | 0.7 panmix 206 | ############################ 207 | # output & variable update # 208 | ############################ 209 | stereo_out 210 | curtrig @ lasttrig ! 211 | t+ 212 | again 213 | ; 214 | 215 | ########### 216 | # Run it! # 217 | ########### 218 | 219 | drum_machine 220 | -------------------------------------------------------------------------------- /examples/dsp_examples/ebow_example.dc: -------------------------------------------------------------------------------- 1 | "dsp.dc" import 2 | 3 | make_hc_filter mylp 4 | 1 make_delay_line mydelay 5 | 6 | : ebow_example 7 | inf times 8 | # trigger, will be nozzled off: 9 | noise 0.5 * 10 | mylp 11 | 768 12 | 0.3 13 | hc_lowpass 14 | 0.9 * 15 | 0.333 16 | 0.1 17 | gate 18 | 0.5 * 19 | * 20 | 0.3 phasor 21 | * 22 | # filtered noise fed into a delay line resonator 23 | mydelay 24 | 1 256 / 25 | delay_read 26 | 0.9999999 * # ( dry wet ) 27 | + # ( dry+wet ) 28 | dup # ( dry+wet dry+wet ) 29 | 0.5 panmix # ( dry+wet ) 30 | # mix for delay_write 31 | 0.99 * # ((dry+wet)*0.95) 32 | mydelay 33 | delay_write # ( ) 34 | # final output 35 | stereo_out 36 | t+ 37 | again 38 | ; 39 | 40 | ebow_example 41 | -------------------------------------------------------------------------------- /examples/dsp_examples/fm_example.dc: -------------------------------------------------------------------------------- 1 | "dsp.dc" import 2 | 3 | : fm_example 4 | inf times 5 | # left chn 6 | 45 1 0.5 7 | fm 0.3 * 8 | 45.3 1 0.1 9 | sine 2 * 10 | 4.1 + 11 | fm 0.007 * 12 | + 13 | 0.3 14 | panmix 15 | # right chn 16 | 45.523 1 0.5 17 | fm 0.3 * 18 | 45.533 1 0.1 19 | sine 2 * 20 | 4.1 + 21 | fm 0.007 * 22 | + 23 | 0.7 24 | panmix 25 | # output 26 | stereo_out 27 | t+ 28 | again 29 | ; 30 | 31 | fm_example 32 | -------------------------------------------------------------------------------- /examples/dsp_examples/hc_bandpass_example.dc: -------------------------------------------------------------------------------- 1 | "dsp.dc" import 2 | 3 | make_hc_filter mylp1 4 | make_hc_filter mylp2 5 | make_hc_filter mylp3 6 | make_hc_filter mylp4 7 | 8 | var modwave 9 | var res 10 | var slmem 11 | 12 | : hc_bandpass_example 13 | inf times 14 | # sweeping mod 15 | # do from 0.08 - 0.02 16 | 0.2 sine 200 * 600 + 17 | modwave ! 18 | 0.1 res ! 19 | ### LEFT ### 20 | 247 phasor 2 * 1 - 0.5 * 21 | mylp1 modwave @ res @ hc_bandpass 22 | mylp2 modwave @ res @ hc_bandpass 0.1 * 23 | # panning 24 | 0.1 panmix 25 | ### RIGHT ### 26 | 247.31252 phasor 2 * 1 - 0.5 * 27 | mylp3 modwave @ res @ hc_bandpass 28 | mylp4 modwave @ res @ hc_bandpass 0.4 * 29 | # panning 30 | 0.9 panmix 31 | # output 32 | stereo_out 33 | # advance time 34 | t+ 35 | again 36 | ; 37 | 38 | hc_bandpass_example 39 | -------------------------------------------------------------------------------- /examples/dsp_examples/hc_lowpass_example.dc: -------------------------------------------------------------------------------- 1 | "dsp.dc" import 2 | 3 | make_hc_filter mylp1 4 | make_hc_filter mylp2 5 | make_hc_filter mylp3 6 | make_hc_filter mylp4 7 | 8 | var modwave 9 | var res 10 | var slmem 11 | 12 | : hc_lowpass_example 13 | inf times 14 | # sweeping mod 15 | # do from 0.08 - 0.02 16 | 0.2 sine 200 * 600 + 17 | modwave ! 18 | 0.1 res ! 19 | ### LEFT ### 20 | #47 phasor 2 * 1 - 0.5 * 21 | slmem 47 0.14 sineloop 0.8 * 22 | mylp1 modwave @ res @ hc_lowpass 23 | mylp2 modwave @ res @ hc_lowpass 0.1 * 24 | # panning 25 | 0.1 panmix 26 | ### RIGHT ### 27 | 47.31252 phasor 2 * 1 - 0.5 * 28 | mylp3 modwave @ res @ hc_lowpass 29 | mylp4 modwave @ res @ hc_lowpass 0.4 * 30 | # panning 31 | 0.9 panmix 32 | # output 33 | stereo_out 34 | # advance time 35 | t+ 36 | again 37 | ; 38 | 39 | hc_lowpass_example 40 | -------------------------------------------------------------------------------- /examples/dsp_examples/metronome_example.dc: -------------------------------------------------------------------------------- 1 | "dsp.dc" import 2 | 3 | var myport 4 | 5 | : metronome_example 6 | inf times 7 | 400 sine 8 | 2.01 metro 9 | 1.2 * 10 | myport 0.09 1.0 11 | port 12 | * 13 | 0.4 14 | panmix 15 | 467 sine 16 | 2.51 metro 17 | 1.2 * 18 | myport 0.09 1.0 19 | port 20 | * 21 | 0.3 sine 22 | 0.25 * 23 | 0.5 + 24 | panmix 25 | 600 sine 26 | 3.01 metro 27 | 1.2 * 28 | myport 0.09 1.0 29 | port 30 | * 31 | 0.6 32 | panmix 33 | stereo_out 34 | t+ 35 | again 36 | ; 37 | 38 | metronome_example 39 | -------------------------------------------------------------------------------- /examples/dsp_examples/midi_beating.dc: -------------------------------------------------------------------------------- 1 | "dsp.dc" import 2 | "midi.dc" import 3 | 4 | 1 127 / const MIDINORM 5 | 60 const BASE 6 | 7 | var sl1 8 | var sl2 9 | var sl3 10 | var sl4 11 | 12 | var port1pch 13 | var port1brt 14 | var port1vol 15 | var port2pch 16 | var port2brt 17 | var port2vol 18 | var port3pch 19 | var port3brt 20 | var port3vol 21 | var port4pch 22 | var port4brt 23 | var port4vol 24 | 25 | make_dcblock lchan_dcfilt 26 | make_dcblock rchan_dcfilt 27 | 28 | make_reverb_struct rev_struct 29 | 30 | create commas 15 16 / , 39 41 / , 31 | 24 25 / , 59 61 / , 32 | 35 36 / , 83 85 / , 33 | 48 49 / , 111 113 / , 34 | 63 64 / , 143 145 / , 35 | 80 81 / , 179 181 / , 36 | 99 100 / , 219 221 / , 37 | 120 121 / , 263 265 / , 38 | 143 144 / , 311 313 / , 39 | 168 169 / , 363 365 / , 40 | 195 196 / , 419 421 / , 41 | 224 225 / , 479 481 / , 42 | 255 256 / , 543 545 / , 43 | 1 1 / , 44 | 545 543 / , 256 255 / , 45 | 481 479 / , 225 224 / , 46 | 421 419 / , 196 195 / , 47 | 365 363 / , 169 168 / , 48 | 313 311 / , 144 143 / , 49 | 265 263 / , 121 120 / , 50 | 221 219 / , 100 99 / , 51 | 181 179 / , 81 80 / , 52 | 145 143 / , 64 63 / , 53 | 113 111 / , 49 48 / , 54 | 85 83 / , 36 35 / , 55 | 61 59 / , 25 24 / , 56 | 41 39 / , 16 15 / , 57 | 58 | : overtone_ctl midictl MIDINORM * 15 * round 1 + BASE * ; 59 | 60 | : beat_ctl midictl MIDINORM * 52 * round commas + @ ; 61 | 62 | : bright_ctl midictl MIDINORM * pi * ; 63 | 64 | : vol_ctl midictl MIDINORM * 0.47 * ; 65 | 66 | : midi_beating 67 | # get a midi control signal every 128 samples 68 | t 0x3f and 0 = 69 | if 70 | refresh_midictl 71 | endif 72 | sl1 73 | 21 overtone_ctl 41 beat_ctl * 74 | port1pch 1.0 1.0 port 75 | 25 bright_ctl 76 | port1brt 2.0 2.0 port 77 | sineloop 78 | 45 vol_ctl 79 | port1vol 2.0 2.0 port 80 | * 81 | 0.4 panmix 82 | sl2 83 | 22 overtone_ctl 42 beat_ctl * 84 | port2pch 1.0 1.0 port 85 | 26 bright_ctl 86 | port2brt 2.0 2.0 port 87 | sineloop 88 | 46 vol_ctl 89 | port2vol 2.0 2.0 port 90 | * 91 | 0.6 panmix 92 | sl3 93 | 23 overtone_ctl 43 beat_ctl * 94 | port3pch 1.0 1.0 port 95 | 27 bright_ctl 96 | port3brt 2.0 2.0 port 97 | sineloop 98 | 47 vol_ctl 99 | port3vol 2.0 2.0 port 100 | * 101 | 0.05 panmix 102 | sl4 103 | 24 overtone_ctl 44 beat_ctl * 104 | port4pch 1.0 1.0 port 105 | 28 bright_ctl 106 | port4brt 2.0 2.0 port 107 | sineloop 108 | 48 vol_ctl 109 | port4vol 2.0 2.0 port 110 | * 111 | 0.95 panmix 112 | # reverb 113 | lcget 0.5 * rcget 0.5 * 114 | rev_struct 0.9 0.97 115 | reverb 116 | 0.2 panmix 117 | 0.8 panmix 118 | # dcblock what's currently in each channel: 119 | lchan @ 120 | lchan_dcfilt 121 | dcblock 122 | lchan ! 123 | rchan @ 124 | rchan_dcfilt 125 | dcblock 126 | rchan ! 127 | # output 128 | stereo_out 129 | t+ 130 | midi_beating 131 | ; 132 | 133 | midi_beating 134 | -------------------------------------------------------------------------------- /examples/dsp_examples/midi_trigger.dc: -------------------------------------------------------------------------------- 1 | "dsp.dc" import 2 | "midi.dc" import 3 | 4 | # Open default MIDI output port 5 | 0 _pm_open_out 6 | 7 | 12 midi_edo ! 8 | 9 | : midi_trigger 10 | t 11 | SAMPLE_RATE 60 96 / * 12 | % dup 0 = if 13 | 100 0 0 edo_degree_to_midi 14 | else 15 | 2000 = if 16 | 0 0 0 edo_degree_to_midi 17 | endif 18 | endif 19 | # dummy values from lchan and rchan 20 | # already 0 -- sent out anyway 21 | # we're really only linking to 22 | # aplay for audio sample timing 23 | stereo_out 24 | t+ 25 | midi_trigger 26 | ; 27 | 28 | midi_trigger 29 | -------------------------------------------------------------------------------- /examples/dsp_examples/noise_example.dc: -------------------------------------------------------------------------------- 1 | "dsp.dc" import 2 | 3 | : noise_example 4 | inf times 5 | noise 0.5 * 6 | 0.5 7 | panmix 8 | stereo_out 9 | t+ 10 | again 11 | ; 12 | 13 | noise_example 14 | -------------------------------------------------------------------------------- /examples/dsp_examples/panning_example.dc: -------------------------------------------------------------------------------- 1 | "dsp.dc" import 2 | 3 | : panning_example 4 | inf times 5 | 300.0 sine 0.4 * 6 | 400.0 sine 0.4 * 7 | + 8 | 0.1 sine 0.4 * 0.5 + panmix 9 | stereo_out 10 | t+ 11 | again 12 | ; 13 | 14 | panning_example 15 | -------------------------------------------------------------------------------- /examples/dsp_examples/portamento_lead.dc: -------------------------------------------------------------------------------- 1 | ###################################################################### 2 | # Lead portamento synth using `sineloop`, sent through reverb. # 3 | # Also demonstrates the use of fraction_music and `euclidean_rhythm` # 4 | ###################################################################### 5 | 6 | "dsp.dc" import 7 | "music.dc" import 8 | 9 | "drone_vol" const :DRONE_VOL 10 | "lead_rev_vol" const :LEAD_REV_VOL 11 | "lead_rev_cf" const :LEAD_REV_CF 12 | "lead_rev_fb" const :LEAD_REV_FB 13 | 14 | var tempo :LEAD_TEMPO redis_music.get_x_tempo tempo ! 15 | var gatevar :GATE redis_get tonum gatevar ! 16 | var bass_pitch redis_music.get_base_pitch bass_pitch ! 17 | var pitch bass_pitch @ 4 * pitch ! 18 | var lead_vol redis_music.get_lead_vol lead_vol ! 19 | var drone_vol :DRONE_VOL redis_get tonum drone_vol ! 20 | var lead_rev_vol :LEAD_REV_VOL redis_get tonum lead_rev_vol ! 21 | var lead_rev_cf :LEAD_REV_CF redis_get tonum lead_rev_cf ! 22 | var lead_rev_fb :LEAD_REV_FB redis_get tonum lead_rev_fb ! 23 | 24 | var curtrig 25 | var lasttrig 26 | var trigcount 27 | var current_euclid euclidean_rhythm current_euclid ! 28 | var trigmask 29 | 30 | var pitch_port1 31 | var pitch_port2 32 | var amp_port 33 | 34 | var slmem1 35 | var slmem2 36 | var slmem3 37 | var slmem4 38 | 39 | make_digit_expansion_struct gen_struct 40 | make_reverb_struct my_reverb 41 | 42 | : portamento_lead 43 | inf times 44 | #################################################################### 45 | # check control changes (at a decent k-rate) that are not rhythmic # 46 | #################################################################### 47 | t 256 % 0 = 48 | if 49 | # has lead vol changed? 50 | :LEAD_VOL lead_vol true update_from_redis 51 | # has drone vol changed? 52 | :DRONE_VOL drone_vol true update_from_redis 53 | # has reverb stuff changed? 54 | :LEAD_REV_VOL lead_rev_vol true update_from_redis 55 | :LEAD_REV_CF lead_rev_cf true update_from_redis 56 | :LEAD_REV_FB lead_rev_fb true update_from_redis 57 | # has the gate value changed? 58 | :GATE gatevar true update_from_redis 59 | endif 60 | ############################ 61 | # Our main metronome pulse # 62 | ############################ 63 | gatevar @ tempo @ gate curtrig ! 64 | curtrig @ lasttrig @ > # rising edge detection 65 | if 66 | # has tempo changed? 67 | :LEAD_TEMPO redis_music.get_x_tempo dup tempo @ <> 68 | if tempo ! else drop endif 69 | # has bass pitch changed? 70 | redis_music.get_base_pitch dup base_pitch @ <> 71 | if bass_pitch ! else drop endif 72 | # possibly alter rhythm 73 | trigcount @ current_euclid @ % 0 = 74 | if 75 | 0 trigcount ! 76 | euclidean_rhythm current_euclid ! 77 | 1 trigmask ! 78 | # change pitch per algorithm 79 | gen_struct fraction_music 80 | edo_degree_to_hz 81 | pitch ! 82 | else 83 | 0 trigmask ! 84 | endif 85 | trigcount @ 1 + trigcount ! 86 | endif 87 | ################ 88 | # melody voice # 89 | ################ 90 | curtrig @ trigmask @ lead_vol @ * * 91 | amp_port 0.001 6.0 92 | port 93 | dup 94 | slmem1 95 | pitch @ pitch_port1 0.01 0.01 port 96 | 0.37 97 | sineloop 98 | * 99 | 0.1 panmix 100 | slmem2 101 | pitch @ 1.004 * pitch_port2 0.01 0.01 port 102 | 0.37 103 | sineloop 104 | * 105 | 0.9 panmix 106 | ############## 107 | # bass drone # 108 | ############## 109 | slmem3 110 | bass_pitch @ 111 | 0.29 112 | sineloop drone_vol @ * 113 | 0.3 panmix 114 | slmem4 115 | bass_pitch @ 1.5024 * 116 | 0.29 117 | sineloop drone_vol @ * 118 | 0.7 panmix 119 | ########## 120 | # output # 121 | ########## 122 | lchan @ lead_rev_vol @ * 123 | rchan @ lead_rev_vol @ * 124 | my_reverb 125 | lead_rev_cf @ 126 | lead_rev_fb @ 127 | reverb 128 | 1.0 panmix 129 | 0.0 panmix 130 | stereo_out 131 | curtrig @ lasttrig ! 132 | t+ 133 | again 134 | ; 135 | 136 | portamento_lead 137 | -------------------------------------------------------------------------------- /examples/dsp_examples/portaudio_stub.c: -------------------------------------------------------------------------------- 1 | /* 2 | * $Id$ 3 | * 4 | * This program uses the PortAudio Portable Audio Library. 5 | * For more information see: http://www.portaudio.com/ 6 | * Copyright (c) 1999-2000 Ross Bencina and Phil Burk 7 | * 8 | * Permission is hereby granted, free of charge, to any person obtaining 9 | * a copy of this software and associated documentation files 10 | * (the "Software"), to deal in the Software without restriction, 11 | * including without limitation the rights to use, copy, modify, merge, 12 | * publish, distribute, sublicense, and/or sell copies of the Software, 13 | * and to permit persons to whom the Software is furnished to do so, 14 | * subject to the following conditions: 15 | * 16 | * The above copyright notice and this permission notice shall be 17 | * included in all copies or substantial portions of the Software. 18 | * 19 | * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 20 | * EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 21 | * MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. 22 | * IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR 23 | * ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF 24 | * CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION 25 | * WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 26 | */ 27 | 28 | /* 29 | * The text above constitutes the entire PortAudio license; however, 30 | * the PortAudio community also makes the following non-binding requests: 31 | * 32 | * Any person wishing to distribute modifications to the Software is 33 | * requested to send the modifications to the original developer so that 34 | * they can be incorporated into the canonical version. It is also 35 | * requested that these non-binding requests be included along with the 36 | * license above. 37 | */ 38 | #include 39 | #include 40 | #include "../../dclang.h" 41 | #include "portaudio.h" 42 | 43 | #define DEVICE_NUM 0 44 | #define NUM_SECONDS 60 45 | #define SAMPLE_RATE 44100 46 | #define FRAMES_PER_BUFFER 256 47 | 48 | typedef struct 49 | { 50 | unsigned long int wordnum; 51 | float left_val; 52 | float right_val; 53 | char message[20]; 54 | } 55 | paTestData; 56 | 57 | /* This routine will be called by the PortAudio engine when audio is needed. 58 | ** It may called at interrupt level on some machines so don't do anything 59 | ** that could mess up the system like calling malloc() or free(). 60 | */ 61 | static int patestCallback(const void *inputBuffer, void *outputBuffer, 62 | unsigned long framesPerBuffer, 63 | const PaStreamCallbackTimeInfo* timeInfo, 64 | PaStreamCallbackFlags statusFlags, 65 | void *userData) 66 | { 67 | paTestData *data = (paTestData*)userData; 68 | float *out = (float*)outputBuffer; 69 | unsigned long i; 70 | 71 | (void) timeInfo; /* Prevent unused variable warnings. */ 72 | (void) statusFlags; 73 | (void) inputBuffer; 74 | 75 | for( i=0; ileft_val; // left 78 | *out++ = data->right_val; // right 79 | dclang_callword(data->wordnum); // update computational state 80 | data->left_val = (float) dclang_pop(); // update left 81 | data->right_val = (float) dclang_pop(); // update right 82 | } 83 | 84 | return paContinue; 85 | } 86 | 87 | /* 88 | * This routine is called by portaudio when playback is done. 89 | */ 90 | static void StreamFinished( void* userData ) 91 | { 92 | paTestData *data = (paTestData *) userData; 93 | printf( "Stream Completed: %s\n", data->message ); 94 | } 95 | 96 | /*******************************************************************/ 97 | int main(void); 98 | int main(void) 99 | { 100 | PaStreamParameters outputParameters; 101 | PaStream *stream; 102 | PaError err; 103 | paTestData data; 104 | int i; 105 | 106 | printf("PortAudio Test: output dclang DSP example. SR = %d, BufSize = %d\n", SAMPLE_RATE, FRAMES_PER_BUFFER); 107 | 108 | // init the data: 109 | dclang_initialize(); 110 | int import_stat = dclang_import(DSP_FILE); 111 | if (import_stat == -1) { 112 | printf("Could not import dclang source file, exiting.\n"); 113 | return -1; 114 | } 115 | unsigned long int wordnum = dclang_findword(DSP_WORD); 116 | if (wordnum == -1) { 117 | printf("Could not find dclang userword, exiting\n"); 118 | return -1; 119 | } 120 | data.wordnum = wordnum; 121 | data.left_val = data.right_val = 0.0f; 122 | 123 | err = Pa_Initialize(); 124 | if( err != paNoError ) goto error; 125 | 126 | 127 | //outputParameters.device = Pa_GetDefaultOutputDevice(); /* default output device */ 128 | outputParameters.device = DEVICE_NUM; 129 | if (outputParameters.device == paNoDevice) { 130 | fprintf(stderr,"Error: No default output device.\n"); 131 | goto error; 132 | } 133 | outputParameters.channelCount = 2; /* stereo output */ 134 | outputParameters.sampleFormat = paFloat32; /* 32 bit floating point output */ 135 | outputParameters.suggestedLatency = Pa_GetDeviceInfo( outputParameters.device )->defaultLowOutputLatency; 136 | outputParameters.hostApiSpecificStreamInfo = NULL; 137 | double sr = Pa_GetDeviceInfo(outputParameters.device)->defaultSampleRate; 138 | 139 | err = Pa_OpenStream( 140 | &stream, 141 | NULL, 142 | &outputParameters, 143 | sr, 144 | FRAMES_PER_BUFFER, 145 | paClipOff, /* we won't output out of range samples so don't bother clipping them */ 146 | patestCallback, 147 | &data ); 148 | if( err != paNoError ) goto error; 149 | 150 | sprintf( data.message, "No Message" ); 151 | err = Pa_SetStreamFinishedCallback( stream, &StreamFinished ); 152 | if( err != paNoError ) goto error; 153 | 154 | err = Pa_StartStream( stream ); 155 | if( err != paNoError ) goto error; 156 | 157 | printf("Play for %d seconds.\n", NUM_SECONDS ); 158 | Pa_Sleep( NUM_SECONDS * 1000 ); 159 | 160 | err = Pa_StopStream( stream ); 161 | if( err != paNoError ) goto error; 162 | 163 | err = Pa_CloseStream( stream ); 164 | if( err != paNoError ) goto error; 165 | 166 | Pa_Terminate(); 167 | printf("Test finished.\n"); 168 | 169 | return err; 170 | error: 171 | Pa_Terminate(); 172 | fprintf( stderr, "An error occurred while using the portaudio stream\n" ); 173 | fprintf( stderr, "Error number: %d\n", err ); 174 | fprintf( stderr, "Error message: %s\n", Pa_GetErrorText( err ) ); 175 | return err; 176 | } 177 | -------------------------------------------------------------------------------- /examples/dsp_examples/pw_mod_example.dc: -------------------------------------------------------------------------------- 1 | "dsp.dc" import 2 | 3 | make_hc_filter mylp 4 | 5 | : pw_mod_example 6 | inf times 7 | ############# 8 | # top pitch # 9 | ############# 10 | 0.1 sine # sine modulation of phase 11 | 0.5 * 0.5 + # bring within 0-1 range 12 | 0.8 * 0.1 + # squash 13 | 120 # pitch of pulse 14 | pulse 0.8 * 15 | mylp 800 0.1 hc_lowpass 0.17 * 16 | # mix and output 17 | 0.15 panmix 18 | ################ 19 | # bottom pitch # 20 | ################ 21 | 0.15 sine # sine modulation of phase 22 | 0.5 * 0.5 + # bring within 0-1 range 23 | 0.8 * 0.1 + # squash 24 | 80.1 # pitch of pulse 25 | pulse 0.8 * 26 | mylp 800 0.1 hc_lowpass 0.17 * 27 | # mix and output 28 | 0.85 panmix 29 | ########## 30 | # output # 31 | ########## 32 | stereo_out 33 | t+ 34 | again 35 | ; 36 | 37 | pw_mod_example 38 | -------------------------------------------------------------------------------- /examples/dsp_examples/randtrig_example.dc: -------------------------------------------------------------------------------- 1 | "dsp.dc" import 2 | 3 | var myampport 4 | var mypchport 5 | var trigval 6 | var curtrig 7 | var lasttrig 8 | var pitch 9 | 10 | create choices 11 | 7 , 8 , 9 , 10 , 11 , 12 , 12 | 13 | : randtrig_example 14 | inf times 15 | 0.02 trigval randtrig # create a trigger 16 | curtrig ! # store it 17 | curtrig @ lasttrig @ > # check if it crosses a change 18 | if # does it? 19 | choices 6 randint + @ 50 * # calculate a new pitch if so 20 | pitch ! # and set it 21 | endif 22 | pitch @ 23 | mypchport 0.01 0.01 port # get the pitch, portamento it 24 | sine # assign the portamento-pitch to a sine wave 25 | curtrig @ 0.7 * # grab the same trigger signal 26 | myampport 0.01 0.6 port * # envelope it 27 | 0.5 panmix # center pan 28 | stereo_out # send out 29 | curtrig @ lasttrig ! # lasttrig = curtrig 30 | t+ # update sample clock 31 | again 32 | ; 33 | 34 | randtrig_example 35 | -------------------------------------------------------------------------------- /examples/dsp_examples/reverb_example.dc: -------------------------------------------------------------------------------- 1 | "dsp.dc" import 2 | 3 | var lpmem1 4 | var myport 5 | make_reverb_struct my_reverb 6 | 7 | : reverb_example 8 | inf times 9 | noise 0.87 * 10 | lpmem1 0.25 11 | lowpass 12 | 0.01 0.34 rand 0.14 * 0.14 + - gate 13 | myport 0.01 0.1 14 | port 15 | * 16 | 0.5 * 17 | 0.5 panmix 18 | lchan @ rchan @ 19 | my_reverb 20 | 0.8 0.97 21 | reverb 22 | 1.0 panmix 23 | 0.0 panmix 24 | stereo_out 25 | t+ 26 | again 27 | ; 28 | 29 | reverb_example 30 | -------------------------------------------------------------------------------- /examples/dsp_examples/run-example-portaudio.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | if [[ $# -lt 1 ]] 4 | then 5 | echo "You didn't give an example .dc file to run" 6 | exit 0 7 | fi 8 | 9 | example=$1 10 | exampleword=$(echo ${example} | sed -E 's/\.dc//g') 11 | cat "$example" \ 12 | | egrep -v "^${exampleword}|inf times|again" \ 13 | | sed -E 's/stereo_out/stereo_stack/g' \ 14 | > _tmp_portaudio.dc 15 | 16 | make clean 17 | 18 | echo "#define DSP_FILE \"_tmp_portaudio.dc\"" >> portaudio_example.c 19 | echo "#define DSP_WORD \"${exampleword}\"" >> portaudio_example.c 20 | cat portaudio_stub.c >> portaudio_example.c 21 | 22 | make 23 | ./portaudio_example 24 | -------------------------------------------------------------------------------- /examples/dsp_examples/run-example.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | if [[ $# -lt 1 ]] 4 | then 5 | echo "You didn't give an example .dc file to run" 6 | exit 0 7 | fi 8 | 9 | # This (`pw-cat` for `pipewire`) can be changed to `aplay` or similar as needed 10 | # This also presumes a node called `dclang_mixer` has been created 11 | dclang sync.dc 12 | nice -19 dclang $1 | pw-cat -p -a \ 13 | --rate 44100 \ 14 | --channels 2 \ 15 | --format s32 \ 16 | --latency 128 \ 17 | --target dclang_mixer - 18 | -------------------------------------------------------------------------------- /examples/dsp_examples/simple_delay_example.dc: -------------------------------------------------------------------------------- 1 | "dsp.dc" import 2 | 3 | # create a delay line 4 | 1 make_delay_line mydelay 5 | 6 | var myport 7 | 8 | # example function 9 | : simple_delay_example 10 | inf times 11 | 440 sine 12 | 0.4333 metro 0.8 * 13 | myport 0.03 0.6 port * 14 | mydelay 0.4462 delay_read 0.75 * 15 | 2dup + 16 | mydelay delay_write 17 | 0.5 * + 18 | ########## 19 | # OUTPUT # 20 | ########## 21 | # center pan 22 | 0.5 panmix 23 | # output 24 | stereo_out 25 | # advance the clock 26 | t+ 27 | again 28 | ; 29 | 30 | simple_delay_example 31 | -------------------------------------------------------------------------------- /examples/dsp_examples/sineloop_example.dc: -------------------------------------------------------------------------------- 1 | "dsp.dc" import 2 | "midi.dc" import 3 | 4 | var sl1 5 | var sl2 6 | var modwave 7 | make_hc_filter mylp 8 | make_hc_filter mylp2 9 | 10 | : sineloop_example 11 | inf times 12 | t 0x8f and 0 = if 13 | refresh_midictl 14 | endif 15 | 0.1 21 midictl 127 / 6 * + 16 | sine 17 | 0.5 * 0.5 + 0.5 * 0.5 + modwave ! 18 | # left channel 19 | sl1 120 modwave @ sineloop 0.99 * 20 | mylp 1200 0.1 hc_lowpass 0.3 * 21 | 0.02 panmix 22 | # right channel 23 | sl2 89.751 2 * modwave @ sineloop 0.99 * 24 | mylp2 1205 0.1 hc_lowpass 0.3 * 25 | 0.98 panmix 26 | # output 27 | stereo_out 28 | t+ 29 | again 30 | ; 31 | 32 | sineloop_example 33 | -------------------------------------------------------------------------------- /examples/dsp_examples/sync.dc: -------------------------------------------------------------------------------- 1 | "redis_music.dc" import 2 | 3 | "Start timestamp is:" print cr 4 | 5 | "start_timestamp" redis_get print cr 6 | synchronized_start 7 | -------------------------------------------------------------------------------- /examples/edo_chart.dc: -------------------------------------------------------------------------------- 1 | " 2 | This script will compare some prime numbered EDOs (equal divisions of the 3 | octave) to compare how close or off the EDO's nearest estimation to a 4 | perfect 5th (3/2 ratio) is. 5 | " print 6 | 7 | # load some primes 8 | 5 0 ! 9 | 7 1 ! 10 | 11 2 ! 11 | 13 3 ! 12 | 17 4 ! 13 | 19 5 ! 14 | 23 6 ! 15 | 29 7 ! 16 | 31 8 ! 17 | 37 9 ! 18 | 41 10 ! 19 | 43 11 ! 20 | 47 12 ! 21 | 53 13 ! 22 | 23 | # perfect 5th to compare, store in slot 14: 24 | 3 2 / log2 14 ! 25 | 26 | : fifth 14 ; 27 | : degree 15 ; 28 | : fifth-cents 16 ; 29 | : diff 17 ; 30 | 31 | " 32 | perfect 5th is: " print 33 | fifth @ 1200 * 7 6 .rj "cents" print cr cr 34 | 35 | # print table header: 36 | " edo | deg | cents for 3/2 | error " print cr 37 | "---------------------------------------" print cr 38 | 39 | # loop through data 40 | : main 41 | 13 times 42 | i @ 4 3 .rj "\bedo" print # edo 43 | fifth @ i @ * round dup degree ! 3 3 .rj # degree 44 | "\bdeg" print 45 | degree @ i @ / 1200 * dup fifth-cents ! 12 6 .rj # cents value of 5th 46 | fifth-cents @ fifth @ 1200 * - 12 6 .rj cr # difference from pure 47 | again 48 | ; 49 | 50 | # run program 51 | main 52 | # final carriage return: 53 | cr 54 | -------------------------------------------------------------------------------- /examples/fibonacci.dc: -------------------------------------------------------------------------------- 1 | "deprecated_stack.dc" import 2 | 3 | : fibo-setup 4 | # this allows us to set up a loop withouth the user worrying about it 5 | 1 0 # ( n 0 1 ) 6 | rot # ( 1 0 n ) 7 | 0 1 # ( 1 0 n 0 1 ) 8 | ; 9 | 10 | : fibonacci 11 | dup 0 = 12 | if 13 | 0 . cr drop 14 | return 15 | else 16 | fibo-setup 17 | for 18 | tuck + 19 | next 20 | . cr drop 21 | endif 22 | ; 23 | 24 | : fibonacci-benchmark 25 | "Running `24 fibonacci`:" print cr 26 | clock 27 | 24 fibonacci 28 | clock 29 | swap - 30 | "`24 fibonacci` finished in: " print . "seconds" print cr 31 | ; 32 | 33 | fibonacci-benchmark 34 | -------------------------------------------------------------------------------- /examples/fizzbuzz.dc: -------------------------------------------------------------------------------- 1 | #!/usr/local/bin/dclang 2 | 3 | # Inspired by https://blog.codinghorror.com/why-cant-programmers-program/ 4 | 5 | # Note how to make a "case/switch" style structure, using if/else/endif, 6 | # I simply refused to indent, because the terms are mutually-exclusive. 7 | # Just follow the structure with the correct number of 'endif' words 8 | # to close it all off... 9 | 10 | : fizzbuzz 11 | 101 1 1 for 12 | i 3 % 0 = 13 | i 5 % 0 = and 14 | if 15 | "FizzBuzz " print 16 | else 17 | i 3 % 0 = 18 | if 19 | "Fizz " print 20 | else 21 | i 5 % 0 = 22 | if 23 | "Buzz " print 24 | else 25 | i . 26 | endif endif endif 27 | next 28 | ; 29 | 30 | fizzbuzz cr 31 | -------------------------------------------------------------------------------- /examples/fractions_examples.dc: -------------------------------------------------------------------------------- 1 | "fractions.dc" import 2 | 3 | "13/7 + 16/14:" print cr 4 | 13 7 16 14 fracadd .s drop drop 5 | cr 6 | 7 | "1/3 + 1/4:" print cr 8 | 1 3 1 4 fracadd .s drop drop 9 | cr 10 | 11 | "2/5 - 1/5:" print cr 12 | 2 5 1 5 fracsub .s drop drop 13 | cr 14 | 15 | "1/7 - 1/6:" print cr 16 | 1 7 1 6 fracsub .s drop drop 17 | cr 18 | 19 | "7/6 * 3/2:" print cr 20 | 7 6 3 2 fracmul .s drop drop 21 | cr 22 | 23 | "14/9 / 4/3:" print cr 24 | 14 9 4 3 fracdiv .s drop drop 25 | cr 26 | -------------------------------------------------------------------------------- /examples/http_server_example.dc: -------------------------------------------------------------------------------- 1 | "http_server.dc" import 2 | 3 | : copy_response_to_buffer 4 | # This reponse code is a simple demo that enumerates the input GET request 5 | # It can/should be customized to suit whatever your response needs are. 6 | # You could also read a variable that might branch according to endpoint 7 | # routing, so you serve different pages, etc. etc. This could perhaps 8 | # be fed by something set in the calling `acceptloop` word (see below) 9 | # after the initial `process_request` word runs, and before the call to 10 | # `write_response`. 11 | "Incoming path was: " str+ 12 | get_path str+ "
\n" str+ 13 | "Query string was: " str+ 14 | get_query 15 | dup 16 | if 17 | str+ 18 | else 19 | drop 20 | endif 21 | "
\nHash Table Entries:
\n" str+ 22 | print_hash_table 23 | ; 24 | 25 | : custom_response 26 | # an example typical response body is defined here...there are other possibilities 27 | zerobuf 28 | copy_header_to_buffer # <-- a standard HTTP header and HTML header 29 | # (can be changed as needed, but exists as a helper in the http_server lib) 30 | copy_response_to_buffer # <-- this can be customized to suit your response needs 31 | copy_footer_to_buffer # <-- this is here to close off the standard HTML header 32 | # (whether preset or not depends on whether `copy_header_to_buffer` was used) 33 | # (exists as a helper in the http_server lib 34 | ; 35 | 36 | acceptloop 37 | -------------------------------------------------------------------------------- /examples/kaleidoscope.dc: -------------------------------------------------------------------------------- 1 | # run this in an 80x24 terminal 2 | # 3 | # usage: nice -19 dclang kaleidoscope.dc 4 | 5 | # buffer size is 1921 (1920, but 1 extra slot for null character) 6 | var mybuf 7 | 1921 mkbuf 8 | mybuf ! 9 | 10 | # characters to choose from, right now, set to ' ' and '*' 11 | 32 1 ! 12 | 42 2 ! 13 | 32 3 ! 14 | 15 | : bufadd 16 | over mybuf @ + swap 1 memset drop 17 | ; 18 | 19 | : kaleidoscope 20 | 4096 times 21 | 0 # buffer offset, local on the stack 22 | 24 times 23 | 80 times 24 | i 160 / 0.25 - dup * # This is all distance formula stuff: 25 | j 48 / 0.25 - dup * # sqrt(a^2 + b^2)...distance from origin 26 | + sqrt sin # (sine of the distance from origin) 27 | k 0.5 * * cos 0.5 * 0.51 + 2.9 * floor 28 | 1 + @ bufadd 29 | 1 + # increment the buffer offset 30 | again 31 | again 32 | # add null char on buffer end 33 | mybuf @ 1920 + 0 1 memset drop 34 | # print the buffer 35 | mybuf @ print 36 | 0.0384 sleep 37 | drop 38 | again 39 | ; 40 | 41 | kaleidoscope 42 | 43 | cr 44 | "DONE!!!!!!" print 45 | cr 46 | -------------------------------------------------------------------------------- /examples/loop_bench.dc: -------------------------------------------------------------------------------- 1 | "deprecated_stack.dc" import 2 | 3 | : present-results 4 | "The sum is: " print . cr 5 | swap - 6 | "The time difference is: " print . "seconds" print cr 7 | ; 8 | 9 | : recur-loop 10 | 1 + # sum cur' 11 | tuck # cur' sum cur' 12 | + # cur' sum' 13 | swap # sum' cur' 14 | dup # sum' cur' cur' 15 | 20000000 <> 16 | if 17 | recur-loop 18 | endif 19 | ; 20 | 21 | : test-recur 22 | clock 23 | 0 0 recur-loop # clock sum cur func 24 | clock # clock sum cur clock' 25 | swap # clock sum clock' cur 26 | drop swap # clock clock' sum 27 | ; 28 | 29 | : testfor 30 | clock 0 31 | 20000001 0 1 for 32 | i + 33 | next 34 | clock 35 | swap 36 | ; 37 | 38 | : testtimes 39 | clock 0 40 | 20000001 times 41 | i + 42 | again 43 | clock 44 | swap 45 | ; 46 | 47 | : testtimes-var 48 | clock 49 | 0 0 ! 50 | 20000001 times 51 | 0 @ i + 0 ! 52 | again 53 | 0 @ 54 | clock 55 | swap 56 | ; 57 | 58 | "\nThis will show how various ways of composing loops are more efficient. 59 | In general, go with the simplest case, and avoid logical and stack 60 | operations inside of loops, when you can. Hence, the the first 'manual' 61 | loop here, using indexing via recursion, is the worst performer, and the 62 | simple 'times' loop at the end is the fastest. For extra interest, we 63 | have added a 'times' loop benchmark where the variable being incremented 64 | lives in the memory heap instead of right on the stack, as a 4th example 65 | " print 66 | 67 | "\nTesting loop using recursion\n" print 68 | test-recur 69 | present-results 70 | 71 | "\nTesting loop using 'for'\n" print 72 | testfor 73 | present-results 74 | 75 | "\nTesting loop using 'times'\n" print 76 | testtimes 77 | present-results 78 | 79 | "\nTesting loop using 'times' and poking/peeking a variable\n" print 80 | testtimes-var 81 | present-results 82 | -------------------------------------------------------------------------------- /examples/math_operation_speed.dc: -------------------------------------------------------------------------------- 1 | : time_add 2 | "Timing addition: " print 3 | clock 4 | 25000000 times 5 | i 42 + 6 | drop 7 | again 8 | clock swap - 2 6 .rj cr 9 | ; 10 | 11 | time_add 12 | 13 | : time_sub 14 | "Timing subtraction: " print 15 | clock 16 | 25000000 times 17 | i 42 - 18 | drop 19 | again 20 | clock swap - 2 6 .rj cr 21 | ; 22 | 23 | time_sub 24 | 25 | : time_mul 26 | "Timing multiplication: " print 27 | clock 28 | 25000000 times 29 | i 42 * 30 | drop 31 | again 32 | clock swap - 2 6 .rj cr 33 | ; 34 | 35 | time_mul 36 | 37 | : time_div 38 | "Timing division: " print 39 | clock 40 | 25000000 times 41 | i 42 / 42 | drop 43 | again 44 | clock swap - 2 6 .rj cr 45 | ; 46 | 47 | time_div 48 | 49 | : time_mod 50 | "Timing modulus: " print 51 | clock 52 | 25000000 times 53 | i 42 % 54 | drop 55 | again 56 | clock swap - 2 6 .rj cr 57 | ; 58 | 59 | time_mod 60 | 61 | : time_sine 62 | "Timing sine: " print 63 | clock 64 | 25000000 times 65 | i sin 66 | drop 67 | again 68 | clock swap - 2 6 .rj cr 69 | ; 70 | 71 | time_sine 72 | -------------------------------------------------------------------------------- /examples/midi-ctrl-knobs/midi_ctrl_knobs.dc: -------------------------------------------------------------------------------- 1 | "http_server.dc" import 2 | "redis.dc" import 3 | 4 | redis_connect 5 | 6 | "midi_ctrl_knobs.html" "r" fopen dup 7 | freadall drop const KNOB_HTML fclose 8 | 9 | # string constants 10 | "knob_21" const :knob_21 11 | "knob_22" const :knob_22 12 | "knob_23" const :knob_23 13 | "knob_24" const :knob_24 14 | "knob_25" const :knob_25 15 | "knob_26" const :knob_26 16 | "knob_27" const :knob_27 17 | "knob_28" const :knob_28 18 | "knob_41" const :knob_41 19 | "knob_42" const :knob_42 20 | "knob_43" const :knob_43 21 | "knob_44" const :knob_44 22 | "knob_45" const :knob_45 23 | "knob_46" const :knob_46 24 | "knob_47" const :knob_47 25 | "knob_48" const :knob_48 26 | 27 | "OK
\n\n" const :OK 28 | create keys_to_check :knob_21 , 29 | :knob_22 , 30 | :knob_23 , 31 | :knob_24 , 32 | :knob_25 , 33 | :knob_26 , 34 | :knob_27 , 35 | :knob_28 , 36 | :knob_41 , 37 | :knob_42 , 38 | :knob_43 , 39 | :knob_44 , 40 | :knob_45 , 41 | :knob_46 , 42 | :knob_47 , 43 | :knob_48 , 44 | var dummy 45 | dummy keys_to_check - const LEN_KEYS 46 | 47 | : _check_keys_and_set 48 | LEN_KEYS 0 1 49 | for 50 | get_query 51 | keys_to_check i + @ 52 | dup svpush 53 | strfind 54 | if 55 | svpop dup h@ swap redis_set 56 | exitfor 57 | endif 58 | svdepth 1 >= 59 | if 60 | svdrop 61 | endif 62 | next 63 | ; 64 | 65 | : custom_response 66 | get_path 67 | "/send_value" str= 68 | if 69 | _check_keys_and_set 70 | zerobuf HTTP_HTML_HEADER str+ 71 | :OK str+ 72 | drop 73 | else 74 | zerobuf HTTP_HTML_HEADER str+ 75 | KNOB_HTML str+ 76 | drop 77 | endif 78 | ; 79 | 80 | acceptloop 81 | -------------------------------------------------------------------------------- /examples/midi/README.md: -------------------------------------------------------------------------------- 1 | # MIDI setup 2 | 3 | Each of the scripts work by setting up a device using the portmidi bindings 4 | created in lib/midi.dc 5 | 6 | You can get an enumeration of MIDI devices on your machine by simply importing that 7 | library in a dclang interactive shell. For example: 8 | 9 | ``` 10 | aaron@aaron-XPS-13-9350:~/programs/dclang/examples/midi$ dclang 11 | Welcome to dclang! Aaron Krister Johnson, 2018-2024 12 | Make sure to peruse README.md to get your bearings! 13 | You can type 'primitives' to see a list of all the primitive (c-builtin) words. 14 | You can type 'words' to see a list of functions defined within dclang. 15 | 16 | There are currently 197 primitives implemented. 17 | The following primitives are visible; invisible primitives start with '_' and are meant to be used privately by libraries: 18 | 19 | Boolean | null false true = <> < > <= >= assert 20 | Bit manipulation | and or xor not << >> 21 | ... # rest of shell heading cut for space.... 22 | 23 | "midi.dc" import # <=== THIS IS WHAT YOU TYPE (AND HIT RETURN) 24 | 25 | # BELOW IS WHAT dclang WILL OUTPUT 26 | 27 | Here are your available MIDI devices: 28 | 0: ALSA, Midi Through Port-0 (default output) 29 | 1: ALSA, Midi Through Port-0 (default input) 30 | 2: ALSA, VirMIDI 1-0 (output) 31 | 3: ALSA, VirMIDI 1-0 (input) 32 | 4: ALSA, VirMIDI 1-1 (output) 33 | 5: ALSA, VirMIDI 1-1 (input) 34 | 6: ALSA, VirMIDI 1-2 (output) 35 | 7: ALSA, VirMIDI 1-2 (input) 36 | 8: ALSA, VirMIDI 1-3 (output) 37 | 9: ALSA, VirMIDI 1-3 (input) 38 | 39 | PORTMIDI_IN_DEVNUM is not set in your environment! 40 | MIDI input functionality will not work. 41 | If you need this, please exit from dclang, set that value, and try again! 42 | PORTMIDI_OUT_DEVNUM is not set in your environment! 43 | MIDI output functionality will not work. 44 | If you need this, please exit from dclang, set that value, and try again! 45 | ``` 46 | 47 | So, notice the message that we haven't selected a device. Now that we know what they are, 48 | let's say I want to use `ALSA, VirMIDI 1-0 (output)`, a virtual port, to send data to. 49 | Simple, that's `PORTMIDI_OUT_DEVNUM=2`, so let's export that. 50 | 51 | ``` 52 | aaron@aaron-XPS-13-9350:~/programs/dclang/examples/midi$ export PORTMIDI_OUT_DEVNUM=2 53 | ``` 54 | 55 | And, let's check again in `dclang` that it picks up: 56 | 57 | ``` 58 | aaron@aaron-XPS-13-9350:~/programs/dclang/examples/midi$ dclang 59 | Welcome to dclang! Aaron Krister Johnson, 2018-2024 60 | Make sure to peruse README.md to get your bearings! 61 | You can type 'primitives' to see a list of all the primitive (c-builtin) words. 62 | You can type 'words' to see a list of functions defined within dclang. 63 | 64 | ... # cut head again for brevity 65 | 66 | "midi.dc" import # <==== type this again and hit return 67 | 68 | Here are your available MIDI devices: 69 | 0: ALSA, Midi Through Port-0 (default output) 70 | 1: ALSA, Midi Through Port-0 (default input) 71 | 2: ALSA, VirMIDI 1-0 (output) 72 | 3: ALSA, VirMIDI 1-0 (input) 73 | 4: ALSA, VirMIDI 1-1 (output) 74 | 5: ALSA, VirMIDI 1-1 (input) 75 | 6: ALSA, VirMIDI 1-2 (output) 76 | 7: ALSA, VirMIDI 1-2 (input) 77 | 8: ALSA, VirMIDI 1-3 (output) 78 | 9: ALSA, VirMIDI 1-3 (input) 79 | 80 | PORTMIDI_IN_DEVNUM is not set in your environment! 81 | MIDI input functionality will not work. 82 | If you need this, please exit from dclang, set that value, and try again! 83 | Opening device number: 2 84 | 85 | ``` 86 | 87 | Great, it's now registered, via an environment variable, that we want to open 88 | `PORTMIDI_OUT_DEVNUM` number `2`. (ATM, we don't have to worry about the fact 89 | taht `PORTMIDI_IN_DEVNUM` is unset. 90 | 91 | Now, many of these scripts use parameters set in the key/value store `redis` 92 | to communicate variables to a live MIDI process. We can control these variables 93 | one of two ways: either directly change them via `redis-cli`, which comes with 94 | `redis`, and allows you to change values by typing them in, or -- start a little 95 | `dclang` web-server that serves a page with GUI widgets in your browser, and have 96 | AJAX messages update the same variables in `redis`, which will be picked up by the 97 | separate `dclang` process that is running a MIDI script. 98 | 99 | Here's how to start the server (you only type what's after the end of the shell prompt, which 100 | ends with `$`), where all this stuff will live will depend on how and where you've installed 101 | `dclang`: 102 | 103 | ``` 104 | aaron@aaron-XPS-13-9350:~/programs/dclang$ cd examples 105 | aaron@aaron-XPS-13-9350:~/programs/dclang/examples$ dclang redis_control.dc 106 | running acceptloop; serving on port 7651 107 | ``` 108 | 109 | The message tells us the interface is being served on port `7651`, so open you browser to 110 | `localhost:7651` in the address bar, and enjoy the widgets you'll see. Each will update 111 | a `redis` parameter behind-the-scenes. In a separate shell, you can start one of the example 112 | midi scripts that live in `examples/midi`. Note that this set of widgets covers most of the 113 | variables you'll encounter over the scripts, so not every parameter is used by any one script. 114 | -------------------------------------------------------------------------------- /examples/midi/change_ring.dc: -------------------------------------------------------------------------------- 1 | "midi.dc" import 2 | "redis_music.dc" import 3 | "permutations.dc" import 4 | 5 | var perm_obj 6 | 8 setup_permutation 7 | perm_obj ! 8 | 9 | create lengths 1 , 2 , 1 , 2 , 1 , 2 , 2 , 10 | var len_idx 11 | 0 len_idx ! 12 | len_idx lengths - const RHYTHM_CYCLE 13 | 41 midi_edo ! 14 | 15 | : generate_interval 16 | / log2 midi_edo @ * round 17 | ; 18 | 19 | 1 2 generate_interval const 1_2 20 | 9 8 generate_interval const 9_8 21 | 4 3 generate_interval const 4_3 22 | 3 2 generate_interval const 3_2 23 | 7 4 generate_interval const 7_4 24 | 2 1 generate_interval const 2_1 25 | 9 4 generate_interval const 9_4 26 | 27 | create scale 1_2 , 0 , 9_8 , 4_3 , 3_2 , 7_4 , 2_1 , 9_4 , 28 | 29 | : _get_len 30 | lengths len_idx @ RHYTHM_CYCLE % + @ 31 | ; 32 | 33 | : _advance_len_idx 34 | len_idx dup @ 1 + swap ! 35 | ; 36 | 37 | : _get_local_on_len 38 | redis_music.get_on_gate _get_len * 39 | ; 40 | 41 | : _get_local_off_len 42 | redis_music.get_off_gate _get_len * 43 | ; 44 | 45 | : _midi_change_ring 46 | block_sigint 47 | ### 48 | 100 49 | scale 50 | perm_obj @ next_permutation_item 51 | + 52 | @ 53 | redis_music.get_transpose 54 | + 55 | dup svpush 56 | 0 57 | edo_degree_to_midi 58 | ### 59 | _get_local_on_len sleep 60 | 0 svpop 0 edo_degree_to_midi 61 | _get_local_off_len sleep 62 | _advance_len_idx 63 | unblock_sigint 64 | _midi_change_ring 65 | ; 66 | 67 | : midi_change_ring 68 | "You are now entering an endless loop, hit CTRL-C to stop..." print cr 69 | "Notice that you won't be able to stop until a note off event hits." print cr 70 | "In this way, the notes end cleanly!" print cr 71 | _midi_change_ring 72 | ; 73 | 74 | midi_change_ring 75 | -------------------------------------------------------------------------------- /examples/midi/digit_sum.dc: -------------------------------------------------------------------------------- 1 | # Makes MIDI music via `digit_sum` 2 | 3 | "math.dc" import 4 | "midi.dc" import 5 | "redis_music.dc" import 6 | 7 | # our EDO var 8 | 41 midi_edo ! 9 | 10 | : generate_interval 11 | / log2 midi_edo @ * round 12 | ; 13 | 14 | : O- midi_edo @ - ; 15 | 16 | : O+ midi_edo @ + ; 17 | 18 | 9 8 generate_interval const 2ND 19 | 5 4 generate_interval const 3RD 20 | 7 5 generate_interval const ^4TH 21 | 3 2 generate_interval const 5TH 22 | 8 5 generate_interval const 6TH 23 | 7 4 generate_interval const H7TH 24 | 25 | create scale 0 O- , 5TH O- , H7TH O- , 26 | 0 , 2ND , 3RD , ^4TH , 5TH , 6TH, H7TH , 27 | 0 O+ , 2ND O+ , 3RD O+ , 28 | var dummy 29 | var scale_size 30 | dummy scale - 31 | scale_size ! 32 | 33 | create rhythm 5 , 3 , 5 , 2 , 3 , 2 , 1 , 5 , 2 , 3 , 6 , 2 , 34 | create vol 1 , 1 , 1 , 1 , 1 , 1 , 1 , 1 , 1 , 1 , 1 , 0 , 35 | 36 | vol rhythm - 37 | const RHYTHM_SIZE 38 | 39 | var x 40 | 0 x ! 41 | 42 | var y 43 | 0 y ! 44 | 45 | : x++ 46 | x @ 1 + 47 | x ! 48 | ; 49 | 50 | : y++ 51 | y @ 1 + dup # ( y1val y1val ) 52 | RHYTHM_SIZE > 53 | if 54 | drop 0 y ! 55 | else 56 | y ! 57 | endif 58 | ; 59 | 60 | : _get_next_note 61 | x @ redis_music.get_mul * 62 | redis_music.get_base 63 | digit_sum 64 | redis_music.get_mode 65 | + 66 | scale_size @ 67 | absmod 68 | scale 69 | + @ 70 | redis_music.get_transpose 71 | + 72 | x++ 73 | ; 74 | 75 | : _get_next_rhythm 76 | rhythm y @ + @ 77 | y++ 78 | ; 79 | 80 | : _get_next_vol 81 | vol y @ + @ 8 << 82 | ; 83 | 84 | : _main 85 | block_sigint 86 | ### 87 | 100 88 | _get_next_note 89 | dup svpush 90 | 0 91 | edo_degree_to_midi 92 | ### 93 | redis_music.get_on_gate 94 | _get_next_rhythm dup svpush 95 | * 96 | sleep 97 | svpop 0 svpop 0 98 | edo_degree_to_midi 99 | redis_music.get_off_gate 100 | * 101 | sleep 102 | unblock_sigint 103 | _main 104 | ; 105 | 106 | : main 107 | "You are now entering an endless loop, hit CTRL-C to stop..." print cr 108 | "Notice that you won't be able to stop until a note off event hits." print cr 109 | "In this way, the notes end cleanly!" print cr 110 | _main 111 | ; 112 | 113 | main 114 | 115 | panic 116 | -------------------------------------------------------------------------------- /examples/midi/digit_sum_enharmonic.dc: -------------------------------------------------------------------------------- 1 | # Makes MIDI music via `digit_sum` 2 | 3 | "math.dc" import 4 | "midi.dc" import 5 | "redis_music.dc" import 6 | 7 | # our EDO var 8 | 665 midi_edo ! 9 | 10 | : generate_interval 11 | / log2 midi_edo @ * round 12 | ; 13 | 14 | : O- midi_edo @ - ; 15 | 16 | : O+ midi_edo @ + ; 17 | 18 | 64 63 generate_interval const 64_63 19 | 16 15 generate_interval const 16_15 20 | 4 3 generate_interval const 4_3 21 | 3 2 generate_interval const 3_2 22 | 32 21 generate_interval const 32_21 23 | 8 5 generate_interval const 8_5 24 | 25 | create scale 4_3 O- O- , 26 | 0 O- , 27 | 4_3 O- , 28 | 0 , 64_63 , 16_15 , 4_3 , 3_2 , 32_21 , 8_5 , 29 | 0 O+ , 64_63 O+ , 16_15 O+ , 4_3 O+ , 30 | var dummy 31 | var scale_size 32 | dummy scale - 33 | scale_size ! 34 | 35 | var x 36 | 0 x ! 37 | 38 | : x++ 39 | x @ 1 + 40 | x ! 41 | ; 42 | 43 | : _get_next_note 44 | x @ 45 | redis_music.get_mul 46 | * 47 | redis_music.get_base 48 | digit_sum 49 | redis_music.get_wrap 50 | % 51 | redis_music.get_mode 52 | + 53 | scale_size @ 54 | absmod 55 | scale 56 | + @ 57 | redis_music.get_transpose 58 | + 59 | x++ 60 | ; 61 | 62 | : _main 63 | block_sigint 64 | ### 65 | 100 66 | _get_next_note 67 | dup svpush 68 | 0 69 | edo_degree_to_midi 70 | ### 71 | redis_music.get_on_gate 72 | sleep 73 | 0 svpop 0 74 | edo_degree_to_midi 75 | redis_music.get_off_gate 76 | sleep 77 | unblock_sigint 78 | _main 79 | ; 80 | 81 | : main 82 | "You are now entering an endless loop, hit CTRL-C to stop..." print cr 83 | "Notice that you won't be able to stop until a note off event hits." print cr 84 | "In this way, the notes end cleanly!" print cr 85 | seterr 86 | _main 87 | ; 88 | 89 | main 90 | 91 | panic 92 | -------------------------------------------------------------------------------- /examples/midi/midi_fractions.dc: -------------------------------------------------------------------------------- 1 | # This illustrates using decimal expansions of a fraction division in any base 2 | # being used to make music via MIDI 3 | # 4 | # First, follow the more general MIDI/Redis setup instructions in this directory's README.md 5 | # 6 | # Shell command should be: 7 | # PORTMIDI_OUT_DEVNUM= dclang midi_fractions.dc 8 | 9 | "midi.dc" import 10 | "music.dc" import 11 | 12 | make_digit_expansion_struct gen_struct 13 | 14 | : _main 15 | block_sigint 16 | ########### 17 | # note on # 18 | ########### 19 | 100 20 | gen_struct fraction_music dup svpush 21 | 0 22 | edo_degree_to_midi 23 | rhythm_generator redis_music.get_on_gate_abs 24 | ############ 25 | # note off # 26 | ############ 27 | 0 svpop 0 edo_degree_to_midi 28 | redis_music.get_off_gate_abs 29 | unblock_sigint 30 | _main 31 | ; 32 | 33 | : main 34 | "You are now entering an endless loop, hit CTRL-C to stop..." print cr 35 | "Notice that you won't be able to stop until a note off event hits." print cr 36 | "In this way, the notes end cleanly!" print cr 37 | redis_music.set_clock_start 38 | _main 39 | ; 40 | 41 | main 42 | 43 | panic 44 | -------------------------------------------------------------------------------- /examples/midi/modulating_arpeggios.dc: -------------------------------------------------------------------------------- 1 | "midi.dc" import 2 | "redis_music.dc" import 3 | 4 | 17 midi_edo ! 5 | 6 | : generate_interval 7 | / log2 midi_edo @ * round 8 | ; 9 | 10 | 9 8 generate_interval const STEP 11 | 6 5 generate_interval const MIN3 12 | 6 5 generate_interval const THIRD 13 | 3 2 generate_interval const FIFTH 14 | 9 5 generate_interval const SEV 15 | 16 | create arpeggio 0 , STEP , THIRD , FIFTH , SEV , 17 | create attacks 96 , 32 , 32 , 32 , 32 , 18 | create modulations FIFTH , MIN3 , FIFTH , MIN3 , 19 | var stopgap 20 | attacks arpeggio - const ARPEGGIO_SIZE 21 | ARPEGGIO_SIZE 2 * const MEASURE 22 | stopgap modulations - const MODUSIZE 23 | var step 24 | 0 step ! 25 | var modulations_pointer 26 | 0 modulations_pointer ! 27 | 28 | : _advance_step 29 | step @ 1 + step ! 30 | ; 31 | 32 | : _get_modulations_pointer 33 | modulations_pointer @ dup 34 | MODUSIZE = 35 | if 36 | drop 37 | 0 38 | endif 39 | dup 1 + modulations_pointer ! 40 | ; 41 | 42 | : _update_arpeggio 43 | svpush 44 | ARPEGGIO_SIZE times 45 | arpeggio i + @ 46 | 0 svpick + # interval on stack is added here 47 | midi_edo @ % 48 | arpeggio i + ! 49 | again 50 | svdrop 51 | # lower first note (root) an octave 52 | arpeggio @ midi_edo @ - 53 | arpeggio ! 54 | arpeggio ARPEGGIO_SIZE sortnums 55 | ; 56 | 57 | : _do_transposition 58 | step @ MEASURE % 59 | 0 = 60 | if 61 | modulations 62 | _get_modulations_pointer 63 | + @ 64 | _update_arpeggio 65 | endif 66 | ; 67 | 68 | : _get_edo_note 69 | step @ 70 | ARPEGGIO_SIZE % 71 | attacks + @ 72 | step @ 73 | ARPEGGIO_SIZE % 74 | arpeggio + @ 75 | ; 76 | 77 | : main 78 | block_sigint 79 | _get_edo_note dup svpush 0 80 | edo_degree_to_midi 81 | redis_music.get_on_gate sleep 82 | 0 svpop 0 83 | edo_degree_to_midi 84 | redis_music.get_off_gate sleep 85 | unblock_sigint 86 | _advance_step 87 | _do_transposition 88 | main 89 | ; 90 | 91 | main 92 | 93 | 8192 0 0xE0 send_midi_reverse 94 | -------------------------------------------------------------------------------- /examples/nano_syntax_highlighting_test.dc: -------------------------------------------------------------------------------- 1 | # Opening this file in the `nano` editor after installing the `contrib/dclang.nanorc` file 2 | # to the correct config location on your system for `nano` should show you some pretty 3 | # syntax coloring! 4 | 5 | null false true pi e 6 | + - * / % abs min max << >> 7 | = <> < > <= >= 8 | assert and or not xor 9 | round ceil floor pow sqrt log log2 log10 sin cos tan rand 10 | drop dup over pick depth swap rot -rot nip tuck 11 | 2drop 2dup 2over 2swap 2rot -2rot 2nip 2tuck 12 | svpush svpop svpick svdrop svclear 13 | ! @ const var allot create , h@ h! hkeys 14 | times again exittimes for next exitfor i j k if else endif return 15 | . h. .. .s .rj cr print emit uemit ord tohex bytes32 16 | strlen str= str< str> strfind strtok mempcpy memset mkbuf free 17 | fopen fread fseek ftell fwrite fflush fclose redirect resetout flush 18 | open mkbuf read tcplisten tcpaccept tcpconnect clock sleep 19 | words primitives import input 20 | : ; 21 | 22 | # comment 23 | "string string" 24 | 25 | "A string " 26 | 27 | "dasd" 28 | 29 | " A 30 | long multiline 31 | string! 32 | " 33 | 34 | # generic non-primitive defined words are darker green: 35 | 36 | : newword 37 | "hello!" print cr 38 | ; 39 | -------------------------------------------------------------------------------- /examples/nested_import.dc: -------------------------------------------------------------------------------- 1 | "examples/some_primes.dc" import 2 | "examples/fractions.dc" import 3 | -------------------------------------------------------------------------------- /examples/permutation_example.dc: -------------------------------------------------------------------------------- 1 | "permutations.dc" import 2 | 3 | var perm_obj 4 | 5 setup_permutation 5 | perm_obj ! 6 | 7 | : run_through_permutations 8 | "Here are the 120 permutations of 5 items!" print cr 9 | 120 times 10 | perm_obj @ print_next_permutation 11 | again 12 | ; 13 | 14 | run_through_permutations 15 | -------------------------------------------------------------------------------- /examples/redis_control.dc: -------------------------------------------------------------------------------- 1 | "http_server.dc" import 2 | "redis.dc" import 3 | 4 | redis_connect 5 | 6 | "redis_control.html" "r" fopen dup 7 | freadall drop const SLIDER_HTML fclose 8 | 9 | # string constants 10 | "base" const :base 11 | "mul" const :mul 12 | "wrap" const :wrap 13 | "div" const :div 14 | "chaos" const :chaos 15 | "mode" const :mode 16 | "gate" const :gate 17 | # Euclidean rhythm 18 | "euclid_numerator" const :euclid_numerator 19 | "euclid_denominator" const :euclid_denominator 20 | # OK status 21 | "OK
\n\n" const :OK 22 | # setup vars 23 | create keys_to_check :base , :mul , :wrap , :div , :chaos , :mode , 24 | :euclid_numerator , :euclid_denominator , :gate , 25 | var dummy 26 | dummy keys_to_check - const LEN_KEYS 27 | 28 | : _check_keys_and_set 29 | LEN_KEYS 0 1 30 | for 31 | get_query 32 | keys_to_check i + @ 33 | 2dup 34 | strfind 35 | if 36 | dup h@ swap redis_set 37 | drop 38 | exitfor 39 | else 40 | 2drop 41 | next 42 | endif 43 | ; 44 | 45 | : custom_response 46 | get_path 47 | "/send_value" str= 48 | if 49 | _check_keys_and_set 50 | zerobuf HTTP_HTML_HEADER str+ 51 | :OK str+ 52 | drop 53 | else 54 | zerobuf HTTP_HTML_HEADER str+ 55 | SLIDER_HTML str+ 56 | drop 57 | endif 58 | ; 59 | 60 | acceptloop 61 | -------------------------------------------------------------------------------- /examples/redis_control.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 43 | 44 | 45 | 46 |
47 |

Redis Param Control

48 | 49 |
50 | 52 |

Numeric base: 2

53 |
54 | 55 |
56 | 58 |

Multiplier: 31

59 |
60 | 61 |
62 | 64 |

Wrap (modulus): 14

65 |
66 | 67 |
68 | 70 |

Divide (denominator): 47

71 |
72 | 73 |
74 | 76 |

Chaos: 1.727

77 |
78 | 79 |
80 | 82 |

Mode offset: 0

83 |
84 | 85 |
86 | 88 |

Euclid numerator: 16

89 |
90 | 91 |
92 | 94 |

Euclid denominator: 6

95 |
96 | 97 | 98 |
99 | 101 |

MIDI gate length: 0.1

102 |
103 |
104 | 105 | 116 | 117 | 118 | 119 | -------------------------------------------------------------------------------- /examples/redis_example.dc: -------------------------------------------------------------------------------- 1 | "redis.dc" import 2 | 3 | # connect to the server 4 | redis_connect 5 | 6 | " 7 | Illustration of redis interface, which for now is limited to the simplest 8 | setting and getting of top-level keys. 9 | " 10 | print cr 11 | 12 | # Illustrate simple key setting and getting 13 | 14 | # STRING 15 | "To set the key \"Foo\" to the value \"Bar\", one calls the following: 16 | 17 | \"Bar\" \"Foo\" redis_set print cr 18 | 19 | Notice that the value precedes the key, consistent with the idea that 20 | a key to be fetched would immediately precede the operator doing the fetching, 21 | and thus, the value to be set would preced _that_. So, 22 | would be the natural order in a stack-based language like `dclang`. 23 | " 24 | print cr 25 | # END STRING 26 | 27 | # CODE 28 | "Bar" "Foo" redis_set print cr 29 | # END CODE 30 | 31 | # STRING 32 | "Now, to fetch the value we have set, we simply do: 33 | 34 | \"Foo\" redis_get print cr 35 | " 36 | print cr 37 | # END STRING 38 | 39 | # CODE 40 | "Foo" redis_get print cr 41 | cr 42 | # END CODE 43 | 44 | # STRING 45 | "Next, we'll do a simlar set/get, but with the great J.S. Bach as the subject 46 | of interest. The following is the output of two commands in succession: 47 | 48 | \"Bach\" \"Best_composer\" redis_set print cr 49 | \"Best_composer\" redis_get print cr 50 | " 51 | print cr 52 | # END STRING 53 | 54 | # CODE 55 | "Bach" "Best_composer" redis_set print cr 56 | "Best_composer" redis_get print cr 57 | # END CODE 58 | -------------------------------------------------------------------------------- /examples/scl2hz.dc: -------------------------------------------------------------------------------- 1 | # Currently, this script is limited to working with scales where the 2 | # assumption is a 2/1 (octave) period 3 | 4 | "string.dc" import 5 | 6 | "!" const :bang 7 | "/" const :slash 8 | 9 | # Get the filename 10 | var filename_to_open 11 | "SCALA_FILE" envget filename_to_open ! 12 | # Open file and assign file pointer 13 | var myfile 14 | filename_to_open @ "r" fopen myfile ! 15 | 16 | # data master array 17 | var master_array 128 allot 18 | var idx 0 idx ! 19 | 20 | 261 const HZ_BASE 21 | 22 | : is_bang_alone? { textline } 23 | textline strlen 2 = 24 | textline :bang strspn 1 = 25 | and 26 | ; 27 | 28 | : go_past_solo_bang 29 | inf times 30 | myfile @ freadline 31 | 0 = if 32 | exittimes 33 | else 34 | is_bang_alone? if 35 | exittimes 36 | else 37 | again 38 | endif 39 | endif 40 | ; 41 | 42 | : write_and_advance 43 | master_array idx @ + ! 44 | idx @ 1 + idx ! 45 | ; 46 | 47 | : calc_and_write_fraction 48 | :slash str_split 49 | dup lpop tonum 50 | swap lpop tonum 51 | swap / 52 | write_and_advance 53 | ; 54 | 55 | : calc_and_write_cents 56 | tonum 1200 / 2 swap pow 57 | write_and_advance 58 | ; 59 | 60 | var myline # place to put line of text 61 | 62 | : read_data 63 | inf times 64 | myfile @ freadline 65 | -1 = if 66 | exittimes 67 | else 68 | myline ! 69 | myline @ :slash strfind 70 | if 71 | myline @ calc_and_write_fraction 72 | else 73 | myline @ calc_and_write_cents 74 | endif 75 | again 76 | endif 77 | ; 78 | 79 | : show_data 80 | 6 -5 1 for 81 | idx @ times 82 | master_array i + @ 83 | HZ_BASE 2 j pow * 84 | * . cr 85 | again 86 | next 87 | ; 88 | 89 | # The main event: 90 | go_past_solo_bang 91 | go_past_solo_bang 92 | read_data 93 | show_data 94 | -------------------------------------------------------------------------------- /examples/some_primes.dc: -------------------------------------------------------------------------------- 1 | # let's print some primes: 2 | # we have some helper functions, the main work is done by 'is-prime?' below. 3 | # Then the primes are printed by a loop-through, and the '.rj' format 4 | # directive is used to keep them right-aligned. 5 | 6 | : is-2-3-5-7? 7 | dup dup # n n n 8 | 2 = # n n bool 9 | swap dup # n bool n n 10 | 3 = # n bool n bool 11 | swap dup # n bool bool n n 12 | 5 = # n bool bool n bool 13 | swap # n bool bool bool n 14 | 7 = # n bool bool bool bool 15 | or or or # n bool 16 | ; 17 | 18 | : check-higher-than-49 19 | dup # n n 20 | sqrt ceil 1 + 6 / # n n 21 | ceil 6 * 12 6 for 22 | dup i 1 - % 0 = 23 | over i 1 + % 0 = 24 | or if 25 | drop 0 exitfor 26 | else 27 | next drop 1 28 | endif 29 | ; 30 | 31 | : is-not-div-otherwise? 32 | dup # n n 33 | 49 < if # n bool 34 | drop 1 35 | else 36 | check-higher-than-49 37 | endif 38 | ; 39 | 40 | : is-not-div-by-2-3-5-7? 41 | dup # n n 42 | 2 % 0 = # n bool 43 | over # n bool n 44 | 3 % 0 = # n bool bool 45 | or over # n bool n 46 | 5 % 0 = # n bool bool 47 | or over # n bool n 48 | 7 % 0 = # n bool bool 49 | or 50 | if 51 | drop 0 52 | else 53 | is-not-div-otherwise? 54 | endif 55 | ; 56 | 57 | : is-prime 58 | is-2-3-5-7? 59 | if 60 | drop 1 61 | else 62 | is-not-div-by-2-3-5-7? 63 | endif 64 | ; 65 | 66 | : test-primes 67 | 8192 2 1 for 68 | i is-prime 69 | if 70 | i 4 0 .rj 71 | else 72 | endif 73 | next 74 | cr 75 | ; 76 | 77 | " \n #### Some primes! ####\n \b" print 78 | test-primes 79 | -------------------------------------------------------------------------------- /examples/sorting.dc: -------------------------------------------------------------------------------- 1 | "string.dc" import 2 | 3 | var iters 24 iters ! 4 | var myarr iters @ allot 5 | 6 | : create_rand_arr 7 | iters @ times 8 | rand 256 * round myarr i + ! 9 | again 10 | ; 11 | 12 | : showarr 13 | iters @ times 14 | myarr i + @ . 15 | again 16 | cr 17 | ; 18 | 19 | "Array before sorting:" print cr 20 | create_rand_arr 21 | showarr 22 | 23 | "Array after sorting:" print cr 24 | myarr iters @ sortnums 25 | showarr 26 | 27 | ############################# 28 | # Example of word splitting # 29 | ############################# 30 | 31 | var :tempest_quote 32 | var :delimiters 33 | var token_hold 34 | var word_index 0 word_index ! 35 | create tempest_words 36 | 37 | 38 | "We are such stuff 39 | as dreams are made on; 40 | and our little life is rounded with a sleep. 41 | " :tempest_quote ! 42 | 43 | " \n;." :delimiters ! 44 | 45 | 46 | cr "The following example takes a Shakespeare quote and splits it by whitespace, and sorts the words." 47 | print cr 48 | 49 | cr "The quote in question is: " print cr cr :tempest_quote @ print cr 50 | 51 | : splitter_main 52 | 0 53 | :delimiters @ 54 | token_hold 55 | strtok 56 | dup 57 | 0 58 | <> 59 | if 60 | , 61 | splitter_main 62 | endif 63 | ; 64 | 65 | : splitter 66 | :tempest_quote @ 67 | :delimiters @ 68 | token_hold 69 | strtok 70 | dup # ( token token ) 71 | 0 72 | <> 73 | if 74 | , 75 | splitter_main 76 | endif 77 | ; 78 | 79 | : showstrs 80 | here tempest_words - 81 | times 82 | tempest_words i + @ 83 | print cr 84 | again 85 | ; 86 | 87 | "Splitting the text..." print cr 88 | # iterate through the text: 89 | splitter 90 | 91 | cr "Displaying..." print cr 92 | # display output: 93 | showstrs 94 | 95 | cr "Sorting..." print cr 96 | # sort the text: 97 | tempest_words 18 sortstrs 98 | 99 | cr "Displaying after sort..." print cr 100 | # display output: 101 | showstrs 102 | -------------------------------------------------------------------------------- /examples/stack_vs_var_speed.dc: -------------------------------------------------------------------------------- 1 | "string.dc" import 2 | 3 | 1024 1024 16 * * const TESTCOUNT 4 | "mykey" const :mykey 5 | 6 | var myvar 7 | 1 myvar ! 8 | 9 | 1 4 ! # 'raw' integer variable 10 | 11 | ###################### 12 | # The test functions # 13 | ###################### 14 | 15 | : time_stack 16 | "Timing the stack: " print 17 | clock 18 | 1 19 | TESTCOUNT times 20 | dup drop 21 | again 22 | drop 23 | clock swap - 2 6 .rj cr 24 | ; 25 | 26 | : time_svstack 27 | "Timing the save stack: " print 28 | clock 29 | 1 svpush 30 | TESTCOUNT times 31 | 0 svpick drop 32 | again 33 | clock swap - 2 6 .rj cr 34 | ; 35 | 36 | : time_locals { somevar } 37 | "Timing local variables: " print 38 | clock 39 | TESTCOUNT times 40 | somevar drop 41 | again 42 | clock swap - 2 6 .rj cr 43 | ; 44 | 45 | : time_var_raw_int 46 | "Timing variables using integers: " print 47 | clock 48 | TESTCOUNT times 49 | 4 @ drop 50 | again 51 | clock swap - 2 6 .rj cr 52 | ; 53 | 54 | : time_var 55 | "Timing normal named variables: " print 56 | clock 57 | TESTCOUNT times 58 | myvar @ drop 59 | again 60 | clock swap - 2 6 .rj cr 61 | ; 62 | 63 | : time_hash 64 | "Timing hash lookup: " print 65 | #################### 66 | # fill with values # 67 | #################### 68 | 1024 times 69 | hex8token hex8token h! 70 | again 71 | 1 :mykey h! 72 | ######################## 73 | # end fill with values # 74 | ######################## 75 | clock 76 | TESTCOUNT times 77 | :mykey h@ drop 78 | again 79 | clock swap - 2 6 .rj cr 80 | ; 81 | 82 | : time_tree 83 | "Timing tree lookup: " print 84 | tmake drop 85 | 1024 times 86 | 0 hex8token hex8token t! drop 87 | again 88 | 0 :mykey 23 t! drop 89 | clock 90 | TESTCOUNT times 91 | 0 :mykey t@ drop 92 | again 93 | clock swap - 2 6 .rj cr 94 | ; 95 | 96 | : do_math_swap 97 | "Timing math with swap: " print 98 | clock 99 | TESTCOUNT times 100 | 1 2 + 101 | 3 4 + 102 | swap 103 | / 104 | drop 105 | again 106 | clock swap - 2 6 .rj cr 107 | ; 108 | 109 | : do_math_save 110 | "Timing math with svpush and svpop: " print 111 | clock 112 | TESTCOUNT times 113 | 1 2 + svpush 114 | 3 4 + 115 | svpop 116 | / 117 | drop 118 | again 119 | clock swap - 2 6 .rj cr 120 | ; 121 | 122 | : do_math_var 123 | "Timing math with ! and @: " print 124 | clock 125 | TESTCOUNT times 126 | 1 2 + 0 ! 127 | 3 4 + 128 | 0 @ 129 | / 130 | drop 131 | again 132 | clock swap - 2 6 .rj cr 133 | ; 134 | 135 | ################# 136 | # Run the tests # 137 | ################# 138 | 139 | time_stack 140 | time_svstack 141 | 142 | 5 time_locals 143 | 144 | time_var_raw_int 145 | 146 | time_var 147 | 148 | time_hash 149 | time_tree 150 | 151 | do_math_swap 152 | do_math_save 153 | do_math_var 154 | -------------------------------------------------------------------------------- /examples/stern_brocot_tree.dc: -------------------------------------------------------------------------------- 1 | "fractions.dc" import 2 | 3 | var numerators 4 | var denominators 5 | lmake numerators ! 6 | lmake denominators ! 7 | 8 | "/" const :slash 9 | 10 | : _show_sb_tree 11 | numerators @ lsize times 12 | numerators @ i l@ .. 13 | :slash print 14 | denominators @ i l@ . 15 | again 16 | cr 17 | ; 18 | 19 | : _make_sb_tree_real { curidx loops n1 d1 n2 d2 } 20 | numerators @ ldel 21 | denominators @ ldel 22 | numerators @ n1 lpush 23 | numerators @ n2 lpush 24 | denominators @ d1 lpush 25 | denominators @ d2 lpush 26 | loops times 27 | inf times 28 | numerators @ lsize 1 - curidx = if 29 | 0 curidx! 30 | exittimes 31 | else 32 | numerators @ curidx l@ 33 | denominators @ curidx l@ 34 | numerators @ curidx 1 + l@ 35 | denominators @ curidx 1 + l@ 36 | fracmediant 37 | denominators @ swap curidx 1 + swap lins 38 | numerators @ swap curidx 1 + swap lins 39 | curidx 2 + curidx! 40 | again 41 | endif 42 | again 43 | ; 44 | 45 | : make_sb_tree 46 | depth 5 < if 47 | "make_sb_tree: stack underflow; need on the stack!" print cr 48 | return 49 | endif 50 | { loops n1 d1 n2 d2 } 51 | 0 loops n1 d1 n2 d2 _make_sb_tree_real 52 | _show_sb_tree 53 | ; 54 | -------------------------------------------------------------------------------- /examples/strings.dc: -------------------------------------------------------------------------------- 1 | "string.dc" import 2 | 3 | : teststr 4 | 1 if 5 | "This is true" print 6 | else 7 | "This is false" print 8 | endif 9 | ; 10 | teststr 11 | cr 12 | 13 | : teststr2 14 | 0 if 15 | "This is true" print 16 | else 17 | "This is false" print 18 | endif 19 | ; 20 | teststr2 21 | cr 22 | 23 | : manyuuids 16 times uuid cr again ; 24 | 25 | manyuuids 26 | -------------------------------------------------------------------------------- /examples/tcpclient.dc: -------------------------------------------------------------------------------- 1 | var serv 2 | var msg 3 | var msglen 4 | var connbuf 256 mkbuf connbuf ! 5 | var prompt "Please enter your message: " prompt ! 6 | 7 | : get_serv serv @ ; 8 | : get_connbuf connbuf @ ; 9 | : get_msg msg @ ; 10 | : get_msglen msglen @ ; 11 | : get_prompt prompt @ ; 12 | : set_msg msg ! ; 13 | : set_msglen msglen ! ; 14 | 15 | : get_user_msg 16 | get_prompt print 17 | input 18 | set_msg 19 | get_msg strlen set_msglen 20 | "You entered: " print get_msg print cr 21 | ; 22 | 23 | : zerobuf get_connbuf 0 256 memset ; 24 | 25 | : msg_to_buf 26 | zerobuf 27 | get_connbuf 28 | get_msg 29 | dup strlen 30 | mempcpy drop 31 | ; 32 | 33 | : client_connect "localhost" 5509 tcpconnect serv ! ; 34 | 35 | : write_to_server 36 | get_serv get_connbuf get_msglen write drop 37 | ; 38 | 39 | : read_response 40 | zerobuf 41 | get_serv get_connbuf 256 read drop 42 | get_connbuf print cr 43 | ; 44 | 45 | 46 | : sendloop 47 | get_user_msg 48 | msg_to_buf 49 | client_connect 50 | write_to_server 51 | read_response 52 | sendloop 53 | ; 54 | 55 | sendloop 56 | -------------------------------------------------------------------------------- /examples/tcpserver.dc: -------------------------------------------------------------------------------- 1 | var connbuf 1024 mkbuf connbuf ! 2 | var received 1024 mkbuf received ! 3 | var response_prefix "OK, message received: " response_prefix ! 4 | var response_prefix_len 5 | response_prefix @ strlen response_prefix_len ! 6 | 7 | # create a listening server 8 | var srv_queue 5509 tcplisten srv_queue ! 9 | var accepted_conn 10 | 11 | : get_accepted_conn accepted_conn @ ; 12 | : get_connbuf connbuf @ ; 13 | : get_received received @ ; 14 | : get_response_prefix response_prefix @ ; 15 | : get_response_prefix_len response_prefix_len @ ; 16 | : zerobuf get_connbuf 0 1024 memset ; 17 | : copyinput 18 | get_received 19 | get_connbuf 20 | dup strlen 21 | mempcpy 22 | drop 23 | ; 24 | 25 | : read_request 26 | zerobuf 27 | get_accepted_conn get_connbuf 1023 read drop 28 | ; 29 | 30 | : concat_response 31 | copyinput 32 | zerobuf 33 | get_connbuf get_response_prefix get_response_prefix_len mempcpy 34 | get_received dup strlen mempcpy 35 | ; 36 | 37 | : write_response 38 | get_accepted_conn get_connbuf dup strlen write drop 39 | get_accepted_conn close drop 40 | ; 41 | 42 | : acceptloop 43 | # wait for a request 44 | "waiting for a request..." print cr 45 | srv_queue @ tcpaccept accepted_conn ! 46 | # read the incoming msg 47 | read_request 48 | # echo the incoming on the server side 49 | "Here is the incoming message: " print get_connbuf print cr 50 | concat_response 51 | write_response 52 | acceptloop 53 | ; 54 | 55 | acceptloop 56 | 57 | # close down connection 58 | srv_queue @ close drop 59 | -------------------------------------------------------------------------------- /examples/tetrachords.dc: -------------------------------------------------------------------------------- 1 | "fractions.dc" import 2 | 3 | var char_n 4 | 4 char_n ! 5 | var char_d 6 | 3 char_d ! 7 | 8 | "/" const :slash 9 | 10 | : next_characteristic 11 | char_n @ 1 + char_n ! 12 | char_d @ 1 + char_d ! 13 | "=== Characteristic ratio of " print 14 | char_n @ .. :slash print char_d @ . 15 | "===" print cr 16 | ; 17 | 18 | : next_frac_to_split 19 | 4 3 20 | char_n @ 21 | char_d @ 22 | fracdiv 2dup 23 | ; 24 | 25 | : increment_fraction { n d } 26 | n 1 + 27 | d 1 + 28 | simplify 29 | ; 30 | 31 | : copy_and_divide { n1 d1 n2 d2 } 32 | n1 d1 n2 d2 33 | n1 d1 n2 d2 fracdiv 34 | ; 35 | 36 | : check_bigger { n1 d1 n2 d2 } 37 | n1 d1 n2 d2 38 | n1 d2 * 39 | n2 d1 * 40 | < 41 | ; 42 | 43 | : check_epimoric { n1 d1 n2 d2 } 44 | n1 d1 n2 d2 # copy the stack so it stays after output 45 | n1 d2 * 46 | n2 d1 * 47 | > # ensure the 1st fraction is bigger than the 2nd 48 | n2 d2 - 1 = # and, that the 2nd fraction is epimoric 49 | and 50 | char_n @ d1 * 51 | n1 char_d @ * 52 | >= # also, ensure the derived fraction is no bigger than 53 | # the characteristic 54 | and 55 | ; 56 | 57 | : output_tetrachord { n1 d1 n2 d2 } 58 | n1 d1 n2 d2 59 | n2 .. :slash print d2 . 60 | n1 .. :slash print d1 . 61 | char_n @ .. :slash print char_d @ . 62 | cr 63 | ; 64 | 65 | : find_tetrachords 66 | 6 times # known in advance not to go beyond the midpoint we need 67 | next_characteristic 68 | next_frac_to_split 69 | inf times 70 | increment_fraction 71 | copy_and_divide 72 | check_bigger 73 | if 74 | clear 75 | exittimes 76 | else 77 | check_epimoric 78 | if 79 | output_tetrachord 80 | endif 81 | 2drop 82 | again 83 | endif 84 | again 85 | ; 86 | 87 | find_tetrachords 88 | -------------------------------------------------------------------------------- /examples/timesquare.dc: -------------------------------------------------------------------------------- 1 | : timesq 2 | 10 times 3 | 10 times 4 | 0 j = 5 | 9 j = 6 | or 7 | 0 i = 8 | 9 i = 9 | or 10 | or 11 | if 12 | 8987 uemit 13 | else 14 | 8986 uemit 15 | endif 16 | again 17 | cr 18 | again 19 | ; 20 | 21 | timesq 22 | -------------------------------------------------------------------------------- /examples/tucson_airport.db.gz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/akjmicro/dclang/5af1a29beb6dc788ab62df1b0e6245eaae6c71cc/examples/tucson_airport.db.gz -------------------------------------------------------------------------------- /examples/waves.dc: -------------------------------------------------------------------------------- 1 | 80 const WIDTH 2 | 24 const HEIGHT 3 | 1 WIDTH / const INV_WIDTH 4 | 1 HEIGHT / const INV_HEIGHT 5 | WIDTH HEIGHT * const AREA 6 | HEIGHT 2 / const HIGHROW 7 | WIDTH 2 / const HIGHCOL 8 | HIGHROW -1 * const LOWROW 9 | HIGHCOL -1 * const LOWCOL 10 | 11 | var mybuf 12 | AREA mkbuf 13 | mybuf ! 14 | 15 | : bufadd 16 | over mybuf @ + swap 1 memset drop 17 | ; 18 | 19 | : waves 20 | 4096 times 21 | 0 22 | HIGHROW LOWROW 1 for 23 | HIGHCOL LOWCOL 1 for 24 | i INV_WIDTH * dup * sin 25 | j INV_HEIGHT * dup * cos 26 | * sqrt 27 | k 28 | * 29 | sin 30 | 0.5 31 | < 32 | if 32 else 42 endif bufadd 33 | 1 + # increment the original 0 counter 34 | next 35 | next 36 | mybuf @ AREA + 0 1 memset drop 37 | mybuf @ print 38 | 0.0384 sleep 39 | drop 40 | again 41 | ; 42 | 43 | waves 44 | 45 | cr 46 | "DONE!!!!!!" print 47 | cr 48 | -------------------------------------------------------------------------------- /examples/word_count.dc: -------------------------------------------------------------------------------- 1 | var :text_to_count 2 | 3 | "Startsidan på DN.se kommer att göras i tre versioner: en riksversion, en 4 | Stockholmsversion och en Göteborgsversion. DN har av många setts som en Stockholmstidning, 5 | och det med all rätt. Men digitalt växer vi nu som mest i orter utanför Stockholmsregionen, 6 | säger Anna Åberg, chef för DN.se. Och de nya läsarna ställer andra krav både på innehållet och på presentationen. 7 | Många läsare utanför Stockholm blir irriterade på vad de upplever som för stort Stockholmsfokus på DN.se. 8 | Samtidigt tycker våra läsare i Stockholm att vi har för lite Stockholmsnyheter på startsidan. 9 | Med satsningen på Göteborg blev detta en av våra viktigaste utmaningar att lösa, säger Anna Åberg. 10 | 11 | Dagens Nyheter har, till skillnad från många andra nyhetssajter, valt att inte låta en algoritm styra i vilken 12 | ordning nyheter visas på förstasidan. Vi är måna om att nyhetsvärderingen och sorteringen på startsidan även 13 | fortsatt ska vara gjord av redaktörer. Men det går inte att helt bortse från geografiskt avstånd i nyhetsvärderingen. 14 | Om det är trafikkaos i Göteborg är det relevant för de som befinner sig i Göteborg, men inte nödvändigtvis för en 15 | person i Malmö, säger Anna Åberg." 16 | :text_to_count ! 17 | 18 | var :delims " \n\t.,!?;:-*" :delims ! 19 | 20 | var savepoint 21 | 22 | : _hash_entry 23 | dup h@ 1 + swap h! 24 | ; 25 | 26 | : splitter_main 27 | 0 :delims @ savepoint strtok 28 | dup 0 <> 29 | if 30 | _hash_entry 31 | splitter_main 32 | endif 33 | ; 34 | 35 | : splitter 36 | :text_to_count @ :delims @ savepoint strtok 37 | dup 0 <> 38 | if 39 | _hash_entry 40 | splitter_main 41 | endif 42 | drop 43 | ; 44 | 45 | : iterkeys 46 | 1 + dup # ( idx idx ) 47 | hkeys dup # ( idx str str ) 48 | 0 <> # ( idx str isnotzero ) 49 | if 50 | dup # ( idx str str ) 51 | print ": " print h@ . cr 52 | iterkeys 53 | else 54 | drop drop 55 | endif 56 | ; 57 | 58 | # The program! 59 | splitter 60 | 0 iterkeys 61 | -------------------------------------------------------------------------------- /examples/word_nesting.dc: -------------------------------------------------------------------------------- 1 | : foo 2 * .s ; 2 | : bar 3 * .s ; 3 | : fubar 1 - foo bar ; 4 | 5 fubar "The answer is: " print . cr 5 | 7 fubar fubar "The 2nd answer is: " print . cr 6 | -------------------------------------------------------------------------------- /lib/clock_sleep.dc: -------------------------------------------------------------------------------- 1 | # This little library implements `sleep_until`, which is a word 2 | # designed to give a bit more deterministic, guaranteed accurate 3 | # timing behavior than using `sleep` alone. Better for e.g. 4 | # musical applications using MIDI, etc. 5 | # 6 | # Most of the MIDI-based examples will be ported to use this eventually. 7 | # As of 2025-05-01, only examples/midi/midi_fractions.dc is using it. 8 | 9 | : _tight_watch { clock_target } 10 | inf times 11 | clock_target clock - 12 | 0 <= 13 | if 14 | exittimes 15 | return 16 | else 17 | again 18 | endif 19 | ; 20 | 21 | : sleep_until { clock_target } 22 | inf times 23 | # measure distance remaining 24 | clock_target clock - dup 25 | 0.005 <= 26 | if 27 | drop 28 | exittimes 29 | else 30 | 2 / sleep 31 | again 32 | endif 33 | clock_target _tight_watch 34 | ; 35 | -------------------------------------------------------------------------------- /lib/csvlib.dc: -------------------------------------------------------------------------------- 1 | # This is a first sketch of a "naive .psv" processing library 2 | # It's set here to split by sqlite3-like records, which are pipe-delimited 3 | # by default with the "|" character. The functionality so far is "naive" 4 | # because it's assumed that the data won't have newlines (\n) in anyplace 5 | # but the true end-of-line of the record (so, it doesn't have the capacity 6 | # yet to do embedded, escaped "\n" via '"'. And, it also assumes your .csv 7 | # file (really a 'psv' by default) also won't have the pipe character "|" 8 | # in your data columns. If you can live with those current restrictions, 9 | # you can do some basic iteration through lines of a CSV file to get at 10 | # integer 0-indexed columns. 11 | 12 | var csv_input_file 13 | var csv_output_file 14 | var csv_line_idx -1 csv_line_idx ! 15 | var csv_sep "|" csv_sep ! # pipe-delimited by default, can be over-ridden 16 | var csv_col_idx 0 csv_col_idx ! 17 | var csv_col_desired 18 | var csv_col_buf 19 | 20 | 21 | : csv_open_input_file 22 | # ( file_string ) # file-string must be on stack 23 | -1 csv_line_idx ! 24 | "r" fopen 25 | csv_input_file ! 26 | ; 27 | 28 | : _csv_init_col_buf 29 | # ( num_bytes ) 30 | csv_col_buf @ # ( num_bytes buf ) 31 | dup 0 = # ( num_bytes buf buf_is_0 ) 32 | if 33 | drop # ( num_bytes ) 34 | else 35 | free 36 | endif 37 | mkbuf 38 | csv_col_buf ! 39 | ; 40 | 41 | : csv_next_input_line 42 | csv_input_file @ freadline # ( result_str num_bytes ) 43 | dup -1 = 44 | if 45 | swap drop return # will return -1. Caller can catch. 46 | else 47 | dup _csv_init_col_buf 48 | over + # ( result_str end_of_str ) 49 | 1 - # ( result_str end_of_str-1 ) 50 | 0 1 memset # replace newline with \0 51 | drop # ( result_str ) 52 | csv_line_idx @ 1 + csv_line_idx ! 53 | endif 54 | ; 55 | 56 | : csv_column_loop 57 | dup csv_sep @ strfind 58 | dup 0 = 59 | if 60 | drop 61 | return 62 | else 63 | 2dup swap 64 | - # ( start end diff ) 65 | csv_col_idx @ csv_col_desired @ = 66 | if 67 | csv_col_buf @ # ( start end diff buf ) 68 | 3 pick 2 pick mempcpy # ( start end diff buf+diff ) 69 | 0 1 memset 70 | swap 71 | - # ( start end buf ) 72 | swap drop swap drop # ( buf ) 73 | return 74 | else 75 | drop # ( start end ) 76 | swap drop # ( end ) 77 | 1 + # ( end+1 ) -- advance the string pointer 78 | csv_col_idx @ 1 + csv_col_idx ! 79 | csv_column_loop 80 | endif 81 | endif 82 | ; 83 | 84 | : csv_find_col_x 85 | 0 csv_col_idx ! 86 | csv_col_desired ! 87 | csv_column_loop 88 | ; 89 | 90 | : csv_cleanup 91 | csv_col_buf @ 92 | dup 0 = if drop else free endif 93 | csv_input_file @ 94 | dup 0 = if drop else fclose endif 95 | csv_output_file @ 96 | dup 0 = if drop else fclose endif 97 | clear 98 | ; 99 | -------------------------------------------------------------------------------- /lib/deprecated_stack.dc: -------------------------------------------------------------------------------- 1 | # These traditional FORTH stack ops are inefficent and 2 | # confusing to use. You are highly encouraged in dclang 3 | # to defy the FORTH purists who mock `pick` and using the 4 | # stack(s) as a local array. One of the things that leads to 5 | # people hating FORTH and other stack languages is the confusion 6 | # caused by stack-dancing. Eventually, these will be deprecated 7 | # once they can be removed entirely from the library and examples 8 | # that already use them. In fact, in dclang, you are encouraged 9 | # to avoid stack-dancing and to simply push what you want on the stack 10 | # in the order you want it - by, in fact, using the stack and the 11 | # save-stack as "arrays", as needed. 12 | # 13 | # Clarity, not obfuscation, will be the underlying philosophy of `dclang`. 14 | 15 | # less bad 16 | : nip swap drop ; 17 | 18 | : tuck swap over ; 19 | 20 | # really bad 21 | : rot 22 | svpush svpush svpush 23 | 1 svpick 2 svpick 0 svpick 24 | svdrop svdrop svdrop 25 | ; 26 | 27 | : -rot 28 | svpush svpush svpush 29 | 2 svpick 0 svpick 1 svpick 30 | svdrop svdrop svdrop 31 | ; 32 | 33 | # abysmal 34 | : 2swap 35 | svpush svpush svpush svpush 36 | 2 svpick 3 svpick 0 svpick 1 svpick 37 | svdrop svdrop svdrop svdrop 38 | ; 39 | 40 | : 2rot 41 | svpush svpush svpush svpush svpush svpush 42 | 2 svpick 3 svpick 4 svpick 5 svpick 0 svpick 1 svpick 43 | svdrop svdrop svdrop svdrop svdrop svdrop 44 | ; 45 | 46 | : -2rot 47 | svpush svpush svpush svpush svpush svpush 48 | 4 svpick 5 svpick 0 svpick 1 svpick 2 svpick 3 svpick 49 | svdrop svdrop svdrop svdrop svdrop svdrop 50 | ; 51 | -------------------------------------------------------------------------------- /lib/fractions.dc: -------------------------------------------------------------------------------- 1 | ########################################################################### 2 | # Fraction words # 3 | # # 4 | # Numerators and denominators are laid out on the stack in `n d` "pairs". # 5 | ########################################################################### 6 | 7 | : gcd swap over % dup 0 <> if gcd else drop endif ; 8 | 9 | : simplify { n d } # ( n d - n d ) 10 | n d gcd n over / swap d swap / 11 | ; 12 | 13 | : fracadd { n1 d1 n2 d2 } # ( n1 d1 n2 d2 - n d ) 14 | n1 d2 * n2 d1 * + d1 d2 * simplify 15 | ; 16 | 17 | : fracsub swap -1 * swap fracadd ; 18 | 19 | : fracmul { n1 d1 n2 d2 } # ( n1 d1 n2 d2 - n d ) 20 | n1 n2 * d1 d2 * simplify 21 | ; 22 | 23 | : fracdiv swap fracmul ; 24 | 25 | : fracmediant { n1 d1 n2 d2 } # ( n1 d1 n2 d2 - n d ) 26 | n1 n2 + d1 d2 + 27 | ; 28 | -------------------------------------------------------------------------------- /lib/gcd.dc: -------------------------------------------------------------------------------- 1 | : ?dup 2 | dup 0 = 3 | if else dup endif 4 | ; 5 | 6 | : gcd 7 | ?dup 8 | if 9 | swap over % 10 | gcd 11 | endif 12 | ; 13 | 14 | 784 48 gcd 16 = assert 15 | -------------------------------------------------------------------------------- /lib/http_server.dc: -------------------------------------------------------------------------------- 1 | "string.dc" import 2 | 3 | # some important constants 4 | 7651 const HTTP_PORT 5 | 65536 const HTTP_BUFSIZE 6 | # create a listening server and its buffer 7 | var srv_queue HTTP_PORT tcplisten srv_queue ! 8 | var connbuf HTTP_BUFSIZE mkbuf connbuf ! 9 | var received 10 | # connection handle lives in this net variable 11 | var accepted_conn 12 | # incoming request string variables 13 | var method 14 | var path_and_query 15 | var httpversion 16 | var path 17 | var query 18 | # strtok string-splitting token storage 19 | var _split1 20 | var _split2 21 | var _split_hash 22 | var _split_q 23 | # response headers 24 | "HTTP/1.1 200 OK\nContent-Type: text/plain\n\n" const HTTP_TEXT_HEADER 25 | "HTTP/1.1 200 OK\nContent-Type: text/html\n\n" const HTTP_HTML_HEADER 26 | # (for CGI-only apps) 27 | "Content-Type: text/plain\n" const :CONTENT_TEXT 28 | "Content-Type: text/html\n" const :CONTENT_HTML 29 | # other string constants 30 | "?" const :QMARK 31 | ": " const :COLON 32 | " " const :SPACE 33 | "=" const :EQUALS 34 | "&" const :AMPERSAND 35 | "
\n" const :HTML_BR 36 | "\n\n" const :HTML_BODY_OPEN 37 | "\n\n" const :HTML_BODY_CLOSE 38 | 39 | # getters and setters 40 | : get_accepted_conn accepted_conn @ ; 41 | : get_connbuf connbuf @ ; 42 | : get_received received @ ; 43 | : zerobuf get_connbuf 0 HTTP_BUFSIZE memset ; 44 | : get_method method @ ; 45 | : get_path_and_query path_and_query @ ; 46 | : get_httpversion httpversion @ ; 47 | : get_path path @ ; 48 | : get_query query @ ; 49 | 50 | ################## 51 | # relevant words # 52 | ################## 53 | 54 | : read_request 55 | srv_queue @ tcpaccept accepted_conn ! 56 | get_accepted_conn zerobuf HTTP_BUFSIZE read drop 57 | get_connbuf strdup received ! 58 | ; 59 | 60 | ############################# 61 | # `process_request` helpers # 62 | ############################# 63 | : split_request_topline 64 | get_received :SPACE _split1 strtok method ! 65 | 0 :SPACE _split1 strtok path_and_query ! 66 | 0 :SPACE _split1 strtok httpversion ! 67 | ; 68 | 69 | : split_path_and_query 70 | get_path_and_query :QMARK _split2 strtok path ! 71 | 0 :QMARK _split2 strtok query ! 72 | ; 73 | 74 | : hash_assign 75 | dup :EQUALS strfind 76 | if 77 | :EQUALS _split_hash strtok 78 | 0 :EQUALS _split_hash strtok 79 | swap h! 80 | else 81 | drop 82 | endif 83 | 0 _split_hash ! 84 | ; 85 | 86 | : _split_query_string_helper 87 | 0 :AMPERSAND _split_q strtok dup 88 | if 89 | strdup hash_assign 90 | _split_query_string_helper 91 | else 92 | drop 93 | endif 94 | ; 95 | 96 | : split_query_string 97 | get_query 98 | if 99 | get_query 100 | strdup :AMPERSAND _split_q strtok dup 101 | if 102 | strdup hash_assign 103 | _split_query_string_helper 104 | else 105 | drop 106 | endif 107 | endif 108 | ; 109 | 110 | ################################# 111 | # End `process_request` helpers # 112 | ################################# 113 | 114 | ##################### 115 | # `process_request` # 116 | ##################### 117 | : process_request 118 | split_request_topline 119 | split_path_and_query 120 | split_query_string 121 | ; 122 | 123 | : _print_hash_table_helper 124 | 1 + dup 125 | hkeys dup 126 | if 127 | dup 128 | get_query swap strfind 129 | if 130 | svpop swap dup svpush 131 | str+ :COLON str+ svpop h@ str+ :HTML_BR str+ 132 | svpush 133 | else 134 | drop 135 | endif 136 | _print_hash_table_helper 137 | else 138 | drop svpop 139 | endif 140 | ; 141 | 142 | : print_hash_table 143 | get_query 144 | if 145 | svpush -1 _print_hash_table_helper 146 | endif 147 | ; 148 | 149 | : copy_header_to_buffer 150 | # ( zeroed_buf ) 151 | HTTP_HTML_HEADER str+ 152 | :HTML_BODY_OPEN str+ 153 | ; 154 | 155 | : copy_footer_to_buffer 156 | :HTML_BODY_CLOSE str+ 157 | ; 158 | 159 | : write_response 160 | "custom_response" exec # Each bit of server code using this framework 161 | # needs an implementation of `custom_response` 162 | get_accepted_conn get_connbuf dup strlen write drop 163 | get_accepted_conn close drop 164 | get_received free 165 | ; 166 | 167 | ###################### 168 | # MAIN LISTENER LOOP # 169 | ###################### 170 | : _acceptloop 171 | read_request # reads in the request 172 | process_request # does the basic necessities like splitting the page and query 173 | write_response # send the response 174 | _acceptloop # infinite "wait for request" loop 175 | ; 176 | 177 | : acceptloop 178 | "running acceptloop; serving on port " print HTTP_PORT . cr 179 | _acceptloop 180 | # close down connection 181 | srv_queue @ close drop 182 | "Connection closed." print cr 183 | ; 184 | -------------------------------------------------------------------------------- /lib/linked_list.dc: -------------------------------------------------------------------------------- 1 | var __private_ll_token_holder__ 2 | 3 | " " const :blank 4 | 5 | : _list_init_nums_helper # ( list ) -- ( list ) 6 | null :blank __private_ll_token_holder__ strtok 7 | dup null = 8 | if 9 | drop 10 | else 11 | tonum over swap lpush 12 | _list_init_nums_helper 13 | endif 14 | ; 15 | 16 | : _lmap_helper 17 | over 0 svpick _lnext <> 18 | if 19 | 0 svpick 0 l@ # grab next cell data 20 | over exec # execute the word 21 | 1 svpick swap lpush # push the result to the new list 22 | svpop _lnext svpush # advance the list cell 23 | _lmap_helper 24 | else 25 | 2drop svdrop # get rid of most of the working data 26 | svpop # leave new list on stack 27 | endif 28 | ; 29 | 30 | : _lshow_helper 31 | 2dup _lnext <> 32 | if 33 | dup 0 l@ . 34 | _lnext 35 | _lshow_helper 36 | else 37 | 2drop cr 38 | endif 39 | ; 40 | 41 | ############## 42 | # Public API # 43 | ############## 44 | 45 | : linit_nums # ( all_nums_str ) -- ( list ) 46 | ############################################################ 47 | # Produce a list of nums based on a space-delimited string # 48 | # of numbers # 49 | ############################################################ 50 | depth 1 < 51 | if 52 | "linit_nums: need on the stack." print cr 53 | return 54 | endif 55 | lmake swap 56 | :blank __private_ll_token_holder__ strtok 57 | dup null = 58 | if 59 | drop 60 | else 61 | tonum over swap lpush 62 | _list_init_nums_helper 63 | endif 64 | ; 65 | 66 | : lmap # ( list word_str_for_eval ) -- ( new_list ) 67 | # Takes an existing list and a dclang word (as a string) 68 | # and returns a new list where the data from the existing list 69 | # gets evaluated by the word. The word should take a single 70 | # argument. 71 | depth 2 < 72 | if 73 | "lmap: need on the stack." print cr 74 | return 75 | endif 76 | lmake svpush 77 | over svpush 78 | _lmap_helper # enter the helper loop 79 | ; 80 | 81 | : lshow # ( list ) -- () 82 | depth 1 < 83 | if 84 | "lshow: need on the stack." print cr 85 | return 86 | endif 87 | dup 88 | _lshow_helper 89 | ; 90 | -------------------------------------------------------------------------------- /lib/logging.dc: -------------------------------------------------------------------------------- 1 | "string.dc" import 2 | 3 | var logfile_name 4 | var logfile 5 | 6 | 128 const :LOGLINE_SIZE 7 | :LOGLINE_SIZE mkbuf const :LOGLINE 8 | "%FT%T " const :TIMESTAMP_FORMAT 9 | "\n" const :NL 10 | 11 | : open_log 12 | logfile_name ! 13 | logfile_name @ "a" fopen 14 | logfile ! 15 | ; 16 | 17 | : to_log 18 | # reset line buf to zeroes 19 | :LOGLINE 0 :LOGLINE_SIZE memset drop 20 | # add timestamp 21 | :LOGLINE epoch :TIMESTAMP_FORMAT epoch->dt dup strlen mempcpy 22 | # add message 23 | swap dup strlen mempcpy 24 | # add newline 25 | :NL dup strlen mempcpy 26 | # write out and flush to the logfile 27 | :LOGLINE dup strlen logfile @ fwrite 28 | logfile @ fflush 29 | ; 30 | 31 | : close_log 32 | logfile @ fclose 33 | ; 34 | -------------------------------------------------------------------------------- /lib/math.dc: -------------------------------------------------------------------------------- 1 | "digit_sum: need and on the stack!" const :DIGIT_SUM_ERROR 2 | 3 | : isneg 1 swap / 0 < ; 4 | 5 | : absmod 6 | dup svpush 7 | % 8 | dup 0 < 9 | if 10 | svpop + 11 | else 12 | svdrop 13 | endif 14 | ; 15 | 16 | : divmod 17 | 2dup % svpush 18 | / floor svpop 19 | ; 20 | 21 | : _digit_sum_helper 22 | over 0 > 23 | if 24 | dup svpush 25 | 2dup % 26 | svpush 27 | / floor 28 | swap svpop 29 | + 30 | swap svpop 31 | _digit_sum_helper 32 | else 33 | 2drop 34 | endif 35 | ; 36 | 37 | : digit_sum 38 | depth 2 < 39 | if 40 | :DIGIT_SUM_ERROR print cr 41 | return 42 | endif 43 | svpush svpush 44 | 0 45 | svpop svpop 46 | _digit_sum_helper 47 | ; 48 | 49 | ################### 50 | # Digit expansion # 51 | ################### 52 | 53 | : make_digit_expansion_struct var 3 allot ; 54 | 55 | : _get_base @ ; 56 | : _set_base ! ; 57 | : _get_div 1 + @ ; 58 | : _set_div 1 + ! ; 59 | : _get_remainder 2 + @ dup 0 = if drop 1 endif ; 60 | : _set_remainder 2 + ! ; 61 | 62 | : gen_digit_expansion 63 | # ( data_struct ) 64 | dup svpush # ( ds ) ( ds ) 65 | _get_remainder # ( rem ) ( ds ) 66 | 0 svpick # ( rem ds ) ( ds ) 67 | _get_base # ( rem base ) ( ds ) 68 | * # ( rem*base ) ( ds ) 69 | 0 svpick # ( rem*base ds ) ( ds ) 70 | _get_div # ( rem*base div ) ( ds ) 71 | divmod # ( quot new_rem ) ( ds ) 72 | svpop # ( quot new_rem ds ) ( ) 73 | _set_remainder # ( quot ) 74 | ; 75 | -------------------------------------------------------------------------------- /lib/midi.dc: -------------------------------------------------------------------------------- 1 | "PORTMIDI_IN_DEVNUM" const :PORTMIDI_IN_DEVNUM 2 | "PORTMIDI_OUT_DEVNUM" const :PORTMIDI_OUT_DEVNUM 3 | 4 | # These will be used again (unused ATM) once MIDI read functionality 5 | # is re-implemented via `portmidi` 6 | var midi_ctl_slots 128 allot 7 | var midi_channel_last_note 16 allot 8 | 9 | # Set the default variable 'midi_edo' to 31. Can be changed by the user later... 10 | var midi_edo 11 | 31 midi_edo ! 12 | 13 | : midi_shutdown 14 | _pm_close 15 | _pm_terminate 16 | ; 17 | 18 | : check_mididev 19 | # Set to stderr printing 20 | seterr 21 | # First, list MIDI devices found: 22 | cr "Here are your available MIDI devices:" print cr 23 | _pm_list cr 24 | # Try to set output device 25 | :PORTMIDI_OUT_DEVNUM envget dup 26 | 0 = 27 | if 28 | :PORTMIDI_OUT_DEVNUM print " is not set in your environment!" print cr 29 | "MIDI output functionality will not work." print cr 30 | "If you need this, please exit from dclang, set that value, and try again!" print cr 31 | drop 32 | else 33 | tonum 34 | "Opening output device number: " print dup . cr 35 | _pm_open_out 36 | endif 37 | # Try to set input device 38 | :PORTMIDI_IN_DEVNUM envget dup 39 | 0 = 40 | if 41 | :PORTMIDI_IN_DEVNUM print " is not set in your environment!" print cr 42 | "MIDI input functionality will not work." print cr 43 | "If you need this, please exit from dclang, set that value, and try again!" print cr 44 | drop 45 | else 46 | tonum 47 | "Opening input device number: " print dup . cr 48 | _pm_open_in 49 | endif 50 | # Reset to stdout printing 51 | setout 52 | ; 53 | 54 | check_mididev 55 | 56 | # update midictl state by polling for incoming messages 57 | : refresh_midictl 58 | _pm_read 59 | 0xff and 0xb0 = 60 | if 61 | midi_ctl_slots + ! 62 | else 63 | 2drop 64 | endif 65 | ; 66 | 67 | # This is the main API for grabbing a controller variable 68 | # ( ctrlnum -- sig ) 69 | : midictl midi_ctl_slots + @ ; 70 | 71 | # basic connection words 72 | : send_midi _pm_ws ; 73 | 74 | : send_midi_reverse _pm_wsr ; 75 | 76 | # useful for when things go nuts! 77 | : panic 78 | 128 0 1 79 | for 80 | 0x80 i 0 81 | send_midi 82 | 0.01 83 | sleep 84 | next 85 | ; 86 | 87 | # words for microtonal/alternate tuning musical applications 88 | 89 | : _bend_to_MSB_LSB_bytes 90 | # a helper function. Given a top-of-stack 14-byte integer MIDI 91 | # pitch-bend amount, replace the top-of-stack with two bytes, 92 | # the top-of-stack being the LSB (least significant byte) and the next 93 | # being the most significant byte 94 | dup 7 >> 95 | swap 0x7f and 96 | ; 97 | 98 | : edo_degree_to_midi 99 | # input stack (rightmost is "top": 100 | # ( volume, edo_degree, midi_channel ) 101 | # 102 | # Take an input edo degree, calculate the octave fraction against the global 103 | # EDO constant, which must be declared ahead-of-time, and emit midi bytes 104 | # to the configured MIDI output device which will sound the correct pitch 105 | # Middle-C is assumed to be "0" in all EDOs, so use negative numbers to go 106 | # below middle-C. 107 | svpush # sequester the channel number away 108 | midi_edo @ / 12 * # scale to 12-EDO with fractional remainder 109 | 60.5 + # shift to middle-C in MIDI, also overshoot fractional 110 | dup floor swap # part on purpose so we can fetch the floor closest 111 | # to the proper midi number; set aside by swap 112 | over - 0.5 - # grab fractional part and cancel previous 0.5 shift 113 | 4096 * # scale by positive half step of bend 114 | 8192 + # center zero at halfway for +/- 115 | # stack now looks like: 116 | # ( volume midi_note_number midi_bend ) ( midi_channel ) 117 | _bend_to_MSB_LSB_bytes 118 | # now we have 119 | # ( volume midi_note_number bend_MSB bend_LSB ) ( midi_channel ) 120 | # choose what to do based on if there is volume, i.e.: if the volume 121 | # is 0, we don't need to worry about bemd, etc. and just send the 122 | # simple note info 123 | 3 pick 0 = 124 | if 125 | 2drop # drop the bend 126 | svpop 0x90 + 127 | send_midi_reverse 128 | else 129 | # send the bend 130 | 0 svpick 0xE0 + 131 | send_midi_reverse 132 | # send the note 133 | svpop 0x90 + 134 | send_midi_reverse 135 | endif 136 | ; 137 | -------------------------------------------------------------------------------- /lib/permutations.dc: -------------------------------------------------------------------------------- 1 | ################################################################################ 2 | # The https://en.wikipedia.org/wiki/Steinhaus-Johnson-Trotter_algorithm # 3 | # (AKA "SJT") # 4 | # # 5 | # An implementation of a generic "change-ringing" type permutation # 6 | # algorithm that has a "generator-like" behavior, i.e. the list of # 7 | # unfolding changes doesn't sit in memory all at once, but is called via # 8 | # a word `next_permutation` to deliver the "next" permuted item. # 9 | # # 10 | # A "permutation object" will be a space in memory that the user creates # 11 | # manually via `create` or via a convenience word, "setup_permutation" # 12 | # that, given a single item representing a number of items to permute, # 13 | # will return the appropriate structure for the user, with sensible # 14 | # defaults. # 15 | # # 16 | # The layout of memory cells: # 17 | # # 18 | # num_values | output_index | highest_val | highest_val_slot | # 19 | # val0 | val1 | val2 | ... # 20 | # # 21 | # "num_values" represents the number of values starting with "val0" # 22 | # that are actually being put through permutation. So, permuting # 23 | # [ 0, 1, 2, 3 ] would mean this would be set to 4. # 24 | ################################################################################ 25 | 26 | "math.dc" import # grab `isneg` definition 27 | 28 | : setup_permutation 29 | here svpush 30 | dup , 0 , 0 , 0 , # size, output_idx, highest_val, highest_val_slot 31 | times -1 i * , again # values and sign for direction 32 | svpop 33 | ; 34 | 35 | : show_permutation_data 36 | dup @ 4 + 37 | times dup i + @ . again 38 | drop 39 | ; 40 | 41 | : show_permutation 42 | dup @ times 43 | dup 4 + i + @ abs . 44 | again 45 | cr drop 46 | ; 47 | 48 | : _return_current_cell # (pobj_addr -- answer pobj_addr) 49 | dup 1 + @ 4 + over + @ abs swap 50 | ; 51 | 52 | : _advance_output_index # (pobj_addr -- pobj_addr) 53 | dup 1 + dup @ 1 + 2 pick @ % swap ! 54 | ; 55 | 56 | : _needs_permuting? dup 1 + @ 0 = ; # (pobj_addr -- pobj_addr bool) 57 | : _get_perm_val_i over 4 + + @ ; # (pobj_addr i -- pobj_addr perm_value) 58 | : _set_perm_val_i svpush over 4 + svpop + ! ; # (pobj_addr val i -- pobj_addr) 59 | : _get_curr_high_val dup 2 + @ ; # (pobj_addr -- pobj_addr high_value) 60 | : _set_curr_high_val over 2 + ! ; # (pobj_addr v -- pobj_addr) 61 | : _get_curr_high_slot dup 3 + @ ; # (pobj_addr -- pobj_addr high_slot) 62 | : _set_curr_high_slot over 3 + ! ; # (pobj_addr -- pobj_addr high_slot) 63 | 64 | : _common_compare 65 | # (previous arg to `and` here from caller) 66 | 0 svpick 67 | 2 pick _get_curr_high_val swap drop 68 | > 69 | and 70 | if # update the current high val _and_ its slot number 71 | svpop _set_curr_high_val 72 | i _set_curr_high_slot 73 | else 74 | svdrop 75 | endif 76 | ; 77 | 78 | : _set_largest_mobile_cell # (pobj_addr -- pobj_addr) 79 | # Set the highest mobile cell on the `pobj` memory "object". 80 | # We'll use the `sv` stack to track the highest absolute value encountered. 81 | # If a higher value is encountered, update. If not, do nothing. 82 | 0 _set_curr_high_val # (start out with a minimal value) 83 | dup @ times 84 | # Test the extremes: if `i` is cell `0` and `isneg` is `true`, this cell 85 | # cannot be considered. Ditto the uppermost cell being positive. 86 | i _get_perm_val_i isneg 87 | if # cell value is negative 88 | i 0 = 89 | if # first cell and negative, skip 90 | again 91 | else # normal case for negative 92 | i _get_perm_val_i abs dup svpush 93 | over i 1 - _get_perm_val_i abs swap drop 94 | > 95 | _common_compare 96 | endif 97 | else # cell value is positive 98 | i over @ 1 - <> 99 | if # normal case for positive 100 | i _get_perm_val_i abs dup svpush 101 | over i 1 + _get_perm_val_i abs swap drop 102 | > 103 | _common_compare 104 | endif 105 | endif 106 | again 107 | ; 108 | 109 | : _setup_swap 110 | _get_curr_high_slot dup svpush _get_perm_val_i 111 | isneg 112 | if 113 | svpop dup 1 - 114 | else 115 | svpop dup 1 + 116 | endif 117 | swap 4 + 118 | swap 4 + 119 | 2 pick + swap 120 | 2 pick + swap 121 | ; 122 | 123 | : _pmswap 2dup @ svpush @ swap ! svpop swap ! ; 124 | 125 | : _swap_neighbor_cells 126 | _setup_swap 127 | _pmswap 128 | ; 129 | 130 | : _reverse_direction_of_greater_values 131 | _get_curr_high_val abs svpush 132 | dup @ times 133 | i _get_perm_val_i abs 134 | 0 svpick 135 | > 136 | if 137 | i _get_perm_val_i -1 * 138 | i _set_perm_val_i 139 | endif 140 | again 141 | svdrop 142 | ; 143 | 144 | ###################### 145 | # The main API words # 146 | ###################### 147 | 148 | : next_permutation_item 149 | # After setting up a `pobj`, call this with ` @ next_permutation_item 150 | # This is a generator that feeds one value at a time 151 | _return_current_cell 152 | _advance_output_index 153 | _needs_permuting? 154 | if 155 | _set_largest_mobile_cell 156 | _swap_neighbor_cells 157 | _reverse_direction_of_greater_values 158 | endif 159 | drop 160 | ; 161 | 162 | : print_next_permutation 163 | # Only displays all X values in a row 164 | dup show_permutation 165 | _set_largest_mobile_cell 166 | _swap_neighbor_cells 167 | _reverse_direction_of_greater_values 168 | drop 169 | ; 170 | -------------------------------------------------------------------------------- /lib/primes.dc: -------------------------------------------------------------------------------- 1 | : is-2-3-5-7? 2 | dup dup # n n n 3 | 2 = # n n bool 4 | swap dup # n bool n n 5 | 3 = # n bool n bool 6 | swap dup # n bool bool n n 7 | 5 = # n bool bool n bool 8 | swap # n bool bool bool n 9 | 7 = # n bool bool bool bool 10 | or or or # n bool 11 | ; 12 | 13 | : check-higher-than-49 14 | dup # n n 15 | sqrt ceil 1 + 6 / # n n 16 | ceil 6 * 12 6 for 17 | dup i 1 - % 0 = 18 | over i 1 + % 0 = 19 | or if 20 | drop 0 exitfor 21 | else 22 | next drop 1 23 | endif 24 | ; 25 | 26 | : is-not-div-otherwise? 27 | dup # n n 28 | 49 < if # n bool 29 | drop 1 30 | else 31 | check-higher-than-49 32 | endif 33 | ; 34 | 35 | : is-not-div-by-2-3-5-7? 36 | dup # n n 37 | 2 % 0 = # n bool 38 | over # n bool n 39 | 3 % 0 = # n bool bool 40 | or over # n bool n 41 | 5 % 0 = # n bool bool 42 | or over # n bool n 43 | 7 % 0 = # n bool bool 44 | or 45 | if 46 | drop 0 47 | else 48 | is-not-div-otherwise? 49 | endif 50 | ; 51 | 52 | : is-prime 53 | is-2-3-5-7? 54 | if 55 | drop 1 56 | else 57 | is-not-div-by-2-3-5-7? 58 | endif 59 | ; 60 | -------------------------------------------------------------------------------- /lib/redis.dc: -------------------------------------------------------------------------------- 1 | #################################################################### 2 | # Still in early stages, but the idea is to implement a Redis API # 3 | # # 4 | # 2022-11-05: updated with a refactor to not use string templates, # 5 | # but rather, append elements continuously to the r/w # 6 | # buffer. The first substring added is a 'header'. # 7 | # # 8 | # 2025-03-24: change in API for connecting. You can set envvars # 9 | # for REDIS_HOST, REDIS_PORT, and REDISCLI_AUTH (pw). # 10 | # If unset in the env, defaults will be used, which # 11 | # are 'localhost' and port 6379. `redis_connect` will # 12 | # give textual feedback about the connection being # 13 | # made, too. # 14 | # # 15 | # TODO: There is a limit now for buffer size, and thus the code is # 16 | # usuable for 90% of cases where there are small keys/vals, # 17 | # but it not yet particularly robust for dynamically and # 18 | # arbitrary message length. (Buffer size now is 1024 bytes.) # 19 | #################################################################### 20 | 21 | "string.dc" import 22 | 23 | # constants 24 | 1024 const REDIS_BUFSIZE 25 | REDIS_BUFSIZE mkbuf const REDIS_BUFFER 26 | 27 | # token_save space for `strtok` variable; socket pointer variable 28 | var token_save 29 | var redis_socket -1 redis_socket ! 30 | 31 | # various redis function API string 'headers' 32 | "\r\n" const :RN 33 | "\r\n$" const :RN$ 34 | "*2\r\n$4\r\nAUTH\r\n$" const :REDIS_AUTH_HEADER 35 | "*3\r\n$3\r\nSET\r\n$" const :REDIS_SET_HEADER 36 | "*2\r\n$3\r\nGET\r\n$" const :REDIS_GET_HEADER 37 | "*2\r\n$4\r\nKEYS\r\n$" const :REDIS_SEARCH_HEADER 38 | "*2\r\n$3\r\nDEL\r\n$" const :REDIS_DELETE_HEADER 39 | 40 | ###################################### 41 | # buffer and tcp communication words # 42 | ###################################### 43 | 44 | : _zero_redis_buffer 45 | REDIS_BUFFER 0 REDIS_BUFSIZE memset 46 | ; 47 | 48 | : _write_redis_buffer 49 | redis_socket @ 50 | REDIS_BUFFER 51 | #_get_msglen 52 | dup strlen 53 | write 54 | drop 55 | ; 56 | 57 | : _read_redis_buffer 58 | _zero_redis_buffer 59 | redis_socket @ swap 60 | REDIS_BUFSIZE 61 | read 62 | drop 63 | REDIS_BUFFER 64 | ; 65 | 66 | : _redis_write_read 67 | _write_redis_buffer 68 | _read_redis_buffer 69 | ; 70 | 71 | : _redis_auth 72 | "REDISCLI_AUTH" envget dup 73 | 0 = if 74 | drop 75 | return # If no password is set, do nothing 76 | endif 77 | svpush 78 | _zero_redis_buffer 79 | :REDIS_AUTH_HEADER str+ 80 | 0 svpick strlen tostr str+ 81 | :RN str+ 82 | svpop str+ 83 | :RN str+ 84 | drop 85 | _redis_write_read 86 | # TODO: Check authentication response 87 | drop 88 | ; 89 | 90 | ######################### 91 | # MAIN PUBLIC API WORDS # 92 | ######################### 93 | 94 | : redis_connect 95 | "REDIS_HOST" envget dup 96 | 0 = if 97 | drop 98 | "localhost" 99 | endif 100 | "REDIS_PORT" envget dup 101 | 0 = if 102 | drop 103 | "6379" 104 | endif 105 | tonum 106 | "REDIS_SILENT_CONNECT" envget 107 | 0 = if 108 | 2dup swap 109 | "Connecting to redis using host: " print print 110 | " and port " print . cr 111 | endif 112 | tcpconnect redis_socket ! 113 | _redis_auth 114 | ; 115 | 116 | : redis_set 117 | depth 2 < 118 | if 119 | "redis_set needs on the stack!" print cr 120 | return 121 | endif 122 | swap svpush svpush 123 | _zero_redis_buffer 124 | :REDIS_SET_HEADER str+ 125 | 0 svpick strlen tostr str+ 126 | :RN str+ 127 | svpop str+ 128 | :RN$ str+ 129 | 0 svpick strlen tostr str+ 130 | :RN str+ 131 | svpop str+ 132 | :RN str+ 133 | drop 134 | _redis_write_read 135 | # TODO: actually check status 136 | drop 137 | ; 138 | 139 | : redis_get 140 | depth 1 < 141 | if 142 | "redis_get needs on the stack!" print cr 143 | return 144 | endif 145 | svpush 146 | _zero_redis_buffer 147 | :REDIS_GET_HEADER str+ 148 | 0 svpick strlen tostr str+ 149 | :RN str+ 150 | svpop str+ 151 | :RN str+ 152 | drop 153 | # for now, ignore the status string and length which represents 154 | # the first line of the response. Our key's value sits in the 155 | # second line. 156 | _redis_write_read :RN token_save strtok drop 157 | null :RN token_save strtok 158 | ; 159 | 160 | : redis_keys 161 | depth 1 < 162 | if 163 | "redis_keys needs on the stack!" print cr 164 | "You can try using something like:" print cr cr 165 | "\"*\" redis_keys print cr" print cr 166 | return 167 | endif 168 | svpush 169 | _zero_redis_buffer 170 | :REDIS_SEARCH_HEADER str+ 171 | 0 svpick strlen tostr str+ 172 | :RN str+ 173 | svpop str+ 174 | :RN str+ 175 | drop 176 | _redis_write_read 177 | ; 178 | 179 | : redis_del 180 | depth 1 < 181 | if 182 | "redis_del needs on the stack!" print cr 183 | return 184 | endif 185 | svpush 186 | _zero_redis_buffer 187 | :REDIS_DELETE_HEADER str+ 188 | 0 svpick strlen tostr str+ 189 | :RN str+ 190 | svpop str+ 191 | :RN str+ 192 | drop 193 | _redis_write_read 194 | # TODO: actually check status 195 | drop 196 | ; 197 | -------------------------------------------------------------------------------- /lib/sequencer.dc: -------------------------------------------------------------------------------- 1 | ######################## 2 | # Simple Sequencer API # 3 | ######################## 4 | 5 | ################################################################# 6 | # These are helpers, user should only call `seq_signal` (below) # 7 | ################################################################# 8 | 9 | : _seq_ptr_incr { seq } 10 | seq 1 + @ 1 + 11 | seq @ 12 | % 13 | seq 1 + 14 | ! 15 | ; 16 | 17 | : _seq_cur_val { seq } 18 | seq 1 + @ 3 + seq + @ 19 | ; 20 | 21 | : seq_cnt_incr { seq } 22 | seq 2 + @ 1 + 23 | dup 24 | seq _seq_cur_val 25 | < 26 | if 27 | seq 2 + ! 28 | else 29 | drop 30 | 0 seq 2 + ! 31 | seq _seq_ptr_incr 32 | endif 33 | ; 34 | 35 | ############### 36 | # End helpers # 37 | ############### 38 | 39 | ###################################### 40 | # The actual word a user should call # 41 | ###################################### 42 | 43 | : seq_signal { seq } 44 | seq 2 + @ 0 = 45 | if 46 | 1 47 | else 48 | 0 49 | endif 50 | seq seq_cnt_incr 51 | ; 52 | 53 | # Example sequencer object 54 | create example_seq 4 , 0 , 0 , # length, pointer, counter 55 | 4 , 2 , 2 , 3 , # sequence_data 56 | 57 | # In the example above `example_seq seq_signal .`, called repeatedly, would return: 58 | # 1 0 0 0 1 0 1 0 1 0 0 .... b/c 4 2 2 3 is the data. 59 | 60 | ##################### 61 | # An array iterator # 62 | ##################### 63 | 64 | : iterator { iter_array } 65 | # `iter_array` should have: length, pointer, ... 66 | iter_array 1 + @ # see where we're pointing now 67 | iter_array @ # grab the length 68 | % # wrap by the length for an index 69 | # deal with update first 70 | dup # duplicate for updating next iteration 71 | 1 + # increment 72 | iter_array 1 + # pointer slot 73 | ! # pointer updated for next go 'round 74 | # back to business 75 | iter_array 2 + # use previous `absmod` result on stack to index in 76 | + @ # dereference; this is the data left on stack 77 | ; 78 | -------------------------------------------------------------------------------- /lib/shuffle.dc: -------------------------------------------------------------------------------- 1 | : _cell_swap 2 | 2dup @ svpush @ swap ! svpop swap ! 3 | ; 4 | 5 | : shuffle_cells 6 | # ( starting_cell size ) 7 | -1 8 | swap 1 - 9 | -1 10 | for 11 | dup i + 12 | over rand i * floor + 13 | _cell_swap 14 | next 15 | drop 16 | ; 17 | -------------------------------------------------------------------------------- /lib/sqlite3.dc: -------------------------------------------------------------------------------- 1 | : sqlite3_open 2 | depth 1 < 3 | if 4 | "`sqlite3_open` -- You need a on the stack" print cr 5 | return 6 | endif 7 | _sqlite_open 8 | ; 9 | 10 | : sqlite3_prepare 11 | depth 2 < 12 | if 13 | "`sqlite3_prepare` -- You need on the stack" print cr 14 | return 15 | endif 16 | _sqlite_prepare 17 | ; 18 | 19 | : sqlite3_step 20 | depth 1 < 21 | if 22 | "`sqlite3_step` -- You need a on the stack" print cr 23 | return 24 | endif 25 | _sqlite_step 26 | ; 27 | 28 | : sqlite3_column 29 | depth 2 < 30 | if 31 | "`sqlite3_column` -- You need on the stack" print cr 32 | return 33 | endif 34 | _sqlite_column 35 | ; 36 | 37 | : sqlite3_finalize 38 | depth 1 < 39 | if 40 | "`sqlite3_finalize` -- You need a on the stack" print cr 41 | return 42 | endif 43 | _sqlite_finalize 44 | ; 45 | 46 | : sqlite3_exec 47 | depth 2 < 48 | if 49 | "`sqlite3_exec` -- You need an on the stack" print cr 50 | return 51 | endif 52 | _sqlite_exec 53 | ; 54 | 55 | : sqlite3_close 56 | depth 1 < 57 | if 58 | "`sqlite3_close` -- You need an on the stack" print cr 59 | return 60 | endif 61 | _sqlite_close 62 | ; 63 | -------------------------------------------------------------------------------- /libtest.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | 4 | int import_ok; 5 | int wordint; 6 | double result; 7 | 8 | int main() 9 | { 10 | dclang_initialize(); 11 | import_ok = dclang_import("libtest.dc"); 12 | if (import_ok == -1) { 13 | printf("Import file not found, exiting!\n"); 14 | } 15 | wordint = dclang_findword("libtest"); 16 | if (wordint == -1) { 17 | printf("Word not found, exiting!\n"); 18 | return -1; 19 | } 20 | dclang_callword(wordint); 21 | result = dclang_pop(); 22 | printf("The first result is: %g\n", result); 23 | result = dclang_pop(); 24 | printf("The second result is: %g\n", result); 25 | } 26 | -------------------------------------------------------------------------------- /libtest.dc: -------------------------------------------------------------------------------- 1 | : libtest 2 | "Hello world! This is a test of dclang as a library." print cr 3 | 2 2 + 4 | 4 3 + 5 | ; 6 | -------------------------------------------------------------------------------- /main.c: -------------------------------------------------------------------------------- 1 | #include "libdclang.c" 2 | 3 | // Where all the juicy fun begins... 4 | int main(int argc, char **argv) { 5 | dclang_initialize(); 6 | //setlocale(LC_ALL, ""); 7 | if (argc > 1) { 8 | for(int opt = 1; opt < argc; opt++) { 9 | if (strcmp(argv[opt], "-i") == 0) { 10 | live_repl = 1; 11 | } else { 12 | dclang_import(argv[opt]); 13 | } 14 | }; 15 | } else { 16 | live_repl = 1; 17 | } 18 | if (live_repl) { 19 | printf("Welcome to dclang! Aaron Krister Johnson, 2018-2025\n"); 20 | printf("Make sure to peruse README.md to get your bearings!\n"); 21 | printf("You can type 'primitives' to see a list of all the primitive (c-builtin) words.\n"); 22 | printf("You can type 'words' to see a list of words defined within dclang.\n"); 23 | show_primitives(); 24 | repl(); 25 | } 26 | } 27 | -------------------------------------------------------------------------------- /noheap/ht.c: -------------------------------------------------------------------------------- 1 | // Simple hash table implemented in C. 2 | 3 | #include "ht.h" 4 | 5 | #include 6 | #include 7 | #include 8 | #include 9 | 10 | #define FNV_OFFSET 14695981039346656037UL 11 | #define FNV_PRIME 1099511628211UL 12 | 13 | // Hash table entry (slot may be filled or empty). 14 | typedef struct { 15 | const char* key; // key is NULL if this slot is empty 16 | void* value; 17 | } ht_entry; 18 | 19 | // Hash table structure: create with hcreate 20 | struct ht { 21 | ht_entry* entries; // hash slots 22 | size_t capacity; // size of _entries array 23 | size_t length; // number of items in hash table 24 | }; 25 | 26 | ht* hcreate(long int CAPACITY) { 27 | // Allocate space for hash table struct. 28 | ht* table = (ht *) dclang_malloc(sizeof(ht)); 29 | if (table == NULL) { 30 | return NULL; 31 | } 32 | table->length = 0; 33 | table->capacity = CAPACITY; 34 | 35 | // Allocate (zero'd) space for entry buckets. 36 | table->entries = (ht_entry *) dclang_malloc( (table->capacity) * sizeof(ht_entry) ); 37 | // TEST 38 | if (table->entries == NULL) { 39 | printf("WARNING: could not create hash table of request size!\n"); 40 | return NULL; 41 | } 42 | return table; 43 | } 44 | 45 | // Return 64-bit FNV-1a hash for key (NUL-terminated). See description: 46 | // https://en.wikipedia.org/wiki/Fowler–Noll–Vo_hash_function 47 | static uint64_t hash_key(const char* key) { 48 | uint64_t hash = FNV_OFFSET; 49 | for (const char* p = key; *p; p++) { 50 | hash ^= (uint64_t)(unsigned char)(*p); 51 | hash *= FNV_PRIME; 52 | } 53 | return hash; 54 | } 55 | 56 | void* hget(ht* table, const char* key) { 57 | // AND hash with capacity-1 to ensure it's within entries array. 58 | uint64_t hash = hash_key(key); 59 | size_t index = (size_t)(hash & (uint64_t)(table->capacity - 1)); 60 | 61 | // Loop till we find an empty entry. 62 | while (table->entries[index].key != NULL) { 63 | if (strcmp(key, table->entries[index].key) == 0) { 64 | // Found key, return value. 65 | return table->entries[index].value; 66 | } 67 | // Key wasn't in this slot, move to next (linear probing). 68 | index++; 69 | if (index >= table->capacity) { 70 | // At end of entries array, wrap around. 71 | index = 0; 72 | } 73 | } 74 | return NULL; 75 | } 76 | 77 | // Internal function to set an entry (without expanding table). 78 | static const char* hset_entry( 79 | ht_entry* entries, 80 | size_t capacity, 81 | const char* key, 82 | void* value, 83 | size_t* plength) 84 | { 85 | // AND hash with capacity-1 to ensure it's within entries array. 86 | uint64_t hash = hash_key(key); 87 | size_t index = (size_t)(hash & (uint64_t)(capacity - 1)); 88 | 89 | // Loop till we find an empty entry. 90 | while (entries[index].key != NULL) { 91 | if (strcmp(key, entries[index].key) == 0) { 92 | // Found key (it already exists), update value. 93 | entries[index].value = value; 94 | return entries[index].key; 95 | } 96 | // Key wasn't in this slot, move to next (linear probing). 97 | index++; 98 | if (index >= capacity) { 99 | // At end of entries array, wrap around. 100 | index = 0; 101 | } 102 | } 103 | // Didn't find key, allocate+copy if needed, then insert it. 104 | if (plength != NULL) { 105 | key = dclang_strdup((char *)key); 106 | if (key == NULL) { 107 | return NULL; 108 | } 109 | (*plength)++; 110 | } 111 | entries[index].key = (char *)key; 112 | entries[index].value = value; 113 | return key; 114 | } 115 | 116 | const char* hset(ht* table, const char* key, void* value) { 117 | // Set entry and update length. 118 | ht_entry *entries = table->entries; 119 | size_t capacity = table->capacity; 120 | return hset_entry(entries, capacity, key, value, 121 | &table->length); 122 | } 123 | 124 | size_t hlength(ht* table) { 125 | return table->length; 126 | } 127 | -------------------------------------------------------------------------------- /noheap/ht.h: -------------------------------------------------------------------------------- 1 | // Simple hash table implemented in C. 2 | 3 | #ifndef _HT_H 4 | #define _HT_H 5 | 6 | #include 7 | #include 8 | 9 | // Hash table structure: create with ht_create, free with ht_destroy. 10 | typedef struct ht ht; 11 | 12 | // Create hash table and return pointer to it, or NULL if out of memory. 13 | ht* hcreate(long int); 14 | 15 | // Get item with given key (NUL-terminated) from hash table. Return 16 | // value (which was set with ht_set), or NULL if key not found. 17 | void* hget(ht* table, const char* key); 18 | 19 | const char* hset(ht* table, const char* key, void* value); 20 | 21 | // Return number of items in hash table. 22 | size_t hlength(ht* table); 23 | 24 | #endif 25 | -------------------------------------------------------------------------------- /noheap/llist.c: -------------------------------------------------------------------------------- 1 | struct node { 2 | struct node *next; 3 | struct node *prev; 4 | }; 5 | 6 | void insque(void *element, void *pred) 7 | { 8 | struct node *e = element; 9 | struct node *p = pred; 10 | if (!p) { 11 | e->next = e->prev = 0; 12 | return; 13 | } 14 | e->next = p->next; 15 | e->prev = p; 16 | p->next = e; 17 | if (e->next) 18 | e->next->prev = e; 19 | } 20 | 21 | void remque(void *element) 22 | { 23 | struct node *e = element; 24 | if (e->next) 25 | e->next->prev = e->prev; 26 | if (e->prev) 27 | e->prev->next = e->next; 28 | } 29 | -------------------------------------------------------------------------------- /noheap/llist.h: -------------------------------------------------------------------------------- 1 | #ifndef _LLIST_H 2 | #define _LLIST_H 3 | 4 | void insque(void *, void *); 5 | void remque(void *); 6 | 7 | #ifdef _GNU_SOURCE 8 | struct qelem { 9 | struct qelem *q_forw, *q_back; 10 | char q_data[1]; 11 | }; 12 | #endif 13 | -------------------------------------------------------------------------------- /noheap/malloc.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | 4 | //reserve 32 MB for malloc 5 | #define MEMSIZE 1024*1024*32 6 | #define ALLOC_STACK_DEPTH 128 7 | 8 | static char memory_pool[MEMSIZE]; 9 | static size_t unused_mem_idx = 0; 10 | size_t alloc_stack[ALLOC_STACK_DEPTH]; 11 | int alloc_stack_top = 0; 12 | 13 | char *dclang_malloc(size_t size) 14 | { 15 | // Is what is being asked too much? 16 | if(size > (MEMSIZE - unused_mem_idx)) { 17 | return NULL; 18 | } 19 | // record where we are for `free` to use for rewinds 20 | if (alloc_stack_top < ALLOC_STACK_DEPTH) { 21 | alloc_stack[alloc_stack_top++] = unused_mem_idx; 22 | } 23 | // and all the rest... 24 | char *mem = &memory_pool[unused_mem_idx]; 25 | unused_mem_idx += size; 26 | unused_mem_idx = (unused_mem_idx + 0x0f) & ~0x0f; // memalign 27 | return mem; 28 | } 29 | 30 | char *dclang_realloc(void *mem, size_t size) 31 | { 32 | char *new_mem = (char *) dclang_malloc(size); 33 | if (new_mem != NULL) { 34 | memcpy(new_mem, mem, size); 35 | } else { 36 | exit(1); 37 | } 38 | return new_mem; 39 | } 40 | 41 | void dclang_free(void *mem) 42 | { 43 | if (alloc_stack_top && 44 | mem == &memory_pool[alloc_stack[alloc_stack_top - 1]]) { 45 | unused_mem_idx = alloc_stack[--alloc_stack_top]; 46 | } 47 | } 48 | 49 | char *dclang_strdup(char *tocopy) 50 | { 51 | size_t str_size = strlen(tocopy) + 1; 52 | char *outbuf = dclang_malloc(str_size); 53 | memcpy(outbuf, tocopy, str_size); 54 | return outbuf; 55 | } 56 | -------------------------------------------------------------------------------- /noheap/trees.c: -------------------------------------------------------------------------------- 1 | #include "trees.h" 2 | 3 | static inline int height(struct tree_node *n) { return n ? n->h : 0; } 4 | 5 | static int rot(void **p, struct tree_node *x, int dir /* deeper side */) 6 | { 7 | struct tree_node *y = x->a[dir]; 8 | struct tree_node *z = y->a[!dir]; 9 | int hx = x->h; 10 | int hz = height(z); 11 | if (hz > height(y->a[dir])) { 12 | /* 13 | * x 14 | * / \ dir z 15 | * A y / \ 16 | * / \ --> x y 17 | * z D /| |\ 18 | * / \ A B C D 19 | * B C 20 | */ 21 | x->a[dir] = z->a[!dir]; 22 | y->a[!dir] = z->a[dir]; 23 | z->a[!dir] = x; 24 | z->a[dir] = y; 25 | x->h = hz; 26 | y->h = hz; 27 | z->h = hz+1; 28 | } else { 29 | /* 30 | * x y 31 | * / \ / \ 32 | * A y --> x D 33 | * / \ / \ 34 | * z D A z 35 | */ 36 | x->a[dir] = z; 37 | y->a[!dir] = x; 38 | x->h = hz+1; 39 | y->h = hz+2; 40 | z = y; 41 | } 42 | *p = z; 43 | return z->h - hx; 44 | } 45 | 46 | /* balance *p, return 0 if height is unchanged. */ 47 | int __tsearch_balance(void **p) 48 | { 49 | struct tree_node *n = *p; 50 | int h0 = height(n->a[0]); 51 | int h1 = height(n->a[1]); 52 | if (h0 - h1 + 1u < 3u) { 53 | int old = n->h; 54 | n->h = h0

h - old; 56 | } 57 | return rot(p, n, h0key); 75 | if (!c) 76 | return n; 77 | a[i++] = &n->a[c>0]; 78 | n = n->a[c>0]; 79 | } 80 | r = (struct tree_node *)dclang_malloc((uintptr_t)(char *)sizeof *r); 81 | if (!r) 82 | return 0; 83 | r->key = key; 84 | r->a[0] = r->a[1] = 0; 85 | r->h = 1; 86 | /* insert new tree_node, rebalance ancestors. */ 87 | *a[--i] = r; 88 | while (i && __tsearch_balance(a[--i])); 89 | return r; 90 | } 91 | 92 | void *tfind(const void *key, void *const *rootp, 93 | int(*cmp)(const void *, const void *)) 94 | { 95 | if (!rootp) 96 | return 0; 97 | 98 | struct tree_node *n = *rootp; 99 | for (;;) { 100 | if (!n) 101 | break; 102 | int c = cmp(key, n->key); 103 | if (!c) 104 | break; 105 | n = n->a[c>0]; 106 | } 107 | return n; 108 | } 109 | 110 | void *tdelete(const void *restrict key, void **restrict rootp, 111 | int(*cmp)(const void *, const void *)) 112 | { 113 | if (!rootp) 114 | return 0; 115 | 116 | void **a[MAXH+1]; 117 | struct tree_node *n = *rootp; 118 | struct tree_node *parent; 119 | struct tree_node *child; 120 | int i=0; 121 | /* *a[0] is an arbitrary non-null pointer that is returned when 122 | the root tree_node is deleted. */ 123 | a[i++] = rootp; 124 | a[i++] = rootp; 125 | for (;;) { 126 | if (!n) 127 | return 0; 128 | int c = cmp(key, n->key); 129 | if (!c) 130 | break; 131 | a[i++] = &n->a[c>0]; 132 | n = n->a[c>0]; 133 | } 134 | parent = *a[i-2]; 135 | if (n->a[0]) { 136 | /* free the preceding tree_node instead of the deleted one. */ 137 | struct tree_node *deleted = n; 138 | a[i++] = &n->a[0]; 139 | n = n->a[0]; 140 | while (n->a[1]) { 141 | a[i++] = &n->a[1]; 142 | n = n->a[1]; 143 | } 144 | deleted->key = n->key; 145 | child = n->a[0]; 146 | } else { 147 | child = n->a[1]; 148 | } 149 | /* freed tree_node has at most one child, move it up and rebalance. */ 150 | dclang_free(n); 151 | *a[--i] = child; 152 | while (--i && __tsearch_balance(a[i])); 153 | return parent; 154 | } 155 | 156 | #define _GNU_SOURCE 157 | 158 | void tdestroy(void *root, void (*freekey)(void *)) 159 | { 160 | struct tree_node *r = root; 161 | 162 | if (r == 0) 163 | return; 164 | tdestroy(r->a[0], freekey); 165 | tdestroy(r->a[1], freekey); 166 | if (freekey) freekey((void *)r->key); 167 | dclang_free(r); 168 | } 169 | -------------------------------------------------------------------------------- /noheap/trees.h: -------------------------------------------------------------------------------- 1 | #include 2 | 3 | /* AVL tree height < 1.44*log2(tree_nodes+2)-0.3, MAXH is a safe upper bound. */ 4 | #define MAXH (sizeof(void*)*8*3/2) 5 | 6 | struct tree_node { 7 | const void *key; 8 | void *a[2]; 9 | int h; 10 | }; 11 | 12 | int __tsearch_balance(void **); 13 | 14 | typedef enum { preorder, postorder, endorder, leaf } VISIT; 15 | 16 | void *tdelete(const void *__restrict, void **__restrict, int(*)(const void *, const void *)); 17 | void *tfind(const void *, void *const *, int(*)(const void *, const void *)); 18 | void *tsearch(const void *, void **, int (*)(const void *, const void *)); 19 | void twalk(const void *, void (*)(const void *, VISIT, int)); 20 | 21 | #ifdef _GNU_SOURCE 22 | void tdestroy(void *, void (*)(void *)); 23 | #endif 24 | -------------------------------------------------------------------------------- /syntaxes/dclang.tmLanguage.json: -------------------------------------------------------------------------------- 1 | { 2 | "scopeName": "source.dclang", 3 | "name": "dclang", 4 | "patterns": [ 5 | { 6 | "name": "comment.line.dclang", 7 | "match": "#.*$", 8 | "settings": { 9 | "foreground": "#FFFFFF", 10 | "background": "#000000" 11 | } 12 | }, 13 | { 14 | "name": "constant.other.dclang", 15 | "match": "(^|\\s)([_:A-Z0-9]+)(?=\\s|$)", 16 | "settings": { 17 | "foreground": "#FF00FF" 18 | } 19 | }, 20 | { 21 | "name": "constant.language.dclang", 22 | "match": "(^|\\s)(null|false|true|pi|e)(?=\\s|$)", 23 | "settings": { 24 | "foreground": "#FF80FF" 25 | } 26 | }, 27 | { 28 | "name": "constant.numeric.dclang", 29 | "match": "(^|\\s)(-?[0-9]+\\.?[0-9]*|0[xX][0-9a-fA-F]+)(?=\\s|$)", 30 | "settings": { 31 | "foreground": "#FFFFFF", 32 | "background": "#000000" 33 | } 34 | }, 35 | { 36 | "name": "string.quoted.dclang", 37 | "begin": "\"", 38 | "end": "\"", 39 | "settings": { 40 | "foreground": "#FFFF00" 41 | } 42 | }, 43 | { 44 | "name": "keyword.operator.dclang", 45 | "match": "(^|\\s)(\\+|-|\\*|/|%|abs|min|max|<<|>>|=|<>|<|>|<=|>=|assert|and|or|not|xor|round|ceil|floor|pow|sqrt|log|log2|log10|sin|cos|tan|rand)(?=\\s|$)", 46 | "settings": { 47 | "foreground": "#FFFF80" 48 | } 49 | }, 50 | { 51 | "name": "support.function.stack.dclang", 52 | "match": "(^|\\s)(drop|dup|over|pick|swap|2drop|2dup|2over|depth|clear|\\.|\\.\\.|\\.rj|\\.s|svpush|svpop|svdrop|svpick|svdepth|svclear)(?=\\s|$)", 53 | "settings": { 54 | "foreground": "#0080FF" 55 | } 56 | }, 57 | { 58 | "name": "support.function.memory.dclang", 59 | "match": "(^|\\s)(!|@|const|var|allot|create|,|h@|h!|hkeys|sortnums|sortstrs|t!|t@|tmake|twalk|tdel|tdestroy|l!|l@|lmake|lpush|lpop|lins|lrem|ldel)(?=\\s|$)", 60 | "settings": { 61 | "foreground": "#FF0000" 62 | } 63 | }, 64 | { 65 | "name": "keyword.control.dclang", 66 | "match": "(^|\\s)(times|again|exittimes|for|next|exitfor|i|j|k|if|else|endif|return)(?=\\\\s|$)", 67 | "settings": { 68 | "foreground": "#80FF00" 69 | } 70 | }, 71 | { 72 | "name": "support.function.other.dclang", 73 | "match": "(^|\\s)(cr|print|emit|uemit|ord|tohex|bytes32|strlen|str=|str<|str>|strfind|strspn|strcspn|strtok|mempcpy|memset|mkbuf|free|isalnum|isalpha|iscntrl|isdigit|isgraph|islower|isprint|ispunct|isspace|isupper|isxdigit|tolower|toupper|regcomp|regexec|regread|fopen|fmemopen|fread|freadline|freadall|fseek|ftell|fwrite|fflush|fclose|redirect|seterr|setout|flush|open|read|write|close|tcplisten|tcpaccept|tcpconnect|clock|sleep|epoch|dt->epoch|epoch->dt|block_sigint|unblock_sigint)(?=\\s|$)", 74 | "settings": { 75 | "foreground": "#00FFFF" 76 | } 77 | }, 78 | { 79 | "name": "punctuation.definition.dclang", 80 | "match": "(^|\\s)(:|;)(?=\\s|$)", 81 | "settings": { 82 | "foreground": "#FF0000" 83 | } 84 | }, 85 | { 86 | "name": "entity.name.function.dclang", 87 | "match": "(^|\\s)([^\\s]+)(?=\\s|$)", 88 | "settings": { 89 | "foreground": "#00FF00" 90 | } 91 | } 92 | ] 93 | } 94 | -------------------------------------------------------------------------------- /tests/branch_test.dc: -------------------------------------------------------------------------------- 1 | : jump_test_false 2 | 0 if 3 | 1 2 3 4 4 | else 5 | 5 6 7 8 6 | endif 7 | 8 = assert 8 | 2drop drop 9 | # should show "5 6 7 8" on stack before assert 10 | ; 11 | 12 | : jump_test_true 13 | 1 if 14 | 1 2 3 4 15 | else 16 | 5 6 7 8 17 | endif 18 | 4 = assert 19 | 2drop drop 20 | # should show "1 2 3 4" on stack before assert 21 | ; 22 | 23 | jump_test_false 24 | 25 | jump_test_true 26 | 27 | : test_nested_if 28 | 0 if 29 | 1 2 3 30 | else 31 | 1 if 32 | 4 5 6 33 | else 34 | 7 8 9 35 | endif 36 | endif 37 | 6 = assert 38 | 2drop 39 | ; 40 | 41 | test_nested_if 42 | 43 | : test_nested_if2 44 | 1 if 45 | 0 if 46 | 1 2 3 47 | else 48 | 4 5 6 49 | endif 50 | else 51 | 7 8 9 52 | endif 53 | 6 = assert 54 | 2drop 55 | ; 56 | 57 | test_nested_if2 58 | 59 | : test_nested_if3 60 | 0 if 61 | 0 if 62 | 1 2 3 63 | else 64 | 4 5 6 65 | endif 66 | else 67 | 0 if 68 | 7 8 9 69 | else 70 | 10 11 12 71 | endif 72 | endif 73 | 12 = assert 74 | 2drop 75 | ; 76 | 77 | test_nested_if3 78 | 79 | : test_early_return 80 | 10 0 1 for 81 | i 5 = 82 | if 83 | i exitfor return 84 | endif 85 | next 86 | ; 87 | 88 | test_early_return 89 | 5 = assert 90 | 91 | : test_complex_early_return 92 | 10 0 1 for 93 | 10 0 1 for 94 | j 5 = i 5 = and 95 | if 96 | j i return 97 | else 98 | endif 99 | next 100 | next 101 | ; 102 | 103 | test_complex_early_return 104 | 5 = assert 5 = assert 105 | -------------------------------------------------------------------------------- /tests/char_tests.dc: -------------------------------------------------------------------------------- 1 | : test_isalnum 2 | "k" isalnum assert 3 | "J" isalnum assert 4 | "1" isalnum assert 5 | "9" isalnum assert 6 | ";" isalnum not assert 7 | ; 8 | 9 | : test_isalpha 10 | "k" isalpha assert 11 | "9" isalpha not assert 12 | ";" isalpha not assert 13 | ; 14 | 15 | : test_iscntrl 16 | "k" iscntrl not assert 17 | "\u0014" iscntrl assert 18 | ; 19 | 20 | : test_isdigit 21 | "k" isdigit not assert 22 | "J" isdigit not assert 23 | "!" isdigit not assert 24 | "1" isdigit assert 25 | "7" isdigit assert 26 | ; 27 | 28 | : test_isgraph 29 | "\n" isgraph not assert 30 | " " isgraph not assert 31 | "!" isgraph assert 32 | "1" isgraph assert 33 | "7" isgraph assert 34 | ; 35 | 36 | : test_islower 37 | "k" islower assert 38 | "K" islower not assert 39 | "a" islower assert 40 | "A" islower not assert 41 | "7" islower not assert 42 | ; 43 | 44 | : test_isprint 45 | "k" isprint assert 46 | "\n" isprint not assert 47 | "\u0003" isprint not assert 48 | ; 49 | 50 | : test_ispunct 51 | "!" ispunct assert 52 | ";" ispunct assert 53 | "0" ispunct not assert 54 | "X" ispunct not assert 55 | ; 56 | 57 | : test_isspace 58 | " " isspace assert 59 | "\n" isspace assert 60 | "\t" isspace assert 61 | " " isspace assert 62 | "5" isspace not assert 63 | "F" isspace not assert 64 | ; 65 | 66 | : test_isupper 67 | "k" isupper not assert 68 | "K" isupper assert 69 | "a" isupper not assert 70 | "A" isupper assert 71 | "7" isupper not assert 72 | ; 73 | 74 | : test_isxdigit 75 | "0" isxdigit assert 76 | "5" isxdigit assert 77 | "9" isxdigit assert 78 | "A" isxdigit assert 79 | "B" isxdigit assert 80 | "C" isxdigit assert 81 | "D" isxdigit assert 82 | "E" isxdigit assert 83 | "F" isxdigit assert 84 | "a" isxdigit assert 85 | "b" isxdigit assert 86 | "c" isxdigit assert 87 | "d" isxdigit assert 88 | "e" isxdigit assert 89 | "f" isxdigit assert 90 | # exceptions 91 | "G" isxdigit not assert 92 | "g" isxdigit not assert 93 | "!" isxdigit not assert 94 | ":" isxdigit not assert 95 | "\n" isxdigit not assert 96 | ; 97 | 98 | : test_encoding 99 | "🌡" "\U0001f321" str= assert 100 | "\x0a" "\n" str= assert 101 | ; 102 | 103 | test_isalnum 104 | test_isalpha 105 | test_iscntrl 106 | test_isdigit 107 | test_isgraph 108 | test_isgraph 109 | test_isgraph 110 | test_isgraph 111 | test_islower 112 | test_isprint 113 | test_ispunct 114 | test_isspace 115 | test_isupper 116 | test_isxdigit 117 | test_encoding 118 | -------------------------------------------------------------------------------- /tests/csvlib_test.dc: -------------------------------------------------------------------------------- 1 | "csvlib.dc" import 2 | 3 | var example_line 4 | "one|two|three|||five" example_line ! 5 | 6 | : test_csv_init_col_buf_resets_full_buffer 7 | 32 mkbuf csv_col_buf ! 8 | csv_col_buf @ 9 | "This sentence has 32 characters!" 10 | dup strlen 11 | mempcpy 12 | drop 13 | depth 0 = assert 14 | 32 _csv_init_col_buf 15 | csv_col_buf @ "" str= assert 16 | ; 17 | 18 | : test_csv_next_input_line 19 | "example.csv" csv_open_input_file 20 | csv_next_input_line "one|two|three" str= assert 21 | csv_next_input_line "four|five|six" str= assert 22 | csv_next_input_line "seven|eight|nine" str= assert 23 | csv_input_file @ fclose 24 | ; 25 | 26 | : test_csv_find_col_x 27 | example_line @ 2 csv_find_col_x "three" str= assert 28 | example_line @ 1 csv_find_col_x "two" str= assert 29 | example_line @ 4 csv_find_col_x "" str= assert 30 | example_line @ 5 csv_find_col_x "five" str= assert 31 | ; 32 | 33 | : test_csv_iteration 34 | "example.csv" csv_open_input_file 35 | csv_next_input_line 0 csv_find_col_x "one" str= assert 36 | csv_next_input_line 1 csv_find_col_x "five" str= assert 37 | csv_next_input_line 2 csv_find_col_x "nine" str= assert 38 | # We expect to hit the EOF here: 39 | csv_next_input_line -1 = assert 40 | ; 41 | 42 | test_csv_init_col_buf_resets_full_buffer 43 | test_csv_next_input_line 44 | test_csv_find_col_x 45 | test_csv_iteration 46 | csv_cleanup 47 | -------------------------------------------------------------------------------- /tests/example.csv: -------------------------------------------------------------------------------- 1 | one|two|three 2 | four|five|six 3 | seven|eight|nine 4 | -------------------------------------------------------------------------------- /tests/file_tests.dc: -------------------------------------------------------------------------------- 1 | var fp 2 | "Hello, world!" const :hello 3 | 4 | : test_fmemopen 5 | 0 64 "w+" fmemopen fp ! 6 | :hello dup strlen fp @ fwrite drop 7 | fp @ fflush 8 | fp @ 0 0 fseek 9 | fp @ freadall drop 10 | :hello 11 | str= assert 12 | ; 13 | 14 | test_fmemopen 15 | -------------------------------------------------------------------------------- /tests/fractions_tests.dc: -------------------------------------------------------------------------------- 1 | "fractions.dc" import 2 | 3 | : test_fracadd 4 | 1 2 1 3 fracadd 5 | swap 6 | 5 = assert 7 | 6 = assert 8 | ; 9 | 10 | : test_fracsub 11 | 1 2 1 3 fracsub 12 | swap 13 | 1 = assert 14 | 6 = assert 15 | ; 16 | 17 | : test_fracmul 18 | 2 3 4 5 fracmul 19 | swap 20 | 8 = assert 21 | 15 = assert 22 | ; 23 | 24 | : test_fracdiv 25 | 3 2 7 5 fracdiv 26 | swap 27 | 15 = assert 28 | 14 = assert 29 | ; 30 | 31 | : test_fracmediant 32 | 4 3 3 2 fracmediant 33 | swap 34 | 7 = assert 35 | 5 = assert 36 | ; 37 | 38 | test_fracadd 39 | test_fracsub 40 | test_fracmul 41 | test_fracdiv 42 | test_fracmediant 43 | -------------------------------------------------------------------------------- /tests/list_tests.dc: -------------------------------------------------------------------------------- 1 | var mylist 2 | lmake mylist ! 3 | mylist @ 0 <> assert 4 | 5 | : test_list_stuff 6 | mylist @ 10 lpush # Push 10 to the list 7 | mylist @ 0 l@ 10 = assert 8 | mylist @ 0 11 l! # Set the value of the first node to 11 9 | mylist @ 0 l@ 11 = assert 10 | 11 | mylist @ lpop 11 = assert 12 | 13 | mylist @ 5 lpush 14 | mylist @ 7 lpush 15 | mylist @ 11 lpush 16 | mylist @ lsize 3 = assert 17 | mylist @ 0 l@ 5 = assert 18 | mylist @ 1 l@ 7 = assert 19 | mylist @ 2 l@ 11 = assert 20 | mylist @ lpop 11 = assert 21 | mylist @ lpop 7 = assert 22 | mylist @ lpop 5 = assert 23 | mylist @ lsize 0 = assert 24 | 25 | mylist @ 5 lpush 26 | mylist @ 7 lpush 27 | mylist @ 11 lpush 28 | mylist @ 2 l@ 11 = assert 29 | mylist @ 2 10 lins 30 | mylist @ 0 l@ 5 = assert 31 | mylist @ 1 l@ 7 = assert 32 | mylist @ 2 l@ 10 = assert 33 | mylist @ 3 l@ 11 = assert 34 | 35 | mylist @ ldel 36 | mylist @ lsize 0 = assert 37 | 38 | mylist @ 5 lpush 39 | mylist @ 7 lpush 40 | mylist @ 11 lpush 41 | mylist @ 1 lrem 42 | mylist @ lpop 11 = assert 43 | mylist @ lpop 5 = assert 44 | 45 | mylist @ free 46 | ; 47 | 48 | test_list_stuff 49 | 50 | -------------------------------------------------------------------------------- /tests/logic_tests.dc: -------------------------------------------------------------------------------- 1 | # and 2 | 0 0 and 0 = assert 3 | 0 1 and 0 = assert 4 | 1 0 and 0 = assert 5 | 1 1 and 1 = assert 6 | 15 3 and 3 = assert 7 | 8 | # or 9 | 0 0 or 0 = assert 10 | 0 1 or 1 = assert 11 | 1 0 or 1 = assert 12 | 1 1 or 1 = assert 13 | 12 3 or 15 = assert 14 | 15 | # xor 16 | 0 0 xor 0 = assert 17 | 0 1 xor 1 = assert 18 | 1 0 xor 1 = assert 19 | 1 1 xor 0 = assert 20 | 21 | # not 22 | 0 not -1 = assert 23 | -1 not 0 = assert 24 | 25 | # equal 26 | 1 1 = assert 27 | -1 -1 = assert 28 | 0 0 = assert 29 | 30 | # not equal 31 | 1 0 <> assert 32 | 1 0 <> assert 33 | -1 1 <> assert 34 | 0 0 <> not -1 = assert 35 | 36 | # greater than 37 | 1 0 > assert 38 | 0 1 > not true = assert 39 | 256 16 > assert 40 | 41 | # less than 42 | 0 1 < assert 43 | 1 0 < not true = assert 44 | 15 16 < assert 45 | 46 | # greater than or equal 47 | 0 0 >= assert 48 | 1 0 >= assert 49 | 16 15 >= assert 50 | 15 15 >= assert 51 | 14 15 >= not true = assert 52 | 53 | # less than or equal 54 | 0 0 <= assert 55 | -1 0 <= assert 56 | 15 16 <= assert 57 | 16 16 <= assert 58 | 15 14 <= not true = assert 59 | -------------------------------------------------------------------------------- /tests/orion_double_stars.sql: -------------------------------------------------------------------------------- 1 | BEGIN; 2 | INSERT INTO "doubles_test" VALUES('05145-0812','2022',204,9.5,0.29999999999999998889,6.7999999999999998223,'B8Iae:','051432.27-081205.9','Ori','STF 668','bet Ori','19 Ori','Rigel',' '); 3 | INSERT INTO "doubles_test" VALUES('05407-0157','2022',167,2.5,1.8799999999999998934,3.7000000000000001776,'+B0III','054045.52-015633.3','Ori','STF 774','zet Ori','50 Ori','Alnitak',' '); 4 | INSERT INTO "doubles_test" VALUES('05354-0555','2021',141,11.199999999999999289,2.7700000000000000177,7.7300000000000004263,'+B8III','053525.98-055435.6','Ori','STF 752','iot Ori','44 Ori','Hatysa',' '); 5 | INSERT INTO "doubles_test" VALUES('05351+0956','2017',185,29.300000000000000709,3.5099999999999997868,10.720000000000000639,'O8+F8V','053508.28+095603.0','Ori','STF 738','lam Ori','Meissa','',' '); 6 | INSERT INTO "doubles_test" VALUES('05351+0956','2021',43,4.0999999999999996447,3.5099999999999997868,5.4500000000000001776,'O8III+B0V','053508.28+095603.0','Ori','STF 738','lam Ori','Meissa','',' '); 7 | INSERT INTO "doubles_test" VALUES('05176-0651','2011',61,35.399999999999998579,3.6000000000000000888,10.900000000000000354,'B5III','051736.40-065039.8','Ori','H 5 25','tau Ori','20 Ori','',' '); 8 | INSERT INTO "doubles_test" VALUES('05176-0651','2011',251,33.299999999999997158,3.6000000000000000888,11,'B5III','051736.40-065039.8','Ori','H 5 25','tau Ori','20 Ori','',' '); 9 | INSERT INTO "doubles_test" VALUES('05387-0236','2019',62,41.39999999999999858,3.7599999999999997868,6.3399999999999998578,'+(B2V+A)','053844.77-023600.2','Ori','BU 1032','sig Ori','V 1030 Ori','48 Ori',' '); 10 | INSERT INTO "doubles_test" VALUES('05387-0236','2019',83,12.900000000000000355,3.7599999999999997868,6.5599999999999996092,'+B2V','053844.77-023600.2','Ori','BU 1032','sig Ori','V 1030 Ori','48 Ori',' '); 11 | INSERT INTO "doubles_test" VALUES('05387-0236','2019',239,11.400000000000000355,3.7599999999999997868,8.7899999999999991473,'+B0.5V','053844.77-023600.2','Ori','BU 1032','sig Ori','V 1030 Ori','48 Ori',' '); 12 | INSERT INTO "doubles_test" VALUES('05123-1152','2015',337,11.900000000000000355,4.4699999999999997513,9.9199999999999999289,'B8V','051217.89-115208.9','Ori','STF 655','iot Lep','3 Lep','',' '); 13 | INSERT INTO "doubles_test" VALUES('05268+0306','2012',328,3,4.5700000000000002842,8.6199999999999992184,'B2IV','052650.12+030546.9','Ori','KNT 3','psi 2 Ori','30 Ori','',' '); 14 | INSERT INTO "doubles_test" VALUES('05133+0252','2021',64,6.7999999999999998223,4.6200000000000001065,8.5,'K2II','051317.48+025140.5','Ori','STF 654','rho Ori','17 Ori','',' '); 15 | INSERT INTO "doubles_test" VALUES('05297-0106','2015',87,12.699999999999999289,4.6900000000000003907,9.6999999999999992894,'K5III','052943.98-010531.8','Ori','STF 725A','31 Ori','CI Ori','',' '); 16 | INSERT INTO "doubles_test" VALUES('05228+0333','2019',29,32,4.9500000000000001776,6.7599999999999997868,'B1V','052250.00+033240.0','Ori','STF 696','23 Ori','','',' '); 17 | INSERT INTO "doubles_test" VALUES('05353-0523','2019',62,13.400000000000000354,5.0599999999999996092,6.3799999999999998934,'O7V+B1.5V','053516.46-052322.9','Ori','DCH 110','Oa,Ob: MT Ori','','',' '); 18 | INSERT INTO "doubles_test" VALUES('05353-0523','2019',62,13.400000000000000354,5.0599999999999996092,6.3799999999999998934,'O7V+B1.5V','053516.46-052322.9','Ori','STF 748A','the 1 Ori A','41 Ori A','V 1016 Ori','the Ori '); 19 | INSERT INTO "doubles_test" VALUES('05353-0523','2019',62,13.400000000000000354,5.0599999999999996092,6.3799999999999998934,'O7V+B1.5V','053516.46-052322.9','Ori','STF 748B','the 1 Ori B','41 Ori B','BM Ori','the Ori '); 20 | INSERT INTO "doubles_test" VALUES('05353-0523','2019',62,13.400000000000000354,5.0599999999999996092,6.3799999999999998934,'O7V+B1.5V','053516.46-052322.9','Ori','STF 748C','the 1 Ori C','41 Ori C','','the Ori '); 21 | INSERT INTO "doubles_test" VALUES('05353-0523','2019',62,13.400000000000000354,5.0599999999999996092,6.3799999999999998934,'O7V+B1.5V','053516.46-052322.9','Ori','STF 748D','the 1 Ori D','41 Ori D','','the Ori '); 22 | INSERT INTO "doubles_test" VALUES('05351+0956','2005',189,31.899999999999998578,5.4500000000000001776,10.720000000000000639,'B0.5V+F8V','053508.52+095606.7','Ori','STF 738','lam Ori','Meissa','',' '); 23 | COMMIT; 24 | -------------------------------------------------------------------------------- /tests/regex_tests.dc: -------------------------------------------------------------------------------- 1 | "string.dc" import 2 | 3 | var pattern 4 | "([[:digit:]]+)([[:blank:]]? things)" 1 regcomp # using 1 for REG_EXTENDED syntax 5 | pattern ! 6 | 7 | var phrase 8 | "I have 1024 things right here!" 9 | phrase ! 10 | 11 | # Note the use below of the "stack depth formatting pattern" to show stack depth 12 | # as things are added, operated on, etc., on the stack. It makes things clearer, 13 | # but the trade-off is use of more vertical real-estate. 14 | 15 | phrase @ # 1 thing on the stack, so indent 2 spaces 16 | pattern @ # 2 things on the stack, so indent 4 spaces, etc. 17 | over 18 | 0 19 | regexec # `regexec` consumed 3 params and leaves 1... 20 | 0 21 | regread # `regread` consumes 2 and leaves 2 22 | strslice # `strslice` consumes 3 -- the initial `phrase @` contents, and `regread` output 23 | "1024 things" 24 | str= 25 | assert 26 | 27 | phrase @ 28 | pattern @ 29 | over 30 | 0 31 | regexec 32 | 1 33 | regread 34 | strslice 35 | "1024" 36 | str= 37 | assert 38 | 39 | phrase @ 40 | pattern @ 41 | over 42 | 0 43 | regexec 44 | 2 45 | regread 46 | strslice 47 | " things" 48 | str= 49 | assert 50 | 51 | 52 | # N.B. that when wanting a literal '\' for the compiled 53 | # pattern, one must double it up, b/c the normal string 54 | # parsing parses whatever character comes after '\' as 55 | # a literal. So for '\' to 'survive' and be part of the 56 | # compiled regex phrase, it must be doubled! 57 | # Also note here we're using basic regex (BRE), indicated 58 | # by the 0 before `regcomp`: 59 | 60 | 61 | "\\([[:alnum:]]\\{1,\\}\\.\\)" 0 regcomp pattern ! 62 | "This. is. strange." phrase ! 63 | phrase @ 64 | pattern @ 65 | over 66 | 0 67 | regexec 68 | 0 69 | regread 70 | strslice 71 | "This." 72 | str= 73 | assert 74 | -------------------------------------------------------------------------------- /tests/run_tests.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | for f in $(ls *.dc) 4 | do 5 | echo "Running tests in file: $f" 6 | dclang $f 7 | done 8 | -------------------------------------------------------------------------------- /tests/sqlite3_tests.dc: -------------------------------------------------------------------------------- 1 | "sqlite3.dc" import 2 | 3 | var db 4 | var stmt 5 | # make memory database 6 | ":memory:" sqlite3_open db ! 7 | # create a table 8 | db @ "CREATE TABLE doubles_test ( 9 | wds_num text, 10 | update_year text, 11 | pos_angle numeric, 12 | sep numeric, 13 | mag1 numeric, 14 | mag2 numeric, 15 | spectrum text, 16 | ra_dec text, 17 | con text, 18 | catalog text, 19 | name1 text, 20 | name2 text, 21 | name3 text, 22 | name4 text 23 | ); 24 | " sqlite3_exec 25 | # import data 26 | var sqlfile 27 | "orion_double_stars.sql" "r" fopen sqlfile ! 28 | var sqltext 29 | sqlfile @ freadall drop sqltext ! 30 | # run the INSERT statements to add data 31 | db @ sqltext @ sqlite3_exec 32 | 33 | "Now selecting doubles" print cr 34 | db @ "SELECT * from doubles_test limit 5;" sqlite3_exec 35 | 36 | # Test an individual query: 37 | db @ "SELECT * FROM doubles_test WHERE wds_num='05145-0812';" sqlite3_prepare stmt ! 38 | stmt @ sqlite3_step drop 39 | stmt @ 12 sqlite3_column "Rigel" str= assert 40 | 41 | # cleanup 42 | stmt @ sqlite3_finalize 43 | db @ sqlite3_close 44 | -------------------------------------------------------------------------------- /tests/string_lib_tests.dc: -------------------------------------------------------------------------------- 1 | "string.dc" import 2 | 3 | var teststr 4 | "thisBLAHisBLAHa littleBLAH testBLAHstring" 5 | teststr ! 6 | 7 | "BLAH" const :BLAH 8 | 9 | # run `substr_count` as a test! 10 | teststr @ :BLAH 11 | 12 | substr_count 13 | 14 | # make an assertion that our test string has 4 instances 15 | # of "BLAH" 16 | 4 = assert 17 | 18 | teststr @ :BLAH "BLAHFOO" strreplace 19 | "thisBLAHFOOisBLAHFOOa littleBLAHFOO testBLAHFOOstring" 20 | str= assert 21 | 22 | teststr @ "NOTFOUND" " " strreplace 23 | teststr @ 24 | str= assert 25 | 26 | var buf 128 mkbuf buf ! 27 | buf @ "This will" str+ 28 | " be concatted " str+ 29 | "together!" str+ 30 | drop 31 | "This will be concatted together!" buf @ 32 | str= assert 33 | buf @ free 34 | 35 | # testing the str_between word: 36 | "blueberry" "apple" "cranberry" str_between 37 | true = assert 38 | "apple" "apple" "cranberry" str_between 39 | true = assert 40 | "cranberry" "apple" "cranberry" str_between 41 | true = assert 42 | "acai" "apple" "cranberry" str_between 43 | false = assert 44 | "lingonberry" "apple" "cranberry" str_between 45 | false = assert 46 | 47 | # test the str_split word: 48 | var split_list 49 | "this/is/a/line/to/split" "/" str_split split_list ! 50 | split_list @ 0 l@ "this" str= assert 51 | split_list @ 1 l@ "is" str= assert 52 | split_list @ 2 l@ "a" str= assert 53 | split_list @ 3 l@ "line" str= assert 54 | split_list @ 4 l@ "to" str= assert 55 | split_list @ 5 l@ "split" str= assert 56 | -------------------------------------------------------------------------------- /tests/trees_tests.dc: -------------------------------------------------------------------------------- 1 | tmake const :mytree 2 | :mytree "Garfield" "A cat" t! drop # t! will automatically put the value of the key to TOS 3 | :mytree "Droopy" "A dog" t! drop # many times, we want to ignore it, so we `drop` it here. 4 | 5 | # assert on fetching from first tree 6 | :mytree "Garfield" t@ 7 | "A cat" str= assert 8 | :mytree "Droopy" t@ 9 | "A dog" str= assert 10 | 11 | # create a second tree 12 | tmake const :mytree2 13 | :mytree2 "Shakespeare" "Elizabethan author" t! drop 14 | 15 | # assert on fetching, and that we are isolated from the first tree 16 | :mytree2 "Shakespeare" t@ 17 | "Elizabethan author" str= assert 18 | :mytree2 "Garfield" t@ # should be a null entry 19 | 0 = assert 20 | 21 | # check the first tree again: 22 | :mytree "Garfield" t@ 23 | "A cat" str= assert 24 | 25 | # test deleting an element 26 | :mytree2 "Shakespeare" tdel 27 | :mytree2 "Shakespeare" t@ 28 | 0 = assert 29 | 30 | # test destroying a tree: 31 | :mytree tdestroy 32 | :mytree "Garfield" t@ 33 | 0 = assert 34 | -------------------------------------------------------------------------------- /tests/variable_tests.dc: -------------------------------------------------------------------------------- 1 | create something 456 , 789 , 2 | something @ 456 = assert 3 | something 1 + @ 789 = assert 4 | 5 | : test-create 6 | create 100 , 200 , 7 | ; 8 | 9 | test-create creation 10 | creation @ 100 = assert 11 | creation 1 + @ 200 = assert 12 | 13 | var foo 14 | var bar 15 | 16 | : testvar 20 foo ! 30 bar ! ; 17 | 18 | testvar 19 | 20 | foo @ 20 = assert 21 | bar @ 30 = assert 22 | 23 | : testfuncvar 1 drop var 4 allot ; 24 | 25 | testfuncvar alpha 26 | 2632.12 alpha ! 27 | alpha @ 2632.12 = assert 28 | 29 | testfuncvar beta 30 | 1111 beta ! 31 | beta @ 1111 = assert 32 | 33 | beta alpha - 4 = assert 34 | 35 | create arr_to_sort 36 | 510 , 83 , 20053 , -19 , 1.618 , 37 | arr_to_sort @ 510 = assert 38 | arr_to_sort 3 + @ -19 = assert 39 | arr_to_sort 5 sortnums 40 | # prove sorting worked: 41 | arr_to_sort @ -19 = assert 42 | arr_to_sort 4 + @ 20053 = assert 43 | -------------------------------------------------------------------------------- /token.c: -------------------------------------------------------------------------------- 1 | int get_char() { 2 | static char *normal_prompt = "dclang=> "; 3 | static char *continue_prompt = " ...=> "; 4 | static int need_prompt = 1; // Tracks when to print a prompt 5 | if (need_prompt && live_repl) { 6 | fprintf(ofp, "%s", (in_string || def_mode) ? continue_prompt : normal_prompt); 7 | fflush(ofp); 8 | need_prompt = 0; // Reset so we don't reprint it every call 9 | } 10 | int c = fgetc(ifp); 11 | if (c == '\n') { 12 | need_prompt = 1; // Set flag to show prompt on next call 13 | } 14 | return c; 15 | } 16 | 17 | // utf-8 char buffer 18 | char utf8_buf[5]; 19 | 20 | long utf8_encode(char *out, uint64_t utf) { 21 | if (utf <= 0x7F) 22 | { 23 | // Plain ASCII 24 | out[0] = (char) utf; 25 | out[1] = 0; 26 | return 1; 27 | } 28 | else if (utf <= 0x07FF) 29 | { 30 | // 2-byte unicode 31 | out[0] = (char) (((utf >> 6) & 0x1F) | 0xC0); 32 | out[1] = (char) (((utf >> 0) & 0x3F) | 0x80); 33 | out[2] = 0; 34 | return 2; 35 | } 36 | else if (utf <= 0xFFFF) 37 | { 38 | // 3-byte unicode 39 | out[0] = (char) (((utf >> 12) & 0x0F) | 0xE0); 40 | out[1] = (char) (((utf >> 6) & 0x3F) | 0x80); 41 | out[2] = (char) (((utf >> 0) & 0x3F) | 0x80); 42 | out[3] = 0; 43 | return 3; 44 | } 45 | else if (utf <= 0x10FFFF) 46 | { 47 | // 4-byte unicode 48 | out[0] = (char) (((utf >> 18) & 0x07) | 0xF0); 49 | out[1] = (char) (((utf >> 12) & 0x3F) | 0x80); 50 | out[2] = (char) (((utf >> 6) & 0x3F) | 0x80); 51 | out[3] = (char) (((utf >> 0) & 0x3F) | 0x80); 52 | out[4] = 0; 53 | return 4; 54 | } 55 | else { 56 | // error - use replacement character 57 | out[0] = (char) 0xEF; 58 | out[1] = (char) 0xBF; 59 | out[2] = (char) 0xBD; 60 | out[3] = 0; 61 | return 3; 62 | } 63 | } 64 | 65 | int get_unicode_by_hex(char *chbuf, int usize) { 66 | char numstr[usize]; 67 | for (int i = 0; i < usize - 1; i++) { 68 | numstr[i] = get_char(); 69 | } 70 | numstr[usize - 1] = '\0'; // Null terminate 71 | int ucode = strtol(numstr, NULL, 16); 72 | int num_bytes_ret = utf8_encode(chbuf, ucode); 73 | return num_bytes_ret > 0 ? 1 : 0; 74 | } 75 | 76 | int get_ascii(char *chbuf, int usize) { 77 | char numstr[usize]; 78 | for (int i = 0; i < usize - 1; i++) { 79 | numstr[i] = get_char(); 80 | } 81 | numstr[usize - 1] = '\0'; // Null terminate 82 | int acode = strtol(numstr, NULL, 16); 83 | chbuf[0] = (char) acode; 84 | chbuf[1] = 0; 85 | return 1; 86 | } 87 | 88 | void stringfunc() { 89 | char ch, escape_ch, chbuf[5]; 90 | int stat = -1; 91 | char *scratch = &memory_pool[unused_mem_idx]; 92 | char *scratch_start = scratch; 93 | in_string = 1; 94 | // Get the first character 95 | if ((ch = get_char()) == EOF) exit(0); 96 | while (ch != '"') { 97 | if (ch == '\\') { 98 | // Handle escape sequences 99 | if ((escape_ch = get_char()) == EOF) exit(0); 100 | switch (escape_ch) { 101 | case 'b': chbuf[0] = 8; break; // Backspace 102 | case 't': chbuf[0] = 9; break; // Tab 103 | case 'n': chbuf[0] = 10; break; // Newline 104 | case 'r': chbuf[0] = 13; break; // Carriage return 105 | case 'x': stat = get_ascii(chbuf, 3); goto check_valid; 106 | case 'u': stat = get_unicode_by_hex(chbuf, 5); goto check_valid; 107 | case 'U': stat = get_unicode_by_hex(chbuf, 9); goto check_valid; 108 | default: chbuf[0] = escape_ch; break; // Literal char 109 | } 110 | chbuf[1] = 0; 111 | } else { 112 | // Regular character 113 | chbuf[0] = ch; 114 | chbuf[1] = 0; 115 | } 116 | check_valid: 117 | if (stat == 0) { 118 | printf("Illegal escape sequence in string.\n"); 119 | return; 120 | } 121 | scratch = mempcpy(scratch, chbuf, strlen(chbuf)); 122 | if ((ch = get_char()) == EOF) exit(0); 123 | continue; 124 | } 125 | *scratch = '\0'; // Null-terminate string 126 | int chr_cnt = (scratch - scratch_start) + 1; 127 | unused_mem_idx = (unused_mem_idx + chr_cnt + 0x0f) & ~0x0f; 128 | // Register string memory range 129 | DCLANG_PTR string_dest_ptr = (DCLANG_PTR) scratch_start; 130 | DCLANG_PTR buflen = (DCLANG_PTR) chr_cnt; 131 | MIN_STR = (MIN_STR == 0 || string_dest_ptr < MIN_STR) ? string_dest_ptr : MIN_STR; 132 | MAX_STR = (MAX_STR == 0 || string_dest_ptr + buflen > MAX_STR) ? string_dest_ptr + buflen : MAX_STR; 133 | // Handle stack or program storage 134 | if (def_mode) { 135 | prog[iptr].opcode = OP_PUSH; 136 | prog[iptr++].param = string_dest_ptr; 137 | } else { 138 | push(string_dest_ptr); 139 | } 140 | in_string = 0; 141 | } 142 | 143 | // Helpers for `get_token()` 144 | 145 | void add_to_buf(char ch) { 146 | if((bufused < IBUFSIZE - 1) && ch != EOF) { 147 | buf[bufused++] = ch; 148 | } 149 | } 150 | 151 | char *buf2str() { 152 | buf[bufused++] = '\0'; 153 | return dclang_strdup(buf); 154 | } 155 | 156 | // End helpers for `get_token()` 157 | 158 | char *get_token() { 159 | DCLANG_INT ch; 160 | bufused = 0; 161 | // Skip leading spaces and handle comments 162 | while ((ch = get_char()) != EOF) { 163 | if (isspace(ch)) continue; 164 | switch (ch) { 165 | case '#': // Comment detected, skip to end of line 166 | while ((ch = get_char()) != EOF && ch != '\n'); 167 | continue; 168 | case '"': // String detected, handle it separately 169 | stringfunc(); 170 | continue; 171 | default: 172 | add_to_buf(ch); 173 | goto read_token; 174 | } 175 | } 176 | return "EOF"; 177 | read_token: 178 | // Read remaining characters until whitespace or EOF 179 | while ((ch = get_char()) != EOF) { 180 | if (isspace(ch)) { 181 | return buf2str(); 182 | } 183 | add_to_buf(ch); 184 | } 185 | return "EOF"; 186 | } 187 | --------------------------------------------------------------------------------