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
'24 Dec 21
: 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
'24 Dec 21
x 9.4 * sin y 9.4 * sin t 4 * sin * * dup t 2 * sin * dup t 3 * sin *
Disco
Ivanq
'24 Dec 21
: 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
'24 Dec 21
: 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
'24 Dec 21
: 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
'24 Dec 21
: 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
'24 Dec 21
\ 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
'24 Dec 21
Recent Haikus
More...
: xor 2dup not and -rot swap not and or ; : init 0 @ 0 = if 1 0 ! 0.6 1 ! 0 2 ! 3 3 ! 0 4 ! 0 5 ! 0 6 ! 1 @ 7 ! 2 @ 8 ! 3 @ 9 ! 1 @ 10 ! 2 @ 11 ! 3 @ 12 ! then ; : mx0 x 0.5 - 3 @ * 1 @ - ; : my0 y 0.5 - 3 @ * 2 @ - ; : sq dup * ; : c sq swap sq + 4 > ; : it 2dup push push c + pop pop 2dup z* mx0 my0 z+ ; : zoom 1 @ 7 ! 2 @ 8 ! 3 @ 9 ! mx 1 my - + 1.9 > if 9 @ 3 * 12 ! else mx 0.6667 >= if 7 @ 9 @ 3 / - 10 ! then mx 0.3333 <= if 7 @ 9 @ 3 / + 10 ! then my 0.6667 >= if 8 @ 9 @ 3 / - 11 ! then my 0.3333 <= if 8 @ 9 @ 3 / + 11 ! then 9 @ 3 / 12 ! then 1 6 ! ; : anim 6 @ if t 5 @ - abs 3 * 1 min dup 1 = if 10 @ 1 ! 11 @ 2 ! 12 @ 3 ! 0 6 ! drop else dup dup >r >r >r 7 @ 10 @ 7 @ - r> * + 1 ! 8 @ 11 @ 8 @ - r> * + 2 ! 9 @ 12 @ 9 @ - r> * + 3 ! then then ; : handle-click 0 button if 4 @ if else t 5 ! zoom 1 4 ! then else 0 4 ! then ; : grid x 0.3333 mod 0.002 < y 0.3333 mod 0.002 < or x 1 y - + 1.9 > or ; init handle-click anim 0 mx0 my0 it it it it it it it it it it it it it it it it it it it drop drop 0.8 swap dup 20 / swap 20 / 1.2 * 1 min >r >r >r grid not dup dup r> * -rot r> * swap r> *
mandelbroat colored Redux Redux
SAKURA
'24 Dec 21
: xor 2dup not and -rot swap not and or ; : init 0 @ 0 = if 1 0 ! 0.6 1 ! 0 2 ! 3 3 ! 0 4 ! then ; : mx0 x 0.5 - 3 @ * 1 @ - ; : my0 y 0.5 - 3 @ * 2 @ - ; : sq dup * ; : c sq swap sq + 4 > ; : it 2dup push push c + pop pop 2dup z* mx0 my0 z+ ; : zoom mx 1 my - + 1.9 > if 3 @ 3 * 3 ! else mx 0.6667 >= if 1 @ 3 @ 3 / - 1 ! then mx 0.3333 <= if 1 @ 3 @ 3 / + 1 ! then my 0.6667 >= if 2 @ 3 @ 3 / - 2 ! then my 0.3333 <= if 2 @ 3 @ 3 / + 2 ! then 3 @ 3 / 3 ! then ; : handle-click 0 button if 4 @ if else zoom 1 4 ! then else 0 4 ! then ; : grid x 0.3333 mod 0.002 < y 0.3333 mod 0.002 < or x 1 y - + 1.9 > or ; init handle-click 0 mx0 my0 it it it it it it it it it it it it it it it it it it it \ it drop drop 0.8 swap dup 20 / swap 20 / 1.2 * 1 min >r >r >r grid not dup dup r> * -rot r> * swap r> *
mandelbroat colored Redux
SAKURA
'24 Dec 21
: rgb 13 @ 8 / dup cos 0.4 swap ; : gr x 0.3333 mod 0.002 < y 0.3333 mod 0.003 < or ; : sq dup * ; : dist sq swap sq + sqrt ; : center rot - -rot swap - ; : dot x y center 2dup dist push atan2 pop swap 13 @ * t + sin 1 + 100 13 @ 10 * - / - 0.01 < 13 @ 0 > and ; : upd dup dup >r >r * rot r> * rot r> * 11 @ + 11 ! 10 @ + 10 ! 12 @ + 12 ! ; : draw 12 ! 11 ! 10 ! 0 @ 13 ! rgb 0.167 0.167 dot upd 1 @ 13 ! rgb 0.500 0.167 dot upd 2 @ 13 ! rgb 0.833 0.167 dot upd 3 @ 13 ! rgb 0.167 0.500 dot upd 4 @ 13 ! rgb 0.500 0.500 dot upd 5 @ 13 ! rgb 0.833 0.500 dot upd 6 @ 13 ! rgb 0.167 0.833 dot upd 7 @ 13 ! rgb 0.500 0.833 dot upd 8 @ 13 ! rgb 0.833 0.833 dot upd 10 @ 11 @ 12 @ ; : f 3 * floor ; : fmx mx f ; : fmy my f ; : cell 3 * + ; : mcell fmx fmy cell ; : rc random 9 * floor ; : swap-cell 2dup @ >r @ swap ! r> swap ! ; : swap-mouse-cell fmx 1 - 0 max fmy cell dup @ 0 = if mcell swap-cell else drop then fmx fmy 1 + 2 min cell dup @ 0 = if mcell swap-cell else drop then fmx 1 + 2 min fmy cell dup @ 0 = if mcell swap-cell else drop then fmx fmy 1 - 0 max cell dup @ 0 = if mcell swap-cell else drop then ; : rswap rc rc swap-cell ; : init 0 @ 0 = 1 @ 0 = and if ( 0 0 ! ) 1 1 ! 2 2 ! 3 3 ! 4 4 ! 5 5 ! 6 6 ! 7 7 ! 8 8 ! rswap rswap rswap rswap then ; : handle-click 0 button if 9 @ if else swap-mouse-cell 1 9 ! then else 0 9 ! then ; init handle-click gr dup dup draw
Camomile Redux 8 puzzle
SAKURA
'24 Dec 21
: q 2 ** ; 0 0 4 push : l x .5 - r@ 1 + * r@ 3 - t 1.9 / cos t 1.9 / sin z* y .5 - r@ 1 + * swap t 2.7 / cos t 2.7 / sin z* -rot q swap q + dup 8 * swap rot q + 1.8 + q - abs .03 < r@ / pop .2 - push max ; : j l l l l ; j j j j pop drop 1.5 * dup 2 ** swap
3D Wire Torus Redux
Anonymous
'24 Dec 21
: grid x 100 * 25 mod 0.2 < y 400 * and y 100 * 25 mod 0.2 < x 400 * and or ; : offset swap 0.25 * 0.125 + swap 0.25 * 0.125 + ; : dot ( R G B r y x -- R G B ) rot 16 mod dup >r -rot offset x - 2 ** swap y - 2 ** + swap 2 ** .00003 * < r> 16 / * dup pi * sin >r + -rot r> + rot ; : init 0 @ 0 = 1 @ 0 = and if 0 16 + 0 ! 1 1 ! 2 2 ! 3 3 ! 4 4 ! 5 5 ! 6 6 ! 7 7 ! 8 8 ! 9 9 ! 10 10 ! 11 11 ! 12 12 ! 13 13 ! 14 14 ! 15 15 ! then ; : draw ( r g b -- r g b ) 0 @ 0 0 dot 1 @ 0 1 dot 2 @ 0 2 dot 3 @ 0 3 dot 4 @ 1 0 dot 5 @ 1 1 dot 6 @ 1 2 dot 7 @ 1 3 dot 8 @ 2 0 dot 9 @ 2 1 dot 10 @ 2 2 dot 11 @ 2 3 dot 12 @ 3 0 dot 13 @ 3 1 dot 14 @ 3 2 dot 15 @ 3 3 dot ; : f 4 * floor ; : fmx mx f ; : fmy my f ; : cell 4 * + ; : mcell fmx fmy cell ; : swap-cell 2dup @ >r @ swap ! r> swap ! ; : swap-mouse-cell fmx 1 - fmy cell dup @ 16 mod 0 = if mcell swap-cell else drop then fmx fmy 1 + cell dup @ 16 mod 0 = if mcell swap-cell else drop then fmx 1 + fmy cell dup @ 16 mod 0 = if mcell swap-cell else drop then fmx fmy 1 - cell dup @ 16 mod 0 = if mcell swap-cell else drop then ; : handle-click 0 button if 0 @ 16 / floor 0 <> if swap-mouse-cell 0 @ 16 mod 0 ! then else 0 @ 16 mod 16 + 0 ! then ; init handle-click grid dup dup draw
15Puzzle Redux
SAKURA
'24 Dec 21
: grid x 100 * 25 mod 0.2 < y 400 * and y 100 * 25 mod 0.2 < x 400 * and or ; : offset swap 0.25 * 0.125 + swap 0.25 * 0.125 + ; : dot offset x - 2 ** swap y - 2 ** + swap 16 mod dup * .00003 * < or ; : init 0 @ 0 = 1 @ 0 = and if 0 16 + 0 ! 1 1 ! 2 2 ! 3 3 ! 4 4 ! 5 5 ! 6 6 ! 7 7 ! 8 8 ! 9 9 ! 10 10 ! 11 11 ! 12 12 ! 13 13 ! 14 14 ! 15 15 ! then ; : draw 0 @ 0 0 dot 1 @ 0 1 dot 2 @ 0 2 dot 3 @ 0 3 dot 4 @ 1 0 dot 5 @ 1 1 dot 6 @ 1 2 dot 7 @ 1 3 dot 8 @ 2 0 dot 9 @ 2 1 dot 10 @ 2 2 dot 11 @ 2 3 dot 12 @ 3 0 dot 13 @ 3 1 dot 14 @ 3 2 dot 15 @ 3 3 dot ; : f 4 * floor ; : fmx mx f ; : fmy my f ; : cell 4 * + ; : mcell fmx fmy cell ; : swap-cell 2dup @ >r @ swap ! r> swap ! ; : ccell 2dup dup 4 < swap 0 >= and swap dup 4 < swap 0 >= and and if cell else drop drop -1 then ; : swap-mouse-cell fmx 1 - fmy ccell dup 0 >= if @ 16 mod 0 = if fmx 1 - fmy ccell mcell swap-cell then else drop then fmx fmy 1 + ccell dup 0 >= if @ 16 mod 0 = if fmx fmy 1 + ccell mcell swap-cell then else drop then fmx 1 + fmy ccell dup 0 >= if @ 16 mod 0 = if fmx 1 + fmy ccell mcell swap-cell then else drop then fmx fmy 1 - ccell dup 0 >= if @ 16 mod 0 = if fmx fmy 1 - ccell mcell swap-cell then else drop then ; : handle-click 0 button if 0 @ 16 / floor 0 <> if swap-mouse-cell 0 @ 16 mod 0 ! then else 0 @ 16 mod 16 + 0 ! then ; init handle-click grid draw dup dup
15Puzzle
SAKURA
'24 Dec 21
: grid ( -- f ) x 0.25 mod 0.0025 < y 400 * sin 0 > and y 0.25 mod 0.0025 < x 400 * sin 0 > and or ; : wave ( sampling -- f ) 1 + 2 / y - abs 0.005 < ; : sin-wave ( hz sec -- level ) * 2 * pi * sin ; : sound1 ( hz sec -- level ) sin-wave random 5 / 0.125 - + ; : sound2 ( hz sec -- level ) sin-wave 0 > if 0.3 else -0.3 then ; : do 261.63 ; : melody ( -- hz ) do ; : sound ( hz sec -- level ) dup >r dup 1 < if sound1 else dup 2 < if sound2 else sin-wave then then r> 1 mod 1 swap - * ; : t1 ( -- mod ) t 3 mod ; : trigger ( -- ) melody t1 sin-wave 0 < melogy t1 0.0001 + sin-wave 0 >= and if t1 0 ! then ; melody t1 sound 0.5 * audio trigger grid grid melody x 200 / 0 @ + sound 0.5 * wave or grid
Audio Test2
SAKURA
'24 Dec 21
( hope you're doing well! ) ( classic amiga effect not so faithfully recreated ) : z .71 * 4 mod 2 - abs 1 - ; : x x 4 * 2 - t z + ; : y y 4 * 1 - t 2 * sin abs - ; : r x dup * y dup * + sqrt ; : m r 1 < * ; : n r 1 >= * ; : m m rot m rot m rot ; : n n rot n rot n rot ; : h rot r> + ; : v >r >r >r h h h ; 1 1 r - sqrt - r / dup x * 1.5 * 1 mod swap y * 1.5 * 1 mod swap t z 2 * + swap 2 * floor swap 2 * floor + 2 mod 1 swap dup m 0.1 0.1 0.7 n v ( sound ) : sin-wave ( hz sec -- level ) * 2 * pi * sin ; : sound1 ( hz sec -- level ) sin-wave random 5 / 0.125 - + ; : do 261.63 ; : sound ( hz sec -- level ) dup >r sound1 r> pi 2 / swap - * \ envelop ; : t1 ( -- mod ) t pi 2 / mod ; do 2 / t1 sound 0.5 * audio
amiga Redux with Sound
SAKURA
'24 Dec 21