#!/usr/bin/perl -w
# File: aline

# ALINE - Charles.Bond@uwa.edu.au 011208
# 
# Copyright (c) 2008, Charlie Bond and Alex Schuettelkopf
# 
# All rights reserved.
# 
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions are
# met:
# 
#     * Redistributions of source code must retain the above copyright
#     * notice, this list of conditions and the following disclaimer.
#     * 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.  Neither the name of the University of
#     * Dundee, the University of Western Australia nor the names of its
#     * contributors may be used to endorse or promote products derived
#     * from this software without specific prior written permission.
# 
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
# "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 COPYRIGHT
# OWNER OR CONTRIBUTORS 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.

use strict;
use Tk;
use Tk::Dialog;
use Tk::ErrorDialog;
use Tk::Pane;
use Tk::Balloon;
use Tk::X11Font;
use Tk::LabFrame;
use Scalar::Util qw(looks_like_number);
use Cwd;
use vars (qw(%raa $canvas));

sub _PrintSplash();
sub _InitGraphics();
sub _getLocalScripts();
sub _Shutdown();
sub _ProcessCommandLine();
sub _LoadPlugins();
sub IsPluginLoaded($);
sub _FlattenMenu($;$);
sub _BuildMenu($$@);
sub _UpdateUndoMenu();
sub InitMainWindow();
sub PullInConfigFiles();
sub ConfigFixup($$);
sub _ConfigFixup($);
sub __configFixup($);
sub ResetParameters();
sub __deepcopy($$);
sub _ConfigPullin($);
sub _ConfigPluginMerge();
sub _FillFontList($);
sub _ValidateFont($$;$$$); # \fontlist,nameref,f2ref,f3ref,silent -> is checked/'corrected'
sub _FontEnt2Block($$;$); # ent,labelhead,block_to_amend (create/add to block from cell data)
sub _FontBlock2Ent($$$); # block,ent,labelhead (adjust cell data based contents of block)
sub _Defocus();
sub Demo();
sub Documentation();

sub action_is($);
sub action_can($);
sub actionname();
sub setaction($);
sub invokeaction($);
sub Status($;$);
sub DeStatus(;$$);
sub StatusNow($;$);
sub _EditModeStatus();
sub _printableNum($;$);
sub _pNum2Real($);

sub Open(;$);
sub Read(;$);
sub _Read($;$); # filename or ['filename',data],&cb(fn,type) -> storelist or undef if nothing
sub _ReadDialog($;$);
sub DumpDataFile(;$);
sub UndumpDataFile(;$);
sub loadpackaline($$$$); # parref,seqref,catref,content_to_load; returns nonzero for error, 0 for ok
sub savepackaline($$$); # parref,seqref,catref; returns content to save
sub n2a64($);
sub SkipUndoData();
sub ClearDocument();
sub ReadColour(;$$); # filename,win
sub SaveColour(;$$); # win,catref
sub UndumpData(;$); # undo 1 level, argument true -> no repaint
sub PDumpData($;$$$); # (label,par?,seq?,cat?), only if cfg{allow_undos}
sub PSmartData($$;$); # (label,coderef,parcause), only if cfg{allow_undos}
sub DumpData($;$$$); # (label,par?,seq?,cat?), unconditional
sub _CopyCat($$;$); # (rsrc,rdest,withcfgfill?), deep copy for categories
sub _CopySeq($$;$); # (rsrc,rdest,leavemunged?), deep copy for seq, set leavemunged? for serialising
sub _FixupSliders(); # update sliders and reattach menu buttons
sub MungeBadPS($;$$);
sub PrintPS(;$);
sub PrintPNG(;$$);
sub Export($;$$); # seqlist,target(filename->write,bare extension->return as string),parentwindow
sub ReadMsf($);
sub ReadBlc($);
sub ReadAln($);
sub ReadFasta($);
sub ReadBlast($);
sub _SQuote($);
sub FillChar($); # seqptr, returns 'null-character' for row
sub _InsSeqNum($$); # seqptr,n
sub _MakeValidExportList($);
sub ExportFasta($);      # seqlist -> text
sub ExportPIR($);        # seqlist -> text
sub ExportMSF($);        # seqlist -> text
sub ExportAln($);        # seqlist -> text
sub _ExportMulti($;$$$); # seqlist -> text
sub _ToFasta($;$$); # n,with_gaps?,length (default=60,0 for inf)
sub _ToPIR($;$$);   # n,with_gaps?,length (default=60,0 for inf)
sub _ToRaw($;$);    # n,with_gaps?
sub _ObtainPDB($;$);  # id(4/5char),sequify? -> {error=>'error'} or 'text' or [seqdata]

sub _RefreshAfterLoad();
sub _UpdateParameters();
sub _ApplyEdits($$);
sub _ApplyCat($$);
sub _MakeSpace($);

sub InsertRow($;$$); # y[,title,comment]
sub DeleteRowByN($);
sub DeleteRowByY($);
sub AttachRow($$;$); # attach #0 to #1, #2: 1=force
sub InsertSequence($$;$$$); # title,sequencestring(,nums,comment,y) [may need to defray later]
sub _FillSeqnum($); # fill in seqnumber records for sequence n if required
sub _SeqStart($); # first residue number or 1
sub _SetNumberingType($$;$); # seq,type(false=auto,true=fixed),newstart, returns 1 if numbers (may) have changed

sub DeleteObjectByPtr($$); # ref,deep?
sub DeleteObjectById($$$); # seq,ob,deep?
sub MoveObject($$$$$); # seq,ob,deep?,deltaX,deltaY
sub CreateObject($$$$$;$$); # type,x2,y2,x1,y1,lc,fc
sub _CreateGraph($$$$$$$$); # type,data,y,lc,fc,seqid or undef for in_n,height,cutpoint
sub InsertGraph($$$$$$$$$$;$$); # seq,befline,type,data,lc,fc,flags<bit0:logscale>,height,cutpoint,noins,fmin,fmax
sub ObjCells($$$); # seq,obj,deep?
sub FindObjectAt($$); # (x,y) -> (s,o) or undef
sub RaiseLowerObj($$$); # s,o,where (2=top,-2=bottom,otherwise do nothing)
sub _ObjPtrToId($);
sub _ObjPtrToId2($$); # like objptrtoid, but takes ref to @seq as first argument
sub _LinkObjects($$); # fresh,old
sub _UnlinkObject($);
sub _ObjectType($$;$); # s,o, class?
sub _IsObjectAtY($$); # (obref,aly), has the object a sibling at aly? returns obref or undef
sub _IsObjectAtX($$); # (obref,alx), has the object element at alx? returns eleref or undef
sub RecolourObject($$;$); # s,o,deep?
sub _DeleteCells($;$); # [xn/xy pairs],flags<bit0:refill,bit1:0=itsn,1=itsy,bit2:sort,bit3:keepcursor,bit4:noattach,
	               #                     bit5:clear_not_del>
sub _InsertCells($;$); # [xnc|xyc pairs],flags<bit0:refill,bit1:0=itsn,1=itsy,bit2:sort,bit3:keepcursor,bit4:noattach>
sub _DefrayEnds(;$); # fixes sequence list after cells have been added/deleted with flags bit 0 off
sub _ResetTo($);
sub _ExtTo($);
sub _TruncTo($);
sub _AttachmentForX($;$); # n,exclude_self? -> [list of co-attached rows]
sub _InsertAttachmentElements($$);
sub _ObTypeList(@);
sub NewObType($$;$); # name,objectdata entry,clickable
sub _GetZMinMax();
sub _GetZList();
sub _ConsolidateZ();
sub _GetCellColour($$$); # x,y/line,flags: bit0:0=y,1=line, bit1:0=bg,1='fg'

sub SequencePicker($$;$$);
sub _FixDopeyScrollable($$$); # win,scrollable,heighlistref
sub _ComposeInpTable($$);
sub _DialogInp($$;$); # win,inptable,boxed?
sub _QuickDialog($$$$$;$$); # parent,title,where(0=),oklabel,okcode,destatus?,cancelcode
sub _CancelOk($$$;$$); # win,oklabel,okcode,destatus?,cancelcode
sub _QuickMessage($$;$); # title,message,parent
sub _AggroCheck(;$); # parent
sub _NoSequences();
sub _PropertySheet($$$$); # cells,'win',flags<bit0:usetype_obj>,solo
sub _PropertyWindow($$$$); # cells,title,undotext,flags<bit0:usetype_obj>
sub _FontPicker($$$;$);
sub _FontPickButton($$);
sub _Autobrowse($);
sub ShouldaSavedEh();

sub PrintSeq(;$);
sub _GridOff();
sub _GlyphFactory(@);
sub _LingFactory($$$$);
sub _Invalidate($); # invalidate titles/cells/objects
sub _InvalidateAll(;$); # invalidate all titles/cells/objects
sub _InvalidatePtr($$);
sub _InvalidateDom($;$); # 0=titles, 1=cells
sub _InvalidateNums($;$); # seq,from
sub _InvalidateGlyphs(); # clear glyph cache

sub _ButtonClick($$$);
sub _RubberBand(@);
sub RegDragActionFactory($$$;$); # dragflags,modifiermask,modifiervalue,callback
sub SequenceEditor($$$);
sub CloseTooltips();
sub _ContextMenu($);
sub _attachcanvastooltips();

sub colourN2R($); # name -> (r,g,b), scale 0..1
sub colourR2N(@); # (r,g,b),scale 0..1 -> valid name
sub colourInterpolate($$$); # c1,c2,frac
sub colourInterpolateHSL($$$); # c1,c2,frac
sub rgb2hsl(@);
sub hsl2rgb(@);
sub _ccbutton($$);
sub _setupcolourhistory($);
sub _SetWorkColour($$);

sub _CursorMove($$$);
sub _refreshCursor();
sub _CursorOn(;$);
sub _CursorOff();
sub _CursorAlt(;$); # default=toggles, otherwise true=alt, false=normal
sub _canvasSee($$); # ax,ay -> make visible if canvas is scrollable
sub _CanvasScrollV($);

sub _symbolify($);
sub _unsymbolify($);

my @symbolmapping=(
    [0x22,0x2200], [0x24,0x2203], [0x27,0x220D], [0x40,0x2245], [0x41,0x0391], [0x42,0x0392],
    [0x43,0x03A7], [0x44,0x0394], [0x45,0x0395], [0x46,0x03A6], [0x47,0x0393], [0x48,0x0397],
    [0x49,0x0399], [0x4A,0x03D1], [0x4B,0x039A], [0x4C,0x039B], [0x4D,0x039C], [0x4E,0x039D],
    [0x4F,0x039F], [0x50,0x03A0], [0x51,0x0398], [0x52,0x03A1], [0x53,0x03A3], [0x54,0x03A4],
    [0x55,0x03A5], [0x56,0x03C2], [0x57,0x03A9], [0x58,0x039E], [0x59,0x03A8], [0x5A,0x0396],
    [0x5C,0x2234], [0x5E,0x22A5], [0x5F,0x23BD], [0x60,0x23BA], [0x61,0x03B1], [0x62,0x03B2],
    [0x63,0x03C7], [0x64,0x03B4], [0x65,0x03B5], [0x66,0x03D5], [0x67,0x03B3], [0x68,0x03B7],
    [0x69,0x03B9], [0x6A,0x03C6], [0x6B,0x03BA], [0x6C,0x03BB], [0x6D,0x03BC], [0x6E,0x03BD],
    [0x6F,0x03BF], [0x70,0x03C0], [0x71,0x03B8], [0x72,0x03C1], [0x73,0x03C3], [0x74,0x03C4],
    [0x75,0x03C5], [0x76,0x03D6], [0x77,0x03C9], [0x78,0x03BE], [0x79,0x03C8], [0x7A,0x03B6],
    [0xA1,0x03D2], [0xA2,0x2032], [0xA3,0x2264], [0xA4,0x2215], [0xA5,0x221E], [0xA6,0x2A0D],
    [0xA7,0x2663], [0xA8,0x2666], [0xA9,0x2665], [0xAA,0x2660], [0xAB,0x2194], [0xAC,0x2190],
    [0xAD,0x2191], [0xAE,0x2192], [0xAF,0x2193], [0xB2,0x2033], [0xB3,0x2265], [0xB4,0x00D7],
    [0xB5,0x221D], [0xB6,0x2202], [0xB7,0x22C5], [0xB8,0x00F7], [0xB9,0x2260], [0xBA,0x2261],
    [0xBB,0x2248], [0xBC,0x2026], [0xBD,0x2758], [0xBE,0x2015], [0xBF,0x21B5], [0xC0,0x2135],
    [0xC1,0x2111], [0xC2,0x211C], [0xC3,0x2118], [0xC4,0x2297], [0xC5,0x2295], [0xC6,0x2300],
    [0xC7,0x22C2], [0xC8,0x22C3], [0xC9,0x2283], [0xCA,0x2287], [0xCB,0x2284], [0xCC,0x2282],
    [0xCD,0x2286], [0xCE,0x2208], [0xCF,0x2209], [0xD0,0x2220], [0xD1,0x2207], [0xD2,0x00AE],
    [0xD3,0x00A9], [0xD4,0x2122], [0xD5,0x220F], [0xD6,0x221A], [0xD7,0x2219], [0xD8,0x00AC],
    [0xD9,0x2227], [0xDA,0x2228], [0xDB,0x21D4], [0xDC,0x21D0], [0xDD,0x21D1], [0xDE,0x21D2],
    [0xDF,0x21D3],
#------------------------- From here on we diverge from the Windows Symbol font (mostly to nothing)
    [0xE0,0x2701], [0xE1,0x27E8], [0xE2,0x2020], [0xE3,0x2021], [0xE4,0x270E], [0xE5,0x2211],

    [0xE6,0x0020], [0xE7,0x0020], [0xE8,0x0020], [0xE9,0x0020], [0xEA,0x0020], [0xEB,0x0020],
    [0xEC,0x0020], [0xED,0x0020], [0xEE,0x0020], [0xEF,0x0020], [0xF0,0x0020],

    [0xF1,0x27E9],
    [0xF2,0x222B],

    [0xF3,0x0020], [0xF4,0x0020], [0xF5,0x0020], [0xF6,0x0020], [0xF7,0x0020],
    [0xF8,0x0020], [0xF9,0x0020], [0xFA,0x0020], [0xFB,0x0020], [0xFC,0x0020], [0xFD,0x0020],
    [0xFE,0x0020], [0xFF,0x0020]
);

my $pathsep=($^O=~/^mswin/i)?(($0=~/\//)?'/':'\\\\'):'/';
my $self=$0; $self=~s|[^$pathsep]+$||;
my $home=($ENV{HOME}||$ENV{TEMP}||'').$pathsep;
if (defined($ENV{ALINEHOME})) {
    $self=$ENV{ALINEHOME}; if ($self!~m|/$|) { $self.='/'; }
} else {
    if (!$self) { # This should not happen, ever...
	my $ppsep=($^O=~/^mswin/i)?';':':';
	foreach (split(/$ppsep/,$ENV{PATH}||'')) {
	    if (-x $_.$pathsep.$0) { $self=$_.$pathsep; last; }
	}
    }
    $self.='../';
}

# Options
my %cfgtemplate=(
    plugindir   => ['%%SELFplugins',                      'Plugin directory',                                  'F',  20],
    exampledir  => ['%%SELFexample',                      'Example file directory',                            'F',  20],
    scriptdir   => ['%%SELFscripts',                      'Default scripts directory',                         'F',  20],
    colsetdir   => ['%%SELFcolourschemes',                'Colour scheme directory',                           'F',  20],
    cfgfiles    => [['/etc/alinerc','%%HOME.alinerc'],    'Configuration file locations',                      undef,0],
    allow_undos => [10,                                   'Number of undo steps',                              'F',  30],
    gapchar     => ['.',                                  'Default gap character or undef',                    'F',  30],
    unchg       => [['',chr(0)],                          'Label/content for "unchanged"',                     undef,0],
    f           => [['#000000','Helvetica','Medium','R',12,'Normal',0],'Default AA font',             undef,0],   # (fg,...,bg)
    fo          => [['#000000','Helvetica','Medium','R',12,'Normal',0],'Default object font',                  undef,0],
    n           => [['#000000','Helvetica','Medium','O',12,'Normal',0],'Default number font',                  undef,0],
    t           => [['#000000','Helvetica','Bold','O',12,'Normal',0],  'Default title font',                   undef,0],
    canvascol   => ['#ffffff',                            'Canvas colour',                                     'Col',30],
    fc          => ['#ff0000',                            'Default fill colour',                               'Col',30],
    lc          => ['#000000',                            'Default line colour',                               'Col',30],
    lw          => [1,                                    'Default line width',                                'F',  30],
    grid        => [1,                                    'Grid on by default',                                'C',  30],
    colorstack  => [16,                                   'Max. depth of colour history',                      'F',  30],
    fcstack     => [['#ffff00','#00ff00','#00ffff','#0000ff','#ff00ff'],'Initial fc history',                  undef,0],
    lcstack     => [undef,                                'Initial lc history',                                undef,0],
    gridbelow   => [1,                                    'Grid is below text',                                'C',  30],
    numcolsize  => [3,                                    'Width of number columns',                           'F',  30],
    scrollable  => [1,                                    'Canvas is scrollable?',                             undef,0],
    cursor      => [['#2040ff',3,'gray25'],               'Cursor',                     undef,0],# outline c/w, fill stipple or 0
    altcursor   => [['#ff2010',3,'gray25'],               'Alternative cursor',                                 undef,0],
    inscopyattr => [0,                                    'Inserted cells inherit attributes from the left?',  'C',  30],
    extrarows   => [1,                                    'Number of rows inserted after loading sequences',   'F',  30],
    autoattach  => [1,                                    'Automatically attach derived rows?',                'C',  30],
    noattach    => [0,                                    'Do not allow attachment',                           'C',  30],
    editaux     => [1,                                    'Allow editing of non-sequence rows',                'C',  30],
    dgrid       => [1,                                    'Darker horizontal grid lines between blocks',       'C',  30],
    clickbox    => [2,                                    'Box \'radius\' /px for clicking objects',           undef,0],
    insmode     => [1,                                    'Keyboard editing: insert by default?',              'C',  30],
    statusbar   => [1,                                    'Status bar enabled',                                'C',  30],
    tooltips    => [400,                                  'Delay before tooltips appear /ms (0=no tooltips)',  'F',  30],
    autobrowse  => [1,                                    'Automatically open file dialogs from FF[OS]?',      undef,0],
    cmbind      => [($^O=~/^darwin/i)?6:4,                'Bind context menu handler to m2/^m1/m3',            undef,0],
    cald        => [[400,20,10,50,'grey75'],              'Calcolours canvases (x,y,fonth,gap,gapco)',         undef,0],
    mbstate     => ['raised',                             'Inactive mode buttons: raised/flat',                undef,0],
    mblabelfont => ['-*-helvetica-*-*-*-9-*-*',           'Mode button label font',                            undef,0],
    mbheight    => [undef,                                'Mode button height or undef for auto',              undef,0],
    mbflags     => [7,                                    'Mode buttons: 1=img, 2=txt, 4=tooltip',             undef,0],
    wcs         => [['#eeeeff','#ddddff','#ccccff'],      'Widget colour scheme',                              undef,0],
    psfontscale => [-1,                                   'Apply scale to ps output text',                     undef,0],
    fontfams    => [[qw(adobe bitstream b&h linotype microsoft urw)], 'Allow fonts from these families',       undef,0],
    fontforcedefault => [0,                               'Use default instead of actual fonts',               undef,1],
    fontmstyles => [['medium-r','medium-o','bold-r','bold-o'],        'Default styles for multifont settings', undef,1],
    fontdefault => [{Courier   => ['','-*-courier-',['medium-r','medium-o','bold-r','bold-o']],
		     Helvetica => ['','-*-helvetica-',['medium-r','medium-o','bold-r','bold-o']],
		     Symbol    => ['','-*-symbol-',['medium-r','medium-i','bold-r','bold-i']],
		     Times     => ['','-*-times-',['medium-r','medium-i','bold-r','bold-i']]},'Default font set',undef,1],
    pdbchget    => ['http://swissmodel.expasy.org/cgi-bin/get-expdb-entry.cgi?%i%C',  'PDB-by-chain URL',      'F',  1],
    pdbflget    => ['http://www.rcsb.org/pdb/download/downloadFile.do?fileFormat=pdb&compression=NO&structureId=%I',
                                                          'PDB download URL',                                  'F',  1],
    wgetloc     => ['wget',                               'The path to a working wget binary',                 'F',  5],
    gsloc       => ['gs',                                 'The path to a working ghostscript binary',          'F',  5],
    debug       => [0,                                    'Debug mode on/off',                                 undef,1],
    scripts     => [0,                                    'Script menu on/off',                                undef,0],
    ocprint     => [0,                                    'Object glyph cache reports',                        undef,0],
);

my %cfg=();
my %cfglocseen=();
my %tempbadcfg=();
my @privatevars=({},{},{},{});
my (%defaultpar,%par,@defaultcategories,@categories);

## Data
my %prog=( # Programs data
  name    => 'Aline',
  version => '1.0.025',
  author  => 'C.S.Bond@dundee.ac.uk',
  website => 'http://crystal.bcs.uwa.edu.au/px/charlie/software/aline/',
);

# The canvas
#y $canvas;                                  # the important bit (now a global)
my @canvasbars=(undef,undef);                # scrollbars on canvas
my %screen=(SW=>0,SH=>0,MC=>255,MD=>1/255);  # screen dimensions

# Other UI elements we'll need
my @statusbar=(undef,undef,[],'');   # Statusbar
my %ui=(
    undoitem   => undef,      # 'Undo' menu item
    cshscale   => undef,      # csh slider
    csvscale   => undef,      # csv slider
    fsiscale   => undef,      # fsi slider
    nchscale   => undef,      # nch slider
    ttlscale   => undef,      # lin slider
    allbutton  => undef,      # all menubutton
    numbutton  => undef,      # num menubutton
    agrbutton  => undef,      # agr menubutton
    actionb    => undef,      # action button hash
    colblc     => undef,      # color button (lc)
    colbfc     => undef,      # color button (fc)
    colmlc     => undef,      # colour history menubutton (lc)
    colmfc     => undef,      # colour history menubutton (fc)
    spinbox    => undef,      # line width spinbox
    fontbtn    => undef,      # font selector button
    yframe     => undef,      # a random harmless ui element we can defocus on
);

# Data structure
my $max_seq_length;                 # length of sequences readfrom file
my @seq;                            # array of arrays of sequence data
my @undo=();                        # undo data, contains {par,seq,cat,label}s
my $unsaved=0;                      # unsaved changes?
my %glyphcache=();                  # glyph cache

# Various Initializations
my %draginfo=(
    class    => -1,    # -1=none, 0=outside, 1=numbers, 2=titles, 3=cells
    flags    => 0,     # bits0,1,3 : 0=selrect, 1=selline, 2=fullline, 3=fullrect, 8=fullcols, 9=none/cb, 10=1d, 11=0d
                       # bit2      : mark immediately
    modkey   => undef,
    callback => undef, # callback coderef
    private  => undef, # private data for callback
    fclick   => 0,     # abused field, set to true if clicking with no sequences
    x0 => undef, y0 => undef, xa => undef, ya => undef, xb => undef, yb => undef,
);
my %tooltips=(ob=>undef,x=>-1,y=>-1,msg=>'Foo!');
my $object_text='';
my %cursor=(ax=>0,ay=>0,on=>0,alt=>0,ox=>-1,oy=>-1);
my $noedit=0;
my @resohistory=(72,100,150,200,300,600,1000);

my %importlist=(
    'ClustalW alignment' => [['.aln'],\&ReadAln],
    'MSF alignment'      => [['.msf'],\&ReadMsf],
    'BLC alignment'      => [['.blc'],\&ReadBlc],
#   'BLAST output'       => [['.bla'],\&ReadBlast],
    'FASTA sequences'    => [['.seq','.fasta'],\&ReadFasta],
);

my %exportlist=(
    'FASTA sequences'    => [['.seq','.fasta'],\&ExportFasta],
    'PIR sequences'      => [['.pir'],\&ExportPIR],
    'MSF alignment'      => [['.msf'],\&ExportMSF],
    'ClustalW alignment' => [['.aln'],\&ExportAln],
);

# cursor default behaviour
my %cursormovers=(
    'Left'  => sub { if ($cursor{ax}) { $cursor{ax}--; _refreshCursor(); } },
    'Right' => sub { if ($cursor{ax}<$max_seq_length) { $cursor{ax}++; _refreshCursor(); } },
    'Up'    => sub { if ($cursor{ay}) { $cursor{ay}--; _refreshCursor(); } else {
     	                 my $t=$cursor{ax}-$par{_fnx};
			 if ($t>=0) { $cursor{ax}=$t; $cursor{ay}=$#seq; _refreshCursor(); }
                     } },
    'Down'  => sub { if ($cursor{ay}<$#seq) { $cursor{ay}++; _refreshCursor(); } else {
                         my $t=$cursor{ax}+$par{_fnx};
			 if ($t<=$max_seq_length) { $cursor{ax}=$t; $cursor{ay}=0; _refreshCursor(); }
                     } },
    'Home'  => sub { if ($cursor{ax}) { $cursor{ax}=0; _refreshCursor(); } },
    'End'   => sub { if ($cursor{ax}<$max_seq_length) { $cursor{ax}=$max_seq_length; _refreshCursor(); } },
    'Prior' => sub { my $t=$cursor{ax}-$par{_fnx};
		     if ($t>=0) { $cursor{ax}=$t; _refreshCursor(); } else { _CanvasScrollV(0); } },
    'Next'  => sub { my $t=$cursor{ax}+$par{_fnx};
		     if ($t<=$max_seq_length) {$cursor{ax}=$t;_refreshCursor();} else { _CanvasScrollV(1); } },
);

# action settings:
# hook codes (keys in actions{}[4] / defaulthooks / earlyhooks) are:
#    <button><area>, button is:
#        C = button1, B = button2, A = button3, D = button1drag, K = keypress, M = CM, P = tooltip,
#    area is:
#        nothing = cells, T = titles, N = numbers, O = outside.
# hooks return false for passthru, true for ok
# non-keyboard hooks get the following arguments:
#   ax,ay,x,y,modkey(bit0=shift,bit1=ctrl,bit2=meta),class(0=out,1=numbers,2=titles,3=cells)
# Drag hooks also should return an array ref to the rubberband flags if called with $_[6]==1.
# CM hooks get a pointer to the menu structure in $_[6], they can modify it, then _must_ return false.
# keyboard hooks get:
#   keycode,modifiers,asciicode
# Note that C hooks are always served before possible D initiation is checked. Thus to override
# an existing click with a drag you must also hook the click action to a RegDragActionFactory($$$;$),
# which takes (rubberband flags,modifier key mask,modifier key value,callback). By default it
# accepts the drag if (modifiers&modmask)==modvalue. If callback is specified it also rejects
# if the callback (called with full hook arguments) returns TRUE.
#
# Remember that the y coordinates in draginfo should be used modulo @seq (they may be true screen y).
#
# The location of an action is normally [priority,buttontag], giving the action its own button
# if there is only one action for the given tag, otherwise add it to the menubutton for the given tag.
# Both buttons and menubutton items are sorted by priority. The location can be simplified to a
# priority only; in this case the action name is taken as the buttontag. If the location is undefined
# the action does not bind to a button.
#
# The 'draw' action is special (setup code, interaction with actual object buttons), so it should not
# be messed with too much... Also note that semicolon is a reserved character for action names.
#
my %defaulthooks=(CN=>\&SetNumberOffsets,DT=>\&EditTitle);
my %earlyhooks=();
my $action='insrow';
my %actions=( # name,location,kbdbinding,tags,hooks,flags<0:cursor_on>,cb_activation,icon
    'draw'      => ['Draw',                  undef,          'Meta-o', [],
		    {D=>\&DrawObject},0,undef,undef],
    'insrow'    => ['Insert Blank Row',      [0,'rowins'],   'Meta-i', [],
		    {C=>\&InsertRowAction,CT=>\&InsertRowAction},0,undef,
		    'R0lGODlhKwAOAKEDAAAAAFJS+fyLi////yH5BAEKAAMALAAAAAArAA4AAAJOnI+py+2vgJ'.
		    'yUwotA2EFz31WihA1gx6Gpup2A8x5uerY0DcfmKH73l9NdeCIDcVLyKVvB0mDJ6uRkxwnU'.
		    'Bcv8bK0qCTNbOodb1hjilRQAADs='],
    'insseq'    => ['Insert Sequence Row',   [10,'rowins'],  undef,    [],
		    {C=>\&InsertSeqRowAction,CT=>\&InsertSeqRowAction},0,undef,
		    'R0lGODlhKwAOAKEDAAAAAFJS+fyLi////yH5BAEKAAMALAAAAAArAA4AAAJZnI+py+2vgJ'.
		    'yUwotA2EFz31WihA1gx6Gpup2A8x5uerY0DcfmKH73l4sBBETBsHg08iqG5cRUNEaTvmor'.
		    '2JxqiVZWJydzTrouWOZna4lJmJm11Eaz4Je1pAAAOw=='],
    'drag'      => ['Drag Row',              5,              'Meta-g', [],
		    {D=>\&DragAction,DT=>\&DragAction},0,undef,
		    'R0lGODlhKwAOAMIFAAAAAFJS+WdnZ/yLi////5mZmZmZmZmZmSH5BAEKAAcALAAAAAArAA'.
		    '4AAAN7eLrc/vCBSWuNzmo6OugeOABYAwRocKZrAH4vKJAKHbVqmqNxDxAChk2iw7U2FgJQ'.
		    'eENaWEWWMrgYCqNQ3Q51VC6rxCxXu93+vNSauoYdc50U71Q4qcIp4vL5a7fBQj0DeUYEZ2'.
		    'kXNSJ/IyCDRSSGN4qTHnd1NWkSlgAJADs='],
    'delrow'    => ['Delete Row',            10,             'Meta-d', [],
		    {D=>\&DeleteRowAction,DT=>\&DeleteRowAction},0,undef,
		    'R0lGODlhKwAOAMIDAAAAAFRU/42Njf///////////////////yH5BAEKAAQALAAAAAArAA'.
		    '4AAAN5SLrcBE7BSB+4OGuhMe8gFozkCJQBMAxcqbIX6sryib5tug6nTfskYMrkWn12tqSv'.
		    'Z2ICkzcjMtikQodPYnRKxRKhV61QZ8x6z6Cu8LXLDd/ObxdeXF3K4iDzrRdnuDh7S4JjWk'.
		    'FcJmWFhikhIDyPjiEVERMOlpQMCQA7'],
#  Object region properties icon...
#		    'R0lGODlhKwAOAMIEAAAAAGdnZ1ld//yLi////////////////yH5BAEAAAcALAAAAAArAA'.
#		    '4AAAN8eLrcGuFAGaet2CnAu+fBJ4pESWiHKKxs675rZ0YOtwFwALN6y801AIPz6sEABGMM'.
#		    'eQoOcbtjSflLLka3YlTANHpoz6c2ykwuSxrbFbp1lc1V8FrsUr7eybJ8nmK37HczVU1BHW'.
#		    '1kBF0mVmkjX44jU0AolA8UlxcUAJkLCQA7'],
#
    'prpobj'    => ['Object Properties',     15,             undef,    [],
		    {C=>\&ObjectPropsAction},0,undef,
		    'R0lGODlhKwAOAMIEAAAAAGdnZ1ld//yLi////////////////yH5BAEAAAcALAAAAAArAA'.
		    '4AAANeeLrc/jAuQKu9OFOpsPhgKI5fxW0HRYbBGqIQnAIuQLRuCUSyutq3nEDWwRRzQNzP'.
                    '4ujRaoSockRkOJFR6ZK3mzx/WS311PVhxaJq4yIsEZLpLllDp0gvnHweENArEgA7'],
    'dragobj'   => ['Drag Object',           20,             undef,    [],
		    {D=>\&DragObjectAction},0,undef,
		    'R0lGODlhKwAOAMIAAAAAAGdnZ1ld//yLi////wAAAAAAAAAAACH5BAEAAAcALAAAAAArAA'.
		    '4AAANyeLrcDi7KBqq9GJCQ81yZII6jRmxkan1HpVRpec5BXEKTCwIxz201nk2gixRbQlkQ'.
		    'panZji8PkmSyEKyo3uWBi8pm4LCT2uUyYN/AT20ak3NltJLIzPZYOjkpqIG53x8YQ3Rgfz'.
		    'csUR0ZNIpQiIhNjxEJADs='],
    'delobj'    => ['Delete Object',         25,             undef,    [],
		    {C=>\&DeleteObjAction},0,undef,
		    'R0lGODlhKwAOAMIDAAAAAFld/42Njf///////////////////yH5BAEAAAQALAAAAAArAA'.
		    '4AAAN0SLrcBE7BSB24OAOhMe9XtXRBGQDDwJlnurKY+EwX26pAiaa5fU6U0Khn2n1SA6JP'.
		    'GGHOli6kcgkcaiRTHTLps10bzhrUlfVWwVUxbIvrFs+M8HSXNJZ1MqFay+O/zHkZXlJrbT'.
		    'BwTSAYdR2MXzKQiA+QDQkAOw=='],
    'prpreg'    => ['Region Properties',     30,             undef,    [],
		    {D=>\&SelectBoxAction},0,undef,
		    'R0lGODlhKwAOAMIDAAAAAFRU/2dnZ////////////////////yH5BAEKAAQALAAAAAArAA'.
		    '4AAAOGSLrcKoJAGaeteIHNu9/CJ45dYJ4mgK7qerZuAAgxCq9hndcz68u4WwswoMlgqmES'.
		    '+Eq5hKlB8djsDZlOrGmXlUlzVysTqg1wscTvePxplrVIqXopRrpvZrJXPt3IaHh+bBx5L4'.
		    'J7U1RKPDVvLwNpRimSJCMhlRxfHZcADp4MGRcUEjOiCwkAOw=='],
    'edit'      => ['Edit Sequences',        35,             'Meta-e', [],
		    {K=>\&SequenceEditor,C=>\&PointCursor},1,undef,
		    'R0lGODlhKwAOAMIDAAAAAFRU/2dnZ////////////////////yH5BAEKAAIALAAAAAArAA'.
		    '4AAANyKLrcGjDK6Cq4OOs7O9zgII4iQJLQYJpocI7sS8Znqr72S5cnu9u7wWfGU61usOII'.
		    'iHPFfMVjErl0UatU6E0brVmDKa4PQC5Pf98m77meItFK7Pbc05bJwrTX/Q7GW3OAMjR3hY'.
		    'ZkHh2HhhWND4kSjgwJADs='],
    'recolours' => ['Recolour Region',       [55,'recolour'],undef,    ['recolour'],
		    {D=>\&RecolourObs,DT=>\&RecolourObs},0,undef,
		    'R0lGODlhKwAOAMIEAAAAAFJS+WdnZ/yLi////////////////yH5BAEKAAcALAAAAAArAA'.
		    '4AAAOHeLrcKuJAGaeteIHNu9/CJ45dYJ4mgK7A4L5vC8OAsN7qHYQz3cc2VO6UG5p4Md9g'.
		    'kyyqnsIUTumSMatLWzFg3KKQ2ORyPK5xz2hp+igLh1vWZepDVAup5Dhcmx56T2BkbzF7a1'.
		    'xeHjttHGKLcHM6hnc/gj1mcyQfIZmZmwAOoAwZFxSlpAsJADs='],
    'recolouro' => ['Recolour Obj Region',   [60,'recolour'],undef,    ['recolour'],
		    {D=>\&RecolourObs,DT=>\&RecolourObs},0,undef,
		    'R0lGODlhKwAOAMIEAAAAAGdnZ1ld//yLi////////////////yH5BAEAAAcALAAAAAArAA'.
		    '4AAAN1eLrcGuFAGaet2CnAu+fBJ4pESWiHKKzsOrxwLHdm5HAb0LKB7M+A2g3A4OwEvZ9y'.
		    'wClpcAvjcalsEmwpUe6YpAJBw6Ju1/XCrE9idLwzA0vYtZjrjgXh6S29zryf0h1HLHxWeI'.
		    'AjIIiIJoYojhIUkReSGQsJADs='],
    'recolourp' => ['Recolour Object',       [65,'recolour'],undef,    [],
		    {C=>\&RecolourObjAction},0,undef,
		    'R0lGODlhKwAOAMIEAAAAAGdnZ1ld//yLi////////////////yH5BAEAAAcALAAAAAArAA'.
		    '4AAANeeLrc/jAuQKu9OFOp8PhgKI5fxW0HRYbBGqIQnAIuQLRuCUSyutq33EDWwRRzQNzP'.
		    '4ujRaoSockRkOJFR6ZK3mzx/WS311PVhxaJq4yIsEZLpLllDp0gvnHweENArEgA7'],
);

# Images for buttons
my $dummy_image='R0lGODdhDQANAIAAAP///wAAACwAAAAADQANAAACHoyPCMsNtlKDj9EXHLbZ3Yt1kbhNpFaio+mdWgIfBQA7';
# Logo bitmap (MIME-encoded gif)
my $logobm='R0lGODdhQwARAKUyAAABABwLDhIOHB8WFhUdDhodETUVFSMhOE0eHiE1IFQeHDk'.
'rLTAsVVQkJD0vNjc3IDMyVT07H1UxMEJAJD07VEY7RlU6MDhPLVg/P1RCP1NCRDhWMlJHSFNLMD'.
'1VOEFWPlVVLFNVMlZTNlVUPE5ePKk6PFpaq31le4uEWv9TW6iFhnWpZI2Qq4iG/vy/wKr/ldTX/'.
'//+gv///////////////////////////////////////////////////////ywAAAAAQwARAAAG'.
'/kCAcEgsGo/IpHIpFDCe0ChjMcBYr1hMpADqer+gBMFzIZvLl4shoGi734qAkNGq2+8tR8bF7/t'.
'dEyAxg4SFMR4bL4qLjC8ICimRkpMpDXN3Q3cOGHxCf3wTIYVChheJQomLQo6QSJEKl3UmQyZ2m5'.
'0An4CihKSFaS9DK6oArCmuKbAAdHUMQ8wtC5wunp+howClp0IBxMZClJLK0HNCdtK4ute92YUeJ'.
'MFDHopyLwoNxwDhr7GzAC1CauWZVu3PBBGjBGiLtwJAt3jfjEBKFssZHWcQ6qCjlssar0G+CH3Y'.
'9mIDgHmr2uQrMnFcHXMt/NW5RS2Auo8xACj8dQEimMNVj/Ltowggo78itTYW9LMOZDtCiHyaHBJ'.
'xqEtnRjLSdKgOYa+dUHuuUkTkGwGrl2DKMqfUYYC3ATg1zfl0UNSxLxqmbCWEgJACAEoQZSATEw'.
'ATW43IxamzFMpii6ZGNCLYJR48G3WB8mrIXapGjIIO5adTimkqWVI/KBCitesPI1wnKFDm3YcLJ'.
'GqrYQMHjhwmwIMLBx4EADs=';

# aminoacids 0-19, forward and reverse
my @aa = (qw(A C D E F G H I K L M N P Q R S T V W Y));
%raa = (); foreach (0..$#aa) { $raa{$aa[$_]}=$_; }


my $mw;
my @maxmax=(0,0,undef,undef);
my $savename = undef;
my @plugins  = ();
my %fontlist = ();

my %specialrows=( # real_title (or ''), blankchar (or spc), flags:bit0=default_export
  'Consensus' => ['Consensus','.',1],
);

my %propwindata=( # flags: bit0=disallowunchg,bit1=numerical,bit2=only edit if single item,bit3=ch->redraw,
                  #        but4=only edit if whole object
    text         => [13,'Title',          'FR',       []],
    otext        => [ 9,'Text',           'F',        []],
    anchor       => [ 8,'Alignment',      'E',        [['Centered','c'],['Right-aligned','e'],['Left-aligned','w']]],
    comment      => [ 5,'Comment',        'F',        []],
    attach       => [ 0,'Attached To',    'ELine+N+M',[-1]],
    FONT_font    => [ 8,'Font',           'Font',     []],
    FONT_title   => [ 8,'Font',           'Font',     []],
    lc           => [ 8,'Line Colour',    'Col',      [undef,'red']],
    fc           => [ 8,'Fill Colour',    'Col',      [undef,'red']],
    lw           => [10,'Line Width',     'E',        [1,2,3,4,5,6,7,8,10,12]],
    type         => [25,'Object Type',    'E',        'doh'],
);

# Object data
my $ob_ty='Helix'; my $i;
# objectdata entries describe drawable objects:
#    class(0=0D,1=1D,2=2D,3=graph,4=text), padposition, flags<bit0=graph_scaleto1?,bit1=dupins>, function,
#    pretty_name or undef, symbol bitmap
my %objectdata=(
    UpTriangle   => [0, 1, 0,_GlyphFactory(['P',0,0.95,0.5,0,1,0.95]),'Triangle (up)',
                     'R0lGODlhDgAOAPECAAAAAGFl5////wAAACH5BAEAAAIALAAAAAAOAA4AAAImlA9w'.
                     'u6nM3IMihUSNvbOBAHLQBmJeGJrah4prmz5ki82whOddZhQAOw=='],
    DownTriangle => [0, 2, 0,_GlyphFactory(['P',0,0.05,0.5,1,1,0.05]),'Triangle (down)',
		     'R0lGODlhDgAOAPECAAAAAGFl5////wAAACH5BAEAAAIALAAAAAAOAA4AAAIllI8I'.
                     'y+0QopxLrEmBuTjqw2UKJCZhUJkk+iUWmbpX7L60fNd5AQA7'],
    UpTriangleS  => [0, 3, 0,_GlyphFactory(['P',0.1,0.85,0.5,0.15,0.9,0.85]),'Small Triangle (up)',
		     'R0lGODlhDgAOAPECAAAAAGFl5////wAAACH5BAEAAAIALAAAAAAOAA4AAAIilI+p'.
                     'qwB83INCzuWCYznoi3TeFgLeSUbmOV4im1qyRNVMAQA7'],
    DownTriangleS=> [0, 4, 0,_GlyphFactory(['P',0.1,0.15,0.5,0.85,0.9,0.15]),'Small Triangle (down)',
		     'R0lGODlhDgAOAPECAAAAAGFl5////wAAACH5BAEAAAIALAAAAAAOAA4AAAIhlI+p'.
                     'K+APnXGh2iAPvRigbWUfEHoKKCZUqkLMxC7xS78FADs='],
    Circle       => [0, 5, 0,_GlyphFactory(['E',0.15,0.15,0.85,0.85]),undef,
		     'R0lGODlhDgAOAPECAAAAAGFl5////wAAACH5BAEAAAIALAAAAAAOAA4AAAIklI+p'.
                     'i+C+XpgvuYnhuTiDDXQeKFKfwYkaGnYr2wZv85zMjSMFADs='],
    Star         => [0, 6, 0,_GlyphFactory(['P',0.5,0,0.39,0.36,0,0.36,0.31,0.57,0.19,0.95,0.5,0.7,
					        0.81,0.95,0.69,0.57,1,0.36,0.61,0.36]),undef,
		     'R0lGODlhDgAOAPECAAAAAGFl5////wAAACH5BAEAAAIALAAAAAAOAA4AAAImlA+n'.
                     'C73f0lNxIhAcjS3zjwWipwnRWDGhN2GntIGwkXLqjVimUQAAOw=='],
    Starm        => [0, 7, 0,_GlyphFactory(['P',0.5,0,0.19,0.95,1,0.36,0,0.36,0.81,0.95]),'Hollow star',
		     'R0lGODlhDgAOAPECAAAAAGFl5////wAAACH5BAEAAAIALAAAAAAOAA4AAAIjlA1w'.
                     'y6ncElzuTZGCpLU7nD2hBVpfpJyNFkKeinxVxJFkYxQAOw=='],
    Square       => [0, 8, 0,_GlyphFactory(['R',0.05,0.05,0.95,0.95]),undef,
		     'R0lGODlhDgAOAPECAAAAAGFl5////wAAACH5BAEAAAIALAAAAAAOAA4AAAIhlI8I'.
                     'y80Cgpw0AFjzjZnu7mGg9I2WOJYpCqot5MRXQh8FADs='],
    Diamond      => [0, 9, 0,_GlyphFactory(['P',0.5,0.05,0.95,0.5,0.5,0.95,0.05,0.5]),undef,
		     'R0lGODlhDgAOAPECAAAAAGFl5////wAAACH5BAEAAAIALAAAAAAOAA4AAAIllA+n'.
                     'C70MgnuihTuVvTihyHHTFooJWUoeampgC8GPlVGNRyFUAQA7'],
    UpArrowC     => [0,10, 0,_GlyphFactory(['P',0.5,0,0.7,0.3,0.5,0.3,0.5,1,0.5,0.3,0.3,0.3]),'CArrow (up)',
		     'R0lGODlhDgAOAKECAAAAAGFl5////////yH5BAEAAAIALAAAAAAOAA4AAAIujA1w'.
		     'JyGf0nvOQQRmhSpI2nDRt01CZpYTqoUmC1qrGcoQrd6pO+/2iWssPENHAQA7'],
    DownArrowC   => [0,11, 0,_GlyphFactory(['P',0.5,1,0.7,0.7,0.5,0.7,0.5,0,0.5,0.7,0.3,0.7]),'CArrow (down)',
		     'R0lGODlhDgAOAKECAAAAAGFl5////////yH5BAEAAAIALAAAAAAOAA4AAAIsjA93'.
		     'EuIOnmtNRkmluC9b7T3cxGhjWYlg+WEsAMeXBxtwx242F8quEqgBBQUAOw=='],
    UpArrowR     => [0,12, 0,_GlyphFactory(['P',1,0,1.2,0.3,1,0.3,1,1,1,0.3,0.8,0.3]),'RArrow (up)',
		     'R0lGODlhDgAOAKECAAAAAGFl5////////yH5BAEAAAIALAAAAAAOAA4AAAImjI8A'.
		     'ISwPhVItxhWUszov+0zTBkoMCX4od5aQ6oZtDNOzqyJ6xhQAOw=='],
    DownArrowR   => [0,13, 0,_GlyphFactory(['P',1,1,1.2,0.7,1,0.7,1,0,1,0.7,0.8,0.7]),'RArrow (down)',
		     'R0lGODlhDgAOAKECAAAAAGFl5////////yH5BAEAAAIALAAAAAAOAA4AAAInjI8B'.
		     'ISwP4Wqxiunsw1qyrHHd9Y0kNYoVwLagtChTaLAvzDYJYgsFADs='],
    BarR         => [0,14, 0,_GlyphFactory(['P',0.95,0,1.05,0,1.05,1,0.95,1]),'RBar',
                     'R0lGODlhDgAOAPEDAAAAAGFl593d/////yH5BAEKAAMALAAAAAAOAA4AAAIjjI+gEOL/WGCwSlqj'.
                     'wVnc1nkb2H2hOJGZGbLleLrriNQLUAAAOw=='],
  #--------------------------------------------------------------------------------------------------------
    Helix        => [1, 0, 2,_LingFactory(
			     _GlyphFactory(['RZ:lc=$fc:lw=0',0,0.1,1,0.9]),                               # shaft
			     _GlyphFactory(['O',0.5,0.5,1,0.5],['E',0.25,0.1,0.75,0.9],                   # head
					   ['RZ:lc=$fc:lw=0',0,0.1,0.5,0.9]),
			     _GlyphFactory(['RZ:lc=$fc:lw=0',0.5,0.1,1,0.9],                              # tail
					   ['E:fc="white"',0.25,0.1,0.75,0.9],['O',0,0.5,0.5,0.5]),
			     _GlyphFactory(['O',0.7,0.5,1,0.5],['E',0.45,0.1,0.95,0.9],                   # short?
					   ['RZ:lc=$fc:lw=0',0.3,0.1,0.7,0.9],
					   ['E:fc="white"',0.05,0.1,0.55,0.9],['O',0,0.5,0.3,0.5])),undef,
		     'R0lGODlhKwAOAPECAAAAAFld/////wAAACH5BAEAAAIALAAAAAArAA4AAAJJlI+py30Ao5y0Qmdo2Lz7'.
                     'v0XYJUDgiZKMWgLo67EJa8K23E6Za8P6DEDUeqngyrgjvnAPZEuZGhmH0JhzMamCmAqL98vFiMeMAgA7'],
    Helix2       => [1, 7, 2,_LingFactory(
                             $i=_GlyphFactory(['P:lc=$fc:lw=0',0,0.47,0.25,0.7,0.5,0.13,0.75,0,1,0.47,    # shaft
					    1,0.87,0.75,0.3,0.5,0.53,0.25,1,0,0.87],
					   ['O',0,0.47,0.25,0.7,0.5,0.13,0.75,0,1,0.47],
					   ['O',1,0.87,0.75,0.3,0.5,0.53,0.25,1,0,0.87]),
                             _GlyphFactory(['PO:lc=$fc:lw=0',0,0.47,0.25,0.7,0.5,0.53,0.75,0.5,1,0.5,     # head
					    0.75,0.5,0.5,0.53,0.25,1,0,0.87]),
			     _GlyphFactory(['PO:lc=$fc:lw=0',1,0.87,0.75,0.3,0.5,0.53,0.25,0.5,0,0.5,     # tail
					    0.25,0.5,0.5,0.13,0.75,0,1,0.47]),$i),'Helix (alt)',
		     'R0lGODlhKgAOAPECAAAAAFld/////wAAACH5BAEAAAIALAAAAAAqAA4AAAJWlI+gyLoMY3NA0irzDPwlwAWeZoHhaC'.
                     'gnRpYd9b1OG6niFV9sq8OwoHqAUL0dcJYaVn7HW5JJA8qcSRkymlgRtUasNEQ9mFZeiA1VDZc/1wl6/dS0IQUAOw=='],
    Strand       => [1, 1, 2,_LingFactory(
			     _GlyphFactory(['RZ:lc=$fc:lw=0',0,0.25,1,0.75]),                             # shaft
			     _GlyphFactory(['PO:lc=$fc:lw=0',0,0.25,0,0,1,0.5,0,1,0,0.75]),               # head
			     _GlyphFactory(['PO:lc=$fc:lw=0',1,0.25,0,0.25,0,0.75,1,0.75]),               # tail
			     _GlyphFactory(['P',0,0.25,0.3,0.25,0.3,0,1,0.5,0.3,1,0.3,0.75,0,0.75])),undef, # short
		     'R0lGODlhKgAOAPECAAAAAFld/////wAAACH5BAEAAAIALAAAAAAqAA4AAAJClI+pC7APo2pN2mtAoA7y'.
                     'D4ZfQHKPRqbqyrapmaDuTKtwVuc5LOv+yvsJSxREb0i7HUTM5quIiRo3UKlVoLxKK5ICADs='],
    Strand2      => [1, 8, 2,_LingFactory(
			     _GlyphFactory(['P:lc=$fc:lw=0',0,0.35,0.25,0.25,0.75,0.45,1,0.35,1,0.65,     # shaft
					    0.75,0.75,0.25,0.55,0,0.65],['O',0,0.35,0.25,0.25,0.75,0.45,
					    1,0.35],['O',1,0.65,0.75,0.75,0.25,0.55,0,0.65]),
			     $i=_GlyphFactory(['PO:lc=$fc:lw=0',0,0.65,0.25,0.65,0.25,0.85,0.75,0.5,1,    # head
					       0.5,0.75,0.5,0.25,0.15,0.25,0.35,0,0.35]),
			     _GlyphFactory(['PO:lc=$fc:lw=0',1,0.65,0.75,0.75,0.5,0.65,0.25,0.65,0.25,    # tail
				   0.5,0,0.5,0.25,0.5,0.25,0.35,0.5,0.35,0.75,0.45,1,0.35]),$i),'Strand (alt)',
		     'R0lGODlhKgAOAPECAAAAAFld/////wAAACH5BAEAAAIALAAAAAAqAA4AAAJFlI+py+0Po2ygTlct'.
                     'zTBr44VIGHhYgIYAypZqy3KJB2dwXd2xOOot7bvJFK+UymZEmjoqYlOwGkqkTsCIesl+styuN1sAADs='],
    Coil         => [1, 2, 2,$i=_GlyphFactory(['O',0,0.5,1,0.5]),undef,
		     'R0lGODlhKgAOAKECAAAAAFld/////////yH5BAEAAAIALAAAAAAqAA4AAAIwjI+pyysPo5y0RmOzznj7'.
		     '332iFY7mFQDqyrbuC7Plec70aN9goNN5r/kBSY2i8VgAADs='],
    DashedLine   => [1,19, 2,$i=_GlyphFactory(['O',0.35,0.5,0.65,0.5]),'Dashed line',
                     'R0lGODlhKgAOAPMAAAAAAFpa/97e////////////////////////////////////////////////'.
                     '/////yH5BAEAAAIALAAAAAAqAA4AAAQ6MMhJq734is27/2DYSWJpluSprunqiu0rjwGwAbaA3/mu'.
                     '90CeUBebzYrGFzLJCjCNy6cpKoVlrthsBAA7'],
    ConnectUp    => [1,15, 2,_LingFactory(_GlyphFactory(['O',0,0.6,1,0.6]),
					  _GlyphFactory(['O',0,0.6,0.5,0.6,0.5,0],['P',0.5,0,0.7,0.3,0.3,0.3]),
					  _GlyphFactory(['O',0.5,0,0.5,0.6,1,0.6],['P',0.5,0,0.7,0.3,0.3,0.3]),
					  _GlyphFactory(['O',0.2,0,0.2,0.6,0.8,0.6,0.8,0],
							['P',0.2,0,0.4,0.3,0,0.3],
							['P',0.8,0,0.6,0.3,1,0.3])),'Connector (up)',
		     'R0lGODlhKgAOAPECAAAAAFld/////wAAACH5BAEAAAIALAAAAAAqAA4AAAI1lC8AyO2mHlNRWkhv'.
                     'CqHqpnCLFXbjNwHi6VAZmrofC081XR84mbe3CwwKZb2i8YhMKpfMXgEAOw=='],
    ConnectDown  => [1,16, 2,_LingFactory(_GlyphFactory(['O',0,0.4,1,0.4]),
					  _GlyphFactory(['O',0,0.4,0.5,0.4,0.5,1],['P',0.5,1,0.7,0.7,0.3,0.7]),
					  _GlyphFactory(['O',0.5,1,0.5,0.4,1,0.4],['P',0.5,1,0.7,0.7,0.3,0.7]),
					  _GlyphFactory(['O',0.2,1,0.2,0.4,0.8,0.4,0.8,1],
							['P',0.2,1,0.4,0.7,0,0.7],
							['P',0.8,1,0.6,0.7,1,0.7])),'Connector (down)',
		     'R0lGODlhKgAOAPECAAAAAFld/////wAAACH5BAEAAAIALAAAAAAqAA4AAAIylI+py+0Po5y'.
                     '02osX2Lz7D0pAhowieZiRSrJMaMEvEAQbttW3Q9tZ7nt0WjtI8ecyFAAAOw=='],
    Underline    => [1,25, 0,_GlyphFactory(['O',0,0.96,1,0.96]),undef,
		     'R0lGODlhKgAOAKECAAAAAFld/////////yH5BAEAAAIALAAAAAAqAA4AAAIyjI+pyysPo5y0R'.
		     'mOzznj7332iFY7mFZwqVK5j64JpbMK0Zt9kAPT+DwwKhz8D8Yg8BgoAOw=='],
  #--------------------------------------------------------------------------------------------------------
    Box          => [2, 0, 2,\&Box,undef,'R0lGODlhJwAOAKECAAAAAFld/////////yH5BAEAAAIALAAAAAAnAA4AAAIqhI+pyxg'.
		     'Po5y0BmOzpnh73X3iFI7mBZxqqX5su71wJs9VbZNpHjf+3ygAADs='],
    Rect         => [2, 1, 2,\&Rect,'Rectangle','R0lGODlhJwAOAIABAAAAAP///yH5BAEAAAEALAAAAAAnAA4AAAIqhI+pyxgP'.
		     'o5y0BmOzpnh73X3iFI7mBZxqqX5su71wJs9VbZNpHjf+3ygAADs='],
  #--------------------------------------------------------------------------------------------------------
    BarGraph     => [3,-1, 0,\&BarGraph,'Bar Graph'],
    BarCGraph    => [3,-1, 0,\&BarCutGraph,'Bar Graph + Cut'],
    LineGraph    => [3,-1, 0,\&LineGraph,'Line Graph'],
    LineCGraph   => [3,-1, 0,\&LineCutGraph,'Line Graph + Cut'],
    GradGraph    => [3,-1, 1,\&GradientGraph,'Gradient (RGB)'],
    GradCGraph   => [3,-1, 1,\&GradientCutGraph,'Gradient (RGB) + Cut'],
    HSLGradGraph => [3,-1, 1,\&GradientGraphHSL,'Gradient (HSL)'],
    HSLGradCGraph=> [3,-1, 1,\&GradientCutGraphHSL,'Gradient (HSL) + Cut'],
    OnebitGraph  => [3,-1, 1,\&BinaryGraph,'Binary'],
  #--------------------------------------------------------------------------------------------------------
    Text         => [4,-1, 0,undef],
    OutlineText  => [4,-1, 0,undef],
);

my %glyphlist=(
  space        => ' ',  # 20
  exclam       => '!',  # 21
  quotedbl     => '"',  # 22
  numbersign   => '#',  # 23
  dollar       => '$',  # 24
  percent      => '%',  # 25
  ampersand    => '&',  # 26
  quotesingle  => "'",  # 27
  parenleft    => '\(', # 28
  parenright   => '\)', # 29
  asterisk     => '*',  # 2A
  plus         => '+',  # 2B
  comma        => ',',  # 2C
  hyphen       => '-',  # 2D
  period       => '.',  # 2E
  slash        => '/',  # 2F
  zero         => '0',  # 30
  one          => '1',  # 31
  two          => '2',  # 32
  three        => '3',  # 33
  four         => '4',  # 34
  five         => '5',  # 35
  six          => '6',  # 36
  seven        => '7',  # 37
  eight        => '8',  # 38
  nine         => '9',  # 39
  colon        => ':',  # 3A
  semicolon    => ';',  # 3B
  less         => '<',  # 3C
  equal        => '=',  # 3D
  greater      => '>',  # 3E
  question     => '?',  # 3F
  at           => '@',  # 40
                        # 41-5A (uppercase letters)
  bracketleft  => '[',  # 5B
  backslash    => '\\', # 5C
  bracketright => ']',  # 5D
  asciicircum  => '^',  # 5E
  underscore   => '_',  # 5F
  grave        => '`',  # 60
                        # 61-7A (lowercase letters)
  braceleft    => '{',  # 7B
  bar          => '|',  # 7C
  braceright   => '}',  # 7D
  asciitilde   => '~',  # 7E
);

# The parameters
%defaultpar=(
    'csh' => 12,               # horizontal character spacing
    'csv' => 12,               # vertical character spacing
    'lin' => 10,               # indent for title in chars
    'all' => 0,                # on/off value title on all rows
    'ofx' => 50,               # coordinate offset from left of canvas
    'ofy' => 50,               # coordinate offset from top of canvas
    'nch' => 40,               # width of alignment in chars
    'fsi' => 1,
    'num' => 'CFG:numcolsize', # width of number column at RHS of page, 0 means no numbers
    'agr' => 0,                # aggressive editing on/off
);

@defaultcategories=(
    ['0.1',["grey90","grey90",'0','black','CFG:f[4]','CFG:f[1]','CFG:f[3]',"Bold"]],
    ['0.2',["grey80","grey80",'0','black','CFG:f[4]','CFG:f[1]','CFG:f[3]',"Bold"]],
    ['0.3',["grey70","grey70",'0','black','CFG:f[4]','CFG:f[1]','CFG:f[3]',"Bold"]],
    ['0.4',["grey60","grey60",'0',"black",'CFG:f[4]','CFG:f[1]','CFG:f[3]',"Bold"]],
    ['0.5',["grey50","grey50",'0',"black",'CFG:f[4]','CFG:f[1]','CFG:f[3]',"Bold"]],
    ['0.6',["grey40","grey40",'0',"white",'CFG:f[4]','CFG:f[1]','CFG:f[3]',"Bold"]],
    ['0.7',["grey30","grey30",'0',"white",'CFG:f[4]','CFG:f[1]','CFG:f[3]',"Bold"]],
    ['0.8',["grey20","grey20",'0',"white",'CFG:f[4]','CFG:f[1]','CFG:f[3]',"Bold"]],
    ['0.9',["grey10","grey10",'0',"white",'CFG:f[4]','CFG:f[1]','CFG:f[3]',"Bold"]],
    ['0.999',["black","black",'0',"white",'CFG:f[4]','CFG:f[1]','CFG:f[3]',"Bold"]],
    ['100',["","",'',"","","","",""]],
);


# Main.
_PrintSplash();
refix:
ConfigFixup(\%cfg,\%cfgtemplate);
if (PullInConfigFiles()) { goto refix; }
ResetParameters();
_CopyCat(\@defaultcategories,\@categories,1);
InitMainWindow();
_UpdateParameters();
_LoadPlugins();
_ConfigPluginMerge();
_FillFontList(\%fontlist);
_InitGraphics();
_ProcessCommandLine();
_Defocus();
MainLoop;
exit 0;


# --------------------------------------------------------------------------------

sub _LoadPlugins()
{   my ($i,$j,$c);
    # Remove old plugins if they hang around...
    foreach $i (@plugins) { $i->terminate(); } @plugins=();

    $i="WARNING: Plugin directory '$cfg{plugindir}' ";
    if (! -d $cfg{plugindir}) { print STDERR "${i}does not exist.\n"; return; }
    unshift @INC,$cfg{plugindir};
    if (!opendir(PDIR,$cfg{plugindir})) { print STDERR "${i}is inaccessible.\n"; return; }
    while (defined($i=readdir(PDIR))) {
	if (($i!~/^\./) && ($i=~/\.plugin$/)) {
	    if ($cfg{debug}) { print STDERR "Loading $cfg{plugindir}/$i.\n"; }
            eval { require "$cfg{plugindir}/$i" };
            if ($@) {
		print STDERR "WARNING: Cannot load '$i'.\n".($cfg{debug}?$@:'');
		next;
	    }
	    $j=$i; $j=~s/\.plugin$//;
            $j=eval('Aline::Plugins::'.$j.'->new(\%cfg,\@seq,\%par,$mw,\@categories,\%draginfo,
                                                 \%cursor,\$canvas,\%prog);');
            if ($@ || !ref($j)) {
		$j||='internal error';
		print STDERR "WARNING: Cannot initialise '$i' ($j).\n".($cfg{debug}?$@:'');
		next;
	    }
	    foreach $c ($j->regbindings(11)) {
		if (($c->[0]>=0) && ($c->[0]<=3)) {
		    if (exists($privatevars[$c->[0]]{$c->[1]})) {
			print STDERR "WARNING: Plugin '$i' cannot be loaded;\n         private data item ".
			             "'$c->[1]' conflicts with '$privatevars[$c->[0]]{$c->[1]}'.\n";
			$j->terminate(); goto badplugin;
		    }
		    $privatevars[$c->[0]]{$c->[1]}=$i;
		}
	    }	    
	    push @plugins,[$i,$j];
badplugin:  ;
	}
    }
    closedir PDIR;
    @plugins=map { $_->[1] } sort {
	($b->[1]->priority()<=>$a->[1]->priority()) || ($a->[0] cmp $b->[0])
    } @plugins;
}

sub _UnloadPluginHelper($)
{ my $plugin=shift; my $c;
  foreach $c ($plugin->regbindings(11)) { delete $privatevars[$c->[0]]{$c->[1]}; }
}

sub IsPluginLoaded($)
{ my $id=shift; my ($item);
  foreach $item (@plugins) { if ($item->id() eq $id) { return 1; } }
  return undef;
}

sub _ProcessCommandLine()
{   my ($i);
    while (@ARGV && ($ARGV[0]=~/^-([^=]+)(?:=(.*))?$/)) {
	$i=$1;
	print STDERR "WARNING: Unknown command line option '-$i'.\n"; shift @ARGV;
    }
    if (@ARGV) {
	if ($ARGV[0]=~/\.script$/i) {
	    if (($i=_ExecScript(1,$ARGV[0]))) { print STDERR "ERROR: $i\n"; }
	} else {
	    Open($ARGV[0]);
	}
	shift @ARGV;
    }
    if (@ARGV) { print STDERR "WARNING: Useless command line arguments: '".join(' ',@ARGV)."'.\n"; }
}

sub _FillFontList($)
{   my ($font,@list,@x,%families,$pname,$i,$j); my $flip=shift; $j=32768;
    $font=$mw->X11Font('*-*-*-*-*-*-*');
    @list=$font->Name($j);
    for ($i=$#list;$i>=0;$i--) { if ($list[$i]=~/^(?:\*-)+\*?$/) { splice @list,$i,1; } }
    if ($cfg{debug}) {
	print "X Fonts: #        = ".scalar(@list)."\n";
	%families=(); foreach $i (@list) { @x=split(/\-/,lc($i)); $families{$x[1]}=1; }
	print 'X Fonts: Families = ('.join('|',sort keys %families).")\n";
    }
    %families=map { $_=>1 } @{$cfg{fontfams}};
    if (!@list || $cfg{fontforcedefault}) {
	foreach $i (keys %{$cfg{fontdefault}}) { $flip->{$i}=$cfg{fontdefault}{$i}; }
	return;
    }
    foreach $i (@list) {
	@x=split(/\-/,$i); shift @x;
	if ((!@{$cfg{fontfams}}) || exists($families{$x[0]})) {
	    $pname=ucfirst($x[1]);
	    if (exists($flip->{$pname}) && ($flip->{$pname}[0] ne $x[0])) {
		foreach $j (@{$cfg{fontfams}}) {
		    if ($j eq $flip->{$pname}[0]) { goto prxfont; }
		    if ($j eq $x[0])              { $flip->{$pname}=undef; goto pryfont; }
		}
		next;
	    }
pryfont:    $flip->{$pname}||=[$x[0],"-$x[0]-$x[1]-",{}];
	    $flip->{$pname}[2]{$x[2].'-'.$x[3].((lc($x[4]) ne 'normal')?('-'.$x[4]):'')}=1;
	}
prxfont:;
    }
    foreach $i (keys %$flip) { $flip->{$i}[2]=[sort { $b cmp $a } keys %{$flip->{$i}[2]}]; }

    foreach $i (qw(f fo n t)) { _ValidateFont($flip,\$cfg{$i}[1],\$cfg{$i}[2],\$cfg{$i}[3]); }
}

sub _ValidateFont($$;$$$)
{   my ($flip,$rec,$f2,$f3,$q)=@_; my ($i,$s,@u,%ior,$ch); local $_=$$rec;
    $ch=0;
    if (!defined($flip)) { $flip=\%fontlist; }
    if ($_ eq $cfg{unchg}[1]) { return 1; }
    if (!exists($flip->{$_})) {
	$ch=1;
	if (/times/i)      { $$rec='Times'; }
	elsif (/courier/i) { $$rec='Courier'; }
	elsif (/symbol/i)  { $$rec='Symbol'; }
	else               { $$rec='Helvetica'; }
	if (!exists($flip->{$$rec})) { $$rec=(sort keys %$flip)[0]; }
	print STDERR "WARNING: Unknown font foundry '$_', using '$$rec' instead.\n" unless $q;
    }

    @u=map { [split(/-/,lc($_).'-*-*-*')]; } @{$flip->{$$rec}[2]};
    goto noslant if !defined($f3) || ($$f3 eq $cfg{unchg}[1]);
    $$f3=lc($$f3);
    for ($_=0,%ior=();$_<@u;$_++) { $ior{$u[$_][1]}=1; }
    if (!exists($ior{$$f3})) {
	$ch=1;
	if    (($$f3 eq 'i') && exists($ior{'o'})) { $$f3='o'; }
	elsif (($$f3 eq 'o') && exists($ior{'i'})) { $$f3='i'; }
	elsif (exists($ior{'r'})) {
	    print STDERR "WARNING: Unsupported font slant '$$f3', reset to 'r'.\n" unless $q; $$f3='r';
	}
    }

noslant:
    return $ch if !defined($f2) || ($$f2 eq $cfg{unchg}[1]);
    $$f2=lc($$f2);
    for ($_=0,%ior=();$_<@u;$_++) {
	$ior{$u[$_][0]}=1 if ($u[$_][1] eq $$f3) || ($$f3 eq $cfg{unchg}[1]);
    }
    return $ch if exists($ior{$$f2});
    $ch=1; @u=keys %ior; if (!@u) { @u=('medium'); }
    if (@u==1) { $i=$u[0]; goto foundweight; }

    @u=(qw(black bold demibold medium regular));
    $i=undef; for ($_=0;$_<@u;$_++) { if ($u[$_] eq $$f2) { $i=$_; last; } }
    if (!defined($i)) { goto badweight; }
    for ($_=1;$_<((@u+1)>>1);$_++) {
	$s=0;
	if ($i>=$_) { $s=1; if (exists($ior{$u[$i-$_]})) { $i=$u[$i-$_]; goto foundweight; } }
	if (($_+$i)<@u) { $s=1; if (exists($ior{$u[$i+$_]})) { $i=$u[$i+$_]; goto foundweight; } }
	last unless $s;
    }
badweight:
    $i='medium';
foundweight:
    print STDERR "WARNING: Changing font weight from '$$f2' to '$i'.\n" unless $q; $$f2=$i;
    return $ch;
}

sub _FontEnt2Block($$;$)
{   my ($e,$l,$block)=@_; my ($i,@v);
    @v=();
    foreach $i (qw(fill foundry weight slant size width bg)) {
	if (!exists($e->{$l.$i})) { push @v,undef; } else { push @v,$e->{$l.$i}; }
    }
    if (!defined($block)) { return \@v; }
    for ($i=0;$i<@v;$i++) {
	if (!defined($block->[$i])) { if (defined($v[$i])) { $block->[$i]=$cfg{unchg}[1]; } }
	else {
	    if (($i==4)?($block->[$i]!=$v[$i]):(lc($block->[$i]) ne lc($v[$i]))) { $block->[$i]=$cfg{unchg}[1]; }
	}
    }
    return $block;
}

sub _FontBlock2Ent($$$)
{   my ($block,$e,$l)=@_; my ($i,$lab); my $ch=0;
    for ($i=0;$i<7;$i++) {
	$lab=(qw(fill foundry weight slant size width bg))[$i];
	next if !exists($e->{$l.$lab});
	if (!defined($block->[$i]) || ($block->[$i] ne (($i==4)?'':$cfg{unchg}[1]))) {
	    $e->{$l.$lab}=$block->[$i]; $ch=1;
	}
    }
    $ch|=_ValidateFont(undef,\$e->{$l.'foundry'},\$e->{$l.'weight'},\$e->{$l.'slant'},1);
    return $ch;
}

sub _FlattenMenu($;$)
{   my ($menu,$dep)=@_; my ($i,$j,$p); $dep=$dep?1:0;

    # merge duplicate submenus
    for ($i=$#$menu-1;$i>=$dep;$i--) {
	next if ref($menu->[$i]) ne 'ARRAY';
	next if defined($menu->[$i][1]) && (ref($menu->[$i][1] ne 'ARRAY'));
	for ($j=$#$menu;$j>$i;$j--) {
	    next if ref($menu->[$j]) ne 'ARRAY';
	    next if defined($menu->[$j][1]) && (ref($menu->[$j][1] ne 'ARRAY'));
	    if ($menu->[$i][0] eq $menu->[$j][0]) {
		shift @{$menu->[$j]}; push @{$menu->[$i]},@{$menu->[$j]}; splice @$menu,$j,1; $j--;
	    }
	}
    }

    # flatten %... submenus
    for ($i=$#$menu;$i>=$dep;$i--) {
	next if ref($menu->[$i]) ne 'ARRAY';
	if ((!defined($menu->[$i][1])) || (ref($menu->[$i][1]) eq 'ARRAY')) {
	    if (substr($menu->[$i][0],0,1) eq '%') {
		my @frk=(); shift @{$menu->[$i]};
		push @frk,'---' if ($i>$dep) && (ref($menu->[$i-1]) eq 'ARRAY');
                push @frk,@{$menu->[$i]};
		push @frk,'---' if ($i<$#$menu) && (ref($menu->[$i+1]) eq 'ARRAY');
		splice @$menu,$i,1,@frk;
	    } else { _FlattenMenu($menu->[$i],1); }
	}
    }
}

sub __bindkey2pr($)
{   my $x=shift; $x=~s/([A-Z][a-zA-Z]*)$/Shift-$1/; $x=~s/([a-z]+)$/ucfirst($1)/e; return $x; }

sub _BuildMenu($$@)
{   my $mw=shift; my $mb=shift; my ($desc,$x,$newitem,@xargs,$tempitem);
    foreach $desc (@_) {
        if (ref($desc) ne 'ARRAY') {
            $mb->separator(-fg=>$cfg{wcs}[1]); next;
        }
        next if @$desc<2;
        if ((!defined($desc->[1])) || (ref($desc->[1]) eq 'ARRAY')) {
            #------ Submenu
            foreach $x (1..$#$desc) { if (defined($desc->[$x])) { goto goodmenu; } }
   	    return;
goodmenu:   $newitem=$mb->cascade(-label => shift(@$desc), -tearoff => 0);
            foreach $x (@$desc) { if (defined($x)) { _BuildMenu($mw,$newitem,$x); } }
	} else {
            #------ Normal menu item
            @xargs=('-label',$desc->[0],'-command',$desc->[1],'-bg',$cfg{wcs}[1]);
            if (defined($desc->[2])) {
		$mw->bind('<'.$desc->[2].'>',$desc->[1]);
		push @xargs,'-accelerator',__bindkey2pr($desc->[2]);
	    }
	    if ($desc->[4]) {
		$tempitem=$mb->checkbutton(@xargs,-variable=>$desc->[4][0],
					   -onvalue=>defined($desc->[4][1])?$desc->[4][1]:1,
					   -offvalue=>defined($desc->[4][2])?$desc->[4][2]:0);
	    } else { $tempitem=$mb->command(@xargs); }
            if (defined($desc->[3])) { ${$desc->[3]}=$tempitem; }
	}
    }
}

sub _Defocus()
{   if (defined($ui{yframe})) { $ui{yframe}->focus(); } }

sub _choosebutton($$) # drawbutton,which
{   foreach my $i (0..$#{$_[0]}) {
        $_[0][$i]->configure(-relief=>($i==$_[1])?'sunken':$cfg{mbstate});
    } _Defocus();
}

sub _mySlider
{   my ($ob,$lab,$x1,$x2,$v,$x,$flags)=@_; my ($sl,$fl,$ll,$factor);
    $factor=($flags&4)?100:1; $lab="$lab: %d".(($flags&4)?' %%':'');
    $fl=$ob->Frame(-borderwidth=>1)->pack(-side=>'top',-fill=>'x');
    $ll=$fl->Label(-text=>sprintf($lab,$v),-anchor=>'w')->pack(-side=>'top',-fill=>'x');
    $sl=$fl->Scale(-orient=>'horizontal',-from=>$x1,-to=>$x2,-length=>150,-width=>12,-showvalue=>0,-command=>sub {
	my $v=shift; $ll->configure(-text=>sprintf($lab,$v)); $v/=$factor;
	return if ($par{$x}==$v);
	if (!@undo || (($undo[-1]{parcause}||'') ne $x)) {
	    my $val=$par{$x}*$factor;
	    PSmartData('Move Sliders',sub {
		$par{$x}=$val; $ui{$x.'scale'}->set($val); _UpdateParameters();
		if ($flags&2) { _InvalidateGlyphs(); } if ($flags&1) { _InvalidateAll(1); } PrintSeq();
	    },$x);
	}
	$par{$x}=$v; _UpdateParameters();  if ($flags&2) { _InvalidateGlyphs(); }
	if ($flags&1) { _InvalidateAll(1); } PrintSeq();
    })->pack(-side=>'top',-fill=>'x');
    $fl->Frame(-borderwidth=>1)->pack(-side=>'top');
    $sl->set($v); return $sl;
}

sub _disallowediting($)
{   my $widget=shift;
    $widget->bind('<FocusIn>',sub { $noedit=1; });
    $widget->bind('<FocusOut>',sub { $noedit=0; });
}

sub _setupcolourhistory($)
{   my $class=shift; my $uie=$ui{'colm'.$class}; my ($i,$menu);
    $menu=$uie->[1]; $uie=$uie->[0];
    if ((!exists($cfg{$class.'stack'})) || (!$cfg{$class.'stack'}) || (!@{$cfg{$class.'stack'}})) {
	$uie->configure(-state=>'disabled'); return;
    }
    $uie->configure(-state=>'normal');
    $menu->delete(0,'end');
    foreach $i (@{$cfg{$class.'stack'}}) {
	my $color=$i;
	$menu->add('command',-activebackground=>$i,-background=>$i,-command=>sub { _ccbutton($class,$color); });
    }
}

sub _ccbutton($$)
{   my ($class,$colour)=@_; my $j; my @col=colourN2R($colour);
    # canonicalize colour names...
    $cfg{$class}=colourR2N(colourN2R($cfg{$class})); $colour=colourR2N(@col);
    if ($col[1]>$col[0]) { $col[0]=$col[1]; } if ($col[2]>$col[0]) { $col[0]=$col[2]; }
    $col[0]=($col[0]>=0.5)?'#000000':'#ffffff';
    if ($cfg{colorstack}) {
	if ($cfg{$class} ne $colour) {
	    for ($j=$#{$cfg{$class.'stack'}};$j>=0;$j--) {
		if ($cfg{$class.'stack'}[$j] eq $colour) { splice @{$cfg{$class.'stack'}},$j,1; }
	    }
	    unshift @{$cfg{$class.'stack'}},$cfg{$class};
	    _setupcolourhistory($class);
	}
    }
    $cfg{$class}=$colour; $ui{'colb'.$class}->configure(-bg=>$colour,-fg=>$col[0]);
}

sub _getLocalScripts()
{   my ($i,$dh); my @r=();
    $dh=undef; opendir $dh,$cfg{scriptdir} or return(());
    while (defined($i=readdir($dh))) {
        next if $i!~/\.script$/; next if -d $cfg{scriptdir}.'/'.$i;
        next if !$cfg{debug} && ($i=~/^dbg-/);
	my $x=$i;
	push @r,[$x,sub { my $rr=_ExecScript(0,$cfg{scriptdir}.'/'.$x); if ($rr) { print STDERR "ERROR: $rr\n"; } }];
    }
    if (@r) { unshift @r,'---'; }
    return @r;
}

sub _InitGraphics()
{   my ($about,$menubar,@temp,@xtemp,$info,$p,$i,$j,$k,$act);

    $about = $mw->Dialog(
        -title          => "About $prog{name}",
        -bitmap         => 'info',
        -default_button => 'OK',
        -buttons        => ['OK'],
        -text           => "$prog{name} version $prog{version}\n".
                           "Copyright (c) 2002-2007 Charlie Bond\n".
			   "Copyright (c) 2005-2007 Alex Schuettelkopf\n".
                           "University of Dundee\n".
                           "http://stein.bioch.dundee.ac.uk/~charlie/scripts/aline\n",
        -wraplength     => '6i',
    );

    $mw->title("Aline: http://stein.bioch.dundee.ac.uk/~charlie/scripts/aline");
    $menubar=$mw->Menu(-bg=>$cfg{wcs}[1]);
    $mw->configure(-menu=>$menubar);
    $screen{SW}=$mw->screenwidth-40;
    $screen{SH}=$mw->screenheight-100;
    ($screen{MC})=$mw->rgb('white'); $screen{MD}=1.0/$screen{MC};
    $mw->geometry("$screen{SW}x$screen{SH}+20+30");
    $mw->configure(-bg=>'white');
    $mw->focus;

    @temp=([],[],[],[],[],[]);
    # Before we build the menu bar, let's get the colour schemes...
    if (opendir(SCHEMES,$cfg{colsetdir})) {
	while (defined(my $i=readdir(SCHEMES))) {
	    if (($i!~/^\./) && ($i=~/^(.+)\.alc$/)) {
		push @{$temp[0]},[$1,sub { ReadColour("$cfg{colsetdir}/$i"); }];
            }
        }
        close SCHEMES;
    }
    # ...then get the plugin bindings (also other bindings for fun)...
    foreach $p (@plugins) {
        foreach $j (1..4) { push @{$temp[$j]},$p->regbindings($j); }
	push @{$temp[5]},$p->regbindings(13);
        foreach $j ($p->regbindings(0))  { $mw->bind('<'.$j->[0].'>',$j->[1]); }
	foreach $j ($p->regbindings(5))  { $actions{$j->[0]}=$j->[1]; }
	foreach $j ($p->regbindings(7))  { NewObType($j->[0],$j->[1],$j->[2]); }
	foreach $j ($p->regbindings(8))  { $importlist{$j->[0]}=[$j->[1],$j->[2]]; }
	foreach $j ($p->regbindings(9))  { $exportlist{$j->[0]}=[$j->[1],$j->[2]]; }
	foreach $j ($p->regbindings(12)) { Aline::Sandbox::_bind($j->[0],$j->[1]); }
	foreach $j ($p->regbindings(6))  { # now things get more complicated
	    # action hooks: [action,type,routine,flags]
	    if ($j->[0] eq '_default') {
		$act=\%defaulthooks;
	    } elsif ($j->[0] eq '_early') {
		$act=\%earlyhooks;
	    } elsif (!exists($actions{$j->[0]})) {
		print STDERR "WARNING: Attempt to bind to unknown action '$j->[0]'.\n"; next;
	    } else {
		$act=$actions{$j->[0]}[4];
	    }
	    if (!exists($act->{$j->[1]})) {
		$act->{$j->[1]}=$j->[2];
	    } else {
		my $fncl=$act->{$j->[1]}; my $fnce=$j->[2];
		if ($j->[3]) { $i=$fncl; $fncl=$fnce; $fnce=$i; } # late hooking
		$act->{$j->[1]}=sub { my $i; if (($i=$fnce->(@_))) { return $i; } return $fncl->(@_); };
	    }
	}
    }

    # ...finally add cosmetic spacers
    if (@{$temp[2]}) { unshift @{$temp[2]},'---'; }

    @temp=(['~File',
               ['~New',\&ClearDocument,'Control-n'],
	       ['~Open...',sub { Open(); },'Control-o'],
               ['~Save',sub { DumpDataFile($savename); },'Control-s'],
               ['Save ~As...',sub { DumpDataFile(); },'Control-S'],
               '---',
	       ['Export Sequences...',sub { Export(undef); },'Control-w'],
               ['Export ~PostScript...',sub { PrintPS(); },'Control-e'],
               ['Export ~PNG...',sub { PrintPNG(); }],
               '---',
	       ['Configure Aline Defaults...',sub { ConfigDialog(); },undef],
	       @{$temp[5]},
               '---',
               ['~Quit',\&_Shutdown,'Control-q'],
	   ],
           ['~Edit',
               ($cfg{allow_undos}?['~Undo',sub { UndumpData(); },'Control-z',\$ui{undoitem}]:undef),
	       ['Aggressive Editing',sub {},undef,\$ui{agrbutton},[\$par{agr}]],
	       ['Editing Copies Attributes',sub {},undef,undef,[\$cfg{inscopyattr}]],
   	       @{$temp[4]},
           ],
           ['~Colouring',
  	       @{$temp[1]},
               ['~Edit Colour Scheme...',\&CalColours,undef],
	       ['~Predefined Colour Schemes',undef,@{$temp[0]}],
               ['~Load Colour Scheme...',sub { ReadColour(); }],
               ['~Save Colour Scheme...',sub { SaveColour(); }],
           ],
	   ['~Tools',
	       ['Grid',sub {$cfg{grid}?Grid():_GridOff();},undef,undef,[\$cfg{grid}]],
	       ['Title on All Lines',sub {_UpdateParameters();PrintSeq();},undef,\$ui{allbutton},[\$par{all}]],
               ['%Numbering',
		   ['Numbers at End of Line',sub { _UpdateParameters(); _InvalidateDom(3,1) if !$par{num};
						   PrintSeq(); },undef,\$ui{numbutton},[\$par{num},$cfg{numcolsize}]],
		   ['Edit Sequence Offsets',\&SetNumberOffsets],
	       ],
	       @{$temp[2]},
           ],
	   @{$temp[3]},
           ($cfg{scripts}?['~Scripts',
	       ['Run Script...',sub { my $i=_ExecScript(0); if ($i) { print STDERR "ERROR: $i\n"; } }],
               _getLocalScripts(),
           ]:()),
	   ($cfg{debug}?['~Debug',
	       ['Refresh Plugins',\&_LoadPlugins],
	   ]:()),
           ['~Help',
	       ['~About',sub {$about->Show;}],
	       ['~Demo',\&Demo],
	       ['~Documentation',\&Documentation],
           ]);

    _FlattenMenu(\@temp);
    _BuildMenu($mw,$menubar,@temp);
    _UpdateUndoMenu();

    if ($cfg{statusbar}) {
	$statusbar[0]=$mw->Frame(-relief=>'sunken',-bd=>2,-bg=>$cfg{wcs}[2])->pack(-side=>'bottom',-fill=>'x');
	$statusbar[1]=$statusbar[0]->Label(-text=>" $prog{name} $prog{version}",-bg=>$cfg{wcs}[2])->
	                             pack(-side=>'top',-anchor=>'w');
    }

    # Tooltip handler ----------------------------------------------------------------------
    if ($cfg{tooltips}) {
	$tooltips{ob}=$mw->Balloon(-initwait=>$cfg{tooltips},-state=>'balloon',-balloonposition=>'mouse');
    } else {
	$cfg{mbflags}^=$cfg{mbflags}&4;
    }

    # Sidebar ------------------------------------------------------------------------------

    $info=$mw->Scrolled('Pane',-scrollbars=>'oe',-sticky=>'n',-bg=>$cfg{wcs}[0])->pack(-side=>'left',-fill=>'y');

    # Logo
    $info->Frame(-height=>10)->pack(-side=>'top',-fill=>'y');
    my $logo=$info->Frame(qw/-borderwidth 2 -relief raised/)->pack(qw/-fill x/);
    my $image=$logo->Photo(-data=>$logobm,-format=>'gif');
    $logo->Button(-command=>sub{$about->Show},-width=>150,-relief=>'flat',-image=>$image)->pack(qw/-side top/);

    # Mode choice
    $info->Frame(-height=>10)->pack(-side=>'top');
    my $modeframe = $info->Frame(-width=>150,-relief=>'raised',-borderwidth=>2)->pack(qw/-fill x -side top/);
    $modeframe->Label(-text=>'Actions:',-anchor=>'w',-bg=>$cfg{wcs}[2])->pack(qw/-fill x/);
    $modeframe=$modeframe->Frame()->pack(-expand=>1,-fill=>'both');
    my $nullimg=$modeframe->Photo(-data=>'R0lGODlhAQABAIAAAP///////yH5BAEKAAEALAAAAAABAAEAAAICRAEAOw==',
				  -format=>'gif');
    my @drawbutton; my @drawstate; my @drawmenu; my @first=(1,1,1);

    my %acbuttlist=(); my @acbuttindex=(); $ui{actionb}={};
    # acbuttlist = buttontag => [priority,[actions],current_action,currenttitle];
    # action is [actionname,priority,icon,title]
    foreach $i (keys %actions) {
	next if !defined($actions{$i}[1]);
	if (ref($actions{$i}[1])) { ($p,$j)=@{$actions{$i}[1]}; } else { $j=$i; $p=$actions{$i}[1]; }
	$acbuttlist{$j}||=[$p,[],0,undef];
	push @{$acbuttlist{$j}[1]},[$i,$p,$modeframe->Photo(-data=>$actions{$i}[7]||$dummy_image,-format=>'gif'),
				    $actions{$i}[0].(defined($actions{$i}[2])?' ('.__bindkey2pr($actions{$i}[2]).
						     ')':'')];
	if ($p<$acbuttlist{$j}[0]) { $acbuttlist{$j}[0]=$p; } $acbuttlist{$j}[3]||=$acbuttlist{$j}[1][-1][3];
    }
    $p=0; @acbuttindex=sort { $acbuttlist{$a}[0]<=>$acbuttlist{$b}[0] } keys %acbuttlist;
    foreach $i (@acbuttindex) {
	my $ent=$p+4;
	@{$acbuttlist{$i}[1]}=sort { $a->[1]<=>$b->[1] } @{$acbuttlist{$i}[1]};
	$j=$modeframe->Frame()->grid(-column=>($p%3),-row=>int($p/3),-sticky=>'nsew');
	$k=$acbuttlist{$i}[1][0]; $act=(@{$acbuttlist{$i}[1]}<=1)?50:40;
	$ui{actionb}{$k->[0]}=sub {
	    my $aname=$acbuttlist{$acbuttindex[$ent-4]}[1][$acbuttlist{$acbuttindex[$ent-4]}[2]][0];
	    return if defined($actions{$aname}[6]) && ($actions{$aname}[6]->());
	    _choosebutton(\@drawbutton,$ent); setaction($aname);
	};
	$drawbutton[$ent]=$j->Button(-compound=>'top',-width=>$act,-relief=>$cfg{mbstate},
				     (defined($cfg{mbheight})?(-height=>$cfg{mbheight}):()),
				     (($cfg{mbflags}&2)?(-text=>$actions{$k->[0]}[0]):()),
				     -image=>(($cfg{mbflags}&1)?$k->[2]:$nullimg),
				     (defined($cfg{mblabelfont})?(-font=>$cfg{mblabelfont}):()),
				     -command=>$ui{actionb}{$k->[0]})->pack(-side=>'left',-expand=>1,-fill=>'both');
	if ($cfg{mbflags}&4) { $tooltips{ob}->attach($drawbutton[$ent],-msg=>\$acbuttlist{$i}[3]); }
	if (@{$acbuttlist{$i}[1]}>1) {
	    $drawmenu[$ent]=$j->Menubutton(-text=>'Actions',-relief=>$cfg{mbstate},-width=>10,
					   (defined($cfg{mbheight})?(-height=>$cfg{mbheight}):()),
					   -image=>$j->Photo(-data=>'R0lGODlhCgAGAIABAAAAAP///yH5BAEKA'.
					   'AEALAAAAAAKAAYAAAIMhI+BGboNXRmRjALADs=',-format=>'gif'))->
					   pack(-side=>'left',-expand=>1,-fill=>'y');
	    foreach $act (0..$#{$acbuttlist{$i}[1]}) {
		my $kp=$acbuttlist{$i}[1][$act];
		$ui{actionb}{$kp->[0]}=sub {
		    return if defined($actions{$kp->[0]}[6]) && ($actions{$kp->[0]}[6]->());
		    setaction($kp->[0]); $acbuttlist{$i}[2]=$act; $acbuttlist{$i}[3]=$kp->[3];
		    $drawbutton[$ent]->configure(-relief=>'sunken',-image=>(($cfg{mbflags}&1)?$kp->[2]:$nullimg),
						 (($cfg{mbflags}&2)?(-text=>$actions{$kp->[0]}[0]):()));
		    _choosebutton(\@drawbutton,$ent);
		};
		$drawmenu[$ent]->command(-image=>$kp->[2],-label=>$kp->[0],-accelerator=>$actions{$kp->[0]}[0],
					 -command=>$ui{actionb}{$kp->[0]});
	    }
	}
	$p++;
    }

    # keyboard bindings for actions...
    foreach $i (keys %actions) { if (defined($actions{$i}[2])) {
	my $ca=$i; $mw->bind('<'.$actions{$i}[2].'>',sub { invokeaction($ca); });
    }}

    # Drawable objects
    $info->Frame(-height=>10)->pack(-side=>'top');
    my $drawframe=$info->Frame(-width=>150,-relief=>'raised',-borderwidth=>2)->pack(qw/-fill x -side top/);
    $drawframe->Label(-text=>'Draw:',-anchor=>'w',-bg=>$cfg{wcs}[2])->pack(qw/-fill x/);
    my $textframe=$drawframe->Frame(-width=>150,-relief=>'groove')->pack(qw/-fill x -side bottom/);
    $ui{yframe}=$textframe;

    # Create buttons first - bind commands later
    $drawbutton[3]=$textframe->Button(-text=>'Text:',-relief=>$cfg{mbstate})->pack(-side=>'left');
    my $textbox = $textframe->Entry(-textvariable=>\$object_text,-bg=>$cfg{wcs}[0])->pack(-side=>'left',-fill=>'x');
    foreach my $i (0..2) {
        my $dbf = $drawframe->Frame()->pack(qw/-side left/);
        $drawbutton[$i] = $dbf->Button(-compound=>'top',-width=>40,-relief=>$cfg{mbstate},
				       (defined($cfg{mbheight})?(-height=>$cfg{mbheight}):()),
				       (defined($cfg{mblabelfont})?(-font=>$cfg{mblabelfont}):()))->
	                        pack(qw/-side left -fill y -expand 1/);
        $drawmenu[$i] = $dbf->Menubutton(-text=>'Objects',-relief=>$cfg{mbstate},-width=>10,
					 (defined($cfg{mbheight})?(-height=>$cfg{mbheight}):()),
					 -image=>$drawframe->Photo(-data=>'R0lGODlhCgAGAIABAAAAAP///yH5BAEKA'.
					 'AEALAAAAAAKAAYAAAIMhI+BGboNXRmRjALADs=',-format=>'gif'))->
       			      pack(qw/-anchor s -side right -fill y/);
        my %image;
        foreach my $b (sort { $objectdata{$a}[1]<=>$objectdata{$b}[1] } keys %objectdata) {
            if ($objectdata{$b}[0]==$i) {
                $image{$b} = $drawframe->Photo(-data => $objectdata{$b}[5]||$dummy_image,-format => 'gif');
                if ($first[$i]) {
                    $drawbutton[$i]->configure((($cfg{mbflags}&2)?(-text=>$objectdata{$b}[4]||$b):()),
					       -image=>(($cfg{mbflags}&1)?$image{$b}:$nullimg));
		    $first[$i]=0; $drawstate[$i]=$b;
		    if ($cfg{mbflags}&4) { $tooltips{ob}->attach($drawbutton[$i],-msg=>$objectdata{$b}[4]||$b); }
                }
		$ui{actionb}{'draw;'.$b}=sub {
		    if ($cfg{mbflags}&4) {
			$tooltips{ob}->detach($drawbutton[$i]);
			$tooltips{ob}->attach($drawbutton[$i],-msg=>$objectdata{$b}[4]||$b);
		    }
                    $ob_ty=$b; setaction('draw'); _choosebutton(\@drawbutton,$i);
		    $drawbutton[$i]->configure((($cfg{mbflags}&2)?(-text=>$objectdata{$b}[4]||$b):()),
					       -image=>(($cfg{mbflags}&1)?$image{$b}:$nullimg),-relief=>'sunken');
		    $drawstate[$i]=$b;
		};
                $drawmenu[$i]->command(-image=>$image{$b},-label=>$b,-accelerator=>$objectdata{$b}[4]||$b,
                                       -command=>$ui{actionb}{'draw;'.$b});
	    }
	}
    }
    foreach my $i (0 .. 2) {
        $drawbutton[$i]->configure(-command => sub {
            setaction('draw'); $ob_ty=$drawstate[$i]; _choosebutton(\@drawbutton,$i);
        });
    }
    $ui{actionb}{'draw;Text'}=sub {
        setaction('draw'); $ob_ty='Text'; _choosebutton(\@drawbutton,3); $textbox->focus();
    };
    $drawbutton[3]->configure(-command=>$ui{actionb}{'draw;Text'});
    $ui{actionb}{draw}=sub { if (exists($ui{actionb}{'draw;'.$ob_ty})) { $ui{actionb}{'draw;'.$ob_ty}->(); } };
    _disallowediting($textbox);
    $textbox->Tk::bind('<Return>',sub {
        setaction('draw'); $ob_ty='Text'; _choosebutton(\@drawbutton,3);
    });

    # Set the current state
    invokeaction($action);

    # Object attributes
    $info->Frame(-height=>10)->pack();
    my $attrframe = $info->Frame(-width=>150,-relief=>'raised',-borderwidth=>2)->pack(qw/-fill x/);
    $attrframe->Label(-text=>'Attributes:',-anchor=>'w',-bg=>$cfg{wcs}[2])->pack(qw/-fill x/);
    my $attrcframe=$attrframe->Frame(-bg=>$cfg{wcs}[1])->pack(qw/-fill both/);

    $attrcframe->Label(-text=>'Colours:',-anchor=>'w')->grid(-column=>0,-row=>0,-sticky=>'w');
    my $colourwidget = $attrcframe->Frame(-bg=>$cfg{wcs}[1])->grid(-column=>1,-row=>0,-sticky=>'ew');
    $colourwidget->Button(-height=>30,-image=>$drawframe->Photo(-data=>'R0lGODlhDgAqAKECAAAAAFld///'.
			  '//////yH5BAEAAAEALAAAAAAOACoAAAI5jI+py+0PAwBwUmenyjlpaW1HKBrXcmJR2rCMi65'.
			  'yNT9wadcqzef9DnqNSIgPZ8P5oIjLX+QJfRYAADs=',-format=>'gif'),,-command=>sub {
	my $i=$cfg{lc}; _ccbutton('lc',$cfg{fc}); _ccbutton('fc',$i);
    })->pack(-side=>'left',-anchor=>'e');
    $colourwidget = $colourwidget->Frame()->pack(-side=>'left',-expand=>1,-anchor=>'w');
    $ui{colblc}=$colourwidget->Button(-text=>'Line colour',-bg=>$cfg{lc},-activebackground=>'white',-command=>sub {
        _ccbutton('lc',$mw->chooseColor(-initialcolor=>$cfg{lc},-title=>"Change line colour")||$cfg{lc});
    })->grid($colourwidget->Button(-height=>20,-image=>$drawframe->Photo(-data=>'R0lGODlhCgAUAIABAAAAAP///yH'.
				   '5BAEAAAEALAAAAAAKABQAAAIejI8IebDpHIzU0CdDteppxoEf6EHiyJSKqK4ke8YFADs=',
				   -format=>'gif'),-command=>sub {
	_ccbutton('lc',$cfg{fc});
    }),($cfg{colorstack}?($ui{colmlc}=$colourwidget->Menubutton(-height=>20,-image=>$drawframe->Photo(-data=>'R0lGOD'.
				'lhCgAGAIABAAAAAP///yH5BAEKAAEALAAAAAAKAAYAAAIMhI+BGboNXRmRjALADs=',-format=>'gif'),
							-text=>'LC History',-relief=>'raised')):()),-sticky=>'ew');
    $ui{colbfc}=$colourwidget->Button(-text=>'Fill colour',-bg=>$cfg{fc},-activebackground=>'white',-command=>sub {
        _ccbutton('fc',$mw->chooseColor(-initialcolor=>$cfg{fc},-title=>"Change fill colour")||$cfg{fc});
    })->grid($colourwidget->Button(-height=>20,-image=>$drawframe->Photo(-data=>'R0lGODlhCgAUAIABAAAAAP///yH'.
				   '5BAEAAAEALAAAAAAKABQAAAIfjI+AG8rnXpQPVjNX1rfdDEROGFpk2SjnCZEVSnVIAQA7',
				   -format=>'gif'),-command=>sub {
	_ccbutton('fc',$cfg{lc});
    }),($cfg{colorstack}?($ui{colmfc}=$colourwidget->Menubutton(-height=>20,-image=>$drawframe->Photo(-data=>'R0lGOD'.
				'lhCgAGAIABAAAAAP///yH5BAEKAAEALAAAAAAKAAYAAAIMhI+BGboNXRmRjALADs=',-format=>'gif'),
							-text=>'FC History',-relief=>'raised')):()),-sticky=>'ew');
    if ($cfg{colorstack}) {
	foreach $i (@{$cfg{fcstack}}) { $i=colourR2N(colourN2R($i)); }
	foreach $i (@{$cfg{lcstack}}) { $i=colourR2N(colourN2R($i)); }
	$ui{colmfc}=[$ui{colmfc},$ui{colmfc}->Menu(-tearoff=>0)]; $ui{colmfc}[0]->configure(-menu=>$ui{colmfc}[1]);
	$ui{colmlc}=[$ui{colmlc},$ui{colmlc}->Menu(-tearoff=>0)]; $ui{colmlc}[0]->configure(-menu=>$ui{colmlc}[1]);
	if ((!defined($cfg{fcstack})) || (!@{$cfg{fcstack}})) { $ui{colmfc}[0]->configure(-state=>'disabled'); }
	else                                                  { _setupcolourhistory('fc'); }
	if ((!defined($cfg{lcstack})) || (!@{$cfg{lcstack}})) { $ui{colmlc}[0]->configure(-state=>'disabled'); }
	else                                                  { _setupcolourhistory('lc'); }
    }
    _ccbutton('lc',$cfg{lc}); _ccbutton('fc',$cfg{fc});

    $attrcframe->Label(-text=>'Line width:',-anchor=>'w')->grid(-column=>0,-row=>1,-sticky=>'w');
    $ui{spinbox}=$attrcframe->Spinbox(-textvariable=>\$cfg{lw},-from=>1,-to=>12,-increment=>1,-width=>5,
				     -bg=>$cfg{wcs}[0],-validate=>'all')->grid(-column=>1,-row=>1,-sticky=>'w');
    $ui{spinbox}->bind('<Return>',sub { _Defocus(); });
    _disallowediting($ui{spinbox});
    $ui{spinbox}->configure(-validatecommand=>sub {
        return 0 if $_[0]=~/[^0-9]/;
	if ((!$_[0]) && (!defined($_[1]))) { $cfg{lw}=1; }
	$ui{spinbox}->configure(-validate=>'all'); return 1;
    });

    $attrcframe->Label(-text=>'Font:',-anchor=>'w')->grid(-column=>0,-row=>2,-sticky=>'w');
    $ui{fontbtn}=$attrcframe->Button(-text=>'',-command=>sub {_FontPicker($mw,$cfg{fo},$ui{fontbtn});},
				     -width=>1,-padx=>'70')->grid(-column=>1,-row=>2,-sticky=>'ew');
    _FontPickButton($cfg{fo},$ui{fontbtn});

    # Scale bars
    $info->Frame(-height=>10)->pack();
    my $sframe = $info->Frame(qw/-borderwidth 2 -relief raised/)->pack(qw/-side top -expand 1 -fill both/);
    $sframe->Label(-text=>"Adjust:",-anchor=>'w',-bg=>$cfg{wcs}[2])->pack(qw/-fill x/);
    $ui{cshscale}=_mySlider($sframe,'Horizontal spacing',8,32,12,'csh',2);
    $ui{csvscale}=_mySlider($sframe,'Vertical spacing',8,32,12,'csv',2);
    $ui{fsiscale}=_mySlider($sframe,'Font scale',10,400,$par{fsi}*100,'fsi',5);
    $ui{nchscale}=_mySlider($sframe,'Width in characters',10,100,40,'nch',0);
    $ui{ttlscale}=_mySlider($sframe,'Title width',0,20,$par{lin},'lin',0);

    # Canvas
    my @ar=('-border',2,'-relief','sunken','-bg',$cfg{canvascol});
    if ($cfg{scrollable}) { $canvas=$mw->Scrolled('Canvas',-scrollbars=>'osoe',@ar); }
    else                  { $canvas=$mw->Canvas(@ar); }
    $canvas->pack(-expand=>1,-fill=>'both',-side=>'right');
    if ($cfg{scrollable}) {
	$canvasbars[0]=$canvas->Subwidget('xscrollbar');
	$canvasbars[1]=$canvas->Subwidget('yscrollbar');
	$canvas=$canvas->Subwidget('canvas');
    }
    if ($cfg{tooltips}) { _attachcanvastooltips(); }

    $canvas->Tk::bind('<1>'               => sub { _ButtonClick($_[0],0,0); });
    $canvas->Tk::bind('<Shift-1>'         => sub { _ButtonClick($_[0],1,0); });
    $canvas->Tk::bind('<ButtonRelease-1>' => sub { _ButtonClick($_[0],0,3); });
    $canvas->Tk::bind('<Control-1>'       => sub { _ButtonClick($_[0],2,($cfg{cmbind}&2)?5:0); });
    $canvas->Tk::bind('<2>'               => sub { _ButtonClick($_[0],0,($cfg{cmbind}&1)?5:1); });
    $canvas->Tk::bind('<3>'               => sub { _ButtonClick($_[0],0,($cfg{cmbind}&4)?5:2); });
    $canvas->Tk::bind('<B1-Motion>'       => \&ButtonMotion);
    $mw->bind('<KeyPress>' => sub {
	return if $noedit; _CursorMove($Tk::event->K,$Tk::event->s||'',$Tk::event->A);
    });
}

sub Demo()
{   UndumpDataFile("$cfg{exampledir}/rada.aline"); }

sub Documentation()
{
    print STDERR "Documentation would be cool.\n";
}

sub _PrintSplash()
{   my @lines=(
        "$prog{name} version $prog{version}",
	'Copyright (c) 2002-2007 Charlie Bond',
	'Copyright (c) 2005-2007 Alex Schuettelkopf',
        'University of Dundee',
        'http://stein.bioch.dundee.ac.uk/~charlie/scripts/aline',
    );
    my ($l,$i);
    $l=0; foreach $i (map { length } @lines) { if ($l<$i) { $l=$i; } } $i='#' x ($l+10);
    print STDERR "$i\n".join('',map { sprintf("###  %-*s  ###\n",$l,$_) } @lines)."$i\n\n";
}

sub GoTooltip()
{   return if !@seq;
    my $tk=shift; my ($ev,$x,$y,$class,$ax,$ay,$i,$rv,$ss);
    return 0 if !defined($ev=$tk->XEvent);
    $x=$tk->canvasx($ev->x); $y=$tk->canvasy($ev->y); $rv=$ev->s||'';
    ($class,$ax,$ay)=_XYtoInfo($x,$y,0);
    $ev='P'.('O','N','T','')[$class];
    if (defined($i=action_can($ev))) {	
	$ss=($rv=~/Shift-/?1:0)+($rv=~/Control-/?2:0)+($rv=~/Meta-/?4:0)+($rv=~/Alt-/?8:0);
	if (!($rv=$i->($ax,$ay % @seq,$x,$y,$ss,$class,0))) { return 0; }
	$tooltips{msg}=$rv; $tooltips{x}=$x; $tooltips{y}=$y; return 1;
    }
    return 0;
}

sub CloseTooltips() # there must be an easier way for this...
{   return if !$cfg{tooltips}; $tooltips{ob}->detach($canvas); _attachcanvastooltips(); }

sub _attachcanvastooltips()
{
    $tooltips{ob}->attach($canvas,-msg=>\$tooltips{msg},-postcommand=>\&GoTooltip,
			  -cancelcommand=>sub { $tooltips{x}=-1; $tooltips{y}=-1; 1; },
			  -motioncommand=>sub {
	my $tk=shift; my $ev=$tk->XEvent;
	return 0 if ($tooltips{x}<0) || ($tooltips{y}<0);
	return 1 if ($tk->canvasx($ev->x)!=$tooltips{x});
	return 1 if ($tk->canvasy($ev->y)!=$tooltips{y});
	return 0;
    });
}

sub Status($;$)
{   return if (!$cfg{statusbar});
    push @{$statusbar[2]},$_[0]; return if $_[0] eq $statusbar[3];
    $statusbar[1]->configure(-text=>' '.$_[0]); $statusbar[3]=$_[0];
    $statusbar[0]->update unless $_[1];
}

sub DeStatus(;$$)
{   return if (!$cfg{statusbar}); return if !@{$statusbar[2]};
    pop @{$statusbar[2]}; my $s=$_[0]?$_[0]:(@{$statusbar[2]}?$statusbar[2][-1]:'');
    return if $s eq $statusbar[3]; $statusbar[3]=$s;
    $statusbar[1]->configure(-text=>' '.$s); $statusbar[0]->update unless $_[1];
}

sub StatusNow($;$)
{   return if !$cfg{statusbar}; my $x=$_[0];
    if (!defined($x)) { if (@{$statusbar[2]}) { $x=$statusbar[2][-1]; } else { $x=''; } }
    return if $x eq $statusbar[3]; $statusbar[3]=$x;
    $statusbar[1]->configure(-text=>' '.$x); $statusbar[0]->update unless $_[1];
}

sub InitMainWindow()
{   $mw=MainWindow->new;
    $mw->option(add => '*background', $cfg{wcs}[1]);
    $mw->option(add => '*activeBackground', $cfg{wcs}[2]);
    $mw->option(add => '*troughColor', $cfg{wcs}[0]);
}

sub __deepcopy($$)
{   my ($src,$dst)=@_; my ($i);
    if (ref($src) eq '')          { $$dst=$src; }
    elsif (ref($src) eq 'SCALAR') { $$dst=$$src; }
    elsif (ref($src) eq 'ARRAY')  { $$dst=[]; for ($i=0;$i<@$src;$i++) { __deepcopy($src->[$i],\$$dst->[$i]); } }
    elsif (ref($src) eq 'HASH')   { $$dst={}; foreach $i (keys %$src) { __deepcopy($src->{$i},\$$dst->{$i}); } }
}

sub PullInConfigFiles()
{   my ($ch,$loc);
    foreach $loc (@{$cfg{cfgfiles}}) {
	if (!$cfglocseen{$loc}) { _ConfigPullin($loc); $ch=1; $cfglocseen{$loc}=1; }
    }
    return $ch;
}

sub __FillConfigPC($)
{   my $x=shift;
    if ($$x=~/^CFG:([a-z0-9]+)$/i)                { $$x=$cfg{$1}; }
    elsif ($$x=~/^CFG:([a-z0-9]+)\[([0-9]+)\]$/i) { $$x=$cfg{$1}[$2]; }
}

sub ResetParameters()
{   my ($i); %par=%defaultpar; foreach $i (values %par) { __FillConfigPC(\$i); } }

sub ConfigFixup($$)
{   my ($c,$t)=@_; local $_;
    foreach (keys %$t) { __deepcopy($t->{$_}[0],\$c->{$_}); }
    _ConfigFixup($c);
}

sub _ConfigFixup($)
{   local $_; my $i; my ($cfg)=@_;
    foreach (values %$cfg) {
	if (!ref($_))              { __configFixup($_); }
	elsif (ref($_) eq 'ARRAY') { foreach $i (@$_) { __configFixup($i); } }
	elsif (ref($_) eq 'HASH')  { _ConfigFixup($_); }
	elsif ($cfg{debug})        { print STDERR "WARNING: Unsupported configuration variable type.\n"; } }
}

sub __configFixup($)
{   return if !defined($_[0]); $_[0]=~s/%%SELF/$self/g; $_[0]=~s/%%HOME/$home/g; }

sub _ConfigPullin($)
{   return if ! -e $_[0];
    my ($i,%tmpc,$m); local $_;

    $i="Configuration file '$_[0]' is unreadable."; open MOOC,'<'.$_[0] or goto qerrorcfg;
    { local $/=undef; $_='%tmpc=('.<MOOC>.');'; } close MOOC;
    eval $_; if ($@) { $i=$@; $i=~s/at \(eval[^)]+\)/in '$_[0]'/; chomp $i; goto qerrorcfg; }
    foreach (keys %tmpc) {
	$m=0; if (s/_merge//) { $m=1; }
	if (!exists($cfg{$_})) { $tempbadcfg{$_}=$_[0]; }
	$cfgtemplate{$_}[0]=$tmpc{$_};
    }
    return;
qerrorcfg:
    print STDERR "WARNING: $i\n"; return;
}

sub _ConfigPluginMerge()
{   my ($i,$p); my %cfn=(); my %cfnt=();
    foreach $p (@plugins) {
	foreach $i ($p->regbindings(10)) {
	    $cfn{$i->[0]}=$i->[1];
	    $cfnt{$i->[0]}=[@$i]; shift @{$cfnt{$i->[0]}};
	    if ($tempbadcfg{$i->[0]}) {
		__deepcopy($cfgtemplate{$i->[0]}[0],\$cfnt{$i->[0]}[0]);
		delete $cfgtemplate{$i->[0]};
		delete $tempbadcfg{$i->[0]};
	    } else {
		__deepcopy($i->[1],\$cfnt{$i->[0]}[0]);
	    }
	}
    }
    _ConfigFixup(\%cfn);
    foreach $i (keys %cfn) { if (!exists($cfg{$i})) { $cfg{$i}=$cfn{$i}; } }
    foreach $i (keys %cfnt) { if (!exists($cfgtemplate{$i})) { $cfgtemplate{$i}=$cfnt{$i}; } }
    foreach $i (keys %tempbadcfg) {
	print STDERR "WARNING: Invalid configuration keyword '$i' in '$tempbadcfg{$i}'.\n";
    }
}

sub AttachRow($$;$)
{   my ($row,$target,$doit)=@_; return if $cfg{noattach};
    if ($doit||$cfg{autoattach}) { $seq[$_[0]]{t}{attach}=defined($_[1])?$_[1]:-1; }
}

sub _printableNum($;$)
{   my $a=int($_[0]); return $a if $a==$_[0];
    my $u=int(0.5+($_[0]-$a)*10000);
    if ($_[1]) { return "$a($u)"; }
    if ($u<=26) { return $a.chr($u+64); }
    return $a.':'.$u;
}

sub _pNum2Real($)
{   return undef if $_[0]!~/^\s*([-+]?[0-9]+)\s*(?:\(\s*([0-9]+)\s*\)\s*)?$/; return $1+0+0.0001*($2||0); }

sub __oboni($$)
{   my ($ss,$x)=@_; my ($i,$o,$n);
    foreach $i (@$ss) { foreach $o (@{$seq[$i]{o}}) { foreach $n (@{$o->{e}}) { return 1 if $n->{xpos}==$x; } } }
    return 0;
}

sub _EditModeStatus()
{   my ($s,$t,$u,$p);
    return if !$cfg{statusbar};
    return if !$cursor{on};
    return if (($cursor{ox}==$cursor{ax}) && ($cursor{oy}==$cursor{ay}));
    foreach $s (0..$#seq) {
	if ($seq[$s]{p}==$cursor{ay}) {
	    $t=$seq[$s]{t}{text};
	    if ($t=~s/^%%%//) {
		StatusNow($specialrows{$t}[0] || '',1);
	    } else {
		if ($cursor{oy}!=$cursor{ay}) { _FillSeqnum($s); }
		$u=$seq[$s]{e}[$cursor{ax}]{seqnumber};
		if (!defined($u)) { $u='-'; } else { $u=_printableNum($u); }
		StatusNow("$t: $u",1);
	    }
	    return;
	}
    }
    StatusNow('',1);
}

sub _CursorMove($$$)
{   my ($i,$ex);
    if ($cfg{tooltips}) { if ($_[0]!~/^(?:Shift|Control|Alt|Meta)_[LR]$/) { CloseTooltips(); } }
    $cursor{ox}=$cursor{ax}; $cursor{oy}=$cursor{ay};
    $ex=$_[1]; $ex=~s/Mod[0-9]\-//g; $ex=~s/Lock\-//g;
    if (defined($i=action_can('K'))) {
	if ($i->($_[0],$_[1],$_[2])) { return; }
	if ($i->($_[0],$ex,$_[2])) { return; }
    }
    return if !$cursor{on};
    if (exists($cursormovers{$_[1].$_[0]})) { $cursormovers{$_[1].$_[0]}->(); return; }
    if (exists($cursormovers{$ex.$_[0]}))   { $cursormovers{$ex.$_[0]}->(); return; }
}

sub PointCursor
{   return if $_[4];
    $cursor{ox}=$cursor{ax}; $cursor{oy}=$cursor{ay};
    ($cursor{ax},$cursor{ay})=@_; _refreshCursor();
    return 1;
}

sub SequenceEditor($$$)
{   my ($k,$sh,$a)=@_; my ($i,$s,$dud,$ao,$d,$qsto,$s0,$s1,$oldlen,$longstring,$prt);
    $d=0; $s=undef; $prt=0; foreach $i (0..$#seq) { if ($seq[$i]{p}==$cursor{ay}) { $s=$i; last; } }
    return 1 if !defined($s); if (!$cfg{editaux}) { return if $seq[$s]{t}{text}=~/^%%%/; }
    my %sd=%cursor; $sd{oy}=-1; $oldlen=@{$seq[0]{e}}; # For smart undo
    if (!defined($k)) {
	return 1 if !$a; PDumpData('Edit Sequence',0,1,0);
	$longstring=substr($a,1); $a=substr($a,0,1); goto entryxx;
    } else { $longstring=undef; }

    if ($sh.$k eq 'Right') { # OVERRIDING DEFAULT BEHAVIOUR!!!
	if ($cursor{ax}<$#{$seq[$s]{e}}) { $cursor{ax}++; _refreshCursor; return 1; }
        $qsto=0; foreach $d (@seq) { if ($d->{e}[-1]{text}!~/^[-._ ]/) { $qsto=1; last; } }
        return 1 if !$qsto;
	PSmartData('Extend Sequences',sub { _DeleteCells([[$sd{ax}+1,$s]],9); %cursor=%sd; return 1; });
	$cursor{ax}++; goto attachendline;
    }
    if (($sh.$k eq 'Insert') || ($sh.$k eq 'U0003')) {
	_CursorAlt(); $cfg{insmode}^=1; return 1;
    }
    if ($sh.$k eq 'BackSpace') {
	return 1 if !$cursor{ax};
	$qsto=_AttachmentForX($s);
	$d=[map { $seq[$_]{e}[$cursor{ax}-1]{text} } @$qsto];
	if (!$par{agr}) { return 1 if grep { !/^[-._ ]?$/ } @$d; }
	if (__oboni($qsto,$cursor{ax}-1)) { # hitting object glyph
	    PDumpData('Delete Cell',0,1,0);
	} else { # -------------------------- no objects - smart undo
	    PSmartData('Delete Cell',sub {
		%cursor=%sd; foreach my $yy (0..$#$d) { _InsertCells([[$sd{ax}-1,$qsto->[$yy],$d->[$yy]]],25); }
		_ExtTo($oldlen); return 1;
	    });
	}
	_DeleteCells([[$cursor{ax}-1,$s]],1); PrintSeq(); return 1;
    }
    if ($sh.$k eq 'Delete') {
	$qsto=_AttachmentForX($s);
	$d=[map { $seq[$_]{e}[$cursor{ax}]{text} } @$qsto];
	if (!$par{agr}) { return 1 if grep { !/^[-._ ]?$/ } @$d; }
	if (__oboni($qsto,$cursor{ax})) { PDumpData('Delete Cell',0,1,0); } else {
	    PSmartData('Delete Cell',sub {
		%cursor=%sd; foreach my $yy (0..$#$d) { _InsertCells([[$sd{ax},$qsto->[$yy],$d->[$yy]]],25); }
		_ExtTo($oldlen); return 1;
	    });
	}
	_DeleteCells([[$cursor{ax},$s]],9);
	if ($cursor{ax}>=@{$seq[$s]{e}}) { $cursor{ax}--; } PrintSeq(); return 1;
    }
    if ($a eq '_') {
	PSmartData('Insert Cell',sub {
	    %cursor=%sd; _DeleteCells([[$sd{ax},$s]],9); _ExtTo($oldlen); return 1;
	});
	_InsertCells([[$cursor{ax},$s]],9); PrintSeq(); return 1;
    }
    if ($sh.$k eq 'Return') {
	return 1 if _AggroCheck();
	my $sqq=''; my ($nw,$nf,$cc);
	($nw,$nf)=_QuickDialog($mw,'Enter Sequence',0,'OK',sub {
	    chomp $sqq; chomp $sqq;
	    if (length($sqq)) { SequenceEditor(undef,undef,$sqq); }
	    $nw->destroy;
	});
	_ComposeInpTable($nf,[['Sequence:','F',\$sqq,-cb=>\$cc]]); $cc->focus();
	return 1;
    }
    if ($k eq 'space') { $a=' '; }
    return 0 if ($sh!~/^(?:Shift-)?$/);
    if ((length($a)==1) && (ord($a)>31)) {
entryxx:$a=~tr/A-Za-z/a-zA-Z/;
	if ($a=~/^[-._ ]?$/) { $dud=0; $a=FillChar($seq[$s]); } else { $dud=1; }
	if ($cfg{insmode}) { # Insert
	    if ((!$dud) || ($par{agr})) {
		PSmartData('Insert Cell',sub {
		    %cursor=%sd; _DeleteCells([[$sd{ax},$s]],9); _ExtTo($oldlen); return 1;
		}) unless defined($longstring);
		_InsertCells([[$cursor{ax},$s,$a]],9);
		$cursor{ax}++; goto attachendline;
	    }
	} else { # Overwrite
	    $qsto=$seq[$s]{e}[$cursor{ax}]{text}; $ao=($qsto=~/^[-._ ]?$/); $d=($qsto eq $a);
	    if (($ao & !$dud) || $d) {
		if (!$d) {
		    PSmartData('Change Cell',sub {
			$seq[$s]{e}[$sd{ax}]{text}=$qsto; _Invalidate([[$s,$sd{ax}]]); %cursor=%sd;
			_TruncTo($oldlen); return 1;
		    }) unless defined($longstring);
		    _Invalidate([[$s,$cursor{ax}]]);
		    $seq[$s]{e}[$cursor{ax}]{text}=$a;
		}
		$cursor{ax}++; goto attachendline;
	    } elsif ($par{agr}) {
		$s0=@{$seq[0]{e}}; $s1=$seq[$s]{e}[$cursor{ax}]{seqnumber};
		PSmartData('Change Cell',sub {
		    $seq[$s]{e}[$sd{ax}]{text}=$qsto; $seq[$s]{e}[$sd{ax}]{seqnumber}=$s1;
		    _Invalidate([[$s,$sd{ax}]]); %cursor=%sd; _TruncTo($s0); return 1;
		}) unless defined($longstring);
		$seq[$s]{e}[$cursor{ax}]{text}=$a;
		if (!$dud)  { $seq[$s]{e}[$cursor{ax}]{seqnumber}=undef; }
		elsif ($ao) { $seq[$s]{e}[$cursor{ax}]{seqnumber}=_InsSeqNum($seq[$s],$cursor{ax}); }
		_Invalidate([[$s,$cursor{ax}]]);
		$cursor{ax}++; $cursor{oy}=-1; goto attachendline;
	    }
	}
	if ($longstring) { $a=substr($longstring,0,1); $longstring=substr($longstring,1); goto entryxx; }
	elsif (defined($longstring)) { goto attachendline; }
    }
    return 0;
attachendline:
    if ($cursor{ax}>=@{$seq[$s]{e}}) {
	my @cells=();
	foreach $s (0..$#seq) {
	    for ($i=@{$seq[$s]{e}};$i<=$cursor{ax};$i++) { push @cells,[$i,$s]; }
	}
	_InsertCells(\@cells,8); $prt=1;
    } elsif ($d) { _refreshCursor(); } else { $prt=1; }
    if ($longstring) { $a=substr($longstring,0,1); $longstring=substr($longstring,1); goto entryxx; }
    PrintSeq() if $prt;
    return 1;
}

sub _UpdateParameters()
{
    $par{_dpl}=(1-$par{all})*$par{lin};
    $par{_fnx}=$par{nch}-$par{all}*$par{lin};
    $par{_inx}=1.0/$par{_fnx};
}

sub _SetWorkColour($$)
{   return if !$_[1]; return if !exists($ui{'colb'.$_[0]}); _ccbutton($_[0],$_[1]); }

sub _ObTypeList(@)
{   my @list=(); my ($i,$j);
    foreach $i (@_) { foreach $j (keys %objectdata) { if ($objectdata{$j}[0]==$i) {
	push @list,[$objectdata{$j}[4] || $j,$j];
    }}}
    @list=sort { $a->[0] cmp $b->[0] } @list;
    return \@list;
}

sub NewObType($$;$)
{   $objectdata{$_[0]}=$_[1]; $objectdata{$_[0]}[1]=-1;
    if ($_[2]) {
	my $ne=-1; foreach my $i (values %objectdata) { if ($i->[1]>$ne) { $ne=$i->[1]; } }
    }
}

sub _Shutdown()
{   local $_;
    return if ShouldaSavedEh();
    foreach (@plugins) { $_->terminate(); }
    if (defined($tooltips{ob})) { $tooltips{ob}->destroy; }
    $mw->destroy;
}

sub action_is($)
{   return 1 if $_[0] eq $action;
    foreach my $i (@{$actions{$action}[3]}) { if ($_[0] eq $i) { return 1; } }
    return 0;
}

sub action_can($)
{   my ($mask,@x); $mask=0;
    if (exists($actions{$action}[4]{$_[0]})) { $mask|=2; $x[1]=$actions{$action}[4]{$_[0]}; }
    if (exists($earlyhooks{$_[0]}))          { $mask|=1; $x[0]=$earlyhooks{$_[0]}; }
    if (exists($defaulthooks{$_[0]}))        { $mask|=4; $x[2]=$defaulthooks{$_[0]}; }
    return undef if !$mask;
    return $x[0] if ($mask==1); return $x[1] if ($mask==2); return $x[2] if ($mask==4);
    return sub {
	my $i;
	if ($x[0]) { if (($i=$x[0]->(@_))) { return $i; } }
	if ($x[1]) { if (($i=$x[1]->(@_))) { return $i; } }
	if ($x[2]) { return $x[2]->(@_); } return 0;
    };
}

sub setaction($)
{
    if ($_[0]) { $action=shift; }
    _Defocus(); return if !$canvas;
    if ($actions{$action}[5]&1) { _CursorOn(); } else { _CursorOff(); }
}

sub invokeaction($)
{   my $b=shift;
    if ($b) { $action=$b; $action=~s/;.*//; } else { $b=$action; }
    if (exists($ui{actionb}{$b})) { $ui{actionb}{$b}->(); }
}

sub actionname()
{   return $actions{$action}[0]; }

sub _refreshCursor()
{   $canvas->delete(-tags=>'cursor');
    return if !@seq; return if !$cursor{on};
    my ($x,$y,$cid);
    ($x,$y)=AlxeltoPixel($cursor{ax},$cursor{ay});
    $cid=$cursor{alt}?$cfg{altcursor}:$cfg{cursor};
    $canvas->createRectangle($x,$y,$x+$par{csh},$y+$par{csv},
			     ($cid->[2]?(-stipple=>$cid->[2],-fill=>$cid->[0]):()),
			     -tags=>'cursor',-width=>$cid->[1],-outline=>$cid->[0]);
    _canvasSee($cursor{ax},$cursor{ay});
    _EditModeStatus();
}

sub _canvasSee($$)
{   my ($ax,$ay)=@_; my ($cid,$s0,$s1,$x,$y,$of0);
    return if !$cfg{scrollable};
    ($x,$y)=AlxeltoPixel($ax,$ay);
    #--------------- This is a really awkward way of scrolling the canvas...
    ($s0,$s1)=$canvasbars[0]->get(); $cid=$maxmax[2]*$par{csh};
    $of0=($x-$par{ofx}+14)*$maxmax[2];
    if (($of0-0.9*$cid)<$s0) {
	$s1-=$s0; $s0=$of0-0.9*$cid; if ($s0<0) { $s0=0; } $s1+=$s0;
	$canvasbars[0]->set($s0,$s1); $canvas->xviewMoveto($s0);
    } elsif (($of0+1.9*$cid)>$s1) {
	$s0-=$s1; $s1=$of0+1.9*$cid; if ($s1>1) { $s1=1; } $s0+=$s1;
	$canvasbars[0]->set($s0,$s1); $canvas->xviewMoveto($s0);
    }
    ($s0,$s1)=$canvasbars[1]->get(); $cid=$maxmax[3]*$par{csv};
    $of0=($y-$par{ofy}+14)*$maxmax[3];
    if (($of0-0.9*$cid)<$s0) {
	$s1-=$s0; $s0=$of0-0.9*$cid; if ($s0<0) { $s0=0; } $s1+=$s0;
	$canvasbars[1]->set($s0,$s1); $canvas->yviewMoveto($s0);
    } elsif (($of0+1.9*$cid)>$s1) {
	$s0-=$s1; $s1=$of0+1.9*$cid; if ($s1>1) { $s1=1; } $s0+=$s1;
	$canvasbars[1]->set($s0,$s1); $canvas->yviewMoveto($s0);
    }
}

sub _CanvasScrollV($)
{   return if !$cfg{scrollable};
    my ($s0,$s1)=$canvasbars[1]->get();
    if ($_[0] && ($s1<1)) {
	$s0-=$s1-1; $canvasbars[1]->set($s0,1); $canvas->yviewMoveto($s0); _refreshCursor();
    } elsif ((!$_[0]) && ($s0>0)) {
	$s1-=$s0; $canvasbars[1]->set(0,$s1); $canvas->yviewMoveto(0); _refreshCursor();
    }
}

sub _CursorOn(;$)
{   $cursor{on}=1; if (defined($_[0])) { $cursor{ax}=0; $cursor{ay}=0; }
    $cursor{oy}=-1; _refreshCursor();
}

sub _CursorOff()
{   $canvas->delete(-tags=>'cursor'); $cursor{on}=0; StatusNow(undef); }

sub _CursorAlt(;$)
{   if (!@_) { $cursor{alt}^=1; } else { $cursor{alt}=$_[0]?1:0; } _refreshCursor(); }


sub PrintSeq(;$)
{   my ($s,$n,$t,$o,$maxnum,%t,@numcou,$x1,$y1,$fcache,$l1,$l2,$lprv,$lnxt,$oldy,@cperf,
	@coord,$text,$chn,$od,$oe,$yt,$cop,$xe,$ye,$curglyph,$glyphs,$gtype,$tl,$xz,$yz,$gl1);

    return unless (@seq || $_[0]);
    $canvas->delete('transient','cursor');
    if (!@seq) { $canvas->delete('glyph'); %glyphcache=(); _GridOff; return; }

    $max_seq_length=$#{$seq[0]{e}}; $glyphs=0;
    $fcache=$fontlist{$cfg{n}[1]}[1].$cfg{n}[5].'-'.$cfg{n}[3].'-'.$cfg{n}[2].'-'.
	    $cfg{n}[4]*$par{fsi}.'-120-*-*-*-*-*-*';

    $x1=$par{lin}; $l1=0; $l2=$par{ofx}+$x1*$par{csh}; $chn=$par{csv}*@seq; @coord=();
    foreach $y1 (0..$max_seq_length) {
	push @coord,[$l2,$l1]; $x1++;
	if ($x1>=$par{nch}) { $l1++; $x1=$par{lin}*$par{all}; $l2=$par{ofx}+$x1*$par{csh} }
	else                { $l2+=$par{csh}; }
    }
    # l1=number of chunks

#------- titles
    $oldy=$par{all}*$coord[-1][1];
    foreach $s (@seq) {
	$s->{t}{tk}||=[]; $s->{ntk}||=[];
	if (@{$s->{t}{tk}}>$oldy) {
	    $y1=@{$s->{t}{tk}}-$oldy; while ($y1) { $canvas->delete(pop @{$s->{t}{tk}}); $y1--; }
	}
    }
    for ($y1=0,$l2=$par{ofy}+0.6*$par{csv};$y1<=$oldy;$y1++,$l2+=$chn) {
	foreach $s (0..$#seq) {
	    $t=$seq[$s]{t};
	    if (defined($t->{tk}[$y1])) {
		$canvas->coords($t->{tk}[$y1],$par{ofx},$l2+$par{csv}*$seq[$s]{p});
	    } else {
		$text=$t->{text}; if ($text=~s/^%%%//) { $text=$specialrows{$text}[0] || ''; }
		$t->{tk}[$y1]=$canvas->createText($par{ofx},$l2+$par{csv}*$seq[$s]{p},-fill=>$t->{titlefill},
						  -text=>$text,-anchor=>'w',-tags=>['title',$s],
						  -font=>$fontlist{$t->{titlefoundry}}[1].$t->{titleweight}.'-'.
				                         $t->{titleslant}.'--'.$t->{titlesize}*$par{fsi}.
				                         '-120-*-*-*-*-*-*');
	    }
	}
    }

    @cperf=(0,0,0,0,0);
    @numcou=();
    foreach $s (@seq) { push @numcou,[($s->{n}||0)-1,0,($s->{t}{text}!~/^%%%/),defined($s->{n}),0]; }
    foreach $s (0..$#seq) {

#------- sequence data
	$y1=$par{ofy}+$par{csv}*$seq[$s]{p};
	foreach $n (0..$max_seq_length) {
	    $t=$seq[$s]{e}[$n]; $x1=$coord[$n][0];
	    $xe=$x1+0.5*$par{csh}; $ye=$y1+0.6*$par{csv};
	    if (exists($t->{tk})) {
		if ($t->{tk}[1]) { $canvas->coords($t->{tk}[1],$x1,$y1,$x1+$par{csh},$y1+$par{csv}); }
		if (($xe!=$t->{tk}[2]) || ($ye!=$t->{tk}[3])) {
		    $canvas->coords($t->{tk}[0],$xe,$ye); $t->{tk}[2]=$xe; $t->{tk}[3]=$ye;
		}
	    } else {
		if ($t->{fontbg}) {
		    $od=$canvas->createRectangle($x1,$y1,$x1+$par{csh},$y1+$par{csv},
						 -tag=>['seq','cell',"$s.$n"],-outline=>$t->{fontbg},
						 -fill=>$t->{fontbg},-width=>0);
		} else { $od=undef; }
		$oe=$canvas->createText($xe,$ye,-fill=>$t->{fontfill},-text=>$t->{text},
					-anchor=>$t->{anchor},-tags=>['cell','text','seq',"$s.$n"],
					-font=>$fontlist{$t->{fontfoundry}}[1].$t->{fontweight}.'-'.
				               $t->{fontslant}.'-'.$t->{fontwidth}.'-'.
	                                       $t->{fontsize}*$par{fsi}.'-120-*-*-*-*-*-*');
		$t->{tk}=[$oe,$od,$xe,$ye];
	    }
	    if ($numcou[$s][3]) {
		if ($t->{text}!~/^[-._ ]$/) { $numcou[$s][0]++; $numcou[$s][1]=$numcou[$s][2]; }
	    } else {
		if (defined($t->{seqnumber})) { $numcou[$s][0]=$t->{seqnumber}; $numcou[$s][1]=$numcou[$s][2]; }
	    }
	    if (($n==$max_seq_length) || ($coord[$n][1]!=$coord[$n+1][1])) {
		if (($par{num}) && $numcou[$s][1]) {
		    $xe=$x1+($par{num}+1)*$par{csh};
		    if ($numcou[$s][4]<@{$seq[$s]{ntk}}) {
			$oe=$seq[$s]{ntk}[$numcou[$s][4]];
			if ($oe->[2]!=$numcou[$s][0]) {
			    $canvas->delete($oe->[3]); _InvalidateNums($s,$numcou[$s][4]);
			    goto makenewnum;
			}
			if (($oe->[0]!=$xe) || ($oe->[1]!=$ye)) {
			    $canvas->coords($oe->[3],$xe,$ye); $oe->[0]=$xe; $oe->[1]=$ye;
			}
		    } else {
makenewnum:	        $od=$canvas->createText($xe,$ye,-fill=>$cfg{n}[0],-text=>_printableNum($numcou[$s][0]),
						-anchor=>'e',-tags=>['text','num','seq'],-font=>$fcache);
                        push @{$seq[$s]{ntk}},[$xe,$ye,$numcou[$s][0],$od];
		    }
		    $numcou[$s][4]++;
		}
		$y1+=$chn;
	    }
	}

#------- objects
	$y1=$par{ofy}+$par{csv}*$seq[$s]{p};
	foreach $o (0 .. $#{$seq[$s]{o}}) {
	    $oe=$seq[$s]{o}[$o];
            if ($oe->{multi}) {
		$lprv=_IsObjectAtY($oe,$seq[$s]{p}-1);
		$lnxt=_IsObjectAtY($oe,$seq[$s]{p}+1);
	    } else {
		$lprv=undef; $lnxt=undef;
	    }
            $od=$oe->{e};
	    foreach $n (0..$#$od) {
		my $t=$od->[$n]; $cop=$coord[$t->{xpos}];
		$x1=$cop->[0]; $yt=$y1+$cop->[1]*$chn;

		if ($t->{type}=~/Text$/) {
		    $gtype=\&DrawText; $yt+=0.5*$par{csv};
		    if ($t->{anchor} ne 'w') { $x1+=(($t->{anchor} eq 'c')?0.5:1.0)*$par{csh}; }
		    $curglyph=[$t->{lc},$t->{otext},$t->{anchor},$t->{fontfoundry},$t->{fontweight},
			       $t->{fontslant},$t->{fontwidth},$t->{fontsize}*$par{fsi},'obj'.$s.'x'.$o];
                    if ($t->{type} eq 'OutlineText') { push @$curglyph,$t->{lw},$t->{fc}; }
		} elsif ($t->{type}=~/Graph$/) {
		    $l1=$t->{text}; $l2=$l1;
		    if ($n && (($od->[$n-1]{xpos}+1)==$t->{xpos})) { $l1=0.5*($l1+$od->[$n-1]{text}); }
		    if (($n<$#$od) && (($od->[$n+1]{xpos}-1)==$t->{xpos})) { $l2=0.5*($l2+$od->[$n+1]{text}); }
		    $gtype=$objectdata{$t->{type}}[3];
		    $curglyph=[$t->{fc},$t->{lc},$t->{lw},'obj'.$s.'x'.$o,$l1,$t->{text},$l2,$oe->{h},$oe->{cut}];
		} else {
		    $l1=0; # Track x start/stop
		    if (!$n || (($od->[$n-1]{xpos}+1)!=$t->{xpos}))         { $l1|=2; }
		    if (($n==$#$od) || (($od->[$n+1]{xpos}-1)!=$t->{xpos})) { $l1|=1; }
		    if (!defined(_IsObjectAtX($lprv,$t->{xpos})))           { $l1|=8; }
		    if (!defined(_IsObjectAtX($lnxt,$t->{xpos})))           { $l1|=4; }
		    $gtype=$objectdata{$t->{type}}[3];
		    $curglyph=[$t->{fc},$t->{lc},$t->{lw},'obj'.$s.'x'.$o,$l1];
	        }
		$l1=$gtype.$oe->{z}.'|'.join(chr(4),@{$curglyph}); $l2=$x1.'|'.$yt; $glyphs=1;
		if (!exists($glyphcache{$l1})) { #------------ no appropriate glyphs - must build
		    if (defined($gl1=$gtype->($x1,$yt,"zz$oe->{z}",@$curglyph))) { $glyphcache{$l1}={$l2=>[1,$gl1]}; }
		    if ($cfg{ocprint}) { $cperf[0]++; print STDERR "ocache: MI $l1 ($l2)\n"; $cperf[4]++; }
		} elsif (exists($glyphcache{$l1}{$l2})) { #---- exists - good
		    $glyphcache{$l1}{$l2}[0]=1;
		    $cperf[1]++;
		} else { #-------------------------------- does not exist, but may be able to move similar glyph
		    $gl1=$glyphcache{$l1};
		    foreach $tl (keys %$gl1) { if (!$gl1->{$tl}[0]) {
			($xz,$yz)=split(/\|/,$tl,2); $x1-=$xz; $yt-=$yz;
			$gl1->{$l2}=$gl1->{$tl}; delete $gl1->{$tl}; $gl1=$gl1->{$l2}; $gl1->[0]=1;
			foreach $tl (@{$gl1->[1]}) { $canvas->move($tl,$x1,$yt); }
			$cperf[2]++;
			goto sortedmove;
		    }}
		    if ($cfg{ocprint}) { $cperf[3]++; print STDERR "ocache: MD $l1 ($l2)\n"; $cperf[4]++; }
		    if (defined($gl1=$gtype->($x1,$yt,"zz$oe->{z}",@$curglyph))) { $glyphcache{$l1}{$l2}=[1,$gl1]; }
sortedmove:;    }
	    }
        }	
    }

#-------- object cache report
    if ($cfg{ocprint}) {
	if ($glyphs) {
	    foreach $s (keys %glyphcache) { foreach $o (keys %{$glyphcache{$s}}) { if (!$glyphcache{$s}{$o}[0]) {
		print STDERR "ocache: RM $s ($o)\n"; $cperf[4]++;
	    }}}
	}
	$s=$cperf[0]+$cperf[1]+$cperf[2]+$cperf[3];
	if ($s) {
	    $o=100/$s;
	    printf STDERR "ocache: %.3f %% hits, %.3f %% moves, %.3f %% misses, %.3f %% delayed misses, n".
		          "=%d, ndel=%d\n",$cperf[1]*$o,$cperf[2]*$o,$cperf[0]*$o,$cperf[3]*$o,$s,$cperf[4];
	}
    }

#-------- clean up unused numbers/glyphs and enforce z-order
    foreach $s (0..$#seq) { _InvalidateNums($s,$numcou[$s][4]); }
    if (!$glyphs) {
	_InvalidateGlyphs();
    } else {
	foreach $s (values %glyphcache) { foreach $o (keys %$s) {
	    if (!$s->{$o}[0]) { $canvas->delete(@{$s->{$o}[1]}); delete $s->{$o}; }
	    else              { $s->{$o}[0]=0; }
	}}
	for ($oe=_GetZList(),$o=0;$o<@$oe;$o++) { $canvas->raise('zz'.$oe->[$o]); }
    }

#-------- (almost) done
    $canvas->raise('text');

    (undef,undef,$maxmax[0],$maxmax[1])=$canvas->bbox('all');

    if ($cfg{grid}) { &Grid; }
    if ($cfg{scrollable}) {
	$maxmax[2]=1.0/($maxmax[0]+28-$par{ofx}); $maxmax[3]=1.0/($maxmax[1]+28-$par{ofy});
	$canvas->configure(-scrollregion=>[$par{ofx}-14,$par{ofy}-14,$maxmax[0]+14,$maxmax[1]+14]);
    }
    _refreshCursor();
}

sub _Invalidate($)
{   my $w=shift; my ($x,@e);
    return if !@$w; @e=();
    if (@{$w->[0]}==1) { # titles
	foreach $x (@$w) {
	    if (exists($seq[$x->[0]]{t}{tk})) {
		push @e,@{$seq[$x->[0]]{t}{tk}}; delete $seq[$x->[0]]{t}{tk};
	    }
	}
    } elsif (@{$w->[0]}==2) { # cells
	foreach $x (@$w) {
	    if (exists($seq[$x->[0]]{e}[$x->[1]]{tk})) {
		push @e,@{$seq[$x->[0]]{e}[$x->[1]]{tk}}[0..1];
		delete $seq[$x->[0]]{e}[$x->[1]]{tk};
	    }
	}
    } else { # object
	my ($z,$bb);
	foreach $x (@$w) {
	    if (!defined($x->[2])) {
		foreach $bb (@{$seq[$x->[0]]{o}[$x->[1]]{e}}) {
		    if (exists($bb->{tk})) { push @e,@{$bb->{tk}}[2..$#{$bb->{tk}}]; delete $bb->{tk}; }
		}
	    } else {
		$bb=$seq[$x->[0]]{o}[$x->[1]]{e}[$x->[2]];
		if (exists($bb->{tk})) { push @e,@{$bb->{tk}}[2..$#{$bb->{tk}}]; delete $bb->{tk}; }
	    }
	}
    }
    $canvas->delete(@e) if @e;
}

sub _InvalidatePtr($$)
{   return if !exists($_[0]{tk});
    if (!$_[1])      { $canvas->delete(@{$_[0]{tk}}); }
    elsif ($_[1]==1) { $canvas->delete(@{$_[0]{tk}}[0..1]); }
    else             { $canvas->delete(@{$_[0]{tk}}[2..$#{$_[0]{tk}}]); }
    delete $_[0]{tk};
}

sub _InvalidateDom($;$)
{
    $canvas->delete((('title','cell','glyph','num')[$_[0]]) || ());
    return if !$_[1];
    my ($i,$s,$o);
    if ($_[0]==0)    { foreach $s (@seq) { delete $s->{t}{tk}; } }
    elsif ($_[0]==1) { foreach $s (@seq) { foreach $i (@{$s->{e}}) { delete $i->{tk}; } } }
    elsif ($_[0]==2) { foreach $s (@seq) { foreach $o (@{$s->{o}}) { foreach $i (@{$o->{e}}) { delete $i->{tk}; } } } }
    else             { foreach $s (@seq) { delete $s->{ntk}; } }
}

sub _InvalidateAll(;$)
{   foreach my $i ((0,1,3)) { _InvalidateDom($i,$_[0]); } }

sub _InvalidateNums($;$)
{   return if !exists($seq[$_[0]]{ntk});
    my ($f,$l)=($_[1]||0,$#{$seq[$_[0]]{ntk}});
    if ($f<=$l) { $canvas->delete(map { $_->[3] } @{$seq[$_[0]]{ntk}}[$f..$l]); }
    if (!defined($_[1])) { delete $seq[$_[0]]{ntk}; } else { splice @{$seq[$_[0]]{ntk}},$f; }
}

sub _InvalidateGlyphs()
{   $canvas->delete('glyph'); %glyphcache=(); }

sub _GridOff()
{   $canvas->delete('grid','ruler'); }

sub Grid {
    _GridOff(); return if !@seq;
    $canvas->createLine($par{ofx},$par{ofy}-10,$par{ofx}+510,$par{ofy}-10,-tags=>['grid','ruler'],
			-fill=>'grey',-width=>5);

    my ($xnu,$ynu,$i,$j,$k,$fill);
    $xnu=$par{nch}+$par{num};
    $ynu=int((scalar(@{$seq[0]{e}})+$par{_dpl}+$par{_fnx}-1)*$par{_inx})*@seq;
    for ($i=0,$j=$par{ofx},$k=$par{ofy}+$ynu*$par{csv};$i<=$xnu;$i++,$j+=$par{csh}) {
	$fill=($cfg{dgrid} && ((!$i) || ($i==$xnu)))?'grey50':'grey';
	$canvas->createLine($j,$par{ofy},$j,$k,-tags=>'grid',-fill=>$fill,-width=>0.01);
    }
    for ($i=0,$j=$par{ofy},$k=$par{ofx}+$xnu*$par{csh};$i<=$ynu;$i++,$j+=$par{csv}) {
	$fill=($cfg{dgrid} && ($i % @seq == 0))?'grey50':'grey';
	$canvas->createLine($par{ofx},$j,$k,$j,-tags=>'grid',-fill=>$fill,-width=>0.01);
    }
    if ($cfg{gridbelow}) { $canvas->lower('grid'); }
    return;
}

sub AlxeltoPixel
{   # Convert Alxel xy to Pixel xy
    my ($Alx,$Aly)=@_;
    my $rn=int(($Alx+$par{_dpl}+0.8)*$par{_inx}); # 0.8 just to avoid rounding errors w/ _inx
    my $Pix=$par{ofx}+$par{csh}*($Alx+$par{lin}-$par{_fnx}*$rn);
    my $Piy=$par{ofy}+$par{csv}*($Aly+($rn*@seq));
    return (($Pix,$Piy));
}

sub _XYtoInfo($$$)
{   my ($x,$y,$type)=@_; my ($ax,$ay,$c,$ty,$tx,$q);

    $tx=($x-$par{ofx})/$par{csh}; $ay=($y-$par{ofy})/$par{csv};
    $q=@{$seq[0]{e}};

    if (($tx<0) || ($ay<0) || ($tx>=($par{num}+$par{nch}))) {
	$ax=$ay=undef; $c=0;
    } elsif (($tx<$par{lin}) && ($par{all} || ($ay<@seq))) {
	$ax=undef; $ay=int($ay); $c=2;
    } else {
	$tx=int($tx); $ay=int($ay);
	$ty=int($ay/@seq); $ay-=$ty*@seq;
	$ax=$ty*$par{_fnx}-$par{lin}+$tx;
	if (($tx<$par{nch}) && ($ax<$q)) { $c=3; } else {
	    # This is awkward but kind of necessary...
	    if ($tx>=$par{nch}) {
		if ((int(($q+$par{_dpl}+$par{_fnx}-1)*$par{_inx})-1)!=$ty) {
		    $c=1; $ax=undef;
		} else {
		    if ($ax<($q+$par{num})) { $c=1; $ax=undef; } else { $c=0; }
		}
	    } else {
		if ($ax<($q+$par{num})) { $c=1; $ax=undef; } else { $c=0; }
	    }
	}
    }
    # Fix things up if the user moved things into a different area...
    if (($type==3) && ($c!=$draginfo{class})) {
	$c=$draginfo{class}; $ax=$draginfo{xb}; $ay=$draginfo{yb};
    }

    return(($c,$ax,$ay));
}

sub _ButtonClick($$$)
{   my ($ev,$x,$y,$class,$ax,$ay,$i,$rv,@cm); my ($tk,$modkey,$type)=@_;
    # type:
    #   0 = button1 (C)
    #   1 = button2 (B)
    #   2 = button3 (A)
    #   3 = 1release=drag (D)
    #   4 = 1dblclick (E)
    #   5 = context menu binding (M)

    _Defocus();
    #Make sure something's read in, otherwise open the read dialog
    if (!@seq) { if ($type==3) { Open() if $draginfo{fclick}; } else { $draginfo{fclick}=1; return; } }
    $draginfo{fclick}=0;
    return if (($type==3) && ($draginfo{class}<0));

    # Get canvas coordinates
    $ev=$tk->XEvent; $x=$tk->canvasx($ev->x); $y=$tk->canvasy($ev->y);
    ($class,$ax,$ay)=_XYtoInfo($x,$y,$type); @cm=();

    $ev=(qw(C B A D E M))[$type].('O','N','T','')[$class];
    if (defined($i=action_can($ev))) { $rv=$i->($ax,$ay % @seq,$x,$y,$modkey,$class,($type==5)?\@cm:0); }
    if ($type==3) { $canvas->delete('transient'); $draginfo{class}=-1; }
    if ($type==5) { _ContextMenu(\@cm); return; }
    if (defined($i) && $rv) { return; }

    if (($type==0) && (defined($i=action_can('D'.substr($ev,1,1))))) {
	$rv=$i->($ax,$ay % @seq,$x,$y,$modkey,$class,1); return if !$rv;
	%draginfo=(x0=>$x,y0=>$y,xa=>$ax,ya=>$ay,xb=>$ax,yb=>$ay,class=>$class,modkey=>$modkey,
		   flags=>$rv->[0],callback=>((@$rv>1)?$rv->[1]:undef),private=>((@$rv>2)?$rv->[2]:undef));
	if ($draginfo{flags}&4) { _RubberBand($class,$ax,$ay); }
	return;
    }
    return;
}

sub _ContextMenu($)
{   my $cm=shift;
    return if !@$cm;
    my $menu=$mw->Menu(-tearoff=>0,-popover=>'cursor',-popanchor=>'nw');
    _BuildMenu($mw,$menu,@$cm); $menu->Popup();
    return;
}

sub RegDragActionFactory($$$;$)
{   my ($flags,$shmask,$shval,$callback)=@_;
    return sub {
	return if (($_[4]&$shmask)!=$shval); if ($callback) { return if $callback->(@_); }
	%draginfo=(x0=>$_[2],y0=>$_[3],xa=>$_[0],ya=>$_[1],xb=>$_[0],yb=>$_[1],class=>$_[5],modkey=>$_[4],
		   flags=>$flags);
	if ($flags&4) { _RubberBand($_[5],$_[0],$_[1]); } return 1;
    }
}

sub ButtonMotion
{   return if $draginfo{class}<0;
    my ($i,$ev);
    $i=shift; $ev=$i->XEvent;
    _RubberBand(_XYtoInfo($i->canvasx($ev->x),$i->canvasy($ev->y),3))
}

sub _RubberBand(@)
{   my ($class,$ax,$ay)=@_; my ($i,$ayo,$axo);
    $canvas->delete('transient');
    if (defined($ax)) { $draginfo{xb}=$ax; } else { $ax=$draginfo{xb}; }
    if (defined($ay)) { $draginfo{yb}=$ay; } else { $ay=$draginfo{yb}; }
    $i=$draginfo{flags}&11;
    if ($i==9) { goto cbonly; }
    if (($i==1) || ($i==2)) { $ayo=$ay; } else { $ayo=$draginfo{ya}; }

    if ($draginfo{class}==2) { # ---------------------------- title region
        if ($i==10) { $ayo=$ay; }
	ShadeRegion(-$par{lin},$ayo,($i&2)?$max_seq_length:-1,$ay,$i);
    } elsif ($draginfo{class}==3) { # ----------------------- cells
	if ($i==1)     { $axo=0; $ax=$max_seq_length; }
	elsif (!$i)    { $axo=$draginfo{xa}; }
	elsif ($i<4)   { $axo=-$par{lin}; $ax=$max_seq_length; }
	elsif ($i==8)  { $ayo=0; $ay=$#seq; $axo=$draginfo{xa}; }
        elsif ($i==10) { $axo=$draginfo{xa}; $ayo=$ay; }
        elsif ($i==11) { $axo=$ax; $ayo=$ay; }
	else           { $axo=$draginfo{xa}; }
	ShadeRegion($axo,$ayo,$ax,$ay,$i);
    } elsif ($draginfo{class}==1) { # ----------------------- number region
	if ($i&2) { $axo=-$par{lin}; $ax=$max_seq_length; }
	else      { $axo=undef; $ax=1; }
	ShadeRegion($axo,$ayo,$ax,$ay,$i);
    }
cbonly:
    if (defined($draginfo{callback})) { $draginfo{callback}->($class,$ax,$ay); }
}

sub ShadeRegion {
    my ($oAlx,$oAly,$Alx,$Aly,$vistype)=@_; my ($ax,$ay,$x,$y,$i,$f,$x2);
    if (!defined($oAlx)) { $oAlx=$Alx; $f=0; } else { $f=1; }
    if ($oAlx>$Alx) { $i=$oAlx; $oAlx=$Alx; $Alx=$i; }
    if ($oAly>$Aly) { $i=$oAly; $oAly=$Aly; $Aly=$i; }
    foreach $ax ($oAlx .. $Alx) {
	foreach $ay ($oAly .. $Aly) {
	    ($x,$y)=&AlxeltoPixel($ax,$ay);
	    if ($f) { $x2=$x+$par{csh}; }
	    else    { $x=$par{ofx}+$par{nch}*$par{csh}; $x2=$x+$par{num}*$par{csh}; }
	    if (($vistype==1) || ($vistype==2)) {
		$canvas->createLine($x,$y,$x2,$y,-fill=>'grey50',-tags=>'transient',-width=>4);
	    } else {
		$canvas->createRectangle($x,$y,$x2,$y+$par{csv},-stipple=>'gray50',
					 -fill=>'grey50',-tags=>'transient',-width=>0,-outline=>'grey');
	    }
	}
    }
}

sub TransientBox($$)
{   my ($xy,$c)=@_; my ($i,$x,$y);
    return if !@$xy;
    my @rx=();
    foreach $i (@$xy) {
	($x,$y)=AlxeltoPixel($i->[0],$i->[1]);
	push @rx,$canvas->createRectangle($x,$y,$x+$par{csh},$y+$par{csv},-fill=>$c,-width=>0,-outline=>$c,
					  -tags=>['cursor','xtransient']);
    }
    $canvas->lower('xtransient','text');
    _canvasSee($xy->[-1][0],$xy->[-1][1]) if (@$xy>1);
    _canvasSee($xy->[0][0],$xy->[0][1]);
}

sub _SetNumberingType($$;$)
{   my $s=$seq[$_[0]]; my $ch=0; my $no=$_[2];

    if (defined($s->{n})) { # is auto
	if (defined($no)) { $ch=($no!=$s->{n}); $s->{n}=$no; }
	if ($_[1]) { _FillSeqnum($_[0]); $s->{n}=undef; }
    } else { # is fixed
	if (!$_[1]) { if (!defined($no)) { $no=_SeqStart($_[0]); } $s->{n}=$no; $ch=1; }
	else {
	    return 0 if !defined($no);
	    $no-=_SeqStart($_[0]); return 0 if !$no; $ch=1;
	    foreach my $j (@{$s->{e}}) { if (defined($j->{seqnumber})) { $j->{seqnumber}+=$no; } }
	}
    }
    if ($ch) { $cursor{oy}=-1; }
    return $ch;
}

sub SetNumberOffsets
{   my ($nw,$edit,@order,$i,$bc,$br,@gh);
    return if $_[4]; # pass if any modkey

    @order=(); @gh=();
    for ($i=0;$i<@seq;$i++) {
	if ($seq[$i]{t}{text}!~/^%%%/) {
	    push @order,[$i,$seq[$i]{p},_printableNum(_SeqStart($i),1),defined($seq[$i]{n})?'Auto':'Fixed'];
	}
    }
    if (!@order) { return 1; }
    @order=sort { $a->[1]<=>$b->[1] } @order;

    $nw=$mw->Toplevel;
    $nw->title('Set numbers of 1st residues');
    $edit=$nw->Frame(-borderwidth=>5)->pack(-side=>'top',-expand=>1,-fill=>'both');
    $edit=$edit->Frame(-borderwidth=>2,-relief=>'groove')->pack(-side=>'top',-expand=>1,-fill=>'both');
    $edit=$edit->Scrolled('Frame',-scrollbars=>'oe')->
	         pack(-side=>'top',-anchor=>'c',-expand=>1,-fill=>'both');

    $edit->Label(-text=>'Sequence')->grid($edit->Label(-text=>'Start number'),-sticky=>'w');
    for ($i=0;$i<@order;$i++) {
	$bc=$order[$i][3];
	$edit->Label(-text=>($i+1).': '.$seq[$order[$i][0]]{t}{text})->
	       grid($order[$i][4]=$edit->Entry(-width=>15,-textvariable=>\$order[$i][2]),
		    $order[$i][5]=$edit->Optionmenu(-variable=>\$order[$i][3],-options=>['Fixed','Auto']),
		    -sticky=>'w');
    }

    push @gh,_CancelOk($nw,'OK',sub {
	my $i; my $ch=0;
	foreach $i (@order) {
	    if (!defined(_pNum2Real($i->[2]))) {
		$i->[4]->focus(); $i->[4]->selectionRange(0,'end'); $i->[4]->icursor('end');
		return 1;
	    }
	}
	PDumpData('Edit Sequence Offsets',0,1,0);
	foreach $i (@order) { $ch|=_SetNumberingType($i->[0],$i->[3] eq 'Fixed',_pNum2Real($i->[2])); }
	if ($ch) { &PrintSeq; } $nw->destroy;
    });
    _FixDopeyScrollable($nw,$edit,\@gh);
    return 1;
}

sub _QuickDialog($$$$$;$$)
{   my ($win,$title,$wloc,$okb,$okc,$co1,$co2)=@_;
    my $nw=$win->Toplevel; $nw->title($title);
    my $tf=$nw->Frame()->pack(-side=>'top',-expand=>1,-fill=>'both');
    _CancelOk($nw,$okb,$okc,$co1,$co2);
    $nw->withdraw; $nw->update;
    if (ref($wloc) eq 'ARRRAY') {
	$nw->geometry("+$wloc->[0]+$wloc->[1]");
    } elsif ($wloc==0) {
	$nw->geometry('+'.int(0.5*($screen{SW}-$nw->reqwidth)).'+'.int(0.5*($screen{SH}-$nw->reqheight)));
    }
    $nw->deiconify; $nw->raise; $nw->focus; $nw->grab();
    return ($nw,$tf);
}

sub InsertRowAction
{   return if $_[4]; my $nu=@seq;
    PSmartData('Insert Row',sub { return DeleteRowByN($nu); });
    InsertRow($_[1]); PrintSeq(); return 1;
}

sub InsertSeqRowAction
{   return if $_[4];
    my ($title,$comment,$line,$nu)=('','',$_[1],scalar(@seq)); my ($x,$cc,$nw);
    ($nw,$x)=_QuickDialog($mw,'Enter Title for New Sequence',0,'OK',sub {
	PSmartData('Insert Row',sub { return DeleteRowByN($nu); });
	InsertSequence($title,'',undef,$comment,$line); PrintSeq(); $nw->destroy;
    });
    _ComposeInpTable($x,[['Title:','F',\$title,-cb=>\$cc],['Comment:','F',\$comment]]);
    $cc->focus(); return 1;
}

sub DeleteRowAction
{   return if $_[4]; return [3] if $_[6];
    my ($y1,$y2,$ch);
    ($y1,$y2)=(($draginfo{class}>=0)?($draginfo{ya}%(@seq)):$_[1],$_[1]);
    if ($y1>$y2) { $ch=$y1; $y1=$y2; $y2=$ch; }
    PDumpData('Delete Row'.(($y1!=$y2)?'s':''),0,1,0); $ch=0;
    for (;$y2>=$y1;$y2--) { $ch|=DeleteRowByY($y2); }
    if ($ch) { PrintSeq(1); } return 1;
}

sub DeleteObjAction
{   return if ($_[4]&254);
    my ($s,$o)=FindObjectAt($_[2],$_[3]);
    return 1 if !defined($s);
    PDumpData(actionname(),0,1,0);
    DeleteObjectById($s,$o,$_[4]!=1);
    PrintSeq();
    return 1;
}

sub _dragobjectrband
{   my ($class,$ax,$ay)=@_; return if !defined($draginfo{private});
    my ($dx,$dy,$nss,$nso)=MoveObject($draginfo{private}[2],$draginfo{private}[3],1,
				      $ax-$draginfo{private}[0],$ay-$draginfo{private}[1]);
    return if !$dx && !$dy;
    $draginfo{private}[0]+=$dx; $draginfo{private}[1]+=$dy;
    $draginfo{private}[2]=$nss; $draginfo{private}[3]=$nso;
    _canvasSee($ax,$ay); PrintSeq(1);
}

sub DragObjectAction
{   return if $_[4];
    if ($_[6]) {
	my ($s,$o)=FindObjectAt($_[2],$_[3]); return if !defined($s);
	return [9,\&_dragobjectrband,[$_[0],$_[1],$s,$o,$_[4]]];
    }
    _dragobjectrband(3,$_[0],$_[1]);
    return 1;
}

sub ObjectPropsAction
{   return if ($_[4]&254);
    my ($s,$o)=FindObjectAt($_[2],$_[3]);
    return 1 if !defined($s);
    PDumpData(actionname(),0,1,0);
    _PropertyWindow(ObjCells($s,$o,$_[4]!=1),actionname(),actionname(),$_[4]!=1);
    return 1;
}

sub DragAction
{   return if $_[4]; return [6] if $_[6];
    my ($Aly,$oAly)=($_[1],$draginfo{ya} % @seq);
    if ($Aly>$oAly) { $Aly--; } return 1 if ($Aly==$oAly);
    PSmartData('Drag Row',sub { _SeqDrag($Aly,$oAly); return 0; });
    _SeqDrag($oAly,$Aly);
    return 1;
}

sub _SeqDrag($$)
{   my ($oAly,$Aly)=@_; my ($s,$orig);
    foreach $s (0 .. $#seq) {
	if ($seq[$s]{p}==$oAly) { $orig=$s; }
	if ($Aly>$oAly) { if (($seq[$s]{p}>$oAly) && ($seq[$s]{p}<=$Aly)) { $seq[$s]{p}--; } }
	if ($Aly<$oAly) { if (($seq[$s]{p}<$oAly) && ($seq[$s]{p}>=$Aly)) { $seq[$s]{p}++; } }
    }
    $seq[$orig]{p}=$Aly;
    &PrintSeq; return;
}

sub _GetZMinMax()
{   my ($s,$o,$min,$max,$c);
    $min=0; $max=0;
    foreach $s (@seq) { foreach $o (@{$s->{o}}) {
	if ($o->{z}<$min) { $min=$o->{z}; } if ($o->{z}>$max) { $max=$o->{z}; }
    }}
    return ($min,$max);
}

sub _GetZList()
{   my ($s,$o); my %lv=();
    foreach $s (@seq) { foreach $o (@{$s->{o}}) { $lv{$o->{z}}=1; } }
    my @data=sort { $a<=>$b } keys %lv; return \@data;
}

sub _ConsolidateZ()
{   my %l=(); my ($s,$o,$z);
    foreach $s (@seq) { foreach $o (@{$s->{o}}) { $l{$o->{z}}||=[]; push @{$l{$o->{z}}},$o; } }
    $z=0;
    foreach $s (sort {$a<=>$b} keys %l) { foreach $o (@{$l{$s}}) { $o->{z}=$z; } $z++; }
}

sub _argio($;$)
{   my ($val,$hard)=@_;
    if (!defined($val)) { return ($hard==2)?'undef':'<undef>'; }
    if (ref($val)) {
	if ($hard) {
	    if (ref($val) eq 'ARRAY') { return '['.join(',',map { _argio($_,1) } @$val).']'; }
	    if (ref($val) eq 'HASH')  { return '{'.join(',',map { $_.'=>'._argio($val->{$_},1) } keys %$val).'}'; }
	}
	return '<'.lc(ref($val)).'ref>' unless $hard;
    }
    return "'$val'" unless looks_like_number($val);
    return $val;
}

sub _GetCellColour($$$)
{ my ($x,$z,$flags)=@_; my ($i,$y,$o,$c,$n,$nc,$ok);
  $y=undef;
  if ($flags&1) { $y=$z; }
  else          { for ($i=0;$i<@seq;$i++) { if ($seq[$i]{p}==$z) { $y=$i; last; } } }
  if (!defined($y)) { goto transparent; }

  if (defined($seq[$y]{o})) {
    $z=-1; $c=undef;
    foreach $o (@{$seq[$y]{o}}) {
      next if $o->{z}<$z; $n=0;
      foreach $i (@{$o->{e}}) {
        last if $i->{xpos}>$x;
        if ($i->{xpos}==$x) { $c=$i; $z=$o->{z}; $nc=$n; $ok=$o; }
        $n++;
      }
    }
    if (defined($c)) {
      if ($c->{type}=~/Graph$/) {
        my ($gfc,$glc)=(undef,undef);
        { local $canvas=Aline::GraphMucker->new(\$gfc,\$glc);
          my $l1=$c->{text}; my $l2=$l1;
	  if ($n && (($ok->{e}[$n-1]{xpos}+1)==$c->{xpos})) { $l1=0.5*($l1+$ok->{e}[$n-1]{text}); }
	  if (($n<$#{$ok->{e}}) && (($ok->{e}[$n+1]{xpos}-1)==$c->{xpos})) { $l2=0.5*($l2+$ok->{e}[$n+1]{text}); }
	  $objectdata{$c->{type}}[3]->(0,0,'x',$c->{fc},$c->{lc},$c->{lw},'y',$l1,$c->{text},$l2,1,$ok->{cut});
        }
        if ($flags&2) { $c=$glc; } else { $c=$gfc; }
      } else {
        $c=($flags&2)?$c->{lc}:$c->{fc};
      }
      if (defined($c)) { return $c; }
    }
  }
  if ($x<@{$seq[$y]{e}}) {
      $i=$seq[$y]{e}[$x];
      $c=($flags&2)?$i->{fontfill}:$i->{fontbg};
      if ($c) { return $c; }
  }
transparent:
  return(($flags&2)?$cfg{lc}:$cfg{canvascol});
}


sub CreateObject($$$$$;$$)
{   my ($ob_ty,$Alx,$Aly,$oAlx,$oAly,$lcolour,$fcolour)=@_; my ($nol,$i,$revob,$noo,$z);
    $lcolour||=$cfg{lc}; $fcolour||=$cfg{fc}; (undef,$z)=_GetZMinMax(); $z++;
    if ($ob_ty=~s/^(Multi)?(Rect|Box)$/$2/) {
	$revob=undef; my %cells=(); my $multi;
	if ($1) {
	    return if !@{$Alx};
	    foreach $i (@{$Alx}) { $cells{$i->[1]}||=[]; push @{$cells{$i->[1]}},$i->[0]; }
	    $multi=(keys(%cells)<=1)?0:1;
	} else {
	    if ($oAly>$Aly) { $i=$oAly; $oAly=$Aly; $Aly=$i; }
	    if ($oAlx>$Alx) { $i=$oAlx; $oAlx=$Alx; $Alx=$i; }
	    foreach $i ($oAly..$Aly) { $cells{$i}=[($oAlx..$Alx)]; }
	    $multi=($oAly==$Aly)?0:1;
	}
	foreach my $ay (sort { $a<=>$b } keys %cells) {
	    foreach $i (@seq) { if ($i->{p}==$ay) { $nol=$i->{o}; last; } }
	    next if !defined($nol);
            push @$nol,{fwd=>undef,rev=>$revob,multi=>$multi,z=>$z,e=>[]};
	    if (defined($revob)) { $revob->{fwd}=$nol->[-1]; }
	    $revob=$nol->[-1]; $noo=$nol->[-1]{e};
	    foreach my $ax (@{$cells{$ay}}) {
		push @$noo,{
		    xpos=>$ax,
		    type=>$ob_ty,
		    lc=>$lcolour,
		    lw=>$cfg{lw},
		    fc=>$fcolour,
		    fontfill => $cfg{fo}[0],
		    fontfoundry => $cfg{fo}[1],
		    fontwidth => $cfg{fo}[5],
		    fontslant => $cfg{fo}[3],
		    fontsize => $cfg{fo}[4],
		    fontweight => $cfg{fo}[2],
		    fontbg => $cfg{fo}[6],
		    anchor => 'nw',
		};
	    }
	}
	return $nol->[-1];
    } elsif ($objectdata{$ob_ty}[0]==1) { # 1D objects
	if ($oAlx>$Alx) { $i=$oAlx; $oAlx=$Alx; $Alx=$i; }
	foreach $i (@seq) { if ($i->{p}==$oAly) { $nol=$i->{o}; last; } }
        push @$nol,{fwd=>undef,rev=>undef,multi=>0,z=>$z,e=>[]}; $noo=$nol->[-1]{e};
	foreach my $ax ($oAlx .. $Alx) {
	    push @$noo,{
		xpos=>$ax,
		type=>$ob_ty,
		lc=>$lcolour,
		lw=>$cfg{lw},
		fc=>$fcolour,
		fontfill => $cfg{fo}[0],
		fontfoundry => $cfg{fo}[1],
		fontwidth => $cfg{fo}[5],
		fontslant => $cfg{fo}[3],
		fontsize => $cfg{fo}[4],
		fontweight => $cfg{fo}[2],
		fontbg => $cfg{fo}[6],
		anchor => "nw",
	    };
	}
	return $nol->[-1];
    } else {
	foreach $i (@seq) { if ($i->{p}==$oAly) { $nol=$i->{o}; last; } }
        push @$nol,{fwd=>undef,z=>$z,rev=>undef,multi=>0,e=>[{
	    type=>$ob_ty,
	    otext => $object_text,
	    fontfill => $cfg{fo}[0],
	    fontfoundry => $cfg{fo}[1],
	    fontwidth => $cfg{fo}[5],
	    fontslant => $cfg{fo}[3],
	    fontsize => $cfg{fo}[4],
	    fontweight => $cfg{fo}[2],
	    fontbg => $cfg{fo}[6],
	    lc=>$lcolour,
	    lw=>$cfg{lw},
	    fc=>$fcolour,
	    anchor => (($ob_ty=~/Text$/)?'c':'nw'),
	    xpos => $oAlx,
	}]};
	return $nol->[-1];
    }
    return;
}

sub _CreateGraph($$$$$$$$)
{   my ($type,$data,$y,$lcolour,$fcolour,$seqid,$height,$cut)=@_; my ($i,$nol,$ax,$ne,$z);
    foreach $i (@seq) { if ($i->{p}==$y) { $nol=$i->{o}; last; } }
    (undef,$z)=_GetZMinMax(); $z++;
    push @$nol,{fwd=>undef,rev=>undef,h=>$height,cut=>$cut,multi=>0,z=>$z,e=>[]}; $nol=$nol->[-1]{e};
    foreach $ax (0..$max_seq_length) {
	if ((!defined($seqid)) || ($seq[$seqid]{e}[$ax]{text}!~/^[-._ ]?$/)) {
	    $ne=shift(@$data);
	    if (defined($ne)) {
		push @$nol,{
		    xpos=>$ax,
		    type=>$type,
		    lc=>$lcolour,
		    lw=>$cfg{lw},
		    fc=>$fcolour,
		    text => $ne,
		    fontfill => $cfg{fo}[0],
		    fontfoundry => $cfg{fo}[1],
		    fontwidth => $cfg{fo}[5],
		    fontslant => $cfg{fo}[3],
		    fontsize => $cfg{fo}[4],
		    fontweight => $cfg{fo}[2],
		    fontbg => $cfg{fo}[6],
		    anchor => 'nw',
		};
	    }
	}
    }
}

sub InsertGraph($$$$$$$$$$;$$)
{   my ($calch,$colch,$type,$data,$lc,$fc,$flags,$height,$cut,$noins,$fmin,$fmax)=@_; my ($i,$min,$max,@pdata);
    $min=undef; $max=undef;
    foreach $i (values %$data) { if (defined($i)) {
	if (defined($fmin) && ($i<$fmin)) { $i=$fmin; } if (defined($fmax) && ($i>$fmax)) { $i=$fmax; }
	if (!defined($min) || ($i<$min))  { $min=$i; }  if (!defined($max) || ($i>$max))  { $max=$i; }
    }}
    if (defined($fmin)) { $min=$fmin; } if (defined($fmax)) { $max=$fmax; }
    $i=int($height+0.99); while ($i>1) { InsertRow($colch,'%%%Graph Spacer'); $colch++; $i--; }
    unless ($noins) {
	InsertRow($colch,'%%%Graph',sprintf('For %s, original dynamic range %.2g to %.2g',
					    $seq[$calch]{t}{text},$min,$max));
	main::AttachRow($#seq,$calch);
    }
    if ($cut=~s/%$//) { $cut=$min+($max-$min)*0.01*$cut; }
    if ($flags&1) {
	foreach $i (values %$data) { $i=log($i) if defined($i); } $min=log($min); $max=log($max); $cut=log($cut);
    }
    if ($objectdata{$type}[2]&1) { $i=1.0; } else { $i=$height; }
    if (abs($max-$min)>0.000001) { $max=$i/($max-$min); } else { $max=$i; }
    foreach $i (values %$data) { $i=($i-$min)*$max if defined($i); }
    $cut=($cut-$min)*$max; @pdata=(); _FillSeqnum($calch);
    foreach $i (@{$seq[$calch]{e}}) {
	push @pdata,(defined($i->{seqnumber}) &&
		     defined($data->{$i->{seqnumber}}))?$data->{$i->{seqnumber}}:undef;
    }
    _CreateGraph($type,\@pdata,$colch,$lc,$fc,undef,$height,$cut);
}

sub MoveObject($$$$$)
{   my ($s,$o,$deep,$dx,$dy)=@_; my ($cells,$x,$y,$i,$xn,$yn,@rtr,$deldel,%mv,$nss,$nso);
    $cells=ObjCells($s,$o,$deep);
    for ($i=0;$i<@seq;$i++) { $rtr[$seq[$i]{p}]=$i; }
retx0:
    $deldel=0;
    foreach $i (@$cells) {
	$x=$seq[$i->[0]]{o}[$i->[1]]{e}[$i->[2]]{xpos}; $y=$seq[$i->[0]]{p}; $xn=$x; $yn=$y+$dy;
retxa:  while ($yn<0) { $yn+=@seq; $xn-=$par{_fnx}; } while ($yn>$#seq) { $yn-=@seq; $xn+=$par{_fnx}; }
	if ($xn<0)              { $yn++; $dy++; $deldel=1; goto retxa; }
	if ($xn>=@{$seq[0]{e}}) { $yn--; $dy--; $deldel=1; goto retxa; }
	$xn+=$dx;
	if ($xn<0)                 { $dx-=$xn; goto retx0; }
	elsif ($xn>=@{$seq[0]{e}}) { $dx+=$#{$seq[0]{e}}-$xn; goto retx0; }
	if ($deldel) { goto retx0; }
	$i->[3]=$rtr[$yn]; $i->[4]=$xn;
    }
    return((0,0,$s,$o)) if !$dx && !$dy;
    %mv=(); $nss=$s; $nso=$o;
    foreach $i (@$cells) {
	$seq[$i->[0]]{o}[$i->[1]]{e}[$i->[2]]{xpos}=$i->[4]; $mv{$i->[0]}||={}; $mv{$i->[0]}{$i->[1]}=$i->[3];
    }
    foreach $i (keys %mv) {
	foreach $x (sort { $b<=>$a } keys %{$mv{$i}}) {
	    if ($i!=$mv{$i}{$x}) {
		$y=splice @{$seq[$i]{o}},$x,1; push @{$seq[$mv{$i}{$x}]{o}},$y;
		if (($s==$i) && ($o==$x))       { $nss=$mv{$i}{$x}; $nso=$#{$seq[$nss]{o}}; }
		elsif (($nss==$i) && ($x<$nso)) { $nso--; }
	    }
	}
    }
    return (($dx,$dy,$nss,$nso));
}

sub DrawObject
{   return if $_[4];
    if ($_[6]) { return [[11,10,0,3,11]->[$objectdata{$ob_ty}[0]]]; }
    my $ob=CreateObject($ob_ty,$draginfo{xa},$draginfo{ya},$_[0],$_[1]);
    PSmartData('Create Object',sub { DeleteObjectByPtr($ob,1); return 1; });
    &PrintSeq; return 1;
}

sub ObjCells($$$)
{   my ($s,$o,$deep)=@_; my @res=(); my @pre=([$s,$o]); my $i;
    if ($deep) {
	$i=$seq[$s]{o}[$o]; while (defined($i=$i->{rev})) { push @pre,_ObjPtrToId($i); }
	$i=$seq[$s]{o}[$o]; while (defined($i=$i->{fwd})) { push @pre,_ObjPtrToId($i); }
    }
    foreach $i (@pre) { $o=$seq[$i->[0]]{o}[$i->[1]]{e}; push @res,map { [$i->[0],$i->[1],$_] } (0..$#$o); }
    return \@res;
}

sub DeleteRowByY($)
{   my $y=shift;
    foreach my $i (0..$#seq) { if ($seq[$i]{p}==$y) { return DeleteRowByN($i); } }
    return 0;
}

sub DeleteRowByN($)
{   my $n=shift; my ($i);
    foreach $i (@seq) {
	if ($i->{p}>$seq[$n]{p}) { $i->{p}--; }
	if ($i->{t}{attach}>$n) { $i->{t}{attach}--; } elsif ($i->{t}{attach}==$n) { $i->{t}{attach}=-1; }
    }
    foreach $i (@{$seq[$n]{o}}) { _UnlinkObject($i); }
    _InvalidateNums($n); _Invalidate([[$n]]); _Invalidate([map { [$n,$_] } (0..$#{$seq[$n]{e}})]);
    if ($cursor{ay}>=$seq[$n]{p}) { $cursor{ay}--; }
    splice @seq,$n,1; return 1;
}

sub _ObjPtrToId($)
{   my ($s,$o);
    foreach $s (0..$#seq) {
	foreach $o (0..$#{$seq[$s]{o}}) { if ($seq[$s]{o}[$o]==$_[0]) { return [$s,$o]; } }
    }
    return undef;
}

sub _ObjPtrToId2($$)
{   my ($s,$o); my $ss=shift;
    foreach $s (0..$#$ss) {
	foreach $o (0..$#{$ss->[$s]{o}}) { if ($ss->[$s]{o}[$o]==$_[0]) { return [$s,$o]; } }
    }
    return undef;
}

sub _ObjectType($$;$)
{   my $o=$seq[$_[0]]{o}[$_[1]]{e}[0]{type};
    if (!$_[2]) { return $o; }
    if ($_[2]==1) { return $objectdata{$o}[0]; }
    return ($objectdata{$o}[4] || $o);
}

sub _UnlinkObject($) # \object
{   my $o=shift;
    if (defined($o->{fwd})) { $o->{fwd}{rev}=$o->{rev}; }
    if (defined($o->{rev})) { $o->{rev}{fwd}=$o->{fwd}; }
}

sub _LinkObject($$)
{   my ($o,$oo)=@_;
    return if ($o->{e}[0]{type} ne $oo->{e}[0]{type});
    return if ($objectdata{$o->{e}[0]{type}}[0]!=2);
    $o->{multi}=1; $oo->{multi}=1;
    if (defined($oo->{fwd})) {
	$o->{rev}=$oo->{fwd}{rev}; $o->{fwd}=$oo->{fwd};
	$oo->{fwd}{rev}=$o; $oo->{fwd}=$o;
    } elsif (defined($oo->{rev})) {
	$o->{fwd}=$oo->{rev}{fwd}; $o->{rev}=$oo->{rev};
	$oo->{rev}{fwd}=$o; $oo->{rev}=$o;
    } else {
	$oo->{fwd}=$o; $o->{rev}=$oo;
    }                                                                                           
}

sub FindObjectAt($$)
{   my ($f,$f2);
    foreach $f (reverse($canvas->find(overlapping=>$_[0]-$cfg{clickbox},$_[1]-$cfg{clickbox},
				      $_[0]+$cfg{clickbox},$_[1]+$cfg{clickbox}))) {
	foreach $f2 ($canvas->gettags($f)) {
	    if ($f2=~/^obj([0-9]+)x([0-9]+)$/) { return(($1+0,$2+0)); }
	}
    }
    return undef;
}

sub RaiseLowerObj($$$)
{   my @obs=($seq[$_[0]]{o}[$_[1]]); my ($x,$list,$c,$s,$o);
    return if (abs($_[2])>2) || !$_[2];
    $x=$obs[0]{rev}; while (defined($x)) { push @obs,$x; $x=$x->{rev}; }
    $x=$obs[0]{fwd}; while (defined($x)) { push @obs,$x; $x=$x->{fwd}; }
    $x=$obs[0]{z}; $list=_GetZList();
    return 0 if ($_[2]<0) && ($x==$list->[0]);
    return 0 if ($_[2]>0) && ($x==$list->[-1]);
    if ($_[2]==2)  { $x=$list->[-1]+1; goto zset; }
    if ($_[2]==-2) { $x=$list->[0]-1; goto zset; }
    for ($c=0;$c<@$list;$c++) { # this is not very efficient, but should not be necessary
	if ($x==$list->[$c]) {
	    if ($_[2]<0) { $c=$list->[$c-1]; } else { $c=$list->[$c+1]; }
	    foreach $s (@seq) { foreach $o (@{$s->{o}}) { if ($o->{z}==$c) { $o->{z}=$x; } } }
	    foreach $o (@obs) { $o->{z}=$c; }
	    return 1;
	}
    }
    return 0;
zset:
    foreach $c (@obs) { $c->{z}=$x; }
    return 1;
}

sub DeleteObjectByPtr($$)
{   my $o=_ObjPtrToId($_[0]); if (defined($o)) { DeleteObjectById($o->[0],$o->[1],$_[1]); } }

sub DeleteObjectById($$$)
{   my @obs=([$_[0],$_[1]]); my $x;
    if ($_[2]) { # deep delete?
        $x=$seq[$_[0]]{o}[$_[1]]{rev}; while (defined($x)) { push @obs,_ObjPtrToId($x); $x=$x->{rev}; }
        $x=$seq[$_[0]]{o}[$_[1]]{fwd}; while (defined($x)) { push @obs,_ObjPtrToId($x); $x=$x->{fwd}; }
    } else {
	_UnlinkObject($seq[$_[0]]{o}[$_[1]]);
    }
    foreach $x (@obs) { if (defined($x)) { splice @{$seq[$x->[0]]{o}},$x->[1],1; } }
}

sub _IsObjectAtY($$)
{   my ($ob,$y)=@_; my ($s,$ot,$o,$aly);
    foreach $s (0..$#seq) { if ($seq[$s]{p}==$y) { $aly=$s; goto gotlineioay; } } return undef;
gotlineioay:
    $ot=$ob->{fwd}; $ob=$ob->{rev};
recycleioay:
    foreach $o (0..$#{$seq[$aly]{o}}) {
	if (defined($ob)) { if ($seq[$aly]{o}[$o]==$ob) { return $ob; } }
	if (defined($ot)) { if ($seq[$aly]{o}[$o]==$ot) { return $ot; } }
    }
    if (defined($ob)) { $ob=$ob->{rev}; } elsif (!defined($ot)) { return undef; }
    if (defined($ot)) { $ot=$ot->{fwd}; }
    goto recycleioay;
}

sub _IsObjectAtX($$)
{   return undef if !defined($_[0]);
    my $ob=$_[0]{e}; my $i;
    foreach $i (@$ob) { if ($i->{xpos}==$_[1]) { return $i; } }
    return undef;
}

sub Blank {};

sub _ApplyCat($$)
{ my ($cat,$xy)=@_; my ($i,@oo,$ms);
  @oo=(); foreach $i (3..7,0) { push @oo,$categories[$cat][1][$i]; }
  _ApplyEdits($xy,\@oo);
}

sub _ComposeInpTable($$)
{   my ($nw,$items)=@_; local $_; my ($r,$cbp,$lab);

    $cbp=undef;
    foreach (@$items) {
	my $i; my $ptr=$_->[2]; $cbp=undef; my @extra=();

	if ($_->[1]=~/^[RI]S$/) { # -------------------------- RS=real slider, IS=integer slider
	    my ($i1,$prc,$pv);

	    $r=0.001*($_->[4]-$_->[3]);
	    if ($_->[1]=~/^R/) { if ($r>1) { $r=1; } $prc=int(0.5-log($r)*0.434); }
	    else               { $r=int(0.01*$r+0.5); if ($r<1) { $r=1; } $prc=0; }
	    $pv=sprintf("\%.${prc}f",$$ptr);
	    $i=$nw->Frame();
	    $i1=$i->Scale(-orient=>'horizontal',-from=>$_->[3],-to=>$_->[4],-showvalue=>0,-resolution=>$r,
		 	  -command=>sub { $$ptr=$i1->get(); $pv=sprintf("\%.${prc}f",$$ptr); })->
		    pack('-side','left','-expand',1);
	    $i->Label(-textvariable=>\$pv)->pack('-side','left');
	    $i1->set($$ptr); $cbp=$i1;
	} elsif ($_->[1] eq 'C') { # ---------------------------------------------- C = checkbox
	    $i=$nw->Checkbutton(-command=>sub { $$ptr^=1; });
	    if ($$ptr) { $$ptr=1; $i->select(); }
	} elsif ($_->[1] eq 'E') { # ---------------------------------------------- E = combobox
	    $r=0; if (defined($$ptr)) {
		foreach $i (0..$#{$_->[3]}) {
		    if ((ref($_->[3][$i])?$_->[3][$i][1]:$_->[3][$i]) eq $$ptr) { $r=$i; }
		    if ($_->[3][$i] eq $cfg{unchg}[1]) { $_->[3][$i]=$cfg{unchg}; }
		}
	    }
	    $i=$nw->Optionmenu(-variable=>$ptr,-options=>$_->[3]);
	    $i->setOption(ref($_->[3][$r])?($_->[3][$r][0],$_->[3][$r][1]):$_->[3][$r]);
	} elsif ($_->[1] eq 'F') { # -------------------------------------------- F = text field
	    $i=$nw->Entry(-textvariable=>$ptr);
	} elsif ($_->[1] eq 'FH') { # ------------------------------- FH = text field w/ history
	    my ($i1,$i2,$menu,$y);
	    $i=$nw->Frame();
	    $i1=$i->Entry(-textvariable=>$ptr)->pack(-side=>'left',-expand=>1);
	    $i2=$i->Menubutton(-height=>18,-image=>$i->Photo(-data=>'R0lGODlhCgAGAIABAAAAAP///yH'.
			       '5BAEKAAEALAAAAAAKAAYAAAIMhI+BGboNXRmRjALADs=',-format=>'gif'),
			       -text=>'History',-relief=>'raised')->pack(-side=>'left');
	    $menu=$i2->Menu(-tearoff=>0); $i2->configure(-menu=>$menu);
            foreach $y (@{$_->[3]}) {
		$menu->add('command',-label=>$y,-command=>sub { $$ptr=$y; }); 
	    }

	} elsif ($_->[1]=~/^FF[OS]$/) { # ------------------------- FF[OS] = file r/w text field
	    my ($i1,$cub,$act,$pp,$p);
	    $i=$nw->Frame(); $cub=$_->[3] || sub {}; $pp=$_->[4] || [];
            $p=$ptr; $act=$_->[1] eq 'FFO';
	    $i1=$i->Entry(-textvariable=>$ptr,-validate=>'all')->pack(-side=>'left',-expand=>1);
	    $extra[0]=$i->Button(-text=>'Browse...',-command=>sub {
		my $f=$act?($nw->Tk::getOpenFile(@$pp)):($nw->Tk::getSaveFile(@$pp));
		return if !defined($f); $$p=$f;
	    })->pack(-side=>'left');
	    $i1->configure(-validatecommand=>sub {
		if (-e $_[0]) { $i1->configure(-foreground=>$act?'black':'red'); $cub->($_[0]); }
		else { $i1->configure(-foreground=>$act?'red':'black'); } 1;
	    });
	    if (defined($$ptr) && (((! -e $$ptr) && $act) || ((-e $$ptr) && !$act))) { $i1->configure(-foreground=>'red'); }
	    $cbp=$i1;
	} elsif ($_->[1] eq 'Font') { # ------------------------------ Font = font picker button
	    my $bbt=$nw->Button(-text=>'',-width=>1,-padx=>'70'); $i=$bbt; my $jj=$$ptr;
	    $bbt->configure(-command=>sub {_FontPicker($nw,$jj,$bbt);}); _FontPickButton($jj,$bbt);
	} elsif ($_->[1] eq 'FR') { # -------------------------------- FR = text field for title
	    $i=$$ptr; if ($i=~s/^%%%//) { $i=$nw->Label(-text=>$i); }
	    else                        { $i=$nw->Entry(-textvariable=>$ptr); }
	} elsif ($_->[1]=~/^E(?:Seq|Line)(?:\+.)*$/) { # ------ ESeq,ELine = sequence/row picker
	    my @order=(); my $mu=0;
	    for ($i=0;$i<@seq;$i++) {
		$r=$seq[$i]{t}{text};
		if ($r!~/^%%%/) {
		    push @order,[$r,$i,$seq[$i]{p}];
		} elsif ($_->[1]=~/^ELine/) {
		    $r=~s/^%%%//; $r="<$r>"; push @order,[$r,$i,$seq[$i]{p}];
		}
	    }
	    @order=map { [($_->[2]+1).': '.$_->[0],$_->[1]] } sort { $a->[2]<=>$b->[2] } @order;
	    if ($_->[1]=~/\+N/) { unshift @order,['None',$_->[3]]; $mu++; }
	    if (($_->[1]=~/\+M/) && defined($$ptr) && ($$ptr eq $cfg{unchg}[1])) {
		unshift @order,$cfg{unchg}; $mu+=2; $r=0; goto nomoretalk;
	    }
	    $r=(($mu&1)?1:0)+(($mu&2)?1:0); if (!defined($$ptr)) { goto nomoretalk; }
	    if ($$ptr=~/^q?end$/) {
		$r=$#order;
		if ($$ptr eq 'qend') { while (($r>0) && ($seq[$order[$r-1][1]]{t}{text}=~/^%%%/)) { $r--; } }
	    } elsif ($$ptr eq 'qstart') {
		while (($r<$#order) && ($seq[$order[$r][1]]{t}{text}=~/^%%%/)) { $r++; }
	    } elsif ($$ptr ne 'start') {
		foreach $i (0..$#order) { if ($order[$i][1]==$$ptr) { $r=$i; last; } }
	    }
nomoretalk: $i=$nw->Optionmenu(-variable=>$ptr,-options=>\@order);
	    $i->setOption($order[$r][0],$order[$r][1]);
	} elsif ($_->[1] eq 'L') { # ------------------------------------------------- L = label
	    $i=$nw->Label(-text=>$_->[2]);
	} elsif ($_->[1]=~/^Col(N)?$/) { # ---------------------- Col(N) = colour picker (+none)
	    my ($b,$d3,$d4,$d5); # 0=label,1=Col,2=varref,3=noneval,4=startcolour
	    $d3=$1; $d4=$_->[3]; $d5=$_->[4];
	    if ($$ptr eq $cfg{unchg}[1])  { $r=[$cfg{wcs}[0],' ??? ']; }
	    elsif ($d3 && ($$ptr eq $d4)) { $r=[$cfg{wcs}[0],'none']; }
	    else                          { $r=[$$ptr,'       ']; }
	    $i=$nw->Frame();
	    $b=$i->Button(-bg=>$r->[0],-activebackground=>$r->[0],-width=>15,-text=>$r->[1],
			  -command=>sub {
		my $c;
		$c=(($$ptr eq $cfg{unchg}[1]) || ($d3 && ($$ptr eq $d4)))?$d5:$$ptr;
		if (defined($c=$nw->chooseColor(-initialcolor=>$c))) {
		    $$ptr=$c; $b->configure(-bg=>$c,-activebackground=>$c,-text=>'');
		}
	    })->grid((($$ptr ne $cfg{unchg}[1])?():($extra[0]=$i->Button(-text=>'?',-command=>sub {
		$$ptr=$cfg{unchg}[1]; $b->configure(-bg=>$cfg{wcs}[0],-activebackground=>$cfg{wcs}[0],-text=>'???');
	    }))),((!$d3)?():($extra[1]=$i->Button(-text=>'0',-command=>sub {
		$$ptr=$d4; $b->configure(-bg=>$cfg{wcs}[0],-activebackground=>$cfg{wcs}[0],-text=>'none');
	    }))));
	    $cbp=$b;
	} elsif ($_->[1] eq 'PISp') { # -------------------------------------- PISp = PI spinbox
	    my $dounch=($$ptr eq $cfg{unchg}[1]);
	    my ($from,$to)=($_->[3],$_->[4]); if (defined($_->[5])) { $r=$_->[5]; } else {
		$r=0.001*($from-$to); $r=int(0.01*$r+0.5); if ($r<1) { $r=1; }
	    }
	    $i=$nw->Spinbox(-bg=>$cfg{wcs}[0],-from=>$from,-to=>$to,-increment=>$r,-width=>7)->
		    pack(-side=>'left',-expand=>1);
	    $i->set($dounch?'':$$ptr); $i->configure(-validate=>'all',-validatecommand=>sub {
		return 0 if $_[0]=~/[^0-9]/; $i->configure(-validate=>'none'); $$ptr=$_[0];
		if (!defined($_[1])) {
		    if ($_[0] eq '') { if (!$dounch) { $$ptr=$from; $i->set($from); } goto nuqe; }
		    if ($_[0]<$from) { $$ptr=$from; $i->set($from); goto nuqe; }
		    if ($_[0]>$to) { $$ptr=$to; $i->set($to); goto nuqe; }
		}
nuqe:	        $i->configure(-validate=>'all'); return 1;
	    });
	} else {
	    $i=$nw->Label(-text=>"Unknown input type '$_->[1]'.");
	}
	$lab=$nw->Label(-text=>$_->[0])->grid($i,-sticky=>'nw');
	if ((!ref($_->[-2])) && (($_->[-2] || '') eq '-cb')) {
	    $cbp||=$i;
	    if (ref($_->[-1]) eq 'ARRAY') { @{$_->[-1]}=($cbp,$lab,@extra); } else { ${$_->[-1]}=$cbp; }
        }
    }
}

sub _CancelOk($$$;$$)
{   my ($win,$btxt,$bcmd,$dest,$cancel)=@_; my ($x,$cb,$rb);
    $cancel||=sub { $win->destroy; DeStatus() if $dest; };
    $x=$win->Frame(-borderwidth=>3)->pack(-side=>'bottom');
    $cb=$x->Button(-text=>defined($btxt)?'Cancel':'Dismiss',-command=>$cancel)->pack(-side=>'right');
    $win->bind('<Escape>',sub { $cb->invoke });
    if (defined($btxt)) {
	$rb=$x->Button(-text=>$btxt,-command=>$bcmd)->pack(-side=>'right');
	$win->bind('<Return>',sub { $rb->invoke });
    } else {
	$win->bind('<Return>',sub { $cb->invoke });
    }
    return $x;
}

sub _DialogInp($$;$)
{   my $x=$_[0]->Frame(-borderwidth=>3)->pack(-side=>'top');
    if ($_[2]) { $x=$x->Frame(-borderwidth=>2,-relief=>'groove')->pack(-side => 'top',-expand=>1); }
    _ComposeInpTable($x,$_[1]); return $x;
}

sub _QuickMessage($$;$)
{   my $window=$_[2] || $mw;
    my $nw=$window->Dialog(-title=>$_[0],-text=>$_[1],-buttons=>['OK']); $nw->Show();
}

sub _AggroCheck(;$)
{   return 0 if $par{agr}; my $window=$_[2] || $mw;
    my $nw=$window->Dialog(-title=>'Sequence changes',-buttons=>['OK, enable it','Cancel'],
			   -text=>'You are trying to make possibly destructive changes to '.
			   'a sequence, which requires \'Aggressive Editing\' to be enabled. '.
			   'If you choose OK, \'Aggressive Editing\' will be turned on and the'.
			   ' current action will proceed, while cancel will abort the current '.
			   'action.',-default_button=>'Cancel');
    return 1 if $nw->Show() eq 'Cancel';
    $par{agr}=1; return 0;
}

sub _NoSequences()
{
    if (!@seq) { _QuickMessage('No sequences!','There is no sequence data.'); return 1; }
    return 0;
}

sub ShouldaSavedEh()
{   my ($nw,$x);
    return undef unless $unsaved; # Nothing to undo - nothing to save...

    $nw=$mw->Dialog(-title=>'Save changes?',-buttons=>['Yes','No','Abort'],-default_button=>'Yes',
		    -text=>'You have unsaved changes in your document. Do you want to save now?');
    $x=$nw->Show();
    return 1 if $x eq 'Abort'; return 0 if $x eq 'No';
    if ($x ne 'Yes') { print STDERR "WARNING: Saving dialog gives strange output - Tk problem?\n"; return 1; }
    if (DumpDataFile($savename)) { return 1; }
    return 0;
}

sub _symbolify($)
{   my %table=map { $_->[0]=>$_->[1] } @symbolmapping;
    return join('',map { chr } map { exists($table{$_})?$table{$_}:$_ } map { ord } split //,$_[0]);
}

sub _unsymbolify($)
{   my %table=map { $_->[1]=>$_->[0] } @symbolmapping;
    return join('',map { chr } map { exists($table{$_})?$table{$_}:$_ } map { ord } split //,$_[0]);
}

sub SequencePicker($$;$$)
{   my ($nw,$edit,$s,%col,$locked,$c,$i,$func,$tb0,$tb1,$bo,$bc,$label,@order,@goodheight);

    return if _NoSequences();
    $func=$_[1]; @goodheight=();

    Status($label || 'Pick sequences...');
    $nw=$mw->Toplevel;
    $label=$_[0]; if ($label=~s/^%L://) { $locked=2; } else { $locked=0; }
    $nw->title($label || 'Pick sequences');

    if ($_[2]) {
      $edit=$nw->Frame(-borderwidth=>2)->pack(-side => 'top'); push @goodheight,$edit;
      $edit->Label(-text=>$_[2],-wraplength=>'5i')->pack(-side=>'top');
    }
    $edit=$nw->Frame(-borderwidth=>5)->pack(-side=>'top',-expand=>1,-fill=>'both');
    $edit=$edit->Frame(-borderwidth=>2,-relief=>'groove')->pack(-side=>'top',-expand=>1,-fill=>'both');
    $edit=$edit->Scrolled('Frame',-scrollbars=>'oe')->
	         pack(-side=>'top',-anchor=>'c',-expand=>1,-fill=>'both');

    $edit->Label(-text=>'Sequence')->grid(-column=>1,-row=>0,-sticky=>'w');
    $edit->Label(-text=>'Use?')->grid(-column=>2,-row=>0);
    if (!$locked) { $edit->Label(-text=>'Colour?')->grid(-column=>3,-row=>0); }

    @order=(); foreach $s (0..$#seq) { if ($seq[$s]{t}{text}!~/^%%%/) {
	push @order,[$s,$seq[$s]{p},$seq[$s]{t}{text},1,1];
    }}
    @order=sort { $a->[1]<=>$b->[1] } @order; $c=1;

    foreach $s (@order) {
	$edit->Label(-text=>($s->[1]+1).':')->grid(-column=>0,-row=>$c,-sticky=>'e');
	$edit->Label(-text=>"  $s->[2]")->grid(-column=>1,-row=>$c,-sticky=>'w');
	push @$s,($edit->Checkbutton(-command => sub {
		      $s->[3]^=1;
		      if ($locked) { $s->[4]^=1; if ($locked<2) { $s->[6]->toggle; } }
		  },-text => '')->grid(-column=>2,-row=>$c),
		  ($locked?():$edit->Checkbutton(-command => sub { $s->[4]^=1; },
						 -text => '')->grid(-column=>3,-row=>$c))
		 );
	$s->[5]->select; if ($locked<2) { $s->[6]->select; } $c++;
    }
    $edit->Button(-text => 'None', -command => sub {
	local $_; foreach (@order) {
	    $_->[3]=0; $_->[5]->deselect;
	    if ($locked) { $_->[4]=0; if ($locked==1) { $_->[6]->deselect; } }
	}
    })->grid(-column=>2,-row=>$c+1,-sticky=>'ew');
    $edit->Button(-text => 'All', -command => sub {
	local $_; foreach (@order) {
	    $_->[3]=1; $_->[5]->select;
	    if ($locked) { $_->[4]=1; if ($locked==1) { $_->[6]->select; } }
	}
    })->grid(-column=>2,-row=>$c+2,-sticky=>'ew');

    if ($locked<2) {
	$tb0=$edit->Button(-text => 'None', -command => sub {
	    local $_; foreach (@order) { $_->[4]=0; $_->[6]->deselect; }
	})->grid(-column=>3,-row=>$c+1,-sticky=>'ew');
	$tb1=$edit->Button(-text => 'All', -command => sub {
	    local $_; foreach (@order) { $_->[4]=1; $_->[6]->select; }
	})->grid(-column=>3,-row=>$c+2,-sticky=>'ew');

	$edit->Checkbutton(-command => sub {
	    local $_; $locked^=1; my $st=$locked?'disabled':'normal';
	    $tb0->configure(-state => $st); $tb1->configure(-state => $st);
	    foreach (@order) {
		if ($locked) {
		    $_->[4]=$_->[3];
		    if ($_->[3]) { $_->[6]->select; } else { $_->[6]->deselect; }
		}
		$_->[6]->configure(-state => $st);
	    }
	},-text => 'Lock?')->grid(-column=>1,-row=>$c+1)->invoke;
    }

    if ($_[3]) { push @goodheight,_DialogInp($nw,$_[3],1); }

    push @goodheight,_CancelOk($nw,'Run',sub {
	my @cal=map { $_->[0] } grep { $_->[3] } @order;
	my %col=map { ($_->[0]=>1) } grep { $_->[4] } @order;
        if (@cal && scalar(keys(%col))) {
            PDumpData($label || 'Modify Sequences',0,1,0);
	    my $r=&$func(\@cal,\%col,$nw);
	    if (!$r) { &PrintSeq; } elsif ($r eq 'NOCLOSE') { SkipUndoData(); $nw->raise(); return; }
	}
	$nw->destroy; DeStatus();
    },1);
    _FixDopeyScrollable($nw,$edit,\@goodheight);
}

sub _FixDopeyScrollable($$$)
{   my ($nw,$edit,$gh)=@_; my ($s,$h,$hmax,$c);
    # AWS: This is some incredibly crappy code to resize the window. Needs help badly.
    $nw->withdraw; $nw->update;
    $h=24+$edit->Subwidget('scrolled')->Subwidget('frame')->reqheight;
    $s=114; if ($h<$s) { $h=$s; } $s=0;
    if (ref($gh)) { foreach $c (@$gh) { $s+=$c->reqheight; } } else { $s+=$gh; }
    $hmax=$screen{SH}-$s; if ($h>=$hmax) { $h=$hmax; }
    $c=int(0.5*($screen{SW}-$nw->reqwidth)); $h+=$s; $s=$nw->reqwidth."x$h+$c+30";
    $nw->geometry($s); $nw->resizable(0,0); $nw->deiconify; $nw->raise; $nw->focus;
}

sub _ListWithMine($$$) # val,list,num?
{   my %x=(); local $_; my @res;
    if (ref($_[0])) { $x{$_[0][1]}=$_[0][0]; } else { $x{$_[0]}=$_[0]; }
    foreach (@{$_[1]}) { if (ref($_)) { $x{$_->[1]}=$_->[0]; } else { $x{$_}=$_; } }
    if ($_[2]) { @res=sort { ($x{$a} eq $cfg{unchg}[0])?-1:(($x{$b} eq $cfg{unchg}[0])?1:($x{$a}<=>$x{$b})) } keys %x; }
    else       { @res=sort { $x{$a} cmp $x{$b} } keys %x; }
    @res=map { [$x{$_},$_] } @res;
    return \@res;
}

sub __fontniceattribs($;$$$)
{   my ($weight,$slant,$bob,$nonorm)=@_; my @prop=();
    if (!defined($slant)) { ($weight,$slant,$bob)=split(/-/,$weight); }
    if (!defined($bob)) { $bob='normal'; } else { $bob=lc($bob); } $weight=lc($weight); $slant=lc($slant);
    if (!$weight || !$slant || !$bob) { return '???'; }
    if ($weight ne 'medium') { push @prop,ucfirst($weight); }
    if ($slant eq 'o')    { push @prop,'Slanted'; } elsif ($slant eq 'i') { push @prop,'Italic'; }
    if (!$nonorm && !@prop) { @prop=('Regular'); }
    if ($bob ne 'normal') { push @prop,'('.ucfirst($bob).')'; }
    return join(' ',@prop);
}

sub __fontnamefromx($)
{   return ($_[0] eq $cfg{unchg}[1])?(exists($fontlist{Helvetica})?'Helvetica':'*'):$_[0]; }

sub __fontpickupdate($$$$) # mode(0=complete,1=att+,2=toponly),font,uiref,attlist
{   my ($mode,$f,$ui,$attlist)=@_; my ($i,$j,$k,$l,$m,$n,$o,$uu,$t);

    $l=($f->[4] eq $cfg{unchg}[1])?'':$f->[4];
    $m=($f->[2] eq $cfg{unchg}[1])?'':$f->[2];
    $n=($f->[3] eq $cfg{unchg}[1])?'':$f->[3];
    $o=($f->[5] eq $cfg{unchg}[1])?'':$f->[5];
    $k=__fontniceattribs($m,$n,$o,1); if ($k) { $k=" $k"; }
    $i=($f->[0] eq $cfg{unchg}[1])?'black':$f->[0];
    $j=$f->[6]; if ((!$j) || ($j eq $cfg{unchg}[1])) { $j=$cfg{wcs}[0]; }
    $t=(($f->[1] eq $cfg{unchg}[1])?'???':$f->[1])."$k, ".($l || '?');
    $t=_symbolify($t) if $f->[1] eq 'Symbol';
    $ui->[0]->configure(-text=>$t,-fg=>$i,-bg=>$j,-font=>$fontlist{__fontnamefromx($f->[1])}[1].
			($m || 'medium').'-'.($n || 'r').'-'.($o || '*').'-*-'.($l || '*').'-*-');
    $ui->[1]->configure(-bg=>($j?$j:$cfg{wcs}[0]));
    if (!$mode) {
	$ui->[2]->delete(0,'end'); $j=undef; $k=0;
	if ($f->[1] eq $cfg{unchg}[1]) { $ui->[2]->insert('end',''); $k++; $j=0; }
	foreach $i (sort keys %fontlist) { if ($i eq $f->[1]) { $j=$k; } $k++; $ui->[2]->insert('end',$i); }
	if (defined($j)) { $ui->[2]->selectionSet($j); $ui->[2]->see($j); }
    }
    if ($mode<=1) {
	$ui->[3]->delete(0,'end'); $j=undef; $k=0; splice @$attlist,0;

	if (exists($fontlist{$f->[1]})) { $uu=$fontlist{$f->[1]}[2]; } else { $uu=$cfg{fontmstyles}; }
	if ((!$m) || (!$n) || (!$o)) {
	    push @$attlist,"$f->[2]-$f->[3]-$f->[5]"; $k++; $j=0; $ui->[3]->insert('end','');
	}
	foreach $i (@$uu) {
	    push @$attlist,$i;
	    if ($i eq lc("$f->[2]-$f->[3]".((lc($f->[5]) eq 'normal')?'':'-'.$f->[5]))) { $j=$k; }
	    $k++; $ui->[3]->insert('end',__fontniceattribs($i));
	}
	if (defined($j)) { $ui->[3]->selectionSet($j); $ui->[3]->see($j); }
    }
}

sub _FontPickButton($$)
{   my ($f,$l)=@_;
    my $fgc=($f->[0] eq $cfg{unchg}[1])?'black':$f->[0];
    my $bgc=$f->[6]; if ((!$bgc) || ($bgc eq $cfg{unchg}[1])) { $bgc=$cfg{wcs}[1]; }
    my $fsz=(($f->[4] eq $cfg{unchg}[1]) || ($f->[4] eq ''))?'?':$f->[4];
    my $flab=($f->[1] eq $cfg{unchg}[1])?'???':$f->[1];
    my $tt="$flab, $fsz"; $tt=_symbolify($tt) if $f->[1] eq 'Symbol';
    $l->configure(-font=>$fontlist{__fontnamefromx($f->[1])}[1].
		  ((($f->[2] eq $cfg{unchg}[1]) || (!$f->[2]))?'medium':$f->[2]).'-'.
		  ((($f->[3] eq $cfg{unchg}[1]) || (!$f->[3]))?'r':$f->[3]).'-'.
		  ((($f->[5] eq $cfg{unchg}[1]) || (!$f->[3]))?'*':$f->[5]).'-*-*-*-',
		  -text=>$tt,-fg=>$fgc,-bg=>$bgc);
}


sub _FontPicker($$$;$)
{   my ($mw,$ifont,$label,$cref)=@_; my ($nw,$tb,$i,@ui,@font,@cb,$cc1,$cc2,$cc4,$cc7,$cc8,@attlist,$fsx);

    $nw=$mw->Toplevel; $nw->focus; $nw->title('Choose a Font');
    @font=@$ifont;

    if ((!exists($fontlist{$font[1]})) && ($font[1] ne $cfg{unchg}[1])) { $font[1]=(sort keys %fontlist)[0]; }

    $fsx=(($font[4] eq $cfg{unchg}[1]) || ($font[4] eq '') || ($font[4]<32))?32:$font[4];

    $i=$nw->Frame(-borderwidth=>1,-relief=>'sunken',-bg=>$cfg{wcs}[0])->pack(-side=>'top',-fill=>'x');
    $ui[1]=$i->Label(-bg=>$cfg{wcs}[0],-text=>' ',-anchor=>'w',-font=>'-*-helvetica-*-*-*-*-'.
		     (8+$fsx).'-*')->pack(-side=>'left');
    $ui[0]=$i->Label(-text=>'',-anchor=>'w',-bg=>$cfg{wcs}[0])->
	       pack(-side=>'left',-anchor=>'w',-fill=>'both',-expand=>1);
    $tb=$nw->Frame(-width=>2,-relief=>'sunken')->pack(-side=>'top',-fill=>'both',-anchor=>'w');

    $i=$tb->Frame()->grid(-column=>0,-row=>0,-sticky=>'nsw');
    $i->Label(-text=>'Font',-anchor=>'w')->pack(-side=>'top',-fill=>'x',-anchor=>'w');
    $ui[2]=$i->Scrolled('Listbox',-scrollbars=>'e',-selectmode=>'single',-exportselection=>0)->
	       pack(-fill=>'both',-expand=>1);

    $i=$tb->Frame()->grid(-column=>1,-row=>0,-sticky=>'nsw');
    $i->Label(-text=>'Attributes',-anchor=>'w')->pack(-side=>'top',-fill=>'x',-anchor=>'w');
    $ui[3]=$i->Scrolled('Listbox',-scrollbars=>'e',-selectmode=>'single',-exportselection=>0)->
	       pack(-fill=>'both',-expand=>1);

    $i=$tb->Frame()->grid(-column=>2,-row=>0,-sticky=>'nw'); $cb[0]=[]; $cb[1]=[];
    _ComposeInpTable($i,[
	['','L',''],['Font size:','PISp',\$font[4],2,$fsx,undef,-cb=>\$cb[2]],
        ['Colour:','Col',\$font[0],0,'Black',-cb=>$cb[0]],
	defined($font[6])?['Background:','ColN',\$font[6],0,'White',-cb=>$cb[1]]:(),
    ]);
    # Now patch us into the buttons etc.
    $cc1=$cb[0][0]->cget(-command);
    $cb[0][0]->configure(-command=>sub { $cc1->Call(@_); __fontpickupdate(2,\@font,\@ui,\@attlist); });
    if (defined($cb[0][2])) {
	$cc7=$cb[0][2]->cget(-command);
	$cb[0][2]->configure(-command=>sub { $cc7->Call(@_); __fontpickupdate(2,\@font,\@ui,\@attlist); });
    }
    if (defined($font[6])) {
	$cc2=$cb[1][0]->cget(-command); $cc4=$cb[1][3]->cget(-command);
	$cb[1][0]->configure(-command=>sub { $cc2->Call(@_); __fontpickupdate(2,\@font,\@ui,\@attlist); });
	$cb[1][3]->configure(-command=>sub { $cc4->Call(@_); __fontpickupdate(2,\@font,\@ui,\@attlist); });
	if (defined($cb[1][2])) {
	    $cc8=$cb[1][2]->cget(-command);
	    $cb[1][2]->configure(-command=>sub { $cc8->Call(@_); __fontpickupdate(2,\@font,\@ui,\@attlist); });
	}
    }
    $cb[2]->configure(-command=>sub { __fontpickupdate(2,\@font,\@ui,\@attlist); });
    $cb[2]->bind('<FocusOut>',sub { __fontpickupdate(2,\@font,\@ui,\@attlist); });

    $ui[2]->bind('<1>',sub {
	my $i=$ui[2]->curselection();
	if ($i) {
	    $font[1]=$ui[2]->get($i->[0]) || $cfg{unchg}[1];
	    _ValidateFont(\%fontlist,\$font[1],\$font[2],\$font[3],1);
	    __fontpickupdate(1,\@font,\@ui,\@attlist);
	}
    });
    $ui[3]->bind('<1>',sub {
	my $i=$ui[3]->curselection();
	if ($i) {
	    my ($j,$k); ($i,$j,$k)=split(/-/,$attlist[$i->[0]]);
	    if (defined($j)) {
		$font[5]=$k||'normal'; $font[2]=ucfirst($i); $font[3]=ucfirst($j);
		__fontpickupdate(2,\@font,\@ui,\@attlist);
	    }
	}
    });
    __fontpickupdate(0,\@font,\@ui,\@attlist);
    $nw->resizable(0,0);

    _CancelOk($nw,'OK',sub {
	@$ifont=@font; if (defined($label)) { _FontPickButton(\@font,$label); }
	if (defined($cref)) { $cref->(); }
	$nw->destroy;
    });
}

sub _Autobrowse($)
{   return if !$cfg{autobrowse}; $_[0][2]->Invoke(); }


sub _WriteGoodConfig($$;$)
{   my ($data,$target,$nw)=@_; my ($i,$dexp,$fh);

    foreach $i (sort keys %$data) {
	__deepcopy($data->{$i},\$cfgtemplate{$i});
	$dexp.=$i.' => '._argio($data->{$i}[0],2).",\n" if $data->{$i}[3];
    }
    if (-e $target) {
	$i="Cannot write configuration file."; rename $target,$target.'~' or goto gonk;
    }
    $i="Cannot open '$target' for writing."; $fh=undef; open $fh,'>'.$target or goto gonk2;
    $i="Cannot write configuration to '$target'."; print {$fh} $dexp or goto gonk2; close $fh;
    if (defined($nw)) { $nw->destroy; }
    return;
gonk2:
    rename $target.'~',$target;
gonk:
    _QuickMessage('Error',$i,$nw);
}

sub ConfigDialog
{   my ($nw,@list,$tbit,$mbit,$bbit,$cb,$okb1,$okb2,$data);

    $data=''; __deepcopy(\%cfgtemplate,\$data);

    $nw=$mw->Toplevel(); $nw->focus; $nw->grab; $nw->title('Aline Configuration');

    $tbit=$nw->Frame(-borderwidth=>2)->pack(-side => 'top');
    $tbit->Label(-text=>'These settings define the default values on program startup. As such '.
                        'changes will only have an effect after aline is restarted.',
                 -wraplength=>'5i')->pack(-side=>'top',-fill=>'x');
    $mbit=$nw->Frame(-borderwidth=>5)->pack(-side=>'top',-expand=>1,-fill=>'both');
    $mbit=$mbit->Scrolled('Frame',-scrollbars=>'oe')->pack(-side=>'top',-anchor=>'c',-expand=>1,-fill=>'both');

    _DialogInp($mbit,[map { $_->[1]=~s/[.:?]$//; $_->[1].=':'; [$_->[1],
                            ref($_->[2])?'E':$_->[2],\$_->[0],ref($_->[2])?$_->[2]:undef] }
		    sort { ($b->[3]<=>$a->[3]) or (lc($a->[1]) cmp lc($b->[1])) }
		    grep { defined($_->[2]) && $_->[3] } values %$data]);

    $bbit=$nw->Frame(-borderwidth=>3)->pack(-side=>'bottom');
    $cb=$bbit->Button(-text=>'Cancel',-command=>sub { $nw->destroy; })->pack(-side=>'right');
    $okb2=$bbit->Button(-text=>'Store as System Defaults',
                        -command=>sub { _WriteGoodConfig($data,'/etc/alinerc',$nw); })->pack(-side=>'right');
    $okb1=$bbit->Button(-text=>'Store as Personal Defaults',
                        -command=>sub { _WriteGoodConfig($data,$home.'.alinerc',$nw); })->pack(-side=>'right');
    $nw->bind('<Escape>',sub { $cb->invoke; });
    $nw->bind('<Return>',sub { $okb1->invoke; });

    _FixDopeyScrollable($nw,$mbit,$screen{SH}-100);    
}

sub _PropertyWindow($$$$)
{   my ($cels,$title,$undot,$flags)=@_; my ($nw,@tc,$chits,$i,@v);
    return if !@$cels;

    @tc=([],[],[]); $chits=0; @v=(undef,undef,undef);
    foreach $i (@$cels) { $nw=scalar(@$i)-1; push @{$tc[$nw]},$i; $chits|=(1<<$nw); }

    $nw=$mw->Toplevel; $nw->focus; $nw->title($title);

    if (($chits==1) || ($chits==2) || ($chits==4)) {
	if (!defined($v[0]=_PropertySheet($cels,$nw,$flags,[$undot]))) { $nw->destroy(); return; }
    } else {
	foreach $i (0..2) { if (@{$tc[$i]}) {
	    $chits=$nw->LabFrame(-label=>('Title','Sequence','Object')[$i],-labelside=>'acrosstop',
	       -fg=>'#206060',-font=>'-*-Helvetica-Normal-*-*-*-*-*-*-*-*-*-*')->pack(-side=>'top',-fill=>'x');
	    $v[$i]=_PropertySheet($tc[$i],$chits,$flags,0);
	}}
    }

    _CancelOk($nw,'OK',sub {
	PDumpData($undot,0,1,0); my $ch=0;
	foreach my $i (0..2) { if (defined($v[$i])) { $ch|=$v[$i]->(); } }
	if ($ch) { PrintSeq(); } $nw->destroy();
    });
}

sub _PropertySheet($$$$)
{   my ($cels,$win,$flags,$solo)=@_; my ($i,$j,$k,$l,$mode,$ob,@foi,$nw,$obo,$tt,$code);
    return(sub {}) if !@$cels;
    $mode=scalar(@{$cels->[0]})-1; # 0=title, 1=seq, 2=obj
    if ($mode==0)    { @foi=(qw(text comment attach FONT_title)); }
    elsif ($mode==1) { @foi=(qw(FONT_font)); }
    else             { @foi=(qw(otext type lc fc lw FONT_font anchor)); }

    for ($i=$#foi;$i>=0;$i--) { # Exclude obviously useless entries...
	$j=$foi[$i];
	if ((($j eq 'attach') && ($cfg{noattach})) ||
	    (!exists($propwindata{$j})) ||
	    (($propwindata{$j}[0]&4) && (@$cels>1)) ||
	    (($propwindata{$j}[0]&16) && (!($flags&1)))) { splice @foi,$i,1; next; }
    }
    foreach $i (@$cels) { # Check out the actual data...
	if ($mode==0)    { $ob=$seq[$i->[0]]{t}; }
	elsif ($mode==1) { $ob=$seq[$i->[0]]{e}[$i->[1]]; }
	else             { $ob=$seq[$i->[0]]{o}[$i->[1]]{e}[$i->[2]]; $obo||=$ob->{type}; }
	for ($k=$#foi;$k>=0;$k--) {
	    $tt=ref($foi[$k])?$foi[$k][0]:$foi[$k];
	    if (($tt=~/^(?:anchor|otext)$/) && ($ob->{anchor} eq 'nw')) { next; } # special - text only
	    if ($tt=~/^FONT_(.*)/) {
		if (!ref($foi[$k])) { $foi[$k]=[$foi[$k],undef]; }
		$foi[$k][1]=_FontEnt2Block($ob,$1,$foi[$k][1]);
	    } else {
		if (!exists($ob->{$tt})) { splice @foi,$k,1; next; }
		if (!ref($foi[$k])) { $foi[$k]=[$tt,$ob->{$tt}]; next; }
		if (@{$foi[$k]}>1) {
		    $l=$ob->{$tt};
		    if (($propwindata{$tt}[0]&2)?($l!=$foi[$k][1]):($l ne $foi[$k][1])) {
			delete $foi[$k][1];
		    }
		}
	    }
	}
    }
    for ($j=$#foi;$j>=0;$j--) { # Multivalue -> delete or set to 'unchanged'
	if (!ref($foi[$j])) { splice @foi,$j,1; next; }
	if (@{$foi[$j]}<2) {
	    if ($propwindata{$foi[$j][0]}[0]&1) { splice @foi,$j,1; } else { $foi[$j][1]=$cfg{unchg}; }
	}
    }
    return(sub {}) if !@foi;

    $k=[];
    foreach $i (@foi) { # Fill composer structure
	$l=$propwindata{$i->[0]}; push @$k,[$l->[1],$l->[2],\$i->[1]];
	if ($l->[2] eq 'E') {
	    if (!ref($l->[3])) { $j=_ObTypeList($objectdata{$obo}[0]);  } else { $j=$l->[3]; }
	    $j=_ListWithMine($i->[1],$j,$l->[0]&2);
	    if (@$j>1) { push @{$k->[-1]},$j; } else { pop @$k; }
	} else { push @{$k->[-1]},@{$l->[3]}; }
    }

    $code=sub {
	my $ch=0;
	foreach $i (@$cels) {
	    if ($mode==0)    { $ob=$seq[$i->[0]]{t}; }
	    elsif ($mode==1) { $ob=$seq[$i->[0]]{e}[$i->[1]]; }
	    else             { $ob=$seq[$i->[0]]{o}[$i->[1]]{e}[$i->[2]]; }
	    foreach $k (0..$#foi) {
		if ($foi[$k][0]=~/^FONT_(.*)/) {
		    $ch|=_FontBlock2Ent($foi[$k][1],$ob,$1);
		} elsif ($foi[$k][1] ne $cfg{unchg}[1]) {
		    $ob->{$foi[$k][0]}=$foi[$k][1]; $ch|=$propwindata{$foi[$k][0]}[0]&8;
		}
	    }
	}
	if ($ch) { _Invalidate($cels); }
	return $ch;
    };

    if (ref($solo) && (@foi==1) && ($foi[0][0]=~/^FONT_/)) { # special case - only a font
	_FontPicker($mw,$foi[0][1],undef,sub {
	    PDumpData($solo->[0],0,1,0); if ($code->()) { PrintSeq(); }
	});
	return undef;
    }

    _DialogInp($win,$k);
    return $code;
}

sub RecolourObjAction
{   return if ($_[4]&254);
    my ($s,$o)=FindObjectAt($_[2],$_[3]);
    return 1 if !defined($s);
    PDumpData('Recolour Object',0,1,0);
    RecolourObject($s,$o,$_[4]!=1);
    PrintSeq();
    return 1;
}

sub RecolourObject($$;$)
{   my ($s,$t,$x)=@_; my ($oc,$i);
    $oc=ObjCells($s,$t,defined($x)?$x:1);
    foreach $i (@$oc) {
	$seq[$i->[0]]{o}[$i->[1]]{e}[$i->[2]]{lc}=$cfg{lc};
	$seq[$i->[0]]{o}[$i->[1]]{e}[$i->[2]]{fc}=$cfg{fc};
    }
}

sub RecolourObs
{   my ($oax,$oay,$ax,$ay)=($_[0]||0,$_[1],$draginfo{xa}||0,$draginfo{ya}); my ($i,$j,$o,@tra);
    return if $_[4]; return unless action_is('recolour'); return [0] if $_[6];

    $ay%=@seq;
    if ($oax>$ax) { $i=$oax; $oax=$ax; $ax=$i; } if ($oay>$ay) { $i=$oay; $oay=$ay; $ay=$i; }
    foreach $i (@seq) { if (($i->{p}>=$oay) && ($i->{p}<=$ay)) { push @tra,$i; } }

    if ($draginfo{class}==2) { # colour titles
	PDumpData('Recolour Titles',0,1,0);
	foreach $i (@tra) { $i->{t}{titlefill}=$cfg{lc}; _InvalidatePtr($i->{t},0); }
    } elsif ($draginfo{class}!=3) {
	return 1;
    } elsif (action_is('recolours')) { # colour sequence
	PDumpData('Recolour Sequences',0,1,0);
	foreach $i (@tra) {
	    foreach $j ($oax..$ax) {
		$i->{e}[$j]{fontfill}=$cfg{lc}; $i->{e}[$j]{fontbg}=$cfg{fc}; _InvalidatePtr($i->{e}[$j],1);
	    }
	}
    } elsif (action_is('recolouro')) { # colour objects
	PDumpData('Recolour Objects',0,1,0);
	foreach $i (@tra) {
	    foreach $o (@{$i->{o}}) {
		foreach $j (@{$o->{e}}) { if (($j->{xpos}>=$oax) && ($j->{xpos}<=$ax)) {
		    $j->{lc}=$cfg{lc}; $j->{fc}=$cfg{fc};
		}}
	    }
	}
    } else {
	return 1;
    }
    PrintSeq(); return 1;
}

sub EditTitle
{   my ($Aly,$oAly,$i,@x);
    return if $_[4]; return [0] if $_[6];
    $Aly=$_[1]; $oAly=$draginfo{ya} % @seq;
    if ($oAly>$Aly) { $i=$Aly; $Aly=$oAly; $oAly=$i; }
    @x=(); foreach $i (0..$#seq) { if (($seq[$i]{p}>=$oAly) && ($seq[$i]{p}<=$Aly)) { push @x,[$i]; } }
    _PropertyWindow(\@x,'Edit Title Properties','Edit Title Properties',0); return 1;
}

sub SelectBoxAction
{   return if $_[4]; return [0] if $_[6]; SelectBox($_[0],$_[1],$draginfo{xa},$draginfo{ya}); return 1; }

sub SelectBox {
    # Get canvas coordinates
    return unless action_is('prpreg');
    my ($Alx,$Aly,$oAlx,$oAly)=@_; my ($s,$n,$o,$x);
    my @sout=();

    if ($oAlx>$Alx) { $s=$Alx; $Alx=$oAlx; $oAlx=$s; }
    if ($oAly>$Aly) { $s=$Aly; $Aly=$oAly; $oAly=$s; }

    foreach $s (0 .. $#seq) {
	if (($seq[$s]{p}>=$oAly) && ($seq[$s]{p}<=$Aly)) {
	    if ($oAlx<@{$seq[$s]{e}}) {
		$n=$#{$seq[$s]{e}}; if ($Alx<$n) { $n=$Alx; }
		push @sout,map { [$s,$_] } ($oAlx..$n);
	    }
	    foreach $o (0..$#{$seq[$s]{o}}) {
		foreach $n (0..$#{$seq[$s]{o}[$o]{e}}) {
		    $x=$seq[$s]{o}[$o]{e}[$n]{xpos};
		    if (($x>=$oAlx) && ($x<=$Alx)) { push @sout,[$s,$o,$n]; }
		}
	    }
	}
    }
    _PropertyWindow(\@sout,actionname(),actionname(),0);
}

sub _ApplyEdits($$)
{   my ($slist,$oo)=@_; my (@e,$i,$s,$q);
    return if !@$slist;
    if (@{$slist->[0]}==2) {
	@e=(qw(fontfill fontsize fontfoundry fontslant fontweight fontbg));
	foreach $s (@$slist) {
	    $q=$seq[$s->[0]]{e}[$s->[1]];
	    for ($i=0;$i<@e;$i++) {
		if ($oo->[$i] ne $cfg{unchg}[1]) { $q->{$e[$i]}=$oo->[$i]; }
	    }
	}
	_Invalidate($slist);
    } elsif (@{$slist->[0]}==3) {
	@e=(qw(fc lc lw fontfill fontsize fontfoundry fontslant fontweight));
	foreach $s (@$slist) {
            my $q=$seq[$s->[0]]{o}[$s->[1]]{e}[$s->[2]];
	    for ($i=0;$i<@e;$i++) {
		if ($oo->[$i] ne $cfg{unchg}[1]) { $q->{$e[$i]}=$oo->[$i]; }
	    }
	}
    }
}

sub ___pstransform0($$$)
{   local $_=shift; my ($r,$glyphs)=@_; my $bc=$_; $$r=0;
    my $x=join('',values %$glyphs);
    if (!s/(0 0 moveto \(TXygqPZ)(\) false charpath[\s\r\n]+pathbbox dup \/baseline exch def)/$1$x$2/g) {
	$$r=1; return $bc;
    }
    return $_;
}

sub ___pstransform1($$)
{   local $_=shift; my $r=shift; my $bc=$_; $$r=0;
    if (!s|(/DrawText)(\s)|$1X$2|) { $$r=1; return $bc; }
    if (!s|cstringshow|cstringshowx|g) { $$r=1; return $bc; }
    s/^[\r\n]+//; return $bc.$_;
}

sub ___pstransform2($$)
{   local $_=shift; my $r=shift; my $bc=$_; $$r=0;
    if (!s|(/cstringshow)(\s)|$1x$2|) { $$r=1; return $bc; }
    if (!s| show | false charpath true setstrokeadjust \[\] 0 setdash stroke |) { $$r=1; return $bc; }
    s/^[\r\n]+//; return $bc.$_;
}

sub ___pstransform3($$$$)
{   my ($dat,$r,$xgllist,$xglptr)=@_; local $_; my (@f,$lb,$i,@sa,$glyph,$out); $$r=0;
    @f=split /[\r\n]+/,$dat;
    foreach (@f) {
	$lb=$_;
	if (!s/^\[\s*// || !s/\s*\]\s*$//) { $$r=1; return $dat; } $out='[(';
	while (length($_)) {
	    if (s/^\(([^\)]*)\)//s) { $out.=$1; next; }
	    if (s/^\/([^\(\/]+)//s) {
		$glyph=$1;
		if ($glyph=~/^[A-Za-z]$/) { $out.=$glyph; next; }
		if (!exists($glyphlist{$glyph})) {
		    if (exists($xgllist->{$glyph})) { $out.=$xgllist->{$glyph}; next; }
		    if ($$xglptr==256) { $$xglptr=1; } elsif ($$xglptr==32) {
			$i="Not enough space to accomodate nonstandard glyph '$glyph'."; goto badgly;
		    }
		    $xgllist->{$glyph}=sprintf('\\%o',$$xglptr); $out.=$xgllist->{$glyph};
		    $$xglptr++; next;
		}
		$out.=$glyphlist{$glyph};
		next;
	    }
	    $i="Cannot parse printable '$lb'."; goto badgly;
	}
	$_=$out.')]';
	next;
badgly: print STDERR "WARNING: $i\n"; $_=$lb;
    }
    return join("",map { "$_\n" } @f);
}

sub ___pstransform4($$$)
{   my ($ps,$r,$padding)=@_; my ($s,$o,$x,$y,$dx,$dy,$lw,$lwpix,$cp,$yy);
    $$r=0;
    foreach $s (@seq) {
	foreach $o (@{$s->{o}}) {
	    if ($o->{e}[0]{type} eq 'OutlineText') {
		($x,$y)=AlxeltoPixel($o->{e}[0]{xpos},$s->{p}); $y=$maxmax[1]-$y-0.5*$par{csv};
		if ($o->{e}[0]{anchor} ne 'w') { $x+=(($o->{e}[0]{anchor} eq 'c')?0.5:1.0)*$par{csh}; }
		if (!ref($padding)) { $y+=$padding; } else { $y=$padding->($x,$y); }
		$lw=$o->{e}[0]{lw}; $lwpix=($lw+1)>>1; $yy=undef;

		for ($dx=-$lwpix;$dx<=$lwpix;$dx++) {
		    for ($dy=-$lwpix;$dy<=$lwpix;$dy++) {
			if ($dx || $dy) {
			    $cp='([-.0-9]+\s+[-.0-9]+\s+[-.0-9]+)\s+setrgbcolor AdjustColor\s*'.
				($x+$dx).' '.($y+$dy).' \[\s*\[[^\]]*\]\s*\].*?DrawText\s*grestore\s*gsave\s*';
			    if ($ps!~s/$cp//s) { $$r=1; return $ps; }
			    $yy=$1;
			}
		    }
		}
		if (defined($yy)) {
		    $cp='('.$yy.'\s+setrgbcolor AdjustColor\s*'.
			$x.' '.$y.' \[\s*\[[^\]]*\]\s*\].*?DrawText)(\s*grestore\s*gsave\s*)';
		    if ($ps!~s/$cp/$lw setlinewidth $1X$2/) { $$r=1; return $ps; }
		} else {
		    $$r=1; return $ps;
		}
	    }
	}
    }
    return $ps;
}

sub ___pstransform5($$$)
{ my ($chnk,$fb,$glyphs)=@_; my ($bc,@gdata,$i,$v);
  $$fb=0; $bc=$chnk;

  # String to glyph array
  $chnk=~s/[\r\n\s]+//g; if ($chnk!~s|^/||) { $$fb=1; return $bc; }
  @gdata=split(/\//,$chnk); if (@gdata!=256) { $$fb=1; return $bc; }

  # Update entries
  foreach $i (keys %$glyphs) { $v=oct(substr($glyphs->{$i},1)); $gdata[$v]=$i; }

  # Glyph array back to string
  $chnk=''; while (@gdata>=8) { $chnk.=join('',map { "/$_" } @gdata[0..7])."\n"; splice @gdata,0,8; }
  if (@gdata) { $chnk.=join('',map { "/$_" } @gdata)."\n"; }
  return $chnk;
}

sub MungeBadPS($;$$)
{   local $_=shift; my $r=shift; my $padding=shift; my ($scale,$fob,%extraglyphs,$nextxglyph);
    $$r=0 if defined($r); $padding=1 if !defined($padding);

    # Fix outline font stuff
    $_=___pstransform4($_,\$fob,$padding); if ($fob) { goto bailoutmunger; }

    # (P)rescale fonts
    $scale=$cfg{psfontscale};
    if ($scale<0) { $scale*=-$canvas->scaling; }
    $fob="\n\n/scalefont {\n$scale mul scalefont\n} bind def\n";
    s|([\r\n]+/cstringshow)|$fob$1|;

    # Duplicate DrawText and cstringshow to generate outlining versions
    if ((!s|([\r\n]/DrawText\s+\{.*?[\r\n]\}\s+bind\s+def\s*[\r\n]+)|___pstransform1($1,\$fob)|es) ||
        ($fob>0)) { goto bailoutmunger; }
    if ((!s|([\r\n]/cstringshow\s+\{.*?[\r\n]\}\s+bind\s+def\s*[\r\n]+)|___pstransform2($1,\$fob)|es) ||
        ($fob>0)) { goto bailoutmunger; }    

    # Turn glyphs going into DrawText(X) back into strings
    $fob=0; %extraglyphs=(); $nextxglyph=127;
    s/(\[\s*[\r\n]+)((?:\[[^\]]+\]\s*[\r\n]+)+)(\][^\r\n]+DrawTextX?[\r\n]+)/
      $1.___pstransform3($2,\$fob,\%extraglyphs,\$nextxglyph).$3/gexs;
    if ($fob>0) { goto bailoutmunger; }

    # Stomp on the delicate flower that is DrawText, heh heh hehehehe
    $_=___pstransform0($_,\$fob,\%extraglyphs); if ($fob) { goto bailoutmunger; }

    # Manipulate Encoding dictionary
    if ((!s|(/CurrentEncoding +\[\s*[\r\n]+)(.*?)(\] +def *[\r\n]+)|$1.___pstransform5($2,\$fob,\%extraglyphs).$3|es) ||
	($fob>0)) { goto bailoutmunger; }

    # Make Symbol use the proper encoding
    s|(/Symbol +findfont +[0-9]+ +scalefont +)(setfont *[\r\n]+)|${1}ISOEncode $2|gs;

    return $_;
bailoutmunger:
    if (defined($r)) { $$r=1; }
    else             { print STDERR "WARNING: Cannot munge Tk PostScript into something vaguely useful.\n"; }
    return $_;
}

sub PrintPNG(;$$)
{   my ($filename,$resol)=@_; my ($nw);

    $filename||=$mw->Tk::getSaveFile(-defaultextension => '.png',
				     -filetypes        => [['PNG Images','.png'],['All Files','*']],
				     -initialfile      => 'aline.png',
				     -title            => 'Select an output file'
    );
    return if !defined($filename);
    $nw=$mw->Toplevel; $nw->focus; $nw->title('PNG Writer');
    if (!defined($resol) || ($resol!~/^[0-9]+(?:\.[0-9]+)?$/)) { $resol=300; }
    _DialogInp($nw,[
        ['Resolution','FH',\$resol,\@resohistory]
    ]);
    _CancelOk($nw,'OK',sub {
	my ($i,$tfn);
	if ($resol!~/^\s*[0-9]+(?:\.[0-9]+)?\s*$/) { return; } # Duh!
	foreach $i (@resohistory) { if ($i=$resol) { goto nonewr; } }
	push @resohistory,$resol; @resohistory=sort {$a<=>$b} @resohistory;
nonewr: $tfn='aline.temp.png.'.$$.'.'.int(rand(65536));
	PrintPS($tfn);
	if (-e $tfn) {
	    $i=_SQuote($cfg{gsloc}).' -r'.$resol.' -dSAFER -dBATCH -dNOPAUSE -sDEVICE=png16m '.
               '-dEPSCrop -dGraphicsAlphaBits=4 -dTextAlphaBits=4 '.
               _SQuote('-sOutputFile='.$filename).' '._SQuote($tfn).' 2>&1'; $i=`$i`;
	    if ((! -e $filename) || ($i=~/Unrecoverable error/)) {
		_QuickMessage('Oops','An error has occured while rendering the image.',$nw);
		unlink $filename;
	    }
	    unlink $tfn;
	}
	$nw->destroy;
    });
}

sub PrintPS(;$)
{   my ($filename,$ps,$s1,$padding);
    $filename=$_[0] || $mw->Tk::getSaveFile(-defaultextension => '.eps',
					    -filetypes        => [['EPS Files','.eps'],['All Files','*']],
					    -initialfile      => 'aline.eps',
					    -title            => 'Select an output file'
    );
    return if !defined($filename);
    open (F1,">$filename") || die "Can't open file";
    _GridOff(); $canvas->delete(-tags=>'cursor');
    $padding=10;
    $ps=$canvas->postscript(-x          => $par{ofx}-$padding,
			    -y          => $par{ofy}-$padding,
			    -pageanchor => 'center',
			    -width      => $maxmax[0]-$par{ofx}+($padding<<1),
			    -height     => $maxmax[1]-$par{ofy}+($padding<<1));
    $s1="$prog{name} $prog{version}";
    $ps=~s/%%Creator:[^\r\n]*/%%Creator: $s1\n%%Creator: $prog{author} $prog{website}\n%%Creator: Tk Canvas Widget/;
    print F1 MungeBadPS($ps,\$s1,$padding); close (F1);

    Grid() if $cfg{grid}; _refreshCursor();    

    if ($s1) { _QuickMessage('Oops','There has been an error processing the PostScript data.'); unlink $filename; }
}

sub _InsSeqNum($$)
{   my ($s,$x)=@_; my ($l,$j,$n);

    if (defined($s->{n})) { return undef; }
    $n=[undef,undef];
    for ($j=$x-1;$j>=0;$j--) {
	if (defined($s->{e}[$j]{seqnumber})) { $n->[0]=$s->{e}[$j]{seqnumber}; last; }
    }
    for ($j=$x;$j<@{$s->{e}};$j++) {
	if (defined($s->{e}[$j]{seqnumber})) { $n->[1]=$s->{e}[$j]{seqnumber}; last; }
    }

    if (!defined($n->[0])) {
	if (defined($n->[1])) {
	    $n=int($n->[1]); if (int($n)==$n) { $n--; }
	} else { $n=1; }
    } elsif ((!defined($n->[1])) || ($n->[1]>int(1+$n->[0]))) {
	$n=int($n->[0]+1);
    } else {
	$n->[0]+=0.0001; if ($n->[0]==$n->[1]) {
	    $l=$n->[1];
	    for ($j=$x;$j<@{$s->{e}};$j++) { if (defined($s->{e}[$j]{seqnumber})) {
		if ($s->{e}[$j]{seqnumber}==$l) { $l+=0.0001; $s->{e}[$j]{seqnumber}=$l; }
		else { last; }
	    }}
	}
	$n=$n->[0];
    }
    return $n;
}

sub FillChar($)
{   my $n=$_[0]{t}{text}; if ($n=~s/^%%%//) { return $specialrows{$n}[1] || ' '; } return $cfg{gapchar} || '.'; }

sub _AttachmentForX($;$)
{   my ($chg,$i,$atta); my %list=($_[0]=>1);
nextrndAFX:
    $chg=0;
    foreach $i (keys %list) {
	$atta=$seq[$i]{t}{attach}; if (($atta>=0) && (!exists($list{$atta}))) { $chg=1; $list{$atta}=1; }
    }
    for ($i=0;$i<@seq;$i++) {
	if (!exists($list{$i})) { $atta=$seq[$i]{t}{attach}; if (exists($list{$atta})) { $chg=1; $list{$i}=1; } }
    }
    goto nextrndAFX if $chg;
    delete $list{$_[0]} if $_[1];
    return [keys %list];
}

sub _InsertAttachmentElements($$)
{   my %aptr=(); my %silence=(); my ($s,$i,$j,$k,$chg);
    foreach $i (@{$_[0]}) { $silence{$i->[1]}=1; }
qeIAE:
    $chg=0;
    foreach $s (0..$#seq) {
	if (($seq[$s]{t}{attach}>=0) && ($seq[$s]{t}{attach}!=$s)) {
	    $i=$seq[$s]{t}{attach}; $j=$s; if ($_[1]) { $i=$seq[$i]{p}; $j=$seq[$j]{p}; }
	    if (!$silence{$j}) {
		$aptr{$i}||={}; $chg||=!exists($aptr{$i}{$j}); $aptr{$i}{$j}=1;
		foreach $k (keys %{$aptr{$j}}) {
		    if ($k!=$i) { $chg||=!exists($aptr{$i}{$k}); $aptr{$i}{$k}=1; }
		}
	    }
	    if (!$silence{$i}) {
		$aptr{$j}||={}; $chg||=!exists($aptr{$j}{$i}); $aptr{$j}{$i}=1;
		foreach $k (keys %{$aptr{$i}}) {
		    if ($k!=$j) { $chg||=!exists($aptr{$j}{$k}); $aptr{$j}{$k}=1; }
		}
	    }
	}
    }
    if ($chg) { goto qeIAE; }
    for ($i=$#{$_[0]};$i>=0;$i--) {
	splice @{$_[0]},$i,0,map { [$_[0][$i][0],$_] } keys %{$aptr{$_[0][$i][1]}};
    }
}

sub _DeleteCells($;$)
{   my $what=shift; my $flags=shift || 0; my %lookup=(); my ($i,$s,$oi,$o,$n,$ar,$curY);
    $curY=$cursor{ay};
    $cursor{oy}=-1; # force status update
    foreach $i (0..$#seq) {
	if ($flags & 2) { $lookup{$seq[$i]{p}}=[$seq[$i],0]; }
	else            { $lookup{$i}=[$seq[$i],0]; if ($cursor{ay}==$seq[$i]{p}) { $curY=$i; } }
    }
    if ((!$cursor{ax}) || ($flags & 8)) { $curY=-1; }
    if (!($flags & 16)) { _InsertAttachmentElements($what,$flags&2); }
    if ($flags & 4) { $ar=[]; @$ar=sort { $a->[0]<=>$b->[0] } @$what; } else { $ar=$what; }
    foreach $i (@$ar) {
	$s=$lookup{$i->[1]}[0]; _InvalidatePtr($s->{e}[$i->[0]],1);
	if (($curY==$i->[1]) && ($cursor{ax}>=$i->[0])) { $cursor{ax}--; }
	if ($flags & 32) { $s->{e}[$i->[0]]{text}=FillChar($s); }
	else             { splice @{$s->{e}},$i->[0],1; $lookup{$i->[1]}[1]--; }
	for ($oi=$#{$s->{o}};$oi>=0;$oi--) {
	    $o=$s->{o}[$oi]; $n=$#{$o->{e}};
	    while (($n>=0) && ($o->{e}[$n]{xpos}>$i->[0])) { $o->{e}[$n]{xpos}-- unless $flags & 32; $n--; }
	    next if $n<0;
	    if ($o->{e}[$n]{xpos}==$i->[0]) { splice @{$o->{e}},$n,1; }
	    if (!@{$o->{e}}) { splice @{$s->{o}},$oi,1; }
	}
    }
    if ($flags & 1) { _DefrayEnds(\%lookup); }
}

sub _InsertCells($;$)
{   my $what=shift; my $flags=shift || 0; my %lookup=(); my ($i,$j,$s,$n,$m,$o,$oi,$ar,$curY,$l);
    $curY=$cursor{ay};
    $cursor{oy}=-1; # force status update
    foreach $i (0..$#seq) {
	if ($flags & 2) { $lookup{$seq[$i]{p}}=[$seq[$i],0]; }
	else            { $lookup{$i}=[$seq[$i],0]; if ($cursor{ay}==$seq[$i]{p}) { $curY=$i; } }
    }
    if ($flags & 8) { $curY=-1; }
    if (!($flags & 16)) { _InsertAttachmentElements($what,$flags&2); }
    if ($flags & 4) { $ar=[]; @$ar=sort { $b->[0]<=>$a->[0] } @$what; } else { $ar=$what; }
    foreach $i (@$ar) {
	$s=$lookup{$i->[1]}[0];
	if (($curY==$i->[1]) && ($cursor{ax}>=$i->[0])) { $cursor{ax}++; }
	if (!defined($i->[2]))      { $n=undef; $m=FillChar($s); }
	elsif ($i->[2]=~/^[-._ ]$/) { $n=undef; $m=$i->[2]; }
	else                        { $n=_InsSeqNum($s,$i->[0]); $m=$i->[2]; }
	splice @{$s->{e}},$i->[0],0,{
	    text => $m, seqnumber => $n,
	    fontfill    => ($cfg{inscopyattr} && $i->[0])?$s->{e}[$i->[0]-1]{fontfill}:$cfg{f}[0],
	    fontfoundry => ($cfg{inscopyattr} && $i->[0])?$s->{e}[$i->[0]-1]{fontfoundry}:$cfg{f}[1],
	    fontwidth   => ($cfg{inscopyattr} && $i->[0])?$s->{e}[$i->[0]-1]{fontwidth}:$cfg{f}[5],
	    fontslant   => ($cfg{inscopyattr} && $i->[0])?$s->{e}[$i->[0]-1]{fontslant}:$cfg{f}[3],
	    fontsize    => ($cfg{inscopyattr} && $i->[0])?$s->{e}[$i->[0]-1]{fontsize}:$cfg{f}[4],
	    fontweight  => ($cfg{inscopyattr} && $i->[0])?$s->{e}[$i->[0]-1]{fontweight}:$cfg{f}[2],
	    fontbg      => ($cfg{inscopyattr} && $i->[0])?$s->{e}[$i->[0]-1]{fontbg}:$cfg{f}[6],
	    anchor => 'center', xpos => 0};
	$lookup{$i->[1]}[1]++;
	for ($oi=$#{$s->{o}};$oi>=0;$oi--) {
	    $o=$s->{o}[$oi]; $n=$#{$o->{e}};
	    while (($n>=0) && ($o->{e}[$n]{xpos}>$i->[0])) { $o->{e}[$n]{xpos}++; $n--; }
	    if ($o->{e}[$n]{xpos}==$i->[0]) {
		$o->{e}[$n]{xpos}++;
		if (($objectdata{$o->{e}[$n]{type}}[2]&2) && ($n>0) && ($o->{e}[$n-1]{xpos}==$i->[0]-1)) {
		    $m={}; %$m=%{$o->{e}[$n]}; $m->{xpos}=$i->[0];
		    splice @{$o->{e}},$n,0,$m;
		}

	    }
	}
    }
    if ($flags&1) { _DefrayEnds(\%lookup); }
}

sub _DefrayEnds(;$)
{   my $lookup=shift; my ($n,$i,$r,$u,$min,$max,@ff,@elx);

    if (!defined($lookup)) {
	$lookup={}; foreach $i (0..$#seq) { $lookup->{$i}=[$seq[$i],scalar(@{$seq[$i]{e}})]; }
    }
    return if !keys(%$lookup);
    @ff=values(%$lookup); $min=$max=$ff[0][1];
    foreach $i (@ff) { if ($i->[1]<$min) { $min=$i->[1]; } if ($i->[1]>$max) { $max=$i->[1]; } }
    if ($min==$max) { $min=0; foreach $i (@ff) { $i->[1]=0; } goto ppulon; }
    $max-=$min;
    foreach $i (@ff) {
	$i->[1]-=$min; $i->[2]=$i->[1];
zokmeg: for ($r=0,$n=$#{$i->[0]{e}};$r<$i->[1];$r++,$n--) {
	    last if $n<0;
	    last if $i->[0]{e}[$n]{text}=~/^[^-._ ]?$/;
	    foreach $u (@{$i->[0]{o}}) { if ($u->{e}[-1]{xpos}>=$n) { last zokmeg; } }
	    $i->[2]--;
	}
    }
    $min=$ff[0][2]; foreach $i (@ff) { if ($i->[2]>$min) { $min=$i->[2]; } }
    #--- ff 3 [ptr,delta0,mindelta]; max=max, min=minmax
ppulon:
    if ($min+scalar(@{$ff[0][0]{e}})==$ff[0][1]) { $min++; }
    foreach $i (@ff) {
	if ($i->[1]>$min) {
	    @elx=splice @{$i->[0]{e}},$min-$i->[1]; $i->[1]=$min; foreach $r (@elx) { _InvalidatePtr($r,1); }
	}
	if (($r=$min-$i->[1])>0) {
	    while ($r) {
		push @{$i->[0]{e}},{
		    text => FillChar($i->[0]), seqnumber => undef,
		    fontfill => $cfg{f}[0],
		    fontfoundry => $cfg{f}[1],
		    fontwidth => $cfg{f}[5],
		    fontslant => $cfg{f}[3],
		    fontsize => $cfg{f}[4],
		    fontweight => $cfg{f}[2],
		    fontbg => $cfg{f}[6],
		    anchor => 'center', xpos => 0};
		$r--;
	    }
	}
    }
    $max_seq_length=$#{$seq[0]{e}};
    if ($cursor{ax}>$max_seq_length) { $cursor{ax}=$max_seq_length; }
}

sub _ExtTo($)
{   my $d=$_[0]-@{$seq[0]{e}}; return if $d<=0;
    my ($i,$s,$c);
    foreach $s (@seq) {
	$c=FillChar($s);
	foreach $i (1..$d) {
	    push @{$s->{e}},{
		text => $c, seqnumber => undef,
		fontfill => $cfg{f}[0],
		fontfoundry => $cfg{f}[1],
		fontwidth => $cfg{f}[5],
		fontslant => $cfg{f}[3],
		fontsize => $cfg{f}[4],
		fontweight => $cfg{f}[2],
		fontbg => $cfg{f}[6],
		anchor => 'center', xpos => 0};
	}
    }
}

sub _TruncTo($)
{   my $d=$_[0]-@{$seq[0]{e}}; return if $d>=0;
    my ($i,$s); foreach $s (@seq) { foreach $i ($d..-1) { _InvalidatePtr($s->{e}[$i],1); } splice @{$s->{e}},$d; }
}

sub _ResetTo($)
{   _ExtTo($_[0]); _TruncTo($_[0]); }

sub _MakeSpace($)
{   my $Aly=shift; my $s;
    foreach $s (@seq) { if ($s->{p}>=$Aly) { $s->{p}++; } } if ($cursor{ay}>=$Aly) { $cursor{ay}++; }
}

sub InsertRow($;$$)
{   my ($j,$e); my $Aly=shift; my $label=shift; my $comment=shift || '';
    if (!defined($label)) { $label='%%%Blank'; }
    _MakeSpace($Aly);
    $e=[]; push @seq,{p=>$Aly,o=>[],e=>$e,t=>{
	text         => $label,
	comment      => $comment,
	attach       => -1,
	titlefill    => $cfg{t}[0],
	titlefoundry => $cfg{t}[1],
	titleslant   => $cfg{t}[3],
	titlewidth   => $cfg{t}[5],
	titlesize    => $cfg{t}[4],
	titleweight  => $cfg{t}[2],
	anchor       => 'center',
    }};
    foreach $j (0 .. $max_seq_length) {
	push @$e,{
	    text        => ' ',
	    fontfill    => $cfg{f}[0],
	    fontfoundry => $cfg{f}[1],
	    fontslant   => $cfg{f}[3],
	    fontwidth   => $cfg{f}[5],
	    fontsize    => $cfg{f}[4],
	    fontweight  => $cfg{f}[2],
	    fontbg      => 0,
	    anchor      => 'center',
	    xpos        => 0,
	};
    }
}

sub _CalX2F($)
{   return(($_[0]-$cfg{cald}[3])/$cfg{cald}[0]); }

sub _CalF2X($)
{   return($_[0]*$cfg{cald}[0]+$cfg{cald}[3]); }

sub _CalFindXD($$)
{   my $delta=2; my $targ=undef; my ($l,$pos)=@_; my ($i,$x);
    foreach $i (0..$#$l) { $x=abs($l->[$i][0]-$pos); if ($x<$delta) { $delta=$x; $targ=$i; } }
    if ($delta>0.015) { $targ=undef; } return $targ;
}

sub _CalDrawLine($$$$$$;$)
{   my ($nc,$cc,$pos,$scc,$fill,$t,$c2)=@_;
    if (!defined($scc))    { $scc=_CalX2F($pos); }
    elsif (!defined($pos)) { $pos=_CalF2X($scc); }
    return if ($scc<0) || ($scc>1.0);
    $nc->createText($pos,0.5*$cfg{cald}[1],-fill=>'black',-text=>$scc,-anchor=>'center',
		    -tags=>$t,-font=>'-*-Helvetica-Normal-r--'.$cfg{cald}[2].'-120-*-*-*-*-*-*');
    if ($c2) { $cc->createLine($pos,0,$pos,$cfg{cald}[1],-fill=>$c2,-tags=>$t,-width=>4); }
    $cc->createLine($pos,0,$pos,$cfg{cald}[1],-fill=>$fill,-tags=>$t,-width=>2);
}

sub _CalDrawLines($$$)
{   my ($nc,$cc,$edc)=@_; my $cat;
    $nc->delete('cat'); $cc->delete('cat');
    foreach $cat (@$edc) { _CalDrawLine($nc,$cc,undef,$cat->[0],$cat->[1][0],'cat') unless $cat->[0]==100; }
}

sub _CalModeSelect($$$)
{   foreach my $i (@{$_[1]}) { $i->configure(-relief=>'raised',-bg=>$_[2]); }
    $_[1][$_[0]]->configure(-relief=>'sunken',-bg=>'#ffffff');
}

sub _CalEditor($$$$$)
{   my ($win,$mode,$scc,$co,$okcode)=@_; my ($nw,$head,$bframe,@b);
    $nw=$win->Toplevel; $nw->focus; $nw->title('Bo Selecta');
    $head=(ref($scc)?
	   sprintf('New gradient from %.2f to %.2f.',$scc->[0],$scc->[1]):
	   sprintf('%s item at %.2f.',($mode?'Existing':'New'),$scc));
    $nw->Label(-text=>$head)->pack(-side=>'top',-anchor=>'w'); @b=(0,0,0,0,0,0);
    _DialogInp($nw,[
	(ref($scc)?(['Steps','E',\$co->[11],_ListWithMine($co->[11],[2,3,4,5,6,7,8,9,10,12,15,20,50],1)],
		    ['Gradient Type','E',\$co->[12],['RGB','HSL']]):()),
	['Fill Colour'.(ref($scc)?' (start)':''),'Col',\$co->[0],undef,$co->[0],'-cb',\$b[0]],
	(ref($scc)?['Fill Colour (end)','Col',\$co->[8],undef,$co->[8],'-cb',\$b[3]]:()),
	['Line Colour'.(ref($scc)?' (start)':''),'Col',\$co->[1],undef,$co->[1],'-cb',\$b[1]],
	(ref($scc)?['Line Colour (end)','Col',\$co->[9],undef,$co->[9],'-cb',\$b[4]]:()),
        ['Line Width','E',\$co->[2],_ListWithMine($co->[2],[0,1,2,3,4,5,6,8,10,12],1)],
	['Font Colour'.(ref($scc)?' (start)':''),'Col',\$co->[3],undef,$co->[3],'-cb',\$b[2]],
	(ref($scc)?['Font Colour (end)','Col',\$co->[10],undef,$co->[10],'-cb',\$b[5]]:()),
	['Font Size','E',\$co->[4],_ListWithMine($co->[4],[2,4,6,8,10,12,14,16,18,20,22,24,32],1)],
	['Font Foundry','E',\$co->[5],_ListWithMine($co->[5],[qw(Helvetica Times Symbol)],0)],
	['Font Slant','E',\$co->[6],_ListWithMine($co->[6],[qw(R O)],0)],
        ['Font Weight','E',\$co->[7],_ListWithMine($co->[7],[qw(Normal Bold)],0)],
    ]);
    $bframe=$nw->Frame(-width=>2,-relief=>'groove')->pack(-side=>'top',-fill=>'x');
    $bframe->Label(-text=>'Copy colours: ')->pack(-side=>'left');
    $bframe->Button(-text=>'F->L',-command=>sub {
	$co->[1]=$co->[0]; $b[1]->configure(-bg=>$co->[0],-activebackground=>$co->[0]);
	if (ref($scc)) { $co->[9]=$co->[8]; $b[4]->configure(-bg=>$co->[8],-activebackground=>$co->[8]); }
    })->pack(-side=>'left');
    $bframe->Button(-text=>'L->F',-command=>sub {
	$co->[0]=$co->[1]; $b[0]->configure(-bg=>$co->[0],-activebackground=>$co->[0]);
	if (ref($scc)) { $co->[8]=$co->[9]; $b[3]->configure(-bg=>$co->[8],-activebackground=>$co->[8]); }
    })->pack(-side=>'left');
    if (ref($scc)) {
	$bframe->Button(-text=>'S->E',-command=>sub {
	    $co->[8]=$co->[0]; $b[3]->configure(-bg=>$co->[0],-activebackground=>$co->[0]);
	    $co->[9]=$co->[1]; $b[4]->configure(-bg=>$co->[1],-activebackground=>$co->[1]);
	    $co->[10]=$co->[3]; $b[5]->configure(-bg=>$co->[3],-activebackground=>$co->[3]);
	})->pack(-side=>'left');
	$bframe->Button(-text=>'E->S',-command=>sub {
	    $co->[0]=$co->[8]; $b[0]->configure(-bg=>$co->[0],-activebackground=>$co->[0]);
	    $co->[1]=$co->[9]; $b[1]->configure(-bg=>$co->[1],-activebackground=>$co->[1]);
	    $co->[3]=$co->[10]; $b[2]->configure(-bg=>$co->[3],-activebackground=>$co->[3]);
	})->pack(-side=>'left');
    }
    _CancelOk($nw,'OK',sub { $okcode->(); $nw->destroy; });
}

sub _CalGrad($$)
{   return $_[0] if !defined($_[1]); return _CalF2X(int(_CalX2F($_[0])/$_[1]+0.5)*$_[1]); }

sub CalColours
{   my ($nw,$i,$bf,$bc,$br,$numbercanvas,$clickcanvas,@editcat,$mode,@mb,$defbg,$dragsrc,$grad);
    my @cosrc=($cfg{fc},$cfg{lc},$cfg{lw},$cfg{f}[0],$cfg{f}[4],$cfg{f}[1],$cfg{f}[3],$cfg{f}[5]);
    $nw=$mw->Toplevel; $nw->focus;
    $nw->title('Edit Colour Scheme');
    _CopyCat(\@categories,\@editcat);
    $bf=$cfg{cald}[0]+2*$cfg{cald}[3]; $dragsrc=undef; $grad=undef;
    $i=$nw->Frame(-borderwidth=>3)->pack(qw/-side top/);
    $i=$i->Frame(-borderwidth=>2,-relief=>'groove')->pack(qw/-side top/);
    $i=$i->Frame(-borderwidth=>2)->pack(qw/-side top/);
    $numbercanvas=$i->Canvas(-height=>$cfg{cald}[1],-width=>$bf,-bg=>'white')->pack(-side=>'top');
    $clickcanvas=$i->Canvas(-height=>$cfg{cald}[1],-width=>$bf,-bg=>'white',-cursor=>'crosshair')->pack;
    $mb[0]=$i->Button(-text=>'Add',-command=>sub {$mode=0;_CalModeSelect($mode,\@mb,$defbg);})->pack(-side=>'left');
    $mb[1]=$i->Button(-text=>'Delete',-command=>sub {$mode=1;_CalModeSelect($mode,\@mb,$defbg);})->pack(-side=>'left');
    $mb[2]=$i->Button(-text=>'Edit',-command=>sub {$mode=2;_CalModeSelect($mode,\@mb,$defbg);})->pack(-side=>'left');
    $mb[3]=$i->Button(-text=>'Add Gradient',-command=>sub {$mode=3;_CalModeSelect($mode,\@mb,$defbg);})->
	       pack(-side=>'left');
    $defbg=$mb[0]->cget(-bg); $mb[0]->invoke();
    $i->Label(-text=>'  Snap to:')->pack(-side=>'left');
    $i->Optionmenu(-variable=>\$grad,-options=>[['none',undef],0.005,0.01,0.02,0.05,0.1])->pack(-side=>'left');
    $numbercanvas->createRectangle(0,0,$cfg{cald}[3],$cfg{cald}[1],-fill=>$cfg{cald}[4],-width=>0);
    $numbercanvas->createRectangle($cfg{cald}[0]+$cfg{cald}[3],0,$bf,$cfg{cald}[1],-fill=>$cfg{cald}[4],-width=>0);
    $clickcanvas->createRectangle(0,0,$cfg{cald}[3],$cfg{cald}[1],-fill=>$cfg{cald}[4],-width=>0);
    $clickcanvas->createRectangle($cfg{cald}[0]+$cfg{cald}[3],0,$bf,$cfg{cald}[1],-fill=>$cfg{cald}[4],-width=>0);
    $clickcanvas->Tk::bind('<1>' => sub {
	my ($tmp,$ev,$scc,$canX,$bob,@co);
	$tmp=shift; $ev=$tmp->XEvent;
	$canX=$tmp->canvasx($ev->x); $canX=_CalGrad($canX,$grad) if (!$mode || ($mode==3));
	$scc=_CalX2F($canX);
	return if ($scc<0) || ($scc>1.0);
	if (($mode==1) || ($mode==2)) {
	    $bob=_CalFindXD(\@editcat,$scc);
	    return if !defined($bob);
	    if ($mode==1) { splice @editcat,$bob,1; _CalDrawLines($numbercanvas,$clickcanvas,\@editcat); return; }
	    $scc=$editcat[$bob][0];
	} elsif ($mode==3) {
	    _CalDrawLine($numbercanvas,$clickcanvas,$canX,undef,'black','transient'); $dragsrc=$canX; return;
	}
	if ($mode==2) { @co=@{$editcat[$bob][1]}; } else { @co=@cosrc; }
	_CalEditor($nw,$mode,$scc,\@co,sub {
	    if ($mode) { $editcat[$bob][1]=\@co; } else { push @editcat,[$scc,[@co]]; }
	    @cosrc=@co;
	    _CalDrawLines($numbercanvas,$clickcanvas,\@editcat);
	});
    });
    $clickcanvas->Tk::bind('<ButtonRelease-1>' => sub {
	return if $mode!=3;
	my ($sc0,$sc1,$tmp,$ev,$canX);
	$tmp=shift; $ev=$tmp->XEvent; $canX=_CalGrad($tmp->canvasx($ev->x),$grad);
	$numbercanvas->delete('transient'); $clickcanvas->delete('transient');
	$sc0=_CalX2F($dragsrc); $sc1=_CalX2F($canX);
	if ($canX==$dragsrc) { $dragsrc=undef; return; }
	$dragsrc=undef;
	return if ($sc1<0) || ($sc1>1.0);
	if ($sc0>$sc1) { $tmp=$sc1; $sc1=$sc0; $sc0=$tmp; }
	my @co=@cosrc; $co[8]=$co[0]; $co[9]=$co[1]; $co[10]=$co[3]; $co[12]='RGB';
	if (defined($grad)) { $co[11]=abs($sc0-$sc1)/$grad; } else {
	    $co[11]=2; while (($ev=abs($sc0-$sc1)/$co[11]) && (($ev-int($ev))>0.02) && ($co[11]<101)) { $co[11]++; }
	}
	_CalEditor($nw,$mode,[$sc0,$sc1],\@co,sub {
	    my ($i,$j,@cx,$d,$intfun);
	    $intfun=($co[12] eq 'RGB')?\&colourInterpolate:\&colourInterpolateHSL;
	    for ($i=0;$i<=$co[11];$i++) {
		@cx=@co[0..7]; $j=$i/$co[11];
		$cx[0]=$intfun->($co[0],$co[8],$j);
		$cx[1]=$intfun->($co[1],$co[9],$j);
		$cx[3]=$intfun->($co[3],$co[10],$j);
		$d=$sc0+($sc1-$sc0)*$j;
		if (($d>=0.999) && ($i!=$co[11])) { next; }
		push @editcat,[$d,[@cx]];
	    }
	    _CalDrawLines($numbercanvas,$clickcanvas,\@editcat);
	    @cosrc=@co[0..7];
	});
    });
    $clickcanvas->Tk::bind('<Motion>' => sub {
	my ($tmp,$ev,$canX);
	$numbercanvas->delete('transient'); $clickcanvas->delete('transient');
	$tmp=shift; $ev=$tmp->XEvent;
	$canX=$tmp->canvasx($ev->x); $canX=_CalGrad($canX,$grad) if (!$mode || ($mode==3));
	if ((!$mode) || (($mode==3) && (!defined($dragsrc)))) {
	    _CalDrawLine($numbercanvas,$clickcanvas,$canX,undef,'black','transient');
	} elsif ($mode<3) {
	    $tmp=_CalFindXD(\@editcat,_CalX2F($canX));
	    return if !defined($tmp);
	    _CalDrawLine($numbercanvas,$clickcanvas,undef,$editcat[$tmp][0],'#ffffff','transient','#001020');
	} elsif ($mode==3) {
	    $clickcanvas->createRectangle($dragsrc,0,$canX,$cfg{cald}[1],-fill=>'#c0c0c0',-stipple=>'gray50',
					  -tags=>'transient',-width=>0);
	    _CalDrawLine($numbercanvas,$clickcanvas,$dragsrc,undef,'#000000','transient');
	    _CalDrawLine($numbercanvas,$clickcanvas,$canX,undef,'#000000','transient');
	}
    });
    $clickcanvas->Tk::bind('<Leave>' => sub {
	$clickcanvas->delete('transient'); $numbercanvas->delete('transient');
    });

    $bf=$nw->Frame->pack(-side=>'bottom',-fill=>'x');
    $br=$bf->Button(-text=>'OK',-command=>sub {
	PDumpData('Edit Colour Scheme',0,0,1);
	@editcat=sort { $a->[0] <=> $b->[0] } @editcat;
	_CopyCat(\@editcat,\@categories);
	$nw->destroy;
    })->pack(-side=>'left');
    $bc=$bf->Button(-text=>'Cancel',-command=>sub { $nw->destroy; })->pack(-side=>'left');
    $bf->Button(-text=>'Save...',-command=>sub { SaveColour($nw,\@editcat); })->pack(-side=>'right');
    $bf->Button(-text=>'Load...',-command=>sub {
	my @tempcat; _CopyCat(\@categories,\@tempcat);
	if (ReadColour(undef,$nw)) {
	    _CopyCat(\@categories,\@editcat); _CalDrawLines($numbercanvas,$clickcanvas,\@editcat);
	}
	_CopyCat(\@tempcat,\@categories);
    })->pack(-side=>'right');
    $bf->Button(-text=>"Defaults",-command=>sub {
	_CopyCat(\@defaultcategories,\@editcat,1);
	_CalDrawLines($numbercanvas,$clickcanvas,\@editcat);
    })->pack(-side=>'right');
    $bf->Button(-text=>'Clear',-command=>sub {
	@editcat=(['100',['','','','','','','','']]);
	_CalDrawLines($numbercanvas,$clickcanvas,\@editcat);
    })->pack(-side=>'right');
    _CalDrawLines($numbercanvas,$clickcanvas,\@editcat);
    $nw->bind('<Escape>',sub { $bc->invoke(); });
    $nw->bind('<Return>',sub { $br->invoke(); });
}

sub _CopyCat($$;$)
{   my ($src,$dest,$tweak)=@_; my ($i,$j);
    @$dest=(); foreach $i (@$src) { push @$dest,[$i->[0],[]]; @{$dest->[-1][1]}=@{$i->[1]}; }
    if ($tweak) { foreach $i (@categories) { foreach $j (@{$i->[1]}) { __FillConfigPC(\$j); } } }
}

sub _CopySeq($$;$)
{   my ($src,$dest,$munged)=@_; my ($i,$j,$k,$l,$m,$ob);
    @$dest=();
    foreach $i (@$src) {
	my $p={}; push @$dest,$p;
	foreach $j (keys %$i) {
	    if ($j eq 'e') {
		my $q=[]; $p->{e}=$q;
		foreach $k (@{$i->{e}}) {
		    my $r={}; push @$q,$r; %$r=%$k; delete $r->{tk};
		}
	    } elsif ($j eq 't') {
		my $q={}; $p->{t}=$q;
		%$q=%{$i->{t}}; delete $q->{tk};
	    } elsif ($j eq 'o') {
		my $q=[]; $p->{o}=$q;
		foreach $k (@{$i->{o}}) {
		    my $r={}; push @$q,$r;
		    foreach $l (keys %$k) {
			if ($l eq 'e') {
			    my $s=[]; $r->{e}=$s;
			    foreach $m (@{$k->{e}}) {
				my $t={}; push @$s,$t; %$t=%$m; delete $t->{tk};
			    }
			} elsif (($l eq 'fwd') || ($l eq 'rev')) {
			    if (defined($k->{$l})) { $r->{$l}=_ObjPtrToId2($src,$k->{$l}); }
			    else { $r->{$l}=undef; }
			} else { $r->{$l}=$k->{$l}; }
		    }
		}
	    } elsif ($j ne 'ntk') { $p->{$j}=$i->{$j}; }
	}
    }
    return if $munged;
    foreach $i (@$dest) {
	foreach $j (@{$i->{o}}) {
	    if (defined($j->{fwd})) { $j->{fwd}=$dest->[$j->{fwd}[0]]{o}[$j->{fwd}[1]]; }
	    if (defined($j->{rev})) { $j->{rev}=$dest->[$j->{rev}[0]]{o}[$j->{rev}[1]]; }
	}
    }
}

sub _UpdateUndoMenu()
{   return if !defined($ui{undoitem});
    if (!@undo) { $ui{undoitem}->configure(-label=>'Nothing to undo',-state=>'disabled'); }
    else        { $ui{undoitem}->configure(-state=>'normal',-label=>'Undo '.$undo[-1]{label}); }
}

sub PDumpData($;$$$)
{   $unsaved=1; return if !$cfg{allow_undos}; DumpData($_[0],$_[1],$_[2],$_[3]); }

sub DumpData($;$$$)
{   my $label=shift;
    $unsaved=1;
    push @undo,{label=>$label,cur=>{}};
    #---- always dump %cursor
    %{$undo[-1]{cur}}=%cursor; 
    #---- dump par?
    if ($_[0]) { $undo[-1]{par}={}; %{$undo[-1]{par}}=%par; $undo[-1]{parcause}=$_[0]; }
    #---- dump seq?
    if ($_[1]) { $undo[-1]{seq}=[]; _CopySeq(\@seq,$undo[-1]{seq}); }
    #---- dump cat?
    if ($_[2]) { $undo[-1]{cat}=[]; _CopyCat(\@categories,$undo[-1]{cat}); }

    if ((@undo>1) && (@undo>$cfg{allow_undos})) { shift @undo; }
    _UpdateUndoMenu();
}

sub PSmartData($$;$)
{   $unsaved=1; return if !$cfg{allow_undos}; push @undo,{label=>$_[0],code=>$_[1]};
    if (defined($_[2])) { $undo[-1]{parcause}=$_[2]; }
    if ((@undo>1) && (@undo>$cfg{allow_undos})) { shift @undo; }
    _UpdateUndoMenu();
}

sub UndumpData(;$)
{   my $chg=0; my $canchg=!$_[0]; my $status=0; $unsaved=1;
    if (!@undo) { return; }
    if (exists($undo[-1]{code})) {
	$chg=$undo[-1]{code}->();
    } else {
	if (exists($undo[-1]{par})) { %par=%{$undo[-1]{par}}; $chg=1; _InvalidateGlyphs(); _FixupSliders(); }
	if (exists($undo[-1]{seq})) { if ($canchg) { Status('Undoing...'); $status=1; }
				      _InvalidateAll(); _CopySeq($undo[-1]{seq},\@seq); $chg=1; }
	if (exists($undo[-1]{cat})) { _CopyCat($undo[-1]{cat},\@categories); }
	if (exists($undo[-1]{cur})) { %cursor=%{$undo[-1]{cur}}; _refreshCursor() if !$chg; }
    }
    pop @undo;
    _UpdateUndoMenu();
    if ($chg && $canchg) { &PrintSeq(); }
    DeStatus(undef,1) if $status;
};

sub SkipUndoData()
{   return if !@undo; pop @undo; _UpdateUndoMenu(); }

sub ReadColour(;$$)
{   my $win=$_[1] || $mw;
    my $filename=$_[0] ||
                 $win->Tk::getOpenFile(-defaultextension => '.alc',
				       -filetypes        => [['Aline colour scheme files','.alc'],
							     ['All Files','*']],
				       -title            => 'Select a saved file');
    return 0 if !defined ($filename);
    open (DUMP,$filename) || die "Can't open file";
    my $tmp; { local $/=undef; $tmp=<DUMP>; }
    close(DUMP);
    my @categoriesx=();
    if (($tmp!~s/([\r\n]+\@categories)(=\()/$1x$2/) || ($tmp=~/[\r\n]+\@categories=\(/)) {
badcsc: _QuickMessage('Oops',"'$filename' is not a valid colour scheme."); return 0;
    }
    eval { eval $tmp; }; if ($@) { goto badcsc; }
    foreach $tmp (@categoriesx) { _ValidateFont(undef,\$tmp->[1][5],\$tmp->[1][7],\$tmp->[1][6]); }
    _CopyCat(\@categoriesx,\@categories);
    push @categories,[100,['','','','','','','','']];
    return 1;
}

sub SaveColour(;$$)
{   my $win=shift || $mw;
    my $filename=$win->Tk::getSaveFile(-defaultextension => '.alc',
				       -filetypes        => [['Aline colour scheme files','.alc'],
							     ['All Files','*']],
				       -initialfile      => 'aline.alc',
				       -title            => 'Select an output file');
    return if !defined($filename);
    open (DUMP,">$filename") || die "Can't open file";
    my ($i,$j,@t,$cat);
    $cat=$_[0]||\@categories;
    print DUMP "### $prog{name} $prog{version} $prog{author} $prog{website}\n### Colour scheme for alignments\n\@categories=(\n";
    foreach $i (@$cat) { if ($i->[0]<=1) {
	@t=@{$i->[1]}; foreach $j (@t) { $j=~s/\'/\\\'/g; }
	printf DUMP "    [%5.3f,['%s','%s',%d,'%s',%d,'%s','%s','%s']],\n",$i->[0],@t;
    }}
    print DUMP ");\n";
    close DUMP;
}

# ----------------------------------------------------------------- Load/save/etc

sub ClearDocument()
{
    return if ShouldaSavedEh();
    $savename=undef;
    ResetParameters();
    @seq=(); $max_seq_length=0;
    _CopyCat(\@defaultcategories,\@categories,1);
    if ($cfg{grid}) { _GridOff(); }
    _RefreshAfterLoad();
}

sub DumpDataFile(;$)
{   my @startloc=('-initialfile','aline.aline'); my $i;
    if ($savename) {
	if (($i=rindex($savename,'/'))>=0) {
	    @startloc=('-initialdir',substr($savename,0,$i+1),
                       '-initialfile',substr($savename,$i+1));
	} else {
	    @startloc=('-initialfile',$savename);
	}
    }
    my $filename=$_[0] ||
                 $mw->Tk::getSaveFile(-defaultextension => '.aline',
				      -filetypes        => [['ALINE files','.aline'],['All Files','*']],
				      @startloc,
				      -title            => "Select an output file",
				      );
    if (!defined $filename) {return 1;}
    Status("Saving to '$filename'...");

    # [aws] We must turn the object references into [seq|obj] pairs before serialising...
    my @munged=(); _CopySeq(\@seq,\@munged,1); # ... and we do it the lazy way.

    open (DUMP,">$filename") || die "Can't open file";
    print DUMP savepackaline(\%par,\@munged,\@categories);
    close DUMP;
    $savename=$filename; $unsaved=0;
    DeStatus();
    return undef;
}

sub savepackaline($$$)
{   my ($pp,$sp,$cp)=@_; local $_; my ($sep,$ext)=(chr(3),chr(5));
    my (@v,%keycache,%txcache,$buf1,$i,$j,$k,$c,$ce,$co,$num,$key,$oldnum,%ocache,$x,$okey,$otx,$ott);

    $x="Aline 1.0 packed state R001\n$prog{name} $prog{version} $prog{author} $prog{website}\n";
    @v=(); foreach (keys %$pp) { push @v,$_.$sep.(ref($pp->{$_})?join($ext,@{$pp->{$_}}):$pp->{$_}); }
    $x.=join($sep,@v)."\n";

    %txcache=(); %ocache=(); %keycache=(); $buf1=''; $okey=0;
    foreach (@$sp) {
	$c={}; %$c=%$_;
	# save {p}, {n} and length of {o}
	$buf1.=$c->{p}.$sep.(defined($c->{n})?$c->{n}:'u').$sep.scalar(@{$c->{o}}).$sep; @v=();

	# as well as {t} items
	foreach $i (keys %{$c->{t}}) { push @v,$i.$sep.$c->{t}{$i}; }
	$buf1.=join($sep,@v)."\n";

	# then remaining non-{e|p|o|t} keys
	$ce=$c->{e}; $co=$c->{o}; foreach $i (qw(n e o p t)) { delete $c->{$i}; }
	@v=(); foreach $i (keys %$c) { push @v,$i.$sep.$c->{$i}; }
	$buf1.='>'.join($sep,@v)."\n";

	# sequence
	$oldnum=0;
	foreach $i (@$ce) {
	    $c={}; %$c=%$i; $num=undef;
	    if (!exists($c->{seqnumber}))     { $c->{seqnumber}=-1; }
	    elsif (!defined($c->{seqnumber})) { $c->{seqnumber}=0; }
	    else {
		if (($c->{seqnumber}-$oldnum)==1) { $c->{seqnumber}=1; $oldnum++; }
		else { $num=$c->{seqnumber}; $oldnum=$num; $c->{seqnumber}=2; }
	    }
	    @v=(); foreach $j (sort keys %$c) { push @v,$j.$sep.$c->{$j}; }
	    $j=join($sep,@v);
	    if (exists($txcache{$j})) { $key=$txcache{$j}; } else {
		$key=substr($c->{text}.'~',0,1);
		if (exists($keycache{$key})) {
		    $keycache{$key}++;
		    if ($keycache{$key}<256) { $key.=chr($keycache{$key}); }
		    else { $key.=$ext.$keycache{$key}.$ext; }
		} else { $keycache{$key}=32; $key.=' '; }
		$txcache{$j}=$key;
	    }
	    $buf1.=$key.(defined($num)?($num.$sep):'');
	}
	$buf1.="\n";

	# object data
	foreach $i (@$co) {
	    $c={}; %$c=%$i; $ce=$c->{e};
	    $buf1.=$c->{multi}.$sep.$c->{z}.$sep.
		(defined($c->{rev})?"$c->{rev}[0]$sep$c->{rev}[1]":'u'.$sep.'u').$sep.
		(defined($c->{fwd})?"$c->{fwd}[0]$sep$c->{fwd}[1]":'u'.$sep.'u')."\n";
	    foreach $j (qw(rev fwd e z multi)) { delete $c->{$j}; }
	    @v=(); foreach $j (keys %$c) { push @v,$j.$sep.$c->{$j}; } $buf1.='>'.join($sep,@v)."\n";

	    # object items
	    $oldnum=0;
	    foreach $j (@$ce) {
		$c={}; %$c=%$j; $num=$c->{xpos}; delete $c->{xpos}; $ott='text';
		if ($c->{type}!~/Graph$/) { $ott='otext'; }
		$otx=exists($c->{$ott})?$c->{$ott}:undef; delete $c->{$ott};
		@v=(); foreach $k (sort keys %$c) { push @v,$k.$sep.$c->{$k}; } $k=join($sep,@v);
		if (!exists($ocache{$k})) {
		    $ocache{$k}=n2a64($okey); $okey++;
		}
		$buf1.="$ocache{$k}$sep".((($num-$oldnum)==1)?'+':$num).(defined($otx)?($ext.$otx):'').$sep;
		$oldnum=$num;
	    }
	    $buf1=~s/$sep$/\n/;
	}
    }
    foreach $i (keys %txcache) { $x.=$txcache{$i}.$sep.$i."\n"; } $x.="$ext\n";
    foreach $i (keys %ocache) { $x.=$ocache{$i}.$sep.$i."\n"; } $x.="$ext\n";
    $buf1.="$ext\n";
    foreach $i (0..($#$cp-1)) {
	@v=($cp->[$i][0],@{$cp->[$i][1]});
	if ($i) { for ($j=1;$j<=@{$cp->[$i][1]};$j++) { if ($v[$j] eq $cp->[$i-1][1][$j-1]) { $v[$j]=$ext; } } }
	if ($v[2] eq $v[1]) { $v[2]='='; } $buf1.=join($sep,@v)."\n";
    }
    return $x.$buf1;
}

sub n2a64($)
{   my $o=''; my $v=shift; my ($i);
    return '0' if !$v;
    while ($v) {
	$i=$v&63; $v>>=6;
	if ($i<10)    { $o=chr(48+$i).$o; }
	elsif ($i<38) { $o=chr(55+$i).$o; }
	else          { $o=chr(59+$i).$o; }
    }
    return $o;
}

sub loadpackaline($$$$)
{   my ($pp,$sp,$cp,$d)=@_; my ($sep,$ext)=(chr(3),chr(5));
    my ($i,$j,$key,%ocache,%txcache,@v,@lines,$lo,$e,$t,$oldnum,$ott,$tv);
    if ($d!~s/^Aline 1\.0 packed state R([0-9]+)[\r\n]+[^\r\n]*[\r\n]+//) { return 1; } $i=$1+0;
    return 2 if $i>1;

    %$pp=(); @$sp=(); @$cp=(); %txcache=(); %ocache=();
    @lines=split(/[\r\n]+/,$d);

    return 3 if !@lines;
    @v=split(/$sep/,shift(@lines));
    while (@v>1) {
	$j=shift @v; $t=shift @v;
	if ($t=~/$ext/) {
	    $pp->{$j}=[]; @{$pp->{$j}}=split(/$ext/,$t);
	} else { $pp->{$j}=$t+0; }
    }

    # read caches
fcache1:
    return 4 if !defined($i=shift(@lines));
    if ($i ne $ext) {
	@v=split(/$sep/,$i); $key=shift @v; $txcache{$key}={};
	while (@v>1) { $j=shift @v; $txcache{$key}{$j}=shift(@v); }
	goto fcache1;
    }
fcache2:
    return 5 if !defined($i=shift(@lines));
    if ($i ne $ext) {
	@v=split(/$sep/,$i); $key=shift @v; $ocache{$key}={};
	while (@v>1) { $j=shift @v; $ocache{$key}{$j}=shift(@v); }
	goto fcache2;
    }

    while (@lines && ($lines[0] ne $ext)) {
	# new sequence
	@v=split(/$sep/,shift(@lines));
	return 6 if @v<3; $lo=$v[2];
	$e=[]; $t={}; push @$sp,{p=>$v[0],n=>(($v[1] eq 'u')?undef:($v[1]+0)),t=>$t,e=>$e,o=>[]};
	splice @v,0,3; while (@v>1) { $j=shift @v; $t->{$j}=shift @v; }
	return 7 if !defined($i=shift(@lines)); return 8 if $i!~s/^>//;
	@v=split(/$sep/,$i); while (@v>1) { $j=shift @v; $sp->[-1]{$j}=shift @v; }
	return 9 if !defined($i=shift(@lines));
	$oldnum=0;
	while (length($i)>1) {
	    $key=substr($i,0,2); $i=substr($i,2);
	    if (substr($key,1,1) eq $ext) { return 10 if $i!~s/^(.+?$ext)//; $key.=$1; }
	    return 11 if !exists($txcache{$key});
	    push @$e,{}; %{$e->[-1]}=%{$txcache{$key}};
	    if ($e->[-1]{seqnumber}==-1) { delete $e->[-1]{seqnumber}; }
	    elsif ($e->[-1]{seqnumber}==0) { $e->[-1]{seqnumber}=undef; }
	    elsif ($e->[-1]{seqnumber}==1) { $oldnum++; $e->[-1]{seqnumber}=$oldnum; }
	    else { return 12 if $i!~s/^(.+?)$sep//; $oldnum=$1+0.0; $e->[-1]{seqnumber}=$oldnum; }
	}
	return 13 if @lines<(3*$lo);
	while ($lo) {
	    @v=split(/$sep/,shift @lines); $t=$sp->[-1]{o}; $e=[]; return 14 if @v!=6;
	    push @$t,{}; $t=$t->[-1]; %$t=(multi=>$v[0],z=>$v[1],rev=>[$v[2],$v[3]],fwd=>[$v[4],$v[5]],e=>$e);
	    if ($t->{rev}[0] eq 'u') { $t->{rev}=undef; } if ($t->{fwd}[0] eq 'u') { $t->{fwd}=undef; }
	    $i=shift @lines; return 15 if $i!~s/^>//; @v=split(/$sep/,$i);
	    while (@v>1) { $j=shift @v; $t->{$j}=shift(@v); }
	    @v=split(/$sep/,shift @lines); $oldnum=0;
	    while (@v>1) {
		$key=shift @v; push @$e,{}; return 16 if !exists($ocache{$key});
		%{$e->[-1]}=%{$ocache{$key}}; $j=shift @v;
		if ($j=~s/$ext(.*)$//) {
		    $tv=$1; $ott='text'; if ($e->[-1]{type}!~/Graph$/) { $ott='otext'; } $e->[-1]{$ott}=$tv;
		}
		if ($j eq '+') { $oldnum++; } else { $oldnum=$j; }
		$e->[-1]{xpos}=$oldnum;
	    }
	    $lo--;
	}
    }
    return 17 if !@lines; shift @lines;
    foreach $i (@lines) {
	@v=split(/$sep/,$i); if ($v[2] eq '=') { $v[2]=$v[1]; } push @$cp,[shift(@v),[]]; @{$cp->[-1][1]}=@v;
	for ($j=0;$j<@{$cp->[-1][1]};$j++) { if ($cp->[-1][1][$j] eq $ext) { $cp->[-1][1][$j]=$cp->[-2][1][$j]; } }
    }
    push @$cp,[100,['','','','','','','','']];
    return 0;
}

sub UndumpDataFile(;$)
{   my ($filename,$tmp,$i,$j);
    return if ShouldaSavedEh();
    $filename=$_[0] ||
	      $mw->Tk::getOpenFile(-defaultextension => '.aline',
				   -filetypes        => [['ALINE files','.aline'],['All Files','*']],
				   -title            => 'Select a saved file');
    return if !defined($filename);
    print STDERR "Reading Aline File\n";
    Status("Reading '$filename'...");
    if (!(open(DUMP,$filename))) {
	_QuickMessage('Oops',"Cannot open '$filename'."); DeStatus(); return;
    }
    { local $/=undef; $tmp=<DUMP>; } close DUMP;
    my (%parx,@seqx,@categoriesx,@obj);

    if ($tmp=~/^### Aline 1.0, /) { # Old Data::Dumper-style state
	if (($tmp!~s/([\r\n]+%par) = /$1x = /) || ($tmp=~/[\r\n]+%par = /) ||
	    ($tmp!~s/([\r\n]+\@seq) = /$1x = /) || ($tmp=~/[\r\n]+\@seq = /) ||
	    ($tmp!~s/([\r\n]+\@categories) = /$1x = /) || ($tmp=~/[\r\n]+\@categories = /)) {
undumpfailure:
	    _QuickMessage('Oops',"'$filename' is not a valid Aline file."); DeStatus(); return;
	}
	eval { eval $tmp; goto undumpfailure if $@; }; goto undumpfailure if $@;
	if (@obj) { _QuickMessage('Warning',"This is an old Aline file, which contains data that cannot".
				  ' be interpreted with this version of Aline - objects have been'.
				  ' removed. Sorry.'); }
    } elsif ($tmp=~/^Aline 1.0 packed state R001/) { # New 'packed' state
	if (loadpackaline(\%parx,\@seqx,\@categoriesx,$tmp)) { goto undumpfailure; }
    } else {
	goto undumpfailure;
    }

    # Manual unmunging plus font validation...
    foreach $i (@seqx) {
	_ValidateFont(\%fontlist,\$i->{t}{titlefoundry});
	foreach $j (@{$i->{e}}) { _ValidateFont(\%fontlist,\$j->{fontfoundry}); }

	foreach $tmp (@{$i->{o}}) {
	    if (defined($tmp->{fwd})) { $tmp->{fwd}=$seqx[$tmp->{fwd}[0]]{o}[$tmp->{fwd}[1]]; }
	    if (defined($tmp->{rev})) { $tmp->{rev}=$seqx[$tmp->{rev}[0]]{o}[$tmp->{rev}[1]]; }

	    foreach $j (@{$tmp->{e}}) { _ValidateFont(\%fontlist,\$j->{fontfoundry}); }
	}
    }

    _CopyCat(\@categoriesx,\@categories);
    %par=%parx; _CopySeq(\@seqx,\@seq);

    _ConsolidateZ();
    $savename=$filename;
    _RefreshAfterLoad();
    DeStatus();
}

sub _RefreshAfterLoad()
{
    _InvalidateAll();
    @undo=(); $unsaved=0;
    $cursor{ax}=0; $cursor{ay}=0; $cursor{alt}=0;
    _UpdateUndoMenu();
    _UpdateParameters();
    _FixupSliders();
    PrintSeq(1);
}

sub _FixupSliders()
{
    #--- Set sliders to current values...
    $ui{cshscale}->set($par{csh});
    $ui{csvscale}->set($par{csv});
    $ui{fsiscale}->set($par{fsi}*100);
    $ui{nchscale}->set($par{nch});
    $ui{ttlscale}->set($par{lin});

    #--- Re-attach menu buttons after %par has been reassigned...
    $ui{numbutton}->configure(-variable=>\$par{num});
    $ui{allbutton}->configure(-variable=>\$par{all});
    $ui{agrbutton}->configure(-variable=>\$par{agr});
}

# ----------------------------------------------------------------- Sequence import/export

sub Open(;$)
{
    return if ShouldaSavedEh();
    my $filename=$_[0] || _ReadDialog($mw,1);
    return if !defined($filename);
    @undo=(); $unsaved=0;
    if ($filename=~/\.aline$/) { return UndumpDataFile($filename); }
    else                       { ClearDocument(); return Read($filename); }
}

sub _ReadDialog($;$)
{   my @fl=map { [$_,$importlist{$_}[0]] } keys %importlist;
    if ($_[1]) { push @fl,['ALINE files',['.aline']]; }
    @fl=sort { $a->[0] cmp $b->[0] } @fl;
    return $_[0]->Tk::getOpenFile(-defaultextension => ($_[1]?'.aline':'.aln'),
				  -filetypes        => [['All supported types',
							 [map { (@{$_->[1]}) } @fl]],
							(map { [$_->[0],$_->[1]] } @fl),
							['All Files','*']],
				  -title            => 'Select a sequence file');
}

sub Read(;$)
{   my ($store,$s);
    return if ShouldaSavedEh();
    my $filename=$_[0] || _ReadDialog($mw);
    return if !defined($filename);

    if (defined($store=_Read($filename,sub { Status("Reading $_[1] from '$_[0]'..."); }))) {
	_InvalidateAll(1); _GridOff(); undef @seq; $max_seq_length=0;
	if (@$store) {
	    foreach $s (@$store) { InsertSequence($s->[0],$s->[1],$s->[2],$s->[3]); }
	    _DefrayEnds(); $max_seq_length=$#{$seq[0]{e}};
	    foreach $s (1 .. $cfg{extrarows}) { InsertRow(scalar(@seq)); }
	}
	$cursor{ax}=0; $cursor{ay}=0;
	PrintSeq(); DeStatus(); return 1;
    }
    return;
}

sub _Read($;$)
{   my ($filename,$cb)=@_; my ($i,$j,$fh,@data);
    if (ref($filename)) { @data=map { "$_\n" } split(/\n+/,$filename->[1]); $filename=$filename->[0]; }
    else                { @data=(); }
    foreach $i (keys %importlist) {
	foreach $j (map { "\\$_\$" } @{$importlist{$i}[0]}) {
	    if ($filename=~/$j$/) {
                if (!@data) { $fh=undef; open ($fh,$filename) or die "Can't open file '$filename'.\n"; }
		if ($cb) { $cb->($filename,$i); }
		if (!@data) { @data=<$fh>; close $fh; }
		return $importlist{$i}[1]->(\@data);
	    }
	}
    }
    _QuickMessage('Cannot read file',"Unknown extension in '$filename', cannot open.");
    return undef;
}

sub Export($;$$)
{   my ($i,$j,$t,$f2); my $win=$_[2] || $mw;
    my $filename=$_[1] ||
                 $win->Tk::getSaveFile(-defaultextension => '.seq',
				       -initialfile      => 'aline.seq',
				       -filetypes        => [['All supported types',
						     [map { (@{$exportlist{$_}[0]}) } sort keys %exportlist]],
						     (map { [$_,$exportlist{$_}[0]] } sort keys %exportlist),
							     ['All Files','*']],
				       -title            => 'Pick a filename');
    return if !defined($filename);

    $f2=$filename;
    foreach $i (keys %exportlist) {
	foreach $j (map { "\\$_\$" } @{$exportlist{$i}[0]}) {
	    if ($f2=~s/$j$//) {
		$t=$exportlist{$i}[1]->($_[0]);
		if ($f2 eq chr(10)) { return $t; }
		Status("Writing $i to '$filename'...");
		open (F1,'>'.$filename) or goto werror;
		print F1 $t; close(F1);
		DeStatus(); return;
	    }
	}
    }
    _QuickMessage('Cannot write file',"Unknown extension in '$filename', cannot export."); return;
werror:
    _QuickMessage('Cannot write file',"Error writing to '$filename'."); return;
}

sub _FillSeqnum($)
{   my $s=$seq[$_[0]]; my ($i,$sn);
    return if !defined($sn=$s->{n});
    foreach $i (@{$s->{e}}) {
	if ($i->{text}=~/^[-._ ]?$/) { $i->{seqnumber}=undef; } else { $i->{seqnumber}=$sn; $sn++; }
    }
}

sub _SeqStart($)
{   my $s=$seq[$_[0]]; my $i;
    if (defined($s->{n})) { return $s->{n}; }
    foreach $i (@{$s->{e}}) { if (defined($i->{seqnumber})) { return $i->{seqnumber}; } }
    return 1;
}

sub InsertSequence($$;$$$)
{   my ($title,$seq,$nums,$comment,$ypos)=@_; my $msl=$max_seq_length || 0; my ($i,$j);
    if (!defined($ypos)) { $ypos=scalar(@seq); }
    $j=length($seq)-1;
    if ($j>$msl)    { $max_seq_length=$j; }
    elsif ($j<$msl) { $i=$cfg{gapchar}||'.'; $seq.=$i x ($msl-$j); $j=$msl; }
    if ($title=~/^(consensus)(.*)/i) { $title='%%%Consensus'; if ($2) { $comment||="$1$2"; } }
    if ($cfg{gapchar}) { $i=$cfg{gapchar}; $seq=~s/[-._ ]/$i/g; }
    InsertRow($ypos,$title,$comment); $max_seq_length=$msl;
    if (!ref($nums)) { $seq[-1]{n}=defined($nums)?$nums:1; } else { $seq[-1]{n}=undef; }
    for ($i=0;$i<=$j;$i++) {
	$seq[-1]{e}[$i]{text}=substr($seq,$i,1);
	if (ref($nums)) { $seq[-1]{e}[$i]{seqnumber}=($i<@$nums)?$nums->[$i]:undef; }
    }
}

sub ReadFasta($)
{   my @store=(); local $_; my $data=shift;
    while (@$data) {
        $_=shift(@$data);
	chomp;
	if (/^>\s*([^\s]*)(?:\s+(.+)?)?$/)  {
	    push @store,[$1,'',undef,$2];
	    if ($store[-1][0]=~/\/([0-9]+)(?:\-[0-9]+)?$/) { $store[-1][2]=$1+0; }
	} else {
	    s/[\r\n\s]+//g; if (!$_) { next; }
	    if (!@store) { print STDERR "WARNING: Ignored line '$_'.\n"; next; }
	    $store[-1][1].=$_;
	}
    }
    return \@store;
}

sub ReadMsf($)
{   my ($t2,$l); local $_; my ($i,$skip,$nmode)=(0,1,0); my @store=(); my $data=shift;
    while (@$data) {
        $_=shift(@$data);
	chomp;
	if ($skip) {
	    if (/Name:\s*([^\s]+)/) {
		$l=$1; foreach $t2 (@store) { if ($t2->[0] eq $l) { $nmode=1; last; } }
		push @store,[$l,'',$i]; $i++; next;
	    };
	    if (m|^//\s*$|) {
		$skip=0; $t2=0;
                if ($nmode) { print STDERR "WARNING: Input contains duplicate sequence names.\n"; }
		else        { @store=sort { length($b->[0])<=>length($a->[0]) } @store; }
		next;
	    }
	    next;
	}
        s/^\s+//; next if !$_;

        if (!$nmode) {
            for ($t2=0;$t2<@store;$t2++) {
	        if (substr($_,0,length($store[$t2][0])) eq $store[$t2][0]) {
                    $_=substr($_,length($store[$t2][0])); goto foundt2;
		}
	    }
            if (/[^0-9\s]/) { print STDERR "Unrecognised data in MSF file:\n> $_ <, skipping.\n"; }
	    goto donemsfline;
	} elsif (!/[^0-9\s]$/) { goto donemsfline; }

foundt2:s/^[^\s]+//; s/\s+//g; $store[$t2][1].=$_;
	if ($nmode) { $t2++; if ($t2>=@store) { $t2=0; } }
donemsfline:;
    }
    @store=map { [$_->[0],$_->[1]] } sort { $a->[2]<=>$b->[2] } @store;
    foreach $i (@store) { if ($i->[0]=~/\/([0-9]+)(?:-[0-9]+)?$/) { $i->[2]=$1+0; } }
    return \@store;
}

sub ReadAln($)
{   local $_; my ($i,@line); my @store=(); my $data=shift;
    while (@$data) {
        $_=shift(@$data);
	next if /^CLUSTAL [FW]/; next if !/[-A-Z]/;
	chomp; @line=split;
	foreach $i (@store) { if ($i->[0] eq $line[0]) { $i->[1].=$line[1]; goto donealln; } }
	push @store,[$line[0],$line[1]];
donealln:
    }
    foreach $i (@store) { if ($i->[0]=~/\/([0-9]+)(?:-[0-9]+)?$/) { $i->[2]=$1+0; } }
    return \@store;
}

sub ReadBlast($)
{   local $_; my ($i,@line,$currid,$count); my @store=(); my $data=shift;
    $count=0;
    while (@$data) {
        $_=shift(@$data);
	next unless ($_ =~ /^(>|Query|Sbjct)/);
	if ($_ =~/^>/) {
	    $count++;
	    $currid=substr($_,1,10);
	    push @store,[$currid,'']; 
	    push @store,["Query-$count",'']; 
	    next;
	}
	my @l=split;
	if ($_ =~ /^Query/) {
	    foreach $i (@store) {
		if ($i->[0] eq "Query-$count") {
#		    $i->[2]=$i->[2]||[$l[1]];
		    $i->[1].=$l[2]
		    }
	    }
	}
	if ($_ =~ /^Sbjct/) {
	    foreach $i (@store) {
		if ($i->[0] eq $currid) {
#		    $i->[2]=$i->[2]||[$l[1]];
		    $i->[1].=$l[2]
		    }
	    }
	}
    }
#CSB Problem with seq numbers - need to FillSeqnum, but can't do it here.
    return \@store;
}

sub ReadBlc($)
{   local $_; my @store=(); my $i; my $data=shift;
    while (@$data) {
        $_=shift(@$data);
	chomp;
	if (s/^>//) { push @store,[$_,'']; next; }
	if (/^\*/) { next; }

	if (length($_)<@store) {
	    print STDERR "WARNING: Not enough sequences in '$_'.\n"; $_.='.' x scalar(@store);
	} elsif (length($_)>@store) { print STDERR "WARNING: Too many sequences in '$_'.\n"; }

	foreach $i (0..$#store) { $store[$i][1].=substr($_,$i,1); }
    }
    foreach $i (@store) { if ($i->[0]=~/\/([0-9]+)(?:-[0-9]+)?$/) { $i->[2]=$1+0; } }
    return \@store;
}

sub _SQuote($)
{ local $_=shift;
  if ($^O=~/^mswin/i) {
    s/"/\\"/g;
    return '"'.$_.'"';
  } else {
    s/'/'"'"'/g;
    return "'$_'";
  }
}

sub _MakeValidExportList($)
{   my ($s,$t,%valids);
    if (!defined($_[0])) { $_[0]=[(0..$#seq)]; }
    %valids=(); foreach $s (0..$#seq) {
	$t=$seq[$s]{t}{text};
	if ($t=~s/^%%%//) {
	    next if !exists($specialrows{$t});
	    next if !(($specialrows{$t}[2] || 0) & 1);
	}
	$valids{$s}=1;
    }
    for ($s=$#{$_[0]};$s>=0;$s--) { if (!exists($valids{$_[0][$s]})) { splice @{$_[0]},$s,1; } }
}

sub ExportFasta($)
{   my ($s,$t,$r); my $sl=shift;
    $r=''; _MakeValidExportList($sl);
    $r=''; foreach $s (@$sl) { $r.=_ToFasta($s,1)."\n"; } return $r;
}

sub ExportPIR($)
{   my ($s,$t,$r); my $sl=shift;
    $r=''; _MakeValidExportList($sl);
    $r=''; foreach $s (@$sl) { $r.=_ToPIR($s,1)."\n"; } return $r;
}

sub ExportMSF($)
{   my ($sdata,$r,$i);
    $sdata=_ExportMulti($_[0],"\n",undef,'-');
    $r="aline MSF: $sdata->[2] Type: P   Check: 0\n\n";
    foreach $i (@{$sdata->[1]}) { $r.="Name: $i->[1] Len: $sdata->[2] Check: 0 Weight: 1.00\n"; }
    $r.="\n//\n\n".$sdata->[0];
    return $r;
}

sub ExportAln($)
{   my ($sdata,$r);
    $sdata=_ExportMulti($_[0],"\n\n",undef,'-');
    $r="CLUSTAL W ($prog{name} $prog{version}) multiple sequence alignment\n\n".$sdata->[0];
    return $r;
}

sub _ExportMulti($;$$$)
{   my ($sl,$splt,$llen,$gchar)=@_; my (@sq,$r,$s,$lm,$tm,$ts,%ttl,$i,$fe);
    _MakeValidExportList($sl);
    @sq=(); $lm=0; $tm=0; $llen||=60; $splt||="\n"; %ttl=();
    foreach $s (@$sl) {
	$ts=_ToRaw($s,1); push @sq,[$ts,$seq[$s]{t}{text}];
	$ts=~s/[-._ ]+//g; $sq[-1][2]=length($ts);
	$sq[-1][1]=~s/\s/_/g; if (defined($gchar)) { $sq[-1][0]=~s/[-._ ]/$gchar/g; }
	if (exists($ttl{$sq[-1][1]})) {
	    $fe=$sq[-1][1];
nuwex:      $ttl{$fe}++;
	    $sq[-1][1]=~s/(\/[0-9]+-[0-9]+)$//; $i=$1||'';
	    $sq[-1][1].='('.$ttl{$fe}.')'.$i;
	    if (exists($ttl{$sq[-1][1]})) { $sq[-1][1]=$fe; goto nuwex; }
	}
	$ttl{$sq[-1][1]}=1;
	if (length($sq[-1][0])>$lm) { $lm=length($sq[-1][0]); }
	if (length($sq[-1][1])>$tm) { $tm=length($sq[-1][1]); }
    }
    foreach $s (@sq) {
	$s->[0]=substr($s->[0].(($gchar||'-') x $lm),0,$lm);
	$s->[1]=substr($s->[1].(' ' x $tm),0,$tm).'  ';
    }

    $r='';
nxl:foreach $s (@sq) {
	$r.=$s->[1];
	if (length($s->[0])>=$llen) { $r.=substr($s->[0],0,$llen); $s->[0]=substr($s->[0],$llen); }
	else                        { $r.=$s->[0]; $s->[0]=''; }
	$r.="\n";
    }
    if (length($sq[0][0])) { $r.=$splt; goto nxl; }

    for ($s=0;$s<@sq;$s++) { $sq[$s][0]=$sl->[$s]; }
    return [$r,\@sq,$lm];
}

sub _ToFasta($;$$)
{ my ($n,$gaps,$len)=@_; my ($i,$s,$num);
  if (!defined($len)) { $len=60; } $len--; $s=''; $num=0;
  foreach $i (@{$seq[$n]{e}}) {
      if ($gaps || ($i->{text}!~/^[-._ ]?$/)) {
	  $s.=$i->{text}; if ($num==$len) { $s.="\n"; $num=0; } else { $num++; }
      }
  }
  if ($num) { $s.="\n"; }
  $i=$seq[$n]{t}{text}; $i=~s/^%%%//; return ">$i\n$s";
}

sub _ToPIR($;$$)
{ my ($n,$gaps,$len)=@_; my ($i,$s,$num);
  if (!defined($len)) { $len=60; } $len--; $s=''; $num=0;
  foreach $i (@{$seq[$n]{e}}) {
      if ($gaps || ($i->{text}!~/^[-._ ]?$/)) {
	  $s.=$i->{text}; if ($num==$len) { $s.="\n"; $num=0; } else { $num++; }
      }
  }
  if ($num) { $s.="\n"; }
  $i=$seq[$n]{t}{text}; $i=~s/^%%%//; return ">P1;$i\n".($seq[$n]{t}{comment}||'')."\n$s*";
}

sub _ToRaw($;$)
{ my ($n,$gaps)=@_; my ($i,$s);
  $s='';
  foreach $i (@{$seq[$n]{e}}) {
      if ($gaps || ($i->{text}!~/^[-._ ]?$/)) {
	  $s.=$i->{text};
      }
  }
  return $s;
}

sub _ObtainPDB($;$)
{   my ($id,$seqify)=@_; my ($ch,$url,$dat);
    if ($seqify && !IsPluginLoaded('Aline::Plugins::fInputPDB')) {
	return {error=>'This function requires the PDB import plugin to be loaded.'};
    }
    if (length($id)>4) {
	$ch=lc(substr($id,4,1)); $id=lc(substr($id,0,4));
	if (defined($cfg{pdbchget})) {
	    if ($ch eq ' ') { $ch='_'; }
	    $url=$cfg{pdbchget}; $url=~s/%i/$id/g; $url=~s/%c/$ch/g;
	    $ch=uc($ch); $id=uc($id); $url=~s/%I/$id/g; $url=~s/%C/$ch/g;
	    $dat=_SQuote($cfg{wgetloc}).' -o/dev/null -O- '._SQuote($url); $dat=`$dat`;
	    if (length($dat) && ($dat!~/ERROR:\s+No\s+File\s+called\s+/)) { goto finaltweak; }
	}
    } else { $ch=undef; }
    $url=$cfg{pdbflget}; $id=lc($id); $url=~s/%i/$id/g; $id=uc($id); $url=~s/%I/$id/g;
    $dat=_SQuote($cfg{wgetloc}).' -o/dev/null -O- '._SQuote($url); $dat=`$dat`;
    if ($dat=~/The file you requested does not exist[.!]/) { return {error=>"Cannot download PDB entry '$id'."}; }
    if (defined($ch)) {
	if ($ch eq '_') { $ch=' '; }
	$dat=join("\n",grep(/^(?:ATOM  |HETATM).{15}$ch/,split /[\r\n]+/,$dat));
    }
finaltweak:
    if ($seqify) { return Aline::Plugins::fInputPDB::pdbload([map { "$_\n" } split /\n+/,$dat]); }
    return $dat;
}

# ----------------------------------------------------------------- Color-related, Glyph-related

sub colourN2R($)
{   my ($r,$g,$b)=$mw->rgb($_[0]); return ($r*$screen{MD},$g*$screen{MD},$b*$screen{MD}); }

sub colourR2N(@)
{   return sprintf('#%04X%04X%04X',$_[0]*65535,$_[1]*65535,$_[2]*65535); }

sub colourInterpolate($$$)
{   my ($r1,$g1,$b1)=$mw->rgb($_[0]); my ($r2,$g2,$b2)=$mw->rgb($_[1]); my $f=65535*$screen{MD};
    return sprintf('#%04X%04X%04X',($r1+($r2-$r1)*$_[2])*$f,($g1+($g2-$g1)*$_[2])*$f,
		   ($b1+($b2-$b1)*$_[2])*$f);
}

sub colourInterpolateHSL($$$)
{   my ($h1,$s1,$l1)=rgb2hsl((colourN2R($_[0])));
    my ($h2,$s2,$l2)=rgb2hsl((colourN2R($_[1])));
    return colourR2N((hsl2rgb($h1+($h2-$h1)*$_[2],$s1+($s2-$s1)*$_[2],$l1+($l2-$l1)*$_[2])));
}

sub rgb2hsl(@)
{   my ($r,$g,$b)=@_; my ($h,$s,$l,$ma,$mi,$de);

    if (($r==$g) && ($r==$b)) { return((0,0,$r)); }
    $ma=($r>$g)?$r:$g; if ($b>$ma) { $ma=$b; } $mi=($r<$g)?$r:$g; if ($b<$mi) { $mi=$b; }
    $l=0.5*($mi+$ma); $s=$ma-$mi; $de=$s;
    if ($l<0.5) { $s/=$ma+$mi; } else { $s/=(2-$ma-$mi); }
    if ($r>=$ma) { $h=($g-$b)/$de; } elsif ($g>=$ma) { $h=2+($b-$r)/$de; } else { $h=4+($r-$g)/$de; }
    $h/=6.0; if ($h<0) { $h+=1.0; }
    return(($h,$s,$l));
}

sub hsl2rgb(@)
{   my ($h,$s,$l)=@_; my (@o,$t2,$t1,$i);

    if ($s==0.0) { return(($l,$l,$l)); }
    $t2=($l<0.5)?($l*(1+$s)):($s+$l*(1-$s)); $t1=2*$l-$t2;
    foreach $i (0..2) { $o[$i]=6.0*$h; }
    if ($o[0]>4) { $o[0]-=4; } else { $o[0]+=2; } if ($o[2]<2) { $o[2]+=4; } else { $o[2]-=2; }
    foreach $i (0..2) {
	if ($o[$i]<1)    { $o[$i]=$t1+($t2-$t1)*$o[$i]; }
	elsif ($o[$i]<3) { $o[$i]=$t2; }
	elsif ($o[$i]<4) { $o[$i]=$t1+($t2-$t1)*(4-$o[$i]); }
	else             { $o[$i]=$t1; }
    }
    return(@o);
}

sub DrawText {
    my ($x,$y,$z,$ffi,$t,$a,$ffo,$fwe,$fsl,$fwi,$fsi,$ta,$olw,$oco)=@_; my (@f);

    if ($ffo eq 'Symbol') { $t=_symbolify($t); }

    if (defined($olw)) {
	@f=(-text=>$t,-anchor=>$a,-tag=>['glyph','text',$ta,$z],
	    -font=>$fontlist{$ffo}[1].$fwe.'-'.$fsl.'--'.$fsi.'-120-*-*-*-*-*-*');
	my @px=(); my ($i,$j); $olw=($olw+1)>>1;
        for ($i=-$olw;$i<=$olw;$i++) { for ($j=-$olw;$j<=$olw;$j++) {
	    push @px,$canvas->createText($x+$i,$y+$j,-fill=>$oco,@f);
	}}
	push @px,$canvas->createText($x,$y,-fill=>$ffi,@f);
	return \@px;
    } else {
	return [$canvas->createText($x,$y,-fill=>$ffi,-text=>$t,-anchor=>$a,-tag=>['glyph','text',$ta,$z],
				    -font=>$fontlist{$ffo}[1].$fwe.'-'.$fsl.'--'.$fsi.'-120-*-*-*-*-*-*')];
    }
}

sub _GlyphFactory(@)
{   my ($i,$j,$k,$t,@e,$v,%xpar);
    $v='$v=sub { my ($x,$y,$z,$fc,$lc,$lw,$ta,$lines)=@_; my @rv=(); ';
    foreach $i (@_) {
	@e=@$i; $t=shift @e; $k=0;
	foreach $j (@e) {
	    $j='$'.($k?'y':'x').($j==0?'':'+'.($j==1?'':$j.'*').'$par{cs'.($k?'v':'h').'}'); $k^=1; #'
	}
	%xpar=(); while ($t=~s/:([^=:]+?)=('[^']*'|"[^"]*"|[^:]*)$//) { $xpar{$1}=$2; } #')
	if ($t=~/^P/) {
	    $v.='push @rv,$canvas->createPolygon('.join(',',@e).',-fill=>'.($xpar{fc}||'$fc').',-outline=>'.
		($xpar{lc}||'$lc').',-width=>'.(exists($xpar{lw})?$xpar{lw}:'$lw').",-tag=>['glyph',\$z,\$ta]); ";
	}
	if ($t=~/^R/) {
	    $v.='push @rv,$canvas->createRectangle('.join(',',@e).',-fill=>'.($xpar{fc}||'$fc').',-outline=>'.
		($xpar{lc}||'$lc').',-width=>'.(exists($xpar{lw})?$xpar{lw}:'$lw').",-tag=>['glyph',\$z,\$ta]); ";
	}
	if ($t=~/O$/) {
	    $v.='push @rv,$canvas->createLine('.join(',',@e).',-capstyle=>\'round\',-fill=>'.($xpar{llc}||'$lc').
		',-width=>'.(exists($xpar{llw})?$xpar{llw}:'$lw').",-tag=>['glyph',\$z,\$ta]); ";
	    next;
	}
	if ($t=~/C$/) {
	    $v.='push @rv,$canvas->createPolygon('.join(',',@e,$e[0],$e[1]).',-fill=>'.($xpar{llc}||'$lc').
		',-width=>'.(exists($xpar{llw})?$xpar{llw}:'$lw').",-tag=>['glyph',\$z,\$ta]); ";
	    next;
	}
	if ($t=~/Z$/) {
	    $v.='push @rv,$canvas->createLine('.join(',',$e[0],$e[1],$e[2],$e[1]).',-fill=>'.($xpar{llc}||'$lc').
		',-capstyle=>\'projecting\',-width=>'.(exists($xpar{llw})?$xpar{llw}:'$lw').
		',-tag=>[\'glyph\',$z,$ta]); push @rv,$canvas->createLine('.join(',',$e[0],$e[3],$e[2],$e[3]).
		',-fill=>'.($xpar{llc}||'$lc').',-capstyle=>\'projecting\',-width=>'.
		(exists($xpar{llw})?$xpar{llw}:'$lw').",-tag=>['glyph',\$z,\$ta]); ";
	    next;
	}
	if ($t eq 'E') {
	    $v.='push @rv,$canvas->createOval('.join(',',@e).',-fill=>'.($xpar{fc}||'$fc').',-outline=>'.
		($xpar{lc}||'$lc').',-width=>'.(exists($xpar{lw})?$xpar{lw}:'$lw').",-tag=>['glyph',\$z,\$ta]); ";
	    next;
        }
    }
    $v.=' return \@rv; };'; eval $v; if ($@ && $cfg{debug}) { print STDERR "$v\n$@\n"; }
    return $v;
}

sub _LingFactory($$$$)
{   my @functions=@_; my $v='$v=sub { return $functions[$_[7]&3]->(@_); }'; eval $v; return $v; }

sub Rect {
    my ($x,$y,$z,$fc,$lc,$lw,$ta,$lines)=@_; my @rv=();
    my ($x2,$y2)=($x+$par{csh},$y+$par{csv});
    my @exp=(-fill=>$lc,-capstyle=>'projecting',-tag=>['glyph',$ta,$z],-width=>$lw);
    if ($lines&8) { push @rv,$canvas->createLine($x,$y,$x2,$y,@exp); }
    if ($lines&4) { push @rv,$canvas->createLine($x,$y2,$x2,$y2,@exp); }
    if ($lines&2) { push @rv,$canvas->createLine($x,$y,$x,$y2,@exp); }
    if ($lines&1) { push @rv,$canvas->createLine($x2,$y,$x2,$y2,@exp); }
    return \@rv;
}

sub Box {
    my ($x,$y,$z,$fc,$lc,$lw,$ta,$lines)=@_; my ($rv,$rr);
    $rr=$canvas->createRectangle($x,$y,$x+$par{csh},$y+$par{csv},-tag=>['glyph',$ta,$z],-outline=>$fc,
				 -fill=>$fc,-width=>$lw);
    $rv=Rect(@_); unshift @$rv,$rr; return $rv;
}

sub LineGraph($$$$$$$$$$$$)
{   my ($x,$y,$z,$fc,$lc,$lw,$tag,@v)=@_; my ($e,$f,$i); $z=['glyph','gra',$tag,$z];
    foreach $i (@v) { $i=$y+(1-$i)*$par{csv}; }
    $e=$canvas->createLine($x,$v[0],$x+0.5*$par{csh},$v[1],-fill=>$lc,-tag=>$z,-width=>$lw);
    $f=$canvas->createLine($x+0.5*$par{csh},$v[1],$x+$par{csh},$v[2],-fill=>$lc,-tag=>$z,-width=>$lw);
    return [$e,$f];
}

sub LineCutGraph($$$$$$$$$$$$)
{   my ($x,$y,$z,$fc,$lc,$lw,$tag,@v)=@_; my ($i,$e,$f,$c); my $cut=pop @v;
    $z=['glyph','gra',$tag,$z];
    if ($v[1]>=$cut) { $c=$lc; } else { $c=$fc; }
    foreach $i (@v) { $i=$y+(1-$i)*$par{csv}; }
    $e=$canvas->createLine($x,$v[0],$x+0.5*$par{csh},$v[1],-fill=>$c,-tag=>$z,-width=>$lw);
    $f=$canvas->createLine($x+0.5*$par{csh},$v[1],$x+$par{csh},$v[2],-fill=>$c,-tag=>$z,-width=>$lw);
    return [$e,$f];
}

sub BarGraph($$$$$$$$$$$$)
{   my ($x,$y,$z,$fc,$lc,$lw,$tag,undef,$v,undef,$toth)=@_;
    $z=['glyph','gra',$tag,$z];
    if ($v>0.0) { return [$canvas->createRectangle($x,$y+(1-$v)*$par{csv},$x+$par{csh},$y+$par{csv},-tag=>$z,
						   -outline=>$lc,-fill=>$lc,-width=>0)]; }
    return undef;
}

sub BarCutGraph($$$$$$$$$$$$)
{   my ($x,$y,$z,$fc,$lc,$lw,$tag,undef,$v,undef,$toth,$cut)=@_; my $c;
    if ($v>0.0) {
	$c=($v>=$cut)?$lc:$fc;
	return [$canvas->createRectangle($x,$y+(1-$v)*$par{csv},$x+$par{csh},$y+$par{csv},
					 -tag=>['glyph','gra',$tag,$z],-outline=>$c,-fill=>$c,-width=>0)];
    }
    return undef;
}

sub GradientGraph($$$$$$$$$$$$)
{   my ($x,$y,$z,$fc,$lc,$lw,$tag,undef,$v,undef,$toth)=@_;
    my $w=colourInterpolate($fc,$lc,$v);
    return [$canvas->createRectangle($x,$y+(1-$toth)*$par{csv},$x+$par{csh},$y+$par{csv},
				     -tag=>['glyph','gra',$tag,$z],-outline=>$w,-fill=>$w,-width=>0)];
}

sub GradientCutGraph($$$$$$$$$$$$)
{   my ($x,$y,$z,$fc,$lc,$lw,$tag,undef,$v,undef,$toth,$c)=@_; my $w;
    if (($c>=1) || ($v<$c)) { $w=colourInterpolate($cfg{canvascol},$fc,$v/$c); }
    else                    { $w=colourInterpolate($fc,$lc,($v-$c)/(1-$c)); }
    return [$canvas->createRectangle($x,$y+(1-$toth)*$par{csv},$x+$par{csh},$y+$par{csv},
				     -tag=>['glyph','gra',$tag,$z],-outline=>$w,-fill=>$w,-width=>0)];
}

sub GradientGraphHSL($$$$$$$$$$$$)
{   my ($x,$y,$z,$fc,$lc,$lw,$tag,undef,$v,undef,$toth)=@_;
    my $w=colourInterpolateHSL($fc,$lc,$v);
    return [$canvas->createRectangle($x,$y+(1-$toth)*$par{csv},$x+$par{csh},$y+$par{csv},
				     -tag=>['glyph','gra',$tag,$z],-outline=>$w,-fill=>$w,-width=>0)];
}

sub GradientCutGraphHSL($$$$$$$$$$$$)
{   my ($x,$y,$z,$fc,$lc,$lw,$tag,undef,$v,undef,$toth,$c)=@_; my $w;
    if (($c>=1) || ($v<$c)) { $w=colourInterpolateHSL($cfg{canvascol},$fc,$v/$c); }
    else                    { $w=colourInterpolateHSL($fc,$lc,($v-$c)/(1-$c)); }
    return [$canvas->createRectangle($x,$y+(1-$toth)*$par{csv},$x+$par{csh},$y+$par{csv},
				     -tag=>['glyph','gra',$tag,$z],-outline=>$w,-fill=>$w,-width=>0)];
}

sub BinaryGraph($$$$$$$$$$$$)
{   my ($x,$y,$z,$fc,$lc,$lw,$tag,undef,$v,undef,$toth,$c)=@_; my $w;
    if ($v<$c) { $w=$fc; } else { $w=$lc; }
    return [$canvas->createRectangle($x,$y+(1-$toth)*$par{csv},$x+$par{csh},$y+$par{csv},
				     -tag=>['glyph','gra',$tag,$z],-outline=>$w,-fill=>$w,-width=>0)];
}

# ----------------------------------------------------------------- Scripting

sub _ExecScript
{   my ($i,$filename); my $easyquit=shift;
    $filename=$_[0] || $mw->Tk::getOpenFile(-defaultextension => '.script',
					    -filetypes        => [['Aline Scripts','.script'],['All Files','*']],
					    -title            => 'Select a script file');
    open MOOF,"<$filename" or return 'Cannot read script file.';
    { local $/=undef; $i=<MOOF>; }
    $i=Aline::Sandbox::_run($i,$easyquit,$filename);
    if (!$i) { return 0; }
    return($i."\nScript execution failed.");
}

sub _sandbox_set
{   if (!exists($cfg{$_[0]})) { $Aline::Sandbox::errstr="Cannot modify nonexisting setting '$_[0]'.\n"; return; }
    if (($_[0] eq 'fc') || ($_[0] eq 'lc')) { _SetWorkColour($_[0],$_[1]); } else { $cfg{$_[0]}=$_[1]; }
}

sub _sandbox_get
{   if (!exists($cfg{$_[0]})) { $Aline::Sandbox::errstr="Cannot retrieve nonexisting setting '$_[0]'.\n"; return; }
    return $cfg{$_[0]};
}

sub _sandbox_rowselect
{   my ($k,$set)=@_; $set||=[0..$#seq]; my ($i,@temp,$type);
    return $set if $k eq 'allrows';
    my %sel=();
    if ($k eq 'allseqs') {
	foreach $i (0..$#seq) { if ($seq[$i]{t}{text}!~/^%%%/) { $sel{$i}=1; } }
    } elsif ($k=~s/^by(id|pos):\s*//) {
	$type=($1 eq 'pos'); $k=~s/\s*$//; @temp=split /\s*(\.\.\.?|,)\s*/,$k;
	for ($i=$#temp;$i>=0;$i--) {
	    if ($temp[$i] eq ',') { splice @temp,$i,1; }
	    elsif ($temp[$i]=~/^-[0-9]+$/) { $temp[$i]+=@$set; }
	    elsif ($temp[$i]=~/^\+?[0-9]+$/) { $temp[$i]+=0; }
	    elsif ($temp[$i] ne '..') { $Aline::Sandbox::errstr="Invalid chunk '$temp[$i]' in '$k'."; return; }
	}
	for ($i=$#temp;$i>=0;$i--) {
	    if ($temp[$i] eq '..') {
		if (!$i || ($i==$#temp)) { $Aline::Sandbox::errstr="Invalid range in '$k'."; return; }
		if ($temp[$i-1]>$temp[$i+1]) { splice @temp,$i-1,3; }
		else { splice @temp,$i-1,3,($temp[$i-1]..$temp[$i+1]); }
	    }
	}
	%sel=map { $_=>1 } @temp;
	if ($type) {
	    @temp=(); foreach $i (0..$#seq) { if ($sel{$seq[$i]{p}}) { push @temp,$i; } } %sel=map { $_=>1 } @temp;
	}
    }
    for ($i=$#$set;$i>=0;$i--) { if (!exists($sel{$set->[$i]})) { splice @$set,$i,1; } }
    return $set;
}

sub _sandbox_seq
{   my $cmd=$_[0] || '#';
    if ($cmd eq '#') { return scalar(@seq); } elsif ($cmd eq 'lastidx') { return $#seq; }
    if (!defined($_[1])) { $Aline::Sandbox::errstr='Missing argument (sequence number) in seq.'; return; }
    my $s=ref($_[1])?$_[1][0]:$_[1];
    if ($s>=@seq) { $Aline::Sandbox::errstr='Sequence number out of range.'; return; }
    if ($cmd eq 'len')        { return scalar(@{$seq[$s]{e}}); }
    elsif ($cmd eq 'y')       { return $seq[$s]{p}; }
    elsif ($cmd eq 'iy')      { foreach my $i (0..$#seq) { if ($seq[$i]{p}==$s) { return $i; } } return -1; }
    elsif ($cmd eq 't')       { return $seq[$s]{t}; }
    elsif ($cmd eq 'title')   { my $rr=$seq[$s]{t}{text};
			        if ($_[2]) { $seq[$s]{t}{text}=$_[2]; _InvalidatePtr($seq[$s]{t},0); } return $rr;  }
    elsif ($cmd eq 'comment') { my $rr=$seq[$s]{t}{comment}; if ($_[2]) { $seq[$s]{t}{comment}=$_[2]; } return $rr; }
    elsif ($cmd=~/^[0-9]+$/)  { return $seq[$s]{e}[$cmd]; }

    $Aline::Sandbox::errstr="Unknown seq command '$cmd'."; return;
}

sub _sandbox_forceupdate { $canvas->update(); }

package Aline::GraphMucker;

our $AUTOLOAD;

sub new
{   my $class=shift; my $data=[$_[0],$_[1]]; return bless $data,$class; }

sub AUTOLOAD
{   my $self=shift; my ($i);
    for ($i=0;$i<(@_-1);$i++) {
        if ($_[$i] eq '-fill')       { ${$self->[0]}=$_[$i+1]; }
        elsif ($_[$i] eq '-outline') { ${$self->[1]}=$_[$i+1]; }
    }
}

1;

package Aline::Sandbox;
no strict;
use Time::HiRes 'time';
#use vars(qw($errstr','$easyquit'));

sub _errchk() { die 'Ouch.' if $errstr; }

sub get($)           { my $r=&main::_sandbox_get; _errchk(); return $r; }
sub loadseq($)       { main::Open($_[0]); return; }
sub propdialog($$;$) { my $nw=$mw->Toplevel; $nw->focus; $nw->title($_[0]); main::_DialogInp($nw,$_[1]);
		       my $f=$_[2]; main::_CancelOk($nw,'OK',sub { if (defined($f)) { $f->(); } $nw->destroy; }); }
sub quit()           { return &main::_Shutdown if ($easyquit || $_[0]);
		       print STDERR "WARNING: Prevented script from quitting.\n";  }
sub rowselect($;$)   { my $r=&main::_sandbox_rowselect; _errchk(); return $r; }
sub seq              { my $r=&main::_sandbox_seq; _errchk(); return $r; }
sub set($$)          { my $r=&main::_sandbox_set; _errchk(); return $r; }
sub undopoint($)     { main::PDumpData($_[0],0,1,0); }
sub update           { if ($_[0]) { main::PrintSeq(1); } main::_sandbox_forceupdate(); }

sub _run($$;$)
{   my $f=$_[2]?"in '$_[2]'":''; local $_;
    $errstr=''; $easyquit=$_[1]; eval $_[0]; $_=$@;
    if ($errstr) { return $errstr; }
    if ($_) { $_=$@; s/at \(eval[^\)]*\) line +([0-9]+).*/$f line $1./gs; return $_; }
    return 0;
}

sub _bind($$)
{   my $cv=$_[0]; *{"Aline::Sandbox::$_[1]"} = sub { my $i; ($i,$errstr)=$cv->(@_); _errchk(); return $i; }; }

1;
