[tcl/tk] Окно логина

             окно_логина
              /         \
кнопки:  (login)       (cancel)
         (process)        \  
          /   \            \ 
         /    ----------> exit
        /
    (показать главное окно)

###################################################
#	MainWindow
###################################################

proc initMainWindow {} {
	global appName
	wm title . $appName
	
}

####################################################
#	Exit procedure
####################################################

proc exitProc {} {
	global appName
	set answer [tk_messageBox \
		-title "Exit " \
		-message "Exit from $appName?" \
		-type "yesno"
		]
	
	if {$answer == "no"} {
		return	
	}
	# some exit procedures
	exit
}

####################################################
#	Selling procedure
####################################################

proc sellProc {} {
	global appName

}

####################################################
#	Login Proccess
#	############################################
proc loginProc {} {
	global appname
	global db
	set l .login
	toplevel $l
	wm title $l "Authentification"

	frame $l.login
	label $l.login.label -text "Username:"
	entry $l.login.entry -textvar _username

	frame $l.pass
	label $l.pass.label -text "Password:"
	entry $l.pass.entry -textvar _password -show *

	frame $l.btn
	button $l.btn.login -text "login" -command {set _dbres [fetchUserCheck $_username $_password ]}
	button $l.btn.cancel -text "cancel" -command { set _dbres 0}
	
	pack $l.btn.login $l.btn.cancel -side left
	
	pack $l.login.label -side left
	pack $l.login.entry -side left -expand 1 -fill x
	pack $l.pass.label -side left
	pack $l.pass.entry -side left -expand 1 -fill x
	pack $l.login $l.pass $l.btn -side top -fill x
	
	vwait _dbres
	destroy $l
	return $::_dbres
}

proc fetchUserCheck {u p} {
	global db
	$db eval "SELECT * FROM users WHERE (login='$u' AND pass='$p')" {
		return 0;
	}
	return 1;
}


####################################################
#	MAIN
####################################################	

dbProc
set loginRes [loginProc]
if { $loginRes != 0 } {
	exit	
}

initMainWindow
initMenu