home *** CD-ROM | disk | FTP | other *** search
/ CD PowerPlay 6 / TheCompleteAdventureCollection1995 / CDPP6.ISO / utility / agtsrc / title.pa4 < prev    next >
Encoding:
Text File  |  1994-05-19  |  7.0 KB  |  198 lines
  1.  
  2.   {TITLE.PA2}
  3.  
  4.   { SetColors }
  5.  
  6.   PROCEDURE SetColors(Sen : s);
  7.  
  8.     FUNCTION ColorNumber(ColorName : words) : Integer;
  9.     VAR TempNum : Integer;
  10.     BEGIN
  11.       TempNum := -1;              {default value for errors, mis-spellings, etc.}
  12.       IF ColorName = 'BLACK' THEN TempNum := BLACK;
  13.       IF ColorName = 'GREEN' THEN TempNum := GREEN;
  14.       IF ColorName = 'CYAN' THEN TempNum := CYAN;
  15.       IF ColorName = 'RED' THEN TempNum := RED;
  16.       IF ColorName = 'MAGENTA' THEN TempNum := MAGENTA;
  17.       IF ColorName = 'BROWN' THEN TempNum := BROWN;
  18.       IF ColorName = 'LIGHTGRAY' THEN TempNum := LIGHTGRAY;
  19.       IF ColorName = 'DARKGRAY' THEN TempNum := DARKGRAY;
  20.       IF ColorName = 'LIGHTBLUE' THEN TempNum := LIGHTBLUE;
  21.       IF ColorName = 'LIGHTGREEN' THEN TempNum := LIGHTGREEN;
  22.       IF ColorName = 'LIGHTCYAN' THEN TempNum := LIGHTCYAN;
  23.       IF ColorName = 'LIGHTRED' THEN TempNum := LIGHTRED;
  24.       IF ColorName = 'LIGHTMAGENTA' THEN TempNum := LIGHTMAGENTA;
  25.       IF ColorName = 'YELLOW' THEN TempNum := YELLOW;
  26.       IF ColorName = 'WHITE' THEN TempNum := WHITE;
  27.       IF ColorName = 'BLUE' THEN TempNum := BLUE;
  28.       ColorNumber := TempNum;
  29.     END;                          {ColorNumber}
  30.  
  31.   LABEL Done;
  32.   VAR TempWord : words;
  33.     TempSen : s;
  34.     TempNum : Integer;
  35.     Spot : Integer;
  36.  
  37.   BEGIN                           {SetColors}
  38.     TempSen := Sen;
  39.     {set default colors -- depending on type of screen adapter}
  40.     IF (DisplayMode = Mono) OR (POS('MONO', TempSen) <> 0)
  41.     THEN BEGIN                    {Mono}
  42.       NormalTextColor := LIGHTGRAY;
  43.       NormalTextBackground := BLACK;
  44.       HighLightTextColor := WHITE;
  45.       ReverseTextColor := BLACK;
  46.       ReverseTextBackground := LIGHTGRAY;
  47.     END
  48.     ELSE IF (POS('DEFAULT', TempSen) <> 0)
  49.     THEN BEGIN                    {Default Colors}
  50.       NormalTextColor := 3;       {Cyan}
  51.       NormalTextBackground := 0;  {Black}
  52.       HighLightTextColor := 14;   {Yellow}
  53.       ReverseTextColor := 4;      {Red}
  54.       ReverseTextBackground := 7; {LightGray}
  55.     END
  56.     ELSE BEGIN                    {Specifing Color Combination of some sort}
  57.       TempSen := But_First(TempSen); {Strip off 'COLOR(S)'}
  58.       TempWord := first_word(TempSen);
  59.       IF TempWord = '' THEN GOTO Done;
  60.       TempNum := ColorNumber(TempWord);
  61.       IF TempNum = -1 THEN GOTO Done;
  62.       NormalTextColor := TempNum MOD 16;
  63.       TempSen := But_First(TempSen);
  64.       TempWord := first_word(TempSen);
  65.       IF TempWord = '' THEN GOTO Done;
  66.       TempNum := ColorNumber(TempWord);
  67.       IF TempNum = -1 THEN GOTO Done;
  68.       HighLightTextColor := TempNum MOD 16;
  69.       TempSen := But_First(TempSen);
  70.       TempWord := first_word(TempSen);
  71.       IF TempWord = '' THEN GOTO Done;
  72.       TempNum := ColorNumber(TempWord);
  73.       IF TempNum = -1 THEN GOTO Done;
  74.       NormalTextBackground := TempNum MOD 8;
  75.       TempSen := But_First(TempSen);
  76.       TempWord := first_word(TempSen);
  77.       IF TempWord = '' THEN GOTO Done;
  78.       TempNum := ColorNumber(TempWord);
  79.       IF TempNum = -1 THEN GOTO Done;
  80.       ReverseTextColor := TempNum MOD 16;
  81.       TempSen := But_First(TempSen);
  82.       TempWord := first_word(TempSen);
  83.       IF TempWord = '' THEN GOTO Done;
  84.       TempNum := ColorNumber(TempWord);
  85.       IF TempNum = -1 THEN GOTO Done;
  86.       ReverseTextBackground := TempNum MOD 8;
  87.     END;                          {color}
  88. Done:
  89.   END;                            {SetColors}
  90.  
  91.  
  92.   PROCEDURE CheckForColor(VAR sentence : s);
  93.   VAR Temp : s;
  94.   BEGIN
  95.     Temp := sentence;
  96.     Capitalize(Temp);
  97.     IF POS('COLOR', Temp) <> 0
  98.     THEN BEGIN
  99.       SetColors(Temp);
  100.       sentence := '';             {Return nil sentence instead of COLOR info}
  101.     END;
  102.   END;                            {CheckForColor}
  103.  
  104.  
  105.   { Title }
  106.   {Print the title screen: }
  107.   {First, if the user has provided a }
  108.   {file TITLE.TTL, display that, pausing}
  109.   {if necessary. Then, print the AGT }
  110.   {copyright/credit information. }
  111.  
  112.   PROCEDURE Title;
  113.  
  114.     { Center }
  115.     {Write the string of text centered}
  116.     {on an 80-column display. }
  117.  
  118.     PROCEDURE center(st : s);
  119.     CONST Blanks = '                                            ';
  120.     VAR i : Integer;
  121.     BEGIN
  122.       IF morecount >= 23 THEN BEGIN
  123.         Pause;
  124.         morecount := 0;
  125.       END;
  126.       {delete leading blanks}
  127.       IF Length(st) > 1 THEN WHILE st[1] = ' ' DO
  128.         st := Copy(st, 2, Length(st)-1);
  129.       FOR i := 1 TO Length(st) DO {Swap # and solid block of color}
  130.         IF st[i] = '#' THEN st[i] := Chr(219); 
  131.       Write(IO, Copy(Blanks, 1, (80-Length(st)) DIV 2));
  132.       WriteLn(IO, st);
  133.       morecount := morecount+1;
  134.     END;                          {center}
  135.  
  136.   CONST
  137.   {$IFDEF NormalVersion}
  138.     cw1 = 'The Adventure Game Toolkit (AGT) 1.7';
  139.   {$ELSE}
  140.     cw1 = 'The BIG Adventure Game Toolkit (AGT) 1.7';
  141.   {$ENDIF}
  142.     cw2 = 'Copyright 1994 -- All Rights Reserved';
  143.     cw3 = 'by David R. Malmberg and Mark J. Welch';
  144.     cw4 = 'AGT is distributed as "Freeware" and you are free to use it as you wish.';
  145.  
  146.   VAR titlefile : Text;
  147.     sentence, TempSen : s;
  148.     w, LowStr, HighStr, TempWord : words;
  149.     fn : Text;
  150.     DataFileBytes, CmdFileBytes, MinTime, MaxTime : Real;
  151.     LowMin, HighMin, TempNum : Integer;
  152.     datafile : FILE;
  153.   BEGIN                           {title}
  154.     {set default colors -- depending on type of screen adapter}
  155.     Word_Chars := ['0'..'9', 'A'..'Z', 'a'..'z', '-', '_'];
  156.     {Necessary for first_word and But_First to work properly}
  157.     SetColors('DEFAULT');
  158.     Scripting := False;           {turn off -- to start}
  159.     WriteLn(IO, ' ');
  160.     morecount := 1;
  161.     w := title_file_name;
  162.     IF (File_Exists(w)) THEN
  163.       BEGIN
  164.         Assign(titlefile, w);
  165.         Reset(titlefile);
  166.         ReadLn(titlefile, sentence);
  167.         CheckForColor(sentence);  {COLOR command should be in first line of file}
  168.         CLRSCR;                   {clear the screen so nothing distracts user from title}
  169.         highlight;                {use highlighted colors for actual title}
  170.         CLRSCR;
  171.         IF NOT EOF(titlefile) THEN
  172.           REPEAT
  173.             IF sentence = ''
  174.             THEN WriteLn
  175.             ELSE center(sentence);
  176.             ReadLn(titlefile, sentence);
  177.             CheckForColor(sentence);
  178.             highlight;            {if COLOR has changed}
  179.           UNTIL (sentence = 'END OF FILE') OR EOF(titlefile);
  180.         Close(titlefile);
  181.       END;                        {if title file exists then}
  182.     normal;                       {use normal colors}
  183.     WriteLn(IO, ' ');
  184.     morecount := morecount+1;
  185.     center('Created using: '+cw1);
  186.     center(cw2);
  187.     center(cw3);
  188.     Write(IO, ' ');
  189.     center(cw4);
  190.     Write(IO, ' ');
  191.     morecount := morecount+2;
  192.     DELAY(5000);                  {give user at least 5 seconds to read title}
  193.     IF UsingFinalVersion
  194.     THEN center('Reading data, please wait (should take 10 to 15 seconds)');
  195.     morecount := 1;               {initialization will take enough time to read screen}
  196.   END;                            {title}
  197.  
  198.