CueCat

http://www.utexas.edu/coc/journalism/SOURCE/j331fall00/faq/cuecat.jpg

Q: What is it?

A: The :CueCat[L1 ] reader reads any product/bar code and instantly transports you to the corresponding Web page for that product. It is not the same thing as a UPC, which swipes products and coupons like soup cans, and price tags, or an ISBN, which swipes magazines, books, and CDs, but it functions in the same way. NOTE: Each CueCat has a unique serial number assoicated with it that is transmitted to DC each time a scan is performed with their software.

FAQ : http://www.utexas.edu/coc/journalism/SOURCE/j331fall00/faq/cuecat.html


Michael Jacobson: Here is a simple decoder function that only works on numbers in the scan code (1st and 3rd) using the string map function.

  set testscan ".C3nZC3nZC3nZDNv2DNP7CNnY.fHmc.C3z6CxTZCxnYDxb7."
  string map {C3 0 CN 1 Cx 2 Ch 3 D3 4 DN 5 Dx 6 Dh 7 E3 8 EN 9\
            n 0 j 1 f 2 b 3 D 4 z 5 v 6 r 7 T 8 P 9\
            Z 0 Y 1 X 2 W 3 3 4 2 5 1 6 0 7 7 8 6 9} $testscan

Michael Jacobson: Here is some code I wrote a while back to decode a cuecat in Tcl (and ignor the serial number). Need to to be repackage a little better but it works.

Also see TkCatScan for a GUI interface for this libarary.


 package provide CueCat 1.0

 namespace eval CueCat {
  # make the procedures visiable
  namespace export Decode Encode InvCase
  # charater position array used to determine the offset (zero based!!!)
  variable seq "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789+-"
                          #0123456789012345678901234567890123456789012345678901234567890123
               #          1         2         3         4         5         6

  proc Decode {inputstr} {
    variable seq
         #remove grouping if brackets get applied
        regsub -all ^{ $inputstr "" inputstr
        regsub -all }$ $inputstr "" inputstr
        set outstr {}
        foreach catstr [split $inputstr .] {
                foreach {a b c d} [split $catstr ""] {
                          set shiftnum 0
                          foreach catlet "$a $b $c $d" {
                                   # get the position of each char (zero based)
                                   set num [string first $catlet $seq]
                                   # shift existing data right 6 and add new data
                                   set shiftnum [expr [expr $shiftnum <<6] | $num]
                        }
                           # now take the 24 bits and group them into 8 bit fields
                           set tempstr {}
                           for {set x 0} {$x<3} {incr x} {
                                   # xor the data with dec 67 (aka hex 43) and get the char value
                                   # add the char to the end of the output string
                set tempstr [format %c [expr [expr $shiftnum & 255] ^ 0x43]]$tempstr
                                   set shiftnum [expr $shiftnum >> 8]
                        }
                        append outstr $tempstr
                }
                # add a seperator in the string so you can use lindex command to get results
                append outstr " "
        }
        return [string trim $outstr]
  }

  proc Encode {args} {
    variable seq
        set outstr {}
        append outstr .
    #remove grouping if brackets get applied
        regsub -all ^{ $args "" args
        regsub -all }$ $args "" args
        #loop over each string set
        foreach catstr $args {
            #read in 3 chars at a time (need to error check this) 
                foreach {a(0) a(1) a(2)} [split $catstr ""] {
                    set totnum 0
                        for {set x 0} {$x<3} {incr x} {
                            # scanned char convert to ordinal num
                                scan $a($x) %c decnum
                                # existing number move it overs and put current num in lower 8 bit 
                                # also xor 67 into the lower 8 bit number
                                set totnum [expr [expr $totnum << 8] + [expr $decnum ^ 67]]
                        }        
                        set tempstr {}
                        for {set x 0} {$x<4} {incr x} {
                                #take the lower 6 bits of the totnum word and find its index in seq index list
                                #prepend it to the tempstr array (to get the order correctly since we are doing it backwards
                                set tempstr [string index $seq [expr $totnum & 0x3F]]$tempstr
                                #get rid of the bits just processed
                                set totnum [expr $totnum >> 6]        
                        }
                        #append the decode 3 chars (now 4 chars) to the output string
                        append outstr $tempstr
                }
                append outstr .
        }
        return [string trim $outstr]
  }

  proc InvCase {inputstr} {
          set original "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
          set inverse  "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"
        regsub -all ^{ $inputstr "" inputstr
        regsub -all }$ $inputstr "" inputstr
          set outstr {}
          foreach letter [split $inputstr ""] {
              set num [string first $letter $original]
              if {$num > -1} {
                append outstr [string index $inverse $num]
              } else {
                append outstr $letter
              }
          }
          return [string trim $outstr]
  }

 proc ISBN {args}  {
        # the procedure to generate ISBN check sum is to:
        # take first 9 digits, and multiply the MSB by 10 the next by 9 etc
        # till the last digit is mult by 2. then add all these values and mod 11
        # subtract 11 from this value and add it onto the end as the ninth digit
        #978013022028890000
        #   0123456789
        #01234567890123
        regsub -all ^{ $args "" args
        regsub -all }$ $args "" args
        set isbnum [string range [lindex $args [expr [llength $args] -1]] 3 11]
        set check 0
    for {set i 0} {$i < 9} {incr i} {
                set check [expr $check + [expr [string index $isbnum $i] * (10 - $i)]]
        }
        set numcheck [expr $check % 11]
    if { $numcheck == 0} {
                append isbnum "0"
        } elseif { $numcheck == 1} {
                append isbnum "X"
        } else {
                append isbnum [expr 11-$numcheck]
        }
        #formated return statement (not needed) but keep just in case I reimplement it
        #return "[string range $isbnum 0 0]-[string range $isbnum 1 2]-[string range $isbnum 3 8]-[string range $isbnum 9 9]"
        return $isbnum
  }
 }

LV Anyone with kids have seen a variety of toys recently that capitalize on scanning bar codes and then from that data generating opponents to battle. Anyone seen any games making use of the CueCat?


Category Application