#!/usr/bin/perl
# (C) 2009 Jan Kocbach / WorldofO.com / Jan@Kocbach.net
#
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details# .
#
# You should have received a copy of the GNU General Public License
# along with this program. If not, see .
# This is a perl script which will aid you in converting an OCAD-file to a
# Garmin map. For the conversion to work it depends on other software. See
# article at WorldofO.com for more information about the process.
################################################################################
# NOTE!!!!
#
# This program was intended for personal use only, and must be characterized as
# a hack. Programming is partly very sloppy, and the program might not do as
# intended in all cases. It has worked for the test cases I have used it for.
# Be happy if it works - if not I might not be able to help you on.
#
# A lot of the use/include/require's at the start of the program are probably not
# necessary - some of them were required in order to make an executable using
# perl2exe.
#
################################################################################
use Fcntl ':seek';
use Convert::Color;
use Convert::Color::CMYK;
use Convert::Color::RGB;
use Convert::Color::RGB8;
use File::Copy;
use Win32;
use Cwd;
use Tk;
use Tk::JPEG;
use Tk::ROText;
use Tk::Scrollbar;
use Tk::Radiobutton;
use Tk::Checkbutton;
use Tk::Pane;
use Tk::Bitmap;
use Tk::Dialog;
use Tk::DialogBox;
use Tk::ErrorDialog;
use Tk::HList;
use Tk::Image;
use Tk::ItemStyle;
use Tk::Optionmenu;
use Tk::Text;
use Tk::Toplevel;
use Tk::Widget;
use Tk::LabFrame;
use Tk::Balloon;
use Tk::Photo;
use Encode;
use Encode::Unicode;
require utf8;
require "unicore/lib/gc_sc/SpacePer.pl";
require "unicore/lib/gc_sc/Uppercas.pl";
require "unicore/lib/gc_sc/Digit.pl";
require "unicore/lib/gc_sc/Word.pl";
require "unicore/lib/gc_sc/Cntrl.pl";
require "unicore/lib/gc_sc/ASCII.pl";
require "Encode/Unicode.pm";
require "unicore/To/Lower.pl";
require "unicore/To/Upper.pl";
require "unicore/To/Fold.pl";
require "unicore/To/Digit.pl";
require "unicore/To/Title.pl";
Tk->import();
Tk::Balloon->import();
Tk::Photo->import();
Tk::Bitmap->import();
Tk::Canvas->import();
Tk::Checkbutton->import();
Tk::Radiobutton->import();
Tk::Dialog->import();
Tk::DialogBox->import();
Tk::ErrorDialog->import();
Tk::HList->import();
Tk::Image->import();
Tk::ItemStyle->import();
Tk::Optionmenu->import();
Tk::ROText->import();
Tk::Scrollbar->import();
Tk::Text->import();
Tk::Toplevel->import();
Tk::Widget->import();
Tk::LabFrame->import();
Tk::Pane->import();
#perl2exe_include Cwd
#perl2exe_include Tk
#perl2exe_include Tk::Pane
#perl2exe_include Tk::Scrollbar
#perl2exe_include MIME::Base64
#perl2exe_include Encode
#perl2exe_include Tk::JPEG
#perl2exe_include Tk::ROText
#perl2exe_include Convert::Color
#perl2exe_include "Tk/arrowdownwin.xbm"
#perl2exe_include "unicore/lib/gc_sc/Word.pl";
#perl2exe_include "unicore/lib/gc_sc/Digit.pl";
#perl2exe_include "unicore/lib/gc_sc/SpacePer.pl";
#perl2exe_include "unicore/lib/gc_sc/Uppercas.pl";
#perl2exe_include "unicore/lib/gc_sc/Cntrl.pl";
#perl2exe_include "unicore/lib/gc_sc/ASCII.pl";
#perl2exe_include "Encode/Unicode.pm";
#perl2exe_include utf8;
#perl2exe_include "unicore/To/Lower.pl";
#perl2exe_include "unicore/To/Upper.pl";
#perl2exe_include "unicore/To/Fold.pl";
#perl2exe_include "unicore/To/Digit.pl";
#perl2exe_include "unicore/To/Title.pl";
#perl2exe_include "utf8_heavy.pl"
# Check: ocad2img.exe -p2x_test
# Usage
# ocad2mp.exe eidsvaag_ocd7.ocd SYMcust.txt + eidsvaag.mp
# cgpsmapper eidsvaag.mp
#This script will make TYP and SYM.txt files.
#
#Note! File must be in OCAD7-format to be able to read symbols. Currently no check for this.\n
#The file input to ocad2mp may still be in OCAD9-format - but save as
#OCAD7 to run this script.\n\n
#
#After running this script run:
#ocad2mp map.ocd SYMcust.txt . map.mp (with border in file)
#ocad2mp map_ocd8.ocd SYMcust.txt + map.mp (use coordinates from OCAD)
#
#Note! Border symbol is defined in the SYMcust.txt file, and must be changed
#by the user by hand for now if the border method is used.
# Open in mapedit
# View -> manage mapskins -> load correct one
readsymbols();
$ocdfilesymbols="example_ocd7.ocd";
$ocdfiletoconvert="example.ocd";
$symfile="ex-sym.txt";
$typfile="ex-typ.txt";
$mpfile="example.mp";
$mapid="17360060";
$typid=888;
$mapname="Example map";
@fullareadescriptions=("Bare rock (black 20%)","Bare rock (grey)","Gigantic boulder or rock pillar","Impassable vegetation","Building inside (not passable)","Canopy","Building","Forest over green and yellow","Garmin White Background");
print "Starting up...\n";
TKshowstart();
sub startconvertsetup
{
# Some initial settings
$countarea=0;
$countpoint=0;
$countline=0;
$countsymbols=0;
@areac=("0e","0f","10","11","12","1b","1c","1d","20","21","22","23","24","25","26","27","29","2a","2b","2c","2d","2e","2f","30","31","33","34","35","36","37","38","39","3a","54","53","52","51","50","4f","4e","4d","4c","4b","4a","49","48","47","46"); # The ones after 54 are maybe not valid valid! Note - should maybe keep 0x50 out of here and make white background with it?
@pointc=("0e","0f","10","11","12","1b","1c","1d","20","21","22","23","24","25","26","27","29","2a","2b","2c","2d","2e","2f","30","31","33","34","35","36","37","38","39","3a","54","6400","6401","6402","6403","6404","6405","6406","6407","6408","6409","640A","640B","640C","640D","640E","640F","6410","6411","6412","6413","6414","6415","6416","6417","6418");
@linec=("01","02","03","04","05","06","07","08","09","0a","0b","0c","0d","0e","0f","10","11","12","13","14","15","16","18","19","1a","1b","1c","1d","1e","1f","20","21","22","23","24","25","26","27","28","29","2a","2b","2c","2d","2e","2f","30","31","32","33","34","35","36","37","38","39","3a","3b","3c","3e","3f","40","41","42","43","44","45","46","47","48","49","50","51","52","53","54");
readocadfile();
ocadconfig();
}
sub startconvert
{
writecnffile();
makesymfile();
maketypfile();
system("cgpsmapper typ $$typfile");
system("ocad2mp.exe --id $$mapid --name \"$$mapname\" --stat $$ocdfiletoconvert $$symfile . $$mpfile");
modifympfile();
system("cgpsmapper ac $$mpfile");
#copy("10378.TYP","C:\\gmaps");
#copy("17360060.IMG","C:\\gmaps\\");
}
sub readocadfile
{
if (-e $$ocdfilesymbols)
{
}
else
{
print "Error: Found no file $$ocdfilesymbols\n";
exit();
}
@symbolpixmaps=(); @symbolicons=(); @symboldescr=(); @symboltypes=(); @symbolcolors=(); @symbolmaincol=(); @symbolseccol=(); @symbolnumbers=(); @symbolmps=(); @symbolmps_org=();
open IFIL, '<:raw', $$ocdfilesymbols or die "Cannot open '$$ocdfilesymbols' $!";
binmode IFIL;
seek IFIL, 4*2, SEEK_SET;
$pos_symbol=readlong();
print "POS_SYMBOL: $pos_symbol\n";
@symbolfilepos=();
seek IFIL, $pos_symbol, SEEK_SET;
$next_symbol_block=readlong();
$val=readlong();
while ($val)
{
$symbolfilepos[$#symbolfilepos+1]=$val;
$val=readlong();
}
seek IFIL, 3*16, SEEK_SET;
$numcols=readshort();
$colseps=readshort();
$cyanfreq=readshort();
$cyanang=readshort();
$magfreq=readshort();
$magang=readshort();
$yellfreq=readshort();
$yellang=readshort();
$blackfreq=readshort();
$blackang=readshort();
$res1=readshort();
$res2=readshort();
print "Colors: $numcols - $colseps\n";
@cols=();
for ($ii=0;$ii<=255;$ii++)
{
# seek IFIL, 3*16+24 + $ii*72, SEEK_SET;
$colnu=readshort();
$res=readshort();
$cyan=readbyte()/2/100;
$magenta=readbyte()/2/100;
$yellow=readbyte()/2/100;
$black=readbyte()/2/100;
$txtlength=readbyte();
read (IFIL, $colname, 31);
read (IFIL, $spotcolinfo, 32);
$colname=~s/\0//g;
if ($colname)
{
#print "$colnu: $colname ($txtlength) $cyan $magenta $yellow $black\n";
$thiscol=Convert::Color::CMYK->new( $cyan, $magenta, $yellow, $black );
#$rgb=$thiscol->convert_to("rgb");
$rgb=$thiscol->convert_to_rgb;
#$orgbhex=$thiscol->as_rgb8->hex;
#print "Color RGB:". ($rgb->red*100) .",". ($rgb->green*100).",".($rgb->blue*100) ." ($rgbhex)\n";
$rgbhex= sprintf("%2x",$rgb->red*255) . sprintf("%2x",$rgb->green*255). sprintf("%2x",$rgb->blue*255) ;
$rgbhex=~s/ /0/g;
#print "$rgbhex - $orgbhex\n";
#<>;
$cols[$colnu]=$rgbhex;
}
#$bb=unpack 'b*', $spotcolinfo;
#print $bb."\n";
}
%thiscols=();
$nextcol=1;
############################################################3
# LOOP over all the symbols
############################################################3
for ($ii=0;$ii<=$#symbolfilepos;$ii++)
{
#print "$ii: ".$symbolfilepos[$ii]."\n";
seek IFIL, $symbolfilepos[$ii], SEEK_SET;
#Size: SmallInt; {Size of the symbol in bytes. This
# depends on the type and the
# number of subsymbols.}
$size=readshort();
# Sym: SmallInt; {Symbol number. This is 10 times
# the value which appears on the
# screen (1010 for 101.0)}
$symnum=sprintf("%.1f",readshort()/10);
# Otp: SmallInt; {Object type
# 1: Point symbol
# 2: Line symbol or Line text
# symbol
# 3: Area symbol
# 4: Text symbol
# 5: Rectangle symbol}
$objtype=readshort();
if ($objtype==1)
{ $objtype="Point symbol";}
elsif ($objtype==2)
{ $objtype="Line symbol";}
elsif ($objtype==3)
{ $objtype="Area symbol";}
elsif ($objtype==4)
{ $objtype="Text symbol";}
elsif ($objtype==5)
{ $objtype="Rectangle symbol";}
# SymTp: byte; {Symbol type
# 1: for Line text and text
# symbols
# 0: for all other symbols}
$symbtype=readbyte();
# Flags: byte; {OCAD 6/7: must be 0
# OCAD 8: bit flags
# 1: not oriented to north (inverted for
# better compatibility)
# 2: Icon is compressed}
$flags=readbyte();
# Extent: SmallInt; {Extent how much the rendered
# symbols can reach outside the
# coordinates of an object with
# this symbol.
# For a point object it tells
# how far away from the coordinates
# of the object anything of the
# point symbol can appear.}
$extent=readshort();
# Selected: boolean; {Symbol is selected in the symbol
# box}
$selected=readbyte();
# Status: byte; {Status of the symbol
# 0: Normal
# 1: Protected
# 2: Hidden}
$status=readbyte();
# Res2: SmallInt;
$res2=readshort();
# Res3: SmallInt;
$res3=readshort();
# FilePos: longint; {File position, not used in the
# file, only when loaded in
# memory. Value in the file is
# not defined.}
$filepos=readlong();
# Cols: TColors; {Set of the colors used in this
# symbol. TColors is an array of
# 32 bytes, where each bit
# represents 1 of the 256 colors.
# TColors = set of 0..255;
# The color with the number 0 in
# the color table appears as the
# lowest bit in the first byte of
# the structure.}
read (IFIL, $colinfo, 32);
$bits=unpack 'b*', $colinfo;
#print "Bits: $bits\n";
$col="";
for ($kk=0;$kk<=length($bits);$kk++)
{
if (substr($bits,$kk,1)=="1")
{
$tcol=$cols[$kk];
if (!$tcol) {$tcol="###$kk";}
$col.= "$tcol;";
}
}
#print "$symnum: $col ($bits)\n";
#<>;
# Description: string [31]; {The description of the symbol}
$descrlength=readbyte();
read (IFIL, $description, 31);
$description=~s/\0+$//g;
# IconBits: array[0..263] of byte;
# {the icon can be uncompressed (16-bit colors)
# or compressed (256 color palette) depending
# on the Flags field.
# In OCAD 6/7 it is always uncompressed}
read (IFIL, $icon, 264);
# Color only for this object
%thiscols=();
$nextcol=1;
##########################################################
# ICON
##########################################################
$ficon="";
for ($kk=0;$kk<22;$kk++)
{
$bytes=substr($icon,$kk*12,12);
$bits="";
for ($ll=0;$ll<11;$ll++)
{
$b=unpack 'b*', substr($bytes,$ll,1);
$col1=substr($b,4,4);
$col2=substr($b,0,4);
if (!$thiscols{"$col1"})
{ $thiscols{"$col1"}=$nextcol;$nextcol++;}
if (!$thiscols{"$col2"})
{ $thiscols{"$col2"}=$nextcol;$nextcol++;}
$bits.=$thiscols{$col1}.$thiscols{$col2};
}
for ($ll=0;$ll$$typfile");
print UFIL "$filestart\n";
$draworder="[_drawOrder]\n";
$allsymboldef="";
for ($ii=0;$ii<=$#symbolicons;$ii++)
{
my $icon=$symbolicons[$ii];
my $description=$symboldescr[$ii];
my $maincol=$symbolmaincol[$ii];
my $seccol=$symbolseccol[$ii];
my $symnum=$symbolnumbers[$ii];
my $symbolmp=$symbolmps[$ii];
my $objtype=$symboltypes[$ii];
my $col=$symbolcolors[$ii];
my $level=1; # For now - all on the same level. Must change this later on
if ($objtype=~/Area/)
{ $draworder.="Type=$symbolmp,$level ; $description ($objtype - $col - $symnum)\n";}
$symboldef=makesymbol($ii);
$allsymboldef.=$symboldef;
}
$draworder.="[end]\n";
print UFIL "$draworder\n";
print UFIL "$allsymboldef\n";
close(UFIL);
}
#print "Color overview:\n";
#foreach $key (sort {$thiscols{$a}<=>$thiscols{$b}} keys %thiscols)
#{
# print "$key: $thiscols{$key}\n";
#}
sub readlong
{
read (IFIL, $buffer, 4);
return my $val = unpack 'L', $buffer;
}
sub readshort
{
read (IFIL, $buffer, 2);
return my $val = unpack 'S', $buffer;
}
sub readbyte
{
read (IFIL, $buffer, 1);
return my $val = unpack 'C', $buffer;
}
sub makesymfile
{
$convertocadmpsymb="";
for ($ii=0;$ii<=$#symbolicons;$ii++)
{
my $description=$symboldescr[$ii];
my $symnum=$symbolnumbers[$ii];
my $symbolmp=$symbolmps[$ii];
my $objtype=$symboltypes[$ii];
my $col=$symbolcolors[$ii];
#if ($objtype=~/Point/i)
#{
# $level=2;
#}
#else
#{
$level=1; # For now - all on the same level. Must change this later on
#}
$convertocadmpsymb.="$symnum,$symbolmp,$level # $description ($objtype - $col)\n";
}
print "Writing file $$symfile\n\n";
open(UFIL,">$$symfile");
print UFIL "[IMG ID]
##
## MP Header section
##
Preprocess=F
CodePage=1251
LblCoding=9
TreSize=1023
TreMargin=0
Elevation=m
RgnLimit=700
Levels=6
Level0=24
Level1=23
Level2=22
Level3=21
Level4=19
Level5=18
Zoom0=0
Zoom1=1
Zoom2=2
Zoom3=3
Zoom4=4
Zoom5=5
[Convert]
###
## Converting OCAD symbol into Polish / Garmin symbol rules
##
## Format:
## OCAD_symbol, MP_symbol [, endlevel]
###
$convertocadmpsymb
[Links]
# # #
# # Link OCAD text symbols to Polish / Garmin symbols label rules
# #
# # Format:
# # OCAD_destination_symbol, OCAD_source_symbol, LinkType [, Radius]
# #
# # LinkType = Edge - align joined lines of different symbols,
# # Name - link text label to master object
# # #
# 110.0, 109.0, Edge # Average orolinii to a thick
# 111.0, 110.0, Edge # Thin orolinii to the middle. Radius trim - default
118.0, 118.1, Name # Signatures marks Heights
118.0, 118.2, Name # Signatures marks Heights
118.0, 118.3, Name # Signatures marks Heights
302.0, 314.0, Name # Marks the water
302.0, 314.1, Name # Marks the water
302.0, 314.2, Name # Marks the water
619.0, 118.1, Name # Heights tops
614.0, 614.1, Name # Names passes
305.0, 318.0, Name # The names of the rivers to the main rivers
306.0, 318.0, Name # The names of the rivers to the rivers
307.0, 318.0, Name # The names of the rivers to rivers peresyhayuschim
308.0, 318.0, Name # The names of the rivers to the endangered rivers
[Escapes]
# # #
# # Escape OCAD text symbols with specified prefix / suffix
# #
# # Format:
# # OCAD_symbol, \"Prefix\", [ \"Suffix\"]
# #
# # #
118.1, \"_\"
118.2, \"_\"
118.3, \"_\"
119.1, \"_\"
614.0, \"[\", \"]\"
314.1, \"[\", \"]\"
[Options]
#BorderSym=301.4 # Border symbol
BorderSym=999.0 # Border symbol
#BorderSym=901.0 # Border symbol
ConvertP42WGS=0 # Turn on / off Pulkovo1942 to WGS42 default conversion
# ProjOverride=1 # Override OCAD projection to Gauss-Krueger
OmitHidden=1 # Omit hidden OCAD symbols during conversion
# BezierParm = 10.0, 1.0 # Adjust Bezier approximation: approximation_scale, angle_tolerance
";
close(UFIL);
}
sub modifympfile
{
# This modifies mpfile given as $$mpfile
open(IFIL,$$mpfile);
@lines=;
close(IFIL);
print "Writing to $$mpfile\n";
open(UFIL,">$$mpfile");
$minlat=1e99;$minlon=1e99;
$maxlat=-1e99;$maxlon=-1e99;
foreach $line (@lines)
{
while ($line=~/\((.*?),(.*?)\)/g)
{
$lat=$1;$lon=$2;
if ($lat>$maxlat) {$maxlat=$lat;}
if ($lon>$maxlon) {$maxlon=$lon;}
if ($lat<$minlat) {$minlat=$lat;}
if ($lon<$minlon) {$minlon=$lon;}
}
if ($line=~/\[END-IMG ID\]/i)
{
# Should be possible to set this via setup?
print UFIL "SimplifyLevel=5\n";
}
print UFIL $line;
}
# Note! Put this at the end of the mp-file to get white forest!
# Bounds should be equal to bounds of complete map.
#print UFIL "
#
#[POLYGON]
#Type=0x50
#Data0=($minlat,$minlon),($maxlat,$minlon),($maxlat,$maxlon),($minlat,$maxlon),($minlat,$minlon)
#EndLevel=0
#[END]
#";
# Note - also need 0x50 for draworder! Forest
close(UFIL);
}
sub TKshowstart
{
$ww=900;
$hh=500;
$top = MainWindow->new;
$top->title("OCAD To Garmin conversion");
$top->geometry("${ww}x$hh");
# Make frame to put everything into
$topfr = $top->Scrolled("Pane", -scrollbars => "osw", -width => "$ww", -height=>"$hh")->pack();
$row=0;$col=0;
$topfr->Button(-text => "Read config-file",-width=>"50", -command => sub { readcnffile(); })->grid(-row => $row, -column => $col);
#$col++;
#$topfr->Button(-text => "Write config-file",-width=>"50", -command => sub { writecnffile(); })->grid(-row => $row, -column => $col);
# Get filenames
$row++;
$ocdfilesymbols=printfileinputrow($ocdfilesymbols,"OCAD file for symbols/colors (Must be OCAD7!)","load","ocd",$row);
$row++;
$ocdfiletoconvert=printfileinputrow($ocdfiletoconvert,"OCAD file to transform (can be OCAD7/8/9)","load","ocd",$row);
$row++;
$symfile=printfileinputrow($symfile,"SYM file to write","save","txt",$row);
$row++;
$typfile=printfileinputrow($typfile,"TYP file to write","save","txt",$row);
$row++;
$mpfile=printfileinputrow($mpfile,"MP file to write","save","mp",$row);
$row++;
$mapname=printinputrow($mapname,"Map name",$row);
$row++;
$mapid=printinputrow($mapid,"ID of Garmin map (8 digits)",$row);
$row++;
$typid=printinputrow($typid,"FID of Garmin map",$row);
$row++;$col=0;
$topfr->Button(-text => "Continue",-width=>"50", -command => sub { $top->destroy(); startconvertsetup(); })->grid(-row => $row, -column => $col);
$col++;
$topfr->Button(-text => "Exit",-width=>"50", -command => sub { exit(); })->grid(-row => $row, -column => $col);
#$topfr->Label(-image => )->pack(-side => "left", -anchor => "w");
#$inputlabel=$topfr->Label(-text => "Startnr: ")->pack(-side => "left", -anchor => "w");
$top->MainLoop;
exit;
}
sub getfilename {
my $type=$_[0];
my $ending=$_[1];
my $filename;
my @types;
print "Getting filename\n";
#$thisdir = cwd();
$thisdir=".";
if ($ending eq "ocd")
{ @types = (["OCAD file", '.ocd', 'TEXT'],["All files", '*']); }
if ($ending eq "txt")
{ @types = (["TXT file", '.txt', 'TEXT'],["All files", '*']); }
if ($ending eq "mp")
{ @types = (["MP file", '.mp', 'TEXT'],["All files", '*']); }
if ($ending eq "cnf")
{ @types = (["Config file", '.cnf', 'TEXT'],["All files", '*']); }
if ($type eq "load")
{
$filename = $top->getOpenFile(-parent => $top,
-filetypes => \@types,
-initialdir=> $thisdir);
#-title => 'Load configuration',
}
elsif ($type eq "save")
{
$filename = $top->getSaveFile(-parent => $top,
-filetypes => \@types,
-initialdir=> $thisdir);
}
#if (-e $stfile)
#{
#if ($stfile=~/\.ocd$/i)
#{
#}
#}
return $filename;
}
sub printfileinputrow
{
my $inf=$_[0];
my $descr=$_[1];
my $type=$_[2];
my $ff=$_[3];
my $row=$_[4];
my $col=0;
$topfr->Button(-text => $descr,-width=>"50", -command => sub { $inf=getfilename($type,$ff); })->grid(-row => $row, -column => $col);
$col++;
$topfr->Entry(-textvariable => \$inf, -width=>"50")->grid(-row => $row, -column => $col);
return \$inf;
}
sub printinputrow
{
my $inf=$_[0];
my $descr=$_[1];
my $row=$_[2];
my $col=0;
$topfr->Label(-text => $descr,-width=>"50")->grid(-row => $row, -column => $col);
$col++;
$topfr->Entry(-textvariable => \$inf, -width=>"50")->grid(-row => $row, -column => $col);
return \$inf;
}
sub readcnffile
{
$cnffile=getfilename("load","cnf");
open(IFIL,$cnffile);
@lines=;
close(IFIL);
%values=();
%readsymbolchanges=();
print "Reading $cnffile...\n";
foreach $line (@lines)
{
$line=~s/\n//g;
$line=~s/\r//g;
if (substr($line,0,1) ne "#")
{
($command,$value)=split(/\=/,$line);
if ($command=~/CHANGESYMBOL/)
{
($symnumber,$description)=split(/\:/,$value);
$readsymbolchanges{$symnumber}=$description;
}
elsif ($command ne "")
{
$values{$command}=$value;
}
}
}
$$ocdfilesymbols=$values{"OCADsymbolfile"};
$$ocdfiletoconvert=$values{"OCADtoconvertfile"};
$$symfile=$values{"SYMfile"};
$$typfile=$values{"TYPfile"};
$$mpfile=$values{"MPfile"};
$$mapid=$values{"MAPID"};
$$typid=$values{"TYPID"};
$$mapname=$values{"MAPNAME"};
}
sub writecnffile
{
#$cnffile=getfilename("save","cnf");
# For now we automatically make new config file...?
$thelocaltime=localtime time;
($nowsec,$nowmin,$nowhour,$nowmday,$nowmon,$nowyear,$nowdaynu)=localtime time;
$nowyear=$nowyear+1900;
$nowmon=$nowmon+1;
$thenowdate=sprintf("%4d%2d%2d-%2d%2d%2d",$nowyear,$nowmon,$nowmday,$nowhour,$nowmin,$nowsec);
$thenowdate=~s/ /0/g;
$cnffile="$$ocdfilesymbols";
($cnffile)=split(/\./,$cnffile);
$cnffile.="_".$thenowdate.".cnf";
open(UFIL,">$cnffile");
print UFIL "##########################\n";
print UFIL "# OCAD2IMG Config file\n";
print UFIL "##########################\n";
print UFIL "OCADsymbolfile=$$ocdfilesymbols\n";
print UFIL "OCADtoconvertfile=$$ocdfiletoconvert\n";
print UFIL "SYMfile=$$symfile\n";
print UFIL "TYPfile=$$typfile\n";
print UFIL "MPfile=$$mpfile\n";
print UFIL "MAPID=$$mapid\n";
print UFIL "TYPID=$$typid\n";
print UFIL "MAPNAME=$$mapname\n";
for ($ii=0;$ii<=$#symbolchanges;$ii++)
{
if ($symbolchanges[$ii])
{
print UFIL "CHANGESYMBOL=".$symbolnumbers[$ii].":".$symbolchanges[$ii]."\n";
}
}
close(UFIL);
}
sub ocadconfig
{
$mw = MainWindow->new;
$mw->title("Check symbols");
$mw->geometry("${ww}x$hh");
changesymbolsaccordingtocnffile();
# Make frame to put everything into
$mwfr = $mw->Scrolled("Pane", -scrollbars => "osw", -width => "$ww", -height=>"$hh")->pack();
$row=0;$col=0;
#$mwfr->Button(-text => "Do nothing",-width=>"50", -command => sub { print "Do nothing for now"; })->grid(-row => $row, -column => $col);
my @list_order =
sort { $symboltypes[$a] cmp $symboltypes[$b] } 0 .. $#symboltypes;
$mwfr->Label(-text => "Sym no") ->grid(-row => $row, -column => $col);
$col++;
$mwfr->Label(-text => "Sym type") ->grid(-row => $row, -column => $col);
$col++;
$mwfr->Label(-text => "Description") ->grid(-row => $row, -column => $col);
$col++;
$mwfr->Label(-text => "Icon") ->grid(-row => $row, -column => $col);
$col++;
$mwfr->Label(-text => "Color") ->grid(-row => $row, -column => $col);
$col++;
$mwfr->Label(-text => "Color II") ->grid(-row => $row, -column => $col);
$col++;
$col++;
$mwfr->Label(-text => "MP sym") ->grid(-row => $row, -column => $col);
$col++;
# Need:
# convert_to_pixmap
# convert_to_mp_symbol_txt
# convert_from_mp_symbol_txt
for ($cc=0;$cc<=$#symbolpixmaps;$cc++)
{
$kk=$list_order[$cc];
$row++;$col=0;
$mwfr->Label(-text => $symbolnumbers[$kk]) ->grid(-row => $row, -column => $col);
$col++;
$mwfr->Label(-text => $symboltypes[$kk]) ->grid(-row => $row, -column => $col);
$col++;
$mwfr->Label(-text => $symboldescr[$kk]) ->grid(-row => $row, -column => $col);
$col++;
$thepixmap=$mw->Pixmap(-data => $symbolpixmaps[$kk]);
$symbolbutton[$kk]=$mwfr->Button(-image => $thepixmap, -command => eval("sub { choosesymbol($kk); } "))->grid(-row => $row, -column => $col);
$col++;
$mwfr->Entry(-textvariable => \$symbolmaincol[$kk], -width=>"10") ->grid(-row => $row, -column => $col);
$col++;
$mwfr->Entry(-textvariable => \$symbolseccol[$kk], -width=>"10") ->grid(-row => $row, -column => $col);
$col++;
$mwfr->Button(-text => "Show colorchange", -command => eval("sub { changecolors($kk); } "))->grid(-row => $row, -column => $col);
$col++;
$col++;
#$mwfr->Entry(-textvariable => \$symbolmps[$kk]) ->grid(-row => $row, -column => $col);
$mwfr->Label(-text => $symbolmps[$kk]) ->grid(-row => $row, -column => $col);
#$topfr->Checkbutton(-image => $top->Pixmap(-data => $pixmap_data)) ->grid(-row => $row, -column => $col);
}
$col=0;$row++;
$mwfr->Button(-text => "Start conversion",-width=>"30", -command => sub { $mw->destroy(); startconvert(); })->grid(-row => $row, -column => $col);
$mw->MainLoop;
}
sub makepixmap
{
my $objtype = $_[0];
my $icon = $_[1];
my $maincol = $_[2];
my $seccol = $_[3];
my $colnu;
my $pixmap;
# This will set all areas full:
#if ($objtype=~/Area/i)
#{
# $icon="";
# for ($kk=1;$kk<=32;$kk++)
# { $icon.="\"XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX\",\n";}
# $icon=substr($icon,0,-2);
#}
if ($seccol)
{ $seccolrow="\"Y c #$seccol\",\n"; }
else
{ $seccolrow="";}
if ($seccol)
{ $colnu=3; }
else
{ $colnu=2; }
my @lines=split(/\n/,$icon);
my $ww=length($lines[0])-3;
my $hh=$#lines+1;
if ($hh==1)
{ $ww=$ww+1;}
$pixmap = "/* XPM */
static char * Icon_xpm[] = {
\"$ww $hh $colnu 1\",
\" c #FFFFFF\",
\"X c #$maincol\",
$seccolrow$icon};
";
$somex=($icon=~/X/g);
if (!$somex && $objtype=~/Area/i)
{
$pixmap=~s/" "/"XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"/g;
}
return $pixmap;
}
sub makesymbol
{
my $symbolnum = $_[0];
# $symbolicons[$countsymbols]=$icon;
# $symboldescr[$countsymbols]="$description";
# $symboltypes[$countsymbols]="$objtype";
# $symbolcolors[$countsymbols]="$col";
# $symbolnumbers[$countsymbols]="$symnum";
# $symbolmps[$countsymbols]="$symbolmp";
# $symbolmps_org[$countsymbols]="$symbolmp";
if ($seccol)
{ $colnu=3; }
else
{ $colnu=2; }
my $icon=$symbolicons[$symbolnum];
my $description=$symboldescr[$symbolnum];
my $maincol=$symbolmaincol[$symbolnum];
my $seccol=$symbolseccol[$symbolnum];
my $symnum=$symbolnumbers[$symbolnum];
my $symbolmp=$symbolmps[$symbolnum];
my $objtype=$symboltypes[$symbolnum];
my $col=$symbolcolors[$ii];
my @lines=split(/\n/,$icon);
my $ww=length($lines[0])-3;
my $hh=$#lines+1;
if ($hh==1)
{ $ww=$ww+1;}
# To use only one color for now
#$icon=~s/Y/X/g;
if ($icon=~/Y/)
{ $numcols=2;
if (!$seccol)
{ $seccol=$maincol;}
$seccolrow="\n\"Y\tc #$seccol\"";
}
else
{ $numcols=1;
$seccolrow="";
}
if ($objtype =~/Area/)
{
$fullarea=checkarea($icon);
if ($fullarea)
{
# Area - one color
$pixmap="
; $description ($objtype - $col - $symnum)
[_polygon]
Type=$symbolmp
string1=0x04,$description
XPM=\"0 0 2 1\"
\"1\tc #$maincol\"
\"3\tc #$maincol\"
[end]
";
}
else
{
# Some problems with two-color areas for now!
if (!$seccol)
{
$ccol="\" \tc None\"
\"X\tc #$maincol\";"
}
else
{
$ccol="\"X\tc #$maincol\"$seccolrow";
$icon=~s/ /Y/g;
}
$pixmap="
; $description ($objtype - $col - $symnum)
[_polygon]
Type=$symbolmp
string1=0x04,$description
XPM=\"$ww $hh 2 1\"
$ccol
${icon}
[end]
";
}
}
elsif ($objtype =~/Line/)
{
# Line one color
$uselinesymbol=1;
# Check $icon to see if this is just a line
($lw,$bw)=checklines($icon);
if ($lw>0)
{
if (!$bw)
{
$seccol=$maincol;
}
$pixmap="
; $description ($objtype - $col - $symnum)
[_line]
Type=$symbolmp
string1=0x04,$description
LineWidth=$lw
BorderWidth=$bw
xpm=\"0 0 2 1\"
\"X c #$maincol\"
\"= c #$seccol\"
[end]
";
}
else
{
# Line with symbol
$pixmap="
; $description ($objtype - $col - $symnum)
[_line]
Type=$symbolmp
string1=0x04,$description
UseOrientation=Y
xpm=\"$ww $hh ".($numcols+1)." 1\"
\" \tc None\"
\"X\tc #$maincol\"$seccolrow
${icon}
[end]
";
}
}
elsif ($objtype =~/Point/)
{
$pixmap="
; $description ($objtype - $col - $symnum)
[_point]
Type=$symbolmp
string1=0x04,$description
Dayxpm=\"$ww $hh ".($numcols+1)." 1\"
\" \tc None\"
\"X\tc #$maincol\"$seccolrow
${icon}
[end]
";
}
return $pixmap;
}
sub makeicon
{
my $objtype = $_[0];
my $ficon = $_[1];
my $ww;
my $hh;
@lines=split(/\n/,$ficon);
if ($objtype=~/Line/i)
{ $ww=32;$hh=22;}
elsif ($objtype=~/Area/i)
{ $ww=32;$hh=32;}
elsif ($objtype=~/Point/i)
{ $ww=22;$hh=22;}
my $icon="";
$lw=0;
$ll=0;
my $cc=0;
while ($cc<$hh)
{
$cc++;
$ln=$lines[$ll];
if ($ln=~/XXXX/)
{ $lw++;}
if ($ww>length($ln))
{ $ln=$ln . substr($ln,0,$ww-length($ln));}
$icon.="\"$ln\",\n";
$ll++;
if ($ll>=$#lines)
{ $ll=0;}
}
$icon=substr($icon,0,-2);
return ($icon,$ww,$hh);
}
sub checklines
{
my $cicon=$_[0];
$cicon=~s/"//g;
$cicon=~s/,//g;
my $lw=0;
my $bw=0;
my @lines=split(/\n/,$cicon);
my $fullines="";
foreach my $line (@lines)
{
$hits=0;
$hits++ while $line=~/X/g;
$hitsy=0;
$hitsy++ while $line=~/Y/g;
if ($hits == length($line))
{ $fullines.="X";}
elsif ($hitsy == length($line))
{ $fullines.="Y";}
elsif ($hits>0 || $hitsy>0)
{ $fullines.="-";}
else
{ $fullines.=" ";}
}
$fullines=~s/^\s+//g;
$fullines=~s/\s+$//g;
$fullines=~s/-/ /g;
# No full line
if ($fullines=~/ /)
{
$lw=0;
}
else
{
if ($fullines=~/Y/)
{
# Line consisting of two cols
$totw=length($fullines);
$fullines=~s/^Y+//g;
$leftw=$totw-length($fullines);
$fullines=~s/Y+$//g;
$rightw=$totw-length($fullines)-$leftw;
$lw=$totw-$leftw-$rightw;
if ($leftw == $rightw && ($lw>0))
{
# Line with border
$bw=$leftw;$lw=$lw;
}
else
{
$bw=0;$lw=0;
}
}
else
{
# Only a single line
$lw=length($fullines);
}
}
return ($lw,$bw);
}
sub checkarea
{
my $cicon=$_[0];
my $fullarea=0;
$cicon=~s/"//g;
$cicon=~s/,//g;
my $lw=0;
my @lines=split(/\n/,$cicon);
my $fullines="";
foreach my $line (@lines)
{
$hits=0;
$hits++ while $line=~/X/g;
$hitsy=0;
$hitsy++ while $line=~/Y/g;
if ($hits == length($line))
{ $fullines.="X";}
elsif ($hits == length($line))
{ $fullines.="Y";}
elsif ($hits>0)
{ $fullines.="-";}
else
{ $fullines.=" ";}
}
$fullines=~s/^\s+//g;
$fullines=~s/\s+$//g;
# Empty area
if (length($fullines)==0)
{ $fullarea=1; }
# Full area
$fullines=~s/-//g;
$fullines=~s/Y//g;
$lw=length($fullines);
if ($lw==($#lines+1))
{ $fullarea=1;}
return $fullarea;
}
sub choosesymbol
{
$symbol_to_change=$_[0];
my $objtype=$symboltypes[$symbol_to_change];
$mwc = MainWindow->new;
$mwc->title("Choose symbol to change to");
$mwc->geometry("${ww}x$hh");
# Make frame to put everything into
$mwcfr = $mwc->Scrolled("Pane", -scrollbars => "osw", -width => "$ww", -height=>"$hh")->pack();
$row=0;$col=0;
#$mwfr->Button(-text => "Do nothing",-width=>"50", -command => sub { print "Do nothing for now"; })->grid(-row => $row, -column => $col);
my @list_order =
sort { $stsymboltypes[$a] cmp $stsymboltypes[$b] } 0 .. $#stsymboltypes;
for ($cc=0;$cc<=$#stsymbolpixmaps;$cc++)
{
$kk=$list_order[$cc];
if ($stsymboltypes[$kk]=~/$objtype/)
{
$row++;$col=0;
$mwcfr->Label(-text => $stsymboldescr[$kk]) ->grid(-row => $row, -column => $col);
$col++;
$thepixmap=$mwc->Pixmap(-data => $stsymbolpixmaps[$kk]);
$mwcfr->Button(-image => $thepixmap, -command => eval("sub { changesymbol($kk); \$mwc->destroy();}"))->grid(-row => $row, -column => $col);
}
}
if ($objtype=~/Line/)
{
$row++;$col=0;
$mwcfr->Label(-text => "Line with chosen color") ->grid(-row => $row, -column => $col);
$col++;
$new_maincol=$symbolmaincol[$symbol_to_change];
$new_linewidth=2;
my $theicon=makelineicon($new_linewidth);
my $thespixmap=makepixmap("Line symbol",$theicon,$new_maincol,"");
my $thepixmap=$mwc->Pixmap(-data => $thespixmap);
$lineiconbutton=$mwcfr->Button(-image => $thepixmap, -command => sub { changesymbol("Line"); \$mwc->destroy();})->grid(-row => $row, -column => $col);
$col++;
$mwcfr->Entry(-textvariable => \$new_maincol) ->grid(-row => $row, -column => $col);
$col++;
$mwcfr->Entry(-textvariable => \$new_linewidth) ->grid(-row => $row, -column => $col);
$col++;
$mwcfr->Button(-text => "Show", -command => sub { showlineicon();})->grid(-row => $row, -column => $col);
}
if ($objtype=~/Area/)
{
$row++;$col=0;
$mwcfr->Label(-text => "Area with chosen color") ->grid(-row => $row, -column => $col);
$col++;
$new_maincol=$symbolmaincol[$symbol_to_change];
my $theicon=makefullfillicon();
my $thespixmap=makepixmap("Area symbol",$theicon,$new_maincol,"");
my $thepixmap=$mwc->Pixmap(-data => $thespixmap);
$areaiconbutton=$mwcfr->Button(-image => $thepixmap, -command => sub { changesymbol("Area"); \$mwc->destroy();})->grid(-row => $row, -column => $col);
$col++;
$mwcfr->Entry(-textvariable => \$new_maincol) ->grid(-row => $row, -column => $col);
$col++;
$mwcfr->Button(-text => "Show", -command => sub { showfillicon();})->grid(-row => $row, -column => $col);
}
$col=0;$row++;
$mwcfr->Button(-text => "Cancel",-width=>"50", -command => sub { $mwc->destroy(); })->grid(-row => $row, -column => $col);
$mwc->MainLoop;
}
sub changesymbol
{
# Should be able to choose between:
#
# 1) All symbols from file
# 2) Line with given color and linewidth (default color is maincol, but changeable)
# 3) Filled area with given color (default color is maincol, but changeable)
#
# For now: Only possible to choose between existing objects in file. Not very interesting...
# Changes must be logged in order to be saved / reloaded in config-file
$changeto=$_[0];
$noupdate=$_[1];
#print "Doing $symbol_to_change -> $changeto ($noupdate)\n";
if ($changeto eq "Line")
{
$theicon=makelineicon($new_linewidth);
$thespixmap=makepixmap("Line symbol",$theicon,$new_maincol,"");
$thepixmapone=$mw->Pixmap(-data => $thespixmap);
$symbolicons[$symbol_to_change]=$theicon;
$symbolmaincol[$symbol_to_change]= $new_maincol;
$symbolseccol[$symbol_to_change]= "";
$symbolpixmaps[$symbol_to_change]=$thespixmap;
$changetostr="STANDARD_LINE,$new_maincol,$new_linewidth";
}
elsif ($changeto eq "Area")
{
$theicon=makefullfillicon();
$thespixmap=makepixmap("Area symbol",$theicon,$new_maincol,"");
$thepixmapone=$mw->Pixmap(-data => $thespixmap);
$symbolicons[$symbol_to_change]=$theicon;
$symbolmaincol[$symbol_to_change]= $new_maincol;
$symbolseccol[$symbol_to_change]= "";
$symbolpixmaps[$symbol_to_change]=$thespixmap;
$changetostr="STANDARD_FILL,$new_maincol";
}
elsif ($changeto == -1)
{
# Load file. Change of colors and old symbol
$symbolmaincol[$symbol_to_change]=$new_maincol;
$symbolseccol[$symbol_to_change]= $new_seccol;
$thespixmap=makepixmap($symboltypes[$symbol_to_change],$symbolicons[$symbol_to_change],$new_maincol,$new_seccol);
$symbolpixmaps[$symbol_to_change]=$thespixmap;
$changetostr=",$new_maincol,$new_seccol";
}
else
{
# Load file. Change of colors and new symbol
if ($noupdate && ($new_maincol || $new_seccol))
{
$symbolmaincol[$symbol_to_change]=$new_maincol;
$symbolseccol[$symbol_to_change]= $new_seccol;
$symbolicons[$symbol_to_change]=$stsymbolicons[$changeto];
$thespixmap=makepixmap($stsymboltypes[$changeto],$stsymbolicons[$changeto],$new_maincol,$new_seccol);
$symbolpixmaps[$symbol_to_change]=$thespixmap;
$changetostr="$stsymboldescr[$changeto],$new_maincol,$new_seccol";
}
else
{
$symbolmaincol[$symbol_to_change]= $stsymbolmaincol[$changeto];
$symbolseccol[$symbol_to_change]= $stsymbolseccol[$changeto];
$symbolicons[$symbol_to_change]=$stsymbolicons[$changeto];
$thepixmapone=$mw->Pixmap(-data => $stsymbolpixmaps[$changeto]);
$symbolpixmaps[$symbol_to_change]=$stsymbolpixmaps[$changeto];
$changetostr=$stsymboldescr[$changeto];
}
}
if (!$noupdate)
{
$symbolbutton[$symbol_to_change]->configure(-image => $thepixmapone);
}
$symbolchanges[$symbol_to_change]=$changetostr;
}
sub changecolors
{
my $kk=$_[0];
$thespixmap=makepixmap($symboltypes[$kk],$symbolicons[$kk],$symbolmaincol[$kk],$symbolseccol[$kk]);
$thepixmapone=$mw->Pixmap(-data => $thespixmap);
$symbolbutton[$kk]->configure(-image => $thepixmapone);
#print "$kk: $changetostr\n";
$oldchangetostr=$symbolchanges[$kk];
if (!$oldchangetostr)
{
$changetostr=",$symbolmaincol[$kk],$symbolseccol[$kk]";
}
else
{
if ($oldchangetostr=~/STANDARD_LINE/)
{
($typ,$maincol,$lw)=split(/\,/,$oldchangetostr);
$changetostr="$typ,$symbolmaincol[$kk],$lw";
}
elsif ($oldchangetostr=~/STANDARD_FILL/)
{
($typ,$maincol)=split(/\,/,$oldchangetostr);
$changetostr="$typ,$symbolmaincol[$kk]";
}
else
{
($typ,$maincol,$seccol)=split(/\,/,$oldchangetostr);
$changetostr="$typ,$symbolmaincol[$kk],$symbolseccol[$kk]";
}
}
$symbolchanges[$kk]=$changetostr;
}
sub changesymbolsaccordingtocnffile
{
print "Changing symbols according to read in cnf-file\n";
#foreach $symnumber (keys %readsymbolchanges)
#{
# print "To change: $symnumber\n";
#}
for ($ii=0;$ii<=$#symbolnumbers;$ii++)
{
$symnumber=$symbolnumbers[$ii];
#print "Checking $symnumber\n";
$newdescription=$readsymbolchanges{$symnumber};
if ($newdescription)
{
$symbol_to_change=$ii;
if ($newdescription=~/STANDARD_LINE/i)
{
($type,$new_maincol,$newlinewidth)=split(/\,/,$newdescription);
$changeto="Line";
}
elsif ($newdescription=~/STANDARD_FILL/i)
{
($type,$new_maincol)=split(/\,/,$newdescription);
$changeto="Area";
}
else
{
($type,$new_maincol,$new_seccol)=split(/\,/,$newdescription);
if (!$type)
{ $changeto = -1;}
else
{ $changeto=$loadedsymbols{$type};}
}
# $changetostr="STANDARD_LINE,$new_maincol,$new_linewidth";
print "Change $symbol_to_change to $changeto\n";
if ($changeto ne "")
{
changesymbol($changeto,"noupdate");
}
else
{
print "Error in cnf-file: Could not find any symbol with name $newdescription in symbols.txt!\n";
}
}
}
}
sub showlineicon
{
my $theicon=makelineicon($new_linewidth);
my $thespixmap=makepixmap("Line symbol",$theicon,$new_maincol,"");
my $thepixmap=$mwc->Pixmap(-data => $thespixmap);
$lineiconbutton->configure(-image => $thepixmap);
}
sub showfillicon
{
my $theicon=makefullfillicon();
my $thespixmap=makepixmap("Area symbol",$theicon,$new_maincol,"");
my $thepixmap=$mwc->Pixmap(-data => $thespixmap);
$areaiconbutton->configure(-image => $thepixmap);
}
sub makelineicon
{
my $linewidth=$_[0];
my $borderwidth=$_[1];
my $icon="";
for (my $kk=0;$kk<$borderwidth;$kk++)
{
$icon.="\"";
for (my $ll=0;$ll<32;$ll++)
{ $icon.="Y";}
$icon.="\",\n";
}
for (my $kk=0;$kk<$linewidth;$kk++)
{
$icon.="\"";
for (my $ll=0;$ll<32;$ll++)
{ $icon.="X";}
$icon.="\",\n";
}
for (my $kk=0;$kk<$borderwidth;$kk++)
{
$icon.="\"";
for (my $ll=0;$ll<32;$ll++)
{ $icon.="Y";}
$icon.="\",\n";
}
$icon=substr($icon,0,-2);
return $icon;
}
sub makefullfillicon
{
my $icon="";
for (my $kk=0;$kk<32;$kk++)
{
$icon.="\"";
for (my $ll=0;$ll<32;$ll++)
{ $icon.="X";}
$icon.="\",\n";
}
$icon=substr($icon,0,-2);
return $icon;
}
sub readsymbols
{
$countsymbols=0;
$symbolsfile="symbols.txt";
open(IFIL,$symbolsfile);
@lines=;
close(IFIL);
for ($ii=0;$ii<=$#lines;$ii++)
{
$line=$lines[$ii];
if ($line=~/^\[_/)
{
($data,$icon,$colinfo)=getthis();
$sobjtype="";$type="";$description="";$useorientation="";$xpm="";$lw="";$bw="";
$hit=$data=~/\[_(.*?)\]/i;
if ($hit)
{ $sobjtype=$1;}
if ($sobjtype =~/point/i)
{ $objtype="Point symbol";}
elsif ($sobjtype =~/line/i)
{ $objtype="Line symbol";}
elsif ($sobjtype =~/polygon/i)
{ $objtype="Area symbol";}
else
{ $objtype="";}
$hit=$data=~/Type=(.*?)\n/i;
if ($hit)
{ $type=$1;}
$hit=$data=~/String.=(.*?)\n/i;
if ($hit)
{$description=$1; $description=~s/0x..,//g; $description=~s/^\s+//g; $description=~s/\s+$//g;
$description=~s/,//g;$description=~s/;//g;
}
$hit=$data=~/UseOrientation=(.*?)\n/i;
if ($hit)
{$useorientation=$1;}
$hit=$data=~/XPM="(.*?)"/i;
if ($hit)
{$xpm=$1;}
$hit=$data=~/LineWidth=(.*?)\n/i;
if ($hit)
{$lw=$1;}
$hit=$data=~/BorderWidth=(.*?)\n/i;
if ($hit)
{$bw=$1;}
($x,$y,$numcols,$xpp)=split(/ /,$xpm);
@colinfos=split(/\n/,$colinfo);
%colsymbols=();
$symnu=0;
$nextcolsymbol=2;
@colors=();
for ($kk=0;$kk<=$#colinfos;$kk++)
{
$str=$colinfos[$kk];
$str=~s/\t/ /g;
$colsymbol=substr($str,1,1);
($dummy,$col)=split(/ c /,$str);
$col=~s/ //g;
$col=~s/"//g;
$col=~s/,//g;
$col=~s/#//g;
#print "$colsymbol --- $col\n";
if ($col eq "ffffff")
{ $col="None";}
if ($col =~/none/i)
{
$newcolsymbol=1;
}
else
{
$newcolsymbol=$nextcolsymbol;
$nextcolsymbol++;
}
$icon=~s/$colsymbol/$newcolsymbol/g;
$colors[$newcolsymbol]=$col;
$colsymbols{$colsymbol}=$col;
}
$icon=~s/1/ /g;
$icon=~s/2/X/g;
$icon=~s/3/Y/g;
$maincol=$colors[2];
$seccol=$colors[3];
# Now process lines
if ($lw)
{
$maincol=$colsymbols{"X"};
$colors[1]="None";
$colors[2]=$maincol;
$seccol=$colsymbols{"="};
$icon=makelineicon($lw,$bw);
}
# Now process filled polygons
if (!$icon && $colsymbols{"1"})
{
$maincol=$colsymbols{"1"};
if ($maincol eq "None")
{ $maincol="ffffff";}
$colors[1]="None";
$colors[2]=$maincol;
$seccol="";
$icon=makefullfillicon();
#print "$description: $maincol\n";
}
$notinclude=0;
#if ($sobjtype =~/line/i && $icon ne "")
#if (!$colors[1])
#{ print "Error: Could not import $description (no background color for icon)!\n\n";$notinclude=1;}
if (!$colors[2])
{ print "Error: Could not import $description (no foreground color for icon)!\n\n";$notinclude=1;}
elsif (!$objtype)
{ print "Error: Could not import $description (no valid objecttype found)!\n\n";$notinclude=1;}
elsif (!$icon)
{ print "Error: Could not import $description (no icon found)!\n\n";$notinclude=1;}
elsif ($useddescr{$description})
{ print "Error: Could not import $description (same name used twice)!\n\n";$notinclude=1;}
elsif ($#colors>3)
{
print "Warning: More than two colors for $description. Only using two!";
$icon=~s/4/X/g; $icon=~s/5/X/g; $icon=~s/6/X/g;
}
if (!$notinclude)
{
$stsymbolpixmaps[$countsymbols]=makepixmap($objtype,$icon,$maincol,$seccol);
$stsymbolicons[$countsymbols]=$icon;
$stsymboldescr[$countsymbols]="$description";
$stsymboltypes[$countsymbols]="$objtype";
$stsymbolmaincol[$countsymbols]="$maincol";
$stsymbolseccol[$countsymbols]="$seccol";
$loadedsymbols{$description}=$countsymbols;
$useddescr{$description}=1;
$countsymbols++;
}
}
}
sub getthis
{
$continue=1;
my $data="";
my $startcol=0;
my $starticon=0;
my $colinfo="";
my $icon="";
while ($continue)
{
$data.=$line;
$ii++;$line=$lines[$ii];
$hit=$line=~/XPM="(.*?)"/i;
if ($hit)
{
(my $x,my $y,my $colors,my $xpp)=split(/ /,$line);
for (my $kk=1;$kk<=$colors;$kk++)
{
$colinfo.=$lines[$ii+$kk];
}
for (my $kk=$colors+1;$kk<$colors+$y+1;$kk++)
{
$icon.=$lines[$ii+$kk];
}
}
if ($line=~/^\[end\]/)
{ $continue=0;}
}
return ($data,$icon,$colinfo);
}
}