# uniParse.tcl --

#

#	This program parses the UnicodeData file and generates the

#	corresponding tclUniData.c file with compressed character

#	data tables.  The input to this program should be the latest

#	UnicodeData file from:

#	    ftp://ftp.unicode.org/Public/UNIDATA/UnicodeData-Latest.txt

#

# Copyright (c) 1998-1999 by Scriptics Corporation.

# All rights reserved.

# 

# RCS: @(#) $Id: uniParse.tcl,v 1.4 2001/05/28 04:37:57 hobbs Exp $

namespace eval uni {

    set shift 5;		# number of bits of data within a page

				# This value can be adjusted to find the

				# best split to minimize table size

    variable pMap;		# map from page to page index, each entry is

				# an index into the pages table, indexed by

				# page number

    variable pages;		# map from page index to page info, each

				# entry is a list of indices into the groups

				# table, the list is indexed by the offset

    variable groups;		# list of character info values, indexed by

				# group number, initialized with the

				# unassigned character group

    variable categories {

	Cn Lu Ll Lt Lm Lo Mn Me Mc Nd Nl No Zs Zl Zp

	Cc Cf Co Cs Pc Pd Ps Pe Pi Pf Po Sm Sc Sk So

    };				# Ordered list of character categories, must

				# match the enumeration in the header file.

    variable titleCount 0;	# Count of the number of title case

				# characters.  This value is used in the

				# regular expression code to allocate enough

				# space for the title case variants.

}

proc uni::getValue {items index} {

    variable categories

    variable titleCount

    # Extract character info

    set category [lindex $items 2]

    if {[scan [lindex $items 12] %4x toupper] == 1} {

	set toupper [expr {$index - $toupper}]

    } else {

	set toupper {}

    }

    if {[scan [lindex $items 13] %4x tolower] == 1} {

	set tolower [expr {$tolower - $index}]

    } else {

	set tolower {}

    }

    if {[scan [lindex $items 14] %4x totitle] == 1} {

	set totitle [expr {$index - $totitle}]

    } else {

	set totitle {}

    }

    set categoryIndex [lsearch -exact $categories $category]

    if {$categoryIndex < 0} {

	puts "Unexpected character category: $index($category)"

	set categoryIndex 0

    } elseif {$category == "Lt"} {

	incr titleCount

    }

    return "$categoryIndex,$toupper,$tolower,$totitle"

}

proc uni::getGroup {value} {

    variable groups

    set gIndex [lsearch -exact $groups $value]

    if {$gIndex == -1} {

	set gIndex [llength $groups]

	lappend groups $value

    }

    return $gIndex

}

proc uni::addPage {info} {

    variable pMap

    variable pages

    set pIndex [lsearch -exact $pages $info]

    if {$pIndex == -1} {

	set pIndex [llength $pages]

	lappend pages $info

    }

    lappend pMap $pIndex

    return

}

proc uni::buildTables {data} {

    variable shift

    variable pMap {}

    variable pages {}

    variable groups {{0,,,}}

    set info {}			;# temporary page info

    set mask [expr {(1 << $shift) - 1}]

    set next 0

    foreach line [split $data \n] {

	if {$line == ""} {

	    set line "FFFF;;Cn;0;ON;;;;;N;;;;;\n"

	}

	set items [split $line \;]

	scan [lindex $items 0] %4x index

	set index [format 0x%0.4x $index]

	set gIndex [getGroup [getValue $items $index]]

	# Since the input table omits unassigned characters, these will

	# show up as gaps in the index sequence.  There are a few special cases

	# where the gaps correspond to a uniform block of assigned characters.

	# These are indicated as such in the character name.

	# Enter all unassigned characters up to the current character.

	if {($index > $next) \

		&& ![regexp "Last>$" [lindex $items 1]]} {

	    for {} {$next < $index} {incr next} {

		lappend info 0

		if {($next & $mask) == $mask} {

		    addPage $info

		    set info {}

		}

	    }

	}

	# Enter all assigned characters up to the current character

	for {set i $next} {$i <= $index} {incr i} {

	    # Split character index into offset and page number

	    set offset [expr {$i & $mask}]

	    set page [expr {($i >> $shift)}]

	    # Add the group index to the info for the current page

	    lappend info $gIndex

	    # If this is the last entry in the page, add the page

	    if {$offset == $mask} {

		addPage $info

		set info {}

	    }

	}

	set next [expr {$index + 1}]

    }

    return

}

proc uni::main {} {

    global argc argv0 argv

    variable pMap

    variable pages

    variable groups

    variable shift

    variable titleCount

    if {$argc != 2} {

	puts stderr "\nusage: $argv0 <datafile> <outdir>\n"

	exit 1

    }

    set f [open [lindex $argv 0] r]

    set data [read $f]

    close $f

    buildTables $data

    puts "X = [llength $pMap]  Y= [llength $pages]  A= [llength $groups]"

    set size [expr {[llength $pMap] + [llength $pages]*(1<<$shift)}]

    puts "shift = 6, space = $size"

    puts "title case count = $titleCount"

    set f [open [file join [lindex $argv 1] tclUniData.c] w]

    fconfigure $f -translation lf

    puts $f "/*

 * tclUniData.c --

 *

 *	Declarations of Unicode character information tables.  This file is

 *	automatically generated by the tools/uniParse.tcl script.  Do not

 *	modify this file by hand.

 *

 * Copyright (c) 1998 by Scriptics Corporation.

 * All rights reserved.

 *

 * RCS: @(#) \$Id\$

 */

/*

 * A 16-bit Unicode character is split into two parts in order to index

 * into the following tables.  The lower OFFSET_BITS comprise an offset

 * into a page of characters.  The upper bits comprise the page number.

 */

#define OFFSET_BITS $shift

/*

 * The pageMap is indexed by page number and returns an alternate page number

 * that identifies a unique page of characters.  Many Unicode characters map

 * to the same alternate page number.

 */

static unsigned char pageMap\[\] = {"

    set line "    "

    set last [expr {[llength $pMap] - 1}]

    for {set i 0} {$i <= $last} {incr i} {

	append line [lindex $pMap $i]

	if {$i != $last} {

	    append line ", "

	}

	if {[string length $line] > 70} {

	    puts $f $line

	    set line "    "

	}

    }

    puts $f $line

    puts $f "};

/*

 * The groupMap is indexed by combining the alternate page number with

 * the page offset and returns a group number that identifies a unique

 * set of character attributes.

 */

static unsigned char groupMap\[\] = {"

    set line "    "

    set lasti [expr {[llength $pages] - 1}]

    for {set i 0} {$i <= $lasti} {incr i} {

	set page [lindex $pages $i]

	set lastj [expr {[llength $page] - 1}]

	for {set j 0} {$j <= $lastj} {incr j} {

	    append line [lindex $page $j]

	    if {$j != $lastj || $i != $lasti} {

		append line ", "

	    }

	    if {[string length $line] > 70} {

		puts $f $line

		set line "    "

	    }

	}

    }

    puts $f $line

    puts $f "};

/*

 * Each group represents a unique set of character attributes.  The attributes

 * are encoded into a 32-bit value as follows:

 *

 * Bits 0-4	Character category: see the constants listed below.

 *

 * Bits 5-7	Case delta type: 000 = identity

 *				 010 = add delta for lower

 *				 011 = add delta for lower, add 1 for title

 *				 100 = sutract delta for title/upper

 *				 101 = sub delta for upper, sub 1 for title

 *				 110 = sub delta for upper, add delta for lower

 *

 * Bits 8-21	Reserved for future use.

 *

 * Bits 22-31	Case delta: delta for case conversions.  This should be the

 *			    highest field so we can easily sign extend.

 */

static int groups\[\] = {"

    set line "    "

    set last [expr {[llength $groups] - 1}]

    for {set i 0} {$i <= $last} {incr i} {

	foreach {type toupper tolower totitle} [split [lindex $groups $i] ,] {}

	# Compute the case conversion type and delta

	if {$totitle != ""} {

	    if {$totitle == $toupper} {

		# subtract delta for title or upper

		set case 4

		set delta $toupper

	    } elseif {$toupper != ""} {

		# subtract delta for upper, subtract 1 for title

		set case 5

		set delta $toupper

	    } else {

		# add delta for lower, add 1 for title

		set case 3

		set delta $tolower

	    }

	} elseif {$toupper != ""} {

	    # subtract delta for upper, add delta for lower

	    set case 6

	    set delta $toupper

	} elseif {$tolower != ""} {

	    # add delta for lower

	    set case 2

	    set delta $tolower

	} else {

	    # noop

	    set case 0

	    set delta 0

	}

	set val [expr {($delta << 22) | ($case << 5) | $type}]

	append line [format "%d" $val]

	if {$i != $last} {

	    append line ", "

	}

	if {[string length $line] > 65} {

	    puts $f $line

	    set line "    "

	}

    }

    puts $f $line

    puts $f "};

/*

 * The following constants are used to determine the category of a

 * Unicode character.

 */

#define UNICODE_CATEGORY_MASK 0X1F

enum {

    UNASSIGNED,

    UPPERCASE_LETTER,

    LOWERCASE_LETTER,

    TITLECASE_LETTER,

    MODIFIER_LETTER,

    OTHER_LETTER,

    NON_SPACING_MARK,

    ENCLOSING_MARK,

    COMBINING_SPACING_MARK,

    DECIMAL_DIGIT_NUMBER,

    LETTER_NUMBER,

    OTHER_NUMBER,

    SPACE_SEPARATOR,

    LINE_SEPARATOR,

    PARAGRAPH_SEPARATOR,

    CONTROL,

    FORMAT,

    PRIVATE_USE,

    SURROGATE,

    CONNECTOR_PUNCTUATION,

    DASH_PUNCTUATION,

    OPEN_PUNCTUATION,

    CLOSE_PUNCTUATION,

    INITIAL_QUOTE_PUNCTUATION,

    FINAL_QUOTE_PUNCTUATION,

    OTHER_PUNCTUATION,

    MATH_SYMBOL,

    CURRENCY_SYMBOL,

    MODIFIER_SYMBOL,

    OTHER_SYMBOL

};

/*

 * The following macros extract the fields of the character info.  The

 * GetDelta() macro is complicated because we can't rely on the C compiler

 * to do sign extension on right shifts.

 */

#define GetCaseType(info) (((info) & 0xE0) >> 5)

#define GetCategory(info) ((info) & 0x1F)

#define GetDelta(info) (((info) > 0) ? ((info) >> 22) : (~(~((info)) >> 22)))

/*

 * This macro extracts the information about a character from the

 * Unicode character tables.

 */

#define GetUniCharInfo(ch) (groups\[groupMap\[(pageMap\[(((int)(ch)) & 0xffff) >> OFFSET_BITS\] << OFFSET_BITS) | ((ch) & ((1 << OFFSET_BITS)-1))\]\])

"

    close $f

}

uni::main

return