home *** CD-ROM | disk | FTP | other *** search
/ Aztec Shareware Collection / AZ_096.ISO / yahwho / yahwho1.pas < prev   
Pascal/Delphi Source File  |  1993-06-18  |  8KB  |  249 lines
  1. Unit YahWho1;
  2.  
  3. { Global Declarations unit}
  4.  
  5. interface
  6. uses Dos,App,Views,Objects,HelpFile;
  7.  
  8. type
  9.   TSound = record
  10.     Hz   : word;
  11.     Wait : word;
  12.   end;
  13.  
  14. const
  15.   ConfigName = 'YAHWHO.CFG';
  16.   HelpName   = 'YAHWHO.HLP';
  17.   Top10Name  = 'YAHWHO.SCO';
  18.   HOFName    = 'YAHWHO.HOF';
  19.  
  20.   {The command list}
  21.  
  22.   cmAbout     = 200;
  23.   cmNewGame   = 201;
  24.   cmNewPlayer = 202;
  25.   cmSaveGame  = 203;
  26.   cmLoadGame  = 204;
  27.   cmRollDie   = 205;
  28.   cmRollDone  = 206;
  29.   cmScored    = 207;
  30.   cmYahtzee   = 208;
  31.   cmNewTotal  = 209;
  32.   cmShowWinner = 210;
  33.   cmShowTop10  = 211;
  34.   cmShowHall   = 212;
  35.   cmReset      = 213;
  36.   cmColors     = 214;
  37.   cmRstColors  = 215;
  38.   cmSaveConfig = 216;
  39.   cmPrefs      = 217;
  40.   cmSelectAll  = 218;
  41.   cmDeSelectAll  = 219;
  42.   cmShowBonus  = 220;
  43.  
  44.   {User-defined Option bits}
  45.  
  46.   ofDie       = 1 shl 15;
  47.   ofScore     = 1 shl 14;
  48.   ofGameWindow = 1 shl 13;
  49.  
  50.   {Misc constants}
  51.  
  52.   DiceSetSize    : TPoint = (X:14; Y:21);
  53.   ScoreBoardSize : TPoint = (X:27; Y:20);
  54.  
  55.   HOF_Threshold = 300; {Hall of Fame entry score}
  56.  
  57.   GWinCmds = [cmTile,cmCascade,cmNext,cmPrev];
  58.  
  59. { Handling color is one of the most confusing and poorly documented
  60. aspects of Turbo Vision. Don't mess around with these constants unless
  61. you really have a grip on these concepts.
  62.  
  63. Modified standard palette in Unit App as follows:
  64.  
  65.       Entries 8 through 15 are used by game windows.
  66.  
  67.                      8    9   10   11   12   13   14   15
  68.                   ╔════╤════╤════╤════╤════╤════╤════╤════╗
  69.      CAppColor    ║$13 │$1F │$1A │$1B │$1E │$30 │$60 │$00 ║
  70.                   ╠════╪════╪════╪════╪════╪════╪════╪════╣
  71.   CAppBlackWhite  ║$07 │$0F │$07 │$07 │$0F │$70 │$70 │$00 ║
  72.                   ╠════╪════╪════╪════╪════╪════╪════╪════╣
  73.   CAppMonochrome  ║$07 │$0F │$07 │$07 │$70 │$70 │$70 │$00 ║
  74.                   ╚══╤═╧══╤═╧══╤═╧══╤═╧══╤═╧══╤═╧══╤═╧══╤═╝
  75.      Frame Passive───┘    │    │    │    │    │    │    └─Reserved
  76.      Frame Active─────────┘    │    │    │    │    └──────Selected Dice
  77.                                │    │    │    │
  78.      Frame Icon────────────────┘    │    │    └───────────Normal Dice
  79.      Normal Score  ─────────────────┘    └────────────────HiLite Score
  80.  
  81. CAppColor:
  82.  
  83.   Position      Value         Color
  84.   ~~~~~~~~      ~~~~~      ~~~~~~~~~~~~~
  85.      8           $13       Cyan on Blue
  86.     11           $1B       Light Cyan on Blue
  87.     12           $1E       Yellow on Blue
  88.     13           $30       Black on Cyan
  89.     14           $60       Black on Brown
  90.  
  91. CAppBlackWhite:
  92.  
  93.     11           $07       White on Black
  94.     12           $0F       Bright White on Black
  95.     13           $70       Black on White
  96.  
  97. CAppMonochrome: (Used in LCD mode also)
  98.  
  99.      4           $70       Black on White (Menu shortcut letters)
  100.     11           $07       White on Black
  101.     12           $70       Black on White
  102.     13           $70       Black on White
  103.  
  104. }
  105.  
  106. CAppColor =
  107.   #$71#$30#$38#$34#$20#$28#$24#$13#$1F#$1A#$1B#$1E#$30#$60#$1F#$37 +
  108.   #$3F#$3A#$13#$13#$3E#$21#$3F#$70#$7F#$7A#$13#$13#$70#$7F#$7E#$70 +
  109.   #$7F#$7A#$13#$13#$70#$70#$7F#$7E#$20#$2B#$2F#$78#$2E#$70#$30#$3F +
  110.   #$3E#$1F#$2F#$1A#$20#$72#$31#$31#$30#$2F#$3E#$31#$13#$38#$00#$57 +
  111.   #$5F#$5C#$71#$71#$5E#$57#$5F#$5E#$10#$1B#$1F#$78#$1E#$50#$30#$3F +
  112.   #$3E#$70#$2F#$7A#$20#$52#$31#$31#$30#$2F#$3E#$31#$53#$38#$00#$37 +
  113.   #$3F#$3A#$13#$13#$3E#$30#$3F#$3E#$20#$2B#$2F#$78#$2E#$30#$70#$7F +
  114.   #$7E#$1F#$2F#$1A#$20#$32#$31#$71#$70#$2F#$7E#$71#$13#$38#$00;
  115.  
  116. CAppBlackWhite =
  117.   #$70#$70#$78#$7F#$07#$07#$0F#$07#$0F#$07#$07#$0F#$70#$70#$0F#$07 +
  118.   #$0F#$07#$70#$70#$07#$70#$0F#$70#$7F#$7F#$70#$07#$70#$07#$0F#$70 +
  119.   #$7F#$7F#$70#$07#$70#$70#$7F#$7F#$07#$0F#$0F#$78#$0F#$78#$07#$0F +
  120.   #$0F#$0F#$70#$0F#$07#$70#$70#$70#$07#$70#$0F#$07#$07#$78#$00#$07 +
  121.   #$0F#$0F#$07#$70#$07#$07#$0F#$0F#$70#$78#$7F#$08#$7F#$08#$70#$7F +
  122.   #$7F#$7F#$0F#$70#$70#$07#$70#$70#$70#$07#$7F#$70#$07#$78#$00#$70 +
  123.   #$7F#$7F#$70#$07#$70#$70#$7F#$7F#$07#$0F#$0F#$78#$0F#$78#$07#$0F +
  124.   #$0F#$0F#$70#$0F#$07#$70#$70#$70#$07#$70#$0F#$07#$07#$78#$00;
  125.  
  126. CAppMonochrome =
  127.   #$70#$07#$07#$70#$70#$70#$70#$07#$0F#$07#$07#$70#$70#$70#$00#$07 +
  128.   #$0F#$07#$70#$70#$07#$70#$00#$70#$70#$70#$07#$07#$70#$07#$00#$70 +
  129.   #$70#$70#$07#$07#$70#$70#$70#$0F#$07#$07#$0F#$70#$0F#$70#$07#$0F +
  130.   #$0F#$07#$70#$07#$07#$70#$07#$07#$07#$70#$0F#$07#$07#$70#$00#$70 +
  131.   #$70#$70#$07#$07#$70#$70#$70#$0F#$07#$07#$0F#$70#$0F#$70#$07#$0F +
  132.   #$0F#$07#$70#$07#$07#$70#$07#$07#$07#$70#$0F#$07#$07#$70#$00#$70 +
  133.   #$70#$70#$07#$07#$70#$70#$70#$0F#$07#$07#$0F#$70#$0F#$70#$07#$0F +
  134.   #$0F#$07#$70#$07#$07#$70#$07#$07#$07#$70#$0F#$07#$07#$70#$00;
  135.  
  136. CNewColor      = CAppColor      + CHelpColor;
  137. CNewBlackWhite = CAppBlackWhite + CHelpBlackWhite;
  138. CNewMonochrome = CAppMonochrome + CHelpMonochrome;
  139.  
  140. type
  141.   TAppPal = array[apColor..apMonochrome] of string[Length(CNewColor)];
  142.  
  143. const
  144.   {This default palette is never changed. It is used to initialize the
  145.   active palette, ActivePal, during TYahWho.Init. It is also used to reset
  146.   ActivePal if the Reset button is selected in the Colors Dialog. When the
  147.   user selects custom colors, it is ActivePal they are modifying. ActivePal
  148.   gets written to disk when the configuration is saved, and is read back
  149.   in during program initialization.}
  150.  
  151.   DefaultPal : TAppPal = (CNewColor, CNewBlackWhite, CNewMonochrome);
  152.  
  153.  
  154.   Bleep : array[0..1] of TSound = (
  155.     (Hz:75; Wait:100),
  156.     (Hz:600; Wait:50));
  157.  
  158.   Bells : array[0..2] of TSound = (
  159.    (Hz:500; Wait:100),
  160.    (Hz:100; Wait:300),
  161.    (Hz:50;  Wait:300));
  162.  
  163.   Top10 : array[0..12] of TSound = (
  164.    (Hz:200; Wait:100),
  165.    (Hz:210; Wait:100),
  166.    (Hz:220; Wait:100),
  167.    (Hz:230; Wait:100),
  168.    (Hz:240; Wait:100),
  169.    (Hz:250; Wait:100),
  170.    (Hz:260; Wait:100),
  171.    (Hz:250; Wait:100),
  172.    (Hz:240; Wait:100),
  173.    (Hz:230; Wait:100),
  174.    (Hz:220; Wait:100),
  175.    (Hz:210; Wait:100),
  176.    (Hz:200; Wait:100));
  177.  
  178.   DiceRoll : array[0..4] of TSound = (
  179.    (Hz:50; Wait:100),
  180.    (Hz:100; Wait:100),
  181.    (Hz:50; Wait:100),
  182.    (Hz:100; Wait:100),
  183.    (Hz:50; Wait:100));
  184.  
  185.   Yahtzee : array[0..5] of TSound = (
  186.    (Hz:165; Wait:200),   {E}
  187.    (Hz:220; Wait:200),   {A}
  188.    (Hz:277; Wait:200),   {C#}
  189.    (Hz:329; Wait:300),   {E}
  190.    (Hz:277; Wait:180),   {C#}
  191.    (Hz:329; Wait:400));  {E}
  192.  
  193. var
  194.   WinNumber : integer;  {Managed by TYahWho.Idle}
  195.   GameOver,LCD,SoundOn  : boolean;  {Configuration flags}
  196.   ActivePal  : TAppPal; {The application palette}
  197.   OrigDir : DirStr;     {Initialized by TYahWho.Awaken to the home dir}
  198.  
  199. function Today : string;
  200. procedure Tune(const S : Array of TSound);
  201. function Exists(FileName: FNameStr): Boolean;
  202.  
  203. implementation
  204. uses Crt;
  205.  
  206. function Today : string;
  207. var
  208.   Year,Month,Day,DOW : word;
  209.   S : string[2];
  210.   DateStr : string[8];
  211. begin
  212.   GetDate(Year,Month,Day,DOW);
  213.   Year := Year mod 100;
  214.   Str(Month:2,S);
  215.   if S[1]=' ' then S[1]:='0';
  216.   DateStr := S + '/';
  217.   Str(Day:2,S);
  218.   if S[1]=' ' then S[1]:='0';
  219.   DateStr := DateStr + S + '/';
  220.   Str(Year:2,S);
  221.   if S[1]=' ' then S[1] := '0';
  222.   DateStr := DateStr + S;
  223.   Today := DateStr;
  224. end;
  225.  
  226. procedure Tune;
  227. var
  228.   i : word;
  229. begin
  230.   if SoundOn then
  231.     for i:=0 to High(S) do
  232.     with S[i] do
  233.     begin
  234.       Sound(Hz); Delay(Wait); NoSound;
  235.     end;
  236. end;
  237.  
  238. function Exists(FileName: FNameStr): Boolean;
  239. var
  240.   F: file;
  241.   Attr: Word;
  242. begin
  243.   Assign(F, FileName);
  244.   GetFAttr(F, Attr);
  245.   Exists := DosError = 0;
  246. end;
  247.  
  248. end.
  249.