Programmer 7500/MAX_PROGRAMMERS.iso/INFO/TURBOPAS/BOOSTDOC.ZIP/BOREF2.PAS

Pascal/Delphi Source File | 1985-11-17 | 20.9 KB | 733 lines

.R:
.R:

.X:8
.XT:4
.F:
.F:
.F:Boosters Users Guide...Page $$$...
                               NSORBIT


Declaration: Procedure NsOrbit ( X1 : ColumnType;
                                 Y1 : RowType;
                                 X2 : ColumnType;
                                 Y2 : RowType;
                              Style : Integer;
                    NumberOfSeconds : Integer);

Purpose:     Draws a box at X1,Y1,X2,Y2 in selected Style, then
             erases all but two components of the box, which ì
             orbit the box interior for time NumberOfSeconds.
             After orbiting, NsOrbit redraws the original box.


             Notes:
             1.  Style is a value from 1 to 4 and controls theì
                 number of lines in a box side (see Boxul ì
                 description for details).


Example:     Display 60 boxes and select one at random to orbit.

             (*$IBodecl  *)
             (*$IPutStr  *)
             (*$ICopies  *)
             (*$IBoxul   *)
             (*$ISetAtt  *)
             (*$ITimer   *)
             (*$INsOrbit *)
             var
                Ulx, Uly : Integer;

             BEGIN

                ClrScr;
                for i := 1 to 15 do
                begin
                   Boxul (1+(i-1)*4,1,4+(i-1)*4,4,1,14);
                   Boxul (1+(i-1)*4,6,4+(i-1)*4,9,2,14);
                   Boxul (1+(i-1)*4,11,4+(i-1)*4,14,3,14);
                   Boxul (1+(i-1)*4,16,4+(i-1)*4,19,4,14);
                end;
                PutStr (h,'Press enter to orbit',60,25,14);
                read;
                Randomize;
                Ulx := Random(15);
                Uly := Random( 4);
                NsOrbit (1+Ulx*4, 1+Uly*5, 4+Ulx*4, 4+Uly*5, Uly+1, 4);

             END (* XNsOrbit *) .

                               OVERSTR


Declaration: Function OverStr ( New, Target : AnyString;
                                Pos, Len    : Integer;
                                Pad         : Char) : AnyString;


Purpose:     Overlays New onto Target beginning at Pos, for ì
             length Len, then pads or truncates accordingly.


             Notes:
             1.  Padding occurs when Pos > length(Target) orì
                 LEN > length(New).


Example:     Modify and pad a string.

             (*$IBodecl  *)
             (*$IOverStr *)
             (*$IPutStr  *)

             BEGIN
                ClrScr;
                S := 'Change this field '+#220+#223+#220+#223+
                     #220+#223+' to an alternate pattern, '+
                     'pad to end of line.';
                PutStr (h,S,1,1,14);
                read;
                PutStr (h,OverStr (#223+#220+#223+#220+#223+#220,
                                   S,19,61,#223),1,1,14);

             END (* XOverStr *) .

                                PUTSTR


Declaration: Procedure PutStr ( HV : Char;
                                 S : AnyString;
                                 X : ColumnType;
                                 Y : RowType;
                               Att : Integer);


Purpose:     Writes S to video display beginning at X,Y, with ì
             display attribute Att.

             Notes:ì
             1.  If HV  = 'V', direction of write is vertical.  Ifì
             HV is any other character, direction of write is ì
             horizontal.
             2.  PutHeap is the corresponding Heap I/O routine.


Example:     Create screens using Write, PutStr, and Heap I/O.

             (*$IBoDecl   *)
             (*$IPutStr   *)
             (*$ICenter   *)
             (*$ISaves    *)
             (*$IRestores *)
             (*$IPutHeap  *)

             BEGIN

                Mark ( HeapTop );
                New ( page[1] );
                ClrScr;
                for i := 1 to 25 do
                   writeln('Using Orthodox methods of screen I/O');
                SaveScreen ( page[1] );
                read;
                for i := 1 to 25 do
                   PutStr (h,Center(' Using PutStr with Center function ',
                           40,' '),41,i,112);
               read;
               ClrScr;
               read;
               for i := 1 to 25 do
                  PutHeap ( page[1], h,Center(' Used PutHeap and'+
                          ' RestoreScreen ',40,' '),41,i,112);
               RestoreScreen ( page[1] );
               Release ( HeapTop );

            END (* XPutStr *) .

                                REMBLK


Declaration: Procedure RemBlk ( X1 : ColumnType;
                                Y1 : RowType;
                                X2 : ColumnType;
                                Y2 : RowType);


Purpose:     Removes the block at display location
             X1,Y1,X2,Y2 by filling it with blanks.

             Notes:
             1.  The attribute byte of the blanked area is
                 set to 14 (intense yellow).
             2.  Use FillHeap to remove areas of the heap.


Example:     Fill the screen with alternate ones and zeroes, then ì
             remove the zeroes.

             (*$IBoDecl *)
             (*$IRemBlk *)
             (*$IPutStr *)

             var  j : integer;

             BEGIN

                repeat
                   for i := 1 to 25 do
                      for j := 1 to 8 do
                         PutStr (h,'1010101010',1+(j-1)*10,i,14);
                   read(Kbd,ch);
                   for j := 1 to 40 do
                      RemBlk (2+(j-1)*2,1,2+(j-1)*2,25);
                   read(Kbd,ch);
                until ch = ' ';

             END (* XRemBlk *) .

                                 RIGHT


Declaration: Function Right ( S : AnyString;
                            Len : Integer;
                            Pad : Char): AnyString;


Purpose:     Returns S right-justified in a string of length Len,
             padded or truncated on the left as needed.


Example:     Use right function to decimal-align monetary values.

             (*$IBoDecl *)
             (*$IRight  *)
             (*$IPutStr *)

             BEGIN

                ClrScr;
                PutStr (h,Right ('0.12',12,' '),1,2,14);
                PutStr (h,Right ('77,126.99',12,' '),1,3,14);
                PutStr (h,Right ('1,345,200.06',12,' '),1,4,14);
                PutStr (h,Right ('35.00',12,' '),1,5,14);

             END (* XRight *) .

                                 RWORD



Declaration: Function Rword (  S : AnyString;
                               N : Integer;
                              St : AnyString ) : AnyString;


Purpose:     Replace word N of S with St.  All other words of
             S (if any) remain unaffected.


             Notes:

             1.  A word is any blank-delimited sequence of
                 characters or a string of nonblank characters.

             2.  If Length(Rword( S,N,St )) > 255, then St is
                 reduced to fit.


Example:     Replace the day of the week with the date.


             Given:  S := 'Today is Friday';

             Then:   S := Rword ( S, 3, 'November 15, 1985');

             Yields: S := 'Today is November 15, 1985';


             Note:

             1.  For a working routine using Rword and other
                 word functions, see the example for Words.

                  SAVE AND RESTORE SCREEN PROCEDURES


Declaration: Procedure SaveScreen    ( Page : HeapBuf );
             Procedure RestoreScreen ( Page : HeapBuf );


Purpose:     Provide convenience and speed for saving and
             restoring contents of video display.

             Notes:
             1.  See BoDemo for additional examples
                 of SaveScreen and RestoreScreen.

Example:     Create two screens, saving each, then alternately
             restore them under user control.

             (*$IBoDecl *)
             (*$ICopies *)
             (*$ICenter *)
             (*$IPutStr *)
             (*$ISaves  *)
             (*$IRestores *)

             BEGIN

                Mark ( HeapTop );
                New  ( page[1] );
                New  ( page[2] );

                for i := 1 to 25 do
                   PutStr (h,Copies ( ' ' ,80), 1, i, 7 );
                PutStr (h, Center (' PRESS ANY KEY ',80,' ' ),1,13,7);
                SaveScreen ( page[1] );
                read(Kbd,ch);
                for i := 1 to 25 do
                   PutStr (h,Center ( 'This is screen 2 - ' +
                                      'press SpaceBar to quit',
                                       80,' '),1,i,14);
                SaveScreen ( page[2] );
                read(Kbd,ch);
                repeat
                   RestoreScreen ( page[1] );
                   read(Kbd,ch);
                   RestoreScreen ( page[2] );
                   read(Kbd,ch);
                until ch = ' ';
                Release ( HeapTop );

             END (* XScreen *) .

                                SETATT


Declaration: Procedure SetAtt ( X1 : ColumnType;
                                Y1 : RowType;
                                X2 : ColumnType;
                                Y2 : RowType;
                               Att : Integer);


Purpose:     Sets the video attributes of the block defined by
             X1,Y1,X2,Y2 according to the value of Att.

             Notes:
             1.  HeapAt sets attributes for pages on the heap.


Example:     Draw 20 bars, then allow the user to set their ì
             attributes.

             (*$IBoDecl *)
             (*$ISetAtt *)
             (*$IPutStr *)

             var
                j, Att : integer;

             BEGIN

                ClrScr;
                for i := 1 to 6 do
                   for j := 1 to 20 do
                      PutStr (h,#04 +#04 +#04 , 1+(j-1)*4, 7-i, 14);

                repeat
                   PutStr (h, 'Enter attribute value,'+
                         ' 0-255 (Out of Range quits) ',
                           1,10,14);
                   ClrEol;
                   read(att);
                   if (att >= 0) and (att <= 255) then
                      for i := 1 to 20 do
                         SetAtt (1+(i-1)*4,1,3+(i-1)*4,6,att);
                until (att < 0) or (att > 255);

             END (* XSetatt *) .

                                 SPACE


Declaration: Function Space ( S : AnyString ) : AnyString;


Purpose:     Returns a string that is S normalized.  A
             normalized string has no leading or trailing
             blanks and one blank between each word.


             Notes:

             1.  A word is any blank-delimited sequence of
                 characters or a string of nonblank characters.


Example:     Normalize a string.


             Given:   S := '   X   Y   Z   ';

             Then:    S := Space ( S );

             Yields:  S := 'X Y Z';


             Note:

             1.  For a working routine using Space and other
                 word functions, see the example for Words.

                                 STRIP


Declaration: Function Strip ( S : AnyString;
                              C : Char) : AnyString;


Purpose:     Copies S to the result string, excluding leading      ì
             and trailing C characters.


Example:     Isolate the dollar sign.

             (*$IBoDecl *)
             (*$IStrip  *)
             (*$IPutStr *)

             BEGIN

                ClrScr;
                S := '   111222333444$444333222111   ';
                PutStr (h, s, 1,1,14);
                read;
                PutStr (h, strip (strip ( strip ( strip (strip
                (S,' ') ,'1'),'2'),'3'),'4'),1,2,14);

             END (* Xstrip *) .

                                  TIMER


Declaration: Function Timer (Seconds : Integer ) : Boolean;ì
                    ì

Purpose:     Returns TRUE if Seconds seconds have elapsed since   ì
             Timer's invocation.

             Notes:
             1.  StartElapsed and TimeElapsed arσ globals. ì
                 StartElapsed must be initialized to FALSE.  Both ì
                 are part of BoDecl (Boosters Declarations file). ì

             2.  Timer uses the system clock (seconds value) to ì
                 keep track of the time elapsed.  The hundredth ì
                 value of the clock is set to zero when the ì
                 timing begins, to ensure a full initial second.ì

             3.  Calls to Timer should not be nested.

             4.  See the Wait procedure for an illustration
                 of how to use Timer.

Example:     Demonstrate a five-second timing.

             var
                SaveTime : integer;

             (*$IBoDecl *)
             (*$ITimer  *)
             (*$IPutStr *)

             BEGIN

                ClrScr;
                PutStr (h,'Set timer for 5 seconds. . .',30,6,14);
                i := 5;
                SaveTime := TimeElapsed;
                repeat
                   if TimeElapsed <> SaveTime then
                   begin
                      str (i,s);
                      PutStr (h,s, 40,12-i,14);
                      i := i - 1;
                      SaveTime := TimeElapsed;
                   end;
                until Timer(5);
                PutStr (h,'Time''s up.',37,13,14);
                read;

             END (* Xtimer *) .

                       SET AND DISPLAY SYSTEM TIME


Declaration: Procedure TimeXY ( X : ColumnType; Y : RowType);

             Procedure Stime  ( hh, mm, ss : integer );


Purpose:     TimeXY displays the system time, while Stime sets it.


Example:     Allow user to set time while current time continually
             displays.

             (*$IBoDecl *)
             (*$IPutStr *)
             (*$ITimeXY *)
             (*$IStime  *)

             var  hh, mm, ss : integer;

             function Range ( Ch: Char): boolean;
             begin
                case Ch of
                   #32,#48..#57 : Range := True
                else
                   Range := false;
                end;
             end;

             BEGIN

                ClrScr;
                S := '';
                PutStr ( h,'Current time: ',30,1, 14 );
                PutStr ( h, 'Enter new time exactly as shown',1, 9, 14);
                PutStr ( h, '      HH MM SS: ',1,10, 14);
                SaveX := 17;
                SaveY := 10;
                Repeat
                   repeat
                      TimeXY(44,1);
                      GoToXY(SaveX,SaveY);
                   until KeyPressed;
                   read(Kbd,ch);
                   if Range(ch) then
                   begin
                      S := S + ch;
                      write(Ch);
                      SaveX := WhereX;
                   end;
                until Ch = #13;
                val ( Copy(S,1,2),hh,ecode );
                val ( Copy(S,4,2),mm,ecode );
                val ( Copy(S,7,2),ss,ecode );
                Stime ( hh,mm,ss );
                repeat TimeXY(44,1) until KeyPressed;

             END (* XtimeXY *) .

                                 UPPER


Declaration: Function Upper ( S : AnyString) : AnyString;


Purpose:     Provides uppercase translation as a function call.
             Returns a string with all lowercase alphabeticsì
             converted to uppercase.


             Notes:
             1.  For a technique using a procedure call, see the ì
                 Turbo Pascal manual.


Example:     Translate user input to uppercase.

             (*$IBoDecl *)
             (*$IUpper  *)
             (*$ICenter *)

             BEGIN

                ClrScr;
                Write ( Center ('Enter any string '+
                      '(''quit'' quits)',80,' '));
                window(1,2,80,25);
                repeat
                   readln(S);
                   S := Upper( S );
                   Writeln( S );
                until S = 'QUIT';
                window(1,1,80,25);

             END (* Xupper *) .

                                WAIT


Declaration: Procedure Wait ( NumberOfSeconds : Integer );

Purpose:     Delays processing for the number of seconds specified
             by NumberOfSeconds or until a key press.  If the key
             pressed was the Home key, processing halts until
             another key press.

Example:     Display 'steps' with 1-second intervals.

             (*$IBoDecl *)
             (*$ITimer  *)
             (*$ICenter *)
             (*$IPutStr *)
             (*$IWait   *)

             BEGIN

                ClrScr;
                PutStr ( h, 'Press a key for speed, home for hold',
                         1, 25, 7 );
                for i := 1 to 24 do
                begin
                   str (i, s);
                   PutStr ( h,Center (S, 10,'-'), 1+(i-1)*3, i, 14 );
                   wait(1);
                end

             END (* Xwait *) .

                                 WORD



Declaration: Function Word ( S : AnyString;
                             N : Integer ) : AnyString;


Purpose:     Returns word N of S.


             Notes:

             1.  A word is any blank-delimited sequence of
                 characters or a string of nonblank characters.


Example:     Extract a word from a string.


             Given:  S := 'The Lone Ranger's friend is Tonto.';

             Then:   T := Word ( S, 6 );

             Yields: T := 'Tonto.';


             Note:

             1.  For a working routine of Word and other word
                 functions, see the example for Words.

                                WORDIND



Declaration: Function WordInd ( S : AnyString;
                                N : Integer ) : Integer;


Purpose:     Returns the string position of word N in S.


             Notes:

             1.  A word is any blank-delimited sequence of
                 characters or a string of nonblank characters.


Example:     Find the starting position of a word in a string.


             Given:  S := 'These are the times that try our souls.';

             Then:   i := WordInd ( S, 4 );

             Yields: i := 15;  { Starting position of 'times' }


             Note:

             1.  See Words below for a working routine using
                 WordInd and the other word functions.

                                 WORDS



Declaration: Function Words ( S : AnyString ) : Integer;


Purpose:     Returns the number of words in S.


             Notes:

             1.  A word is any blank-delimited sequence of
                 characters or a string of nonblank characters.
             2.  The string 'Turbo Pascal' has 2 words.


Example:     Analyze and optionally modify user input until
             user types 'Q' or 'q'.

             (*$IBoDecl *)
             (*$IStrip  *)
             (*$ICenter *)
             (*$IRword  *)
             (*$IWord   *)
             (*$IWords  *)
             (*$IWordInd*)
             (*$ISpace  *)

             var
                Ts : AnyString;
                j  : Integer;

             BEGIN
                ClrScr;
                Write( Center ( 'Type a message for analysis.'+
                                ' Q to quit.',80,' '));
                Write( Center ( '''n , string'' replaces word' +
                                ' n of previous message'+
                                ' with ''string''',80,' ') );
                window (1,3,80,25);
.E
                repeat
                   readln( S );
                   S := space(S);
                   if Length(S) > 0 then
                   begin
                      val ( word(S,1), i, ecode );
                      if (ecode = 0) and (word(S,2) = ',') then
                      begin
                         j  := WordInd (S, 3);
                         Ts := rword ( Ts , i,
                              copy ( S, j, Length(S)-j+1) );
                         Writeln ( Ts );
                      end
                      else
                      begin
                         Ts := S;
                         Writeln ( S );
                         i := 1 + Random(Words(Ts));
                      end;
                      GotoXY( WordInd(Ts,i), WhereY );
                      writeln( #004 );
                      Writeln( 'There are ',words(Ts),
                               ' words in your message.');
                      Writeln('There are ',length(word(Ts,i)),
                              ' characters in word ',i);
                   end (*  Length > 0 *);
                until (S = 'Q') or (S = 'q');
                window (1,1,80,25);

             END (*  Xwords *).
.E