diff options
Diffstat (limited to 'zinclib.d/gen.pl')
| -rw-r--r-- | zinclib.d/gen.pl | 275 |
1 files changed, 275 insertions, 0 deletions
diff --git a/zinclib.d/gen.pl b/zinclib.d/gen.pl new file mode 100644 index 0000000..ac703d8 --- /dev/null +++ b/zinclib.d/gen.pl @@ -0,0 +1,275 @@ +#!/usr/bin/perl + +# This software is the property of IntuiLab SA, France. +# All rights reserved. +# +# Redistribution and use in source and binary forms, with or without +# modification, are permitted provided that the following conditions +# are met: +# 1. Redistributions of source code must retain the above copyright +# notice, this list of conditions and the following disclaimer. +# 2. Redistributions in binary form must reproduce the above copyright +# notice, this list of conditions and the following disclaimer in the +# documentation and/or other materials provided with the distribution. +# 3. The name of the author may not be used to endorse or promote products +# derived from this software without specific prior written permission. +# +# THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR +# IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES +# OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. +# IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, +# INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT +# NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +# DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +# THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +# (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF +# THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + + +$a=""; + +$res = ""; +$undone = ""; +$enum = ""; +$enum2 = ""; +open CODE,">code.cpp"; +open HPP,">code.hpp"; +while (<>) +{ + if( /{ ZN_CONFIG_(\w+), "-(\w+)"/ ) + { + if(defined $opt{$2}) + { + next if($opt{$2} == $1); + die("ERROR different TYPE\n"); + } + $opt{$2} = $1; + if( $1 eq "BOOL" ) + { $e = 0; $t = "bool"; $T = "BOO"; } + elsif( $1 eq "FLAG" ) + { $e = 0; $t = "int"; $T= "INT"; } + elsif( $1 eq "GRADIENT" ) + { $e = 0; $t = "String"; $T= "STR"; } + elsif( $1 eq "UINT" ) + { $e = 0; $t = "unsigned int"; $T= "INT"; } + elsif( $1 eq "INT" ) + { $e = 0; $t = "int"; $T= "INT"; } + elsif( $1 eq "LINE_STYLE" ) + { $e = 1; $t = "ineStyle"; $T="lineStyles"; } + elsif( $1 eq "DIM" ) + { $e = 0; $t = "double"; $T= "DBL"; } + elsif( $1 eq "ANGLE" ) + { $e = 0; $t = "unsigned int"; $T= "INT"; } + elsif( $1 eq "PRI" ) + { $e = 0; $t = "unsigned int"; $T= "INT"; } + elsif( $1 eq "RELIEF" ) + { $e = 1; $t = "relief"; $T="reliefs"; } + elsif( $1 eq "ALPHA" ) + { $e = 0; $t = "unsigned int"; $T= "INT"; } + elsif( $1 eq "TEXT" ) + { $e = 0; $t = "String"; $T= "STR"; } + elsif( $1 eq "ALIGNMENT" ) + { $e = 1; $t = "alignment"; $T="alignments"; } + elsif( $1 eq "USHORT" ) + { $e = 0; $t = "unsigned short"; $T= "INT"; } + elsif( $1 eq "SHORT" ) + { $e = 0; $t = "short"; $T= "INT"; } + elsif( $1 eq "STRING" ) + { $e = 0; $t = "String"; $T= "STR"; } + elsif( $1 eq "FONT" ) + { $e = 0; $t = "ZincFont *"; $T= "PSTR"; } + elsif( $1 eq "ITEM" ) + { $e = 0; $t = "ZincItem *"; $T= "PTR"; } + elsif( $1 eq "BITMAP" ) + { $e = 0; $t = "ZincBitmap *"; $T= "PTR"; } + elsif( $1 eq "IMAGE" ) + { $e = 0; $t = "ZincImage *"; $T= "PTR"; } + elsif( $1 eq "ANCHOR" ) + { $e = 1; $t = "anchor"; $T="anchors"; } + elsif( $1 eq "LINE_SHAPE" ) + { $e = 1; $t = "lineShape"; $T="lineShapes"; } + elsif( $1 eq "CAP_STYLE" ) + { $e = 1; $t = "capStyle"; $T="capStyles"; } + elsif( $1 eq "JOIN_STYLE" ) + { $e = 1; $t = "joinStyle"; $T="joinStyles"; } + elsif( $1 eq "FILL_RULE" ) + { $e = 1; $t = "fillRule"; $T="fillRules"; } + elsif( $1 eq "EDGE_LIST" ) + { $e = 1; $t = "edgeList"; $T="edgeLists"; } + else + { + $undone .= "$2: $1\n"; + next; + } + + $t2 = $2; + substr($t2,0,1) =~ tr/[a-z]/[A-Z]/; + if($e==1) + { + if($en{$1}!=1) + { + $enum .= "$t { t_$T };\n"; + $enum2.= "const char* $T"."Strings [1] = { \"t$T\" };\n"; + $enum2.= "Tcl_Obj* $T [1] = { Tcl_NewStringObj (\"t$T\", -1) };\n"; + $en{$1}=1; + } + } + print HPP " /**\n"; + print HPP " * Call zinc->itemconfigure ( -$2 )\n"; + print HPP " * \@param item the item to configure\n"; + print HPP " * \@param value the $2 to set\n"; + print HPP " */\n"; + print HPP " void itemSet$t2 (ZincItem * item, $t value);\n\n"; + print HPP " /**\n"; + print HPP " * Call zinc->itemcget ( -$2 )\n"; + print HPP " * \@param item the item to get $2 from\n"; + print HPP " * \@return $2 value\n"; + print HPP " */\n"; + if ($t eq "String") + { + print HPP " String itemGet$t2 (ZincItem * item);\n\n"; + } + else + { + print HPP " $t itemGet$t2 (ZincItem * item);\n\n"; + } + $res .= "Z_DEFINE_ZOPT ($2); //the \"-$2\" option\n"; + + print CODE "/**\n"; + print CODE " * Call zinc->itemconfigure ( -$2 )\n"; + print CODE " *\n"; + print CODE " * \@param item the item to configure\n"; + print CODE " * \@param value the $2 to set\n"; + print CODE " */\n"; + print CODE "void Zinc::itemSet$t2 (ZincItem * item, $t value)\n"; + print CODE "{\n"; + print CODE " //prepare arguments : .zinc itemconfigure item attribute value\n"; + print CODE " p1[0] = id;\n"; + print CODE " p1[1] = ZFCT_itemconfigure;\n"; + print CODE " p1[2] = item->object;\n"; + print CODE " p1[3] = ZOPT_$2;\n"; + if( $e==1 ) + { + print CODE " p1[4] = ".$T."[value];\n"; + } + elsif ($T eq "PTR") + { + print CODE " p1[4] = value->object;\n"; + } + elsif ($T eq "PSTR") + { + print CODE " p1[4] = Z_STR_POOL (0, value->name.c_str(), value->name.length());\n"; + } + elsif ($T eq "STR") + { + print CODE " p1[4] = Z_".$T."_POOL (1, value.c_str (), value.length ());\n"; + } + else + { + print CODE " p1[4] = Z_".$T."_POOL (1, value);\n"; + } + print CODE " //call the zinc function with 5 arguments in internal form\n"; + print CODE " z_command (5, \"itemSet$t2 Failed : \");\n"; + print CODE "}\n\n"; + + print CODE "/**\n"; + print CODE " * Call zinc->itemcget ( -$2 )\n"; + print CODE " *\n"; + print CODE " * \@param item the item to get $2 from\n"; + print CODE " * \@return $2 value\n"; + print CODE " */\n"; + if ($t eq "String") + { + print CODE "String Zinc::itemGet$t2 (ZincItem * item)\n"; + } + else + { + print CODE "$t Zinc::itemGet$t2 (ZincItem * item)\n"; + } + print CODE "{\n"; + print CODE " Tcl_Obj* tmp;\n"; + print CODE " //discard all old results\n"; + print CODE " Tcl_ResetResult (interp);\n"; + print CODE " //prepare arguments : .zinc itemcget item \n"; + print CODE " p1[0] = id;\n"; + print CODE " p1[1] = ZFCT_itemcget;\n"; + print CODE " p1[2] = item->object;\n"; + print CODE " p1[3] = ZOPT_$2;\n"; + print CODE " //call the zinc function with 4 arguments in internal form\n"; + print CODE " z_command (4, \"itemGet$t2 Failed : \");\n\n"; + print CODE " //retreive the result trough the tcl interpreter and convert it\n"; + print CODE " tmp = Tcl_GetObjResult (interp);\n"; + if($e == 1) + { + print CODE " int value;\n"; + print CODE " z_tcl_call (Tcl_GetIndexFromObj (interp, tmp,\n"; + print CODE " $T"."Strings, \n"; + print CODE " \"$T\",\n"; + print CODE " 0, &value),\n"; + print CODE " \"itemGet$t2 Failed : \")\n"; + print CODE " return $t (value);\n"; + } + elsif ( $T eq "STR") + { + print CODE " return String (Tcl_GetStringFromObj (tmp, NULL));\n"; + } + elsif ( $T eq "PSTR") + { + print CODE " return new ZincFont (String (Tcl_GetStringResult (interp)));\n"; + } + elsif ( $T eq "PTR" ) + { + if( $t =~ /ZincItem/ ) + { + print CODE " return new ZincItem(tmp);\n"; + } + else if ( $t =~ /ZincImage/ ) + { + print CODE " return new ZincImage(tmp);\n"; + } + else + { + print CODE " return new ZincBitmap(tmp);\n"; + } + } + elsif ( $T eq "INT" ) + { + print CODE " int value;\n"; + print CODE " z_tcl_call (Tcl_GetIntFromObj (interp, tmp, &value),\n"; + print CODE " \"itemGet$t2 Failed : \");\n"; + print CODE " return ($t)value;\n"; + } + elsif ( $T eq "DBL" ) + { + print CODE " double value;\n"; + print CODE " z_tcl_call (Tcl_GetDoubleFromObj (interp, tmp, &value),\n"; + print CODE " \"itemGet$t2 Failed : \");\n"; + print CODE " return ($t)value;\n"; + } + elsif ( $T eq "BOO" ) + { + print CODE " int value;\n"; + print CODE " z_tcl_call (Tcl_GetBooleanFromObj (interp, tmp, &value),\n"; + print CODE " \"itemGet$t2 Failed : \");\n"; + print CODE " return ($t)value;\n"; + } + else + { + die("generationg error\n"); + } + print CODE "}\n\n"; + + $done .= "$2: $1\n"; + } +} + +print "--- CONSTANTES\n"; +print $res; +print "--- ENUMS.h\n"; +print $enum; +print "--- ENUMS.c\n"; +print $enum2; +print "--- FAIT\n"; +print $done; +print "--- PAS FAIT\n"; +print $undone; |