home *** CD-ROM | disk | FTP | other *** search
/ GEMini Atari / GEMini_Atari_CD-ROM_Walnut_Creek_December_1993.iso / files / astronmy / astro / astronmy.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1985-11-20  |  30.7 KB  |  762 lines
  1.  
  2.  
  3.                   {     A S T R O N M Y . P A S     }
  4.  
  5.  
  6. {This is the main program for the aSTronomer. It contains the program shell,
  7.  and all the support subroutines for the main menu. As it compiles, it calls
  8.  6 include files, three of which are for GEM, 2 for the main menu choice, ie.
  9.  ALMANAC.PAS, SKY_PLOT.PAS, and 1 resource include file, ASTRONMY.I.}
  10.  
  11.                 { Last Modifications: February 20, 1987 }
  12.  
  13. {Thanks go to Darek Mihocka, (even though he tried to make me 'C' the light),
  14.  and Carmine Caccioppoli for the ideas they gave throughout the programming of
  15.  this piece of software.}
  16.  
  17.  
  18.  
  19. Program Astronomy (input, output, infile, outfile, i2, i3, i4) ;
  20.  
  21.  
  22. const
  23.  
  24.    {$I GEMCONST.PAS}
  25.    {$I ASTRONMY.I}
  26.    pi    = 3.14159265359 ;                {standard constants for calculations}
  27.    twopi = 6.283185307 ;
  28.    rad   = 57.29577951 ;
  29.    stars = 1573 ;                           {number of stars in large database}
  30.    n_star = 166 ;                      {number of stars in small star database}
  31.    n_objects   = 9 ;      {number of objects in planet and comet database file}
  32.  
  33.  
  34. type
  35.    {$I GEMTYPE.PAS}
  36.    fullstr  = string[255] ;                            {full sized string type}
  37.    s_system = array [1..n_objects] of real ;                {solar system data}
  38.  
  39.  
  40. var
  41.  
  42.    outfile             : text ;    {screen/printer/nul IO redirection variable}
  43.  
  44.    Astronomy_Menu        : Menu_Ptr ;                     {main menu variables}
  45.    astron_dial,dial_init : Dialog_Ptr ;        {initial and desk info variable}
  46.  
  47.    c, p                : integer ;                   {planet and comet numbers}
  48.  
  49.    prompt,editfld      : fullstr ;                         {dialog strings and}
  50.    w_name,d_str,values : fullstr ;                                {window name}
  51.  
  52.    what_event          : integer;                       {event returned by gem}
  53.    resolution          : integer  ;
  54.    a                   : integer ;                    {for single letter input}
  55.  
  56.    fullwindow          : integer ;                {window management variables}
  57.    fw_x,fw_y,fw_w,fw_h : integer ;
  58.    unletter            : integer ;
  59.    dummy               : integer ;           {dummy variable for event handler}
  60.    msg                 : Message_Buffer ;             {buffer for gem messages}
  61.  
  62.    scrnwhite, did_current : boolean ;   {flags for scrn color (white or black)}
  63.    scrncol, txtcol : integer ;                         {colors for screen, txt}
  64.                                                               {default strings}
  65.    tempstr, latitude_str, longitude_str, date_str, time_str, device : fullstr ;
  66.    printouts           : boolean ;
  67.  
  68.    tp,ep,om,ee,ax      : s_system ;                               {planet data}
  69.    ii,no,th,bb         : s_system ;
  70.  
  71.    c_pe,c_pl,c_no,c_tp : s_system ;                                {comet data}
  72.    c_ee,c_ii,c_aa      : s_system ;
  73.  
  74.    planet              : array [1..n_objects] of fullstr ; {planet/comet names}
  75.    comet               : array [1..n_objects] of fullstr ;
  76.  
  77.    sright              : array [1..n_star] of real ;          {star RA and Dec}
  78.    sdecl               : array [1..n_star] of real ;
  79.  
  80.    right, decl    : array [1..19]  of real ;   {data arrays for plotting needs}
  81.    alts, azim     : array [1..19]  of integer ;
  82.    salts, sazim   : array [1..166] of integer ;
  83.    obname         : array [1..19]  of fullstr ;
  84.  
  85.    s_ra,s_de,s_mag     : array [1..stars] of real ;  {large database of stars,}
  86.             {includes RA, Dec and magnitudes for the detailed Star Atlas plot.}
  87.  
  88.    h, m, s, rh, rm, rs, dh, dm, ds        : integer ; {HMS variables for time,}
  89.                                                            {RA and declination}
  90.    day, month, year                       : integer ;      {variables for date}
  91.  
  92.    dday, dd, la, be, RA_0, Dec_0, t_univ : real ;    {variables for days since}
  93.    RA, Dec, epsilon, latitude, longitude : real ; {1980, RA, dec, latitude,etc}
  94.  
  95.  
  96. {$I GEMSUBS.PAS}
  97.  
  98.  
  99. function Val (Snumber : string) : real ;   {turn a string into a real number!!}
  100.                                            {Personal Pascal should have this!!}
  101. var
  102.    number  : real ;                      {number that is converted from string}
  103.    x,z,y   : integer ;                  {variables for positions inside string}
  104.    neg     : integer ;                                   {negative number flag}
  105.    ten     : real ;            {factor to multiply each component of string by}
  106.    c,d     : fullstr ;                                      {temporary strings}
  107.  
  108. begin
  109.    number := 0 ;                                {original value of string is 0}
  110.    ten    := 1.0 ;                                      {multiplication factor}
  111.    c      := Copy (Snumber,1,1) ;             {check to see if number negative}
  112.    if c = '-' then begin
  113.       neg := -1 ;                                             {negative factor}
  114.       Delete (Snumber,1,1) ;
  115.    end
  116.    else neg := 1 ;                                            {positive factor}
  117.    y      := Pos ('.',Snumber) ;               {find location of decimal point}
  118.    if y = 0 then y := length (Snumber) + 1 ;           {calculate integer part}
  119.    for x := (y-1) downto 1 do begin
  120.       number := number + (ord (Snumber [x])-48) * ten ;
  121.       ten := ten * 10 ;                 {increment multiplication factor by 10}
  122.    end;
  123.    ten := 0.1;                                      {calculate fractional part}
  124.    z   := Pos ('E',Snumber) ;       {find location of exponent if there at all}
  125.    if z = 0 then z := length (Snumber) + 1 ;
  126.    if y < (length(Snumber)) then  begin                    {do fractional part}
  127.       for x := (y+1) to (z-1) do begin
  128.          number := number + (ord (Snumber [x])-48) * ten ;
  129.          ten := ten / 10 ;              {decrease mulitiplication factor by 10}
  130.       end ;
  131.       if z < length(Snumber) then begin                    {calculate exponent}
  132.          c := Copy (Snumber,z+1,1) ;                 {get +/- sign of exponent}
  133.          d := Copy (Snumber,z+2,2) ;                             {get exponent}
  134.          y := round (Val(d)) ;
  135.          if c = '-' then for x:= 1 to y do number := number / 10.0
  136.          else for x:= 1 to y do number := number * 10.0 ;     {calculate value}
  137.      end ;                                                          {of string}
  138.    end ;
  139.    number := number * neg ;       {make number negative if string was negative}
  140.    Val := number;               {return the value of the string back to Pascal}
  141. end ;  {Val}
  142.  
  143.  
  144. procedure itoa (x : integer; var s : string) ;      {convert integer to string}
  145.               {pass to it an integer, and the string for it to be converted to}
  146.  
  147. var
  148.    c        : integer ;                                               {counter}
  149.    ten      : integer ;                                      {division counter}
  150.    negative : boolean ;                                         {negative flag}
  151.  
  152. begin
  153.    if x = 0 then s := '0' else begin                               {check if 0}
  154.       if x < 0 then negative := TRUE else negative := FALSE ;    {check if neg}
  155.       x := abs (x) ;                                   {make sure its positive}
  156.       s := '     ' ;                         {initialize string,factor,counter}
  157.       ten := 10000 ;
  158.       c := 1 ;
  159.       while (ten <> 0) do begin                                 {do conversion}
  160.          s[c] := chr ( (x div ten) + 48) ;
  161.          c := c + 1 ;
  162.          x := x mod ten ;
  163.          ten := ten div 10 ;
  164.       end ;
  165.       while s[1] = '0' do Delete (s,1,1) ;               {remove leading zeros}
  166.       while s[1] = ' ' do Delete (s,1,1) ;              {remove leading spaces}
  167.       if negative then s := Concat ('-',s) ;           {add neg sign if needed}
  168.    end ;
  169. end ;  {itoa}
  170.  
  171.  
  172. procedure read_stars ;           {read in star data and convert to real values}
  173.  
  174. var
  175.    infile            : text ;                                   {file variable}
  176.    x                 : integer ;                      {counter for data arrays}
  177.    s                 : fullstr ;       {input string to be converted into real}
  178.  
  179. begin
  180.    x:= 1 ;
  181.    reset (infile,'ASTRONOM.Y\CONST.DAT') ;
  182.    while not eof (infile) do begin
  183.       readln (infile,s) ; sright[x] := Val (s) ;
  184.       readln (infile,s) ; sdecl [x] := Val (s) ;
  185.       x := x + 1 ;
  186.    end ;
  187.    close (infile) ;
  188. end ;  {read_stars}
  189.  
  190.  
  191. procedure read_com ;            {read in comet data and convert to real values}
  192.  
  193. var
  194.    infile            : text ;                                   {file variable}
  195.    x                 : integer ;                      {counter for data arrays}
  196.    s                 : fullstr ;       {input string to be converted into real}
  197.  
  198. begin
  199.    x:= 1 ;
  200.    reset (infile,'ASTRONOM.Y\COMETS.DAT') ;
  201.    while not eof (infile) do begin
  202.       readln (infile, comet[x]) ;
  203.       readln (infile,s) ; c_pe[x] := Val (s) ;
  204.       readln (infile,s) ; c_pl[x] := Val (s) ;
  205.       readln (infile,s) ; c_no[x] := Val (s) ;
  206.       readln (infile,s) ; c_tp[x] := Val (s) ;
  207.       readln (infile,s) ; c_aa[x] := Val (s) ;
  208.       readln (infile,s) ; c_ee[x] := Val (s) ;
  209.       readln (infile,s) ; c_ii[x] := Val (s) ;
  210.       x := x + 1 ;
  211.    end ;
  212.    close (infile) ;
  213. end ;  {read_com}
  214.  
  215.  
  216. procedure read_pln ;           {read in planet data and convert to read values}
  217.  
  218. var
  219.    infile            : text ;                                   {file variable}
  220.    x                 : integer ;                      {counter for data arrays}
  221.    s                 : fullstr ;       {input string to be converted into real}
  222.  
  223. begin
  224.    x:= 1 ;
  225.    reset (infile,'ASTRONOM.Y\PLANETS.DAT') ;
  226.    while not eof (infile) do begin
  227.       readln (infile, planet[x]) ;
  228.       readln (infile,s) ; tp[x] := Val (s) ;
  229.       readln (infile,s) ; ep[x] := pi / 180.0 * Val (s) ;        {do degree to}
  230.       readln (infile,s) ; om[x] := pi / 180.0 * Val (s) ;  {radian conversions}
  231.       readln (infile,s) ; ee[x] := Val (s) ;
  232.       readln (infile,s) ; ax[x] := Val (s) ;
  233.       readln (infile,s) ; ii[x] := pi / 180.0 * Val (s) ;
  234.       readln (infile,s) ; no[x] := pi / 180.0 * Val (s) ;
  235.       readln (infile,s) ; th[x] := pi / 180.0 * Val (s) ;
  236.       readln (infile,s) ; bb[x] := Val (s) ;
  237.       x := x + 1 ;
  238.    end ;
  239.    close (infile) ;
  240. end ;  {read_pln}
  241.  
  242.  
  243. procedure r_star_data ;        {read in large star database (over 1500 stars!)}
  244.                                {and convert strings to read numbers as read in}
  245.  
  246. var
  247.    infile       : text ;                                        {file variable}
  248.    a            : string ;             {input strings to be converted to reals}
  249.    x            : integer ;                            {counter for data array}
  250.  
  251.    function conra (s:string) : real ;      {convert RA string to a real number}
  252.                                                          {string in form HHMMD}
  253.    var
  254.       a,b,c : string ;
  255.       d,e,f : real ;
  256.  
  257.    begin
  258.       a := Copy (s,1,2) ;                 {parse string to get required values}
  259.       b := Copy (s,3,2) ;
  260.       c := Copy (s,5,1) ;
  261.       d := Val (a) ;
  262.       e := Val (b) ;
  263.       f := Val (c) ;
  264.       conra := d + (e + f/10) / 60 ;                   {convert to real number}
  265.    end ;  {conra}
  266.  
  267.  
  268.    function conde (s:string) : real ;     {convert Dec string to a real number}
  269.                                                          {string in form -DDMM}
  270.    var
  271.       a,b,c : string ;
  272.       d,e,f : real ;
  273.  
  274.    begin
  275.       c := Copy (s,1,1) ;                 {parse string to get required values}
  276.       a := Copy (s,2,2) ;
  277.       b := Copy (s,4,2) ;
  278.       d := Val (a) ;
  279.       e := Val (b) ;
  280.       f := d + e / 60 ;
  281.       if c = '-' then conde := -f else conde := f ;    {convert to real number}
  282.    end ;  {conde}
  283.  
  284.  
  285. begin
  286.    reset (infile,'ASTRONOM.Y\S_RA.DAT') ;                            {RA file}
  287.    for x := 1 to stars do begin
  288.       readln (infile,a) ;
  289.       s_ra [x]   := conra (a) ;                          {convert string to RA}
  290.    end ;
  291.    close (infile) ;
  292.    reset (infile,'ASTRONOM.Y\S_DE.DAT') ;                   {Declination file}
  293.    for x := 1 to stars do begin
  294.       readln (infile,a) ;
  295.       s_de [x]   := conde (a) ;                         {convert string to Dec}
  296.    end ;
  297.    close (infile) ;
  298.    reset (infile,'ASTRONOM.Y\S_MAG.DAT') ;                    {Magnitude file}
  299.    for x := 1 to stars do begin
  300.       readln (infile,a) ;
  301.       s_mag [x]  := Val (a) ;
  302.    end ;
  303.    close (infile) ;
  304. end ;  {r_star_data}
  305.  
  306.  
  307. function Get_Rez : integer ;                            {get screen resolution}
  308.    XBIOS (4) ;
  309.  
  310.  
  311. function gettime : integer ;                              {get the system time}
  312.    GEMDOS ($2C) ;
  313.  
  314.  
  315. function getdate : integer ;                              {get the system date}
  316.    GEMDOS ($2A) ;
  317.  
  318.  
  319. procedure system_time (var s : string) ;          {get system time into string}
  320.  
  321. var
  322.    h,m,a        : integer ;              {temporary variables for hour, minute}
  323.    s_h,s_m      : string ;                       {temporary string equivalents}
  324.  
  325.  
  326. begin
  327.    a  := gettime ;                                            {get system time}
  328.    h  := ShR ( (a & $F800),11) ;                           {get hr bit pattern}
  329.    m  := ShR ( (a & $07E0), 5) ;                          {get min bit pattern}
  330.    itoa (h,s_h) ;    if h < 10 then s_h := Concat ('0',s_h) ;  {convert to str}
  331.    itoa (m,s_m) ;    if m < 10 then s_m := Concat ('0',s_m) ;
  332.    s  := Concat (s_h,s_m) ;
  333. end ;  {system_date}
  334.  
  335.  
  336. procedure system_date (var s : string) ;          {get system date into string}
  337.  
  338. var
  339.    y,m,d,a      : integer ;          {temporary variables for year, month, day}
  340.    s_y,s_m,s_d  : string ;                       {temporary string equivalents}
  341.  
  342.  
  343. begin
  344.    a  := getdate ;                                            {get system date}
  345.    y  := ShR ( (a & $FE00),9) + 1980 ;                   {get date bit pattern}
  346.    m  := ShR ( (a & $01E0),5) ;                         {get month bit pattern}
  347.    d  := a & $001F ;                                      {get day bit pattern}
  348.    itoa (y,s_y) ;                 {convert to a string for default date string}
  349.    itoa (m,s_m) ;    if m < 10 then s_m := Concat ('0',s_m) ;
  350.    itoa (d,s_d) ;    if d < 10 then s_d := Concat ('0',s_d) ;
  351.    s  := Concat (s_y,s_m,s_d) ;
  352. end ;  {system_date}
  353.  
  354.  
  355. function setprt (x : integer) : integer ;   {set/get the printer configuration}
  356.    XBIOS (33) ;
  357.  
  358.  
  359. function bconin (dev : integer) : integer ;            {single character input}
  360.    BIOS (2) ;
  361.  
  362.  
  363. procedure Curs_Off ;                                          {turn off cursor}
  364.  
  365. begin
  366.    write (output, chr(27), 'f') ;                               {VT-52 command}
  367. end ;  {Curs_Off}
  368.  
  369.  
  370. procedure PrintAt (x : integer; y : integer);          {position cursor at x,y}
  371.  
  372. var
  373.    esc : char;                                    {ASCII esc character code 27}
  374.  
  375. begin
  376.    esc := chr (27);                                      {the escape character}
  377.    write (output, esc, 'Y', chr(x+32), chr(y+32));         {use VT-52 emulator}
  378. end;     {PrintAt}
  379.  
  380.  
  381. procedure Button_Key ;        {Gem function to check keyboard and mouse button}
  382.  
  383. begin
  384.    what_event := Get_Event (E_Button | E_Message | E_Keyboard,
  385.                             1,0,1,0,False,0,0,0,0,
  386.                             False,0,0,0,0,msg,unletter,dummy,
  387.                             dummy,dummy,dummy,dummy);
  388. end;  {Button_Key}
  389.  
  390.  
  391. procedure Event (what_kind : integer);                  {general event manager}
  392.  
  393. begin
  394.    what_event := Get_Event (what_kind,0,0,0,0,False,0,0,0,0,
  395.                             False,0,0,0,0,msg,dummy,dummy,
  396.                             dummy,dummy,dummy,dummy);
  397. end;  {Event}
  398.  
  399.  
  400. function Multi_Dial (pr,ed,va : string ; var d_str : string) : boolean ;
  401.  
  402. {sets up a standard dialog box with one prompt and edit field; returns true if
  403. OK is selected, false if Cancel is selected; d_str is modified by this routine}
  404.  
  405. var
  406.    d_dialog : Dialog_Ptr ;
  407.    d_title, d_item, d_ok, d_cancel, button : integer ;
  408.    s_str    : fullstr ;
  409.  
  410. begin
  411.    d_dialog  := New_Dialog (4,0,0,30,8);
  412.    d_title   := Add_DItem (d_dialog, G_String, None, 2,1,0,0,0,0);
  413.    Set_DText (d_dialog, d_title, pr, System_Font, TE_Left);
  414.    d_item    := Add_DItem (d_dialog, G_FText, None, 2,3,26,1,0,$1180);
  415.    Set_DEdit (d_dialog, d_item, ed, va, d_str, System_Font,TE_Center);
  416.                                     {set up the edit portion of the dialog box}
  417.    d_ok      := Add_DItem (d_dialog,G_Button,Selectable|Default|Exit_Btn,
  418.              3,5,8,2,2,$1180);                  {make OK the default choice!!!}
  419.    Set_DText (d_dialog,d_ok,'OK',System_Font,TE_Center);
  420.    d_cancel  := Add_DItem (d_dialog,G_Button,Selectable|Exit_Btn,
  421.              19,5,8,2,2,$1180);                       {standard dialog button!}
  422.    Set_DText (d_dialog,d_cancel,'Cancel',System_Font,TE_Center);
  423.    Center_Dialog (d_dialog);
  424.    Show_Mouse;
  425.    button    := Do_Dialog (d_dialog,d_item);
  426.    if button <>d_cancel then begin
  427.       Get_DEdit(d_dialog,d_item,s_str) ;                       {get new string}
  428.       if length (s_str) = length (d_str) then d_str := s_str ;   {check if new}
  429.    end ;                                  {string is same length as old string}
  430.    Hide_Mouse ;                               {if yes, replace old with new!!!}
  431.    End_Dialog    (d_dialog) ;
  432.    Delete_Dialog (d_dialog) ;
  433.    if button = d_ok then Multi_Dial := True else Multi_Dial := False ;
  434. end ;  {Multi_Dial}
  435.  
  436.  
  437. procedure wind_open (windtitle: Window_Title) ;     {do necessary procedures to
  438.                                             open a full screen graphics window}
  439.  
  440. begin
  441.    fullwindow := New_Window (g_Name | G_Close,windtitle,0,0,0,0) ;
  442.    Open_Window (fullwindow,0,0,0,0) ;               {open full graphics window}
  443.    Set_Window  (fullwindow) ;                       {make it window for output}
  444.    Work_Rect (fullwindow,fw_x,fw_y,fw_w,fw_h) ;    {find limits of work screen}
  445.    Set_Clip (fw_x,fw_y,fw_w,fw_h) ;                       {set clipping values}
  446.    Paint_Style (1) ;  Paint_Color (white) ;
  447.    Paint_Rect (0,0,fw_w,fw_h) ;                {paint interior of window white}
  448. end ;  {wind_open}                               {in other words, clear screen}
  449.  
  450.  
  451. procedure wind_close ;        {procedure to close the previously opened window}
  452.  
  453. begin
  454.    Text_Style (Thickened) ;        {choose bold face for close window message!}
  455.    if resolution = 2 then Text_Color (txtcol) else Text_Color (Red) ;
  456.    Draw_String (158, (fw_h - 4),            {red in med res, black in high res}
  457.        ' Click Window Closed to Return to Menu ...  ') ;
  458.    Show_Mouse ;                            {allow mouse to click window closed}
  459.    while (msg[0]<>WM_Closed) do Button_Key ; {wait until window closed message}
  460.    Hide_Mouse ;
  461.    Close_Window (fullwindow) ;            {close and remove window from screen}
  462.    Delete_Window (fullwindow) ;
  463.    if not scrnwhite then write (chr(27),'q') ;        {reset text screen color}
  464. end ;  {wind_close}
  465.  
  466.  
  467. procedure Clearxy  ;                               {clear main window to color}
  468.  
  469. begin
  470.    Paint_Style (1) ; Draw_Mode (2) ; Line_Style (1) ;  {set up graphics attrib}
  471.    Line_Color (txtcol) ; Text_Color (txtcol) ;          {set up txt/line color}
  472.    Paint_Color (scrncol) ;   {choose color interior and paint the window color}
  473.    Paint_Rect (0,0,fw_w,fw_h) ;
  474.    if not scrnwhite then write (chr(27),'p') ;       {set up text screen color}
  475. end ;  {Clearxy}
  476.  
  477.  
  478. procedure Init_Astronomy_Menu ;                          {initialize main menu}
  479.  
  480. var ok : boolean ;
  481.  
  482. begin
  483.    ok := Load_Resource ('ASTRONMY.RSC') ;                 {set up object trees}
  484.    Find_Menu   (MAINMENU,Astronomy_Menu) ;
  485.    Find_Dialog (ASTROINF,astron_dial) ;
  486.    Set_Mouse (M_Arrow) ;
  487.    Menu_Check (Astronomy_Menu,WHITSCRN,TRUE) ;                  {set checkmark}
  488.    Hide_Mouse ;                                       {hide mouse until needed}
  489. end;     {Init_Astronomy_Menu}
  490.  
  491.  
  492. procedure About_The_Desktop_Astronomer;                   {desktop information}
  493.  
  494. var
  495.    ok   : integer ;                    {dummy variable for dialog box function}
  496.  
  497. begin
  498.    Show_Mouse ;
  499.    Obj_SetState (astron_dial, INF_BUTN, Normal, False) ;
  500.    Center_Dialog (astron_dial) ;
  501.    ok := Do_Dialog (astron_dial,0) ;
  502.    End_Dialog (astron_dial) ;
  503.    Hide_Mouse ;
  504. end ;  {About_The_Desktop_Astronomer}
  505.  
  506.  
  507.  
  508. function OK_to_Quit (choice : integer) : integer ;       {verify if OK to quit}
  509.           {Aye means yes, Nay means no (close to what Sulu would say to Kirk!!}
  510. var
  511.    ok : integer ; {variable for alert box function, corresponding to yes or no}
  512.  
  513. begin
  514.    ok := Do_Alert
  515. ('[3][ Get us out of orbit  | Mr. Sulu. Ahead warp | factor 1.][ Aye | Nay ]'
  516.                  ,2);
  517.    if ok = 2 then OK_to_Quit := 0 else Ok_to_Quit := choice; {set up quit flag}
  518. end ;  {OK_to_Quit}
  519.  
  520.  
  521. {$I ALMANAC.PAS}                       {sky plot support, and its menu choices}
  522. {$I SKY_PLOT.PAS}
  523.  
  524.  
  525. procedure Do_Print ;                      {do the printout options menu choice}
  526.  
  527. begin
  528.    if printouts = TRUE then begin                        {check printouts flag}
  529.       Menu_Check (Astronomy_Menu,PRNT_OUT,FALSE) ;        {remove checkmark on}
  530.       printouts := FALSE ;                                   {menu, reset flag}
  531.       device := 'CON:' ;                               {reset device to screen}
  532.    end
  533.    else begin
  534.       Menu_Check (Astronomy_Menu,PRNT_OUT,TRUE) ;       {set checkmark on menu}
  535.       printouts := TRUE ;                                         {set flag on}
  536.       device := 'PRN:' ;                                {set device to printer}
  537.    end ;
  538. end ;  {Do_Print}
  539.  
  540.  
  541. procedure Do_White ;                      {do the printout options menu choice}
  542.  
  543. var txt : string[255] ;
  544.  
  545. begin
  546.    if scrnwhite = TRUE then begin                            {check color flag}
  547.       Menu_Check (Astronomy_Menu,WHITSCRN,FALSE) ;           {remove checkmark}
  548.       scrnwhite := FALSE ;                                         {reset flag}
  549.       scrncol := black ; txtcol := white ;                       {reset colors}
  550.    end
  551.    else begin
  552.       Menu_Check (Astronomy_Menu,WHITSCRN,TRUE) ;               {set checkmark}
  553.       scrnwhite := TRUE ;                                          {reset flag}
  554.       scrncol := white ; txtcol := black ;                       {reset colors}
  555.    end ;
  556. end ;  {Do_White}
  557.  
  558.  
  559. procedure Do_Setup ;                         {set up the printer configuration}
  560.  
  561. var
  562.    x,a,b,c,d,e,f : integer ;     {variables for bits in the printer config var}
  563.    w             : Window_Title ;                      {name of window to open}
  564.  
  565. begin
  566.    x := setprt (-1) ;                              {get current printer config}
  567.    a := (x & 1) ;                                   {dot matrix or daisy wheel}
  568.    b := (x & 4) div 4 ;                                {Atari or Epson printer}
  569.    c := (x & 8) div 8 ;                                   {draft or final mode}
  570.    d := (x & 16) div 16 ;                             {Parallel or Serial Port}
  571.    e := (x & 32) div 32 ;                           {form or single sheet feed}
  572.    f := (x & 2) div 2 ;                               {monochrome device/color}
  573.    a := Do_Alert (                 {get new information or default to original}
  574. '[0][       Type of printer?       ][  Dot  | Daisy ]',(a+1)) - 1 ;
  575.    if a = 0 then b := Do_Alert (
  576. '[0][    Which make of printer?    ][ Atari | Epson ]',(b+1)) - 1 ;
  577.    c := Do_Alert (
  578. '[0][     Which printing mode?     ][ Draft | Final ]',(c+1)) - 1 ;
  579.    d := Do_Alert (
  580. '[0][         Which  Port?         ][ Parallel | Serial ]',(d+1)) - 1 ;
  581.    e := Do_Alert (
  582. '[0][    Type of paper feeding?    ][  Form  | Single ]',(e+1)) - 1 ;
  583.  
  584.    x := a + (f*2) + (b*4)+ (c*8)+ (d*16)+ (e*32) ;    {calculate new parameter}
  585.  
  586.    x := setprt (x) ;                               {set the port with new data}
  587.    w := ' Current Printer Status ' ;                       {open output window}
  588.    wind_open (w) ;
  589.    PrintAt (6,20) ;
  590.    writeln (output,'Printer Status is:') ;   {output the new status of printer}
  591.    PrintAt (10,20) ;
  592.    if a = 0 then writeln (output,'Dot Matrix Printer')
  593.    else writeln (output,'Daisy Wheel Printer') ;
  594.    PrintAt (12,20) ;
  595.    if b = 0 then writeln (output,'Atari Printer')
  596.    else writeln (output,'Epson Printer') ;
  597.    PrintAt (14,20) ;
  598.    if c = 0 then writeln (output,'Draft Mode Printing')
  599.    else writeln (output,'Final Mode Printing') ;
  600.    PrintAt (16,20) ;
  601.    if d = 0 then writeln (output,'Parallel Printer Port')
  602.    else writeln (output,'Serial (RS 232) Port') ;
  603.    PrintAt (18,20) ;
  604.    if e = 0 then writeln (output,'Form Feeding')
  605.    else writeln (output,'Single Sheet Feeding') ;
  606.    wind_close ;
  607. end ;  {Do_Setup}
  608.  
  609.  
  610. procedure Do_Help ;                                         {display help file}
  611.  
  612. var
  613.    infile : text ;                                              {file variable}
  614.    x      : integer ;                                {current line to print on}
  615.    s      : fullstr ;                                            {input string}
  616.    w_name : Window_Title ;                              {name of output window}
  617.  
  618. begin
  619.    w_name := '  Help Window  ' ;                     {open a new output window}
  620.    wind_open (w_name) ;
  621.    reset (infile,'ASTRONOM.Y\HELP.DOC') ;          {open file and read from it}
  622.    x := 3 ;                                         {start at line 3 on screen}
  623.    while not eof (infile) do begin
  624.       readln (infile,s) ;                              {read line of help text}
  625.       PrintAt (x,5) ;
  626.       write  (output,s) ;                           {print help text on screen}
  627.       x := x + 1 ;
  628.    end ;
  629.    wind_close ;
  630. end ;  {Do_Help}
  631.  
  632.  
  633. procedure Do_Location (menu : integer) ;     {change the latitude or longitude}
  634.  
  635. var
  636.    ok   : boolean ;       {determines if latitude/longitude chosen or canceled}
  637.  
  638. begin
  639.    did_current := FALSE ;
  640.    if menu = LATITUD then begin
  641.       prompt := 'Please enter the latitude:' ;
  642.       editfld := '__ d __ '' __ " _ ' ;
  643.       values := '999999A' ;
  644.       ok := Multi_Dial (prompt,editfld,values,latitude_str); {get new latitude}
  645.    end
  646.    else begin
  647.       prompt := 'Please enter the longitude:' ;
  648.       editfld := '___ d __ '' __ " _ ' ;
  649.       values := '9999999A' ;
  650.       ok := Multi_Dial(prompt,editfld,values,longitude_str);{get new longitude}
  651.    end ;
  652. end ;  {Do_Location}
  653.  
  654.  
  655. procedure Do_Clock (menu : integer) ;             {change the date or the time}
  656.  
  657. var
  658.    ok   : boolean ;              {determines if date/time is changed or cancel}
  659.  
  660. begin
  661.    did_current := FALSE ;
  662.    if menu = DATE then begin
  663.       prompt := 'Please enter the date:' ;
  664.       editfld := 'Y: ____  M: __  D: __ ' ;
  665.       values := '99999999' ;
  666.       ok := Multi_Dial (prompt,editfld,values,date_str) ;        {get new date}
  667.    end
  668.    else begin
  669.       prompt := 'Please enter time (U.T.):' ;
  670.       editfld := '__ h  __ m' ;
  671.       values := '9999' ;
  672.       ok := Multi_Dial (prompt,editfld,values,time_str) ;        {get new time}
  673.    end ;
  674. end ;  {Do_Clock}
  675.  
  676.  
  677. procedure Do_The_Menu ;                                      {do the main menu}
  678.  
  679. var
  680.    choice1 : integer ;                                       {main menu choice}
  681.    choice2 : integer ;                                  {pull down menu choice}
  682.  
  683. begin
  684.    Draw_Menu (Astronomy_Menu) ;                  {Display and freeze main menu}
  685.    Erase_Menu (Astronomy_Menu) ;
  686.    About_The_Desktop_Astronomer ;                  {display info on program!!!}
  687.    repeat
  688.       Draw_Menu (Astronomy_Menu) ;
  689.       Show_Mouse ;
  690.       Event (E_Message) ;                   {wait for a menu item to be chosen}
  691.       Hide_Mouse ;
  692.       Erase_Menu (Astronomy_Menu) ;
  693.  
  694.       choice1 := msg[3] ;                         {which menu choice is chosen}
  695.       choice2 := msg[4] ;                         {which pull down menu chosen}
  696.  
  697.       case choice1 of                                               {do choice}
  698.          DESK_INF : About_The_Desktop_Astronomer ;
  699.          ALMANAC  : Do_Sky_Plot (choice2) ;
  700.          OPTIONS  : case choice2 of
  701.                        PRNT_OUT : Do_Print ;
  702.                        SET_PRNT : Do_Setup ;
  703.                        WHITSCRN : Do_White ;
  704.                        HELP     : Do_Help ;
  705.                        QUIT     : choice2 := OK_to_Quit (choice2) ;
  706.                     end ;                                        {case choice2}
  707.          LOCATION : Do_Location (choice2) ;
  708.          CLOCK    : Do_Clock    (choice2) ;
  709.       end ;
  710.  
  711.       Menu_Normal (Astronomy_Menu,DESK_INF) ;            {return the main menu}
  712.       Menu_Normal (Astronomy_Menu,ALMANAC) ;                        {to normal}
  713.       Menu_Normal (Astronomy_Menu,OPTIONS) ;
  714.       Menu_Normal (Astronomy_Menu,LOCATION) ;
  715.       Menu_Normal (Astronomy_Menu,CLOCK) ;
  716.  
  717.    until choice2 = QUIT ;
  718.    Delete_Menu (Astronomy_Menu) ;                    {allow restoration of Gem}
  719.    Show_Mouse ;                                  {make sure mouse is on at end}
  720. end ;  {Do_The_Menu}
  721.  
  722.  
  723. begin                                                                {mainline}
  724.  
  725.    resolution := Get_Rez ;             {find out what resolution program is in}
  726.    if resolution = 0 then begin
  727.       Clear_Screen ;                     {don't allow use of low resolution!!!}
  728.       Curs_Off ;                                          {turn off any cursor}
  729.       PrintAt (10,0) ;                               {output error message!!!!}
  730.       writeln (output,'Use medium or high resolution PLEASE!') ;
  731.       write   (output,'Please press any key ... ') ;
  732.       a := bconin (2) ;                                       {get a character}
  733.    end
  734.    else begin
  735.       Init_Astronomy_Menu ;                          {Set up the main menu bar}
  736.       latitude_str  := '432950N' ;                     {set up default strings}
  737.       longitude_str := '0802230W' ;
  738.       system_time (time_str) ;                                    {system time}
  739.       system_date (date_str) ;                                    {system date}
  740.       printouts     := FALSE ;                          {set printout flag off}
  741.       device        := 'CON:' ;                          {set device to screen}
  742.       did_current   := FALSE ;                     {no data has been calc yet!}
  743.       scrnwhite := TRUE ; scrncol:= white ; txtcol:= black ; {set up flag, col}
  744.  
  745.       if Init_Gem <> -1 then              {initialize GEM for graphics, etc!!!}
  746.       begin
  747.          PrintAt (0,0) ;                 {tell user that files are being read!}
  748.          write (output,
  749.          '                 Please Wait ... Initializing Data Files!!!       ');
  750.          read_pln ;                                     {read in data files!!!}
  751.          read_stars ;
  752.          read_com ;
  753.          r_star_data ;
  754.  
  755.          Do_The_Menu ;
  756.          Exit_Gem ;                           {leave GEM and return to desktop}
  757.       end ;
  758.    end ;
  759. end.                                                                 {mainline}
  760.  
  761.  
  762.