Forth Haiku Salon
Top Haikus
More...
: d dup ; : m 1 min ; : f d floor - ; : c cos abs ; : j t 4 + 2 * x 8 * floor 8 / + 4 * c 2 / t 4 + 2 / c 4 ** * - ; : a 1 x x 8 * floor 0.5 + 8 / - d * y ; : b - d * + sqrt 50 * 8 ** ; : p x t 4 + pi / f 1.6 * - 0.2 + ; : v t 4 + pi 2 * / f ; a j 0.5 b - v d 0.5 < * 4 * m * 1 p d * y 0.5 - d * + 36 * 30 ** m - y 0.5 - p atan2 abs t 10 * c 0.8 * - 16 * m * 0 max a 0.5 b - 0 max d p 16 * < * + p d * y 0.58 b m * v 0.5 >= * + d 0.2
PACMAN
www.manwe.ru
'25 Jan 17
: d dup ; : ' .5 - ; : r x ' d * y ' d * + sqrt ; : lx t 7 + 1.9 * sin 2 / ; : ly t 7 + 1.7 * sin 2 / ; : lr lx d * ly d * + .16 + sqrt ; : z r 80 * sin .7 * ; : m lr / * 0 max ; x ' r / z * lx m y ' r / z * ly m r 80 * cos .15 * .85 + .4 r 40 * cos 1 + 6 / + m + + 1 x ' lx - d * y ' ly - d * + sqrt - 0 max * d d * 2 /
Golden bump
Manwe
'25 Jan 17
x 9.4 * sin y 9.4 * sin t 4 * sin * * dup t 2 * sin * dup t 3 * sin *
Disco
Ivanq
'25 Jan 17
: y0 y 1.6 * .45 - ; : d dup ; : c rot d >r ; : l c c c >r swap >r over * over d r> * swap r> * 4 + d * swap d * + over d * + 7 - swap 1 + min + r> r> r> ; 0 x 1.7 * .85 - d d * y0 d * + 4 + sqrt d d >r >r / y0 r> / -2 t 6.2 + 9 / sin 2 / + r> / l l l l l l l l l l l l l l l l drop drop drop 3.7 / d d * over sqrt -rot
Coffee (final)
Manwe
'25 Jan 17
: c push negate swap negate y x z+ dup * swap dup * + pop dup * < ; : l push -rot negate swap negate y x z+ 2dup dup * swap dup * + pop dup * < push atan2 - abs 0.05 < pop * ; : p dup rot dup sin swap cos rot * -rot * rot + -rot + swap ; : a t 3 * sin ; : b a 1.1 * ; : m x 10 * + + sin 1 over dup * - sqrt atan2 swap / y 0.6 - > ; 0.5 0.7 -1.57 0.3 l 0.5 0.4 -1.57 a + 0.15 l + 0.5 0.4 -1.57 a + 0.15 p -2 b + 0.2 l + 0.5 0.4 -1.57 a - 0.15 l + 0.5 0.4 -1.57 a - 0.15 p -2 b - 0.2 l + 0.5 0.6 -1.57 a + 0.1 l + 0.5 0.6 -1.57 a + 0.1 p -0.5 b + 0.1 l + 0.5 0.6 -1.57 a - 0.1 l + 0.5 0.6 -1.57 a - 0.1 p -0.5 b - 0.1 l + 0.5 0.7 0.05 c + dup 0 swap 15 1 t 2 / m 20 3 t m + 25 0 t 4 / m 35 4 t 4 / m + + y 0.2 > * +
Man running with landscape
Alok
'25 Jan 17
: d dup ; : m 0.4 * 0.5 + - ; : a y - abs 0.1 < x ; : r t swap / d floor - 1.96 * 0.98 - d 0 > 2 * 1 - * 0.01 + ; : e 2.9 r 0.94 * 0.03 + ; : f 3.7 r ; : p f 0.9 * 0.05 + d t ; e x - d * f y - d * + sqrt 0.02 < p 3 * sin m e * - a 0.03 < * p 2 * cos m 1 e - * - a 0.97 > * + + d d
PONG game
www.manwe.ru
'25 Jan 17
: web push push x 0.5 + y 0.3 + * pop * sin 0 max x 0.3 + y 0.5 + * pop * sin 0 max + ; 31 23 web 17 17 web * x + 23 31 web 19 19 web * y x * + 31 31 web 7 7 web * y +
streak
BradN
'25 Jan 17
\ use WASD keys : b button ; : d dup ; 2 b dt * 200 / d 1 @ sin * swap 1 @ cos * 4 @ 5 @ z+ 5 ! 4 ! 2 @ 3 @ 4 @ 5 @ z+ 3 ! 2 ! 2 @ x + .5 - 3 @ y + .5 - 5 b dt * 3 * 1 b dt * 3 * - 1 @ + d d 1 ! cos swap sin z* 2dup .05 + atan2 abs .4 < -rot .01 - atan2 abs 1 < - 0 max 6 @ sin dt * 2 * 7 @ + 7 ! 6 @ cos dt * 2 * 8 @ + 8 ! 3 b d d if 1 @ 6 ! then if 2 @ 7 ! then if 3 @ 8 ! then 7 @ .5 x - - d * 8 @ .5 y - - d * + .00003 < + x y ** 56 * sin 237 * d floor - 1000 * 999 - 0 max + d d
Asteroids
Manwe
'25 Jan 17
Recent Haikus
More...
: флаг y 0.333 > if 0.81 0.09 0.13 1 ( красный цвет ) else 0.03 0.486 0.188 1 ( зёленый цвет ) then ; флаг
Беларуский флаг v1.0
GleckStar
'25 Jan 17
( Click to random restart ) : 1+ 2 * + ; : s+ >r r@ 32 / floor r> 32 mod 32768 * + ; : s- >r r@ 32768 mod 32 * r> 32768 / floor 32 mod + ; : c0 >r r@ 2 mod r@ 32 / floor 2 mod 32 * + r@ 1024 / floor 2 mod 1024 * + r> 32768 / floor 2 mod 32768 * + ; : rule >r r@ 6 = if 1 else r@ 5 = r@ 7 = or if 1 else r@ 1 = r@ 3 = or if 0 else r@ 8 >= if 0 else 0 then then then then r> drop ; : newgen >r r@ 16 mod rule r@ 32 / floor 16 mod rule 32 * + r@ 1024 / floor 16 mod rule 1024 * + r> 32768 / floor 16 mod rule 32768 * + ; : update 0 4 ! 0 5 ! 0 6 ! 0 7 ! 1 @ s+ >r 1 @ s- 8 ! 4 @ r@ 1+ 1 @ 1+ 8 @ 1+ 4 ! 5 @ r@ 1+ 8 @ 1+ 5 ! 6 @ r> 1+ 1 @ 1+ 8 @ 1+ 6 ! 2 @ s+ >r 2 @ s- 8 ! 5 @ r@ 1+ 2 @ 1+ 8 @ 1+ 5 ! 6 @ r@ 1+ 8 @ 1+ 6 ! 7 @ r> 1+ 2 @ 1+ 8 @ 1+ 7 ! 3 @ s+ >r 3 @ s- 8 ! 6 @ r@ 1+ 3 @ 1+ 8 @ 1+ 6 ! 7 @ r@ 1+ 8 @ 1+ 7 ! 4 @ r> 1+ 3 @ 1+ 8 @ 1+ 4 ! 0 @ s+ >r 0 @ s- 8 ! 7 @ r@ 1+ 0 @ 1+ 8 @ 1+ 7 ! 4 @ r@ 1+ 8 @ 1+ 4 ! 5 @ r> 1+ 0 @ 1+ 8 @ 1+ 5 ! 0 @ 4 @ + newgen 0 ! 1 @ 5 @ + newgen 1 ! 2 @ 6 @ + newgen 2 ! 3 @ 7 @ + newgen 3 ! ; : life 15 @ 0 = t 2 * 1 mod 0.5 < and if 1 15 @ - 15 ! update else 15 @ 1 = t 2 * 1 mod 0.5 > and if 1 15 @ - 15 ! then then ; : draw y 4 * floor @ x 4 * floor >r 2 r> 5 * ** / floor 2 mod dup dup ; : ran random 2 20 ** * 1 - ; 0 button if ran c0 0 ! ran c0 1 ! ran c0 2 ! ran c0 3 ! 0 0 0 else life draw then
Game of Life
SAKURA
'25 Jan 17
( 16x25 Pixcel Editor ) ( Q or Click=Draw, A=Erase ) ( Fixed the bug in bit inversion handling for columns where only bit24 is 1 and bits0-23 are 0, affecting bit0-bit32. ) : wy 25 * floor ; : wx 16 * floor ; : get24 >r r@ 16777216 = r@ 0 <> r> 1 < and or ; : set24 >r r@ get24 if r> else r@ 0 = if r> drop 16777216 else r> 2 24 ** / then then ; : reset24 >r r@ get24 if r@ 16777216 = if r> drop 0 else r> 2 24 ** * then else r> then ; : get23 >r r@ get24 if r> 2 24 ** * else r> then ; : d >r r@ 24 = if r> drop get24 else get23 2 r> ** / floor 2 mod then ; : , ( v y - f ) x wx = >r y wy d r> * ; : # ( c y v - c' y' ) , + ; : s dup @ abs swap # ; : draw 0 0 0 s 1 s 2 s 3 s 4 s 5 s 6 s 7 s 8 s 9 s 10 s 11 s 12 s 13 s 14 s 15 s 1 ; : toggle my wy >r r@ 24 = if mx wx dup @ 1 button if reset24 else 0 button if set24 then then swap ! r> drop else mx wx dup @ dup get24 -rot 16777216 mod get23 dup 2 r> ** dup >r / floor 2 mod if r> 1 button * - rot if set24 then swap ! else r> 0 button * + rot if set24 then swap ! then then ; mx 1 < my 1 < mx 0 >= my 0 >= and and and if toggle then draw
16x25 Pixcel Editor - Fixed Version 2
SAKURA
'25 Jan 17
( 16x25 Pixcel Editor ) ( Q or Click=Draw, A=Erase ) ( Fixed the bug in the handling of the top row. ) : wy 25 * floor ; : wx 16 * floor ; : get24 >r r@ 16777216 = r@ 0 <> r> 1 < and or ; : set24 >r r@ get24 if r> else r@ 0 = if r> drop 16777216 else r> 2 24 ** / then then ; : reset24 >r r@ get24 if r@ 16777216 = if r> drop 0 else r> 2 24 ** * then else r> then ; : get23 >r r@ get24 if r> 2 24 ** * else r> then ; : d >r r@ 24 = if r> drop get24 else get23 2 r> ** / floor 2 mod then ; : , ( v y - f ) x wx = >r y wy d r> * ; : # ( c y v - c' y' ) , + ; : s dup @ abs swap # ; : draw 0 0 0 s 1 s 2 s 3 s 4 s 5 s 6 s 7 s 8 s 9 s 10 s 11 s 12 s 13 s 14 s 15 s 1 ; : toggle my wy >r r@ 24 = if mx wx dup @ buttons 2 / floor 2 mod if reset24 else buttons 2 mod if set24 then then swap ! r> drop else mx wx dup @ dup get24 -rot get23 dup 2 r> ** dup >r / floor 2 mod if r> buttons 2 / floor 2 mod * - rot if set24 then swap ! else r> buttons 2 mod * + rot if set24 then swap ! then then ; mx 1 < my 1 < mx 0 >= my 0 >= and and and if toggle then draw
16x25 Pixcel Editor - Fixed Version
SAKURA
'25 Jan 17
( 16x25 Pixcel Editor ) ( Q or Click=Draw, A=Erase ) : wy 25 * floor ; : wx 16 * floor ; : get24 >r r@ 16777216 = r@ 0 <> r> 1 < and or ; : set24 >r r@ get24 if r> else r@ 0 = if r> drop 16777216 else r> 2 24 ** / then then ; : get23 >r r@ get24 if r> 2 24 ** * else r> then ; : d >r r@ 24 = if r> drop get24 else get23 2 r> ** / floor 2 mod then ; : , ( v y - f ) x wx = >r y wy d r> * ; : # ( c y v - c' y' ) , + ; : s dup @ abs swap # ; : draw 0 0 0 s 1 s 2 s 3 s 4 s 5 s 6 s 7 s 8 s 9 s 10 s 11 s 12 s 13 s 14 s 15 s 1 ; : toggle my wy >r r@ 24 = if mx wx dup @ set24 swap ! r> drop else mx wx dup @ dup get24 -rot get23 dup 2 r> ** dup >r / floor 2 mod if r> buttons 2 / floor 2 mod * - rot if set24 then swap ! else r> buttons 2 mod * + rot if set24 then swap ! then then ; mx 1 < my 1 < mx 0 >= my 0 >= and and and if toggle then draw
16x25 Pixcel Editor
SAKURA
'25 Jan 17
: p 2 t floor 14 mod ** ; 0 x p * floor p / 107 * y p * floor p / 10007 * + 1 + sin t * pi mod sin dup
Pseudo-Random
SAKURA
'25 Jan 17
: ini 0 ; : n1 1 ; : n2 2 ; : n3 3 ; : n4 4 ; : n5 5 ; : n6 6 ; : r0 7 ; : r1 8 ; : r2 9 ; : r3 10 ; : r4 11 ; : r5 12 ; : r6 13 ; : r7 14 ; : r8 15 ; : n * 1 mod .5 - 4 * ; : ra4 4096 n ; : ra3 65536 n ; : ra2 256 n ; : ra1 1 n ; : relu 0 max ; : ac relu \ some movement .2 t pi * 2 / sin 16 / + atan2 ; : r3ac @ ra3 8 / + ac ; : r4ac @ ra4 8 / + ac ; : calc x .5 - r0 @ ra1 * y .5 - r0 @ ra2 * + r0 r3ac n1 ! x .5 - r1 @ ra1 * y .5 - r1 @ ra2 * + r1 r3ac n2 ! x .5 - r2 @ ra1 * y .5 - r2 @ ra2 * + r2 r3ac n3 ! n1 @ r3 @ ra1 * n2 @ r3 @ ra2 * n3 @ r3 @ ra3 * + + r3 r4ac n4 ! n1 @ r4 @ ra1 * n2 @ r4 @ ra2 * n3 @ r4 @ ra3 * + + r4 r4ac n5 ! n1 @ r5 @ ra1 * n2 @ r5 @ ra2 * n3 @ r5 @ ra3 * + + r5 r4ac n6 ! n4 @ r6 @ ra1 * n5 @ r6 @ ra2 * n6 @ r6 @ ra3 * + + r6 r4ac \ R n4 @ r7 @ ra1 * n5 @ r7 @ ra2 * n6 @ r7 @ ra3 * + + r7 r4ac \ G n4 @ r8 @ ra1 * n5 @ r8 @ ra2 * n6 @ r8 @ ra3 * + + r8 r4ac \ B ( Using intermediate calculation results for color effects, just for fun. ) n1 @ + n4 @ + 3 / -rot n2 @ + n5 @ + 3 / -rot n3 @ + n6 @ + 3 / -rot ; init @ 0 = if random r0 ! random r1 ! random r2 ! random r3 ! random r4 ! random r5 ! random r6 ! random r7 ! random r8 ! 1 ini ! 0 0 0 ( noise removal ) else t 2 / 1 mod 0.5 < ini @ 0.5 > and ini @ 1.5 < and if ini @ 1 + ini ! then t 2 / 1 mod 0.5 > ini @ 1.5 > and if ini @ 1 + ini ! then ini @ 2.5 > if 0 ini ! then calc then
Random Nuron
SAKURA
'25 Jan 17
: ro negate 10 @ 11 @ rot dup cos swap sin z* 11 ! 10 ! ; : grid 12 @ ro 10 @ .5 + .05 mod .0017 < 11 @ .5 + .05 mod .0015 < or ; : of 10 @ 11 @ z+ 11 ! 10 ! ; : re x .5 - 10 ! y .7 - 11 ! 0 12 ! t 15 @ 60 / * pi * pi + cos abs .2 * .5 + 10 @ 11 @ rot 0 z* 11 ! 10 ! ; : b 10 @ 2 ** 11 @ 2 ** + sqrt .01 < ; : v of ro 10 @ >= 0 10 @ <= and 11 @ abs .004 < and ; : p 0.1 pi 2 ; : q re 0 @ 2 / ro ; : stickman 0 re 0 @ 4 / negate ro 10 @ 2 ** 11 @ 2 ** + sqrt dup .05 < swap .042 > and or .015 -.005 of b or -.03 0 of b or re 0 @ 2 / ro 0.14 pi 2 / negate 0 .05 v or q p / 0 @ * 0 .075 v or p * 1 @ * -.1 0 v or q p / 2 @ * pi + 0 .075 v or p * 3 @ * pi + -.1 0 v or pi 4 / negate 13 ! q p / 4 @ * 13 @ + 0 .19 v or p * 5 @ * 13 @ + -.1 0 v or pi pi 4 / + 14 ! q p / 6 @ * 14 @ + 0 .19 v or p * 7 @ * 14 @ + -.1 0 v or ; : r random .5 - ; : ar drop drop drop 1 1 1 ; : handle-click 0 button if 9 @ if else 1 9 ! my 0.5 < if 15 @ 1 - 15 ! then my 0.5 > if 15 @ 1 + 15 ! then then my 0.5 < if y 0.1 < x .5 - abs y < and if ar then then my 0.5 > if y 0.9 > x .5 - abs 1 y - < and if ar then then else 0 9 ! then ; 15 @ not if 136 15 ! 0 9 ! then 8 @ not if r 0 ! r 1 ! r 2 ! r 3 ! r 4 ! r 5 ! r 6 ! r 7 ! 1 8 ! 0 0 0 else 15 @ 30 / t * 1 mod dup .5 < 8 @ .5 > and 8 @ 1.5 < and if 8 @ 1 + 8 ! then .5 > 8 @ 1.5 > and if 8 @ 1 + 8 ! then 8 @ 2.5 > if 0 8 ! then stickman dup dup then x .5 - 10 ! y .5 - 11 ! t 15 @ 100.5 - 200 / * 12 ! grid or -rot handle-click
Random Stickman Redux2
SAKURA
'25 Jan 17