2009-02-11

なつかしのソンブレロ


8bit パソコン全盛の頃、愛機 MZ-80K2E を、320x200 ドットの解像度でグラフィック表示が出きるように改造して、ソンブレロを表示させて遊んでいました。キャリーラボWICS で記述した記憶があります。懐かしくなり、C プログラミングの本の、陰線消去法の説明で紹介されていたソンブレロのサンプルを Tcl/Tk 用に書き直してみました。配列をプロシージャー(ユーザーコマンド)に渡す場合、Tcl では綺麗に記述できないので、全てリストに置き換えました。


namespace eval sombrero {
namespace export *

variable DX 640
variable DY 400
variable SOX [expr $DX / 2 - 1]
variable SOY [expr $DY / 2 - 1]
variable MAX [lrepeat $DX -1]
variable MIN [lrepeat $DX $DY]
variable Pi 3.1415926535

proc getWidth {} {
variable DX
return $DX
}
proc getHeight {} {
variable DY
return $DY
}
proc getRad {x} {
variable Pi
return [expr $x * $Pi / 180.0]
}
proc initVal {x y z} {
variable sx; variable sy; variable sz
variable cx; variable cy; variable cz

set x [getRad $x]; set y [getRad $y]; set z [getRad $z]
set sx [expr sin($x)]; set sy [expr sin($y)]; set sz [expr sin($z)]
set cx [expr cos($x)]; set cy [expr cos($y)]; set cz [expr cos($z)]
return
}
proc rotate {x y z} {
variable sx; variable sy; variable sz
variable cx; variable cy; variable cz

set x1 $x
set y1 [expr $y * $cx - $z * $sx]
set z1 [expr $y * $sx + $z * $cx]
set x2 [expr $x1 * $cy + $z1 * $sy]
set y2 $y1
set z2 [expr -$x1 * $sy + $z1 * $cy]
set x3 [expr $x2 * $cz - $y2 * $sz]
set y3 [expr $x2 * $sz + $y2 * $cz]
set z3 $z2
return [list $x3 $y3 $z3]
}
proc loop {a b c} {
if {$c > 0} {
return [expr $a <= $b]
} else {
return [expr $a >= $b]
}
}
proc func {x z} {
variable Pi

set l [expr hypot($x, $z)]
return [expr 50 * cos($Pi * $l / 100) + 5 * sin($Pi * $l / 25)]
}
proc draw {w x y} {
variable SOX; variable SOY
variable MAX; variable MIN
variable ix0; variable iy0
variable lsw

set ix [expr int($SOX + $x)]; set iy [expr int($SOY - $y)]
if {$lsw == 1} {
set lsw 0
set ix0 $ix; set iy0 $iy
}
if {$iy > [lindex $MAX $ix]} {
lset MAX $ix $iy
$w create line $ix0 $iy0 $ix $iy
}
if {$iy < [lindex $MIN $ix]} {
lset MIN $ix $iy
$w create line $ix0 $iy0 $ix $iy
}
set ix0 $ix; set iy0 $iy
return
}
proc main {w rx ry rz} {
variable DY
variable lsw

initVal $rx $ry $rz
set retList [rotate 0.0 0.0 [expr -$DY / 2]]
set za [lindex $retList 2]
set retList [rotate 0.0 0.0 [expr $DY / 2]]
set zb [lindex $retList 2]
set zz1 [expr -$DY / 2]; set zz2 [expr $DY / 2]; set stz 5
if {$za > $zb} {set zz1 -$zz1; set zz2 -$zz2; set ztz -$stz}
set xx1 [expr -$DY / 2]; set xx2 [expr $DY / 2]; set stx 1
for {set z $zz1} {[loop $z $zz2 $stz]} {incr z $stz} {
set lsw 1
for {set x $xx1} {[loop $x $xx2 $stx]} {incr x $stx} {
set dataList [rotate $x [func $x $z] $z]
set xa [lindex $dataList 0]
set ya [lindex $dataList 1]
draw $w $xa $ya
}
}
}
}

namespace import sombrero::*
# ------------------------------------------------------------------------------
# MAIN
# ------------------------------------------------------------------------------
wm title . "sombrero"
set w [canvas .can -width [getWidth] -height [getHeight]]
pack $w

main $w -45 20 0
# ---
# PROGRAM END

参考資料


[1] C アルゴリズム全科 基礎からグラフィックスまで (1995)
千葉則茂、村岡一信、小沢一文、海野啓明
近代科学社 ISBN4-7649-0239-7