Haiku Gallery

Flag of ROC 何祥祿
'25 Jul 10

Flag of ROC Redux 辛
'25 Jul 10

Flag of ROC Redux Redux 陳柏宇
'25 Jul 10

Flag of Tonga Redux 陳柏宇
'25 Jul 10

Flag of ROC 陳佳騰
'25 Jul 10

Titra Victtor
'25 Jul 10

Flag of ROC Redux Anonymous
'25 Jul 10

: 以十字顯示滑鼠位置
  crosshair+ drop ;
\ cx,cy 為 p,q 原點
\ 預設 cx,cy 為 滑鼠點的位置
: cx .5 ; : cy .5 ; \ 中心為原點
: 不顯示滑鼠位置 crosshair-
  drop ;
: 2pi pi pi + ; \ 2 倍 圓周率
: 2/ 2 / ; : 2* 2 * ; : 2+ 2 + ;
: 1+ 1 + ; : 1- 1 - ; : 2- 2 - ;
: 2^ 2 ** ;
: h- .5 - ; : h+ .5 + ;
: r ( -- r ) \ 中心 到 x,y 距離
  x h- 2 ** y h- 2 ** + sqrt ;
: a ( -- a ) \ 中心 到 x,y 角度
  y h- x h- atan2 pi + 2pi / ;
: p x cx - ; : q y cy - ;
: 角 ( -- 角 ) \ 原點 到 p,q 角度
  q p atan2 \ 值域 -pi 到 pi
  pi + 2pi / ; \ 對應 值域 0 到 1
: 距 ( -- 距 ) \ 原點 到 p,q 距離
  p 2 ** q 2 ** + sqrt ;
: 內 ( x v -- 區 ) < ; \ x<v 區
: 外 ( x v -- 區 ) > ; \ x>v 區
: 間 ( x L U -- 區 ) \ x 在 L U 間
  >r over r> < >r > r> and ;
: 圓 ( v -- 圓 ) 距 > ; \ 距<v 區
: 洞 ( v -- 洞 ) 距 < ; \ 距>v 區
: 線粗 .01 ;
: 線 ( r v d -- 線 ) \ r=v 線, d 粗細
  –rot - abs > ;
: 圈 ( v -- 圈 ) \ 距=v 線
  距 線 ;
: 反 ( v -- 1-v ) 1 swap - ;
: 暈 ( r v -- 暈 ) \ r=v 暈
  - .2 ** 反 ;
: 層 ( v n -- v ) \ v 的 n 層 對應值
  dup >r * dup 1 mod - r> 1 - / ;
: 層格 ( x y n -- v ) \ x,y 的 n*n 層格 對應值
  dup >r 層 swap r> 層 + 2 / ;
: 摺 ( v n -- v ) \ v 的 n 摺 對應值
  * 1 mod ;
: 摺格 ( x y n -- v ) \ x,y 的 n*n 摺格 對應值
  dup >r 摺 swap r@ 摺 * r@ 2 * r> / * ;
: 移 ( x n -- v ) - ; \ x向0方向回移n 
: 放 ( x n -- v ) * ; \ x區放大n倍
: 縮 ( x n -- v ) / ; \ x區縮小n倍
: 絕對 ( x -- v ) abs ; \ 取x的絕對值
: 負 ( x -- v ) negate ; \ 取x的負值
: 方 ( r -- b ) \ 內接圓半徑r的正方
  p abs over < swap q abs > * ;
: 兩點線 ( x1 y1 x2 y2 -- line )
  >r over r> ( x1 y1 x2 y1 y2 )
  - ( x1 y1 x2 y1-y2 )
  >r ( x1 y1 x2 )
  >r over r> ( x1 y1 x1 x2 )
  - ( x1 y1 x1-x2 ) dup
  if
   r> swap ( x1 y1 y1-y2 x1-x2 )
   / ( x1 y1 a )
   >r swap r@ * - r> ( b a )
   x * + y線粗 線
  else drop r> ( x1 y1 y1-y2 )
   if drop x線粗 線 
   else ( x1 y1 ) y線粗 線
    swap x線粗 線 *
   then
  then ; 
: 點角向 \ x1 y1 a -- 圖
  .25 - \ 向上
  1 mod
  2pi * \ 值域 -pi 到 pi
  >r y - swap x - atan2 r> +
  pi + cos ;
: 點角線 \ x0 y0 a -- 圖
  .25 - \ 向上
  1 mod
  2pi * \ 值域 -pi 到 pi
  >r
  2dup r@ 點角向
  -rot swap \ m y0 x0
  r@ sin x rot - * \ m y0 fx
  swap \ m fx y0
  r> cos y rot - * \ m fx fy
  + abs 1 - 線粗 2 / - 15000 **
  * ; \ m 角a心線 
( A. 圓圈洞 與 紅綠藍透
\ 以十字顯示滑鼠位置
  .1 圓 \ 半徑 0.1 圓 紅色面 r
  .2 圈 \ 半徑 0.2 圈 綠色面 g
  .3 洞 \ 半徑 0.3 洞 藍色面 b
  .4 圓 \ 半徑 0.4 圓 透視面 a
\ 建議: 數值 測試區間 0.0 到 0.5 )

( B. 距角內外間反
  以十字顯示滑鼠位置
\ 距 \ 原點 到 任意點 距離
\ 角 \ 原點 到 任意點 角度
  距 .2 內 \ 半徑 0.2 圓 紅
  距 .3 外 \ 半徑 0.3 洞 綠
  角 0 .1 間 \ 角度 -180 到 36 藍
\ .4 洞 反 \ 半徑 0.4 圓 透
\ 註1 洞 反 即是 圓, 圓 反 即是 洞
\ 註2 紅藍重疊變 紫, 綠藍重疊變 青
\ 建議: 距 測試區間 0.0 到 0.5
\ 建議: 角 測試區間 0.0 到 1.0 )

( C. xypq 間方
  以十字顯示滑鼠位置
\ x 左右 0 到 1
\ y 下上 0 到 1
\ p 左右 小於 cx 為負值
\ q 下上 小於 cy 為負值
  .1       方 \ 紅 cx,cy 心 .2 方
  x  .3 .7 間 \ 綠 
  q -.2 .2 間 \ 藍 cx 心 .4 寬帶
  .4       方 \ 透 cx,cy 心 .4 方
\ 建議: p q 測試區間 -0.5 到 0.5
\ 建議: x y 測試區間 0.0 到 1.0 )

( D. xyrapq距角 層格摺格
  以十字顯示滑鼠位置
  距 sin 角 t sin - 5 摺 +
\ y
\ p
\ q
  x 3 摺 y 3 摺 + 2 /
\ x y 9 摺格
\ x 9 層 y 9 層 + 2 /
\ x y 9 層格
\ x y + 2/
\ p q 9 層格
\ p 9 摺 q 9 摺 *
\ p q 9 摺格
\ p 9 層 q 9 層 * 4 *
\ 距 角 9 摺格
\ 距 9 摺 角 9 摺 *
\ 距 角 9 層格
\ 距 9 層 角 9 層 *
\ )
( E. 風扇
  以十字顯示滑鼠位置
\ 角 t 移 3 摺 \ 3葉扇正轉
\ 角 t 負 移 3 摺 \ 3葉扇反轉
: 風扇
  角 t 5 / - 4 摺 \ 紅 4葉風扇正轉
  dup \ 綠 \ 與紅重疊變黃
  0 \ 無 藍
  距 8 層 反  .45 圓 *  \ 透視
; 風扇
\ )

( F. x 函數 等於 y 隨 t 移 的線
  不顯示滑鼠位置
  : t t 5 縮 ; \ t 區縮小 5 倍
  : x x t 移 ; \ x 原點 隨 t 移
  : x x 2pi 放 1 放 ; \ x 區放大
  : y y .5 移 ; \ y 原點 移到中間
  : y y 5 放 ; \ y 區放大 5 倍
  : f x sin ; \ f 為 x 的 函數
  f y 線 \ f 等於 y 的線
  f y 暈 \ f 等於 y 的暈
\ 建議: 改變縮放倍數測試效果 )

( G. 時鐘
  不顯示滑鼠位置
: 秒 t floor ; \ 捨小數 取整數 
: 分 t 60 / ;
: 時 t 3600 / ;
: r \ 中心到 x,y 的距離, 1 到邊
  x .5 - dup * y .5 - dup *
  + sqrt ;
: a \ 中心到 x,y 的角度, 0 到 1
  y .5 - x .5 - atan2
  pi + pi / 2 / ;
\ 中心發 角 t 線
: 格 \ t n -- 線
/ .25 - \ 0 向上
  2pi * \ 值域 -pi 到 pi
  >r \ 角度儲存備用
  r@ sin x .5 - *
  r@ cos y .5 - *
  + abs 1.005 - 150 ** \ 角a 心線 
  r> 2pi / a + .5 - 2pi * cos *
 ; \ 去 角a+pi 線
: 秒針
  秒 60 格 \ 每秒走 1/60 圈
  r .05 .37 間 * \ 秒針起訖端點
  r .03 .05 間 + \ 中心紅圈
; 秒針 \ 顯示 紅色秒針
: 秒標 60 2pi * \ 60 週期
  a * cos \ 餘旋波
  .93 > \ 振幅大於.93 設定 時標 長
  r .41 .43 間 * \ 設定 秒標 寬
; 秒標 + \ 紅色秒標
: 分針
  分 60 格 \ 每分走 1/60 圈
  r .07 .32 間 * \ 分針起訖端點
  r .05 .07 間 + \ 中心綠圈
; 分針 \ 顯示 綠色分針
: 時標 12 2pi * \ 12 週期
  a * cos \ 餘旋波
  .97 > \ 振幅大於.97 設定 時標 長
  r .41 .425 間 * \ 設定 時標 寬
; 時標 + \ 綠色時標
: 時針
  時 12 格 \ 每時走 1/12 圈
  r .09 .3 間 * \ 時針起訖端點
  r .07 .09 間 + \ 中心藍圈
; 時針 \ 顯示 藍色時針
: 框 \ v -- 框
  x    y    * .001 > * \ 右下黑
  x 反 y    * .001 > * \ 左下黑
  x    y 反 * .001 > * \ 右上黑
  x 反 y 反 * .001 > * \ 左上黑
;
 .5 框 \ 亮度 .5
\ 藍色盤面 \\\\\\\\\\\\\\\\\\\
 .3 \ 亮度 .3
 x    y    * .009 > * \ 右下紅
 x 反 y    * .009 > * \ 左下紅
 x    y 反 * .009 > * \ 右上紅
 x 反 y 反 * .009 > * \ 左上紅
 + \ 增中間亮度為 .8
 .2 \ 綠色亮度 .2
 x    y    * .022 > * \ 右下紅
 x 反 y    * .022 > * \ 左下紅
 x    y 反 * .022 > * \ 右上紅
 x 反 y 反 * .022 > * \ 左上紅
 + \ 增中間紅色亮度為 1
 r .39 > *
 + \ 半徑 .39 洞
 1 框
\ )

( H 從點 x,y 向角 a 發出的線

: x1 .1 ; : y1 .4 ;
: x2 .6 ; : y2 .8 ;
: a1 x2 x1 - y2 y1 - atan2
  2pi / ;
\ 紅色參考格線
  x 10 摺 .05 <
  y 10 摺 .05 < +
\ 紅色點角線
\ .5 .5 a1 點角線 +
\ 綠色兩點線
\ x1 y1 x2 y2 兩點線
\ 藍色兩點區間
\ x1 y1 a1 .5 + 點角向
\ x2 y2 a1 點角向 * *
\ )

Untitled x
'25 Jul 10

: 以十字顯示滑鼠位置
  crosshair+ drop ;
\ cx,cy 為 p,q 原點
\ 預設 cx,cy 為 滑鼠點的位置
: cx .5 ; : cy .5 ; \ 中心為原點
: 不顯示滑鼠位置 crosshair-
  drop ;
: 2pi pi pi + ; \ 2 倍 圓周率
: 2/ 2 / ; : 2* 2 * ; : 2+ 2 + ;
: 1+ 1 + ; : 1- 1 - ; : 2- 2 - ;
: 2^ 2 ** ;
: h- .5 - ; : h+ .5 + ;
: r ( -- r ) \ 中心 到 x,y 距離
  x h- 2 ** y h- 2 ** + sqrt ;
: a ( -- a ) \ 中心 到 x,y 角度
  y h- x h- atan2 pi + 2pi / ;
: p x cx - ; : q y cy - ;
: 角 ( -- 角 ) \ 原點 到 p,q 角度
  q p atan2 \ 值域 -pi 到 pi
  pi + 2pi / ; \ 對應 值域 0 到 1
: 距 ( -- 距 ) \ 原點 到 p,q 距離
  p 2 ** q 2 ** + sqrt ;
: 內 ( x v -- 區 ) < ; \ x<v 區
: 外 ( x v -- 區 ) > ; \ x>v 區
: 間 ( x L U -- 區 ) \ x 在 L U 間
  >r over r> < >r > r> and ;
: 圓 ( v -- 圓 ) 距 > ; \ 距<v 區
: 洞 ( v -- 洞 ) 距 < ; \ 距>v 區
: 線粗 .01 ;
: 線 ( r v d -- 線 ) \ r=v 線, d 粗細
  –rot - abs > ;
: 圈 ( v -- 圈 ) \ 距=v 線
  距 線 ;
: 反 ( v -- 1-v ) 1 swap - ;
: 暈 ( r v -- 暈 ) \ r=v 暈
  - .2 ** 反 ;
: 層 ( v n -- v ) \ v 的 n 層 對應值
  dup >r * dup 1 mod - r> 1 - / ;
: 層格 ( x y n -- v ) \ x,y 的 n*n 層格 對應值
  dup >r 層 swap r> 層 + 2 / ;
: 摺 ( v n -- v ) \ v 的 n 摺 對應值
  * 1 mod ;
: 摺格 ( x y n -- v ) \ x,y 的 n*n 摺格 對應值
  dup >r 摺 swap r@ 摺 * r@ 2 * r> / * ;
: 移 ( x n -- v ) - ; \ x向0方向回移n 
: 放 ( x n -- v ) * ; \ x區放大n倍
: 縮 ( x n -- v ) / ; \ x區縮小n倍
: 絕對 ( x -- v ) abs ; \ 取x的絕對值
: 負 ( x -- v ) negate ; \ 取x的負值
: 方 ( r -- b ) \ 內接圓半徑r的正方
  p abs over < swap q abs > * ;
: 兩點線 ( x1 y1 x2 y2 -- line )
  >r over r> ( x1 y1 x2 y1 y2 )
  - ( x1 y1 x2 y1-y2 )
  >r ( x1 y1 x2 )
  >r over r> ( x1 y1 x1 x2 )
  - ( x1 y1 x1-x2 ) dup
  if
   r> swap ( x1 y1 y1-y2 x1-x2 )
   / ( x1 y1 a )
   >r swap r@ * - r> ( b a )
   x * + y線粗 線
  else drop r> ( x1 y1 y1-y2 )
   if drop x線粗 線 
   else ( x1 y1 ) y線粗 線
    swap x線粗 線 *
   then
  then ; 
: 點角向 \ x1 y1 a -- 圖
  .25 - \ 向上
  1 mod
  2pi * \ 值域 -pi 到 pi
  >r y - swap x - atan2 r> +
  pi + cos ;
: 點角線 \ x0 y0 a -- 圖
  .25 - \ 向上
  1 mod
  2pi * \ 值域 -pi 到 pi
  >r
  2dup r@ 點角向
  -rot swap \ m y0 x0
  r@ sin x rot - * \ m y0 fx
  swap \ m fx y0
  r> cos y rot - * \ m fx fy
  + abs 1 - 線粗 2 / - 15000 **
  * ; \ m 角a心線 
( A. 圓圈洞 與 紅綠藍透
\ 以十字顯示滑鼠位置
  .1 圓 \ 半徑 0.1 圓 紅色面 r
  .2 圈 \ 半徑 0.2 圈 綠色面 g
  .3 洞 \ 半徑 0.3 洞 藍色面 b
  .4 圓 \ 半徑 0.4 圓 透視面 a
\ 建議: 數值 測試區間 0.0 到 0.5 )

( B. 距角內外間反
  以十字顯示滑鼠位置
\ 距 \ 原點 到 任意點 距離
\ 角 \ 原點 到 任意點 角度
  距 .2 內 \ 半徑 0.2 圓 紅
  距 .3 外 \ 半徑 0.3 洞 綠
  角 0 .1 間 \ 角度 -180 到 36 藍
\ .4 洞 反 \ 半徑 0.4 圓 透
\ 註1 洞 反 即是 圓, 圓 反 即是 洞
\ 註2 紅藍重疊變 紫, 綠藍重疊變 青
\ 建議: 距 測試區間 0.0 到 0.5
\ 建議: 角 測試區間 0.0 到 1.0 )

( C. xypq 間方
  以十字顯示滑鼠位置
\ x 左右 0 到 1
\ y 下上 0 到 1
\ p 左右 小於 cx 為負值
\ q 下上 小於 cy 為負值
  .1       方 \ 紅 cx,cy 心 .2 方
  x  .3 .7 間 \ 綠 
  q -.2 .2 間 \ 藍 cx 心 .4 寬帶
  .4       方 \ 透 cx,cy 心 .4 方
\ 建議: p q 測試區間 -0.5 到 0.5
\ 建議: x y 測試區間 0.0 到 1.0 )

( D. xyrapq距角 層格摺格
  以十字顯示滑鼠位置
  距 sin 角 t sin - 5 摺 +
\ y
\ p
\ q
  x 3 摺 y 3 摺 + 2 /
\ x y 9 摺格
\ x 9 層 y 9 層 + 2 /
\ x y 9 層格
\ x y + 2/
\ p q 9 層格
\ p 9 摺 q 9 摺 *
\ p q 9 摺格
\ p 9 層 q 9 層 * 4 *
\ 距 角 9 摺格
\ 距 9 摺 角 9 摺 *
\ 距 角 9 層格
\ 距 9 層 角 9 層 *
\ )
( E. 風扇
  以十字顯示滑鼠位置
\ 角 t 移 3 摺 \ 3葉扇正轉
\ 角 t 負 移 3 摺 \ 3葉扇反轉
: 風扇
  角 t 5 / - 4 摺 \ 紅 4葉風扇正轉
  dup \ 綠 \ 與紅重疊變黃
  0 \ 無 藍
  距 8 層 反  .45 圓 *  \ 透視
; 風扇
\ )

( F. x 函數 等於 y 隨 t 移 的線
  不顯示滑鼠位置
  : t t 5 縮 ; \ t 區縮小 5 倍
  : x x t 移 ; \ x 原點 隨 t 移
  : x x 2pi 放 1 放 ; \ x 區放大
  : y y .5 移 ; \ y 原點 移到中間
  : y y 5 放 ; \ y 區放大 5 倍
  : f x sin ; \ f 為 x 的 函數
  f y 線 \ f 等於 y 的線
  f y 暈 \ f 等於 y 的暈
\ 建議: 改變縮放倍數測試效果 )

( G. 時鐘
  不顯示滑鼠位置
: 秒 t floor ; \ 捨小數 取整數 
: 分 t 60 / ;
: 時 t 3600 / ;
: r \ 中心到 x,y 的距離, 1 到邊
  x .5 - dup * y .5 - dup *
  + sqrt ;
: a \ 中心到 x,y 的角度, 0 到 1
  y .5 - x .5 - atan2
  pi + pi / 2 / ;
\ 中心發 角 t 線
: 格 \ t n -- 線
/ .25 - \ 0 向上
  2pi * \ 值域 -pi 到 pi
  >r \ 角度儲存備用
  r@ sin x .5 - *
  r@ cos y .5 - *
  + abs 1.005 - 150 ** \ 角a 心線 
  r> 2pi / a + .5 - 2pi * cos *
 ; \ 去 角a+pi 線
: 秒針
  秒 60 格 \ 每秒走 1/60 圈
  r .05 .37 間 * \ 秒針起訖端點
  r .03 .05 間 + \ 中心紅圈
; 秒針 \ 顯示 紅色秒針
: 秒標 60 2pi * \ 60 週期
  a * cos \ 餘旋波
  .93 > \ 振幅大於.93 設定 時標 長
  r .41 .43 間 * \ 設定 秒標 寬
; 秒標 + \ 紅色秒標
: 分針
  分 60 格 \ 每分走 1/60 圈
  r .07 .32 間 * \ 分針起訖端點
  r .05 .07 間 + \ 中心綠圈
; 分針 \ 顯示 綠色分針
: 時標 12 2pi * \ 12 週期
  a * cos \ 餘旋波
  .97 > \ 振幅大於.97 設定 時標 長
  r .41 .425 間 * \ 設定 時標 寬
; 時標 + \ 綠色時標
: 時針
  時 12 格 \ 每時走 1/12 圈
  r .09 .3 間 * \ 時針起訖端點
  r .07 .09 間 + \ 中心藍圈
; 時針 \ 顯示 藍色時針
: 框 \ v -- 框
  x    y    * .001 > * \ 右下黑
  x 反 y    * .001 > * \ 左下黑
  x    y 反 * .001 > * \ 右上黑
  x 反 y 反 * .001 > * \ 左上黑
;
 .5 框 \ 亮度 .5
\ 藍色盤面 \\\\\\\\\\\\\\\\\\\
 .3 \ 亮度 .3
 x    y    * .009 > * \ 右下紅
 x 反 y    * .009 > * \ 左下紅
 x    y 反 * .009 > * \ 右上紅
 x 反 y 反 * .009 > * \ 左上紅
 + \ 增中間亮度為 .8
 .2 \ 綠色亮度 .2
 x    y    * .022 > * \ 右下紅
 x 反 y    * .022 > * \ 左下紅
 x    y 反 * .022 > * \ 右上紅
 x 反 y 反 * .022 > * \ 左上紅
 + \ 增中間紅色亮度為 1
 r .39 > *
 + \ 半徑 .39 洞
 1 框
\ )

\ H 從點 x,y 向角 a 發出的線

: x1 .1 ; : y1 .4 ;
: x2 .6 ; : y2 .8 ;
: a1 x2 x1 - y2 y1 - atan2
  2pi / ;
\ 紅色參考格線
  x 10 摺 .05 <
  y 10 摺 .05 < +
\ 紅色點角線
\ .5 .5 a1 點角線 +
\ 綠色兩點線
\ x1 y1 x2 y2 兩點線
\ 藍色兩點區間
\ x1 y1 a1 .5 + 點角向
\ x2 y2 a1 點角向 * *
\ )

Untitled 距 .3 <
'25 Jul 10

glow snow 陳暘Justin
'25 Jul 10

ray 陳暘Justin
'25 Jul 10

illusion 迷幻 賴睿麒
'25 Jul 10

Hallucination 幻象 賴睿麒 Ricky Lai
'25 Jul 10

Hallucination 賴睿麒Ricky Lai
'25 Jul 10

умирающая звезда ViKKtor
'25 Jul 10

PACMAN Redux Anonymous
'25 Jul 10

Disco Redux Anonymous
'25 Jul 10

Flag of Mnaco Redux Anonymous
'25 Jul 10

my-first-prog ViKKtor
'25 Jul 10

\ 點線測試 ( 過兩點直線維持 固定粗細 )

: 線粗 .01 ;

\ 2 倍 圓周率
: 2pi pi pi + ;

\ 從 rstack 取出 a b 到 dstack
: 2>r \ a b ; -- ; b a
  >r >r ;

\ 從 rstack 取出 a b 到 dstack
: 2r> \ ; b a -- a b ;
  r> r> ;

\ 從 rstack 複製 a b 到 dstack
: 2r@ \ ; b a -- a b ;
  r> dup r@ rot >r ;

\ dstack 上 兩對數 位置互換
: 2swap \ a b c d -- c d a b
  >r -rot r> -rot ;

\ 複製 dstack 第二對數
: 2over \ a b c d -- a b c d a b
  2>r 2dup 2r> 2swap ;

\ 複製 dstack 上 4 個數
\ ( a b c d -- a b c d a b c d )
: 4dup 2over 2over ;

\ v"=L if v<L, v"=U if v>U
: 間 ( v L U -- v" )
  2dup > if swap then
  >r ( v L )
  max r> ( v' U )
  min ( v" ) ;
 
\ 0 到 1 變化的 f 放大 n 倍取 小數
: 摺 ( f n -- f ) \ f 的 n 摺
  * 1 mod ;

\ f 等於 v 的 線
: 線 ( f v d -- 線 ) \ f=v 線
  -rot - abs > ;

\ 過 x1,y1 與 x2,y2 的 直線 或 點
: 兩點線 ( x1 y1 x2 y2 -- 線 )
  >r over r> ( x1 y1 x2 y1 y2 )
  - ( x1 y1 x2 y1-y2 )
  >r ( x1 y1 x2 )
  >r over r> ( x1 y1 x1 x2 )
  - ( x1 y1 x1-x2 ) dup
  if \ x1-x2<>0 非垂直線
   r> swap ( x1 y1 y1-y2 x1-x2 )
   / ( x1 y1 斜率 )
   >r swap r@ * - ( y軸交點 )
   r@ ( y軸交點 斜率 )
   x * + y ( y軸交點+斜率*x y )
   r> 2 ** 1 + sqrt
 \ 線粗修正係數 斜率平方加一後開根號
   線粗 2 / * 線
  else \ x1-x2=0 垂直線 或 一個點
   drop r> ( x1 y1 y1-y2 )
   if \ y1-y2<>0 垂直線
    drop x ( x1 x ) 線粗 2 / 線 
   else \ y1-y2=0 一個點
    ( x1 y1 ) y 線粗 2 / 線 swap x 線粗 2 / 線 *
   then
  then ;

\ 在點 p1 角度為 a1 的 方向
: 點角向 \ x1 y1 a1 -- 方向
  .25 - \ 向上
  2pi * \ 值域 -pi 到 pi
  >r y - 
  swap x - atan2 r> +
  pi + cos
  dup 0 < if drop 0 then ;

\ 在點 p1 角度為 a1 方向 的 線
: 點角線 \ x1 y1 a1 -- 線
  >r
  2dup r@ .5 + 點角向
  -rot swap \ m y1 x1
  r> .25 - \ 向上
  2pi * \ 值域 -pi 到 pi
  dup >r
  sin x rot - * \ m y1 fx
  swap \ m fx y1
  r> cos y rot - * \ m fx fy
  + abs 1.003 - 200 **
  \ m 角a心線 
  * 0 1 間 ;

\ p1 到 p2 的連線 角度
: 兩點角 ( x1 y1 x2 y2 -- 角 )
  >r swap r> - \ x1 x2 y1-y2
  -rot - swap \ x1-x2 y1-y2
  atan2 2pi / ;

\ p1 到 p2 的連線 方向
: 兩點向 2over 兩點角 點角向 ;

\ p1 到 p2 的連線
: 兩點連線 \ x1 y1 x2 y2 -- 線
  4dup 兩點線 \ x1 y1 x2 y2 線
  >r \ x1 y1 x2 y2
  4dup 兩點向 \ x1 y1 x2 y2 向1
  >r \ x1 y1 x2 y2
  2swap 兩點向 \ 向2
  r> r> * * ;

\ p0 x0,y0 到 任意點 p x,y 的 距離
: r \ x0 y0 -- r
  y - dup * swap x - dup *
  + sqrt ;

\ p0 x0,y0 到 任意點 p x,y 的 角度
: a \ x0 y0 -- a
  y swap - swap x swap - atan2
  2pi / ;

\ 中心點 p0 及 測試點 p1 p2 p3
: p0 .5 .5 ; : p1 .6 .8 ;
: p2 .1 .4 ; : p3 .7 .2 ;

0 \ 紅色亮度 0

\ ( 測試0 底圖 10*10 格線
: 底圖格線
  x 10 摺 .05 <  y 10 摺 .05 <
  + ;
  底圖格線 +
\ )

\ ( 測試1 p1 與 p2 的連線
  p1 p2 兩點連線 +
\ )

\ ( 測試2 p0 線 與 p1 到 p2 同方向 
: a1 p1 p2 兩點角 ;
  p0 a1   \ t 10 / +      \ 順時鐘慢轉
  點角線  \ p0 r .5 < * \ 長度 .5
  +
\ )

\ ( 測試3 p2 與 p3 的連線
  p2 p3 兩點線
  p2 p3 兩點向
  p3 p2 兩點向 * * +
\ )

\ ( 測試4 p1 與 p3 的連線
: a3 p3 p1   兩點角 ;
  p1 p3      兩點線
  p1 a3      點角向 * 
  p3 a3 .5 + 點角向 * +
\ )

\ ( 測試5 圓與洞
: 圓 r .03 < ;
: 反 1 swap - ;
: 洞 圓 反 ;
  p0 圓 + p1 圓 - p2 圓 -
0 p1 圓 +
0 p2 圓 +
0 p3 洞 +
\ )

點線測試 Redux 陳爽
'25 Jul 10

Pulse Beetle
'25 Jul 10

抽象畫 陳爽
'25 Jul 10

\ 點線測試

\ 2 倍 圓周率
: 2pi pi pi + ;

\ 從 rstack 取出 a b 到 dstack
: 2>r \ a b ; -- ; b a
  >r >r ;

\ 從 rstack 取出 a b 到 dstack
: 2r> \ ; b a -- a b ;
  r> r> ;

\ 從 rstack 複製 a b 到 dstack
: 2r@ \ ; b a -- a b ;
  r> dup r@ rot >r ;

\ dstack 上 兩對數 位置互換
: 2swap \ a b c d -- c d a b
  >r -rot r> -rot ;

\ 複製 dstack 第二對數
: 2over \ a b c d -- a b c d a b
  2>r 2dup 2r> 2swap ;

\ 複製 dstack 上 4 個數
\ ( a b c d -- a b c d a b c d )
: 4dup 2over 2over ;

\ v"=L if v<L, v"=U if v>U
: 間 ( v L U -- v" )
  2dup > if swap then
  >r ( v L )
  max r> ( v' U )
  min ( v" ) ;
 
\ 0 到 1 變化的 f 放大 n 倍取 小數
: 摺 ( f n -- f ) \ f 的 n 摺
  * 1 mod ;

: 線粗 .02 ;

\ f 等於 v 的 線
: 線 ( f v -- 線 ) \ f=v 線
  - abs 線粗 2 / < ;

\ 過 x1,y1 與 x2,y2 的 直線 或 點
: 兩點線 ( x1 y1 x2 y2 -- 線 )
  >r over r> ( x1 y1 x2 y1 y2 )
  - ( x1 y1 x2 y1-y2 )
  >r ( x1 y1 x2 )
  >r over r> ( x1 y1 x1 x2 )
  - ( x1 y1 x1-x2 ) dup
  if \ x1-x2<>0 非垂直線
   r> swap ( x1 y1 y1-y2 x1-x2 )
   / ( x1 y1 斜率 )
   >r swap r@ * - ( y軸交點 )
   r> ( y軸交點 斜率 )
   x * + y ( y軸交點+斜率*x y )
   線
  else \ x1-x2=0 垂直線 或 一個點
   drop r> ( x1 y1 y1-y2 )
   if \ y1-y2<>0 垂直線
    drop x ( x1 x ) 線 
   else \ y1-y2=0 一個點
    ( x1 y1 ) y 線 swap x 線 *
   then
  then ;

\ 在點 p1 角度為 a1 的 方向
: 點角向 \ x1 y1 a1 -- 方向
  .25 - \ 向上
  2pi * \ 值域 -pi 到 pi
  >r y - 
  swap x - atan2 r> +
  pi + cos
  dup 0 < if drop 0 then ;

\ 在點 p1 角度為 a1 方向 的 線
: 點角線 \ x1 y1 a1 -- 線
  >r
  2dup r@ .5 + 點角向
  -rot swap \ m y1 x1
  r> .25 - \ 向上
  2pi * \ 值域 -pi 到 pi
  dup >r
  sin x rot - * \ m y1 fx
  swap \ m fx y1
  r> cos y rot - * \ m fx fy
  + abs 1.005 - 200 **
  \ m 角a心線 
  * 0 1 間 ;

\ p1 到 p2 的連線 角度
: 兩點角 ( x1 y1 x2 y2 -- 角 )
  >r swap r> - \ x1 x2 y1-y2
  -rot - swap \ x1-x2 y1-y2
  atan2 2pi / ;

\ p1 到 p2 的連線 方向
: 兩點向 2over 兩點角 點角向 ;

\ p1 到 p2 的連線
: 兩點連線 \ x1 y1 x2 y2 -- 線
  4dup 兩點線 \ x1 y1 x2 y2 線
  >r \ x1 y1 x2 y2
  4dup 兩點向 \ x1 y1 x2 y2 向1
  >r \ x1 y1 x2 y2
  2swap 兩點向 \ 向2
  r> r> * * ;

\ p0 x0,y0 到 任意點 p x,y 的 距離
: r \ x0 y0 -- r
  y - dup * swap x - dup *
  + sqrt ;

\ p0 x0,y0 到 任意點 p x,y 的 角度
: a \ x0 y0 -- a
  y swap - swap x swap - atan2
  2pi / ;

\ 中心點 p0 及 測試點 p1 p2 p3
: p0 .5 .5 ; : p1 .6 .8 ;
: p2 .1 .4 ; : p3 .9 .2 ;

0 \ 紅色亮度 0

\ ( 測試0 底圖 10*10 格線
: 底圖格線
  x 10 摺 .05 <  y 10 摺 .05 <
  + ;
  底圖格線 +
\ )

\ ( 測試1 p1 與 p2 的連線
  p1 p2 兩點連線 +
\ )

\ ( 測試2 p0 線 與 p1 到 p2 同方向 
: a1 p1 p2 兩點角 ;
  p0 a1 點角線 +
\ )

\ ( 測試3 p2 與 p3 的連線
  p2 p3 兩點線
  p2 p3 兩點向
  p3 p2 兩點向 * * +
\ )

\ ( 測試4 p1 與 p3 的連線
: a3 p3 p1   兩點角 ;
  p1 p3      兩點線
  p1 a3      點角向 * 
  p3 a3 .5 + 點角向 * +
\ )

\ ( 測試5 圓與洞
: 圓 r .03 < ;
: 反 1 swap - ;
: 洞 圓 反 ;
  p0 圓 + p1 圓 - p2 圓 -
0 p1 圓 +
0 p2 圓 +
0 p3 洞 +
\ )

點線測試 陳爽
'25 Jul 10

Spaceport Chaos Redux (Cryptotext) DarkstarAG
'25 Jul 10

: 2pi pi pi + ; \ 2 倍 圓周率
: 2/ 2 / ; : 1- 1 - ;
: 線 ( r v -- 線 ) \ r=v 線
  - abs .01 < ;

: 摺 ( v n -- v ) \ v 的 n 摺 對應值
  * 1 mod ;

: 兩點線 ( x1 y1 x2 y2 -- line )
  >r over r> ( x1 y1 x2 y1 y2 )
  - ( x1 y1 x2 y1-y2 )
  >r ( x1 y1 x2 )
  >r over r> ( x1 y1 x1 x2 )
  - ( x1 y1 x1-x2 ) dup
  if
   r> swap ( x1 y1 y1-y2 x1-x2 )
   / ( x1 y1 a )
   >r swap r@ * - r> ( b a )
   x * + y 線 
  else drop r> ( x1 y1 y1-y2 )
   if drop x 線 
   else ( x1 y1 ) y 線
    swap x 線 *
   then
  then ;
: 線粗 .01 ;
: 點角向 \ x1 y1 a -- 圖
  .25 - \ 向上
  1 mod
  2pi * \ 值域 -pi 到 pi
  >r y - swap x - atan2 r> +
  pi + cos ;
: 點角線 \ x0 y0 a -- 圖
  .25 - \ 向上
  1 mod
  2pi * \ 值域 -pi 到 pi
  >r
  2dup r@ 點角向
  -rot swap \ m y0 x0
  r@ sin x rot - * \ m y0 fx
  swap \ m fx y0
  r> cos y rot - * \ m fx fy
  + abs 1- 線粗 2/ - 15000 **
  \ m 角a心線 
  * ;

: x1 .1 ; : y1 .4 ;
: x2 .6 ; : y2 .8 ;
: a1 x2 x1 - y2 y1 - atan2
  2pi / ;
\ 紅色參考格線
  x 10 摺 .05 <
  y 10 摺 .05 < +
\ 綠色點角線
  .5 .5 a1 點角線 +
\ 綠色兩點線
  x1 y1 x2 y2 兩點線
\ 藍色兩點區間
  x1 y1 a1 .5 + 點角向
  x2 y2 a1 點角向 *
\ )

兩點線 陳爽
'25 Jul 10

Check NaN and INF in code 3 DarkstarAG
'25 Jul 10

Check NaN and INFINITY in code Redux DarkstarAG
'25 Jul 10

Check NaN and INFINITY in code DarkstarAG
'25 Jul 10

\ F. 時鐘
: 秒 t floor ; \ 捨小數 取整數 
: 分 t 60 / ;
: 時 t 3600 / ;
: 2pi pi pi + ;
: 反 1 swap - ;
: 間 ( x L U -- b ) \ x 在 L U 間
  >r over r> < >r > r> and ;
: r \ 中心到 x,y 的距離, 1 到邊
  x .5 - dup * y .5 - dup *
  + sqrt ;
: a \ 中心到 x,y 的角度, 0 到 1
  y .5 - x .5 - atan2
  pi + pi / 2 / ;
: 格 ( t -- 線 ) \ 中心發 角a線
  / .25 + \ 0 向上
  1 mod .5 - \ 值域 -1 到 1
  2pi * \ 值域 -pi 到 pi
  >r \ 角度儲存備用
  r@ sin x .5 - *
  r@ cos y .5 - *
  + abs 1 - 150 ** \ 角 a 中心線 
  r> 2pi / a + .5 - 2pi * cos
  * ; \ 去除 角 a+pi 線段
: 秒針
  秒 60 格 \ 每秒走 1/60 圈
  r .05 .37 間 * \ 秒針起訖端點
  r .03 .05 間 + \ 中心紅圈
; 秒針 \ 顯示 紅色秒針
: 秒標 60 2pi * \ 60 週期
  a * cos \ 餘旋波
  .97 > \ 振幅大於.97 設定 時標 長
  r .41 .425 間 * \ 設定 時標 寬
; 秒標 + \ 紅色秒標
: 分針
  分 60 格 \ 每分走 1/60 圈
  r .07 .32 間 * \ 分針起訖端點
  r .05 .07 間 + \ 中心綠圈
; 分針 \ 顯示 綠色分針
: 時標 12 2pi * \ 12 週期
  a * cos \ 餘旋波
  .97 > \ 振幅大於.97 設定 時標 長
  r .41 .425 間 * \ 設定 時標 寬
; 時標 + \ 綠色時標
: 時針
  時 12 格 \ 每時走 1/12 圈
  r .09 .3 間 * \ 時針起訖端點
  r .07 .09 間 + \ 中心藍圈
; 時針 \ 顯示 藍色時針
: 框 ( v -- 框 )
  x    y    * .001 > * \ 右下黑
  x 反 y    * .001 > * \ 左下黑
  x    y 反 * .001 > * \ 右上黑
  x 反 y 反 * .001 > * \ 左上黑
; .5 框 \ 亮度 .5
\ 藍色盤面 \\\\\\\\\\\\\\\\\\\
 .3 \ 亮度 .3
 x    y    * .009 > * \ 右下紅
 x 反 y    * .009 > * \ 左下紅
 x    y 反 * .009 > * \ 右上紅
 x 反 y 反 * .009 > * \ 左上紅
 + \ 增中間亮度為 .8
 .2 \ 綠色亮度 .2
 x    y    * .022 > * \ 右下紅
 x 反 y    * .022 > * \ 左下紅
 x    y 反 * .022 > * \ 右上紅
 x 反 y 反 * .022 > * \ 左上紅
 + \ 增中間紅色亮度為 1
 r .39 > * + \ 半徑 .39 洞
1 框

時鐘 Redux 陳爽
'25 Jul 10

\ F. 時鐘
: 秒 t floor ; \ 捨小數 取整數 
: 分 t 60 / ;
: 時 t 3600 / ;
: 2pi pi pi + ;
: 反 1 swap - ;
: 間 ( x L U -- b ) \ x 在 L U 間
  >r over r> < >r > r> and ;
: r \ 中心到 x,y 的距離, 1 到邊
  x .5 - dup * y .5 - dup *
  + sqrt ;
: a \ 中心到 x,y 的角度, 0 到 1
  y .5 - x .5 - atan2
  pi + pi / 2 / ;
: 格 ( t -- 線 ) \ 中心發 角a線
  / .25 + \ 0 向上
  1 mod .5 - \ 值域 -1 到 1
  2pi * \ 值域 -pi 到 pi
  >r \ 角度儲存備用
  r@ sin x .5 - *
  r@ cos y .5 - *
  + abs 1 - 150 ** \ 角 a 中心線 
  r> 2pi / a + .5 - 2pi * cos
  * ; \ 去除 角 a+pi 線段
: 秒針
  秒 60 格 \ 每秒走 1/60 圈
  r .05 .37 間 * \ 秒針起訖端點
  r .03 .05 間 + \ 中心紅圈
; 秒針 \ 顯示 紅色秒針
: 分針
  分 60 格 \ 每分走 1/60 圈
  r .07 .32 間 * \ 分針起訖端點
  r .05 .07 間 + \ 中心綠圈
; 分針 \ 顯示 綠色分針
: 時標 12 2pi * \ 12 週期
  a * cos \ 餘旋波
  .97 > \ 振幅大於.97 設定 時標 長
  r .41 .425 間 * \ 設定 時標 寬
; 時標 + \ 綠色時標
: 時針
  時 12 格 \ 每時走 1/12 圈
  r .09 .3 間 * \ 時針起訖端點
  r .07 .09 間 + \ 中心藍圈
; 時針 \ 顯示 藍色時針
: 框 ( v -- 框 )
  x    y    * .001 > * \ 右下黑
  x 反 y    * .001 > * \ 左下黑
  x    y 反 * .001 > * \ 右上黑
  x 反 y 反 * .001 > * \ 左上黑
; .5 框 \ 亮度 .5
\ 藍色盤面 \\\\\\\\\\\\\\\\\\\
 .3 \ 亮度 .3
 x    y    * .009 > * \ 右下紅
 x 反 y    * .009 > * \ 左下紅
 x    y 反 * .009 > * \ 右上紅
 x 反 y 反 * .009 > * \ 左上紅
 + \ 增中間亮度為 .8
 .2 \ 綠色亮度 .2
 x    y    * .022 > * \ 右下紅
 x 反 y    * .022 > * \ 左下紅
 x    y 反 * .022 > * \ 右上紅
 x 反 y 反 * .022 > * \ 左上紅
 + \ 增中間紅色亮度為 1
 r .39 > * + \ 半徑 .39 洞
1 框

時鐘陳爽
'25 Jul 10

\ F. 時鐘
\ 新增指令 \\\\\\\\\\\\\\\\\\\
: 2pi pi pi + ;
: r \ 中心到 x,y 的距離, 1 到邊
 x .5 - x .5 - * y .5 - y .5 - *
 + sqrt ;
: a \ 中心到 x,y 的角度, 0 到 1
  y .5 - x .5 - atan2
  pi + pi / 2 / ;
: 分 t 60 / ; : 時 分 60 / ;
: 格 / + 1 mod ;
: 反 1 swap - ;
: 間 ( x L U -- b ) \ x 在 L U 間
  >r over r> < >r > r> and ;
\ 紅色盤面 \\\\\\\\\\\\\\\\\\\
 0 \ 紅色亮度 0
 .5 + \ 紅色亮度 .5
 x    y    * .001 > * \ 右下黑
 x 反 y    * .001 > * \ 左下黑
 x    y 反 * .001 > * \ 右上黑
 x 反 y 反 * .001 > * \ 左上黑
 dup push
 .3 \ 綠色亮度 .3
 x    y    * .009 > * \ 右下紅
 x 反 y    * .009 > * \ 左下紅
 x    y 反 * .009 > * \ 右上紅
 x 反 y 反 * .009 > * \ 左上紅
 + \ 增中間紅色亮度為 .8
 .2 \ 綠色亮度 .2
 x    y    * .022 > * \ 右下紅
 x 反 y    * .022 > * \ 左下紅
 x    y 反 * .022 > * \ 右上紅
 x 反 y 反 * .022 > * \ 左上紅
 + \ 增中間紅色亮度為 1
 r .39 > * \ 半徑 .39 紅洞
 r .08 < + \ 半徑 .08 紅圓 )
\ 紅色秒針 \\\\\\\\\\\\\\\\\\\
: 秒針 a .25 + \ 修正 角度 0 向上
 t 60 格 \ 每秒 1/60 圈
 .005 < \ 秒針寬度
 r .1 .37 間 * \ 加上秒針
; 秒針 + \ 顯示 紅色秒針
\ 綠色時標 \\\\\\\\\\\\\\\\\\\
: 時標 12 2pi * \ 12 週期
 a * cos \ 餘旋波
 .95 > \ 振幅大於 .95 定 時標長
 r .41 .425 間 * \ 定 時標寬
; 時標 \ 綠時標 (加紅色呈黃色)
\ 綠色分針 \\\\\\\\\\\\\\\\\\\
: 分針 a .25 + \ 修正 角度 0 向上
 分 60 格 \ 每時角 0 到 1
 .005 < \ 分針寬度
 r .1 .32 間 * \ 加上秒針
; 分針 + \ 顯示 綠色秒針
\ 藍色時針 \\\\\\\\\\\\\\\\\\\
: 時針 a .25 + \ 修正 角度 0 向上
 時 12 格 \ 每 12 小時 角 0 到 1
 .005 < \ 時針寬度
 r .1 .3 間 * \ 加上秒針
; 時針 \ 顯示 藍色秒針
pop 2 *
\ )

時鐘陳爽
'25 Jul 10

n cycle sine curve Redux Anonymous
'25 Jul 10

n cycle sine curve holi
'25 Jul 10

n by n fans 陳爽
'25 Jul 10

圈線暈板 Redux Redux Redux 陳爽
'25 Jul 10

圈線暈板 Redux Redux 陳爽
'25 Jul 10

圈線暈板 Redux 陳爽
'25 Jul 10

Haiku Gallery

Next