{~ Unit used just by the Map_BSC program to sort and plot stars ~} unit {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} ; {by J. Hollan} {split from Map_BSC just to make the main program short enough to be debuggable} interface uses crt, {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} ,{graph} graph_tx, {J.H.'s text replacement of graph} solar_ut,DbBridge,un_str_m,str_num,angles_o,precesse; type poi_st=^star; star=record HR:longint; {BSC number} Vb,Vf:integer; {Vb (only or minimal faintness) and Vf (maximal faintness)} r: word; {radius of star's circle} Vari:boolean; {is variable?} {same_place:boolean; is the preceding (upward) star on the same place?} alone: char; {' ' if alone, 'P' if part of a fixed star, 'S' if compound fixed star} xc,yc:longint; {cartesian coordinates} sek_del20:byte; {1/cos(delta), but <=20, to search farther for overlaps near poles} p_up, p_down:poi_st; {pointers to following and preceding star} end; type Finforec = record len : byte; start : word; end; var {auxfin,auxfid:array[1..100] of integer; --just for some debugging} fcat:file; recCat:array[1..451] of char; sig:shortint; FInfo:array[1..8] of Finforec; FComInfo:array[1..2] of Finforec; Fa,Fsig:byte; bright_sum,faint_sum,bright,faint: real; i_star, {index of a star in the queue} DistC {distance of centres of two stars} : word; n_further: integer; {number of further stars to be checked for overlap} stereo_shift:longint; {word, in fact, but this is for computation} Parms,Parallax:integer; {var tst:text; - just for testing purposes:} {c_aux,c2_aux:char;} {p_heap:pointer; p_heap_i: longint absolute p_heap;} const {AUXI:word=1; --just for some debugging} BSC:boolean=true; {Bright Stars Catalogue} Tycho:boolean=false; {Tycho main catalogue} stereo_coef:longint=20; {20 mm for a 25 cm screen and a parallax of 1 arcsecond} stereo_coef_plan:longint=20{stereo_coef}; stereo_coef_Moon:longint=20{stereo_coef}; stereo_shift_coef:longint=100; {byte, in fact; this is just for computation} White_space: word=15; {white space between two stars in PS file} n_queue: word=0; {number of stars in the queue} p_star: poi_st=nil; {a star within the examined queue} p_new: poi_st=nil; {new star within a map} p_sum: poi_st=nil; {a fixed star which is being modified} p_top :poi_st=nil; {top of queue - last added star mostly} p_bott:poi_st=nil; {bottom of queue} p_aux: poi_st=nil; { for clearing the plotted star record } p_add_bott: poi_st=nil; {bottom of the adding part of the queue} nm_add_eq:word=15; nm_add_most:word=100; {maximum size of the newest part of the queue which is examined for creating compound fixed stars} {In the Bright Stars Catalogue, there is maximum of 350 stars per ten degrees of right ascension. Per 12', what corresponds to maximal width of one fixed star, it amounts to 7 stars. To be on the safe side, 15 should suffice at equator. Near poles, the search is done next 15/cos(delta) stars, but maximum 300 (i.e., nm_add_eq*sek_del20).} nm_queue_ini=150; nm_queue:word=nm_queue_ini; {maximum size of the whole queue, for non-PostScript output; for PostScript, more overlaps are sought for and the queue might be some 700 stars longer} test1:boolean=true; {first test printout} Faintness_base:integer=-200; {cmag} ToFont_dmag:byte = 10; rotate:real=-1000; NoPlotted: word=0; DistFromStar: byte=16; Com_Stars: boolean=true; Lab_Stars: boolean=false; nCom_Stars: byte=5; nLab_Stars: byte=0; ZenExt:word=20; {zenith extinction in centimagnitudes} zenith:boolean=true; {no polar map} below_horizon:boolean=true; {including stars below horizon} Faintness_lim:integer=800; {cmag} select:boolean=false; {no marking of selected stars} ST:real=-1000; {right ascension of the centre (sidereal time corresponding to the center being in zenith) } stereoscopic:boolean=false; Monoscopic: boolean=true; right_eye:byte=10{lightgreen -- unrecognized by the employed version of fpc}; StereoMirror:boolean=false; Compose:boolean=true; {compose fixed stars} nselect:integer=9; {field 'A' of the b5_cd.dbf} Equidistant=0; conformal=1; gnomonic=2; Equivalent=4; Nikon990FE=5; Nikon990=6; Pentax=7; plane=0; cone=1; cylinder=2; kind:byte=Equidistant; surface:byte=plane; EclLenC:real=-360; {central ecliptical length for zodiac maps} Map_A_round_known:boolean=true; DoForce:boolean=false; {just for handling void part of cone} cone_j:byte=0; south_pole:boolean=false; {south pole centered map} h_cone:real=60;{angular height or declination of line perpendicular to cone} DeltX:longint=0; {Input as degrees or % of radius, stored as tenths of this,} DeltY:longint=0; { then converted to pixels/16, as all length units} Head_North:boolean=true; NuField:byte=7; {Number of text catalogue data fields to bo read (for Hipparcos)} NuComField:byte=0; {Number of text catalogue comment fields to bo read (for Hipparcos)} PrecHT:boolean=true; {Precess Hipparcos and Tycho to PrecDate (J2000, e.g.) } PrecFixedStars:boolean=false; Sink:boolean=true; {Try overlap bright stars by fainter ones} star_full_mode_ori:byte=NormalPut; L_L:real=1; {semi-length of coodrinate marks} grid:boolean=false; {make just a grid (mask) for rotating chart} Pole_out:boolean=false; Zodiac: boolean=false; {draw zodiac marks (each 30 degrees on ecliptics)} Colurs:boolean=false; ColursMod:byte=18; {in multiples of 5 degrees} adj_line:word=0; Equator:boolean=true; {draw equator} Ecliptics:boolean=true; {draw ecliptics} Months:boolean=false; {display months of midnight culmination along ecliptics} height_circles:boolean=false; HeightCircMod:byte=18; cut_string='[40 60 5 60] 0 setdash'+cl; wrtcolour:byte=60; hr_scale_inner:boolean=true; hr_scale_outer:boolean=true; map_angheight:real = 0; var One_Star,ThreeStars:word; RA_d,De_d,r_cone,p16_p_r,ln_con_cone_coef,r,lg:real; IsPlus:array[0..1] of shortint; ForcePlus:boolean; {just for handling void part of cone} no_repeat_h_cone_d,sin_h_cone:real; Map_A_round:integer; p_star_li: longint absolute p_star; p_aux_li: longint absolute p_aux; li_aux,x,y, x1,y1,x2,y2: longint; LnM:real; {ln(10)/250: logarithm of brightness ratio corresp. to 100 cmag} rb,ra2cd: word; V,V_least,de2cd,d: integer; ra2,de2:real; aux_boo:boolean; nname,ndec,na,nv,nvmx,nvmin,{nhr,}nparms, nvar,nHp{this just for Hipparchos},kb,i2: byte; SChar: char; aux_st:string[15]; CenX,CenY,p16_p_d,p16_p_d_RA,nm_add:word; StereoHalfX,x_left:longint; function MapCoord(A, h:real; var x,y:longint):boolean; procedure RADe2xy; {procedure Dispose_and_null(p:pointer); used just in this unit, to cure disposing a non-assigned pointer} function round_rot(A:real):integer; {if not Dont_turn then roundUp(A + rotate)} procedure Zenith_map_network(DoHorizon:boolean); procedure World_Pole_map_network; function VT(Vcmag:integer):integer; {:=transformed V faintness / 1 dmag = =(Vcmag-Faintness_base) div ToFont_dmag} function VdmagF2R(VdmagF:integer):word; {diameter of star image from transformed V faintness / 1 dmag} function V2R(Vcmag:integer):word; {diameter of star image from true V faintness / 1 cmag} {Top of the queue: the newly added star} procedure look_through_the_queue; {Trying to form a compound fixed star -- this way the newly added star may get farther (lower) in the queue as a part of a compound star. Just the upper part of the queue is looked through: the "adding part"} procedure sink_if_larger_and_overlapping; {The bottom fixed star of the adding part of the queue is discarded, if not bright enough. Otherwise, fainter earlier stars below the adding part of the queue which would be overlapped by that fixed star are sought for (the length of scope is proportional to the plotted star radius); if found, the star is shifted below the farthest star to be overlapped -- this way the fainter stars are never overlapped, but are ovarlapping the brighter ones, plotted earlier} procedure take_star_and_plot; {The bottommost fixed star is plotted and cut off the queue} function CatRead(NofRec:longint; var reco:DbStr; data:boolean):boolean; implementation var j:integer; rkb:real; V1,V2,V_ecl_P:V3; p_near, p_search: poi_st; {star which is overlaped by a new brighter one} const VarDif: byte=50; {Minimum variation in cmag to be shown} procedure Dispose_reliable_aux; {var p_heap_l:pointer; p_heap_li:longint absolute p_heap_l; p_up_li, p_down_li: longint; } begin {mark(p_heap_l); else with p_aux^ do begin append(tst); if vari then c_aux:='V' else c_aux:=' '; move(p_up,p_up_li,4); move(p_down,p_down_li,4); writeln(tst,HR:11,Vb:7,Vf:7,c_aux,alone,xc:5,yc:5,p_aux_li:12, p_heap_li:12, p_heap_i:12, p_up_li:12,p_down_li:12); close(tst); end;} {if (p_aux_lip_heap_i) then} {now, perhaps dispose will not produce error 204} if MaxAvail<50000 then {enough space for star images is to be left} {I don't know why sometimes p_aux is outside the heap, dependent on using *.elm, svga(256) etc and producing error 204 (or General protection error in the fpc-compiled executables) So I choose not to dispose if not necessary.} dispose(p_aux); end; function round_rot(A:real):integer; begin if Dont_turn then {holds always for cylinders} round_rot:=0 else if surface=plane then round_rot:=RoundUp(A+rotate) else if Map_A_round_known then round_rot:=Map_A_round else begin A:=bas_int(A-90+EclLenC,360)-180; if DoForce then if ForcePlus and (A<-no_repeat_h_cone_d) then A:=A+360 else if (not ForcePlus) and (A> no_repeat_h_cone_d) then A:=A-360; round_rot:=RoundUp((A+rotate)*sin_h_cone); end; end; procedure MC1; begin aux_boo:=MapCoord(A,h,x1,y1) end; function MC2:boolean; begin aux_boo:=MapCoord(A,h,x2,y2) or aux_boo; aux_boo:= aux_boo and (abs(x1-x2)CenY then x1:=CenY; x2:=RoundUp(x1*sqrt(2)); y1:=RoundUp(x1/sqrt(2)); if MapCoord(0,90,x,y) then; y2:=135; {if Fi<0 then begin x2:=-x2; y2:=-(y2-90); end; } end; begin pole_cross(true); pole_cross(false); if not grid then {True Horizon and Ecliptics} begin ecl_pole_cross(true); ecl_pole_cross(false); if DoHorizon then begin gm_comm(cl+'% Horizon:'); aux_boo:=MapCoord(0,90,x1,y1); aux_boo:=MapCoord(0,0,x2,y2); if (GM_mode<3) or (abs(x1)>Int_Lim) or (abs(y1)>Int_Lim) or (abs(x2)>Int_Lim) or (abs(y2)>Int_Lim) or below_horizon or (surface<>plane) then segmented:=true; if not segmented then begin gm_comm( 'Horizon as a circle:'); gm_circle_empty(x1,y1,round(sqrt(sqr(x2-x1)+sqr(y2-y1)))); gm_comm( 'Clipping ev. by this circle, can be moved just behind initial clipping by borders:'); {clipping is boresome, wiping off S, W, N, E marks..., commented out on Oct 31, 2010} gm_verbatim('%'+SI(5,x1)+SI(6,y1)+SI(6,round(sqrt(sqr(x2-x1)+sqr(y2-y1))))+ ' clhw add 0 360 arc clip'+cl+ 'newpath'+cl+cl); gm_comm( 'Azimuth marks:'); end; for i:= 0 to 71 do begin r:=i*5; kb:=1; if (i mod 2) = 0 then if (i mod 18) = 0 then begin kb:=2; if MapCoord(r,-L_L*2.5,x,y) then; gm_outxy(x,y,SWNE[i div 18],'c',round_rot(r)); end else if Height_Circles then if (i mod HeightCircMod) = 0 then begin if MapCoord(r,-L_L*2.5,x,y) then; gm_outxy(x,y,LTrim(SI(4,i*5-180)),'c',round_rot(r)); end; if segmented then begin aux_boo:=MapCoord(r+L_L,0,x1,y1); if MapCoord(r-L_L,0,x2,y2) or aux_boo then if NoLL then {horizon line segment} gm_line(x1,y1,x2,y2); end; aux_boo:=MapCoord(r,L_L*kb*(2-(i mod 2)),x1,y1); if MapCoord(r,0,x2,y2) or aux_boo then if NoLL then {azimuth mark+} gm_line(x1,y1,x2,y2); end; gm_comm(' (end of Horizon)'); end else below_horizon:=true; {as it is no interesting limit then} gm_comm(cl+'% Ecliptics:'); if Monoscopic and Ecliptics then for i:= 0 to 71 do begin r:=i*5; Ecl_to_Equ(r-L_L,ra,decl); A_h(ST,ra,decl,A,h) ; MC1; Ecl_to_Equ(r+L_L,ra,decl); A_h(ST,ra,decl,A,h) ; if MC2 then gm_line(x1,y1,x2,y2); if Zodiac and ((i mod 6)=0) then begin LB_RD(r,L_L,ra,decl); A_h(ST,ra,decl,A,h) ; MC1; LB_RD(r,-L_L,ra,decl); A_h(ST,ra,decl,A,h) ; if MC2 then gm_line(x1,y1,x2,y2); end; end; gm_comm(' (end of Ecliptics)'); end; {of if not grid (for both True Horizon and Ecliptics)} if colurs then begin if not grid then gm_comm(cl+'% Colurs:') else gm_comm(cl+'% Height circles:'); if GM_Mode=3 then gm_verbatim('gsave'+gm_dash_string); if grid and (Gm_Mode=3) and (Draw_picture_border in ['M','F']) then begin gm_comm(cl+'% Clipping:'); Mask_values; gm_verbatim('/cutpath {'+ SI(6,x)+SI(6,y)+SI(6,x1)+SI(5,-y2)+SI(5,y2)+' arc'+ SI(6,x-x2)+SI(6,y)+' lineto'+ SI(6,x-y1)+SI(6,y-y1)+' lineto clip newpath} def'+cl+'cutpath'+cl); end; for i:= 1 to 35 do begin r:=90-i*5; rkb:= 1 /cos(deg_to_rad(r)); for i2:=1 to 72 do if {((i2 <> 72) or (r > 0)) and} ((i2 mod ColursMod = 0) {colur} or ((i mod ColursMod = 0) {parallel} and (((i in [4..32]) and (i2 mod 2 = 0)) {colur lines >=20 from pole} or (i in [7..29]) {parall. lines >=35 from pole} ) ) ) and ((i in [3..33]) {at least 15 degrees from pole} or (i2 mod (ColursMod * 3) =0) {each third colur up to pole} or (i2 mod 18 =0 ) {main colurs up to pole} ) then begin ra:=5*i2; A_h(ST,ra,r,A,h); if MapCoord(A,h,x,y) and (h>=-89) then begin if i2 mod 2 = 0 then {colur line segments just at tens} begin A_h(ST,ra,r+L_L,A,h) ; MC1; A_h(ST,ra,r-L_L,A,h) ; if MC2 then gm_sh_line(x1,y1,x2,y2,x,y); end; if i mod 2 = 0 then {parallel line segments just at tens} begin A_h(ST,ra+L_L*rkb,r,A,h) ; MC1; A_h(ST,ra-L_L*rkb,r,A,h) ; if MC2 then gm_sh_line(x1,y1,x2,y2,x,y); end; end; end; end; A_h(ST,0,-90,A,h); r:=-90+L_L; if MapCoord(A,h,x,y) and (h>=-89) then begin if not grid then gm_comm('Opposite pole:') else gm_comm('Nadir:'); A_h(ST,0,r,A,h) ; MC1; A_h(ST,180,r,A,h) ; if MC2 then gm_sh_line(x1,y1,x2,y2,x,y); A_h(ST,90,r,A,h) ; MC1; A_h(ST,270,r,A,h) ; if MC2 then gm_sh_line(x1,y1,x2,y2,x,y); end; if not grid then gm_comm(' (end of Colurs)') else gm_comm(' (end of Height circles)'); if GM_Mode=3 then gm_verbatim('grestore'+cl); end; if grid then begin gm_comm(cl+'% Hour scale:'); case surface of plane: {if Fi>=0 then} d:=90 {else d:=-90}; cylinder: {if Fi>=0 then} d:=180; cone: if Fi>=0 then d:=180; end; if GM_Mode=3 then begin gm_verbatim('gsave RR'+cl); if Draw_picture_border in ['M','F'] then gm_verbatim('cutpath'+cl); end; P3S_Vector(pi,Fi,V_ecl_P); {V_ecl_P seems to point to zenith here} for i:= 0 to 23 do begin A:=i*15; if (abs(Fi)>1) or not (i in [10..14]) then begin if hr_scale_inner and (i mod 2 = 0) then {scale around center of projection} begin if Fi<0 then A:=180-A; h:= 40; if MapCoord(-A,h,x1,y1) then if MapCoord(-A,80,x2,y2) then if NoLL then begin gm_line(x1,y1,x2,y2); if MapCoord(-A,60,x,y) then if i<10 then gm_outxy(x,y,SI(1,i),'o',-d) else gm_outxy(x,y,SI(2,i),'o',-d); end; if Fi<0 then A:=180-A; end; if hr_scale_outer then begin r:=deg_to_rad(A + 90); P3S_Vector(r,0,V1); Vect_prod(V_ecl_P,V1,V2); Vector_P3S(V2,A,h); A:=rad_to_deg(A); h:=rad_to_deg(h)-6; if Fi<0 then A:=-A; if MapCoord(A,h,x,y) then {scale below horizon} begin case surface of cylinder: j:=0; cone: j:=Map_A_round; plane: j:=Map_A_round{+d :an obsolete addition found 2001-03}; end; if i<10 then gm_outxy(x,y,SI(1,i),'o',j) else gm_outxy(x,y,SI(2,i),'o',j); end; end; end; end; gm_comm(' (end of Hour scale)'); if Draw_picture_border in ['M','F'] then begin gm_comm(cl+'% Lines to fold and cut the mask:'); Mask_values; if Draw_picture_border = 'F' then {lines to fold, not to cut} begin if GM_Mode=3 then gm_verbatim('grestore gsave'+cl+ {to avoid clipping} cut_string); gm_line(0,y+y1+adj_line,x-y1+adj_line,y+y1+adj_line); {lines to cut, simple} gm_line(0,y-y1-adj_line,x-y1+adj_line,y-y1-adj_line); if GM_Mode=3 then gm_verbatim('[40 40] 0 setdash'+cl); {lines to fold, not to cut} end else gm_verbatim(cut_string); gm_line(x-x2,y,x-y1,y+y1); gm_line(x-x2,y,x-y1,y-y1); if GM_Mode<>2 then {LaTeX can plot circles of any size, but I don't know the proper way yet} begin if GM_mode=3 then gm_verbatim(cut_string+ SI(5,x-y1)+' 0'+SI(6,MaxX)+SI(6,MaxY)+' rectclip'+cl); gm_circle_empty(x,y,x1); if GM_mode=3 then gm_verbatim('r grestore'+cl); end; end; end; if Equator then begin if not grid then begin gm_comm(cl+'% Equator:'); if GM_Mode=3 then gm_verbatim('gsave'+gm_dash_string); end else begin gm_comm(cl+'% Horizon:'); if GM_Mode=3 then begin gm_verbatim('gsave RR ljp 2 mul setlinewidth'+cl); if Draw_picture_border in ['M','F'] then gm_verbatim('cutpath'+cl); end; end; for i:= 0 to 71 do begin r:=i*5; if ((i mod 18) = 0) and (not Colurs) then kb:=2 else kb:=1; A_h(ST,r,0,A,h) ; if MapCoord(A,h,x,y) and (h>=-89) then begin A_h(ST,r+L_L,0,A,h) ; MC1; A_h(ST,r-L_L,0,A,h) ; if MC2 then gm_sh_line(x1,y1,x2,y2,x,y); if i mod 2 = 0 then begin A_h(ST,r,L_L*kb{*(2-(i mod 2))},A,h) ; MC1; A_h(ST,r,-L_L*kb{*(2-(i mod 2))},A,h) ; if MC2 then gm_sh_line(x1,y1,x2,y2,x,y); if grid and (i mod 18 = 0) then begin j:=roundup(C2_to_Pdf(y2-y1,x2-x1)); if (i div 18) mod 2 = 1 then aux_st:=SWNEfull[((i div 18) + 2) mod 4] else aux_st:=SWNEfull[i div 18]; d:=p16_p_d*6; gm_outxtxy(x,y,'',aux_st, '','o',j,0,-(d+230)); gm_outxtxy(x,y,'',SWNEfull[((i div 18) +2) mod 4], '','o',j-180,0,-(d+50)) end; end; end; end; if not grid then gm_comm(' (end of Equator)') else gm_comm(' (end of Horizon)'); if GM_Mode=3 then gm_verbatim('r grestore'+cl); end; if height_circles then begin if not grid then gm_comm(cl+'% Height circles:') else gm_comm(cl+'% Colurs:'); if GM_Mode=3 then gm_verbatim('gsave'+gm_dash_string); for i:= 1 to 35 do begin h:=90-i*5; rkb:= 1/cos(deg_to_rad(h)); for i2:=1 to 72 do if ((i2 mod HeightCircMod = 0) {height circle} or ((i mod HeightCircMod = 0) {parallel} and (((i in [4..32]) and (i2 mod 2 = 0)) {colur lines >=20 from zenith} or (i in [7..29]) {parall. lines >=35 from zenith} ) ) ) and ((i in [3..33]) {at least 15 degrees from zenith} or (i2 mod (HeightCircMod * 3) =0) {each third h. c. up to zenith} or (i2 mod 18 =0 ) {main h. c. up to zenith} ) then begin A:=5*i2; if MapCoord(A,h,x,y) then begin if (i2 mod 2 = 0) then {h. c. line segments just at tens} begin aux_boo:=MapCoord(A,h-L_L,x1,y1); if MapCoord(A,h+L_L,x2,y2) or aux_boo then if NoLL then {line segment down} gm_line(x1,y1,x2,y2); end; if (i mod 2 = 0) then {parallel line segments just at tens} begin aux_boo:=MapCoord(A+L_L*rkb,h,x1,y1); if MapCoord(A-L_L*rkb,h,x2,y2) or aux_boo then if NoLL then {horizontal line segment} gm_sh_line(x1,y1,x2,y2,x,y); end; if (i2 mod 2 <> 0) and (i mod 2 <> 0) and (HeightCircMod=1) then {small cross at non-tenths for 5 degree grid} begin aux_boo:=MapCoord(A,h-L_L/2,x1,y1); if MapCoord(A,h+L_L/2,x2,y2) or aux_boo then if NoLL then {line segment down} gm_line(x1,y1,x2,y2); aux_boo:=MapCoord(A+L_L*rkb/2,h,x1,y1); if MapCoord(A-L_L*rkb/2,h,x2,y2) or aux_boo then if NoLL then {horizontal line segment} gm_sh_line(x1,y1,x2,y2,x,y); end; end; end; end; if not grid then gm_comm(' (end of Height circles)') else gm_comm(' (end of Colurs)'); if GM_Mode=3 then gm_verbatim('grestore'+cl); end; end; {of Zenith_map_network} Procedure World_Pole_map_network; var i:byte; begin lg:=270; r:=90-Epsi; if south_pole then begin lg:=90; r:=-r; end; aux_boo:= MapCoord(-lg,r-L_L,x1,y1); if MapCoord(-lg,r+L_L,x2,y2) or aux_boo then if NoLL and Monoscopic then begin gm_comm('cross at the ecliptics pole'); gm_line(x1,y1,x2,y2); aux_boo:=MapCoord(-lg+L_L/sin(deg_to_rad(Epsi)),r,x1,y1); if MapCoord(-lg-L_L/sin(deg_to_rad(Epsi)),r,x2,y2) or aux_boo then if NoLL then gm_line(x1,y1,x2,y2) end; if Equator then begin gm_comm(cl+'% Equator:'); for i:= 0 to 71 do begin r:=i*5; if ((i mod 18) = 0) and (not Colurs) then kb:=2 else kb:=1; if MapCoord(r,0,x,y) then begin aux_boo:=MapCoord(r+L_L,0,x1,y1); if MapCoord(r-L_L,0,x2,y2) or aux_boo then if NoLL then gm_sh_line(x1,y1,x2,y2,x,y); if i mod 2 = 0 then begin aux_boo:=MapCoord(r,L_L*kb{*(2-(i mod 2))},x1,y1); if MapCoord(r,-L_L*kb{*(2-(i mod 2))},x2,y2) or aux_boo then if NoLL then gm_sh_line(x1,y1,x2,y2,x,y) end; end; end; gm_comm(' (end of Equator)'); end; gm_comm(cl+'% Ecliptics:'); if Monoscopic and Ecliptics then for i:= 0 to 71 do begin r:=i*5; Ecl_to_Equ(r,ra,decl); if MapCoord(-ra,decl,x,y) then begin Ecl_to_Equ(r-L_L,ra,decl); aux_boo:=MapCoord(-ra,decl,x1,y1); Ecl_to_Equ(r+L_L,ra,decl); if MapCoord(-ra,decl,x2,y2) or aux_boo then if NoLL then gm_sh_line(x1,y1,x2,y2,x,y); if Zodiac and ((i mod 6)=0) then begin LB_RD(r,-L_L,ra,decl); aux_boo:=MapCoord(-ra,decl,x1,y1); LB_RD(r,L_L,ra,decl); if MapCoord(-ra,decl,x2,y2) or aux_boo then if NoLL then gm_sh_line(x1,y1,x2,y2,x,y); end; end; end; gm_comm(' (end of Ecliptics)'); if Months then begin gm_comm(cl+'% Midnight Months along Ecliptics:'+cl+ '% [ Format is:'+cl+ '% x y x-shift y-shift angle (string) justification_procedure'); if GM_Mode=3 then gm_verbatim('gsave RR'+gm_dash_string); P3S_Vector(3*pi/2,pi/2-epsi_rad,V_ecl_P); for i:=1 to 12 do begin r:=deg_to_rad(i*30 -7); P3S_Vector(r,0,V1); Vect_prod(V_ecl_P,V1,V2); Vector_P3S(V2,ra,decl); ra_d2l_b(epsi_rad,ra,decl); lg:=rad_to_deg(ra); Ecl_to_Equ(lg,ra,decl); aux_boo:=MapCoord(-ra,decl,x,y); Ecl_to_Equ(lg-L_L,ra,decl); if MapCoord(-ra,decl,x1,y1) or aux_boo then begin Ecl_to_Equ(lg+L_L,ra,decl); aux_boo:=MapCoord(-ra,decl,x2,y2); r:=deg_to_rad(180-C2_to_Pdf(x2-x1,y2-y1)); if not Head_North then r:=r+pi; gm_outxtxy(x,y,'',month_en[i],'','o',RoundUp(rad_to_deg(r)), 0, 150); end; end; gm_comm(' (end of Midnight Months along Ecliptics)'); if GM_Mode=3 then gm_verbatim('r grestore'+cl); end; if colurs then begin gm_comm(cl+'% Colurs:'); if GM_Mode=3 then gm_verbatim('gsave'+gm_dash_string); for i:= 1 to 35 do begin r:=90-i*5; rkb:= 1/cos(deg_to_rad(r)); for i2:=1 to 72 do if ((i2 mod ColursMod = 0) {colur} or ((i mod ColursMod = 0) {parallel} and (((i in [4..32]) and (i2 mod 2 = 0)) {colur lines >=20 from pole} or (i in [7..29]) {parall. lines >= 35 from pole} ) ) ) and ((i in [3..33]) {at least 15 degrees from pole} or (i2 mod (ColursMod * 3) =0) {each third colur up to pole} or (i2 mod 18 =0 ) {main colurs up to pole} ) then begin A:=5*i2; if MapCoord(A,r,x,y) then begin if i2 mod 2 = 0 then {colur segments just at tens} begin aux_boo:=MapCoord(A,r+L_L,x1,y1); if MapCoord(A,r-L_L,x2,y2) or aux_boo then if NoLL then gm_sh_line(x1,y1,x2,y2,x,y); end; if i mod 2 = 0 then {parallel line segment just at tens} begin aux_boo:=MapCoord(A+L_L*rkb,r,x1,y1); if MapCoord(A-L_L*rkb,r,x2,y2) or aux_boo then if NoLL then gm_sh_line(x1,y1,x2,y2,x,y); end; end; end; end; gm_comm(' (end of Colurs)'); if GM_Mode=3 then gm_verbatim('grestore'+cl); end; end; {of World_Pole_map_network} function VT(Vcmag:integer):integer; {:=transformed V faintness / 1 dmag} begin VT:=(Vcmag-Faintness_base) div ToFont_dmag; {ToFont_dmag larger than 10 makes the scale less steep, smaller than 10 makes it steeper than in reality, default value of 10 makes areas of circles proportional to brightness} end; function VdmagF2R(VdmagF:integer):word; {diameter of star image from transformed V faintness / 1 dmag} var cn:byte; begin cn:=gm_cn_f(VdmagF); if star_radius[cn]=0 then star_radius[cn]:=gm_star_font_radius(cn); VdmagF2R:=star_radius[cn]; end; function V2R(Vcmag:integer):word; {diameter of star image from true V faintness / 1 cmag} begin V2R:=VdmagF2R(VT(Vcmag)); end; procedure further_star; begin p_star:=p_star^.p_down; inc(i_star); end; procedure add_new; {to a composed fixed star} begin with p_sum^ do begin bright_sum:=exp(-Vb*LnM); faint_sum :=exp(-Vf*LnM); x:=xc; y:=yc; {write(HR:5,Vb:5);} end; with p_new^ do begin bright:=exp(-Vb*LnM); faint :=exp(-Vf*LnM); x:=round((x*Bright_sum+xc*Bright)/(Bright_sum+Bright)); y:=round((y*Bright_sum+yc*Bright)/(Bright_sum+Bright)); Bright_sum:=Bright_sum+Bright; Faint_sum :=Faint_sum+Faint; {write(HR:5,Vb:5); } end; with p_sum^ do begin xc:=x; yc:=y; Vb:=round(-ln(Bright_sum)/LnM); Vf:=round(-ln(Faint_sum)/LnM); Vari:=Vf>Vb+10; {write(r:3); } r:=V2R(Vb); {writeln(r:3); } end; end; procedure sink_if_larger_and_overlapping; var is_compound:boolean; begin if p_add_bott<>nil then begin p_search:=p_add_bott; p_add_bott:=p_search^.p_up; if p_search^.alone<>'P' then {for parts of a compound fixed star, no activity} begin if (p_search^.Vb>=Faintness_lim) {and (p_search^.alone='S')} then {Not bright enough, cutting the fixed star off the queue} begin dec(n_queue); p_near:=p_search^.p_down; p_star:=p_search^.p_up; is_compound:=p_search^.alone='S'; p_aux:=p_search; dispose_reliable_aux; if is_compound then {composed fixed star} begin while (p_star<>nil) and (p_star^.alone='P') do begin {discarding parts of a fixed star:} dec(n_queue); p_aux:=p_star; p_star:=p_star^.p_up; dispose_reliable_aux ; end; p_add_bott:=p_star; end; if p_star<> nil then p_star^.p_down:=p_near else p_top:=p_near; if p_near<> nil then p_near^.p_up:=p_star else p_bott:=p_star; end {of discarding a not-bright-enough fixed star} else {The fixed star is bright enough: search for overlaps follows} begin with p_search^ do begin p_star:=p_down; p_near:=nil; i_star:=0; if One_Star>0 then n_further:=(7*sek_del20*r) div One_Star else n_further:=0; {there is maximum average of 3.5 stars per One_Star, so the search should go perhaps to 7 r / (one_star*cos(delta)).} while (p_star<>nil) and (i_starDistC) and (p_star^.Vb>Vb) then p_near:=p_star; further_star; end; if p_near<>nil then if alone=' ' then {single-component star:} begin {cutting it off the original place:} p_star:=p_up; if p_star=nil then p_top:=p_down else p_star^.p_down:=p_down; p_down^.p_up:=p_star; {inserting it before the star to be overlapped, so that it will become overlapping instead:} p_up:=p_near; p_down:=p_near^.p_down; p_near^.p_down:=p_search; if p_down=nil then {new star got to the bottom} p_bott:=p_search else p_down^.p_up:=p_search; end else {compound fixed star:} begin {cutting it off the original place:} p_star:=p_search; for j:=1 to HR+1 do p_star:=p_star^.p_up; p_add_bott:=p_star; if p_star=nil then p_top:=p_down else p_star^.p_down:=p_down; p_down^.p_up:=p_star; {inserting it before the overlapping star:} p_down:=p_near^.p_down; if p_down=nil then p_bott:=p_search else p_down^.p_up:=p_search; p_star:=p_search; for j:=1 to HR do p_star:=p_star^.p_up; p_star^.p_up:=p_near; p_near^.p_down:=p_star; end end;{of: if Vbnil} end; {of sink if larger and overlapping} procedure look_through_the_queue; begin if Compose then begin i_star:=1; p_star:=p_top; nm_add:=nm_add_eq*p_new^.sek_del20; repeat {trying to make or add to a compound fixed star} if (p_star^.alone='P') then further_star else begin DistC:=((abs(x-p_star^.xc)+abs(y-p_star^.yc))*7) div 10; if (DistC>One_Star) then {rough criterion} further_star else begin DistC:=round(sqrt(sqr(x-p_star^.xc)+sqr(y-p_star^.yc))); if DistC>One_Star then {accurate criterion} further_star else begin if p_star^.alone<>'S'then {the new star is inserted below this star and a compound fixed star is created from them and placed below them} begin New(p_sum); inc(n_queue); p_sum^:=p_star^; p_star^.alone:='P'; with p_sum^ do begin HR:=2; alone:='S'; p_up:=p_new; end; with p_new^ do begin alone:='P'; p_up:=p_star; p_down:=p_sum; end; p_star^.p_down:=p_new; add_new; if p_sum^.p_down=nil then {new star got to the bottom} p_bott:=p_sum else p_sum^.p_down^.p_up:=p_sum; p_star:=p_sum; end else {placing it just above an existing sum} {if true then further_star else} begin p_sum:=p_star; add_new; with p_new^ do begin alone:='P'; p_up:=p_sum^.p_up; p_down:=p_sum; p_up^.p_down:=p_new; end; p_sum^.p_up:=p_new; inc(p_sum^.HR); end end end end until (p_new^.alone='P') or (i_star=nm_add) or (p_star=nil); {end of trying to make or add to a compound a fixed star} { if (p_sum<>nil) and (p_sum^.HR>2) then begin test_printout; p_sum:=nil; end; } end; with p_new^ do if p_up=nil then {the new star remained alone, it is placed to the top} begin p_down:=p_top; p_top^.p_up:=p_new; p_top:=p_new end; { non-LaTeX} if Sink {(GM_mode<>2)} and (n_queue>nm_add_most+1) then sink_if_larger_and_overlapping end; {of look_through_the_queue} procedure plot_star(x,y,VdmagF:integer;r:word;empty:boolean;comment,lab_st:string); begin if r=0 then r:=VdmagF2R(VdmagF); if stereoscopic then begin Parms:=I_S(__cvtstr(rec[nparms],_rem_white_str)); if (Parms<15) then Parms:=0; Parallax:=((Parms*stereo_coef) div 100); x:=(x div 16)*16 + 11; {for getting smooth one-pixel screen parallax step, but coarser stellar positions in PostScript file as well} x_left:=x+Parallax; if StereoMirror then x_left:= StereoHalfX - x_left; gm_star(x_left, y,VdmagF,r,round_rot(A),empty,comment); if Lab_st<>'' then gm_outxtxy(x_left, y,'',Lab_St,'','r',round_rot(A),-r-DistFromStar,0); if StereoColor then begin if Gray16_stars then begin StereoRight:=true; setcolor(wrtcolour shl TwoOrFour) end else SetColor(right_eye {lightgreen/blue} ); if GM_mode=3 then gm_verbatim('/pc {pcr} def pc '); gm_star_full_mode:=OrPut; {to prevent biting into the left star; red as transparent for black would be better, of course, then even the faint green/blue stars would be visible within the bright ones} {this lengthy switching is needed, as wheras normal stars are plotted in PS as plain circles for right eye, variable stars and "true" spiky bright ones retain the usual procedures, where pc is used inside} end; gm_star(x+stereo_shift-Parallax, y,VdmagF,r,round_rot(A),empty,comment); if Lab_st<>'' then gm_outxtxy(x+stereo_shift-Parallax, y,'',Lab_St,'','r',round_rot(A),-r-DistFromStar,0); if StereoColor then begin if Gray16_stars then begin StereoRight:=false; setcolor(wrtcolour) end else SetColor(LightRed); if GM_mode=3 then gm_verbatim('/pc {pcl} def pc '); gm_star_full_mode:=star_full_mode_ori; end; end else begin gm_star(x,y,VdmagF,r,round_rot(A),empty,comment); {if not empty then} inc(NoPlotted); if Lab_st<>'' then gm_outxtxy(x,y,'',Lab_St,'','r',round_rot(A),-r-DistFromStar,0); end; end; procedure Dispose_star_bott; var is_compound:boolean; begin if p_star=nil then exit; {just a quick hack, should never happen, but, pitiously, it happens for @bsh.cnf ra210} p_aux:=p_star; is_compound:=p_star^.alone='S'; {composed fixed star} p_star:=p_star^.p_up; dispose_reliable_aux; if is_compound then while (p_star<>nil) and (p_star^.alone='P') do begin dec(n_queue); p_aux:=p_star; p_star:=p_star^.p_up; dispose_reliable_aux; end; p_bott:=p_star; if p_star<> nil then p_star^.p_down:=nil; end; procedure take_star_and_plot; var No_vari:boolean; com_st,lab_st:string; begin p_star:=p_bott; if p_star=nil then exit; {begin gm_close; writeln('TSaP is nil!'); halt end;} dec(n_queue); { This was just a test print: with p_star^ do begin p_aux:=p_down; li_aux:=p_aux_li; p_aux:=p_up; if vari then c_aux:='V' else c_aux:=' '; if alone='S'then c2_aux:='S' else c2_aux:=' '; writeln(tst,HR:11,Vb:7,Vf:7,c_aux,c2_aux,xc:5,yc:5,p_star_li:12, p_aux_li:12,li_aux:12); end; } if p_star^.Vb>=Faintness_lim then begin Dispose_star_bott; {used just here, could be inserted instead} exit end; with p_star^ do begin x:=xc; y:=yc; V:=Vb; V_least:=Vf; rb:=r; no_vari:=not vari; end; if p_star^.alone='S' then {composed fixed star} begin com_st:=''; lab_st:=''; p_aux:=p_star; p_star:=p_star^.p_up; dispose_reliable_aux ; while (p_star<>nil) and (p_star^.alone='P') do begin if Com_Stars or Lab_Stars then aux_boo:=CatRead(p_star^.HR,rec,false); if Com_Stars then aux_st:=__cvtstr(SI(6,p_star^.HR)+' '+rec[nCom_Stars],_rem_white_str) else aux_st:=__cvtstr(SI(6,p_star^.HR),_rem_white_str); if com_st='' then com_st:=aux_st else com_st:=com_st+' + '+aux_st; if Lab_stars then begin aux_st:=__cvtstr(rec[nLab_Stars],_rem_white_str); if aux_st<>'' then if lab_st<>'' then lab_st:=lab_st+'+'+aux_st else lab_st:=aux_st end else lab_st:=''; if not (BSC or (Dont_turn and (surface<>cone) and Monoscopic)) then {to get rotation or also cones} aux_boo:=CatRead(p_star^.HR,rec,true); dec(n_queue); p_aux:=p_star; p_star:=p_star^.p_up; dispose_reliable_aux ; end; end else begin if Com_Stars or Lab_Stars then aux_boo:=CatRead(p_star^.HR,rec,false); if Com_Stars then com_st:=__cvtstr(SI(6,p_star^.HR)+' '+rec[nCom_Stars],_rem_white_str) else com_st:=__cvtstr(SI(6,p_star^.HR),_rem_white_str); if Lab_stars then lab_st:=__cvtstr(rec[nLab_Stars],_rem_white_str) else lab_st:=''; if not (BSC or (Dont_turn and (surface<>cone) and Monoscopic)) then {to get rotation or also cones} aux_boo:=CatRead(p_star^.HR,rec,true); p_aux:=p_star; p_star:=p_star^.p_up; dispose_reliable_aux ; end; p_bott:=p_star; if p_star<> nil then p_star^.p_down:=nil; if BSC then begin val(__cvtstr(rec[ndec],_rem_white_str),de2cd,j); val(__cvtstr(rec[na],_rem_white_str),ra2cd,j); if PrecFixedStars then begin ra2:=ra2cd/100; de2:=de2cd/100; Precess(ra_d,de_d); de2cd:=RoundUp(de2*100); ra2cd:=RoundUp(ra2*100); end end else if PrecHT and (rec[nv]<>' ') then begin Precess(ra2,de2); de2cd:=RoundUp(de2*100); ra2cd:=RoundUp(ra2*100); end; if Dont_turn then A:=0 else begin ra_d:=RA2cd/100; de_d:=De2cd/100; DoForce:=false; if surface=cone then RADe2xy else if Zenith then A_h(ST,RA_d,De_d,A,h) else begin A:=-ra_d; if south_pole then if Head_north then A:=180-A else A:=-A else if not Head_North then A:=A+180; end end; repeat {in case of cones, in fact, because of voids} if no_vari then plot_star(x,y,VT(V),rb,false,com_st,lab_st) else {plotting variable:} if ( V_least - V > VarDif) then begin plot_star(x,y,VT(V),rb,true,com_st,lab_st); if V_least= Faintness_lim then exit else plot_star(x,y,VT((V+V_least) div 2),0,false,com_st,lab_st); if select then begin if nselect>0 then begin if rec[nselect][1]=SChar then gm_line(x,y-2*rb,x,y+2*rb) end else if nselect=0 then gm_line(x,y,x,y+2*rb) else gm_line(x,y-2*rb,x,y); end; if (surface=cone) and not DoForce then if abs(IsPlus[cone_j])=0 then aux_boo:=true else begin DoForce:=true; ForcePlus:=IsPlus[cone_j]<0; RADe2xy; if aux_boo then aux_boo:=false else begin aux_boo:=true; Doforce:=false; end; end else begin aux_boo:=true; DoForce:=false; end; until aux_boo; end; {of plotting a star} function MapCoord(A,h:real; var x,y:longint):boolean; var radius,angle:real; begin if south_pole then begin A:=-A; h:=-h; end; case surface of plane: radius:=90-h; cone: if kind=conformal then radius:=90-h else radius:=h_cone-h; cylinder: radius:=h; end; case kind of conformal: case surface of plane: {stereographic projection} begin radius:=pi*radius/360; radius:=2*p16_p_r*sin(radius)/cos(radius) end; cylinder: begin if abs(radius)>=89 then begin MapCoord:= false; exit end; radius:=abs(sin(deg_to_rad(radius))); radius:=p16_p_r*ln((1+radius)/(1-radius))/2; if h<0 then radius:=-radius; end; cone: if radius<0.01 then radius:=-r_cone else if radius>=179 then begin MapCoord:= false; exit end else begin radius:=pi*radius/360; radius:=r_cone*(exp(sin_h_cone*ln(sin(radius)/cos(radius)) +ln_con_cone_coef) -1); end; end; gnomonic: if surface=plane then begin if abs(radius)>=89 then begin MapCoord:= false; exit end; radius:=pi*radius/180; radius:=p16_p_r*sin(radius)/cos(radius); end; Equidistant: radius:=radius*p16_p_d; Equivalent: if surface=plane then begin radius:=pi*radius/360; radius:=2*p16_p_r*sin(radius); end; Nikon990FE: if surface=plane then begin radius:=pi*radius/(360+72); {2*(360+72)/360=2.4} radius:=2.4*p16_p_r*sin(radius); end; Nikon990: if surface=plane then begin if abs(radius)>=125{135} then begin MapCoord:= false; exit end; radius:=(pi*radius/180) /1.4; radius:=1.4*p16_p_r*sin(radius)/cos(radius); end; Pentax: if surface=plane then begin if abs(radius)>=125{135} then begin MapCoord:= false; exit end; radius:=(pi*radius/180) /1.2; radius:=1.2*p16_p_r*sin(radius)/cos(radius); end; end {of case}; if abs(radius) > 1E9 then begin MapCoord:= false; x:=0; y:=0; exit end; {checking of excessive radius added 0103} case surface of plane: begin angle:=pi*(A+rotate)/180; x:=round(CenX+DeltX+radius*sin(angle)); y:=round(CenY+DeltY+radius*cos(angle)); end; cylinder: if (kind=Equidistant) or (kind=Conformal) then begin x:=round(CenX + DeltX + p16_p_d_RA * (Bas_Int((A-90+EclLenC),360)-180)); y:=round(CenY + DeltY - radius {which is B here}); { If Nikon (or, generally, all special) radius transformations would be prevented, then h=radius/p16_p_d and Delta_Az = Bas_Int((A-90+EclLenC),360)-180) could be employed to compute polar coordinates, transform new radius as needed and compute x y like for a plane } end else begin {we have h and A, possibly counted from horizontal plane and south. Let's transform them to polar coordinates starting in the map centre. } angle:= pi*(Bas_Int((A-90+EclLenC),360))/180; {making it relative to the map centre} radius:=pi*h/180; {it's h, not radius here...} {to radians} Ah_to_td(-(pi/2-map_angheight), angle,radius); {another rotations could be made, this one assumes the map centre pointing horizontally} radius:=pi/2 - radius; {now it is radius indeed} angle:=angle+pi*(rotate)/180; case kind of gnomonic: begin if abs(radius)>=pi/2 - 0.02 then begin MapCoord:= false; exit end; radius:=p16_p_r*sin(radius)/cos(radius); end; Equivalent: begin radius:=radius/2; radius:=2*p16_p_r*sin(radius); end; Nikon990FE: begin radius:=radius/2.4; {2*(360+72)/360=2.4} radius:=2.4*p16_p_r*sin(radius); end; Nikon990: begin if abs(radius)>=2.18{125}{135} then begin MapCoord:= false; exit end; radius:=radius /1.4; radius:=1.4*p16_p_r*sin(radius)/cos(radius); end; Pentax: begin if abs(radius)>=2.18{125}{135} then begin MapCoord:= false; exit end; radius:=radius /1.2; radius:=1.2*p16_p_r*sin(radius)/cos(radius); end; end {of case}; if abs(radius) > 1E9 then begin MapCoord:= false; x:=0; y:=0; exit end; x:=round(CenX+DeltX-radius*sin(angle)); y:=round(CenY+DeltY-radius*cos(angle)); end; cone: begin angle:=bas_int(A-90+EclLenC,360)-180; if DoForce then if ForcePlus and (angle<-no_repeat_h_cone_d) then angle:=angle+360 else if (not ForcePlus) and (angle> no_repeat_h_cone_d) then angle:=angle-360; cone_j:=(cone_j+1) mod 2; IsPlus[cone_j]:=trunc(angle) div 90; angle:=deg_to_rad(angle+rotate)*sin_h_cone; radius:=R_cone+radius; x:=round(CenX+DeltX+radius*sin(angle)); y:=round(CenY+DeltY+radius*cos(angle)); end; end; if (y 0) and (x>0) and (x=0) or below_horizon) then begin MapCoord:=true; if surface<>cylinder then Map_A_round:=RoundUp(rad_to_deg(angle)); end else MapCoord:=false; end; procedure RADe2xy; begin if Zenith then begin A_h_A(ST,RA_d,De_d,A,h,Air_mass) ; aux_boo:=MapCoord(A,h,x,y) end else begin A:=-ra_d; aux_boo:=MapCoord(A,de_d,x,y); if south_pole then if Head_north then begin Map_A_round:=Map_A_round+180; A:=180-A end else A:=-A else if not Head_North then begin Map_A_round:=Map_A_round+180; A:=A+180; end end end; function CatRead(NofRec:longint;var reco:DbStr; data:boolean):boolean; var i{,j}:byte; {k:word;} wrong_code:integer; begin if BSC then CatRead:=DbRead(NofRec,reco) else begin Seek(fcat,NofRec-1); if eof(fcat) then begin CatRead:=false; exit end else CatRead:=true; BlockRead(fcat,recCat,1); if Data then begin for i:=1 to NuField do begin move(recCat[FInfo[i].start],reco[i][1],FInfo[i].len); { k:=FInfo[i].start; for j:=1 to FInfo[i].len do begin reco[i][j]:=recCat[k]; inc(k); end; } reco[i][0]:=chr(FInfo[i].len); end; { just for only babylonian declination format: if recCat[Fsig]='-' then sig:=-1 else sig:=1; if Bab2Dec(sig, I_S(recCat[Fsig+1]+recCat[Fsig+2]), I_S(recCat[Fsig+4]+recCat[Fsig+5]), I_S(recCat[Fsig+7]+recCat[Fsig+8]), I_S(recCat[Fsig+10]+recCat[Fsig+11]),Aux_r,'D') then } IF NDEC<>2 THEN begin {There has been a curious bug, that NDEC lost its proper value each time, in executable by Free Pascal Compiler } {auxfin[auxi]:=nofrec; auxfid[auxi]:=ndec; if auxi<100 then inc(auxi);} NDEC:=2; end; val(reco[ndec],de2,wrong_code); if wrong_code=0 then de2cd:=RoundUp(de2*100) {reco[ndec]:=SI(5,RoundUp(Aux_r*100))} else BEGIN reco[ndec]:=' '; {GM_CLOSE; WRITELN(nOFrec,cl, reco[na],cl, na:3, ndec:3, nv:3, nparms:3, nvmx:3, nvmin:3, nvar:3,cl, ndec:6,finfo[ndec].start:6,finfo[ndec].len:6,cl, ' 2',finfo[2].start:6,finfo[2].len:6,cl, RECO[NDEC],CL,DE2); HALT;} END; { Babylonian-like hour RA: if Bab2Dec(1, I_S(recCat[Fa]+recCat[Fa+1]), I_S(recCat[Fa+3]+recCat[Fa+4]), I_S(recCat[Fa+6]+recCat[Fa+7]), I_S(recCat[Fa+9]+recCat[Fa+10]),Aux_r,'H') then } val(reco[na],ra2,wrong_code); if wrong_code=0 then ra2cd:=RoundUp(ra2*100) {reco[na]:=SI(5,RoundUp(Aux_r*100))} else reco[na]:=' '; if Tycho and (reco[nv]=' ') then {missing V in Tycho should not convert to 0} begin ra2cd:=0; de2cd:=0; { reco[na]:=' '; reco[ndec]:=' '; } reco[nv]:=' '; end else begin wrong_code:=RoundUp(R_S(reco[nv])*100); reco[nv]:=SI(4,wrong_code); end; reco[nparms]:=SI(3,RoundUp(R_S(reco[nparms]))); { reco[nhr]:=SI(5,NofRec);} if (Tycho and (reco[nvar][1]<>'V')) or (reco[nvar][1]<'2') then reco[nvmx]:=' ' else begin if (reco[nvmx]=' ') or (reco[nvmin]=' ') then reco[nvmx]:=' ' else begin if Tycho then wrong_code:=0 else wrong_code:=wrong_code-RoundUp(R_S(reco[nHp])*100); reco[nvmx]:=SI(4,RoundUp(R_S(reco[nvmx])*100)+wrong_code); reco[nvmin]:=SI(4,RoundUp(R_S(reco[nvmin])*100)+wrong_code); end; end; end else if NuComField>0 then for i:=1 to NuComField do begin move(recCat[FComInfo[i].start],reco[i][1],FComInfo[i].len); { k:=FComInfo[i].start; for j:=1 to FComInfo[i].len do begin reco[i][j]:=recCat[k]; inc(k); end; } reco[i][0]:=chr(FComInfo[i].len); end; {if reco[nvmx]<>' ' then gm_outtextxy(10,10*16*nofRec mod 7500, reco[na]+','+reco[ndec]+','+reco[nv]+','+reco[nparms]+',' +reco[nvmx]+','+reco[nvmin]+','+reco[nvar]+','+reco[ncom_stars]); } end end; begin LnM:=L10/250; end.