home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS - Coast to Coast / simteldosarchivecoasttocoast.iso / pcmag / vol9n21.zip / PRISMENU.INC < prev    next >
Text File  |  1990-10-06  |  18KB  |  455 lines
  1. { ========================================================================= }
  2. { PRISMENU.INC }
  3. { ========================================================================= }
  4. { PrismMenu/MagMenu Declarations ========================================== }
  5.  
  6. { Code generated by MakeMenu. }
  7.  
  8. CONST
  9. {Color set used by menu system}
  10.   MenuColors : ColorSet = (
  11.     TextColor       : BlackOnCyan;        TextMono        : LtGrayOnBlack;
  12.     CtrlColor       : YellowOnBlue;       CtrlMono        : WhiteOnBlack;
  13.     FrameColor      : BlackOnCyan;        FrameMono       : LtGrayOnBlack;
  14.     HeaderColor     : WhiteOnCyan;        HeaderMono      : BlackOnLtGray;
  15.     ShadowColor     : DkGrayOnBlack;      ShadowMono      : WhiteOnBlack;
  16.     HighlightColor  : WhiteOnRed;         HighlightMono   : BlackOnLtGray;
  17.     PromptColor     : BlackOnCyan;        PromptMono      : LtGrayOnBlack;
  18.     SelPromptColor  : BlackOnCyan;        SelPromptMono   : LtGrayOnBlack;
  19.     ProPromptColor  : BlackOnCyan;        ProPromptMono   : LtGrayOnBlack;
  20.     FieldColor      : YellowOnBlue;       FieldMono       : LtGrayOnBlack;
  21.     SelFieldColor   : BlueOnCyan;         SelFieldMono    : WhiteOnBlack;
  22.     ProFieldColor   : LtGrayOnBlue;       ProFieldMono    : LtGrayOnBlack;
  23.     ScrollBarColor  : CyanOnBlue;         ScrollBarMono   : LtGrayOnBlack;
  24.     SliderColor     : CyanOnBlue;         SliderMono      : WhiteOnBlack;
  25.     HotSpotColor    : BlackOnCyan;        HotSpotMono     : BlackOnLtGray;
  26.     BlockColor      : YellowOnCyan;       BlockMono       : WhiteOnBlack;
  27.     MarkerColor     : WhiteOnMagenta;     MarkerMono      : BlackOnLtGray;
  28.     DelimColor      : BlueOnCyan;         DelimMono       : WhiteOnBlack;
  29.     SelDelimColor   : BlueOnCyan;         SelDelimMono    : WhiteOnBlack;
  30.     ProDelimColor   : BlueOnCyan;         ProDelimMono    : WhiteOnBlack;
  31.     SelItemColor    : WhiteOnBlue;        SelItemMono     : BlackOnLtGray;
  32.     ProItemColor    : CyanOnCyan;         ProItemMono     : BlackOnBlack;
  33.     HighItemColor   : RedOnCyan;          HighItemMono    : WhiteOnBlack;
  34.     AltItemColor    : WhiteOnBlue;        AltItemMono     : WhiteOnBlack;
  35.     AltSelItemColor : WhiteOnCyan;        AltSelItemMono  : BlackOnLtGray;
  36.     FlexAHelpColor  : WhiteOnBlue;        FlexAHelpMono   : WhiteOnBlack;
  37.     FlexBHelpColor  : WhiteOnBlue;        FlexBHelpMono   : WhiteOnBlack;
  38.     FlexCHelpColor  : LtCyanOnBlue;       FlexCHelpMono   : BlackOnLtGray;
  39.     UnselXrefColor  : YellowOnBlue;       UnselXrefMono   : LtBlueOnBlack;
  40.     SelXrefColor    : WhiteOnMagenta;     SelXrefMono     : BlackOnLtGray;
  41.     MouseColor      : WhiteOnRed;         MouseMono       : BlackOnLtGray
  42.   );
  43.  
  44. { Menu Item Constants ===================================================== }
  45.  
  46. {Menu item constants from MAGMENU}
  47. const
  48.   miHelp1         = 1;
  49.   miKeypad2       = 2;
  50.   miMouse3        = 3;
  51.   miAbout4        = 4;
  52.   miAbout5        = 5;
  53.   miUsing6        = 6;
  54.   miReferences7   = 7;
  55.   miCopyright8    = 8;
  56.   miOptions9      = 9;
  57.   miSound10       = 10;
  58.   miMouse11       = 11;
  59.   miDissolve12    = 12;
  60.   miPalettes13    = 13;
  61.   miUndo14        = 14;
  62.   miSwap15        = 15;
  63.   miRestore16     = 16;
  64.   miNew17         = 17;
  65.   miDuplicate18   = 18;
  66.   miLoad19        = 19;
  67.   miSave20        = 20;
  68.   miQuit21        = 21;
  69.   miYesExit22     = 22;
  70.   miNoResume23    = 23;
  71.  
  72. { ========================================================================= }
  73. { ErrorHandler ============================================================ }
  74.  
  75. {$F+}
  76. PROCEDURE ErrorHandler(UnitCode : Byte; var ErrCode : Word; Msg : string);
  77.   {-Report errors}
  78. VAR
  79.   vip, vcs : word;
  80.  
  81. BEGIN
  82.   RingBell;
  83.   Inline ($8B/$46/$02/                           { MOV AX,[BP+2] }
  84.           $89/$86/vip/                           { MOV vip,AX }
  85.           $8B/$46/$04/                           { MOV AX,[BP+4] }
  86.           $89/$86/vcs);                          { MOV vcs,AX }
  87.   FastWrite ('ERROR: '+Long2Str(ErrCode)+' in Unit '+Long2Str(UnitCode)+
  88.              ' at address '+hexW(vcs-Cseg)+':'+hexW(vip)+'.',
  89.              1, 1, $4E);
  90.   if ReadKey = #0 then;
  91. END;
  92.  
  93. { DisplayHelp ============================================================= }
  94.  
  95. PROCEDURE DisplayHelp (UnitCode : Byte;
  96.                        IdPtr : Pointer;
  97.                        HelpIndex : Word);
  98.  
  99. { Display context sensitive help}
  100. BEGIN
  101.  
  102.   if HelpIndex <> 0 then
  103.     with PrismHelp do begin
  104.       SetTopic (HelpIndex);
  105.       Process;
  106.       Erase;
  107.       end;
  108.  
  109. END;
  110.  
  111. { CustomItemString ======================================================== }
  112.  
  113. PROCEDURE CustomItemString (VAR S : string;
  114.                             Key : longint;
  115.                             Selected, Highlighted : boolean;
  116.                             WPtr : RawWindowPtr);
  117. CONST
  118.   MouseState : array [0..3] of string [6] = ('  Slow', 'Normal',
  119.                                              '  Fast', ' Zoom!');
  120. VAR
  121.   Len : byte absolute S;
  122.   S1  : string;
  123.   L1  : byte absolute S1;
  124.  
  125. BEGIN
  126. {
  127.   This routine shows the existing state of the options within the menu.
  128.   Each menu press will change the state of the default.  When the routine
  129.   exits, it sets a flag indicating that the defaults must be rewritten to
  130.   a disk file.
  131. }
  132.  
  133.   Case Key of
  134.     miSound10    : move (FlagArray [SfxFlag, 1], S [Len - 2], 3);
  135.     miMouse11    : begin
  136.                    move (MouseState [MouseSpeed, 1], S [Len - 5], 6);
  137.                    end;
  138.     miDissolve12 : begin
  139.                    S1 := Num2Str (FadeRateArray [DissolveDelay]);
  140.                    Move (S1 [1], S [Len - pred (L1)], L1);
  141.                    end;
  142.     end;
  143. END;
  144. {$F-}
  145.  
  146. { InitMenu ================================================================ }
  147.  
  148. FUNCTION InitMenu(var M : Menu) : Word;
  149.   {-Initialize menu system generated by MAKEMENU}
  150. CONST
  151.   {Frame constants}
  152.   Frame1 : FrameArray = '┌└┐┘──││';
  153. BEGIN
  154.   With M do begin
  155.     if not InitCustom(1, 24, 80, 24, MenuColors,
  156.                       wClear+wUserContents+wCoversOnDemand, 
  157.                       Horizontal) then begin
  158.       InitMenu := InitStatus;
  159.       Exit;
  160.       end;
  161.     mnOptionsOn(mnAlphaMatch+mnSelectOnMatch+mnAllowPending+mnArrowSelect+
  162.                 mnAllHotSpots+mnUseItemForTopic+mnSelectOnClick);
  163.     mnOptionsOff(mnPopOnSelect);
  164.     AddItemHelp(' Help ', 3, 2, miHelp1,
  165.                 '   Help with this program.');
  166.       AddFramedSubMenu(2, 14, 21, 22, Vertical, Frame1);
  167.       SetNormAttr(BlackOnLtGray, LtGrayOnBlack);
  168.       SetHighAttr(RedOnLtGray, WhiteOnBlack);
  169.       SetProtectAttr(LtGrayOnLtGray, BlackOnBlack);
  170.       SetFrameAttr(BlackOnLtGray, LtGrayOnBlack);
  171.       SetHeaderAttr(WhiteOnLtGray, BlackOnLtGray);
  172.       AddShadow(shBR, shSeeThru);
  173.       AddSeparator('├', '─', '┤', 3);
  174.       AddSeparator('├', '─', '┤', 7);
  175.       AddItemHelp('Keypad Editing', 1, 1, miKeypad2,
  176.                   '   How to edit a palette of colors using the number pad keys.');
  177.       AddItemHelp('Mouse Editing', 2, 1, miMouse3,
  178.                   '   How to edit a palette of colors using the mouse.');
  179.       AddItemHelp('About the VGA', 4, 11, miAbout4,
  180.                   '   How the Video Graphics Array works.  ');
  181.       AddItemHelp('About This Program', 5, 12, miAbout5,
  182.                   '   How this program was developed -- and why.');
  183.       AddItemHelp('Using This Program', 6, 1, miUsing6,
  184.                   '   How to make the best use of this program.');
  185.       AddItemHelp('References', 8, 1, miReferences7,
  186.                   '   Where to find more information about programming the VGA display.  ');
  187.       AddItemHelp('Copyright', 9, 1, miCopyright8,
  188.                   '   PRISM, v1.0.  This version copyright (c) 1990 Ziff Communications Co.');
  189.       ItemsDone;
  190.     AddItemHelp(' Options ', 15, 2, miOptions9,
  191.                 '   Reset the defaults for sound effects, mouse speed, and dissolve rate. ');
  192.       AddFramedSubMenu(14, 20, 33, 22, Vertical, Frame1);
  193.       SetNormAttr(BlackOnLtGray, LtGrayOnBlack);
  194.       SetHighAttr(RedOnLtGray, WhiteOnBlack);
  195.       SetProtectAttr(LtGrayOnLtGray, BlackOnBlack);
  196.       SetFrameAttr(BlackOnLtGray, LtGrayOnBlack);
  197.       SetHeaderAttr(WhiteOnLtGray, BlackOnLtGray);
  198.       AddShadow(shBR, shSeeThru);
  199.       AddItemHelp('Sound Effects', 1, 1, miSound10,
  200.                   '   Toggle sound effects on or off.');
  201.       AddItemHelp('Mouse Speed', 2, 1, miMouse11,
  202.                   '   Change the default speed for moving the mouse.');
  203.       AddItemHelp('Dissolve Rate', 3, 1, miDissolve12,
  204.                   '   Set the number of steps to fade from one color to another.');
  205.       ItemsDone;
  206.     AddItemHelp(' Palettes ', 31, 2, miPalettes13,
  207.                 '   Generate a NEW (random) palette, DUPLICATE a color, UNDO, RESTORE, or SWAP.');
  208.       AddFramedSubMenu(30, 18, 44, 22, Vertical, Frame1);
  209.       SetNormAttr(BlackOnLtGray, LtGrayOnBlack);
  210.       SetHighAttr(RedOnLtGray, WhiteOnBlack);
  211.       SetProtectAttr(LtGrayOnLtGray, BlackOnBlack);
  212.       SetFrameAttr(BlackOnLtGray, LtGrayOnBlack);
  213.       SetHeaderAttr(WhiteOnLtGray, BlackOnLtGray);
  214.       AddShadow(shBR, shSeeThru);
  215.       AddItemHelp('Undo       ^U', 1, 1, miUndo14,
  216.                   '   Undo the last change.  Repeated calls will undo the last 12 changes.');
  217.       AddItemHelp('Swap       ^S', 2, 1, miSwap15,
  218.                   '   Swap two colors within a palette.  Select source color, then target.');
  219.       AddItemHelp('Restore    ^R', 3, 1, miRestore16,
  220.                   '   Restore the system palette that was active when the program began.');
  221.       AddItemHelp('New        ^N', 4, 1, miNew17,
  222.                   '   Generate a totally random palette of colors.  ');
  223.       AddItemHelp('Duplicate  ^D', 5, 1, miDuplicate18,
  224.                   '   Duplicate a color.  Select source color, then target.');
  225.       ItemsDone;
  226.     AddItemHelp(' Load ', 48, 2, miLoad19,
  227.                 '   Load a palette of colors.');
  228.     AddItemHelp(' Save ', 61, 2, miSave20,
  229.                 '   Save a palette of colors.');
  230.     AddItemHelp(' Quit ', 73, 2, miQuit21,
  231.                 '   Exit the program, return to DOS.');
  232.       AddFramedSubMenu(61, 21, 79, 22, Vertical, Frame1);
  233.       SetNormAttr(YellowOnRed, LtGrayOnBlack);
  234.       SetSelectAttr(WhiteOnBlack, BlackOnLtGray);
  235.       SetHighAttr(WhiteOnRed, WhiteOnBlack);
  236.       SetProtectAttr(LtGrayOnLtGray, BlackOnBlack);
  237.       SetFrameAttr(LtRedOnRed, LtGrayOnBlack);
  238.       SetHeaderAttr(YellowOnRed, BlackOnLtGray);
  239.       AddShadow(shBR, shSeeThru);
  240.       AddItemHelp('Yes.  Exit to DOS', 1, 1, miYesExit22,
  241.                   '   Do you really want to quit this program?');
  242.       AddItemHelp('No.   Resume Work', 2, 1, miNoResume23,
  243.                   '   No.  Do not quit.');
  244.       ItemsDone;
  245.     ItemsDone;
  246.  
  247.     MenuCommands.SetHelpProc (DisplayHelp);      { show help on demand }
  248.     mnOptionsOn (mnUseItemForTopic);             { menu item sets help topic }
  249.     SetCustomStringProc (CustomItemString);      { show option states }
  250.  
  251.     SetErrorProc (ErrorHandler);                 { error msgs }
  252.  
  253.     InitMenu := RawError;
  254.     end; { with M do }
  255. END;
  256.  
  257. { InitHelpLine ============================================================ }
  258.  
  259. FUNCTION InitHelpLine(var H : RawWindow) : Word;
  260.   {-Initialize window for the help line}
  261. CONST 
  262.   Row : byte = 25;
  263. BEGIN
  264.   if not H.InitCustom (1, Row, ScreenWidth, Row,
  265.                        MenuColors, wClear) then begin
  266.     InitHelpLine := InitStatus;
  267.     Exit;
  268.   end;
  269.   H.SetTextAttr (LtBlueOnBlack, LtGrayOnBlack);
  270.   InitHelpLine := 0;
  271. END;
  272.  
  273. { UpdateHelpLine ========================================================== }
  274.  
  275. {$F+}
  276. PROCEDURE UpdateHelpLine (CurrentItem : MenuItemNodePtr; MPtr : MenuPtr);
  277.   {-Update HelpLine for each menu item}
  278. VAR
  279.   S : String;
  280. BEGIN
  281.   if CurrentItem = nil then
  282.     S := ''
  283.   else
  284.     S := CurrentItem^.HelpString;
  285.   H.wFastText(Pad(S, H.Width), 1, 1);
  286. END;
  287. {$F-}
  288.  
  289. { ========================================================================= }
  290. { ========================================================================= }
  291. { Help System }
  292. { ========================================================================= }
  293. { GetHelp ================================================================= }
  294.  
  295. PROCEDURE GetHelp (HelpIndex : word);
  296.  
  297. VAR
  298.   Finished : boolean;
  299.   StoreMouseRoutine : pointer;
  300.   StoreMouseRoutineEvent : MouseEventType;
  301.  
  302. BEGIN
  303.   StoreMouseRoutine := MouseRoutine;
  304.   StoreMouseRoutineEvent := MouseRoutineEvent;
  305.   SetMouseEventHandler (DisableEventHandler, nil);
  306.  
  307.   { Loop through help system }
  308.   Finished := false;
  309.   repeat
  310.     { Display master index, pick help topic }
  311.     PrismHelp.SetTopic (HelpIndex);
  312.     PrismHelp.Process;
  313.     Case PrismHelp.GetLastCommand of
  314.       ccError,
  315.       ccQuit    : Finished := true;
  316.       ccSelect  : begin
  317.                   PrismHelp.SetTopic (PrismHelp.GetTopicChoice);
  318.                   repeat
  319.                     PrismHelp.Process;
  320.                     Case PrismHelp.GetLastCommand of
  321.                       ccError : Finished := true;
  322.                       ccQuit  : if not PrismHelp.InHelpMode then
  323.                                 { escape from pick window within help }
  324.                                   Finished := true;
  325.                       end;  { case }
  326.                   until
  327.                     Finished or (PrismHelp.GetLastCommand = ccQuit);
  328.                   end;
  329.       end;  { case }
  330.   until
  331.     Finished;
  332.   PrismHelp.Erase;
  333.  
  334.   SetMouseEventHandler (StoreMouseRoutineEvent, StoreMouseRoutine);
  335. END;
  336.  
  337. { ========================================================================= }
  338. { ========================================================================= }
  339. { Pick list functions }
  340. { ========================================================================= }
  341. { CustomDirListFormat ===================================================== }
  342.  
  343. {$F+}
  344. PROCEDURE CustomDirListFormat (VAR X : DirRec;  VAR pkCat : byte;
  345.                                VAR S : string;  D : DirListPtr);
  346. {$F-}
  347. { Show only name of palette file, no extension. }
  348.  
  349. BEGIN
  350.   S := Pad (' ' + JustName (X.Name), 10);        { final string }
  351.   pkCat := pkNormal;                             { return normal cat }
  352. END;
  353.  
  354. { ========================================================================= }
  355. { DirectoryList =========================================================== }
  356.  
  357. FUNCTION PickFile : string;
  358. { Gets directory, selects a file. }
  359.  
  360. VAR
  361.   Dir           : dirlist;
  362.   Result,
  363.   Count         : word;
  364.  
  365.   ExitFlag      : boolean;
  366.   EraseFile     : file;
  367.   EraseFileName : string;
  368.   EraseFileAttr : word;
  369.   StoreMouseRoutine : pointer;
  370.   StoreMouseRoutineEvent : MouseEventType;
  371.  
  372. BEGIN
  373.   PickFile := '';
  374.   With Dir do begin
  375.     if not InitCustom (5, 5, 77, 21,
  376.                        MenuColors,
  377.                        DefWindowOptions or wBordered,
  378.                        MaxAvail,
  379.                        PickSnaking,
  380.                        SingleFile)
  381.     then begin
  382.       WriteLn ('Failed to init DirList, Status = ', InitStatus);
  383.       halt;
  384.       end;
  385.  
  386.     { Add mouse support }
  387.     if MouseInstalled then begin
  388.       PickCommands.cpOptionsOn (cpEnableMouse);
  389.       StoreMouseRoutine := MouseRoutine;         { store event handler }
  390.       StoreMouseRoutineEvent := MouseRoutineEvent;
  391.       MouseRoutine := nil;                       { disable event handler }
  392.       EnableEventHandling;
  393.       end;
  394.  
  395.     { Set desired DirList features }
  396.     wframe.AddShadow (shBr, shSeeThru);
  397.     SetPosLimits (1,1, ScreenWidth, pred (ScreenHeight));
  398.     SetPadSize (1,1);
  399.     diOptionsOn (diOPtimizeSize);
  400.     AddMaskHeader (True, 1, 30, heTC);
  401.     SetSortOrder (SortName);
  402.     SetUserFormat (10, CustomDirListFormat);
  403.     SetMask (ProgramPath + '*.Pal', ReadOnly);
  404.     SetSearchMode (PickAltStringSearch);
  405.     PreloadDirList;
  406.     Result := GetLastError;
  407.     end;   { with Dir do begin }
  408.  
  409.   if Result <> 0 then
  410.     PauseMsgBox ('Sorry.  Error ' + Num2Str (Result) + ' has occurred.  ' +
  411.                  ProgramName + ' cannot load this directory.',
  412.                  RedDbColorSet, dbJustify + dbShadow, 40)
  413.   else begin
  414.     Count := Dir.GetMatchingFileCount;
  415.     if Count = 0 then
  416.       PauseMsgBox ('Sorry.  There are no palette files to load.',
  417.                    RedDbColorSet, dbShadow, 50)
  418.     else begin
  419.  
  420.       PickCommands.AddCommand (ccUser2, 1, KcF1, 0);
  421.       PickCommands.AddCommand (ccUser3, 1, KcCtrlU, 0);
  422.  
  423.       ExitFlag := false;
  424.       repeat
  425.         Dir.Process;
  426.         case Dir.GetLastCommand of
  427.  
  428.           ccSelect : begin
  429.                      PickFile := ForceExtension (Dir.GetSelectedPath, 'PAL');
  430.                      ExitFlag := true;
  431.                      end;
  432.           ccError  : FastWrite ('Error:  ' + Long2Str (Dir.GetLastError),
  433.                                 ScreenHeight, 1, TextAttr);
  434.           ccQuit,
  435.           ccUser3  : ExitFlag := true;
  436.  
  437.           ccUser2  : GetHelp (miLoad19);
  438.  
  439.         end;  { case }
  440.       until
  441.         ExitFlag;
  442.       end;  { pick a file }
  443.     end;  { if then else begin }
  444.  
  445.   if MouseInstalled then begin
  446.     MouseRoutine := StoreMouseRoutine;           { restore event handler }
  447.     MouseRoutineEvent := StoreMouseRoutineEvent;
  448.     end;
  449.   Dir.Done;
  450. END;
  451.  
  452. { ========================================================================= }
  453. { ========================================================================= }
  454.  
  455.