 {~ Plotting various Star Maps from The Bright Star Catalogue (B5_cd.dbf) etc. ~}

{actually, this version has been edited, to ignore 0,0 points of Hipparcos
 - NotNova set to false for such stars}

Program {map_bsc} map_bsct
 {replacement of map_bsc, producing just an *.eps file}
 {it should not be edited,
 as it is always generated by a change file from the file it replaces}
;
(*  Copyright (C) 1999 Jan Hollan

    This program is free software; you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation; either version 2 of the License, or
    (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program; if not, write to the Free Software
    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
*)


uses
{standard Borland Turbo Pascal units:}
 crt,{graph} graph_tx, {J.H.'s text replacement of graph}
dos,
{J.Hollan's units:}
 {params_g} params {replacement of params_g, running in text mode}
,   {decoding some most usual command-line parameters of my programmes}
 {graph_m8} graph_mt
 {replacement of graph_m8, to avoid screen graphics}
 {it should not be edited,
 as it is always generated by a change file from the file it replaces}
, {screen graphic in 16'ths of a pixel, optional PS or LaTeX file}
 solar_ut, {astronomical procedures and functions}
 angles_o, {angular operations and polar-to-cartesian transformations}
 Str_num,  {string to numbers and vice versa conversions}
 Un_Str_M, {a free substitute for: Unit_str by Blaise Computing,Inc.}
 planets,  {Sun, Moon and planetary positions,
                 based on a source written by David Motl}
 elm,      {just for definition of the path loc_obj}
 DbBridge, {creating, writing to and reading dBaseIII+ (*.dbf) files,
                 based on a source written by Dr. Milan Drasil}
 precesse, {to handle J2000.0 catalogue in years far from it}
 bsc_dir,      {just the loc_bsc constants}
 {map_bs_p} map_bstp
 {replacement of map_bs_p, running in text mode}
 {it should not be edited,
 as it is always generated by a change file from the file it replaces}
,    {just to shorten this file}
 {map_bs_s} map_bsts
 {replacement of map_bs_s, running in text mode}
 {it should not be edited,
 as it is always generated by a change file from the file it replaces}
;    {just to shorten this file}

{var tst:text; - just for testing purposes}

{Not made yet:
 For conical surfaces, repeating of small bodies of Solar system
 (and, more important of their labels) around voids.}

{For comet paths etc., it might be nice to produce a series of strips.
 As the strips should a bit overlap, it is not so easy to implement
 that possibility into the programme. Currently, the strips can be made
 by repeated runs of Map_BSC, and by editing of the resulting files.
 Non-overlapping strips would be easy to make (Y would be incremented for
 X over the right margin), but of no value, probably.}

{Center of a map or pole of a strip is assumed to be zenith in the same time,
 when the map is not north(south)-pole centered. Therefore it is not easy
 to show a true ideal horizon, when the centre of projection is not
 a true zenith. A computation of the true ideal horizon might be added, and
 even true extinction added to the unit Stars. It would just take some time.}

const

HipInfo:array[1..8,1..2] of word=
 {  a       dec     v     parms   vmx    vmin     var   Hp   }
 ((52,10),(65,10),(42,5),(80,7),(302,5),(308,5),(48,1),(275,7));

TycInfo:array[1..8,1..2] of word=
 {  a       dec     v     parms   vmx    vmin     var     -  }
 ((52,10),(65,10),(42,5),(80,7),(280,5),(286,5),(294,1),(1,1));
 {-- tyc_main.dat original}

TycInfoSel:array[1..8,1..2] of word=
 {  a       dec     v     parms   vmx    vmin     var     -  }
 ((19, 9),(28, 9),(13,5),(37,7),(105,5),(110,5),(116,1),(1,1));
 {-- tyc_main.sel, approximately 35% that large file without astrometric data}
TycSelRecSize=120;

ObjFileName:string='obj.dbf';
PlanFileName:string='planets.dbf';
maps_name: string='maps.dbf';

OneStarScale=12;     {radius of field, where scaling of One_star_r begins}
OneStarScaleT='12';

h10=cl+
'Map_BSC h dDD[.MM[.YY]] { tHH[.MM[.SS]] | t{e|m|b}[#] } UT# '+cl+
' l<longitude> f<latitude>'+cl+
' b# m# tr# [{wT[-] | wH | wP}<OuFile>] p[-] pl[-] ip im[<name>] ie'+cl+
' {ib|nib} b<char>[-] nb nd ne np#[:#] ls# s:<char> s[#[:#[:#]]] sd[-]'+cl;
h20=
' r# k<string>[:<string>] hor o[<name>][:<string>]'+cl+
' e[#] g[#] x# xs# y# ys# z# ro# r- TS# RA# De# c hc mo gr gr#'+cl+
' @<par-file> $@<orb.el.file> $<one_element>'+cl2;

h2a=
'plots a star map using the Bright Star Catalogue and auxiliary catalogs'+cl+
'               (Hipparcos or Tycho catalogues are a slow alternative).'+cl+
                                                            cl;
h30=
'H   writes this information into Map_BSC.hlp'+cl+
'HI[path] demands input from Hipparcos catalogue instead of the BSC'+cl+
'  (default path is d:\cats\hip_main.dat),'+cl+
' path like e: means \cats\hip_main.dat is on drive e,'+cl;
h30a=
' path ending by \ is appended by hip_main.dat'+cl+
'TI[path] demands input from Tycho catalogue instead of BSC'+cl+
'  (default path is d:\cats\tyc_main.dat); if there is just one character'+cl+
'  (any) instead of path,   tyc_main.sel   file is assumed,'+cl;
h31=
'D and T have the current values as default'+cl+
'F{G|J} forces Gregorian (Julian) dating even outside the standard interval'+cl+
'TT#[unit] forces the Terrestric Time - UT difference, default unit is s'+cl;
h31a=
'TE[#] is the moment when Sun is at # (default 12) degrees below horizon'+cl+
'     in the evening (TM for morning, TB for both evening and morning)'+cl;
h32=
'UT is the t-UTC difference / 1 h (default 1 from Nov. to March, else 2)'+cl+
'L and F (longitude and latitude / 1 degree) are those of '
  +MyLocation_Name+''+cl;
h40=
'B#  base for the faintness scale / 1 cmag (default -200, more for small fields)'+cl+
'B{R|C|M|F[#]}[-] plot [no] (default yes) border'+cl+
'   Rectangle (default) | Circle | Mask to cut | mask to cut and Fold'+cl;
h41=
'    (an outward shift (/ 1 mm) of lines to cut may be given then)'+cl+
'BG# per cent of white for background (default 0)'+cl;
h45=
'M#[:#]  faintness liMit / 1 cmag (default 800), the other number concerns'+cl+
'   just the solar system particles, mainly in cometary tails'+cl+
'Tr# transformation coefficient from cmag to dmag for star images (default 10)'+cl;
h50=
'wT[-] (wH, wP) precedes the output LaTeX (HPGL, eps) file name'+cl+
'    (default Screen.{ltx|hpg|eps})'+cl+
' wT- implies creating just the picture part, not a complete LaTeX file'+cl;
h51=
'LA  for a PostScript output: prepend it with a prologue for landscape'+cl+
'   printing (the file will not be a true eps format any more)'+cl;
 {the landscape option added 2001-03-27}
h55=
'P[{N|S}[{N|S}]] map center at north (south) pole instead of zenith'+cl+
'   with label tops toward north (south) (default is north)'+cl+
'Pl[-] include [not include] planets'+cl;
h55a=
'PlF planets as full circles with full names at left'+cl;
h56=
'Pl{N|B}#[:#[:#]]  number of planetary positions next or before (default 0)'+cl+
'   [:<time step>] for each new position / 1 day (default 1,'+cl+
'    #h  for # / 1 hour, #m for time step in minutes)'+cl;
h57=
'   [:<module>] for other bodies than Moon (default 1)'+cl+
'PlT#[:#] <module> for displaying times by planets'+cl+
'    (default 1, 0 means no times)'+cl+
'   [:<module>] for displaying times for Moon (default as for planets)'+cl;
h58=
'IP  include north poles of planets and their orbital planes'+cl;
h60=
'IM[<name>] include map outlines and descriptions from <name>.dbf (def. Maps)' +cl+
'IE  include perpendicular marks at each 30 degrees of ecliptics'+cl+
'IB  include stars below horizon'+cl+
'NI[B] do not include stars below horizon'+cl;
h70=
'NB  do not draw picture borders (see above, switch b<char>[-])'+cl+
'NE  do not draw equator'+cl+
'NZ  do not draw eclipitcs'+cl+
'ND[P]  do not print date [print parameters instead]'+cl;
h72=
'NG  do not show geocentric Moon over horizon (just the topocentric one)'
   +cl+ {added 2001-01-22, thanks to Rudolf Novak}
'NP  do not show progress of reading the stars'+cl+ 
'NR  do not refract, neither consider extinction'+cl;  {added 2001-01-13}
h80=
'LS# labels of stars 0: nothing (default),1: HR numbers,..., 5: Names,... '+cl+
' (#:# for Hipparcos/Tycho input: starting column and length of label)'+cl+
'LL# length of line segments / 1 degree (default 2)'+cl;
h90=
'CS# comment stars - like LS, but just for the output file, default 5 (Name)'+cl+
' (#:# for Hipparcos/Tycho input: starting column and length, default none).'+cl+
' Record numbers are always present in the output file.'+cl;
h91=
'CW# compose stars within # minutes into one fixed star (default 6,'+cl+
'    for field radius below '+OneStarScaleT+
           ' degrees scaled down as 6*<radius of field>/'+OneStarScaleT+')'+cl+
'CR[-] plot a central cross (default; do not when -)'+cl;
h92=
'S:<char>[#] asks for marking stars having <char> as the beginning'+cl+
'    of the field # (default field 9, named A) (for text input, # is column)'+cl;
h92a=
'S[#[!#[!#]][:#[:#]] Stereo view'+cl+
'    screen parallax (/ some 1 mm) for 1000 mas stellar parallax'+cl+
'    distance  (default 20)'+cl;
h92b=
'    ! screen parallax for planets at 0.1 AU distance (default the same)'+cl+
'       ! and for the Moon at 30 Earth radii distance (default the same)'+cl;
h93=
'           : % of standard shift of some 70 mm (default 100)'+cl+
'              : nearer viewpoint then from the Earth / 1 AU (default 0,'+cl+
'   just for Solar system bodies other than Moon, useful for cometary heads)'+cl;
h93a=
'SD[-] Show [do not show: default] distances of Solar system bodies'+cl;
h93b=
'SC[#|-|B|G|R#] Stereo view in colour, full width. Sets standard shift to 0.'+cl+
'   # is green relative luminance / 1 % (default 75)'+cl+
'   R# the same for red, - means gray stereo again,'+cl;
h93c=
'   B demands blue stars for the right eye, G resets them to green'+cl+
'SM Stereo view -- Mirror reversed image left. Sets % of standard shift to 190.'+cl+
'   (put the mirror between the images, put your right eye just a bit right'+cl;
h93d=
'   from the mirror plane, look right to the mirror by your left eye)'+cl+
'HF hide faint stars within the bright ones (to preserve the bright ones)'+cl;
h94=
'R#  vertical radius of the field / 1 degree (default 95 for plane or conus,'+cl+
'   67 for cylinder as a projection surface, see below);'+cl+
'   it is measured in the units which hold in the center'+cl;
h94a=
'   (away from center they hold just for the equidistant projection)'+cl;
h94d=
'K<string>[:<string>]  kind of geometry and surface:'+cl+
'  E or 0     Equidistant from projection pole (default), z,'+cl+
'  Conf or 1  Conformal (non-distorted angles), 2 tg(z/2) for a plane,'+cl;
h95=
'  G or 2     Gnomonic (central perspective),  tg(z)'+cl+
'  4          Equivalent (equal surface area), 2 sin(z/2)'+cl+
'  5          Nikon990 with fish eye convertor FC-E8,  2.4 sin(z/2.4)'+cl+
'  6          Nikon990,  1.4 tg(z/1.4)'+cl+
'  7          Pentax?,  1.2 tg(z/1.2)'+cl;
h95a=
'  P or A     to a Plane (Azimuthal, default)'+cl+
'  Cyl or R or 3  to a Cylinder (the base grid will be Rectangular)'+cl;
h96=
'  Cone[#]    to a Conus, normal to a line of sight at # degrees'+cl+
'       of angular height (or absolute value of declination, default 60)'+cl+
'  S          Stereographic: short for to a Plane, Conformal'+cl;
h97=
'  U#         Undistorted parallel # degrees far from the central one'+cl+
'       (for cylinders and cones using equidistant projection,'+cl+
'       default half the R value)'+cl;
h100=
'Ho[r] like K3 NIB; then default R33 and Y24 and undistorted height 28.5'+cl+
'Ho[r]# another angular height than 0 degrees, applies to K 2 and 4-6'+cl;
h105=
'AA#  central astronomical azimuth / 1 degree (just for K=3, default 0)'+cl+
'A#  central (geographical) azimuth / 1 degree (just for K=3, default 180)'+cl;
h110=
'O[<name>][:<string>]  include objects from a database <name>.dbf (default obj)'+cl+
'    containing <string> (default A) in field MAPS'+cl;
h115=
'E[#] centers the map at this longitude of the ecliptic (default 90)'+cl+
'    (sets also "kR r67 ys50 m500 b-200")'+cl;
h120=
'G[#] centers the map at this galactic longitude (default 0)'+cl+
'    (sets also "kR r67 ys50 b-300")'+cl;
h130=
'X[P]# shift of X coordinate  / 1 degree [or % of vertical radius] (default 0)'+cl+
'Y[P]#     (the same for Y coordinate)'+cl;
h132=
'XS# side along X coordinate / 1 % of the screen (default 100)'+cl+
'YS#       (the same for Y coordinate)'+cl;
h140=
'Z#  is zenith extinction / 1 cmag (default 20) '+cl+
'RO# rotate anticlockwise / 1 degree (default 0)'+cl+
'R-  do not turn descriptions with tops toward the map centre'+cl+
'TS# sidereal time / 1 h (sets "pl-": do not show planets)'+cl;
h150=
'RA# right ascension of the map pole (same as TS, but in degrees)'+cl+
'De# declination of the map pole (same as F)'+cl+
'C[{-|#}] Colurs and parallels will be [not: default] plotted'+cl+
'   each # degrees (default 90; 5, 10 or 30 are good values)'+cl;
h151=
'HC[{-|#}] Height circles      -         "          - '+cl2;
h160=
'  For charts turnable or shiftable under a mask, two more options:'+cl+
'Mo[-] [don''t] display Months along the ecliptics marking midnight culmination'+cl+
'Gr[-] [don''t] make a Grid (an overlay or mask) for a map made with Mo option'+cl;
h161=
'Gr{I|O}- don''t display a inner/outer hour scale in that grid'+cl2;
h165=
'  A (S)VGA screen options:'+cl+
'Gr# 2:Use just black and white for stars (instead of 16 degrees of gray)'+cl+
'    5 to 100: % of the maximum white (default 60) for lines and texts' +cl;
h166=
'  A large catalogue speed-up option:'+cl+
'Q#[:#[:#]] Size of whole queueue, size of its part for compounding stars,'+cl+
'  limit over the limiting faintness (parameter M) for the components / 1 cmag.'+cl;
h167=
'  Default is 150:100:500 for the BSC (150:100:200 for HI or TY),'+cl+
'          or 850:100:200 for PostScript output,'+cl+
'  q0 gives quick draft processing, unsuitable for the final output.'+cl;
h167a=
'  (HF option, see above, reduces the queue to its second part, 100 by default)'+cl;
h168=
'Q  quit after making the map (batch mode, for generating PostScript output)'+cl2;
h170=
'@   file with any default parameters (other than further @);'+cl+
'    default suffix is .cnf; on each line, text after %, & or # is a comment.'+cl+
'    % or & can be also used to disable the rest of the command line.'+cl;
h180=
'$   prefix for elements concering comets etc.'+cl+
' ($? to see help, $h to append it to file Map_BSC.hlp)'+cl+
'$@  file with orbital elements; default suffix is .elm'+cl2;

h185=
'  Further paths:'+cl;

h189=
'no parameters are obligatory, ? gives this help'+cl2;

h190=
'( (C) Jan Hollan, N.Copernicus Observatory and Planetarium in Brno, 1999;'+cl+
' subject to the GNU General Public License, http://www.gnu.org/copyleft;'+cl+
' source code available at http://astro.sci.muni.cz/pub/hollan/programmes)'+cl;

Include_below:boolean=false;  {stars below horizon even for zenith-centered maps}
 {I am confused about the above boolean and the below_horizon one...}
Incl_D_S:boolean=false; {no deep-sky objects}
r_o_f:real=95;
r_o_f_new:boolean=false;
planets_too:boolean=true;
planets_too_set:boolean=false;
{Strips:boolean=false;}
YS:byte=100;   {per cent of the screen vertical side}
XS:byte=100;
AzC:real=0;
Incl_p_p:boolean=false;  {poles of the planets}
Next_plan:word=0;
Before_plan:word=0;
Decl_given:boolean=false;
Incl_Maps: boolean=false;
Map_sh:string='A';
{DaysOfWeek:boolean=true;}
Shift_in_degrees_x:boolean=true;
Shift_in_degrees_y:boolean=true;
Cross:boolean=true;
Faintness_lim_given:boolean=false;
Faintness_base_forced:integer=2000;
BatchMode:boolean=true;
  {with no map on the screen, batch mode is default}
plan_mod:byte=1;
notGree3tm:boolean=true;
undistort_parallel_far:real=-10;
hor_param_given:boolean=false;   {added 2001-01-13}
refract:boolean=true;            {added 2001-01-13}
NoDate:boolean=false;

cat_coeff:real=0.03865;

CatName:pathstr='hip_main.dat';
CatNameTyc='tyc_main.dat';
CatNameTycSel='TYC_MAIN.SEL';
CatDrive:string[2]='d:';
CatDir:pathstr='\cats\';
CatPath:pathstr='';  {the empty stuff here is for flexibility in giving paths}
CatDirN:dirstr='';
CatNameN:namestr='';
CatExt:extstr='';
{CatRecSize:word=452;  in MS-DOS for Hipparcos, hip_main.dat}
CatRecSize:word=451;  {for Hipparcos, hip_main.dat}

B5_CD_FirstTime:boolean=true;
NotNova:boolean=true;
SetQueue:boolean=false;
Set_add:word=200; {over Faintness_lim for adding to compound fixed stars,
                   not for the BSC}
ShowParString:boolean=false;
ParString:string='';
 PrecDate:real=2000.0; {left this way just for BSC and not more than
                      three years from J2000}
 Lab_Stars_txt: boolean=false;
 Com_Stars_txt: boolean=false;
 One_Star_r_ini:real=6;
 One_Star_r:real=6; {the value of One_Star
                 is computed in the main programme to correspond to 6',
                 or scaled down for field radius below OneStarScale degrees}
 One_Star_r_given:boolean=false;
 MaxOutside:longint=300;
 MaxOutsideTychoHard=25000; {for Tycho maps, this might do}
 offs_belt:longint=0;
 Belt_width=pi*7.5/180;
 Tyc_belts_ind:array[0..24] of longint=
{Tyc_main.dat
 begginnings (record No.s) of bands
                    (1-2*(index mod 12))*(3.25 degrees+index*7.5 degrees)
 of declination;
 index of line goes from 0 to 24,
 index=24 means a begginning of a non-existent band}
(     1,
  51984,
 104296,
 156337,
 209664,
 269804,
 329360,
 386333,
 434280,
 466907,
 487566,
 499693,
 503484,
 552016,
 602292,
 658171,
 718187,
 779803,
 842165,
 903729,
 964466,
1013408,
1041755,
1054363,
1058333);

var
 Tyc_belt:byte;
 SetQueue_n,SetQueue_na:word;
 ParOrg:string;
 jj:byte;
 i:byte;
 NoR, NoR_C : longint;
 {oldx, oldy, oldd}{, r90, NewJD,NewSM}{  :real;}
 VMx: string[4];
 VMin: string[4];
 j,Faintness_lim_add : integer;
 {Add_Old,}Rising,UnShifted,IsVari:boolean;
 c:char;
 aux_st2:string[15];
 nsh:byte;
 {JD_plan, SM_plan,} Fi_mapc:real;
{ p_heap:pointer;}


 procedure PriGScr(s:string; j1,j2:byte); begin; end; 
  {fake procedure to skip graphics}
 
 procedure help(message:string);
var ch:char;
begin
 highvideo;
 if message<>'' then
  begin
   writeln(cl,message,cl);
   lowvideo;
   write(h0);
   ch:=readkey;
   if UpCase(ch)= 'Q' then halt;
   write(h0clear);
   highvideo;
  end;
 write(h10,h20,h2a);
 lowvideo;
 write(h0);
 ch:=readkey;
 if UpCase(ch)= 'Q' then halt;
 write(h0clear,h30,h30a,h31,h31a,h32,h40,h41,h45,h0);
 ch:=readkey;
 if UpCase(ch)= 'Q' then halt;
 write(h0clear,h50,h51,h55,h55a,h56,h57,h58,h60,h0);
 ch:=readkey;
 if UpCase(ch)= 'Q' then halt;
 write(h0clear,h70,h72,h80,h90,h91,h92,h0);
 ch:=readkey;
 if UpCase(ch)= 'Q' then halt;
 write(h0clear,h92a,h92b,h93,h93a,h93b,h93c,h93d,h0);
 ch:=readkey;
 if UpCase(ch)= 'Q' then halt;
 write(h0clear,h94,h94a,h94d,h95,h95a,h96,h97,h100,h105,h0);
 ch:=readkey;
 if UpCase(ch)= 'Q' then halt;
 write(h0clear,h110,h115,h120,h130,h132,h140,h150,h151,h0);
 ch:=readkey;
 if UpCase(ch)= 'Q' then halt;
 write(h0clear,h160,h161,h165,h_svga1,h_svga2,h0);
 ch:=readkey;
 if UpCase(ch)= 'Q' then halt;
 write(h0clear,h166,h167,h167a,h0);
 ch:=readkey;
 if UpCase(ch)= 'Q' then halt;
 write(h0clear,h_refraction,h168,h170,h180,h185,h0last);
 ch:=readkey;
 if UpCase(ch)= 'Q' then halt;
 write(h0clear,h_dir_bsc,h_dir_elem,cl,h189,h190);
 halt
end;

procedure help_file;
var h_file:text;
begin
 if rt_rewrite(h_file,'Map_BSC.hlp') then
  begin
   write(h_file,h10,h20,h2a,
               h30,h30a,h31,h31a,h32,h40,h41,h45,h50,h51,h55,h55a,h56,h57,h58,h60,h70,h72,
               h80,h90,h91,h92,h92a,h92b,h93,h93a,h93b,h93c,h93d,h94,h94a,
               h94d,h95,h95a,h96,h97,h100,h105,h110,h115,h120,h130,h132,
               h140,h150,h151,h160,h161,h165,h_svga1,h_svga2,cl,h166,h167,h167a,
               cl,h_refraction,h168,
               h170,h180,h185,h_dir_bsc,h_dir_elem,cl,h189,h190);
   close(h_file);
  end
   else help('');
 halt
end;

procedure CatClose;
begin
 DbClose;
end;


procedure Deep_Sky;
 var
  nVMX,nMaps,nAA,nAS,nJ: byte;
  sh_x,sh_y:integer;
 begin
  if not DbInitSearch(Loc_obj,ObjFileName) then
   begin
    writeln('in ',Loc_obj,' -- no deep-sky objects will be shown.');
    exit;
   end;
  gm_comm(cl+'% Deep-sky objects:'+cl+
  '% [ Format is:'+cl+
  '% x  y  x-shift  y-shift  angle  (string) justification_procedure ]');
  if (GM_mode=2) and notGree3tm then
   begin
    GM_verbatim('\input{gree3tm.sty}'+cl);
    notgree3tm:=false;
   end;

  NoR:=1;
  ndec:= DbFieldNum('DE2');
  na:=   DbFieldNum('RA2');
  nsh:=  DbFieldNum('SH');
  nVMx:= DbFieldNum('VMX');
  nMaps:=DbFieldNum('MAPS');
  nJ:=   DbFieldNum('J');
  nAA:=  DbFieldNum('AA');
  nAS:=  DbFieldNum('AS');
  settextstyle(2,0,10);
  j:= 4000 div textheight('font No.');
  setusercharsize(j,100,j,100);
  {if Graphresult<>grOK then
   settextstyle(Defaultfont,0,8);
  }
  while DbRead(NoR,rec) do
   begin
    if (__cvtstr(rec[nsh],_rem_white_str)<>'')
    and (pos(Map_sh,rec[nMaps])>0)  then   {but this is not enough, see }
     begin
      i:=ItemCount(rec[nMaps]);
      aux_boo:=false;
      if i>0 then for i2:= 1 to i do
       if Map_sh=ItemStr(i2,rec[nMaps]) then aux_boo:=true;     {|^ here}
      if aux_boo then
       begin
        val(__cvtstr(rec[ndec],_rem_white_str),de_d,j);
        val(__cvtstr(rec[na],_rem_white_str),ra_d,j);
        RADe2xy;
	if Zenith then
	   {to avoid plotting names of objects fainter than the map limit}
	  if (rig_ord_val(rec[nVMx])+ZenExt*Air_Mass>Faintness_Lim) 
	  and (rec[nVMx]<>'   ') then aux_boo:=false;
        if aux_boo and not((ra_d=0) and (de_d=0)) then
         begin
          aux_st:='';
          aux_st2:='';
          sh_x:=0;
          sh_y:=0;
          if rec[nsh][1]=' ' then
           begin
            case gm_mode of
             2: aux_st:='\tiny ';
             3: begin
                 aux_st:='gsave rr ';
                 aux_st2:=' r grestore';
                end;
            end;
            c:='w';
           end
          else
           begin
            d:=V2R(rig_ord_val(rec[nVMx]))+DistFromStar;
            if rec[nsh][1]>='a' then
             case gm_mode of
              2: begin
                  aux_st:='$\';
                  aux_st2:='$'
                 end;
              3:begin
                 aux_st:='gsave s ';
                 aux_st2:=' r grestore';
                end;
             end;
            if rec[nsh][1]<'A' then
             case gm_mode of
              2: begin
                  aux_st:='{\it{}';
                  aux_st2:='}'
                 end;
              3:begin
                 aux_st:='gsave i ';
                 aux_st2:=' r grestore';
                end;
             end;
            c:='1';
            if R_S(rec[nAS])<>0 then
             d:=d+round(p16_p_d*R_S(rec[nAS])/100);
            if rec[nJ]='r' then
             begin
              c:='r';
              d:=-d
             end;
            if R_S(rec[nAA])<>0 then
             begin
              sh_x:=round(d*cos(deg_to_rad(R_S(rec[nAA]))));
              sh_y:=round(d*sin(deg_to_rad(R_S(rec[nAA]))));
             end
            else
             begin
              sh_x:=d;
             end
           end;
          if (itemcount(rec[nsh])<2) or (aux_st='') then
           gm_outxtxy(x,y,aux_st,__cvtstr(rec[nsh],_rem_white_str),aux_st2,
                     c,round_rot(A),sh_x,sh_y)
          else                                   {font switching:}
           gm_outxtxy(x,y,aux_st,__cvtstr(rec[nsh],_rem_white_str),aux_st2,
                     '2',round_rot(A),sh_x,sh_y);
         end;
       end;
     end;
    inc(NoR);
   end;
  DbClose;
 end;

procedure Planets_p_t;
 var nI,nL: byte;
 begin
  if not DbInitSearch(Loc_obj,PlanFileName) then
   begin
    writeln('in ',Loc_obj,' -- no planetary poles will be shown.');
    exit;
   end;
  gm_comm(cl+'% Poles of planets and of their trajectories:'+cl+
  '% [ Format is:'+cl+
  '% x  y  x-shift  y-shift  angle  (string) justification_procedure ]');
  aux_st:=''; aux_st2:='';
  case gm_mode of
   2: aux_st:='\footnotesize ';
   3: begin aux_st:='gsave rr '; aux_st2:=' r grestore' end;
  end;
  c:='c';
  d:=0;
  NoR:=1;
  ndec:= DbFieldNum('N_pol_Decl');
  na:= DbFieldNum('N_pol_RA');
  nsh:= DbFieldNum('Name');
  nI:=DbFieldNum('I');
  nL:=DbFieldNum('L_tr_pole');
  while DbRead(NoR,rec) do
   begin
    val(__cvtstr(rec[ndec],_rem_white_str),de_d,j);
    val(__cvtstr(rec[na],_rem_white_str),ra_d,j);
    RADe2xy;
    if aux_boo then
     gm_outxtxy(x,y,aux_st,copy(rec[nsh],1,2)+'P',aux_st2,c,round_rot(A),d,0);

    val(__cvtstr(rec[nI],_rem_white_str),bg,j);
    val(__cvtstr(rec[nL],_rem_white_str),lg,j);
    if lg<>0 then  {to avoid "trajectory pole of Sun"}
     begin
      LB_RD(lg,90-bg,ra_d,de_d);
      RADe2xy;
      if aux_boo then
       gm_outxtxy(x+d,y,aux_st,copy(rec[nsh],1,2)+'T',aux_st2,c,round_rot(A),d,0);
     end;
    inc(NoR)
   end;
  DbClose;
 end;

procedure Maps;
 var nSX,nSY,nAX,nAY:byte; sx,sy,ax,ay,rra:real;
 begin
  if not DbInitSearch(Loc_obj,maps_name) then
   begin
    writeln('in ',Loc_obj,' -- no outlines of minor maps can be shown');
    exit
   end;
  gm_comm(cl+'% Minor maps rectangles:'+cl+
  '% [ Format is:'+cl+
  '% x  y  x-shift  y-shift  angle  (string) justification_procedure'+cl+
  '% (and then four line segments as a map outline) ]');
  aux_st:=''; aux_st2:='';
  case gm_mode of
   2: aux_st:='\footnotesize ';
   3: begin aux_st:='gsave ii '; aux_st2:=' r grestore' end;
  end;
  c:='l';
  d:=24;
  NoR:=1;
  ndec:= DbFieldNum('De2');
  na:=   DbFieldNum('RA2');
  nName:=DbFieldNum('Page');
  nSX:=  DbFieldNum('SX');
  nSY:=  DbFieldNum('SY');
  nAX:=  DbFieldNum('AX');
  nAY:=  DbFieldNum('AY');
  while  DbRead(NoR,rec) do
   begin
    val(__cvtstr(rec[ndec],_rem_white_str),de_d,j);
    val(__cvtstr(rec[na],_rem_white_str),ra_d,j);
    val(__cvtstr(rec[nSX],_rem_white_str),sx,j);
    val(__cvtstr(rec[nSY],_rem_white_str),sy,j);
    val(__cvtstr(rec[nAX],_rem_white_str),Ax,j);
    val(__cvtstr(rec[nAY],_rem_white_str),Ay,j);
    if (SX>0) and (SY>0) then
     begin
      rra:=sx/2/cos(deg_to_rad(de_d));
      RADe2xy;
      if aux_boo then
       begin
        AX:=AX/2/cos(deg_to_rad(de_d));
        ra_d:=ra_d-rra-AX;
        de_d:=de_d+AY;
        RADe2xy;
        gm_outxtxy(x,y,aux_st,__cvtstr(rec[nName],_rem_white_str),aux_st2,
         'l',round_rot(A-PA),d,0);
        ra_d:=ra_d+AX;
        de_d:=de_d-AY+sy/2;
        RADe2xy;
        x1:=x; y1:=y;
        ra_d:=ra_d+2*rra;
        RADe2xy;
        gm_line(x1,y1,x,y);
        x1:=x; y1:=y;
        de_d:=de_d-sy;
        RADe2xy;
        gm_line(x1,y1,x,y);
        x1:=x; y1:=y;
        ra_d:=ra_d-2*rra;
        RADe2xy;
        gm_line(x1,y1,x,y);
        x1:=x; y1:=y;
        de_d:=de_d+sy;
        RADe2xy;
        gm_line(x1,y1,x,y);
       end;
     end;
    inc(NoR)
   end;
  DbClose;
end;

procedure B5_CD;
var
 finished:boolean; Too_faint,loc_size:word;
 Inside, InsideRising, Should_Decrease:boolean;
 NoR_loc:longint; Fi_tyc:real;
 Tyc_belt_str:string[20]; Tyc_zone:shortint;
const Tycho_finished:boolean=false; loc_NoS:longint=0;

 begin
  LastReport:=false;
  if BSC then
   begin
    if not DbInitSearch(Loc_bsc,'b5_cd.dbf') then
     begin
      moveto(5,report_h);
      outtext('The Bright Star Catalogue not found in '+Loc_bsc+' -- no stars can be shown');
      exit;
     end
    else CatRecSize:=DbRecL;
    if not precinit(2000.0,PrecDate) then;
   end
  else
   begin
    CatDir:=CatDrive+CatDir;
    if CatPath<>'' then
     begin
      FSplit(CatPath,CatDirN,CatNameN,CatExt);
      if CatDirN<>'' then CatDir:=CatDirN;
      if CatNameN+CatExt<>'' then CatName:=CatNameN+CatExt;
     end;
    if Tycho and (CatName=CatNameTycSel) then
      begin
       CatRecSize:=TycSelRecSize;
       move(TycInfoSel,TycInfo,32);
      end;
    if (CatDirN<>'') or (FSearch(CatName,'')='') then
     begin
      CatName:=FSearch(CatName,CatDir);
      if CatName='' then
       begin
        moveto(5,report_h);
        outtext('The Catalogue '+CatName+' not found in '+CatDir+' -- no stars can be shown');
        exit;
       end;
     end;
    Assign(fcat,CatName);
    FileMode:=0; {will open the file by reset as Read Only
                  -- it can be then marked so even if not on a CD}
    Reset(fcat,CatRecSize);
    na:=1; ndec:=2; nv:=3; nparms:=4;
    nvmx:=5;
    nvmin:=6;
    nvar:=7;
    Com_Stars:=Com_Stars_txt;
    Lab_Stars:=Lab_Stars_txt;
    if Tycho then
     begin
      FInfo[na].start:=TycInfo[na,1];
      FInfo[na].len:=TycInfo[na,2];
      FInfo[ndec].start:=TycInfo[ndec,1];
      FInfo[ndec].len:=TycInfo[ndec,2];
      FInfo[nparms].start:=TycInfo[nparms,1];
      FInfo[nparms].len:=TycInfo[nparms,2];
      FInfo[nv].start:=TycInfo[nv,1];{42}  {Mean Hipparcos faintness /(1 mag)}
      FInfo[nv].len:=TycInfo[nv,2];
      FInfo[nHp].start:=TycInfo[nHp,1];{275}{?Median Tycho faintness /(1 mag)}
      FInfo[nHp].len:=TycInfo[nHp,2];
      FInfo[nvar].start:=TycInfo[nvar,1];{294} {'V' when probably intrinsicaly variable}
      FInfo[nvar].len:=TycInfo[nvar,2];
      FInfo[nvmx].start:=TycInfo[nvmx,1];{280} {VTmax: VTmag at maximum brightness (15th percentile)}
      FInfo[nvmx].len:=TycInfo[nvmx,2];
      FInfo[nvmin].start:=TycInfo[nvmin,1];{286} {VTmin: VTmag at minimum brightness (85th percentile)}
      FInfo[nvmin].len:=TycInfo[nvmin,2];
   {  FInfo[nv].start:=231;     VTmag: Mean VT faintness /(1 mag)
      FInfo[nv].len:=6; }
      MaxOutside:=4000;
      if r_o_f<10 then  MaxOutside:=round((MaxOutside*20)/r_o_f);
      if MaxOutside>MaxOutsideTychoHard then  MaxOutside:=MaxOutsideTychoHard;
     end
    else
     begin
      if select then nselect:=NuField;
      inc(NuField);       {because of Hp}
      nHp:=NuField;
      FInfo[na].start:=HipInfo[na,1];
      FInfo[na].len:=HipInfo[na,2];
      FInfo[ndec].start:=HipInfo[ndec,1];
      FInfo[ndec].len:=HipInfo[ndec,2];
      FInfo[nparms].start:=HipInfo[nparms,1];
      FInfo[nparms].len:=HipInfo[nparms,2];
      FInfo[nv].start:=HipInfo[nv,1];{42}   {Median V faintness /(1 mag)}
      FInfo[nv].len:=HipInfo[nv,2];
      FInfo[nHp].start:=HipInfo[nHp,1];{275}{Median Hipparcos faintness /(1 mag)}
      FInfo[nHp].len:=HipInfo[nHp,2];
      FInfo[nvar].start:=HipInfo[nvar,1];
      FInfo[nvar].len:=HipInfo[nvar,2];
      FInfo[nvmx].start:=HipInfo[nvmx,1];
      FInfo[nvmx].len:=HipInfo[nvmx,2];
      FInfo[nvmin].start:=HipInfo[nvmin,1];
      FInfo[nvmin].len:=HipInfo[nvmin,2];
      MaxOutside:=600;
     end;
    DbNuRec:=FileSize(fcat);
    cat_coeff:=360/DbNuRec;
    if not precinit(2000,
     {1991.25 is the epoch, not the equinox, so not precession from that
     date should be made, but proper motion instead. This is neglected
     here, however. Originally, before July 2000, precession has been made
     wrongly from 1991.5, sorry.}
                    PrecDate) then;
   end;
  gm_comm(cl+
  '% Fixed stars:'+cl+
  '%   [ Format is:'+cl+
  '%  x  y  radius star_procedure'+cl+
  '%   or (for true stars, not just circles):'+cl+
  '%  x  y  radius angle true_star_procedure ]');
  gm_comm(cl+
  '%  You may easily add names to stars by using procedure nstar:'+cl+
  '%  x  y radius (text) nstar'+cl+
  '%   or procedure nstarr, with rotated text:'+cl+
  '%  x  y radius angle (text) nstarr');
  gm_comm(cl+
   '                   % The comment after each star is its record number'+cl+
   '                 % (for Hipparcos, mostly lower than its Hipparcos number)');
  if Com_Stars then
   if BSC then
    gm_comm(
  '    and a field number'+SI(3,nCom_Stars)+' of the Bright Star Catalogue')
   else
    gm_comm(
  '    and a string of length '+SI(3,FComInfo[nCom_Stars].len)+
   ' starting at column'+SI(3,FComInfo[nCom_Stars].start)+' of input file');

  {for repeated starts, new initialization:}
 n_queue:=0;  {number of stars in the queue}
 p_star:=nil;    {a star within the examined queue}
 p_new:=nil;     {new star within a map}
 p_sum:=nil;     {a fixed star which is being modified}
 p_top :=nil;     {top of queue - last added star mostly}
 p_bott:=nil;     {bottom of queue}
 p_aux:=nil;      { for clearing the plotted star record }
 p_add_bott:=nil; {bottom of the adding part of the queue}

{  oldx:=0; oldy:=0; oldd:=0;}
  Fi_Tyc:=Fi;
  {repeat}
   if Tycho then { (1-2*(index mod 12))*(3.25 degrees+index*7.5 degrees)}
    begin
     Tyc_belt:=trunc(abs(Fi_Tyc)/belt_width);
     Tyc_Zone:=RoundUp(7.5*Tyc_belt + 3.25);
     if Fi_Tyc<0 then Tyc_belt:=Tyc_belt+12;
     if Tyc_belt>11 then Tyc_Zone:=-Tyc_Zone;
     Tyc_belt_str:=' belt'+SI(4,Tyc_Zone)+chr(248)+'; outside:';
     offs_belt:=Tyc_belts_ind[Tyc_belt]-1;
     DbNuRec:=Tyc_belts_ind[Tyc_belt+1]-Tyc_belts_ind[Tyc_belt];
     cat_coeff:=360/DbNuRec;
     {outtextxy(30,10+20*Tyc_belt,SI(2,Tyc_belt)+SI(7,offs_belt)+SI(7,DbNuRec))}
    end;
  repeat
   NoR:=1+offs_belt;

   if Pole_out and (not south_pole) and (Unshifted) then
 {starting approximately in the field centre - works just for unshifted maps
     or for most horizon maps (vertical shift is ignored for them),
     otherwise an inverse function x,y -> RA(,Delta) is to be made}
    begin
     if Zenith then
      begin
       if surface=cylinder then
        begin
         lg:=deg_to_rad(-EclLenC-90.0); {lg:= central azimuth ?}
         bg:=0;
         Ah_to_td(pi/2 - fi,lg,bg);
         NoR_C:=round(Bas_int((15*ST - rad_to_deg(lg) - 5.75),360)/cat_coeff);
        end
       else
        NoR_C:=round((ST*15 - 5.75)/cat_coeff);
      end
     else
      NoR_C:=round((ST*15 - 5.75)/cat_coeff);
     {if Tycho then dec(NoR_C,1000);}
     if NoR_C>0 then
      begin
       inc(NoR_C,offs_belt);
       NoR:=NoR_C;
      end
     else NoR_C:=offs_belt+1;
       {position within catalogue that should be near the central colur}
    end
   else   {search for compound fixed stars is made longer near poles}
    begin
     NoR_C:=offs_belt+1;
     if B5_CD_FirstTime and BSC and (nm_queue>0) then
      begin
       inc(nm_add_most,200);
       inc(nm_queue,200);
      end;
    end;

   B5_CD_FirstTime:=false;
   NoS:=0;
   Rising:=true;
   Tyc_str:='asce.'+Tyc_belt_str;
   finished:=false;
   Outside:=0;
   too_faint:=0;
   loc_size:=MaxOutside;
   Inside:=false;
   Should_decrease:=(Pole_out and (not south_pole) and (Unshifted)) or Tycho;
   if BSC then
    begin
    { nname:=DbFieldNum('NAME');}
     ndec:= DbFieldNum('DE2CD');
     na:= DbFieldNum('RA2CD');
     nv:= DbFieldNum('V');
     nvmx:= DbFieldNum('VMX');
     nvmin:= DbFieldNum('VMIN');
    { nhr:= DbFieldNum('HR');}
     nparms:= DbFieldNum('Parms');
    end;
   moveto(5,report_h);
   if Monoscopic and ShowProgress then outtext('plotted/read, free mem.: ');
   xnum:=getx;
   aux_boo:=CatRead(NoR,rec,true);
   progress_report;

   repeat
    inc(NoS);
    if Rising then inc(NoR) else
     if BSC then dec(NoR)     {slow backward reading is no problem}
     else
      begin    {reads forward in RA belts, overlaps may be not
                handled properly at seams. Relying on cache and
                reading backwards would leave just the initial seam}
       inc(Loc_NoS);
       if Loc_NoS<loc_size then inc(NoR)
       else
        begin
         if NoR_loc=offs_belt+1 then
          NoR_Loc:=offs_belt+DbNuRec+1;
         if NoR_loc-MaxOutside>offs_belt then
          begin
           dec(NoR_loc,MaxOutside);
           loc_size:=MaxOutside;
          end
         else
          begin
           loc_size:=NoR_Loc-offs_belt;
           NoR_loc:=offs_belt+1;
          end;
         Loc_NoS:=0;
         NoR:=NoR_loc;
        end;
      end;
    if (NoS mod 100)=0 then
     begin
      if not BatchMode then 
       if Tycho then if gm_cquit('C') then Outside:=MaxOutside+1;
      progress_report
     end;
   { the [0,90] point plots at [950,1390], the [0,0] at [950+r90,1390]}
    V:=rig_ord_val(rec[nv]);
    VMx:=rec[nvmx];
    if VMx<>'   ' then {some information on variability is given}
     begin
      IsVari:=true;
      V_least:=rig_ord_val(VMx);
     end
    else
     IsVari:=false;
    if (V>Faintness_lim_add)
    or (IsVari and (V_least>Faintness_lim_add) and (V_least <= V+100)) then
     begin
      inc(too_faint);
     end
    else        {just for bright enough stars}
     begin
      if V_least > V+100 then IsVari:=false;
     {a hack to overcome Castor with YY Gem variability given...} 
      if BSC then
       begin
        val(__cvtstr(rec[ndec],_rem_white_str),de2cd,j);
        val(__cvtstr(rec[na],_rem_white_str),ra2cd,j);
	NotNova:= (ra2cd>0) and (de2cd<>0);
        if PrecFixedStars then
         begin
          ra2:=ra2cd/100;
          de2:=de2cd/100;
          Precess(ra2,de2);
          de2cd:=RoundUp(de2*100);
          ra2cd:=RoundUp(ra2*100);
         end
       end
      else 
       begin
        NotNova:= (ra2>0) and (de2<>0);
        if PrecHT and (rec[nv]<>'    ') then
        begin
         Precess(ra2,de2);
         de2cd:=RoundUp(de2*100);
         ra2cd:=RoundUp(ra2*100);
        end;
       end;    
      VMin:=rec[nvmin];

      if Zenith then
       begin
        A_h_A(ST,RA2CD/100,De2CD/100,A,h,{PA,}Air_mass);
        aux_boo:=MapCoord(A,h,x,y)
       end
      else
       aux_boo:=MapCoord(-ra2cd/100,de2cd/100,x,y);

      if aux_boo then if NotNova then
       begin
        New(p_aux);     {filling a new record of a star}
        p_new:=p_aux;
        with p_new^ do
         begin
           {faintesses:}
          if IsVari then {some information on variability is given}
           begin
            Vari:=true;
            if V_least<>0 then       { V in maximum light is given}
             begin
              if V_least > V then V:=(V_least+V) div 2 else V:=V_least;
                                     {mean for V<Vmx}     {V for maximum brightness}
              Vf:=rig_ord_val(Vmin);
             end
            else                     {VMin says how much can be the star fainter}
              Vf:=V+rig_ord_val(VMin);
           end
          else
           begin
            Vari:=false;
            Vf:=V
           end;
          Vb:=V;
          if Zenith
             and refract {added 2001-01-13}
             {and (not below_horizon) --deleted 2001-01-13} then
           begin
            d:=RoundUp(ZenExt*Air_Mass);
            inc(Vb,d);
            inc(Vf,d);
           end;
          if Vb<Faintness_lim_add then
           begin
            r:=V2R(Vb);
             {further data:}
            if Rising or (not BSC) then HR:=NoR-1 else HR:=NoR+1;
            xc:=x;
            yc:=y;
            alone:=' ';
            lg:=1/cos(deg_to_rad(De2cd/100));
            if lg<20 then
             sek_del20:=round(lg)
            else
             sek_del20:=20;
            p_down:=nil;
            p_up:=nil;
            inc(n_queue);
           end;
         end;

        if p_new^.Vb<Faintness_lim_add then
         begin
          if (n_queue>1) then  {looking in the first part of the queue for
                       the same fixed stars and stars which would be overlapped}
           look_through_the_queue
          else
           begin
            p_bott:=p_new;
            p_top:=p_new;
            p_add_bott:=p_new;
           end;

          if (n_queue>nm_queue) or (MaxAvail<ThreeStars) then
            take_star_and_plot;
         end
        else
         dispose(p_aux); {this may happend either because of extinction
                          had made the star to faint, or sometimes because
                          of (V+V_least/2) being larger than Faintness_lim}
        Outside:=0;
        Too_Faint:=0;
        Inside:=UnShifted;
       end   {of star inside a map}

      else    {a star outside the map}
       begin
        inc(Outside);
        if ((Inside and Pole_out) or Should_decrease)
        and (Outside+too_faint>MaxOutside) then
         if Rising then
          begin
           Rising:=false;
           Tyc_str:='desc.'+Tyc_belt_str;
           Outside:=0;
           Too_faint:=0;
           InsideRising:=Inside;
           Inside:=false;
           NoR:=NoR_C-1;
           if not BSC then
            begin
             loc_NoS:=MaxOutside;
             NoR_loc:= NoR_C;
            end;
          end
         else finished:=true;
       end;
     end;

     if Should_decrease and ((NoR = offs_belt) or (NoR>DbNuRec+offs_belt)) then
      if Rising then
       NoR:=offs_belt+1
      else
       begin
        NoR:=DbNuRec+offs_belt;
        if not BSC then
         begin
          loc_NoS:=MaxOutside;
          NoR_loc:= NoR;
         end
       end;
     finished:=finished or not CatRead(NoR,rec,true);
   until finished or (NoS>DbNuRec);
   if Tycho then { (1-2*(index mod 12))*(3.25 degrees+index*7.5 degrees)}
    begin
     if ((not Inside) and (not InsideRising) and unshifted)
     or (Tyc_belt=11) then
      if Fi_tyc>=Fi then
       begin
        Fi_tyc:=Fi-belt_width;
        Fi_Tyc:=Fi_Tyc+0.001;
         {the additive constant should prevent skipping of southward belt}
       end
      else
       Tycho_finished:=true
     else
      if Fi_Tyc>=Fi then
       Fi_Tyc:=Fi_Tyc+belt_width
      else
       Fi_Tyc:=Fi_Tyc-belt_width;
     Tyc_belt:=trunc(abs(Fi_Tyc)/belt_width);
     Tyc_Zone:=RoundUp(7.5*Tyc_belt + 3.25);
     if Fi_Tyc<0 then Tyc_belt:=Tyc_belt+12;
     if Tyc_belt in [0..23] then
      begin
       if Tyc_belt>11 then Tyc_Zone:=-Tyc_Zone;
       Tyc_belt_str:=' belt'+SI(4,Tyc_Zone)+chr(248)+'; outside:';
       offs_belt:=Tyc_belts_ind[Tyc_belt]-1;
       DbNuRec:=Tyc_belts_ind[Tyc_belt+1]-Tyc_belts_ind[Tyc_belt];
       cat_coeff:=360/DbNuRec;
       {outtextxy(30,10+20*Tyc_belt,SI(2,Tyc_belt)+SI(7,offs_belt)+SI(7,DbNuRec))}
      end
     else Tycho_finished:=true
    end;
  until (not Tycho) or  Tycho_finished;

  if p_bott<>nil then
   repeat
    if Sink {GM_mode<>2} {=3 before, but screen deserves it as well} then
     sink_if_larger_and_overlapping;
    take_star_and_plot
   until p_bott=nil;
  LastReport:=true;
  progress_report;
  CatClose;
 end; {of B5_CD}


procedure Process_parameters;
 procedure one_Map_BSC_param;
  var wrong_pos:integer;
  begin
   if ParOrg[1] in ['/','-'] then ParOrg:=copy(ParOrg,2,length(ParOrg)-1);
   Par:=__cvtstr(ParOrg,_To_UpCase_Str);
   if length(Par)>0 then
   case Par[1] of
    '?','-': Help(''); {- added to respect unix --help even without the help}
    'A': if length(Par)>1 then
          if Par[2]='A' then
           AzC:=par_num(copy(par,2,length(par)-1))
          else
           AzC:=par_num(par)+180;
    'B': if length(par)>1 then
          case Par[2] of
           'C','M','R','F':
                if length(par)>2 then
                 if Par[3]='-' then Draw_picture_border:=' '
                 else
                  begin
                   Draw_picture_border:=Par[2];
                   if Draw_picture_border ='F' then
                    adj_line:=RoundUp(100*ss2r(Par,3));
                  end
                else Draw_picture_border:=Par[2];
           'G': BackgroundWhitePercent:=ss2i(Par,3);
          else
           Faintness_base_forced:=par2i(Par);
          end;
    'C': if length(par)>1 then
          case Par[2] of
          '-': Colurs:=false;
          '1'..'9' :
               begin
                ColursMod:=ss2i(Par,2) div 5;
                if ColursMod=0 then ColursMod:=1;
                Colurs:=true;
               end;
          'R': begin
                Cross:=length(Par)<3; if not Cross then Cross:=Par[3]<>'-';
               end;
          'S': begin
                if ItemCountD(':',Par)=1 then
                 begin
                  nCom_Stars:=ss2i(Par,3);
                  if nCom_Stars=0 then Com_Stars:=false
                  else Com_Stars:=true;
                  Com_Stars_txt:=false;
                 end
                else
                 begin
                  inc(NuComField);
                  nCom_Stars:=NuComField;
                  Com_Stars_txt:=true;
                  FComInfo[nCom_Stars].start:=
                   I_S(ItemStrD(':',1,copy(Par,3,length(Par)-2)));
                  FComInfo[nCom_Stars].len:=
                   I_S(ItemStrD(':',2,Par));
                 end;
               end;
          'T': if not par_celtemp then help(' ');
          'W': begin
                One_Star_r:=ss2r(Par,3);
                if One_Star_r>0 then
                 One_Star_r_given:=true
               end;
          end
         else
          Colurs:=true;
    'D': if length(Par)>1 then
          if Par[2] ='E' then
           begin
            Par:=copy(Par,2,length(par)-1);
            if not Par_Fi then help('(Declination is meant, in fact.)');
            Fi_mapc:=Fi;
            Decl_given:=true;
           end
          else
           if not Par_Date then help(' ');
    'E': begin
          surface:=cylinder;
          include_below:=true; {added 2001-03-27}
          r_o_f:=67;
          ys:=50;
          Faintness_lim:=500;
          Faintness_base:=-300;
          if length(Par)=1 then EclLenC:=90
          else EclLenC:=par_num(Par);
         end;
    'F': if length(par)>1 then
          case Par[2] of
            'J': ForcedJulian:=true;
            'G': ForcedGregorian:=true;
           else
            begin
             if not Par_Fi then help(' ');
             Fi_true:=Fi;
            end;
           end;
    'G': if (length(Par)=1)
         or (Par[2] in ['0'..'9']) then
          begin                 {along galactic equator}
           ST:=192.8593/15;
           if not planets_too_set then
            planets_too:=false;
           surface:=cylinder;
           include_below:=true; {added 2001-03-27}
           r_o_f:=67;
           ys:=50;
           Faintness_base:=-300;
           Fi:=deg_to_rad(27.1283);
           if length(Par)>1 then
            AzC:=Bas_int(par_num(Par)+303,360)
           else
            AzC:=303;
          end
         else
          if Par[2]='R' then
           if Length(Par)=2 then
            begin                 {no map, just a coordinate grid}
             Grid:=true;
             ST:=12;
	     if not planets_too_set then
              planets_too:=false;
             Faintness_lim:=-2;
             Below_horizon:=true;
             include_below:=true;
            end
           else
            begin
             case par[3] of
             '-': Grid:=false;
             'I': if length(Par)=3 then hr_scale_inner:=true
                  else if Par[4]='-' then hr_scale_inner:=false;
             'O': if length(Par)=3 then hr_scale_outer:=true
                  else if Par[4]='-' then hr_scale_outer:=false;
             else
              begin
               wrong_pos:=ss2i(par,3);
               if wrong_pos=2 then
                gray16_stars:=false  { black & white screen}
               else
                if wrong_pos in [3..100] then
                                 {texts at wrtcolour % of the maximum white}
                 wrtcolour:=wrong_pos;
              end;
             end;
            end;
    'H': case length(Par) of
           1: help_file;
        2..255: case Par[2] of
             'C':
               if length(Par)=2 then height_circles:=true
               else
                case Par[3] of
                '-': height_circles:=false;
                '1'..'9' :
                     begin
                      HeightCircMod:=ss2i(Par,3) div 5;
                      if HeightCircMod=0 then HeightCircMod:=1;
                      Height_Circles:=true;
                     end;
                end;
             'F':  star_full_mode_ori:=OrPut;
                 {hide faint stars in the bright ones,
                  to prevent destroying of the bright ones}
             'O':
               begin
                surface:=cylinder;
                below_horizon:=false;
                {include_below:=false; added maybe erroneously 2005-06-30}
                hor_param_given:=true;   {added 2001-01-13}
                if length(Par)>2 then 
		  if not (Par[3]='R') then 
		   map_angheight:=pi*ss2r(Par,3)/180
		  else if length(Par)>3 then  
		   map_angheight:=pi*ss2r(Par,4)/180;
               end;
             'I':  {Hipparcos catalogue input}
               begin
                BSC:=false; Tycho:=false;
                if length(Par)>2 then
                 if length(Par)=4 then
                  if pos(':',Par)=4 then
                   CatDrive:=copy(ParOrg,3,2)
                  else
                   CatPath:=copy(ParOrg,3,length(Par)-2)
                 else
                  CatPath:=copy(ParOrg,3,length(Par)-2);
               end;
              end;
         end;
    'I': if length(Par)>1 then
          case Par[2] of
           'B': Include_below:=true;
           'E': Zodiac:=true;
           'M': begin
                 Incl_maps:=true;
                 if length(Par)>2 then
                  Maps_name:=copy(Par,3,length(Par)-2);
                end;
           'P': Incl_p_p:=true;
          end;
    'K':  if length(par)>1 then
          begin
           par:=copy(par,2,length(par)-1);
           i2:=ItemCountD(':',par);
           for kb:=1 to i2 do
            begin
             aux_st:=ItemStrD(':',kb,par);
             case aux_st[1] of
              '0'..'2': kind:=I_S(aux_st);
              '3'     : surface:=cylinder;
              '4'     : kind:=equivalent;
              '5'     : kind:=Nikon990FE;
              '6'     : kind:=Nikon990;
              '7'     : kind:=Pentax;
              'G'     : kind:=gnomonic;
              'E'     : kind:=equidistant;
              'A','P' : surface:=plane;
              'R'     : surface:=cylinder;
              'S'     : begin surface:=plane; kind:=conformal; end;
                   {as Stereographic}
              'U'     : Undistort_parallel_far:=par2r(aux_st);
              'C'     : begin
                if copy(aux_st,1,4)='CONF' then kind:=conformal
                else
                 if copy(aux_st,1,4)='CONE' then
                  begin
                   surface:=cone;
                   if length(aux_st)>4 then
                   h_cone:=ss2r(aux_st,5);
                   if (h_cone<0.5) or (h_cone>89) then help(
  'The cone normal should have angular height or |declination| from 1 to 89');
                  end
                 else
                  if copy(aux_st,1,3)='CYL' then surface:=cylinder;
                        end;
             else help('Wrong kind of projection');
             end;
            end;
          end;
    'L': if length(Par)>2 then
          case  Par[2] of
           'A': LandscapeA4:=true;  {added 2001-03-27, more paper sizes
                                     could be included}
           'B': Loc_BSC:=copy(ParOrg,3,length(par)-2);
           'E': Loc_obj:=copy(ParOrg,3,length(par)-2);
           'L': L_L:=ss2r(Par,3) / 2;
           'S': begin
                 if ItemCountD(':',Par)=1 then
                  begin
                   nLab_Stars:=ss2i(Par,3);
                   if nLab_Stars=0 then Lab_Stars:=false
                   else Lab_Stars:=true;
                   Lab_Stars_txt:=false;
                  end
                 else
                  begin
                   inc(NuComField);
                   nLab_Stars:=NuComField;
                   Lab_Stars_txt:=true;
                   FComInfo[nLab_Stars].start:=
                    I_S(ItemStrD(':',1,copy(Par,3,length(Par)-2)));
                   FComInfo[nLab_Stars].len:=
                    I_S(ItemStrD(':',2,Par));
                  end;
                 end;
          else
           if not Par_Lambda then help(' ');
          end
         else
          if length(Par)>1 then
           if Par[2]='A' then
            LandscapeA4:=true
           else
            if not Par_Lambda then help(' ');
    'M': if length(Par)>1 then
          if par[2]='O' then
           begin
            Months:=true;
            if length(par)>2 then if par[3]='-' then Months:=false
           end
          else
           begin
            Faintness_lim:=par2i(ItemStrD(':',1,Par));
            Faintness_lim_given:=true;
            if ItemCountD(':',Par)>1 then
             Faintness_lim_SolSyst:=I_S(ItemStrD(':',2,Par));
           end;
    'N': if length(Par)>1 then
          case par[2] of
           'I': begin below_horizon:=false; {include_below:=false; 
                  maybe obsolete, added and deleted 2005-06/07} end;
           'B': Draw_Picture_Border:=' ';
           'D': begin
                 NoDate:=true;
                 if length(Par)>2 then
                 if par[3]='P' then ShowParString:=true;
                end;
           'E': Equator:=False;
	   'Z': Ecliptics:=False;
           'G': ShowGeocentricMoonToo:=false;
           'P': ShowProgress:=false;
           'R': refract:=false; {added 2001-01-13}
          end;
    'O': begin
          Incl_D_S:=true;
          if length(Par)>1 then
           begin
            Par:=copy(ParOrg,2,length(ParOrg)-1);
            aux_st:=ItemStrD(':',1,Par);
            if aux_st<>'' then ObjFileName:=aux_st;
            if ItemCountD(':',Par)>1 then
             Map_sh:=ItemStrD(':',2,Par);
           end;
         end;
    'P': if length(Par)=1 then
          begin
           Zenith:=false;
           south_pole:=false
          end
         else
          case Par[2] of
           'L': if Length(Par)=2 then 
	         begin planets_too:=true;
		       planets_too_set:=true;
                 end
                else
                 case Par[3] of
                  '-' : begin planets_too:=false; planets_too_set:=true; end;
                  '+' : begin planets_too:=true; planets_too_set:=true; end;
                  'B','N': if length(par)>3 then
                    begin
                     if Par[3]='N' then
                      Next_Plan:=ss2i(ItemStrD(':',1,Par),4)
                     else
                      Before_Plan:=ss2i(ItemStrD(':',1,Par),4);
                     if ItemCountD(':',Par)>1 then
                      begin
                       Par:=ItemStrD(':',2,Par);
                       if pos('H',Par)>0 then
                        begin
                         val(copy(Par,1,pos('H',Par)-1),Step_plan,wrong_pos);
                         Step_plan:=Step_plan/24;
                        end
                       else
                        if pos('M',Par)>0 then
                         begin
                          val(copy(Par,1,pos('M',Par)-1),Step_plan,wrong_pos);
                          Step_plan:=Step_plan/24/60;
                         end
                        else
                         val(Par,Step_plan,wrong_pos);
                       if ItemCountD(':',ParOrg)>2 then
                        begin
                         plan_mod:=I_S(ItemStrD(':',3,ParOrg));
                         if plan_mod=0 then plan_mod:=1;
                 {just a provision, 0 should at least swith off the Moon}
                        end;
                      end;
                    end;
		  'F': PlanFullMode:=true;    
                  'T': if Length(Par)>3 then
                     begin
                      WtTimeMod:=ss2i(ItemStrD(':',1,Par),4);
                      if ItemCountD(':',Par)>1 then
                       WtTimeModMoon:=I_S(ItemStrD(':',2,Par))
                      else
                       WtTimeModMoon:=WtTimeMod
                     end;
                 end;
           'R': if not par_relpres then help(' ');
           'S': begin
                 Zenith:=false;
                 south_pole:=true;
                 if length(Par)>2 then Head_North:=Par[3]<>'S';
                end;
           'N': begin
                 Zenith:=false;
                 south_pole:=false;
                 if length(Par)>2 then Head_North:=Par[3]<>'S';
                end;
          end;
    'Q': if length(Par)>1 then
          begin
           SetQueue:=true;
           SetQueue_n:=par2i(ItemStrD(':',1,par));
           if ItemCountD(':',Par)>1 then
            SetQueue_na:=ss2i(ItemStrD(':',2,par),1)
           else
            if SetQueue_n<nm_queue_ini then
             if SetQueue_n>30 then
              SetQueue_na:=SetQueue_n - 20
             else
              begin SetQueue_na:=SetQueue_n; Sink:=false; end;
           if ItemCountD(':',Par)>2 then
            Set_add:=ss2i(ItemStrD(':',3,par),1)
           else if SetQueue_na=0 then Set_add:=0;
          end
         else BatchMode:=true;
    'R': if length(Par)>1 then
          case  Par[2] of
           'A': if Par_BabLike(3,'RA','Right Ascension',RA,'D',360) then
                 begin
                  ST:=RA/15;
                  if not planets_too_set then
                   planets_too:=false
                 end;
           'H': if not par_relhum then help(' ');
           'O': Rotate:=ss2r(Par,3);
           '-': Dont_turn:=true;
          else begin r_o_f:=par2r(Par); r_o_f_new:=true; end;
          end;
    'S': if length(Par)>1 then
          case Par[2] of
          ':': if length(Par)>2 then
                begin
                 select:=true;
                 SChar:=ParOrg[3];
                 if length(par)>3 then
                  nselect:=ss2i(par,3);
                 inc(NuField);
                 FInfo[NuField].len:=1;
                 FInfo[NuField].start:=nselect;
                end;
          'C': begin
                stereoscopic:=true;
                StereoColor:=true;
                if length(par)>2 then
                 case par[3] of
                 '-': StereoColor:=false;
                 'B': GreenStereo:=false;
                 'G': GreenStereo:=true;
                 'R': if length(par)>3 then
                       begin
                        if ss2i(par,4)>0 then
                         RedLumPerCent:=ss2i(par,4);
                        if RedLumPerCent>100 then RedLumPerCent:=100;
                       end;
                 else
                  begin
                   if ss2i(par,3)>0 then
                    GreenLumPerCent:=ss2i(par,3);
                   if GreenLumPerCent>100 then GreenLumPerCent:=100;
                  end;
                 end;
                if StereoColor then stereo_shift_coef:=0;
               end;
          'D': if length(Par)>2 then
                if Par[3]='-' then ShowDistances:=false
                 else ShowDistances:=true
                else ShowDistances:=true;
          'M': begin
                stereoscopic:=true;
                StereoMirror:=true;
                stereo_shift_coef:=190;
               end;
          'V': Par_SVGA;
          else
           begin
            Par:=copy(Par,2,length(Par)-1);
            aux_st:=ItemStrD(':',1,Par);
            stereo_coef:=I_S(ItemStrD('!',1,aux_st));
            if ItemCountD('!',aux_st)=1 then
             begin
              stereo_coef_plan:=stereo_coef;
              stereo_coef_Moon:=stereo_coef_plan;
             end
            else
             begin
              stereo_coef_plan:=I_S(ItemStrD('!',2,aux_st));
              if ItemCountD('!',aux_st)=2 then
               stereo_coef_Moon:=stereo_coef_plan
              else
               stereo_coef_Moon:=I_S(ItemStrD('!',3,aux_st));
             end;
            if (stereo_coef>0) or (stereo_coef_plan>0) or (stereo_coef_Moon>0)
             then stereoscopic:=true;
            if ItemCountD(':',Par)>1 then
             begin
              stereo_shift_coef:=I_S(ItemStrD(':',2,Par));
              if ItemCountD(':',Par)>2 then
                Stereo_Dist_ftEarth:=R_S(ItemStrD(':',3,Par));
             end
           end
          end
         else
          begin
           stereoscopic:=true;
           stereo_coef_plan:=stereo_coef;
           stereo_coef_Moon:=stereo_coef_plan;
          end;
    'T': if length(Par)>1 then
          case Par[2] of
           'I','Y':  {Tycho catalogue input}
             begin
              BSC:=false; Tycho:=true;
              if not (CatName=CatNameTycSel) then CatName:=CatNameTyc;
              CatRecSize:=352;
              if length(Par)>3 then
               if length(Par)=4 then
                if pos(':',Par)=4 then
                 CatDrive:=copy(ParOrg,3,2)
                else
                 CatPath:=copy(ParOrg,3,length(Par)-2)
               else
                CatPath:=copy(ParOrg,3,length(Par)-2)
              else
               if length(Par)=3 then
                 CatName:=CatNameTycSel
               else CatName:=CatNameTyc;
             end;
           'M','E','B':
             begin
              Morning_or_evening:=par[2];
              if length(Par)>2 then
              Sun_depth:=ss2r(par,3);
              hh:=12; mi:=0; ss:=0; hs:=0;
             end;
           'S':
             if Par_BabLike(3,'TS','Sidereal Time',ST,'H',24) then
              if not planets_too_set then
               planets_too:=false;
           'R': ToFont_dmag:=round(ss2r(Par,3));
           else if not Par_Time_or_TT then help(' ');
          end;
    'U': if not Par_UT then help(' ');
    'W': if length(Par)>1 then
          begin
           case Par[2] of
            'T': begin GM_mode:=2; Sink:=false; end;
            'H': GM_mode:=1;
            'P': begin GM_mode:=3; inc(nm_queue,700); end;
           end;
           if length(Par)>2 then
            begin
             GM_OuFile:= copy (ParOrg,3,length(Par)-2);
             if (GM_mode=2) and (GM_OuFile[1]='-') then
              begin
               GM_Mode:=22;
               GM_OuFile:=copy(GM_OuFile,2,length(GM_OuFile)-1);
              end;
            end;
          end;
    'X': if length(Par)>1 then
          case Par[2] of
           'S': XS:=ss2i(Par,3);
           'P': begin Shift_in_degrees_x:=false;
                      DeltX:=trunc(10*ss2r(Par,3));
                end;
           else begin Shift_in_degrees_x:=true;
                      DeltX:=trunc(10*ss2r(Par,2));
                end;
          end;
    'Y': if length(Par)>1 then
          case Par[2] of
           'S': YS:=ss2i(Par,3);
           'P': begin Shift_in_degrees_y:=false;
                      DeltY:=trunc(10*ss2r(Par,3));
                end;
           else begin Shift_in_degrees_y:=true;
                      DeltY:=trunc(10*ss2r(Par,2));
                end;
          end;
    'Z': begin ZenExt:=ss2i(Par,2);
          if ZenExt<15 then help('Zenith extinction cannot be under 15 cmag.')
         end;
   end; {of case}
  end;  {of one_Map_BSC_param}

 begin  {of Process_parameters}
  command_line:='';
  for j:= 1 to paramcount do
   begin
    Par:=paramstr(j);
    if Par[1]='@' then
     begin
      par_file_Name:=copy(par,2,length(par)-1);
      if not rt_reset_suf(Loc_Obj,par_file,par_file_name,'cnf') then
       help('@ file >>'+par_file_name+'<< not found in .\ or '+Loc_obj);
      while not eof(par_file) do
       begin
        readln(par_file,par_line);
        remark:=false;
        i:=itemcount(par_line);
        for jj:= 1 to i do
         begin
          ParOrg:=itemstr(jj,par_line);
          if ParOrg[1] in rem_char then remark:=true;
          if not remark then one_Map_BSC_param;
         end;
       end;
      close(par_file);
      par_file_name:='';
     end;
   end;
  for j:= 1 to paramcount do
   command_line:=command_line+paramstr(j)+' ';
  remark:=false;
  i:=itemcount(command_line);
  for jj:= 1 to i do
   begin
    ParOrg:=itemstr(jj,command_line);
    if ParOrg[1] in rem_char then remark:=true;
    if not remark then one_Map_BSC_param;
   end;
  if Faintness_base_forced<2000 then
   Faintness_base:=Faintness_base_forced;
 end; {of Process_parameters (if paramcount>0)}


begin    {of the main programme:   M A I N   P R O G R A M M E  }

{gm_tstarlim:=30; dmag from the brightest for using a true-star shape;
                the old default given in graph_m#(currently 8) unit
                had been 10}

FileMode:=0; {will open the files by reset as Read Only
                  -- they can be then marked so even if not on a CD}

ThreeStars:=3*SizeOf(star);

{assign(tst,'queue.tst');
rewrite(tst);
writeln(tst,
'         HR     Vb     Vf     xc   yc    p_aux_li      p_heap_top  p_heap_beg',
'     p_up_li   p_down_li',cl);
close(tst); }

Main_program:='Map_BSCt'; 
 if GM_Mode=0 then begin GM_Mode:=3; inc(nm_queue,700) end;

Fi_true:=Fi;
Fi_mapc:=Fi;

{FInfo[8].start:=391;
 FInfo[8].len:=6;      - this has been HD number in Hip_main.dat}

if paramcount>0 then Process_parameters;


if SetQueue then
 begin
  nm_queue:=SetQueue_n;
  nm_add_most:=SetQueue_na;
  Faintness_lim_add:=Faintness_lim+Set_add;
 end
else
 if BSC then
  Faintness_lim_add:=Faintness_lim+500
 else
  Faintness_lim_add:=Faintness_lim+Set_add;

if nm_queue<nm_add_most+10 then
 begin
  nm_queue:=nm_add_most;
  Sink:=false;
 end;

if (Faintness_base_forced=2000) and (r_o_f<OneStarScale) then
 Faintness_base:=Faintness_base + round(100*(OneStarScale / r_o_f));

if Decl_given then Fi:=Fi_mapc
else Fi_mapc:=Fi_true;
if WtTimeMod=0 then Write_time:=false;

if zenith and (surface=plane) {and added 2005-06-30 below_horizon} then
 below_horizon:=Include_below;
if surface=cylinder then
 begin
  Pole_out:=true;
  Dont_turn:=true;
  {if added 2005-06-30 below_horizon then}
   below_horizon:=Include_below; {added 2001-01-13}
  {if (added 2005-06-30) below_horizon then}
   if not zenith then below_horizon:=true; {added 2001-03-27}
 end;
if rotate<-999 then
 if grid and (surface=plane) then
  if Fi>=0 then rotate:=90 else rotate:=-90
 else
  rotate:=0;
Get_JD;
if not tt_UT_set then tt_ut:=tt_UTC_in_days(JD);
if Morning_or_evening<>' ' then
 begin
  MoE:=Morning_or_evening;
  if Morning_or_evening='B' then
   MoE:='M';
  if not At_height(MoE,-Sun_depth,MJD) then halt;
  JD:=MJD+JD_MJD;
  Name:=DoW(JD,t_UT,_English);
  DD:=ND;
  Get_JD;
  step_plan:=trunc(step_plan);
  if step_plan=0 then step_plan:=1;
 end;
if (not BSC) or (abs(YYYYreal(JD)-2000.0)>3) or PrecFixedStars then
 begin
  PrecDate:=YYYYreal(JD);
  PrecFixedStars:=true;
 end;
OSM:=SM;
OJD:=JD;
LastJD:=JD;
FirstJD:=JD;
LastSM:=SM;
FirstSM:=SM;
Epsi:=Epsilon(jd);
if ST<-999 then  {a sidereal time (or right ascension) has not been given}
 begin
  ST:=SM;
  aux_boo:=false;
 end
else
 aux_boo:=true;
if EclLenC>-359 then  {an Ecliptical Length has been given}
 if surface=cylinder then
  begin
   fi:=deg_to_rad(90-epsi);
   ST:=18.0
  end
 else
  begin
   Ecl_to_Equ(EclLenC,ra,decl);
   ST:=ra/15;
   fi:=deg_to_rad(decl);
   ra:=cos(deg_to_rad(ra));
   Rotate:=rad_to_deg(arctan(ra*sEpsi/SqRt(1-Sqr(ra)*Sqr(sEpsi))));
  end
else if surface<>plane then
 if zenith then EclLenC:=-AzC-90
 else if aux_boo then EclLenC:=ST*15 - 90 else EclLenC:=-90;

sin_Fi:=sin(Fi);
cos_Fi:=cos(Fi);

gm_JustTrial:=stereoscopic;
gm_init(XS,YS);  {takes some ten KB from the heap when InitsGraph,
                    and some five when SettingTextStyle to LITTle font...}
adj_line:=RoundUp(adj_line/(gm_un2mm*100));
 {adj_line transformed from hudredths of mm to the employed units}
if stereoscopic then
 begin
  gm_close;
  stereo_coef:= ((MaxX div 16) * stereo_coef) div 320;
  stereo_coef_plan:= ((MaxX div 16) * stereo_coef_plan) div 320;
  stereo_coef_Moon:= ((MaxX div 16) * stereo_coef_Moon * 30) div 32;
  stereo_shift:=17{16}*(((MaxX div 4) * stereo_shift_coef) div 1600);
  stereo_shift:=(stereo_shift div 16) * 16;
          {to have the base shift in whole pixels}
  if not StereoColor then
   XS:=RoundUp(1.95*(XS*stereo_shift / MaxX))
  else
   XS:=RoundUp(XS*(1 - (stereo_shift / MaxX)));
  Draw_Picture_Border:=' ';
  Draw_Picture_Border:=' ';
  Equator:=false;
  gm_JustTrial:=false;
  gm_init(Xs,Ys);
  if not StereoColor then
   begin
    MaxX:=round(MaxX*0.95/1.95); { -- to get the width of one belt only}
    setviewport((GetMaxX div 2)-(stereo_shift div 16),0,GetMaxX,GetMaxY,true);
    StereoHalfX:=(((MaxX + stereo_shift) div 2 - 240) div 16) *16;
   end
  else
   begin
    if not gray16_stars then setcolor(lightred);
    if GM_mode=3 then gm_verbatim('/pc {pcl} def pc');
    {to have the first plotted thing red (left is red usually) as well}
   end;
 end;
Monoscopic:= not stereoscopic;
CenX:=MaxX div 2;
CenY:=MaxY div 2;
report_h:=(MaxY -TextH) shr 4 - 3;
if gray16_stars then
 begin
  if StereoColor then
   wrtcolour:= (wrtcolour*(MaxColorSqrt-1)) div 100
  else
   wrtcolour:= (wrtcolour*GetMaxColor) div 100;
  setcolor(wrtcolour);
  gm_Star_full_mode:=star_full_mode_ori;
 end
else
 wrtcolour:=GetMaxColor;

{if BackgroundColor>0 then
 begin
  setfillstyle(solidfill,BackgroundColor);
  floodfill(CenX, CenY, MaxColor);
 end;
-- included in graph_m#(currently 8) unit already}

if (star_full_mode_ori=OrPut) then
 begin
  nm_queue:=nm_add_most;
  Sink:=false;
 end;

p16_p_d:= round(CenY / r_o_f);
if (surface=cylinder) then
 begin
  if (r_o_f=95) and (not r_o_f_new) then
   if (DeltY=0) and {(not below_horizon)} hor_param_given  then
    begin                              {changed 2001-01-13}
     r_o_f:=33;
     p16_p_d:= roundup(CenY / r_o_f);
     DeltY:=240;
     if undistort_parallel_far<-1 then
      undistort_parallel_far:=(r_o_f + DeltY/10)/2;
     {shown 57 degrees above horizon,
      undistorted parallel at half that height}
    end
   else
    begin
     r_o_f:=67;
     p16_p_d:= roundup(CenY / r_o_f);
     if undistort_parallel_far<-1 then
      undistort_parallel_far:=r_o_f/2;
    end
  else
   if undistort_parallel_far<-1 then
    undistort_parallel_far:=r_o_f/2;
    {undistorted parallels in the one and three quarters of the screen}
  if (kind<>equidistant) or (undistort_parallel_far<=0)
   then p16_p_d_RA:=p16_p_d
  else
   p16_p_d_RA:=round(p16_p_d*cos(deg_to_rad(undistort_parallel_far)));
 end;
p16_p_r:= CenY /deg_to_rad(r_o_f);
 {conical projection parameters}
if surface=cone then
 begin
  r_cone:=deg_to_rad(h_cone);
  sin_h_cone:=sin(r_cone);
  r_cone:=p16_p_r*cos(r_cone)/sin_h_cone;
  case kind of
   equidistant:
    begin
     if undistort_parallel_far<0 then
      undistort_parallel_far:=r_o_f/2;
        {undistorted parallels at one and three quarters of the screen height}
     r:=r_cone*cos(deg_to_rad(undistort_parallel_far));
     h:=p16_p_d*(90-h_cone);
     if r<h then
      begin
       r:=h/r_cone;
       undistort_parallel_far:=rad_to_deg(arctan(sqrt(1-sqr(r))/r));
       r_cone:=h;    {but pole always inside it}
      end
     else
      r_cone:=r;
    end;
   conformal:
     ln_con_cone_coef:=sin_h_cone*ln((1+sin_h_cone)/(1-sin_h_cone))/2;
  end {case kind of};
  no_repeat_h_cone_d:=180-0.8*180*(1-sin_h_cone)/sin_h_cone;
  if no_repeat_h_cone_d<140 then no_repeat_h_cone_d:=140;
 end;

case kind of
 equidistant: name:='Equidistant';
 conformal:   name:='Conformal';
 gnomonic:    name:='Gnonomic';
end;
name:=name+' projection to a ';
case surface of
 plane: name:=name+'plane';
 cone:
   begin
    name:=name+'cone'+cl+
     '%  with central parallel at height/declination'
         +SRe(5,1,h_cone)+' degrees'+cl;
    if (kind=equidistant) and (undistort_parallel_far>0) then
     name:=name+'%  and undistorted parallels'+SRe(5,1,undistort_parallel_far)
           +' from it (i.e., at'+SRe(6,1,undistort_parallel_far+h_cone)+' and'
           + SRe(6,1,h_cone-undistort_parallel_far)+' degrees).'
    else
     name:=name+'%  (undistorted).';
   end;
 cylinder:
   begin
    name:=name+'cylinder'+cl;
    if (kind=equidistant) and (undistort_parallel_far>0) then
     name:=name+'%  with undistorted parallels'+SRe(5,1,undistort_parallel_far)
           +' degrees from horizon/equator.'
    else
     name:=name+'% (with undistorted horizon/equator).';
   end;
end;
gm_comm(cl);
gm_comm(name+cl);

if surface=plane then
 name:='in zenith/pole'
else
 if (kind=equidistant) and (undistort_parallel_far>0) then
  name:='on the undistorted parallels'
 else
  if surface=cone then
   name:='on the undistorted parallel'
  else
   name:='on the horizon/equator';
if kind=equidistant then
 name:=name+cl+'%  and along lines going from the zenith/pole.'
else name:=name+'.';
gm_comm('Original scale is'
        +SRe(6,2,1/gm_un2mm)+
        ' units per millimeter, and'
        +SRe(7,2,p16_p_d)+' units per degree '+cl+'%  '+name+cl);

if Shift_in_degrees_x then
 DeltX:=DeltX*p16_p_d div 10
else
 DeltX:=(DeltX*CenY) div 1000;
if Shift_in_degrees_y then
 DeltY:=DeltY*p16_p_d div 10
else
 DeltY:=(DeltY*CenY) div 1000;
                {DeltX/Y converted from decidegrees of per mil to pixels/16}
UnShifted:=sqr(DeltX)+sqr(DeltY)<1E5;
if (surface=cylinder) and (DeltX=0) and (DeltY<=CenY) then Unshifted:=true;
 {(as it probably cannot miss the map)}
if surface=cone then
 begin
  DeltY:=RoundUp(DeltY-R_cone);
  if zenith then A:=180+AzC-1E-6
  else
   if south_pole then
    A:=-90+EclLenC-1E-6
   else
    A:=90-EclLenC-1E-6;
  if GM_mode=3 then gm_verbatim('gsave '+cut_string);
  if south_pole then
   begin
    if MapCoord(a,-90,x,y) then;
    if kind=equidistant then
     aux_boo:= MapCoord(a,90,x2,y2)
    else
     if MapCoord(a,80-h_cone,x2,y2) then;
    gm_line(x,y,x2,y2);
    A:=A+2e-6;
    if kind=equidistant then
     aux_boo:=MapCoord(a,90,x1,y1)
    else
     if MapCoord(a,80-h_cone,x1,y1) then;
    if MapCoord(a,-90,x,y) then;
    if Draw_picture_border<>' ' then
     gm_line(x,y,x1,y1);
    ParOrg:=
      SI(6,x2)+SI(6,MaxY-y2)+' lineto'
     +SI(6,CenX+DeltX)+SI(6,MaxY-round(CenY+DeltY))+' lineto'
     +SI(6,x1)+SI(6,MaxY-y1)
   end
  else
   begin
    if MapCoord(a,90,x,y) then;
    if kind=equidistant then
     aux_boo:= MapCoord(a,-90,x2,y2)
    else
     if MapCoord(a,h_cone-80,x2,y2) then;
    gm_line(x,y,x2,y2);
    A:=A+2e-6;
    if kind=equidistant then
     aux_boo:=MapCoord(a,-90,x1,y1)
    else
     if MapCoord(a,h_cone-80,x1,y1) then;
    if MapCoord(a,90,x,y) then;
    if Draw_picture_border<>' ' then
     gm_line(x,y,x1,y1);
    ParOrg:=
      SI(6,x1)+SI(6,MaxY-y1)+' lineto'
     +SI(6,CenX+DeltX)+SI(6,MaxY-round(CenY+DeltY))+' lineto'
     +SI(6,x2)+SI(6,MaxY-y2)
   end;
  if GM_mode=3 then
   begin
    gm_verbatim('grestore'+cl+
     'newpath 0 0 moveto 0'+SI(6,MaxY)+' lineto'+cl+
     ParOrg+' lineto'+cl+
     SI(6,MaxX)+SI(6,MaxY)+' lineto'+SI(6,MaxX)+' 0 lineto 0 0 lineto'+cl+
     'clip newpath'+cl);
   end;
  if (GM_mode<>2) and (kind=equidistant) then
    begin     {upper limit of the cone}
     x:=RoundUp(R_cone+p16_p_d*(h_cone-90));
     if x>0 then
     gm_circle_empty(CenX+DeltX,round(CenY+DeltY),x);
    end;
 end;

if One_Star_r=0 then begin Compose:=false; One_Star_r:=One_star_r_ini; end;
if (not One_Star_r_given) and (r_o_f<OneStarScale) then
 One_Star_r:=One_Star_r * r_o_f / OneStarScale;  {6' is scaled down for small fields}
One_Star:=Round(p16_p_d * One_Star_r) div 60; {sum fixed stars closer than (6')}
if One_Star=0 then Compose:=false;

if not Compose then
begin
 dec(nm_queue,nm_add_most);
 nm_add_most:=0;
end;

Datum:=__Dt2StStr(YYYY,MM,ND,_ANSI_Dt_Str);
if Monoscopic and (not NoDate)   then
 gm_outxy(MaxX-48,MaxY-TextH-32,Datum+' , '+Time,'r',0)
else if ShowParString then
 begin
  for i:=1 to paramcount do
   ParString:=ParString+paramstr(i)+' ';
  gm_outxy(MaxX-48,MaxY-TextH-32,ParString,'r',0)
 end;

if surface=plane then
begin
 if Zenith and (not grid) and cross then
  gm_comm('cross at zenith - i.e., at center of projection:')
 else
  gm_comm('cross at pole - i.e., at center of projection:');
 if grid and (GM_mode=3) then
  gm_verbatim('gsave currentlinewidth 2 mul setlinewidth'+cl);
              {double strength}
 r:=90-L_L; if south_pole then r:=-r;
 aux_boo:=MapCoord(0,r,x1,y1);
 if Monoscopic and (MapCoord(180,r,x2,y2) or aux_boo) and cross then
  gm_line(x1,y1,x2,y2);
 aux_boo:=MapCoord(90,r,x1,y1);
 if MapCoord(270,r,x2,y2) or aux_boo then
  begin
   if Monoscopic and cross then
    gm_line(x1,y1,x2,y2)
  end
 else Pole_out:=true;
 if grid and (GM_mode=3) then
  gm_verbatim('grestore'+cl);
end;

if Tycho then Pole_out:=true; {to prevent beginning out of the map for zones
                              far from the map centre}
ForcePlus:=true;
if surface=cone then DoForce:=true;

repeat   {but, in fact, just in case of conical surface, prolonging the map
               into the void a bit}

  Elevate_by_refraction:=false
           {added 2001-03-29 to prevent refracting the altazimuthal grid,
            just celestial objects are to be refracted eventually};
 if Zenith then    {zenith-centered map}
  Zenith_map_network((Fi_true=Fi_mapc) and Monoscopic)
 else   {north Earth pole centered map}
  World_Pole_map_network;

 {setting the refraction index of air:}
  h:=refract_d(30,pressure_db_101325,Celsius_temp,Relative_humidity);
  Elevate_by_refraction:=Zenith
                         and refract {added 2001-01-13}
           { and (not below_horizon) -- deleted 2001-01-13};
  refract_multiplier_unset:=false;

 if Incl_Maps then Maps; {including rectangles of minor maps}

 if Incl_D_S then   {including deep-sky objects}
  Deep_Sky;

 if Incl_P_P then  {including poles of planets and of their trajectories}
  Planets_p_t;

 ForcePlus:=not ForcePlus;

until (surface<>cone) or ForcePlus;

          {the small Solar system bodies are not repeated into cone voids:}
DoForce:=false;
{mark(p_heap);}
posi_elm;
gm_Star_full_mode:=star_full_mode_ori;

ForcePlus:=true;
if surface=cone then DoForce:=true;
repeat    {but planets are repeated into cone voids:}
 if Planets_too then
  begin
   if not PrecFixedStars then if precinit(YYYYreal(JD),PrecDate) then;
     {just one precession matrix for all planetary positions in a map,
      tolerable in most cases. The planetary positions are not accurate to
      10''.}
   sol_rad:=0.695550/149.504; {in AU}
   if Step_plan<=0 then
    begin
     Next_Plan:=0;
     Before_plan:=0;
    end;
   if (Next_plan=0) and (Before_plan=0)  then
    Write_time:=false
   else
    disp_times:= (Next_plan<>0) and
                ((round(10*step_plan) mod 10 <> 0)
                 or (step<1)
                  {not whole days step}
                 or (Morning_or_evening<>' '));
                  {changing twilight times}
   plan_moon(JD,SM,0,false);
   Sigstep:=1;
   step:=step_plan;
   repeat     {for Next and Before}
    if ((Sigstep=1) and (Next_Plan>0))
    or ((Sigstep=-1) and (Before_plan>0)) then
     begin
      JD:=OJD;
      SM:=OSM;
      eph_time:=OJD-JD_MJD;
      if Sigstep=-1 then Next_plan:=Before_plan;
      for i:=1 to Next_Plan do
       begin
        Newtime;
        plan_moon(JD,SM,i, i mod plan_mod <> 0 );
       end;
     end;
    dec (SigStep,2)
   until Sigstep<-1;
   SM:=OSM;
   if (surface=cylinder) and (Morning_or_evening<>' ') then
    ST:=SM;
   JD:=OJD;
  end;

 ForcePlus:=not ForcePlus;

until (surface<>cone) or ForcePlus;

if MoreTimesHappened
and (Morning_or_evening<>' ')
and (surface=cylinder)
and not Faintness_lim_given then
 Faintness_lim:=-100;

if Faintness_lim>=0 then
 begin
  if surface<>cone then Map_A_round_known:=false;
  DoForce:=false;
  B5_CD;
  if MoreTimesHappened and (Morning_or_evening<>' ') and (surface=cylinder)
  then
   begin
    Name:=DoW(OJD,t_UT,_English);
    Datum:=__Dt2StStr(YYYY,MM,ND,_ANSI_Dt_Str);
    if Monoscopic then
     gm_outxy(MaxX-48,MaxY-TextH-32,'Base: '+Datum+' , '+Time,'r',0);
    if (FirstJD<JD) then
     begin
      select:=true;
      nselect:=0;
      SM:=FirstSM;
      ST:=SM;
      JD:=FirstJD;
      Name:=DoW(JD,t_UT,_English);
      Datum:=__Dt2StStr(YYYY,MM,ND,_ANSI_Dt_Str);
      gm_comm(cl+'%Fixed Stars at the first moment when a solar system body appeared:');
      if Monoscopic then
       gm_outxy(MaxX-48,MaxY-TextH-32-TextH,'First: '+Datum+' , '+Time,'r',0);
      if Incl_D_S then   {including deep-sky objects}
       Deep_Sky;
      B5_cd;
      NoPlotted:=0;
      JD:=OJD;
     end;
    if (LastJD>JD) then
     begin
      select:=true;
      nselect:=-1;
      SChar:=' ';
      SM:=LastSM;
      ST:=SM;
      JD:=LastJD;
      NoPlotted:=0;
      Name:=DoW(JD,t_UT,_English);
      Datum:=__Dt2StStr(YYYY,MM,ND,_ANSI_Dt_Str);
      gm_comm(cl+'%Fixed Stars at the last moment when a solar system body appeared:');
      if Monoscopic then
       gm_outxy(MaxX-48,MaxY-TextH-32-TextH-TextH,'Last: '+Datum+' , '+Time,'r',0);
      if Incl_D_S then   {including deep-sky objects}
       Deep_Sky;
      B5_CD;
     end;
   end;
 end;

{release(p_heap);}
 {Top of heap has been marked before posi_elm; restoring it now means
  deleting all dynamic variables serving for:
    star screen images prototypes
     and
    for the queue of stars (created if B5_CD has been used).
  Restoring place for new heap is not nedded here,
  but enables program development from this point on}

if Monoscopic and ShowProgress then
 outtext(
  ' (Esc or Q exits, other keys leave map on.)');

if BatchMode then
 begin
  gm_close;
  halt
 end
else

{
GM_CLOSE;   trying to catch a bug in case of fpk
for i:=1 to auxi do writeln(auxfin[i]:6,auxfid[i]:6);
}

 if Stereoscopic then begin sound(440); delay(200); nosound; end;
 repeat gm_quit until false;

end.
