home *** CD-ROM | disk | FTP | other *** search
/ Play and Learn 2 / 19941.ZIP / 19941 / EDUCNOMY / HERSCHEL / SELECTS.INC < prev   
Encoding:
Text File  |  1994-02-04  |  16.9 KB  |  506 lines
  1. Procedure SelectH; { Select desired Herschel classes }
  2.   Var
  3.     SaveClass,SelectClass : HClassSet;
  4.     Ch : Char;
  5.   Begin { Procedure SelectH }
  6.     ClrScr;
  7.     Writeln('The Herschel classes are:');
  8.     Writeln;
  9.     HighVideo; Write('  1'); LowVideo; Writeln(' : Bright Nebulae');
  10.     HighVideo; Write('  2'); LowVideo; Writeln(' : Faint Nebulae');
  11.     HighVideo; Write('  3'); LowVideo; Writeln(' : Very Faint Nebulae');
  12.     HighVideo; Write('  4'); LowVideo; Writeln(' : Planetary Nebulae');
  13.     HighVideo; Write('  5'); LowVideo; Writeln(' : Very Large Nebulae');
  14.     HighVideo; Write('  6'); LowVideo;
  15.     Writeln(' : Very Compressed and Rich Clusters of Stars');
  16.     HighVideo; Write('  7'); LowVideo;
  17.     Writeln(' : Compressed Clusters of Small and Large Stars');
  18.     HighVideo; Write('  8'); LowVideo;
  19.     Writeln(' : Coarsely Scattered Clusters of Stars');
  20.     Writeln;
  21.     Writeln('Current selected values are:');
  22.     If ClassSet  >= [1..8] Then
  23.       Writeln('All Herschel classes.')
  24.     Else
  25.       Begin { Else }
  26.         Write('Herschel class(es) ');
  27.         For Index := 1 To 8 Do
  28.           If Index In ClassSet Then
  29.             Write(ClassNames[Index],' ');
  30.         Writeln;
  31.       End; { Else }
  32.     Writeln;
  33.     SaveClass := ClassSet; { Save the current set in case we need to keep it }
  34.     If Not Expanding Then
  35.       ClassSet := [];
  36.     Write('Type single digit classes one at a time. Type "');
  37.     HighVideo; Write('Q'); LowVideo; Writeln('" to quit');
  38.     Writeln;
  39.     Write('Type your class(es) now: ');
  40.     Repeat
  41.       Repeat
  42.         Read(Kbd,Ch);
  43.       Until Upcase(Ch) In ['1'..'8','Q'];
  44.       HighVideo; Write(Ch,' ');
  45.       If Upcase(Ch) <> 'Q' Then
  46.         Begin { Then }
  47.           Case Ch Of
  48.             '1' : SelectClass := [1];
  49.             '2' : SelectClass := [2];
  50.             '3' : SelectClass := [3];
  51.             '4' : SelectClass := [4];
  52.             '5' : SelectClass := [5];
  53.             '6' : SelectClass := [6];
  54.             '7' : SelectClass := [7];
  55.             '8' : SelectClass := [8];
  56.           End; { Case }
  57.           ClassSet := ClassSet + SelectClass; { Build set of desired classes }
  58.         End; { Then }
  59.     Until Upcase(Ch) = 'Q';
  60.     If ClassSet = [] Then { User entered procedure but didn't select anything }
  61.       ClassSet := SaveClass { Restore saved class selection values }
  62.     Else
  63.       NewSelection := True; { Something was selected }
  64.   End; { Procedure SelectH }
  65.  
  66. Procedure SelectNGC;
  67. { This procedure allows the user to select a range of desired NGC #s. }
  68.   Begin { Procedure SelectNGC }
  69.     ClrScr;
  70.     Writeln('Currently selected NGC #s are from ',LowNGC,' to ',HighNGC);
  71.     Writeln;
  72.     AllOK := False;
  73.     NewSelection := True;
  74.     Repeat
  75.       Writeln;
  76.       Repeat
  77.         Write('Enter low NGC number: ');
  78.         {$I-} Readln(LowNGC) {$I+};
  79.         OK := (IoResult = 0);
  80.         If Not OK Then
  81.           Write(^G); { Ring bell to alert user to entry error }
  82.         Writeln;
  83.       Until OK;
  84.       Repeat
  85.         Write('Enter high NGC number: ');
  86.         {$I-} Readln(HighNGC) {$I+};
  87.         OK := (IoResult = 0);
  88.         If Not OK Then
  89.           Write(^G); { Ring bell to alert user to entry error }
  90.         Writeln;
  91.       Until OK;
  92.       AllOK := LowNGC <= HighNGC;
  93.       If Not AllOK Then
  94.         Begin { Then }
  95.           Write(^G); { Ring bell to alert user to entry error }
  96.           HighVideo;
  97.           Writeln('Enter the low NGC number first!');
  98.           LowVideo;
  99.         End; { Then }
  100.     Until AllOK;
  101.   End; { Procedure SelectNGC }
  102.  
  103. Procedure SelectRA;
  104. { This procedure allows the user to select a desired range of r.a. }
  105.   Begin { Procedure SelectRA }
  106.     ClrScr;
  107.     Write('Currently selected r.a. values are from ',LowRAHr,'h, ');
  108.     Writeln(LowRAMin,'m to ',HighRAHr,'h, ',HighRAMin,'m');
  109.     AllOK := False;
  110.     NewSelection := True;
  111.     Repeat
  112.       Writeln;
  113.       Repeat
  114.         Write('Enter low r.a. Hrs. : ');
  115.         {$I-} Readln(LowRAHr) {$I+};
  116.         OK := (IoResult = 0);
  117.         If Not OK Then
  118.           Write(^G); { Ring bell to alert user to entry error }
  119.         Writeln;
  120.       Until OK;
  121.       Repeat
  122.         Write('  Enter Low r.a. Minutes: ');
  123.         {$I-} Readln(LowRAMin) {$I+};
  124.         OK := (IoResult = 0);
  125.         If Not OK Then
  126.           Write(^G); { Ring bell to alert user to entry error }
  127.         Writeln;
  128.       Until OK;
  129.       Repeat
  130.         Write('Enter high r.a. Hrs. : ');
  131.         {$I-} Readln(HighRAHr) {$I+};
  132.         OK := (IoResult = 0);
  133.         If Not OK Then
  134.           Write(^G); { Ring bell to alert user to entry error }
  135.         Writeln;
  136.       Until OK;
  137.       Repeat
  138.         Write('  Enter high r.a. minutes: ');
  139.         {$I-} Readln(HighRAMin) {$I+};
  140.         OK := (IoResult = 0);
  141.         If Not OK Then
  142.           Write(^G); { Ring bell to alert user to entry error }
  143.         Writeln;
  144.       Until OK;
  145.       AllOK := LowRAHr <= HighRAHr;
  146.       If Not AllOK Then
  147.         Begin { Then }
  148.           Write(^G); { Ring bell to alert user to entry error }
  149.           HighVideo;
  150.           Writeln('Enter the low r.a. first!');
  151.           LowVideo;
  152.         End; { Then }
  153.     Until AllOK;
  154.   End; { Procedure SelectRA }
  155.  
  156. Procedure SelectDec;
  157. { Select desired range of Declination. }
  158.   Begin { Procedure SelectDec }
  159.     ClrScr;
  160.     Write('Currently selected dec. values are from ',LowDecDeg,'d, ');
  161.     Writeln(Abs(LowDecMin),'m to ',HighDecDeg,'d, ',HighDecMin,'m');
  162.     AllOK := False;
  163.     NewSelection := True;
  164.     Repeat
  165.       Writeln;
  166.       Repeat
  167.         Write('Enter low Dec. degrees: ');
  168.         {$I-} Readln(LowDecDeg) {$I+};
  169.         OK := (IoResult = 0);
  170.         If Not OK Then
  171.           Write(^G); { Ring bell to alert user to entry error }
  172.         Writeln;
  173.       Until OK;
  174.       Repeat
  175.         Write('  Enter low Dec. minutes: ');
  176.         {$I-} Readln(LowDecMin) {$I+};
  177.         OK := (IoResult = 0);
  178.         If Not OK Then
  179.           Write(^G); { Ring bell to alert user to entry error }
  180.         Writeln;
  181.       Until OK;
  182.       Repeat
  183.         Write('Enter high Dec. degrees: ');
  184.         {$I-} Readln(HighDecDeg) {$I+};
  185.         OK := (IoResult = 0);
  186.         If Not OK Then
  187.           Write(^G); { Ring bell to alert user to entry error }
  188.         Writeln;
  189.       Until OK;
  190.       Repeat
  191.         Write('  Enter high Dec. minutes: ');
  192.         {$I-} Readln(HighDecMin) {$I+};
  193.         OK := (IoResult = 0);
  194.         If Not OK Then
  195.           Write(^G); { Ring bell to alert user to entry error }
  196.         Writeln;
  197.       Until OK;
  198.       AllOK := LowDecDeg <= HighDecDeg;
  199.       If Not AllOK Then
  200.         Begin { Then }
  201.           Write(^G); { Ring bell to alert user to entry error }
  202.           HighVideo;
  203.           Writeln('Enter the low declination first!');
  204.           LowVideo;
  205.         End; { Then }
  206.     Until AllOK;
  207.   End; { Procedure SelectDec }
  208.  
  209. Procedure SelectMag;
  210. { Select a desired range of magnitude. }
  211.   Begin { Procedure SelectMag }
  212.     ClrScr;
  213.     Write('Currently selected mag. values are from ');
  214.     Writeln(LowMag / 10:4:1,' to ',HighMag / 10:4:1);
  215.     AllOK := False;
  216.     NewSelection := True;
  217.     Repeat
  218.       Writeln;
  219.       Repeat
  220.         Write('Enter low (bright) magnitude: ');
  221.         {$I-} Readln(LowMag) {$I+};
  222.         OK := (IoResult = 0);
  223.         If Not OK Then
  224.           Write(^G); { Ring bell to alert user to entry error }
  225.         Writeln;
  226.       Until OK;
  227.       LowMag := LowMag * 10;
  228.       Repeat
  229.         Write('Enter high (faint) magnitude: ');
  230.         {$I-} Readln(HighMag) {$I+};
  231.         OK := (IoResult = 0);
  232.         If Not OK Then
  233.           Write(^G); { Ring bell to alert user to entry error }
  234.         Writeln;
  235.       Until OK;
  236.       HighMag := HighMag * 10;
  237.       AllOK := LowMag <= HighMag;
  238.       If Not AllOK Then
  239.         Begin { Then }
  240.           Write(^G); { Ring bell to alert user to entry error }
  241.           HighVideo;
  242.           Writeln('Enter the low magnitude first!');
  243.           LowVideo;
  244.         End; { Then }
  245.     Until AllOK;
  246.   End; { Procedure SelectMag }
  247.  
  248. Procedure SelectType;
  249. { Select desired object types. }
  250.   Var
  251.     SaveTypes,SelectType : HTypeSet;
  252.     Ch : Char;
  253.   Begin { Procedure SelectType }
  254.     ClrScr;
  255.     Writeln('Object types are:');
  256.     Writeln;
  257.     HighVideo; Write('  O'); LowVideo; Writeln('pen Clusters');
  258.     Write('  Globular '); HighVideo; Write('C'); LowVideo; Writeln('lusters');
  259.     HighVideo; Write('  D'); LowVideo; Writeln('iffuse Nebulae');
  260.     HighVideo; Write('  P'); LowVideo; Writeln('lanetary Nebulae');
  261.     HighVideo; Write('  G'); LowVideo; Writeln('alaxies');
  262.     Write('  Clusters'); HighVideo; Write('/'); LowVideo; Writeln('Nebulae');
  263.     HighVideo; Write('  N'); LowVideo; Writeln('onexistant');
  264.     Writeln;
  265.     Writeln('Currently selected object types are:');
  266.     If TypeSet  >= [1..7] Then
  267.       Writeln('All object types.')
  268.     Else
  269.       Begin { Else }
  270.         Write('Object type(s) ');
  271.         For Index := 1 To 7 Do
  272.           If Index In TypeSet Then
  273.             Write(ObjectTypes[Index],' ');
  274.         Writeln;
  275.       End; { Else }
  276.     Writeln;
  277.     Write('Type single characters for types one at a time. Type "');
  278.     HighVideo; Write('Q'); LowVideo; Writeln('" to quit.');
  279.     Writeln;
  280.     SaveTypes := TypeSet; { Save current value for possible restoring }
  281.     Writeln;
  282.     If Not Expanding Then
  283.       TypeSet := [];
  284.     Write('Type your object class(es) now: ');
  285.     Repeat
  286.       Repeat
  287.         Read(Kbd,Ch);
  288.       Until Upcase(Ch) In ['O','G','P','D','C','U','N','/','Q'];
  289.       HighVideo; Write(Ch,' ');
  290.       If Upcase(Ch) <> 'Q' Then
  291.         Begin { Then }
  292.           Case Ch Of
  293.             'O','o' : SelectType := [1];
  294.             'C','c' : SelectType := [2];
  295.             'D','d' : SelectType := [3];
  296.             'P','p' : SelectType := [4];
  297.             'G','g' : SelectType := [5];
  298.             '/'     : SelectType := [6];
  299.             'N','n' : SelectType := [7];
  300.           End; { Case }
  301.           TypeSet := TypeSet + SelectType; { Build set of desired types }
  302.         End; { Then }
  303.     Until Upcase(Ch) = 'Q';
  304.     If TypeSet = [] Then { User enterd procedure but didn't select anything }
  305.       TypeSet := SaveTypes { Restore saved type selection values }
  306.     Else
  307.       NewSelection := True; { Something was selected }
  308.   End; { Procedure SelectType }
  309.  
  310. Procedure SelectCon;
  311. { Select desired constellations. }
  312.   Const
  313.     Arrow = '->';
  314.  
  315.   Var
  316.     FunKey,AllSelected,SelfDeleted,ChangeInArray : Boolean;
  317.     HoldCons : Array[Cons] Of Boolean;
  318.     ConArrayIndex,X,Y,Row,Column : Byte;
  319.     Index : Cons;
  320.  
  321.  Procedure Beep; { Make a sound when the arrow is moved }
  322.    Begin { Procedure Beep }
  323.      Sound(1000);
  324.      Delay(3);
  325.      NoSound;
  326.    End; { Procedure Beep }
  327.  
  328.  Procedure AddCon;
  329.  { The user typed a "+" - so add the constellation to the desired list.
  330.    The Constel array flags the desired constellations for comparison in
  331.    procedure Inp. }
  332.    Begin { Procedure AddCon }
  333.      Beep;
  334.      Constel[Index] := True;
  335.      Write(Names[Index]);
  336.    End; { Procedure AddCon }
  337.  
  338.  Procedure RemoveCon;
  339.  { The user typed a "-", so we remove the constellation from consideration. }
  340.    Begin { Procedure RemoveCon }
  341.      Beep;
  342.      Constel[Index] := False;
  343.      LowVideo;
  344.      Write(Names[Index]);
  345.      HighVideo;
  346.    End; { Procedure RemoveCon }
  347.  
  348. Procedure EraseArrow;
  349. { This procedure erases the "->" at each new move. }
  350.   Begin { Procedure EraseArrow }
  351.     Beep;
  352.     GoToXY(X,Y);
  353.     Write('  ');
  354.   End; { Procedure EraseArrow }
  355.  
  356.  Procedure GetArrow;
  357.  { The user typed an arrow (cursor control) key - find which one & respond }
  358.    Begin { Procedure GetArrow }
  359.      If KeyPressed Then
  360.        Begin { Then }
  361.          FunKey := True;
  362.          Read(Kbd,Ch); { Get 2nd character of extended code }
  363.        End; { Then }
  364.      If FunKey Then
  365.        Begin { Then }
  366.          FunKey := False;
  367.          Case Ch Of
  368.            #81 : Ch := 'a'; { # 81 is 'Q' and we don't want to quit }
  369.            #75 : Begin { Case Left }
  370.                    EraseArrow;
  371.                    X := X - 5;
  372.                    Index := Index - 1;
  373.                    If X < 10 Then
  374.                      Begin { Then }
  375.                        X := 60;
  376.                        Index := Index + 11;
  377.                      End; { Then }
  378.                  End; { Case Left }
  379.            #77 : Begin { Case Right }
  380.                    EraseArrow;
  381.                    X := X + 5;
  382.                    Index := Index + 1;
  383.                    If X > 60 Then
  384.                      Begin { Then }
  385.                        X := 10;
  386.                        Index := Index - 11;
  387.                      End; { Then }
  388.                  End; { Case Right }
  389.            #72 : Begin { Case Up }
  390.                    EraseArrow;
  391.                    Y := Y - 2;
  392.                    Index := Index - 11;
  393.                    If Y < 1 Then
  394.                      Begin { Then }
  395.                        Y := Y + 16;
  396.                        Index := Index + 88;
  397.                      End; { Then }
  398.                  End; { Case Up }
  399.            #80 : Begin { Case Down }
  400.                    EraseArrow;
  401.                    Y := Y + 2;
  402.                    Index := Index + 11;
  403.                    If Y > 17 Then
  404.                      Begin { Then }
  405.                        Y := Y - 16;
  406.                        Index := Index - 88;
  407.                      End; { Then }
  408.                  End; { Case Down }
  409.          End; { Case }
  410.        End; { Then }
  411.    End; { Procedure GetArrow }
  412.  
  413.  Procedure WriteConScreen; { Write the constellation selection screen }
  414.   Begin { Procedure WriteConScreen }
  415.     ClrScr;
  416.     Writeln;
  417.     For Row := 0 To 7 Do { Nested FOR loop to write Con. names in order }
  418.       Begin { For Row }
  419.         Tab(11);
  420.         For Column := 1 To 11 Do
  421.           Begin { For Column }
  422.             LowVideo;
  423.             If Constel[11 * Row + Column] Then
  424.               HighVideo;
  425.             Write(Names[11 * Row + Column],'  ');
  426.           End; { For Column }
  427.         Writeln; Writeln;
  428.       End; { For Row }
  429.     LowVideo;
  430.     Writeln;
  431.     Tab(18); Writeln('Position arrow with cursor control keys.');
  432.     Writeln;
  433.     Tab(16); Write('Add with "'); HighVideo; Write('+');
  434.     LowVideo; Write('", delete with "'); HighVideo; Write('-');
  435.     LowVideo; Write('". Quit with "'); HighVideo; Write('Q');
  436.     LowVideo; Writeln('".');
  437.     Writeln;
  438.     Tab(19); Write('Add all with "'); HighVideo; Write('A');
  439.     LowVideo; Write('", delete all with "'); HighVideo; Write('D');
  440.     LowVideo; Writeln('"');
  441.     HighVideo;
  442.   End; { Procedure WriteConScreen }
  443.  
  444.  Procedure AddAll; { Add all constellations into consideration. This makes
  445.                      it easier to add all but a few constellations. }
  446.    Begin { Procedure AddAll }
  447.      Beep;
  448.      Constel := TrueConArray; { All constellations selected }
  449.      WriteConScreen;
  450.    End; { Procedure AddAll }
  451.  
  452.  Procedure DeleteAll; { Remove all constellations from consideration }
  453.    Begin { Procedure DeleteAll }
  454.      Beep;
  455.      For ConArrayIndex := 0 To NumberOfConstellations Do
  456.        Constel[ConArrayIndex] := False;
  457.      WriteConScreen;
  458.    End; { Procedure DeleteAll }
  459.  
  460.   Begin { Procedure SelectCon }
  461.    { Here is the logic at the heart of the SelectCon routine. }
  462.    SelfDeleted := True; { Program will delete all if all cons. are selected }
  463.    For Index := 0 To NumberOfConstellations Do { Loop to check selections }
  464.      If Not Constel[Index] Then { Not every con. was selected }
  465.        SelfDeleted := False;
  466.    If SelfDeleted Then { Delete all & prepare for fresh selection }
  467.      For Index := 0 To NumberOfConstellations Do { Delete all }
  468.        Constel[Index] := False;
  469.    HoldCons := Constel; { Save Constel array for comparing at proc. end }
  470.    FunKey := False; { No numeric keypad key has been pressed }
  471.    Window(1,1,80,25); { Set window size to entire screen }
  472.    WriteConScreen;
  473.    X := 10; { Initial position for arrow }
  474.    Y := 2;
  475.    Index := 1; { Arrow is at Constel[1] }
  476.    Repeat
  477.      GoToXY(X,Y);
  478.      Write(Arrow);
  479.      Repeat
  480.        Read(Kbd,Ch)
  481.      Until Upcase(Ch) In ['+','-','Q','A','D',#27];
  482.      Case Ch Of
  483.        '+' : AddCon;
  484.        '-' : RemoveCon;
  485.        'A','a' : AddAll;
  486.        'D','d' : DeleteAll;
  487.        #27 : GetArrow;
  488.      End; { Case }
  489.    Until Upcase(Ch) = 'Q';
  490.    LowVideo;
  491.    ChangeInArray := False; { For checking for individual changes }
  492.    AllSelected := True; { For checking for case of all selected }
  493.    For Index := 0 To NumberOfConstellations Do { Loop to check selections }
  494.      Begin { For Index }
  495.        If Constel[Index] <> HoldCons[Index] Then
  496.          ChangeInArray := True; { Something has changed since we saved }
  497.        If Not Constel[Index] Then { Not all were selected }
  498.          AllSelected := False;
  499.      End; { For Index }
  500.    If Not (SelfDeleted And AllSelected) Then { OK to set NewSelection }
  501.      If ChangeInArray Then
  502.        NewSelection := True;
  503.    If SelfDeleted And ((Not ChangeInArray) Or AllSelected) Then
  504.      Constel := TrueConArray; { User made no selection so we restore all }
  505.  End; { Procedure SelectCon }
  506.