gplot.src

        Copyright (c) Kapteyn Laboratorium Groningen 2009
        All Rights Reserved.

Name:         gplot.src
Creator:      vogelaar
Host:         albirumi
Date:         Apr 14, 2009
Contents:     gplot.make gplot.dc1 gplot.h gplot.c process.c
              utils.c

#>            gplot.make
# Makefile for GPLOT, aug 17, 1998
#
# Separate documentation (html) can be found in $gip_root/htm/gplot.
# 
#
# Pack sources into gplot.src with:      > make -f gplot.make pack
# Unpack source files with:              > $gip_exe/xfile gplot.src
# Install source file with:              > p -reserve gplot.src
#                                        > p -install gplot.src
#
# Local compilation for testing:         > p gplot.make
#
# The CC_OPTS etc are set by 'compile'
#----------------------------------------------------------------------

SHELL = /bin/sh

OPTS  = $(CC_OPTS)
COMP  = $(CC_COMP)
OPTS  = $(CC_OPTS)
LIBS  = $(CC_LIBS)

.SUFFIXES: .c .o

DOCUMENTS = gplot.dc1

INCLUDES  = gplot.h

SOURCES   = gplot.c process.c utils.c 

OBJECTS   = gplot.o process.o utils.o

# drawaxis.o beam.o pgconx.o

default:: gplot

pack::
	$${gip_sys}/pack.csh gplot.src gplot.make $(DOCUMENTS) $(INCLUDES) $(SOURCES)

clean::
	rm -f gplot $(OBJECTS)

.c.o:
	@echo "$(COMP) -c $(OPTS) $< ";\
	$(COMP) -c $(OPTS) $<
   
gplot:  $(INCLUDES) $(OBJECTS)
	@echo "$(COMP) -o gplot $(OBJECTS) $(LIBS)";\
	$(COMP) -o gplot $(OBJECTS) $(LIBS)
#<

#>            gplot.dc1

Program:       GPLOT

Purpose:       General macro based plot program for interactive use
               of PGPLOT subroutines and the Gipsy Data Subsystem (GDS).

Category:      PLOTTING

File:          gplot.c

Author:        M.G.R. Vogelaar


               =======================
               DOCUMENTATION AND HELP:
               =======================

               All GPLOT commands have a separate description that can be read
               from within GPLOT.
               At the COMMAND= keyword type: help
               for a list all available commands.
               or type:  help abcd
               for a description about abcd.
               (Note that an asterisk ('*') character can be used as a 
               wild card).

               A GPLOT users manual in HTML format can be found on the
               Kapteyn Homepage under GIPSY/recipes/gplot.

Keywords:

   COMMAND=    In 'main' mode (macro "main"):
               EXECUTE command n in "main":

               In 'macro' mode (macro "xxx"):
               STORE command n for macro "xxx":

               Enter a GPLOT command (with parameters). Depending on
               the current mode, the command is executed or stored.
               Stored commands can be used as a macro. COMMAND=help
               generates a list with GPLOT commands and
               COMMAND=<a GPLOT command> displays information about syntax
               and use of the specified GPLOT command.

               example: COMMAND=help *info
               displays help about 'setinfo', 'devinfo' and 'plotinfo'


  GRDEVICE=    Graphics device              [list of all graphics devices]
               Name of the device to which
               the plot commands are directed (minimal match implemented).
               Examples:

               0. NULL                      (Null device)
               1. TEKTRONIX                 (Tektronix)
               2. L1LASER, L2LASER, LPSFILE (PostScript Landscape)
               3. P1LASER, P2LASER, PPSFILE (Postscript Portrait)
               4. LCOLOUR, LCPSFILE         (Colour Postscript Landscape)
               5. PCOLOUR, PCPSFILE         (Colour Postscript Portrait)
               6. XTERM                     (Xterm in tektronix mode)
               7. GIDS                      (GIDS in graphics mode)
               8. THERTEK                   (thermes tektronix window)
               9. X11                       (PGPLOT X11 driver)

               Note that Postscript File devices have the option to
               send output to a file given by the user. The syntax is
               GRDEVICE=<PSfile dev>[/<filename>].

               Example:
               GRDEVICE=PPSFILE/myfile.ps


Notes:         You can expect more GPLOT keywords than described above
               because macro's can generate their own keywords which 
               have a meaning in the context of that macro.

Example:       See documentation.

Updates:       Jan 22,  1993: VOG, Document created.
               Dec  2,  1994: VOG, Small changes, e.g. 'xsize', 'ysize'
                                  'beam' commands.
               Apr  6,  1995: VOG, New commands 'profint', 'profaxis',
                                  'keyword', 'manual', 'file'.
                                   Character heights now in mm.
               May 21,  1995: VOG, New commands 'autoscale', en commands
                                   related to polarisation. Number formatting
                                   in text is possible using the {} characters.
               Aug 8,   1995: VOG, Included mosaic commands.
               Oct 7,   1997: VOG, pgbeam replaced by beam.
               Aug 20,  1998: VOG, Add new set of vectors va, ..., vz.
               Dec 23,  1999: VOG, Changed (fint) in NINT() for 'profbox'.
               May  1,  2007: JPT, Included conditional code for Apple Mac.
               Apr 14,  2009: VOG, Changed definition of macro NINT to one
                                   which uses floor() for consistency with
                                   other routines that process coordinates.
                                   Also minor clean up of unused code.
               Jun 15,  2009: JPT, Replaced private strdup() by private StrDup()
               Aug 11,  2009: JPT, Renamed getline to GetLine


Description:   See gplot.html



File structure:
===============================================================
Data for a command starts with a line containing '#start'
A data block ends where a '#end' is encountered.
There must be one data block for each command.
===============================================================

Description and syntax of all GPLOT commands:


#start
command: angle
syntax:  angle [x]
         If x is omitted, the current value is displayed.
         The angle applies to plotted text strings.

example: angle 90              ! Rotate text over +90 degrees
#end


#start
command: arrow
syntax:  arrow x1 y1 [x2 y2]
         If two numbers are given, then draw an arrow from current
         position to x1 y1. If four numbers are given then move to x1 y1 
         and draw to x2 y2. The cursor position after the arrow command will 
         always be x2, y2.
note:    The style of the arrowhead can be changed with the 'arstyle' command.
#end


#start
command: arstyle
syntax:  arstyle [fs angle style]
         Command arstyle without parameters will list the current style for
         arrowheads. If you want to change these settings you can use the
         following parameters:
         fs:    Fill Style: fs = 1 => filled; fs = 2 => outline.
                Other values are treated as 2. Default 1.
         angle: the acute angle of the arrow point, in degrees;
                angles in the range 20.0 to 90.0 give reasonable
                results. Default 45.0.
         barb:  the fraction of the triangular arrow-head that
                is cut away from the back. 0.0 gives a triangular
                wedge arrow-head; 1.0 gives an open >. Values 0.3
                to 0.7 give reasonable results. Default 0.3.
#end


#start
command: autoscale
syntax:  autoscale
         Set a default location and scale so that a frame will fit
         on the current device. If a set is read and no box was set
         then 'autoscale' will also set the default box to the size
         of the entire (sub)set.
#end


#start
command: axdelta
syntax:  axdelta [d] [units]
         d is major tick separation. If no units are given, d is in
         world coordinates, else d is in units entered by the user.
         For an offset axis with physical coordinates, the offset will
         plotted in the user given units.
         if d is omitted, a default value will be calculated. 

example: axdelta 5.0           ! Separation major ticks is 5 (world coordinates)
         axdelta 10 arcmin     ! Convert value to header units
         axdelta               ! Calculate default

note:    The value for 'axdelta' is reset after the use of the 'axis' command'
#end

#start
command: axformat
syntax:  axformat [string]
         'string' is a text string used as format template.
         If the string is an empty string, the general format will be 
         used for numerical labels. The hms format will be used for a 
         spatial longitude axis and the dms format will be used for a 
         spatial latitude axis. In the hms/dms formats part(s)
         of the label are always printed if the corresponding
         field is fixed by a capital.

table:   string       | number     | result      | remark 
         =============|============|=============|============================
         +eeeeee.eeee | 43345.5436 | +4.3346e+04 | exp. format, signed convers.
         gggg.ggggg   | 34.43      | _____34.430 | field width is 10
         +ffff.ff     | 23.456     | __+23.46    | signed conversion
         -ffff        | 345.87     | 346         | left justified
         -+ffff.fff   | 34.43      | +34.430     | left justified, signed conv.
         eee.eeee     | 234.43     | ________*   | field width too small
         ffff.ff      | blank      | _______b    | input was a blank
         hms          | 45         | 3h0m0s      | program determines precision
         hms.ss       | 45         | 3h0m0.00s   | 2 digits in precision
         hms.         | 45         | 3h0m0s      | 0 digits in precision
         dms          | 45         | 45o0'       | program determines precision
         dmS          | 45         | 45o0'0''    | always print the seconds

note 1:  If your start position for plotting major ticks is not a 'nice' 
         number, but the step size is, the default precision in the hms/dms
         formats, could be too small to label correctly. If this occurs, set
         the precision with the 'axformat' command.
#end


#start
command: axis
syntax:  axis B/R/T/L [P][W][O][F][Z][In1n2][An1n2]
         B = Bottom axis, T = Top axis, R = Right axis and L = left axis.
         P = Physical coord. labels
         W = World coord. labels, 
         O = Offset labels. 
         F = FITS transformations: phys = CRVAL + grid*CDELT
         Z = Plot labels as 10**(World coordinate).
         E = Extend the major label ticks to create a coordinate grid.
         I11 = Plot ticks marks inside frame.
         I10 = Plot ticks marks outside frame.
         I00 = Do NOT plot any tick marks
         A11 = Plot labels inside frame.
         A10 = Plot labels outside frame.
         A00 = Do NOT plot any labels

example: axis B                ! Plot Bottom axis, no labels 
         axis BW               ! Plot Bottom axis, labels are world coordinates 
         axis BP               ! Plot Bottom axis, labels are converted 
                               ! coordinates
                               ! a set must be given with inset command.

note:    The default position for the tick marks is inside
         the frame and for the labels outside the frame. Only if
         you want to change this scheme, you need the 'I' and/or 'A' options.

         The 'E' option can create an incomplete coordinate grid because
         for some projections the opposite axis labels do not show the
         same labels. In that case repeat the 'axis' commands with the
         'E' option for both opposite axes and use the same 'axpos' and
         'axdelta' values for these axes. The 'cgstep' (coordinate grid
         step) command sets the sampling of the points at which the grid
         coordinates are calculated.
#end


#start
command: axlogs
syntax:  axlogs [x1 x2 x3...]
         Define the major tick marks on a logarithmic axis.
         i.e. plot labels as 10^(world/physical coordinate).
         The default labels are .. 0.01  0.1  1  10 etc.
         If you specify x1 x2 etc. (and 1.0 <= xi < 10)
         then also the numbers x1 x2 etc. are plotted. 

note:    The axis specification must include the character Z.

Example: axlogs 1 3 5
         Plot major ticks at ...0.1 0.3 0.5 1 3 5 10 30 50 100 .....
#end


#start
command: axminors
syntax:  axminors [n]
         n is the number of minor intervals between two major ticks.
         If n is omitted, the current value is displayed. If n < 0
         a default is calculated.

note:    The value of axminors is reset after plotting an axis, so it is
         only valid for the next call to 'axis'
#end


#start
command: axpos
syntax:  axpos [x] [units]
         x is position where first label has to be plotted, x is in
         world coordinates. If the current axis belongs to a set, 
         x can be given in units compatible with the units found in the 
         header. A list with units can be generated with: help units
         
         If 'axpos' has no parameters, a default value will be calculated.
         For physical coordinates, the program uses the GIPSY syntax.
         Spatial positions:
         *        ;  for RA or DEC in resp. HMS and DMS.
         *1950    ;  for RA or DEC in resp. HMS and DMS in EPOCH 1950.0
         *xxxx.x  ;  for RA or DEC in resp. HMS and DMS in EPOCH xxxx.x
         G        ;  Galactic longitude or latitude in degrees
         E        ;  Ecliptic longitude or latitude in degrees
         S        ;  Supergalactic longitude or latitude in degrees

example: axpos 120             ! Start writing ticks at world coord. 120
         axpos 200 km/s        ! Convert value to header units
         axpos                 ! Calculate default
         axpos PC              ! Start at to projection centre
         axpos AC              ! Start at axis centre in set (naxis/2-crpix)
         axpos * -60 12 23     ! Spatial position in dms for latitude
         axpos * 12 30 5.5     ! Spatial position in hms for longitude
#end


#start
command: axtitle
syntax:  axtitle [string]
         if 'string' is omitted, a default title is plotted.

note:    A position for the title is obtained only after using the 
         axis command with the option W or P included.
#end


#start
command: beam
syntax:  Two different situation are distinguished:
         
         1) There is a 2-dim (sub)set and the map is a spatial map:
         beam  major minor [pos.angle] [lines] [slope] [shape] 
               
         The items "major [units]", "minor [units]" and "angle" can
         be replaced by "header". This will read the appropriate
         header item from header of the set.
               
         major = FWHM of major axis of beam in grids (world coordinates) 
                 or header compatible units. 
         minor = FWHM of minor axis of beam in grids (world coordinates)
                 or header compatitble units.
         angle = Angle (deg) between the North in your spatial map and
                 the major axis, taken in the direction of positive
                 latitude (for an RA axis i.e. anti-clockwise).
        
         2) There is a 2-dim (sub)set but the map is NOT a spatial map:
         beam  Xaxis [units] Yaxis [units] [angle=0.0] [lines] 
               [slope] [shape]
         Xaxis = FWHM (in x dir.) of beam in grids (world coordinates)
                 or header compatitble units.
         Yaxis = FWHM (in y dir.) of beam in grids (world coordinates)
                 or header compatitble units.
         angle = 0.0. The angle for such a set is not defined and is
                 set to zero by the program. Therefore the order of the  
                 beam axes is important. The first axis must be in the
                 X-direction and the second in the Y-direction.

         3) There is not a set available:
         beam  Xaxis Yaxis [angle] [lines] [slope] [shape]
         Xaxis = FWHM (in x dir.) of beam in world coordinates
         Yaxis = FWHM (in y dir.) of beam in world coordinates
         angle = Angle between the beam axis in X-direction and the X-
                 axis.

         The other (optional) parameters are the same for each 
         situation:
         
         lines = Number of shade lines crossing axis in y direction
         slope = Slope of shade lines in degrees.
         shape = 1 an elliptical beam (default).
                 2 a rectangular beam.
                 3 a cross

         Examples:
         ad 1) 1: beam 1.4 arcmin 1 arcmin  ! A beam with mjor axis 1.4
                                            ! arcmin aligned with the north
               2; beam 1.4 arcmin 1 arcmin 110 20 30 2
                                            ! Same beam at angle 110 degrees
                                            ! with 20 shade lines at slope 30 
                                            ! deg. However the beam is 
                                            ! rectangular now.

note:    Draw a shaded ellipse in world coordinates. The position angle 
         (set by command 'angle')
         of the 'Xaxis' is wrt. the pos. x-axis. The ellipse is rotated
         counter-clockwise. The interior of the ellipse is shaded with lines
         The number of lines is lines' and the slope of the lines is 
         'slope' (deg.).
#end 


#start
command: box
syntax:  box xlo ylo xhi yhi

example: box -10 -10 120 90      ! Box from (-10,-10) to (120,90)
         box PC D 10 10          ! Box with sizes 10x10 centered around
                                 ! the projection centre of the set
                                 ! that was selected with command 'inset' 

note:    -The GIPSY input syntax for boxes (like 'PC', 'AC', 'D' etc.)
         can only be used if a set is known. In that case the box may
         exceed the subset size.
         -The limits can also be changed with commands 'xrange' and 
         'yrange' (with or without a given set), but then the input 
         is always in world coordinates!
         It is allowed to set xlo > xhi and ylo > yhi for boxes (without
         a set) and ranges.
#end


#start
command: cgstep
syntax:  cgstep [x]
         If x is omitted, the current value is displayed.

note:    This command is used if you are not satisfied with the
         coordinate sampling in the coordinate grid that was plotted 
         with the 'E' option in the 'axis' command. The default value
         is 1.0, i.e. a grid coordinate is calculated at each pixel.
         To accelerate the process, select a value greater than 1.0. 
         If you want a more accurate grid, select a value less than 1.0.

#end


#start
command: charheight
syntax:  charheight [x] (mm)
         If x is omitted, the current character height is displayed.

note:    The size affects all text and graph markers. The default
         size is corresponds to a character height
         about 1/40 the height (in mm) of the view surface. Changing
         the character size also scales the length of tick marks for 
         standard boxes (without physical coordinates) and terminals
         drawn by the 'errorbar' command.
#end


#start
command: clear
syntax:  clear

note:    For non-interactive use. This command will be stored in the
         list. See also 'erase'
#end


#start
command: clist
syntax:  clist [one or more column names]
         The column names can be abbreviated.
example: clist x ex ycol eycolumn 
#end


#start
command: closeplot
syntax:  closeplot

note:    Only after this command, a plotfile is closed or
         a plot is sent to a printer. If you used the 'hardcopy'
         command it is not necessary to use 'closeplot'.
#end


#start
command: colbar
syntax:  colbar [width] [height] [orientation]

         Plot an annotated grey-scale or color wedge at the current
         pen position using the current colour settings in GIDS.
         Height and width are in mm and are defined for every orientation
         of the colour bar/wedge. If you specify one of the axis 
         orientations L, R, T or B (together with width & height) 
         then L and R define a vertical bar and T and B define a 
         horizontal bar.
         The labels are controlled by the commands 'axpos', 'axdelta'
         and 'axformat'.
note 1:  A colour bar is plotted starting at the current pen position.
#end


#start
command: color
syntax:  See description at colour
#end


#start
command: colour
syntax:  colour [n]
    or:  colour [colour name]
         n is a colour number. If n is omitted, the current colour
         index is displayed. For the names, wildcards (*) can be used
         ======= AVAILABLE COLOURS =======
         0      Background
         1      Foreground or Default (Black if background is white)
         2      Red
         3      Green
         4      Blue
         5      Cyan
         6      Magenta
         7      Yellow
         8      Orange
         9      GreenYellow
         10     GreenCyan
         11     BlueCyan
         12     BlueMagenta
         13     RedMagenta
         14     DarkGray
         15     LightGray
         16-255 Undefined
#end


#start
command: colplot
syntax:  colplot

recipe:  Use GIPSY application VIEW to start GIDS and adjust colours.
         getlut                  ! Command to fix the current colour settings.
         device lcpsfile         ! Select a colour device
         inset myset             ! Set of which you want a colour plot.
         box                     ! Define the box.
         colplot                 ! Create the colour plot.
         levels 1:10             ! Select levels for contours.
         contours                ! Draw the contours.
         end                     ! Close the plot, your PostScript file is ready.

note:    The GIDS colour Look Up Table and levels are used by the program
         to create a colour plot. GIDS must be available and set to your own
         preferences. Your graphics device must be a colour device e.g.
         keyword GRDEVICE=lcpsfile or command 'device lcpcfile' 
         If you want a colour plot and contours at the same time, use the
         'colplot' command before the 'contours' command. Otherwise you will
         see no contours in your hardcopy.
#end


#start
command: colrep
syntax:  colrep index red green blue

note:    Set colour representation: i.e., define the color to be
         associated with a color index. The colours red, green
         and blue are number between 0.0 and 1.0.

example: colrep 20 0.5 0.1 0.75
#end



#start
command: connect
syntax:  connect [b]

note:    Connect coordinates given in xcolumn, ycolumn by lines.
         The default 'connect' interprets blanks as values that cannot be 
         plotted and skips making connections between one or more blanks.
         If option 'b' is used, the blanks are completely ignored. Connections
         between points will not be interrupted.

example: xcolumn file(xcol,1,1:)       ! Read x data from file
         ycolumn file(ycol,1,1:)       ! Read y data from another file
         xrange xcolumn                ! Range is min/max of this column
         yrange ycolumn
         xsize 120                     ! Size of plot in mm
         ysize 80
         color foreground              ! Set colour to foreground
         frame                         
         symbol 17                     ! Select a marker symbol
         points                        ! Plot the markers
         color green    
         connect b                     ! Connect the points, ignore blanks
#end


#start
command: contlab
syntax:  contlab [intval] [minint] [label]

         The spacing of labels along the contour is specified by parameters
         INTVAL and MININT. The routine follows the contour through the
         array, counting the number of cells that the contour crosses. The
         first label will be written in the MININT'th cell, and additional
         labels will be written every INTVAL cells thereafter. A contour
         that crosses less than MININT cells will not be labelled. Some
         experimentation may be needed to get satisfactory results; a good
         place to start is the default (which is intval 20, MININT 10).

         If you want your own text along a contour, then specify a
         label. Then however, you need to specify intval and minint also

note:    See also 'contours'. Note that the contour label routine does NOT
         recognize blank values.

#end

#start
command: contticks
syntax:  contticks [tick length] [tick step]
         Length of ticks in world coordinates. If tick length is
         positive, the direction of the ticks is toward a maximum.
         If it is a negative number, it points to a minimum.
         The tick step is an integer and sets the separation 
         of the ticks in grids!

note:    Defaults are 0.5 for the tick length and 1 for the
         tick step.
#end


#start
command: contours
syntax:  contours

note:    Contours can only be plotted if levels are specified (levels command)
         Each contour line is drawn with the current line attributes (color
         index (color), style (lstyle), and width (lwidth).
#end


#start
command: cursor
syntax:  cursor [mode]

note:    Start a loop in which the cursor position can be read. A 
         position is displayed if a key is pressed. You can leave the 
         cursor loop by pressing 'q' or 'Q'. The last position can be 
         marked by pressing 'm' or 'M' (See also at 'symbol')
         Other keys can also be defined. Their definition is 
         returned as a command. See 'curtxt'.
         The commands are executed immediately if a lower case
         character is pressed. If an upper case character is
         pressed, the command can be edited on the command line.

         The cursor 'mode' is implemented but there are currently
         no GIPSY devices that support different cursor styles. Mode is 
         a number between 0 and 7.
#end


#start
command: curtxt
syntax:  curtxt #key string
         This command defines a keyboard character (a-z) as a 
         key definition in the interactive environment started with
         'cursor'. The string can include C-type formats. For each
         format pair, a x,y coordinate pair is substituted
         The coordinate pairs are the current cursor position.
         The maximum number of coordinate pairs is 4.
         All keys can be defined except 'Q' and 'M' because they
         have a definition in 'cursor'.

example: curtxt #A draw %f %f
         Define for use in 'cursor' the A key as command 
         draw x y where x y are the current cursor position.
         Start 'cursor' with COMMAND=cursor and press -a- to 
         execute the draw command or press -A- to edit the 
         draw command.
#end


#start
command: delete
syntax:  1) delete 'macroname'
         2) delete number-expression
         The syntax for the number expression follows the rules for the 
         GIPSY input of integer numbers.

example: delete curve	      ! delete macro curve
         delete 3             ! delete line 3 in current macro
         delete 3:6           ! delete lines 3 4 5 and 6 in current macro
#end


#start
command: device
syntax:  device [devicename] [nx] [ny]
         devicename:  name[//append] or name[/'filename']
         name:        the name of a known GIPSY plotting device
         //append:    write to device but do not clear first.
         /filename:   write hardcopy output to this file instead of 
                      a file with name generated by the program.
         nx: the number of subdivisions of the view surface in X.
         ny: the number of subdivisions of the view surface in Y.
         The program puts nx x ny graphs on each plot page or screen;
         when the view surface is sub-divided in this way, PAGE moves to
         the next sub-page, not the next physical page.

Note:    Sending output to a hardcopy device is only done 
         after the command 'end' to close the current device.

example: device gids              ! select device GIDS for plotting
         device                   ! prompt with GRDEVICE= (has list of devices)
         device gids//append      ! append to existing image in gids window
         device PPSFILE/myfile.ps ! write output to PPSFILE with
#end                              ! name 'myfile.ps'.


#start
command: devinfo
syntax:  devinfo
#end


#start
command: draw
syntax:  draw x y

example: see examples  'move' 
#end


#start
command: edit
syntax:  edit [macroname]

example: edit                     ! edit current macro
         edit curve               ! start or edit macro curve,
                                  ! return to calling environment
note:    Abort editor action with ^C
#end


#start
command: ellipse
syntax:  ellipse  Xaxis [units] Yaxis [units] [start] [end] [delta]
         Plot ellipse at current pen position
         Xaxis = Semi axis (in x dir.) of ellipse in world coordinates
         Yaxis = Semi axis (in y dir.) of ellipse in world coordinates
         start = Angle (deg) to start drawing ellipse, default is 0
         end   = Angle (deg) to stop drawing ellipse, default is 360
         delta = sample angle increment in degrees.

         Units can be given only if a set is known!

note:    Draw an ellipse in world coordinates. The position angle
         (set by command 'angle')
         of the 'Xaxis' is wrt. the pos. x-axis. The ellipse is rotated
         counter-clockwise. The plotting starts at 'start' degrees from the
         'Xaxis' and stops at 'end' degrees from this 'Xaxis'.
#end


#start
command: end
syntax:  end
         Quit insert mode while building a macro, or quit macro
         and go to 'execute' (or 'main') mode.

example: end                      ! leave insert mode
         end                      ! leave macro, jump to execute mode

note:    Use 'closeplot' to close a device before sending a plot 
         to a printer.
#end


#start
command: environ
syntax:  environ xlo ylo xhi yhi [just] [axis]
	 just:	  if just=1, the scales of the x and y axes will be equal
         otherwise they will be scaled independently.
         axis:
         -2 : draw no box, axes or labels
         -1 : draw box only
          0 : draw box and label it with coordinates
          1 : same as 0 but also draw lines x=0 and y=0
          2 : same as 1, but also draw grid lines at major inc.
         10 : draw box and label x-axis logarithmically
         20 : draw box and label y-axis logarithmically
         30 : draw box and label both axes logarithmically

example: environ 0 0 100 50 1 0   ! draw box in equal scales and label axes

note:    default values for just and axis are 1 and 0 resp.
#end



#start
command: erase
syntax:  erase

note:    This interactive command cannot be stored in a macro.
         See also 'clear'.
#end


#start
command: errorbar
syntax:  1) errorbar [y] [x] [-y] [-x]
         2) errorbar [y1] [units] [x1] [units] [y2] [units] [x2] [units]
         ad 1) y, x, -x, -y are typed as shown, order is unimportant.
         ad 2) y1, x1, y2, x2 are floating point numbers, order is important.
               units can be used only if a set was given with the 'inset' command.

note:    As soon as one number is found, the routine draws one error bar
         with given bar lengths. Else, all positions in 'xcolumn, ycolumn'
         with corresponding errors in 'excolumn' or 'yxcolumn' will get
         an error bar.

example: errorbar y -y           ! draw vertical error bar. Length of bar in 
                                 ! one direction is given by the corresponding 
                                 ! value in 'eycolumn'. Repeat action for all 
                                 ! points in 'xcolumn, ycolumn'.
         errorbar 5 4            ! vertical error bar of length 5 and a hori-
                                 ! zontal error bar of length 4.
#end


#start
command: excolumn
syntax:  see description at xcolumn
#end


#start
command: eycolumn
syntax:  see description at xcolumn
#end


#start
command: expand
syntax:  expand x [y]
         x and y are expansion factors for the x- and y direction

note:    Only the scale(s) will be affected by the 'expand' command.
         The expansion is always with respect to the current values of
         'xscale' and 'yscale', so 'expand 1 1' will reset the scales to
         their original values.

example: expand 2.2 0.8          ! Expand factor 2.2 in x direction
                                 ! and shrink factor 0.8 in y direction
#end


#start
command: fastyle
syntax:  fastyle [n]
         If n is omitted, the current value is displayed.
         The default value is 2 (=hollow).
         If n is 1, the rectangle will be filled in the current colour

example: fastyle 1               ! solid fill
         fastyle 2               ! hollow (outline only)
         fastyle 3               ! hatched
         fastyle 4               ! cross hatched
#end


#start
command: file
syntax:  file filename help [item1, item2, ...]
         or:
         file filename xcolumn/ycolumn/excolumn/eycolumn [xc../..]
         First option can be used to print a help file with command
         descriptions. file filename help will write all available
         help to file filename. If items (e.g. some commands) are
         entered after 'help' then only the help that is available for
         these items are written to file.
         The second option is used to write data stored in one of the
         GPLOT columns to a file. After the file name, one or more
         column names can be entered e.g.:
         file profile.txt ycolumn eycolumn
         which will store the contents of 'ycolumn' and 'eycolumn' to a
         file on disk with name 'profile.txt'.
#end



#start
command: font
syntax:  font [n]
         or:
         font [normal]/[roman]/[italic]/[script]
         If n is omitted, the number of the current font is listed, 
         together with a list of available fonts.

example: font 3                  ! All subsequent text is in italic font
         font italic             ! Same

note:    1 = (default) a simple single stroke font (normal)
         2 = roman font
         3 = talic font
         4 = script font
#end


#start
info:    formats 
Use:     text-command  [characters] [{[format,]expression}] [characters]
         format is a string containing the optional flags '+', '-', followed
         by characters indicating field width and precision.
         Text commands are 'text', 'xlabel', etc.

Example: text Values at theta {fffff.fff,pi/2}

Table:      format    | input      |  output      |   remark nr
         =========================================================
         +eeeeee.eeee | 43345.5436 |  +4.3346e+04 |      1
         gggg.ggggg   | 34.43      |     34.430   |      2
         +ffff.ff     | 23.456     |   +23.46     |      3
         -ffff        | 345.87     | 346          |      4
         -+ffff.fff   | 34.43      | +34.430      |      5
         eee.eeee     | 234.43     |        *     |      6
         ffff.ff      | blank      |       b      |      7

         Remarks:

         1) exponential format, signed conversion
         2) field width is 10
         3) signed conversion
         4) left justified, integer format
         5) signed, left justified
         6) field width too small for conversion
         7) input was a blank
#end


#start
command: frame
syntax:  frame

note:    This command consists of 4 calls to the 'axis' command (if subset.
         dimension equals 2
         Use the 'axis' commands if more 'label' control is wanted.
#end


#start
info:    functions  

example: To plot the function y=sin(x) for 0 < x < 90 use commands:
         xcol 0:90               !generate values 0..90 in xcolumn
         ycol sin(rad(xcolumn))  !take the sine of each entry in xcolumn
         points                  !plot the markers at each x, y
#end


#start
command: getlut
syntax:  getlut [header]

note:    Fix the current GIDS colour lut. This colour characteristics will
         be used for all colour plots of a set until 'getlut' is used again.
         This command must be used before using the 'colplot' command.
         The lut is preserved after the 'reset' command.
         A lut can be stored in a set given with 'inset' with command
         'storelut'. To retrieve it, use 'getlut header'.
#end


#start
command: gids
syntax:  gids

note:    For an overlay over an image displayed in GIDS (after command 'view'
         or GIPSY application VIEW), first select 'device gids//append' or
         'GRDEVICE=gids//append' at the start of GPLOT. Then use GPLOT command
         'gids' to read the set and box from GIDS and adjust the scales and
         offsets. After this, the command 'frame' can be used to draw a frame.
         The plot mode after this command is always 'world coordinates'.
#end


#start
command: grayscale
syntax:  grayscale

note:    Create a gray scale plot of the data in the set, subset as 
         specified in 'inset' and 'box'. The levels are selected with 
         the 'levels' command. The number of levels must be at least two.
         The first level appears in shade 0 ('background') and the last 
         level appears in shade 1 ('foreground'). The shading algorithm
         depends on the selected device. If you sort levels in descending
         order, the shading will change from dark to light.
#end


#start
command: hardcopy
syntax:  hardcopy [device specification]

example: hardcopy p1laser         ! re-execute commands for p1laser
                                  ! close plot file and send it
#end


#start
command: help
syntax:  help item1 item2 ...
         help *

example: help *lab*               ! display help about all commands 
                                  ! containing 'lab'
         help *                   ! display all available help
note:    With command 'file filename help',  all help information 
         is sent to an Ascii file with name -filename-.
#end


#start
command: histobin
syntax:  histobin [center]
         center: if yes, the xcolumn values denote the center of the bin, if
         no, the xcolumn values denote the lower edge (in x) of the bin.
         The default value for center is yes

note:    Plot a histogram of values with xcolumn values along the ordinate,
         and ycolumn along the abscissa. Bin width is spacing between X 
         values.
#end


#start
command: histogram
syntax:  histogram [nb]
         nb: the number of bins to use (in 'xcolumn' data)
         if omitted, 10 is substituted.

note:    The range given by 'minmax' is divided into nb equal bins and
         the number of 'xcolumn'  values in each bin is determined by
         this routine. 'nb' may not exceed 200.
#end


#start
command: id
syntax:  id

note:    Plot string with user name and date on position of pen. This
         position can be changed with 'move'. The text attributes apply
         also to this command.
#end


#start
command: input
syntax:  input 'filename'

example: input myplot.txt         ! input and execute contents of 'myplot.txt'

note:    If you change or extend the contents of main and want to write
         it back to disk in the old file, use: write main 'myplot.txt'
#end


#start
command: inset
syntax:  inset [set] [subset(s)]
         Use GIPSY input syntax for set, subset(s)

note:    After a valid 'inset' specification, some commands are treated
         in a different way. For instance 'box' now follows the GIPSY
         standard input syntax for boxes and all positions can be given
         in the standard GIPSY way.
#end


#start
command: interpol
syntax:  interpol on/off 
         interpol yes/no
         Set PostScript's interpolation mode on or off. PostScript 
         levels 2 and higher have a mode in which an image is interpolated.
         The method is a bilinear interpolation method incorporated in the
         PostScript output.
         
example: interpol on
         colplot 
         interpol off

note:    Blanks are not interpolated.
#end


#start
command: justificat
syntax:  justificat [n]
         if n is omitted, the current justification will be displayed

note:    'justificat' controls the horizontal justification of strings.
         If justific=0.0 the string will be left-justified at the 
         current pen position. If justific=0.5, it will be centered and 
         if justific=1.0, text will be right justified.
#end


#start
command: keyword
syntax:  keyword command prompt
         Generate a keyword prompt. The name of the keyword is given in
         'command' (do not include '=' character!). The prompt is given in
         'prompt'. The text that is entered at the prompt will be passed to
         the command given in 'command' for execution.

example: keyword xrange Give xrange
         Generates keyword XRANGE= and prompts with: Give xrange
#end



#start
command: levels
syntax:  levels x1 x2 ... xn [perc]
         If no parameters are given, the command generates a list with the
         current levels. There is a maximum to the number of levels (...)
         If the last argument is perc , all the levels will be scaled between
         values specified with 'minmax'. The conversion from percentages
         to absolute levels is done with the formula: 
         level[i] = min + perc[i]/100 * [max-min] 
         so that 0% results in the level 'min' and 100% results in 'max'
          
         To inverse the shading of the gray scales, use a descending order 
         for the levels e.g. 1000 800 400 100

example: minmax set                ! min, max of current set
         levels 2 10 50 perc       ! 2% 10% 50%      
#end


#start
command: list
syntax:  list [expression]
         The syntax for the expression follows the rules for the
         GIPSY input of integer numbers.

example: list                     ! list all lines in current macro
         list 3                   ! list line 3 in current macro
         list 3:6                 ! list lines 3 4 5 and 6 in current macro
#end


#start
command: location
syntax:  location [x] [y]
         x and y are numbers in mm that indicate the offset from the
         lower left corner of your device.
         If both numbers are omitted, the current offsets are displayed.
         The lower left corner of the current box is plotted at the
         position given with 'location' (in mm) or 'ulocation' (in world-
         coordinates). The relocation can be used for instance to create
         panels.

note:    If you use location x y, the values x y indicate (in mm) the 
         position on the device of the lower left corner of the viewport
         If you want a position in world coordinates, use command 'ulocation'
#end


#start
command: lstyle
syntax:  lstyle [n]

note:    lstyle 1  : full line (default) 
         lstyle 2  : long dashes 
         lstyle 3  : dash-dot-dash-dot 
         lstyle 4  : dotted 
         lstyle 5  : dash-dor-dot-dot 
#end


#start
command: lwidth
syntax:  lwidth [n]
         If n is omitted, the current width is displayed. 

note:    This command affects lines, graph markers and text.
         But the exact appearance is device dependent. The minimum
         number is 1 and the maximum is 21.
#end


#start
command: macdir
syntax:  macdir [pathname]
example: macdir /zwi1/users/whoever/macro
         Search for macro in directory /zwi1...

note:    macdir without argument resets path to current directory
#end


#start
command: macro
syntax:  macro macroname

example: macro rotcur             ! start or update macro rotcur
                                  ! Equivalent to: edit rotcur

note:    Start a macro in execute mode by typing the name of the macro.
         f.i. rotcur NGC443 64  (Start macro rotcur with variables
         NGC443 and 64)
#end


#start
command: marker
syntax:  marker [filename]
         Plot marker at current pen position. The marker is a symbol as defined
         with the command 'symbol'
         If a file name is given, then markers are plotted on all positions
         that could be extracted from the file. Each line in the file must
         have a valid two dim. position specification according to the GIPSY
         syntax for input of positions. A line can be empty or contain comment
         (starting with the '!' character).

note:    A series of markers can also be plotted using the 'xcolumn', 'ycolumn'
        'symbol' and 'points' commands. Then the input can only be grid
         positions.

example: A file 'pos.txt' contains the positions:
         * 10 16 47.99  * 45 46 59.9
         * 10 16 43.22  * 45 48  9.8
         * 10 16 38.44  * 45 49 19.7 ! Last of the physical coordinates
         !back to grids
         80.3 56.7

         Markers are plotted with:
         device x11
         inset n3198h f 2
         box
         frame
         marker pos.txt
#end


#start
command: minmax
syntax:  minmax n1 n2
         minmax set
         minmax head
         minmax xcol (or ycol, excol, eycol)
         minmax (without parameters, displays current values

example: minmax 0 10.2             ! set min to 0 and max to 10.2
         minmax set                ! determine min, max of current set
                                   ! in current box.
         minmax header             ! get min, max from header of current set.
         minmax xcolumn            ! min, max from xcolumn.
#end


#start
command: mmeter
syntax:  mmeter

note:    Switch back to world coordinates with command 'world'
#end

#start
command: mosaic
syntax:  mosaic
         Starts an internal macro which will prompt you for the set and
         subsets, the character height of the axis titles (the height
         of the axis position labels will be scaled with this number),
         the mosaic layout ('moslxly') and a number of commands that 
         must be repeated for each mosaic panel (MOSCOM0=, MOSCOM1=,
         etc). The MOSCOM keywords are used to specify GPLOT commands
         with their parameters. There are some restrictions: the commands
         cannot be abbreviated and macro's cannot be used.
         Pressing carriage return at the MOSCOMn= keyword, 
         starts repeating the entered mosaic commands for each panel
         in the mosaic. A lot of assumptions are made in this internal 
         GPLOT macro and of course you lose flexibility, but it is easy 
         to use.

         If however you want to set up a mosaic using GPLOT commands, then 
         examine the next example. 

example: location 30 30
         color foreground
         inset aurora f
         box   
         xsize 120
         ysize 80
         moslxly 6 6
         mosframe
         levels 1 10 20 40 100
         subset 1
         color yellow
         conto
         ! ======== Next frame =======         
         mosnext
         subset 2
         color green
         conto
         ! ======== Next frame =======
         ... etc ...
#end

#start
command: mosframe
syntax:  mosframe
         Plot a mosaic frame, i.e. label panel axes if they are positioned
         at the left side or lower side of the frame. Plot also the name of 
         the axes. The character height for the axis labels is decreased
         with a factor calculated by the program. This command doe not \
         change the position of the current panel.
#end

#start
command: moslxly
syntax:  moslxly [x y]
         Set a mosaic to x columns and y rows. The complete mosaic
         size must be given before this command (f.i. with 'xsize' and
         'ysize'). Each panel will have a width of xsize/x and height
         ysize/y. 
         If the command is given without parameters, it will reset the 
         scales and sizes to the values stored before a call to 'moslxly'.
         The 'moslxly' command is always the first command to set up a 
         mosaic.
#end

#start
command: mosnext
syntax:  mosnext
         Go to the next panel. The order is left to right and upper to lower.
#end

#start
command: mosprev
syntax:  mosprev
         Go to the previous panel. The order is right to left and lower 
         to upper.
#end


#start
command: mosxy
syntax:  mosxy x y
         Set current panel to column x and row y. The values for x and 
         y start with 1 which corresponds to the panel in the lower left 
         corner. The default, after a call to 'moslxly', is a panel in
         the upper left corner, where x is 1 but y is equal to the 
         number of rows that you entered in 'moslxly'.
#end


#start
command: move
syntax:  move x y
         Move the current pen position to the position (x,y).
         The position can be interpreted as grids, mm or physical
         coordinates.

example: move 20 30              ! Move to world coordinates (20,30)
                                 ! in millimeter mode: (20,30) mm
         IF A SET IS SPECIFIED:
         move PC                 ! Move to projection centre in set
         move AC                 ! Move to axis centre in set (naxis/2-crpix)
         move * 10 12 8  * -67 8 9.6
                                 ! Move to RA 10h12m8s, DEC -67d8m9.6s
                                 ! in the epoch found in the header
         move *2000.0 10 12 8 *2000.0 -67 8 9.6
                                 ! Same as above but now for Epoch 2000.0
         move U 45.323 U 30.322
                                 ! Move to physical position 45.323, 30.322
                                 ! DEGREE
         move G 45 G 45          ! Move to this galactic lon, lat in degrees
         move E 45 E 45          ! Move to this ecliptic lon, lat in degrees
         move S 45 S 45          ! Move to this supergalactic lon, lat in deg.
         move 30000 M/S U 45     ! A velocity and a number in axis units

note:    If the subset dimension was 1 (only one axis specified), the physical
         coordinate will be converted for that axis (whatever its orientation
         will be).
#end


#start
command: overbox
syntax:  overbox
         Get a default box for an overlay set so that this
         set fits into the box that was used by the previous
         set.

note:    The box is calculated using physical coordinates.
         Therefore, projection and rotation are important.
         However the program assumes that the rotation and
         projection are the same for each set and does not
         check this explicitly.

example:
         inset set1
         levels 2 4 6
         box
         frame
         contours
         inset set2   !Load a set
         overbox      !Set a default box to fit overlay
         overlay on   !Adjust scales automatically
         contours
#end


#start
command: overlay
syntax:  overlay , overlay on, overlay y
         -Start overlay mode
         overlay off
         -Return to previous scales and offset

note:    For an overlay over an image displayed in GIDS see at 'gids'

example:
         inset set1
         levels 2 4 6
         box
         frame
         contours
         inset set2   !Load a set
         box -30 -30 30 30 (or use overbox)
         overlay on   !Adjust scales automatically
         contours
#end


#start
command: page
syntax:  page

note:    Advance to a new (sub) page, clearing the screen.
         PAGE does not change the window or the position of the viewport
         relative to the (sub-)page.
#end


#start
command: pattern
syntax:  pattern x1 ... x8
         The parameters are 8 numbers which set a new line style
         pattern. The numbers consist of 4 pairs. The first number
         of each pair is the number of dots that must be plotted
         and the second number is the number of dots that must
         be skipped. The line style is reset with command 'lstyle 1'.
         The parameters are floating point numbers > 0

examples:The patterns of the default line styles:
         dashed: pattern 10::8
         dot-dash-dot-dash: patt 8 6 1 6  8 6 1 6
         dotted: patt 1 6 1 6  1 6 1 6
         dash-dot-dot-dot: 8 6 1 6  1 6 1 6
#end


#start
command: pause
syntax:  pause
         (Continue after pressing carriage return)

note:    Pausing can be useful if you want to execute a macro
         but also want for example to change the color lut
         just before a 'getlut' command.
#end


#start
command: pgframe
syntax:  pgframe [string1 tick1 sub1 string2 tick2 sub2]
         string1: string of options for horizontal axis
         tick1:   world coordinate interval between major ticks in X
                  If tick1=0.0, the interval is chosen by the program
         sub1:    number of sub intervals to divide the major coordinate
                  intervals into. If sub1=0, the number is chosen by the
                  program (also if tick1=0.0).
         string2, tick2, sub2: same as above but now for y axis
         string consists of characters:
         A: draw Axis (X axis is horizontal line Y=0, etc.)
         B: draw Bottom (X) or left (Y) edge of frame
         C: draw top (X) or right (Y) edge of frame
         G: draw Grid of vertical (X) or horizontal (Y) lines
         I: Invert the tick marks; i.e. draw them outside the viewport
            instead of inside
         L: Label axis logarithmically. The major tick interval is always 1.0.
            The numeric label is 10**(x) where x is the world coordinate
            at the tick mark. If subticks are requested, 8 subticks are drawn
            between each major tick at equal logarithmic intervals.
         N: write Numeric labels in the conventional location below the
            viewport (X) or to the left of the viewport (Y)
         P: extend ('Project') major tick marks outside the box (ignored 
            if option I is specified.
         M: write numeric labels in the unconventional location above the
            viewport (X) or to the right of the viewport (Y)
         T: draw major Tick marks at the major coordinate interval
         S: draw minor tick marks (Subticks)
         V: orient numeric labels Vertically. This is only applicable to Y.
            The default is to write Y-labels parallel to the axis

note:    There are defaults for the arguments. But you cannot omit them
         in a random order. So if you want to specify only the number
         of subticks along Y, you have to give the other arguments too!

example: pgframe                 ! same as pgframe BCNST 0.0 0 BCNSTV 0.0 0
#end


#start
command: pgviewport
syntax:  pgviewport xlo ylo xhi yhi (all in mm)

note:    Change the size and position of the viewport, specifying the viewport
         in mm in each dimension. The viewport is the rectangle on the view 
         surface through which one views the graph. Most of the plot routines
         truncate at the edge of the viewport. The region of world space
         (the coordinate space of the graph) which is visible through the
         viewport is set by 'box' or 'xrange' and 'yrange'. It is legal to
         request a viewport larger than the view surface. Only the part which
         appears on the view surface will be plotted. The default viewport is
         the entire device.
#end


#start
command: playback
syntax:  playback [device]

example: playback                 ! Re-execute stored commands on current device
         playback xterm           ! Re-execute stored commands on device xterm
         playback ?               ! playback, but prompt with GRDEVICE= first
#end


#start
command: plotinfo
syntax:  plotinfo
#end


#start
command: points
syntax:  points
         Routine to draw Graph Markers (polymarker) at coordinates in 
         xcolumn, ycolumn. They are drawn using
         the current values of attributes color-index, line-width, and
         character-height (character-font applies if the symbol number
         is >31).  If the point to be marked lies outside the window,
         no marker is drawn.

note:    Blank values are not plotted!
#end


#start
command: polmode
syntax:  polmode R/D
         If the mode is set to R (default) the angles read
         from 'polset' are in radians. If the mode is set to D
         the angles are in degrees.
#end


#start
command: polplot
syntax:  polplot [gridmask_x, gridmask_y] [iscale]
         gridmask_x/y are integers, iscale is a float
         Plot at predefined grid positions polarisation vectors
         with lengths set by data from 'inset' and with angles
         set by data from 'polset'. Data in 'inset' is scaled
         by 'iscale'. This is a number that scales the maximum
         intensity to the size of one pixel. If your maximum is Imax
         then iscale = 1/Imax will scale all vectors so that the
         longest fits into one pixel.
         If 'iscale' is omitted, a default will be calculated.
         Vectors will be plotted only on those integer grid-positions
         where the grid can be divided by gridmask_x in the x direction
         and gridmask_y in the y direction.

note:    See also 'polmode' and 'polset'.
#end


#start
command: polset
syntax:  polset set [subset(s)]
         Read angles of polarisation vectors from this set.
         Whether the angles are read as radians or degrees depend
         on 'plotmode'.
#end


#start
command: poly
syntax:  poly
         Shade the interior of a closed polygon. The action
         of this routine depends on the setting of 'fastyle'
         If Fill-Area Style is 1 (SOLID, the default), the
         interior of the polygon is solid-filled using the 
         current Color Index (colour). If Fill-Area Style is
         HOLLOW, the outline of the polygon is drawn using
         the current line attributes (color index, line-style,
         and line-width)

note:    If one of the arrays xcolumn or ycolumn contain
         blank values, plotting is aborted!
#end


#start
command: pplot
syntax:  pplot
         pplot is a macro that generates keywords to specify the profile
         that you want to plot. An internal loop allows you to create
         mosaics of profiles. There is also a keyword to store calculated
         profile coordinates (if possible physical coordinates) and the 
         corresponding profile values to disk.
         At the end of the loop you are asked to quit GPLOT or to stay
         in command mode.

note:    Most important ingredients are the commands:
         inset   
         profile       
         profint
         profdata
         profaxis bp
         profaxis tw
         profinfo
#end


#start
command: profaxis
syntax:  See command 'axis'.
         Draw an axis, just like the 'axis' command, but be sure that 
         the plotted axis is the profile axis. This is not always the case
         with the usual 'axis' command because this command depends on
         how 'inset' is used.

note:    Command has effect only after 'profile' is used.
         It is not necessary to use 'profaxis' if the 'inset' command
         specified a class 2 input (e.g. inset n3198h freq). In that case
         it is obvious which axis is the profile axis
#end


#start
command: profdata
syntax:  profdata
         This command actually assembles the profile data and stores
         it in the x/ycolumns and the excolumn. Also a string with profile 
         information is created. This string is printed with command 'profinfo'.
         'xcolumn' contains sample coordinates in the profile in grids.
         'excolumn' contains the physical equivalents of the grid positions
         in units as found in the header (CUNITn, n=1,2,..), 
         and 'ycolumn' contains the profile data in units given by the header
         (BUNIT).
#end


#start
command: profile
syntax:  profile x1 x2 .. xn  y1 y2 .. yn
         or 
         profile x1 x2 .. xn
         or 
         profile    (which generates a keyword prompt)

         The input depends on the input at 'inset'. For class 1 input
         (subset definitions), two profile positions must be entered to
         define a start- and an end point in the subset. For class 2 input
         (a profile axis is defined, e.g. inset n3198h freq 3:100), a
         position must be defined. The dimension of the vectors n, is the
         dimension of the subset that you defined.
         If arguments are omitted, you get a PROFILE= keyword with a message
         in which a position or a range is prompted e.g. 
         'Give profile from (RA1,DEC1) to (RA2,DEC2):' 
         or 
         'Give position in (RA,DEC): 
         Only the first input method allows you extract your profile
         in ANY direction in your (sub) set. Between the two profile
         positions a line is calculated and all grids on this line are
         used to get the corresponding image value. The image values are
         stored in the array 'ycolumn'. If the profile is aligned to one
         of the subset axes, 'xcolumn' will contain the grids along this
         axis, else, 'xcolumn' will contain the numbers 0 to number of
         points in profile minus one.
         The profile axis must be plotted with command 'profaxis' instead
         of 'axis'. The arguments can be the same as in 'axis'.

note:    The data is copied to xcolumn and ycolumn ONLY AFTER COMMAND
         'profdata'. Between these commands, you can use command 'profint'
         to set the integration sizes.
#end


#start
command: profinfo
syntax:  profinfo
         Plot at current pen position the profile information
         that was obtained after command 'profdata'. It contains the
         profile definition (position or range) and the integration 
         sizes (abbreviated as int.) if any are defined with 'profint'.
#end


#start
command: profint
syntax:  profint [integration sizes]
         If profint is given without parameters, then a prompt will be
         generated. The contents will depend on the way that 'inset'
         fixed your profile. If a profile specification aligns a profile
         with one of the axes in a set, then integration is possible
         in all remaining directions of that set. If you know beforehand
         in which directions integration is possible, then you can give
         the integration sizes as command parameters.
         The numbers that you enter are sizes of a box centered around a 
         profile position according to the formulas: 
               gridlo = cpos - PROFINT/2      and
               gridhi = cpos + PROFINT/2

example: inset AURORA f    ! AURORA is RA-DEC-FREQ set. Profile is in frequency
         profile 0 0       ! Profile starts at RA=0, DEC=0
         profint 2 4       ! Integrate over 3 pixels in RA, 5 pixels in DEC
#end


#start
command: quit
syntax:  quit (or stop)

note:    To abort the program use 'quit' or 'stop'.
         To send a plot without quitting GPLOT, use 'closeplot'.
#end


#start
command: read
syntax:  read macroname [filename]

example: read house               ! Create macro 'house', and 
                                  ! read input from 'house.mac' 
         read stars /dj2/users/me/local.txt      ! Start macro stars
                                                 ! input from 'local.txt'

note:    Start a macro in execute mode by typing the name of the macro
         The macro name must be an unique name, i.e. it should not get
         the name of an existing command.
#end


#start
command: rectangle
syntax:  rectangle x1 [units] y1 [units] x2 [units] y2 [units]
or:
         rectangle xlen ylen
         1) Four numbers must be supplied. If a set is known, also 
            units can be given.
         2) Two numbers must be supplied. The first one is a length
            in grids corresponding to the length in x-direction.
            The second is the length in y.

example: recta * 2 2 0 * 37 52 0 * 1 59 0 * 38 4 0
                                 ! draw rectangle from:
                                 ! RA=2h2m0s, DEC=37d52m0s to 
                                 ! RA=1h59m0s, DEC=38d4m0s
         recta -900 km/s -10 900 km/s 10
                                 ! draw rectangle from:
                                 ! x1=-900 km.s y1=-10 (grids) to 
                                 ! x2=900 km/s y2=10 (grids)
         rectangle 100 30
                                 ! length 100 grids in x, 30 in y
#end


#start
command: reset
syntax:  reset
#end


#start
command: setinfo
syntax:  setinfo
#end


#start
command: subset
syntax:  subset index
         index is a subset index number. The first number is always 0.
         The maximum number is (number_of_subsets-1).
#end


#start
command: status
syntax:  status

note:    See DEVINFO for plot status (device characteristics etc.)
#end


#start   
command: storelut
syntax:  storelut
         Store all colour information obtained with 'getlut' and GIDS
         in a table in the header of the set given in 'inset'. The 
         information is retrieved with 'getlut header'. The table is
         stored at the subset level given in 'inset'.
#end

#start
command: symbol
syntax:  symbol n
         n == -1                 ! Draw a dot of the smallest possible size.
         0 < n < 32              ! Draw plot symbol from table in PGPLOT manual
         n > 32                  ! Plot corresponding ASCII character as marker
#end


#start
command: stop
syntax:  stop (or quit)

note:    To quit the program use 'quit' or 'stop'.
         To send a plot without quitting GPLOT, use 'closeplot'.
#end


#start
command: task
syntax:  task taskname keyword1=val1 keyword2=val2 keyword3=val3, ......
         Spawn a task that reads the keywords as entered in the keyword
         list (list after the task name).
example: task COMBIN RESULT01=ifgt($2,3.0,$1,blank) RESULT02= 
         SET01=u9211-2dim 1 SET02=u9211-2dim 8 SETOUT01=temp BOX01= BOX02=
#end


#start
command: termlen
syntax:  termlen [n]
         Length of error bar terminals as multiple of the default length.
         If termlen equals 0.0 no terminals will be drawn.
         If n is omitted, the current value is displayed.
#end


#start
command: text
syntax:  text string
         'string' is a text string to be plotted at the current pen position.
         The text is plotted with angle and justification as specified in
         'angle' and 'justificat'. Also the text attributes apply.
         A string entered on the COMMAND LINE can only include semicolons(;) and
         equal characters(=) if the string (or these characters) are escaped
         with a back-quote(`) character.
         If you want to include leading spaces in your string, substitute a
         '@' character for each space that you want to include.
         The text can also include special characters/symbols.
         These (Hershey) symbols are represented by a number between parentheses,
         prefixed by a backslash.
         Text can also contain an expression. Expressions are enclosed
         between brackets '{}'. Between these brackets there can be either the
         expression or a format string followed by a comma followed by an 
         expression. This expression is either a mathematical expression
         or a '#' character followed by a number. This number indicates the 
         number of the axis outside the current subset for which a physical
         coordinate must be returned. The first non-subset axis is #1, the
         second is #2 etc.

         These notes apply for all text commands like x/ylabel etc.
         For an overview of formats use: help formats

example: text NGC841             ! nothing special
         text H\\d2\\uO            ! 2 in subscript
         text \\(0274)            ! Draw a copyright symbol
         text `x=3;`             ! Text with '=' and semicolon must be escaped with back quotes
         text Values at theta {fffff.fff,pi/2}
         text Velocity is {ffffff.ff,#1} km/s
         See GPLOT manual for special characters and symbols

note:    If text is read from a command file, then it is not necessary to use
         back quotes. In fact, back quotes will be part of the string then.
#end


#start
command: ticksize
syntax:  ticksize [x]
         x is a number in mm. If x is omitted, the current value is listed.
#end


#start
command: tomm
syntax:  tomm x y
         x and y are world coordinates that are transformed to
         to mm. The values are written in the log file
#end


#start
command: toplabel
syntax:  toplabel string(s)

example: toplabel Vel (Km/s)
         The labels are plotted according to fixed angles and justification.

note:    If the default positions calculated by the program
         are not suitable, use command 'text' instead.
#end


#start
command: toworld
syntax:  x y
         x and y are coordinates in mm that are transformed to
         to world coordinates The values are written in the log file
#end



#start
command: ulocation
syntax:  ulocation [x] [y]
         x and y are numbers in world coordinates that indicate the offset
         from the lower left corner of the current viewport (=0,0 mm).
         If both numbers are omitted, the current offsets are displayed in mm.

note:    For absolute offsets (in mm), use the 'location' command.
#end


#start
info:    units 

table:   ======== Units recognized by GIPSY ========
 
              DEGREE      ARCSEC      ARCMIN      RADIAN
              CIRCLE      DMSSEC      DMSMIN      DMSDEG
              HMSSEC      HMSMIN      HMSHOUR
              METER       ANGSTROM    NM          MICRON
              MM          CM          INCH        FOOT
              YARD        M           KM          MILE
              PC          KPC         MPC
              TICK        SECOND      MINUTE      HOUR
              DAY         YEAR
              HZ          KHZ         MHZ         GHZ
              M/S         MM/S        CM/S        KM/S
              K           MK
              JY          MJY
              TAU

#end


#start
command: va
         Also vb, ..., vz
syntax:  See at command 'xcolumn'

note:    In GPLOT you have 26 vector variables with names va, vb etc.
         These vectors behave in the same way as the special vectors 
         'xcolumn', 'ycolumn', 'excolumn' and 'eycolumn' but they have 
         no special meaning for plotting etc. they are just arrays 
         for data storage. Available memory determines the maximum
         length of the vectors. Expressions with these variables
         are case INsensitive. Expression lengths cannot exceed 1024 
         characters.

Example: va 0:pi:0.1
         vb sin(va)
         ycolumn va*vb
         clist ycolumn vA vB
#end


#start
command: view
syntax:  view

note:    The application VIEW is started. The input set is given by 'inset'.
         The box is copied from the current box.
         GPLOT will ask you to supply a CLIP= keyword (belongs to VIEW)
#end


#start
command: world
syntax:  world

note:    This command is used after the 'mmeter' command
         to switch back to the stored box and scales.
#end


#start
command: write
syntax:  write macroname [filename]

example: write house               ! write contents of 'house' to 'house.mac'
         write stars /dj2/users/me/local.txt
                                   ! write contents of stars to 
                                   ! /dj2/users/me/local.txt
         write main                ! write contents of excecute macro 
                                   ! to 'main.mac'
#end


#start
command: xcolumn
syntax:  Syntax is the same for xcolumn, ycolumn, excolumn & eycolumn
         xcolumn filename colnr
         xcolumn file(filename,column,row-range (Hermes syntax for input from files
         xcolumn expression-without-variables
         xcolumn expression-with-variables

example: xcolumn radius.dat 3       ! Read third column from radius.dat in xcolumn
         xcolumn file(gauss.dat,1,8:15)
         xcol 10**[0 1 5]           ! xcolumn values:    1 10 100000
         xcol sin(rad(xcolumn))     ! take the sine of each entry in xcolumn

note:    The variable names are the names of the columns. In an expression
         you have to specify the generic name like xcolumn, eycolumn etc.
         The contents of the columns can be listed with 'clist'.
         This command accepts (abbreviated) column names as arguments.
         The array contents will be listed in the same left to right order
         as that the arguments were entered.
#end


#start
command: xlabel
syntax:  See description at toplabel
#end


#start
command: xmargin
syntax:  xmargin [mm]
         Argument is given in mm
         If value is omitted, the current value is displayed

note:    For better layout, you often do not want the pixels, as plotted
         by for instance 'grayscale', intersect your axes. It is possible
         to enlarge the frame a bit in x and y direction with this command.
#end


#start
command: xrange
syntax:  xrange
         xrange lo hi
         xrange xcolumn
         xrange ycolumn
         xrange minmax
        'lo, hi' are in world coordinates
         Command without parameters displays current values.
         xrange (or yrange) and a column name will set the range to 
         the min and max. value in that column. The column names can be
         abbreviated to xcol/ycol.
         If the argument is minmax, then the current values indicating
         a minimum and maximum as stored in 'minmax' are copied (see .
         description at 'minmax' to read what can be set by 'minmax').
#end
 


#start
command: xscale
syntax:  xscale [n] [units]
         xscale without parameters will display the current value.
         Without units, the scale is in grids/mm
         With units, the units are physical units corresponding to
         the axis units (or other units if a conversion is possible).

note:    If a set is specified with 'inset' and your axes are in
         units corresponding with the header units, you can also
         specify the scale in physical units. For example if an axis
         unit is in degrees, you can give: 
         xscale n1 DEGREE  or 
         xscale n2 ARCMIN  or 
         xscale n3 ARCSEC  or 
         The command help units generates a list with GIPSY units.
#end


#start
command: xsize
syntax:  xsize [x]
         If x is omitted, the current value is displayed.
         This command sets the size in mm for the current range on the
         x axis. It can be used independent of 'xscale'.
#end


#start
command: ycolumn
syntax:  see description at xcolumn
#end


#start
command: ylabel
syntax:  see description at toplabel
#end


#start
command: ymargin
syntax:  see description at xmargin
#end


#start
command: yrange
syntax:  see description at xrange
#end


#start
command: yscale
syntax:  see description at xscale
#end


#start
command: ysize
syntax:  see description at xsize
#end




#<

#>            gplot.h
/* gplot.h

                            COPYRIGHT (c) 1992
                      Kapteyn Astronomical Institute
                University of Groningen, The Netherlands
                           All Rights Reserved.

*/


#include    "stdio.h"        /* Defines ANSI C input and output utilities */
#include    "stdlib.h"       /* Defines the ANSI C functions for number */
                             /* conversion, storage allocation, and similar tasks.*/
#include    "string.h"       /* Declares the ANSI C string functions*/
                             /* like:strcpy, strcat etc.*/
#include    "math.h"         /* Declares the mathematical functions and macros.*/
#include    "float.h"        /* Definition of FLT_MAX etc.*/
#include    "ctype.h"        /* Declares ANSI C functions for testing characters */
                             /* like: isalpha, isdigit etc. also tolower, toupper.*/
                             
                            
#include    "gipsyc.h"       /* Defines the ANSI-F77 types for Fortran to C intface */
                             /* including def. of char2str,str2char,tofchar,zadd */
                             /* and macros tobool and toflog */
                                                          
/* Common includes */

#include    "init.h"         /* Declare task running to HERMES and initialize.*/
#include    "finis.h"        /* Informs HERMES that servant quits and cleans up the mess.*/
#include    "anyout.h"       /* General character output routine for GIPSY programs.*/
#include    "setfblank.h"    /* Subroutine to set a data value to the universal BLANK.*/
#include    "setdblank.h"
#include    "dblank.h"
#include    "error.h"        /* User error handling routine. */
#include    "myname.h"       /* Obtain the name under which a GIPSY task is being run.*/
#include    "nelc.h"         /* Characters in F-string discarding trailing blanks.*/
#include    "editfile.h"
#include    "fiepar.h"
#include    "fiedo.h"
#include    "fieini.h"
#include    "fieclr.h"
#include    "axtype.h"
#include    "axcoord.h"
#include    "factor.h"
#include    "minmax1.h"
#include    "wkey.h"
#include    "type.h"
#include    "deputy.h"
#include    "getusernam.h"   /* Returns the user name of the current user.*/
#include    "getdate.h"      /* Returns the current time and date as a text string.*/
#include    "cotrans.h"
#include    "grtoph.h"
#include    "phtogr.h"
#include    "wmatch.h"       /* Matches a test string with the mask string with wildcards.*/
#include    "drawaxis.h"
#include    "printusing.h"


/* User input routines */

#include    "userint.h"      /* User input interface routines.*/
#include    "userlog.h"
#include    "userreal.h"
#include    "userdble.h"
#include    "usertext.h"
#include    "userchar.h"
#include    "userfio.h"
#include    "reject.h"       /* Reject user input.*/
#include    "cancel.h"       /* Remove user input from table maintained by HERMES.*/


/* Input of sets */

#include    "gdsinp.h"       /* Input of set, subsets, return # subsets.*/
#include    "gdspos.h"       /* Define a position in a subset.*/
#include    "gdsbox.h"       /* Define a box inside/around a subset.*/
#include    "gdsc_range.h"   /* Return lower left and upper right corner of a subset.*/
#include    "gdsc_ndims.h"   /* Return the dimensionality of a coordinate word.*/
#include    "gdsc_grid.h"    /* Extract grid value.*/
#include    "gdsc_fill.h"    /* return coordinate word filled with a grid */
                             /* value for each axis.*/
#include    "gdsc_name.h"
#include    "gdsc_word.h"
#include    "gdsd_rchar.h"
#include    "gdsd_rdble.h"
#include    "gdsd_rreal.h"
#include    "gdsi_read.h"    /* Reads data from (part of) a set.*/


/* GDS Tables */

#include    "gdsa_crecol.h"  /* Creates a column in a GDS descriptor file.*/
#include    "gdsa_delcol.h"  /* Deletes a column in a GDS table.*/
#include    "gdsa_colinq.h"  /* Give information about columns in a GDS table.*/
#include    "gdsa_wcreal.h"  /* Write real items to a column in a GDS table.*/
#include    "gdsa_wcdble.h"  /* Double.*/
#include    "gdsa_wcint.h"   /* Integer. */
#include    "gdsa_rcint.h"
#include    "gdsa_rcreal.h"


/* GIDS related */

#include    "gdi_iinfo.h"
#include    "gdi_iinfo2.h"
#include    "gdi_cinfo.h"
#include    "gdi_open.h"
#include    "gdi_open2.h"
#include    "gdi_close.h"
#include    "gdi_frame.h"
#include    "gdi_getlut.h"
#include    "gdi_error.h"


/* Decoding */

#include    "dcdint.h"
#include    "dcdreal.h"
#include    "dcdlog.h"
#include    "dcddble.h"
#include    "dcdpos.h"


/* PGplot includes */

#include     "pgplot.h"
#include     "pgpat.h"
#include     "pgellipse.h"
#include     "beam.h"


/* Common includes */

#include    "anyout.h"       /* General character output routine for GIPSY programs.*/
#include    "userfio.h"
#include    "error.h"        /* User error handling routine. */
#include    "cancel.h"       /* Cancel keyword */
#include    "editfile.h"
#include    "dydx.h"         /* Determine derivative of a mathematical expression */


/* Include file for function 'process'. This function processes */
/* user input into macro commands and arguments.                */

extern int process( char *, int *, int *, int *, int );


typedef struct {
   char *name;                 /* name of command */
   int  save;                  /* save command in macro ? */
   char *comment;              /* short description */
} cstruct;                     /* command structure */


#define fmake(fchr,size) { \
                           static char buff[size+1]; \
                           int i; \
                           for (i = 0; i < size; buff[i++] = ' '); \
                           buff[i] = 0; \
                           fchr.a = buff; \
                           fchr.l = size; \
                         }


#define MAXAXES        10              /* Max. axes in a set */
#define LONGSTR        128
#define STRLEN         80              /* Max length of strings */
#define HUGEBUF        32*1024
#define SPACE          ' '
#define COMMA          ','
#define MAXTASKNAME    20              /* Max. length of task name */
#define NONE           0               /* Default levels in userxxx routines */
#define REQUEST        1
#define HIDDEN         2
#define EXACT          4
#define YES            1               /* C versions of .TRUE. and .FALSE. */
#define NO             0
#define VARRECLEN      132             /* Variable reclen. for table comments */
#define ITEMLEN        8
#define CASEINSENSITIVE 0
#define CASESENSITIVE  1
#define MAXFILLSTYLES  4

#define MYMAX(a,b)       ( (a) > (b) ? (a) : (b) )
#define MYMIN(a,b)       ( (a) > (b) ? (b) : (a) )
#define RAD(a)           ( (a) * 0.017453292519943295769237 )
#define DEG(a)           ( (a) * 57.295779513082320876798155 )
#define ABS(a)           ( (a) < 0 ? (-(a)) : (a) )
#define FSWAP(a,b)       { float temp=(a);(a)=(b);(b)=temp; } /* Swap 2 numbers */


#define fcopy( f, c )                   \
        {int k;for(k=0;c[k]&&k<f.l;f.a[k]=c[k],k++);while(k<f.l)f.a[k++]=' ';}

extern char    taskname[MAXTASKNAME]; /* name of this application */

extern int  execute( char *, char *, char **, int  );
extern int  execom( char *, char * );
extern int  exemacro( int, char * );

extern int  dispcoord( double, double, double, double, double *, double *, double * );
extern void anylog( int, char *, char * );
extern void anyoutC( int, char * );
extern int  deputyC( char *, char * );
extern void prtout( FILE *, int, char * );
extern void dcderror( int );
extern void poserr( char *, fint );
extern void axinfo( int, int, int, int, char *, char *, char *, char * );
extern void plvsiz( float, float, float, float );
extern int  pltext( char *, double, double, double, double, fchar, fint, fint *, char *);
extern void plrect( double, double, double, double );
extern char *StrDup( const char * );
extern char *cleanstr( char * ); 
int wmatchC( char *, char * );
int getcolor( char * );
void devinfo( double, double, double, double );
extern int luttotable( fchar, fint, fint, float *, float *, float *, fint, fint, fint, float, float, fint );
extern int lutfromtable( fchar, fint, fint *, float *, float *, float *,
                         fint *, fint *, fint *, float *, float *, fint * );
extern int printusing( char *, float, char * );
extern void p_ellipse(fchar, fint, double *,double, double, double, double, double );
extern int equalstrings( char *, char *, int );
#<

#>            gplot.c
 /* gplot.c
                            COPYRIGHT (c) 1992
                      Kapteyn Astronomical Institute
                University of Groningen, The Netherlands
                           All Rights Reserved.


*/

#include    "gplot.h"
#include    "cmain.h"        /* Defines the main body of a C program with */
                             /* MAIN_PROGRAM_ENTRY and IDENTIFICATION */


/* DEFINITIONS: */

/* Initialize Fortran compatible string with macro 'fmake' */


/* Malloc version of 'fmake'  */
#define finit( fc , len ) { fc.a = malloc( ( len + 1 ) * sizeof( char ) ) ;  \
                            fc.a[ len ] = '\0' ; \
                            fc.l = len ; }


#define RELEASE         "2.3"            /* Version number */
#define MAXSUBSETS       1024            /* Max. allowed subsets */
#define MAXBUF           16*4096         /* Buffer size for I/O */
#define MAXLEVELS        256             /* Maximum number of gray scale levels */
#define HUGESTR          512
#define CURDEVLEN        200             /* Length of device name (with filename appended) */
#define TITLEOFF_X       0.4             /* An offset scaled with char. height */
#define TITLEOFF_Y       1.0
#define NCHAR            256             /* Max. width of contents ascii data file */
#define KEYLEN           20              /* Max length of keywords */
#define FITSLEN          20
#define VARLEN           10              /* Length of variables in 'fie' routines */
#define ABC              26
#define SPECIALCOL       4
#define MAXVAR           (ABC+SPECIALCOL)
#define XARRAY           ABC
#define YARRAY           ABC+1
#define EXARRAY          ABC+2
#define EYARRAY          ABC+3
#define MAXEXPRLEN       1024
#define MAXVARLEN        10

#define BETWEEN(a,b,c)   ( (a) < (b) ? (b) : ((a) > (c) ? (c) : (a) ) )
/* Pre Apr 2009 def.: #define NINT(a)          ( (a) < 0 ? (int)((a)-.5) : (int)((a)+.5) ) */
#define NINT(a) ( (int) floor( (double) (a) + 0.5 ) )
#define PI               3.141592653589793


/* Keyword defines: */

#define   KEY_BOX        tofchar("BOX=")
#define   KEY_PROFILE    tofchar("PROFILE=")
#define   KEY_PROFINT    tofchar("PROFINT=")
#define   KEY_POSITION   tofchar("POSITION=")
#define   KEY_OVERWRITE  tofchar("OVERWRITE=")
#define   KEY_PRESS      tofchar("PRESS=")
#define   KEY_ERASE      tofchar("ERASE=")
#define   KEY_MOSLXLY    tofchar("MOSLXLY=")

/* Miscellaneous */

static fchar    Key, Mes;              /* Global strings for use in input routines */
static fint     setlevel = 0;          /* To get header items at set level. */
static float    blank;                 /* Global value for BLANK. */
static double   dblank;
static char     message[NCHAR];        /* All purpose character buffer. */


/* Related to command interpreter. */
/* These variables must be global. */

int  macno = 0;                /* initial macro number */
int  ins = 0;                  /* insert mode active */
int  lno = 1;                  /* current line number */

typedef    float  *floatptr;


/* Function prototypes */


static int setbox( double *worldbox );


cstruct vocab[] =          /* command structure */
{
   { "angle"     , 1 , "Set plotting angle" },
   { "arrow"     , 1 , "Draw arrow" },
   { "arstyle"   , 1 , "Set the style to be used for arrowheads" },
   { "autoscale" , 1 , "Set scale and origin so that frame fits on device" },
   { "axdelta"   , 1 , "Set major tick separation in physical units" },
   { "axformat"  , 1 , "Set format for labels" },
   { "axis"      , 1 , "Draw axis, and optionally label it with (converted) coords." },
   { "axlogs"    , 1 , "Define the major tick marks on a logarithmic axis" },
   { "axminors"  , 1 , "Set number of minor tick intervals" },
   { "axpos"     , 1 , "Set physical start position on axis" },
   { "axtitle"   , 1 , "Set title of axis to be plotted" },
   { "beam"      , 1 , "Plot a shaded ellipse at current pen position" },
   { "box"       , 1 , "Use Gipsy input syntax to convert box to world coordinates" },
   { "cgstep"    , 1 , "Create coordinate grid by extending label ticks at cgstep pixels" },
   { "charheight", 1 , "Set character height" },
   { "clear"     , 1 , "Clear device" },
   { "clist"     , 1 , "List contents of arguments (arrays)" },
   { "closeplot" , 1 , "Close plot file or send output to printer" },
   { "colbar"    , 1 , "Plot colour bar with numbers" },
   { "color"     , 1 , "Set color index for subsequent plotting" },
   { "colour"    , 1 , "Set colour index for subsequent plotting" },
   { "colplot"   , 1 , "Make colour plot of current set with current settings of GIDS" },
   { "colrep"    , 1 , "Set color representation" },
   { "connect"   , 1 , "Connect points" },
   { "contlab"   , 1 , "Label contours" },
   { "contours"  , 1 , "Draw contours" },
   { "contticks" , 1 , "Draw contours with ticks" },
   { "cursor"    , 0 , "Put cursor on screen" },
   { "curtxt"    , 1 , "Format string for interactive position output" },
   { "delete"    , 0 , "Delete (a) command(s) or a macro" },
   { "device"    , 0 , "Define plot device" },
   { "devinfo"   , 0 , "Print PGPLOT general information in log file" },
   { "draw"      , 1 , "Draw a line" },
   { "excolumn"  , 1 , "Denote error data for x" },
   { "eycolumn"  , 1 , "Denote error data for y" },
   { "edit"      , 0 , "Call editor in current macro" },
   { "ellipse"   , 1 , "Plot ellipse at current pen position" },
   { "end"       , 0 , "End current activity, without leaving the program" },
   { "environ"   , 1 , "Plotting environment, set window and viewport, and draw frame" },
   { "erase"     , 0 , "Clear screen/plot file, but do not store the command" },
   { "errorbar"  , 1 , "Plot error bars" },
   { "expand"    , 1 , "Set expand factor in x- and y direction" },
   { "fastyle"   , 1 , "Set fill area style" },
   { "file"      , 1 , "Write contents of a column or results of 'help' to file" },
   { "font"      , 1 , "Set character font" },
   { "frame"     , 1 , "Draw labeled frame around viewport (physical coordinates)" },
   { "getlut"    , 1 , "Fix current GIDS colour settings for colour plots of sets" },
   { "gids"      , 1 , "Get scales and offsets of image displayed in GIDS" },
   { "grayscale" , 1 , "Make grayscale plot" },
   { "hardcopy"  , 0 , "Close the plot file and send it to new destination" },
   { "help"      , 0 , "Get help" },
   { "histogram" , 1 , "Plot a histogram of UNBINNED data" },
   { "histobin"  , 1 , "Plot a histogram of BINNED data" },
   { "id"        , 1 , "Put plot id on plot" },
   { "input"     , 1 , "Read macro from file" },   
   { "inset"     , 1 , "Open Gipsy set" },
   { "interpol"  , 1 , "Set/unset PGPLOT/PostScript image interpolation" },
   { "justificat", 1 , "Horizontal justification for text (0..1)" },
   { "keyword"   , 1 , "Specify a value using a keyword" },
   { "levels"    , 1 , "Define contour levels" },
   { "list"      , 0 , "List commands in a macro" },
   { "location"  , 1 , "Define offset in plot in mm" },
   { "lstyle"    , 1 , "Define line type" },
   { "lwidth"    , 1 , "Set line thickness" },
   { "macdir"    , 1 , "Macro path" },
   { "macro"     , 0 , "Macro editing" },
   { "manual"    , 0 , "Load GPLOT document in editor "},
   { "marker"    , 1 , "Put marker on current pen position" },
   { "minmax"    , 1 , "Get min and max of image or column" },
   { "mmeter"    , 1 , "Plot in millimeter, use entire surface" },
   { "mosaic"    , 1 , "Call the intern mosaic macro" },
   { "mosframe"  , 1 , "Plot a frame in a mosaic" },
   { "moslxly"   , 1 , "Divide page into x times y sub frames" },
   { "mosnext"   , 1 , "Go to the next mosaic panel" },
   { "mosprev"   , 1 , "Go to the previous mosaic panel" },
   { "mosxy"     , 1 , "Set x, y position in mosaic panel" },
   { "move"      , 1 , "Move to position x, y"},
   { "overbox"   , 1 , "Calculate default box for overlay set" },
   { "overlay"   , 1 , "Switch from old scale to overlay scale vv."},
   { "page"      , 1 , "Advance to a new (sub) page" },
   { "pattern"   , 1 , "Set line style according to this pattern"},
   { "pause"     , 1 , "Pause executing commands in main" },
   { "pgframe"   , 1 , "Draw labeled frame around viewport" },
   { "pgviewport", 1 , "Set viewport (normalized device coordinates)" },
   { "playback"  , 0 , "Playback commands in main" },
   { "plotinfo"  , 1 , "Generate a list of global plot variables" },
   { "points"    , 1 , "Plot points" },
   { "polmode"   , 1 , "Set polarisation angles to Degrees or Radians" },
   { "polplot"   , 1 , "Plot polarisation vectors from 'inset' & 'polset'" },
   { "polset"    , 1 , "Read polarisation angles from this set" },
   { "poly"      , 1 , "Fill a polygonal area with shading" },
   { "pplot"     , 1 , "Plot profile from set" },
   { "printusing", 1 , "Set a format for output of numbers" },
   { "profaxis"  , 1 , "Draw (and label) profile axis" },
   { "profdata"  , 1 , "Assemble the profile data into x/ycolumn" },
   { "profile"   , 1 , "Get profile data from current subset" },
   { "profint"   , 1 , "Integrate profile along subset axes" },
   { "profinfo"  , 1 , "Write profile info at current pen position" },
   { "quit"      , 0 , "Quit and leave program" },
   { "read"      , 0 , "Read a macro" },
   { "rectangle" , 1 , "Draw rectangle from x1,y1 to x2,y2" },
   { "reset"     , 0 , "Reset all global variables to their start value" },
   { "setinfo"   , 1 , "Print information about specified set in log file" },
   { "subset"    , 1 , "Change current subset" },
   { "status"    , 0 , "Show macro status" },
   { "storelut"  , 1 , "Store current lut values and other colour info" },
   { "symbol"    , 1 , "Select marker symbol" },
   { "stop"      , 0 , "Quit and leave program" },
   { "task"      , 1 , "Spawn an external GIPSY task" },
   { "termlen"   , 1 , "Length of terminals at end of errorbar(s)" },
   { "text"      , 1 , "Write text at arbitrary position and angle" },
   { "ticksize"  , 1 , "Set size of ticks on axis" },
   { "tomm"      , 1 , "Convert x, y in world coordinates to mm" },
   { "toplabel"  , 1 , "Put text at top of plot" },
   { "toworld"   , 1 , "Convert x, y in mm to world coordinates" },
   { "ulocation" , 1 , "Define offset in plot in world coordinates" },
   { "va"        , 1 , "Data column" },
   { "vb"        , 1 , "Data column" },
   { "vc"        , 1 , "Data column" },
   { "vd"        , 1 , "Data column" },
   { "ve"        , 1 , "Data column" },
   { "vf"        , 1 , "Data column" },
   { "vg"        , 1 , "Data column" },
   { "vh"        , 1 , "Data column" },
   { "vi"        , 1 , "Data column" },
   { "vj"        , 1 , "Data column" },
   { "vk"        , 1 , "Data column" },
   { "vl"        , 1 , "Data column" },
   { "vm"        , 1 , "Data column" },
   { "vn"        , 1 , "Data column" },
   { "vo"        , 1 , "Data column" },
   { "vp"        , 1 , "Data column" },
   { "vq"        , 1 , "Data column" },
   { "vr"        , 1 , "Data column" },
   { "vs"        , 1 , "Data column" },
   { "vt"        , 1 , "Data column" },
   { "vu"        , 1 , "Data column" },
   { "vv"        , 1 , "Data column" },
   { "vw"        , 1 , "Data column" },
   { "vx"        , 1 , "Data column" },
   { "vy"        , 1 , "Data column" },
   { "vz"        , 1 , "Data column" },
   { "view"      , 1 , "Start application view with current set and box" },
   { "write"     , 0 , "Save a macro to file" },
   { "world"     , 1 , "Plot in world coordinates, set a transformation" },
   { "xcolumn"   , 1 , "Denote x data" },
   { "xlabel"    , 1 , "Label along x axis" },
   { "xmargin"   , 1 , "Offset in location of axes in x direction" },
   { "xrange"    , 1 , "Limits in world coord. of horizontal axis" },
   { "xscale"    , 1 , "Scale in X to define w.coord. system (grids/mm or units/mm)" },
   { "xsize"     , 1 , "Set length of plot in mm in x direction" },
   { "ycolumn"   , 1 , "Denote y data" },
   { "ylabel"    , 1 , "Label along y axis" },
   { "ymargin"   , 1 , "Offset in location of axes in y direction" },
   { "yrange"    , 1 , "Limits in world coord. of vertical axis" },
   { "yscale"    , 1 , "Scale in Y to define w.coord. system (grids/mm or units/mm)" },
   { "ysize"     , 1 , "Set length of plot in mm in y direction" },
};

#define MAXVOCAB  (sizeof(vocab)/sizeof(cstruct))     /* # of commands */


/* Global plot variables */


static char    curdevnam[CURDEVLEN] = {'?'};  /* default generate list of devices */
static char    xscaletxt[STRLEN];
static char    yscaletxt[STRLEN];
static char    *formatstr[26];                /* Key definitions for macros */
static fchar   Devtype;                       /* Type of current device */
static fint    nsubx = 1, nsuby = 1;          /* sub divisions of plot surface */
static double  devx1mm, devx2mm;              /* limits of device in mm */
static double  devy1mm, devy2mm;
static double  Xorgmm, Yorgmm;                /* transformation world to mm vv., offset */
static double  Xscale, Yscale;                /* ... and scale */
static double  worldbox[4];                   /* arbitrary box in world coordinates */
static double  prevworldbox[4];               /* world coordinates before overlay */
static double  gridmargin[2] = {0.0, 0.0};    /* enlarge box to enclose border grids */
static double  currentXY[2] = {0.0, 0.0};     /* move position of pen */
static double  angle = 0.0;                   /* angle for text etc. */
static double  justification = 0.0;
static double  charheight = 4.0;              /* Height in mm */
static double  charmm = 0.0;
static double  labelsize = 1.0;
static double  ticksize;
static float   termlen = 1.0;
static fint    font = 1;
static fint    symbol = 2;
static fint    linestyle = 1;
static fint    fillareastyle = 2;             /* default is hollow */
static fint    linewidth = 1;
static int     editcom;                       /* Reject subtituted command */
static fint    mosrows, moscols;
static fint    mosposX, mosposY;


/* Globals related to data and levels */

static float   image[MAXBUF];          /* Buffer for image data */
static float   levels[MAXLEVELS];      /* Levels for gray scales, contours etc. */
static int     numlev;                 /* Number of levels */
static float   minmax[2] = {0.0, 0.0};


/* Global related to a set */


static fchar    Setin;              /* Name of input set */
static fint     subin[MAXSUBSETS];  /* Subset coordinate words */
static fint     nsubs;              /* Number of input subsets */
static fint     axnum[MAXAXES];     /* Array of size MAXAXES containing the */
                                    /* axes numbers.  The first elements (upto */
                                    /* the dimension of the subset) contain the */
                                    /* axes numbers of the subset, the other */
                                    /* ones contain the axes numbers outside the */
                                    /* the subset ordered ccording to the */
                                    /* specification by the user. */
static fint     axcount[MAXAXES];   /* Array of size MAXAXES containing the */
                                    /* number of grids along an axes as */
                                    /* specified by the user. The first elements */
                                    /* (upto the dimension of the subset) contain */
                                    /* the length of the subset axes, the other */
                                    /* ones contain the the number of grids along */
                                    /* an axes outside the subset. */
static fint     maxsubs = MAXSUBSETS;
static fint     maxaxes = MAXAXES;  /* Max num. of axes the program can deal with.*/
static fint     class = 1;          /* Class 1 is for applications which repeat */
                                    /* the operation for each subset, Class 2 */
                                    /* is for applications for which the operation */
                                    /* requires an interaction between the different */
                                    /* subsets. */
static fint     subdim;             /* Dimensionality of the subsets for class 1 applications */
static fint     setdim;             /* Dimension of set. */
static fint     flo[MAXAXES];       /* Low  edge of frame in grids */
static fint     fhi[MAXAXES];       /* High edge of frame in grids */
static fint     profblo[MAXAXES];
static fint     profbhi[MAXAXES];
static fchar    Bunit;
static fchar    Cunit[MAXAXES];
static fchar    Dunit[MAXAXES];     /* Units of physical coordinates */
static fchar    Ctype[MAXAXES];     /* Complete axis name fi. RA-NCP */
static fchar    Dtype[MAXAXES];     /* Complete axis name fi. RA-NCP */
static fint     axistype[MAXAXES];
static double   cdelt[MAXAXES];
static double   ddelt[MAXAXES];
static double   crval[MAXAXES];
static double   drval[MAXAXES];
static double   crota;
static int      subsetindex = 0;
static int      spatialmap = NO;    /* Global variable that indicates whether */
                                    /* the current (sub)set is spatial or not. */
static char     setstring[256];     /* Complete input string for sets */
static fint     profsubset = 0;
static fint     profintsize[MAXAXES];


/* Globals related to polarisation */

static fchar    Setang;             /* Name of set with polarisation angles */
static fint     subang[MAXSUBSETS]; /* Subsets for this set */
static fint     polgrid[2];         /* Sample grid for polarisation */
static float    poltrans;           /* Transformation between im.value & mm */
static char     polmode = 'R';      /* Angles radians or degree? */


/* Global vectors related to column data */

static float   *vect[ABC+SPECIALCOL];         /* 26 columns + 4 */
static int     vectsize[ABC+SPECIALCOL];      /* Sizes of these columns */
static char    vectname[ABC+SPECIALCOL][MAXVARLEN];  /* Names of the variables */


/* Globals related to plotting physical coordinates */

static double  axpos;
static double  axdelta;
static fint    axminors;
static char    axformat[HUGESTR];
static char    axposstr[HUGESTR];
static char    axdeltastr[HUGESTR];
static char    axtitle[LONGSTR];
static char    profiletxt[LONGSTR];
static double  titleXY[8];
static char    title_id;
static double  *axlogs = NULL;
static fint    axloglen = 0;
static double  cgstep = 1.0;


/* Store characteristics of previous set */

static fchar    prevSetin;          /* Name of previous input set */
static double   prevcdelt[2];
static fint     prevsubin;
static int      prevax1, prevax2;
static double   storeXscale, storeYscale;
static double   storeXscaleEXP, storeYscaleEXP;
static double   storeXorgmm;
static double   storeYorgmm;
static double   mosaic_Xorgmm, mosaic_Yorgmm;
static double   mosaic_Xlen, mosaic_Ylen;
static double   mosaic_Xtot, mosaic_Ytot;
static double   storeworldbox[4];


/* GIDS related */

static fint     GIDSdisplay_id;
static fint     lutlen = 0;
static float    lutr[256];
static float    lutg[256];
static float    lutb[256];
static float    GIDSbscale;
static float    GIDSbzero;
static fint     GIDSmincol;
static fint     GIDSmaxcol;
static fint     GIDSncolors;
static fint     GIDSblank;


/* Globals related to output formats of numbers */

static char     *printusingstr = NULL;

/* Global miscellaneous & flags! */


static fint     dfault;                /* Default option for input etc */
static bool     inset    = NO;         /* Is a Gipsy set open yet? */
static bool     polset   = NO;
static bool     prevset  = NO;         /* Was there a previous set (for overlays)? */
static bool     world    = NO;         /* Is transformation to world coords possible? */
static bool     devopen  = NO;         /* Is a device opened yet? */
static bool     cursor   = NO;         /* Has device interactive graphics? */
static bool     headerok = YES;        /* Header of current set is correct */
static bool     overlay  = NO;         /* Plotting in overlay mode */
static bool     interpol = NO;         /* PGPLOT/PostScript image interpolation */
static bool     getlut   = NO;         /* Is a lut already known? */
static bool     profint  = NO;         /* Do profile integration? */
static bool     boxset   = NO;         /* Is a box/range already set? */
static bool     mosaic   = NO;







static void plmove( double x,
                    double y )
/*-------------------------------------------------------------*/
/* Alternative for pgmove.                                     */
/*-------------------------------------------------------------*/
{
   float a, b;

   a = (float) x; b = (float) y;
   pgmove_c( &a, &b );
   currentXY[0] = x;
   currentXY[1] = y;
}



static void pldraw( double x,
                    double y )
/*-------------------------------------------------------------*/
/* Alternative for pgdraw.                                     */
/*-------------------------------------------------------------*/
{
   float a, b;

   a = (float) x; b = (float) y;
   pgdraw_c( &a, &b );
   currentXY[0] = x;
   currentXY[1] = y;
}





static void autoscale( void )
/*-------------------------------------------------------------*/
/* Calculate a default scale and origin. A default frame with  */
/* axis sizes in 'worldbox' must fill the current device.      */
/* 'percentage' determines the amount of white space for a     */
/* default offset and scale.                                   */
/*-------------------------------------------------------------*/
{
   double xlen, ylen;
   double percentage = 15.0 / 100;       /* Number smaller than 50/100 */

   xlen   = devx2mm - devx1mm;
   ylen   = devy2mm - devy1mm;
   Xorgmm = devx1mm + xlen * percentage;
   Yorgmm = devy1mm + ylen * percentage;
   Xscale = (worldbox[2] - worldbox[0]) /
                 ( xlen * (1.0 - 2.0 * percentage) );
   Yscale = (worldbox[3] - worldbox[1]) /
                 ( ylen * (1.0 - 2.0 * percentage) );
}




static void preset()
/*-------------------------------------------------------------*/
/* Some global variables need a preset.                        */
/*-------------------------------------------------------------*/
{
   fint   col;
   int    i;


   /* AXIS RELATED */

   ticksize  = -1.0;
   axminors  = -1;
   cgstep    =  1.0;
   axdelta   =  dblank;
   axpos     =  dblank;
   axposstr[0]   = '\0';
   axdeltastr[0] = '\0';
   axformat[0]   = '\0';
   axtitle[0]    = '\0';
   profiletxt[0] = '\0';

   for (i = 0; i < 8; i++)
      titleXY[i] = dblank;

   /* MISCELLANEOUS */

   storeXscale = storeYscale = dblank;
   storeXorgmm = storeYorgmm = dblank;

   worldbox[0] = -128.0;             /* A box this size fills current device */
   worldbox[1] = -128.0;
   worldbox[2] =  128.0;
   worldbox[3] =  128.0;
   /*-------------------------------------------------------------*/
   /* Calculate a default scale and origin. A default frame with  */
   /* axis sizes in 'worldbox' must fill the current device.      */
   /*-------------------------------------------------------------*/
   autoscale();

   /* The height in mm of one character for this device */
   charmm = MYMIN(devx2mm - devx1mm, devy2mm - devy1mm) / 40.0;

   storeXscaleEXP = Xscale;
   storeYscaleEXP = Yscale;
   xscaletxt[0] = '\0';
   yscaletxt[0] = '\0';
   storeworldbox[0] = worldbox[0];   /* Storage for overlay option */
   storeworldbox[1] = worldbox[1];
   storeworldbox[2] = worldbox[2];
   storeworldbox[3] = worldbox[3];
   gridmargin[0] = gridmargin[1] = 0.0;
   angle = 0.0;
   currentXY[0] = currentXY[1] = 0.0;
   (void) setbox( worldbox );
   world = YES;

   numlev = 0;                       /* Number of levels for contours etc.*/
   subsetindex = 0;                  /* Current subset */
   editcom = NO;
   poltrans = blank;                 /* Transform image value to a length in grids */
   moscols = 1;
   mosrows = 1;
   mosposX = 1;
   mosposY = 1;

   /* ATTRIBUTES */

   justification = 0.0;
   termlen       = 1.0;
   labelsize     = charmm;
   font          = 1;
   pgscf_c( &font );
   symbol        = 2;
   linestyle     = 1;                /* full line */
   fillareastyle = 2;                /* default is hollow, outline only */
   linewidth     = 1;
   col           = 1;
   charheight    = 4.0;              /* User char height in mm */
   {
      float ch = charheight / charmm;     /* Must be scaled with default height */
      pgsch_c( &ch );
   }
   pgsfs_c( &fillareastyle );
   pgslw_c( &linewidth );
   pgqci_c( &col );

   /* Reset the  DATA vectors*/

   for (i = 0; i < ABC+SPECIALCOL; i++)
   {
      if (vect[i] != NULL)
         free( vect[i] );
      vect[i] = NULL;
      vectsize[i] = 0;
   }

   minmax[0] = minmax[1] = 0.0;

   /* FLAGS */

   mosaic   = NO;
   inset    = NO;                    /* Is a Gipsy set open yet? */
   spatialmap = NO;
   prevset  = NO;                    /* Was there a previous set (for overlays)? */
   headerok = YES;                   /* Header of current set is correct */
   overlay  = NO;                    /* Current mode is overlay mode */
   interpol = NO;                    /* Reset PGPLOT/PS interpolation */
   profint  = NO;
   getlut   = NO;                    /* Is a lut already known? */
   boxset   = NO;

   /* GIDS */

   GIDSdisplay_id = -1;


   /* Format string for 'printusing' routine */
   if (printusingstr != NULL)
   {
      free( printusingstr );
      printusingstr = NULL;
   }

}



static void macroquit( char *key,
                       char *mes,
                       fint dfault )
/*------------------------------------------------------------*/
/* Quit program flow by substituting COMMAND=quit in the      */
/* keyword parameter list.                                    */
/*------------------------------------------------------------*/
{
   fint    r;
   fint    nitems = 1;
   bool    toGplot;

   r = userlog_c( &toGplot, &dfault, &nitems, tofchar(key), tofchar(mes) );
   if (!r)
      toGplot = NO;
   toGplot = tobool( toGplot );
   if (!toGplot)
      wkey_c( tofchar("COMMAND=quit") );
}



static int pplotmacro( void )
/*------------------------------------------------------------*/
/* Internal macro for generating profiles.                    */
/*------------------------------------------------------------*/
{
   int     quit;
   int     first = YES;
   float   ypos;
   float   oldch;
   float   xs= 120, ys = 80;
   char    message[NCHAR];

   if (!inset)    /* Global flag */
      (void) execom( "keyword", "inset Give a (sub)set to extract a profile:" );
   if (!inset)
      return( 0 );
   (void) execom( "font", "2" );
   (void) sprintf( message, "charheight Give character height in mm:  [%.1f]",
                   charheight );
   (void) execom( "keyword", message );
   (void) execom( "symbol", "21" );
   do
   {
      quit = !execom( "profile", "" );
      if (!quit)
      {
         (void) execom( "profint", "" );
         (void) execom( "profdata", "" );
         /*--------------------------------------------------*/
         /* The command given with 'execom' cannot be        */
         /* abbreviated. The loop is aborted if no positions */
         /* are given at the profile prompt.                 */
         /*--------------------------------------------------*/
         (void) execom( "xrange", "xcolumn" );
         (void) execom( "yrange", "ycolumn" );
         (void) sprintf( message, "xrange Give grid range in x:    [%g %g]",
                         worldbox[0], worldbox[2] );
         (void) execom( "keyword", message );
         (void) sprintf( message, "yrange Give grid range in y:    [%g %g]",
                         worldbox[1], worldbox[3] );
         (void) execom( "keyword", message );
         if (!first)
         {
            fint nitems = 1;
            fint dfault = REQUEST;
            fint r;
            bool era = toflog( YES );
            r = userlog_c( &era, &nitems, &dfault, KEY_ERASE,
                           tofchar("Erase screen for next plot?   [Y]/N") );
            cancel_c( KEY_ERASE );
            era = tobool( era );
            if (era)
               (void) execom( "erase", "" );
         }
         (void) sprintf( message, "%f", xs );
         (void) execom( "xsize", message );
         (void) sprintf( message, "%f", ys );
         (void) execom( "ysize", message );
         (void) sprintf( message, "xsize Size of plot in x (mm):   [%.1f]",
                         xs );
         (void) execom( "keyword", message );
         xs = (worldbox[2] - worldbox[0]) / Xscale;
         (void) sprintf( message, "ysize Size of plot in y (mm):   [%.1f]",
                         ys );
         (void) execom( "keyword", message );
         ys = (worldbox[3] - worldbox[1]) / Yscale;
         (void) execom( "location", "30 35" );
         (void) execom( "keyword", "location Lower left corner of plot (mm,mm):     [30,35]");
         (void) execom( "xmargin", "2" );
         (void) execom( "ymargin", "2" );
         (void) execom( "colour", "yellow" );
         (void) execom( "profaxis", "bp" );
         (void) execom( "axtitle", "" );
         (void) execom( "axis", "lw" );
         (void) sprintf( message, "%.*s", nelc_c(Bunit), Bunit.a );
         (void) execom( "axtitle", message );
         (void) execom( "axis", "r" );
         (void) execom( "colour", "cyan" );
         (void) execom( "profaxis", "tw" );
         (void) execom( "axtitle", "grids" );
          /* Use the y position of the title for the top axis to  */
         /* calculate the position of some info lines.           */
          ypos = titleXY[5] + 10 + 1.2 * charheight;
         (void) execom( "lstyle", "4" );
         (void) sprintf( message, "%f 0", worldbox[0] );
         (void) execom( "move", message );
         (void) sprintf( message, "%f 0", worldbox[2] );
         (void) execom( "draw", message );
         (void) execom( "lstyle", "1" );
         (void) execom( "colour", "red" );
         (void) execom( "points", "" );
         (void) execom( "colour", "green" );
         (void) execom( "connect", "\0" );
         (void) execom( "mmeter", "" );
         (void) execom( "colour", "default" );
         (void) sprintf( message, "%f %f", Xorgmm, ypos );
         (void) execom( "move", message );
         (void) execom( "profinfo", "\0" );
         (void) sprintf( message, "%f %f", Xorgmm, ypos + 1.2 * charheight );
         (void) execom( "move", message );
         (void) sprintf( message, "Set: %s", setstring);
         (void) execom( "text", message );
         (void) execom( "world", "\0" );
         {
            fint nitems = 1;
            fint dfault = REQUEST;
            fint r;
            fchar Filename;
            fmake( Filename, 256 );
            r = userchar_c( Filename, &nitems, &dfault, tofchar("FILENAME="),
                            tofchar("Write profile data to file:     [No file]") );
            (void) sprintf( message,
                            "%.*s excolumn eycolumn ycolumn",
                            nelc_c(Filename), Filename.a );
            if (r)
               (void) execom( "file", message );
         }
         first = NO;
      }
   }
   while (!quit);
   if (!first)
   {
      (void) execom( "mmeter", "" );
      oldch = charheight;
      (void) execom( "charheight", "3" );
      (void) sprintf( message, "%f %f", 30.0, 10.0 );
      (void) execom( "move", message );
      (void) execom( "id", "" );
      (void) sprintf( message, "%f", oldch );             /* Restore */
      (void) execom( "charheight", message );
      (void) execom( "world", "\0" );
   }
   macroquit( "GPLOT=",
              "Go to General Plot Command mode?        Y/[N]", REQUEST );
   return( 1 );
}



static int mosaicmacro( void )
/*------------------------------------------------------------*/
/* Internal macro for generating a mosaic.                    */
/*------------------------------------------------------------*/
{
   fint  nxy[2];
   fint  r;
   fint  nitems, dfault;
   int   count = 0;
   int   ret;
   int   i;
   char  message[NCHAR];


   if (!inset)
      (void) execom( "keyword", "inset Give set and subsets for a mosaic:" );
   if (!inset)
      return( 0 );
   (void) execom( "font", "2" );
   (void) sprintf( message, "charheight Give character height in mm:  [%.1f]",
                   charheight );
   (void) execom( "keyword", message );
   nxy[0] = (int) sqrt( nsubs );
   nxy[1] = nsubs / nxy[0];
   if (nxy[0]*nxy[1] < nsubs)
      nxy[1] += 1;
   (void) sprintf( message, "Give mosaic columns, rows:   [%d %d]",
                   nxy[0], nxy[1] );
   nitems = 2;
   dfault = REQUEST;
   r = userint_c( nxy, &nitems, &dfault,
                  KEY_MOSLXLY,
                  tofchar(message) );
   cancel_c( KEY_MOSLXLY );
   (void) sprintf( message, "%d %d", nxy[0], nxy[1]);
   (void) execom( "moslxly", message );
   (void) execom( "mosframe", message );

   for (i = 0; i < MYMIN(nsubs, moscols*mosrows); i++)
   /*--------------------------------------------------*/
   /* Loop over all panels or all subsets whichever is */
   /* the smallest number. For the first panel the user*/
   /* will be prompted with a series of keywords       */
   /* MOSCOMn=, where n starts with 0. The keywords    */
   /* expect a GPLOT command (not abbreviated). Each   */
   /* command is excecuted immediately. Pressing enter */
   /* aborts this keyword loop. The keywords are not   */
   /* cancelled, so for each panel all the command will*/
   /* be repeated.                                     */
   /*--------------------------------------------------*/
   {
      count = 0;
      dfault = REQUEST;
      do
      {
         char   *p1, *p2;
         fchar  Commandtxt;
         fmake( Commandtxt, HUGESTR );
         (void) sprintf( message, "MOSCOM%d=", count++ );
         r = usertext_c( Commandtxt, &dfault,
                         tofchar(message),
                         tofchar("Give command to repeat in each panel:   [start executing]"));
         if (r)
         /*--------------------------------------------------*/
         /* A command is given. If possible, split the       */
         /* command line into a command and its parameters.  */
         /*--------------------------------------------------*/
         {
            Commandtxt.a[r] = '\0';
            p1 = Commandtxt.a;
            p2 = strpbrk( Commandtxt.a, " " );
            if (p2)
            {
               *p2 = '\0';
               p2++;
               ret = execom( p1, p2 );
            }
            else
               ret = execom( p1, "" );
            if (!ret)
            {
               count--;
               (void) sprintf( message, "MOSCOM%d=", count );
               cancel_c( tofchar(message) );
            }
         }
      }
      while (r);
      (void) execom( "mosnext", "" );
      (void) sprintf( message, "%d", i );
      (void) execom( "subset", message );
   }
   /* Cancel the keywords */
   for (i = 0; i < count; i++)
   {
      (void) sprintf( message, "MOSCOM%d=", i );
      cancel_c( tofchar(message) );
   }
   return( 1 );
}




static int getgridvalue( fchar Setname,
                         fint  subset,
                         fint  *grid,
                         fint  *axnum,
                         fint  *intsizes,
                         int   integrate,
                         float *value )
/*------------------------------------------------------------*/
/* Read the image value at grid 'grid'. If integration over   */
/* profiles is wanted, create a box in the given subset using */
/* the values in 'intsizes'. Read data in this box and take   */
/* an average.                                                */
/*------------------------------------------------------------*/
{
   fint    cw;
   fint    maxdata = 1;
   fint    tid = 0;
   fint    nread;
   fint    ret = 1;
   fint    subdim;
   int     i;


   subdim = gdsc_ndims_c( Setname, &subset );
   if (!integrate)         /* Fast method */
   {
      cw = gdsc_fill_c( Setname, &subset, grid );
      gdsi_read_c( Setname,
                   &cw,
                   &cw,
                   value,
                   &maxdata,
                   &nread,
                   &tid  );
      if (tid != 0 || nread != maxdata)
         ret = 0;
   }
   else                    /* Integrate over box with size as in 'intsizes' */
   {
      fint  blo[MAXAXES];
      fint  bhi[MAXAXES];
      fint  cwlo, cwhi;
      fint  pixels = 1;
      int   n = 0;
      float *databuf = NULL;
      float sum = 0.0;

      for (i = 0; i < subdim; i++)
      {
         blo[i] = grid[i] - intsizes[i]/2;
         bhi[i] = grid[i] + intsizes[i]/2;
         blo[i] = MYMAX( blo[i], flo[i] );
         bhi[i] = MYMIN( bhi[i], fhi[i] );
         pixels *= (bhi[i] - blo[i] + 1);
      }
      cwlo = gdsc_fill_c( Setname, &subset, blo );
      cwhi = gdsc_fill_c( Setname, &subset, bhi );
      databuf = (float *) calloc( pixels, sizeof(float) );
      if (!databuf)
      {
         *value = 0.0;
         return( 0 );
      }
      gdsi_read_c( Setname,
                   &cwlo,
                   &cwhi,
                   databuf,
                   &pixels,
                   &nread,
                   &tid  );

      if (tid != 0 || nread != pixels)
         ret = 0;
      for (i = 0; i < pixels; i++)
      {
         if (databuf[i] != blank )
         {
            sum += databuf[i];
            n++;
         }
         if (n == 0)
            *value = blank;
         else
            *value = sum / (float) n;
      }

      free( databuf );
   }
   return( ret );
}




static int fillprofile( fchar  Setin,
                        fint   *subin,
                        fint   nsubs,
                        fint   *blo,
                        fint   *bhi,
                        fint   *intsizes,
                        int    integrate,
                        char   *command,
                        fint   *coordword )
/*------------------------------------------------------------*/
/* Given two vectors (blo, bhi), get image data along that    */
/* line and store values in x and y column. If 'nsubs' > 1    */
/* follow a different approach.                               */
/*------------------------------------------------------------*/
{
   float     sample = 0.0;
   float     lambda;
   float     stepsize;
   float     deltaphys = 0.0;
   int       i, k;
   fint      subdim, profdim;
   int       unequal[MAXAXES];
   int       unequals = 0;
   int       npoints;
   float     value;
   fint      grid[MAXAXES];
   fint      startgrid[MAXAXES];
   int       alignax;


   /*--------------------------------------------------*/
   /* The specification of a profile can be done in    */
   /* several ways. As an example: Take a profile in   */
   /* frequency of a RA-DEC-FREQ cube AURORA           */
   /* 1) inset AURORA                                  */
   /*    profile from (RA1,DEC1,FREQ1) to              */
   /*    (RA2,DEC2,FREQ2):                             */
   /* 2) inset AURORA freq                             */
   /*    profile needs position in (RA1,DEC1):         */
   /* 3) inset AURORA ra 1 dec 1                       */
   /*    profile from (FREQ1) to (FREQ2):              */
   /*--------------------------------------------------*/
   subdim = gdsc_ndims_c( Setin, &subin[0] );

   /*--------------------------------------------------*/
   /* Loop over the subset dimension to get an indicat-*/
   /* ion of the size of the sample. The sample is the */
   /* number of positions at which profile data will be*/
   /* extracted from the given set. Distinguish input  */
   /* that specifies one subset [options 1) and 3)] and*/
   /* that specifies more than one subsets [option 2)].*/
   /*--------------------------------------------------*/
   sample = nsubs;
   if (nsubs == 1)
   {
      *coordword = subin[0];
      for (k = 0; k < subdim; k++)
         sample += (float) (bhi[k] - blo[k] + 1) * (bhi[k] - blo[k] + 1);
      sample = NINT( sqrt(sample) );
      if (!sample)
      {
         anylog( 16, command, "Cannot extract a profile with sample size 1!" );
         return( 0 );
      }
   }
   else
      *coordword = setlevel;

   /*--------------------------------------------------*/
   /* Next code tries to determine the coordinate word */
   /* that belangs to the profile axis. The profile    */
   /* axis is aligned to a set axis if the dimension   */
   /* of the calculated coordinate word == 1           */
   /*--------------------------------------------------*/
   alignax = 0;
   for (k = 0; k < subdim; k++)
   {
      unequal[k] = (blo[k] != bhi[k]);
      if (unequal[k])
      {
         unequals++;
         alignax = k;
      }
      else
      {
         fint r1 = 0;
         *coordword = gdsc_word_c( Setin, &axnum[k], &blo[k], coordword, &r1 );
      }
   }


   /*--------------------------------------------------*/
   /* Just some information:                           */
   /*--------------------------------------------------*/
   profdim = gdsc_ndims_c( Setin, coordword );
   (void) sprintf( message, "Profile runs in %d dimension(s).", profdim );
   anylog( 16, command, message );

   npoints = (int) sample;
   (void) sprintf( message, "Profile contains %d points", npoints );
   anylog( 16, command, message );

   (void) sprintf( message, "Fixed axes: %d", unequals );
   anylog( 16, command, message );

   /*--------------------------------------------------*/
   /* Allocate space for 4 special arrays. The Xarray  */
   /* contains positions in grids. EXarray contains the*/
   /* physical values for these positions and Yarray   */
   /* contains the profile data as read from the set.  */
   /*--------------------------------------------------*/
   for (i = ABC; i < ABC+SPECIALCOL; i++)
   {
      if (vect[i] != NULL)
         free( vect[i] );
      vect[i] = (float *) calloc( npoints, sizeof(float) );
      if (vect[i] == NULL)
      {
         anylog( 1, command, "Cannot allocate space for profile columns" );
         return( NO );
      }
      vectsize[i] = npoints;
   }


   /*--------------------------------------------------*/
   /* Generate the sample positions. Note that         */
   /* 'npoints' is the integer equivalent of 'sample'. */
   /* The sample value is only necessary if the number */
   /* of subsets is 1. Only then it will be possible   */
   /* to extract a profile that is NOT aligned with    */
   /* one of the set axes.                             */
   /*--------------------------------------------------*/
   stepsize = 1.0 / (sample - 1.0);
   for (i = 0; i < npoints; i++)
   {
      for (k = 0; k < subdim; k++)
      {
         if (nsubs == 1)
         {
            lambda = (float) i * stepsize;
            grid[k] = (fint) NINT( (float)blo[k] + lambda * ((float)(bhi[k]-blo[k])) );
         }
         else
            grid[k] = blo[k];
      }
      if (i == 0)
      {
         /* Store the values of the start grid */
         for (k = 0; k < subdim; k++)
            startgrid[k] = grid[k];
      }
      if (i == 1)
      {
         char  sbuf[FITSLEN];
         char  lbuf[256];
         /* Determine the distance between this grid and previous grid */
         deltaphys = 0.0;
         strcpy( lbuf, "");
         for (k = 0; k < subdim; k++)
         {
            float d = (grid[k] - startgrid[k]) * cdelt[k];
            deltaphys += d * d;
            if (k == subdim - 1)
               sprintf( sbuf, "%.*s", nelc_c(Cunit[k]), Cunit[k].a );
            else
               sprintf( sbuf, "%.*s x ", nelc_c(Cunit[k]), Cunit[k].a );
            strcat( lbuf, sbuf);
         }
         deltaphys = sqrt( deltaphys );
         anyoutf( 1, "Distance between sample points is %g", deltaphys );
         anyoutf( 1, "Units of the axis/axes: %s", lbuf );
      }
      vect[EXARRAY][i] = vect[XARRAY][i] = (float) i;   /* Initialize, just in case */
      vect[EYARRAY][i] = vect[XARRAY][i] * deltaphys;
      value      = blank;
      if (nsubs == 1)
      {
         if ( getgridvalue(Setin, subin[0], grid, axnum,
                           intsizes, integrate, &value) )
         {
            if (profdim == 1)
               vect[XARRAY][i] = (float) grid[alignax];
         }
      }
      else
      {
         if ( getgridvalue(Setin, subin[i], grid, axnum,
                           intsizes, integrate, &value) )
         {
            fint   r1 = 0;
            if (profdim == 1)
               vect[XARRAY][i] = (float) gdsc_grid_c(
                                        Setin,        /* Extract a grid value */
                                        &axnum[subdim],
                                        &subin[i],
                                        &r1 );
         }
      }
      vect[YARRAY][i] = value;
      /*----------------------------------------*/
      /* There was an aligned profile. Try to   */
      /* convert a grid to the physical value   */
      /* given by that axis.                    */
      /*----------------------------------------*/
      if (profdim == 1)
      {
         fint    r1;
         double  dgrid = (double) vect[XARRAY][i];
         double  dphys;

         r1 = grtoph_c( Setin, coordword, &dgrid, &dphys );
         if (r1 == 0)
            vect[EXARRAY][i] = (float) dphys;
         else
            vect[EXARRAY][i] = vect[XARRAY][i];
      }
   }
   return( npoints );
}



static int readimage( fchar Setname, fint subset,
                      fint xlo, fint ylo, fint xhi, fint yhi,
                      float *image )
/*------------------------------------------------------------*/
/* Read data from set in given box and put values in buffer   */
/* 'image'.                                                   */
/*------------------------------------------------------------*/
{
   fint    cwlo, cwhi;
   fint    blo[2];
   fint    bhi[2];
   fint    maxdata;
   fint    tid = 0;
   fint    nread;

   blo[0] = xlo; blo[1] = ylo;
   bhi[0] = xhi; bhi[1] = yhi;
   cwlo = gdsc_fill_c( Setname, &subset, blo );
   cwhi = gdsc_fill_c( Setname, &subset, bhi );
   maxdata = (xhi-xlo+1)*(yhi-ylo+1);
   gdsi_read_c( Setname,
                &cwlo,
                &cwhi,
                image,
                &maxdata,
                &nread,
                &tid  );
   if ((tid != 0) || (nread != maxdata))
      return(0);
   return(1);
}



static void world2mm( double xg, double yg, double *xmm, double *ymm )
/*------------------------------------------------------------*/
/* Convert position in world coordinates to mm.               */
/*------------------------------------------------------------*/
{
   *xmm = Xorgmm + (xg-worldbox[0])/Xscale;
   *ymm = Yorgmm + (yg-worldbox[1])/Yscale;
}



static void mm2world( double xmm, double ymm, double *xgr, double *ygr )
/*------------------------------------------------------------*/
/* Convert position in mm to world coordinates.               */
/*------------------------------------------------------------*/
{
  *xgr = (xmm - Xorgmm) * Xscale + worldbox[0];
  *ygr = (ymm - Yorgmm) * Yscale + worldbox[1];
}




static int getboxminmax( fchar Setin,
                         fint  subset,
                         fint  *blo,
                         fint  *bhi,
                         float *mnmx )
/*------------------------------------------------------------*/
/* PURPOSE: Get min/max of data in box of a set/subset.       */
/*------------------------------------------------------------*/
{
   fint    cwlo, cwhi;
   fint    tid = 0;
   fint    maxdata = MAXBUF;
   fint    nread;
   float   datamin, datamax;


   cwlo = gdsc_fill_c( Setin, &subset, blo );
   cwhi = gdsc_fill_c( Setin, &subset, bhi );
   mnmx[0] = blank;                                          /* Initialize */
   mnmx[1] = blank;
   do
   {
      gdsi_read_c( Setin,
                   &cwlo,
                   &cwhi,
                   image,                                /* Global buffer */
                   &maxdata,
                   &nread,
                   &tid  );
      minmax1_c( image, &nread, &datamin, &datamax );
      if (mnmx[0] == blank)
      {
         if (datamin != blank)
            mnmx[0] = datamin;
      }
      else if (datamin != blank)
         mnmx[0] = MYMIN( datamin, mnmx[0] );
      if (mnmx[1] == blank)
      {
         if (datamax != blank)
            mnmx[1] = datamax;
      } else if (datamax != blank)
         mnmx[1] = MYMIN( datamax, mnmx[1] );
   } while ( tid > 0 );
   if ((mnmx[0] == blank) || (mnmx[1] == blank))
      return( 0 );
   return( 1 );
}




static int plotpolvectors( fchar   Setin,
                           fchar   Setang,
                           fint    subsetin,
                           fint    subsetang,
                           fint   *polgrid,
                           float   poltrans,
                           char    polmode )
/*------------------------------------------------------------*/
/* PURPOSE: Plot polarisation vectors. The vector size is     */
/*          represented by data from 'inset'. The vector angle*/
/*          is represented by data from 'polset'.             */
/* Vectors are extracted from each grid in the input sets but */
/* are plotted only on the grid given by 'polgrid'. The image */
/* values are transformed to grids by 'poltrans'. If          */
/* 'poltrans' is blank, a default value will be calculated so */
/* that the longest vector will fit into n grids where n is   */
/* the minimum value of the two mask values given in 'polgrid'*/
/*------------------------------------------------------------*/
{
   fint    ndata = MAXBUF;
   float   *image1 = NULL;
   float   *image2 = NULL;
   float   crotarad;
   bool    torad;

   fint  idim, jdim;
   fint  startline, endline;
   fint  xlo = (fint) worldbox[0], ylo = (fint) worldbox[1];
   fint  xhi = (fint) worldbox[2], yhi = (fint) worldbox[3];
   float trans[6];
   fint  maxlines;
   fint  numlines;
   fint  startindexX, startindexY;
   fint  endindexX, endindexY;
   int   ystart;                        /* Offset for arraow positions */


   image1 = (float *) calloc( ndata, sizeof(float) );
   image2 = (float *) calloc( ndata, sizeof(float) );
   if (image1 == NULL || image2 == NULL)
   {
      anylog( 1, "polplot", "Cannot allocate memory for image data!" );
      return( 0 );
   }

   torad = (toupper(polmode) == 'D');
   crotarad = (float) RAD( crota );

   xlo = MYMIN( (fint) worldbox[0], (fint) worldbox[2] );
   ylo = MYMIN( (fint) worldbox[1], (fint) worldbox[3] );
   xhi = MYMAX( (fint) worldbox[0], (fint) worldbox[2] );
   yhi = MYMAX( (fint) worldbox[1], (fint) worldbox[3] );

   /* Security */
   xlo = MYMAX( xlo, flo[0] );
   ylo = MYMAX( ylo, flo[1] );
   xhi = MYMIN( xhi, fhi[0] );
   yhi = MYMIN( yhi, fhi[1] );

   /*-----------------------------------------------------------------------*/
   /* The transformation matrix 'trans' is used to calculate the world      */
   /* coordinates of the center of the "cell" that represents each          */
   /* array element. The world coordinates of the center of the cell        */
   /* corresponding to array element A(I,J) are given by:                   */
   /*                                                                       */
   /*    X = trans[0] + trans[1]*I + trans[2]*J                             */
   /*    Y = trans[3] + trans[4]*I + trans[5]*J                             */
   /*                                                                       */
   /* Because there is no rotation or shear, trans[2] and trans[4] are 0.0  */
   /*-----------------------------------------------------------------------*/

   trans[0] = xlo - 1.0;   /* Fortran indices from 1..n */
   trans[1] = 1.0;
   trans[2] = 0.0;
   trans[3] = ylo - 1.0;
   trans[4] = 0.0;
   trans[5] = 1.0;
   
   ystart = ylo; /* Pixel positions for the arrows */

   /* Get a scaling factor for the vector lengths */
   if (poltrans == blank)
   {
      float   mnmx[2];
      fint    blo[2];
      fint    bhi[2];

      blo[0] = xlo;  blo[1] = ylo;
      bhi[0] = xhi;  bhi[1] = yhi;

      if ( getboxminmax( Setin, subsetin, blo, bhi, mnmx ) )
      /*--------------------------------------------------*/
      /* Get min/max of data in box blo-bhi from the set  */
      /* with intensities.                                */
      /*--------------------------------------------------*/
      {
         poltrans = MYMIN( polgrid[0], polgrid[1] ) / mnmx[1];
      }
      else
      {
         anylog( 1, "minmax", "Cannot scale pol. vector: data min. or max. is blank!" );
         return( 0 );
      }
   }


   idim = xhi - xlo + 1;
   jdim = yhi - ylo + 1;
   maxlines = MAXBUF / idim;
   if (maxlines < 1) {
      anylog( 1, "polplot", "Buffer to small to read at least one line" );
      return(0);
   }
   endline  = ylo - 1;             /* Initialize */

   do
   {
      int   count;
      int   i, j;
      int   x, y;
      

      startline = endline + 1;
      endline   = MYMIN( (startline+maxlines-1), yhi );
      numlines  = (endline - startline + 1);
      
      if (!readimage( Setin, subsetin, xlo, startline, xhi, endline, image1 ))
      {
         anylog( 1, "polplot", "cannot read data from intensity/length set" );
         return(0);
      }
      if (!readimage( Setang, subsetang, xlo, startline, xhi, endline, image2 ))
      {
         anylog( 1, "polplot", "cannot read data from angles set" );
         return(0);
      }
      startindexX = 1;
      startindexY = 1;
      endindexX   = idim;
      endindexY   = numlines;

      count = 0;
      for (j = 0; j < numlines; j++)
      {
         for (i = 0; i < idim; i++)
         {
            float val1, val2;
            x = xlo + i;
            y = ystart + j;
            val1 = image1[count];
            val2 = image2[count];
            /*--------------------------------------------------*/
            /* At this point, we have an intensity (val1), an   */
            /* angle (val2) and a grid position. Plot a vector  */
            /* with the center at x, y, if the values are not   */
            /* blank and the grid is not masked by 'polgrid'.   */
            /*--------------------------------------------------*/
            if (val1 != blank && val2 != blank &&
               !(x%polgrid[0]) && !(y%polgrid[1]) )
            {
               float  dx, dy;
               float  xx, yy;
               float  x1, x2, y1, y2;
               xx = (float) x;
               yy = (float) y;
               val1 *= 0.5 * poltrans;    /* Center vector and scale */
               if (torad)
                  val2 = RAD( val2 );
               val2 += (0.5*PI + crotarad);
               dx = val1 * cos( val2 );
               dy = val1 * sin( val2 );
               x1 = xx-dx; y1 = yy-dy;
               x2 = xx+dx; y2 = yy+dy;
               pgarro_c( &x1, &y1, &x2, &y2 );
            }
            count++;
         }
      }
      trans[3] += numlines - 1;    /* !! There is an overlap of 1 line */
      ystart += numlines;
   } while (endline < yhi);

   free( image1 );
   free( image2 );
   return(1);
}





static int colbar( fchar   Devtype,
                   char   *command,
                   fint    lutlen,
                   float  *lutr,
                   float  *lutg,
                   float  *lutb,
                   fint    GIDSmincol,
                   fint    GIDSmaxcol,
                   fint    GIDSncolors,
                   float   GIDSbscale,
                   float   GIDSbzero,
                   double  xorg,
                   double  yorg,
                   double  width,
                   double  height,
                   char    orientation,
                   bool    annotation )
/*------------------------------------------------------------*/
/* Plot a colour bar if the device is a colour device. If it  */
/* not such a device, plot the colourbar frame only.          */
/*------------------------------------------------------------*/
{
   fint    idim, jdim;
   float   trans[6];
   int     i, j;
   fint    c;
   int     iret;
   int     maxcolindx = 0;
   bool    cpstype = YES;
   bool    changed = NO;
   double  xorg_mm, yorg_mm;
   double  xsc, ysc;
   float   *colbardata = NULL;


   if (strstr( Devtype.a, "PS") == NULL)
   {
      anylog( 1, command, "Selected device is not a PostScript device, use 'device' to change" );
      anylog( 1, command, "However, frame will be plotted.");
      cpstype = NO;   /* But we still can draw frame and labels of the bar */
   }

   /*--------------------------------------------------*/
   /* Calculate length and width of colour bar in      */
   /* pixels. X and Y can be changed if a horizontal   */
   /* bar is wanted. Then 'orientation' is either 'T'  */
   /* or 'B'.                                          */
   /*--------------------------------------------------*/
   idim    = 1;
   jdim    = GIDSmaxcol - GIDSmincol;              /* Range in colour indices */
                                             /* exclude the index for a blank */


   colbardata = (float *) calloc( jdim, sizeof(float) );
   if (colbardata == NULL)
   {
      anylog( 1, command, "Cannot allocate space for colour bar!" );
      return(0);
   }

   for (j = 0, i = GIDSmincol + 1; i <= GIDSmaxcol; i++, j++)
   {
      colbardata[j] = GIDSbscale * (float) (i) + GIDSbzero;
   }
   maxcolindx = j - 1;
   for (c = GIDSmincol + 1; c <= GIDSmaxcol; c++)
   {
      int k = c - GIDSmincol;      /* Index 0 is the definition of a blank!!! */
      pgscr_c( &c,
               &lutr[k],
               &lutg[k],
               &lutb[k] );
   }
   /* Set the colour index range */
   {
      fint c1 = GIDSmincol + 1;
      fint c2 = GIDSmaxcol;
      pgscir_c( &c1, &c2 );
   }

   /* Start position always in mm ! */
   if (world)
   {
      world2mm( xorg, yorg, &xorg_mm, &yorg_mm );
      changed = YES;
   }
   else
   {
      xorg_mm = xorg;
      yorg_mm = yorg;
   }
   /*-----------------------------------------------------------------------*/
   /* The transformation matrix 'trans' is used to calculate the world      */
   /* coordinates of the center of the "cell" that represents each          */
   /* array element. The world coordinates of the center of the cell        */
   /* corresponding to array element A(I,J) are given by:                   */
   /*                                                                       */
   /*    X = trans[0] + trans[1]*I + trans[2]*J                             */
   /*    Y = trans[3] + trans[4]*I + trans[5]*J                             */
   /*                                                                       */
   /* Because there is no rotation or shear, trans[2] and trans[4] are 0.0  */
   /*-----------------------------------------------------------------------*/

   if (toupper(orientation) == 'B' || toupper(orientation) == 'T')
   {
      /* Swap the length and width in pixels */
      fint sw = jdim;
      jdim = idim;
      idim = sw;
   }
   xsc = ((double)idim) / width;
   ysc = ((double)jdim) / height;
   /*--------------------------------------------------*/
   /* Correct starting point for Fortran offset of     */
   /* 1 (pixel) and correct offset for 0.5 pixel       */
   /* because pixel is centered and array is only one  */
   /* pixel wide.                                      */
   /*--------------------------------------------------*/
   trans[0] = (float) (xorg_mm - 0.5/xsc);
   trans[1] = (float) (1.0 / xsc);
   trans[2] = 0.0;
   trans[3] = (float) (yorg_mm - 0.5/ysc);
   trans[4] = 0.0;
   trans[5] = (float) (1.0/ysc);


   if (cpstype)
   /*--------------------------------------------------*/
   /* The transformation matrix used in 'pgcolim_c'    */
   /* is set up to work in millimeters !               */
   /*--------------------------------------------------*/
   {
      fint    startindexX, startindexY;
      fint    endindexX, endindexY;

      if (world)
      {
         iret = execom( "mmeter", "" );
         changed = YES;
      }
      startindexX = 1;
      startindexY = 1;
      endindexX   = idim;
      endindexY   = jdim;

      pgimag_c( colbardata,       /* Colour indices to be plotted */
                &idim,            /* First dimension of colbardata' */
                &jdim,            /* Second dimension of colbardata' */
                &startindexX,     /* Start of range of first index */
                &endindexX,       /* End of range of first index */
                &startindexY,     /* Start of range of second index */
                &endindexY,       /* End of range of second index */
                &colbardata[0],   /* Minimum image data */
                &colbardata[maxcolindx], /* max. image data */
                trans );          /* Transformation between pixels and w.coords. */

      if (changed)                                       /* Back to world */
         iret = execom( "world", "" );
   }


   /*----------------------------------------*/
   /* Draw a frame around colour bar         */
   /* The current coordinates must be world- */
   /* coordinates.                           */
   /*----------------------------------------*/
   {
      float    datmin = colbardata[0];   /* World coords. of frame around bar */
      float    datmax = colbardata[maxcolindx];
      double   storebox[4];
      double   Xscalestore, Yscalestore;
      double   Xorgmmstore, Yorgmmstore;
      int      i;

      if (world)
         changed = NO;
      else
      {
         execom( "world", "" );
         changed = YES;
      }
      /* Store the current box and scale and origin */
      for  (i = 0; i < 4; i++)
         storebox[i] = worldbox[i];

      Xscalestore = Xscale;
      Yscalestore = Yscale;
      Xorgmmstore = Xorgmm;
      Yorgmmstore = Yorgmm;


      if (toupper(orientation) == 'L' || toupper(orientation) == 'R')
      {
         worldbox[0] = 0.0;
         worldbox[1] = datmin;
         worldbox[2] = 1.0;
         worldbox[3] = datmax;
      }
      else
      {
         worldbox[0] = datmin;
         worldbox[1] = 0.0;
         worldbox[2] = datmax;
         worldbox[3] = 1.0;
      }

      /* Enter new origin, box and scales */
      Xorgmm = xorg_mm;
      Yorgmm = yorg_mm;
      sprintf( message, "%f %f %f %f", worldbox[0], worldbox[1],
               worldbox[2], worldbox[3] );
               
      /*----------------------------------------------------------*/
      /* Important! The box command knows that a set is available */
      /* because a flag 'inset' is set. Then it calls gdsbox      */
      /* which rounds values to nearest integers. If we set this  */
      /* flag to NO than always the alternative for gdsbox will   */
      /* be applied.                                              */
      /*----------------------------------------------------------*/
      {
         static bool     insetstorecurrentvalue;
       
         insetstorecurrentvalue = inset;      
         inset = NO;
         execom( "box", message );
         inset = insetstorecurrentvalue;
      }      

      sprintf( message, "%f", width );
      execom( "xsize", message );
      sprintf( message, "%f", height );
      execom( "ysize", message );

      if (annotation)
      {
         sprintf( message, "%cwI10", orientation );  /* Default ticks outside */
         execom( "axis", message );
      }

      /* Draw a frame around bar */
      execom( "axis", "l" );
      execom( "axis", "b" );
      execom( "axis", "r" );
      execom( "axis", "t" );

      /* Restore previous box */
      worldbox[0] = storebox[0];
      worldbox[1] = storebox[1];
      worldbox[2] = storebox[2];
      worldbox[3] = storebox[3];
      Xscale = Xscalestore;
      Yscale = Yscalestore;
      Xorgmm = Xorgmmstore;
      Yorgmm = Yorgmmstore;
      execom( "box", "" );

      if (changed)
         execom( "mmeter", "" );
   }

   free( colbardata );
   return( YES );
}



static int plotcol( fchar  Setname, fint subset,
                    fchar  Devtype,
                    char   *command,
                    fint   lutlen,
                    float  *lutr, float *lutg, float *lutb,
                    fint   GIDSmincol, fint GIDSmaxcol,
                    fint   GIDSncolors,
                    fint   GIDSblank,
                    float  GIDSbscale, float GIDSbzero )
/*------------------------------------------------------------*/
/* Plot colour image of current set in current box. Use the   */
/* luts as obtained from GIDS.                                */
/*------------------------------------------------------------*/
{
   fint  idim, jdim;
   fint  startline, endline;
   fint  xlo, ylo;
   fint  xhi, yhi;
   float trans[6];
   fint  maxlines;
   fint  numlines;
   fint  startindexX, startindexY;
   fint  endindexX, endindexY;
   fint  *intdata = NULL;
   float datmin, datmax;
   fint  c;


   if (strstr( Devtype.a, "PS") == NULL)
   {
      anylog( 1, command, "Selected device is not a PostScript hardcopy device." );
      anylog( 1, command, "Change to another device like LCPSFILE or PCPSFILE." );
      return( NO );
   }

   xlo = MYMIN( (fint) worldbox[0], (fint) worldbox[2] );
   ylo = MYMIN( (fint) worldbox[1], (fint) worldbox[3] );
   xhi = MYMAX( (fint) worldbox[0], (fint) worldbox[2] );
   yhi = MYMAX( (fint) worldbox[1], (fint) worldbox[3] );

   xlo = MYMAX( xlo, flo[0] );
   ylo = MYMAX( ylo, flo[1] );
   xhi = MYMIN( xhi, fhi[0] );
   yhi = MYMIN( yhi, fhi[1] );

   /*-----------------------------------------------------------------------*/
   /* The transformation matrix 'trans' is used to calculate the world      */
   /* coordinates of the center of the "cell" that represents each          */
   /* array element. The world coordinates of the center of the cell        */
   /* corresponding to array element A(I,J) are given by:                   */
   /*                                                                       */
   /*    X = trans[0] + trans[1]*I + trans[2]*J                             */
   /*    Y = trans[3] + trans[4]*I + trans[5]*J                             */
   /*                                                                       */
   /* Because there is no rotation or shear, trans[2] and trans[4] are 0.0  */
   /*-----------------------------------------------------------------------*/

   trans[0] = xlo - 1.0;   /* Fortran indices from 1..n */
   trans[1] = 1.0;
   trans[2] = 0.0;
   trans[3] = ylo - 1.0;
   trans[4] = 0.0;
   trans[5] = 1.0;



   idim = xhi - xlo + 1;
   jdim = yhi - ylo + 1;
   maxlines = MAXBUF / idim;
   if (maxlines < 1)
   {
      anylog( 1, command, "Buffer to small to read at least one line" );
      return(0);
   }

   /*----------------------------------------------------------------------*/
   /* PGIMAG wants two floats, which are depicted  onto two colour indices */
   /* c1 and c2. The index range is set by PGSCIR. Because we want         */
   /* interaction with GIDS (interactive colour adjustment, many luts,     */
   /* common transfer functions) we are bound to some GIDS characteristics.*/
   /* First: GIDS sets the colour indices. Then GIDS returns the colour    */
   /* lut for a user adjusted colour scheme. The lut always starts at      */
   /* index 0 (which represents a blank). At last: GIDS returns a BSCALE   */
   /* and a BZERO with which floats can be calculated that represent c1    */
   /* and c2. Again: Note that the first element in the lut arrays         */
   /* represent the rgb value of a blank. PGIMAG recognizes blanks after   */
   /* PGPLOT is told which index corresponds to a blank.                   */
   /*----------------------------------------------------------------------*/
   datmin = GIDSbscale * (float)  GIDSmincol + GIDSbzero;
   datmax = GIDSbscale * (float)  GIDSmaxcol + GIDSbzero;

   /* Set the colour representations using the lut returned by gdi_getlut */
   for (c = GIDSmincol; c <= GIDSmaxcol; c++)
   {
      int k = c - GIDSmincol;      /* Index 0 is the definition of a blank!!! */
      pgscr_c( &c,
               &lutr[k],
               &lutg[k],
               &lutb[k] );
   }
   

   pgsbci_c( &GIDSmincol );               /* This index corresponds to blanks */
   {
      fint newmin = GIDSmincol + 1;
      pgscir_c( &newmin, &GIDSmaxcol );          /* Set the color index range */
   }

   
   endline  = ylo;                                              /* Initialize */
   do
   {
      /* Original value for startline was: startline = endline + 1; */
      /* However, images are not plotted correctly if there are     */
      /* more pixels to plot than the size of the buffer 'MAXBUF'.  */
      /* Therefore prepend each new buffer with the last line of    */
      /* previous buffer.                                           */

      startline = endline;
      endline   = MYMIN( (startline+maxlines-1), yhi );
      numlines  = (endline - startline + 1);
      if (!readimage( Setname, subset, xlo, startline, xhi, endline, image ))
      {
         anylog( 1, command, "cannot read data from set" );
         return(0);
      }
      startindexX = 1;
      startindexY = 1;
      endindexX   = idim;
      endindexY   = numlines;

      pgimag_c( image,            /* Colour indices to be plotted */
                &idim,            /* First dimension of 'intdata' */
                &numlines,        /* Second dimension of 'intdata' */
                &startindexX,     /* Start of range of first index */
                &endindexX,       /* End of range of first index */
                &startindexY,     /* Start of range of second index */
                &endindexY,       /* End of range of second index */
                &datmin,
                &datmax,
                trans );

      trans[3] += numlines - 1;
   } while (endline < yhi);
   free( intdata );
   return(1);
}




static int plotgray( fchar Setname, fint subset,
                     float *levels, fint ngray )
/*------------------------------------------------------------*/
/* Plot gray scales for current box and set.                  */
/*------------------------------------------------------------*/
{
   fint  idim, jdim;
   fint  startline, endline;
   fint  xlo = (fint) worldbox[0], ylo = (fint) worldbox[1];
   fint  xhi = (fint) worldbox[2], yhi = (fint) worldbox[3];
   float trans[6];
   fint  maxlines;
   fint  numlines;
   fint  startindexX, startindexY;
   fint  endindexX, endindexY;
   float immin, immax;


   xlo = MYMIN( (fint) worldbox[0], (fint) worldbox[2] );
   ylo = MYMIN( (fint) worldbox[1], (fint) worldbox[3] );
   xhi = MYMAX( (fint) worldbox[0], (fint) worldbox[2] );
   yhi = MYMAX( (fint) worldbox[1], (fint) worldbox[3] );

   /* Security */
   xlo = MYMAX( xlo, flo[0] );
   ylo = MYMAX( ylo, flo[1] );
   xhi = MYMIN( xhi, fhi[0] );
   yhi = MYMIN( yhi, fhi[1] );

   /*-----------------------------------------------------------------------*/
   /* The transformation matrix 'trans' is used to calculate the world      */
   /* coordinates of the center of the "cell" that represents each          */
   /* array element. The world coordinates of the center of the cell        */
   /* corresponding to array element A(I,J) are given by:                   */
   /*                                                                       */
   /*    X = trans[0] + trans[1]*I + trans[2]*J                             */
   /*    Y = trans[3] + trans[4]*I + trans[5]*J                             */
   /*                                                                       */
   /* Because there is no rotation or shear, trans[2] and trans[4] are 0.0  */
   /*-----------------------------------------------------------------------*/

   trans[0] = xlo - 1.0;   /* Fortran indices from 1..n */
   trans[1] = 1.0;
   trans[2] = 0.0;
   trans[3] = ylo - 1.0;
   trans[4] = 0.0;
   trans[5] = 1.0;



   idim = xhi - xlo + 1;
   jdim = yhi - ylo + 1;
   maxlines = MAXBUF / idim;
   if (maxlines < 1) {
      anylog( 1, "grayscales", "Buffer to small to read at least one line" );
      return(0);
   }
/*   minmax1_c( levels, &ngray, &immin, &immax );*/
   immin = levels[0];
   immax = levels[ngray-1];
   endline  = ylo - 1;             /* Initialize */

   pgbbuf_c();
   do
   {
      int     i;
      float   range;

      startline = endline + 1;
      endline   = MYMIN( (startline+maxlines-1), yhi );
      numlines  = (endline - startline + 1);
      if (!readimage( Setname, subset, xlo, startline, xhi, endline, image ))
      {
         anylog( 1, "grayscales", "cannot read data from set" );
         return(0);
      }
      startindexX = 1;
      startindexY = 1;
      endindexX   = idim;
      endindexY   = numlines;

      /*------------------------------------------------------------*/
      /* Filter the blanks and rebin the data to allow NONLINEAR    */
      /* subdivision of gray scales. There are two cases: first:    */
      /* the first level is smaller than the last and the second    */
      /* case is the other situation. Note that both require diffe- */
      /* rent treatment for blanks and values outside the range of  */
      /* levels.                                                    */
      /*------------------------------------------------------------*/
      range = levels[ngray-1] - levels[0];
      for (i = 0; i < (numlines*idim); i++)
      {
         int   lev;
         int   found = NO;

         if (immax >= immin)    /* ASCENDING order */
         {
            if (image[i] == blank)
            {
               image[i] = immin - 1.0;
            }
            else
            {
               for (lev = 0; lev < ngray-1; lev++)
               {
                  /* Standard: levels sorted in ascending order */
                  if (image[i] > levels[lev] && image[i] <= levels[lev+1])
                  {
                     float    factor = (((float) lev) + 0.5) / (float) ngray;
                     image[i] = levels[0] + factor*range;
                     break;
                  }
               }
            }
         }
         else                  /* DESCENDING order */
         {
            if (image[i] == blank)
            {
               image[i] = immax - 1.0;
            }
            else
            {
               for (lev = 0; lev < ngray-1; lev++)
               {
                  /* Descending order */
                  if (image[i] <= levels[lev] && image[i] > levels[lev+1])
                  {
                     float    factor = (((float) lev) + 0.5) / (float) ngray;
                     image[i] = levels[ngray-1] - factor*range;
                     found = YES;
                     break;
                  }
               }
               if (!found)
               {
                  /* Values outside ranges and immax < immin ! */
                  if (image[i] >= immin)
                     image[i] = immax - 1.0;
                  else if (image[i] <= immax)
                     image[i] = immin + 1.0;
               }
            }
         }
      }
      {
         float imi, ima;
         imi = immin;
         ima = immax;
         if (immin > immax)
            FSWAP( imi, ima );

         pggray_c(  image,            /* Array to be plotted */
                    &idim,            /* First dimension of 'image' */
                    &numlines,        /* Second dimension of 'image' */
                    &startindexX,     /* Start of range of first index */
                    &endindexX,       /* End of range of first index */
                    &startindexY,     /* Start of range of second index */
                    &endindexY,       /* End of range of second index */
                    &ima,             /* The array value which is to appear with shade 1 ("foreground") */
                    &imi,             /* Shade 0 ("background") */
                    trans             /* Transformation matrix between array grid and world coordinates */
                 );
      }

#ifdef ERUIT
      pggray2_c(  image,            /* Array to be plotted */
                  &idim,            /* First dimension of 'image' */
                  &numlines,        /* Second dimension of 'image' */
                  &startindexX,     /* Start of range of first index */
                  &endindexX,       /* End of range of first index */
                  &startindexY,     /* Start of range of second index */
                  &endindexY,       /* End of range of second index */
                  &immax,           /* The array value which is to appear with shade 1 ("foreground") */
                  &immin,           /* Shade 0 ("background") */
                  trans,            /* Transformation matrix between array grid and world coordinates */
                  levels,           /* Array with gray scale levels */
                  &ngray  );        /* Number of gray scale levels */
#endif


      trans[3] += numlines;
   }
   while (endline < yhi);

   pgebuf_c();
   return(1);
}



static int plotcont( fchar Setname, fint subset,
                     float *levels, fint ncont,
                     float immin,   float immax,
                     float ticklen, fint tickstep,
                     int   standard )
/*------------------------------------------------------------*/
/* Plot contours for current box and set.                     */
/*------------------------------------------------------------*/
{
   fint  idim, jdim;
   fint  startline, endline;
   fint  xlo = (fint) worldbox[0], ylo = (fint) worldbox[1];
   fint  xhi = (fint) worldbox[2], yhi = (fint) worldbox[3];
   float trans[6];
   fint  maxlines;
   fint  numlines;
   fint  nc;
   fint  startindexX, startindexY;
   fint  endindexX, endindexY;


   xlo = MYMIN( (fint) worldbox[0], (fint) worldbox[2] );
   ylo = MYMIN( (fint) worldbox[1], (fint) worldbox[3] );
   xhi = MYMAX( (fint) worldbox[0], (fint) worldbox[2] );
   yhi = MYMAX( (fint) worldbox[1], (fint) worldbox[3] );

   xlo = MYMAX( xlo, flo[0] );
   ylo = MYMAX( ylo, flo[1] );
   xhi = MYMIN( xhi, fhi[0] );
   yhi = MYMIN( yhi, fhi[1] );

   /*-----------------------------------------------------------------------*/
   /* The transformation matrix 'trans' is used to calculate the world      */
   /* coordinates of the center of the "cell" that represents each          */
   /* array element. The world coordinates of the center of the cell        */
   /* corresponding to array element A(I,J) are given by:                   */
   /*                                                                       */
   /*    X = trans[0] + trans[1]*I + trans[2]*J                             */
   /*    Y = trans[3] + trans[4]*I + trans[5]*J                             */
   /*                                                                       */
   /* Because there is no rotation or shear, trans[2] and trans[4] are 0.0  */
   /*-----------------------------------------------------------------------*/

   trans[0] = xlo - 1.0;           /* Fortran indices in pgconb from 1..n */
   trans[1] = 1.0;
   trans[2] = 0.0;
   trans[3] = ylo - 1.0;
   trans[4] = 0.0;
   trans[5] = 1.0;


   idim = xhi - xlo + 1;
   jdim = yhi - ylo + 1;
   maxlines = MAXBUF / idim;
   if (maxlines < 2)
   {
      anylog( 1, "contours", "Buffer to small to read at least two lines" );
      return(0);
   }
   /*-----------------------------------------------------------------*/
   /* The contour routine creates empty lines if the data buffers fit */
   /* exactly. Therefore an overlap is implemented. The last line of  */
   /* the previous buffer becomes the start line of the next buffer.  */
   /*-----------------------------------------------------------------*/
   endline = ylo;
   do
   {
      startline = endline;
      endline   = MYMIN( (startline+maxlines-1), yhi );
      numlines  = (endline - startline + 1);
      if (!readimage( Setname, subset, xlo, startline, xhi, endline, image ))
      {
         anylog( 1, "contours", "cannot read data from set" );
         return(0);
      }
      nc = -ncont;
      startindexX = 1;
      startindexY = 1;
      endindexX   = idim;
      endindexY   = numlines;
      if (standard)
         pgconb_c(  image,            /* Array to be plotted */
                    &idim,            /* First dimension of 'image' */
                    &numlines,        /* Second dimension of 'image' */
                    &startindexX,     /* Start of range of first index */
                    &endindexX,       /* End of range of first index */
                    &startindexY,     /* Start of range of second index */
                    &endindexY,       /* End of range of second index */
                    levels,           /* Array of contour levels */
                    &nc,              /* Number of contour levels */
                    trans,            /* Transformation matrix between array grid and world coordinates */
                    &blank );
      else
         pgcotic_c(  image,            /* Array to be plotted */
                     &idim,            /* First dimension of 'image' */
                     &numlines,        /* Second dimension of 'image' */
                     &startindexX,     /* Start of range of first index */
                     &endindexX,       /* End of range of first index */
                     &startindexY,     /* Start of range of second index */
                     &endindexY,       /* End of range of second index */
                     levels,           /* Array of contour levels */
                     &nc,              /* Number of contour levels */
                     trans,            /* Transformation matrix between array grid and world coordinates */
                     &blank,
                     &ticklen,         /* Length of 'normal' ticks in w. coords. */
                     &tickstep );

      trans[3] += numlines - 1;    /* !! There is an overlap of 1 line */
   } while (endline < yhi);
   return(1);
}




static int plotcontlab( fchar Setname, fint subset,
                        float *levels, fint ncont,
                        char  *label,
                        fint  intval, fint minint )
/*------------------------------------------------------------*/
/* Plot contours for current box and set.                     */
/*------------------------------------------------------------*/
{
   fint  idim, jdim;
   fint  startline, endline;
   fint  xlo = (fint) worldbox[0], ylo = (fint) worldbox[1];
   fint  xhi = (fint) worldbox[2], yhi = (fint) worldbox[3];
   float trans[6];
   fint  maxlines;
   fint  numlines;
   fint  startindexX, startindexY;
   fint  endindexX, endindexY;


   xlo = MYMIN( (fint) worldbox[0], (fint) worldbox[2] );
   ylo = MYMIN( (fint) worldbox[1], (fint) worldbox[3] );
   xhi = MYMAX( (fint) worldbox[0], (fint) worldbox[2] );
   yhi = MYMAX( (fint) worldbox[1], (fint) worldbox[3] );

   xlo = MYMAX( xlo, flo[0] );
   ylo = MYMAX( ylo, flo[1] );
   xhi = MYMIN( xhi, fhi[0] );
   yhi = MYMIN( yhi, fhi[1] );

   /*-----------------------------------------------------------------------*/
   /* The transformation matrix 'trans' is used to calculate the world      */
   /* coordinates of the center of the "cell" that represents each          */
   /* array element. The world coordinates of the center of the cell        */
   /* corresponding to array element A(I,J) are given by:                   */
   /*                                                                       */
   /*    X = trans[0] + trans[1]*I + trans[2]*J                             */
   /*    Y = trans[3] + trans[4]*I + trans[5]*J                             */
   /*                                                                       */
   /* Because there is no rotation or shear, trans[2] and trans[4] are 0.0  */
   /*-----------------------------------------------------------------------*/

   trans[0] = xlo - 1.0;           /* Fortran indices in pgconb from 1..n */
   trans[1] = 1.0;
   trans[2] = 0.0;
   trans[3] = ylo - 1.0;
   trans[4] = 0.0;
   trans[5] = 1.0;


   idim = xhi - xlo + 1;
   jdim = yhi - ylo + 1;
   maxlines = MAXBUF / idim;
   if (maxlines < 2)
   {
      anylog( 1, "contours", "Buffer to small to read at least two lines" );
      return(0);
   }
   /*-----------------------------------------------------------------*/
   /* The contour routine creates empty lines if the data buffers fit */
   /* exactly. Therefore an overlap is implemented. The last line of  */
   /* the previous buffer becomes the start line of the next buffer.  */
   /*-----------------------------------------------------------------*/
   endline = ylo;
   do
   {
      int   contour;

      startline = endline;
      endline   = MYMIN( (startline+maxlines-1), yhi );
      numlines  = (endline - startline + 1);
      if (!readimage( Setname, subset, xlo, startline, xhi, endline, image ))
      {
         anylog( 1, "contours", "cannot read data from set" );
         return(0);
      }
      startindexX = 1;
      startindexY = 1;
      endindexX   = idim;
      endindexY   = numlines;


#ifdef SPECIALBLANKS
      /* Force a blank to be just an exceptional point */
      ndat = numlines*idim;
      minmax1_c( image, &ndat, &datamin, &datamax );
      for (i = 0; i < (numlines*idim); i++)
      {
         if (image[i] == blank)
           image[i] = -10.0 * ABS( datamin );
      }
#endif


      for (contour = 0; contour < ncont; contour++)
      {
         char   lab[256];

         if (label == NULL)
         {
            sprintf( lab, "%g", levels[contour] );
         }
         else
         {
            if ( strlen(label) == 0 )
               sprintf( lab, "%g", levels[contour] );
            else
               strcpy( lab, label );
         }

         pgconl_c(  image,            /* Array to be plotted */
                    &idim,            /* First dimension of 'image' */
                    &numlines,        /* Second dimension of 'image' */
                    &startindexX,     /* Start of range of first index */
                    &endindexX,       /* End of range of first index */
                    &startindexY,     /* Start of range of second index */
                    &endindexY,       /* End of range of second index */
                    &levels[contour],  /* Array of contour levels */
                    trans,            /* Transformation matrix between array grid and world coordinates */
                    tofchar(lab),
                    &intval,
                    &minint );
      }


      trans[3] += numlines - 1;    /* !! There is an overlap of 1 line */
   } while (endline < yhi);
   return(1);
}



static void purpose( FILE *fp,
                     int  dev,
                     char *item,
                     bool info,
                     bool *helped )
/*-----------------------------------------------------------*/
/* Find item in list of command comments. Display command    */
/* and comment stored in the 'vocab' structure. If a command */
/* is not a real command but it contains '(info)' then       */
/* replace command: by info:                                 */
/*-----------------------------------------------------------*/
{
   int    m, n;
   int    l = MAXVOCAB;
   char   messbuf[80];


   for (m = 0, n = 0; m < strlen(item); m++, n++)
      messbuf[n] =  toupper(item[m]);
   messbuf[n] = '\0';

   if (info)
      strcat( messbuf, "  (info)" );
   prtout( fp, dev, messbuf );
   m = 0;
   while ((m < l) && (strcmp(vocab[m].name,item)))    /* command list */
      m++;
   if (m < l)
   {
      (void) sprintf( messbuf, "purpose: %s", vocab[m].comment );
      prtout( fp, dev, messbuf );
   }
   *helped = YES;
}



static void help( FILE *fp, char *command )
/*------------------------------------------------------------*/
/* List help about commands etc. The purpose line is          */
/* extracted from the 'command' structure.                    */
/*------------------------------------------------------------*/
{
   int   i;
   fint  d = 1;                                         /* output destination */
   bool  helped = NO;


   if (!strlen(command))                                /* List all commands */
   {
      i = sprintf( message, "%-15.15s: %s", "COMMAND", "PURPOSE LINE" );
      prtout( fp, d,  message );
      memset( message, '=', i );
      prtout( fp, d,  message );
      for (i = 0; i < MAXVOCAB; i++)
      {
         sprintf( message, "%-15.15s: %s", vocab[i].name, vocab[i].comment );
         prtout( fp, d,  message );
      }
      prtout( fp, d,  " " );
      prtout( fp, d,  "INFO ITEMS:" );
      prtout( fp, d,  "units          : List of available units" );
      prtout( fp, d,  "functions      : Functions and constants to be used in expressions" );
      prtout( fp, d,  "formats        : Formats to convert numbers to text" );
      prtout( fp, d,  " " );
      prtout( fp, d,  "HELP" );
      prtout( fp, d,  "Syntax:  help [command]");
      prtout( fp, d,  "         'command' is one of the commands listed above.");
      prtout( fp, d,  "         You can use wildcards. The wildcard character is '*'");
      prtout( fp, d,  "         e.g.: help *label* will list help about all commands that");
      prtout( fp, d,  "         have 'label' as a sub string.");
   }
   else
   /*------------------------------------------------------------*/
   /* Get help for this command. The command is (minimal) matched*/
   /* with the list of known keywords in a case-INsensitive way. */
   /*------------------------------------------------------------*/
   {
      FILE    *helpfp = NULL;
      char    *path;

      path = malloc( strlen(getenv("gip_tsk")) + strlen("/gplot.dc1") + 1 );
      if (path == NULL)
      {
         anylog( 1, "warning", "Cannot allocate memory for path & filename!");
         return;
      }
      strcpy( path, getenv("gip_tsk") );
      strcat( path, "/gplot.dc1" );

      helpfp = fopen( path, "r" );
      if (helpfp == NULL)
      {
         anylog( 1, "help", "Cannot open help file" );
         return;
      }
      while (!feof(helpfp))
      /*--------------------------------------------------*/
      /* The file $gip_tsk/gplot.dc1 contains information */
      /* records for each command and info item. A record */
      /* starts with '#start' and ends with '#end'.       */
      /*--------------------------------------------------*/
      {
         fgets( message, NCHAR, helpfp );
         if ( strncmp(message, "#start", 6) == 0 )
         {
            char   *mesptr = NULL;
            bool   foundcommand = NO;
            bool   foundinfo    = NO;
            do
            {
               fgets( message, NCHAR, helpfp );
               foundcommand = (strncmp(message, "command:", 8) == 0);
               foundinfo    = (strncmp(message, "info:", 5) == 0);
            }
            while ( !(foundcommand || foundinfo) && !feof(helpfp) );
            if (foundcommand)
               mesptr = strtok(&message[strlen("command:")+1], " \n");
            if (foundinfo)
               mesptr = strtok(&message[strlen("info:")+1], " \n");

            if (mesptr)
            {
               if ( wmatchC(mesptr, command) )
               {
                  bool endrec;
                  prtout( fp, d, " " );
                  purpose( fp, d, mesptr, foundinfo, &helped );
                  do
                  {
                     fgets( message, NCHAR, helpfp );
                     endrec = (strncmp(message, "#end", 4) == 0);
                     if (!endrec)
                     {
                        message[strlen(message)-1] = '\0';  /* Replace newline */
                        prtout( fp, d, message );
                     }
                     else
                        prtout( fp, d, " " );
                  }
                  while (!endrec);
               }
            }
         }
      }
      if (path)
         free( path );
      fclose( helpfp );

      if (!helped)
      {
         (void) sprintf( message, "Sorry, no help match for %s", command );
         anylog( d, command, message );
      }
   }
}





static int setinfo( bool headerok )
/*------------------------------------------------------------*/
/* List set characteristics.                                  */
/*------------------------------------------------------------*/
{
   fint     dev = 1;
   int      i;
   fchar    Dummy1, Dummy2;
   fint     skysys, prosys, velsys;
   char     orientation[20];
   char     typetxt[30];
   char     skytxt[30];
   char     protxt[30];
   char     veltxt[30];
   fint     r;
   fint     colev;


   if (!inset)
   {
      anylog( dev, "setinfo", "No set specified, use 'inset' first!" );
      return( 0 );
   }
   (void) sprintf( message, "===== INFO ABOUT SELECTED AXES FROM [%.*s] =====",
                   nelc_c( Setin ), Setin.a );
   if (!headerok)
      strcat( message, " (Header not complete!)" );
   anyoutC( dev, message );

   fmake( Dummy1, 20 );
   fmake( Dummy2, 20 );
   for (i = 0; i < subdim; i++)
   {
      anyoutC( dev, " " );
      axistype[i] = axtype_c( Ctype[i],
                              Dummy1,       /* Natural units */
                              Dummy2,
                              &skysys,
                              &prosys,
                              &velsys );
      if (i == 0)
         strcpy( orientation, "HORIZONTAL" );
      else
         strcpy( orientation, "VERTICAL  " );

      (void) sprintf( message,
                     "%-15.15s : %s axis from %d to %d",
                      "NAME", strtok( Ctype[i].a, " -" ),
                      flo[i], fhi[i] );
      anyoutC( dev, message );

      axinfo( axistype[i],
              skysys, prosys, velsys,
              typetxt, skytxt, protxt, veltxt );
      (void) sprintf( message, "%-15.15s : %s",
                     "TYPE", typetxt );
      anyoutC( dev, message );

      crota = 0.0;
      if (axistype[i] == 2)    /* spatial axis latitude */
      {
         (void) sprintf( message, "CROTA%d", axnum[i] );
         r = 0;
         gdsd_rdble_c( Setin, tofchar(message), &setlevel, &crota, &r );
         if (r < 0)
            crota = 0.0;
         (void) sprintf( message, "%-15.15s : %g deg.",
                        "MAP-ROTATION", crota );
         anyoutC( dev, message );
      }

      if (strlen(skytxt) > 0)
      {
         (void) sprintf( message, "%-15.15s : %s",
                        "SKY", skytxt );
         anyoutC( dev, message );
      }

      if (strlen(protxt) > 0)
      {
         (void) sprintf( message, "%-15.15s : %s",
                        "PROJECTION", protxt );
         anyoutC( dev, message );
      }

      if (strlen(veltxt) > 0)
      {
         (void) sprintf( message, "%-15.15s : %s",
                        "VELOCITY", veltxt );
         anyoutC( dev, message );
      }

      if (crval[i] != dblank)
      {
         (void) sprintf( message, "%-15.15s : %f (%.*s)",
                        "GRID 0", crval[i], nelc_c(Cunit[i]), Cunit[i].a );

      }
      else
      {
         (void) sprintf( message, "%-15.15s : %s",
                        "GRID 0", "No reference value found in header!");
      }
      anyoutC( dev, message );


      if (drval[i] != dblank)
      {
         (void) sprintf( message, "%-15.15s : %f (%.*s)",
                        "(second axis)", drval[i], nelc_c(Dunit[i]), Dunit[i].a );
         anyoutC( dev, message );
      }
      if (cdelt[i] != dblank)
      {
         (void) sprintf( message, "%-15.15s : %f (%.*s)",
                        "GRID SPACING", cdelt[i], nelc_c(Cunit[i]), Cunit[i].a );
      }
      else
      {
         (void) sprintf( message, "%-15.15s : %s",
                        "GRID SPACING", "No value for grid spacing in header!");
      }
      anyoutC( dev, message );
      if (ddelt[i] != dblank)
      {
         (void) sprintf( message, "%-15.15s : %f (%.*s)",
                        "(second axis)", ddelt[i], nelc_c(Dunit[i]), Dunit[i].a );
         anyoutC( dev, message );
      }
      r = axcoord_c( Setin, &axnum[i], Dummy1, Dummy2, &colev );
      if (r == 0)
      {
         char  trans[20];
         if (colev == 1)
            strcpy( trans, "primary" );
         else
            strcpy( trans, "secondary" );
         (void) sprintf( message, "%-15.15s : Transformations to physical coordinates for %s axis",
                        "TRANSFORMATION", trans );
      }
      else
      {
         (void) sprintf( message, "%-15.15s : No transformation to physical coordinates possible!",
                        "TRANSFORMATION");
      }
      anyoutC( dev, message );
   }
   if (subdim == 2)
   {
       if (axistype[0] == 1 && axistype[1] == 2)
          spatialmap = YES;
       else
          spatialmap = NO;
   }
   else
      spatialmap = NO;

   (void) sprintf( message, "Number of selected subsets: %d", nsubs );
   anyoutC( dev, message );
   (void) sprintf( message, "Current subset index number: %d", subsetindex );
   anyoutC( dev, message );
   return( 1 );
}



static bool getlutGIDS( fint  *Gidsdisplay_id,
                        fint  *lutlen,
                        float *lutr, float *lutg, float *lutb,
                        fint  *GIDSmincol, fint *GIDSmaxcol,
                        fint  *GIDSncolors, fint *GIDSblank,
                        float *GIDSbscale, float *GIDSbzero )
/*------------------------------------------------------------*/
/* Temp. routine to read a colour look up table from GIDS.    */
/* Input is the current device name.                          */
/*------------------------------------------------------------*/
{
   fint   r1;
   fint   display_id;
   bool   opened = NO;
   fint   display_stat;
   fint   GIDSsubset;
   fchar  Errstr;
   fchar  GIDSset;
   fint   GIDSblo[2];
   fint   GIDSbhi[2];


   fmake( Errstr, 80 );

   display_id = gdi_open2_c( tofchar(" ") );     /* open display device */
   if (display_id < 0)
   {
      anylog( 1, "getlut", "Cannot connect to GIDS for colours" );
      anylog( 1, "getlut", "Use VIEW/INIDISPLAY first to get GIDS" );
      return( NO );
   }
   else
      opened = YES;

   r1 = gdi_getlut_c( &display_id, lutr, lutg, lutb, lutlen );
   if (r1 != 0)
   {
      anylog( 1, "getlut", "Cannot get colour look up table from GIDS" );
      r1 = gdi_error_c( &r1, Errstr );
      if (r1 == -61)
      {
         anylog( 1, "getlut", "Unknown GDI error.");
      }
      else
      {
         (void) sprintf( message, "%.*s", nelc_c( Errstr ), Errstr.a );
         anylog( 1, "getlut", message );
      }      
      if (opened)
      {
         r1 = gdi_close_c( &display_id );  /* close display */
         opened = NO;
      }
      return( NO );
   }

   /* Get BSCALE and BZERO from GIDS to scale image data to integers */
   fmake( GIDSset, 256 );
   display_stat = gdi_iinfo2_c( &display_id ,    /* id of display */
                                GIDSset ,        /* name of set */
                                &GIDSsubset ,    /* subset level */
                                GIDSblo,         /* lower left frame boundary */
                                GIDSbhi,         /* upper right frame boundary */
                                GIDSbscale,
                                GIDSbzero );
   if (display_stat < 0)                         /* error obtaining info */
   {
      anylog( 1, "getlut","No image loaded! Use VIEW!" );
      return( NO );
   }

   display_stat = gdi_cinfo_c( &display_id ,    /* id of display */
                               GIDSmincol,      /* Minimum display value for which a color can be assigned. */
                               GIDSmaxcol,
                               GIDSncolors,     /* Number of colors (MAXCOL - MINCOL + 1).*/
                               GIDSblank );     /* Display value reserved for undefined data. */


   if (display_stat < 0)                        /* error obtaining info */
   {
      anylog( 1, "getlut","Cannot obtain the min.& max. colour from GIDS!" );
      return( NO );
   }

   if (opened)
   {
      r1 = gdi_close_c( &display_id );  /* close display */
   }
   *Gidsdisplay_id = display_id;

   /* Give some messages, only in test mode */
   (void) sprintf( message, "allocated colours=%d  bscale=%g  bzero=%g",
                  *lutlen, *GIDSbscale, *GIDSbzero );
   anylog( 16, "getlut", message );
   (void) sprintf( message, "colour indices: [%d,%d], blank index=%d",
                   *GIDSmincol, *GIDSmaxcol, *GIDSblank );
   anylog( 16, "getlut", message );

   return( YES );
}




static int getset( char *params )
/*------------------------------------------------------------*/
/* Get a set and its axis characteristics.                    */
/*------------------------------------------------------------*/
{
   fint     showdev = 16;            /* Device number (as in ANYOUT) for info */
   fint     r;
   int      i, k;


   if (inset)
   {
      /*----------------------------------------------------------------*/
      /* There is a previous set defined now. Store the parameters that */
      /* are needed for an overlay.                                     */
      /*----------------------------------------------------------------*/
      prevset = YES;
      prevcdelt[0] = cdelt[0];
      prevcdelt[1] = cdelt[1];
      prevsubin    = subin[subsetindex];
      for (i = 0; i < (int) nelc_c( Setin ); i++)
         prevSetin.a[i] = Setin.a[i];
      for (; i < prevSetin.l; i++)
         prevSetin.a[i] = SPACE;
      prevax1 = axnum[0] - 1;
      prevax2 = axnum[1] - 1;
      for (k = 0; k < 4; k++)
         prevworldbox[k] = worldbox[k];
   }
   headerok = YES;
   if (strlen(params) != 0)
      dfault = HIDDEN;
   else
      dfault = REQUEST;
   subdim  = 0;                    /* If != 0, allow only 'subdim' dimension */
   Key     = tofchar("INSET=");
   Mes     = tofchar("Give input set (, subsets):");
   str2char( params, Setin );
   nsubs   = gdsinp_c( Setin,      /* Name of input set. */
                       subin,      /* Array containing subsets coordinate words. */
                       &maxsubs,   /* Maximum number of subsets in 'subin'.*/
                       &dfault,    /* Default code as is USERxxx. */
                       Key,        /* Keyword prompt. */
                       Mes,        /* Keyword message for the user. */
                       &showdev,   /* Device number (as in ANYOUT). */
                       axnum,      /* Array of size 'maxaxes' containing the axes numbers. */
                                   /* The first elements (upto the dimension of the subset) */
                                   /* contain the axes numbers of the subset, */
                                   /* the other ones contain the axes numbers */
                                   /* outside the subset ordered according to the */
                                   /* specification by the user. */
                       axcount,    /* Number of grids on axes in 'axnum' */
                       &maxaxes,   /* Max. number of axes. */
                       &class,     /* Class 1 is for applications which repeat */
                                   /* the operation for each subset. */
                       &subdim );  /* Dimensionality of the subsets for class 1 */
   cancel_c( Key );
   if (nelc_c(Setin) == 0)    /* Allow empty string */
   {
      inset   = NO;
      prevset = NO;   /* No previous set */
      return( 1 );
   }
   strcpy( setstring, params );
   setdim      = gdsc_ndims_c( Setin, &setlevel );
   subsetindex = 0;
   inset       = YES;

   /*-------------------------------*/
   /* Determine edges of this frame */
   /*-------------------------------*/
   {
      fint cwlo, cwhi;                          /* Local coordinate words */
      fint r1 = 0, r2 = 0;
      int  m;
      gdsc_range_c( Setin, &setlevel, &cwlo, &cwhi, &r1 );
      r1 = r2 = 0;
      for (m = 0; m < (int) setdim; m++)
      {
         flo[m] = gdsc_grid_c( Setin, &axnum[m], &cwlo, &r1 );
         fhi[m] = gdsc_grid_c( Setin, &axnum[m], &cwhi, &r2 );
      }
   }

   /*-------------------------------*/
   /* Characteristics of this set:  */
   /*-------------------------------*/
   r = 0;
   gdsd_rchar_c( Setin, tofchar("BUNIT"), &setlevel, Bunit, &r );
   if (r < 0)
      strcpy( Bunit.a, "?" );

   for (i = 0; i < subdim; i++)
   {
      (void) sprintf( message, "CTYPE%d", axnum[i] );
      r = 0;
      gdsd_rchar_c( Setin, tofchar(message), &setlevel, Ctype[i], &r );
      if (r < 0)
      {
         strcpy( Ctype[i].a, "?" );
         headerok = NO;
      }


      (void) sprintf( message, "CUNIT%d", axnum[i] );
      r = 0;
      gdsd_rchar_c( Setin, tofchar(message), &setlevel, Cunit[i], &r );
      if (r < 0)
      {
         strcpy( Cunit[i].a, "?" );
         headerok = NO;
      }

      (void) sprintf( message, "CRVAL%d", axnum[i] );
      r = 0;
      gdsd_rdble_c( Setin, tofchar(message), &setlevel, &crval[i], &r );
      if (r < 0)
      {
         crval[i] = dblank;
         headerok = NO;
      }

      (void) sprintf( message, "CDELT%d", axnum[i] );
      r = 0;
      gdsd_rdble_c( Setin, tofchar(message), &setlevel, &cdelt[i], &r );
      if (r < 0)
      {
         cdelt[i] = dblank;
         headerok = NO;
      }

      (void) sprintf( message, "DTYPE%d", axnum[i] );
      r = 0;
      gdsd_rchar_c( Setin, tofchar(message), &setlevel, Dtype[i], &r );
      if (r < 0)
         strcpy( Dtype[i].a, "?" );

      (void) sprintf( message, "DUNIT%d", axnum[i] );
      r = 0;
      gdsd_rchar_c( Setin, tofchar(message), &setlevel, Dunit[i], &r );
      if (r < 0)
         strcpy( Dunit[i].a, "?" );

      (void) sprintf( message, "DRVAL%d", axnum[i] );
      r = 0;
      gdsd_rdble_c( Setin, tofchar(message), &setlevel, &drval[i], &r );
      if (r < 0)
         drval[i] = dblank;

      (void) sprintf( message, "DDELT%d", axnum[i] );
      r = 0;
      gdsd_rdble_c( Setin, tofchar(message), &setlevel, &ddelt[i], &r );
      if (r < 0)
         ddelt[i] = dblank;
   }
   (void) setinfo( headerok );
   return(1);
}



static int plotinfo( void )
/*-----------------------------------------------------------*/
/* List some global plot variables like scale and offset etc.*/
/*-----------------------------------------------------------*/
{
   int  j;
   int  dev = 1;


   anyoutC( dev, "=========== GLOBAL PLOT STATUS =============" );
   if (!devopen)
      (void) sprintf( message, "Device name              :  No device opened" );
   else
      (void) sprintf( message, "Device name              :  %s", curdevnam );
   anyoutC( dev, message );
   (void) sprintf( message, "Box (world coords.)      :  from %g %g  to %g %g",
                   worldbox[0], worldbox[1],
                   worldbox[2], worldbox[3] );
   anyoutC( dev, message );
   (void) sprintf( message, "Current device size      :  from (%g,%g) (mm) to (%g,%g) mm",
                   devx1mm, devy1mm,
                   devx2mm, devy2mm );
   anyoutC( dev, message );
   (void) sprintf( message, "Shift in origin          :  %g x %g mm", Xorgmm, Yorgmm );
   anyoutC( dev, message );
   (void) sprintf( message, "Scales (expression)      :  %s x %s", xscaletxt, yscaletxt );
   anyoutC( dev, message );
   (void) sprintf( message, "Scales in grids/mm       :  %g x %g", Xscale, Yscale );
   anyoutC( dev, message );
   (void) sprintf( message, "Axis margins (mm)        :  %g x %g", gridmargin[0], gridmargin[1] );
   anyoutC( dev, message );
   if (cursor)
      (void) sprintf( message, "Interactive cursor?      :  YES" );
   else
      (void) sprintf( message, "Interactive cursor?      :  NO" );
   anyoutC( dev, message );
   if (world)
      (void) sprintf( message, "Plotting mode            :  world coordinates" );
   else
      (void) sprintf( message, "Plotting mode            :  mm" );
   anyoutC( dev, message );      
   if (overlay)
      (void) sprintf( message, "In overlay mode?         :  YES" );
   else
      (void) sprintf( message, "In overlay mode?         :  NO" );
   anyoutC( dev, message );
   if (interpol)
      (void) sprintf( message, "PGPLOT/PS interpolation? :  YES" );
   else
      (void) sprintf( message, "PGPLOT/PS interpolation? :  NO" );
   anyoutC( dev, message );

   if (world)
   {
      double xmm, ymm;
      (void) sprintf( message, "World or mm mode?        :  World coordinates" );
      anyoutC( dev, message );
      world2mm( currentXY[0], currentXY[1], &xmm, &ymm );
      (void) sprintf( message,
                     "Current pen position     :  %.3f %.3f in world coord. (= %.2f %.2f mm)",
                      currentXY[0], currentXY[1], xmm, ymm );
   }
   else
   {
      (void) sprintf( message, "World or mm mode?        :  Coordinates in mm" );
      anyoutC( dev, message );
      (void) sprintf( message,
                     "Current pen position     :  %.2f %.2f in mm",
                      currentXY[0], currentXY[1] );
   }
   anyoutC( dev, message );
   (void) sprintf( message, "Current angle            :  %g deg", angle );
   anyoutC( dev, message );
   (void) sprintf( message, "Current font             :  %d", font );
   anyoutC( dev, message );
   (void) sprintf( message, "Current char. height     :  %g (mm)", charheight );
   anyoutC( dev, message );
   (void) sprintf( message, "Current text justf.      :  %g", justification );
   anyoutC( dev, message );
   (void) sprintf( message, "Current line style       :  %d", linestyle );
   anyoutC( dev, message );
   (void) sprintf( message, "Current line width       :  %d", linewidth );
   anyoutC( dev, message );
   (void) sprintf( message, "Current values min, max. :  %f %f", minmax[0], minmax[1] );
   anyoutC( dev, message );
   (void) sprintf( message, "Current plot symbol      :  %d", symbol );
   anyoutC( dev, message );
   (void) sprintf( message, "Current Fill-Area style  :  %d", fillareastyle );
   anyoutC( dev, message );
   for (j = 0; j < numlev; j++)
   {
      if (j == 0)
         (void) sprintf( message, "Current levels           :  %g", levels[j] );
      else
         (void) sprintf( message, "%.*s, %g", strlen(message), message, levels[j]);

      if ((strlen(message) > (80-20) ) || (j == numlev-1))
      {
         anyoutC( 3, message );
         (void) sprintf( message, "                         :");
      }
   }
   (void) sprintf( message, "Size of xcolumn, ycolumn :  %d %d", vectsize[XARRAY], vectsize[YARRAY] );
   anyoutC( dev, message );
   return( 1 );
}



static int getposition( fchar Setin, fint subset,
                        fint maxpos,
                        char *params, char **pars, int npar,
                        double *x )
/*------------------------------------------------------------*/
/* If a set is specified, try to convert a physical position  */
/* to a grid. There are several possibilities: A set is not   */
/* available ==> do a double transformation for all parameters*/
/* If a set is available and the subset dimension is 0, then  */
/* a dcddble transformation is applied. If the dim. is 1, then*/
/* all parameters are passed to dcdpos, but only the 1th, 3th */
/* etc. parameters can be physical. The number of 'maxpos'    */
/* must be multiplied by 2 to be able to enter 2-dim positions*/
/* For subset dimensions > 2, there is only the dcddble trans-*/
/* formation.                                                 */
/*------------------------------------------------------------*/
{
   fint     npos = 0;
   int      i;
   int      doset = NO;
   fint     one = 1;
   fint     r, err;



   if (inset)
   {
      subdim = gdsc_ndims_c( Setin, &subset );
      if (subdim == 1 || subdim == 2)
         doset = YES;
   }
   if (doset)
   {
      double *xd;
      if (subdim == 1)
         maxpos *= 2;
      xd = (double *) calloc( maxpos*subdim, sizeof(double) );
      npos = dcdpos_c( Setin, &subset, tofchar(params), xd, &maxpos );
      if (npos >= 0)
      {
         for (i = 0; i < npos * subdim; i++)
            x[i] = xd[i];
         if (subdim == 1)
            npos /= 2;
      }
      else
      {
         poserr( message, npos );
         anylog( 1, "position", message );
      }
      free( xd );
   }
   else
   {
      r = 0;
      for (i = 0; i < MYMIN(npar, 2*maxpos); i++)
      {
         r += dcddble_c( tofchar(pars[i]), &x[i], &one, &err );
         if (err)
            dcderror( err );
      }
      /* Now the position is always 2-dim: */
      npos = r / 2;
   }
   return( npos );
}



static int getminmax( char *mode, fint subset )
/*------------------------------------------------------------*/
/* Get min. and max. of set, set header, xcolumn or ycolumn.  */
/*------------------------------------------------------------*/
{
   fint    r;


   if (strstr(mode, "set") != NULL)
   {
      fint    blo[2];
      fint    bhi[2];
      float   mnmx[2];

      blo[0] = (fint) worldbox[0];
      blo[1] = (fint) worldbox[1];
      bhi[0] = (fint) worldbox[2];
      bhi[1] = (fint) worldbox[3];

      if ( getboxminmax( Setin, subset, blo, bhi, mnmx ) )
      {
         minmax[0] = mnmx[0];
         minmax[1] = mnmx[1];
         return( 1 );
      }
      else
      {
         anylog( 1, "minmax", "Min. or max. is blank!" );
         return( 0 );
      }
   }

   if (strstr(mode, "header") != NULL)
   {
      r = 0;
      gdsd_rreal_c(  Setin,
                     tofchar( "DATAMIN" ),
                     &subset,
                     &minmax[0],
                     &r  );
      if ( r < 0 )
      {
         anylog( 1, "minmax", "Cannot read 'DATAMIN' from header" );
         return( 0 );
      }
      r = 0;
      gdsd_rreal_c(  Setin,
                     tofchar( "DATAMAX" ),
                     &subset,
                     &minmax[1],
                     &r  );
      if ( r < 0 )
      {
         anylog( 1, "minmax", "Cannot read 'DATAMAX' from header" );
         return( 0 );
      }
      return( 1 );
   }

   if (strstr(mode, "xcolumn") != NULL)
   {
      if ((vectsize[XARRAY] == 0) || (vect[XARRAY] == NULL))
      {
         anylog( 1, "minmax", "Empty x column!" );
         return( 0 );
      }
      else
      {
         fint size = (fint) vectsize[XARRAY];
         minmax1_c( vect[XARRAY], &size, &minmax[0], &minmax[1] );
      }
      return( 1 );
   }

   if (strstr(mode, "ycolumn") != NULL)
   {
      if ((vectsize[YARRAY] == 0) || (vect[YARRAY] == NULL))
      {
         anylog( 1, "minmax", "Empty y column!" );
         return( 0 );
      }
      else
      {
         fint size = (fint) vectsize[YARRAY];
         minmax1_c( vect[YARRAY], &size, &minmax[0], &minmax[1] );
      }
      return( 1 );
   }

   if (strstr(mode, "eycolumn") != NULL)
   {
      if ((vectsize[EYARRAY] == 0) || (vect[EYARRAY] == NULL))
      {
         anylog( 1, "minmax", "Empty y error column!" );
         return( 0 );
      }
      else
      {
         fint size = (fint) vectsize[EYARRAY];
         minmax1_c( vect[EYARRAY], &size, &minmax[0], &minmax[1] );
      }
      return( 1 );
   }

   if (strstr(mode, "excolumn") != NULL)
   {
      if ((vectsize[EXARRAY] == 0) || (vect[EXARRAY] == NULL))
      {
         anylog( 1, "minmax", "Empty x error column!" );
         return( 0 );
      }
      else
      {
         fint size = (fint) vectsize[EXARRAY];
         minmax1_c( vect[EXARRAY], &size, &minmax[0], &minmax[1] );
      }
      return( 1 );
   }
   return( 1 );
}



static int createarray( int       npar,        /* Number of arguments */
                        char    **pars,        /* Array with all the arguments */
                        char     *allparams,   /* Same but in one string */
                                               /* e.g. a math. expression */
                        floatptr *arrayptr,    /* Pointer to the data */
                        int      *Asize,       /* Size of this array */
                        int       aindx )      /* Array index */
/*------------------------------------------------------------*/
/* Argument can be a filename. If the file cannot be opened,  */
/* it must be an expression. The expression can contain a     */
/* known column name. This name is used as an variable.       */
/*------------------------------------------------------------*/
{
   int       i;
   FILE      *fp;
   int       r;
   int       size = MAXBUF;
   floatptr  data = *arrayptr;
   fint      colnr = 1;



   if (npar == 0)
   {
      anylog( 1, "Vectors", "vector with no arguments!" );
      return( NO );
   }

   fp = fopen( pars[0], "r" );                    /* Is first arg. a file? */
   if (fp != NULL)
   {
      if (data != NULL)
         free( data );
      data = (float *) calloc( size, sizeof(float) );
      if (data == NULL)
      {
         anylog( 1, "VECTORS", "Cannot allocate memory for this column!" );
         *Asize = 0;
         fclose( fp );
         return( NO );
      }
      if (npar == 2)                              /* File name and column number */
      {
         fint    r;
         fint    one = 1;
         fint    err;
         r = dcdint_c( tofchar(pars[1]), &colnr, &one, &err );
         if (err)
            dcderror( err );
         if (r != 1)
            colnr = 1;
      }

      i = 0;
      while (!feof(fp))
      {
         fgets( message, NCHAR, fp );
         if ( cleanstr(message) )
         {
            if (colnr != 1)
            {
               int  k = 0;
               int  col = 0;
               int  found = NO;
               while ((message[k] != '\0') && (k < NCHAR) && (!found))
               {
                  while ((message[k] == SPACE) || (message[k] == COMMA)) k++;
                  if (message[k])
                  {
                     col++;                             /* A column is found */
                     r = sscanf( &message[k], "%f", &data[i] );
                     if ((col == colnr) && (r == 1))
                     {
                        i++;                            /* Store data value */
                        found = YES;
                     }
                     else if (!found)
                     {
                        while ((message[k] != SPACE)      /* Next field */
                            && (message[k] != '\0')
                            && (message[k] != COMMA)) k++;
                     }
                  }
               }
            }
            else
            {
               r = sscanf( message, "%f", &data[i] );     /* No column specified */
               if (r == 1) i++;
            }
         }
         if (!(i%MAXBUF))                                 /* More space needed ? */
         {
            size += MAXBUF;
            data = realloc( data, size*sizeof(float) );
            if (data == NULL)
            {
               anylog( 1, "VECTORS", "Cannot allocate memory for this column!" );
               *Asize = 0;
               fclose( fp );
               return( NO );
            }
         }
      } /* End reading file */
      size = i;
      if (size == 0)                                      /* Nothing converted */
      {
         sprintf( message, "Column number %d is empty!", colnr );
         anylog( 1, "VECTORS", message );
      }
      *Asize = size;
      *arrayptr = data;
      fclose( fp );
      return( YES );
   }
   else                                 /* No filename -> this is an expression */
   {
      fint  fieid;
      fint  errpos;
      fint  varindex;

      /* Initialization of the variable names is done in main. */

      /* Evaluate the 'allparams' string. This string can contain an */
      /* expression with spaces. */

      varindex = fieini_c( tofchar(allparams), &fieid, &errpos );

      /*----------------------------------------------------------*/
      /* 'varindex' is largest parameter number in expression.    */
      /* This number of parameters must be present in FIEDO.      */
      /* if 'varindex' is 0, then there are no parameters in the  */
      /* expression. But fieini detects a syntax error first. If  */
      /* we want to use the syntax for the dcd*** routines also,  */
      /* try dcdreal as soon as 'varindex' < 0.                   */
      /*----------------------------------------------------------*/

      if (varindex <= 0)
      {
         /* Expression without a parameter */
         fint    err;
         fint    numconv;
         fint    dcdsize = (fint) size;

         if (data != NULL)
            free( data );
         data = (float *) calloc( size, sizeof(float) );
         if (data == NULL)
         {
            anylog( 1, "VECTORS", "Cannot allocate memory for this column!" );
            *Asize = 0;
            return( NO );
         }
         /* This is an expression without a parameter, use dcdreal */
         do
         {
            err = 0;
            numconv = dcdreal_c( tofchar(allparams), data, &dcdsize, &err );
            if (err == -23)
            {
               dcdsize += MAXBUF;                /* Error code, see HERINP.DC2 */
               data = realloc( data, dcdsize*sizeof(float) );
               if (data == NULL)
               {
                  anylog( 1, "VECTORS", "Cannot allocate memory for this column!" );
                  *Asize = 0;
                  return( NO );
               }
            }
         } while (err == -23);
         dcdsize = numconv;

         if (err)
         {
            anylog( 1, "VECTORS", "Argument is not a filename or valid expression!" );
            dcderror( err );
            return( NO );
         }
         else
         {
            *Asize = dcdsize;
            *arrayptr = data;
            return( YES );
         }
      }
      else
      /*--------------------------------------------------*/
      /* This is option for which we have to call 'fiedo' */
      /* There are 30 variables. These are all associated */
      /* with an array which must be copied in a bigger   */
      /* array for 'fiedo'.                               */
      /* What are the rules? If the elements of the       */
      /* mathematical expression represent a vector, then */
      /* different vectors must have equal lengths, other-*/
      /* wise an error is returned.                       */
      /*--------------------------------------------------*/
      {
         float *indata = NULL;
         fint  maxsize = 0;
         int   inlen;
         fint  outlen;
         int   n;
         fint  nvars;
         char  varbuf[MAXVAR*MAXVARLEN];
         fchar Vars[MAXVAR];


         /* Get the variables from the expression */
         {
            int         k;
            fint        r;
            fint        csize = MAXVARLEN;
            char        exprO[MAXEXPRLEN];
            char        derv[10*MAXEXPRLEN];
            fchar       ExprO;
            fchar       Derv;

            ExprO.a = exprO;
            ExprO.l = MAXEXPRLEN-1;
            Derv.a  = derv;
            Derv.l  = 10*MAXEXPRLEN-1;
            for (k = 0; k < ABC+SPECIALCOL; k++)
            {
               Vars[k].a = &varbuf[k*MAXVARLEN];
               Vars[k].l = MAXVARLEN;
            }
            r = dydx_c( tofchar(allparams),      /* The expression */
                        tofchar("R"),   /* Just a variable */
                        ExprO,          /* DYDX's interpretation of Expr.*/
                        Derv,           /* derivative of Expr */
                        Vars[0],        /* names of constants appearing in Expr */
                        &csize,         /* Input max. size of a variable string. */
                        &nvars );       /* number of variables found.*/
            if (r != 0 )
               nvars = 0;
            else
            {
               for(k = 0; k < nvars; k++)
                  Vars[k].a[nelc_c(Vars[k])] = '\0';  /* Make C-strings */
            }
         }

         if (nvars == 0)
         {
            anylog( 1, "VECTORS", "No valid variables in expression" );
            return( NO );
         }


         /* Check whether variables correspond with non empty arrays */

         maxsize = 0;
         for (n = 0; n < ABC + SPECIALCOL; n++)
         {
            int    h;
            int    found = NO;
            for (h = 0; h < nvars; h++)
            {
               if (equalstrings( vectname[n], Vars[h].a, CASEINSENSITIVE ))
               {
                  found = YES;
                  break;
               }
            }
            if (found)
            {
               /* This is a vector name which is included in the */
               /* expression. If it is empty, return with an error */
               /* message. Else, its length can determine the maximum */
               /* array length of the new vector. */
               if (vectsize[n] == 0)
               {
                  char errmes[20];
                  sprintf( errmes, "%s is empty", vectname[n] );
                  anylog( 1, "VECTORS", errmes );
                  return( NO );
               }
               else
               {
                  /* First array with length != 0 */
                  if (maxsize == 0)
                     maxsize = vectsize[n];
                  else
                  {
                     /* Does next array have same length? */
                     if (vectsize[n] != maxsize)
                     {
                        anylog( 1, "VECTORS", "Not all vectors have the same length" );
                        return( NO );
                     }
                  }
               }
            }
         }

         if (maxsize == 0)
         {
            anylog( 1, "VECTORS", "No valid vectors found in expression" );
            return( NO );
         }
         /* Can we allocate enough space for the arrays ? */
         inlen = (ABC+SPECIALCOL) * maxsize;
         outlen = maxsize;
         indata = (float *) calloc( inlen, sizeof(float) );
         if (indata == NULL)
         {
            anylog( 1, "VECTOR", "Cannot allocate memory for calculation array!" );
            return( NO );
         }

         /* Now fill the input array. Each part of the array has length 'outlen' */
         /* The total length is 'inlen' */

         for (n = 0; n < ABC + SPECIALCOL; n++)
         {
            int    h;
            int    found = NO;
            for (h = 0; h < nvars; h++)
            {
               if (equalstrings( vectname[n], Vars[h].a, CASEINSENSITIVE ))
               {
                  found = YES;
                  break;
               }
            }
            if (found)
            {
               int   k;
               for (k = 0; k < outlen; k++)
                  indata[(n*outlen)+k] = vect[n][k];
            }
         }

         if (data != NULL)
            free( data );
         /* array can be freed because needed data is copied now. */
         data = (float *) calloc( outlen, sizeof(float) );
         if (data == NULL)
         {
            anylog( 1, "VECTOR", "Cannot allocate memory for this column!" );
            *Asize = 0;
            return( NO );
         }

         /* Calculate the output as function of the input array(s) */

         r = fiedo_c( indata, &outlen, data, &fieid );
         free( indata );          /* There is no use for this calculation column anymore */
         fieclr_c( &fieid );
         if (r == 0)              /* Success */
         {
            *Asize = outlen;
            *arrayptr = data;
            return( YES );
         }
         else
         {
            anylog( 1, "VECTORS", "Could not calculate the column!" );
            *Asize = 0;
         }
      }
   }
   return( NO );
}



static int  getoverlaybox( fchar Originalset, fint origsubset,
                           fchar Overlayset,  fint oversubset,
                           double *worldboxin, double *worldboxout )
/*------------------------------------------------------------*/
/* Create default box for overlays.                           */
/*------------------------------------------------------------*/
{
   fint    phys2grid = 0;
   fint    grid2phys = 1;
   fint    r1, r2;
   fint    overcwlo, overcwhi;
   double  GridXY[MAXAXES];
   double  PhysXY[MAXAXES];
   double  DumXY[MAXAXES];
   fint    overflo[2], overfhi[2];
   int     i;
   fint    iax;
   fint    grid;
   double  overblo[2], overbhi[2];
   double  origblo[2], origbhi[2];
   fint    origindex[2];
   fint    overindex[2];
   fint    origaxis[2];
   fint    overaxis[2];
   int     agreed;
   fint    setdim;
   fint    setlevel = 0;


   setdim = gdsc_ndims_c( Originalset, &setlevel );
   i = 0;
   for (iax = 1; iax <= setdim; iax++)
   {
      r1 = 0;
      grid = gdsc_grid_c( Originalset, &iax, &origsubset, &r1 );
      if (r1 < 0)
      {
         origaxis[i] = iax;                        /* Undefined axis, must be a subset axis */
         origindex[i++] = iax-1;
      }
   }
   setdim = gdsc_ndims_c( Overlayset, &setlevel );
   i = 0;
   for (iax = 1; iax <= setdim; iax++)
   {
      r1 = 0;
      grid = gdsc_grid_c( Overlayset, &iax, &oversubset, &r1 );
      if (r1 < 0)
      {
         overaxis[i] = iax;                        /* Undefined axis, must be a subset axis */
         overindex[i++] = iax-1;
      }
   }

   for (i = 0; i < 2; i++)
   {
      origblo[i] = worldboxin[i];
      origbhi[i] = worldboxin[i+2];
   }

   GridXY[0]  = origblo[0];
   GridXY[1]  = origblo[1];
   r1 = cotrans_c( Originalset, &origsubset, GridXY, DumXY, &grid2phys);
   if (r1 != 0)
      return( r1 );
   PhysXY[0]  = DumXY[origindex[0]];
   PhysXY[1]  = DumXY[origindex[1]];
   r1 = cotrans_c( Overlayset, &oversubset, PhysXY, GridXY, &phys2grid );
   if (r1 != 0)
      return( r1 );
   overblo[0] = GridXY[overindex[0]];
   overblo[1] = GridXY[overindex[1]];
   GridXY[0]  = origbhi[0];
   GridXY[1]  = origbhi[1];
   r1 = cotrans_c( Originalset, &origsubset, GridXY, DumXY, &grid2phys);
   if (r1 != 0)
      return( r1 );
   PhysXY[0]  = DumXY[origindex[0]];
   PhysXY[1]  = DumXY[origindex[1]];
   r1 = cotrans_c( Overlayset, &oversubset, PhysXY, GridXY, &phys2grid );
   if (r1 != 0)
      return( r1 );
   overbhi[0] = GridXY[overindex[0]];
   overbhi[1] = GridXY[overindex[1]];

   r1 = 0;
   gdsc_range_c( Overlayset, &setlevel, &overcwlo, &overcwhi, &r1 );
   for (i = 0; i < 2; i++)
   {
      r1 = r2 = 0;
      overflo[i] = gdsc_grid_c( Overlayset, &overaxis[i], &overcwlo, &r1 );
      overfhi[i] = gdsc_grid_c( Overlayset, &overaxis[i], &overcwhi, &r2 );
   }

   overbhi[0] = NINT( MYMIN( overbhi[0], overfhi[0] ) );
   overbhi[1] = NINT( MYMIN( overbhi[1], overfhi[1] ) );
   overblo[0] = NINT( MYMAX( overblo[0], overflo[0] ) );
   overblo[1] = NINT( MYMAX( overblo[1], overflo[1] ) );
   agreed = (  (overbhi[0] >= overblo[0]) && (overbhi[1] >= overblo[1]) );
   if (!agreed) return( -1 );
   for (i = 0; i < 2; i++)
   {
      worldboxout[i]   = overblo[i];
      worldboxout[i+2] = overbhi[i];
   }
   return( 0 );
}



static int okbox( double *box )
/*------------------------------------------------------------*/
/* Is this a valid box?                                       */
/*------------------------------------------------------------*/
{
   int      iret = 1;


   if (box[0] == box[2])
   {
      anylog( 1, "okbox", "Not a valid box: xlo == xhi" );
      iret = 0;
   }
   if (box[1] == box[3])
   {
      anylog( 1, "okbox", "Not a valid box: ylo == yhi" );
      iret = 0;
   }
   return(iret);
}



static void setcharhei( double charhei )
/*------------------------------------------------------------*/
/* Set character height given in mm.                          */
/* 'charmm' is the height of one character.                   */
/*------------------------------------------------------------*/
{
   float ch = fabs( charhei ) / charmm;   /* Convert to a ratio */
   pgsch_c( &ch );                        /* Set new height */
}



static void setupmm( double *x1mm, double *x2mm,
                     double *y1mm, double *y2mm )
/*------------------------------------------------------------*/
/* Set viewport to the dimensions of total available view     */
/* surface.                                                   */
/*------------------------------------------------------------*/
{
   fint   mm = 2;
   float  nx1 = 0.0, nx2 = 1.0, ny1 = 0.0, ny2 = 1.0;
   float  x1, x2, y1, y2;

   pgsvp_c( &nx1, &nx2, &ny1, &ny2 );
   pgqvp_c( &mm, &x1, &x2, &y1, &y2 );
   pgswin_c( &x1, &x2, &y1, &y2 );
   *x1mm = (double) x1;
   *x2mm = (double) x2;
   *y1mm = (double) y1;
   *y2mm = (double) y2;

   /*---------------------------------------------------------------*/
   /* First command is always "device". Then this routine is called */
   /* to get the device sizes. After this the scales gets a default */
   /* value and world2mm can be called. So 'world' must be false if */
   /* this routine is called the first time, otherwise the scales   */
   /* are zero and world2mm could not convert to mm.                */
   /*---------------------------------------------------------------*/

   if (world)
   {
      double  xmm, ymm;
      world2mm( currentXY[0], currentXY[1], &xmm, &ymm );
      /* Move to the last cursor position: */
      plmove( xmm, ymm );
   }
}



static bool convert( double *val, char *units, int ax )
/*------------------------------------------------------------*/
/* Convert an axis value to different units. The units must   */
/* be compatible with the current axis units (inset == YES).  */
/*------------------------------------------------------------*/
{
   fint    r;
   double  cfact;
   double  result;

   result = *val;
   if (!inset)
      return(NO);                 /* No set: return */
   if (strlen(units) == 0)
      return(YES);                /* No units, return input value */
   r = factor_c( tofchar(units), Cunit[ax], &cfact );
   if (r == 0)
   {
      result *= cfact/cdelt[ax];
   }
   else
   {
      r = factor_c( tofchar(units), Dunit[ax], &cfact );
      if (r == 0)
      {
         /* Conversion is possible */
         result *= cfact/ddelt[ax];
      }
      else
      {
         /* Second try: Cunit is DEGREE but scale units are time. */
         if ((strstr( Cunit[ax].a, "DEGREE") != NULL ) &&
             (factor_c( tofchar(units), tofchar("HOUR") , &cfact ) == 0))
         {
             /* Convert to hours and then degrees */
             result *= 15.0 * (cfact/cdelt[ax]);
         } else
             return( NO );
      }
   }
   *val = result;
   return(YES);
}



static int pgready( double *wbox )
/*------------------------------------------------------------*/
/* Check whether a plot device is already opened.             */
/*------------------------------------------------------------*/
{
   int   iret;


   if (!devopen)
   {
      anylog( 1, "warning", "No device selected! Use command 'device' first.");
      iret = NO;
   }
   else
   {
      if (okbox(wbox))
         iret = YES;
      else
         iret = NO;
   }
   return( iret );
}



static int setbox( double *wbox )
/*------------------------------------------------------------*/
/* Set viewport to new box.                                   */
/*------------------------------------------------------------*/
{
   double  xmm[4];
   float   xin[4];
   float   w[4];
   int     i;


   if (!pgready(wbox))
      return( 0 );

   for (i = 0; i < 4; i++)
      worldbox[i] = wbox[i];

   xmm[0] = Xorgmm;
   xmm[1] = Yorgmm;
   world2mm( worldbox[2], worldbox[3], &xmm[2], &xmm[3] );
   for (i = 0; i < 4; i++)
   {
      xin[i] = (float) (xmm[i]/25.4);                /* convert mm to inches */
      w[i] = worldbox[i];
   }

   /*----------------------------------------------------------*/
   /* Change the size and position of the viewport, specifying */
   /* the viewport in physical device coordinates (inches).    */
   /*----------------------------------------------------------*/
   plvsiz( xin[0], xin[2], xin[1], xin[3] );
   pgswin_c( &w[0], &w[2], &w[1], &w[3] );

/*   world = YES;*/
   return(1);
}



static int getGIDSset( char *command )
/*------------------------------------------------------------*/
/* Check whether a GIDS window is open and a set is displayed.*/
/* Get info about size and position of the displayed image.   */
/* Calculate the offset (from lower left corner) in mm        */
/*------------------------------------------------------------*/
{
   fint         display_stat;                       /* display operation status */
   fint         setdim;
   fint         iax;
   fint         r1, r2;
   int          i;
   fint         grid;
   fchar        Axisname;
   fint         GIDSdisplay_id = -1;                /* id of display */
   fchar        GIDSset;
   fint         GIDSsubset;
   fint         GIDSblo[2];
   fint         GIDSbhi[2];
   float        GIDSflo[2];                         /* Corners of GIDS area */
   float        GIDSfhi[2];
   double       testbox[4];


   GIDSdisplay_id = gdi_open_c( tofchar(" ") );     /* open display device */
   if (GIDSdisplay_id < 0)                          /* error opening display */
   {
      anylog( 1, command, "Could not open display!");
      return( 0 );
   }
   fmake( GIDSset, 128 );
   display_stat = gdi_iinfo_c( &GIDSdisplay_id ,    /* id of display */
                               GIDSset ,            /* name of set */
                               &GIDSsubset ,        /* subset level */
                               GIDSblo,             /* lower left frame boundary */
                               GIDSbhi );           /* upper right frame boundary */

   if (display_stat < 0)                            /* error obtaining info */
   {
      anylog( 1, command, "No image loaded! Use application VIEW!");
      return( 0 );
   }
   if (gdsc_ndims_c( GIDSset, &GIDSsubset ) != 2)
   {
      anylog( 1, command, "Wrong dimension of set in GIDS!");
      return( 0 );
   }
   (void) sprintf( message, "Displayed set [%.*s]",
                   nelc_c(GIDSset), GIDSset.a );
   anylog( 1, command, message );
   (void) sprintf( message, "Box: [%d %d %d %d]",
                   GIDSblo[0], GIDSblo[1], GIDSbhi[0], GIDSbhi[1] );
   anylog( 1, command, message );


   (void) sprintf( message, "%.*s", nelc_c(GIDSset), GIDSset.a);
   setdim = gdsc_ndims_c( GIDSset, &setlevel );
   i = 0;
   fmake( Axisname, FITSLEN );
   for (iax = 1; iax <= setdim; iax++)
   {
      r1 = 0;
      grid = gdsc_grid_c( GIDSset, &iax, &GIDSsubset, &r1 );
      if (r1 >= 0)
      {
         r2 = 0;
         gdsc_name_c( Axisname, GIDSset, &iax, &r2 );
         (void) sprintf( message, "%.*s %s %d",
                         strlen(message), message,
                         strtok( Axisname.a , " -" ), grid );
      }
   }
   (void) getset( message );

   r1 = gdi_frame_c( &GIDSdisplay_id ,    /* id of display */
                     GIDSflo,             /* lower left frame boundary of total GIDS area... */
                     GIDSfhi );           /* ...  in (floating) grids */

   if (r1 != 0)
   {
      (void) sprintf( message,
                     "Cannot obtain info about frame currently on display! (err=%d)", r1 );
      anylog( 1, command, message );
      return( 0 );
   }
   display_stat = gdi_close_c( &GIDSdisplay_id );   /* close display */

   /*------------------------------------------------------------------*/
   /* The displayed box is given in GIDSblo/bhi, but the GIDS frame is */
   /* stored in GIDSflo/fhi. Therefore we can calculate a new scale    */
   /* with flo/fhi and the device size in mm (of currently selected    */
   /* device) and an offset with blo and flo and the new determined    */
   /* scale.                                                           */
   /*------------------------------------------------------------------*/

   testbox[0] = (double)GIDSblo[0];
   testbox[1] = (double)GIDSblo[1];
   testbox[2] = (double)GIDSbhi[0];
   testbox[3] = (double)GIDSbhi[1];

   /*------------------------------------------------------------*/
   /* If GIDS image is only one pixel in height or width,        */
   /* increase box with +/- 0.5.                                 */
   /*------------------------------------------------------------*/
   if (testbox[0] == testbox[2])
   {
      testbox[0] -= 0.5;
      testbox[2] += 0.5;
   }
   if (testbox[1] == testbox[3])
   {
      testbox[1] -= 0.5;
      testbox[3] += 0.5;
   }

   i = 1;
   if (okbox(testbox))
   {
      i = setbox( testbox );
      Xscale = ((double)GIDSfhi[0] - (double)GIDSflo[0]) / (devx2mm - devx1mm);
      Yscale = ((double)GIDSfhi[1] - (double)GIDSflo[1]) / (devy2mm - devy1mm);
      Xorgmm = devx1mm + (testbox[0] - (double)GIDSflo[0]) / Xscale;
      Yorgmm = devy1mm + (testbox[1] - (double)GIDSflo[1]) / Yscale;
      execom( "world", "" );     /* Always change to 'world coordinates' mode */
   }
   return( i );
}



static int device( int npar, char *devname,
                   fint nsubx, fint nsuby )
/*------------------------------------------------------------*/
/* Open a plot device.                                        */
/*------------------------------------------------------------*/
{
   fint          r;
   char          *tmpname;


   cursor = NO;                          /* Is interactive graphics possible? */
   if (devopen)                          /* Device still open, so close first */
      pgend_c( );
   if (npar < 3)
      nsuby = 1;
   if (npar < 2)
      nsubx = 1;

   if (npar == 0)
   {
      tmpname = malloc( 2 );
      strcpy( tmpname, "?" );
   }
   else
   {
      tmpname = malloc( strlen(devname)+1 );
      strcpy( tmpname, devname );
   }

   /*r = pgbeg_c( &unit, tofchar(tmpname), &nsubx, &nsuby );*/
   r = pgopen_c( tofchar(tmpname) );
   if (r <= 0)
   {
      anylog( 1, "device", "no access to plot device" );
      devopen = NO;
   }


#ifdef KJKJKJKKJK
   if (r != 1)
   {
       /* Device is valid but will not open; give message and abort task */
       anylog( 1, "device", "no access to plot device" );
       devopen = NO;
   }
#endif
   else
   {
      fchar  Infostr;
      fint   flen = STRLEN;
      fmake( Infostr, STRLEN );

      devopen = YES;
      strcpy( curdevnam, tmpname );
      /* Set viewport to the dimensions of total available view surface.*/
      setupmm( &devx1mm, &devx2mm, &devy1mm, &devy2mm );
      if (world)
         r = execute( "world", "\0", NULL, 0 );

      pgqinf_c( tofchar("TYPE"), Devtype, &flen );

      pgqinf_c( tofchar("CURSOR"), Infostr, &flen );
      if (toupper(Infostr.a[0]) == 'Y')
      {
         cursor = YES;
         pgqinf_c( tofchar("TYPE"), Infostr, &flen );
         if (strncmp( Infostr.a, "TEK4010", 7 ) == 0)
         {
            cursor = NO;
            anylog( 1, "DEVICE","Device has interactive graphics but cursor routines do" );
            anylog( 1, "DEVICE","not work properly. To use interactive graphics, please" );
            anylog( 1, "DEVICE","select other device (f.i.GIDS)" );
         }
      }
      pgsubp_c( &nsubx, &nsuby );
   }
   cancel_c(tofchar("GRDEVICE="));

   free( tmpname );
   return( devopen );
}


static int clist( char **pars, int npar, char *command )
/*------------------------------------------------------------*/
/* PURPOSE: Print contents of columns.                        */
/*------------------------------------------------------------*/
{
   int   i;
   int   maxlen;
   int   printcol[ABC+4];
   int   numcols = 0;
   int   row, col;
   char  message[MAXVAR*20];


   for (i = 0; i < ABC+SPECIALCOL; i++)
      printcol[i] = NO;

   maxlen = 0;
   message[0] = '\0';
   for (i = 0; i < npar; i++)
   {
      int   k;
      for (k = 0; k < ABC+SPECIALCOL; k++)
      {
         if (equalstrings( vectname[k], pars[i], CASEINSENSITIVE ))
         {
            char   buf[20];
            printcol[i] = k;
            numcols++;
            if (vectsize[k] > maxlen)
            maxlen = vectsize[k];
            sprintf( buf, "%15s   ", vectname[k] );          /* Format first */
            strcat( message, buf );
         }
      }
   }

   if (numcols == 0)
   {
      anylog( 1, command, "No valid column names entered!" );
      return( 0 );
   }

   if (maxlen == 0)
   {
      anylog( 1, command, "Array length(s) 0" );
      return( 0 );
   }

   /* Prefix with comment marker */
   message[0] = '!';
   anyoutC( 1, message );
   for (row = 0; row < maxlen; row++)
   {
      message[0] = '\0';

      for (col = 0; col < numcols; col++)
      {
         int k = printcol[col];
         char    sbuf[25];

         if (row < vectsize[k])
         {
            float   val;
            val = vect[k][row];
            if (val != blank)
               sprintf( sbuf, "%15g   ", val );
            else
               sprintf( sbuf, "%15s   ", "blank" );
         }
         else
         {
            sprintf( sbuf, "%15s   ", " - " );
         }
         strcat( message, sbuf );
      }
      anyoutC( 1, message );
   }
   return( 1 );
}





static void icursor( fint  mode,
                     float *xpos,
                     float *ypos,
                     char  *stat,
                     char  *command )
/*------------------------------------------------------------*/
/* PURPOSE: Start the interactive plot cursor.                */
/*------------------------------------------------------------*/
{
   fchar   Ch;
   int     exit = NO;
   fint    one  = 1;
   float   xref = *xpos;
   float   yref = *ypos;
   fint    posn = 1;


   fmake( Ch, 1 );
   while (!exit)
   {
      char    upchr;
      anyoutf( 1, "Option = %d", mode );
      pgband_c( &mode, &posn, &xref, &yref, xpos, ypos, Ch );
      upchr = toupper(Ch.a[0]);
      exit = (upchr == 'Q');
      if (!exit)
      {
         (void) sprintf( message, "<Q=quit,M=mark> Pos: %10.2f %10.2f (%s)",
                         *xpos, *ypos, stat );
         anylog( 1, command, message );
         if (upchr == 'M')
            pgpt_c( &one, xpos, ypos, &symbol );
         else
         {
            if (upchr >= 'A' && upchr <= 'Z')
            /*-------------------------------------------------*/
            /* The purpose of this option is to prepare a text */
            /* and use it as a GPLOT command or macro.         */
            /*-------------------------------------------------*/
            {
               int  k = (int) (upchr - 'A');
               char mess1[1024];                   /* Arbitrary (big) size */
               char mess2[1024];                   /* Arbitrary (big) size */
               if (formatstr[k])
               {
                  (void) sprintf( mess1, formatstr[k],
                                  *xpos, *ypos, *xpos, *ypos,
                                  *xpos, *ypos, *xpos, *ypos );
                  (void) sprintf( mess2, "COMMAND=%s; cursor", mess1 );
                  wkey_c( tofchar(mess2) );
                  exit = YES;
                  if (Ch.a[0] == upchr)   /* Shift key is pressed, edit com. */
                     editcom = YES;
               }
               else
                  anylog( 1, command, "Key not defined!" );
            }
         } /* Not the 'M' or 'Q' keys */
      } /* Exit from loop? */
   }
}




extern int execute( char *command, char *params,
                    char **pars, int npar )
/*------------------------------------------------------------*/
/* Do the actual command processing.                          */
/* command: Name of current command.                          */
/* params:  String with all parameters                        */
/* pars:    List with 'npar' strings                          */
/*------------------------------------------------------------*/
{
   static int    first = 1;
   static int    firstdevice = YES;
   int           iret;                              /* Savestatus of command */
   int           i = 0;
   fint          r = 0;
   fint          err;
   fint          one = 1;
   char          *dummypar;

   /*------------------------------------------------*/
   /* If first command is not a device command, ask  */
   /* device specification and preset graphics imme- */
   /* deately. This preset is only done once. If how-*/
   /* ever, the first command is a 'device' command  */
   /* execute it and (p)reset graphics.              */
   /* Note: for the preset function, a device must   */
   /* already be opened.                             */
   /*------------------------------------------------*/
   if (first)
   {
      first = 0;    /* avoid endless loop in recursion because of static int first */
      if (strncmp( command, "devic", 5 ) != 0)
      {
          execute( "device", "", &dummypar, 0 ); /* Start asking destination of the plot */
          preset();
          firstdevice = NO;
      }
   }


   if (!strcmp(command,"angle"))                                 /* set angle */
   {
      if (npar == 0)
      {
         (void) sprintf( message, "Current value of angle  = %g (deg)", angle );
         anylog( 1, "inquiry", message );
         return( 1 );
      }
      else
      {
         r = dcddble_c( tofchar(pars[0]), &angle, &one, &err );
         if (r != 1)
         {
            anylog( 1, command, "Cannot convert angle!" );
            return( 0 );
         }
      }
      return( 1 );
   }



   if (!strcmp(command,"arrow"))
   {
      double  dummy[4];

      fint    maxpos = 2;
      if (!pgready(worldbox))
         return( 0 );

      if (npar == 0)
         return( 0 );

      {
         r = getposition( Setin, subin[subsetindex], maxpos,
                          params, pars, npar, dummy );
         if (r == 0)
            return( 0 );
      }
      {
         float x1, y1, x2, y2;
         if (r == 1)
         {
            x1 = (float) currentXY[0]; y1 = (float) currentXY[1];
            x2 = (float) dummy[0];     y2 = (float) dummy[1];
         }
         else
         {
            x1 = (float) dummy[0]; y1 = (float) dummy[1];
            x2 = (float) dummy[2]; y2 = (float) dummy[3];
         }
         pgarro_c( &x1, &y1, &x2, &y2 );
         /* Make end point the current plot position */
         currentXY[0] = x2;
         currentXY[1] = y2;
      }
      return( 1 );
   }



   if (!strcmp(command,"arstyle"))
   {
      fint   fs;
      float  angle, barb;

      if (!pgready(worldbox))
         return( 0 );

      if (npar == 0)
      {
         pgqah_c( &fs, &angle, &barb );
         if (fs == 1)
            sprintf( message, "arrow fill style: filled" );
         else
            sprintf( message, "arrow fill style: outline" );
         anylog( 1, "inquiry", message );
         sprintf( message, "Acute angle of the arrow point: %g (deg)", angle );
         anylog( 1, "inquiry", message );
         sprintf( message, "Arrow-head cut away fraction: %g", barb );
         anylog( 1, "inquiry", message );

      }
      /* set defaults */
      fs = 1; angle = 45.0; barb = 0.3;
      if (npar >=1)
      {
         fint    dummy;
         r = dcdint_c( tofchar(pars[0]), &dummy, &one, &err );
         if (r != 1)
         {
            anylog( 1, command, "Cannot convert value for fill style!" );
            return( 0 );
         }
         else
         {
           fs = dummy;
         }
      }
      if (npar >= 2)
      {
         float dummy;
         r = dcdreal_c( tofchar(pars[1]), &dummy, &one, &err );
         if (r != 1)
         {
            anylog( 1, command, "Cannot convert value for angle!" );
            return( 0 );
         }
         else
         {
           angle = dummy;
         }
      }
      if (npar >= 3)
      {
         float dummy;
         r = dcdreal_c( tofchar(pars[2]), &dummy, &one, &err );
         if (r != 1)
         {
            anylog( 1, command, "Cannot convert value for barb!" );
            return( 0 );
         }
         else
         {
           barb = dummy;
         }
      }
      pgsah_c( &fs, &angle, &barb );
      return( 1 );
   }



   if (!strcmp(command,"autoscale"))
   {
      if (inset && !boxset)
         (void) execom( "box", "" );
      autoscale();
      (void) setbox( worldbox );                      /* Map box to new scale */
      return( 1 );
   }


   if (!strcmp(command,"axdelta"))
   {
      if (npar > 0)
         strcpy( axdeltastr, params );
      else
         axdeltastr[0] = '\0';

      return( 1 );
   }


   if (!strcmp(command,"axformat"))
   {
      axformat[0] = '\0';
      if (npar > 0)
         strcpy( axformat, pars[0] );
      return( 1 );
   }


   if (!strcmp(command,"axis") || !strcmp(command,"profaxis") )
   {
      double    scale[2];
      double    origin[2];
      fchar     Title_id;
      fchar     Axtitle;
      fint      ldev = 1;
      fint      Isubin;
      int       reset = NO;
      bool      setexist;


      fmake( Axtitle, 128 );
      fmake( Title_id, 1 );

      if (!pgready(worldbox))
         return( 0 );

      if (npar == 0)
      {
         anylog( 1, command, "Axis command needs parameter!" );
         return( 0 );
      }
      if (world)
      {
         iret = execute( "mmeter", "\0", NULL, 0 );
         reset = YES;
      }
      scale[0]  = Xscale;
      scale[1]  = Yscale;
      origin[0] = Xorgmm;
      origin[1] = Yorgmm;

      setexist = NO;
      if (inset)
      {
         if ( !strcmp(command,"profaxis") )
         {
            Isubin = profsubset;
            if ( gdsc_ndims_c(Setin, &profsubset) == 1 )
               setexist = YES;
         }
         else
         {
            Isubin = subin[subsetindex];
            if ( gdsc_ndims_c(Setin, &subin[subsetindex]) <= 2 )
               setexist = YES;
         }
      }
      /*--------------------------------------------------------------*/
      /* The first parameter is a string of options containing one of */
      /* B(ottom), R(ight), L(eft) and T(op) and optionally one or    */
      /* more modifiers (WPOFEIAZ).                                   */
      /*--------------------------------------------------------------*/

      r = drawaxis_c( tofchar(pars[0]),
                      gridmargin,
                      scale,
                      origin,
                      worldbox,
                      &setexist,
                      Setin,
                      &Isubin,
                      &ldev,
                      &ticksize,
                      tofchar(axposstr),
                      tofchar(axdeltastr),
                      &axminors,
                      tofchar(axformat),
                      axlogs,
                      &axloglen,
                      &cgstep,
                      Axtitle,
                      titleXY,
                      Title_id );

      if (reset)
         iret = execute( "world", "\0", NULL, 0 );

      if  (r == -51)
         (void) sprintf( message, "Unknown 'axdelta' units (%s) to convert from", axdeltastr );
      if  (r == -52)
         (void) sprintf( message, "Unknown (axis) units to convert to");
      if  (r == -53)
         (void) sprintf( message, "Both 'axdelta' units (%s) and axis units are unknown", axdeltastr);
      if  (r == -54)
         (void) sprintf( message, "Incompatible units");

      if (r < 0)
      {
         if  ((r <= -51) && (r >= -54))
         {
            anylog( 1, command, message );
            anylog( 1, command, "Use:  help units   to get a list of GIPSY units." );
         }
         else
         {
            (void) sprintf( message, "Error in axis routine!", r );
            anylog( 1, command, message );
         }
         return( 0 );
      }

      title_id = Title_id.a[0];
      (void) char2str( Axtitle, axtitle, LONGSTR );

      /* Reset defaults */
      axdelta       = dblank;
      axminors      = -1;
      axpos         = dblank;
      axposstr[0]   = '\0';
      axdeltastr[0] = '\0';
      axformat[0]   = '\0';
      axloglen      = 0;
      return( 1 );
   }


   if (!strcmp(command,"axlogs"))
   {
      if (axlogs)
      {
         free( axlogs );
         axloglen = 0;
      }
      axlogs = (double *) calloc( npar, sizeof(double) );
      if (axlogs == NULL)
      {
         anylog( 1, "AXLOGS", "Cannot allocate memory for this column!" );
         return( 0 );
      }
      axloglen = npar;
      r = dcddble_c( tofchar(params), axlogs, &axloglen, &err );
      for (i = 0; i < r; i++)
      {
         if (axlogs[i] < 1.0 || axlogs[i] >= 10.0)
         {
            anylog( 1, "AXLOGS", "Numbers out of range: 1.0 <= x < 10.0" );
            return( 0 );
         }
      }
      axloglen = r;
      return( 1 );
   }


   if (!strcmp(command,"axminors"))
   {
      fint    dummy;
      if (npar >= 1)
      {
         r = dcdint_c( tofchar(pars[0]), &dummy, &one, &err );
         if (r != 1)
         {
            anylog( 1, command, "Cannot convert value(s)!" );
            return( 0 );
         }
         else
         {
            axminors = dummy;
         }
      }
      return( 1 );
   }


   if (!strcmp(command,"axpos"))
   {
      if (npar > 0)
      {
         strcpy( axposstr, params );
      }
      else
      {
         axposstr[0] = '\0';
      }
      return( 1 );
   }


   if (!strcmp(command,"axtitle"))
   {
      double    xoff, yoff;
      double    titlejust = 0.5;
      double    titleangle = 0.0;
      double    x, y;
      int       axnr = 0;
      int       status;

      /*--------------------------------------------------------------*/
      /* titleXY is the centered position in x and y outside the box, */
      /* where a title can be plotted without crossing a label. This  */
      /* position must be adjusted for the current title character    */
      /* height.                                                      */
      /*--------------------------------------------------------------*/
      if (!pgready(worldbox))
         return( 0 );

      charheight = charheight;

      xoff = yoff = 0.0;
      if      (title_id == 'B')
      {
         yoff = -TITLEOFF_Y * charheight;
         titleangle = 0.0;
         axnr = 0;
      }
      else if (title_id == 'R')
      {
         titleangle = -90.0;
         xoff = TITLEOFF_X * charheight;
         axnr = 1;
      }
      else if (title_id == 'T')
      {
         titleangle = 0.0;
         yoff = TITLEOFF_Y * charheight;
         axnr = 2;
      }
      else if (title_id == 'L')
      {
         titleangle = 90.0;
         xoff = -TITLEOFF_X * charheight;
         axnr = 3;
      }

      if ( (titleXY[axnr*2] == dblank) || (titleXY[axnr*2+1] == dblank) )
      {
          anylog( 1, command, "Cannot position title, use axis command first" );
          return( 0 );
      }

      x = titleXY[axnr*2]   + xoff;     /* Do not alter value of titleXY */
      y = titleXY[axnr*2+1] + yoff;

      /*--------------------------------------------------*/
      /* Note that title positions were given in mm.      */
      /* Go to mm mode first!                             */
      /*--------------------------------------------------*/
      iret = execute( "mmeter", "\0", NULL, 0 );
      if (npar > 0)
      {
         /* Plot all given text (all pars == params) */
         status = pltext( command,  x, y, titleangle, titlejust,
                          Setin, subin[subsetindex], axnum, params );
      }
      else
         status = pltext( command, x, y, titleangle, titlejust,
                          Setin, subin[subsetindex], axnum, axtitle );

      iret = execute( "world", "\0", NULL, 0 );
      return( status );
   }


   if (!strcmp(command,"beam"))
   {
      double   cfact;
      double   bmmin, bmmaj, bmpa;
      fint     lines;                                    /* Shading parameter */
      double   slope;                                    /* Shading parameter */
      fint     shape;                                    /* Shading parameter */
      int      j;

      if (!pgready(worldbox))
         return( 0 );

      /*--------------------------------------------------*/
      /* The syntax can be described by:                  */
      /* "beam major units minor units angle lines slope shape */
      /* The units must be given for both axes. The units */
      /* for the angle are degrees. The other arguments   */
      /* are attributes of the beam. Both "major units"   */
      /* "minor units"  and "angle" can be replaced by    */
      /* "header". Then the header items "BMMAJ", "BMMIN" */
      /* and "BMPA" set the values of the beam parameters.*/
      /*--------------------------------------------------*/
      if (npar == 0)
      {
         anylog( 1, command, "No arguments for beam routine!" );
         return( 0 );
      }



      /* ========== MAJOR AXIS (+UNITS) ================= */
      j = 0;
      if (strstr(pars[j], "header") != NULL)
      {
         int   dev;
         if (!inset)
         {
            anylog( 1, command, "No set entered, therefore no header available!" );
            return( NO );
         }
         bmmaj = 0.0;
         err = 0;
         gdsd_rdble_c( Setin,
                       tofchar( "BMMAJ" ),
                       &subin[subsetindex],
                       &bmmaj,
                       &err );
         sprintf( message, "Major axis from header: %g arcsec. Error code: %d",
                  bmmaj, err );
         if (err < 0)
            dev = 1;
         else
            dev = 16;
         anylog( dev, command, message );
         /* This item has always its units in ARCSEC */
         bmmaj /= 3600.0;                                          /* Now in degrees */
         j += 1;
      }
      else
      {
         err = 0;
         r = dcddble_c( tofchar(pars[j]), &bmmaj, &one, &err );
         if (err < 0)
         {
            anylog( 1, command, "Cannot convert value for major axis!" );
            return( 0 );
         }
         j++;
         if (inset)                      /* In case of sets, units must be specified! */
         {
            if (npar < j+1)
            {
               anylog( 1, command, "No units entered for major axis!" );
               return( 0 );
            }
            if (spatialmap)
               r = factor_c( tofchar(pars[j]), tofchar("DEGREE"), &cfact );
            else
            {
               r = factor_c( tofchar(pars[j]), Cunit[0], &cfact );
               if (r != 0)
               {
                  /* Try again with DUNIT */
                  r = factor_c( tofchar(pars[j]), Dunit[0], &cfact );
               }
            }

            if (r != 0)
            {
               if (spatialmap)
               {
                  sprintf( message, "Cannot convert major axis units %s to DEGREE!",
                           pars[j] );
                  anylog( 1, command, message );
               }
               else
               {
                  sprintf( message, "Cannot convert major axis units %s to %.*s",
                           pars[j],
                           nelc_c(Cunit[0]), Cunit[0].a );
                  anylog( 1, command, message );
               }
               return( 0 );
            }
            bmmaj *= cfact;
            j++;
         }
      }

      /* ========== MINOR AXIS (+UNITS) ================= */
      bmmin = 0.0;
      if (npar > j)
      {
         if (strstr(pars[j], "header") != NULL)
         {
            int  dev;
            if (!inset)
            {
               anylog( 1, command, "No set entered, therefore no header available!" );
               return( NO );
            }
            bmmin = 0.0;
            err = 0;
            gdsd_rdble_c( Setin,
                          tofchar( "BMMIN" ),
                          &subin[subsetindex],
                          &bmmin,
                          &err );
            sprintf( message, "Minor axis from header: %g arcsec. Error code: %d",
                     bmmin, err );
            if (err < 0)
               dev = 1;
            else
               dev = 16;
            anylog( dev, command, message );
            /* This item has always its units in ARCSEC */
            bmmin /= 3600.0;                               /* Now in degrees */
            j += 1;
         }
         else
         {
            err = 0;
            r = dcddble_c( tofchar(pars[j]), &bmmin, &one, &err );
            if (err < 0)
            {
               anylog( 1, command, "Cannot convert value for minor axis!" );
               return( 0 );
            }
            j++;
            if (inset)           /* In case of sets, units must be specified */
            {
               if (npar < j+1)
               {
                  anylog( 1, command, "No units entered for minor axis!" );
                  return( 0 );
               }
               if (spatialmap)
                  r = factor_c( tofchar(pars[j]), tofchar("DEGREE"), &cfact );
               else
               {
                  r = factor_c( tofchar(pars[j]), Cunit[1], &cfact );
                  if (r != 0)
                  {
                     /* Try again with DUNIT */
                     r = factor_c( tofchar(pars[j]), Dunit[1], &cfact );
                  }
               }

               if (r != 0)
               {
                  if (spatialmap)
                  {
                     sprintf( message, "Cannot convert minor axis units %s to DEGREE!",
                              pars[j] );
                     anylog( 1, command, message );
                  }
                  else
                  {
                     sprintf( message, "Cannot convert minor axis units %s to %.*s",
                              pars[j],
                              nelc_c(Cunit[1]), Cunit[1].a );
                     anylog( 1, command, message );
                  }
                  return( 0 );
               }
               bmmin *= cfact;
               j++;
            }
         }
      }

      /* ========== BEAM ANGLE ================= */
      bmpa = 0.0;
      if (npar > j)
      {
         if (strstr(pars[j], "header") != NULL)
         {
            int   dev;
            if (!inset)
            {
               anylog( 1, command, "No set entered, therefore no header available!" );
               return( NO );
            }
            bmpa = 0.0;
            err = 0;
            gdsd_rdble_c( Setin,
                          tofchar( "BMPA" ),
                          &subin[subsetindex],
                          &bmpa,
                          &err );
            sprintf( message, "Position angle beam from header: %g deg. Error code: %d",
                     bmpa, err );
            if (err < 0)
               dev = 1;
            else
               dev = 16;
            anylog( dev, command, message );
            /* This item has always its units in DEGREE */
         }
         else
         {
            err = 0;
            r = dcddble_c( tofchar(pars[j]), &bmpa, &one, &err );
            if (err < 0)
            {
               anylog( 1, command, "Cannot convert value for major axis!" );
               return( 0 );
            }
         }
         j++;
      }

      /* Number of shade lines */
      lines = 10;
      if (npar > j)
      {
         err = 0;
         r = dcdint_c( tofchar(pars[j]), &lines, &one, &err );
         if (err < 0)
         {
            anylog( 1, command, "Cannot convert value for number of shade lines!" );
            return( 0 );
         }
         j++;
      }

      /* Slope of shade lines */
      slope = 30.0;
      if (npar > j)
      {
         err = 0;
         r = dcddble_c( tofchar(pars[j]), &slope, &one, &err );
         if (err < 0)
         {
            anylog( 1, command, "Cannot convert value for slope of shade lines!" );
            return( 0 );
         }
         j++;
      }

      /* Beam shape: elliptical or rectangular */
      shape = 1;
      if (npar > j)
      {
         err = 0;
         r = dcdint_c( tofchar(pars[j]), &shape, &one, &err );
         if (err < 0)
         {
            anylog( 1, command, "Cannot determine value for shape of beam!" );
            return( 0 );
         }
         j++;
      }


      if (inset)
      /*--------------------------------------------------*/
      /* (Sub)set has a spatial latitude and longitude    */
      /* axis. Then it is possible to use some spherical  */
      /* geometry to determine the right position of the  */
      /* ellipse boundary.                                */
      /*--------------------------------------------------*/
      {
         double cpos[2];

         if (spatialmap)
         {
            fint  Spatial = 1;
            if (bmmaj == 0.0 || bmmin == 0.0)
               lines = 0;
            /*----------------------------------------*/
            /* Some notes:                            */
            /* 1) The major axis angle is only        */
            /* correct in physical coordinates. The   */
            /* coordinate transformations are correc- */
            /* ted  for any aspect ratio of the grid. */
            /* 2) In RA you cannot check              */
            /* the width of the beam using the        */
            /* labels along the axis. The distance b  */
            /* between two points (a1,d1) and (a2,d2) */
            /* is given by the relation:              */
            /* cos(b) = sin(d1)sin(d2) +              */
            /*               cos(d1)cos(d2)cos(a2-a1) */
            /* Along the RA axis: d1==d2 -->          */
            /* cos(b)=sin(d1)^2+cos(d1)^2.cos(a2-a1)  */
            /* Therefore only at d1=0 you will find   */
            /* b = a2-a1.                             */
            /*----------------------------------------*/

            r = beam_c( Setin, &subin[subsetindex],
                        &Spatial,
                        cdelt,
                        currentXY,
                        &bmmaj, &bmmin,
                        &bmpa,
                        &lines,
                        &slope,
                        &shape );
         }
         else
         {
            double   deltaX, deltaY;
            double   physcoord1[2], physcoord2[2];
            double   deltaXY[2];
            fint     Spatial = 0;
            /*----------------------------------------*/
            /* Find the number of pixels in width and */
            /* height. Calculate the distance in      */
            /* physical coordinates too. Determine a  */
            /* gridspacing and use it to scale the    */
            /* axes of the ellipse. This way we do    */
            /* not have to find out whether primary   */
            /* or secondary units are used.           */
            /* Also: not always a ddelt is stored in  */
            /* the header.                            */
            /* HOWEVER: If one of the axes is a       */
            /* spatial axis, use the cdelt from the   */
            /* header instead. For a RA axis this is  */
            /* necessary because the method described */
            /* above for such an axis calculates the  */
            /* distance in RA which is not the        */
            /* distance on a sphere.                  */
            /*----------------------------------------*/
            cpos[0] = worldbox[0];
            cpos[1] = worldbox[1];
            r = grtoph_c( Setin, &subin[subsetindex], cpos, physcoord1 );
            cpos[0] = worldbox[2];
            cpos[1] = worldbox[3];
            r = grtoph_c( Setin, &subin[subsetindex], cpos, physcoord2 );
            deltaX = ABS(physcoord2[0] - physcoord1[0]) / (worldbox[2] - worldbox[0]);
            deltaY = ABS(physcoord2[1] - physcoord1[1]) / (worldbox[3] - worldbox[1]);

            if (axistype[0] == 1 || axistype[0] == 2)
               deltaXY[0] = cdelt[0];
            else
               deltaXY[0] = deltaX;
            if (axistype[1] == 1 || axistype[1] == 2)
               deltaXY[1] = cdelt[1];
            else
               deltaXY[1] = deltaY;

            bmpa  = 0.0;
            lines = 0;
            slope = 0.0;
            shape = 3;
            r = beam_c( Setin, &subin[subsetindex],
                        &Spatial,
                        deltaXY,
                        currentXY,
                        &bmmaj, &bmmin,
                        &bmpa,
                        &lines,
                        &slope,
                        &shape );
         }

      }
      else
      {
         anylog( 1, command, "No set specified, please use command 'ellipse'" );
         r = -1;
      }
      if (r != 0)
         return( 0 );
      return( 1 );
   }


   if (!strcmp(command,"box"))
   /*----------------------------------------------------------------*/
   /* Set limits independent from xrange and yrange. 'box' will only */
   /* work with n-dim subsets and can be a range or a box.           */
   /*----------------------------------------------------------------*/
   {
      double testbox[4];
      double dummy;

      if (!pgready(worldbox))
         return( 0 );

      for (i = 0; i < 4; i++)
         testbox[i] = worldbox[i];       /* Copy */

      if (!inset)
      {
         for (i = 0; i < npar; i++)
         {
            r = dcddble_c( tofchar(pars[i]), &dummy, &one, &err );
            if (r != 1)
            {
               (void) sprintf( message,
                              "Cannot convert %dth box value!", i+1 );
               anylog( 1, command, message );
               return( 0 );
            }
            else
               testbox[i] = dummy;
         }
      }
      else
      /*--------------------------------------------------*/
      /* Create a BOX= keyword with specification and     */
      /* write it to the task's own parameter list (wkey) */
      /* The routine gdsbox uses this routine.            */
      /*--------------------------------------------------*/
      {
         fint   dfault = HIDDEN;
         fint   blo[2], bhi[2];
         fint   scrnum = 16;
         fint   option = 1;             /* box may exceed subset size */
         char   boxtxt[STRLEN];


         if (subdim != 1 && subdim != 2)
         {
            anylog( 1, command, "Dimension of set not 1 or 2, use x/yrange");
            return( 0 );
         }
         (void) sprintf( boxtxt, "BOX=%s", params );
         wkey_c( tofchar(boxtxt) );
         gdsbox_c( blo, bhi, Setin, &subin[subsetindex], &dfault,
                   KEY_BOX, tofchar(" "), &scrnum, &option );
         cancel_c( KEY_BOX );
         testbox[0] = (double) blo[0];
         testbox[2] = (double) bhi[0];
         if (subdim > 1)
         {
            testbox[1] = (double) blo[1];
            testbox[3] = (double) bhi[1];
         }
      }
      iret = 0;
      if (okbox(testbox))
         iret = setbox( testbox );
      if (iret)
         boxset = YES;
      return( iret );
   }


   if (!strcmp(command,"cgstep"))
   {
      if (npar == 0)
      {
         (void) sprintf( message,
                        "current coordinate grid step = %g", cgstep );
         anylog( 1, "inquiry", message );
      }
      else
      {
         r = dcddble_c( tofchar(pars[0]), &cgstep, &one, &err );
         if (r != 1)
         {
            anylog( 1, command, "Cannot convert coordinate grid step!" );
            return( 0 );
         }
      }
      return( 1 );
   }


   if (!strcmp(command,"charheight"))
   {
      if (npar == 0)
      {
         (void) sprintf( message,
                        "current character height = %g (mm)", charheight );
         anylog( 1, "inquiry", message );
      }
      else
      {
         r = dcddble_c( tofchar(pars[0]), &charheight, &one, &err );
         if (r != 1)
         {
            anylog( 1, command, "Cannot convert height number!" );
            return( 0 );
         }
         setcharhei( charheight );
      }
      return( 1 );
   }


   if (!strcmp(command,"clear"))
   {
      bool   flag;
      if (!pgready(worldbox))
         return( 0 );
      flag = toflog(NO);
      pgask_c( &flag );
      pgpage_c();                     /* control new page prompting */
      flag = toflog(YES);
      pgask_c( &flag );
      return( 1 );
   }


   if (!strcmp(command,"clist"))
   {
      if (npar == 0)
      {
         anylog( 1, command, "No column names entered!" );
         return( 0 );
      }
      return( clist(pars, npar, "clist") );
   }


   if (!strcmp(command,"closeplot"))
   {
      if (devopen)
      {
         pgclos_c();
         devopen = NO;
      }
      return( 1 );
   }


   if (!strcmp(command,"colbar"))
   {
      double   width = 7.5;
      double   height = 60.0;
      double   dum;
      char     orientation = 'L';
      bool     annotation = YES;

      if (!pgready(worldbox))
         return( 0 );
      if (!getlut)
      {
         if (!execute( "getlut", "\0", NULL, 0 ))
            return( 0 );
      }
      if (npar > 0)
      {
         r = dcddble_c( tofchar(pars[0]), &dum, &one, &err );
         if (r == 1)
            width = dum;
      }
      if (npar > 1)
      {
         r = dcddble_c( tofchar(pars[1]), &dum, &one, &err );
         if (r == 1)
            height = dum;
      }
      if (npar > 2)
         orientation = pars[2][0];

      if (npar > 3)
      {
         r = dcdlog_c( tofchar(pars[3]), &annotation, &one, &err );
         if (r == 1)
            annotation = tobool( annotation );
         else
            annotation = YES;
      }

      colbar( Devtype, command,
              lutlen, lutr, lutg, lutb,
              GIDSmincol, GIDSmaxcol, GIDSncolors,
              GIDSbscale, GIDSbzero,
              currentXY[0], currentXY[1],
              width, height,
              orientation,
              annotation );
      return( 1 );
   }


   if (!strcmp(command,"colour") || !strcmp(command,"color"))
   {
      fint   col = -1;

      if (!pgready(worldbox))
         return( 0 );
      if (npar == 0)
      {
         pgqci_c( &col );
         (void) sprintf( message, "current colour index = %d. For a list, type: help colour", col );
         anylog( 1, "inquiry", message );
         return( 1 );
      }
      /* Is the colour a number? */
      r = dcdint_c( tofchar(pars[0]), &col, &one, &err );
      if (r == 1)
      {
         pgsci_c( &col );
         return( 1 );
      }
      /* Maybe it is a string. */
      col = getcolor( pars[0] );
      if (col == -1)
      {
         anylog( 1, command, "Cannot convert this colour" );
         return( 0 );
      }
      else
         pgsci_c( &col );
      return( 1 );
   }


   if (!strcmp(command,"colplot"))
   {
      if (!pgready(worldbox))
         return( 0 );
      if (!getlut)
      {
         if (!execute( "getlut", "\0", NULL, 0 ))
            return( 0 );
      }
      r = plotcol( Setin, subin[subsetindex], Devtype, command,
                   lutlen, lutr, lutg, lutb,
                   GIDSmincol, GIDSmaxcol, GIDSncolors, GIDSblank,
                   GIDSbscale, GIDSbzero );
      return( 1 ); /* Allow unsuccessful execution of 'plotcol' */
   }


   if (!strcmp(command,"colrep"))
   {
      fint    colindx;
      fint    one = 1;
      float   red, green, blue;

      if (npar != 4)
      {
         (void) sprintf( message, "You must enter 4 numbers: indx, r,g,b" );
         anylog( 1, command, message );
         return( 0 );
      }

      r = dcdint_c( tofchar(pars[0]), &colindx, &one, &err );
      if (err)
      {
         dcderror( err );
         return( 0 );
      }

      r = dcdreal_c( tofchar(pars[1]), &red, &one, &err );
      r = dcdreal_c( tofchar(pars[2]), &green, &one, &err );
      r = dcdreal_c( tofchar(pars[3]), &blue, &one, &err );
      red   = MYMIN( red,   1.0 );  red   = MYMAX( red,   0.0 );
      green = MYMIN( green, 1.0 );  green = MYMAX( green, 0.0 );
      blue  = MYMIN( blue,  1.0 );  blue  = MYMAX( blue,  0.0 );

      pgscr_c( &colindx, &red, &green, &blue );
      return( 1 );
   }


   if (!strcmp(command,"contticks"))
   {
      int     standard = NO;
      fint    tickstep = 1;
      float   ticklen  = 0.5;

      if (!pgready(worldbox))
         return( 0 );
      if (numlev == 0)
      {
         anylog( 1, command, "No levels specified, use command 'levels' first" );
      }
      if (npar >=1)
      {
         r = dcdreal_c( tofchar(pars[0]), &ticklen, &one, &err );
         if (r != 1)
         {
            anylog( 1, command, "Cannot convert tick size number!" );
            return( 0 );
         }
      }
      if (npar > 1)
      {
         r = dcdint_c( tofchar(pars[1]), &tickstep, &one, &err );
         if (r != 1)
         {
            anylog( 1, command, "Cannot convert tick step number!" );
            return( 0 );
         }
      }
      return( plotcont( Setin, subin[subsetindex],
              levels, numlev,
              minmax[0], minmax[1],
              ticklen, tickstep, standard ) );
   }


   if (!strcmp(command,"contours"))
   {
      int standard = YES;

      if (!inset)
      {
          anylog( 1, command, "No set opened yet, use command 'inset' to open set" );
          return( 0 );
      }
      if (!pgready(worldbox))
         return( 0 );
      if (numlev == 0)
      {
         anylog( 1, command, "No levels specified, use command 'levels' first" );
      }
      return( plotcont( Setin, subin[subsetindex],
              levels, numlev,
              minmax[0], minmax[1],
              0.0, 0, standard ) );                /* 0 arguments are dummies */
   }


   if (!strcmp(command,"contlab"))
   {
      fint   intval = 20, minint = 10;
      char   *label = NULL;
      if (!inset)
      {
          anylog( 1, command, "No set opened yet, use command 'inset' to open set" );
          return( 0 );
      }
      if (!pgready(worldbox))
         return( 0 );
      if (numlev == 0)
      {
         anylog( 1, command, "No levels specified, use command 'levels' first" );
      }


      if (npar > 0)
      {
         r = dcdint_c( tofchar(pars[0]), &intval, &one, &err );
      }
      if (npar > 1)
      {
         r = dcdint_c( tofchar(pars[1]), &minint, &one, &err );
      }
      if (npar > 2)
         label = pars[2];

      return plotcontlab( Setin, subin[subsetindex],
                          levels, numlev, label,
                          intval, minint );
   }



   if (!strcmp(command,"cursor"))
   {
      float   x1, x2, y1, y2;
      char    stat[40];                            /* In world coords. or mm? */
      fint    option;

      static  int     first = YES;
      static  float   xpos, ypos;


      if (!cursor)
      {
         anylog( 1, command, "Device not suitable for interactive graphics" );
         return(0);
      }


      option = 0;
      if (npar > 0)
      {
         r = dcdint_c( tofchar(pars[0]), &option, &one, &err);
         if (r != 1)
            option = 0;
      }


      if (world)
         strcpy( stat, "world coords." );
      else
         strcpy( stat, "mm" );

      if (first)
      {
         pgqwin_c( &x1, &x2, &y1, &y2 );        /* Inquire (to center cursor) */
         xpos = (x1 + x2) / 2.0;
         ypos = (y1 + y2) / 2.0;
         first = NO;
      }
      icursor( option, &xpos, &ypos, stat, command );
      return(0);
   }


   if (!strcmp(command,"curtxt"))
   /* The syntax for a keyboard macro is #<key> <text> */
   {
      char *p;

      p = strchr( params, '#' );
      if (p)
      {
         int k;
         p++;
         k = (int) (toupper(*p) - 'A');
         if (k < 0 || k > 25)
         {
            anylog( 1, command, "Not a valid keyboard character defined!" );
            return( 0 );
         }
         p++;
         if (p)
         {
            if (formatstr[k] )
               free( formatstr[k] );
            formatstr[k] = malloc( strlen(p) + 1 );
            strcpy( formatstr[k], p );
            anylog( 1, command, formatstr[k] );
         }
         else
            formatstr[k][0] = '\0';

      }
      else
      {
         anylog( 1, command, "Not a valid keyboard character defined!" );
         return( 0 );
      }
      return( 1 );
   }


   if (!strcmp(command,"device"))
   {
      if (npar > 1)                                          /* convert nsubx */
      {
         r = dcdint_c( tofchar(pars[1]), &nsubx, &one, &err );
         if (err != 0)
            npar--;
      }
      if (npar > 2)                                          /* convert nsuby */
      {
         r = dcdint_c( tofchar(pars[2]), &nsuby, &one, &err );
         if (err != 0)
            npar--;
      }
      if (npar)
         iret = device( npar, pars[0], nsubx, nsuby );
      else
         iret = device( npar, "\0", nsubx, nsuby );

      if (firstdevice)
      {
         preset();
         firstdevice = NO;
      }
      return( iret );
   }

   if (!strcmp(command,"devinfo"))
   {
      devinfo( devx1mm, devy1mm, devx2mm, devy2mm );
      return(0);
   }


   if (!strcmp(command,"draw"))
   {
      fint    maxpos = 1;
      double  XY[2];

      if (!pgready(worldbox))
         return( 0 );
      /* No problem if there is not a set specified */
      r = getposition( Setin, subin[subsetindex], maxpos,
                       params, pars, npar, XY );
      if (r == 0)
         return( 0 );

      if (r != 1)
      {
         anylog( 1, command, "needs 2 numbers!" );
         return( 0 );
      }
      pldraw( XY[0], XY[1] );
      return( 1 );
   }


   if (!strcmp(command,"forward"))
   {
      /* Line of certain length from current pen position with certain angle */
      return( 1 );
   }


   if (!strcmp(command,"ellipse"))
   {
      /* syntax:  ellipse  Xaxis [units] Yaxis [units] [start] [end] [delta] */
      
      double  dummy[5];
      double  dum;
      float   X, Y, start, end;         /* Ellipse parameters */
      float   Xor, Yor, ang, delta;
      int     j;
      int     ax;

      if (!pgready(worldbox))
         return( 0 );
         
      for (i = 0, j = 0; ((i < npar) && (j < 5)); i++)
      {
         r = dcddble_c( tofchar(pars[i]), &dum, &one, &err );
         if ((r != 1) || (err < 0))
         {
            if (inset && (j < 3) && (j > 0))
            {
               if (j == 1)
                  ax = 0;
               else
                  ax = 1;
               if (!convert( &dummy[j-1], pars[i], ax ))
               {
                  (void) sprintf( message, "Cannot convert %g to %s", dummy[j-1], pars[i] );
                  anylog( 1, command, message );
                  return( 0 );
               }
            }
            else
            {
               anylog( 1, command, "Cannot convert number(s)!" );
               return( 0 );
            }
         }
         else
         {
            dummy[j++] = dum;
         }
      }
      if (j < 2)
      {
         anylog( 1, command, "needs at least two numbers" );
         return( 0 );
      }
      X = (float) dummy[0];
      Y = (float) dummy[1];
      start = 0.0; end = 360.0;
      delta = 1.0;
      if (j > 2)
         start = (float) dummy[2];
      if (j > 3)
         end   = (float) dummy[3];
      if (j > 4)
         delta = (float) fabs(dummy[4]);         
      Xor = (float) currentXY[0];
      Yor = (float) currentXY[1];
      ang = (float) angle;      
      pgellipse_c( &Xor, &Yor, &X, &Y, &ang, &start, &end, &delta );
      return( 1 );
   }


   if (!strcmp(command,"excolumn"))
   {
      int indx = EXARRAY;
      iret = createarray( npar, pars, params, &vect[indx], &vectsize[indx], indx );
      return( iret );
   }


   if (!strcmp(command,"eycolumn"))
   {
      int indx = EYARRAY;
      iret = createarray( npar, pars, params, &vect[indx], &vectsize[indx], indx );
      return( iret );
   }


   if (!strcmp(command,"environ"))
   {
      fint   axis  = 0;
      fint   just  = 1;
      float  xlo=-10.0, ylo=-10.0, xhi=10.0, yhi=10.0;

      if (!pgready(worldbox))
         return( 0 );
      for (i = 0; i < MYMIN(npar,4); i++)
      {
         float  x;
         r = dcdreal_c( tofchar(pars[i]), &x, &one, &err );
         if (r == 1)
         {
            if (i == 0) xlo = x;
            if (i == 1) ylo = x;
            if (i == 2) xhi = x;
            if (i == 3) yhi = x;
         }
      }
      for (i = MYMIN(npar,4); i < 6; i++)
      {
         fint   num;
         r = dcdint_c( tofchar(pars[i]), &num, &one, &err );
         if (r == 1)
         {
            if (i == 4) just = num;
            if (i == 5) axis = num;
         }
      }
      pgenv_c( &xlo, &xhi, &ylo, &yhi, &just, &axis );
      return( 1 );
   }


   if (!strcmp(command,"erase"))
   {
      bool   flag;
      if (!pgready(worldbox))
         return( 0 );
      flag = toflog(NO);
      pgask_c( &flag );
      pgpage_c();                     /* control new page prompting */
      flag = toflog(YES);
      pgask_c( &flag );
      return( 1 );
   }


   if (!strcmp(command,"errorbar"))
   {
      int     x1mode = NO;
      int     x2mode = NO;
      int     y1mode = NO;
      int     y2mode = NO;
      int     minlen = 0;
      double  dummy[4];
      double  dum;
      int     ax = 0;
      int     j;

      if (npar == 0)
      {
         anylog( 1, command, "No arguments, use -x x -y or y or supply one or more numbers" );
         return( 0 );
      }

      for (i = 0, j = 0; ((i < npar) && (j < 4)); i++)
      {
         r = dcddble_c( tofchar(pars[i]), &dum, &one, &err );
         if ((r != 1) || (err < 0))
         {
            if (inset && (j < 5) && (j > 0))
            {
               /* First value is a y-value, not a x value, so change 'ax' numbers */
               ax = j%2;
               if (!convert( &dummy[j-1], pars[i], ax ))
               {
                  (void) sprintf( message, "Cannot convert %g to %s", dummy[j-1], pars[i] );
                  anylog( 1, command, message );
                  return( 0 );
               }
            }
         }
         else
         {
            dummy[j++] = dum;
         }
      }
      if (j)
      {
         float  x1, x2;
         float  y1, y2;
         float  XY[2];

         XY[0] = (float) currentXY[0];
         XY[1] = (float) currentXY[1];
         x1 = x2 = (float) currentXY[0];
         y1 = y2 = (float) currentXY[1];
         y1 = (float) (currentXY[1] - dummy[0]);
         if (j >= 1)
            y2 = (float) (currentXY[1] + dummy[0]);
         if (j >= 3)
            y2 = (float) (currentXY[1] + dummy[2]);

         pgerry_c( &one, &XY[0], &y1, &y2, &termlen );
         if (j > 1)
         {
            x1 = (float) (currentXY[0] - dummy[1]);
            if (j >= 2)
               x2 = (float) (currentXY[0] + dummy[1]);
            if (j == 4)
               x2 = (float) (currentXY[0] + dummy[3]);
            pgerrx_c( &one, &x1, &x2, &XY[1], &termlen );
         }
         return( 1 );
      }

      for (i = 0; i < npar; i++)
      {
         if (strstr( pars[i], "x" ) != NULL)
         {
            /* +/- x direction */
            if (strstr( pars[i], "-x" ) != NULL)
               x1mode = YES;
            else
               x2mode = YES;
         }
         if (strstr( pars[i], "y" ) != NULL)
         {
            /* +/- y direction */
            if (strstr( pars[i], "-y" ) != NULL)
               y1mode = YES;
            else
               y2mode = YES;
         }
      }
      minlen = MYMIN( vectsize[XARRAY], vectsize[YARRAY] );
      if (minlen == 0)
      {
         anylog( 1, command, "No coordinates in 'xcolumn' , 'ycolumn'");
         return( 0 );
      }
      if ((x1mode || x2mode) && (vectsize[EXARRAY] < minlen))
      {
         minlen = vectsize[EXARRAY];
         if (minlen == 0)
         {
            anylog( 1, command, "No bar lengths in 'excolumn'");
            return( 0 );
         }
      }
      if ((y1mode || y2mode) && (vectsize[EYARRAY] < minlen))
      {
         minlen = vectsize[EYARRAY];
         if (minlen == 0)
         {
            anylog( 1, command, "No bar lengths in 'eycolumn'");
            return( 0 );
         }
      }
      if (x1mode || x2mode)
      {
         for (i = 0; i < MYMIN(minlen, vectsize[EXARRAY]); i++)
         {
            float x1, x2;
            float y  = vect[YARRAY][i];
            x1 = x2 = vect[XARRAY][i];
            if (x1mode)
               x1 -= vect[EXARRAY][i];
            if (x2mode)
               x2 += vect[EXARRAY][i];
            pgerrx_c( &one, &x1, &x2, &y, &termlen );
         }
      }
      if (y1mode || y2mode)
      {
         for (i = 0; i < MYMIN(minlen, vectsize[EYARRAY]); i++)
         {
            float y1, y2;
            float x  = vect[XARRAY][i];
            y1 = y2 = vect[YARRAY][i];
            if (y1mode)
               y1 -= vect[EYARRAY][i];
            if (y2mode)
               y2 += vect[EYARRAY][i];
            pgerry_c( &one, &x, &y1, &y2, &termlen );
         }
      }
      return( 1 );
   }


   if (!strcmp(command,"expand"))
   {
      double   dummy[2];

      iret = 1;
      if (npar > 0)
      {
         for (i = 0; i < MYMIN(npar,2); i++)
         {
            r = dcddble_c( tofchar(pars[i]), &dummy[i], &one, &err );
            if (r != 1)
            {
               anylog( 1, command, "Cannot convert value(s)!" );
               return( 0 );
            }
         }
         if ((npar >= 1) && (dummy[0] != 0.0))
            Xscale = storeXscaleEXP / ABS(dummy[0]);
         if ((npar >= 2) && (dummy[1] != 0.0))
            Yscale = storeYscaleEXP / ABS(dummy[1]);
         iret = 0;
         if (okbox(worldbox))
            iret = setbox( worldbox );
      }
      return( iret );
   }


   if (!strcmp(command,"fastyle"))
   {
      fint  l;
      if (npar == 0)
      {
         anyoutC( 1, "fastyle 1  : solid fill (default) ");
         anyoutC( 1, "fastyle 2  : hollow (outline only) ");
         (void) sprintf( message, "current fill-area style: %d", fillareastyle );
         anylog( 1, "inquiry", message );
         return( 1 );
      }
      r = dcdint_c( tofchar(pars[0]), &l, &one, &err);
      if (r == 1)
      {
         if ((l < 1) || (l > MAXFILLSTYLES))
         {
            anylog( 1, command, "Fill-Area style must be in range 1..4" );
            return( 0 );
         }
         fillareastyle = l;
         pgsfs_c( &fillareastyle );
      }
      return( 1 );
   }



   if (!strcmp(command,"file"))
   {
      FILE    *fileptr = NULL;
      int     i;

      if (npar == 0)
      {
         anylog( 1, command, "Need a filename!" );
         return( 0 );
      }
      if (npar == 1)
      {
         anylog( 1, command, "Nothing to write to file!" );
         return( 0 );
      }
      fileptr = fopen( pars[0], "r" );
      if (fileptr != NULL)                   /* File exists */
      {
         bool   overw = toflog( NO );
         fint   nitems = 1;

         fclose( fileptr );
         dfault = REQUEST;
         r = userlog_c( &overw, &nitems, &dfault, KEY_OVERWRITE,
                        tofchar("File exists. Overwrite it?    Y/[N]") );
         cancel_c( KEY_OVERWRITE );
         overw = tobool( overw );
         if (!overw)
            return( 0 );
      }
      fileptr = fopen( pars[0], "w" );
      if (fileptr == NULL)
      {
         (void) sprintf( message, "Cannot open: %s", pars[0] );
         anylog( 1, command, message );
         return( 0 );
      }
      if ( strstr("help", pars[1]) )
      {
         if (npar == 2)
         {
            help( fileptr, "" );
            help( fileptr, "*" );
         }
         else
         {
            for (i = 2; i < npar; i++)
               help( fileptr, pars[i] );
         }
      }
      else
      /*------------------------------------------------------------*/
      /* The parameters must be columns. Create a format and write  */
      /* contents to the file. The first parameter is the file name */
      /* and the others are the column names. The number of columns */
      /* to write is ncol = npar - 1.                               */
      /*------------------------------------------------------------*/
      {
         char   cbuff[512];
         char   *fbuff = NULL;
         int    len = 0;
         int    ncol;
         int    fieldlen;



         if (printusingstr != NULL)
            fieldlen = printusing( printusingstr, 0.0, cbuff );
         else
            fieldlen = 12;

         ncol = npar - 1;
         fbuff = malloc( ncol * (fieldlen+3) + 2 );
         if (fbuff == NULL)
         {
            anylog( 1, command, "Cannot allocate memory for format string" );
            return( 0 );
         }

         /* Which column has biggest size? Note that */
         /* the scan order is important */
         for (i = 1; i <= ncol; i++)
         {
            if (      !strncmp(pars[i], "excolumn", 2) )
               len = MYMAX( len, vectsize[EXARRAY] );
            else if ( !strncmp(pars[i], "eycolumn", 2) )
               len = MYMAX( len, vectsize[EYARRAY] );
            else if ( !strncmp(pars[i], "xcolumn", 2) )
               len = MYMAX( len, vectsize[XARRAY] );
            else if ( !strncmp(pars[i], "ycolumn", 2) )
               len = MYMAX( len, vectsize[YARRAY] );

         }

         for (i = 0; i < len; i++)
         {
            int col;
            strcpy( fbuff, "" );
            for (col = 1; col <= ncol; col++)
            {
               float    val = blank;
               int      ok = NO;
               sprintf( cbuff, "%12.12s  ", " " );
               if (      !strncmp(pars[col], "excolumn", 2) && i < vectsize[EXARRAY] )
               {
                  val = vect[EXARRAY][i];
                  ok = YES;
               }
               else if ( !strncmp(pars[col], "eycolumn", 2) && i < vectsize[EYARRAY] )
               {
                  val = vect[EYARRAY][i];
                  ok = YES;
               }
               else if ( !strncmp(pars[col], "xcolumn", 2) && i < vectsize[XARRAY] )
               {
                  val = vect[XARRAY][i];
                  ok = YES;
               }
               else if ( !strncmp(pars[col], "ycolumn", 2) && i < vectsize[YARRAY] )
               {
                  val = vect[YARRAY][i];
                  ok = YES;
               }
               if (ok)
               {
                  if (printusingstr != NULL)
                  {
                     printusing( printusingstr, val, cbuff );
                     strcat( cbuff, "  " );
                  }
                  else
                     sprintf( cbuff, "%*g  ", fieldlen, val );
               }
               else
                  sprintf( cbuff, "%*.*s  ", fieldlen, fieldlen, " " );

               strcat( fbuff, cbuff );
            }
            fprintf( fileptr, "%s\n", fbuff );     /* write to file */
         }

         free( fbuff );
      }
      fclose( fileptr );
      return( 1 );
   }



   if (!strcmp(command,"font"))
   {
      char   *fontstr = NULL;
      fint   newfont;

      if (npar == 0)
      {
         pgqcf_c( &font );
         (void) sprintf( message, "current character font = %d", font );
         anylog( 1, "inquiry", message );
         anylog( 1, "inquiry", "Available: 1) Normal  2) Roman  3) Italic  4) Script");
         return( 1 );
      }
      /* Is font a number? */
      r = dcdint_c( tofchar(pars[0]), &newfont, &one, &err );
      if (r == 1)
      {
         if (newfont < 1 || newfont > 4)
         {
            anylog( 1, command, "Fonts must be in range 1..4" );
            return( 0 );
         }
         font = newfont;
         pgscf_c( &font );
         return( 1 );
      }
      /* Maybe it is a string. Add a wildcard to pars[0]. */
      fontstr = malloc( strlen(pars[0]) + 2 );
      if (!fontstr)
      {
         anylog( 1, "warning", "Cannot allocate memory for font string!");
         return( 0 );
      }
      strcpy( fontstr, pars[0] );
      strcat( fontstr, "*" );

      iret = 1;
      if (wmatchC( "normal",         fontstr )) {
         font = 1; pgscf_c( &font );
      } else if (wmatchC( "roman",   fontstr )) {
         font = 2; pgscf_c( &font );
      } else if (wmatchC( "italic",  fontstr )) {
         font = 3; pgscf_c( &font );
      } else if (wmatchC( "script",  fontstr )) {
         font = 4; pgscf_c( &font );
      }
      else
      {
         anylog( 1, command, "Cannot convert parameter to a font" );
         iret = 0;
      }
      free( fontstr );
      return( iret );
   }


   if (!strcmp(command,"frame"))
   {
      char *par;

      if (!pgready(worldbox))
         return( 0 );
      par = malloc(10);
      if (inset)
      {
         strcpy( par, "bp" ); execute( "axis", "\0", &par, 1 );
         execute( "axtitle", "\0", NULL, 0 );
         if (subdim == 2)
         {
            strcpy( par, "lp" ); execute( "axis", "\0", &par, 1 );
            execute( "axtitle", "\0", NULL, 0 );
         }
         else
         {
            strcpy( par, "lw" );
            execute( "axis", "\0", &par, 1 );
         }
         strcpy( par, "t" ); execute( "axis", "\0", &par, 1 );
         strcpy( par, "r" ); execute( "axis", "\0", &par, 1 );
      }
      else
      {
         strcpy( par, "bw" ); execute( "axis", "\0", &par, 1 );
         strcpy( par, "lw" ); execute( "axis", "\0", &par, 1 );
         strcpy( par, "t" );  execute( "axis", "\0", &par, 1 );
         strcpy( par, "r" );  execute( "axis", "\0", &par, 1 );
      }
      free( par );
      return( 1 );
   }


   if (!strcmp(command,"getlut"))
   {
      if (npar > 0)
      {
         if ( strstr(pars[0], "head") )
         {
            r = lutfromtable( Setin,
                              subin[0],
                              &lutlen,
                              lutr,
                              lutg,
                              lutb,
                              &GIDSmincol,
                              &GIDSmaxcol,
                              &GIDSncolors,
                              &GIDSbscale,
                              &GIDSbzero,
                              &GIDSblank );
            if (r)
            {
               anylog( 1, command, "Successfully read lut from table in header");
               getlut = YES;
               return( 1 );
            }
            else
            {
               anylog( 1, command, "Could not read lut from header of current set");
               getlut = NO;
               return( 0 );
            }
         }
      }

      r = getlutGIDS( &GIDSdisplay_id, &lutlen, lutr, lutg, lutb,
                      &GIDSmincol, &GIDSmaxcol, &GIDSncolors, &GIDSblank,
                      &GIDSbscale, &GIDSbzero );
      if (r == NO)
      {
         anylog( 1, command, "Cannot obtain a colour look up table from GIDS.");
         getlut = NO;
         return( 0 );
      }
      else
      {
         anylog( 1, command, "Read colour information from GIDS now!" );
         getlut = YES;
      }
      return( 1 );
   }


   if (!strcmp(command,"gids"))
   {
      /*--------------------------------------------------------------*/
      /* Get set from GIDS and adjust offset and scaling for that set */
      /*--------------------------------------------------------------*/
      return( getGIDSset( command ) );
   }


   if (!strcmp(command,"grayscale"))
   {
      if (!inset)
      {
          anylog( 1, command, "No set opened yet, use command 'inset' to open set" );
          return( 0 );
      }
      if (!pgready(worldbox))
         return( 0 );
      if (numlev == 0)
      {
         anylog( 1, command, "No levels specified, use command 'levels' first" );
         return( 0 );
      }
      if (numlev == 1)
      {
         anylog( 1, command, "Need at least 2 levels to create a grayscale map" );
         return( 0 );
      }
      return( plotgray( Setin, subin[subsetindex], levels, numlev ) );
   }


   if (!strcmp(command,"hardcopy"))
   {
      preset();
      if (npar)
         iret = device( npar, pars[0], nsubx, nsuby );
      else
         iret = device( npar, "\0", nsubx, nsuby );
      exemacro( 0, "\0" );
      pgend_c();
      return( 0 );
   }


   if (!strcmp(command,"help"))
   {
      int  i;
      if (npar == 0)
         help( NULL, "" );
      for (i = 0; i < npar; i++)
         help( NULL, pars[i] );

      return( 0 );
   }


   if (!strcmp(command,"histobin"))
   {
      fint    len = MYMIN(vectsize[XARRAY], vectsize[YARRAY]);
      bool    center;

      if (!pgready(worldbox))
         return( 0 );
      if ((len > 0) && (vect[XARRAY] != NULL) && (vect[YARRAY] != NULL))
      {
         if (npar > 0)
         {
            r = dcdlog_c( tofchar(pars[0]), &center, &one, &err);
            if ((r != 1) || (err < 0))
               center = toflog( YES );
         }
         else
            center = toflog( YES );
      }
      else
      {
         anylog( 1, command, "something wrong with xcolumn, or ycolumn");
         return( 0 );
      }
      pgbin_c( &len, vect[XARRAY], vect[YARRAY], &center );
      return(1);
   }


   if (!strcmp(command,"histogram"))
   {
      fint    nbins;
      fint    n;
      fint    flag;

      if (!pgready(worldbox))
         return( 0 );
      if (minmax[0] == minmax[1])
      {
         anylog( 1, command, "min == max, use command 'minmax' with arguments first!" );
         return(0);
      }
      if (vectsize[XARRAY] == 0)
      {
         anylog( 1, command, "xcolumn is empty" );
         return( 0 );
      }
      if (npar > 0)
      {
         r = dcdint_c( tofchar(pars[0]), &nbins, &one, &err);
         if (r == 1)
         {
            if (nbins < 1)
               nbins = 1;
            if (nbins > 200)
               nbins = 200;
         }
      }
      else
         nbins = 10;

      n = vectsize[XARRAY];
      flag = 1;
      pghist_c( &n, vect[XARRAY], &minmax[0], &minmax[1], &nbins, &flag );
      return(1);
   }


   if (!strcmp(command,"id"))
   {
      fchar     Idstr;
      if (!pgready(worldbox))
         return( 0 );
      fmake( Idstr, STRLEN );
      getusernam_c( Idstr );
      (void) sprintf( message, "\\fi GIPSY:\\fn %.*s",
                      nelc_c( Idstr ), Idstr.a );
      getdate_c( Idstr );
      (void) sprintf( message, "%.*s %.*s", strlen(message), message,
                      nelc_c( Idstr ), Idstr.a );
      return( pltext( command,
                      currentXY[0],
                      currentXY[1],
                      angle,
                      justification,
                      Setin, subin[subsetindex], axnum,
                      message ) );
   }


   if (!strcmp(command,"inset"))
   {
      iret = getset( params );
      return( iret );
   }
   
  
  
   if (!strcmp(command,"interpol"))
   /*------------------------------------------------------------*/
   /* Set/unset the image interpolation for hardcopy devices.    */
   /*------------------------------------------------------------*/
   {
      fint    ip;
      
      /* YES or ON: */
      if (toupper(pars[0][0]) == 'Y' || toupper(pars[0][1]) == 'N')
      {
         ip = 1;
         pgsimi_c( &ip );
         interpol = YES;
      }
      else
      {
         ip = 0;
         pgsimi_c( &ip );
         interpol = NO;         
      }
      return( YES );
   }


   if (!strcmp(command,"keyword"))
   /*------------------------------------------------------------*/
   /* The keyword command must have a parameter to specify the   */
   /* name of a keyword. The keyword will be prompted, displaying*/
   /* the message in 'params' minus the keyword name. E.g.       */
   /*                keyword xrange Give xrange:                 */
   /* will prompt you with keyword XRANGE= with message          */
   /*                Give xrange:                                */
   /*------------------------------------------------------------*/
   {
      char   *keyword = NULL;
      char   *mes = NULL;
      char   *p;
      int    s, k;
      fint   r;
      fchar  Newparams;

      if (npar == 0)
      {
         anylog( 1, command, "No command specified!" );
         return( 0 );
      }
      fmake( Newparams, HUGEBUF + 1 );
      k = strlen( pars[0] );
      keyword = malloc( k + 2 );         /* Extra space for '0' and '=' */
      if (keyword == NULL)
      {
         anylog( 1, command, "Cannot allocate memory for keyword!" );
         return( 0 );
      }
      strcpy( keyword, pars[0] );
      strcat( keyword, "=" );
      if (params)
      {
         s = strlen( params );
         mes = malloc( s - k + 1 );
      }
      else
      {
         mes = malloc( 1 );
      }
      if (mes == NULL)
      {
         anylog( 1, command, "Cannot allocate memory for keyword message!" );
         free( keyword );
         return( 0 );
      }

      if (params)
      {
         p = params;
         p += k + 1;
         strcpy( mes, p );
      }
      else
         mes[0] = '\0';

      dfault = REQUEST;
      r = usertext_c( Newparams, &dfault, tofchar(keyword), tofchar(mes) );
      Newparams.a[r] = '\0';
/*      cancel_c( tofchar(keyword) );*/
      free( keyword );
      free( mes );
      return( execom(pars[0], Newparams.a) );
   }


   if (!strcmp(command,"justificat"))
   {
      if (npar == 0)
      {
         (void) sprintf( message, "Current justification: %g", justification );
         anylog( 1, command, message );
      }
      else
      {
         r = dcddble_c( tofchar(pars[0]), &justification, &one, &err );
         if (r != 1)
         {
            anylog( 1, command, "Cannot convert justification!" );
            return( 0 );
         }
      }
      return( 1 );
   }


   if (!strcmp(command,"levels"))
   {
      fint   maxlevs = MAXLEVELS;
      int    percent = NO;
      int    j;


      if (npar == 0)
      {
         if (numlev == 0)
            anylog( 1, "inquiry", "No levels defined" );
         else
         {
            for (j = 0; j < numlev; j++)
            {
               if (j == 0)
                  (void) sprintf( message, "Current levels     : %g", levels[j] );
               else
                  (void) sprintf( message, "%.*s, %g", strlen(message), message, levels[j]);

               if ((strlen(message) > (80-20) ) || (j == numlev-1))
               {
                  anyoutC( 3, message );
                  (void) sprintf( message, "                   :");
               }
            }
         }
         return( 1 );
      }

      numlev = 0;      /* Reset number of levels */
      if (strstr(pars[npar-1], "perc") != NULL)
      {
         percent = YES;
         npar -= 1;
      }
      if (percent)
      {
         if (minmax[0] == minmax[1])
         {
            anylog( 1, command, "min == max, use command 'minmax' with arguments first!" );
            return(0);
         }
      }
      for (i = 0; i < npar; i++)
      {
         r = dcdreal_c( tofchar(pars[i]), &levels[numlev], &maxlevs, &err );
         if (err)
            dcderror( err );
         else
         {
            numlev += r;
            maxlevs -= r;
         }
      }
      if (numlev == 0)
      {
         anylog( 1, command, "Number of levels == 0" );
         return(0);
      }
      if (percent)
      {
         /* The conversion from percentages to absolute levels is done with */
         /* the formula: level[i] = min + perc[i]/100 * [max-min]           */
         /* so that 0% results in the level 'min' and 100% results in       */
         /* the level 'max'.                                                */
         for (i = 0; i < numlev; i++)
            levels[i] = minmax[0] + levels[i]/100.0 * (minmax[1]-minmax[0]);
      }
      return( 1 );
   }


   if ((!strcmp(command,"location")) || (!strcmp(command,"ulocation")))
   {
      double     XYoffset[2];

      if (!pgready(worldbox))
         return( 0 );
      if (npar == 0)
      {
         (void) sprintf( message,
                        "Current position of lower left corner: %g, %g (mm)",
                         Xorgmm,
                         Yorgmm );
         anylog( 1, command, message );
         return( 1 );
      }
      if (!strcmp(command,"ulocation"))
      {
         if (world)
         {
            fint  maxpos = 1;
            r = getposition( Setin, subin[subsetindex], maxpos,
                             params, pars, npar, XYoffset );
            world2mm( XYoffset[0], XYoffset[1],  &XYoffset[0], &XYoffset[1] );
            if (r != 0 && r != 1)
            {
               anylog( 1, command, "Need two numbers!" );
               return( 0 );
            }
         }
         else
         {
            anylog( 1, command, "Not in 'world' mode" );
            return( 0 );
         }
      }
      else           /* location in mm */
      {
         int  n = 0;
         for (i = 0; i < npar; i++)
         {
            r = dcddble_c( tofchar(pars[i]), &XYoffset[i], &one, &err );
            if (r != 1)
            {
               anylog( 1, command, "Cannot convert offset(s)!" );
               return( 0 );
            }
            n++;
         }
         if (n != 2)
         {
            anylog( 1, command, "Need two numbers!" );
            return( 0 );
         }
      }
      Xorgmm = XYoffset[0];
      Yorgmm = XYoffset[1];
      iret = 0;
      if (okbox(worldbox))
         iret = setbox( worldbox );
      return( iret );
   }


   if (!strcmp(command,"lstyle"))
   {
      fint  l;
      if (npar == 0)
      {
         anyoutC( 1, "lstyle 1  : full line (default) ");
         anyoutC( 1, "lstyle 2  : long dashes ");
         anyoutC( 1, "lstyle 3  : dash-dot-dash-dot ");
         anyoutC( 1, "lstyle 4  : dotted ");
         anyoutC( 1, "lstyle 5  : dash-dor-dot-dot ");
         (void) sprintf( message, "current line style: %d", linestyle );
         anylog( 1, "inquiry", message );
         return( 1 );
      }

      r = dcdint_c( tofchar(pars[0]), &l, &one, &err);
      if (r == 1)
      {
         if ((l < 1) || (l >5))
         {
            anylog( 1, command, "Line style must be in range 1..5" );
            return( 0 );
         }
         linestyle = l;
         pgsls_c( &linestyle );
      }
      return( 1 );
   }


   if (!strcmp(command,"lwidth"))
   {
      fint  l;
      if (npar == 0)
      {
         (void) sprintf( message, "current line width: %d", linewidth );
         anylog( 1, "inquiry", message );
         return( 1 );
      }
      r = dcdint_c( tofchar(pars[0]), &l, &one, &err);
      if (r == 1)
      {
         if ((l < 1) || (l > 21))
         {
            anylog( 1, command, "Width must be in range 1..21" );
            return( 0 );
         }
         linewidth = l;
         pgslw_c( &linewidth );
      }
      return( 1 );
   }


   if (!strcmp(command,"manual"))
   {
      char    filename[256];
      fint    r;

      (void) sprintf( filename, "%s/gplot.doc", getenv("gip_doc") );
      r = editfile_c( tofchar(filename),
                      tofchar("<CARRIAGE RETURN> == READ   <ctrl>C == ABORT") );
      if (r != 0)
      {
         if      (r == -1)
            anyoutC( 1, "Warning: user canceled the edit" );
         else if (r == -2)
            anyoutC( 1, "Warning: cannot start editor" );
         else if (r == -3)
            anyoutC( 1, "Warning: editor process exited with error status");
         else if (r == -666)
            anyoutC( 1, "Warning: this version of Hermes does not support EDITFILE" );
      }
      return( 0 );
   }


   if (!strcmp(command,"marker"))
   {
      float X, Y;

      if (!pgready(worldbox))
         return( 0 );

      if (npar == 0)
      {
         X = (float) currentXY[0];
         Y = (float) currentXY[1];
         pgpt_c( &one, &X, &Y, &symbol );
      }
      else
      /*------------------------------------------------------------*/
      /* There is a parameter. This parameter must be a file. Read  */
      /* the lines in this file and convert to a position. Plot a   */
      /* marker at that position. Convert newlines and comment      */
      /* character (!) to a zero character.                         */
      /*------------------------------------------------------------*/
      {
         FILE  *fp = NULL;

         fp = fopen( pars[0], "r" );
         if (fp == NULL)                   /* File does not exists */
         {
            (void) sprintf( message, "Cannot open file: %s", pars[0] );
            anylog( 1, command, message );
            return( 0 );
         }
         while (!feof(fp))
         {
            fgets( message, NCHAR, fp );
            if ( cleanstr(message) )
            {
               fint    r;
               r = execom( "move", message );
               if (r)
                  (void) execom( "marker", "" );
            }
         }
         fclose( fp );
      }
      return( 1 );
   }


   if (!strcmp(command,"minmax"))
   {
      if (npar == 0)
      {
         (void) sprintf( message, "Current min, max: %f %f", minmax[0], minmax[1] );
         anylog( 1, "inquiry", message );
         return( 1 );
      }
      if (strstr( pars[0], "set" ) != NULL) {
         iret = getminmax( "set", subin[subsetindex] );
      } else if (strstr( pars[0], "head" ) != NULL) {
         iret = getminmax( "header", subin[subsetindex] );
      } else if (strstr( pars[0], "xcol" ) != NULL) {
         iret = getminmax( "xcolumn", 0 );
      } else if (strstr( pars[0], "ycol" ) != NULL) {
         iret = getminmax( "ycolumn", 0 );
      } else if (strstr( pars[0], "excol" ) != NULL) {
         iret = getminmax( "excolumn", 0 );
      } else if (strstr( pars[0], "eycol" ) != NULL) {
         iret = getminmax( "eycolumn", 0 );
      }
      else
      {
         if (npar == 0)
         {
            anylog( 1, command, "Needs argument(s)" );
            return( 0 );
         }
         else
         {
            for (i = 0; i < 2; i++)
            {
               r = dcdreal_c( tofchar(pars[i]), &minmax[i], &one, &err );
               if (r != 1)
               {
                  anylog( 1, command, "Cannot convert minmax!" );
                  return( 0 );
               }
            }
         }
         iret = 1;
      }
      return( iret );
   }


   if (!strcmp(command,"mmeter"))
   {
      /* (Back) to mm's and using entire surface */
      setupmm( &devx1mm, &devx2mm, &devy1mm, &devy2mm );
      world = NO;
      return(1);
   }



   if (!strcmp(command,"mosaic"))
   {
      return( mosaicmacro() );
   }



   if (!strcmp(command,"mosframe"))
   {
      int      x, y;
      int      storeX, storeY;
      float    ch, storech;

      if (!mosaic)
      {
         anylog( 1, command, "No mosaic set!" );
         return( 0 );
      }
      storeX = mosposX;
      storeY = mosposY;
      pgqch_c( &storech );
      ch = storech * pow(0.9,(moscols-1));
      pgsch_c( &ch );
      for (x = 1; x <= moscols; x++)
      {
         for (y = 1; y <= mosrows; y++)
         {
            sprintf( message, "%d %d", x, y );
            (void) execom( "mosxy", message );
            if (x == 1)
            {
               if (inset)
                  (void) execom( "axis", "lp" );
               else
                  (void) execom( "axis", "lw" );
               if (y == 1)
               {
                  titleXY[7] = mosaic_Yorgmm + mosaic_Ytot / 2.0;
                  pgsch_c( &storech );
                  (void) execom( "axtitle", "" );
                  pgsch_c( &ch );
               }
            }
            else
               (void) execom( "axis", "l" );
            if (y == 1)
            {
               if (inset)
                  (void) execom( "axis", "bp" );
               else
                  (void) execom( "axis", "bw" );
               if (x == 1)
               {
                  titleXY[0] = mosaic_Xorgmm + mosaic_Xtot / 2.0;
                  pgsch_c( &storech );
                  (void) execom( "axtitle", "" );
                  pgsch_c( &ch );
               }
            }
            else
               (void) execom( "axis", "b" );
            (void) execom( "axis", "r" );
            (void) execom( "axis", "t" );
         }
      }
      pgsch_c( &storech );
      /* Reset to the start panel */
      sprintf( message, "%d %d", storeX, storeY );
      (void) execom( "mosxy", message );
      return( 1 );
   }


   if (!strcmp(command,"moslxly"))
   {
      static double  local_Xscale, local_Yscale;
      if (npar == 0)
      {
         if (!mosaic)
         {
            anylog( 1, command, "No mosaic set!" );
            return( 0 );
         }
         else
         {
            anylog( 1, command, "Reset mosaic" );
            mosaic  = NO;
            moscols = 1;
            mosrows = 1;
            mosposX = 1;
            mosposY = 1;
            Xorgmm = mosaic_Xorgmm;
            Yorgmm = mosaic_Yorgmm;
            Xscale = local_Xscale;
            Yscale = local_Yscale;
            return( 1 );
         }
      }
      /* New mosaic wanted, reset first */
      if (mosaic)
      {
         (void) execom( "moslxly", "" );
      }
      if (npar > 0)
      {
         r = dcdint_c( tofchar(pars[0]), &moscols, &one, &err);
         if (err)
         {
            dcderror( err );
            return( 0 );
         }
         mosrows = 1;
      }
      if (npar > 1)
      {
         r = dcdint_c( tofchar(pars[1]), &mosrows, &one, &err);
         if (err)
         {
            dcderror( err );
            return( 0 );
         }
      }
      mosaic_Xtot   = (worldbox[2] - worldbox[0]) / Xscale;
      mosaic_Ytot   = (worldbox[3] - worldbox[1]) / Yscale;
      mosaic_Xorgmm = Xorgmm;
      mosaic_Yorgmm = Yorgmm;
      mosaic_Xlen   = (worldbox[2] - worldbox[0]) / (Xscale * moscols);
      mosaic_Ylen   = (worldbox[3] - worldbox[1]) / (Yscale * mosrows);
      local_Xscale  = Xscale;
      local_Yscale  = Yscale;
      mosaic = YES;
      /* Columns and rows are entered */
      Xscale *= (float) moscols;
      Yscale *= (float) mosrows;
      /* Select upper left panel as a start position */
      sprintf( message, "%d %d", 1, mosrows );
      (void) execom( "mosxy", message );
      return( 1 );
   }

   if (!strcmp(command,"mosnext"))
   {
      fint    x, y;
      x = mosposX + 1;
      y = mosposY;
      if (x > moscols)
      {
         x = 1;
         y -= 1;
      }
      sprintf( message, "%d %d", x, y );
      return( execom("mosxy", message) );
   }

   if (!strcmp(command,"mosprev"))
   {
      fint    x, y;
      x = mosposX - 1;
      y = mosposY;
      if (x < 1)
      {
         x = 1;
         y += 1;
      }
      sprintf( message, "%d %d", x, y );
      return( execom("mosxy", message) );
   }


   if (!strcmp(command,"mosxy"))
   {
      if (!mosaic)
      {
         anylog( 1, command, "No mosaic set!" );
         return( 0 );
      }
      if (npar > 0)
      {
         r = dcdint_c( tofchar(pars[0]), &mosposX, &one, &err);
         if (err)
         {
            dcderror( err );
            return( 0 );
         }
      }
      if (npar > 1)
      {
         r = dcdint_c( tofchar(pars[1]), &mosposY, &one, &err);
         if (err)
         {
            dcderror( err );
            return( 0 );
         }
      }
      if (mosposX < 1 || mosposX > moscols)
      {
         anylog( 1, command, "mosaic x out of range!" );
         return( 0 );
      }
      if (mosposY < 1 || mosposY > mosrows)
      {
         anylog( 1, command, "mosaic y out of range!" );
         return( 0 );
      }
      Xorgmm = mosaic_Xorgmm + (mosposX-1) * mosaic_Xlen;
      Yorgmm = mosaic_Yorgmm + (mosposY-1) * mosaic_Ylen;
      iret   = setbox( worldbox );
      return( iret );
   }


   if (!strcmp(command,"move"))
   {
      fint    maxpos = 1;
      double  XY[2];
      if (!pgready(worldbox))
         return( 0 );
      r = getposition( Setin, subin[subsetindex],
                       maxpos,
                       params, pars, npar,
                       XY );
      if (r != 1)
      {
         anylog( 1, command, "needs 2 numbers!" );
         return( 0 );
      }
      plmove( XY[0], XY[1] );
      return( 1 );
   }


   if (!strcmp(command,"overbox"))
   {
      int r;
      if (!inset)
      {
         anylog( 1, command, "No set opened yet, use command 'inset' to open set!" );
         return( 0 );
      }
      if (!prevset)
      {
         anylog( 1, command, "There is not a 'previous' set defined!" );
         return( 0 );
      }

      /*----------------------------------------------------*/
      /* Get the maximum box of the new set that is totally */
      /* included in the previous box.                      */
      /*----------------------------------------------------*/

      r = getoverlaybox( prevSetin, prevsubin,
                         Setin, subin[subsetindex],
                         prevworldbox, worldbox );
      if (r != 0)
      {
         if (r == -1) anylog( 1, command, "No part of overlay is contained in original box");
         if (r  >  0) anylog( 1, command, "Problems with coordinate transformations.");
         return( 0 );
      }
      else
      {
         sprintf( message, "New box:[ %g %g %g %g]", worldbox[0], worldbox[1],
                  worldbox[2], worldbox[3] );
         anylog( 1, command, message );
      }
      return( 1 );
   }


   if (!strcmp(command,"overlay"))
   {
      double   gridXY[2];
      double   physXY[2];
      double   dumXY[2];
      fint     phys2grid = 0;
      fint     grid2phys = 1;
      int      k;
      fint     r1, r2;


      if (!inset)
      {
         anylog( 1, command,
                "No set opened yet, use command 'inset' to open set!" );
         return( 0 );
      }
      if (!prevset)
      {
         anylog( 1, command, "There is not a 'previous' set defined!" );
         return( 0 );
      }

      /*------------------------------------------------------------*/
      /* Start overlay with the overlay keyword without a parameter */
      /* or with parameters containing sub strings "on" or "y"      */
      /*------------------------------------------------------------*/
      if ((npar == 0) || (strstr( pars[0], "on" ) != NULL) ||
                         (strstr( pars[0], "y"  ) != NULL))
      {
         /* Set new scales and location, store old values first */
         storeXscale = Xscale;  storeYscale = Yscale;
         storeXorgmm = Xorgmm;  storeYorgmm = Yorgmm;
         for (k = 0; k < 4; k++)     /* Store in case something wents wrong */
            storeworldbox[k] = worldbox[k];
         anylog( 1, command, "Overlay mode is ON" );

         /*---------------------------------------------------------------*/
         /* The lower left corner of the overlay is in 'worldbox[0]/[1]'. */
         /* This grid is converted to a physical value that belongs to    */
         /* the overlay set. But that value can be converted to a grid    */
         /* position that belongs to the previous set. The difference in  */
         /* grids of this position and the values in 'prevworldbox[0]/[1]'*/
         /* is used to calculate a new origin in mm using the values of   */
         /* X/Yscale before the scales are recalculated.                  */
         /*---------------------------------------------------------------*/
         gridXY[0] = worldbox[0];
         gridXY[1] = worldbox[1];
         r1 = cotrans_c( Setin, &subin[subsetindex], gridXY, physXY, &grid2phys );
         r2 = 0;
         if (r1 == 0)
         {
            dumXY[0] = physXY[axnum[0]-1];
            dumXY[1] = physXY[axnum[1]-1];
            r2 = cotrans_c( prevSetin, &prevsubin,
                            dumXY, gridXY, &phys2grid );
         }
         if ((r1 != 0) || (r2 != 0))    /* COTRANS problem, restore old values */
         {
            Xscale = storeXscale; Yscale = storeYscale;
            Xorgmm = storeXorgmm; Yorgmm = storeYorgmm;
            for (k = 0; k < 4; k++)
               worldbox[k] = storeworldbox[k];
            return( 0 );
         }

         Xorgmm += (gridXY[prevax1]-prevworldbox[0]) / Xscale;
         Yorgmm += (gridXY[prevax2]-prevworldbox[1]) / Yscale;

         Xscale *= prevcdelt[0]/cdelt[0];
         Yscale *= prevcdelt[1]/cdelt[1];


#ifdef qqqqqqq
      double   xmm, ymm;
         /*-----------------------------------------------------*/
         /* Determine the position of 0,0 in the previous set   */
         /* wrt.  the frame of the previous set. (i.e. wrt. the */
         /* origin and box of that set.                         */
         /*-----------------------------------------------------*/
         gridXY[0] = gridXY[1] = 0.0;
         Xorgmm += (gridXY[0]-prevworldbox[0])/Xscale;
         Yorgmm += (gridXY[1]-prevworldbox[1])/Yscale;

         /*----------------------------------------------------------------*/
         /* The contents of 'worldbox' has changed now. A new origin in mm */
         /* can be calculated. For this we started calculating the physical*/
         /* values of grid (0,0) in the previous set and also the corres-  */
         /* sponding position in mm as a origin. For these values we       */
         /* calculate the grids in the overlay set. The new origin in mm   */
         /* can be determined with this grid, the new scale and the lower  */
         /* left corner of the new box.                                    */
         /*----------------------------------------------------------------*/

         /*-----------------------------------------------------------------*/
         /* Adjust the scales. This must be done after the call to world2mm */
         /* because this routine makes use of the old values of the scale.  */
         /*-----------------------------------------------------------------*/
         Xscale = Xscale * (float) (prevcdelt[0]/cdelt[0]);
         Yscale = Yscale * (float) (prevcdelt[1]/cdelt[1]);
         r1 = cotrans_c( prevSetin, &prevsubin, gridXY, physXY, &grid2phys );
         r2 = 0;
         if (r1 == 0)
         {
            dumXY[0] = physXY[prevax1];
            dumXY[1] = physXY[prevax2];
            r2 = cotrans_c( Setin, &subin[subsetindex],
                            dumXY, gridXY, &phys2grid );
         }
         if ((r1 != 0) || (r2 != 0))    /* COTRANS problem, restore old values */
         {
            Xscale = storeXscale; Yscale = storeYscale;
            Xorgmm = storeXorgmm; Yorgmm = storeYorgmm;
            for (k = 0; k < 4; k++)
               worldbox[k] = storeworldbox[k];
            return( 0 );
         }
         /* New origin in mm determined with new scale. */

         xmm = (float)((gridXY[axnum[0]-1] - (double)worldbox[0]) / (double)Xscale);
         ymm = (float)((gridXY[axnum[1]-1] - (double)worldbox[1]) / (double)Yscale);

         Xorgmm -= xmm;
         Yorgmm -= ymm;
#endif


         /*-----------------------------*/
         /* Make the new box effective. */
         /*-----------------------------*/
         if (okbox(worldbox))
            iret = setbox( worldbox );
         overlay = YES;
      }
      else     /* Overlay off, restore old values */
      {
         if ((storeXscale != dblank) && (storeYscale != dblank) &&
             (storeXorgmm != dblank) && (storeYorgmm != dblank))
         {
            Xscale = storeXscale;
            Yscale = storeYscale;
            Xorgmm = storeXorgmm;
            Yorgmm = storeYorgmm;
            for (k = 0; k < 4; k++)
               worldbox[k] = storeworldbox[k];
            if (okbox(worldbox))
               iret = setbox( worldbox );
         }
         overlay = NO;
         anylog( 1, command, "Overlay mode is OFF" );
      }
      return( 1 );
   }


   if (!strcmp(command,"page"))
   {
      if (!pgready(worldbox))
         return( 0 );
      pgpage_c();
      return( 0 );
   }


   if (!strcmp(command,"pattern"))
   {
      float  pat[8];
      int    i;
      int    numpat = 0;
      fint   maxpat = 8;
      fint   r;

      if (npar == 0)
         return( 0 );
      for (i = 0; i < 8; i++)
         pat[i] = 10.0;
      for (i = 0; i < npar; i++)
      {
         r = dcdreal_c( tofchar(pars[i]), &pat[numpat], &maxpat, &err );
         if (err)
            dcderror( err );
         else
         {
            numpat += r;
            maxpat -= r;
         }
      }
      for (i = 0; i < 8; i++)
         pat[i] = ABS(pat[i]);

      pgpat_c( pat );
      return( 1 );
   }


   if (!strcmp(command,"pause"))
   {
      fchar Con;
      fmake( Con, 1 );
      dfault = REQUEST;
      r = usertext_c( Con, &dfault, KEY_PRESS,
                      tofchar("Press carriage return to continue: ") );
      cancel_c( KEY_PRESS );
      return( 1 );
   }


   if (!strcmp(command,"pgframe"))
   {
      float  XYtick[2];
      fint   xysub[2];
      char   *optstrX;
      char   *optstrY;

      /* defaults: */
      XYtick[0] = XYtick[1] = 0.0;
      xysub[0] = xysub[1] = 0;

      if (!pgready(worldbox))
         return( 0 );
      if (npar > 5)
      {
         r = dcdint_c( tofchar(pars[5]), &xysub[1], &one, &err);
         if (r != 1)
            xysub[1] = 0;
      }
      if (npar > 4)
      {
         r = dcdreal_c( tofchar(pars[4]),&XYtick[1], &one, &err);
         if (r != 1)
            XYtick[1] = 0.0;
      }
      if (npar < 4)
         optstrY = StrDup( "BCNSTV" );
      else
         optstrY = StrDup( pars[3] );

      if (npar > 2)
      {
         r = dcdint_c( tofchar(pars[2]), &xysub[0], &one, &err);
         if (r != 1) xysub[0] = 0;
      }
      if (npar > 1)
      {
         r = dcdreal_c( tofchar(pars[1]),&XYtick[0], &one, &err);
         if (r != 1)
            XYtick[0] = 0.0;
      }
      if (npar < 1)
         optstrX = StrDup( "BCNST" );
      else
         optstrX = StrDup( pars[0] );

      /* Sometimes it gives a better layout if the box is a little */
      /* bit bigger to enclose f.i. all (gray scale) pixels.       */

      if ((gridmargin[0] != 0.0) || (gridmargin[1] != 0.0))
      {
         float x1mmO, x2mmO, y1mmO, y2mmO;
         float x1winN, x2winN, y1winN, y2winN;
         float x1winO, x2winO, y1winO, y2winO;
         fint  mm = 2;
         float x1in, x2in, y1in, y2in;
         float dx, dy;

         pgqvp_c( &mm, &x1mmO, &x2mmO, &y1mmO, &y2mmO );
         dx = gridmargin[0];
         dy = gridmargin[1];

         x1in = (x1mmO - dx) / 25.4;            /* convert mm to inches */
         x2in = (x2mmO + dx) / 25.4;
         y1in = (y1mmO - dy) / 25.4;
         y2in = (y2mmO + dy) / 25.4;
         plvsiz( x1in, x2in, y1in, y2in );

         pgqwin_c( &x1winO, &x2winO, &y1winO, &y2winO );
         x1winN = x1winO - (float) gridmargin[0];
         x2winN = x2winO + (float) gridmargin[0];
         y1winN = y1winO - (float) gridmargin[1];
         y2winN = y2winO + (float) gridmargin[1];
         pgswin_c( &x1winN, &x2winN, &y1winN, &y2winN );
         pgbox_c( tofchar(optstrX), &XYtick[0], &xysub[0],
                  tofchar(optstrY), &XYtick[1], &xysub[1] );
         /* Now back to original situation */
         x1in = x1mmO / 25.4;                   /* convert mm to inches */
         x2in = x2mmO / 25.4;
         y1in = y1mmO / 25.4;
         y2in = y2mmO / 25.4;
         plvsiz( x1in, x2in, y1in, y2in );
         pgswin_c( &x1winO, &x2winO, &y1winO, &y2winO );
      }
      else
      {
         pgbox_c( tofchar(optstrX), &XYtick[0], &xysub[0],
                  tofchar(optstrY), &XYtick[1], &xysub[1] );
      }
      /* store current character height for use in x/ylabel commands */
      labelsize = charheight;                  /* in mm */
      if (optstrX)
         free( optstrX );
      if (optstrY)
         free( optstrY );
      return(1);
   }


   if (!strcmp(command,"pgviewport"))
   {
      if (!pgready(worldbox))
         return( 0 );
      if (npar != 4)
      {
         anylog( 1, command,"needs 4 arguments!" );
         return(0);
      }
      else
      {
         float xmm[4];
         float xin[4];
         for (i = 0; i < 4; i++)
         {
            dcdreal_c( tofchar(pars[i]), &xmm[i], &one, &err );
            xin[i] = xmm[i]/25.4;                       /* convert mm to inches */
         }
         plvsiz( xin[0], xin[2], xin[1], xin[3] );
         pgswin_c( &xmm[0], &xmm[2], &xmm[1], &xmm[3] );
      }
      return(1);
   }


   if (!strcmp(command,"playback"))
   {
      preset();
      if (npar)
         iret = device( npar, pars[0], nsubx, nsuby );
      else
         iret = device( 1, curdevnam, nsubx, nsuby );
      exemacro( 0, "\0" );
      return( 0 );
   }


   if (!strcmp(command,"plotinfo"))
   {
      return( plotinfo() );
   }


   if ( !strcmp(command,"points") || !strcmp(command,"connect") )
   {
      fint    npoints = MYMIN(vectsize[XARRAY], vectsize[YARRAY]);
      bool    con = NO;

      if (!pgready(worldbox))
         return( 0 );

      con = !strcmp(command,"connect");
      if (npoints > 0 && vect[XARRAY] != NULL && vect[YARRAY] != NULL)
      /*--------------------------------------------------*/
      /* If parameter is 'b' then connect all non blank   */
      /* values, else skip blank values so the connecting */
      /* lines will be cut into parts.                    */
      /*--------------------------------------------------*/
      {
         fint   arlen = 0;
         fint   start = 0;
         int    i;

         if (con && npar > 0)
         {
            if (toupper(pars[0][0]) == 'B')
            {
               float *X = NULL;
               float *Y = NULL;
               fint   j;

               X = (float *) calloc( npoints, sizeof(float) );
               Y = (float *) calloc( npoints, sizeof(float) );
               if (X == NULL || Y == NULL)
               {
                  anylog( 1, command, "Cannot allocate memory for X/Y arrays!" );
                  return( 0 );
               }
               for (j = 0, i = 0; i < npoints; i++)
               {
                  if (vect[XARRAY][i] != blank && vect[YARRAY][i] != blank)
                  {
                     X[j] = vect[XARRAY][i];
                     Y[j] = vect[YARRAY][i];
                     j++;
                  }
               }
               pgline_c( &j, X, Y );
               free( X );
               free( Y );
            }
            else
            {
               anylog( 1, command, "Unknown parameter!" );
               return( 0 );
            }
         }

         /*------------------------------------------------------------*/
         /* Plot all non blank points (and optionally connect them)    */
         /* by examining all points. Start plotting only if one of     */
         /* the coordinates is a blank or if the last point has        */
         /* been examined.                                             */
         /*------------------------------------------------------------*/
         arlen = 0;
         start = 0;
         for (i = 0; i < npoints; i++)
         {
            if (vect[XARRAY][i] != blank && vect[YARRAY][i] != blank)
               arlen++;
            if ( (i+1) == npoints || vect[XARRAY][i] == blank || vect[YARRAY][i] == blank )
            {
               if (arlen > 0)
               {
                  if (con)
                     pgline_c( &arlen, &vect[XARRAY][start], &vect[YARRAY][start] );
                  else
                     pgpt_c( &arlen, &vect[XARRAY][start], &vect[YARRAY][start], &symbol );
                  arlen = 0;
               }
               start = i + 1;
            }
         }
      }
      else
      {
         anylog( 1, command,"One of the array lengths is 0." );
         return( 0 );
      }
      return( 1 );
   }


   if (!strcmp(command,"polmode"))
   {
      if (npar == 0)
      {
         (void) sprintf( message, "Current mode POLARISATION angles: %c", polmode );
         anylog( 1, "inquiry", message );
         return( 1 );
      }
      if (toupper(pars[0][0]) == 'R')
         polmode = 'R';
      else if (toupper(pars[0][0]) == 'D')
         polmode = 'D';
      else
      {
         anylog( 1, command, "Mode is not one of D(egree) or R(adian)" );
         return( 0 );
      }
      return( 1 );
   }


   if (!strcmp(command,"polplot"))
   {
      fint   blo[2], bhi[2];
      int    m;

      if (!polset)
      {
         anylog( 1, command, "Need a set with angles first!" );
         return( 0 );
      }
      polgrid[0] = polgrid[1] = 1;
      for (m = 0; m < MYMIN(npar,2); m++)
      {
         r = dcdint_c( tofchar(pars[m]), &polgrid[m], &one, &err );
         if (err)
         {
            dcderror( err );
            return( 0 );
         }
         else
            polgrid[m] = MYMAX( 1, polgrid[m] );
      }
      poltrans = blank;
      if (npar > 2)
      {
         r = dcdreal_c( tofchar(pars[2]), &poltrans, &one, &err );
         if (err)
         {
            dcderror( err );
            return( 0 );
         }
      }

      for (m = 0; m < 2; m++)
      {
         blo[m] = (fint) worldbox[m];
         bhi[m] = (fint) worldbox[m+2];
      }
      return( plotpolvectors( Setin,
                              Setang,
                              subin[subsetindex],
                              subang[subsetindex],
                              polgrid,
                              poltrans,
                              polmode ) );
   }


   if (!strcmp(command,"polset"))
   {
      fint   n;
      fint   angsubdim;
      fint   showdev = 16;          /* Device number (as in ANYOUT) for info */
      fint   angaxnum[MAXAXES];
      fint   angaxcount[MAXAXES];   /* Array of size MAXAXES containing the */


      if (!inset)
      {
         anylog( 1, command, "Need an 'inset' first!" );
         return( 0 );
      }
      if (strlen(params) != 0)
         dfault = HIDDEN;
      else
         dfault = REQUEST;
      angsubdim = subdim;
      str2char( params, Setang );

      n = gdsinp_c( Setang,
                    subang,
                    &maxsubs,      /* Maximum number of subsets */
                    &dfault,       /* Default code as is USERxxx. */
                    tofchar("POLSET="),
                    tofchar("Give set(,subsets) with polarisation angles:"),
                    &showdev,      /* Device number (as in ANYOUT). */
                    angaxnum,      /* Array of size 'maxaxes' containing the axes numbers. */
                    angaxcount,    /* Number of grids on axes in 'axnum' */
                    &maxaxes,      /* Max. allowed axes */
                    &class,        /* Input class == 1 */
                    &angsubdim );  /* Dimensionality of the subsets */
      cancel_c( tofchar("POLSET=") );
      if (n != nsubs)
      {
         (void) sprintf( message, "You need to specify %d subsets", nsubs );
         anylog( 1, command, message );
         return( 0 );
      }


      /*-------------------------------*/
      /* Determine edges of this frame */
      /*-------------------------------*/
      {
         fint cwlo, cwhi;                          /* Local coordinate words */
         fint r1 = 0, r2 = 0;
         int  m;
         int  inside;

         gdsc_range_c( Setang, &setlevel, &cwlo, &cwhi, &r1 );
         r1 = r2 = 0;
         inside = YES;
         for (m = 0; m < (int) subdim; m++)
         {
            fint  blo, bhi;
            fint  aflo, afhi;
            blo = (fint) worldbox[m];
            bhi = (fint) worldbox[m+2];
            aflo = gdsc_grid_c( Setang, &angaxnum[m], &cwlo, &r1 );
            afhi = gdsc_grid_c( Setang, &angaxnum[m], &cwhi, &r2 );
            inside = (inside && (blo >= aflo) && (bhi <= afhi));
         }
         if (!inside)
         {
            anylog( 1, command, "Current box does not fit in this set!" );
            return( 0 );
         }
      }
      polset = YES;
      return( 1 );
   }


   if (!strcmp(command,"poly"))
   {
      fint len = MYMIN(vectsize[XARRAY], vectsize[YARRAY]);
      if (!pgready(worldbox))
         return( 0 );
      if ((len > 0) && (vect[XARRAY] != NULL) && (vect[YARRAY] != NULL))
      {
         fint  i;
         for (i = 0; i < len; i++)
         {
            if (vect[XARRAY][i] == blank)
            {
               (void) sprintf( message, "X column contains blank at position %d", i+1 );
               anylog( 1, command, message );
               return( 0 );
            }
            if (vect[YARRAY][i] == blank)
            {
               (void) sprintf( message, "Y column contains blank at position %d", i+1 );
               anylog( 1, command, message );
               return( 0 );
            }
         }
         pgpoly_c( &len, vect[XARRAY], vect[YARRAY] );
      } else
         anylog( 1, command, "xcolumn or ycolumn are empty!" );

      return( 1 );
   }


   if (!strcmp(command,"pplot"))
   {
      return( pplotmacro() );
   }


   if (!strcmp(command,"printusing"))
   {
      if (printusingstr != NULL)
      {
         free( printusingstr );
         printusingstr = NULL;
      }
      if (npar > 0)
      {
         printusingstr = malloc( strlen(pars[0]) + 1 );
         if (printusingstr == NULL)
         {
            anylog( 1, command, "Cannot allocate space for format string!" );
            return( 0 );
         }
         strcpy( printusingstr, pars[0] );
      }
      return( 1 );
   }


   if (!strcmp(command,"profdata"))
   {
      int      npoints;
      int      k;
      char     cbuff[FITSLEN];

      /* Prepare a profile message with position and integration */
      if (nsubs == 1)
      {
         if (profint)
         {
            strcpy( message, "Profile (int:" );
            for (k = 0; k < subdim; k++)
            {
               if (k)
                  strcat( message, "x" );
               (void) sprintf( cbuff, "%d", profintsize[k] );
               strcat( message, cbuff );
            }
            strcat( message, ") in (" );
         }
         else
            strcpy( message, "Profile in (" );
         for (k = 0; k < subdim; k++)
         {
            if (k)
               strcat( message, "," );
            (void) sprintf( cbuff, "%s", strtok(Ctype[k].a, " -") );
            strcat( message, cbuff );
         }
         strcat( message, ") from (" );
         for (k = 0; k < subdim; k++)
         {
            if (k)
               strcat( message, "," );
            (void) sprintf( cbuff, "%d", profblo[k] );
            strcat( message, cbuff );
         }
         strcat( message, ") to (" );
         for (k = 0; k < subdim; k++)
         {
            if (k)
               strcat( message, "," );
            (void) sprintf( cbuff, "%d", profbhi[k] );
            strcat( message, cbuff );
         }
         strcat( message, ")" );
      }
      else
      {
         if (profint)
         {
            strcpy( message, "Profile (int:" );
            for (k = 0; k < subdim; k++)
            {
               if (k)
                  strcat( message, "x" );
               (void) sprintf( cbuff, "%d", profintsize[k] );
               strcat( message, cbuff );
            }
            strcat( message, ") at position (" );
         }
         else
            (void) sprintf( message, "Profile at position (" );
         for (k = 0; k < subdim; k++)
         {
            if (k)
               strcat( message, "," );
            (void) sprintf( cbuff, "%s", strtok(Ctype[k].a, " -") );
            strcat( message, cbuff );
         }
         strcat( message, ") = (" );
         for (k = 0; k < subdim; k++)
         {
            if (k)
               strcat( message, "," );
            (void) sprintf( cbuff, "%d", profblo[k] );
            strcat( message, cbuff );
         }
         strcat( message, ")" );
      }
      anylog( 16, command, message );
      strcpy( profiletxt, message );      /* Store info about profile */

      /* Fill the columns with profile data */
      npoints = fillprofile( Setin,
                             subin,       /* Send all subsets! */
                             nsubs,       /* Number of subsets */
                             profblo, profbhi,
                             profintsize,
                             profint,
                             command,
                             &profsubset );

      if (npoints == 0)
      {
         anylog( 1, command, "No points in profile!");
         return( 0 );
      }
      else
      {
         (void) sprintf( message, "There are %d profile elements stored in 'xcolumn', 'ycolumn'",
                         npoints );
         anylog( 1, command, message );
      }
      return( 1 );
   }


   if (!strcmp(command,"profint"))
   {
      fint     dfault;
      int      k;
      char     cbuff[FITSLEN];

      if (!inset)
      {
         anylog( 1, command, "No set opened yet, use command 'inset' to open set!" );
         return( 0 );
      }
      if (npar == 0)
      {
         if (subdim > 1)
            strcpy( message, "Integration sizes in (" );
         else
            strcpy( message, "Integration size in (" );
         for (k = 0; k < subdim; k++)
         {
            if (k)
               strcat( message, "," );
            (void) sprintf( cbuff, "%s", strtok(Ctype[k].a, " -") );
            strcat( message, cbuff );
            profintsize[i] = 0;
         }
         strcat( message, "):    [no integration]" );
         dfault = REQUEST;
         r = userint_c( profintsize, &subdim, &dfault,
                        KEY_PROFINT,
                        tofchar(message) );
         cancel_c( KEY_PROFINT );
         profint = (r != 0);
      }
      else
      {
         for (i = 0; i < MYMAX(npar,subdim); i++)
         {
            r = dcdint_c( tofchar(pars[i]), &profintsize[i], &one, &err );
            if (err)
            {
               dcderror( err );
               return( 0 );
            }
            profintsize[i] = ABS( profintsize[i] );
         }
         profint = YES;
      }
      return( 1 );
   }



   if (!strcmp(command,"profile"))
   {
      double   dummy[2*MAXAXES];
      fint     dfault = HIDDEN;
      fint     maxpos = 2;
      int      k;
      char     cbuff[FITSLEN];

      if (!inset)
      {
         anylog( 1, command, "No set opened yet, use command 'inset' to open set!" );
         return( 0 );
      }
      /*--------------------------------------------------*/
      /* This routine plots only one profile at a time.   */
      /* This implies that the input can be given in      */
      /* 1) The set and ONE subset can be given. Then a   */
      /*    start and an end point must be specified with */
      /*    dimensionality equal to the dimension of the  */
      /*    subset.                                       */
      /* 2) The set name is given and more than one       */
      /*    subsets. Then just one position must be       */
      /*    entered with dimensionality equal to the      */
      /*    dimension of the set minus the dimension of   */
      /*    the subsets.                                  */
      /*--------------------------------------------------*/
      if (npar == 0)
      {
         int    agreed;
         /* No parameters, create keyword and prompt */

         if (nsubs == 1)
         {
            strcpy( message, "Profile from (" );
            for (k = 0; k < subdim; k++)
            {
               if (k)
                  strcat( message, "," );
               (void) sprintf( cbuff, "%s1", strtok( Ctype[k].a, " -" ) );
               strcat( message, cbuff );
            }
            strcat( message, ") to (" );
            for (k = 0; k < subdim; k++)
            {
               if (k)
                  strcat( message, "," );
               (void) sprintf( cbuff, "%s2", strtok( Ctype[k].a, " -" ) );
               strcat( message, cbuff );
            }
            strcat( message, "):   [abort]");
         }
         else
         {
            strcpy( message, "Give position in (" );
            for (k = 0; k < subdim; k++)
            {
               if (k)
                  strcat( message, "," );
               (void) sprintf( cbuff, "%s1", strtok( Ctype[k].a, " -" ) );
               strcat( message, cbuff );
            }
            strcat( message, "):   [abort]");
         }
         dfault = REQUEST;

         do
         {
            fchar  Postxt;
            char   mbuff[30];
            fmake( Postxt, 120 );

            if (nsubs == 1)
            {
               r = usertext_c( Postxt, &dfault, KEY_PROFILE, tofchar(message) );
               r = dcdpos_c( Setin, &subin[subsetindex], Postxt, dummy, &maxpos );
               agreed = (r == 0 || r == 2);
               if (!agreed && r != 2)
               {
                  char   mbuff[30];
                  (void) sprintf( mbuff, "Need 2 pos.(=%d numbers)!", 2*subdim );
                  reject_c( KEY_PROFILE, tofchar(mbuff) );
               }
               else
                  cancel_c( KEY_PROFILE );
            }
            else
            {
               r = usertext_c( Postxt, &dfault, KEY_POSITION, tofchar(message) );
               r = dcdpos_c( Setin, &subin[subsetindex], Postxt, dummy, &maxpos );
               agreed = (r == 0 || r == 1);
               if (!agreed && r != 1)
               {
                  (void) sprintf( mbuff, "Need 1 pos.(=%d numbers)!", 1*subdim );
                  reject_c( KEY_POSITION, tofchar(mbuff) );
               }
               else
                  cancel_c( KEY_POSITION );
            }
         }
         while (!agreed);

         if (r == 0)            /* Nothing else tot do */
            return( 0 );
      }
      else           /* Some parameters are supplied, convert these positions */
      {
         r = dcdpos_c( Setin, &subin[subsetindex],
                       tofchar(params), dummy, &maxpos );
         if (r < 0)
         {
            poserr( message, r );
            anylog( 1, command, message );
            return( 0 );
         }

         /* One subset ==> 2 positions: */
         if (nsubs == 1 && r != 2)
         {
            anylog( 1, command, "Need two positions!" );
            return( 0 );
         }
         if (nsubs > 1 && r != 1)
         {
            anylog( 1, command, "Need one position!" );
            return( 0 );
         }
      }

      /* Check the positions */
      for (k = 0; k < subdim; k++)
      {
         profblo[k] = NINT( dummy[k] );
         if (nsubs == 1)                  /* There is also an upper grid */
         {
            profbhi[k] = NINT( dummy[k+subdim] );
            if (profblo[k] < flo[k] || profblo[k] > fhi[k])
            {
               (void) sprintf( message, "lo[%d]=%d is out of range (min=%d)",
                               k, profblo[k], flo[k] );
               anylog( 1, command, message );
               return( 0 );
            }
            if (profbhi[k] > fhi[k] || profbhi[k] < flo[k])
            {
               (void) sprintf( message, "hi[%d]=%d is out of range (max=%d)",
                               k, profbhi[k], fhi[k] );
               anylog( 1, command, message );
               return( 0 );
            }
         }
         else
         {
            profbhi[k] = profblo[k];
            if (profblo[k] < flo[k] || profblo[k] > fhi[k])
            {
               (void) sprintf( message, "position[%d]=%d is out of range (min=%d)",
                               k, profblo[k], flo[k] );
               anylog( 1, command, message );
               return( 0 );
            }
         }
      }
      return( 1 );
   }


   if (!strcmp(command,"profinfo"))
   {
      return( pltext( command,
                      currentXY[0],
                      currentXY[1],
                      angle,
                      justification,
                      Setin, subin[subsetindex], axnum,
                      profiletxt ) );
   }


   if (!strcmp(command,"storelut"))
   {
      if (!inset)
      {
          anylog( 1, command, "No set opened yet, use command 'inset' to open set");
          return( 0 );
      }
      if (!getlut)
      {
         if (!execute( "getlut", "\0", NULL, 0 ))
            return( 0 );
      }
      /* Store data on subset level */
      return( luttotable( Setin, subin[0], lutlen, lutr, lutg, lutb,
                          GIDSmincol, GIDSmaxcol, GIDSncolors,
                          GIDSbscale, GIDSbzero, GIDSblank ) );
   }


   if (!strcmp(command,"subset"))
   {
      fint   indx;
      if (!inset)
      {
         anylog( 1, command, "No set opened yet, use command 'inset' to open set!" );
         return( 0 );
      }
      if (npar == 0)
      {
         (void) sprintf( message, "Subset index number (not grid) is [%d]", subsetindex );
         anylog( 1, command, message );
         return( 1 );
      }
      if (npar > 0)
      {
         r = dcdint_c( tofchar(pars[0]), &indx, &one, &err );
         if (r != 1)
         {
            anylog( 1, command, "Cannot convert subset number!" );
            return( 0 );
         }
      }
      if ((indx < 0) || (indx >= nsubs))
      {
         (void) sprintf( message, "Subset index number must be in range [0,%d]", nsubs-1 );
         anylog( 1, command, message );
         return( 0 );
      }
      else
         subsetindex = (int) indx;

      return( 1 );
   }


   if (!strcmp(command,"rectangle"))
   {
      double  dummy[4];

      fint    maxpos = 2;
      if (!pgready(worldbox))
         return( 0 );

      if (npar < 2)
         return( 0 );

      if (npar == 2)                  /* must be lengths */
      {
         double  xlen, ylen;
         for (i = 0; i < 2; i++)
         {
            r = dcddble_c( tofchar(pars[i]), &dummy[i], &one, &err );
            if (err)
            {
               dcderror( err );
               return( 0 );
            }
         }
         xlen = dummy[0];
         ylen = dummy[1];
         dummy[0] = currentXY[0];
         dummy[1] = currentXY[1];
         dummy[2] = dummy[0] + xlen;
         dummy[3] = dummy[1] + ylen;
      }
      else
      {
         r = getposition( Setin, subin[subsetindex], maxpos,
                          params, pars, npar, dummy );
         if (r == 0)
            return( 0 );

         if (r != 2)
         {
            anylog( 1, command, "needs 4 numbers!" );
            return( 0 );
         }
      }
      plrect( dummy[0], dummy[1], dummy[2], dummy[3] );
      return( 1 );
   }


   if (!strcmp(command,"reset"))
   {
      preset();
      return( 0 );
   }


   if (!strcmp(command,"setinfo"))
   {
      return( setinfo(headerok) );
   }


   if (!strcmp(command,"symbol"))
   {
      if (npar > 0)
      {
         r = dcdint_c( tofchar(pars[0]), &symbol, &one, &err );
         if (r != 1)
         {
            anylog( 1, command, "Cannot convert symbol number!" );
            return( 0 );
         }
      }
      return( 1 );
   }


   if (!strcmp(command,"task"))
   {
      /* Separate task name and keyword list */
      wkey_c( tofchar(&params[strlen(pars[0])+1]) );
      return( deputyC(pars[0], "task") );
   }


   if (!strcmp(command,"termlen"))
   {
      if (npar == 0)
      {
         (void) sprintf( message, "current length of error bar terminals as multiple of the");
         anylog( 1, command, message );
         (void) sprintf( message, "default length: %g (if 0.0, no terminals will be drawn)", termlen );
         anylog( 1, command, message );
      }
      else
      {
         r = dcdreal_c( tofchar(pars[0]), &termlen, &one, &err );
         if (r != 1)
         {
            anylog( 1, command, "Cannot convert this number!" );
            return( 0 );
         }
      }
      return( 1 );
   }


   if (!strcmp(command,"text"))
   {
      if (!pgready(worldbox))
         return( 0 );

      return( pltext( command,
                      currentXY[0],
                      currentXY[1],
                      angle,
                      justification,
                      Setin, subin[subsetindex], axnum,
                      params ) );
   }


   if (!strcmp(command,"ticksize"))
   {
      if (npar == 0)
      {
         (void) sprintf( message, "current tick size: %f (mm)", ticksize );
         anylog( 1, command, message );
      }
      else
      {
         r = dcddble_c( tofchar(pars[0]), &ticksize, &one, &err );
         if (r != 1)
         {
            anylog( 1, command, "cannot convert ticksize" );
            return( 0 );
         }
      }
      return( 1 );
   }


   if (!strcmp(command,"tomm"))
   {
      /* Convert x,y in world coords, to mm */
      double  x[2];
      double  xmm[2];

      if (!world)
      {
         anylog( 1, command, "Transformation not set, use 'world o1 o1 sc1 sc2' first" );
         return( 0 );
      }
      if (npar != 2)
      {
         anylog( 1, command, "needs 2 arguments!" );
         return( 0 );
      }
      for (i = 0; i < 2; i++)
      {
         r = dcddble_c( tofchar(pars[i]), &x[i], &one, &err );
         if (r != 1)
         {
            anylog( 1, command, "cannot convert position" );
            return(0);
         }
      }
      world2mm( x[0], x[1], &xmm[0], &xmm[1] );
      (void) sprintf( message, "<world to mm> (%g , %g) == (%g , %g) mm",
             x[0], x[1], xmm[0], xmm[1] );
      anyoutC( 1, message );
      return(1);
   }


   if (!strcmp(command,"toplabel"))
   {
      double   oldangle = angle;
      double   oldjust  = justification;
      double   x, y;
      int      status = 0;

      if (!pgready(worldbox))
         return( 0 );

      justification = 0.5;
      angle = 0.0;

      if (titleXY[4] != dblank && titleXY[5] != dblank)
      /*--------------------------------------------------*/
      /* There is a default position obtained by a previ- */
      /* ous call to 'axis T'.                            */
      /*--------------------------------------------------*/
      {
         x = titleXY[4];
         y = titleXY[5] + TITLEOFF_Y * charheight;
         iret = execute( "mmeter", "\0", NULL, 0 );
         status = pltext( command, x, y, angle, justification,
                          Setin, subin[subsetindex], axnum, params );
         iret = execute( "world", "\0", NULL, 0 );
      }
      else
      /*--------------------------------------------------*/
      /* An alternative way, using the current world      */
      /* coordinates.                                     */
      /*--------------------------------------------------*/
      {
         x  = (worldbox[0] + worldbox[2]) / 2.0; /* Centre text along x */
         y  = worldbox[3];                       /* start position upper horizontal axis */
         y += labelsize * Yscale;                /* Char. height of already plotted labels */
         y += gridmargin[1] * Yscale;            /* Space between plot and axis */
         y += 4.0 * Yscale;                      /* Extra space for better layout */

         status = pltext( command, x, y, angle, justification,
                          Setin, subin[subsetindex], axnum, params );
      }

      angle = oldangle;
      justification = oldjust;
      return( 1 );
   }


   /*==================================================*/
   /* Template for call to 'tracks' routine.           */
   /*==================================================*/
   if (!strcmp(command,"tracks"))
   {
      if (!pgready(worldbox))
         return( 0 );
      for (i = 0; i < MYMIN(npar,5); i++)
      {
      }
      return( 1 );
   }
   /*==================================================*/


   /*--------------------------------------------------*/
   /* Scan for the vector variables                    */
   /*--------------------------------------------------*/
   for (i = 0; i < ABC; i++)
   {
       char vname[VARLEN];
       sprintf( vname, "v%c", i + (int) 'a' );
       if ( !strcmp(command,vname) )
       {
         iret = createarray( npar,
                             pars,
                             params,
                             &vect[i],
                             &vectsize[i],
                             i );
         return( iret );
      }
   }


   if (!strcmp(command,"view"))
   {
      int   status;
      if (!inset)
      {
         anylog( 1, command, "No set opened yet, use command 'inset' to open set!" );
         return( 0 );
      }
      if (!okbox(worldbox))
         return( 0 );
      (void) sprintf( message, "BOX=%d %d %d %d",
                      (int) worldbox[0],
                      (int) worldbox[1],
                      (int) worldbox[2],
                      (int) worldbox[3] );
      wkey_c( tofchar(message) );
      (void) sprintf( message, "INSET=%s", setstring );
      wkey_c( tofchar(message) );
      wkey_c( tofchar("ANYOUT=16") );
      status = deputyC( "view", "view" );
      cancel_c( tofchar("BOX=") );
      cancel_c( tofchar("INSET=") );
      cancel_c( tofchar("ANYOUT=") );
      cancel_c( tofchar("CLIP=") );
      return( status );
   }


   if (!strcmp(command,"world"))
   {
      /* For the transformation to and from world coordinates, you need */
      /* an origin in mm and a scale in grids/mm. */
      double gX, gY;

      iret = 0;
      if (!world)
      {
         /* currentXY is in mm now! */
         mm2world( currentXY[0], currentXY[1], &gX, &gY );
      }
      if (okbox(worldbox))
      {
         iret = setbox( worldbox );
         world = YES;
         /* Move to the last cursor position: */
         plmove( gX, gY );
      }
      return(iret);
   }


   if (!strcmp(command,"xcolumn"))
   {
      int indx = XARRAY;
      iret = createarray( npar, pars, params, &vect[indx], &vectsize[indx], indx );
      return( iret );
   }


   if (!strcmp(command,"xlabel"))
   {
      double   defangle = 0.0;
      double   defjust  = 0.5;
      double   x, y;
      int      status = 0;

      if (!pgready(worldbox))
         return( 0 );

      /* The x-label is written below the lowest y axis */

      if (titleXY[0] != dblank && titleXY[1] != dblank)
      /*--------------------------------------------------*/
      /* There is a default position obtained by a previ- */
      /* ous call to 'axis B'.                            */
      /*--------------------------------------------------*/
      {
         x = titleXY[0];
         y = titleXY[1] - TITLEOFF_Y * charheight;
         iret = execute( "mmeter", "\0", NULL, 0 );
         status = pltext( command, x, y, defangle, defjust,
                          Setin, subin[subsetindex], axnum, params );
         iret = execute( "world", "\0", NULL, 0 );
      }
      else
      /*--------------------------------------------------*/
      /* An alternative way, using the current world      */
      /* coordinates.                                     */
      /*--------------------------------------------------*/
      {
         x  = (worldbox[0] + worldbox[2]) / 2.0;    /* Centre text in x direction */
         y  = worldbox[1];                          /* Position of lower x-axis */
         y -= labelsize * Yscale;                   /* Subtract height of labels already plotted */
         y -= charheight * Yscale;                  /* Subtract height of title label */
         y -= gridmargin[1] * Yscale;               /* Subtract the grid margin in woco */
         y -= 4.0 * Yscale;                         /* Extra space: 4 mm converted to woco's */
         status = pltext( command, x, y, defangle, defjust,
                          Setin, subin[subsetindex], axnum, params );
      }
      return( status );
   }


   if (!strcmp(command,"xmargin") || !strcmp(command,"ymargin"))
   {
      bool  xm = (!strcmp(command,"xmargin"));
      if (npar == 0)
      {
         if (xm)
            (void) sprintf( message, "margin in x = %g (mm)", gridmargin[0] );
         else
            (void) sprintf( message, "margin in y = %g (mm)", gridmargin[1] );
         anylog( 1, command, message );
      }
      else
      {
         int   i;
         if (xm)
            i = 0;
         else
            i = 1;
         r = dcddble_c( tofchar(pars[0]), &gridmargin[i], &one, &err );
         if (r != 1)
         {
            anylog( 1, command, "Cannot convert value" );
            return( 0 );
         }
         gridmargin[i] = fabs( gridmargin[i] );
      }
      return( 1 );
   }

   if (!strcmp(command,"xrange") || !strcmp(command,"yrange"))
   {
      double   testbox[4];
      double   dummy;
      float    mini, maxi;
      fint     size;
      int      j = 0;


      if (!pgready(worldbox))
         return( 0 );

      if (!npar)
      /*--------------------------------------------------*/
      /* No parameters: list current values.              */
      /*--------------------------------------------------*/
      {
         if ( !strcmp(command,"xrange") )
            (void) sprintf( message, "Current values in xrange: %g %g",
                            worldbox[0], worldbox[2] );
         else
            (void) sprintf( message, "Current values in yrange: %g %g",
                            worldbox[1], worldbox[3] );
         anylog( 1, "inquiry", message );
         return( 0 );
      }

      for (i = 0; i < 4; i++)           /* Copy for security */
         testbox[i] = worldbox[i];
      if (!strcmp(command,"yrange"))
         j = 1;

      if ( strstr(pars[0], "excolumn") )
      /*--------------------------------------------------*/
      /* Min and max values from 'excolumn'               */
      /*--------------------------------------------------*/
      {
         /* Get testbox from min,max of xcolumn */
         if (vectsize[EXARRAY] == 0 || vect[EXARRAY] == NULL)
         {
            anylog( 1, command, "Empty excolumn !" );
            return( 0 );
         }
         size = (fint) vectsize[EXARRAY];
         minmax1_c( vect[EXARRAY], &size, &mini, &maxi );
         if (mini == blank || maxi == blank)
         {
            anylog( 1, command, "One of range values is a blank!" );
            return( 0 );
         }
         testbox[0+j] = (double) mini;
         testbox[2+j] = (double) maxi;
      }
      else if ( strstr(pars[0], "eycolumn") )
      /*--------------------------------------------------*/
      /* Min and max values from 'eycolumn'               */
      /*--------------------------------------------------*/
      {
         if (vectsize[EYARRAY] == 0 || vect[EYARRAY] == NULL)
         {
            anylog( 1, command, "Empty eycolumn !" );
            return( 0 );
         }
         size = (fint) vectsize[EYARRAY];
         minmax1_c( vect[EYARRAY], &size, &mini, &maxi );
         if (mini == blank || maxi == blank)
         {
            anylog( 1, command, "One of range values is a blank!" );
            return( 0 );
         }
         testbox[0+j] = (double) mini;
         testbox[2+j] = (double) maxi;
      }
      else if ( strstr(pars[0], "xcolumn") )
      /*--------------------------------------------------*/
      /* Min and max values from 'xcolumn'                */
      /*--------------------------------------------------*/
      {
         /* Get testbox from min,max of xcolumn */
         if (vectsize[XARRAY] == 0 || vect[XARRAY] == NULL)
         {
            anylog( 1, command, "Empty xcolumn !" );
            return( 0 );
         }
         size = (fint) vectsize[XARRAY];
         minmax1_c( vect[XARRAY], &size, &mini, &maxi );
         if (mini == blank || maxi == blank)
         {
            anylog( 1, command, "One of range values is a blank!" );
            return( 0 );
         }
         testbox[0+j] = (double) mini;
         testbox[2+j] = (double) maxi;
      }
      else if ( strstr(pars[0], "ycolumn") )
      /*--------------------------------------------------*/
      /* Min and max values from 'ycolumn'                */
      /*--------------------------------------------------*/
      {
         if (vectsize[YARRAY] == 0 || vect[YARRAY] == NULL)
         {
            anylog( 1, command, "Empty ycolumn !" );
            return( 0 );
         }
         size = (fint) vectsize[YARRAY];
         minmax1_c( vect[YARRAY], &size, &mini, &maxi );
         if (mini == blank || maxi == blank)
         {
            anylog( 1, command, "One of range values is a blank!" );
            return( 0 );
         }
         testbox[0+j] = (double) mini;
         testbox[2+j] = (double) maxi;
      }

      else if ( strstr(pars[0], "minmax") )
      /*--------------------------------------------------*/
      /* Min and max values from current values of        */
      /* 'minmax'.                                        */
      /*--------------------------------------------------*/
      {
         testbox[0+j] = (double) minmax[0];
         testbox[2+j] = (double) minmax[1];
      }
      else
      /*--------------------------------------------------*/
      /* Min and max values from user.                    */
      /*--------------------------------------------------*/
      {
         for (i = 0; i < MYMIN(npar, 2); i++)
         {
            r = dcddble_c( tofchar(pars[i]), &dummy, &one, &err );
            if (r != 1)
            {
               anylog( 1, command, "Cannot convert value(s)!" );
               return( 0 );
            }
            else
            {
               testbox[i*2+j] = dummy;
            }
         }
      }
      iret = 0;
      if (okbox(testbox))
         iret = setbox( testbox );
      if (iret)
         boxset = YES;
      return(iret);
   }


   if (!strcmp(command,"xscale") || !strcmp(command,"yscale"))
   {
      /*------------------------------------------------------------------*/
      /* This is an important command. If there is no set open, then the  */
      /* values supplied with this command, are both in grids. If however */
      /* there is a set, the gridspacing is known and a conversion can be */
      /* made to the units of the axes. Therefore the parameter line is   */
      /* also scanned for units.                                          */
      /*------------------------------------------------------------------*/
      double   scale;
      int      ax = 0;
      bool     scaleX = NO;
      bool     scaleY = NO;

      scaleX = !strcmp(command,"xscale");
      scaleY = !strcmp(command,"yscale");
      if (scaleX)
      {
         xscaletxt[0] = '\0';
         ax = 0;
      }
      if (scaleY)
      {
         yscaletxt[0] = '\0';
         ax = 1;
      }

      if (npar == 0)
      {
         (void) sprintf( message, "Current value of xscale, yscale: %g %g", Xscale, Yscale );
         anylog( 1, "inquiry", message );
         if ((strlen(xscaletxt) != 0) || (strlen(yscaletxt) != 0))
         {
            (void) sprintf( message, "Scale(s) equivalent to %s %s", xscaletxt, yscaletxt );
            anylog( 1, "inquiry", message );
         }
         return( 1 );
      }
      r = dcddble_c( tofchar(pars[0]), &scale, &one, &err );
      if (r != 1)
      {
         anylog( 1, command, "cannot convert number" );
         return(0);
      }
      if (scale == 0.0)
      {
         anylog( 1, command, "Cannot scale with 0.0" );
         return(0);
      }
      else
      {
         if (scaleX)
            Xscale = scale;
         if (scaleY)
            Yscale = scale;
      }
      if ((inset) && (npar > 1))
      {
         if (convert( &scale, pars[1], ax ))
         {
            if (scaleX)
               Xscale = scale;
            if (scaleY)
               Yscale = scale;
         }
         else
         {
            anylog( 1, command, "Cannot convert between units" );
            return( 0 );
         }
      }
      iret = 0;
      if (okbox(worldbox))
         iret = setbox( worldbox );
      if (scaleX)
         strcpy( xscaletxt, params );
      if (scaleY)
         strcpy( yscaletxt, params );
      storeXscaleEXP = Xscale;
      storeYscaleEXP = Yscale;
      return( iret );
   }


   if (!strcmp(command,"xsize") || !strcmp(command,"ysize"))
   /*------------------------------------------------------------*/
   /* In 'world' mode there is a box or x/yrange and given and   */
   /* it is possible to recalculate the scale(s).                */
   /*------------------------------------------------------------*/
   {
      double  len;

      if (!world)
      {
         anylog( 1, command, "Cannot scale this in mm mode" );
         return( 0 );
      }

      if (npar == 0)
      {
         if (!strcmp(command,"xsize"))
         {
            len = (worldbox[2] - worldbox[0]) / Xscale;
            (void) sprintf( message, "Current value of 'xsize' = %.1f mm", len );
         }
         else
         {
            len = (worldbox[3] - worldbox[1]) / Yscale;
            (void) sprintf( message, "Current value of 'ysize' = %.1f mm", len );
         }
         anylog( 1, "inquiry", message );
         return( 1 );
      }

      r = dcddble_c( tofchar(pars[0]), &len, &one, &err );
      if (r != 1)
      {
         anylog( 1, command, "cannot convert number" );
         return( 0 );
      }
      if (len == 0.0)
      {
         anylog( 1, command, "cannot scale to length 0" );
         return( 0 );
      }
      len = ABS( len );

      if (!strcmp(command,"xsize"))
      {
         Xscale = (worldbox[2] - worldbox[0]) / len;
         xscaletxt[0] = '\0';
      }
      else
      {
         Yscale = (worldbox[3] - worldbox[1]) / len;
         yscaletxt[0] = '\0';
      }

      iret = setbox( worldbox );       /* set window on box with new scales */
      return( iret );
   }


   if (!strcmp(command,"ycolumn"))
   {
      int indx = YARRAY;
      iret = createarray( npar, pars, params, &vect[indx], &vectsize[indx], indx );
      return( iret );
   }


   if (!strcmp(command,"ylabel"))
   {
      double   defangle = 90.0;
      double   defjust  = 0.5;
      double   lo, hi;
      int      l1, l2;
      int      status = 0;
      double   x, y;
      double   size;


      if (!pgready(worldbox))
         return( 0 );

      if (titleXY[6] != dblank && titleXY[7] != dblank)
      /*--------------------------------------------------*/
      /* There is a default position obtained by a previ- */
      /* ous call to 'axis L'.                            */
      /*--------------------------------------------------*/
      {
         x = titleXY[6] - TITLEOFF_X * charheight;
         y = titleXY[7];
         iret = execute( "mmeter", "\0", NULL, 0 );
         status = pltext( command, x, y, defangle, defjust,
                          Setin, subin[subsetindex], axnum, params );
         iret = execute( "world", "\0", NULL, 0 );
      }
      else
      /*--------------------------------------------------*/
      /* An alternative way, using the current world      */
      /* coordinates.                                     */
      /*--------------------------------------------------*/
      {
         lo = worldbox[1];
         hi = worldbox[3];
         l1 = sprintf( message, "%.5g",  (lo+hi)/2.0 );
         l2 = sprintf( message, "%.5g",  lo );
         l1 = MYMAX( l1, l2 );
         l2 = sprintf( message, "%.5g",  hi );
         l1 = MYMAX( l1, l2 );
         size = labelsize;                       /* approx. width of 1 char in mm */
         size *= 1.0 + (double) l1;              /* width (in mm) of longest label */
         size *= Xscale;                         /* width in grids in x direction */
         y  = (worldbox[1] + worldbox[3]) / 2.0;
         x  = worldbox[0] - size;
         x -= gridmargin[0] * Xscale;
         status = pltext( command, x, y, defangle, defjust,
                          Setin, subin[subsetindex], axnum, params );
      }
      return( 1 );
   }

   sprintf( message, "Command [%s] unknown as interactive command!", command );
   anylog( 1, "warning", message );
   return( 0 );
}



static char *GetLine( int macno, int lno, char *line, int ins, int edit )
/*-----------------------------------------------------------------------*/
/*                                                                       */
/*name:         int GetLine                                              */
/*                                                                       */
/*purpose:      prompt user for input and return input to caller         */
/*                                                                       */
/*use:          GetLine( macno,       int            input               */
/*                       lno,         int            input               */
/*                       len,         int            input               */
/*                       line,        char *         output              */
/*                       ins )        int            input               */
/*                                                                       */
/*arguments:    macno     id of active macro                             */
/*              lno       current line number in macro                   */
/*              len       maximum number of characters to read           */
/*              line      buffer for characters typed by user            */
/*              ins       flag for insert/overwrite mode                 */
/*                                                                       */
/*returns:      number of characters typed by user                       */
/*                                                                       */
/*-----------------------------------------------------------------------*/
{
   fint       dfault;                /* Used in input routines */
   fint       r;
   fchar      Commandline;
   char       localbuf[HUGEBUF+1];
   char       message[80];
   fchar      Key;
   fchar      Mes;
   static int first = 1;


   if (first)
   {
      line = NULL;
      sprintf( message, "EXECUTE command 1 in \"main\":" );
      first = 0;
   }
   else
   {
      if (line)
         free( line );
      line = NULL;

      if (macno)
      {
         if (ins)
            sprintf( message, "INSERT command %d in macro [%d]:", lno, macno );
         else
            sprintf( message, "STORE command %d for macro [%d]:", lno, macno );
      }
      else
      {
         if (ins)
            sprintf( message, "INSERT command %d in \"main\":", lno );
         else
            sprintf( message, "EXECUTE command %d in \"main\":", lno );
      }
   }
   Commandline.a = localbuf;
   Commandline.l = HUGEBUF;
   Key           = tofchar("COMMAND=");
   Mes           = tofchar( message );
   dfault        = 1;                                              /* request */
   if (edit)
      reject_c( tofchar("COMMAND="), tofchar("Edit command") );

   r = usertext_c( Commandline, &dfault, Key, Mes );
   cancel_c( Key );
   localbuf[r] = '\0';
   line = malloc( r + 1 );
   if (!line)
   {
      anyoutC( 1, "Warning: Memory allocation problems in copying input!" );
      return( NULL );
   }
   return( strcpy(line, localbuf) );
}



MAIN_PROGRAM_ENTRY
/*-------------------------------------------------------------------------*/
/* The macro MAIN_PROGRAM_ENTRY replaces the C-call main() to start the    */
/* main body of your GIPSY application. Variables defined as 'fchar' start */
/* with a capital.                                                         */
/*-------------------------------------------------------------------------*/
{
   char   *cline = NULL;
   int    i;
   static fchar fiepars;

   init_c();                               /* contact Hermes */
   /* Task identification */
   {
      fint     l;
      fchar    Task;                       /* Name of current task */
      fmake( Task, MAXTASKNAME );          /* Macro 'fmake' must be available */
      myname_c( Task );                    /* Get task name */
      Task.a[nelc_c(Task)] = '\0';         /* Terminate task name with null char*/
      IDENTIFICATION( Task.a, RELEASE );   /* Show task and version */
      l = nelc_c( Task );
      strncpy( taskname, Task.a, l );      /* Store it as a C string */
      taskname[l] = '\0';
   }


   setfblank_c( &blank );
   setdblank_c( &dblank );
   fmake( Key, KEYLEN );
   fmake( Mes, STRLEN );
   fmake( Setin, STRLEN );
   fmake( Setang, STRLEN );
   fmake( prevSetin, STRLEN );
   fmake( Devtype, STRLEN );
   fmake( Bunit, FITSLEN );
   for (i = 0; i < MAXAXES; i++)
   {
      finit( Ctype[i], FITSLEN );
      finit( Dtype[i], FITSLEN );
      finit( Cunit[i], FITSLEN );
      finit( Dunit[i], FITSLEN );
   }

   /* Initialize the vector variables/arrays */
   {
      fint   varnum = ABC + SPECIALCOL;
      fint   r;
      int    i, j;

      fiepars.a = (char *) calloc( varnum * VARLEN, sizeof(char) );
      for (i = 0; i < ABC; i++)
      {
         char vname[VARLEN];
         sprintf( vname, "v%c", i + (int) 'a' );
         strcpy( &fiepars.a[i*VARLEN], vname );
         vectsize[i] = 0;
         vect[i] = NULL;
         strcpy( vectname[i], vname );
      }
      /* Append the four special names */
      for (i = 0, j = ABC; i < SPECIALCOL; i++, j++)
      {
              if (i == 0) strcpy( vectname[j], "xcolumn" );
         else if (i == 1) strcpy( vectname[j], "ycolumn" );
         else if (i == 2) strcpy( vectname[j], "excolumn" );
         else if (i == 3) strcpy( vectname[j], "eycolumn" );

         strcpy( &fiepars.a[j*VARLEN], vectname[j] );
         vect[j] = NULL;
         vectsize[j] = 0;
      }
      fiepars.l = VARLEN;

      /* Declare variables for the expression parser */
      r = fiepar_c( fiepars, &varnum );
   }


   do
   {
     cline = GetLine( macno, lno, cline, ins, editcom );  /* get command from user */
     editcom = NO;
   }
   while ( process(cline, &macno, &lno, &ins, MAXVOCAB) );


   /* End of GPLOT actions. Clean up a bit */
   free( fiepars.a );
   for (i = 0; i < MAXAXES; i++)
   {
      free( Ctype[i].a );
      free( Dtype[i].a );
      free( Cunit[i].a );
      free( Dunit[i].a );
   }

   for (i = 0; i < ABC+SPECIALCOL; i++)         /* free the vectors variables */
   {
      if (vect[i] != NULL) free( vect[i] );
   }

   if (axlogs  != NULL) free( axlogs );
   if (devopen)                                 /* Close PGPLOT */
      pgend_c( );

   if (printusingstr != NULL)
   {
      free( printusingstr );
      printusingstr = NULL;
   }

   finis_c();
   return(EXIT_SUCCESS);
}
#<

#>            process.c
/* process.c
                            COPYRIGHT (c) 1994
                      Kapteyn Astronomical Institute
                University of Groningen, The Netherlands
                           All Rights Reserved.

*/


/*  process.c: include files     */
#include    "gplot.h"

#define MESLEN               80


typedef struct
{
   char *name;                 /* name of macro */
   char **buff;                /* pointer to pointers to command buffer */
   int  ncom;                  /* number of commands in command buffer */
   int  save;                  /* All macros have save status except main! */
                               /* This is to avoid an endless recursion if */
                               /* one types main in main mode.             */
   int  used;                  /* macro in use ? */
} mstruct;                     /* macro structure */


/* A few global variables for the parser */
static mstruct *macro = NULL;
extern cstruct vocab[];
static int     maxvocab;       /* Length of array with predefined commands */
static int     maxmacros;



int execute( char *, char *, char **, int );


int execom( char *command, char *params )
/*----------------------------------------------------------------------*/
/*                                                                      */
/*name:         int execom                                              */
/*                                                                      */
/*purpose:      executes the command after separation of parameters     */
/*                                                                      */
/*use:          execom( command,       char *       input               */
/*                      params )       char *       input               */
/*                                                                      */
/*arguments:    command      string containing plot command to execute  */
/*              params       string containing the command parameters   */
/*                                                                      */
/*returns:      0: error                                                */
/*              1: success                                              */
/*                                                                      */
/*----------------------------------------------------------------------*/
{
   int    ipar = 0;                           /* Char counter */
   int    npar = 0;                           /* Number of parameters after */
                                              /* the command */
   char   **pars = NULL;
   int    len;
   int    i = 0;
   int    r;



   /* get the parameters: (without leading blanks) */


   len = strlen( params );
   if (len < 256)   
      anyoutf( 16, "<PROCESS> Debug: Input parameters: %s", params );
   

   while (params[ipar] && ipar < len)                      /* Has no leading spaces */
   {
      int    jpar = 0;

      /*------------------------------------------------------------*/
      /* Start building a new parameter string. Create extra        */
      /* pointer and allocate space for one character.              */
      /*------------------------------------------------------------*/
      pars = realloc( pars, (npar+1) * sizeof(char *) );   /* new pointer */
      pars[npar] = malloc( 1 );                            /* One character */

      /*------------------------------------------------------------*/
      /* Loop over the separators until end of string.              */
      /*------------------------------------------------------------*/
      while ( (params[ipar]) &&
              (params[ipar] != ' ') &&
              (params[ipar] != ',') )
      {
         if (params[ipar] == '"')
         /*------------------------------------------------------------*/
         /* If a " is encountered, copy all characters until next ".   */
         /* Do not copy the " characters.                              */
         /*------------------------------------------------------------*/
         {
            ipar++;                                         /* Skip quote */
            while ((params[ipar]) && (params[ipar] != '"'))
            {
               pars[npar][jpar++] = params[ipar++];
               pars[npar] = realloc( pars[npar], (jpar+1) * sizeof( char ) );
            }
            if (params[ipar] == '"')
               ipar++;
         }
         else if (params[ipar] == '(' || params[ipar] == '[')
         /*------------------------------------------------------------*/
         /* If a '(' is encountered, copy all characters until matching*/
         /* ')'.  Copy the '()' characters. Brackets are treated as    */
         /* parentheses.                                               */
         /*------------------------------------------------------------*/
         {
            int     stack = 0;
            do                               /* Include the parentheses */
            {
               if (params[ipar] == '(' || params[ipar] == '[')
                  stack++;
               if (params[ipar] == ')' || params[ipar] == ']')
                  stack--;
               pars[npar][jpar++] = params[ipar++];
               pars[npar] = realloc( pars[npar], (jpar+1) * sizeof( char ) );
            } while ((params[ipar]) && stack);
         }
         else
         /*------------------------------------------------------------*/
         /* Just copy the character.                                   */
         /*------------------------------------------------------------*/
         {
            pars[npar][jpar++] = params[ipar++];
            pars[npar] = realloc( pars[npar], (jpar+1) * sizeof( char ) );
         }
      }

      pars[npar][jpar] = 0;                      /* add terminating zero byte */
      if (jpar < 256)
         anyoutf( 16, "<PROCESS> Debug: parameter nr %d: %128s", npar, pars[npar] );
      npar++;

      /* skip command separators */

      while ((params[ipar] == ' ') ||
             (params[ipar] == ','))
         ipar++ ;
   }
   /*--------------------------------------------------*/
   /* Note that command can also enter the function as */
   /* a character constant. In that case the contents  */
   /* cannot be altered. But we want the command in    */
   /* lowercase. Allocate memory for new string.       */
   /*--------------------------------------------------*/
   r = execute( command, params, pars, npar );
   for (i = 0; i < npar; i++)                    /* Free the buffers */
      free( pars[i] );
   free( pars );                                 /* Free the pointers */
   return( r );
}



static int parse( int macno, char *line, char **cmd,
                  char **rest, int *savestat )
/*-----------------------------------------------------------------------*/
/*                                                                       */
/*name:         int parse                                                */
/*                                                                       */
/*purpose:      separates command from line                              */
/*                                                                       */
/*use:          parse( macno,        int        input                    */
/*                     line,         char *     input                    */
/*                     cmd,          char *     output                   */
/*                     rest,         char *     output                   */
/*                     savestat )    char *     output                   */
/*                                                                       */
/*arguments:    macno     Current macro number                           */
/*              line      input string containing command + parameters   */
/*                        but no comments!                               */
/*              cmd       output string containing command               */
/*              rest      output string containing parameters            */
/*              savestat  Must extracted command be stored?              */
/*                                                                       */
/*returns:       0: error, no command found                              */
/*              >0: command number + 1 or macro number + maximum number  */
/*                  of commands + 1                                      */
/*                                                                       */
/*-----------------------------------------------------------------------*/
{
   char    c = line[0];
   int     f = 0, i = 1, j = 0;
   int     icmd = 0, iret;
   int     ic, firstic;
   int     im, firstim;
   int     first;
   char    *command = 0;
   char    *parameters = 0;
   char    message[MESLEN+1];


   *savestat = 0;

   i = 0;
   while ((c=line[i]) == ' ')                          /* skip leading blanks */
      i++;

   if (!c)
      return(0);                                       /* no command on line */

   command    = malloc( strlen(line) + 1 );
   parameters = malloc( strlen(line) + 1 );
   if (!command || !parameters)
   {
      anyoutC( 1, "Cannot allocate enough memory to copy command!" );
      return( 0 );
   }

   j = 0;
   while ( ((c=line[i]) != 0) && (c != ' ') )          /* get command */
   {
      command[j++] = tolower(c);
      i++;
   }
   command[j] = 0;                                     /* add terminating byte */


   /*--------------------------------------------------*/
   /* This command can either be stored in a list with */
   /* predefined commands, or in a list with macro     */
   /* names.                                           */
   /*--------------------------------------------------*/
   firstic = f = 0;
   first = YES;
   for (ic = 0; ic < maxvocab; ic++)                   /* search command list */
   {
      if (!strncmp(vocab[ic].name,command,j))          /* in list ? */
      {
         if (!f)
         {
            f = 1;
            icmd = firstic = ic;
            *savestat = vocab[ic].save;                /* command has save status */
            if (*cmd)
               free(*cmd);
            *cmd = malloc( strlen(vocab[ic].name) + 1 );
            if (!cmd)
            {
               anyoutC( 1, "Memory allocation error for command" );
               free( command );
               free( parameters );
               return( 0 );
            }
            strcpy( *cmd, vocab[ic].name );            /* copy to caller */
         }
         else
         {
            if (f == 1)
            {
               anyoutC( 1, "Warning: Command not unique, unambiguous commands are:" );
               f = -1;
            }
            if (first)
            {
               sprintf( message, "-%.*s",MESLEN, vocab[firstic].name);
               anyoutC( 1, message );
               first = NO;
            }
            sprintf( message, "-%.*s",MESLEN, vocab[ic].name);
            anyoutC( 1, message );
         }
      }
   }

   first = YES;
   firstim = 0;
   for (im = 0; im < maxmacros; im++)                    /* search macro list */
   {
      if (isalpha(macro[im].name[0]))                        /* macro defined */
      {
         if (!strncmp(macro[im].name,command,j))                 /* in list ? */
         {
            if (!f)
            {
               f = 1;
               icmd = im + maxvocab;
               firstim = im;
               if (*cmd)
                  free(*cmd);
               *cmd = malloc( strlen(macro[im].name) + 1 );
               if (!cmd)
               {
                  anyoutC( 1, "Memory allocation error for command" );
                  free( command );
                  free( parameters );
                  return( 0 );
               }
               strcpy( *cmd, macro[im].name );              /* copy to caller */
            }
            else
            {
               if (f == 1)
               {
                  anyoutC( 1, "Warning: Command not unique, unambiguous commands are:" );
                  f = -1;
               }
               if (first)
               {
                  sprintf( message, "-%.*s",MESLEN, macro[firstim].name);
                  anyoutC( 1, message );
                  first = NO;
               }
               sprintf( message, "-%.*s",MESLEN, macro[im].name);
               anyoutC( 1, message );
            }
         }
      }
   }


   switch(f)
   {
      case -1:                                              /* multiple match */
      {
         anyoutC(1, " ");
         iret = 0;
      }
      break;
      case  0:                                                   /* not found */
      {
         sprintf( message, "Warning: Unknown command [%.25s] in \"%.25s\"",
                  command, macro[macno].name );
         anyoutC( 1, message );
         iret = 0;
      }
      break;
      case  1:                                                        /* O.K. */
         iret = icmd+1;
      break;
      default:                                                /* just in case */
         iret = 0;
      break;
   }

   if (*rest)
      free( *rest );

   if (iret)                                   /* return rest of command line */
   {
      int j = 0;
      int len = strlen( line );
      while ((line[i] == ' ') && (i < len))            /* skip leading blanks */
         i++;
      /* Note that i has already some value != 0  */         
      while ((line[i]) && (i < len))                             /* copy rest */
      {
         if (line[i] == '@')
         {
            parameters[j++] = ' ';
            i++;
         }
         else
            parameters[j++] = line[i++];
      }
      parameters[j++] = 0;
      *rest = malloc( strlen( parameters ) + 1 );
      if (!*rest)
      {
         anyoutC( 1, "Memory allocation error for parameters" );
         free( command );
         free( parameters );
         return( 0 );
      }
      strcpy( *rest, parameters );
   }
   else
   {
      *rest = malloc( 1 );           /* To be save if there are no parameters */
      rest[0][0] = 0;
   }

   free( command );
   free( parameters );
   return(iret);                                          /* return to caller */
}




static int insert( int macno, int lno, char *line )
/*----------------------------------------------------------------------*/
/*                                                                      */
/*name:         int insert                                              */
/*                                                                      */
/*purpose:      insert command in macro                                 */
/*                                                                      */
/*use:          insert( macno,            int          input            */
/*                      lno,              int          input            */
/*                      line )            char *       input            */
/*                                                                      */
/*arguments:    macno       id of current macro                         */
/*              lno         line number where to insert                 */
/*              line        text to insert                              */
/*                                                                      */
/*returns:      0: error                                                */
/*              1: success                                              */
/*                                                                      */
/*----------------------------------------------------------------------*/
{
   char **p;
   int  n;

   n = macro[macno].ncom;                         /* # of commands in macro */
   if ((lno < 1) || (lno > n))                    /* append command */
      lno = n;

   p = macro[macno].buff;
   p = realloc( p, (n+1)*sizeof(char *) );        /* An extra pointer */
   if (p == NULL)
   {
      anyoutC(1, "Warning: Cannot allocate enough memory to store command");
      return(0);
   }

   if (lno == n)                                  /* Append */
   {
      p[n] = malloc( strlen(line) + 1 );          /* Space for the command */
      if (p[n] == NULL)
      {
         anyoutC( 1, "Warning: Cannot allocate enough memory to store command");
         return(0);
      }
      strcpy( p[n], line );                       /* Copy that command */
   }
   else
   {                                              /* Insertion */
      int ind = lno - 1;
      int i;

      for (i = n; i > ind; i--)                   /* Move all existing entries */
      {
         p[i] = malloc( strlen( p[i-1] + 1 ));    /* Space for that command */
         if (p[i] == NULL)
         {
            anyoutC( 1, "Warning: Cannot allocate enough memory to store command");
            return(0);
         }
         strcpy( p[i], p[i-1] );                  /* Copy command */
         free( p[i-1] );                          /* Release space */
      }
      p[ind] = malloc( strlen(line) + 1 );
      if (p[ind] == NULL)
      {
         anyoutC( 1, "Warning: Cannot allocate enough memory to store command");
         return(0);
      }
      strcpy( p[ind], line );
   }
   macro[macno].buff  = p;
   macro[macno].ncom += 1;
   return(1);                                     /* success */
}




static int input( int macno, int lno, char *file, int reset, int exec )
/*-----------------------------------------------------------------------*/
/*                                                                       */
/*name:        int input                                                 */
/*                                                                       */
/*purpose:     reads commands from file and stores them in current macro */
/*                                                                       */
/*use:         input( macno,          int            input               */
/*                    lno,            int            input               */
/*                    file,           char *         input               */
/*                    reset,          int            input               */
/*                    exec )          int            input               */
/*                                                                       */
/*arguments:   macno      id of current macro                            */
/*             lno        position to start inserting commands from file */
/*             file       name of file which contains commands           */
/*             reset      append to buffer or reset?                     */
/*             exec       execute commands (or store)?                   */
/*                                                                       */
/*returns:     next insert position                                      */
/*-----------------------------------------------------------------------*/
{
   FILE   *in;
   int    savestat;
   char   message[80];
   int    parsed = YES;
   int    abort;
   char   *line = NULL;
   char   *linecp = NULL;
   char   *rest = NULL;
   char   *cmnd = NULL;


   if (!*file)
   {
      anyoutC( 1, "Warning: Input ?");
      return(lno);                                     /* error */
   }
   if ((in = fopen(file,"r")) == NULL)                 /* open file */
   {
      sprintf( message, "Warning:  File '%s' not found", file );
      anyoutC( 1, message );
      return(lno);                                     /* error */
   }
   if (reset)
   {
      int i;

      for (i = 0; i < macro[macno].ncom; i++)
         free( macro[macno].buff[i] );
      free( macro[macno].buff );
      macro[macno].buff = NULL;
      macro[macno].ncom = 0;
      lno = 1;
   }
   while (!feof(in))
   {
      int  k = 0;
      char ch;
      int  nextline;

      /*--------------------------------------------------*/
      /* Read characters until newline, or end of line    */
      /* char '\'. The line will contain comments.        */
      /*--------------------------------------------------*/

      line = NULL;
      rest = NULL;
      cmnd = NULL;
      line = malloc( 1 );
      do
      {
         while (((ch = fgetc(in)) != '\n') &&
                  ch != EOF &&
                  ch != '\\'   )
         {
            line[k++] = ch;
            line = realloc( line, (k+1) * sizeof( char ) );
         }
         nextline = (ch == '\\');
         if (nextline)
         {
            /* If next character is a space then skip rest of line */
            ch = fgetc(in);
            if (ch == ' ')
               while (((ch = fgetc(in)) != '\n') && ch != EOF)
                  ; /* do nothing, semicolon is essential here */
            else if (ch != '\n' && ch != EOF)
            {
               /* A character followed so include the backslash and char. */
               line[k++] = '\\';
               line = realloc( line, (k+1) * sizeof( char ) );
               line[k++] = ch;
               line = realloc( line, (k+1) * sizeof( char ) );
            }
         }
      } while (nextline);                       /* Definition continued on next line */
      line[k] = 0;                              /* Close string */


      /*--------------------------------------------------*/
      /* Before further processing, make a copy of this   */
      /* string for the command insertion (i.e.input with */
      /* comment).                                        */
      /*--------------------------------------------------*/

      linecp = malloc( strlen(line) + 1 );
      if (!linecp)
      {
         anyoutC( 1, "Memory allocation problems while copying input!" );
         return( lno );                         /* Input line number */
      }
      strcpy( linecp, line );

      /*--------------------------------------------------*/
      /* If there is a '!' in the string, then comment.   */
      /* follows. Skip this comment. With this we change  */
      /* the contents of 'line'.                          */
      /*--------------------------------------------------*/
      {
         char *p = strchr( line, '!' );
         if (p)
            *p = '\0';
      }

      if (line[0])                             /* Nothing to do */
      {
         parsed = parse( macno, line, &cmnd, &rest, &savestat );

         abort = NO;
         if (!parsed)
         {
            if (!reset)                        /* Not an edit session */
               abort = YES;                    /* abort when error occurs */
         }
         else
         {
            if (exec)
            {
               if ( !execom(cmnd, rest) )
               {
                  (void) sprintf( message,
                                 "Warning: Error executing command %s",
                                  cmnd);
                  anyoutC( 1, message );
                  abort = YES;
               }
            }
         }

         if (!abort && savestat && parsed)     /* command has to be stored */
         {
            if ( !insert(macno, lno, linecp) ) /* Store line with comments */
               abort = YES;
         }
         if (parsed && !abort)
            lno++;
      }
      free( line );
      free( linecp );
      free( cmnd );
      free( rest );
   }  /* No more characters (lines) to read */
   fclose(in);
   return(lno);                                /* success */
}


static int list( int macno, char *rest )
/*----------------------------------------------------------------------*/
/*                                                                      */
/*name:         int list                                                */
/*                                                                      */
/*purpose:      list commands in macro                                  */
/*                                                                      */
/*use:          list( macno,           int         input                */
/*                    rest )           char *      input                */
/*                                                                      */
/*arguments:    macno      id of active macro                           */
/*              rest       string contaning start and end line numbers  */
/*                                                                      */
/*returns:      0: error                                                */
/*              1: success                                              */
/*                                                                      */
/*----------------------------------------------------------------------*/
{
   int     n   = macro[macno].ncom;
   fint    arraylen = (fint) n;
   fint    *listnums = NULL;
   fint    err;
   fint    r = 0;
   int     list;
   int     k, v;
   char    message[MESLEN+1];


   if (!n)
   {
      anyoutC( 1, "Warning: No commands in macro");
      return(1);                                     /* success */
   }
   if (*rest)                      /* rest not empty, so find numbers to list */
   {
      listnums = (fint *) calloc( arraylen, sizeof(fint) );
      if (listnums == NULL)
      {
         anyoutC( 1, "Warning: Cannot allocate space for list array" );
         return(0);
      }
      r = dcdint_c( tofchar(rest), listnums, &arraylen, &err );
      if (r < 1) {
         (void) sprintf( message, "Warning: Don't grog %.*s",
                         MESLEN-12, rest);
         anyoutC( 1, message );
         free( listnums );
         return(0);                                  /* error */
      }
   }

   for (k = 0; k < n; k++)                           /* Loop over all commands in buff. */
   {
      list = YES;
      if (*rest)
      {
         list = NO;
         for (v = 0; v < r; v++)                     /* Loop over all list numbers */
         {
            if ( (k+1) == listnums[v] )              /* Found entry to list */
            {
               list = YES;
               break;
            }
         }
      }
      if (list)
      {
         (void) sprintf( message, "%3d: %.*s",
                         k+1, MESLEN-6, macro[macno].buff[k] );
         anyoutC( 1, message );
      }
   }
   free( listnums );
   return(1);                                        /* success */
}


static int startmacro( int macno, char *rest )
/*-----------------------------------------------------------------------*/
/*                                                                       */
/*name:         int startmacro                                           */
/*                                                                       */
/*purpose:      initializes a macro                                      */
/*                                                                       */
/*use:          startmacro( macno,           int        input            */
/*                          rest )           char *     input            */
/*                                                                       */
/*arguments:    macno     id of active macro                             */
/*              rest      name of new macro                              */
/*                                                                       */
/*returns:      current macro id if error, else macro id of new macro    */
/*                                                                       */
/*-----------------------------------------------------------------------*/
{
   char    ch = rest[0];
   char    *name = NULL;
   int     l1 = 0, l2 = 1;
   int     c, f = 0, m = 0;
   char    message[MESLEN+1];


   if (ch == 0)                               /* macro name present ? */
   {
      anyoutC(1, "Warning: Macro ?");
      return(macno);                          /* return current active macro id */
   }


   /* Get the name of the macro. Name ends with space or 0 */
   name = malloc( strlen( rest ) + 1 );
   if (!name)
   {
      anyoutC( 1, "Memory allocation problems: Cannot copy macro name" );
      return( macno );
   }
   while ((ch != ' ') && (ch != 0))
   {
      name[l1++] = tolower(ch);
      ch = rest[l2++];
   }
   name[l1] = 0;


   /* Is there already a macro with this name? */
   while ((m < maxmacros) && (strcmp(macro[m].name,name)))
      m++;                                   /* macro list */
   if (m < maxmacros) 
   {
      free( name );
      return(m);                             /* use old macro */
   }

   /*--------------------------------------------------*/
   /* Macro name is not in list with macros. Check if  */
   /* it is a known command.                           */
   /*--------------------------------------------------*/
   c = 0;
   while ((c < maxvocab) && (strcmp(vocab[c].name,name)))
      c++;                                  /* vocab list */
   if (c < maxvocab)
   {
      char *str = "Warning: Duplicate command:";
      sprintf( message, "%s %.*s", str, MESLEN-strlen(str), name);
      anyoutC( 1, message );
      free( name );
      return(macno);                        /* return current active macro id */
   }
   if (!isalpha(name[0]))
   {
      char *str = "Warning: illegal macro name";
      sprintf( message, "%s %.*s", str, MESLEN-strlen(str), name);
      anyoutC( 1, message );
      free( name );
      return(macno);                        /* return current active macro id */
   }
   while ((f < maxmacros) && (isalpha(macro[f].name[0])))
      f++;                                 /* free macro */
   if (f < maxmacros)
   {
      macro[f].name = malloc( strlen( name ) + 1 );
      strcpy(macro[f].name,name);           /* created new macro */
   }
   else
   {
      /* Create a new macro */
      macro = (mstruct *) realloc( (mstruct *) macro,
                                   (maxmacros+1)*sizeof(mstruct) );
      f = maxmacros;
      maxmacros++;
      macro[f].name = malloc( strlen( name ) + 1 );
      if (!macro[f].name)
      {
         anyoutC( 1, "Memory allocation error in creating new macro!" );
         free( name );
         return( macno );
      }
      strcpy( macro[f].name, name );        /* created new macro */
      macro[f].buff = NULL;
      macro[f].ncom = 0;
      macro[f].save = 1;
      macro[f].used = 0;
   }
   free( name );
   return( f );
}



static int delete( int macno, char *rest )
/*----------------------------------------------------------------------*/
/*                                                                      */
/*name:         int delete                                              */
/*                                                                      */
/*purpose:      delete lines or a macro                                 */
/*                                                                      */
/*use:          delete( macno,         int         input                */
/*                      rest )         char *      input                */
/*                                                                      */
/*arguments:    macno      id of current macro                          */
/*              rest       name of macro to delete or range in commands */
/*                         to delete                                    */
/*                                                                      */
/*returns:      0: error                                                */
/*              1: success                                              */
/*                                                                      */
/*----------------------------------------------------------------------*/
{
   char ch = rest[0];
   char message[MESLEN+1];


   if (ch != 0)
   {
      if (isalpha(ch))
      {
         char *name;
         int  l1 = 0, l2 = 1;
         int  m = 0;

         name = malloc( 1 );
         while ((ch != ' ') && (ch != 0))
         {
            name[l1++] = tolower(ch);
            name = realloc( name, (l1+1)*sizeof(char) );
            ch = rest[l2++];
         }
         name[l1] = 0;
         while ((m < maxmacros) && (strcmp(macro[m].name,name)))
            m++;
         if (m == maxmacros)
         {
            sprintf( message, "Warning: Macro %.*s is not defined",
                     MESLEN-34, name);
            anyoutC( 1, message );
            free( name );
            return(0);                                            /* error */
         }
         else if (!m)
         {
            sprintf( message, "Macro %.*s cannot be deleted",
                     MESLEN-27, name );
            anyoutC( 1, message );
            free( name );
            return(0);                                            /* error */
         }
         else if (m == macno)
         {
            anyoutC( 1, "Warning: Cannot delete active macro" );
            free( name );
            return(0);                                            /* error */
         }
         else
         {
            /*--------------------------------------------------*/
            /* Undefine a macro by freeing the character buf-   */
            /* fers.                                            */
            /*--------------------------------------------------*/
            int i, k;
            int last = maxmacros-1;

            for (k = m + 1; k < maxmacros; k++)
            {
               /* Copy buffer field */
               for (i = 0; i < macro[k-1].ncom; i++)
                  free( macro[k-1].buff[i] );
               free( macro[k-1].buff );                /* Free array with pointers */
               macro[k-1].buff = NULL;
               macro[k-1].buff = realloc( macro[k-1].buff,     /* New array of pointers */
                                          macro[k].ncom * sizeof(char *) );
               for (i = 0; i < macro[k].ncom; i++)
               {
                  macro[k-1].buff[i] = malloc( strlen(macro[k].buff[i])+1 );
                  strcpy( macro[k-1].buff[i], macro[k].buff[i] );
               }


               /* Copy name field */
               free( macro[k-1].name );
               macro[k-1].name = malloc( strlen(macro[k].name)+1 );
               strcpy( macro[k-1].name, macro[k].name );

               /* Copy rest of macro items */
               macro[k-1].ncom = macro[k].ncom;
               macro[k-1].save = macro[k].save;
               macro[k-1].used = macro[k].used;
            }
            /* Free the last macro */
            for (i = 0; i < macro[last].ncom; i++)
               free( macro[last].buff[i] );
            free( macro[last].buff );
            free( macro[last].name );
            maxmacros--;
            macro = (mstruct *) realloc( (mstruct *) macro,
                                         (maxmacros)*sizeof(mstruct) );

            return(1);                                  /* success */
         }
      }
      else  /* Numbers -> delete these lines */
      {
         fint r;
         int  k;
         int  n = macro[macno].ncom;                    /* number of commands in macro */
         fint arraylen = (fint) n;
         fint err;
         fint *delnums = NULL;

         delnums = (fint *) calloc( arraylen, sizeof(fint) );
         if (delnums == NULL)
         {
            anyoutC( 1, "Warning: Cannot allocate space for delete array" );
            return(0);
         }
         r = dcdint_c( tofchar(rest), delnums, &arraylen, &err );
         if (r < 1)                                     /* No valid numbers */
         {
            (void) sprintf( message, "Don't grog %.*s",
                            MESLEN-14, rest);
            anyoutC( 1, message );
            free( delnums );
            return(0);                                  /* error */
         }
         else                                           /* We have valid numbers */
         {
            char **p = macro[macno].buff;               /* pointer to command buffer */
            int  del;
            int  i, v;

            i = 0;
            for (k = 0; k < macro[macno].ncom; k++)     /* Loop over all commands in buff. */
            {
               del = NO;
               for (v = 0; v < r; v++)                  /* Loop over all delete numbers */
               {
                  if ( (k+1) == delnums[v] )            /* Found entry to delete */
                  {
                     del = YES;
                     break;
                  }
               }
               if (!del)
               {
                  if (i != k)
                  {
                     p[i] = malloc( strlen(p[k]) + 1 );
                     if (p[i] == NULL)
                     {
                        anyoutC(1, "Warning: Memory allocation problems!");
                        return(0);
                     }
                     strcpy( p[i], p[k] );
                     free( p[k] );
                  }
                  i++;
               }
               else
               {
                  n--;
                  free( p[k] );
               }
            }
            macro[macno].buff = p;
            macro[macno].ncom = n;
            free( delnums );
            return(1);                                  /* success */
         }
      }
   }
   anyoutC( 1, "Warning: Delete ?");
   return( 0 );
}



int exemacro( int macno, char *rest )
/*----------------------------------------------------------------------*/
/*                                                                      */
/*name:         int exemacro                                            */
/*                                                                      */
/*purpose:      executes a macro                                        */
/*                                                                      */
/*use:          exemacro( macno,       int       input                  */
/*                        rest )       char *    input                  */
/*                                                                      */
/*arguments:    macno      id of macro to execute                       */
/*              rest       parameters for this macro                    */
/*                                                                      */
/*returns:      0: error                                                */
/*              1: success                                              */
/*                                                                      */
/*----------------------------------------------------------------------*/
{
   char **pars = NULL;
   int  npar = 0;
   int  lno = 0;
   int  i = 0;
   int  savestat;
   char message[MESLEN+1];


   if (macro[macno].used)
   {
      anyoutC( 1, "Warning: Recursive macro execution not allowed");
      return(0);                                 /* error */
   }
   else if (!macro[macno].ncom)
   {
      sprintf( message, "Macro %.*s is empty",
               MESLEN - 18, macro[macno].name );
      anyoutC( 1, message );
      return(0);                                 /* error */
   }
   while ((rest[i]) && (i < strlen(rest)))       /* get the parameters */
   {
      int j = 0;
      pars = realloc( pars, (npar+1) * sizeof(char *) );   /* One new pointer */
      pars[npar] = malloc( 1 );
      while ((rest[i] != ' ') && (rest[i]))
      {
         pars[npar][j++] = rest[i++];
         pars[npar] = realloc( pars[npar], (j+1) * sizeof( char ) );
      }
      pars[npar++][j] = 0;                       /* add terminating zero byte */
      while (rest[i] == ' ')                     /* skip separating blanks */
         i++;
   }
   while (lno < macro[macno].ncom)
   {
      char *line = NULL;
      char *rest = NULL;
      char *cmnd = NULL;
      int  len;

      line = malloc( strlen( macro[macno].buff[lno] ) + 1 );

      if (!line)
      {
         anyoutC( 1, "Memory allocation problems while copying macro buffer!");
         for (i = 0; i < npar; i++)              /* Free the buffers */
            free( pars[i] );
         free( pars );                           /* Free the pointers */
         return( 0 );
      }

      /* Copy the line for use in parse routine */
      strcpy( line, macro[macno].buff[lno] );
      len = strlen( line );

      {
         int nret;
         int il = 0, ir = 0;

         if (!(nret = parse( macno, line, &cmnd, &rest, &savestat )))
         {
            for (i = 0; i < npar; i++)           /* Free the buffers */
               free( pars[i] );
            free( pars );                        /* Free the pointers */
            free( line );
            return(0);                           /* error */
         }

         while (rest[ir])
         {
            if (rest[ir] != '%')
               line[il++] = rest[ir++];
            else
            {
               int ia = 0, np = 0;
               while (isdigit(rest[++ir]))
                  np = 10 * np + (rest[ir] - '0');
               if ((np == 0) || (np > npar))
               {
                  sprintf( message,
                     "Warning: Cannot find value for macro parameter %d", np );
                  anyoutC( 1, message );
                  for (i = 0; i < npar; i++)     /* Free the buffers */
                     free( pars[i] );
                  free( pars );                  /* Free the pointers */
                  free( line );
                  return(0);                     /* error */
               }
               len += strlen( pars[np-1] );
               line = realloc( line, (len+1)*sizeof(char) );

               while (pars[np-1][ia])
                  line[il++] = pars[np-1][ia++];
            }
         }
	 line[il] = 0;

         if (nret > maxvocab)
         {
            int nmac = nret - maxvocab - 1;
            macro[macno].used = 1;
            if (!exemacro(nmac,line))
            {
               sprintf(message, "Warning: Error executing macro %.*s",
                       MESLEN - 35, macro[nmac].name );
               anyoutC( 1, message );
               macro[macno].used = 0;
               for (i = 0; i < npar; i++)        /* Free the buffers */
                  free( pars[i] );
               free( pars );                     /* Free the pointers */
               free( line );
               return(0);                        /* error */
            }
            macro[macno].used = 0;
         }
         else
         {
            macro[macno].used = 1;
            if (!execom(cmnd,line))
            {
               sprintf( message, "Warning: Error executing command %.*s",
                        MESLEN - 35, cmnd );
               anyoutC( 1, message );
               macro[macno].used = 0;
               for (i = 0; i < npar; i++)        /* Free the buffers */
                  free( pars[i] );
               free( pars );                     /* Free the pointers */
               free( line );
               return(0);                        /* error */
            }
            macro[macno].used = 0;
         }
      }
      lno++;
      free( line );
      free( rest );
      free( cmnd );
   }
   for (i = 0; i < npar; i++)                    /* Free the buffers */
      free( pars[i] );
   free( pars );                                 /* Free the pointers */
   return(1);                                    /* success */
}



static int readmacro( char *rest, char *pathname )
/*----------------------------------------------------------------------*/
/*                                                                      */
/*name:         int readmacro                                           */
/*                                                                      */
/*purpose:      reads a macro from a file                               */
/*                                                                      */
/*use:          readmacro( rest,            char *     input            */
/*                         pathname )       char *     input            */
/*                                                                      */
/*arguments:    rest      string contains macro name and name of file   */
/*              pathname  path entered with 'macdir' command.           */
/*                                                                      */
/*returns:      0: error                                                */
/*              1: success                                              */
/*                                                                      */
/*----------------------------------------------------------------------*/
{
   char *name = NULL;
   char *file = NULL;
   char ch;
   int  lno = 1;
   int  ir = 0;
   int  im = 0;
   int  in = 0;
   int  m = 0, f = 0;
   char message[MESLEN+1];
   FILE *infile;


   /* Get macro name */
   if (!*rest)
   {
      anyoutC( 1, "Warning: Read ?");
      return(0);                                      /* error */
   }
   ch = rest[ir++];
   name = malloc( 1 );
   while ((ch) && (ch != ' '))                        /* copy macro name */
   {
      name[im++] = tolower(ch);
      name = realloc( name, (im+1)*sizeof(char) );
      ch = rest[ir++];
   }
   name[im] = 0;
   while (ch == ' ')
      ch = rest[ir++];                                 /* skip blanks */
   while ((m < maxmacros) && strcmp(macro[m].name,name))
      m++;                                             /* macro exists? */
   if (m < maxmacros)
   {
      sprintf( message, "Warning: Macro %.*s already exists!",
               MESLEN - 32, name);
      anyoutC( 1, message );
      free( name );
      return(0);                                       /* error */
   }

   file = malloc( 1 );
   while ((ch) && (ch != ' '))                         /* copy file name */
   {
      file[in++] = ch;
      file = realloc( file, (in+1)*sizeof(char) );
      ch = rest[ir++];
   }
   file[in] = 0;
   if (!file[0])                                       /* default file name */
   {
      int k = strlen(pathname) + strlen(name) + strlen(".mac");
      file = realloc( file, (k+1)*sizeof(char) );
      strcpy( file, pathname );
      strcat( file, name );
      strcat( file, ".mac" );
   }


   if ((infile = fopen(file,"r")) == NULL)             /* file exists? */
   {
      sprintf( message, "Warning: Macro %s not found", file );
      anyoutC( 1, message );
      return(0);                                       /* error */
   }
   else
      fclose( infile );

   /* It is time to create space for a new macro */

   macro = (mstruct *) realloc( (mstruct *) macro,
                                (maxmacros+1)*sizeof(mstruct) );
   f = maxmacros;
   maxmacros++;
   macro[f].name = malloc( strlen( name ) + 1 );
   if (!macro[f].name)
   {
      anyoutC( 1, "Memory allocation error in creating new macro!" );
      free( name );
      free( file );
      return( 0 );                                      /* Error */
   }
   strcpy( macro[f].name, name );                       /* created new macro */
   macro[f].buff = NULL;
   macro[f].ncom = 0;
   macro[f].save = 1;
   macro[f].used = 0;

   input( f, lno, file, NO, NO );                       /* Read the macro from file */

   free( name );
   free( file );
   return(1);                                           /* success */
}



static int writemacro( char *rest, char *pathname )
/*----------------------------------------------------------------------*/
/*                                                                      */
/*name:         int writemacro                                          */
/*                                                                      */
/*purpose:      write a macro to a file                                 */
/*                                                                      */
/*use:          writemacro( rest,             char *     input          */
/*                          pathname )        char *     input          */
/*                                                                      */
/*arguments:    rest      string contains macro name and name of file   */
/*              pathname  path entered with 'macdir' command.           */
/*                                                                      */
/*returns:      0: error                                                */
/*              1: success                                              */
/*                                                                      */
/*----------------------------------------------------------------------*/
{
   FILE *out;
   char *name = NULL;
   char *file = NULL;
   char ch;
   int  nc, nmax;
   int  ir = 0;
   int  im = 0;
   int  in = 0;
   int  m = 0;
   char message[MESLEN+1];


   /* Get macro name first */

   if (!rest[ir])
   {
      anyoutC( 1, "Warning: Write ?");
      return(0);                                        /* error */
   }
   name = malloc( 1 );
   ch = rest[ir++];
   while ((ch) && (ch != ' '))                         /* copy macro name */
   {                                                   /* in lower case */
      name[im++] = tolower(ch);
      name = realloc( name, (im+1)*sizeof(char) );
      ch = rest[ir++];
   }
   name[im] = 0;

   while (ch == ' ')                                   /* skip blanks */
      ch = rest[ir++];
   while ((m < maxmacros) && strcmp(macro[m].name, name))
      m++;                                             /* macro exists? */
   if (m == maxmacros)
   {
      sprintf( message, "Warning: Macro %.*s does not exist",
               MESLEN - 34, name);
      anyoutC( 1, message );
      free( name );
      return(0);                                       /* error */
   }
   if ((nmax = macro[m].ncom) == 0)
   {
      sprintf( message, "Warning: Macro %.*s is empty",
               MESLEN - 30, name);
      anyoutC( 1, message );
      free( name );
      return(0);                                       /* error */
   }


   /* Now get the file name */

   file = malloc( 1 );
   while ((ch) && (ch != ' '))                         /* copy file name */
   {
      file[in++] = ch;
      file = realloc( file, (in+1)*sizeof(char) );
      ch = rest[ir++];
   }
   file[in] = 0;
   if (!file[0])                                       /* default file name */
   {
      int k = strlen(pathname) + strlen(name) + strlen(".mac");
      file = realloc( file, (k+1)*sizeof(char) );
      strcpy( file, pathname );
      strcat( file, name );
      strcat( file, ".mac" );
   }
   if ((out = fopen(file,"w")) == NULL)
   {
      sprintf( message, "Warning: Cannot open %.*s for writing",
               MESLEN - 33,  file);
      anyoutC( 1, message );
      free( name );
      free( file );
      return(0);                                       /* error */
   }

   for (nc = 0; nc < nmax; nc++)                       /* Write to disk */
      fprintf( out,"%s\n", macro[m].buff[nc] );

   fclose(out);
   free( name );
   free( file );
   return(1);                                          /* success */
}


static int edit( int macno, int lno, char *pathname)
/*--------------------------------------------------------------------*/
/* The value of lno is needed if the editor could not be used and the */
/* original current line number must be returned.                     */
/*--------------------------------------------------------------------*/
{
   char  *filename = NULL;
   fint  r;
   char  *message;

   filename = tmpnam( filename );                                 /* Name for temp. file */
   message  = malloc( strlen(filename) + strlen(macro[macno].name) + 3 );
   if (!message)
   {
      anyoutC( 1, "Memory allocation problems while creating a file name!" );
      return( lno );
   }
   (void) sprintf( message, "%s %s", macro[macno].name, filename );
   writemacro( message, pathname );
   r = editfile_c( tofchar(filename), tofchar("Continue=<enter>, abort=^C") );  /* Local editor */
   if (r == 0)
   {
      lno = input( macno, lno, filename, YES, NO );
      remove( filename );
   }
   else
   {
      if      (r == -1)    anyoutC( 1, "Warning: user canceled the edit" );
      else if (r == -2)    anyoutC( 1, "Warning: cannot start editor" );
      else if (r == -3)    anyoutC( 1, "Warning: editor process exited with error status");
      else if (r == -666)  anyoutC( 1, "Warning: this version of Hermes does not support EDITFILE" );
   }
   free( filename );
   return( lno );
}



static int initmacros( void )
/*--------------------------------------------------*/
/* Initialize first element of macro list.          */
/*--------------------------------------------------*/
{
   macro = (mstruct *) calloc( 1, sizeof(mstruct) );
   macro[0].name = malloc( strlen("main") + 1 );
   if (!macro[0].name)
   {
      anyoutC( 1, "Memory allocation problems!" );
      return( 0 );
   }
   strcpy( macro[0].name, "main" );
   macro[0].ncom = 0;
   macro[0].save = 0;
   macro[0].used = 0;
   macro[0].buff = NULL;
   return( 1 );
}



static void status( void )
/*----------------------------------------------------------------------*/
/*                                                                      */
/*name:       void status                                               */
/*                                                                      */
/*purpose:    Displays status info about defined macros.                */
/*                                                                      */
/*use:        status( )                                                 */
/*                                                                      */
/*arguments:                                                            */
/*                                                                      */
/*returns:                                                              */
/*                                                                      */
/*----------------------------------------------------------------------*/
{
   int   m;
   char  message[120];

   for (m = 0; m < maxmacros; m++)
   {
      if (isalpha(macro[m].name[0]))
      {
         int j, len = 0;
         for (j = 0; j < macro[m].ncom; j++)
            len += strlen(macro[m].buff[j]);
	 sprintf( message,
	          "Macro %2d, %-20.20s has %6d commands and reserves %6d bytes",
                  m, macro[m].name, macro[m].ncom, len );
	 anyoutC( 1, message );
      }
   }
}



int process( char *line, int *macronr, int *linenr, int *insrt,
                    int maxcommands )
/*-----------------------------------------------------------------------*/
/*name:         void process                                             */
/*                                                                       */
/*purpose:      does the job                                             */
/*                                                                       */
/*use:          process(  char *line,       input                        */
/*                        int  *macronr,    in/output                    */
/*                        int  *linenr,     in/output                    */
/*                        int  *insrt )     in/output                    */
/*                                                                       */
/*arguments:    line      The command and parameters.                    */
/*              macronr   Current macro number                           */
/*              linenr    Line in current macro                          */
/*              insrt     Insert or append?                              */
/*              maxcommands  Size of command list (cstruct).             */
/*                                                                       */
/*returns:      0 if user wants to quit, 1 if user wants to continue.    */
/*                                                                       */
/*Description:  read commands, initialize macro's, parse commands.       */
/*-----------------------------------------------------------------------*/
{
   static int    firstcommand = YES;
   int           lno;
   int           macno;
   int           ins;
   char          *command = NULL;
   char          *rest = NULL;
   static char   *pathname = NULL;
   int           nret;
   int           savestat;
   int           con = 1;
   char          *linecp;
   int           nmac, ncom;


   if (!strlen(line))                                /* Is there a command to execute? */
      return( 1 );

   maxvocab = maxcommands;

   lno       = *linenr;
   macno     = *macronr;
   ins       = *insrt;

   if (firstcommand)                                 /* Initialize */
   {
      lno   = 1;
      macno = 0;
      ins   = 0;
      maxmacros = initmacros();
      if (maxmacros != 1)
      {
         anyoutC( 1, "Warning: Could not initialize macros!" );
         return( 1 );
      }
   }

   if (pathname == NULL)
   {
      pathname = malloc( 1 );
      pathname[0] = '\0';
   }

   linecp = malloc( strlen( line ) + 1 );
   if (!linecp)
   {
      anyoutC( 1, "Warning: Memory allocation problem in line copy" );
      return( 1 );
   }
   strcpy( linecp, line );

   /*--------------------------------------------------*/
   /* If there is a '!' in the string, then comment    */
   /* follows. Skip this comment. With this we change  */
   /* the contents of 'line'.                          */
   /*--------------------------------------------------*/
   {
      char *p = strchr( line, '!' );
      if (p)
         *p = '\0';
   }

   if (isdigit(line[0]))                             /* Do we start with a line number? */
   {
      int numb;
      if (sscanf(line,"%d",&numb) != 1)
         anyoutC( 1, "Warning: Cannot convert to a line number");
      else if ((numb < 1) || (numb > macro[macno].ncom))
      {
         if (ins && numb == macro[macno].ncom +1)
            ins = 0;                                 /* exit insert mode */
         else
            anyoutC( 1, "Warning: Line number out of range");
      }
      else                                           /* Must be inserted */
      {
         ins = 1;
         lno = numb;
      }
   }
   else
   {
      /*--------------------------------------------------*/
      /* This is a real command, not a line number.       */
      /* Split line into a command and its parameters.    */
      /* The parse function allocates memory for the      */
      /* character buffers.                               */
      /*--------------------------------------------------*/
      if ( (nret = parse(macno, line, &command, &rest, &savestat)) )
      {
         if (!strcmp(command,"macdir"))
         {
            if (pathname != NULL)
               free( pathname );
            if ( strlen(rest) )
            {
               pathname = malloc( strlen(rest)+2 );  /* Space for copy and / */
               strcpy( pathname, rest );
               strcat( pathname, "/" );
            }
            else                                     /* Reset path name */
            {
               pathname = malloc( 1 );
               pathname[0] = '\0';
            }
         }
         else if (!strcmp(command,"macro"))          /* change macro */
         {
            ins = 0;                                 /* exit insert mode */
            macno = startmacro(macno,rest);          /* initialize macro */
         }
         else if (!strcmp(command,"input"))          /* input from file */
         {
            if (macno == 0)
               lno = input( macno, lno, rest, NO, YES );
            else
               lno = input( macno, lno, rest, NO, NO );
         }
         else if (!strcmp(command,"edit"))           /* Call the editor */
         {
            if (strlen(rest) > 0)                    /* Edit this specific macro */
            {
               char *origin;
               origin = malloc( strlen(macro[macno].name) + 1 );
               if (!origin)
                  anyoutC( 1, "Warning: Memory allocation problems with name copy!" );
               else
               {
                  strcpy( origin, macro[macno].name );
                  macno = startmacro(macno,rest);
                  lno = edit(macno, lno, pathname);
                  macno = startmacro(macno,origin);
               }
            }
            else                                     /* Edit 'main' */
               lno = edit(macno, lno, pathname);
         }
         else if (!strcmp(command,"read"))           /* read macro from file */
            (void) readmacro(rest, pathname);
         else if (!strcmp(command,"write"))          /* write macro to file */
            (void) writemacro(rest,pathname);
         else if (!strcmp(command,"delete"))         /* delete lines/macro */
         {
             ins = 0;
             (void) delete(macno,rest);              /* delete lines or macro */
         }
         else if (!strcmp(command,"end"))            /* end insert or macro */
         {
            if (ins)
               ins = 0;
            else if (macno != 0)
               macno = startmacro( 0, macro[0].name );
         }
         else if ( !strcmp(command,"quit") ||        /* finish this job */
                   !strcmp(command,"stop") )
            con = 0;
         else if (!strcmp(command,"list"))           /* list commands */
            (void) list(macno,rest);
         else if (!strcmp(command,"status"))
            status( );
         else if (nret > maxvocab)                   /* command is macro */
         {
            nmac = nret - maxvocab - 1;              /* macro number */
            if ((!ins) && (!macno))
            {
               if (exemacro(nmac,rest))              /* execute macro */
               {
                  if (macro[nmac].save)
                  {
                     if (insert( macno, lno, linecp ))
                        lno++;
                  }
               }
            }
            else if (macro[nmac].save)
            {
               if (insert( macno, lno, linecp ))
                  lno++;
            }
         }
         else                                        /* command is not a macro */
         {
            ncom = nret - 1;                         /* command number */
            if ((!ins) && (!macno))
            {
               if (execom(command,rest))             /* execute command */
               {
                  if (vocab[ncom].save)
                  {
                     if (insert( macno, lno, linecp ))
                        lno++;
                  }
               }
            }
            else if (vocab[ncom].save)
            {
               if (insert( macno, lno, linecp ))
                  lno++;
            }
         }
      }
      else   /* A parse error */
      {
        if (ins)                                     /* Exit insert mode */
           ins = 0;
      }

      if (!ins)
         lno = macro[macno].ncom + 1;                /* append commands in macro */
      if (!con)                                      /* user wants to quit */
      {                                              /* free macro space */
         int i, m;
         for (m = 0; m < maxmacros; m++)
         {
            for (i = 0; i < macro[m].ncom; i++)
               free( macro[m].buff[i] );
            free( macro[m].buff );
            free( macro[m].name );
         }
         free( macro );
      }
      free( rest );
      free( command );
   }
   *macronr = macno;
   *linenr  = lno;
   *insrt   = ins;
   firstcommand = NO;
   free( linecp );
   return( con );
}
#<

#>            utils.c
/* utils.c
                            COPYRIGHT (c) 1994
                      Kapteyn Astronomical Institute
                University of Groningen, The Netherlands
                           All Rights Reserved.

*/


/*  utils.c: include files     */
#include    "gplot.h"

#define   TABNAME    "LUTS"

char         taskname[MAXTASKNAME]; /* name of this application */




int dispcoord( double    longitude,
               double    latitude,
               double    disp,
               double    angle,
               double   *cdelt,
               double   *longout,
               double   *latout )
/*------------------------------------------------------------*/
/* PURPOSE: Calculate new longitude, latitude after a dis-    */
/*          placement in the sky in a direction given by an   */
/*          angle.                                            */
/* INPUT:   longitude: enter in degrees.                      */
/*          latitude:  enter in degrees.                      */
/*          disp:      the displacement in the sky entered    */
/*                     in degrees. The value can also be      */
/*                     negative to indicate the opposite      */
/*                     direction.                             */
/*          angle:     the angle wrt. a great circle of       */
/*                     constant declination entered in        */
/*                     degrees.                               */
/*          cdelt:     A negative value of cdelt[0] corres-   */
/*                     ponds to a counter-clockwise rotation  */
/*                     instead of a clockwise rotation.       */
/*                                                            */
/* Assume a triangle on a sphere with side b(=disp) connec-   */
/* ting two positions along a great circle and sides 90-d1,   */
/* and 90-d2 (d1, d2 are the declinations of the input and    */
/* output positions) that connect the input and output        */
/* position to the pole P of the sphere. Then the distance    */
/* between the two points Q1=(a1,d1) and Q2=(a2,d2) is:       */
/* cos(b)=cos(90-d1)cos(90-d2)+sin(90-d1)sin(90-d2)cos(a2-a1) */
/* If the angle PQ1Q2 is alpha then we have anoher cosine     */
/* rule:                                                      */
/* cos(90-d2) = cos(b)cos(90-d1)+sin(b)sin(90-d1)cos(alpha)   */
/* or :                                                       */
/* sin(d2) = cos(b)sin(d1)+sin(b)cos(d1)cos(alpha)            */
/* which gives d2. Angle Q1PQ2 is equal to a2-a1. For this    */
/* angle we have the sine formula:                            */
/* sin(b)/sin(a2-a1) = sin(90-d2)/sin(alpha) so that:         */
/* sin(a2-a1) = sin(b)sin(alpha)/cos(d2).                     */
/* b,alpha and d2 are known -> a2.                            */
/*------------------------------------------------------------*/
{
   double   alpha;
   double   b  = ABS(RAD(disp));
   double   a1 = RAD(longitude), a2;
   double   d1 = RAD(latitude),  d2;
   double   dH;


   if (disp < 0.0)
      angle += 180.0;
   
   alpha = RAD(angle);     
   d2 = asin( cos(b)*sin(d1)+cos(d1)*sin(b)*cos(alpha) );   
   dH = asin( sin(b)*sin(alpha)/cos(d2) );
   if (cdelt[0] < 0.0)
     a2 = a1 + dH;
   else 
     a2 = a1 - dH;
  
   *longout = DEG(a2);
   *latout  = DEG(d2);
               
   return( 1 );
}





void anyoutC( int dev,
              char *anyCstr )
/*------------------------------------------------------------*/
/* The C version of 'anyout_c' needs two parameters:          */
/* an integer and a C-type string. The integer determines     */
/* the destination of the output which is:                    */
/*    0  use default [set by HERMES to 3 but can be changed   */
/*       by user]                                             */
/*    1  terminal                                             */
/*    2  LOG file                                             */
/*    8  terminal, suppressed in "experienced mode"           */
/*   16  terminal, only when in "test mode"                   */
/*------------------------------------------------------------*/
{
   fint ldev = (fint) dev;
   anyout_c( &ldev, tofchar( anyCstr ) );
}


void anylog( int  dev,
             char *stat,
             char *mess )
/*------------------------------------------------------------*/
/* Display warnings and remarks etc.                          */
/* Input: dev  ,  integer ,  output level for anyout_c        */
/*        stat ,  char *  ,  status of message                */
/*        mess ,  char *  ,  message to display               */
/*------------------------------------------------------------*/
{
   char   buff[LONGSTR];
   fint   ldev = (fint) dev;

   (void) sprintf( buff, "<%s %s> %s", taskname, stat, mess );
   anyout_c( &ldev, tofchar(buff) );
}



int deputyC( char *taskname, char *command )
/*------------------------------------------------------------*/
/* The C version 'deputy'. The deputy was only successful if  */
/* the return value of 'status' is 1.                         */
/*------------------------------------------------------------*/
{
   fint   status;

   deputy_c( tofchar(taskname), &status );
   if (status ==  5)
      anylog( 1, command, "called task disconnected");
   if (status == -6)
      anylog( 1, command, "task not present");
   if (status == -7)
      anylog( 1, command, "max number of tasks already active");
   return( (status == 1) );
}



void prtout( FILE *fp,
             int  dev,
             char *anyCstr )
/*------------------------------------------------------------*/
/* Write text to file or anyout.                              */
/*------------------------------------------------------------*/
{
   if (fp != NULL)
      fprintf( fp, "%s\n", anyCstr );
   else
   {
      fint ldev = (fint) dev;
      anyout_c( &ldev, tofchar(anyCstr) );
   }
}



void dcderror( int errorcode )
/*------------------------------------------------------------*/
/* The dcd*** routines Decodes a string of characters into    */
/* reals, integers etc. The returned error codes are used to  */
/* generate a message in this function.                       */
/*------------------------------------------------------------*/
{
   char localmes[80];

   localmes[0] = '\0';
   switch( errorcode )
   {
      case -11:
         strcpy( localmes, "bad call");
         break;
      case -12:
         strcpy( localmes, "unknown function");
         break;
      case -13:
         strcpy( localmes, "syntax error");
         break;
      case -14:
         strcpy( localmes, "illegal character");
         break;
      case -15:
         strcpy( localmes, "wrong repeat argument");
         break;
      case -16:
         strcpy( localmes, "wrong number of arguments");
         break;
      case -17:
         strcpy( localmes, "arithmetic error");
         break;
      case -18:
         strcpy( localmes, "not enough internal memory");
         break;
      case -19:
         strcpy( localmes, "conversion error");
         break;
      case -20:
         strcpy( localmes, "unequal list length");
         break;
      case -21:
         strcpy( localmes, "empty list");
         break;
      case -22:
         strcpy( localmes, "nested lists");
         break;
      case -23:
         strcpy( localmes, "output buffer overflow");
         break;
      case -24:
         strcpy( localmes, "floating overflow/underflow in conversion");
         break;
      default:
         (void) sprintf( localmes, "Unknown error no.%d", errorcode );
   }
   anylog( 1, "Error in number conversion", localmes );
}



void poserr( char *mes,
             fint  err )
/*-----------------------------------------------------------*/
/* Generate a message that belongs to a dcdpos error         */
/*-----------------------------------------------------------*/
{
   if      (err == -1)  strcpy( mes, "DCDPOS illegal use of 'PC', 'AC' or 'D'");
   else if (err == -2)  strcpy( mes, "DCDPOS prefix incompatible with axis");
   else if (err == -3)  strcpy( mes, "DCDPOS position incomplete");
   else if (err == -4)  strcpy( mes, "DCDPOS error reading descriptor info");
   else if (err == -5)  strcpy( mes, "DCDPOS 'D' not allowed for positions");
   else if (err == -6)  strcpy( mes, "DCDPOS No grid separation defined for units");
   else if (err == -7)  strcpy( mes, "DCDPOS Too many positions");
   else if (err == -8)  strcpy( mes, "DCDPOS Cannot obtain header information");
   else if (err == -9)  strcpy( mes, "DCDPOS No mixed epochs allowed");
   else if (err == -10) strcpy( mes, "DCDPOS General decode error (detected by dcddble)" );
   else if (err == -11) strcpy( mes, "DCDPOS BLANKS decoded" );
   else                 strcpy( mes, "DCDPOS Unknown error" );
}


void  axinfo( int  typenum,
              int  skynum,
              int  pronum,
              int  velnum,
              char *typestr,
              char *skystr,
              char *prostr,
              char *velstr )
/*------------------------------------------------------------*/
/* What kind of axis is this? The 'typenum' corresponds to a  */
/* text.                                                      */
/*------------------------------------------------------------*/
{
   switch ( (int) typenum )
   {
      case 0:
         strcpy( typestr, "unknown type" );
         break;
      case 1:
         strcpy( typestr, "spatial axis longitude" );
         break;
      case 2:
         strcpy( typestr, "spatial axis latitude" );
         break;
      case 3:
         strcpy( typestr, "spectral axis frequency" );
         break;
      case 4:
         strcpy( typestr, "spectral axis velocity" );
         break;
      case 5:
         strcpy( typestr, "spectral axis wavelength" );
         break;
      case 6:
         strcpy( typestr, "spectral axis inverse wavelength" );
         break;
      case 7:
         strcpy( typestr, "spectral axis log(wavelength)" );
         break;
      case 8:
         strcpy( typestr, "time axis" );
         break;
      case 9:
         strcpy( typestr, "polarisation axis" );
         break;
      case 10:
         strcpy( typestr, "parameter axis" );
         break;
      case 11:
         strcpy( typestr, "sample axis of iras data" );
         break;
      case 12:
         strcpy( typestr, "tick axis of iras data" );
         break;
      case 13:
         strcpy( typestr, "detector axis of iras data" );
         break;
      case 14:
         strcpy( typestr, "snip axis of iras data" );
         break;
   }

   skystr[0] = '\0';
   prostr[0] = '\0';
   if ((typenum == 1) || (typenum == 2))
   {
      /* Display projection system */
      switch( (int) skynum )
      {
         case 1:
            strcpy( skystr, "equatorial" );
            break;
         case 2:
            strcpy( skystr, "galactic" );
            break;
         case 3:
            strcpy( skystr, "ecliptic" );
            break;
         case 4:
            strcpy( skystr, "supergalactic" );
            break;
      }

      switch( (int) pronum )
      {
         case 1:
            strcpy( prostr, "AITOFF equal area" );
            break;
         case 2:
            strcpy( prostr, "equivalent cylindrical" );
            break;
         case 3:
            strcpy( prostr, "flat" );
            break;
         case 4:
            strcpy( prostr, "gnomonic" );
            break;
         case 5:
            strcpy( prostr, "orthographic" );
            break;
         case 6:
            strcpy( prostr, "rectangular" );
            break;
         case 7:
            strcpy( prostr, "global sinusoidal" );
            break;
         case 8:
            strcpy( prostr, "north celestial pole (WSRT)" );
            break;
         case 9:
            strcpy( prostr, "stereographic" );
            break;
         case 10:
            strcpy( prostr, "mercator projection" );
            break;
      }
   }

   velstr[0] = '\0';
   if (typenum == 3)
   {
      /* Display projection system */
      switch( (int) skynum )
      {
         case 1:
            strcpy( velstr, "optical" );
            break;
         case 2:
            strcpy( velstr, "radio" );
            break;
      }
   }
   if (typenum == 4)
      strcpy( velstr, "radio" );
}




void plvsiz( float x1,
             float x2,
             float y1,
             float y2 )
/*-------------------------------------------------------------*/
/* Set the viewport in inches. Note that xin[0] must be greater*/
/* than xin[2] (same for y-direction.                          */
/*-------------------------------------------------------------*/
{
   float xin[4];

   xin[0] = MYMIN( x1, x2 );
   xin[2] = MYMAX( x1, x2 );
   xin[1] = MYMIN( y1, y2 );
   xin[3] = MYMAX( y1, y2 );
   pgvsiz_c( &xin[0], &xin[2], &xin[1], &xin[3] );
}



int printusing( char     *formatstr,
                float    number,
                char     *resultstr )
/*------------------------------------------------------------*/
/* PURPOSE: Print numbers in an user specified format.        */
/* Substitute 'b' for blanks. Do not print a number if the    */
/* length exceeds the fieldlen.                               */
/*------------------------------------------------------------*/
{
   int    len;
   int    before, after;
   char   format[512];
   int    clen;
   int    i;   
   char   *instr;
   char   mode;
   float  blank;


   setfblank_c( &blank );
   len    = strlen( formatstr );
   before = strcspn( formatstr, "." );
   if (before > len)
      before = len;
   if (before!=len)
      after = len - before - 1;
   else
      after = 0;
   strcpy( format, "%" );
   for (i = 0; i < 2; i++)
   {
     mode = formatstr[i];
     if (mode == '+')
        strcat( format, "+" );
     if (mode == '-')
        strcat( format, "-" );
   }
   instr = strpbrk( formatstr, "eEgG" );
   if (instr == NULL)
      mode = 'f';
   else
   /*--------------------------------------------------------------------*/
   /* For e, E, f, g and G conversions, the result shall always contain  */
   /* a radix character, even if no digits follow the radix character.   */
   /* For g and G conversions, trailing zeroes shall not be removed from */
   /* the result as they usually are.                                    */
   /*--------------------------------------------------------------------*/
   {
      mode = *instr;
      strcat( format, "#" );
   }

   sprintf( format, "%.*s%d.%d%c", strlen(format), format, len, after, mode );
   if (number == blank)
      sprintf( resultstr, "%*s", len, "b" );
   else
   {
      clen = sprintf( resultstr, format, number );
      if (clen > len)
         sprintf( resultstr, "%*s", len, "*" );
   }
   return( len );
}




float getphysval( fchar Setin,
                  fint  subset,
                  fint  *axnum,
                  int   axisnr )
/*------------------------------------------------------------*/
/* PURPOSE: */
/*------------------------------------------------------------*/
{
   fint     setdim;
   fint     subdim;
   fint     r1;
   int      i;
   double   coordin[MAXAXES];    /* Grids before transformation */
   double   coordout[MAXAXES];   /* Physical coordinates after transformation */
   fint     direction;           /* grid coord. -> physical coord. */
   fint     axnr;
   fint     setlevel = 0;
   float    blank;



   setfblank_c( &blank );
   if ( nelc_c(Setin) == 0 )
      return( blank );

   setdim = gdsc_ndims_c( Setin, &setlevel );
   subdim = gdsc_ndims_c( Setin, &subset );
   if (axisnr > (setdim-subdim) || axisnr <= 0)
   {
      anyoutf( 1, "Axis [%d] is not in range [1..%d]", axisnr, setdim-subdim );
      return( blank );
   }
   for (i = 0; i < setdim; i++)
      coordin[i] = 0.0;

   axnr = axnum[axisnr+subdim-1];
   coordin[axnr-1] = (double) gdsc_grid_c( Setin, &axnr, &subset, &r1 );
   direction = 1;                           /* grid coord. -> physical coord. */
   r1 = cotrans_c( Setin, &subset, coordin, coordout, &direction );
   if (r1)
      return( blank );
   return( (float) coordout[axnr-1] );
}




int pltext( char    *command,
            double  xx,
            double  yy,
            double  angle,
            double  just,
            fchar   Setin,
            fint    subset,
            fint    *axnum,
            char    *txt )
/*------------------------------------------------------------*/
/* PURPOSE: If 'txt' contains  a '{' character, try to substi-*/
/*          tute the expression between '{}'                  */
/* Repeat process until last character is examined.           */
/* Alternative for pgptxt.                                    */
/*------------------------------------------------------------*/
{
   float    x, y;
   float    ang, jus;

   char     longstr[1024];
   char     substr[1024];
   int      charsleft = strlen( txt );
   int      i = 0, j = 0;
   float    blank;


   setfblank_c( &blank );
   x = (float) xx;
   y = (float) yy;
   ang = (float) angle;
   jus = (float) just;

   if ( strchr(txt, '{') == NULL )
   {
      pgptxt_c( &x, &y, &ang, &jus, tofchar(txt) );
      return( 1 );
   }

   while (charsleft)
   {
      while (txt[i] != '{' && charsleft)           /* Copy this text */
      {
         longstr[j++] = txt[i++];
         charsleft--;
      }
      if (charsleft)
      {
         int    k = 0;
         i++;
         while (txt[i] == SPACE && charsleft)
         {
            /* skip leading spaces */
            i++;
            charsleft--;
         }
         while (txt[i] != '}' && charsleft)
         {
            /* Assemble the string between {} */
            substr[k++] = txt[i++];
            charsleft--;
         }
         if (txt[i] != '}')
         {
            anylog( 1, command, "Could not find matching '}'" );
            return( 0 );
         }
         else
         {
            fint      r;
            fint      one = 1;
            fint      err = 0;
            int       t;
            char     *valstr;
            char      formstr[80];
            double    val;

            i++;
            substr[k]  = '\0';             /* Close string */
            formstr[0] = '\0';
            valstr     = substr;
            /*--------------------------------------------------*/
            /* This sub string can contain an expression or a   */
            /* format string followed by an expression. The     */
            /* comma character is the only separator.           */
            /*--------------------------------------------------*/
            if ( strchr(substr, COMMA) != NULL )
            {
               /* There MUST be 2 arguments separated by a comma */
               int   p = 0, q = 0;
               while (substr[p] != COMMA)
                  formstr[q++] = substr[p++];
               formstr[q] = '\0';
               while( substr[p] == SPACE || substr[p] == COMMA )
                  p++;
               valstr = &substr[p];
            }
            t = strlen( valstr );
            while (t > 0 && valstr[t-1] == ' ')
               valstr[--t] = '\0';

            if (valstr[0] == '#')
            /*--------------------------------------------------*/
            /* User wants physical coordinate of current set,   */
            /* subset.                                          */
            /*--------------------------------------------------*/
            {
               int    axisnr;
               axisnr = atoi( &valstr[1] );
               val = getphysval( Setin, subset, axnum, axisnr );
               if (val == blank)
                  return( 0 );
            }
            else
               r = dcddble_c( tofchar(valstr), &val, &one, &err );
            if (err)
            {
               dcderror( err );
               return( 0 );
            }
            else
            {
               int s;
               anyoutf( 16, "%s: Converted {%s} to number: %g",
                        command, valstr, val );
               if (strlen(formstr))
               {
                  int  len = printusing_c( tofchar(formstr),
                                           &val,
                                           tofchar(substr) );
                  substr[len] = '\0';   /* Not closed by function */
               }
               else
               {
                  /* A default format */
                  (void) sprintf( substr, "%g", val );
               }
               /* Copy the (formatted) evaluation to the text buffer */
               for (s = 0; s < strlen(substr); s++)
                  longstr[j++] = substr[s];
            }
         }
      }
   }
   longstr[j] = '\0';
   pgptxt_c( &x, &y, &ang, &jus, tofchar(longstr) );
   return( 1 );
}



void plrect( double xx1,
             double yy1,
             double xx2,
             double yy2 )
/*-------------------------------------------------------------*/
/* Alternative for pgrect. Note that box runs from x1,y1 to    */
/* x2, y2 instead of vv.                                       */
/*-------------------------------------------------------------*/
{
   float x1, x2, y1, y2;
   x1 = (float) xx1; x2 = (float) xx2;
   y1 = (float) yy1; y2 = (float) yy2;
   pgrect_c( &x1, &x2, &y1, &y2 );
}


char *StrDup(const char *inpstr )
/*-------------------------------------------------------------*/
/* Create space for a string and copy contents of input.       */
/*-------------------------------------------------------------*/
{
   char *outstr = NULL;

   int l = strlen( inpstr ) + 1;
   outstr = malloc( l );
   if (!outstr)
   {
      anyoutC( 1, "Cannot allocate space for string in 'StrDup' function!");
      return( outstr );
   }
   return( strcpy( outstr, inpstr ) );
}


char *cleanstr( char *str )
/*------------------------------------------------------------*/
/* Scan string on comments, newlines and trailing spaces.     */
/*------------------------------------------------------------*/
{
   int  i;
   /* replace new line and '!' character to zero char. */
   for (i = 0; i < strlen(str); i++)
   {
      if (str[i] == '!' || str[i] == '\n')
      {
         str[i] = '\0';
         break;
      }
   }

   /* Get rid of trailing spaces */
   i = strlen( str ) - 1;
   while( i >= 0 && isspace(str[i]) )
      str[i--] = '\0';

   if (!str[0])
      return( NULL );
   return( str );
}


int wmatchC( char *test, char *mask )
/*------------------------------------------------------------*/
/* Matches a test string with the mask string which contains  */
/* wildcards. wmatchC returns non-zero if matched, zero if    */
/* not.                                                       */
/*------------------------------------------------------------*/
{
   int   matched;
   fint  casesensitive = NO;

   matched = (int) wmatch_c( tofchar(test),    /* String to test agains MASK. */
                             tofchar(mask),    /* String which contains the mask with wildcards. */
                             tofchar("*"),     /* Character which represents the wildcard. */
                             &casesensitive ); /* If zero, matching is case-insensitive. */
   return( matched );
}


int getcolor( char *colorstr )
/*------------------------------------------------------------*/
/* Given a string, find the corresponding colour number.      */
/* If no match could be found, return -1.                     */
/*------------------------------------------------------------*/
{
   char   *colstr = NULL;
   fint   col = -1;

   colstr = malloc( strlen(colorstr) + 2 );
   if (!colstr)
   {
      anylog( 1, "warning", "Cannot allocate memory for colour string!");
      return( 0 );
   }
   strcpy( colstr, colorstr );
   strcat( colstr, "*" );
   if (wmatchC( "Background",         colstr )) {
      col = 0;
   } else if (wmatchC( "Foreground",  colstr )) {
      col = 1;
   } else if (wmatchC( "Default",     colstr )) {
      col = 1;
   } else if (wmatchC( "Red",         colstr )) {
      col = 2;
   } else if (wmatchC( "Green",       colstr )) {
      col = 3;
   } else if (wmatchC( "Blue",        colstr )) {
      col = 4;
   } else if (wmatchC( "Cyan",        colstr )) {
      col = 5;
   } else if (wmatchC( "Magenta",     colstr )) {
      col = 6;
   } else if (wmatchC( "Yellow",      colstr )) {
      col = 7;
   } else if (wmatchC( "Orange",      colstr )) {
      col = 8;
   } else if (wmatchC( "GreenYellow", colstr )) {
      col = 9;
   } else if (wmatchC( "GreenCyan",   colstr )) {
      col = 10;
   } else if (wmatchC( "BlueCyan",    colstr )) {
      col = 11;
   } else if (wmatchC( "BlueMagenta", colstr )) {
      col = 12;
   } else if (wmatchC( "RedMagenta",  colstr )) {
      col = 13;
   } else if (wmatchC( "DarkGray",    colstr )) {
      col = 14;
   } else if (wmatchC( "LightGray",   colstr )) {
      col = 15;
   }
   free( colstr );
   return( col );
}


void devinfo( double devx1mm,
              double devy1mm,
              double devx2mm,
              double devy2mm )
/*------------------------------------------------------------*/
/* Display PGPLOT device information.                         */
/*------------------------------------------------------------*/
{
   fchar  Infostr;
   fint   flen = STRLEN;
   fint   mm = 2;
   float  x1mm, x2mm, y1mm, y2mm;
   char   message[LONGSTR];
   int    devopen = NO;

   fmake( Infostr,STRLEN );
   anyoutC( 1, "======================= PGPLOT STATUS ========================");
   pgqinf_c( tofchar("VERSION"), Infostr, &flen );
   (void) sprintf( message, "PGPLOT software version: %.*s", flen, Infostr.a );
   anyoutC( 1, message );
   pgqinf_c( tofchar("STATE"), Infostr, &flen );
   (void) sprintf( message, "PGPLOT status: %.*s", flen, Infostr.a );
   anyoutC( 1, message );
   if (Infostr.a[0] == 'O')
      devopen = YES; 
  
   pgqinf_c( tofchar("USER"), Infostr, &flen );
   (void) sprintf( message, "User name: %.*s", flen, Infostr.a );
   anyoutC( 1, message );
   pgqinf_c( tofchar("NOW"), Infostr, &flen );
   (void) sprintf( message, "Current date and time: %.*s", flen, Infostr.a );
   anyoutC( 1, message );
   pgqinf_c( tofchar("DEVICE"), Infostr, &flen );
   (void) sprintf( message, "Current PGPLOT device: %.*s", flen, Infostr.a );
   anyoutC( 1, message );
   pgqinf_c( tofchar("FILE"), Infostr, &flen );
   (void) sprintf( message, "Current PGPLOT file: %.*s", flen, Infostr.a );
   anyoutC( 1, message );
   pgqinf_c( tofchar("TYPE"), Infostr, &flen );
   (void) sprintf( message, "Device-type code name of the current PGPLOT device: %.*s", flen, Infostr.a );
   anyoutC( 1, message );
   pgqinf_c( tofchar("HARDCOPY"), Infostr, &flen );
   (void) sprintf( message, "Is the current device a hardcopy device: %.*s", flen, Infostr.a );
   anyoutC( 1, message );
   pgqinf_c( tofchar("TERMINAL"), Infostr, &flen );
   (void) sprintf( message, "Is the current device the user's interactive terminal: %.*s", flen, Infostr.a );
   anyoutC( 1, message );
   pgqinf_c( tofchar("CURSOR"), Infostr, &flen );
   (void) sprintf( message, "Does the current device have a graphics cursor: %.*s", flen, Infostr.a );
   anyoutC( 1, message );
   
   if (devopen)
   {
      fint cilo, cihi;      
      pgqvp_c( &mm, &x1mm, &x2mm, &y1mm, &y2mm );
      (void) sprintf( message, "Current viewport: from (%g,%g) to (%g,%g) mm",
                      x1mm, y1mm, x2mm, y2mm );
      anyoutC( 1, message );
      (void) sprintf( message, "Sizes of this device: %g x %g (mm)",
                      (devx2mm-devx1mm), (devy2mm-devy1mm) );
      anyoutC( 1, message );
      
      pgqcir_c( &cilo, &cihi );
      anyoutf( 1, "Colour index range: from %d to %d", cilo, cihi );
   }                  
   anyoutC( 1, "==============================================================");
}



static void readerror( fchar Setin,
                       fchar Tname,
                       fchar Cname )
/*------------------------------------------------------------*/
/* PURPOSE: Display an error message if data from a column    */
/*          could not be read.                                */
/*------------------------------------------------------------*/
{
   anyoutf( 1, "Cannot read data from column [%.*s] of table [%.*s] in set [%.*s]",
            nelc_c(Cname), Cname.a,
            nelc_c(Tname), Tname.a,
            nelc_c(Setin), Setin.a );
}



static int colexist( fchar Setin,
                     fint  subset,
                     fchar Tname,
                     fchar Cname )
/*------------------------------------------------------------*/
/* PURPOSE: Does a column in this table in this set exists?   */
/*------------------------------------------------------------*/
{
   fint    r1 = 0;
   fint    nrows;
   fchar   Units;
   fchar   Comment;
   fchar   Type;

   fmake( Units,   VARRECLEN );
   fmake( Comment, VARRECLEN );
   fmake( Type,    VARRECLEN );

   gdsa_colinq_c( Setin, &subset, Tname, Cname, Type, Comment, Units, &nrows, &r1 );
   if (r1 < 0)
   {
      anyoutf( 16, "Cannot get info from column [%.*s] in set [%.*s]",
               nelc_c(Cname), Cname.a, nelc_c(Setin), Setin.a );
      return( 0 );
   }
   return( 1 );
}



int luttotable( fchar Setin,
                fint  subset,
                fint  lutlen,
                float *lutr,
                float *lutg,
                float *lutb,
                fint  GIDSmincol,
                fint  GIDSmaxcol,
                fint  GIDSncolors,
                float GIDSbscale,
                float GIDSbzero,
                fint  GIDSblank )
/*------------------------------------------------------------*/
/* PURPOSE: Store in the header of 'Setin' the lut parameters */
/*          in a table.                                       */
/* The lut parameters are three arrays with the RGB values.   */
/* The arrays have length 'lutlen'. Scaling is done with the  */
/* values of 'GIDSmincol/maxcol', and 'GIDSbscale/bzero'.     */
/*------------------------------------------------------------*/
{
   fchar   Cname;
   fchar   Tname;
   fchar   Units;
   fchar   Comment;
   fchar   Type;
   fint    r1;
   fint    one = 1;


   fmake( Tname,   ITEMLEN );
   fmake( Cname,   ITEMLEN );
   fmake( Units,   VARRECLEN );
   fmake( Comment, VARRECLEN );
   fmake( Type,    VARRECLEN );

   fcopy( Tname, TABNAME );
   fcopy( Cname, "LUTR" );
   fcopy( Units, "NONE" );
   if ( colexist( Setin, subset, Tname, Cname) )
   {
      r1 = 0;
      gdsa_delcol_c( Setin, &subset, Tname, Cname, &r1 );
   }
   fcopy( Type, "REAL" );
   fcopy( Comment, "Lut array RED" );
   r1 = 0;
   gdsa_crecol_c( Setin, &subset, Tname, Cname, Type, Comment, Units, &r1 );

   fcopy( Cname, "LUTG" );
   if ( colexist( Setin, subset, Tname, Cname) )
   {
      r1 = 0;
      gdsa_delcol_c( Setin, &subset, Tname, Cname, &r1 );
   }
   fcopy( Comment, "Lut array GREEN" );
   r1 = 0;
   gdsa_crecol_c( Setin, &subset, Tname, Cname, Type, Comment, Units, &r1 );

   fcopy( Cname, "LUTB" );
   if ( colexist( Setin, subset, Tname, Cname) )
   {
      r1 = 0;
      gdsa_delcol_c( Setin, &subset, Tname, Cname, &r1 );
   }
   fcopy( Comment, "Lut array BLUE" );
   r1 = 0;
   gdsa_crecol_c( Setin, &subset, Tname, Cname, Type, Comment, Units, &r1 );

   r1 = 0;
   gdsa_wcreal_c( Setin, &subset, Tname, tofchar("LUTR"), lutr, &one, &lutlen, &r1 );
   r1 = 0;
   gdsa_wcreal_c( Setin, &subset, Tname, tofchar("LUTG"), lutg, &one, &lutlen, &r1 );
   r1 = 0;
   gdsa_wcreal_c( Setin, &subset, Tname, tofchar("LUTB"), lutb, &one, &lutlen, &r1 );

   fcopy( Cname, "LUTLEN" );
   if ( colexist(Setin, subset, Tname, Cname) )
   {
      r1 = 0;
      gdsa_delcol_c( Setin, &subset, Tname, Cname, &r1 );
   }
   fcopy( Type, "INT" );
   fcopy( Comment, "Lut array length" );
   r1 = 0;
   gdsa_crecol_c( Setin, &subset, Tname, Cname, Type, Comment, Units, &r1 );
   r1 = 0;
   gdsa_wcint_c( Setin, &subset, Tname, Cname, &lutlen, &one, &one, &r1 );

   fcopy( Cname, "MINCOL" );
   if ( colexist( Setin, subset, Tname, Cname) )
   {
      r1 = 0;
      gdsa_delcol_c( Setin, &subset, Tname, Cname, &r1 );
   }
   fcopy( Type, "INT" );
   fcopy( Comment, "Minimum colour index" );
   r1 = 0; 
   gdsa_crecol_c( Setin, &subset, Tname, Cname, Type, Comment, Units, &r1 );
   r1 = 0; 
   gdsa_wcint_c( Setin, &subset, Tname, Cname, &GIDSmincol, &one, &one, &r1 );

   fcopy( Cname, "MAXCOL" );
   if ( colexist( Setin, subset, Tname, Cname) )
   {
      r1 = 0;
      gdsa_delcol_c( Setin, &subset, Tname, Cname, &r1 );
   }
   fcopy( Type, "INT" );
   fcopy( Comment, "Maximum colour index" );
   r1 = 0;
   gdsa_crecol_c( Setin, &subset, Tname, Cname, Type, Comment, Units, &r1 );
   r1 = 0;
   gdsa_wcint_c( Setin, &subset, Tname, Cname, &GIDSmaxcol, &one, &one, &r1 );

   fcopy( Cname, "NCOLORS" );
   if ( colexist( Setin, subset, Tname, Cname) )
   {
      r1 = 0;
      gdsa_delcol_c( Setin, &subset, Tname, Cname, &r1 );
   }
   fcopy( Type, "INT" );
   fcopy( Comment, "Maximum number of colours" );
   r1 = 0;
   gdsa_crecol_c( Setin, &subset, Tname, Cname, Type, Comment, Units, &r1 );
   r1 = 0;
   gdsa_wcint_c( Setin, &subset, Tname, Cname, &GIDSncolors, &one, &one, &r1 );

   fcopy( Cname, "BSCALE" );
   if ( colexist( Setin, subset, Tname, Cname) )
   {
      r1 = 0;
      gdsa_delcol_c( Setin, &subset, Tname, Cname, &r1 );
   }
   fcopy( Type, "REAL" );
   fcopy( Comment, "Colour scaling (bscale)" );
   r1 = 0;
   gdsa_crecol_c( Setin, &subset, Tname, Cname, Type, Comment, Units, &r1 );
   r1 = 0;
   gdsa_wcreal_c( Setin, &subset, Tname, Cname, &GIDSbscale, &one, &one, &r1 );

   fcopy( Cname, "BZERO" );
   if ( colexist( Setin, subset, Tname, Cname) )
   {
      r1 = 0;
      gdsa_delcol_c( Setin, &subset, Tname, Cname, &r1 );
   }
   fcopy( Type, "REAL" );
   fcopy( Comment, "Colour offset (bzero)" );
   r1 = 0;
   gdsa_crecol_c( Setin, &subset, Tname, Cname, Type, Comment, Units, &r1 );
   r1 = 0;
   gdsa_wcreal_c( Setin, &subset, Tname, Cname, &GIDSbzero, &one, &one, &r1 );

   fcopy( Cname, "BLANKIND" );
   if ( colexist(Setin, subset, Tname, Cname) )
   {
      r1 = 0;
      gdsa_delcol_c( Setin, &subset, Tname, Cname, &r1 );
   }
   fcopy( Type, "INT" );
   fcopy( Comment, "Colour index of a blank" );
   r1 = 0;
   gdsa_crecol_c( Setin, &subset, Tname, Cname, Type, Comment, Units, &r1 );
   r1 = 0;
   gdsa_wcint_c( Setin, &subset, Tname, Cname, &GIDSblank, &one, &one, &r1 );

   return( 1 );
}



int lutfromtable( fchar Setin,
                  fint  subset,
                  fint  *lutlen,
                  float *lutr,
                  float *lutg,
                  float *lutb,
                  fint  *GIDSmincol,
                  fint  *GIDSmaxcol,
                  fint  *GIDSncolors,
                  float *GIDSbscale,
                  float *GIDSbzero,
                  fint  *GIDSblank )
/*------------------------------------------------------------*/
/* PURPOSE: Read colour lut and scaling parameters from header*/
/* The sizes of the lutr/g/b arrays are fixed to 256.         */
/* The column sizes of the other parameters is 1.             */
/*------------------------------------------------------------*/
{
   fchar   Cname;
   fchar   Tname;
   fchar   Units;
   fchar   Comment;
   fchar   Type;
   fint    r1;
   fint    nrows;
   fint    one = 1;


   fmake( Tname,   ITEMLEN );
   fmake( Cname,   ITEMLEN );
   fmake( Units,   VARRECLEN );
   fmake( Comment, VARRECLEN );
   fmake( Type,    VARRECLEN );

   fcopy( Tname, TABNAME );
   fcopy( Cname, "LUTLEN" );
   if ( !colexist( Setin, subset, Tname, Cname) )
      return( 0 );
   r1 = 0;
   gdsa_rcint_c( Setin, &subset, Tname, Cname, lutlen, &one, &one, &r1 );
   if (r1 < 0)
   {
      readerror( Setin, Tname, Cname );
      return( 0 );
   }
   nrows = *lutlen;

   fcopy( Cname, "LUTR" );
   if ( !colexist( Setin, subset, Tname, Cname) )
      return( 0 );
   r1 = 0;
   gdsa_rcreal_c( Setin, &subset, Tname, Cname, lutr, &one, &nrows, &r1 );
   if (r1 < 0)
   {
      readerror( Setin, Tname, Cname );
      return( 0 );
   }

   fcopy( Cname, "LUTG" );
   if ( !colexist( Setin, subset, Tname, Cname) )
      return( 0 );
   r1 = 0;
   gdsa_rcreal_c( Setin, &subset, Tname, Cname, lutg, &one, &nrows, &r1 );
   if (r1 < 0)
   {
      readerror( Setin, Tname, Cname );
      return( 0 );
   }

   fcopy( Cname, "LUTB" );
   if ( !colexist( Setin, subset, Tname, Cname) )
      return( 0 );
   r1 = 0;
   gdsa_rcreal_c( Setin, &subset, Tname, Cname, lutb, &one, &nrows, &r1 );
   if (r1 < 0)
   {
      readerror( Setin, Tname, Cname );
      return( 0 );
   }

   fcopy( Cname, "MINCOL" );
   if ( !colexist( Setin, subset, Tname, Cname) )
      return( 0 );
   r1 = 0;
   gdsa_rcint_c( Setin, &subset, Tname, Cname, GIDSmincol, &one, &one, &r1 );
   if (r1 < 0)
   {
      readerror( Setin, Tname, Cname );
      return( 0 );
   }

   fcopy( Cname, "MAXCOL" );
   if ( !colexist( Setin, subset, Tname, Cname) )
      return( 0 );
   r1 = 0;
   gdsa_rcint_c( Setin, &subset, Tname, Cname, GIDSmaxcol, &one, &one, &r1 );
   if (r1 < 0)
   {
      readerror( Setin, Tname, Cname );
      return( 0 );
   }

   fcopy( Cname, "NCOLORS" );
   if ( !colexist(Setin, subset, Tname, Cname) )
      return( 0 );
   r1 = 0;
   gdsa_rcint_c( Setin, &subset, Tname, Cname, GIDSncolors, &one, &one, &r1 );
   if (r1 < 0)
   {
      readerror( Setin, Tname, Cname );
      return( 0 );
   }

   fcopy( Cname, "BSCALE" );
   if ( !colexist(Setin, subset, Tname, Cname) )
      return( 0 );
   r1 = 0;
   gdsa_rcreal_c( Setin, &subset, Tname, Cname, GIDSbscale, &one, &one, &r1 );
   if (r1 < 0)
   {
      readerror( Setin, Tname, Cname );
      return( 0 );
   }

   fcopy( Cname, "BZERO" );
   if ( !colexist(Setin, subset, Tname, Cname) )
      return( 0 );
   r1 = 0;
   gdsa_rcreal_c( Setin, &subset, Tname, Cname, GIDSbzero, &one, &one, &r1 );
   if (r1 < 0)
   {
      readerror( Setin, Tname, Cname );
      return( 0 );
   }
  
   fcopy( Cname, "BLANKIND" );
   if ( !colexist(Setin, subset, Tname, Cname) )
      return( 0 );
   r1 = 0;
   gdsa_rcint_c( Setin, &subset, Tname, Cname, GIDSblank, &one, &one, &r1 );
   if (r1 < 0)
   {
      readerror( Setin, Tname, Cname );
      return( 0 );
   }

   anyoutf(16,"Lut from table: lutlen=%d maxcol=%d mincol=%d, ncolors=%d, bscale=%f, bzero=%f, blank=%d",
           *lutlen, *GIDSmincol, *GIDSmaxcol, *GIDSncolors, *GIDSbscale, *GIDSbzero, *GIDSblank );
  
   return( 1 );
}



void p_ellipse(   fchar  Setin,
                  fint   subset,
                  double *cdelt,
                  double Centre_X,          
                  double Centre_Y ,
                  double Major,        
                  double Minor,
                  double Posangle )
/*------------------------------------------------------------*/
/* Draw ellipse with area fill. The beam can also be plotted  */
/* as a rectangle.                                            */
/*------------------------------------------------------------*/
{
   double    CosA, SinA;                    /* Angles */
   double    Alpha;                         /* Used in Polar coordinates */
   double    R;                             /* Radius used in Polar coordinates */
   double    Denom;                         /* Help var. */
   double    physpos[2];
   double    gridpos[2];   
   double    minor2 = Minor * Minor;
   double    major2 = Major * Major;   
   double    minor2major2 = minor2 * major2;
   float     Xpoints[368], Ypoints[368];    /* Outline ellipse in arrays */
   int       i;                             /* Array index */
   fint      Numpoints;                     /* Number of points in arrays */
   fint      r;

  
   i = 0;
   /*-----------------------------------------------------------*/
   /*                                2       2                  */
   /* General equation ellipse: (x/a) + (y/b) = 1 is also       */
   /* written as b^2.x^2 + a^2.y^2 = a^2.b^2                    */
   /* Substitute: x = R.cos(alpha), y = R.sin(alpha) and solve  */
   /* for R. Then                                               */
   /*                          a^2.b^2                          */
   /* R = sqrt( ------------------------------------- )         */
   /*            (b.cos(alpha))^2 + (a.sin(alpha))^2            */
   /*                                                           */
   /* Repeat this calculation for angles between 0 and 360 deg. */
   /* For each displacement R on a sphere in the direction      */
   /* position angle + alpha, there is a new (a,d) in degrees   */
   /* that can be transformed to grids with the standard        */
   /* coordination transformation routines.                     */
   /*-----------------------------------------------------------*/   
   for (Alpha = 0.0; Alpha <= 360.0; Alpha += 1.0) 
   {
      CosA = cos(RAD(Alpha));
      SinA = sin(RAD(Alpha));
      Denom = (minor2*CosA*CosA + major2*SinA*SinA);
      if (Denom != 0.0)
         R = sqrt( minor2major2 / Denom );      
      else
         R = 0;
         
      /*--------------------------------------------------------------*/
      /* Here we have calculated an ellipse radius for a given angle. */
      /* With this radius and angle, determine a new (a,d) using      */
      /* two spherical trigionometry formulas. This physical          */
      /* coordinate is transformed to a grid with the standard        */
      /* coordinate transformations. Note that in this case axes and  */
      /* position angle are plotted correctly for images of all       */ 
      /* sizes and known projections.                                 */
      /*--------------------------------------------------------------*/      
      
      dispcoord( Centre_X, Centre_Y,
                 R,
                 Posangle + Alpha,
                 cdelt,
                 &physpos[0], &physpos[1] ); 
     
      r = phtogr_c( Setin, &subset, physpos, gridpos );
      
      Xpoints[i] = (float) gridpos[0]; 
      Ypoints[i] = (float) gridpos[1];
      i++;
   }
   Numpoints = i;
   pgline_c( &Numpoints, Xpoints, Ypoints );   /* Can be replaced by 'pgpoly' */
}



int equalstrings( char *s1, char *s2, int mode )
/*------------------------------------------------------------*/
/* PURPOSE: Are two strings equal?                            */
/* 'mode' sets case sensitivity.                              */
/*------------------------------------------------------------*/
{
   int  i;
   int  l1 = strlen( s1 );
   
   if ( l1 != strlen(s2) )
      return( 0 );
      
   for (i = 0; i < l1; i++)
   {
      char c1 = s1[i];
      char c2 = s2[i];
      if (mode == CASEINSENSITIVE)
      {
         c1 = toupper(c1);
         c2 = toupper(c2);
      }
      if (c1 != c2)
         return( 0 );
   }
   return( 1 );   
}



#ifdef JJHJHKSOISN

void p_ellipse(   fchar  Setin,
                  fint   subset,
                  double cdeltX,
                  double cdeltY,
                  double Centre_X,          /* Centre in grids */
                  double Centre_Y ,
                  double Major_axis,        /* axes in grids */
                  double Minor_axis,
                  double Posangle )
/*------------------------------------------------------------*/
/* Draw ellipse with area fill. The beam can also be plotted  */
/* as a rectangle.                                            */
/*------------------------------------------------------------*/
{

   double    Cpx, Cpy;                      /* Central position x, y */
   double    Major, Minor;                  /* Axis of ellipse */
   double    CosP, SinP;                    /* Angles */
   double    CosA, SinA;                    /* Angles */
   double    Pa;                            /* Position angle */
   double    Alpha;                         /* Used in Polar coordinates */
   double    R;                             /* Radius used in Polar coordinates */
   double    Denom;                         /* Help var. */
   double    Xell, Yell;                    /* Points of not rotated ellipse */
   double    Xrot, Yrot;                    /* X,Yell rotated over Pos.angle */
   float     Xpoints[368], Ypoints[368];    /* Outline ellipse in arrays */
   int       i;                             /* Array index */
   fint      Numpoints;                     /* Number of points in arrays */


   /* Convert for convenience */

   Cpx   = Centre_X;
   Cpy   = Centre_Y;
   Minor = fabs(Minor_axis);
   Major = fabs(Major_axis);
   Pa    = 90.0+Posangle;
   CosP  = cos( RAD(Pa) );
   SinP  = sin( RAD(Pa) );
   Xell  = 0.0;
   Yell  = 0.0;
   
  
   {
      i = 0;
      for (Alpha = 0.0; Alpha <= 360.0; Alpha += 1.0) {
         fint   r;
         double   physpos[2];
         double   gridpos[2];
         /*-----------------------------------------------------------*/
         /* Ellipse: b^2.x^2 + a^2.y^2 = a^2.b^2                      */
         /* Substitute: x = r.cos(alpha), y = r.sin(alpha) and solve  */
         /* for r. Repeat this action for angles between 0 and 90 deg */
         /*-----------------------------------------------------------*/
         CosA = cos(RAD(Alpha));
         SinA = sin(RAD(Alpha));
         Denom = (Minor*CosA * Minor*CosA + Major*SinA * Major*SinA);
         if (Denom == 0.0) {
            R = 0;
         }
         else {
            R = sqrt( Minor*Major * Minor*Major / Denom );
         }
         Xell = R * CosA;
         Yell = R * SinA;
         /* We have a point on this ellipse, now rotate this point */
         /* and move to given origin */
         Xrot =  Xell * CosP + Yell * SinP;
         Yrot = -Xell * SinP + Yell * CosP;
         physpos[0] = Xrot;
         physpos[1] = Yrot;
/*         r = phtogr_c( Setin, &subset, physpos, gridpos );*/
         gridpos[0] = physpos[0]/cdeltX + Cpx;
         gridpos[1] = physpos[1]/cdeltY + Cpy;
         Xpoints[i] = (float) gridpos[0]; Ypoints[i] = (float) gridpos[1];
         i++;
      }
      Numpoints = i;
      pgline_c( &Numpoints, Xpoints, Ypoints );   /* Can be replaced by 'pgpoly' */
   }
}


void p_ellipse(   fchar  Setin,
                  fint   subset,
                  double Centre_X,          /* Centre in grids */
                  double Centre_Y ,
                  double Major_axis,        /* axes in grids */
                  double Minor_axis,
                  double Posangle )
/*------------------------------------------------------------*/
/* Draw ellipse with area fill. The beam can also be plotted  */
/* as a rectangle.                                            */
/*------------------------------------------------------------*/
{

   double    Cpx, Cpy;                      /* Central position x, y */
   double    Major, Minor;                  /* Axis of ellipse */
   double    CosP, SinP;                    /* Angles */
   double    CosA, SinA;                    /* Angles */
   double    Pa;                            /* Position angle */
   double    Alpha;                         /* Used in Polar coordinates */
   double    R;                             /* Radius used in Polar coordinates */
   double    Denom;                         /* Help var. */
   double    Xell, Yell;                    /* Points of not rotated ellipse */
   double    Xrot, Yrot;                    /* X,Yell rotated over Pos.angle */
   float     Xpoints[368], Ypoints[368];    /* Outline ellipse in arrays */
   int       i;                             /* Array index */
   fint      Numpoints;                     /* Number of points in arrays */


   /* Convert for convenience */

   Cpx   = Centre_X;
   Cpy   = Centre_Y;
   Minor = fabs(Minor_axis);
   Major = fabs(Major_axis);
   Pa    = 90.0+Posangle;
   CosP  = cos( RAD(Pa) );
   SinP  = sin( RAD(Pa) );
   Xell  = 0.0;
   Yell  = 0.0;
   
  
   {
      i = 0;
      for (Alpha = 0.0; Alpha <= 360.0; Alpha += 1.0) {
         fint   r;
         double   physpos[2];
         double   gridpos[2];
         /*-----------------------------------------------------------*/
         /* Ellipse: b^2.x^2 + a^2.y^2 = a^2.b^2                      */
         /* Substitute: x = r.cos(alpha), y = r.sin(alpha) and solve  */
         /* for r. Repeat this action for angles between 0 and 90 deg */
         /*-----------------------------------------------------------*/
         CosA = cos(RAD(Alpha));
         SinA = sin(RAD(Alpha));
         Denom = (Minor*CosA * Minor*CosA + Major*SinA * Major*SinA);
         if (Denom == 0.0) {
            R = 0;
         }
         else {
            R = sqrt( Minor*Major * Minor*Major / Denom );
         }
         Xell = R * CosA;
         Yell = R * SinA;
         /* We have a point on this ellipse, now rotate this point */
         /* and move to given origin */
         Xrot =  Xell * CosP + Yell * SinP;
         Yrot = -Xell * SinP + Yell * CosP;
         physpos[0] = Xrot + Cpx;
         physpos[1] = Yrot + Cpy;
         r = phtogr_c( Setin, &subset, physpos, gridpos );
         Xpoints[i] = (float) gridpos[0]; Ypoints[i] = (float) gridpos[1];
         i++;
      }
      Numpoints = i;
      pgline_c( &Numpoints, Xpoints, Ypoints );   /* Can be replaced by 'pgpoly' */
   }
}
#endif
#<
