{~ Graphic interface: simultaneous PostScript/LaTeX file, stars, graphs ~}

Unit graph_m8;  {plotting on the screen and eventually
                  creating a LaTeX file or an Encapsulated PostScript file
                       (or a HPGL  file - just a rudimentary one)
                  in the same time }
                {some procedures do nothing in LaTeX yet
                  and I doubt I will finish them all}
                {Jan Hollan, 1994-2000}
interface
uses  {standard units:} graph, crt, dos,
      {J.H.'s units:}  angles_o, str_num, un_str_m;

const
    {graphic mode initialisation, can be changed from the main programme:}
 GM_Mode:byte=0; {0=no output file; 1 for HPGL file,
                  2 for LaTeX with emTeX specials
                     (the only important is "em: lineto" for lines of
                      arbitrary slope),
                  3 for EPS,
                  22 for just a picture part of LaTeX file}
 GM_OuFile:string='';  {name of the output file}
 stars:boolean=false;  {sign of the Stars font being switched on
                        -- used for LaTeX}
 count_o:byte=110;     {number of characters in that font - open circles}
 count_f:byte=110;     {    -  "   -                        full - " -  }
 Reverse_X:boolean=false;  {for plotting graphs: reverse axis orientation}
 Reverse_Y:boolean=false;
 Main_program: string=''; {program calling Graph_m8 procedures can output
                           its name through setting this variable}
 Draw_Picture_Border:char='R';
 min_ps_r:byte=2;
 gray16_stars:boolean=true;
 SVGA:boolean=false;         {true is not working on all cards}
 SVGA256:boolean=false;
 SVGAmode:byte=4;            {4 means 1024*768 in 64 grays
                      (in 256 colors, each four neighbouring are the same)
               3 holds for 800*600}

 SVGA_driverName:string[7]='SVGA256'
  {Default is the Jordan Powell Hargrave's 256 one, 16 is an alternative --
   both are available from his home page, but registration is recommended,
   as they are in the shareware category.
     SVGA by Knight and De Trans Sw (said to be public domain by De Trans)
   might work on some cards as well.
     The Free Pascal no-BGI alternative
   is the free and reliable possibility for all true VESA cards.};

 gm_star_full_mode:byte=NormalPut;
 Dont_turn:boolean=false;
 gm_dash_string=cl+'[ljp dup 4 mul] 0 setdash'+cl;

 gm_un2mm_vga=0.0240;
 gm_un2mm:real=gm_un2mm_vga; {unit of measurement is 0.024 mm,
           what corresponds to 480 pixels of screen
                              * 16 (for printing, units are 16 times finer)
                      being 184.4 mm including the border line of 1"/300;
           for svga modes the unit is to be multiplied
           by 480/600 or 480/768}
 bp2mm=0.35278; {1 bp (= 1 inch / 72) / 1 mm, for conversion of
               (big)points (PostScript units) to millimetres}
 lj3point=0.24; {one lj3 dot size / 1 bp}
 gm_linewidth:real=lj3point; {initially 1"/300, i.e. 1 dot at 300 dots per inch}
 gr_through: boolean=false; {replace marks on axes by lines going through}
 gr_div_str_y:string[7]=''; {divider of Y variable to match the Y-axis;
                             if set to '-', then not displayed}
 gr_div_str_x:string[7]=''; {divider of X variable to match the X-axis;
                             if set to '-', then not displayed}
 NumStarRad=220;
 StereoColor:boolean=false;
 StereoRight:boolean=false;
 GreenStereo:boolean=true;
 GreenLumPerCent:longint=75;   {byte in fact, this is just for computation}
 RedLumPerCent:longint=100;   {byte in fact, this is just for computation}
 gm_JustTrial:boolean=false;
 MoreYAxes:boolean=false; NumFYAxes:byte=0;
 LandscapeA4:boolean=false;        {added 2001-03-27}
 BackgroundWhitePercent:longint=0; {added 2001-08-11}
 BackgroundColor:word=0;

var       {common:}
 MaxColor,MaxColorH,MaxColorE:word;
 MaxColorD16,MaxColorSqrt,TwoOrFour :byte;
 AutoDetectPointer:pointer;
 GM_mode_ori:byte;  {if 22, then just the Picture part of LaTeX file is made}
 MaxX, MaxY: word; {Default 16*(GetMaxX+1) and (..) values:
                            16*640 and *480 for VGA,
                    can be made just xs% and ys% by calling GM_Init(xs,ys).}
 TextH:byte {:=TextHeight('Rg') * 16 + 48;};

          {plotting stars:}
 Vstep:array[-1..20] of integer; {faintness/1dmag for integer radii}
 count_b:byte;      {number of characters for both full and empty circles in
                     the font Stars := count_o+count+f}

 star_radius:array[1..NumStarRad] of word;
 ps: array[1..{220}2*NumStarRad] of pointer;
          {plotting graphs:}
 gr_left, gr_right, gr_top, gr_bottom: word;  {limits of the graph: set to
                                              be 10% from the screen margins}
                                    {seems to be |  rather 1/15 than 1/10!}
 X_min,X_max,Y_min,Y_max,X_max_min,Y_max_min: real;
                    {to be set by the programme calling this unit}
 mark_l:byte;   {length of the marks at axes,
                 set to 1% of the vertical dimension of the graph}
 DekExpX:real; {The used power of 10 in a semilogarithmic notation of X}
 {L10, natural logarithm of 10, is set already in angles_o and str_num}
 ln1dmag:real; {:=ln(1.047129); ln of ratio of radii corresponding
          to one decimagnitude difference, used when plotting stars}
 AYCoef,AYAddi:array[1..5] of real;


procedure gm_init(xs,ys:byte);
  {GM_mode 0: no file, 1: HPGL, 2: LaTeX (works already), 3: PostScript.
   Opens the graphic mode, sets MaxX and MaxY and plots the screen borders,
   and sets font to settextstyle(2,HorizDir,4) - LITTle font}
procedure gm_line(x1,y1,x2,y2: longint{eger});
procedure gm_sh_line(x1,y1,x2,y2,x,y:longint);
                        {shifted line from 1 to 2 to pass through [x,y]}
procedure gm_circle_full(x,y:longint;r:word);
procedure gm_circle_empty(x,y:longint;r:word);
function gm_cn_f(m:integer):byte; {number of character from the star font,}
function gm_cn_o(m:integer):byte; {the same for open star circles}
procedure gm_setVstep(d0:word);  {preparing the screen faintness scale Vstep}
function gm_Star_font_Radius(cn:byte):word;
procedure gm_star(x,y:longint;m:integer {dmag from the brigtest};
                  r:word;  {for facilitating computing radius in PS file}
                  angle:integer; {for ev. rotating a non-circular shape}
                  empty:boolean;comm:string);
    {gm_star in gray mode uses just the upper half of the palette,
     i.e. all the dark grays below rgb=(32,32,32) are unused. This is
     no problem with 256 modes, but makes unnecesarily discrete greyscale
     for 16 color modes (just 7 grays employed). However, to change it
     would involve an alternative grayscale setting in gm_init and
     then another code for setting the graycolour number and
     the stereocolour number from the graycolour one. Seems not to be
     so important to me now, so perhaps sometimes in future. J.H.}
procedure gm_outxtxy(x,y:longint;
                     t1,txt,t2:string;
                     align:char;angle:integer;Xshift,Yshift:integer);
 {align can be simply L, R, or C like in standard OutTextXY;
  L can be replaced by 1 or 2, what makes a difference in PS:
   1 clears a white rectangle for the text,
   2 serves for displaying a greek letter followed by standard text
     (in txt, the greek letter is coded by 2- or 3-letter abbrev.,
      and further text follws after a space; that space is deleted in
      output)
  C can be replaced by W, for having a white rectangle for the text in PS.
  t1 and t2 are ignored on screen, used t1+txt+t2 in LaTeX,
    and making start and end of PostScript line; in this case,
    t1 containing ' S ' assumes first word of txt being a code for
    a greek letter.
  angle is ignored on the screen, but makes a rotated a co-ordinate system
    originating in x,y, for which Xshift and Yshift apply.
  }
procedure gm_outxy(x,y:longint;txt:string;align:char;angle:integer);
                  {like preceding, but simpler}
procedure gm_outtextxy(x,y:longint;txt:string);
procedure gm_ellipse(x,y:longint;angle,sa,ea:real;a,b:word);
                               {just on screen and in PS, presently}
procedure gm_rectangle(xtl,ytl,xbr,ybr:word); {not yet fot LaTex}
procedure gm_close; {just closes graphic mode and ouput file}
procedure gm_quit; {quits on any key, moreover closes graphic mode
                     (and output file) on q, Q, x, X, Esc or any special key}
function gm_cquit(keyc:char):boolean; {like gm_quit, lest c=keyc in uppercase}
procedure gm_comm(comm:string);   {adds a comment line to the output file}
procedure gm_verbatim(verb:string); {parses verbatim to the output file}

function gr_x(x:real):word;
function gr_y(y:real):word;
procedure gr_frame(NameFig,NameX,NameY:string);
                       {if NameX begins with '-',
         then it is but a sign that no scale along X is to be made,
         just DekExpX is offered to make an own scale along the X-axis.}

{
 The X-coordinate goes from 0 to MaxX-1,
 the Y-coordinate ranges from 0 to MaxY-1;
 these coordinates are transformed to the true screen ones x,y by
          x:= X div 16 and y:= Y div 16  (i.e., divided by 16)
 The y coordinate in the file is y:=MaxY-Y.

 Regarding the dimensions of the A4 paper (210mm*297.4mm),
 the bottom 28 pixels of VGA are  outside the right margin of the paper
     if its height matches the width of the screen,
 or the top 174 mm of the paper is outside the right margin of the screen,
     if its height matches the width of the paper.
 However, from practical and aesthetical reasons, the unit does not use
 paper till the edges, but just a 185mm*253mm rectangle to match VGA screen.
}

implementation
const
  khpg:real=1000/252;
  cl=#13#10; cl2=cl+cl;
  diam0:word={160}480  ;     {base diameter for -1 mag - in pixels*16}
  YSide:real=1;
var
 OutScreen:text;
 gd, gm,j: integer;
 c: char;
 YYYY,MM,DD,DoW,HH,MI,SS,HS:word;
 gr_hor,gr_ver: word;
 r0s,                         {number of star sizes on the screen}
 ReduceColorRed,ReduceColorGreen, {decrement of the red colour luminance}
 RedLum,GreenLum,BlueLum,ZeroOrTwo,StereoColorDiv,FileModeOrg :byte;
 CurrStyle:TextSettingsType;


procedure gm_init(xs,ys:byte);
  {GM_mode 0: no file, 1: HPGL, 2: LaTeX (works already), 3: PostScript}
{var Palette:PaletteType;}
const
lhead1=
'\documentclass[a4paper]{article}'+cl;
lhead11=
'\usepackage{rotate_m}'  +cl;
lhead12=
'\textwidth 253mm'       +cl+
'\textheight 185mm'      +cl+
'\hoffset -12.4mm'         +cl+
'\voffset -12.4mm'         +cl+
'\topmargin 0mm'         +cl+
'\headheight 0mm'        +cl;
lhead2=
'\headsep 0mm'           +cl+
'\oddsidemargin 0mm'     +cl+
'\footskip 0mm'          +cl+
'\pagestyle{empty}'      +cl+
'\begin{document}'       +cl+
'\parindent 0mm'         +cl;
lhead3=
'{\unitlength=0.1mm'       +cl+
'\begin{picture}(0,';
lhead4=
'\small'                   +cl+
'\newlength{\un}'          +cl+
'\setlength{\un}{';
lhead4a=
'mm}'+cl+
'\unitlength=\un'          +cl;
phead1=
'\def\l{\line(1,0)}'       +cl+
'\def\c{\circle*}'         +cl+
'\def\o{\circle}'          +cl+
'\def\ch{\char}'           +cl+
'\def\p{\put(}'            +cl;
phead2=
'\def\m{\makebox(0,0)}'    +cl+
'\def\e#1#2#3#4{'          +cl+
'       \put(#1,#2){\special{em:moveto}}' +cl+
'       \put(#3,#4){\special{em:lineto}}}'+cl+
'\font\stars=stars'        +cl;

phl0=
'% A prolog to print'+cl+
'% an (Encapsulated) PostScript page with rather landscape dimensions'+cl+
'% really landscape on an A4 format sheet.'+cl2+

'/mm2pt {72 25.4 div mul} def            % millimeters to points'+cl2;
phl1=
'196.5 mm2pt 20 mm2pt translate 90 rotate   % Landscape'+cl+
'% these      shifts'+cl+
'% could be different: the first one up to some (for A4 paper)'+cl+
'% 205'+cl+
'% and the second one down to some'+cl+
'%           5'+cl+
'% to be able to print maximum-sized pictures'+cl;


ph0=
'%!PS-Adobe-3.0 EPSF-3.0' +cl+
'%%BoundingBox: ';
ph0a=
'%%LanguageLevel: 2'      +cl+
'%%Creator: Graph_M8'     +cl+
'%%CreationDate: ';
ph1=
'gsave'                                                   +cl+
                                                          +cl+
'% The page itself begins by line   % Painting: ' +cl+
'%  (should be line 158), if you would like to edit it.'+cl+
'% Before that, the constants and procedures that may be used are defined.'+cl2;

ph1a=
'% Definitions:'+cl2+

'% Initial values (modified further to remain the same even after'+cl+
'%                 scaling to another units)'+cl;
ph1a1=
'/sep 0.48 def      % separation of two stars 2 lj3 dots'+cl+
'/H 10 def          % base font (R and S) 10bp large'+cl2;

ph1a2=
' setlinewidth % initial width 1 lj3 dot by default'+cl+
' % if the programme sets it different, it changes the following command'+cl+
' % the Bounding Box in the heading corespondingly.'+cl+
' % If you would modify it later, the UR corner of the BB should'+cl;
ph1a3=
' % be shifted by the increment of the line width, and the translation'+cl+
' % command in the next line half of that. Both holds for framed pictures,'+cl+
' % for unframed ones, no change is needed.'+cl;
ph1a4=
' dup translate % to get the 1"/300 border line inside the BoundingBox'+cl2;
ph1b=
' dup dup scale'                        +cl+
'% The above line matches the height of the VGA screen to 184.4 mm.'+cl+
'% The number is the employed unit of measurement divided by 1 bp'+cl+
'%  (e.g., the unit of measurement in PostScript points)'+cl2;
ph1b2=
'1 exch div dup dup dup 72 mul 300 div'+cl+
'/ljp exch def                    % ljp is 72/300 bp, i.e. 1"/300'+cl+
'currentlinewidth mul setlinewidth    % line width again as before scaling'+cl+
'sep mul /sep exch def  H mul /H exch def % the same for sep and H'+cl2;

ph1c=
'/enl 1.05 def  % white rim radius around stars 1.05 times their own radius'+cl+
'/cio {0 360 arc stroke} def   % open circle'+cl+
'/cif {0 360 arc fill} def     % full circle'+cl2;
ph1c2=
'/pcg {0 setgray} def  /pc {pcg} def  % default color for stars is black'+cl+
'/pcl {1 0 0 setrgbcolor} def  % left stars may be red'+cl+
'/pcr {0 1 0 setrgbcolor} def  % right stars perhaps green'+cl+
'% (redefining pc in enables stereo colour plots of stars)'+cl2;

ph2=
'/sf {neg 4 mul selectfont} def'                     +cl+
'/RR {/sh H 3 div neg def /Times-Roman sh sf} def'  +cl+
'/R {/sh H 4 div neg def /Times-Roman sh sf} def'  +cl+
'/r {/sh H 5 div neg def /Times-Roman sh sf} def'  +cl;
ph2a=
'/i {/sh H 5 div neg def /Times-Italic sh sf} def' +cl+
'/ii {/sh H 6 div neg def /Times-Italic sh sf} def'+cl;
ph3=
'/rr {/sh H 6 div neg def /Times-Roman sh sf} def' +cl+
'/S {/sh H 4 div neg def /Symbol sh sf} def'       +cl+
'/s {/sh H 5 div neg def /Symbol sh sf} def'       +cl+
'/grgray {0.7 setgray} def' +cl2;

ph3a=
'/sp     % one spike of a true star'                 +cl+
' {ra   0 moveto'                                    +cl+
'  0  sr lineto'                                    +cl+
'  ra neg  0 lineto'                                 +cl+
'  0  sr neg lineto'                                +cl+
'  closepath'                                       +cl+
' } def'                                            +cl;
ph3b=
'/tst'            +cl+
' {exch /ra exch def'                         +cl+
'  /sr ra 2 div def'                                 +cl+
'  3 1 roll'                                        +cl+
'  gsave'                                           +cl+
'   translate'                                      +cl+
'   rotate 22.5 rotate'                             +cl+
'   8 {45 rotate sp} repeat fill'                   +cl+
'  grestore } def'                                  +cl;
ph3c=
'/tstar  % true star: x y r angle tstar'            +cl+
' {1 setgray 4 copy exch enl mul sep add exch tst'  +cl+
' pc tst} def'                               +cl;
ph4=
'/star       % plain star:  x y r star'                           +cl+
' {1 setgray 3 copy enl mul sep add cif'                          +cl+
'  pc cif} def'                                            +cl;
ph5=
'/vstar      % variable star - as empty circle: x y r vstar'      +cl+
' {1 setgray 3 copy'                                              +cl+
' gsave'                                                          +cl+
'  enl mul sep 2 div dup setlinewidth add'                        +cl+
'  cio'                                                           +cl+
' grestore'                                                       +cl+
' pc cio} def'                                             +cl;
ph6=
'/nstar      % star with name: x y r (text) nstar'                +cl+
' %   - meant for ev. editing the PS file'                        +cl+
' {4 1 roll 3 copy 3 1 roll gsave translate 30 add sh moveto'     +cl+
' 4 -1 roll show grestore star} def'                              +cl;
ph7=
'/nstarr     % star with rotated name: x y r angle (text) nstarr' +cl+
' %   - meant for ev. editing the PS file'                        +cl+
' {5 2 roll 3 copy 3 1 roll gsave translate 6 -1 roll rotate    ' +cl+
' 30 add sh moveto 4 -1 roll show grestore star} def'             +cl;

ph8=
'/ellipse  %: from to a b angle x y ellipse'                      +cl+
'{gsave'                                                          +cl+
'  translate rotate dup 3 1 roll div 1 scale'                     +cl+
'  0 0 3 -1 roll 5 3 roll arc stroke'                             +cl+
' grestore} def'                                                  +cl;

ph9=
'/stringbox  % fills a (white) rectangle'                                  +cl+
'   % (around a text string to be shown shown later)'                      +cl+
'   % the string should be on top of stack  and currentpoint should exist' +cl;
ph10=
' {gsave'                                                                  +cl+
' dup stringwidth pop           % x-size is needed, y-size should be 0'    +cl+
' currentpoint sh 0.75 mul add  % to get bottom a bit down from the string'+cl;
ph11=
' exch sh 2 div add exch        % to get left side  " left   -  "   -'     +cl+
' 3 -1 roll sh neg 0.6 mul add sh neg 4 mul  % better x  width and y width'+cl;
ph12=
'  1 setgray                     % or: 0.5 setgray for gray'               +cl+
' rectfill'                                                                +cl+
'grestore} def'                                                         +cl+cl;

ph13=
'/t         % simple text: x y (string) t'                           +cl+
'  {3 1 roll moveto show} def'                                             +cl+
                                                                           +cl+
'% futher command centers vertically small letters'                      +cl;
ph14=
'                          % (rather than capitals):'                      +cl+
'/td                % shifted text: x y x-shift (string) td'               +cl+
' {4 1 roll 3 1 roll'                                                      +cl+
'  gsave'                                                                  +cl+
'   translate'                                                             +cl+
'   sh moveto'                                                             +cl+
'   show'                                                                  +cl+
'  grestore } def'                                                         +cl;

ph14a=
'/nc     % from: x y x-shift y-shift angle (string) trd?'                  +cl+
'  % makes the translated and rotated coord. system'                       +cl+
' {6 4 roll'                                                               +cl+
' gsave'                                                                   +cl+
'  translate'                                                              +cl+
'  4 1 roll rotate}    % now: (string) x-shift y-shift'                    +cl+
'def'                                                                      +cl;
ph15=
'/xw {exch 3 -1 roll dup 4 1 roll stringwidth pop neg} def'                +cl+
'                     % now: (string) y-shift x-shift -x-width'            +cl;

ph16=
'% futher commands center vertically capitals:'                          +cl;
ph17=
'/trdl  % rotated and shifted text: x y x-shift y-shift angle (string) trdl'+cl+
' {nc'                                                                     +cl+
'  sh 1.25 mul add moveto'                                                          +cl+
'  show'                                                                   +cl+
' grestore } def'                                                          +cl;
ph18=
'/trdr  % rotated, shifted and right justified:'                           +cl+
' {nc xw'                                                                  +cl+
'  add  % strigwidth left'                                                 +cl+
'  exch sh 1.25 mul add moveto                        % and a bit down'             +cl+
'  show'                                                                   +cl+
' grestore} def'                                                           +cl;
ph19=
'/trdc % rotated, shifted and horizontally centerd:'                     +cl+
' {nc xw'                                                                  +cl+
'  2 div add                 % half the string width left'                 +cl+
'  sh neg 5 div add          % correction to get the string x-centered'    +cl;
ph20=
'  exch sh 1.25 mul add           % so is it y-centered'                        +cl+
'  moveto'                                                                 +cl+
'  show'                                                                   +cl+
' grestore } def'                                                          +cl;
ph21=
'/trdw  % rotated, shifted and centered, in a white rectangle around it:'  +cl+
'  {nc xw'                                                                  +cl+
'  2 div add                 % half the string width left'                 +cl+
'  sh neg 5 div add          % correction to get the string x-centered'    +cl;
ph22=
'  exch sh 1.25 mul add           % so is it y-centered'                        +cl+
'  moveto'                                                                 +cl+
'  stringbox     % this is the only additional command to trdc'            +cl+
'  show'                                                                   +cl+
' grestore } def'                                                          +cl;
ph21o=
'/trdo  % rotated, shifted, centered, outlined, in a white rectangle:'  +cl+
'  {nc xw'                                                                  +cl+
'  2 div add                 % half the string width left'                 +cl+
'  sh neg 5 div add          % correction to get the string x-centered'    +cl;
ph22o=
'  exch sh 1.25 mul add           % so is it y-centered'                        +cl+
'  moveto'                                                                 +cl+
'  stringbox     % this is the only additional command to trdc'            +cl+
'  true charpath stroke'                              +cl+
' grestore } def'                                                          +cl;
ph23=
'/trdlw  % rotated and shifted text: x y x-shift y-shift angle (string) trdlw'+cl+
' {nc'                                                                     +cl+
'  sh 1.25 mul add moveto'                                                          +cl+
'  stringbox     % this is the only additional command to trdl'            +cl+
'  show'                                                                   +cl+
' grestore } def'                                                          +cl;
ph24=
'/trdl2  % like trdlw, but for 2 words (the 2-nd gets r-font); unlike trdl'+cl+
'  {translate rotate sh 1.25 mul add moveto'                                    +cl+
'    stringbox show'                                                   +cl+
'    r stringbox show} def   % needs data in natural order'             +cl+cl;

ph25=
'% (end of Definitions)' +cl2+

'% Painting:'                                                              +cl+
                                                                           +cl+
'r  % setting initial font, see Definitions for /r'                        +cl;

procedure fail(message:string);
var errorcode:integer;
begin
 ErrorCode := GraphResult;
 if (ErrorCode <> grOK) or (message='') then
  begin
   if gm_open then closegraph;
   if (message<>'') then
    writeln(message,':  ',ErrorCode,GraphErrorMsg(ErrorCode),cl);
   SVGA:=false;
  end;
end;

{$F+}
function DetectSVGA256 : integer;

{ Detects ?VGA or MCGA video cards }
(*
var
  DetectedDriver : integer;
  SuggestedMode  : integer;
begin
  DetectGraph(DetectedDriver, SuggestedMode);
  if (DetectedDriver = VGA) or (DetectedDriver = MCGA) then
    DetectSVGA256 := SuggestedMode    { Default video mode = 0 }
  else
   begin
    DetectSVGA256 := grError; { Couldn't detect hardware }
    fail('DetectSVGA256 fails');
   end;
 *)
    {The above code could avoid SVGA mode when not available,
     but for the programme to run, the following command is enough,
     and does not conflict with the employed version of the fpk:}
begin
 DetectSVGA256 :=0; {:0 sets to 320x200, 2 to 640x480, 3 to 800x600}
end; { DetectVGA256 }
{$F-}

procedure Set256Palette;
type
  RGBColor   = record
                 R, G, B : byte;
               end;
  VGAPalette = array[0..255] of RGBColor;
var
  VGAPal   : VGAPalette;

procedure SetDACBlock(Start, Count : integer; var Pal : VGAPalette);
var
  Regs : Registers;
begin
  with Regs do
  begin
    AH := $10;
    AL := $12;
    BX := Start;
    CX := Count;
    ES := Seg(Pal);
    DX := Ofs(Pal);
  end;
  Intr($10, Regs);
end;

begin
 if StereoColor then
  begin
   with VGAPal[0] do begin R:=0; G:=0; B:=0 end;
   for gd:=1 to MaxColor do
    with VGAPal[gd] do
     begin         {   4   }
      R:=2*(gd - ((gd shr TwoOrFour) shl TwoOrFour));
               {i.e., R:=2*(gd mod 16), maximum is 30}
             {    30           }
      if R>0 then
       R:=R + 2*(MaxColorSqrt-1)+3-ReduceColorRed;
       {R is given by the lower four bits, so may attain 15 non-zero values,
        set usually at 35, 37, ... 63. Zero value is left zero.}
      G:=2*(gd shr TwoOrFour);
      if G>0 then                   {3 by default}
       G:=G + 2*(MaxColorSqrt-1)+3-ReduceColorGreen;
        {G is given by the upper four bits, so may also attain 15 non0 values,
        set usually at 32, 34, ... 60. Zero value is left zero.}
      if not GreenStereo then
       begin
        B:=G;
        G:=0;
       end
      else B:=0;
     end;
  end
 else
   for gd:=0 to MaxColor do
      with VGAPal[gd] do begin R:=gd shr 2; G:=gd shr 2; B:=gd shr 2 end;
 SetDACBlock(0, 256, VGAPal);
end; { Set256Palette }

begin
 {DetectGraph(gd,gm);}
 FileModeOrg:=FileMode;
 FileMode:=0;  {to be able to have *.bgi and *.chr as read-only;
               set back to original at the end of the procedure,
               for case that writing permissions are
               to be given to files open by the "reset" command}
 if SVGA then
  begin
   AutoDetectPointer := @DetectSVGA256;   { Point to detection routine }
   GD := InstallUserDriver(SVGA_driverName, AutoDetectPointer);
   fail('SVGA not installed, InstallUserDriver failed.');
  end;
 if not SVGA then gd:=0;
 gm:=0;
 InitGraph(gd,gm,GetEnv('BGI'));
 if GraphResult<>grOK then
  begin
   writeln(
 'The BGI driver is not in the directory given by the BGI environment variable.');
   halt
  end
 else
  gm_open:=true;
 if SVGA then
  begin
   if SVGAmode<=GetMaxMode then GM:=SVGAmode
   else fail('Maximum number of mode is '+SI(3,GetMaxMode));
   if SVGA then SetGraphMode(GM);
   fail('SetGraphMode protest on'+SI(3,GM));
  end;
 BlueLum:=0;
 MaxColor := GetMaxColor;  { Get the maximum allowable drawing color }
 SVGA256:=SVGA and (MaxColor>16);
 MaxColorSqrt:=round(sqrt(MaxColor+1));
 MaxColorH:= MaxColor div 2;
 StereoColorDiv:=1+((MaxColor-MaxColorH) div (MaxColorSqrt-1));
 MaxColorE:= 2*MaxColor - (MaxColor div 8){+3} {MaxColor+1+MaxColorH};
 MaxColorD16:=MaxColor div 16;
 if MaxColorD16=0 then MaxColorD16:=1;

 MaxX:=RoundUp(0.01*xs*((GetMaxX+1) shl 4));
                                  {not X<MaxX means behind the right edge}
 MaxY:=RoundUp(0.01*ys*((GetMaxY+1) shl 4));
                                  {    Y    Y       below  the bottom    }
 if gm_JustTrial then exit; {to spare the extremely slow setRGBpalette}
 gm_un2mm:=gm_un2mm_vga*480/(GetMaxY+1);
   {the initialization is always overwritten, for vga to the same value}
 YSide:=0.01*ys;

 if MaxColor<16 then
  begin
   ReduceColorRed:=((100-RedLumPerCent)*4*MaxColorH) div 100;
   ReduceColorGreen:=((100-GreenLumPerCent)*4*MaxColorH) div 100;
   TwoOrFour:=2; ZeroOrTwo:=0;
  end
 else
  begin
   ReduceColorRed:=((100-RedLumPerCent)*MaxColorH) div 100;
   ReduceColorGreen:=((100-GreenLumPerCent)*MaxColorH) div 100;
   TwoOrFour:=4; ZeroOrTwo:=2;
  end;
 if gray16_stars then
  if SVGA256 then
   begin
    ReduceColorRed:= ReduceColorRed shr 2;  {i.e., div 4}
    ReduceColorGreen:= ReduceColorGreen shr 2;
    Set256Palette;
   end
  else
   begin                   {setting gray palette from 0 to 15}
    for gd := 0 to {15}MaxColor do
     begin
      if MaxColor<16 then
       {VGA:}
       j:=gd*4
      else
       {internal VESA of the Free Pascal Compiler:}
       j:=gd div 4;
            {the division suits some snapshot from beginning of Feb 2000,
             0.15...}
      if gd=0 then  SetRGBPalette(gd,0,0,0)
       else
        if StereoColor then
         begin
         {luminance of the  red-          green-
    -pigmented pixels is given by just
                        2 lower bits     2 upper (more significant) bits
                     or 4             or 4
    of the gd value:}
          RedLum:=8*(gd - ((gd shr TwoOrFour) shl TwoOrFour));
          if RedLum > 0 then
           RedLum:=RedLum + 8*(MaxColorSqrt-1)+15-ReduceColorRed;
          GreenLum:=8*(gd shr TwoOrFour);
          if GreenLum>0 then
           GreenLum:=GreenLum + 8*(MaxColorSqrt-1)+15-ReduceColorGreen;
          if not GreenStereo then
           begin
            BlueLum:=GreenLum;
            GreenLum:=0;
           end;
          SetRGBPalette(gd,RedLum shr ZeroOrTwo,GreenLum shr ZeroOrTwo,
                                                BlueLum  shr ZeroOrTwo)
         end
        else
         SetRGBPalette(gd,j,j,j);
     end;
    if MaxColor<16 then
     for gd:=0 to MaxColor do SetPalette(gd,gd);
     {for FPC VESA mode, the above line would spoil the gray palette again!?}
    {GetPalette(Palette);}
   end;

 setcolor(MaxColor);

 if GM_mode>0 then
  begin
   GetDate(YYYY,MM,DD,DoW);
   GetTime(HH,MI,SS,HS);
   if GM_mode=22 then
    begin
     GM_mode:=2;
     GM_mode_ori:=22
    end
   else if GM_mode=2 then GM_mode_ori:=2;
   case GM_mode of
   1:
    begin
     if GM_OuFile='' then GM_OuFile:='screen.hpg';
     if rt_rewrite(OutScreen,GM_OuFile) then
      begin
       writeln(OutScreen,{#27,'&l1O',} #27,'%0B'); {landscape orientation, HPGL-mode}
       writeln(OutScreen,'IN;');                {initialisation}
       writeln(OutScreen,'SP1;SI.12,.18;');     {pen 1; width, height (inches)}
      end
     else GM_mode:=0;
    end;
   2:
    begin
     if GM_OuFile='' then GM_OuFile:='screen.ltx';
     if rt_rewrite(OutScreen,GM_OuFile) then
      begin
       if GM_mode_ori=2 then
        begin
         writeln(OutScreen,lhead1);
         if not Dont_turn then writeln(OutScreen,lhead11);
         writeln(OutScreen,lhead12,lhead2);
        end;
       write(OutScreen,lhead3,RoundUp(18.44*ys),')'+cl,lhead4);
       writeln(OutScreen,gm_un2mm:6:4,lhead4a);
       writeln(OutScreen,
      '%LaTeX picture from ',YYYY:4,'-',MM:2,'-',DD:2,HH:3,':',MI:2,':',SS:2);
       if Paramcount>0 then
        begin
         write(OutScreen,'%The parameters of the program '+Main_program+' were: ');
         for j:=1 to paramcount do
           write(OutScreen,Paramstr(j),' ');
         writeln(OutScreen)
        end;
       writeln(OutScreen,'\special{em:linewidth ',gm_linewidth:5:3,'bp}');
       writeln(OutScreen,phead1,phead2);
      end
     else GM_mode:=0;
    end;
   3:
    begin
     if GM_OuFile='' then GM_OuFile:='screen.eps';
     if rt_rewrite(OutScreen,GM_OuFile) then
      begin
       if not LandscapeA4 then
        writeln(OutScreen,ph0,'0 0',
             gm_linewidth+(MaxX-1)*(gm_un2mm/bp2mm):6:1,
             gm_linewidth+(MaxY-1)*(gm_un2mm/bp2mm):6:1)
       else
        writeln(OutScreen,ph0,
             196.5/bp2mm - (gm_linewidth+(MaxY-1)*(gm_un2mm/bp2mm)):6:1,
             20/bp2mm:6:1, 196.5/bp2mm:6:1,
             20/bp2mm + gm_linewidth+(MaxX-1)*(gm_un2mm/bp2mm):6:1
             );
       writeln(OutScreen,ph0a,
             YYYY:4,'-',MM:2,'-',DD:2,HH:3,':',MI:2,':',SS:2);
       if Paramcount>0 then
        begin
         write(OutScreen,'%%Title: '+Main_program+' ');
         for j:=1 to paramcount do
           write(OutScreen,Paramstr(j),' ');
         writeln(OutScreen)
        end;
       if LandscapeA4 then
        writeln(OutScreen,
         196.5/bp2mm:6:1, 20/bp2mm:6:1,
         ' translate 90 rotate   % Landscape');
       writeln(OutScreen, ph1, ph1a, ph1a1,
        gm_linewidth:5:3,ph1a2,ph1a3,
        gm_linewidth/2:5:3,ph1a4,
        gm_un2mm/bp2mm :9:6,ph1b,ph1b2,
        ph1c,ph1c2,ph2,ph2a,ph3,ph3a,ph3b,ph3c,
        ph4, ph5, ph6, ph7, ph8, ph9,
        ph10,ph11,ph12,ph13,ph14,ph14a,
        ph15,ph16,ph17,ph18,ph19,
        ph20,ph21,ph22,ph21o,ph22o,ph23,ph24,ph25);

      end
     else GM_mode:=0;
    end;
   end;
  end;
 if GM_mode=3 then
  begin
   gm_comm(cl+'%Rectclip:');
   if Draw_Picture_Border in ['R','C'] then
    writeln(OutScreen,
'newpath',cl,
'/clhw currentlinewidth 2 div def')
   else   {no need to enlarge the area for thicker frame}
    writeln(OutScreen,
'newpath',cl,
'/clhw ljp 2 div def'); {ljp is the initial default line thickness}
   writeln(OutScreen,cl,
' clhw neg clhw neg ',MaxX-1,' clhw 2 mul add ',MaxY-1,' clhw 2 mul add rectclip',cl,
'newpath');
  end;
 case Draw_Picture_Border of
  'R':
   begin
    gm_comm(cl+'%Border lines:');
    gm_line(0,0,MaxX-1,0);
    gm_line(0,MaxY-1,MaxX-1,MaxY-1);
    gm_line(0,0,0,MaxY-1);
    gm_line(MaxX-1,0,MaxX-1,MaxY-1);
   end;
  'C':
   begin
    gm_comm(cl+'%Maximum circle:');
    if MaxX<=MaxY then
     gm_circle_empty(MaxX div 2,MaxY div 2, MaxX div 2)
    else
     gm_circle_empty(MaxX div 2,MaxY div 2, MaxY div 2)
   end;
 end;

 if BackgroundWhitePercent>0 then
  begin
   BackgroundColor:=(BackgroundWhitePercent*MaxColor) div 100;
   setfillstyle(solidfill,BackgroundColor);
   floodfill(MaxX div 32, MaxY div 32, GetColor);
  end;

 settextstyle(2,HorizDir,4); {LITTle font}
 TextH:=TextHeight('Rg') shl 4 + 48;

  {gm_outtextxy(MaxX div 2, MaxY div 2,SI(3,TextH));}
    if TextH=0 then TextH:=240;
  {for fpk version with TextHeight not working}

 gr_left:={MaxX div 15}  2*TextH; gr_right:=MaxX-gr_left;
 gr_hor:=gr_right-gr_left;
 gr_top:={MaxY div 15}   2*TextH; gr_bottom:=MaxY-gr_top{-TextH};
 gr_ver:=gr_bottom-gr_top;
 FileMode:=FileModeOrg;

end;

function hpgx(x:real):real;
begin
hpgx:=(x-950)*khpg+3760
end;

function hpgy(y:real):real;
begin
hpgy:=(y-1390)*khpg+5700
end;

function hpgd(d:real):real;
begin
hpgd:=d*khpg
end;

function hpgm(m:byte):real;
begin
{d is to be computed from maximum diameter and m}
{hpgm:=d*khpg}
end;

procedure gm_line(x1,y1,x2,y2: longint);
var AuxI:longint;
begin
  if X2<X1 then
   begin AuxI:=X2; X2:=X1; X1:=AuxI; AuxI:=Y2; Y2:=Y1; Y1:=AuxI end;
  if X1<0 then if X2>0 then
      begin Y1:=RoundUp(Y1+((Y2-Y1)/(x2-x1))*(-X1)); X1:=0 end
               else exit;
  if X2>=MaxX then if X1<MaxX then
      begin Y2:=RoundUp(Y2-((Y2-Y1)/(x2-x1))*(X2+1-MaxX)); X2:=MaxX-1 end
                   else exit;
  if Y2>=MaxY then if Y1<MaxY then
      begin X2:=RoundUp(X2-((X2-X1)/(Y2-Y1))*(Y2+1-MaxY)); Y2:=MaxY-1 end
                   else exit;
  if Y1>=MaxY then if Y2<MaxY then
      begin X1:=RoundUp(X1-((X2-X1)/(Y2-Y1))*(Y1+1-MaxY)); Y1:=MaxY-1 end
                   else exit;
  if Y2<0 then if Y1>0 then
      begin X2:=RoundUp(X2+((X2-X1)/(Y2-Y1))*(-Y2)); Y2:=0 end
                   else exit;
  if Y1<0 then if Y2>0 then
      begin X1:=RoundUp(X1+((X2-X1)/(Y2-Y1))*(-Y1)); Y1:=0 end
                   else exit;
line(x1 div 16, y1 div 16, x2 div 16, y2 div 16);
if GM_mode >0 then
 begin
  case GM_mode of
 1:
   begin
{  x1:=hpgx(x1);
  y1:=hpgy(y1);
  x2:=hpgx(x2);
  y2:=hpgy(y2);
  writeln(OutScreen,'PU',x1:3:0,',',y1:3:0,';PD',x2:3:0,',',y2:3:0,';')
}  end;
 2: writeln(OutScreen,'\e{',x1,'}{',MaxY-y1,'}{',x2,'}{',MaxY-y2,'}');
 3: writeln(OutScreen,x1,' ',MaxY-y1,' moveto ',x2,' ',MaxY-y2,' lineto stroke');
  end
 end
end;

procedure gm_Sh_line(x1,y1,x2,y2,x,y:longint); {shifting line to pass through [x,y]}
var dx,dy,sql,shx,shy:longint;
begin
 dx:=x2-x1; dy:=y2-y1;
 sql:=(dx*dx+dy*dy);
 shy:=((x-x1)*(-dy)+(y-y1)*dx);
 shx:=-((shy*dy) div sql);
 shy:=(shy*dx) div sql;
 gm_line(x1+shx,y1+shy,x2+shx,y2+shy)
end;

procedure gm_circle_full(x,y:longint;r:word);
var d:word;
begin
if GM_mode >0 then
 case GM_mode of
 1: writeln(OutScreen,'PU',hpgx(x):3:0,',',hpgy(y):3:0,
     ';WG',hpgd(r):1:0,',0,360;');
 2: begin
     if r>5 {d>10} then c:='c'
     else begin c:='l'; d:=(r*r) shr 1 {(d*d) shr 3}; x:= x - d shr 1 end;
     writeln(OutScreen,'\p',x,',',MaxY-y,'){\',c,'{',r*2,'}}')
    end;
 3: writeln(OutScreen,x,' ',MaxY-Y,' ',r:4,' 0 360 arc fill')
 end;
x:=x div 16;
y:=y div 16;
if r<11 {d<11} then
 putpixel(x,y,GetColor)
else
 if r<16 {d<13} then          {small circle as :.}
  for gd:=0 to 1 do for gm:=0 to gd do putpixel(x+gd,y+gm,GetColor)
 else
  begin
   circle(x,y, r div 16 {d shr 3 div 3});
   setfillstyle(solidfill,getcolor);
   floodfill(x,y,GetColor)
  end
end;

procedure gm_ellipse(x,y:longint;angle,sa,ea:real;a,b:word);
begin
 sa:=RoundUp(Bas_Int({360-}sa,360));
 ea:=RoundUp(Bas_Int({360-}ea,360));
 ellipse(x div 16,y div 16,RoundUp(sa),RoundUp(ea),a div 16,b div 16 );
 if GM_mode=3 then
  writeln(OutScreen,sa:5:1,ea:6:1,' ',a,' ',b,angle:6:1,' ',
                    x,' ',MaxY-y,' ellipse')
end;


procedure gm_circle_empty(x,y:longint;r:word);
begin
if r>16 then
  circle(x div 16,y div 16, r div 16)
else putpixel(x div 16,y div 16,GetColor);
if GM_mode >0 then
 case GM_mode of
 1: writeln(OutScreen,'PU',hpgx(x):3:0,',',hpgy(y):3:0,';CI',hpgd(r):1:0,';');
 2: writeln(OutScreen,'\p',x,',',MaxY-y,'){\o{',r*2,'}}');
 3: writeln(OutScreen,x,' ',MaxY-Y,' ',r:4,' 0 360 arc stroke')
 end
end;

procedure gm_rectangle(xtl,ytl,xbr,ybr:word); {does nothint in LaTeX yet}
var
 R_width,R_height:word;
 l_aux:longint;   {just to be able to get negative argument for abs()}
begin
 rectangle(xtl shr 4, ytl shr 4,xbr shr 4,ybr shr 4);
 if GM_Mode>0 then
  begin
   l_aux:=xbr;
   R_width:=abs(l_aux-xtl);
   l_aux:=ybr;
   R_Height:=abs(l_aux-ytl);
   if xtl>xbr then xtl:=xbr;
   if ybr<ytl then ybr:=ytl;
   case GM_Mode of
    3: writeln(OutScreen,xtl,' ',MaxY-ybr,' ',R_width,' ',R_Height,
     ' 4 copy 1 setgray rectfill pc rectstroke');
   end
  end
end;

function gm_cn_o(m:integer):byte;
begin
 if m>=count_o then
  gm_cn_o:=count_b+1-count_o
 else
  if m>=0 then
   gm_cn_o:=count_b-m
  else
   gm_cn_o:=count_b;
end;

function gm_cn_f(m:integer):byte;
begin
 if m>=count_f then
  gm_cn_f:=1
 else
  if m>=0 then
   gm_cn_f:=count_f-m
  else
   gm_cn_f:=count_f;
end;

procedure gm_setVstep(d0:word);  {preparing the screen faintness scale Vstep}
begin
 r0s:=d0 shr 5;
 for j:=1 to r0s do
  begin
   Vstep[j]:=RoundUp( (sqrt( sqr(1+ln(j/r0s)/(-L10/500)/100) -1) -1)*10);
  end;
 Vstep[0]:=Vstep[1]+10;
 Vstep[-1]:=Vstep[0]+10;
end;

function gm_Star_font_Radius(cn:byte):word;
 begin
   gm_star_font_radius:=RoundUp(min_ps_r*exp(ln1dmag*(cn-1)));
 end;

procedure gm_star(x,y:longint;m:integer {dmag from the brigtest};
                  r:word; angle: integer;
                  empty:boolean;comm:string);
var cn:{byte}word; xs,ys:longint; CentreColor:word; plotted:boolean;
 ps_aux:pointer;
const
  x_aux=100;    {these two constants denote just the place, where all}
  y_aux=100;    { star images are formed first time }


 procedure screen_star(x,y:longint);
  var i,j:byte; rs,rs2:byte; gray:integer;
      ULX,ULY,LRX,LRY:integer; SiFig,screen_r: word;

  procedure StereoModColor;
   begin
    if StereoColor then       {for Red/Green (Blue) stars}
     if gray<=MaxColorH then
      gray:=0
     else
      begin
       gray:=1 + ( (gray-MaxColorH-1) div StereoColorDiv);
       {if gray=MaxColor then dec(gray);}
       if StereoRight then
        {dec(gray,MaxColorH)}
        gray := gray shl TwoOrFour;
      end;
   end;

  procedure put_ring;
   begin
    if gray>{15} MaxColor then gray:={15} MaxColor;
    if gray<BackgroundColor then gray:=BackgroundColor;
    StereoModColor;
    if j=0 then
     begin
      putpixel(x_aux+i,y_aux,gray);
      putpixel(x_aux-i,y_aux,gray);
      putpixel(x_aux,y_aux+i,gray);
      putpixel(x_aux,y_aux-i,gray);
     end
    else
     begin
      putpixel(x_aux+i,y_aux+j,gray);
      putpixel(x_aux-i,y_aux+j,gray);
      putpixel(x_aux-i,y_aux-j,gray);
      putpixel(x_aux+i,y_aux-j,gray);
      if i<>j then
       begin
        putpixel(x_aux+j,y_aux+i,gray);
        putpixel(x_aux+j,y_aux-i,gray);
        putpixel(x_aux-j,y_aux-i,gray);
        putpixel(x_aux-j,y_aux+i,gray);
       end
     end;
   end;

  procedure SetGray;
   begin
    gray:=RoundUp(MaxColorD16*(7+screen_r-sqrt(sqr(16.0 *i)+sqr(16.0 *j))));
     {Now, the interval of grays is made twice shorter:
      transformed into the upper half}
    gray:=gray div 2 + MaxColorH;
    if gray<BackgroundColor then gray:=BackgroundColor;
   end;

  begin
   if gray16_stars then
    begin
     screen_r:=r;
     rs:=(screen_r+7) div 16;
     rs2:=(screen_r+7) div 4;
     if rs2>rs+1 then rs2:=rs+1;
        {rs2 serves for getting smoother rins of stars, and not so
         large step bewteen one-point stars and five-point ones
         - it is not functional for color stereo, as there is no
         luminance available below the middle one
         (mere 2 or 4 bits for luminance are used for the upper half of
         the available luminance inreerval)
         }
     CentreColor:=(screen_r * MaxColorD16) div 2 +MaxColorH;
     if empty then
      cn:=gm_cn_o(m)
     else
      cn:=gm_cn_f(m); {inc(cn,count_*f)}
     if StereoRight and Gray16_stars then inc(cn,NumStarRad);
     if ps[cn]=nil then
      begin
       ULX:=x_aux-rs2; ULY:=y_aux-rs2; LRX:=x_aux+rs2; LRY:=y_aux+rs2;
       SiFig:= ImageSize(ULX,ULY,LRX,LRY);
       if SiFig<MaxAvail then
        begin
         GetMem(ps_aux,SiFig);
         GetImage(ULX,ULY,LRX,LRY,ps_aux^)
        end
       else
        begin
         gm_close;
         writeln(
  'Sorry, not enough memory for storing a screen square to create a star image');
         halt;
        end;

       if empty then
        begin
         if (rs>0) and (screen_r>10) then
          begin
           putpixel(x_aux,y_aux,BackgroundColor);
           for i:=1 to rs2 do
            for j:=0 to rs2 do
             begin
              SetGray;
              if gray>{15} MaxColor then gray:={33} MaxColorE - gray;
              put_ring;
             end;
          end
         else
          begin
           gray:=CentreColor - (CentreColor div 4);
           if gray<BackgroundColor then gray:=BackgroundColor;
           StereoModColor;
           putpixel(x_aux,y_aux,gray);
         end;
        end
       else
        begin
         gray:=CentreColor;
         if gray>MaxColor {15} then gray:= MaxColor {15} ;
         if gray<BackgroundColor then gray:=BackgroundColor;
         StereoModColor;
         putpixel(x_aux,y_aux,gray);
         if rs2>0 then
          begin
           for i:=1 to rs2 do
            for j:=0 to rs2 do
             begin
              SetGray;
              put_ring;
             end;
          end;
        end;
       if SiFig<MaxAvail then
        begin
         GetMem(ps[cn],SiFig);
         GetImage(ULX,ULY,LRX,LRY,ps[cn]^)
        end
       else
        begin
         gm_close;
         writeln('Sorry, not enough memory for storing a star image');
         halt;
        end;
       PutImage(x_aux-rs2,y_aux-rs2,ps_aux^,NormalPut);
       FreeMem(ps_aux,SiFig);
      end;
   (* if empty then
       PutImage(x-rs,y-rs,ps[cn]^, OrPut)  {OrPut failes in fpk}
      else
   *)
     PutImage(x-rs2,y-rs2,ps[cn]^, {OrPut} gm_star_full_mode);
    end

   else   {black&white or black and two colors, no star images are stored,
           as they are quickly made anew; they are not plotted as simple
           circles in the target place, to separate them by a black rectangle
           from the surrounding stars. In case of red-green stars, PutImage
           is the only way to add colors so that they make yellow together.}
    begin
     rs:=1+((r+7) div 16);
     ULX:=x_aux-rs; ULY:=y_aux-rs; LRX:=x_aux+rs; LRY:=y_aux+rs;
     SiFig:=ImageSize(ULX,ULY,LRX,LRY);
     GetMem(ps_aux,SiFig);
     GetImage(ULX,ULY,LRX,LRY,ps_aux^);
     if m>Vstep[-1] then putpixel(x_aux,y_aux,GetColor)
     else
      if m>Vstep[0] then
       for gd:=0 to 1 do for gm:=0 to gd do putpixel(x_aux+gd,y_aux+gm,GetColor)
      else
       if m<=Vstep[r0s] then  circle(x_aux,y_aux,r0s)
       else
        begin
         j:=1;
         plotted:=false;
         repeat
          if m>Vstep[j] then
           begin
            circle(x_aux,y_aux,j);
            plotted:=true
           end;
          inc(j);
         until plotted;
        end;
     if (not empty) and (m<=Vstep[0]) then
      begin
       setfillstyle(solidfill,getcolor);
       floodfill(x_aux,y_aux,GetColor); {filling the circle}
      end;
     GetMem(ps[1],SiFig);
     GetImage(ULX,ULY,LRX,LRY,ps[1]^);
     PutImage(x-rs,y-rs,ps[1]^, {OrPut} gm_star_full_mode);
     FreeMem(ps[1],SiFig);
     PutImage(x_aux-rs,y_aux-rs,ps_aux^,NormalPut);
     FreeMem(ps_aux,SiFig);
    end;

  end;

begin

xs:=x div 16; ys:=y div 16;  {star to screen}
screen_star(xs,ys);
if empty then
 begin
  if GM_mode >0 then   {to output file}
  case GM_mode of
   1:
    writeln(OutScreen,'PU',hpgx(x):3:0,',',hpgy(y):3:0,';CI',hpgm(m):1:0,';');
   2:
    begin
     if not stars then begin writeln(OutScreen,'{\stars'); stars:=true end;
     cn:=gm_cn_o(m);
     write(OutScreen,'\p',x,',',MaxY-y,'){\ch',cn,'}');
     if comm<>'' then writeln(OutScreen,' % ',comm) else writeln(OutScreen);
    end;
   3:
    begin
      r:=r-2;
          write(OutScreen,x:5,' ',MaxY-y:6,r:4,' vstar');
     if comm<>'' then writeln(OutScreen,' % ',comm) else writeln(OutScreen);
    end;
  end
 end
else   {full}
 begin
  if GM_mode >0 then  {to output file}
   case GM_mode of
    1: writeln(OutScreen,'PU',hpgx(x):3:0,',',hpgy(y):3:0,';WG',
               hpgm(m):1:0,',0,360;');
    2: {LaTeX}
     begin
      if not stars then begin writeln(OutScreen,'{\stars'); stars:=true end;
      cn:=gm_cn_f(m);
      write(OutScreen,'\p',x,',',MaxY-y,'){\ch',cn,'}');
      if comm<>'' then writeln(OutScreen,' % ',comm) else writeln(OutScreen);
     end;
    3: {PostScript}
     begin
      if m<=10 then
       write(OutScreen,x:5,' ',MaxY-y:6,r:4,' ',angle,' tstar')
      else
       if gm_star_full_mode=NormalPut then      {white ring around a star}
        write(OutScreen,x:5,' ',MaxY-y:6,r:4,' star')
       else                                     {merging circles}
        write(OutScreen,x:5,' ',MaxY-y:6,r:4,' cif');
      if comm<>'' then writeln(OutScreen,' % ',comm) else writeln(OutScreen);     end;
   end;
 end
end;

function VertCenter:word;
 var vc: word;
begin
 vc:=textheight('a') shr 2;
                                  if vc=0 then vc:=3;
                                   {fpk provisional}
 VertCenter:=vc;
end;


procedure gm_screentext(x,y:longint;
                     txt:string;
                     align:char;Xshift,Yshift:integer);

var textshift,j,jj: integer;
      ps_aux,ps_aux2:pointer;
      xcorr,ycorr,LRX,LRY:word; SiFig: word;
begin
 GetTextSettings(CurrStyle);
 case UpCase(align) of
  'L','1','2' : begin SetTextJustify(LeftText,CenterText); textshift:=1 end;
  'R' : begin SetTextJustify(RightText,CenterText); textshift:=-1 end;
  'C','W','O' : begin SetTextJustify(CenterText,CenterText); textshift:=0 end;
 end;
 if StereoColor then {to add the two color components so that red plus green
                      makes yellow}
  begin
   if CurrStyle.Direction=HorizDir then
    begin
     LRX:=textwidth(txt)+5*VertCenter;
     LRY:=textheight(txt)+5*VertCenter;
     xcorr:=(-(textshift-1)*textwidth(txt)) div 2;
     ycorr:= textheight(txt) div 2;
    end
   else
    begin
     LRY:=textwidth(txt);
     LRX:=textheight(txt);
     ycorr:=(-(textshift-1)*textwidth(txt)) div 2;
     xcorr:= textheight(txt) div 2;
    end;
   SiFig:= ImageSize(0,0,LRX,LRY);
   if SiFig<MaxAvail then
    begin
     GetMem(ps_aux,SiFig);
     GetImage(0,0,LRX,LRY,ps_aux^)
    end
   else
    begin
     gm_close;
     writeln(
'Sorry, not enough memory for storing a screen square to create a star image');
     halt;
    end;
   for j:=0 to lrx do for jj:=0 to lry do putpixel(j,jj,0);
  { rectangle(0,0,LRX,LRY); just for checking the bbox}
   outtextxy(xcorr,ycorr,txt);
   if SiFig<MaxAvail then
    begin
     GetMem(ps_aux2,SiFig);
     GetImage(0,0,LRX,LRY,ps_aux2^)
    end
   else
    begin
     gm_close;
     writeln('Sorry, not enough memory for storing the text');
     halt;
    end;
   PutImage(0,0,ps_aux^,NormalPut);
   if CurrStyle.Direction=HorizDir then
    PutImage((x+Xshift) div 16 +textshift -xcorr,
             (y+Yshift) div 16 - VertCenter - ycorr,
             ps_aux2^,OrPut)
   else
    PutImage((x+Xshift) div 16 - VertCenter -xcorr,
             (y+Yshift) div 16 + textshift -ycorr,
             ps_aux2^,OrPut);
   FreeMem(ps_aux2,SiFig);
   FreeMem(ps_aux,SiFig);
  end
 else
  if CurrStyle.Direction=HorizDir then
   outtextxy((x+Xshift) div 16 +textshift,(y+Yshift) div 16 - VertCenter,txt)
  else
   outtextxy((x+Xshift) div 16 - VertCenter,(y+Yshift) div 16 + textshift,txt);
 with CurrStyle do SetTextJustify(Horiz,Vert);
end;

procedure gm_outxtxy(x,y:longint;
                     t1,txt,t2:string;
                     align:char;angle:integer;Xshift,Yshift:integer);
 {align can be simply L, R, or C like in standard OutTextXY;
  L can be replaced by 1 or 2, what makes a difference in PS:
   1 clears a white rectangle for the text,
   2 serves for displaying a greek letter followed by standard text
     (in txt, the greek letter is coded by 2- or 3-letter abbrev.,
      and further text follows after a space; that space is deleted in
      output)
  C can be replaced by W, for having a white rectangle for the text in PS.
  t1 and t2 are ignored on screen, concatenated t1+txt+t2 in LaTeX,
    and making start and end of PostScript line; in this case,
    t1 containing ' S ' assumes first word of txt being a code for
    a greek letter.
  angle is ignored on the screen, but makes a rotated a co-ordinate system
    originating in x,y, for which Xshift and Yshift apply.
  }

var j: integer; found:boolean; txt2:string;
const greek: array[1..7,1..2] of string [3] = {Symb font pos. of PostScript}
     (('eta','h'),('ksi','x'),('phi','j'),('xi','c'),('psi','y'),
      ('the','q'),('ome','w'));
begin
 gm_screentext(x,y,txt,align,Xshift,Yshift);
 if GM_mode >0 then
 begin
  angle:=RoundUp(Bas_Int(angle,360));
  case GM_mode of
   1: begin end;  {hpgl not available}
   2:
    begin
     case align of
      'C','W','O': align:='c';
      'L','1','2': align:='l';
      'R' : align:='r';
     end;
     txt:=t1+txt+t2;
     if stars then begin writeln(OutScreen,'} '); stars:=false end;
     if angle<>0 then
      if Xshift=0 then
       writeln(OutScreen,'\p',x,',',MaxY-y,'){\r[',
             -angle,']{\m[',align,']{',                        txt,'}}}')
      else
       writeln(OutScreen,'\p',x,',',MaxY-y,'){\r[',
            -angle,']{\m[',align,']{\hspace{',SI(3,Xshift),'\un}',txt,'}}}')
     else
      if Xshift=0 then
       writeln(OutScreen,'\p',x,',',MaxY-y,'){'   ,
                     '\m[',align,']{',                        txt,'}}')
      else
       writeln(OutScreen,'\p',x,',',MaxY-y,'){',
                     '\m[',align,']{\hspace{',SI(3,Xshift),'\un}',txt,'}}')
    end;
   3:begin
      if txt[length(txt)]='\' then txt:=txt+' ';
         {this ensures that the ) ending the PS string will be valid}
      if align='2' then
       begin
        txt2:=copy(txt,pos(' ',txt)+1,length(txt)-pos(' ',txt));
        txt:=copy(txt,1,pos(' ',txt));
       end;
      if pos(' S ',__cvtstr(t1,_to_upcase_str))>0 then
       begin
        if align='2' then txt:=copy(txt,1,3);
        j:=1; found:=false;
        repeat
         if txt=greek[j,1] then
          begin txt:=greek[j,2]; found:=true end;
         inc(j);
        until found or (j>7);
        if not found then txt:=txt[1];
        if align='2' then txt:=txt+' ';
       end;
      case align of
       '2':
        writeln(OutScreen,t1,'(',txt2,') (',txt,') ',Xshift,' ',Yshift,' ',
              angle,' ',x,' ',MaxY-y,' trdl2',t2);
       '1':
       writeln(OutScreen,t1,x,' ',MaxY-y,' ',Xshift,' ',Yshift,' ',
              angle,' (',txt,') trdlw',t2);
      else
       writeln(OutScreen,t1,x,' ',MaxY-y,' ',Xshift,' ',Yshift,' ',
              angle,' (',txt,') trd'+align,t2)
      end
     end
  end
 end
end;

procedure gm_outxy(x,y:longint;txt:string;align:char;angle:integer);
                  {like preceding, but simpler}
begin
gm_screentext(x,y,txt,align,0,0);
if GM_mode >0 then {hpgl not available}
case GM_mode of
1: begin end;
2:
 begin
  case align of
   'C','W','O': align:='c';
   'L' : align:='l';
   'R' : align:='r';
  end;
  if align in ['W','O'] then align:='C';
  angle:=RoundUp(Bas_Int(angle,360));
  if stars then begin writeln(OutScreen,'} '); stars:=false end;
  if angle<>0 then
   writeln(OutScreen,'\p',x,',',MaxY-y,'){\r[',-angle,']{\m[',align,']{',txt,'}}}')
  else
   writeln(OutScreen,'\p',x,',',MaxY-y,'){'   ,       '\m[',align,']{',txt,'}}');
 end;
3: begin
      if txt[length(txt)]='\' then txt:=txt+' ';
         {this ensures that the ) ending the PS string will be valid}
      writeln(OutScreen,x,' ',MaxY-y,' 0 0 ',
              angle,' (',txt,') trd'+align)
   end;
end
end;

procedure gm_outtextxy(x,y:longint;txt:string);
                  {left aligned in files}
begin
gm_screentext(x,y,txt,'l',0,0);
if GM_mode >0 then {hpgl not available}
case GM_mode of
1: begin end;
2:
 begin
  if stars then begin writeln(OutScreen,'} '); stars:=false end;
   writeln(OutScreen,'\p',x,',',MaxY-y,'){'   ,       '\m[l]{',txt,'}}');
 end;
3: begin
      if txt[length(txt)]='\' then txt:=txt+' ';
         {this ensures that the ) ending the PS string will be valid}
      writeln(OutScreen,x,' ',MaxY-y,' (',txt,') t')
   end;
end
end;

procedure gm_close;
const
lfoot1=
'\end{picture}'          +cl+
'}'                      +cl;
lfoot2=
'\end{document}'         +cl;
pfoot=
'grestore' +cl+
'showpage' +cl+
'%%EOF' +cl;
begin
if (not gm_JustTrial) and (GM_mode >0) then
 begin
  case GM_mode of
  1: writeln(OutScreen,#27,'.Z', #27,'%0A'{, #27,'&l0O'});
      {end of plot, PCL mode, portrait orientation}
  2:
   begin
    if Stars then writeln(Outscreen,'}');
    writeln(outscreen,lfoot1);
    if GM_mode_ori=2 then
     writeln(outscreen,lfoot2);
   end;
  3: writeln(outscreen,pfoot);
  end;
  if GM_Mode>0 then close(OutScreen)
 end;
closegraph;
gm_open:=false;
end;

procedure gm_quit; {quits on any key, moreover closes graphic mode
                     (and output file) on q, Q, x, X, Esc or any special key}
begin
      if keypressed then
       begin
        c:=readkey;
        if UpCase(c) in ['Q','X',#27,#0] then gm_close
        else
         begin
          if GM_Mode>0 then close(OutScreen);
          if MaxColor>16 then SetRGBPalette(7,50,50,50);
           {this ensures visible DOS-prompt afterwards in 256 color modes}
         end;
        halt
       end;
end;

function gm_cquit(keyc:char):boolean; {like gm_quit, lest c=keyc in uppercase}
begin
 gm_cquit:=false;
 if keypressed then
  begin
   c:=readkey;
   if UpCase(c)=UpCase(keyc) then
    begin
     gm_cquit:=true;
     exit;
    end
   else
    begin
     if UpCase(c) in ['Q','X',#27,#0] then gm_close
     else
      begin
       if GM_Mode>0 then close(OutScreen);
       if MaxColor>16 then SetRGBPalette(7,50,50,50);
        {this ensures visible DOS-prompt afterwards in 256 color modes}
      end;
     halt
    end;
  end;
end;

procedure gm_comm(comm:string);   {adds a comment line to the output file}
begin
if GM_mode>1 then writeln(OutScreen,'% ',comm)
end;

procedure gm_verbatim(verb:string); {parses verbatim to the output file}
begin
if GM_mode>1 then write(OutScreen,verb)
end;

function gr_x(x:real):word;
begin
 if Reverse_X then
  gr_x:=gr_right-RoundUp(gr_hor*(x-X_min)/X_max_min)
 else
  gr_x:=gr_left+RoundUp(gr_hor*(x-X_min)/X_max_min)
end;

function gr_y(y:real):word;
begin
 if Reverse_Y then
  gr_y:=gr_top+RoundUp(gr_ver*(y-Y_min)/Y_max_min)
 else
  gr_y:=gr_bottom-RoundUp(gr_ver*(y-Y_min)/Y_max_min)
end;

procedure gr_frame(NameFig,NameX,NameY:string);
var s,step:real;  whole_log_step: integer; Bas_step,ia:byte;
    y, x: word; No_s, Dig_s:longint; div_str:string[7];

 procedure round_step(span:real); {rounds the step to 1,3,5,10,30,50,...}

  function log(x:real):real;
  begin log:=ln(x)/L10 end;

 var
  log_step : real;
  j: integer;
  deci_log_step: real;

 begin
  log_step:=log(span/11);
  whole_log_step:=trunc(log_step);
  deci_log_step:=frac(log_step);
  if(log_step)<0 then
    begin
     dec(whole_log_step);
     deci_log_step:=1+deci_log_step
    end;
  if deci_log_step<log(1.414)  then Bas_step:=1
  else if deci_log_step<log(3.16) then Bas_step:=3
       else if deci_log_step<log(7.07) then Bas_step:=5
            else Bas_step:=10;
  step:=Bas_step;
  if Bas_step=10 then begin Bas_step:=1; step:=1; inc(whole_log_step) end;
  if whole_log_step>0 then
   for j:=1 to whole_log_step do step:=step*10
  else if whole_log_step<0 then
   for j:= whole_log_step to -1 do step:=step/10;
 end;

 procedure Get_div_str;
 begin
  case whole_log_step of
   0: div_str:='';
   1..3: div_str:=
    ' /'+__cvtstr(SRe(5,0,step/Bas_step),_rem_lead_white_str);
   -2: div_str:=
    ' /'+__cvtstr(SRe(4,2,step/Bas_step),_rem_lead_white_str);
   -1: div_str:=
    ' /'+__cvtstr(SRe(3,1,step/Bas_step),_rem_lead_white_str);
   else div_str:=
    ' / 1E'+__cvtstr(SI(3,whole_log_step),_rem_lead_white_str);
  end;
 end;

begin
  gm_comm('Left and right Y-axis:');
  gm_line(gr_left,gr_top,gr_left,gr_bottom);
  gm_line(gr_right,gr_top,gr_right,gr_bottom);
  gm_comm('Top and bottom X-axis:');
  gm_line(gr_left,gr_top,gr_right,gr_top);
  gm_line(gr_left,gr_bottom,gr_right,gr_bottom);
  mark_l:=gr_ver div 100;

  if NameFig<>'' then
   begin
    gm_comm('Name of figure:');
    gm_outxy(MaxX-32,roundUp(0.8*TextH),NameFig,'r',0);
   end;

  if NameY<>'' then
   begin
    round_step(Y_max_min/YSide);
    No_s:=trunc(Y_min/step){+1};
    if No_s<0 then dec(No_s);
    s:=No_s*step;
    Dig_s:=No_s*Bas_step;
    gm_comm(cl+'% Marks at Y-axes:');
    while s<Y_max do
     begin
      if s>Y_min then
       begin
        y:=gr_y(s);
        if gr_through and (GM_mode<3) then
         gm_line(gr_left,y,gr_right,y)
        else
         begin
          gm_line(gr_left,y,gr_left+mark_l,y);
          gm_line(gr_right-mark_l,y,gr_right,y);
          if gr_through then
           begin
            if GM_mode=3 then gm_verbatim('gsave grgray'+cl);
            gm_line(gr_left+mark_l,y,gr_right-mark_l,y);
            if GM_mode=3 then gm_verbatim('grestore'+cl);
           end;
         end;
        gm_outxy(gr_left-16,y,__cvtstr(SI(6,Dig_s),_rem_lead_white_str),'r',0);
        {More Y Axes description inserted 2000-12-15:}
         if MoreYAxes then
          for ia:=1 to NumFYAxes do
           gm_outxy(gr_right+16,y+TextH*(ia-1),
            __cvtstr(SI(6,RoundUp(Dig_s/AYCoef[ia]-AYAddi[ia])),
            _rem_lead_white_str),'l',0);
       end;
      s:=s+step;
      inc(Dig_s,Bas_step);
     end;
    Get_div_str;
    gm_comm(cl+'% Description of Y-axis');
    if  gr_div_str_y<>'-' then
     gm_outxy(gr_left-TextH,gr_top-RoundUp(0.6*TextH),NameY+div_str,'l',0)
    else
     gm_outxy(gr_left-TextH,gr_top-RoundUp(0.6*TextH),NameY,'l',0);
    gr_div_str_y:=div_str;
   end;

  if NameX<>'' then
   begin
    round_step(X_max_min);
    if NameX[1]<>'-' then
     begin
      No_s:=trunc(X_min/step){+1};
      if No_s<0 then dec(No_s);
      s:=No_s*step;
      Dig_s:=No_s*Bas_step;
      gm_comm(cl+'% Marks at X-axes:');
      while s<X_max do
       begin
        if s>X_min then
         begin
        x:=gr_x(s);
        if gr_through and (GM_mode<3) then
         gm_line(x,gr_bottom,x,gr_top)
        else
         begin
          gm_line(x,gr_bottom-mark_l,x,gr_bottom);
          gm_line(x,gr_top,x,gr_top+mark_l);
          if gr_through then
           begin
            if GM_mode=3 then gm_verbatim('gsave grgray'+cl);
            gm_line(x,gr_bottom-mark_l,x,gr_top+mark_l);
            if GM_mode=3 then gm_verbatim('grestore'+cl);
           end;
         end;
        gm_outxy(x,gr_bottom+(TextH div 2),__cvtstr(SI(6,Dig_s),_rem_lead_white_str),'c',0);
         end;
        s:=s+step;
        inc(Dig_s,Bas_step);
       end;
     end
    else NameX:=copy(NameX,2,length(NameX)-1);
    Get_div_str;
    gm_comm(cl+'% Description of X-axis');
    if  gr_div_str_x<>'-' then
     gm_outxy(gr_right,MaxY-RoundUp(0.8*TextH),NameX+div_str,'r',0)
    else
     gm_outxy(gr_right,MaxY-RoundUp(0.8*TextH),NameX,'r',0);
    gr_div_str_x:=div_str;
    DekExpX:=exp(Whole_log_step*L10);
   end; {of X-axis and whole gr_frame}
end;

begin
 count_b:=count_o+count_f;
 ln1dmag:=ln(1.047129);
 gm_setVstep(diam0);
 for j:=1 to 2*NumStarRad do ps[j]:=nil;
 FillChar(star_radius,NumStarRad,0);
end.