aboutsummaryrefslogtreecommitdiff
path: root/zinclib.d/gen.pl
diff options
context:
space:
mode:
Diffstat (limited to 'zinclib.d/gen.pl')
-rw-r--r--zinclib.d/gen.pl275
1 files changed, 0 insertions, 275 deletions
diff --git a/zinclib.d/gen.pl b/zinclib.d/gen.pl
deleted file mode 100644
index ac703d8..0000000
--- a/zinclib.d/gen.pl
+++ /dev/null
@@ -1,275 +0,0 @@
-#!/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;
generated by cgit v1.1 at 2024-06-18 21:31:57 +0000