TCL number convertion

#==============================================#
# Assigning values to variables #
#==============================================#

set decimal_number 17
set hexa_number D3
set binary_number 1011001

#===============================================#
# Convertion of decimal number to hexa decimal #
#===============================================#

set decimal_to_hex [format %x $decimal_number]
puts "The hexa equivalent of $decimal_number is : $decimal_to_hex"


#===============================================#
# Convertion of hexa number to decimal format #
#===============================================#

set hex_to_decimal [format %d 0x$hexa_number]
puts "The decimal equivalent of 0x$hexa_number is : $hex_to_decimal"

#===============================================#
# Convertion of decimal to binary format #
#===============================================#

proc int2bits {i} {
binary scan [binary format I1 $i] B* x
return [split [string trimleft $x 0] {}]
}

set decimal_to_binary [int2bits $decimal_number]
puts "The binary equivalent of $decimal_number is : $decimal_to_binary"


#===============================================#
# Convertion of binary to decimal format #
#===============================================#

proc bits2int {bits} {
set bits [format %032s [join $bits {}]]
binary scan [binary format B* $bits] I1 x
return $x
}


set binary_to_decimal [bits2int $decimal_to_binary]
puts "The decimal equivalent of $decimal_to_binary is : $binary_to_decimal"

#===============================================#
# Convertion of hexa to binary format #
#===============================================#

proc hex2bin {hex} {
binary scan [binary format H* $hex] B* bin
return $bin
}

set hexadecimal_to_binary [hex2bin $hexa_number]
puts "The binary equivalent of $hexa_number is : $hexadecimal_to_binary"


#===============================================#
# Convertion of binary to hexa format #
#===============================================#

proc 4bit_bin2hex {bin} {

# This procedure converts 4 bit binary to its corresponding hexa decimal number

set pattern {
0000 0
0001 1
0010 2
0011 3
0100 4
0101 5
0110 6
0111 7
1000 8
1001 9
1010 A
1011 B
1100 C
1101 D
1110 E
1111 F
}
return [string map -nocase $pattern $bin]
}; #end of proc

proc bin2hex {str} {

# This procedure selects the 4-bit binary number in LSB from the provided string

set hex ""
set len [string length $str]
while {1} {
if { $len>4} {
set hex "[4bit_bin2hex [string range $str end-3 end]]$hex"
set str [string range $str 0 end-4]
set len [string length $str]
} else {
set hex "[4bit_bin2hex [format %04d $str]]$hex"
break
}; #end of if-else

}; #end of while

return $hex
}; #end of proc

set binary_to_hexadecimal [bin2hex $binary_number]puts "The hexa equivalent of $binary_number is : $binary_to_hexadecimal"

######################################################## OUTPUT

The hexa equivalent of 17 is : 11
The decimal equivalent of 0xD3 is : 211
The binary equivalent of 17 is : 1 0 0 0 1
The decimal equivalent of 1 0 0 0 1 is : 17
The binary equivalent of D3 is : 11010011
The hexa equivalent of 1011001 is : 59

TCL package

Q. Write a TCL program that meet he following requirements
Create a package “hw_config” which contains 3 procedures namely “Lockport”, “Freeport”, and “Breakport”. There must be an array “socket” global to the package “hw_config” which is defined with the default parameters. The parameters defined in array “socket” is used by all the 3 procedures (Lockport, Freeport, Breakport), whenever required. If a user wants to override the default params it will be passed to the procedure as an array. Within the procedure we have to use the user passed params (if not found, use default)

Solution:

File name 1: sample.tcl
Content:
package require hw_config 1.0

#Setting port lock parameters
set socket(ip) "10.100.11.153"
::hw_config::lockport socket

File name 2: hw_config.tcl ; # used for package
Content:
#!/usr/bin/expect
package require Expect
package provide hw_config 1.0

namespace eval hw_config {
variable socket
array set socket {ip 10.10.10.10 port 7}
namespace export lockport
namespace export freeport
namespace export breakport
}

proc ::hw_config::lockport { soc } {
upvar $soc sock
variable socket

#overriding the default values with the values supplied

foreach var [array names sock] {
set socket($var) $sock($var)
}

puts " Specified port $socket(ip):$socket(port) locked"
}

proc ::hw_config::freeport { } {
puts " Specified ports are freed"
}
proc ::hw_config::breakport { } {
puts " Specified ports are brocken"
}