なつかしのソンブレロ

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