home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS - Coast to Coast / simteldosarchivecoasttocoast.iso / pcmag / vol9n21.zip / DGDIALOG.PAS < prev    next >
Pascal/Delphi Source File  |  1990-09-25  |  54KB  |  1,479 lines

  1. {
  2.  ▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄
  3.  █                                                                         █
  4.  █        TITLE :      DGDIALOG.TPU                                        █
  5.  █      PURPOSE :      Dialog Boxes and Message Routines.                  █
  6.  █       AUTHOR :      David Gerrold, CompuServe ID:  70307,544            █
  7.  █ ______________________________________________________________________  █
  8.  █                                                                         █
  9.  █   Written in Turbo Pascal, Version 5.5,                                 █
  10.  █   with routines from TurboPower, Object Professional.                   █
  11.  █                                                                         █
  12.  █   Turbo Pascal is a product of Borland International.                   █
  13.  █   Object Professional is a product of TurboPower Software.              █
  14.  █ ______________________________________________________________________  █
  15.  █                                                                         █
  16.  █   This is not public domain software.                                   █
  17.  █   This software is copyright (c) 1990, by David Gerrold.                █
  18.  █   Permission is hereby granted for personal use.                        █
  19.  █                                                                         █
  20.  █        The Brass Cannon Corporation                                     █
  21.  █        9420 Reseda Blvd., #804                                          █
  22.  █        Northridge, CA  91324-2932.                                      █
  23.  █                                                                         █
  24.  ▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀
  25.                                                                             }
  26. { Compiler Directives ===================================================== }
  27.  
  28. {$A-}    {Switch word alignment off, necessary for cloning}
  29. {$R-}    {Range checking off}
  30. {$B-}    {Boolean complete evaluation off}
  31. {$S-}    {Stack checking off}
  32. {$I-}    {I/O checking off}
  33. {$N+,E+} {Simulate numeric coprocessor}
  34. {$M 16384,0,327680} {stack and heap}
  35. {$V-}    {Variable range checking off}
  36.  
  37. { Name ==================================================================== }
  38.  
  39. UNIT DgDialog;
  40. {
  41.   The purpose of DgDialog is to provide a Dialog Box object and several
  42.   basic implementations of it.  Also included are several other message
  43.   routines.
  44. }
  45.  
  46. { Interface =============================================================== }
  47.  
  48. INTERFACE
  49.  
  50. USES
  51. { Object Professional Units }
  52.   OpDos,
  53.   OpDate,
  54.   OpCmd,
  55.   OpColor,
  56.   OpCrt,
  57.   OpFrame,
  58.   OpInline,
  59.   OpMenu,
  60.   OpMouse,
  61.   OpRoot,
  62.   OpString,
  63.   OpWindow,
  64.  
  65. { DgUnits }
  66.   DgMath,
  67.   DgWryte,
  68.   DgSound,
  69.   DgDate,
  70.   DgFile,
  71.   DgReboot,
  72.   DgDec,
  73.   DgStr;
  74.  
  75. { Declarations ============================================================ }
  76. { Dialog Box declarations ------------------------------------------------- }
  77.  
  78. TYPE
  79.   Coords = Record                                { for windows }
  80.              Left, Top, Right, Bottom : byte;
  81.              end;
  82.  
  83.   DbColorSet = Record
  84.                  TextAttr, FrameAttr, MonoAttr : byte;
  85.                  end;
  86.  
  87.   DialogBoxPtr = ^DialogBoxOb;
  88.   DialogBoxOb = Object
  89.     W1,                                          { outer window }
  90.     W2        : ^RawWindow;                      { inner window }
  91.     W1Coords,
  92.     W2Coords  : Coords;                          { window coordinates }
  93.     DbWidth   : byte;                            { width of dialog area }
  94.     DbHeight  : byte;                            { height of dialog area }
  95.  
  96.     DbMsg     : string;                          { the actual dialog }
  97.     DbColors  : DbColorSet;                      { local color set }
  98.     DbOptions : word;                            { toggles }
  99.  
  100.     Constructor Init (Msg     : string;          { store the parameters }
  101.                       Colors  : DbColorSet;
  102.                       Options : byte;
  103.                       Width   : byte);
  104.     Destructor  Done;                            { close and dispose }
  105.     Procedure   SetOptions (Option : word);      { set new options }
  106.     Function    Db (Option : word) : boolean;    { is this option on? }
  107.  
  108.     Procedure   DbBeep;                          { beep cue }
  109.     Procedure   DbClick;                         { click cue }
  110.  
  111.     Procedure   Draw;  virtual;                  { sets loc, calls DrawKernel }
  112.     Procedure   DrawKernel;                      { does actual drawing }
  113.     Procedure   Erase;                           { bye bye box }
  114.     end;
  115.  
  116.   LowDialogBoxPtr = ^LowDialogBoxOb;
  117.   LowDialogBoxOb = Object (DialogBoxOb)
  118.     Procedure   Draw;  virtual;                  { puts box low on screen }
  119.     end;
  120.  
  121.   RandomDialogBoxPtr = ^RandomDialogBoxOb;
  122.   RandomDialogBoxOb = Object (DialogBoxOb)
  123.     Procedure   Draw;  virtual;                  { locates box randomly }
  124.     end;
  125.  
  126. CONST
  127.   GreenDbColorSet : DbColorSet =
  128.     (TextAttr  : WhiteOnGreen;
  129.      FrameAttr : BlackOnGreen;
  130.      MonoAttr  : BlackOnLtGray);
  131.  
  132.   RedDbColorSet : DbColorSet =
  133.     (TextAttr  : WhiteOnRed;
  134.      FrameAttr : BlackOnRed;
  135.      MonoAttr  : BlackOnLtGray);
  136.  
  137.   CyanDbColorSet : DbColorSet =
  138.     (TextAttr  : BlackOnCyan;
  139.      FrameAttr : LtBlueOnCyan;
  140.      MonoAttr  : BlackOnLtGray);
  141.  
  142.   BlueDbColorSet : DbColorSet =
  143.     (TextAttr  : WhiteOnBlue;
  144.      FrameAttr : LtCyanOnBlue;
  145.      MonoAttr  : BlackOnLtGray);
  146.  
  147.   PopDbColorSet : DbColorSet =
  148.     (TextAttr  : WhiteOnBrown;
  149.      FrameAttr : BlackOnBrown;
  150.      MonoAttr  : BlackOnLtGray);
  151.  
  152. { Configure dialog box ---------------------------------------------------- }
  153.  
  154.   DbCues     = $01;                              { beep cues? }
  155.   DbBoxClick = $02;                              { box click? }
  156.   DbMusic    = $04;                              { Music? }
  157.   DbSound    = $07;                              { all sounds }
  158.                                                  { $08 is still free }
  159.   DbJustify  = $10;                              { default is unjustified }
  160.   DbCenter   = $20;                              { default is flush left }
  161.   DbShadow   = $40;                              { add a shadow, if room }
  162.   DbLowBox   = $80;                              { put box low }
  163. {
  164.   To use, pass these values to the DialogBox as Options.
  165.  
  166.   DbJustify will cause text to be justified in the box.  DbCenter will
  167.   cause text to be centered.  DbJustify will have no effect if sent with
  168.   DbCenter;  DbCenter will take precedence.
  169. }
  170.  
  171.   BlBlank        = $01;                          { enable screen blanker }
  172.   BlBlankWarning = $02;                          { enable warning msg }
  173.   BlLock         = $04;                          { enable program lock }
  174.   BlLockWarning  = $08;                          { enable warning msg }
  175.   BlLogFile      = $10;                          { enable log file? }
  176.  
  177.   BlLockSet      = $1F;                          { blank, lock & file }
  178.   BlOptions      : word = BlLockSet;
  179.  
  180. { Program constants ------------------------------------------------------- }
  181.  
  182. CONST
  183.   dgShadowColor : byte = DkGrayOnBlack;          { shadow attr color }
  184.   dgShadowMono  : byte = DkGrayOnBlack;          { shadow attr mono }
  185.  
  186.   LockProgram_Password : string25 = 'Eat a bug'; { unlock program }
  187.   TimeUntilBlank : longint = 180000;             { 3 minute screen blanker }
  188.   BounceBoxWait  : longint = 7500;               { time between bounces }
  189.   PopToggleFlag  : boolean = true;               { show toggles? }
  190.  
  191. { Variables --------------------------------------------------------------- }
  192.  
  193. VAR
  194.   Pause : Procedure;                             { configurable pause proc }
  195.   Yorn  : Function (Msg : string) : boolean;     { configurable yes/no }
  196.   PopMsgProc : Procedure (D : DialogBoxPtr);     { hook to PopMsgBox }
  197.  
  198. { ========================================================================= }
  199. { Functions and Procedures ================================================ }
  200.  
  201. FUNCTION Bl (Option : word) : boolean;
  202. { returns true if BlOption is set }
  203.  
  204. PROCEDURE Wait;
  205. { waits for any keyboard activity }
  206.  
  207. FUNCTION WaitingPatiently (TimeToWait : longint) : boolean;
  208. {
  209.   Returns false if key is pressed before time is up.
  210.   Displays date and time in upper right corner if DbByte clock bit is on.
  211. }
  212.  
  213. FUNCTION InKeyWaiting (TimeToWait : longint) : boolean;
  214. { Returns false if ANY key is pressed before time is up. }
  215.  
  216. PROCEDURE BounceBox (MsgBox : RandomDialogBoxPtr);
  217. { Erases MsgBox and redraws it at a new location. }
  218.  
  219. PROCEDURE ScreenBlanker;
  220. { While WaitingPatiently do ScreenBlanker. . . . }
  221.  
  222. PROCEDURE LockProgram;
  223. { blanks screen, demands password to continue }
  224.  
  225. PROCEDURE NewPassword;
  226. { Gets a new password, puts it in LockProgram_Password. }
  227.  
  228. PROCEDURE PauseMsgLn (Msg : string);
  229. { Sends msg and pauses.  Waits for a keypress. }
  230.  
  231. PROCEDURE PauseLn;
  232. { Prompts:  'Press any key to continue.' }
  233.  
  234. PROCEDURE PauseMsgBox (Msg : string;  Colors : DbColorSet;
  235.                        Options : word;  Width : byte);
  236. { Creates a dialog box with a custom message, waits for any keypress. }
  237.  
  238. PROCEDURE PauseBox;
  239. { Prompts:  'Press any key to continue.' in a dialog box. }
  240.  
  241. PROCEDURE TimedPauseMsg (Msg : string;  Colors : DbColorSet;
  242.                          Options : word;  Width : byte;
  243.                          TimeToWait : longint);
  244. { Creates a dialog box with a custom message, waits for a set time. }
  245.  
  246. PROCEDURE PopDummy (D : DialogBoxPtr);
  247. { Does nothing.  Default procedure for assignment to PopMsgProc. }
  248.  
  249. PROCEDURE PopMsgBox (Msg : string;  Colors : DbColorSet;
  250.                      Options : word;  Width : byte;
  251.                      DialogBox : DialogBoxPtr);
  252. { Creates a dialog box with a custom message, waits for alt-key release. }
  253.  
  254. PROCEDURE PopClock;
  255. { Pops a clock on screen until alt-key is released. }
  256.  
  257. PROCEDURE NotYet (S : string25);
  258. { TimedPauseMsg:  'Sorry, 'S' not implemented yet.' }
  259.  
  260. PROCEDURE Sorry;
  261. { TimedPauseMsg:  'Sorry.  Not implemented yet.' }
  262.  
  263. FUNCTION YornLn (Msg : string) : boolean;
  264. { Prints centered Msg on screen, demands a yes or no answer. }
  265.  
  266. FUNCTION YornBox (Msg : string) : boolean;
  267. { Opens a dialog box, demands a yes or no answer. }
  268.  
  269. PROCEDURE QuitProgram;
  270. { Do you really want to quit?  If yes, halt. }
  271.  
  272. PROCEDURE DoLines;
  273. { set configurable functions for line scrolling }
  274.  
  275. PROCEDURE DoBoxes;
  276. { set configurable functions for boxes }
  277.  
  278. { ========================================================================= }
  279. { Implementation ========================================================== }
  280.  
  281. IMPLEMENTATION
  282.  
  283. { ========================================================================= }
  284. { DialogBoxOb.Init ======================================================== }
  285.  
  286. CONSTRUCTOR DialogBoxOb.Init (Msg     : string;
  287.                               Colors  : DbColorSet;
  288.                               Options : byte;
  289.                               Width   : byte);
  290.  
  291. VAR
  292.   S : ^string;                                   { for internal use }
  293.  
  294. BEGIN
  295. {
  296.   Save all passed parameters.
  297.  
  298.   If the length of the message is less than the width of the dialog
  299.   box, the length of the message will be used as the width of the box.
  300. }
  301.   DbMsg     := Msg;                              { save the message }
  302.   DbColors  := Colors;
  303.   DbOptions := Options;
  304.   DbWidth   := Min (Width, Length (Msg));
  305. {
  306.   Do a dummy wordwrap to compute height of multiple line display.
  307. }
  308.   While DbWidth > (ScreenWidth - 12) do
  309.     dec (DbWidth);                               { trap bad width }
  310.   DbHeight := 0;
  311.   new (S);                                       { allocate memory }
  312.   While Msg > '' do begin                        { While Msg contains text }
  313.     inc (DbHeight);                              { count number of lines }
  314.     WordWrap (Msg, S^, Msg, DbWidth, false);     { needed to wordwrap }
  315.     end;
  316.   dispose (S);                                   { deallocate S }
  317.   W1 := nil;                                     { flush pointers }
  318.   W2 := nil;
  319. END;
  320.  
  321. { DialogBoxOb.Done ======================================================== }
  322.  
  323. DESTRUCTOR DialogBoxOb.Done;
  324.  
  325. BEGIN
  326. {
  327.   Just in case...close windows.
  328. }
  329.   if (W2 <> nil) or (W1 <> nil) then Erase;
  330. END;
  331.  
  332. { DialogBoxOb.SetOptions ================================================== }
  333.  
  334. PROCEDURE DialogBoxOb.SetOptions (Option : word);
  335.  
  336. BEGIN
  337.   DbOptions := Option;
  338. END;
  339.  
  340. { DialogBoxOb.Db ========================================================== }
  341.  
  342. FUNCTION DialogBoxOb.Db (Option : word) : boolean;
  343. { returns true if option is set }
  344.  
  345. BEGIN
  346.   Db := DbOptions and Option = Option;
  347. END;
  348.  
  349. { DialogBoxOb.DbClick ===================================================== }
  350.  
  351. PROCEDURE DialogBoxOb.DbClick;
  352. { dialog box sfx }
  353. BEGIN
  354.   if Db (DbBoxClick) then CueClick;
  355. END;
  356.  
  357. { DialogBoxOb.DbBeep ====================================================== }
  358.  
  359. PROCEDURE DialogBoxOb.DbBeep;
  360. { dialog box sfx }
  361. BEGIN
  362.   IF Db (DbCues) then Beep;
  363. END;
  364.  
  365. { DialogBoxOb.Draw ======================================================== }
  366.  
  367. PROCEDURE DialogBoxOb.Draw;
  368.  
  369. BEGIN
  370. {
  371.   First compute how much space will be needed for the actual dialog
  372.   window.  Then compute the size of the outer border window.
  373.  
  374.   The fastest/easiest way to achieve a wide margin around a frame
  375.   is simply to put the framed window inside a larger unframed one.
  376. }
  377.   with W2Coords do begin                         { inner window coords }
  378.     { vertically centered dialog box }
  379.     Top := (ScreenHeight - DbHeight) div 2;
  380.     Bottom := Succ (Top + DbHeight);
  381.     Left   := pred((ScreenWidth-DbWidth) div 2); { set left side of window }
  382.     Right  := Left + DbWidth + 3;                { and right }
  383.     end;
  384.  
  385.   with W1Coords do begin                         { outer window coords }
  386.     Bottom := W2Coords.Bottom + 2;               { allow space for margins }
  387.     Top    := W2Coords.Top - 2;
  388.     Left   := W2Coords.Left - 5;
  389.     Right  := W2Coords.Right + 5;
  390.     end;
  391.   DrawKernel;
  392. END;
  393.  
  394. { DialogBoxOb.DrawKernel ================================================== }
  395.  
  396. PROCEDURE DialogBoxOb.DrawKernel;
  397.  
  398. VAR
  399.   LocalColorSet : ColorSet;                      { OpWindow color set }
  400.   Msg : ^string;
  401.   Height : byte;
  402.   S : ^string;                                   { for internal use }
  403.   StoreDbOptions : word;
  404.  
  405. BEGIN
  406. {
  407.   Set the attributes of the LocalColorSet.
  408. }
  409.   LocalColorSet.SetFrameAttr (DbColors.FrameAttr, DbColors.MonoAttr);
  410.   LocalColorSet.SetTextAttr (DbColors.TextAttr, DbColors.MonoAttr);
  411.  
  412. {
  413.   Belt and suspenders code.  Don't allow illegal coordinates.
  414. }
  415.   While W1Coords.Bottom > ScreenHeight do begin
  416.     dec (W1Coords.Bottom);
  417.     dec (W2Coords.Bottom);
  418.     end;
  419.   While W1Coords.Right > ScreenWidth do begin
  420.     dec (W1Coords.Right);
  421.     dec (W2Coords.Right);
  422.     end;
  423.   While W1Coords.Top < 1 do begin
  424.     inc (W1Coords.Top);
  425.     inc (W2Coords.Top);
  426.     end;
  427.   While W1Coords.Left < 1 do begin
  428.     inc (W1Coords.Left);
  429.     inc (W2Coords.Left);
  430.     end;
  431. {
  432.   Watch out for shadow.
  433. }
  434.   StoreDbOptions := DbOptions;                   { save options }
  435.   if                                             { if }
  436.     (W1Coords.Bottom = ScreenHeight)             { no room at bottom }
  437.       or                                         { or }
  438.     (W1Coords.Right = ScreenWidth)               { no room at side }
  439.   then                                           { then }
  440.     DbOptions := DbOptions and not DbShadow;     { no shadow }
  441.  
  442.  
  443. {
  444.   Initialize the outer window, set its cursor to hidden, set it to have
  445.   a shadow if there's room for it.
  446. }
  447.   with W1Coords do                               { allocate outer window }
  448.     new (W1, InitCustom (Left, Top, Right, Bottom,
  449.                          LocalColorSet, wclear));
  450.   W1^.SetCursor (cuHidden);                      { hide the cursor }
  451.   W1^.wFrame.SetShadowAttr (dgShadowColor, dgShadowMono, false);
  452.   If (DbOptions and DbShadow = DbShadow) then
  453.     W1^.wFrame.AddShadow (shBR, shSeeThru);      { declare a shadow }
  454.   DbOptions := StoreDbOptions;                   { restore options }
  455.  
  456. {
  457.   Initialize the inner window, set its cursor to hidden, set it to have
  458.   a double-line frame.
  459. }
  460.   with W2Coords do                               { allocate inner window }
  461.     new (W2, InitCustom (Left, Top, Right, Bottom,
  462.                          LocalColorSet, wBordered));
  463.   W2^.SetCursor (cuHidden);                      { hide the cursor }
  464.   FramePtr (W2^.MainFramePtr)^.SetFrameType (DblWindowFrame);
  465.  
  466. {
  467.   The Opro manual (page 4-89) says that the above construct is
  468.   recommended to get the best future benefits of OOP, but it also
  469.   acknowledges a more efficient way to achieve the same result:
  470.  
  471.   W2^.wFrame.SetFrameType (DblWindowFrame);
  472. }
  473.   W1^.Draw;                                      { outer window }
  474.   W2^.Draw;                                      { inner window }
  475.  
  476. {
  477.   Wordwrap the message.
  478. }
  479.   new (Msg);                                     { allocate Msg }
  480.   new (S);                                       { allocate S }
  481.   Msg^ := DbMsg;                                 { store DbMsg }
  482.   Height := 1;
  483.   While Msg^ > '' do begin                       { while there's text }
  484.     inc (Height);
  485.     Wordwrap (Msg^, S^, Msg^, DbWidth, false);        { get output line }
  486.     if (DbOptions and DbCenter = DbCenter) then       { if center option }
  487.       W2^.wFastCenter (S^, Height,                    { write centered }
  488.         ColorMono (DbColors.TextAttr, DbColors.MonoAttr))
  489.     else begin
  490.       if (DbOptions and DbJustify = DbJustify) then   { if justify }
  491.         if                                            { if not last line }
  492.           (Msg^ > '') or (length (S^) > (DbWidth * 0.75))
  493.         then                                          { or long last line }
  494.           S^ := Justify (S^, DbWidth);                { justify }
  495.       W2^.wFastWrite (S^, Height, 3,                  { write it }
  496.         ColorMono (DbColors.TextAttr, DbColors.MonoAttr));
  497.       end;
  498.     end;
  499.   dispose (S);                                   { deallocate S }
  500.   dispose (Msg);                                 { deallocate Msg }
  501. END;
  502.  
  503. { DialogBoxOb.Erase ======================================================= }
  504.  
  505. PROCEDURE DialogBoxOb.Erase;
  506.  
  507. BEGIN
  508. {
  509.   Disposing automatically erases.
  510. }
  511.   if (W1 <> nil) and (W2 <> nil) then begin
  512.     dispose (W2, Done);                          { deallocate windows }
  513.     dispose (W1, Done);
  514.     W1 := nil;
  515.     W2 := nil;
  516.     end;
  517. END;
  518.  
  519. { LowDialogBoxOb.Draw ===================================================== }
  520.  
  521. PROCEDURE LowDialogBoxOb.Draw;
  522.  
  523. BEGIN
  524. {
  525.   First compute how much space will be needed for the actual dialog
  526.   window.  Then compute the size of the outer border window.
  527.  
  528.   The fastest/easiest way to achieve a wide margin around a frame
  529.   is simply to put the framed window inside a larger unframed one.
  530. }
  531.   with W2Coords do begin                         { inner window coords }
  532.     { this will locate the dialog box 2 rows from the bottom }
  533.     Bottom := ScreenHeight - 4;                  { leave space at bottom }
  534.     Top    := pred (Bottom - DbHeight);          { leave space for margin }
  535.     Left   := pred((ScreenWidth-DbWidth) div 2); { set left side of window }
  536.     Right  := Left + DbWidth + 3;                { and right }
  537.     end;
  538.  
  539.   with W1Coords do begin                         { outer window coords }
  540.     Bottom := W2Coords.Bottom + 2;               { allow space for margins }
  541.     Top    := W2Coords.Top - 2;
  542.     Left   := W2Coords.Left - 5;
  543.     Right  := W2Coords.Right + 5;
  544.     end;
  545.   DrawKernel;
  546.   Beep;
  547. END;
  548.  
  549. { RandomDialogBoxOb.Draw ================================================== }
  550.  
  551. PROCEDURE RandomDialogBoxOb.Draw;
  552. {
  553.   Locates the box randomly on screen.  Does not click or beep.
  554.   Intended for use with ScreenBlanker and LockProgram.
  555. }
  556.  
  557. BEGIN
  558. {
  559.   First compute how much space will be needed for the actual dialog
  560.   window.  Then compute the size of the outer border window.
  561.  
  562.   The fastest/easiest way to achieve a wide margin around a frame
  563.   is simply to put the framed window inside a larger unframed one.
  564.  
  565.   The numbers in the calculations below are to allow for the larger
  566.   frame around the window.
  567. }
  568.   with W2Coords do begin                         { inner window coords }
  569.     Top := 3 + Random (ScreenHeight - DbHeight - 5);  { random top }
  570.     Bottom := succ (Top + DbHeight);                  { and bottom }
  571.     Left := 6 + Random (ScreenWidth - DbWidth - 13);  { random left }
  572.     Right := Left + DbWidth + 3;                      { and right }
  573.     end;
  574.  
  575.   with W1Coords do begin                         { outer window coords }
  576.     Bottom := W2Coords.Bottom + 2;               { allow space for margins }
  577.     Top    := W2Coords.Top - 2;
  578.     Left   := W2Coords.Left - 5;
  579.     Right  := W2Coords.Right + 5;
  580.     end;
  581.  
  582. (*
  583. {
  584.   For debugging only.  This code will write the outer
  585.   box coordinates to the screen and halt the program if,
  586.   for any reason, an illegal box coordinate is generated.
  587.  
  588.   The coordinate generating code has been debugged.  If
  589.   changes are made to it, reinclude this code until you
  590.   are sure that the new code has been thoroughly fumigated.
  591. }
  592.   with w1coords do begin
  593.     WriteLn ('b: ', bottom);
  594.     WriteLn ('t: ', top);
  595.     WriteLn ('l: ', left);
  596.     WriteLn ('r: ', right);
  597.     end;
  598.  
  599.   if
  600.     (W1Coords.Bottom > (ScreenHeight))
  601.       or
  602.     (W1Coords.Right > (ScreenWidth))
  603.   then begin
  604.     WriteLn ('Bottom = ', W1Coords.Bottom);
  605.     WriteLn ('Right = ', W1Coords.Right);
  606.     halt;
  607.     end;
  608. *)
  609.   DrawKernel;                                    { do it }
  610. END;
  611.  
  612. { ========================================================================= }
  613. { Bl ====================================================================== }
  614.  
  615. FUNCTION Bl (Option : word) : boolean;
  616. { returns true if BlOption is set }
  617. BEGIN
  618.   Bl := BlOptions and Option = Option;
  619. END;
  620.  
  621. { Wait ==================================================================== }
  622.  
  623. PROCEDURE Wait;
  624. {
  625.   Waits for any keyboard activity -- will recognize all normal keys,
  626.   all control keys, and all shift keys, including Alt and Ctrl.  Wait
  627.   will flush any key pressed, with this very important exception:
  628.   If the user hits a shift, Alt, or Ctrl key, and holds it down, then
  629.   he's probably going to type a shifted, alternate, or control character.
  630.  
  631.   The wait routine will allow the press of a shift, alt, or ctrl key to
  632.   toggle the KeyStateByte in case the user wants to hit a shifted char;
  633.   but if not, and he releases the shift, alt, or ctrl key, then the
  634.   KeyStateByte returns to normal.
  635. }
  636. VAR
  637.   StoreState      : byte;
  638.  
  639. BEGIN
  640.   StoreState := KeyStateByte;                    { save status of lock keys }
  641.   repeat until
  642.     KeyOrButtonPressed or (StoreState <> KeyStateByte);
  643.   FlushKbd;                                      { flush keyboard }
  644.   KeyStateByte :=
  645.     (KeyStateByte and $F) or (StoreState and $F0);
  646.   KeyClick;                                      { sound cue }
  647. {
  648.   (KeyStateByte and $F) means save the bit if any of the lower four
  649.   shift keys are pressed, but throw away the bit if any of the upper
  650.   four keys are pressed.  This is the CURRENT state of the KeyStateByte.
  651.  
  652.   (StoreState and $F0) means save the states of the upper four, the Lock
  653.   keys, but throw away the states of the lower four shift keys.  This is
  654.   the SAVED state of the KeyStateByte.
  655.  
  656.   Using the OR function to combine the current state of the KeyStateByte's
  657.   lower four bits with the saved state of the KeyStateByte's upper four
  658.   bits allows the function to maintain the status of all lock keys, while
  659.   allowing the shift, alt, ctrl keys to pass their new states, if needed.
  660.  
  661.   If the user removes his finger from the shift, alt, or ctrl keys, the
  662.   KeyStateByte returns to normal.
  663.  
  664.   Without this way of saving the states, if the user wanted to hit a
  665.   shift, alt, or ctrl key, he'd have to remove his finger from the
  666.   keyboard and then hit it again.  In normal usage, this would not only
  667.   be annoying, it could leave the user wondering if his keyboard had
  668.   broken.
  669.  
  670.   This method allows the user to toggle the end of a wait by hitting ANY
  671.   key on the keyboard, including a shift key, and then lets him proceed
  672.   naturally with any other keystroke necessary without his having to remove
  673.   his finger from the shift key.
  674. }
  675. END;
  676.  
  677. { WaitingPatiently ======================================================== }
  678.  
  679. FUNCTION WaitingPatiently (TimeToWait : longint) : boolean;
  680. {
  681.   Returns false if key is pressed before time is up.
  682.   Displays date and time in upper right corner if ClockFlag is true.
  683.   TimeToWait is computed in milleseconds.  100 is 1 tenth of a second.
  684.   1000 is one second.  60000 is one minute.  180000 is three minutes.
  685. }
  686.  
  687. VAR
  688.   Start, Stop  : longint;
  689.   StoreState   : byte;
  690.  
  691. BEGIN
  692.   WaitingPatiently := false;                     { assume key is pressed }
  693.   Start := TimeMs;                               { log start time }
  694.   StoreState := KeyStateByte;                    { save shift key states }
  695.   Repeat                                         { start counting }
  696.     ShowClock;                                   { show time, if enabled }
  697.     Stop := TimeMs;                              { time to quit yet? }
  698.     if
  699.       (Stop < Start)                             { if midnight has occurred }
  700.         or                                       { or }
  701.       (StoreState <> KeyStateByte)               { if a shift-key is hit }
  702.     then begin                                   { then }
  703.       StoreState := KeyStateByte;                { save it and }
  704.       Start := TimeMs;                           { start counting again }
  705.       end;
  706.     if KeyOrButtonPressed then exit;             { keypress returns false }
  707.   Until
  708.     (Stop - Start) > TimeToWait;                 { we waited till the end }
  709.   WaitingPatiently := true;                      { no key struck in time }
  710. END;                                             { return true }
  711.  
  712. { InKeyWaiting ============================================================ }
  713.  
  714. FUNCTION InKeyWaiting (TimeToWait : longint) : boolean;
  715. {
  716.   Returns false if key is pressed before time is up.
  717.   Displays date and time in upper right corner if ClockFlag is true.
  718.   Different than WaitingPatiently:
  719.     also returns on shift, alt, and ctrl keys.
  720.     flushes keyboard before returning.
  721. }
  722.  
  723. VAR
  724.   Start, Stop  : longint;
  725.   StoreState   : byte;
  726.  
  727. BEGIN
  728.   repeat until AltKeyReleased;                   { flush alt key }
  729.   FlushKbd;                                      { flush anything else }
  730.   InKeyWaiting := false;                         { assume key is pressed }
  731.   Start := TimeMs;                               { log start time }
  732.   KeyStateByte := KeyStateByte and $F0;          { turn off shift keys }
  733.   StoreState := KeyStateByte;                    { save shift key states }
  734.   Repeat                                         { start counting }
  735.     ShowClock;                                   { show time, if enabled }
  736.     Stop := TimeMs;                              { time to quit yet? }
  737.     if
  738.       Stop < Start                               { if midnight has occurred }
  739.     then                                         { then }
  740.       Start := TimeMs;                           { start counting again }
  741.     if
  742.       KeyOrButtonPressed                         { keypress }
  743.         or                                       { or }
  744.       (StoreState <> KeyStateByte)               { shift key }
  745.     then begin                                   { then get out }
  746.       FlushKbd;
  747.       KeyClick;                                  { sound cue }
  748.       exit;                                      { returns false }
  749.       end;
  750.   Until
  751.     (Stop - Start) > TimeToWait;                 { we waited till the end }
  752.   InKeyWaiting := true;                          { no key struck in time }
  753. END;                                             { return true }
  754.  
  755. { BounceBox =============================================================== }
  756.  
  757. PROCEDURE BounceBox (MsgBox : RandomDialogBoxPtr);
  758. VAR
  759.   StoreDbOptions : word;
  760.  
  761. BEGIN
  762.   MsgBox^.Erase;                                 { erase msg }
  763.   MsgBox^.Draw;                                  { show msg }
  764. END;
  765.  
  766. { ClickOnce =============================================================== }
  767.  
  768. PROCEDURE ClickOnce;
  769. { Guarantees correct click will sound. }
  770. BEGIN
  771.   if not Sfx (SfxKeyClick) then CueClick;        { sound cue }
  772. END;
  773.  
  774. { ScreenBlanker =========================================================== }
  775.  
  776. PROCEDURE ScreenBlanker;
  777. {
  778.   The operative code is:
  779.  
  780.     While
  781.       WaitingPatiently (TimeUntilBlank)
  782.     do
  783.       ScreenBlanker;
  784.  
  785.   WaitingPatiently returns false if a key is pressed and true if
  786.   no key is pressed before the number of milleseconds specified in
  787.   TimeUntilBlank has elapsed.
  788.  
  789.   If WaitingPatiently returns true, the ScreenBlanker will open
  790.   a blank window, then wait for a key to be pressed -- at which
  791.   point, control is passed back to WaitingPatiently, to repeat the
  792.   process until WaitingPatiently returns false.  When WaitingPatiently
  793.   returns false the key pressed is passed to the program's I/O routines.
  794. }
  795.  
  796. VAR
  797.   W : WindowPtr;                                 { window in memory }
  798.   MsgBox   : ^RandomDialogBoxOb;                 { pointer to popup box }
  799.   MouseState : boolean;                          { mouse condition }
  800.  
  801. BEGIN
  802.   if not Bl (BlBlank) then exit;                 { if screen blanker on }
  803.   ClickOnce;                                     { sound cue }
  804.   HideMousePrim (MouseState);                    { no mouse cursor }
  805.   new (W, Init (1, 1, ScreenWidth, ScreenHeight));   { set window pointer }
  806.   if Bl (BlBlankWarning) then
  807.     new (MsgBox, Init ('The screen is blanked to prevent image ' +
  808.                        'burn-in.  Press any key to return to the ' +
  809.                        'program.', BlueDbColorSet, DbJustify, 24));
  810.  
  811.   W^.SetCursor (cuHidden);                       { turn off cursor }
  812.   W^.Draw;                                       { show window }
  813.   if Bl (BlBlankWarning) then begin
  814.     MsgBox^.Draw;
  815.     While InKeyWaiting (BounceBoxWait) do
  816.       BounceBox (MsgBox)                         { relocates msg box }
  817.     end
  818.   else
  819.     Wait;                                        { includes KeyClick }
  820.   ClickOnce;                                     { but just in case }
  821.   if Bl (BlBlankWarning) then
  822.     Dispose (MsgBox, Done);                      { get rid of blank msg }
  823.   Dispose (W, Done);                             { close and dispose }
  824.   ShowMousePrim (MouseState);                    { bring back mouse cursor }
  825. END;
  826.  
  827. { WriteLogFile ============================================================ }
  828.  
  829. PROCEDURE WriteLogFile (S : StringPtr);
  830.  
  831. BEGIN
  832.   If ExistFile (LogFileName) then
  833.     Append (LogFile)
  834.   else begin
  835.     Rewrite (LogFile);
  836.     WriteLn (LogFile,
  837.       'An unauthorized attempt to access this computer may have occurred.');
  838.     WriteLn (LogFile);
  839.     end;
  840.   WriteLn (LogFile, TimeStamp + ': ' + S^);
  841.   Close   (LogFile);
  842. END;
  843.  
  844. { ValidatePassword ======================================================== }
  845.  
  846. PROCEDURE ValidatePassword;
  847. { checks user-entered password }
  848. VAR
  849.   S  : StringPtr;
  850.   Ch : char;
  851.   MsgBox : ^RandomDialogBoxOb;                   { pointer to warning msg }
  852.   TimeCtr : longint;                             { count the time }
  853.   TryCtr  : word;                                { how many tries? }
  854.   StoreSfxOptions : longint;                     { save sound effects }
  855.  
  856. BEGIN
  857.   if LockProgram_Password = '' then
  858.     ScreenBlanker
  859.   else begin
  860.     if Bl (BlBlankWarning) then
  861.       New (MsgBox, Init ('This computer is locked.  ' +
  862.                          'You must enter the correct password ' +
  863.                          'to restore normal operation.',
  864.                           RedDbColorSet, DbJustify, 27));
  865.     new (S);                                     { allocate string }
  866.     TimeCtr := TimeMs;                           { start count }
  867.     if Bl (BlBlankWarning) then MsgBox^.Draw;    { show first msg }
  868.     TryCtr := 0;                                 { count number of tries }
  869.     repeat
  870.       S^ := '';                                  { flush string }
  871.       Ch := #0;
  872.       repeat
  873.         if Bl (BlBlankWarning) then begin        { if show msg then }
  874.           if TimeMs < TimeCtr then               { if midnight then }
  875.             TimeCtr := TimeMs;                   { reset count }
  876.           if
  877.             TimeMs - TimeCtr > BounceBoxWait     { if time then }
  878.           then begin
  879.             TimeCtr := TimeMs;                   { restart time count }
  880.             BounceBox (MsgBox)                   { relocate msg box }
  881.             end;
  882.           end;
  883.         if keypressed then begin
  884.           Ch := ReadKey;                         { get char }
  885.           KeyClick;                              { sound cue }
  886.           S^ := S^ + Ch;                         { add it to string }
  887.           end;
  888.       until                                      { until }
  889.         Ch = #13;                                { Enter key is pressed }
  890.       ClickOnce;
  891.       dec (S^ [0]);                              { subtract Enter key }
  892.       if
  893.         CompUcString (S^, LockProgram_Password) <> equal  { if wrong }
  894.       then begin
  895.         inc (TryCtr);                            { count the tries }
  896.         StoreSfxOptions := SfxOptions;
  897.         SfxOptions := SfxOptions or SfxSound;    { enable all sounds }
  898.         Case TryCtr of                           { make funny noise }
  899.           1..3       : Bonk;
  900.           4..6       : BadBuzzer;
  901.           7..9       : IndustrialSiren;
  902.           10..12     : RealBadBuzzer;
  903.           13..MaxInt : IncBuzzer;
  904.           end; { Case }
  905.         SfxOptions := StoreSfxOptions;
  906.         if (TryCtr > 3) and Bl (BlLogFile) then  { if 3+ attempts then }
  907.           WriteLogFile (S);                      { record them }
  908.         end
  909.       else begin                                 { else }
  910.         dispose (S);                             { deallocate string }
  911.         if Bl (BlBlankWarning) then
  912.           dispose (MsgBox, Done);                { deallocate lockout msg }
  913.         exit;                                    { leave }
  914.         ClickOnce;                               { make a sound }
  915.         end;
  916.     until
  917.       true = false;                              { no exit here }
  918.     end;
  919. END;
  920.  
  921. { ReportLogFile =========================================================== }
  922.  
  923. PROCEDURE ReportLogFile;
  924.  
  925. VAR
  926.   S  : ^string;
  927.   Ch : char;
  928.  
  929. BEGIN
  930.   If ExistFile (LogFileName) then begin
  931.     Reset (LogFile);
  932.     new (S);
  933.     While not Eof (LogFile) do begin
  934.       ReadLn (LogFile, S^);
  935.       WryteLn (S^);
  936.       end;
  937.     dispose (S);
  938.     WryteLn ('');
  939.     WryteLn ('Erase file?');
  940.     Ch := upcase (ReadKey);
  941.     KeyClick;                                    { sound cue }
  942.     ClickOnce;                                   { just in case }
  943.     ClrScr;
  944.     If Ch = 'Y' then erase (LogFile);
  945.     end;
  946. END;
  947.  
  948. { LockProgram ============================================================= }
  949.  
  950. PROCEDURE LockProgram;
  951. { blanks screen, demands password to continue }
  952. VAR
  953.   W : WindowPtr;                                 { window in memory }
  954.   MouseState : boolean;                          { mouse condition }
  955.  
  956. BEGIN
  957.   if not Bl (BlLock) then exit;                  { lock not authorized }
  958.   DisableReboot;                                 { forbid Ctrl-Alt-Delete }
  959.   HideMousePrim (MouseState);                    { no mouse cursor }
  960.   New (W, Init (1, 1, ScreenWidth, ScreenHeight));   { set window pointer }
  961.   W^.SetCursor (cuHidden);                       { turn off cursor }
  962.   W^.Draw;                                       { show empty window }
  963.  
  964.   ClickOnce;                                     { sound cue }
  965.   ValidatePassword;                              { unlock system? }
  966.  
  967.   ReportLogFile;                                 { check for break-ins }
  968.   Dispose (W, Done);                             { close and dispose }
  969.   ShowMousePrim (MouseState);                    { bring back mouse cursor }
  970.   BuzzCounter := 1;                              { reset length of badbuzz }
  971.   EnableReboot;                                  { allow Ctrl-Alt-Delete }
  972. END;
  973.  
  974. { NewPassword ============================================================= }
  975.  
  976. PROCEDURE NewPassword;
  977. { Gets a new password, puts it in LockProgram_Password. }
  978.  
  979. BEGIN
  980.   NotYet ('New Password');
  981. END;
  982.  
  983. { PauseMsgLn ============================================================== }
  984.  
  985. PROCEDURE PauseMsgLn (Msg : string);
  986. { Sends a one-line msg, then waits for a keypress. }
  987.  
  988. VAR
  989.   StoreTextAttr : byte;
  990.   Len : byte absolute Msg;
  991.  
  992. BEGIN
  993.   StoreTextAttr := TextAttr;
  994.   TextAttr := ColorMono (LightRed, White);
  995.   WryteLn ('');
  996.   Wryte (PadCenter (Msg, ScreenWidth));
  997.   Beep;
  998.   While WaitingPatiently (TimeUntilBlank) do ScreenBlanker;
  999.   FlushKbd;
  1000.   KeyClick;
  1001.   TextAttr := StoreTextAttr;
  1002. END;
  1003.  
  1004. { PauseLn ================================================================ }
  1005.  
  1006. {$F+} PROCEDURE PauseLn; {$F-}
  1007. BEGIN
  1008.   PauseMsgLn ('Press any key to continue.');
  1009. END;
  1010.  
  1011. { PauseMsgBox ============================================================= }
  1012.  
  1013. PROCEDURE PauseMsgBox (Msg : string;  Colors : DbColorSet;
  1014.                        Options : word;  Width : byte);
  1015. {
  1016. Creates a dialog box with user-defined message, waits for keypress.
  1017. }
  1018. VAR
  1019.   DialogBox : DialogBoxPtr;
  1020.  
  1021. BEGIN
  1022.   if Options and DbLowBox = DbLowBox then
  1023.     DialogBox := new (LowDialogBoxPtr, init (Msg, Colors, Options, Width))
  1024.   else
  1025.     DialogBox := new (DialogBoxPtr, init (Msg, Colors, Options, Width));
  1026.   With DialogBox^ do begin
  1027.     Draw;
  1028.     if not Db (DbCues) and not Sfx (SfxKeyClick) then DbClick else DbBeep;
  1029.     While InKeyWaiting (TimeUntilBlank) do ScreenBlanker;
  1030.     FlushKbd;
  1031.     if not Sfx (SfxKeyClick) then DbClick;
  1032.     end;
  1033.   dispose (DialogBox, Done);                     { automatically erases }
  1034. END;
  1035.  
  1036. { PauseBox ================================================================ }
  1037.  
  1038. {$F+} PROCEDURE PauseBox; {$F-}
  1039.  
  1040. BEGIN
  1041.   PauseMsgBox ('Press any key to continue.', RedDbColorSet,
  1042.                DbShadow + DbLowBox + DbSound + DbLowBox, 40);
  1043. END;
  1044.  
  1045. { TimedPauseMsg =========================================================== }
  1046.  
  1047. PROCEDURE TimedPauseMsg (Msg : string;  Colors : DbColorSet;
  1048.                          Options : word;  Width : byte;
  1049.                          TimeToWait : longint);
  1050. { Creates a dialog box with a custom message, waits for a set time. }
  1051.  
  1052. VAR
  1053.   DialogBox : DialogBoxPtr;
  1054.  
  1055. BEGIN
  1056.   if Options and DbLowBox = DbLowBox then
  1057.     DialogBox := new (LowDialogBoxPtr, init(Msg, Colors, Options, Width))
  1058.   else
  1059.     DialogBox := new (DialogBoxPtr, init (Msg, Colors, Options, Width));
  1060.   with DialogBox^ do begin
  1061.     Draw;
  1062.     if not Db (DbCues) and not Sfx (SfxKeyClick) then DbClick else DbBeep;
  1063.     if InKeyWaiting (TimeToWait) then FlushKbd;
  1064.     DbClick;
  1065.     end;
  1066.   dispose (DialogBox, Done);                     { automatically erases }
  1067. END;
  1068.  
  1069. { PopDummy ================================================================ }
  1070.  
  1071. {$F+} PROCEDURE PopDummy (D : DialogBoxPtr);  {$F-}
  1072. { Does nothing.  Default procedure for assignment to PopMsgProc. }
  1073.  
  1074. BEGIN
  1075. END;
  1076.  
  1077. { PopMsgBox =============================================================== }
  1078.  
  1079. PROCEDURE PopMsgBox (Msg : string;  Colors : DbColorSet;
  1080.                      Options : word;  Width : byte;
  1081.                      DialogBox : DialogBoxPtr);
  1082. { Creates a dialog box with a custom message, waits for alt-key release. }
  1083.  
  1084. BEGIN
  1085.   If Options and DbLowBox = DbLowBox then
  1086.     DialogBox := new (LowDialogBoxPtr, init(Msg, Colors, Options, Width))
  1087.   else
  1088.     DialogBox := new (DialogBoxPtr, init (Msg, Colors, Options, Width));
  1089.   with DialogBox^ do begin
  1090.     Draw;
  1091.     if not Db (DbCues) and not Sfx (SfxKeyClick) then DbClick else DbBeep;
  1092.  
  1093.     TimeCheck := CurrentTime;
  1094.     PopMsgProc (DialogBox);                      { show first msg }
  1095.     Delay (150);                                 { allow for click }
  1096.  
  1097.     repeat                                       { now cycle }
  1098.       PopMsgProc (DialogBox);                    { passed proc }
  1099.       FlushKbd;                                  { discard typamatic }
  1100.     until
  1101.       AltKeyReleased;
  1102.  
  1103.     DbClick;                                     { sound cue }
  1104.     end;  { with DialogBox^ do }
  1105.   dispose (DialogBox, Done);                     { automatically erases }
  1106.   PopMsgProc := PopDummy;                        { reassign the dummy }
  1107. END;
  1108.  
  1109. { PopClockProc ============================================================ }
  1110.  
  1111. {$F+} PROCEDURE PopClockCycle (DialogBox : DialogBoxPtr);  {$F-}
  1112. { PopClock assigns this procedure to PopMsgProc for use by PopMsgBox. }
  1113.  
  1114. VAR
  1115.   A : byte;                                      { attribute }
  1116.  
  1117. BEGIN
  1118.   A := ColorMono (DialogBox^.DbColors.TextAttr,
  1119.                   DialogBox^.DbColors.MonoAttr); { get attr }
  1120.   DialogBox^.W2^.wFastCenter
  1121.     (PadCenter (FullDate, 30), 2, A);            { write date }
  1122.   DialogBox^.W2^.wFastCenter (PcTime, 4, A);     { write time }
  1123.   if ClockFlag then ClockProc;                   { update onscreen clock? }
  1124.   TickTock;                                      { make clock noise }
  1125.   Chimes;                                        { chime on the hour }
  1126. END;
  1127.  
  1128. { PopClock ================================================================ }
  1129.  
  1130. PROCEDURE PopClock;
  1131. { Pops a clock on screen until alt-key is released. }
  1132.  
  1133. VAR
  1134.   DialogBox     : DialogBoxPtr;
  1135.  
  1136. BEGIN
  1137.   PopMsgProc := PopClockCycle;                   { assign a procedure }
  1138.   PopMsgBox (CharStr (#255, 70),                 { pop a clear box }
  1139.             BlueDbColorSet,
  1140.             DbCenter + DbShadow + DbBoxClick,
  1141.             30,                                  { width }
  1142.             DialogBox);                          { pointer }
  1143. END;
  1144.  
  1145. { NotYet ================================================================== }
  1146.  
  1147. PROCEDURE NotYet (S : string25);
  1148. { TimedPauseMsg:  'Sorry, 'S' not implemented yet.' }
  1149. BEGIN
  1150.   TimedPauseMsg ('Sorry, but the ''' + S +
  1151.     ''' function has not been implemented yet.',
  1152.     RedDbColorSet, DbShadow + DbJustify + DbSound, 40, 1500);
  1153. END;
  1154.  
  1155. { Sorry ================================================================== }
  1156.  
  1157. PROCEDURE Sorry;
  1158. { TimedPauseMsg:  'Sorry.  Not implemented yet.' }
  1159. BEGIN
  1160.   TimedPauseMsg ('Sorry.  Not implemented yet.',
  1161.     RedDbColorSet,
  1162.     DbShadow + DbJustify + DbSound,
  1163.     40, 1500);
  1164. END;
  1165.  
  1166. { YornLn ================================================================== }
  1167.  
  1168. {$F+} FUNCTION YornLn (Msg : string) : boolean; {$F-}
  1169. { Prints centered Msg on screen, demands a yes or no answer. }
  1170.  
  1171. VAR
  1172.   Ch    : char;
  1173.   ChVal : word;
  1174.   StoreTextAttr : byte;
  1175.  
  1176. BEGIN
  1177.   StoreTextAttr := TextAttr;
  1178.   TextAttr := ColorMono (LightRed, White);
  1179.   WryteLn ('');
  1180.   Wryte (PadCenter (Msg, ScreenWidth));
  1181.  
  1182.   Ch := #0;
  1183.   While
  1184.     (Ch <> 'Y') and (Ch <> 'N')
  1185.   do begin
  1186.     While
  1187.       WaitingPatiently (TimeUntilBlank)          { 3 minutes }
  1188.     do
  1189.       ScreenBlanker;
  1190.  
  1191.     CueClick;                                    { sound cue }
  1192.     Ch := UpCaseMac (chr (lo (ReadKeyWord)));
  1193.     Case Ch of
  1194.       'Y' : YornLn := true;
  1195.       'N' : YornLn := false;
  1196.     else
  1197.       Beep;
  1198.       end;  { case }
  1199.     end;  { While do begin }
  1200.  
  1201.   TextAttr := StoreTextAttr;
  1202. END;
  1203.  
  1204. { YornBox ================================================================= }
  1205.  
  1206. { MakeMenu code ----------------------------------------------------------- }
  1207.  
  1208. CONST
  1209.   MouseChar : Char = #04;
  1210.  
  1211. {Color set used by menu system}
  1212.   YornMenuColors : ColorSet = (
  1213.     TextColor       : YellowOnRed;        TextMono        : LtGrayOnBlack;
  1214.     CtrlColor       : YellowOnBlue;       CtrlMono        : WhiteOnBlack;
  1215.     FrameColor      : RedOnRed;           FrameMono       : LtGrayOnBlack;
  1216.     HeaderColor     : RedOnRed;           HeaderMono      : BlackOnLtGray;
  1217.     ShadowColor     : DkGrayOnBlack;      ShadowMono      : WhiteOnBlack;
  1218.     HighlightColor  : WhiteOnRed;         HighlightMono   : BlackOnLtGray;
  1219.     PromptColor     : BlackOnCyan;        PromptMono      : LtGrayOnBlack;
  1220.     SelPromptColor  : BlackOnCyan;        SelPromptMono   : LtGrayOnBlack;
  1221.     ProPromptColor  : BlackOnCyan;        ProPromptMono   : LtGrayOnBlack;
  1222.     FieldColor      : YellowOnBlue;       FieldMono       : LtGrayOnBlack;
  1223.     SelFieldColor   : BlueOnCyan;         SelFieldMono    : WhiteOnBlack;
  1224.     ProFieldColor   : LtGrayOnBlue;       ProFieldMono    : LtGrayOnBlack;
  1225.     ScrollBarColor  : CyanOnBlue;         ScrollBarMono   : LtGrayOnBlack;
  1226.     SliderColor     : CyanOnBlue;         SliderMono      : WhiteOnBlack;
  1227.     HotSpotColor    : BlackOnCyan;        HotSpotMono     : BlackOnLtGray;
  1228.     BlockColor      : YellowOnCyan;       BlockMono       : WhiteOnBlack;
  1229.     MarkerColor     : WhiteOnMagenta;     MarkerMono      : BlackOnLtGray;
  1230.     DelimColor      : BlueOnCyan;         DelimMono       : WhiteOnBlack;
  1231.     SelDelimColor   : BlueOnCyan;         SelDelimMono    : WhiteOnBlack;
  1232.     ProDelimColor   : BlueOnCyan;         ProDelimMono    : WhiteOnBlack;
  1233.     SelItemColor    : BlackOnLtGray;      SelItemMono     : BlackOnLtGray;
  1234.     ProItemColor    : RedOnRed;           ProItemMono     : LtGrayOnBlack;
  1235.     HighItemColor   : WhiteOnRed;         HighItemMono    : WhiteOnBlack;
  1236.     AltItemColor    : WhiteOnBlue;        AltItemMono     : WhiteOnBlack;
  1237.     AltSelItemColor : WhiteOnCyan;        AltSelItemMono  : BlackOnLtGray;
  1238.     FlexAHelpColor  : WhiteOnBlue;        FlexAHelpMono   : WhiteOnBlack;
  1239.     FlexBHelpColor  : WhiteOnBlue;        FlexBHelpMono   : WhiteOnBlack;
  1240.     FlexCHelpColor  : LtCyanOnBlue;       FlexCHelpMono   : BlackOnLtGray;
  1241.     UnselXrefColor  : YellowOnBlue;       UnselXrefMono   : LtBlueOnBlack;
  1242.     SelXrefColor    : WhiteOnMagenta;     SelXrefMono     : BlackOnLtGray;
  1243.     MouseColor      : WhiteOnRed;         MouseMono       : BlackOnLtGray
  1244.   );
  1245.  
  1246. {Menu item constants}
  1247. CONST
  1248.   miYes1 = 1;
  1249.   miNo2  = 2;
  1250.  
  1251. {$F+}
  1252. procedure ErrorHandler(UnitCode : Byte; var ErrCode : Word; Msg : string);
  1253.   {-Report errors}
  1254. begin
  1255. end;
  1256. {$F-}
  1257.  
  1258. { YornBox ------------------------------------------------------------------ }
  1259.  
  1260. {$F+} FUNCTION YornBox (Msg : string) : boolean; {$F-}
  1261. { Opens a dialog box, demands a yes or no answer. }
  1262.  
  1263. VAR
  1264.   DialogBox : DialogBoxPtr;
  1265.   M : Menu;                                      { menu system }
  1266.  
  1267.   SlidingMargin,
  1268.   LeftButton,
  1269.   RightButton : byte;
  1270.  
  1271. BEGIN
  1272.   DialogBox := new (DialogBoxPtr,
  1273.                     init (Msg, RedDbColorSet, DbShadow + DbJustify, 40));
  1274.   DialogBox^.Draw;
  1275.  
  1276.   with M do begin
  1277.     LeftButton := 6;
  1278.     RightButton := (DialogBox^.W1Coords.Right - DialogBox^.W1Coords.Left - 7);
  1279.     SlidingMargin := 0;
  1280.     if RightButton - LeftButton > 16 then
  1281.       SlidingMargin := trunc ((RightButton - LeftButton)/4);
  1282.  
  1283.     if not InitCustom(DialogBox^.W1Coords.Left,
  1284.                       DialogBox^.W2Coords.Bottom + 2,
  1285.                       DialogBox^.W1Coords.Right,
  1286.                       DialogBox^.W2Coords.Bottom + 3,
  1287.                       YornMenuColors,
  1288.                       wClear+wUserContents+wCoversOnDemand, 
  1289.                       Horizontal)
  1290.     then begin
  1291.       WriteLn('Error initializing menu: ', InitStatus);
  1292.       Halt(1);
  1293.       end;
  1294.  
  1295.     mnOptionsOn(mnAlphaMatch+mnSelectOnMatch+mnPopOnSelect+mnAllHotSpots+
  1296.                 mnSelectOnClick);
  1297.     mnOptionsOff(mnAllowPending+mnArrowSelect+mnUseItemForTopic);
  1298.     AddShadow (shBR, shSeeThru);
  1299.     AddItem(' Yes ', LeftButton + SlidingMargin, 2, miYes1);
  1300.     AddItem(' No ', RightButton - SlidingMargin, 2, miNo2);
  1301.     ItemsDone;
  1302.  
  1303.     SetErrorProc(ErrorHandler);
  1304.     end;
  1305.  
  1306.   if MouseInstalled then
  1307.     with YornMenuColors do begin
  1308.       {activate mouse cursor}
  1309.       SoftMouseCursor($0000, (ColorMono(MouseColor, MouseMono) shl 8)+
  1310.                              Byte(MouseChar));
  1311.       ShowMouse;
  1312.       {enable mouse support}
  1313.       MenuCommands.cpOptionsOn (cpEnableMouse);
  1314.     end;
  1315.  
  1316.   M.Draw;
  1317.   M.Process;
  1318.  
  1319.   if M.GetLastCommand = ccSelect then begin
  1320.     case M.MenuChoice of
  1321.       miYes1          : YornBox := true;
  1322.       miNo2           : YornBox := false;
  1323.       end; { case }
  1324.     end
  1325.   else
  1326.     case M.GetLastCommand of
  1327.       { Esc, MouseRt }
  1328.       ccQuit : begin
  1329.                Beep;                             { make noise }
  1330.                YornBox := false;
  1331.                end;
  1332.       end;  { case }
  1333.  
  1334.   M.Erase;
  1335.   M.Done;
  1336.  
  1337.   dispose (DialogBox, Done);
  1338. END;
  1339.  
  1340. { QuitProgram ============================================================= }
  1341.  
  1342. PROCEDURE QuitProgram;
  1343. { Do you really want to quit?  If yes, halt. }
  1344.  
  1345. VAR
  1346.   StoreTextAttr : byte;
  1347.  
  1348. BEGIN
  1349.   StoreTextAttr := TextAttr;
  1350.   TextAttr := ColorMono (LightRed, White);
  1351.   if Yorn ('Do you REALLY want to quit?') then halt;
  1352.   TextAttr := StoreTextAttr;
  1353. END;
  1354.  
  1355. { DoLines ================================================================= }
  1356.  
  1357. PROCEDURE DoLines;
  1358. { set configurable functions for line scrolling }
  1359. BEGIN
  1360.   Yorn := YornLn;
  1361.   Pause := PauseLn;
  1362.   PopToggleFlag := false;
  1363. END;
  1364.  
  1365. { DoBoxes ================================================================= }
  1366.  
  1367. PROCEDURE DoBoxes;
  1368. { set configurable functions for boxes }
  1369. BEGIN
  1370.   Yorn := YornBox;
  1371.   Pause := PauseBox;
  1372.   PopToggleFlag := true;
  1373. END;
  1374.  
  1375. { ========================================================================= }
  1376. { Initialization ========================================================== }
  1377.  
  1378. BEGIN
  1379.   DoLines;                                       { default is scrolling }
  1380.   PopMsgProc := PopDummy;                        { do nothing }
  1381. END.
  1382.  
  1383. { ========================================================================= }
  1384. { DgDialog History ======================================================== }
  1385.  
  1386. VERSION HISTORY:
  1387.   9004.06
  1388.     Added DbBlank option to DbByte to allow enabling and disabling of
  1389.     ScreenBlanker from a configuration menu.
  1390.  
  1391.     Allow LockProgram to exit on any keypress if no password set.
  1392.  
  1393.     Added NotYet procedure for debugging purposes.
  1394.  
  1395.   9004.08
  1396.     Added RandomDialogBox child of dialog box.  Pops the box to a
  1397.     random location.  No shadow if too close to edge.
  1398.  
  1399.     Added Erase method to DialogBoxOb.  Allows box to be erased and
  1400.     redrawn without requiring reinitializing.  Repeated calls to
  1401.     RandomDialogBox.Erase and .Draw will move box around screen at
  1402.     random....
  1403.  
  1404.     Added Db (Option) function.  Returns true if Option is installed in
  1405.     DbOption.  DbOption is now longint.
  1406.  
  1407.     Designed config menu.  Have not installed it yet.  Too bad it's too
  1408.     complex for an article...or is it?
  1409.  
  1410.   9004.10
  1411.     Added BounceBox procedure to Implementation section for use with
  1412.     ScreenBlanker.  BounceBox draws and Erases a msg in a RandomDialogBox.
  1413.     Added InKeyWaiting procedure for use with BounceBox.  Usage:
  1414.       While
  1415.         InKeyWaiting (TimeToWait)
  1416.       do
  1417.         BounceBox (DialogBox^);
  1418.  
  1419.   9004.11
  1420.     BounceBox now works with LockProgram warning msg.  LockProgram_Password
  1421.     must be ASCII characters.  (Is there value in allowing alt-chars?)
  1422.  
  1423.   9004.13
  1424.     Added an automatic logfile feature to LockProgram.  If anyone tries to
  1425.     break into a locked system, the logfile will record every password and
  1426.     the time it was entered.
  1427.  
  1428.   9004.15
  1429.     Implemented BadBuzzer, IndustrialSiren, RealBadBuzzer, in LockProgram
  1430.     routine.  These really ugly noises CANNOT be disabled.  The program
  1431.     must be able to protect itself in every way possible against any
  1432.     unauthorized entry.
  1433.  
  1434.   9004.30
  1435.     Made Pause a procedure variable, so it can be assigned PauseLn or
  1436.     PauseBox, depending on what the program needs -- or even a user-defined
  1437.     Pause procedure.  Default is PauseBox.
  1438.  
  1439.   9005.01
  1440.     Divided PauseMsg into PauseMsgBox and PauseMsgLn.
  1441.  
  1442.   9005.06
  1443.     Added PopMsgBox and PopClock procedure.  Added QuitProgram procedure.
  1444.  
  1445.   9005.08
  1446.     Installed PopMsgProc in PopMsgBox, allowing procedures to be passed
  1447.     and run within a popped box.  See PopClock and PopClockCycle.
  1448.  
  1449.     This technique can be used later to extend the power of other dialog
  1450.     boxes.
  1451.  
  1452.   9005.11
  1453.     Added DbSound options to DbOptions.  Allows Dialog Boxes to have their
  1454.     own sound cues.  Note that KeyClick and CueClick have two different
  1455.     functions.
  1456.  
  1457.   9005.12
  1458.     Added DoLines and DoBoxes for easy initialization of Pause and Yorn.
  1459.     Added PopToggleFlag.
  1460.  
  1461.   9007.10
  1462.     Added mouse-clicks to Wait, WaitingPatiently, InKeyWaitingPatiently,
  1463.     and YornKernel, so that the mouse can be used with all dialog functions.
  1464.  
  1465.   9009.01
  1466.     Added Yes/No menu to YornBox.
  1467.  
  1468. { DgDialog Needs ========================================================== }
  1469.  
  1470. DIALOG BOX OPTION
  1471.   DisableOuterBox.
  1472.  
  1473. { Bug Reports ============================================================= }
  1474.  
  1475. BUGS:
  1476.   No known bugs.
  1477.  
  1478. { ========================================================================= }
  1479.