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 Jun 03
: 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 Jun 03
x 9.4 * sin y 9.4 * sin t 4 * sin * * dup t 2 * sin * dup t 3 * sin *
Disco
Ivanq
'25 Jun 03
: 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 Jun 03
: 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 Jun 03
: 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 Jun 03
: 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 Jun 03
\ 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 Jun 03
Recent Haikus
More...
: center ( -- x y ) 0.5 0.5 ; : xy ( -- x y ) x y ; : mouse ( -- x y ) mx my ; : sq ( n -- n² ) dup * ; : distance ( x1 y1 x2 y2 -- r ) rot - sq rot rot - sq + sqrt ; mouse xy distance dup ( show distance in red channel, circle in green ) 0.2 < 2 / ( reduce brightness )
mouse-following circle
cben
'25 Jun 03
: center ( -- x y ) 0.5 0.5 ; : xy ( -- x y ) x y ; : sq ( n -- n² ) dup * ; : distance ( x1 y1 x2 y2 -- r² ) rot - sq rot rot - sq + sqrt ; center xy distance dup ( show distance in red channel, circle in green ) 0.2 < 2 / ( reduce brightness )
circle
cben
'25 Jun 03
: square dup * ; : dist square swap square + sqrt ; : 2dup over over ; : spiral 0.1 - swap 0.1 - 2dup dist push atan2 t 0.02 * * pop + 100 * sin ; x y spiral dup dup
Moiré 1 Redux Redux
acidx
'25 Jun 03
: t t pi * 2 / ; : l * + sin ; : r t 1 y t + 4 l + 1.57 ; : x x 4 * 2 - t y 3 l + ; : v 2dup x >= swap x < * -rot swap - l ; : a r 4 l ; : b r 1 l ; : c r 2 l ; : d r 3 l ; 0 d a v a b v b c v c d v 0.1 0.2
twister
boomlinde
'25 Jun 03
\ Original 256 bytes DOS intro by unlord / xylem \ Released on Function 2017 demo \ Modified by acidx 2025 : aa x .5 - 2 ** y .5 - 2 ** + sqrt .3 - ; : bb y .5 - x .5 - atan2 ; : a aa 2 / ; : b bb ; : s' t + b + b sin t sin * 2 * + cos .1 * ; : $ 1.6 + 6.4 mod s' ; : h 1.6 * >r r@ s' r@ $ - 42 * a r@ s' - r> $ a - min 128 * 0 max 1 min * + ; : g 1.6 * dup dup s' .1 - r@ * a rot s' - rot $ a - min - ; 0 0 h 1 h 2 h 3 h >r 0 g 3 g * 1 g 10 g * 2 g 4 g * r> drop
Twist Ring Redux Remix
acidx
'25 Jun 03
: флаг y 0.333 > if 0.81 0.09 0.13 1 ( красный цвет ) else 0.03 0.486 0.188 1 ( зёленый цвет ) then ; флаг
Беларуский флаг v1.0
GleckStar
'25 Jun 03
( 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 Jun 03
( 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 Jun 03