Windows.tcl

# Windows Tcl/Tk emulation scripts
# Initial implementation by Peter MacDonald pmacdona@sanjuan.uvic.ca

proc CreateWindow { f t x y h w } {
	global baseframe
	set baseframe $f
	wm title . "$t"
	frame .$f
	pack append . .$f {top}
	canvas .$f.canvas1 -scrollregion " $x $y $h $w " -width 15c -height 10c
	pack append .$f .$f.canvas1 {top}
}

proc CreateMenuEntry { fn t x } {
	global baseframe
	menubutton .$fn -text "$t" -underline $x -menu .$fn.m
	pack append .$baseframe .$fn left
	menu .$fn.m
}

proc CreateMenuBar { f } {
	global allmenus
	global baseframe
	set allmenus ""
	frame .$f -relief raised -borderwidth 1
	pack before .$baseframe .$f {top fillx}
}

proc AppendMenu { a b c d x } {
	global allmenus
	global baseframe
	if { ($b == 0x10) } {
		.$c configure -text "$d" -underline "$x"
		pack append .$a .$c left
		set allmenus "$allmenus $c"
		tk_menuBar .$a $allmenus
		tk_bindForTraversal .$baseframe.canvas1
	} else { if { ($b == 0x0800) } {
		.$a.m add separator
	} else {
		.$a.m add command -label "$d" -command "wincallback menu $a $b $c $d" -underline $x
	}}
}

####################################################################
# Misc unimplemented stuff
####################################################################

proc LoadIcon { wind name } {
	echo "LoadIcon"
}

proc LoadBitmap { wind name } {
	echo "LoadBitmap"
}

proc LoadCursor { wind name } {
	echo "LoadCursor"
}

proc GetObject { obj count ptr } {
	echo "GetObject $obj $count $ptr"
}

proc GetStockObject { wind } {
	echo "GetStockObject $wind"
}

proc DefWindowProc { a b c d } {
	echo "DefWindowProc $a $b $c $d"
}

proc GetMenu { a } {
	echo "GetMenu $a"
}

proc SetMenu { a b } {
	echo "SetMenu $a $b"
}

proc MessageBeep {a } {
	echo "MessageBeep $a"
}

proc MessageBox { wind msg title type } {
	echo "MessageBox '$msg'"
}

proc DrawText { f t top left right bottom } {
	.$f.canvas1 create text $top $left -text "$t" -anchor n
}