wm withdraw .; wm withdraw .output; wm geom .konsola 829x629+183+7; kons_font 16
kons_font 13; # Morasko

# ...

# CDR z JavaIDL + plik qqq2.idl i pieniek, 22.08.2016
# + czy to jest dobry sposob na komunikacje mq Java-Tcl ?
# + mozna wyslac TC na poczatku, a potem wielokrotnie dane
#   zgodne z tym TC...
#
proc e args {catch $args err; set err}
proc ii o {join [java::info meth $o] \n}
proc narrow ob {java::cast [[$ob getClass] getName] $ob}
lappend auto_path ~/tcl/mini-blend; package re java
set orb [java::call org.omg.CORBA.ORB \
  {init {java.lang.String[]} java.util.Properties} \
  [java::null] [java::null]
]
proc pokaz_is is { # przystosowane do JavaIDL
  while 1 {
    set b [catch {$is read_octet} e]
      # + niestety jest warning na ekranie...
    if {$b!=0} break
    lappend _ $e
  }
  return $_
}

# seq_long
set a1 [java::new {int[]} {} {11 22 33 44 55}]
set os [$orb create_output_stream]
java::call qqq2.seq_longHelper write $os $a1
set is [$os create_input_stream]
pokaz_is $is
  #% 0 0 0 5 0 0 0 11 0 0 0 22 0 0 0 33 0 0 0 44 0 0 0 55

#ii com.sun.corba.se.impl.encoding.EncapsOutputStream
set os_ [narrow $os]
$os_ isLittleEndian
  #% 0
[$os_ getGIOPVersion] toString
  #% 1.2

# vtype1 (VT)
set a1 [java::new qqq2.vtype1Impl]
#java::info fields $a1
  #% a b
java::field $a1 a "abc"
java::field $a1 b [java::new {int[]} {} {1 2 3 4}]
set os [$orb create_output_stream]
java::call qqq2.vtype1Helper write $os $a1
set is [$os create_input_stream]
set b1 [pokaz_is $is]
  #% 127 -1 -1 10 0 0 0 20 73 68 76 58 113 113 113 50 47 118 116 121 112 101 49 58 49 46 48 0 0 0 0 28 0 0 0 4 97 98 99 0 0 0 0 4 0 0 0 1 0 0 0 2 0 0 0 3 0 0 0 4 -1 -1 -1 -1
llength $b1
  #% 64

# vtype1 (VT)
set a1 [java::new qqq2.vtype1Impl]
java::field $a1 a "A ku ku !!!"
java::field $a1 b [java::new {int[]} {} {1 2 3 4 5 6 7}]
set os [$orb create_output_stream]
java::call qqq2.vtype1Helper write $os $a1
set is [$os create_input_stream]
set b1a [pokaz_is $is]
  #% 127 -1 -1 10 0 0 0 20 73 68 76 58 113 113 113 50 47 118 116 121 112 101 49 58 49 46 48 0 0 0 0 48 0 0 0 12 65 32 107 117 32 107 117 32 33 33 33 0 0 0 0 7 0 0 0 1 0 0 0 2 0 0 0 3 0 0 0 4 0 0 0 5 0 0 0 6 0 0 0 7 -1 -1 -1 -1
llength $b1a
  #% 84

# vtype1 (VT) + TC
set a1 [java::new qqq2.vtype1Impl]
java::field $a1 a "abc"
java::field $a1 b [java::new {int[]} {} {1 2 3 4}]
set os [$orb create_output_stream]
$os write_TypeCode [java::call qqq2.vtype1Helper type]
java::call qqq2.vtype1Helper write $os $a1
set is [$os create_input_stream]
set b2 [pokaz_is $is]
  #% 0 0 0 29 0 0 0 -98 0 0 0 0 0 0 0 20 73 68 76 58 113 113 113 50 47 118 116 121 112 101 49 58 49 46 48 0 0 0 0 7 118 116 121 112 101 49 0 0 0 0 0 0 0 0 0 0 0 0 0 2 0 0 0 2 97 0 0 0 0 0 0 18 0 0 0 0 0 1 0 0 0 0 0 2 98 0 0 0 0 0 0 21 0 0 0 68 0 0 0 0 0 0 0 22 73 68 76 58 113 113 113 50 47 115 101 113 95 108 111 110 103 58 49 46 48 0 0 0 0 0 0 9 115 101 113 95 108 111 110 103 0 0 0 0 0 0 0 19 0 0 0 12 0 0 0 0 0 0 0 3 0 0 0 0 0 1 0 0 127 -1 -1 10 0 0 0 20 73 68 76 58 113 113 113 50 47 118 116 121 112 101 49 58 49 46 48 0 0 0 0 28 0 0 0 4 97 98 99 0 0 0 0 4 0 0 0 1 0 0 0 2 0 0 0 3 0 0 0 4 -1 -1 -1 -1
llength $b2
  #% 232
expr 232-64
  #% 168
  # + tyle zabiera TC dla vtyp1...

# kontrola spod cdr/combata...
#
lappend auto_path ../combat-tcl-0.7.4; package re combat
  #% 0.7

set x1 [binary format c* $b1]
Combat::CDR::Decoder d1 $x1
[d1 get_buffer] configure -byteorder 0
d1 Demarshal {valuetype IDL:qqq2/vtype1:1.0 {public a string public b {sequence long}} 0 {}}
  #% a abc b {1 2 3 4} _tc_ {valuetype IDL:qqq2/vtype1:1.0 {public a string public b {sequence long}} 0 {}}
  # + musze wczesniej znac TC !!
itcl::delete object d1

set x1 [binary format c* $b1a]
Combat::CDR::Decoder d1 $x1
[d1 get_buffer] configure -byteorder 0
d1 Demarshal {valuetype IDL:qqq2/vtype1:1.0 {public a string public b {sequence long}} 0 {}}
  #% a {A ku ku !!!} b {1 2 3 4 5 6 7} _tc_ {valuetype IDL:qqq2/vtype1:1.0 {public a string public b {sequence long}} 0 {}}
itcl::delete object d1

set x2 [binary format c* $b2]
Combat::CDR::Decoder d1 $x2
[d1 get_buffer] configure -byteorder 0
d1 Demarshal any
  #% {valuetype IDL:qqq2/vtype1:1.0 {public a string public b {sequence long}} 0 {}} {a abc b {1 2 3 4} _tc_ {valuetype IDL:qqq2/vtype1:1.0 {public a string public b {sequence long}} 0 {}}}
itcl::delete object d1













exit