aboutsummaryrefslogtreecommitdiff
path: root/stemlib/stdlib.stem
blob: ffd3b676dab0d433dde8ff26cadf7ccee82a6487 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
#!/usr/local/bin/stem
# Author: Preston Pan
evalstr [ strquote eval ] def
include [ fread evalstr ] def

neg [ 0 swap - ] def

# Author of loop deftion: Andrei S
loop [
  swap dup 0 > [
    swap
    dup eval
    swap 1 - swap loop
  ] [ dsc dsc ] if
] def


swapd [ [ swap ] dip ] def
swapt [ [ [ swap ] dip ] dip ] def

dscd [ swap dsc ] def
dsct [ swapd swap dsc ] def

dsc2 [ dsc dsc ] def
dsc3 [ dsc dsc dsc ] def

# Author: Matthew H
dupd [ [ dup ] dip ] def
dupt [ [ [ dup ] dip ] dip ] def
dupq [ [ [ [ dup ] dip ] dip ] dip ] def

over [ dupd swap ] def
over2 [ dupt swapd swap ] def
over3 [ dupq swapt swapd swap ] def

dup2 [ over over ] def
dup3 [ over2 over2 over2 ] def
dup4 [ over3 over3 over3 over3 ] def

dip2 [ swap [ dip ] dip ] def
dip3 [ swap [ dip ] dip ] def
while [  dup2 [ [ ] if ] dip2 over [ while ] [ dsc dsc ] if ] def
when [ [ ] if ] def

loop-times [ dup2 [ swap [ ] if ] dip2
dup [ 1 - loop-times ] [ dsc2 ] if ] def


# d>base [ [ pow * "" swap ] keep2

# [ [ over ] [ [ dup2 / floor * swap over - ] keep [ [ "0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "↊" "↋" ] vat swap + ] with dip2 ] while dsc2 dup len(str-len) ] dip
# - dup2 tail [ head "." ] dip + + ] def

# Author: Preston Pan
map [ [ ] over2 over2 len 0 swap
[ dup4 swap vat over2 eval dscd dscd quote compose swap 1 + dsct dsct dsct over3 swap over3 swap ] swap loop-times dsc3 dscd dscd ] def

filter [ [ ] over2 over2 len 0 swap
[ dup4 swap vat dup over3 eval dsct dsct [ quote compose ] [ dsc ] if swap 1 + dsct dsct dsct over3 swap over3 swap ] swap loop-times dsc3 dscd dscd ] def