Skip to content

Instantly share code, notes, and snippets.

@hiiamboris
hiiamboris / arity.red
Last active Apr 12, 2021
get arity of any word or path
View arity.red
arity?: func [p [word! path!] /local p2] [
either word? p [
preprocessor/func-arity? spec-of get :p
][
; path format: obj1/obj2.../func/ref1/ref2...
; have to find a point where in that path a function starts
; i.e. p2: obj1/obj2.../func
; and the call itself is: func/ref1/ref2...
p2: as path! clear [] ; reuse the same block over and over again
until [
@hiiamboris
hiiamboris / func-cache-estimation.red
Created Mar 18, 2021
Function cache size estimation and cache creation prototype
View func-cache-estimation.red
Red []
#include %assert.red
#include %keep-type.red
#include %composite.red
#include %map-each.red
#include %format-number.red
#macro [#print string!] func [[manual] s e] [insert remove s [print #composite] s]
word-id: routine [word [any-type!] return: [integer!] /local w] [
@hiiamboris
hiiamboris / rolling-text.red
Last active Mar 16, 2021
Smooth rolling text
View rolling-text.red
Red []
speed: 50
rt: rtd-layout [{ Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor incididunt ut labore et dolore magna aliqua.}]
rt/font: make font! [name: "Colonna MT" size: 100]
rt/size: 99999x999
rt/size: size-text rt
draw: compose/deep [scale 0.5 0.5 [pen cyan text 0x20 (rt)]]
draw2: compose/only/deep [translate 0x0 (draw) translate (rt/size * 1x0 / 2) (draw)]
t0: now/precise
View lagometer.red
Red [needs: view]
img: draw 4000x2000 [scale 2 2 fill-pen yello circle 1000x500 1000 500]
lag: object [max: avg: 0.0]
offset: 0x0
plot: []
system/view/auto-sync?: off
view/no-wait [
below
@hiiamboris
hiiamboris / react-mark-view.red
Last active Jun 19, 2020
Reactivity benchmark (using faces)
View react-mark-view.red
Red [title: "reactivity benchmark" needs: view] ;) run as `red --cli ...` to eliminate GUI console influence!
do https://gitlab.com/hiiamboris/red-mezz-warehouse/-/raw/master/clock.red
do-unseen: function [code [block!]] [
old: system/view/auto-sync?
system/view/auto-sync?: no
do code
system/view/auto-sync?: old
]
@hiiamboris
hiiamboris / react-mark-noview.red
Last active Jun 19, 2020
Reactivity benchmark (using reactors)
View react-mark-noview.red
Red [title: "reactivity benchmark"] ;) run as `red --cli ...` to eliminate GUI console influence!
do https://gitlab.com/hiiamboris/red-mezz-warehouse/-/raw/master/clock.red
recycle/off
print-count: does [
attempt [print ["relations count:" (length? system/reactivity/relations) / 4]]
attempt [print ["relations count:" system/reactivity/relations-count]]
]
@hiiamboris
hiiamboris / react-mark.red
Last active May 25, 2020
Reactivity benchmark
View react-mark.red
Red [title: "reactivity benchmark" needs: view] ;) run as `red --cli ...` to eliminate GUI console influence!
do https://gitlab.com/hiiamboris/red-mezz-warehouse/-/raw/master/clock.red
do-unseen: function [code [block!]] [
old: system/view/auto-sync?
system/view/auto-sync?: no
do code
system/view/auto-sync?: old
]
@hiiamboris
hiiamboris / slow-redraw.red
Created May 22, 2020
Time redraw of an image
View slow-redraw.red
Red [needs: view] ;) run as `red --cli ...` to eliminate GUI console influence!
img: make image! 2000x1000 ;) need a big enough image
system/view/auto-sync?: no ;) disable auto-update so we can profile it
view [
panel [
base font-color black "CHASE THE MOUSE AROUND" 1000x500 img
all-over on-over [
t0: now/precise
face/image/(10x10): random white ;) update the image
View piping.red
Red []
; WOW! dialectic version of function piping!
; . with a cutest dot!
; . to make expressions more readable!
; . can be invoked recursively (pipe [ pipe [...] . ... ])
; e.g. [1 2 3 4 5] . skip 1 . change/part '- 3 . head
; => head change/part skip [1 2 3 4 5] 1 '- 3
@hiiamboris
hiiamboris / benchcollect.red
Created May 19, 2018
A `collect` mezzanine variant of improved performance and RAM footprint
View benchcollect.red
Red []
; outright improvement of collect mezzanine's performance and RAM footprint
; the compiled default "collect"
collect1: :collect
; the interpreted default "collect"
collect2: func spec-of :collect body-of :collect