Wikipedia:Skrypt tworzący obrazki do związków chemicznych

Z Wikipedii

Poniższy program w języku Perl posłużył do wygenerowania obrazków obecnych w tabelach z opisem związków chemicznych. Program wymaga obecości modułu "Encode" ( powinien być dołączony do dystrybucji perla ) i "Image::Magick" ( może wymagać instalacji pakietu ImageMagick ). Do poprawnego działania skryptu, należy też skopiować do katalogu w którym się on znajduje dwa pliki z czcionką Arial ( arialbd.ttf i arialbi.ttf ), plik z danymi, oraz obrazki znajdujące się w tabelce poniżej.

Szablon Tabelki:
Brak struktury krystalicznej:
Struktura heksagonalna:	Grafika:Heksagonalna.png
Struktura jednoskośna:	Grafika:Jednoskosna.png
Struktura regularna:	Grafika:Regularna.png
Struktura regularna przestrzennie centrowana:	Grafika:Regularna przestrzennie centrowana.png
Struktura regularna ściennie centrowana:	Grafika:Regularna sciennie centrowana.png
Struktura rombowa:	Grafika:Rombowa.png
Struktura tetragonalna:	Grafika:Tetragonalna.png
Struktura trójskośna:	Grafika:Trojskosna.png

Program uruchamiamy wydając polecenie ./nazwa_programu. Gotowe obrazki zostaną zapisane w podkatalogu obrazki.

#!/usr/bin/perl

use Encode;
use Image::Magick;

local $la;
local $name;
local $short;
local $u;
local $crystal;
local $type;
local $image;
local $mesh;
local $filename;
#katalog na obrazki
local $dir="obrazki";
#tablica asocjacyjna typów struktury krystalicznej
local %cstruct=('hex'=>'Heksagonalna.png',
                'jed'=>'Jednoskosna.png',
                'rpc'=>'Regularna_przestrzennie_centrowana.png',
                'rsc'=>'Regularna_sciennie_centrowana.png',
                'reg'=>'Regularna.png',
                'rom'=>'Rombowa.png',
                'tet'=>'Tetragonalna.png',
                'tro'=>'Trojskosna.png',
                'brk'=>'Brak.png'
);
#tablica asocjacyna typów związków
local %tstruct=('mal'=>'#FF6666',  #metal alkaliczny
                'mza'=>'#FFDEAD',  #metal ziem alkalicznych
                'lan'=>'#FFBFFF',  #lantanowiec
                'akt'=>'#FF99CC',  #aktynowiec
                'mpz'=>'#FFC0C0',  #metal przejściowy
                'mgg'=>'#CCCCCC',  #metal grup głównych
                'mtd'=>'#CCCC99',  #metaloid
                'nie'=>'#A0FFA0',  #niemetal
                'hal'=>'#FFFF99',  #halogen
                'szl'=>'#A0FFFF'   #gaz szlachetny
);

sub DrawSelection{
  local $startx,$starty;
  local $points;
  #określamy lewy górny róg ramki na podstawie l.a.
  #pierwszy okres
  if ($la==1){
    $startx=0;
    $starty=0;
  }#if
  elsif($la==2){
    $startx=248;
    $starty=0;
  }#elsif
  #drugi okres
  elsif(($la==3)||($la==4)){
    $startx=($la-3)*8;
    $starty=11;
  }#elsif
  elsif(($la>=5)&&($la<=10)){
    $startx=($la-5)*8+208;
    $starty=11;
  }#elsif
  #trzeci okres
  elsif(($la==11)||($la==12)){
    $startx=($la-11)*8;
    $starty=22;
  }#elsif
  elsif(($la>=13)&&($la<=18)){
    $startx=($la-13)*8+208;
    $starty=22;
  }#elsif
  #czwarty okres
  elsif(($la==19)||($la==20)){
    $startx=($la-19)*8;
    $starty=33;
  }#elsif
  elsif(($la>=21)&&($la<=36)){
    $startx=($la-21)*8+128;
    $starty=33;
  }#elsif
  #piąty okres
  elsif(($la==37)||($la==38)){
    $startx=($la-37)*8;
    $starty=44;
  }#elsif
  elsif(($la>=39)&&($la<=54)){
    $startx=($la-39)*8+128;
    $starty=44;
  }#elsif
  #szósty okres
  elsif(($la>=55)&&($la<=86)){
    $startx=($la-55)*8;
    $starty=55;
  }#elsif
  #siódmy okres
  elsif(($la>=87)&&($la<=118)){
    $startx=($la-87)*8;
    $starty=66;
  }#elsif
  #tworzymy ciąg współrzędnych
  $points=sprintf("%i,%i %i,%i %i,%i %i,%i %i,%i",$startx,$starty,$startx+8,
                  $starty,$startx+8,$starty+11,$startx,$starty+11,$startx,
                  $starty);
  $image->Draw(primitive=>'polyline',bordercolor=>'black',points=>$points,
               antialias=>'false');
}#DrawSelection


mkdir("$dir");
open(FILE,'data.txt');
$line=readline(FILE);
while ($line!=""){
  #usuwamy spacje i znak końca linii
  $line=~s/\ //g;
  $line=~s/\n//g;
  #wydobywamy dane
  ($la,$name,$short,$u,$crystal,$type)=split('-',$line);
  #tworzymy nowy obrazek z szablonu
  $image=Image::Magick->new;
  $image->ReadImage('Szablon-TableImage.png');
  #rysujemy ramkę
  DrawSelection();
  #wypisujemy nazw
  $name=decode("iso-8859-2",$name);
  $image->Annotate(font=>'arialbi.ttf',pointsize=>15,fill=>'black',
                   text=>$name,align=>'Center',x=>163,y=>25);
  #dodajemy obrazek z typem struktury krystalicznej
  $mesh=Image::Magick->new;
  $mesh->ReadImage($cstruct{$crystal});
  $image->Composite(image=>$mesh,compose=>'Over',x=>18,y=>(54-$mesh->Get('height')));
  undef $mesh;
  #dodajemy opis związku w prostokącie
  $image->Draw(primitive=>'rectangle',bordercolor=>'black',fill=>'black',
               points=>'72,4 111,51',antialias=>'false');
  $image->Draw(primitive=>'rectangle',bordercolor=>$tstruct{$type},
               fill=>$tstruct{$type},points=>'73,5 110,50',
               antialias=>'false');
  #symbol
  if (length($short)<=2){
    $image->Annotate(font=>'arialbd.ttf',pointsize=>22,fill=>'black',
                     text=>$short,align=>'Right',x=>106,y=>37);
  }#if
  else{
    $image->Annotate(font=>'arialbd.ttf',pointsize=>18,fill=>'black',
                     text=>$short,align=>'Right',x=>109,y=>35);
  }#else
  #l.a.
  $image->Annotate(font=>'arialbd.ttf',pointsize=>10,fill=>'black',
                   text=>$la,align=>'Left',x=>76,y=>48);
  #masa atomowa
  $image->Annotate(font=>'arialbd.ttf',pointsize=>10,fill=>'black',
                   text=>$u,align=>'Center',x=>93,y=>16);
  #zapisujemy nowy obrazek
  $filename=sprintf("%s/%s-TableImage.png",$dir,$short);
  printf("Tworzę %s\n",$filename);
  $image->Write(filename=>$filename);
  undef $image;
  $line=readline(FILE);
}#while
close(FILE);