Haiku Gallery
: 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 9 over dup * - sqrt atan2 swap / y 0.6 - > ; 0.5 0.7 -1.57 0.3 l 0.5 0.3 -1.57 a + 0.15 l + 0.5 0.4 -1.57 a + 0.15 p -2 b + 0. l + 0.5 0.7 -1.57 a - 0.15 l + 0.5 0.4 -1.57 a - 0.15 p -2 b - 0. l + 0.5 0.6 -1.57 a + 0.1 l + 0.5 0.62 -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 > * +
SEL'ELA' SUK'AN LAE'SUI' UA'KHAN
sel'hen
'17 Sep 11
: i x 10 * floor ; : j y 10 * floor ; : has_bit swap 2 swap ** dup -rot 2 * mod swap >= ; i j - 2 + 21 has_bit i j + 7 - 21 has_bit \ 2 * + dup 1 >= swap 2 = dup rot + swap
GalaxiesColliding has_bit Redux
陳爽
'17 Sep 10
: 2pi 2 pi * ; : d dup * swap dup * + sqrt t 2pi / sin 5 / + ; : s push - swap pop - 2dup d push atan2 0.01 * r@ + 200 * sin 1 pop - * ; : u t sin pi / ; : v t cos pi / ; .5 u + .5 v + x y s .5 u - .5 v - x y s
rolling spiral
陳爽
'17 Sep 10
: d dup ; : m 0.4 * 0.6 + - ; : a y - abs 0.1 < x ; : r t swap / d floor - 1.96 * 0.98 - d 0 > 8 * 1 - * 0.01 + ; : e 2.4 r 0.94 * 0.03 + ; : f 3.7 r ; : p f 0.7 * 0.98 + d t ; e x - d * f y - d * + sqrt 0.01 < p 1000 * sin m e * - a 0.03 < * p 100 * cos m 1 e - * - a 0.97 > * + + d d
lightning and the fast ball Redux
shin-En
'17 Sep 10
: g x 6 * floor y 10 * floor ; g + 4 = g + 3 = g + 1 = or or g - 7 = g = g - -9 = or or 4 * + dup 1 >= swap 5 =
unfortunate chess game
Anonymous
'17 Sep 10
: d dup ; : ' .5 - ; : r x ' d * y ' d * + sqrt ; : lx t 7 + 1.8 * sin 7 / ; : ly t 7 + 1.7 * sin 3 / ; : lr lx d * ly d * + .16 + sqrt ; : z r 89 * sin .7 * ; : m lr / * 0 max ; x ' r / z * lx m y ' r / z * ly m r 80 * cos .1 * .20000098 + .200 r 92 * cos 1 + 6 / + m + + 1 x ' lx - d * y ' ly - d * + sqrt - 0 max * d d * 2 /
darkenbrass
shin-En
'17 Sep 10
: d dup ; : m 0.4 * 0.6 + - ; : a y - abs 0.1 < x ; : r t swap / d floor - 1.96 * 0.98 - d 0 > 8 * 1 - * 0.01 + ; : e 2.4 r 0.94 * 0.03 + ; : f 3.7 r ; : p f 0.7 * 0.98 + d t ; e x - d * f y - d * + sqrt 0.01 < p 1000 * sin m e * - a 0.03 < * p 100 * cos m 1 e - * - a 0.97 > * + + d d
lightning and the disapearing ball
shin-En
'17 Sep 10
: 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 .1 * .85 + .4 r 40 * cos 1 + 6 / + m + + 1 x ' lx - d * y ' ly - d * + sqrt - 0 max * d d * 2 /
Golden bump Redux
Anonymous
'17 Aug 01
: sq dup * ; : d sq swap sq + sqrt^3 ; : s push - swap pop - 2dup d push atan2 0.01 * pop + 200 * sin ; .5 .5 x y s t sin abs t cos abs x y s + dup dup
Moiré pattern generator #1 Redux
Anonymous
'17 Jun 13
: i x 10 * floor ; : j y 10 * floor ; : has_bit swap 2 swap ** dup -rot 2 * mod swap >= ; i j - 2 + 21 has_bit i j + 7 - 21 has_bit 2 * + dup 1 >= swap 2 =
GalaxiesColliding has_bit
Christer Nilsson
'17 May 27
: g x 10 * floor y 10 * floor ; g + 7 = g + 9 = g + 11 = or or g - 2 = g = g - -2 = or or 2 * + dup 1 >= swap 2 =
GalaxiesColliding
Christer Nilsson
'17 May 27
: square dup * ; : dist square swap square + sqrt ; : 2dup over over ; : spiral 0.5 - swap 0.5 - 2dup dist push atan2 0.01 * pop + 100 * sin ; x y spiral x y spiral x y spiral
Look into my Eyes Redux
Anonymous
'17 May 13
: square dup * ; : dist square swap square + sqrt ; : 2dup over over ; : spiral 0.5 - swap 0.5 - 2dup dist push atan2 0.01 * pop + 100 * sin ; x y spiral x y spiral x y spiral
Look into my Eyes Redux
Anonymous
'17 May 13
x random + y random + dup + 1
Rain
dm
'17 May 04
: square dup * ; : pt y - square push x - square pop + 1 swap t sin 2 + pow / swap over * z+ ; 0 0 .2 .3 .2 pt 1 .2 t sin + .5 pt .8 .1 .7 pt 0 .7 .2 pt .5 .3 .5 t sin * pt 0 .7 .7 pt .3 .32 t cos * .4 pt swap / 0 0 .2 .1 .2 pt 1 .2 .4 pt .8 .1 .7 pt 0 .7 t sin - .2 pt .2 .4 .5 pt 0 .9 .7 t cos * pt .3 t cos * .32 .4 pt swap / 0 0 .2 .15 .1 pt .3 .3 t sin + .3 pt .2 .1 .6 pt 0 .7 t cos + .2 pt .2 .4 .5 pt 1 .9 .8 t sin * pt .3 .42 .5 pt swap /
Voronous Redux
Anonymous
'17 Apr 15
: square dup * ; : pt y - square push x - square pop + 1 swap 5 pow / swap over * z+ ; 0 0 .2 .3 .2 pt 1 .2 .5 pt .8 .1 .7 pt 0 .7 .2 pt .5 .3 .5 pt 0 .7 .7 pt .3 .32 .4 pt swap / 0 0 .2 .1 .2 pt 1 .2 .4 pt .8 .1 .7 pt 0 .7 .2 pt .2 .4 .5 pt 0 .9 .7 pt .3 .32 .4 pt swap / 0 0 .2 .15 .1 pt .3 .3 .3 pt .2 .1 .6 pt 0 .7 .2 pt .2 .4 .5 pt 1 .9 .8 pt .3 .42 .5 pt swap /
Voronous
BradN
'17 Apr 15
\ n-edge-graph : polygon ( X Y R N -- red_circle n_green_edge ) over >r rot y swap - >r ( X R N | R y-Y ) rot x swap - >r swap ( N R | R y-Y x-X ) pi 2 / dup >r ( N R α | R y-Y x-X α ) sin * ( N R*sin[α] | R y-Y x-X α ) r> rot ( R*sin[α] α N | R y-Y x-X ) pi swap / ( R*sin[α] α h | R y-Y x-X ) dup dup + ( R*sin[α] α h a | R y-Y x-X ) r> r@ ( R*sin[α] α h a x-X y-Y | R y-Y ) over >r ( R*sin[α] α h a x-X y-Y | R y-Y x-X ) atan2 ( R*sin[α] α h a θ | R y-Y x-X ) swap mod ( R*sin[α] α h mod(θ,a) | R y-Y x-X ) swap - ( R*sin[α] α mod(θ,a)-h | R y-Y x-X ) abs ( R*sin[α] α β | R y-Y x-X ) over cos over sin * ( R*sin[α] α β cos[α]*sin[β] | R y-Y x-X ) -rot ( R*sin[α] cos[α]*sin[β] α β | R y-Y x-X ) cos swap sin * + ( R*sin[α] cos[α]*sin[β]+cos[β]*sin[α] | R y-Y x-X ) / ( K | R y-Y x-X ) r> 2 ** r> 2 ** + sqrt ( K r | R ) dup r> .93 * < -rot - ( r<R*.95 K-r | ) abs 1 swap - 199 ** ( r<R*.95 {1-abs[K-r]}**199 | ) ; .5 .5 .2 3 polygon
circle and triangle
sjdiau
'17 Mar 13
: 3dup >r 2dup r@ -rot r> ; : offset >r swap >r + r> r> + ; : between >r swap dup >r <= r> r> < and ; : hor >r .01 .09 between r> -.01 .01 between and ; : ver >r -.01 .01 between r> .01 .09 between and ; : off over <> r> and >r ; : sega >r 0 -.2 offset hor r> 1 >r 1 off 4 off drop r> and ; : segb >r -.1 -.1 offset ver r> 1 >r 5 off 6 off drop r> and ; : segc >r -.1 0 offset ver r> 1 >r 2 off drop r> and ; : segd >r hor r> 1 >r 1 off 4 off 7 off 9 off drop r> and ; : sege >r ver r> 1 >r 1 off 3 off 4 off 5 off 7 off 9 off drop r> and ; : segf >r 0 -.1 offset ver r> 1 >r 1 off 2 off 3 off 7 off drop r> and ; : segg >r 0 -.1 offset hor r> 1 >r 0 off 1 off 7 off drop r> and ; : digit 3dup sega >r 3dup segb r> or >r 3dup segc r> or >r 3dup segd r> or >r 3dup sege r> or >r 3dup segf r> or >r segg r> or ; : 2digit 3dup >r >r >r 10 / floor digit r> .14 - r> r> 10 mod floor digit or ; : sec t 60 mod floor ; : r x .5 - 2 ** y .5 - 2 ** + .5 ** ; \ r .3 < x .36 - y .4 - sec 2digit x y 1 sega
timer Redux
Anonymous
'17 Mar 06
: 2pi pi 2 * ; : a y .5 - x .5 - atan2 2pi / 1 mod ; \ 中心 到 x,y 角度 a .1 - 1 mod \ 36 degree angle
36 degree
sjdiau
'17 Mar 06
: offset >r swap >r - r> r> - ; : norm dup * swap dup * + sqrt ; : theta swap atan2 ; : polar 2dup norm -rot theta ; : rect 2dup cos * -rot sin * ; : shine 80 * 2 ** 1 + 1 swap / ; : swing t 1.6 * pi * dup >r 2 * cos .25 * r> pi .25 * + sin .25 * ; : length swing norm ; : saber x y .5 .5 offset polar swing theta - rect >r dup 0 < if drop r> drop 1000 else dup length <= if drop r> else length - r> norm then then ; saber shine
Darth Vader 2
FSD
'17 Mar 05
: nip swap drop ; : offset >r swap >r - r> r> - ; : norm dup * swap dup * + sqrt ; : theta swap atan2 ; : polar 2dup theta >r norm r> ; : rect 2dup sin * >r cos * r> ; : shine 80 * 2 ** 1 + 1 swap / ; : swing t 0.8 * 2 * pi * dup >r 2 * cos 2 / r> pi 4 / + sin 2 / ; : length swing norm ; : saber x y .5 .5 offset polar swing theta - rect >r dup 0 < if drop r> drop 1000 else dup length <= if drop r> else length - r> norm then then ; saber shine
Darth Vader
FSD
'17 Mar 04
: offset >r swap >r - r> r> - ; : norm dup * swap dup * + sqrt ; : shine 80 * 2 ** 1 + 1 swap / ; : lisa t 2 * pi * dup >r 2 * cos 2 / r> pi 4 / + sin 2 / ; : juice >r x y .5 .5 offset rot r> offset norm shine ; lisa juice
Lisa Juice
FSD
'17 Mar 03
: 3dup >r 2dup r@ -rot r> ; : offset >r swap >r + r> r> + ; : between >r swap dup >r <= r> r> < and ; : hor >r .01 .09 between r> -.01 .01 between and ; : ver >r -.01 .01 between r> .01 .09 between and ; : off over <> r> and >r ; : sega >r 0 -.2 offset hor r> 1 >r 1 off 4 off drop r> and ; : segb >r -.1 -.1 offset ver r> 1 >r 5 off 6 off drop r> and ; : segc >r -.1 0 offset ver r> 1 >r 2 off drop r> and ; : segd >r hor r> 1 >r 1 off 4 off 7 off 9 off drop r> and ; : sege >r ver r> 1 >r 1 off 3 off 4 off 5 off 7 off 9 off drop r> and ; : segf >r 0 -.1 offset ver r> 1 >r 1 off 2 off 3 off 7 off drop r> and ; : segg >r 0 -.1 offset hor r> 1 >r 0 off 1 off 7 off drop r> and ; : digit 3dup sega >r 3dup segb r> or >r 3dup segc r> or >r 3dup segd r> or >r 3dup sege r> or >r 3dup segf r> or >r segg r> or ; : 2digit 3dup >r >r >r 10 / floor digit r> .14 - r> r> 10 mod floor digit or ; : sec t 60 mod floor ; : r x .5 - 2 ** y .5 - 2 ** + .5 ** ; r .3 < x .36 - y .4 - sec 2digit
timer
陳爽
'17 Mar 01
\ n-edge-graph : edge-graph ( X Y R N -- red_circle n_green_edge ) over >r rot y swap - >r ( X R N | R y-Y ) rot x swap - >r swap ( N R | R y-Y x-X ) pi 2 / dup >r ( N R α | R y-Y x-X α ) sin * ( N R*sin[α] | R y-Y x-X α ) r> rot ( R*sin[α] α N | R y-Y x-X ) pi swap / ( R*sin[α] α h | R y-Y x-X ) dup dup + ( R*sin[α] α h a | R y-Y x-X ) r> r@ ( R*sin[α] α h a x-X y-Y | R y-Y ) over >r ( R*sin[α] α h a x-X y-Y | R y-Y x-X ) atan2 ( R*sin[α] α h a θ | R y-Y x-X ) swap mod ( R*sin[α] α h mod(θ,a) | R y-Y x-X ) swap - ( R*sin[α] α mod(θ,a)-h | R y-Y x-X ) abs ( R*sin[α] α β | R y-Y x-X ) over cos over sin * ( R*sin[α] α β cos[α]*sin[β] | R y-Y x-X ) -rot ( R*sin[α] cos[α]*sin[β] α β | R y-Y x-X ) cos swap sin * + ( R*sin[α] cos[α]*sin[β]+cos[β]*sin[α] | R y-Y x-X ) / ( K | R y-Y x-X ) r> 2 ** r> 2 ** + sqrt ( K r | R ) dup r> .93 * < -rot - ( r<R*.95 K-r | ) abs 1 swap - 199 ** ( r<R*.95 {1-abs[K-r]}**199 | ) ; : n t 10 mod floor 4 + ; \ 3 < n < 14 .3 .35 .25 n edge-graph .5 .65 .25 n edge-graph .7 .35 .25 n edge-graph z+ z+
n-edge-graph Redux
陳爽
'17 Mar 01
\ n-edge-graph : edge-graph ( X Y R N -- red_circle n_green_edge ) rot y swap - >r ( X R N | y-Y ) rot x swap - >r swap ( N R | y-Y x-X ) pi 2 / dup >r ( N R α | y-Y x-X α ) sin * ( N R*sin[α] | y-Y x-X α ) r> rot ( R*sin[α] α N | y-Y x-X ) pi swap / ( R*sin[α] α h | y-Y x-X ) dup dup + ( R*sin[α] α h a | y-Y x-X ) r> r@ ( R*sin[α] α h a x-X y-Y | y-Y ) over >r ( R*sin[α] α h a x-X y-Y | y-Y x-X ) atan2 ( R*sin[α] α h a θ | y-Y x-X ) swap mod ( R*sin[α] α h mod(θ,a) | y-Y x-X ) swap - ( R*sin[α] α mod(θ,a)-h | y-Y x-X ) abs ( R*sin[α] α β | y-Y x-X ) over cos over sin * ( R*sin[α] α β cos[α]*sin[β] | y-Y x-X ) -rot ( R*sin[α] cos[α]*sin[β] α β | y-Y x-X ) cos swap sin * + ( R*sin[α] cos[α]*sin[β]+cos[β]*sin[α] | y-Y x-X ) / ( R*sin[α]/{cos[α]*sin[β]+cos[β]*sin[α]} | y-Y x-X ) r> 2 ** r> 2 ** + sqrt dup .23 < -rot - abs 1 swap - 199 ** ; : n t 10 mod floor 4 + ; .3 .35 .25 n edge-graph .5 .65 .25 n edge-graph .7 .35 .25 n edge-graph z+ z+
n-edge-graph
陳爽
'17 Mar 01
: n t 7 mod floor 3 + ; : 2pi/n 2 pi * n / ; : pi/n pi n / ; : spoke 2pi/n mod pi/n - abs ; : r ( x y -- r ) 2 ** swap 2 ** + .5 ** ; : a ( x y -- a ) swap atan2 ; : polar 2dup r -rot a ; : wedge dup cos 1.376 n 5 / 2 ** * \ adjust * swap sin - * .268 <= ; : gram spoke wedge ; : x x .5 - ; : y y .5 - ; x y polar ( r a ) over .4 < ( r a circle ) >r over .3 > ( r a hole ) >r pi 2 / - gram r> r>
Zap Redux
陳爽
'17 Feb 28
: 3dup >r 2dup r@ -rot r> ; : offset >r swap >r + r> r> + ; : between >r swap dup >r <= r> r> < and ; : hor >r .01 .09 between r> -.01 .01 between and ; : ver >r -.01 .01 between r> .01 .09 between and ; : off over <> r> and >r ; : sega >r 0 -.2 offset hor r> 1 >r 1 off 4 off drop r> and ; : segb >r -.1 -.1 offset ver r> 1 >r 5 off 6 off drop r> and ; : segc >r -.1 0 offset ver r> 1 >r 2 off drop r> and ; : segd >r hor r> 1 >r 1 off 4 off 7 off 9 off drop r> and ; : sege >r ver r> 1 >r 1 off 3 off 4 off 5 off 7 off 9 off drop r> and ; : segf >r 0 -.1 offset ver r> 1 >r 1 off 2 off 3 off 7 off drop r> and ; : segg >r 0 -.1 offset hor r> 1 >r 0 off 1 off 7 off drop r> and ; : digit 3dup sega >r 3dup segb r> or >r 3dup segc r> or >r 3dup segd r> or >r 3dup sege r> or >r 3dup segf r> or >r segg r> or ; : 2digit 3dup >r >r >r 10 / floor digit r> .14 - r> r> 10 mod floor digit or ; x .36 - y .4 - 24 2digit dup 0
24
FSD
'17 Feb 25
: d push x - dup * pop y - dup * + sqrt ; : r 2dup push push d 200 * x pop - y pop - atan2 20 * sin 3 * + sin ; : and + abs 2 mod ; .5 .5 r t 10 / dup push sin abs pop cos abs r xor dup dup
Moiré pattern generator #2 Redux
Anonymous
'17 Feb 23
: sq dup * ; : d sq swap sq + sqrt ; : s push - swap pop - 4dup d push atan2 0.01 * pop + 300 * sin ; .8 .4 x y s t sin abs t cos abs x y s + dup dup
Untitled Redux Redux Redux Redux
Anonymous
'17 Feb 23
: sq dup * ; : d sq swap sq + sqrt ; : s push - swap pop - 2dup d push atan2 0.01 * pop + 300 * sin * .5 ; .5 .5 x y s t sin abs t cos abs x y s + dup dup
Untitled Redux Redux Redux
Anonymous
'17 Feb 23
: sq dup * ; : d sq swap sq + sqrt ; : s push - swap pop - 2dup d push atan2 0.01 * pop + 300 * sin * cos / 4 ; .5 .5 x y s t sin abs t cos abs x y s + dup dup
Untitled Redux Redux
Anonymous
'17 Feb 23
: sq dup * ; : d sq swap sq + sqrt ; : s push - swap pop - 2dup d push atan2 0.01 * pop + 300 * sin * cos * 4 ; .5 .5 x y s t sin abs t cos abs x y s + dup dup
Untitled Redux
Anonymous
'17 Feb 23
: sq dup * ; : d sq swap sq + sqrt ; : s push - swap pop - 2dup d push atan2 0.01 * pop + 300 * sin ; .5 .5 x y s t sin abs t cos abs x y s + dup dup
Untitled
Anonymous
'17 Feb 23
: nip swap drop ; : sq dup * ; : offset >r swap >r + r> r> + ; : norm >r sq r> sq + sqrt ; : theta dup 0 >= if swap atan2 else >r negate r> negate swap atan2 pi + then ; : polar 2dup >r >r norm r> r> theta ; : spoke pi .4 * mod pi .2 * - abs ; : wedge dup >r cos 1.376 * r> sin - * .265 <= ; : gram spoke wedge ; x y -.5 -.5 offset polar pi 2 / - gram 0 0
Zap
Duke of New York
'17 Feb 22
y 16 * ceil x * floor 16 /
Interpolator
Manwe
'17 Feb 18
\ 圍棋 1 19 / 0 ! \ delta 0 @ 2 / 1 ! \ half delta 0 2 ! \ start t 3 @ not * 3 @ + 3 ! : 格線 2 @ - 0 @ mod 1 @ - abs .004 < ; : 格盤 ( 亮度 -- 盤 ) x 格線 y 格線 + * ; : 棋盤 0 @ 1 @ .2 格盤 1 @ 2 ! 0 @ 6 * 0 ! 0 @ 2 / 1 ! .1 格盤 + 2 @ -5 * 2 ! 0 @ 3 * 0 ! .3 格盤 + -rot 1 ! 0 ! ; 棋盤 : steps ( ns -- ) 2 + 6 ! t 3 @ - floor 4 ! 0 5 ! 0 ; : , ( p ix iy -- p' ) 0 @ * 1 @ - negate y + \ 任意點到落子位置的縱向距離 dup * swap 0 @ * 1 @ - negate x + \ 任意點到落子位置的橫向距離 dup * + sqrt \ 任意點到落子位置的距離 5 @ 2 mod \ 檢視 步數 是否 奇數 if .022 < \ 奇數步 取 白子 距離小於 .022 的圓 else dup .018 > swap .024 < * \ 偶數步 取 黑子 距離等於 .021 的圈 .006 線徑 then 4 @ 5 @ > * + \ 棋子下到棋盤 5 @ 1 + 5 ! \ 步數遞增 ; : 星位小飛 6 steps 16 16 , 17 14 , 14 16 , 18 16 , 17 17 , 17 11 , ; \ 星位小飛 ( 和平互圍 ) : 星位二間高夾 8 steps 16 04 , 14 03 , 11 04 , 14 05 , 17 06 , 16 02 , 17 03 , 11 02 , ; \ 星位二間高夾 ( 戰鬥夾攻 ) : 星位三三 13 steps 04 04 , 03 03 , 04 03 , 03 04 , 03 05 , 02 05 , 03 06 , 02 06 , 03 07 , 04 02 , 05 02 , 03 02 , 06 03 , ; \ 星位三三 ( 地勢兩分 ) : 星位混合互用 12 steps 04 16 , 06 17 , 08 17 , 03 17 , 04 17 , 03 16 , 04 15 , 04 18 , 05 18 , 03 18 , 05 17 , 03 14 , ; \ 星位混合互用 : cases_begin 9 ! 0 7 ! ; : case 8 @ 7 @ = * + 7 @ 1 + 7 ! ; : cases_end 4 @ 6 @ >= if 8 @ 1 + 9 @ mod 8 ! t 3 ! then ; 2 cases_begin 星位二間高夾 case 星位小飛 case cases_end
圍棋2
陳爽
'17 Feb 15
\ 圍棋 : n 19 ; \ n*n board : d 0 @ ; : d! 0 ! ; 1 n / d! \ delta : h 1 @ ; : h! 1 ! ; d 2 / h! \ half delta : s 2 @ ; : s! 2 ! ; 0 s! \ start : 格線 s - d mod h - abs .004 < ; : 格盤 ( 亮度 -- 盤 ) x 格線 y 格線 + * ; : 棋盤 d >r h >r .2 格盤 h s! d 6 * d! d 2 / h! .1 格盤 + s -5 * s! d 3 * d! .3 格盤 + r> h! r> d! ; 棋盤 : t0 3 @ ; : t0! 3 ! ; t t0 not * t0 + t0! \ t0 0 = if t t0! then : it 4 @ ; : it! 4 ! ; : is 5 @ ; : is! 5 ! ; : ns 6 @ ; : ns! 6 ! ; : ir 7 @ ; : ir! 7 ! ; : ic 8 @ ; : ic! 8 ! ; : nc 9 @ ; : nc! 9 ! ; : r ( ix iy -- r ) d * h - negate y + dup * swap d * h - negate x + dup * + sqrt ; : 之間 ( n a b -- a<=n<b ) >r over r> < >r >= r> and ; : 白子 r .022 < ; : 黑子 r .017 .025 之間 ; : steps ( ns -- ) 2 + ns! t t0 - floor it! 0 is! 0 ; : step ( p p' -- p" ) is it < * + is 1 + is! ; : 星位小飛 6 steps 16 16 黑子 step 17 14 白子 step 14 16 黑子 step 18 16 白子 step 17 17 黑子 step 17 11 白子 step ; \ 星位小飛 ( 和平互圍 ) : 星位二間高夾 8 steps 16 4 黑子 step 14 3 白子 step 11 4 黑子 step 14 5 白子 step 17 6 黑子 step 16 2 白子 step 17 3 黑子 step 11 2 白子 step ; \ 星位二間高夾 ( 戰鬥夾攻 ) : 星位三三 13 steps 4 4 黑子 step 3 3 白子 step 4 3 黑子 step 3 4 白子 step 3 5 黑子 step 2 5 白子 step 3 6 黑子 step 2 6 白子 step 3 7 黑子 step 4 2 白子 step 5 2 黑子 step 3 2 白子 step 6 3 黑子 step ; \ 星位三三 ( 地勢兩分 ) : 星位混合互用 12 steps 4 16 黑子 step 6 17 白子 step 8 17 黑子 step 3 17 白子 step 4 17 黑子 step 3 16 白子 step 4 15 黑子 step 4 18 白子 step 5 18 黑子 step 3 18 白子 step 5 17 黑子 step 3 14 白子 step ; \ 星位混合互用 : cases_begin nc! 0 ir! ; : case ic ir = * + ir 1 + ir! ; : cases_end it ns >= if ic 1 + nc mod ic! t t0! then ; 2 cases_begin 星位二間高夾 case 星位三三 case cases_end
圍棋
陳爽
'17 Feb 13
: ns 1.9 * .45 - 13 * ; : between? >r swap dup >r <= r> r> < and ; : canton? over .4 < over ns 6 13 between? and ; : union drop drop 0 .157 0.4 ; : stripes swap drop ns 2 mod 1 < if .75 .04 .188 else 1 1 1 then ; : flag canton? if union else stripes then ; : sky drop drop 0 .75 1 ; : frame dup .237 .763 between? if flag else sky then ; : wavy over t 2 / + 1 mod 4 * pi * cos .01 * + ; : zzz random dup dup ; t 7 mod 3 < if x y wavy frame else zzz then
Broadcast Day 2
FSD
'17 Jan 28
: no drop drop drop ; : ns y 0.237 - 1.9 * 13 * ; : h 0 ns <= ns 13 < and ; : s h if ns 2 mod 1 < if no .75 .04 .188 else no 1 1 1 then then ; : u 6 ns <= ns 13 < and x .4 < and if no 0 .157 0.4 then ; : f 0 .75 1 s u ; : zz random dup dup ; t 7 mod 2 < if f else zz then
Broadcast Day
FSD
'17 Jan 27
: norm dup * >r dup * r> + ; : r x 0.5 - y 0.5 - norm ; : wave pi * 2 * cos ; : wiggle over swap / wave 0.5 * + ; : c1 r 4 * t 3 wiggle - 1 mod wave ; : c2 r 2 * t 5 wiggle - 1 mod wave ; : c3 r 1 * t 7 wiggle - 1 mod wave ; c1 c2 c3
Supernova
FSD
'17 Jan 26
Next