Skip to content

Instantly share code, notes, and snippets.

View greggirwin's full-sized avatar

Gregg Irwin greggirwin

  • Redlake Technologies
View GitHub Profile
@greggirwin
greggirwin / map-view-spec.red
Created July 28, 2023 19:03
Associate set-words in a VID spec with a map, rather than globally.
Red []
;styles: keys-of system/view/vid/styles
style-name: [
'base | 'button | 'text | 'field | 'area | 'rich-text | 'toggle
| 'check | 'radio | 'progress | 'slider | 'scroller | 'camera
| 'calendar | 'text-list | 'drop-list | 'drop-down | 'panel
| 'group-box | 'tab-panel | 'h1 | 'h2 | 'h3 | 'h4 | 'h5 | 'box
| 'image
]
@greggirwin
greggirwin / view-ctx.red
Created July 28, 2023 00:46
View with context
Red []
; A quick hack for capturing VID set-words into a context, and limiting their global damange.
view-ctx: function [
"View a layout, binding set-words in it to a returned context."
spec [block!] "VID layout spec; LAY will refer to the root of the face tree in the result."
][
words: collect-words/set/deep spec ; what about draw words though?
@greggirwin
greggirwin / apply-objects-x1.red
Last active May 17, 2023 17:52
Call APPLY with objects (experiments)
Comment {
APPLY is coming! To keep it simple, it won't support named args in
the initial release. These are experiments for how we can think of
ways to do that at the mezz level and play.
APPLY is an avanced func and may be used in both very dynamic code
(think thunks) but also code that requires high performance. We may
not get all the features to do both without some effort, but some
of the ideas here may give you clues about how to do things to your
taste, that meets your needs.
@greggirwin
greggirwin / step-test.red
Last active August 19, 2023 06:51
Step mezz func (new name for incr/decr) and demo script.
Red []
do %step.red
; Wrapper that hides the detail of whether a value is indirectly referenced.
arg-val: func [arg][
either any [any-word? arg any-path? arg] [get arg][arg]
]
test-step: func [arg /by amt][
@greggirwin
greggirwin / ren-type-survey.red
Created January 13, 2022 19:50
Ren Datatype Survey (Dynamic GUI Example)
Red []
; We should give our survey a name so we can identify
; responses for it.
survey-name: "Ren datatype survey"
types: [
none
true
@greggirwin
greggirwin / safe-filename.red
Created August 16, 2021 22:18
safe-filename.red
; This was developed for Windows only, as far as specific names
; the OS uses. For cross-platform use we need to add lists of
; reserved names, and maybe more complex rule checks. It also
; takes a "lowest common denomitator" approach, in that it doesn't
; express illegal chars by OS, the idea being that a good goal is
; to create portable filenames.
safe-filename: function [
"Changes invalid characters to underscores, limits length; reserved OS names return none."
file [any-string!] "Unqualified filenames."
/local mark
@greggirwin
greggirwin / _5-pane-view.red
Created March 7, 2021 18:41
5 Pane View GUI example
Red []
_5-panes-ctx: context [
layout-spec: none ; layout spec we build
p-top: p-left: p-center: p-right: p-bottom: none ; area panels
def-panel-sizes: [top 50 left 200 right 150 bottom 25]
sizes: [] ; panel sizes used in layout
win-sizes: compose [ ;!! may be better to separate default
Red []
context [
list: none
last-event: none
trap: function [
event [word!] ;-- event name
input [string! binary!] ;-- input series at current loading position
type [datatype! word! none!] ;-- type of token or value currently processed.
; Go lang style defer experiment
deferreds-ctx: context [
stack: []
cur-stack: does [last stack] ; current function's stack
push-frame: does [append/only stack copy []] ; new stack frame
pop-frame: does [take/last stack] ; drop last stack frame
;push-defer: func [blk [block!]] [append/only cur-stack blk] ; LIFO
push-defer: func [blk [block!]] [insert/only cur-stack blk] ; FIFO
do-deferreds: does [foreach blk cur-stack [attempt [do blk]]]
@greggirwin
greggirwin / select-case-tests.red
Created November 4, 2020 18:19
select-case.red (old experimental dialected dispatch func)
Red []
do %select-case.red
test: func [val] [print mold :val]
a: 15
test select-case a [15 [OK]]
test select-case a [1 [a] 5 [b] 15 [OK]]