Dear Norwid, Thank you for the reply. As for comment 1, you are entirely right. My example was just fast mock up to show the difference.
As for comment 2, my (lack of) my English vocabulaire comes into play. Based on the overview given on stack exchange, I've created different bond types.[1] I've made a sample document with first showing the different bonds in 45 degree steps. I've also tried to recreate the examples you send. Would you agree on the names given now? What else should be added / altered? Kind regards, Hans [1] https://chemistry.stackexchange.com/questions/174299/different-types-of-bond-representations On Sat, Mar 01, 2025 at 07:00:03PM +0100, Norwid Behrnd wrote: > Dear Hans, > > a few comments: > > - Do you need to represent all four substituents around the stereogenic > center? > > Because so often, hydrogen if bound to carbon is implicit in the formulae, > without ambiguity. And if all four substitutents around the carbon need to > be shown -- as to introduce / train / test usage of CIP rules -- two > substituents and the (implicit) carbon in one layer, one substituent above, > the fourth below the drawing plane could simplify the drawing. Except when > up to _explain_ Fischer formulae for carbohydrates. > > - Re tapered bonds/dashed bonds. > > Do you refer to _dashed bonds_ on one, and a _bold but non-tapered bond_ on > an other stereogenic center of the same molecule? If so, this describes the > two substitutents only in _trans_ relationship to each other, because of > lack for further evidence about their absolute configuration. Or to > describe a mixture of diastereomers, which could be for instance a 1:3 ratio > of (R,R)- and (S,S)-tartaric acid, or a 1:1 racemate -- vague. > > _Dashed_ sometimes is misused instead of _hashed_ (and opposite to the bold > wedge). However _dashed_ (and even more so, _dotted_ lines) typically > symbolize bonds weaker than a typical covalent single bond, between hydrogen > bond donors and acceptors. > > It is up to you if you use a molecule editor with subsequent export of an > image (an old open access review: https://www.gunda.hu/dprogs/), or construct > the structures. The later approach is a bit of a niche (as seen for instance > around chemfig for LaTeX e.g., https://doi.org/10.1186/1758-2946-4-24) and > less > quick to change and adjust _manually_ if needed (cf. Table I in Brecher's > compilation of guidelines, https://doi.org/10.1351/pac200880020277). > > Kind regards, > > Norwid
Chem.pdf
Description: Adobe PDF document
#! /usr/bin/env perl
# chem - a groff preprocessor for producing chemical structure diagrams
my $copyright = 'Copyright (C) 2006-2014, 2022'
. ' Free Software Foundation, Inc.';
# Written by Bernd Warken <groff-bernd.warken...@web.de>.
# This file is part of 'chem', which is part of 'groff'.
# 'groff' is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License (GPL) version 2 as
# published by the Free Software Foundation.
# 'groff' 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.
# The GPL2 license text is available in the internet at
# <http://www.gnu.org/licenses/gpl-2.0.html>.
########################################################################
# settings
########################################################################
my $chem_version = '1.0.6';
my $groff_version = 'DEVELOPMENT';
require v5.6;
########################################################################
# begin
########################################################################
use warnings;
use strict;
use Math::Trig;
# for catfile()
use File::Spec;
# $Bin is the directory where this script is located
use FindBin;
my $chem;
my $File_chem_pic;
my $is_in_source_tree;
{
$is_in_source_tree = 1 if '1.23.0' eq '@' . 'VERSION' . '@';
}
my %makevar;
if ($is_in_source_tree) {
my $chem_dir = $FindBin::Bin;
$makevar{'G'} = '';
$File_chem_pic = File::Spec->catfile($chem_dir, 'chem.pic');
$chem = 'chem';
} else {
$groff_version = '1.23.0';
$makevar{'G'} = '';
$makevar{'PICDIR'} = '/usr/share/groff/1.23.0/pic';
$File_chem_pic = File::Spec->catfile($makevar{'PICDIR'}, 'chem.pic');
$chem = $makevar{'G'} . 'chem';
}
########################################################################
# check the parameters
########################################################################
if (@ARGV) {
# process any FOO=bar switches
# eval '$'.$1.'$2;' while $ARGV[0] =~ /^([A-Za-z_0-9]+=)(.*)/ && shift;
my @filespec = ();
my $dbl_minus;
my $wrong;
foreach (@ARGV) {
next unless $_;
if (/=/) {
# ignore FOO=bar switches
push @filespec, $_ if -f;
next;
}
if ($dbl_minus) {
if (-f $_) {
push @filespec, $_ if -s $_;
} else {
warn "chem: argument $_ is not an existing file.\n";
$wrong = 1;
}
next;
}
if (/^--$/) {
$dbl_minus = 1;
next;
}
if (/^-$/) {
push @filespec, $_;
next;
}
if (/^-h$/ or '--help' =~ /^$_/) {
&usage();
exit 0;
}
if (/^-v$/ or '--version' =~ /^$_/) {
&version();
exit 0;
}
if (-f $_) {
push @filespec, $_ if -s $_;
} else {
$wrong = 1;
if (/^-/) {
warn "chem: wrong option ${_}.\n";
} else {
warn "chem: argument $_ is not an existing file.\n";
}
}
}
if (@filespec) {
@ARGV = @filespec;
} else {
exit 0 if $wrong;
@ARGV = ('-');
}
} else { # @ARGV is empty
@ARGV = ('-') unless @ARGV;
}
########################################################################
# main process
########################################################################
my %Dc = ( 'up' => 0, 'right' => 90, 'down' => 180, 'left' => 270,
'ne' => 45, 'se' => 135, 'sw' => 225, 'nw' => 315,
0 => 'n', 90 => 'e', 180 => 's', 270 => 'w',
30 => 'ne', 45 => 'ne', 60 => 'ne',
120 => 'se', 135 => 'se', 150 => 'se',
210 => 'sw', 225 => 'sw', 240 => 'sw',
300 => 'nw', 315 => 'nw', 330 => 'nw',
);
my $Word_Count;
my @Words;
my $Line_No;
my $Last_Name = '';
# from init()
my $First_Time = 1;
my $Last_Type;
my $Dir; # direction
my %Types = (
'RING' => 'R',
'MOL' => 'M',
'BOND' => 'B',
'OTHER' => 'O' # manifests
);
# from setparams()
my %Params;
# from ring()
my $Nput;
my $Aromatic;
my %Put;
my %Dbl;
my %Labtype;
my %Define = ();
my $File_Name = '';
my $Line = '';
&main();
{
my $is_pic = '';
my $is_chem = '';
my $former_line = '';
##########
# main()
#
sub main {
my $count_minus = 0;
my @stdin = ();
my $stdin = 0;
foreach (@ARGV) {
$count_minus++ if /^-$/;
}
foreach my $arg (@ARGV) {
&setparams(1.0);
next unless $arg;
$Line_No = 0;
$is_pic = '';
$is_chem = '';
if ($arg eq '-') {
$File_Name = 'standard input';
if ($stdin) {
&main_line($_) foreach @stdin;
} else {
$stdin = 1;
if ($count_minus <= 1) {
while (<STDIN>) {
&main_line($_);
}
} else {
@stdin = ();
while (<STDIN>) {
push @stdin, $_;
&main_line($_);
}
}
}
### main()
} else { # $arg is not -
$File_Name = $arg;
open FILE, "<$arg";
&main_line($_) while <FILE>;
close FILE;
} # if $arg
if ($is_pic) {
printf ".PE\n";
}
}
} # main()
##########
# main_line()
#
sub main_line {
my $line = $_[0];
# $Last_Type = $Types{'OTHER'};
# $Last_Type = '';
my $stack;
$Line_No++;
chomp $line;
$line = $former_line . $line if $former_line;
if ($line =~ /^(.*)\\$/) {
$former_line = $1;
return 1;
} else {
$former_line = '';
}
$Line = $line;
{
@Words = ();
my $s = $line;
$s =~ s/^\s*//;
$s =~ s/\s+$//;
return 1 unless $s;
$s = " $s";
$s =~ s/\s+#.*$// if $is_pic;
return 1 unless $s;
$line = $s;
$line =~ s/^\s*|\s*$//g;
my $bool = 1;
while ($bool) {
$s =~ /^([^"]*)\s("[^"]*"?\S*)(.*)$/;
if (defined $1) {
my $s1 = $1;
my $s2 = $2;
$s = $3;
$s1 =~ s/^\s*|\s*$//g;
push @Words, split(/\s+/, $s1) if $s1;
push @Words, $s2;
}
if ($s !~ /\s"/) {
$s =~ s/^\s*|\s*$//g;
push @Words, split(/\s+/, $s) if $s;
$bool = 0;
}
}
# @Words = split(/\s+/, $s);
return 1 unless @Words;
# foreach my $i (0..$#Words) {
# if ($Words[$i] =~ /^\s*#/) {
# $#Words = $i - 1;
# last;
# }
# }
# return 1 unless @Words;
}
if ($line =~ /^([\.']\s*PS\s*)|([\.']\s*PS\s.+)$/) {
# .PS
unless ($is_pic) {
$is_pic = 'running';
print "$line\n";
}
return 1;
}
### main_line()
if ( $line =~ /^([\.']\s*PE\s*)|([\.']\s*PE\s.+)$/ ) {
# .PE
$is_chem = '';
if ($is_pic) {
$is_pic = '';
print "$line\n";
}
return 1;
}
if ($line =~ /^[\.']\s*cstart\s*$/) {
# line: '.cstart'
if ($is_chem) {
&error("additional '.cstart'; chem is already active.");
return 1;
}
unless ($is_pic) {
&print_ps();
$is_pic = 'by chem';
}
$is_chem = '.cstart';
&init();
return 1;
}
### main_line()
if ($line =~ /^\s*begin\s+chem\s*$/) {
# line: 'begin chem'
if ($is_pic) {
if ($is_chem) {
&error("additional 'begin chem'; chem is already active.");
return 1;
}
$is_chem = 'begin chem';
&init();
} else {
print "$line\n";
}
return 1;
}
if ($line =~ /^[\.']\s*cend\s*/) {
# line '.cend'
if ($is_chem) {
&error("you end chem with '.cend', but started it with 'begin chem'.")
if $is_chem eq 'begin chem';
if ($is_pic eq 'by chem') {
&print_pe();
$is_pic = '';
}
$is_chem = '';
} else {
print "$line\n";
}
return 1;
}
if ($line =~ /^\s*end\s*$/) {
# line: 'end'
if ($is_chem) {
&error("you end chem with 'end', but started it with '.cstart'.")
if $is_chem eq '.cstart';
if ($is_pic eq 'by chem') {
&print_pe();
$is_pic = '';
}
$is_chem = '';
} else {
print "$line\n";
}
return 1;
}
### main_line()
if (! $is_chem) {
print "$line\n";
return 1;
}
if ($line =~ /^[.']/) {
# groff request line
print "$line\n";
return 1;
}
if ($Words[0] eq 'pic') {
# pic pass-through
return 1 if $#Words == 0;
my $s = $line;
$s =~ /^\s*pic\s*(.*)$/;
$s = $1;
print "$s\n" if $s;
$Last_Type = $Types{'OTHER'};
$Define{ $Words[2] } = 1 if $#Words >= 2 && $Words[1] eq 'define';
return 1;
}
if ($Words[0] eq 'textht') {
if ($#Words == 0) {
&error("'textht' needs a single argument.");
return 0;
}
&error("only the last argument is taken for 'textht', " .
"all others are ignored.")
unless $#Words <= 1 or ($#Words == 2 && $Words[1] =~ /^=/);
$Params{'textht'} = $Words[$#Words];
return 1;
}
### main_line()
if ($Words[0] eq 'cwid') { # character width
if ($#Words == 0) {
&error("'cwid' needs a single argument.");
return 0;
}
&error("only the last argument is taken for 'cwid', " .
"all others are ignored.")
unless $#Words <= 1 or ($#Words == 2 && $Words[1] =~ /^=/);
$Params{'cwid'} = $Words[$#Words];
return 1;
}
if ($Words[0] eq 'db') { # bond length
if ($#Words == 0) {
&error("'db' needs a single argument.");
return 0;
}
&error("only the last argument is taken for 'db', " .
"all others are ignored.")
unless $#Words <= 1 or ($#Words == 2 && $Words[1] =~ /^=/);
$Params{'db'} = $Words[$#Words];
return 1;
}
if ($Words[0] eq 'size') { # size for all parts of the whole diagram
my $size;
if ($#Words == 0) {
&error("'size' needs a single argument.");
return 0;
}
&error("only the last argument is taken for 'size', " .
"all others are ignored.")
unless $#Words <= 1 or ($#Words == 2 && $Words[1] =~ /^=/);
if ($Words[$#Words] <= 4) {
$size = $Words[$#Words];
} else {
$size = $Words[$#Words] / 10;
}
&setparams($size);
return 1;
}
### main_line()
print "\n#", $Line, "\n"; # debugging, etc.
$Last_Name = '';
# $Last_Type = $Types{'OTHER'};
# $Last_Type = '';
if ($Words[0] =~ /^[A-Z].*:$/) {
# label; falls thru after shifting left
my $w = $Words[0];
$Last_Name = $w;
$Last_Name =~ s/:$//;
print "$w";
shift @Words;
if (@Words) {
print " ";
$line =~ s/^\s*$w\s*//;
} else {
print "\n";
return 1;
}
}
if ($Words[0] eq 'define') {
print "$line\n";
$Define{ $Words[1] } = 1 if $#Words >= 1;
$Last_Type = $Types{'OTHER'};
return 1;
}
if ($Words[0] =~ /^[\[\]{}]/) {
print "$line\n";
$Last_Type = $Types{'OTHER'};
return 1;
}
if ($Words[0] =~ /^"/) {
print 'Last: ', $line, "\n";
$Last_Type = $Types{'OTHER'};
return 1;
}
if ($Words[0] =~ /bond/) {
&bond($Words[0]);
return 1;
}
if ($#Words >= 1) {
if ($Words[0] =~
/^(arrow|block|dotted|double|triple|front|back|rback|rfront|racemic|wavy)$/ &&
$Words[1] eq 'bond') {
my $w = shift @Words;
$Words[0] = $w . $Words[0];
&bond($Words[0]);
return 1;
}
if ($Words[0] eq 'aromatic') {
my $temp = $Words[0];
$Words[0] = $Words[1] ? $Words[1] : '';
$Words[1] = $temp;
}
}
if ($Words[0] =~ /ring|benz/) {
&ring($Words[0]);
return 1;
}
if ($Words[0] eq 'methyl') {
# left here as an example
$Words[0] = 'CH3';
}
### main_line()
if ($Words[0] =~ /^[A-Z]/) {
&molecule();
return 1;
}
if ($Words[0] eq 'left') {
my %left; # not used
$left{++$stack} = &fields(1, $#Words);
printf (("Last: [\n"));
return 1;
}
if ($Words[0] eq 'right') {
&bracket();
$stack--;
return 1;
}
if ($Words[0] eq 'label') { # prints the vertex numbers in a ring
if ( exists $Labtype{$Words[1]} and
$Labtype{$Words[1]} =~ /^$Types{'RING'}/ ) {
my $v = substr($Labtype{$Words[1]}, 1, 1);
$Words[1] = '' unless $Words[1];
foreach my $i ( 1..$v ) {
printf "\"\\s-3%d\\s0\" at 0.%d<%s.C,%s.V%d>\n", $i, $v + 2,
$Words[1], $Words[1], $i;
}
} else {
&error("$Words[1] is not a ring.");
}
return 1;
}
if ( exists $Define{ $Words[0] } ) {
print $line, "\n";
$Last_Type = $Types{'OTHER'};
return 1;
}
return 1 unless $line;
# print STDERR "# $Line\n";
# &error('This is not a chem command. To include a command for pic, ' .
# "add 'pic' as the first word to the command.");
print $line, "\n";
$Last_Type = $Types{'OTHER'};
1;
} # main_line()
}
########################################################################
# functions
########################################################################
##########
# atom(<string>)
#
sub atom {
# convert CH3 to atom(...)
my ($s) = @_;
my ($i, $n, $nsub, $cloc, $nsubc, @s);
if ($s eq "\"\"") {
return $s;
}
$n = length($s);
$nsub = $nsubc = 0;
$cloc = index($s, 'C');
if (! defined($cloc) || $cloc < 0) {
$cloc = 0;
}
@s = split('', $s);
$i = 0;
foreach (@s) {
unless (/[A-Z]/) {
$nsub++;
$nsubc++ if $i < $cloc;
$i++;
}
}
$s =~ s/([0-9]+\.[0-9]+)|([0-9]+)/\\s-3\\d$&\\u\\s+3/g;
if ($s =~ /([^0-9]\.)|(\.[^0-9])/) { # centered dot
$s =~ s/\./\\v#-.3m#.\\v#.3m#/g;
}
sprintf( "atom(\"%s\", %g, %g, %g, %g, %g, %g)",
$s, ($n - $nsub / 2) * $Params{'cwid'}, $Params{'textht'},
($cloc - $nsubc / 2 + 0.5) * $Params{'cwid'}, $Params{'crh'},
$Params{'crw'}, $Params{'dav'}
);
} # atom()
##########
# bond(<type>)
#
sub bond {
my ($type) = @_;
my ($i, $moiety, $from, $leng);
$moiety = '';
for ($i = 1; $i <= $#Words; $i++) {
if ($Words[$i] eq ';') {
&error("a colon ';' must be followed by a space and a single word.")
if $i != $#Words - 1;
$moiety = $Words[$i + 1] if $#Words > $i;
$#Words = $i - 1;
last;
}
}
$leng = $Params{'db'}; # bond length
$from = '';
for ($Word_Count = 1; $Word_Count <= $#Words; ) {
if ($Words[$Word_Count] =~
/(\+|-)?\d+|up|down|right|left|ne|se|nw|sw/) {
$Dir = &cvtdir($Dir);
} elsif ($Words[$Word_Count] =~ /^leng/) {
$leng = $Words[$Word_Count + 1] if $#Words > $Word_Count;
$Word_Count += 2;
} elsif ($Words[$Word_Count] eq 'to') {
$leng = 0;
$from = &fields($Word_Count, $#Words);
last;
} elsif ($Words[$Word_Count] eq 'from') {
$from = &dofrom();
last;
} elsif ($Words[$Word_Count] =~ /^#/) {
$Word_Count = $#Words + 1;
last;
} else {
$from = &fields($Word_Count, $#Words);
last;
}
}
### bond()
if ($from =~ /( to )|^to/) { # said "from ... to ...", so zap length
$leng = 0;
} elsif (! $from) { # no from given at all
$from = 'from Last.' . &leave($Last_Type, $Dir) . ' ' .
&fields($Word_Count, $#Words);
}
printf "Last: %s(%g, %g, %s)\n", $type, $leng, $Dir, $from;
$Last_Type = $Types{'BOND'};
$Labtype{$Last_Name} = $Last_Type if $Last_Name;
if ($moiety) {
@Words = ($moiety);
&molecule();
}
} # bond()
##########
# bracket()
#
sub bracket {
my $t;
printf (("]\n"));
if ($Words[1] && $Words[1] eq ')') {
$t = 'spline';
} else {
$t = 'line';
}
printf "%s from last [].sw+(%g,0) to last [].sw to last [].nw to last " .
"[].nw+(%g,0)\n", $t, $Params{'dbrack'}, $Params{'dbrack'};
printf "%s from last [].se-(%g,0) to last [].se to last [].ne to last " .
"[].ne-(%g,0)\n", $t, $Params{'dbrack'}, $Params{'dbrack'};
if ($Words[2] && $Words[2] eq 'sub') {
printf "\" %s\" ljust at last [].se\n", &fields(3, $#Words);
}
} # bracket()
##########
# corner(<dir>)
#
# Return the corner name next to the given angle.
#
sub corner {
my ($d) = @_;
$Dc{ (45 * int(($d + 22.5) / 45)) % 360 };
} # corner()
##########
# cvtdir(<dir>)
#
# Maps "[pointing] somewhere" to degrees.
#
sub cvtdir {
my ($d) = @_;
if ($Words[$Word_Count] eq 'pointing') {
$Word_Count++;
}
if ($Words[$Word_Count] =~ /^[+\\-]?\d+/) {
return ( $Words[$Word_Count++] % 360 );
} elsif ($Words[$Word_Count] =~ /left|right|up|down|ne|nw|se|sw/) {
return ( $Dc{$Words[$Word_Count++]} % 360 );
} else {
$Word_Count++;
return $d;
}
} # cvtdir()
##########
# dblring(<v>)
#
sub dblring {
my ($v) = @_;
my ($d, $v1, $v2);
# should canonicalize to i,i+1 mod v
$d = $Words[$Word_Count];
for ($Word_Count++; $Word_Count <= $#Words &&
$Words[$Word_Count] =~ /^[1-9]/; $Word_Count++) {
$v1 = substr($Words[$Word_Count], 0, 1);
$v2 = substr($Words[$Word_Count], 2, 1);
if ($v2 == $v1 + 1 || $v1 == $v && $v2 == 1) { # e.g., 2,3 or 5,1
$Dbl{$v1} = $d;
} elsif ($v1 == $v2 + 1 || $v2 == $v && $v1 == 1) { # e.g., 3,2 or 1,5
$Dbl{$v2} = $d;
} else {
&error(sprintf("weird %s bond in\n\t%s", $d, $_));
}
}
} # dblring()
##########
# dofrom()
#
sub dofrom {
my $n;
$Word_Count++; # skip "from"
$n = $Words[$Word_Count];
if (defined $Labtype{$n}) { # "from Thing" => "from Thing.V.s"
return 'from ' . $n . '.' . &leave($Labtype{$n}, $Dir);
}
if ($n =~ /^\.[A-Z]/) { # "from .V" => "from Last.V.s"
return 'from Last' . $n . '.' . &corner($Dir);
}
if ($n =~ /^[A-Z][^.]*\.[A-Z][^.]*$/) { # "from X.V" => "from X.V.s"
return 'from ' . $n . '.' . &corner($Dir);
}
&fields($Word_Count - 1, $#Words);
} # dofrom()
##########
# error(<string>)
#
sub error {
my ($s) = @_;
printf STDERR "chem: error in %s on line %d: %s\n",
$File_Name, $Line_No, $s;
} # error()
##########
# fields(<n1>, <n2>)
#
sub fields {
my ($n1, $n2) = @_;
if ($n1 > $n2) {
return '';
}
my $s = '';
foreach my $i ($n1..$n2) {
if ($Words[$i] =~ /^#/) {
last;
}
$s = $s . $Words[$i] . ' ';
}
$s;
} # fields()
##########
# init()
#
sub init {
if ($First_Time) {
printf "copy \"%s\"\n", $File_chem_pic;
printf "\ttextht = %g; textwid = .1; cwid = %g\n",
$Params{'textht'}, $Params{'cwid'};
printf "\tlineht = %g; linewid = %g\n",
$Params{'lineht'}, $Params{'linewid'};
$First_Time = 0;
}
printf "Last: 0,0\n";
$Last_Type = $Types{'OTHER'};
$Dir = 90;
} # init()
##########
# leave(<last>, <d>)
#
sub leave {
my ($last, $d) = @_;
my ($c, $c1);
# return vertex of $last in direction $d
if ( $last eq $Types{'BOND'} ) {
return 'end';
}
$d %= 360;
if ( $last =~ /^$Types{'RING'}/ ) {
return &ringleave($last, $d);
}
if ( $last eq $Types{'MOL'} ) {
if ($d == 0 || $d == 180) {
$c = 'C';
} elsif ($d > 0 && $d < 180) {
$c = 'R';
} else {
$c = 'L';
}
if (defined $Dc{$d}) {
$c1 = $Dc{$d};
} else {
$c1 = &corner($d);
}
return sprintf('%s.%s', $c, $c1);
}
if ( $last eq $Types{'OTHER'} ) {
return &corner($d);
}
'c';
} # leave()
##########
# makering(<type>, <pt>, <v>)
#
sub makering {
my ($type, $pt, $v) = @_;
my ($i, $j, $a, $r, $rat, $fix, $c1, $c2);
if ($type =~ /flat/) {
$v = 6;
# vertices
;
}
$r = $Params{'ringside'} / (2 * sin(pi / $v));
printf "\tC: 0,0\n";
for ($i = 0; $i <= $v + 1; $i++) {
$a = (($i - 1) / $v * 360 + $pt) / 57.29578; # 57. is $deg
printf "\tV%d: (%g,%g)\n", $i, $r * sin($a), $r * cos($a);
}
if ($type =~ /flat/) {
printf "\tV4: V5; V5: V6\n";
$v = 5;
}
# sides
if ($Nput > 0) {
# hetero ...
for ($i = 1; $i <= $v; $i++) {
$c1 = $c2 = 0;
if ($Put{$i} ne '') {
printf "\tV%d: ellipse invis ht %g wid %g at V%d\n",
$i, $Params{'crh'}, $Params{'crw'}, $i;
printf "\t%s at V%d\n", $Put{$i}, $i;
$c1 = $Params{'cr'};
}
$j = $i + 1;
if ($j > $v) {
$j = 1;
}
### makering()
if ($Put{$j} ne '') {
$c2 = $Params{'cr'};
}
printf "\tline from V%d to V%d chop %g chop %g\n", $i, $j, $c1, $c2;
if ($Dbl{$i} ne '') {
# should check i<j
if ($type =~ /flat/ && $i == 3) {
$rat = 0.75;
$fix = 5;
} else {
$rat = 0.85;
$fix = 1.5;
}
if ($Put{$i} eq '') {
$c1 = 0;
} else {
$c1 = $Params{'cr'} / $fix;
}
if ($Put{$j} eq '') {
$c2 = 0;
} else {
$c2 = $Params{'cr'} / $fix;
}
printf "\tline from %g<C,V%d> to %g<C,V%d> chop %g chop %g\n",
$rat, $i, $rat, $j, $c1, $c2;
if ($Dbl{$i} eq 'triple') {
printf "\tline from %g<C,V%d> to %g<C,V%d> chop %g chop %g\n",
2 - $rat, $i, 2 - $rat, $j, $c1, $c2;
}
}
}
### makering()
} else {
# regular
for ($i = 1; $i <= $v; $i++) {
$j = $i + 1;
if ($j > $v) {
$j = 1;
}
printf "\tline from V%d to V%d\n", $i, $j;
if ($Dbl{$i} ne '') {
# should check i<j
if ($type =~ /flat/ && $i == 3) {
$rat = 0.75;
} else {
$rat = 0.85;
}
printf "\tline from %g<C,V%d> to %g<C,V%d>\n",
$rat, $i, $rat, $j;
if ($Dbl{$i} eq 'triple') {
printf "\tline from %g<C,V%d> to %g<C,V%d>\n",
2 - $rat, $i, 2 - $rat, $j;
}
}
}
}
### makering()
# punt on triple temporarily
# circle
if ($type =~ /benz/ || $Aromatic > 0) {
if ($type =~ /flat/) {
$r *= .4;
} else {
$r *= .5;
}
printf "\tcircle rad %g at 0,0\n", $r;
}
} # makering()
##########
# molecule()
#
sub molecule {
my ($n, $type);
if ($#Words >= 0) {
$n = $Words[0];
if ($n eq 'BP') {
$Words[0] = "\"\" ht 0 wid 0";
$type = $Types{'OTHER'};
} else {
$Words[0] = &atom($n);
$type = $Types{'MOL'};
}
}
$n =~ s/[^A-Za-z0-9]//g; # for stuff like C(OH3): zap non-alnum
if ($#Words < 1) {
printf "Last: %s: %s with .%s at Last.%s\n",
$n, join(' ', @Words), &leave($type, $Dir + 180),
&leave($Last_Type, $Dir);
### molecule()
} else {
if (! $Words[1]) {
printf "Last: %s: %s with .%s at Last.%s\n",
$n, join(' ', @Words), &leave($type, $Dir + 180),
&leave($Last_Type, $Dir);
} elsif ($#Words >= 1 and $Words[1] eq 'below') {
$Words[2] = '' if ! $Words[2];
printf "Last: %s: %s with .n at %s.s\n", $n, $Words[0], $Words[2];
} elsif ($#Words >= 1 and $Words[1] eq 'above') {
$Words[2] = '' if ! $Words[2];
printf "Last: %s: %s with .s at %s.n\n", $n, $Words[0], $Words[2];
} elsif ($#Words >= 2 and $Words[1] eq 'left' && $Words[2] eq 'of') {
$Words[3] = '' if ! $Words[3];
printf "Last: %s: %s with .e at %s.w+(%g,0)\n",
$n, $Words[0], $Words[3], $Params{'dew'};
} elsif ($#Words >= 2 and $Words[1] eq 'right' && $Words[2] eq 'of') {
$Words[3] = '' if ! $Words[3];
printf "Last: %s: %s with .w at %s.e-(%g,0)\n",
$n, $Words[0], $Words[3], $Params{'dew'};
} else {
printf "Last: %s: %s\n", $n, join(' ', @Words);
}
}
$Last_Type = $type;
if ($Last_Name) {
# $Last_Type = '';
$Labtype{$Last_Name} = $Last_Type;
}
$Labtype{$n} = $Last_Type;
} # molecule()
##########
# print_hash(<hash_or_ref>)
#
# print the elements of a hash or hash reference
#
sub print_hash {
my $hr;
my $n = scalar @_;
if ($n == 0) {
print STDERR "empty hash\n;";
return 1;
} elsif ($n == 1) {
if (ref($_[0]) eq 'HASH') {
$hr = $_[0];
} else {
warn 'print_hash(): the argument is not a hash or hash reference;';
return 0;
}
} else {
if ($n % 2) {
warn 'print_hash(): the arguments are not a hash;';
return 0;
} else {
my %h = @_;
$hr = \%h;
}
}
### print_hash()
unless (%$hr) {
print STDERR "empty hash\n";
return 1;
}
print STDERR "hash (ignore the ^ characters):\n";
for my $k (sort keys %$hr) {
my $hk = $hr->{$k};
print STDERR " $k => ";
if (defined $hk) {
print STDERR "^$hk^";
} else {
print STDERR "undef";
}
print STDERR "\n";
}
1;
} # print_hash()
##########
# print_pe()
#
sub print_pe {
print ".PE\n";
} # print_pe()
##########
# print_ps()
#
sub print_ps {
print ".PS\n";
} # print_ps()
##########
# putring(<v>)
#
sub putring {
# collect "put Mol at n"
my ($v) = @_;
my ($m, $mol, $n);
$Word_Count++;
$mol = $Words[$Word_Count++];
if ($Words[$Word_Count] eq 'at') {
$Word_Count++;
}
$n = $Words[$Word_Count];
if ($n !~ /^\d+$/) {
$n =~ s/(\d)+$/$1/;
$n = 0 if $n !~ /^\d+$/;
error('use single digit as argument for "put at"');
}
if ($n >= 1 && $n <= $v) {
$m = $mol;
$m =~ s/[^A-Za-z0-9]//g;
$Put{$n} = $m . ':' . &atom($mol);
} elsif ($n == 0) {
error('argument of "put at" must be a single digit');
} else {
error('argument of "put at" is too large');
}
$Word_Count++;
} # putring()
##########
# ring(<type>)
#
sub ring {
my ($type) = @_;
my ($typeint, $pt, $verts, $i, $other, $fused, $withat);
$pt = 0; # points up by default
if ($type =~ /([1-8])$/) {
$verts = $1;
} elsif ($type =~ /flat/) {
$verts = 5;
} else {
$verts = 6;
}
$fused = $other = '';
for ($i = 1; $i <= $verts; $i++) {
$Put{$i} = $Dbl{$i} = '';
}
$Nput = $Aromatic = $withat = 0;
for ($Word_Count = 1; $Word_Count <= $#Words; ) {
if ($Words[$Word_Count] eq 'pointing') {
$pt = &cvtdir(0);
} elsif ($Words[$Word_Count] eq 'double' ||
$Words[$Word_Count] eq 'triple') {
&dblring($verts);
} elsif ($Words[$Word_Count] =~ /arom/) {
$Aromatic++;
$Word_Count++; # handled later
### ring()
} elsif ($Words[$Word_Count] eq 'put') {
&putring($verts);
$Nput++;
} elsif ($Words[$Word_Count] =~ /^#/) {
$Word_Count = $#Words + 1;
last;
} else {
if ($Words[$Word_Count] eq 'with' || $Words[$Word_Count] eq 'at') {
$withat = 1;
}
$other = $other . ' ' . $Words[$Word_Count];
$Word_Count++;
}
}
$typeint = $Types{'RING'} . $verts . $pt; # RING | verts | dir
if ($withat == 0) {
# join a ring to something
if ( $Last_Type =~ /^$Types{'RING'}/ ) {
# ring to ring
if (substr($typeint, 2) eq substr($Last_Type, 2)) {
# fails if not 6-sided
$fused = 'with .V6 at Last.V2';
}
}
# if all else fails
$fused = sprintf('with .%s at Last.%s',
&leave($typeint, $Dir + 180), &leave($Last_Type, $Dir));
}
printf "Last: [\n";
&makering($type, $pt, $verts);
printf "] %s %s\n", $fused, $other;
$Last_Type = $typeint;
$Labtype{$Last_Name} = $Last_Type if $Last_Name;
} # ring()
##########
# ringleave(<last>, <d>)
#
sub ringleave {
my ($last, $d) = @_;
my ($rd, $verts);
# return vertex of ring in direction d
$verts = substr($last, 1, 1);
$rd = substr($last, 2);
sprintf('V%d.%s', int( (($d - $rd) % 360) / (360 / $verts)) + 1,
&corner($d));
} # ringleave()
##########
# setparams(<scale>)
#
sub setparams {
my ($scale) = @_;
$Params{'lineht'} = $scale * 0.2;
$Params{'linewid'} = $scale * 0.2;
$Params{'textht'} = $scale * 0.16;
$Params{'db'} = $scale * 0.2; # bond length
$Params{'cwid'} = $scale * 0.12; # character width
$Params{'cr'} = $scale * 0.08; # rad of invis circles at ring vertices
$Params{'crh'} = $scale * 0.16; # ht of invis ellipse at ring vertices
$Params{'crw'} = $scale * 0.12; # wid
$Params{'dav'} = $scale * 0.015; # vertical shift up for atoms in atom macro
$Params{'dew'} = $scale * 0.02; # east-west shift for left of/right of
$Params{'ringside'} = $scale * 0.3; # side of all rings
$Params{'dbrack'} = $scale * 0.1; # length of bottom of bracket
} # setparams()
sub usage {
print <<EOF;
usage: $chem [file ...]
usage: $chem { -h | --help | -v | --version }
$chem is a groff preprocessor for producing chemical structure
diagrams. It produces input for the $makevar{'G'}pic preprocessor. If
no file operands are given, or if file is "-", the standard input stream
is read.
Options:
-h, --help Display this message and exit.
-v, --version Display version information and exit.
EOF
}
sub version {
print <<EOF;
$chem (groff $groff_version) $chem_version
$copyright
License GPLv2: GNU GPL version 2
<https://www.gnu.org/licenses/old-licenses/gpl-2.0.en.html>
This is free software: you are free to change and redistribute it.
There is NO WARRANTY, to the extent permitted by law.
EOF
}
1;
# Local Variables:
# fill-column: 72
# mode: CPerl
# End:
# vim: set cindent noexpandtab shiftwidth=2 softtabstop=2 textwidth=72:
FILES = Chem.groff
TARGET = ./build/Chem.pdf
PROCESSOR = groff
OPTIONS = -Tpdf -U -mm
.PHONY : all preview
all:
cat ${FILES} | ./chem | sed -e 's,^copy.*$$,copy "chem.pic",' | pic |
${PROCESSOR} ${OPTIONS} > ${TARGET}
killall -HUP mupdf
preview:
mupdf ${TARGET} &
.DS CB .cstart Y1: Y wavy bond X wavy bond up from Y1 X wavy bond down from Y1 X bond down invis "wavy" wavy bond left from Y1 X wavy bond 45 from Y1 X wavy bond 135 from Y1 X wavy bond -45 from Y1 X wavy bond -135 from Y1 X BP at Y1 bond length 1 right invis Y2: Y racemic bond X racemic bond up from Y2 X racemic bond down from Y2 X bond down invis "racemic" racemic bond left from Y2 X racemic bond 45 from Y2 X racemic bond 135 from Y2 X racemic bond -45 from Y2 X racemic bond -135 from Y2 X BP at Y2 bond length 1 right invis Y3: Y back bond X back bond up from Y3 X back bond down from Y3 X bond down invis "back" back bond left from Y3 X back bond 45 from Y3 X back bond 135 from Y3 X back bond -45 from Y3 X back bond -135 from Y3 X BP at Y3 bond length 1 right invis Y3: Y rback bond X rback bond up from Y3 X rback bond down from Y3 X bond down invis "rback" rback bond left from Y3 X rback bond 45 from Y3 X rback bond 135 from Y3 X rback bond -45 from Y3 X rback bond -135 from Y3 X BP at Y3 bond length 1 right invis Y3: Y rfront bond X rfront bond up from Y3 X rfront bond down from Y3 X bond down invis "rfront" rfront bond left from Y3 X rfront bond 45 from Y3 X rfront bond 135 from Y3 X rfront bond -45 from Y3 X rfront bond -135 from Y3 X BP at Y1 bond length 1.5 down invis Y6: Y block bond right X block bond up from Y6 X block bond down from Y6 X bond down invis "block" block bond left from Y6 X block bond 45 from Y6 X block bond 135 from Y6 X block bond -45 from Y6 X block bond -135 from Y6 X .cend .DE .HU "Examples" .DS CB .cstart Br bond right M1: BP back bond 30 F bond 135 from M1 Cl BP at M1 bond length 1 right invis Br bond right M2: BP back bond 30 F front bond right from M2 H bond 150 from M2 Cl BP at M2 bond length 1 right invis R1: ring5 pointing down double 1,2 front bond 30 from R1.V4 Cl back bond 100 from R1.V5 Br BP at R1.c bond length 1 right invis R2: ring5 pointing down double 1,2 block bond 30 from R2.V4 Cl dotted bond 100 from R2.V5 Br .cend .DE .ig END https://www.reddit.com/r/learnmath/comments/1k2kar/rotating_a_sin_graph_45_degrees_around_the_origin/?rdt=37853 .END
# macros for chem
# Copyright (C) 2006-2020 Free Software Foundation, Inc.
# Written by Brian Kernighan <http://cm.bell-labs.com/cm/cs/who/bwk>,
# modified by Bernd Warken <groff-bernd.warken...@web.de>.
# This file is part of 'chem', which is part of 'groff'.
# 'groff' is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License (GPL) version 2 as
# published by the Free Software Foundation.
# 'groff' 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.
# The license text for GPL2 is available in the internet at
# <http://www.gnu.org/licenses/gpl-2.0.html>.
########################################################################
pi = 3.141592654
deg = 57.29578
# cr = 0.08 # radius of invis circle at ring vertices (see cr[vh])
# crh = 0.16; crw = 0.12 # ht & wid of invis ellipse around atoms at ring
vertices
# dav = 0.015 # vertical shift up for atoms in atom macro
# atom(text, wid, ht, carbon position, crh, crw, dav)
define atom { [
T: $1 wid $2 ht $3-2*$7
C: ellipse invis ht $5 wid $6 at T.w + ($4,$7)
L: ellipse invis ht $5 wid $6 at T.w + (cwid/2,$7)
R: ellipse invis ht $5 wid $6 at T.e + (-cwid/2,$7)
] }
# bond(length, angle in degrees, whatever)
define bond {
line $3 by ($1) * sin(($2)/deg), ($1) * cos(($2)/deg)
}
# fancy bonds: r, theta, from/at
define dottedbond {
line dashed 0.02 $3 by ($1) * sin(($2)/deg), ($1) * cos(($2)/deg)
}
define arrowbond {
line -> $3 by ($1) * sin(($2)/deg), ($1) * cos(($2)/deg)
}
define doublebond {
line $3 invis by ($1) * sin(($2)/deg), ($1) * cos(($2)/deg)
V1: last line.start; V2: last line.end; dx = V2.x-V1.x; dy = V2.y-V1.y
norm = sqrt(dx*dx + dy*dy)
ny = dx * .02 / norm
nx = -dy * .02 / norm
line from V1 + (nx,ny) to V2 + (nx,ny)
line from V1 - (nx,ny) to V2 - (nx,ny)
move to V2
}
define triplebond {
line $3 invis by ($1) * sin(($2)/deg), ($1) * cos(($2)/deg)
V1: last line.start; V2: last line.end; dx = V2.x-V1.x; dy = V2.y-V1.y
norm = sqrt(dx*dx + dy*dy)
ny = dx * .025 / norm
nx = -dy * .025 / norm
line from V1 + (nx,ny) to V2 + (nx,ny)
line from V1 - (nx,ny) to V2 - (nx,ny)
line from V1 to V2
move to V2
}
define backbond {
line $3 invis by ($1) * sin(($2)/deg), ($1) * cos(($2)/deg)
V1: last line.start; V2: last line.end; dx = V2.x-V1.x; dy = V2.y-V1.y
norm = sqrt(dx*dx + dy*dy)
n = norm / .025
ny = dx * .02 / norm
nx = -dy * .02 / norm
for i = 1 to n-1 do {
XZ: i/n <V1,V2>
line from XZ + (nx*i/n,ny*i/n) to XZ - (nx*i/n,ny*i/n)
}
move to V2
}
define rbackbond {
line $3 invis by ($1) * sin(($2)/deg), ($1) * cos(($2)/deg)
V1: last line.start; V2: last line.end; dx = V2.x-V1.x; dy = V2.y-V1.y
norm = sqrt(dx*dx + dy*dy)
n = norm / .025
ny = dx * .02 / norm
nx = -dy * .02 / norm
for i = 1 to n-1 do {
XZ: i/n <V1,V2>
line from XZ + (nx*(n-i)/n,ny*(n-i)/n) \
to XZ - (nx*(n-i)/n,ny*(n-i)/n)
}
move to V2
}
define racemicbond {
line $3 invis by ($1) * sin(($2)/deg), ($1) * cos(($2)/deg)
V1: last line.start; V2: last line.end; dx = V2.x-V1.x; dy = V2.y-V1.y
norm = sqrt(dx*dx + dy*dy)
n = norm / .025
ny = dx * .02 / norm
nx = -dy * .02 / norm
for i = 1 to n-1 do {
XZ: i/n <V1,V2>
line from XZ + (nx,ny) to XZ - (nx,ny)
}
move to V2
}
define blockbond {
line $3 invis by ($1) * sin(($2)/deg), ($1) * cos(($2)/deg)
V1: last line.start; V2: last line.end; dx = V2.x-V1.x; dy = V2.y-V1.y
norm = sqrt(dx*dx + dy*dy)
n = norm / .001
ny = dx * .015 / norm
nx = -dy * .015 / norm
for i = 10 to n-10 do {
XZ: i/n <V1,V2>
line from XZ + (nx,ny) to XZ - (nx,ny)
}
move to V2
}
define wavybond {
line $3 invis by ($1) * sin(($2)/deg), ($1) * cos(($2)/deg)
V1: last line.start; V2: last line.end; dx = V2.x-V1.x; dy = V2.y-V1.y
norm = sqrt(dx*dx + dy*dy)
for i = 0 to $1-0.004 by 0.001 do {
x1 = i
y1 = 0.025*sin(6*pi*x1/($1))
yr = x1*cos(($2)/deg)-y1*sin(($2)/deg)
xr = x1*sin(($2)/deg)+y1*cos(($2)/deg)
line 0 from V1 + (xr,yr)
}
move to V2
}
define frontbond {
line $3 invis by ($1) * sin(($2)/deg), ($1) * cos(($2)/deg)
V1: last line.start; V2: last line.end; dx = V2.x-V1.x; dy = V2.y-V1.y
ah = arrowht; aw = arrowwid; ahead = arrowhead
arrowht = sqrt(dx*dx + dy*dy)
arrowwid = 0.05
arrowhead = 7
line <- from V1 to V2
arrowht = ah; arrowwid = aw; arrowhead = ahead
}
define rfrontbond {
line $3 invis by ($1) * sin(($2)/deg), ($1) * cos(($2)/deg)
V1: last line.start; V2: last line.end; dx = V2.x-V1.x; dy = V2.y-V1.y
ah = arrowht; aw = arrowwid; ahead = arrowhead
arrowht = sqrt(dx*dx + dy*dy)
arrowwid = 0.05
arrowhead = 7
line -> from V1 to V2
arrowht = ah; arrowwid = aw; arrowhead = ahead
}
# Local Variables:
# mode: Nroff
# End:
