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