home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Sunny 1,000 Collection
/
SUNNY1000.iso
/
Files
/
Dos
/
boardlz
/
YAHWHO.ZIP
/
YAHWHO1.PAS
< prev
Wrap
Pascal/Delphi Source File
|
1993-06-18
|
8KB
|
249 lines
Unit YahWho1;
{ Global Declarations unit}
interface
uses Dos,App,Views,Objects,HelpFile;
type
TSound = record
Hz : word;
Wait : word;
end;
const
ConfigName = 'YAHWHO.CFG';
HelpName = 'YAHWHO.HLP';
Top10Name = 'YAHWHO.SCO';
HOFName = 'YAHWHO.HOF';
{The command list}
cmAbout = 200;
cmNewGame = 201;
cmNewPlayer = 202;
cmSaveGame = 203;
cmLoadGame = 204;
cmRollDie = 205;
cmRollDone = 206;
cmScored = 207;
cmYahtzee = 208;
cmNewTotal = 209;
cmShowWinner = 210;
cmShowTop10 = 211;
cmShowHall = 212;
cmReset = 213;
cmColors = 214;
cmRstColors = 215;
cmSaveConfig = 216;
cmPrefs = 217;
cmSelectAll = 218;
cmDeSelectAll = 219;
cmShowBonus = 220;
{User-defined Option bits}
ofDie = 1 shl 15;
ofScore = 1 shl 14;
ofGameWindow = 1 shl 13;
{Misc constants}
DiceSetSize : TPoint = (X:14; Y:21);
ScoreBoardSize : TPoint = (X:27; Y:20);
HOF_Threshold = 300; {Hall of Fame entry score}
GWinCmds = [cmTile,cmCascade,cmNext,cmPrev];
{ Handling color is one of the most confusing and poorly documented
aspects of Turbo Vision. Don't mess around with these constants unless
you really have a grip on these concepts.
Modified standard palette in Unit App as follows:
Entries 8 through 15 are used by game windows.
8 9 10 11 12 13 14 15
╔════╤════╤════╤════╤════╤════╤════╤════╗
CAppColor ║$13 │$1F │$1A │$1B │$1E │$30 │$60 │$00 ║
╠════╪════╪════╪════╪════╪════╪════╪════╣
CAppBlackWhite ║$07 │$0F │$07 │$07 │$0F │$70 │$70 │$00 ║
╠════╪════╪════╪════╪════╪════╪════╪════╣
CAppMonochrome ║$07 │$0F │$07 │$07 │$70 │$70 │$70 │$00 ║
╚══╤═╧══╤═╧══╤═╧══╤═╧══╤═╧══╤═╧══╤═╧══╤═╝
Frame Passive───┘ │ │ │ │ │ │ └─Reserved
Frame Active─────────┘ │ │ │ │ └──────Selected Dice
│ │ │ │
Frame Icon────────────────┘ │ │ └───────────Normal Dice
Normal Score ─────────────────┘ └────────────────HiLite Score
CAppColor:
Position Value Color
~~~~~~~~ ~~~~~ ~~~~~~~~~~~~~
8 $13 Cyan on Blue
11 $1B Light Cyan on Blue
12 $1E Yellow on Blue
13 $30 Black on Cyan
14 $60 Black on Brown
CAppBlackWhite:
11 $07 White on Black
12 $0F Bright White on Black
13 $70 Black on White
CAppMonochrome: (Used in LCD mode also)
4 $70 Black on White (Menu shortcut letters)
11 $07 White on Black
12 $70 Black on White
13 $70 Black on White
}
CAppColor =
#$71#$30#$38#$34#$20#$28#$24#$13#$1F#$1A#$1B#$1E#$30#$60#$1F#$37 +
#$3F#$3A#$13#$13#$3E#$21#$3F#$70#$7F#$7A#$13#$13#$70#$7F#$7E#$70 +
#$7F#$7A#$13#$13#$70#$70#$7F#$7E#$20#$2B#$2F#$78#$2E#$70#$30#$3F +
#$3E#$1F#$2F#$1A#$20#$72#$31#$31#$30#$2F#$3E#$31#$13#$38#$00#$57 +
#$5F#$5C#$71#$71#$5E#$57#$5F#$5E#$10#$1B#$1F#$78#$1E#$50#$30#$3F +
#$3E#$70#$2F#$7A#$20#$52#$31#$31#$30#$2F#$3E#$31#$53#$38#$00#$37 +
#$3F#$3A#$13#$13#$3E#$30#$3F#$3E#$20#$2B#$2F#$78#$2E#$30#$70#$7F +
#$7E#$1F#$2F#$1A#$20#$32#$31#$71#$70#$2F#$7E#$71#$13#$38#$00;
CAppBlackWhite =
#$70#$70#$78#$7F#$07#$07#$0F#$07#$0F#$07#$07#$0F#$70#$70#$0F#$07 +
#$0F#$07#$70#$70#$07#$70#$0F#$70#$7F#$7F#$70#$07#$70#$07#$0F#$70 +
#$7F#$7F#$70#$07#$70#$70#$7F#$7F#$07#$0F#$0F#$78#$0F#$78#$07#$0F +
#$0F#$0F#$70#$0F#$07#$70#$70#$70#$07#$70#$0F#$07#$07#$78#$00#$07 +
#$0F#$0F#$07#$70#$07#$07#$0F#$0F#$70#$78#$7F#$08#$7F#$08#$70#$7F +
#$7F#$7F#$0F#$70#$70#$07#$70#$70#$70#$07#$7F#$70#$07#$78#$00#$70 +
#$7F#$7F#$70#$07#$70#$70#$7F#$7F#$07#$0F#$0F#$78#$0F#$78#$07#$0F +
#$0F#$0F#$70#$0F#$07#$70#$70#$70#$07#$70#$0F#$07#$07#$78#$00;
CAppMonochrome =
#$70#$07#$07#$70#$70#$70#$70#$07#$0F#$07#$07#$70#$70#$70#$00#$07 +
#$0F#$07#$70#$70#$07#$70#$00#$70#$70#$70#$07#$07#$70#$07#$00#$70 +
#$70#$70#$07#$07#$70#$70#$70#$0F#$07#$07#$0F#$70#$0F#$70#$07#$0F +
#$0F#$07#$70#$07#$07#$70#$07#$07#$07#$70#$0F#$07#$07#$70#$00#$70 +
#$70#$70#$07#$07#$70#$70#$70#$0F#$07#$07#$0F#$70#$0F#$70#$07#$0F +
#$0F#$07#$70#$07#$07#$70#$07#$07#$07#$70#$0F#$07#$07#$70#$00#$70 +
#$70#$70#$07#$07#$70#$70#$70#$0F#$07#$07#$0F#$70#$0F#$70#$07#$0F +
#$0F#$07#$70#$07#$07#$70#$07#$07#$07#$70#$0F#$07#$07#$70#$00;
CNewColor = CAppColor + CHelpColor;
CNewBlackWhite = CAppBlackWhite + CHelpBlackWhite;
CNewMonochrome = CAppMonochrome + CHelpMonochrome;
type
TAppPal = array[apColor..apMonochrome] of string[Length(CNewColor)];
const
{This default palette is never changed. It is used to initialize the
active palette, ActivePal, during TYahWho.Init. It is also used to reset
ActivePal if the Reset button is selected in the Colors Dialog. When the
user selects custom colors, it is ActivePal they are modifying. ActivePal
gets written to disk when the configuration is saved, and is read back
in during program initialization.}
DefaultPal : TAppPal = (CNewColor, CNewBlackWhite, CNewMonochrome);
Bleep : array[0..1] of TSound = (
(Hz:75; Wait:100),
(Hz:600; Wait:50));
Bells : array[0..2] of TSound = (
(Hz:500; Wait:100),
(Hz:100; Wait:300),
(Hz:50; Wait:300));
Top10 : array[0..12] of TSound = (
(Hz:200; Wait:100),
(Hz:210; Wait:100),
(Hz:220; Wait:100),
(Hz:230; Wait:100),
(Hz:240; Wait:100),
(Hz:250; Wait:100),
(Hz:260; Wait:100),
(Hz:250; Wait:100),
(Hz:240; Wait:100),
(Hz:230; Wait:100),
(Hz:220; Wait:100),
(Hz:210; Wait:100),
(Hz:200; Wait:100));
DiceRoll : array[0..4] of TSound = (
(Hz:50; Wait:100),
(Hz:100; Wait:100),
(Hz:50; Wait:100),
(Hz:100; Wait:100),
(Hz:50; Wait:100));
Yahtzee : array[0..5] of TSound = (
(Hz:165; Wait:200), {E}
(Hz:220; Wait:200), {A}
(Hz:277; Wait:200), {C#}
(Hz:329; Wait:300), {E}
(Hz:277; Wait:180), {C#}
(Hz:329; Wait:400)); {E}
var
WinNumber : integer; {Managed by TYahWho.Idle}
GameOver,LCD,SoundOn : boolean; {Configuration flags}
ActivePal : TAppPal; {The application palette}
OrigDir : DirStr; {Initialized by TYahWho.Awaken to the home dir}
function Today : string;
procedure Tune(const S : Array of TSound);
function Exists(FileName: FNameStr): Boolean;
implementation
uses Crt;
function Today : string;
var
Year,Month,Day,DOW : word;
S : string[2];
DateStr : string[8];
begin
GetDate(Year,Month,Day,DOW);
Year := Year mod 100;
Str(Month:2,S);
if S[1]=' ' then S[1]:='0';
DateStr := S + '/';
Str(Day:2,S);
if S[1]=' ' then S[1]:='0';
DateStr := DateStr + S + '/';
Str(Year:2,S);
if S[1]=' ' then S[1] := '0';
DateStr := DateStr + S;
Today := DateStr;
end;
procedure Tune;
var
i : word;
begin
if SoundOn then
for i:=0 to High(S) do
with S[i] do
begin
Sound(Hz); Delay(Wait); NoSound;
end;
end;
function Exists(FileName: FNameStr): Boolean;
var
F: file;
Attr: Word;
begin
Assign(F, FileName);
GetFAttr(F, Attr);
Exists := DosError = 0;
end;
end.