home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / TPKEYS.ZIP / TPKEYS.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1988-10-12  |  42.5 KB  |  1,498 lines
  1. {$S-,I-,V-}
  2. {$M 16384,16384,600000}
  3.  
  4. {$I TPDEFINE.INC}
  5.  
  6. {************************************************************}
  7. {*                     TPKEYS.PAS 5.00                      *}
  8. {* Keyboard installation program for Turbo Professional 5.0 *}
  9. {*                 By TurboPower Software                   *}
  10. {************************************************************}
  11.  
  12. program TpKeys;
  13.  
  14. uses
  15.   TpEnhKbd,
  16.   TpString,
  17.   TpDos,
  18.   TpCrt,
  19.   {$IFDEF UseMouse}
  20.   TpMouse,                   {Turbo Professional mouse routines}
  21.   {$ENDIF}
  22.   TpCmd,
  23.   TpClone,
  24.   TpWindow,
  25.   TpMenu,
  26.   {the following units are not actually used}
  27.   TpEdit,
  28.   TpEntry,
  29.   TpPick,
  30.   TpHelp;
  31.  
  32. type
  33.   StringPointer = ^string;
  34. var
  35.   MainMenu : Menu;           {pointer to menu system}
  36.   Ch : Char;                 {menu selection character}
  37.   Key : MenuKey;             {menu choice key}
  38.  
  39.   OrigMode : Word;           {video mode when program started}
  40.   OrigAttr : Byte;           {vide attribute when program started}
  41.  
  42.   LoColor : Byte;            {low video color}
  43.   TiColor : Byte;            {title color}
  44.   CfColor : Byte;            {conflict color}
  45.   ChColor : Byte;            {changed key color}
  46.   EdColor : Byte;            {edit window color}
  47.   FrColor : Byte;            {border frame color}
  48.   StColor : Byte;            {status message color}
  49.  
  50. const
  51.   NameLength = 26;           {Maximum length for command name}
  52.  
  53.   PriCmdCol = 28;            {Where '1: ' appears}
  54.   PriMinCol = 31;            {Where primary key sequence starts}
  55.   PriMaxCol = 45;            {Where primary key sequence ends}
  56.  
  57.   SecCmdCol = 46;            {Where '2: ' appears}
  58.   SecMinCol = 49;            {Where secondary key sequence starts}
  59.   SecMaxCol = 63;            {Where secondary key sequence ends}
  60.  
  61.   TerCmdCol = 64;            {Where '3: ' appears}
  62.   TerMinCol = 67;            {Where tertiary key sequence starts}
  63.   TerMaxCol = 80;            {Where tertiary key sequence ends}
  64.  
  65.   CmdWid = 14;               {Number of columns where the command is displayed}
  66.   FirstRow = 4;              {First row where keys are installed}
  67.   LastRow = 22;              {Last row where keys are installed}
  68.   StatCol = 2;               {Column for status messages}
  69.   StatRow = 24;              {Row for status messages}
  70.   StatWid = 78;              {maximum length of status messages}
  71.  
  72.   EditWinLeft = 3;           {coordinates for key edit window}
  73.   EditWinRight = 78;
  74.   EditWinTop = 11;
  75.   EditWinBot = 13;
  76.   EditCmdWid = 74;           {internal width of key edit window}
  77.   EditCmdCol = 65;           {column for Command/Literal message}
  78.  
  79.   SingBarChar = '─';
  80.   DoubBarChar = '═';
  81.  
  82.   EditPrompt : string[72] =
  83.     '-delete  C-clear  R-restore  ┘-accept  ESC-cancel  Scroll Lock-literal';
  84.   BrowsePrompt : string[67] =
  85.     '--scroll  PgUp-PgDn-page  ┘-modify  R-restore defaults  ESC-exit';
  86.  
  87. type
  88.   String80 = string[80];
  89.  
  90.   NameString = string[NameLength];
  91.   NameArray = array[1..MaxCommands] of NameString;
  92.   MapArray = array[1..MaxCommands] of Byte;
  93.   ByteArray = array[0..MaxKeys] of Byte;
  94.  
  95. var
  96.   EditCP : ClonePack;        {TPEDIT - clone file}
  97.   EntryCP : ClonePack;       {TPENTRY - clone file}
  98.   HelpCP : ClonePack;        {TPHELP - clone file}
  99.   MenuCP : ClonePack;        {TPMENU - clone file}
  100.   PickCP : ClonePack;        {TPPICK - clone file}
  101.  
  102.   EditPos : LongInt;         {TPEDIT - file pointer}
  103.   EntryPos : LongInt;        {TPENTRY - file pointer}
  104.   HelpPos : LongInt;         {TPHELP - file pointer}
  105.   MenuPos : LongInt;         {TPMENU - file pointer}
  106.   PickPos : LongInt;         {TPPICK - file pointer}
  107.  
  108.   MenuKeySet2 : array[0..MenuKeyMax] of Byte; {TPMENU - packed keys}
  109.  
  110.   EditUK : UnpackedKeyArray; {TPEDIT - unpacked keys}
  111.   EntryUK : UnpackedKeyArray; {TPENTRY - unpacked keys}
  112.   HelpUK : UnpackedKeyArray; {TPHELP - unpacked keys}
  113.   MenuUK : UnpackedKeyArray; {TPMENU - unpacked keys}
  114.   PickUK : UnpackedKeyArray; {TPPICK - unpacked keys}
  115.  
  116.   OUK : UnpackedKeyArray;    {Original unpacked key array}
  117.   P : UnpackedKeyPtr;        {Pointer to current unpacked key array}
  118.   N : ^NameArray;            {Pointer to current name array}
  119.   NNames : Word;             {Current number of command names}
  120.   M : ^MapArray;             {Pointer to current order map array}
  121.   NMaps : Word;              {Current number of displayed commands}
  122.  
  123.   Modified : Boolean;        {True when installation changes may have occurred}
  124.  
  125.   {$IFDEF UseMouse}
  126. const
  127.   MapLeftButton : Boolean = True;
  128.  
  129.   {used to translate mouse buttons to keys}
  130.   ButtonCodes : array[$E9..$EF] of Word = (
  131.     $011B,                   {all three buttons         = ESC}
  132.     $011B,                   {right and center buttons  = ESC}
  133.     $011B,                   {left and center buttons   = ESC}
  134.     $011B,                   {center button             = ESC}
  135.     $011B,                   {both buttons              = ESC}
  136.     $011B,                   {right button              = ESC}
  137.     $1C0D);                  {left button               = Enter}
  138.   {$ENDIF}
  139.  
  140.   {.F-}
  141. const
  142.   EditFileName : string[6] = 'TPEDIT';
  143.  
  144.   {names of TpEdit commands -- array must start with 1 (RSchar)}
  145.   EditNames : array[RSchar..RSuser9] of NameString = (
  146.    '',                            {RSchar}
  147.    'Enter control char',          {RSctrlChar}
  148.    'Accept string',               {RSenter}
  149.    'Cancel',                      {RSquit}
  150.    'Restore string',              {RSrestore}
  151.    'Cursor to start of line',     {RShome}
  152.    'Cursor to end of line',       {RSend}
  153.    'Cursor left',                 {RSleft}
  154.    'Cursor right',                {RSright}
  155.    'Cursor left one word',        {RSwordLeft}
  156.    'Cursor right one word',       {RSwordRight}
  157.    'Delete previous char',        {RSback}
  158.    'Delete char at cursor',       {RSdel}
  159.    'Delete to end of line',       {RSdelEol}
  160.    'Delete from start of line',   {RSdelBol}
  161.    'Delete entire line',          {RSdelLine}
  162.    'Delete word',                 {RSdelWord}
  163.    'Toggle insert mode',          {RSins}
  164.    'Help',                        {RShelp}
  165.    'User 0',                      {RSuser0}
  166.    'User 1',                      {RSuser1}
  167.    'User 2',                      {RSuser2}
  168.    'User 3',                      {RSuser3}
  169.    'User 4',                      {RSuser4}
  170.    'User 5',                      {RSuser5}
  171.    'User 6',                      {RSuser6}
  172.    'User 7',                      {RSuser7}
  173.    'User 8',                      {RSuser8}
  174.    'User 9'                       {RSuser9}
  175.    );
  176.  
  177.   {Display map for TpEdit commands -- 0 inserts a divider bar}
  178.   EditDisplay = 31;
  179.   EditMap : array[1..EditDisplay] of Byte = (
  180.     RSleft, RSright, RSwordLeft, RSwordRight, RShome, RSend,
  181.     0,
  182.     RSback, RSdel, RSdelEol, RSdelBol, RSdelLine, RSdelWord, RSins,
  183.     0,
  184.     RSenter, RSquit, RSctrlChar, RSrestore, RShelp,
  185.     0,
  186.     RSuser0, RSuser1, RSuser2, RSuser3, RSuser4,
  187.     RSuser5, RSuser6, RSuser7, RSuser8, RSuser9);
  188.  
  189.   EntryFileName : string[7] = 'TPENTRY';
  190.   EntryNames : array[ESChar..ESmouse] of NameString = (
  191.    '',                            {ESchar}
  192.    'Enter control char',          {ESctrlChar}
  193.    'Restore string',              {ESrestore}
  194.    'Cursor to start of line',     {EShome}
  195.    'Cursor to end of line',       {ESend}
  196.    'Cursor left',                 {ESleft}
  197.    'Cursor right',                {ESright}
  198.    'Cursor left one word',        {ESwordLeft}
  199.    'Cursor right one word',       {ESwordRight}
  200.    'Delete previous char',        {ESback}
  201.    'Delete char at cursor',       {ESdel}
  202.    'Delete entire field',         {ESdelLine}
  203.    'Delete to end of field',      {ESdelEol}
  204.    'Delete from start of field',  {ESdelBol}
  205.    'Delete word',                 {ESdelWord}
  206.    'Toggle insert mode',          {ESins}
  207.    'Help',                        {EShelp}
  208.    'Next subfield',               {EStab}
  209.    'Previous subfield',           {ESbackTab}
  210.    'Increment choice',            {ESincChoice}
  211.    'Decrement choice',            {ESdecChoice}
  212.    'Next field',                  {ESnextField}
  213.    'Previous field',              {ESprevField}
  214.    'Next field down',             {ESdownField}
  215.    'Next field up',               {ESupField}
  216.    'Next record',                 {ESnextRec}
  217.    'Previous record',             {ESprevRec}
  218.    'First field',                 {ESfirstFld}
  219.    'Last field',                  {ESlastFld}
  220.    '',                            {ESnested} {shouldn't be assigned!}
  221.    'User 0',                      {ESuser0}
  222.    'User 1',                      {ESuser1}
  223.    'User 2',                      {ESuser2}
  224.    'User 3',                      {ESuser3}
  225.    'User 4',                      {ESuser4}
  226.    'User 5',                      {ESuser5}
  227.    'User 6',                      {ESuser6}
  228.    'User 7',                      {ESuser7}
  229.    'User 8',                      {ESuser8}
  230.    'User 9',                      {ESuser9}
  231.    'Accept data',                 {ESdone}
  232.    'Cancel',                      {ESquit}
  233.    '',                            {ESclickExit} {shouldn't be assigned!}
  234.    'Mouse select'                 {ESmouse}
  235.    );
  236.   EntryDisplay = 46;
  237.   EntryMap : array[1..EntryDisplay] of Byte = (
  238.     ESleft, ESright, ESwordLeft, ESwordRight, EShome, ESend, EStab, ESbackTab,
  239.     0,
  240.     ESback, ESdel, ESdelEol, ESdelBol, ESdelLine, ESdelWord, ESins,
  241.     0,
  242.     ESnextField, ESprevField, ESdownField, ESupField,
  243.     ESnextRec, ESprevRec, ESfirstFld, ESlastFld,
  244.     0,
  245.     ESdone, ESquit, ESmouse, ESctrlChar, ESrestore, EShelp,
  246.     0,
  247.     ESincChoice, ESdecChoice,
  248.     0,
  249.     ESuser0, ESuser1, ESuser2, ESuser3, ESuser4,
  250.     ESuser5, ESuser6, ESuser7, ESuser8, ESuser9);
  251.  
  252.   HelpFileName : string[6] = 'TPHELP';
  253.   HelpNames : array[HKSAlpha..HKSUser3] of NameString = (
  254.    '',                            {HKSAlpha}
  255.    'Cursor up',                   {HKSUp}
  256.    'Cursor down',                 {HKSDown}
  257.    'Page up',                     {HKSPgUp}
  258.    'Page down',                   {HKSPgDn}
  259.    'Cursor left',                 {HKSLeft}
  260.    'Cursor right',                {HKSRight}
  261.    'Exit from help system',       {HKSExit}
  262.    'Select cross-ref topic',      {HKSSelect}
  263.    'Previous help topic',         {HKSPrev}
  264.    'First help page',             {HKSHome}
  265.    'Last help page',              {HKSEnd}
  266.    'Display help index',          {HKSIndex}
  267.    'Mouse select',                {HKSProbe}
  268.    'User 0',                      {HKSuser0}
  269.    'User 1',                      {HKSuser1}
  270.    'User 2',                      {HKSuser2}
  271.    'User 3'                       {HKSuser3}
  272.    );
  273.   HelpDisplay = 19;
  274.   HelpMap : array[1..HelpDisplay] of Byte = (
  275.     HKSUp, HKSDown, HKSLeft, HKSRight,
  276.     HKSHome, HKSEnd, HKSPgUp, HKSPgDn,
  277.     0,
  278.     HKSSelect, HKSProbe, HKSPrev, HKSIndex, HKSExit,
  279.     0,
  280.     HKSUser0, HKSUser1, HKSUser2, HKSUser3);
  281.  
  282.   MenuFileName : string[6] = 'TPMENU';
  283.   MenuNames : array[MKSAlpha..MKSuser3] of NameString = (
  284.    '',                            {MKSAlpha}
  285.    'Cursor up',                   {MKSUp}
  286.    'Cursor down',                 {MKSDown}
  287.    '',                            {unused}
  288.    '',                            {unused}
  289.    'Cursor left',                 {MKSLeft}
  290.    'Cursor right',                {MKSRight}
  291.    'Exit from menu',              {MKSExit}
  292.    'Select item',                 {MKSSelect}
  293.    'Help',                        {MKSHelp}
  294.    'First menu item',             {MKSHome}
  295.    'Last menu item',              {MKSEnd}
  296.    'Mouse select',                {MKSProbe}
  297.    'User 0',                      {MKSuser0}
  298.    'User 1',                      {MKSuser1}
  299.    'User 2',                      {MKSuser2}
  300.    'User 3'                       {MKSuser3}
  301.    );
  302.   MenuDisplay = 17;
  303.   MenuMap : array[1..MenuDisplay] of Byte = (
  304.     MKSUp, MKSDown, MKSLeft, MKSRight,
  305.     0,
  306.     MKSHome, MKSEnd,
  307.     0,
  308.     MKSSelect, MKSProbe, MKSExit, MKSHelp,
  309.     0,
  310.     MKSUser0, MKSUser1, MKSUser2, MKSUser3);
  311.  
  312.   PickFileName : string[6] = 'TPPICK';
  313.   PickNames : array[PKSAlpha..PKSUser3] of NameString = (
  314.    '',                            {PKSAlpha}
  315.    'Cursor up',                   {PKSUp}
  316.    'Cursor down',                 {PKSDown}
  317.    'Page up',                     {PKSPgUp}
  318.    'Page down',                   {PKSPgDn}
  319.    'Cursor left',                 {PKSLeft}
  320.    'Cursor right',                {PKSRight}
  321.    'Exit from pick list',         {PKSExit}
  322.    'Select item',                 {PKSSelect}
  323.    'Help',                        {PKSHelp}
  324.    'First menu item',             {PKSHome}
  325.    'Last menu item',              {PKSEnd}
  326.    'Mouse select',                {PKSProbe}
  327.    'User 0',                      {PKSuser0}
  328.    'User 1',                      {PKSuser1}
  329.    'User 2',                      {PKSuser2}
  330.    'User 3'                       {PKSuser3}
  331.    );
  332.   PickDisplay = 19;
  333.   PickMap : array[1..PickDisplay] of Byte = (
  334.     PKSUp, PKSDown, PKSLeft, PKSRight,
  335.     0,
  336.     PKSHome, PKSEnd, PKSPgUp, PKSPgDn,
  337.     0,
  338.     PKSSelect, PKSProbe, PKSExit, PKSHelp,
  339.     0,
  340.     PKSUser0, PKSUser1, PKSUser2, PKSUser3);
  341. {.F+}
  342.  
  343.   {$IFDEF UseMouse}
  344.  
  345.   function ReadKeyWord : Word;
  346.     {-Get a key from the keyboard or mouse}
  347.   var
  348.     I : Word;
  349.   begin
  350.     I := ReadKeyOrButton;
  351.     case Hi(I) of
  352.       $E9..$EE :
  353.         ReadKeyWord := ButtonCodes[Hi(I)];
  354.       $EF :
  355.         if MapLeftButton then
  356.           ReadKeyWord := ButtonCodes[$EF]
  357.         else
  358.           ReadKeyWord := $EF00;
  359.     else
  360.       ReadKeyWord := I
  361.     end;
  362.   end;
  363.  
  364.   function ReadKey : Char;
  365.     {-Special ReadKey routine that accounts for mouse}
  366.   const
  367.     ScanCode : Char = #0;
  368.   var
  369.     Key : Word;
  370.   begin
  371.     if ScanCode <> #0 then begin
  372.       {return the scan code}
  373.       ReadKey := ScanCode;
  374.       ScanCode := #0;
  375.     end
  376.     else begin
  377.       {get the next keystroke}
  378.       Key := ReadKeyWord;
  379.  
  380.       {return the low byte}
  381.       ReadKey := Char(Lo(Key));
  382.  
  383.       {if it's 0, save the scan code for the next call}
  384.       if Lo(Key) = 0 then
  385.         ScanCode := Char(Hi(Key));
  386.     end;
  387.   end;
  388.  
  389.   function KeyPressed : Boolean;
  390.     {-Special KeyPressed routine that accounts for mouse}
  391.   begin
  392.     KeyPressed := TpCrt.KeyPressed or MousePressed;
  393.   end;
  394.  
  395.   {$ENDIF}
  396.  
  397.   function ErrorMessage(Status : Word) : string;
  398.     {-Return Turbo runtime error messages}
  399.   var
  400.     S : string;
  401.   begin
  402.     case Status of
  403.       000 : S := '';
  404.       002 : S := 'File not found';
  405.       003 : S := 'Path not found';
  406.       004 : S := 'Too many open files';
  407.       005 : S := 'File access denied';
  408.       006 : S := 'Invalid file handle';
  409.       012 : S := 'Invalid file access code';
  410.       015 : S := 'Invalid drive number';
  411.       016 : S := 'Cannot remove current directory';
  412.       017 : S := 'Cannot rename across drives';
  413.       100 : S := 'Disk read error';
  414.       101 : S := 'Disk write error';
  415.       102 : S := 'File not assigned';
  416.       103 : S := 'File not open';
  417.       104 : S := 'File not open for input';
  418.       105 : S := 'File not open for output';
  419.       106 : S := 'Invalid numeric format';
  420.       150 : S := 'Disk is write-protected';
  421.       151 : S := 'Unknown unit';
  422.       152 : S := 'Drive not ready';
  423.       153 : S := 'Unknown command';
  424.       154 : S := 'CRC error in data';
  425.       155 : S := 'Bad drive request structure length';
  426.       156 : S := 'Disk seek error';
  427.       157 : S := 'Unknown media type';
  428.       158 : S := 'Sector not found';
  429.       159 : S := 'Printer out of paper';
  430.       160 : S := 'Device write fault';
  431.       161 : S := 'Device read fault';
  432.       162 : S := 'Hardware failure';
  433.       200 : S := 'Division by zero';
  434.       201 : S := 'Range check error';
  435.       202 : S := 'Stack overflow';
  436.       203 : S := 'Insufficient memory';
  437.       204 : S := 'Invalid pointer operation';
  438.       205 : S := 'Floating point overflow';
  439.       206 : S := 'Floating point underflow';
  440.       207 : S := 'Invalid floating point operation';
  441.     else
  442.       S := 'Turbo runtime error '+Long2Str(Status);
  443.     end;
  444.     ErrorMessage := S;
  445.   end;
  446.  
  447.   procedure Error(Msg : string);
  448.     {-Report error and halt}
  449.   begin
  450.     {$IFDEF UseMouse}
  451.     if MouseInstalled then
  452.       HideMouse;
  453.     {$ENDIF}
  454.  
  455.     Window(1, 1, ScreenWidth, ScreenHeight);
  456.     ClrScr;
  457.     WriteLn(Msg);
  458.     Halt(1);
  459.   end;
  460.  
  461.   procedure ClrStatLine;
  462.     {-Clear status line}
  463.   begin
  464.     FastWrite(CharStr(' ', StatWid), StatRow, StatCol, StColor);
  465.   end;
  466.  
  467.   procedure InitMenu(var M : Menu);
  468.     {-Initialize menu system}
  469.   const
  470.     Color1 : MenuColorArray = ($1F, $5F, $1B, $5F, $1B, $00, $00, $00);
  471.     Mono1 : MenuColorArray = ($0F, $70, $07, $70, $0F, $00, $00, $00);
  472.     Frame1 : FrameArray = '╒╘╕╛═│';
  473.   begin
  474.     {we'll do our own color mapping}
  475.     MapColors := False;
  476.     if (WhichHerc <> HercInColor) and (CurrentMode <> 3) then
  477.       Color1 := Mono1;
  478.  
  479.     M := NewMenu([], nil);
  480.     SubMenu(1, 1, 0, Horizontal, Frame1, Color1,
  481.       ' TPKEYS - Turbo Professional 5.0 Keyboard Installation ');
  482.       MenuWidth(80);
  483.       MenuItem(' TPEDIT ', 4, 0, 1, '');
  484.       MenuItem(' TPENTRY ', 18, 0, 2, '');
  485.       MenuItem(' TPHELP ', 34, 0, 3, '');
  486.       MenuItem(' TPMENU ', 50, 0, 4, '');
  487.       MenuItem(' TPPICK ', 65, 0, 5, '');
  488.     PopSublevel;
  489.  
  490.     ResetMenu(M);
  491.   end;
  492.  
  493.   procedure Init;
  494.     {-Initialize data structures}
  495.   begin
  496.     {Assure 80 column}
  497.     CheckBreak := False;
  498.     OrigMode := LastMode;
  499.     OrigAttr := TextAttr;
  500.  
  501.     {assure 80 column text mode}
  502.     case CurrentMode of
  503.       0..1 : TextMode(CurrentMode+2);
  504.       2..3, 7 : {ok} ;
  505.     else TextMode(3);
  506.     end;
  507.  
  508.     {assure 25-line mode}
  509.     if Hi(LastMode) <> 0 then
  510.       SelectFont8x8(False);
  511.  
  512.     {Set up colors}
  513.     if (CurrentMode = 3) or (WhichHerc = HercInColor) then begin
  514.       LoColor := $0F;
  515.       TiColor := $0B;
  516.       ChColor := $0C;
  517.       EdColor := $1F;
  518.       CfColor := $4F;
  519.       FrColor := $1F;
  520.       StColor := $1B;
  521.     end
  522.     else begin
  523.       LoColor := $07;
  524.       TiColor := $0F;
  525.       ChColor := $0F;
  526.       EdColor := $70;
  527.       CfColor := $70;
  528.       FrColor := $0F;
  529.       StColor := $07;
  530.     end;
  531.  
  532.     TextAttr := LoColor;
  533.     ClrScr;
  534.     Modified := False;
  535.  
  536.     FrameWindow(StatCol-1, StatRow-1, StatCol+StatWid, StatRow+1,
  537.       FrColor, FrColor, '');
  538.     ClrStatLine;
  539.  
  540.     {$IFDEF UseMouse}
  541.     if MouseInstalled then begin
  542.       {use a diamond for our mouse cursor}
  543.       if (CurrentMode = 3) or (WhichHerc = HercInColor) then
  544.         SoftMouseCursor($0000, $4F04)
  545.       else
  546.         SoftMouseCursor($0000, $0F04);
  547.       ShowMouse;
  548.  
  549.       {enable mouse support}
  550.       EnableMenuMouse;
  551.     end;
  552.     {$ENDIF}
  553.   end;
  554.  
  555.   procedure StatMessage(Msg : string);
  556.     {-Write a message to status line}
  557.   var
  558.     Col : Byte;
  559.   begin
  560.     {$IFDEF UseMouse}
  561.     if MouseInstalled then
  562.       HideMouse;
  563.     {$ENDIF}
  564.  
  565.     ClrStatLine;
  566.     if Length(Msg) > StatWid then
  567.       Msg[0] := Char(StatWid);
  568.     Col := (80-Length(Msg)) shr 1;
  569.     FastWrite(Msg, 24, StatCol+Col, StColor);
  570.     GoToXYAbs(StatCol+Col+Length(Msg), 24);
  571.  
  572.     {$IFDEF UseMouse}
  573.     if MouseInstalled then
  574.       ShowMouse;
  575.     {$ENDIF}
  576.   end;
  577.  
  578.   function PromptYesNo(Msg : string) : Boolean;
  579.     {-Return true if yes answer}
  580.   var
  581.     Ch : Char;
  582.   begin
  583.     StatMessage(Msg);
  584.     repeat
  585.       Ch := Upcase(ReadKey);
  586.     until (Ch = 'Y') or (Ch = 'N');
  587.     PromptYesNo := (Ch = 'Y');
  588.   end;
  589.  
  590.   procedure PromptEsc(Msg : string);
  591.     {-Prompt for <Esc> to be pressed}
  592.   var
  593.     Ch : Char;
  594.   begin
  595.     StatMessage(Msg+'. Press <Esc>');
  596.     repeat
  597.       Ch := ReadKey;
  598.     until Ch = #27;
  599.   end;
  600.  
  601.   procedure PressEsc(Msg : string);
  602.     {-Write a message and wait for <Esc>}
  603.   var
  604.     Ch : Char;
  605.   begin
  606.     StatMessage(Msg+'. Press <Esc> to correct...');
  607.     repeat
  608.       Ch := ReadKey;
  609.     until Ch = #27;
  610.   end;
  611.  
  612.   procedure CheckCloneError(FPos : LongInt; Msg : string);
  613.     {-Check the opening of the installation program}
  614.   begin
  615.     if CloneError <> 0 then
  616.       if FPos = 0 then
  617.         Error(Msg)
  618.       else
  619.         Error(ErrorMessage(CloneError));
  620.   end;
  621.  
  622.   procedure InitClonePrim(FName : String80; var CP : ClonePack;
  623.                           var ID : string; var Pos : LongInt);
  624.     {-Primitive routine to initialize a unit for cloning}
  625.   begin
  626.     {open file for cloning}
  627.     FName := DefaultExtension(FName, 'TPU');
  628.     if not ExistOnPath(FName, FName) then
  629.       CloneError := 2
  630.     else
  631.       Pos := InitForCloning(FName, CP, ID, Length(ID)+1);
  632.  
  633.     {check for errors}
  634.     if CloneError = 2 then
  635.       Error(FName+' not found')
  636.     else
  637.       CheckCloneError(Pos, FName+' ID string not found');
  638.  
  639.     {skip over ID string}
  640.     Inc(Pos, Length(ID)+1);
  641.   end;
  642.  
  643.   procedure Open;
  644.     {-Open the TPU files for installation}
  645.   begin
  646.     {don't change time *or* date stamps on TPU files--it might force
  647.      unnecessary recompilation of other units}
  648.     DateUpdate := UpdateNone;
  649.  
  650.     WriteLn('Finding identification strings...');
  651.     InitClonePrim(EditFileName, EditCP, EditKeyID, EditPos);
  652.     InitClonePrim(EntryFileName, EntryCP, EntryKeyID, EntryPos);
  653.     InitClonePrim(MenuFileName, MenuCP, MenuKeyID, MenuPos);
  654.     InitClonePrim(HelpFileName, HelpCP, HelpKeyID, HelpPos);
  655.     InitClonePrim(PickFileName, PickCP, PickKeyID, PickPos);
  656.   end;
  657.  
  658.   procedure LoadPrim(var CP : ClonePack; FPos : LongInt;
  659.                      var Defaults; DefSize : Word);
  660.     {-Primitive routine to load defaults for a unit}
  661.   begin
  662.     {load defaults}
  663.     LoadDefaults(CP, FPos, Defaults, DefSize);
  664.  
  665.     {check for errors}
  666.     CheckCloneError(1, '');
  667.   end;
  668.  
  669.   procedure Load;
  670.     {-Load the default settings}
  671.   begin
  672.     LoadPrim(EditCP, EditPos, EditKeySet, SizeOf(EditKeySet));
  673.     LoadPrim(EntryCP, EntryPos, EntryKeySet, SizeOf(EntryKeySet));
  674.     LoadPrim(MenuCP, MenuPos, MenuKeySet2, SizeOf(MenuKeySet2));
  675.     LoadPrim(HelpCP, HelpPos, HelpKeySet, SizeOf(HelpKeySet));
  676.     LoadPrim(PickCP, PickPos, PickKeySet, SizeOf(PickKeySet));
  677.   end;
  678.  
  679.   procedure UnpackPrim(var PK, UK);
  680.     {-Primitive routine to unpack the commands for a unit}
  681.   var
  682.     I : Word;
  683.   begin
  684.     I := UnpackKeys(PK, UK, MaxCommands, 3);
  685.   end;
  686.  
  687.   procedure Unpack;
  688.     {-Unpack all of the key arrays}
  689.   begin
  690.     UnpackPrim(EditKeySet, EditUK);
  691.     UnpackPrim(EntryKeySet, EntryUK);
  692.     UnpackPrim(MenuKeySet2, MenuUK);
  693.     UnpackPrim(HelpKeySet, HelpUK);
  694.     UnpackPrim(PickKeySet, PickUK);
  695.   end;
  696.  
  697.   procedure PackPrim(var PK, UK; MaxBytes : Word);
  698.     {-Primitive routine to pack the commands for a unit}
  699.   var
  700.     I : Word;
  701.   begin
  702.     I := PackKeys(PK, MaxCommands, MaxBytes, UK);
  703.   end;
  704.  
  705.   procedure Pack;
  706.     {-Pack all of the key arrays}
  707.   begin
  708.     PackPrim(EditKeySet, EditUK, EditKeyMax);
  709.     PackPrim(EntryKeySet, EntryUK, EntryKeyMax);
  710.     PackPrim(MenuKeySet2, MenuUK, MenuKeyMax);
  711.     PackPrim(HelpKeySet, HelpUK, HelpKeyMax);
  712.     PackPrim(PickKeySet, PickUK, PickKeyMax);
  713.   end;
  714.  
  715.   procedure StorePrim(var CP : ClonePack; FPos : LongInt;
  716.                       var Defaults; DefSize : Word);
  717.     {-Primitive routine to store the packed commands for a unit}
  718.   begin
  719.     {store modified defaults}
  720.     StoreDefaults(CP, FPos, Defaults, DefSize);
  721.  
  722.     {check for errors}
  723.     CheckCloneError(1, '');
  724.  
  725.     {close clone file}
  726.     CloseForCloning(CP);
  727.  
  728.     {check for errors}
  729.     CheckCloneError(1, '');
  730.   end;
  731.  
  732.   function CheckModifiedFlags(var UnpackedKeys; NumCmds : Word) : Boolean;
  733.     {-Check to see if any of the Modified flags are set in UnpackedKeys}
  734.   var
  735.     I : Word;
  736.     UK : UnpackedKeyArray absolute UnpackedKeys;
  737.   begin
  738.     {assume success}
  739.     CheckModifiedFlags := False;
  740.  
  741.     {turn off all Conflict flags}
  742.     for I := 1 to NumCmds do
  743.       if UK[I].Modified then begin
  744.         CheckModifiedFlags := True;
  745.         Exit;
  746.       end;
  747.   end;
  748.  
  749.   procedure Store;
  750.     {-Store the new default settings}
  751.   begin
  752.     StatMessage('Storing new defaults....');
  753.     if CheckModifiedFlags(EditUK, MaxCommands) then
  754.       StorePrim(EditCP, EditPos, EditKeySet, SizeOf(EditKeySet));
  755.     if CheckModifiedFlags(EntryUK, MaxCommands) then
  756.       StorePrim(EntryCP, EntryPos, EntryKeySet, SizeOf(EntryKeySet));
  757.     if CheckModifiedFlags(MenuUK, MaxCommands) then
  758.       StorePrim(MenuCP, MenuPos, MenuKeySet2, SizeOf(MenuKeySet2));
  759.     if CheckModifiedFlags(HelpUK, MaxCommands) then
  760.       StorePrim(HelpCP, HelpPos, HelpKeySet, SizeOf(HelpKeySet));
  761.     if CheckModifiedFlags(PickUK, MaxCommands) then
  762.       StorePrim(PickCP, PickPos, PickKeySet, SizeOf(PickKeySet));
  763.   end;
  764.  
  765.   {$L PREF.OBJ}
  766.  
  767.   {$F+}
  768.   function EscapeSequence(B : Byte) : StringPointer; external;
  769.   {-Return a pointer to a text string representing extended scan code B}
  770.   {$F-}
  771.  
  772.   procedure KeyToString(Key : Word; var S : string; SingleKey : Boolean);
  773.    {-Returns a string (S) representing a Key. Special is set to False if
  774.      a simple character is being returned.}
  775.   begin
  776.     if (Lo(Key) = 0) or (Lo(Key) = $E0) then
  777.       S := '<'+EscapeSequence(Hi(Key))^+'>'
  778.     else begin
  779.       if (Lo(Key) <= 31) and not SingleKey then
  780.         S := '<^'+Chr(Lo(Key)+64)+'>'
  781.       else
  782.         case Lo(Key) of
  783.           008 : S := '<BkSp>'; {Backspace}
  784.           009 : S := '<Tab>'; {Tab}
  785.           010 : S := '<^Enter>'; {^Enter}
  786.           013 : S := '<Enter>'; {Enter}
  787.           027 : S := '<Esc>'; {Escape}
  788.           1..31 :            {Control characters}
  789.             S := '<^'+Chr(Lo(Key)+64)+'>';
  790.           032 : S := '<Space>';
  791.           127 : S := '<^BkSp>'; {ASCII DEL}
  792.           255 : S := '<#255>'; {#255}
  793.         else
  794.           {Normal character}
  795.           S := '<'+Char(Lo(Key))+'>';
  796.         end;
  797.     end;
  798.   end;
  799.  
  800.   procedure DrawKeys(Keys : KeyString; Row, Col : Integer; Attr : Byte;
  801.                      MoveCursor : Boolean; CmdWidth : Byte);
  802.     {-Draw the keystrokes in specified attribute}
  803.   var
  804.     KLen : Byte absolute Keys;
  805.     I : Integer;
  806.     KW : Word;
  807.     KeyStr : string[20];
  808.     CurCol : Integer;
  809.     Special : Boolean;
  810.     S : String80;
  811.     SLen : Byte absolute S;
  812.   begin
  813.     I := 1;
  814.     SLen := 0;
  815.     while I <= KLen do begin
  816.       if Keys[I] = #0 then begin
  817.         if I = KLen then
  818.           KW := 0
  819.         else begin
  820.           Inc(I);
  821.           KW := Swap(Byte(Keys[I]));
  822.         end;
  823.       end
  824.       else
  825.         KW := Byte(Keys[I]);
  826.       KeyToString(KW, KeyStr, KLen = 1);
  827.       S := S+KeyStr;
  828.       Inc(I);
  829.     end;
  830.     if SLen >= CmdWidth then begin
  831.       CurCol := CmdWidth;
  832.       SLen := CmdWidth;
  833.     end
  834.     else begin
  835.       CurCol := SLen;
  836.       S := Pad(S, CmdWidth);
  837.     end;
  838.  
  839.     FastWrite(S, Row, Col, Attr);
  840.     if MoveCursor then
  841.       GoToXY(Col+CurCol, Row);
  842.   end;
  843.  
  844.   procedure DrawCmd(Cmd, Row : Integer);
  845.     {-Write a single command, Cmd, at screen Row}
  846.   var
  847.     Attr : Byte;
  848.     St : String80;
  849.     Index : Word;
  850.   begin
  851.     {$IFDEF UseMouse}
  852.     if MouseInstalled then
  853.       HideMouse;
  854.     {$ENDIF}
  855.  
  856.     if Cmd = 0 then begin
  857.       {Separator bar}
  858.       St := CharStr(SingBarChar, 80);
  859.       FastWrite(St, Row, 1, TiColor);
  860.     end
  861.     else begin
  862.       Index := ((Cmd-1)*3)+1;
  863.  
  864.       {Name of command}
  865.       St := Pad(N^[Cmd], PriCmdCol-1);
  866.       St := St+'1:';
  867.       FastWrite(Pad(St, 80), Row, 1, TiColor);
  868.  
  869.       {Primary keys}
  870.       with P^[Index] do begin
  871.         if Length(Keys) = 0 then
  872.           Attr := LoColor
  873.         else if Conflict then
  874.           Attr := CfColor
  875.         else if Modified then
  876.           Attr := ChColor
  877.         else
  878.           Attr := LoColor;
  879.         DrawKeys(Keys, Row, PriMinCol, Attr, False, CmdWid);
  880.       end;
  881.  
  882.       {Secondary keys}
  883.       FastWrite('2:', Row, SecCmdCol, TiColor);
  884.       with P^[Index+1] do begin
  885.         if Length(Keys) = 0 then
  886.           Attr := LoColor
  887.         else if Conflict then
  888.           Attr := CfColor
  889.         else if Modified then
  890.           Attr := ChColor
  891.         else
  892.           Attr := LoColor;
  893.         DrawKeys(Keys, Row, SecMinCol, Attr, False, CmdWid);
  894.       end;
  895.  
  896.       {Tertiary keys}
  897.       FastWrite('3:', Row, TerCmdCol, TiColor);
  898.       with P^[Index+2] do begin
  899.         if Length(Keys) = 0 then
  900.           Attr := LoColor
  901.         else if Conflict then
  902.           Attr := CfColor
  903.         else if Modified then
  904.           Attr := ChColor
  905.         else
  906.           Attr := LoColor;
  907.         DrawKeys(Keys, Row, TerMinCol, Attr, False, CmdWid);
  908.       end;
  909.     end;
  910.  
  911.     {$IFDEF UseMouse}
  912.     if MouseInstalled then
  913.       ShowMouse;
  914.     {$ENDIF}
  915.   end;
  916.  
  917.   procedure EditCmd(Cmd : Word; var Key : KeyRec);
  918.     {-Edit one keystroke sequence}
  919.   const
  920.     SMask = $10;             {Scroll lock bit mask}
  921.     ComStr : string[9] = ' Command ';
  922.     LitStr : string[9] = ' Literal ';
  923.   var
  924.     KFlag : Byte absolute $0040 : $0017;
  925.     SLock : Byte;
  926.     LLock : Byte;
  927.     KW : Word;
  928.     K : KeyString;
  929.     KLen : Byte absolute K;
  930.     B : KeyString;
  931.     Done : Boolean;
  932.     Attr : Byte;
  933.  
  934.     function AddKey(B : Byte) : Char;
  935.       {-Map alpha characters to control key equivalents}
  936.     begin
  937.       Char(B) := System.Upcase(Char(B));
  938.       case Char(B) of
  939.         'A'..'Z' :
  940.           AddKey := Char(B-64);
  941.       else
  942.         AddKey := Char(B);
  943.       end;
  944.     end;
  945.  
  946.   begin
  947.     StatMessage(EditPrompt);
  948.  
  949.     {$IFDEF UseMouse}
  950.     if MouseInstalled then
  951.       HideMouse;
  952.     {$ENDIF}
  953.  
  954.     FrameWindow(EditWinLeft, EditWinTop, EditWinRight, EditWinBot,
  955.       EdColor, EdColor, ' '+N^[Cmd]+' ');
  956.  
  957.     LLock := $FF;
  958.     K := Key.Keys;
  959.     B := K;
  960.  
  961.     Done := False;
  962.     repeat
  963.       {$IFDEF UseMouse}
  964.       if MouseInstalled then
  965.         HideMouse;
  966.       {$ENDIF}
  967.  
  968.       DrawKeys(K, EditWinTop+1, EditWinLeft+1, EdColor, True, EditCmdWid);
  969.  
  970.       {$IFDEF UseMouse}
  971.       if MouseInstalled then
  972.         ShowMouse;
  973.       {$ENDIF}
  974.  
  975.       repeat
  976.         SLock := KFlag and SMask;
  977.         if SLock <> LLock then begin
  978.  
  979.           {$IFDEF UseMouse}
  980.           if MouseInstalled then
  981.             HideMouse;
  982.           {$ENDIF}
  983.  
  984.           if SLock = 0 then
  985.             FastWrite(ComStr, EditWinBot, EditCmdCol, EdColor)
  986.           else
  987.             FastWrite(LitStr, EditWinBot, EditCmdCol, EdColor);
  988.  
  989.           {$IFDEF UseMouse}
  990.           if MouseInstalled then
  991.             ShowMouse;
  992.           {$ENDIF}
  993.  
  994.           LLock := SLock;
  995.         end;
  996.       until KeyPressed;
  997.  
  998.       {$IFDEF UseMouse}
  999.       KW := ReadKeyOrButton;
  1000.       {$ELSE}
  1001.         KW := ReadKeyWord;
  1002.       {$ENDIF}
  1003.  
  1004.       if SLock <> 0 then begin
  1005.         {Literal mode}
  1006.         if Lo(KW) = 0 then begin
  1007.           if KLen+1 < KeyLength then
  1008.             K := K+#0+Char(Hi(KW));
  1009.         end
  1010.         else
  1011.           K := K+AddKey(KW);
  1012.  
  1013.       end
  1014.       {Command mode}
  1015.       else begin
  1016.         {remap mouse commands}
  1017.         case Hi(KW) of
  1018.           $ED :              {ClickBoth - toggle scroll lock}
  1019.             KFlag := KFlag xor SMask;
  1020.           $E9..$EF :         {remap other mouse buttons}
  1021.             KW := ButtonCodes[Hi(KW)];
  1022.         end;
  1023.  
  1024.         if (KW <> $ED00) then
  1025.           case Lo(KW) of
  1026.             00 :             {Extended key}
  1027.               if KLen+1 < KeyLength then
  1028.                 K := K+#0+Char(Hi(KW));
  1029.             08 :             {Backspace}
  1030.               if KLen > 0 then begin
  1031.                 Dec(KLen);
  1032.                 if (KLen > 0) and (K[KLen] = #0) then
  1033.                   Dec(KLen);
  1034.               end;
  1035.             13 :             {Enter}
  1036.               Done := True;
  1037.             27 :             {Esc}
  1038.               begin
  1039.                 K := B;
  1040.                 Done := True;
  1041.               end;
  1042.             67, 99 :         {C - clear}
  1043.               KLen := 0;
  1044.             82, 114 :        {R - restore}
  1045.               K := B;
  1046.  
  1047.             65..90, 97..122 : {alpha keys-map to control chars}
  1048.               K := K+AddKey(KW);
  1049.  
  1050.           else
  1051.             K := K+Char(KW);
  1052.           end;
  1053.       end;
  1054.     until Done;
  1055.  
  1056.     {restore previous prompt}
  1057.     StatMessage(BrowsePrompt);
  1058.  
  1059.     with Key do begin
  1060.       Keys := K;
  1061.       Modified := (K <> B);
  1062.       if Modified or (KLen = 0) then
  1063.         Conflict := False;
  1064.     end;
  1065.   end;
  1066.  
  1067.   procedure DrawPage(FirstCmd : Integer);
  1068.     {-Write a full page of commands, starting at FirstC}
  1069.   var
  1070.     Row : Integer;
  1071.     Cmd : Integer;
  1072.   begin
  1073.     Row := FirstRow;
  1074.     Cmd := FirstCmd;
  1075.  
  1076.     {$IFDEF UseMouse}
  1077.     if MouseInstalled then
  1078.       HideMouse;
  1079.     {$ENDIF}
  1080.  
  1081.     while (Row <= LastRow) and (Cmd <= NMaps) do begin
  1082.       DrawCmd(M^[Cmd], Row);
  1083.       Inc(Row);
  1084.       Inc(Cmd);
  1085.     end;
  1086.  
  1087.     {$IFDEF UseMouse}
  1088.     if MouseInstalled then
  1089.       ShowMouse;
  1090.     {$ENDIF}
  1091.   end;
  1092.  
  1093.   procedure EditKeys(Msg : String80; var TopCmd, CurCmd, ColNum : Integer);
  1094.     {-Edit the keys in P^}
  1095.   var
  1096.     MapCmd : Integer;
  1097.     MapIndex : Integer;
  1098.     OldTopCmd : Integer;
  1099.     Row : Integer;
  1100.     Col : Integer;
  1101.     R : Integer;
  1102.     KW : Word;
  1103.     K : KeyRec;
  1104.     {$IFDEF UseMouse}
  1105.     MRow, MCol : Byte;
  1106.     NewRow, NewColNum : Byte;
  1107.     {$ENDIF}
  1108.   begin
  1109.     {$IFDEF UseMouse}
  1110.     if MouseInstalled then
  1111.       HideMouse;
  1112.     {$ENDIF}
  1113.  
  1114.     Window(1, FirstRow, 80, LastRow);
  1115.  
  1116.     {$IFDEF UseMouse}
  1117.     MouseWindow(1, FirstRow, 80, LastRow);
  1118.     {$ENDIF}
  1119.  
  1120.     ClrScr;
  1121.     Window(1, 1, 80, LastRow);
  1122.     StatMessage(BrowsePrompt);
  1123.  
  1124.     {$IFDEF UseMouse}
  1125.     if MouseInstalled then
  1126.       ShowMouse;
  1127.     {$ENDIF}
  1128.  
  1129.     {Initialize pick state}
  1130.     DrawPage(TopCmd);
  1131.     Row := FirstRow+(CurCmd-TopCmd);
  1132.     repeat
  1133.       {Perform display mapping}
  1134.       MapCmd := M^[CurCmd];
  1135.       if MapCmd <> 0 then begin
  1136.         MapIndex := (MapCmd-1)*3+1+ColNum;
  1137.         K := P^[MapIndex];
  1138.       end;
  1139.       case ColNum of
  1140.         0 : Col := PriMinCol;
  1141.         1 : Col := SecMinCol;
  1142.         2 : Col := TerMinCol;
  1143.       end;
  1144.       GoToXY(Col, Row);
  1145.  
  1146.       {$IFDEF UseMouse}
  1147.       MapLeftButton := False;
  1148.       {$ENDIF}
  1149.  
  1150.       {Get a command}
  1151.       KW := ReadKeyWord;
  1152.  
  1153.       {$IFDEF UseMouse}
  1154.       MapLeftButton := True;
  1155.       {$ENDIF}
  1156.  
  1157.       case KW of
  1158.         $1C0D :              {Enter}
  1159.           if MapCmd <> 0 then begin
  1160.             EditCmd(MapCmd, K);
  1161.             P^[MapIndex] := K;
  1162.             DrawPage(TopCmd);
  1163.           end;
  1164.  
  1165.         $4800 :              {Up arrow}
  1166.           if CurCmd > 1 then begin
  1167.             Dec(CurCmd);
  1168.             if Row = FirstRow then begin
  1169.               TopCmd := CurCmd;
  1170.  
  1171.               {$IFDEF UseMouse}
  1172.               if MouseInstalled then
  1173.                 HideMouse;
  1174.               {$ENDIF}
  1175.  
  1176.               InsLine;
  1177.               DrawCmd(M^[CurCmd], Row);
  1178.  
  1179.               {$IFDEF UseMouse}
  1180.               if MouseInstalled then
  1181.                 ShowMouse;
  1182.               {$ENDIF}
  1183.             end
  1184.             else
  1185.               Dec(Row);
  1186.           end;
  1187.  
  1188.         $5000 :              {Down arrow}
  1189.           if CurCmd < NMaps then begin
  1190.             Inc(CurCmd);
  1191.             if Row = LastRow then begin
  1192.               Inc(TopCmd);
  1193.               GoToXY(1, FirstRow);
  1194.  
  1195.               {$IFDEF UseMouse}
  1196.               if MouseInstalled then
  1197.                 HideMouse;
  1198.               {$ENDIF}
  1199.  
  1200.               DelLine;
  1201.               DrawCmd(M^[CurCmd], LastRow);
  1202.  
  1203.               {$IFDEF UseMouse}
  1204.               if MouseInstalled then
  1205.                 ShowMouse;
  1206.               {$ENDIF}
  1207.             end
  1208.             else
  1209.               Inc(Row);
  1210.           end;
  1211.  
  1212.         $4B00 :              {Left Arrow}
  1213.           if ColNum > 0 then
  1214.             Dec(ColNum);
  1215.  
  1216.         $4D00 :              {Right Arrow}
  1217.           if ColNum < 2 then
  1218.             Inc(ColNum);
  1219.  
  1220.         $4900 :              {PgUp}
  1221.           begin
  1222.             OldTopCmd := TopCmd;
  1223.             R := FirstRow;
  1224.             while (CurCmd > 1) and (R < LastRow) do begin
  1225.               Dec(CurCmd);
  1226.               if Row = FirstRow then
  1227.                 TopCmd := CurCmd
  1228.               else
  1229.                 Dec(Row);
  1230.               Inc(R);
  1231.             end;
  1232.             if OldTopCmd <> TopCmd then
  1233.               DrawPage(TopCmd);
  1234.           end;
  1235.  
  1236.         $5100 :              {PgDn}
  1237.           begin
  1238.             OldTopCmd := TopCmd;
  1239.             R := FirstRow;
  1240.             while (CurCmd < NMaps) and (R < LastRow) do begin
  1241.               Inc(CurCmd);
  1242.               if Row = LastRow then
  1243.                 Inc(TopCmd)
  1244.               else
  1245.                 Inc(Row);
  1246.               Inc(R);
  1247.             end;
  1248.             if TopCmd <> OldTopCmd then
  1249.               DrawPage(TopCmd);
  1250.           end;
  1251.  
  1252.         $4700 :              {Home}
  1253.           if CurCmd > 1 then begin
  1254.             CurCmd := 1;
  1255.             TopCmd := 1;
  1256.             Row := FirstRow;
  1257.             ColNum := 0;
  1258.             DrawPage(TopCmd);
  1259.           end;
  1260.  
  1261.         $4F00 :              {End}
  1262.           if CurCmd < NMaps then begin
  1263.             if LastRow-FirstRow+1 > NMaps then
  1264.               Row := FirstRow+NMaps-1
  1265.             else
  1266.               Row := LastRow;
  1267.             CurCmd := NMaps;
  1268.             TopCmd := NMaps-(Row-FirstRow);
  1269.             ColNum := 2;
  1270.             DrawPage(TopCmd);
  1271.           end;
  1272.  
  1273.         $1372, $1352 :       {r, R}
  1274.           begin
  1275.             P^ := OUK;
  1276.             DrawPage(TopCmd);
  1277.           end;
  1278.  
  1279.         {$IFDEF UseMouse}
  1280.         Integer($EF00) :     {left mouse button}
  1281.           if MouseInstalled then begin
  1282.             MRow := MouseKeyWordY;
  1283.             MCol := MouseKeyWordX+MouseXLo;
  1284.  
  1285.             if MRow <= NMaps then begin
  1286.               {find the new row and column}
  1287.               NewRow := MRow+MouseYLo;
  1288.               if (MCol <= PriMaxCol) then
  1289.                 NewColNum := 0
  1290.               else if (MCol <= SecMaxCol) then
  1291.                 NewColNum := 1
  1292.               else
  1293.                 NewColNum := 2;
  1294.  
  1295.               if (Row = NewRow) and (ColNum = NewColNum) then begin
  1296.                 {cursor already in right place--same as <Enter>}
  1297.                 if MapCmd <> 0 then begin
  1298.                   EditCmd(MapCmd, K);
  1299.                   P^[MapIndex] := K;
  1300.                   DrawPage(TopCmd);
  1301.                 end;
  1302.               end
  1303.               else begin
  1304.                 {move to new row/column}
  1305.                 Row := NewRow;
  1306.                 ColNum := NewColNum;
  1307.                 CurCmd := TopCmd+Pred(MRow);
  1308.               end;
  1309.             end;
  1310.           end;
  1311.         {$ENDIF}
  1312.  
  1313.         $011B :              {Esc}
  1314.           Exit;
  1315.       end;
  1316.     until False;
  1317.   end;
  1318.  
  1319.   procedure InstallKeys(Msg : String80;
  1320.                         var UK : UnpackedKeyArray;
  1321.                         var Names; NumNames : Word;
  1322.                         var Map; NumMaps : Word;
  1323.                         MaxBytes : Word);
  1324.     {-Install specified keylist}
  1325.   var
  1326.     ChangesMade : Boolean;
  1327.     I, J, ColNum : Integer;
  1328.     CurCmd, TopCmd : Integer;
  1329.     Code : Byte;
  1330.   begin
  1331.     {Put parameters into globals for easier access}
  1332.     P := @UK;
  1333.     N := @Names;
  1334.     NNames := NumNames;
  1335.     M := @Map;
  1336.     NMaps := NumMaps;
  1337.  
  1338.     {start with first command}
  1339.     CurCmd := 1;
  1340.     TopCmd := 1;
  1341.     ColNum := 0;
  1342.  
  1343.     {Save backup copy of keys}
  1344.     OUK := UK;
  1345.  
  1346.     repeat
  1347.       {Random access editing}
  1348.       EditKeys(Msg, TopCmd, CurCmd, ColNum);
  1349.  
  1350.       {$IFDEF UseMouse}
  1351.       FullMouseWindow;
  1352.       {$ENDIF}
  1353.  
  1354.       ChangesMade := CheckModifiedFlags(UK, MaxCommands);
  1355.       if ChangesMade then
  1356.         StatMessage('Checking for conflicts...');
  1357.       if ChangesMade and ConflictsFound(UK, MaxCommands) then begin
  1358.         {display error message}
  1359.         PressEsc('Conflicts found');
  1360.  
  1361.         {find first conflict}
  1362.         I := 1;
  1363.         while not UK[I].Conflict do
  1364.           Inc(I);
  1365.         Code := UK[I].CommandCode;
  1366.         CurCmd := 1;
  1367.         while M^[CurCmd] <> Code do
  1368.           Inc(CurCmd);
  1369.  
  1370.         {calculate new TopCmd based on CurCmd}
  1371.         J := LastRow-FirstRow;
  1372.         if (CurCmd < TopCmd) or (CurCmd > TopCmd+J) then begin
  1373.           TopCmd := CurCmd;
  1374.           if (TopCmd+J > NumMaps) then
  1375.             TopCmd := NumMaps-J;
  1376.           if TopCmd < 1 then
  1377.             TopCmd := 1;
  1378.         end;
  1379.  
  1380.         {calculate new ColNum}
  1381.         ColNum := Pred(I) mod 3;
  1382.       end
  1383.       else begin
  1384.         {calculate size of packed key array}
  1385.         if ChangesMade and (SizeKeys(UK, MaxCommands) > MaxBytes) then
  1386.           {Keys too big to fit}
  1387.           PressEsc('Keys won''t fit in installation area')
  1388.         else begin
  1389.           Modified := Modified or ChangesMade;
  1390.  
  1391.           {$IFDEF UseMouse}
  1392.           if MouseInstalled then
  1393.             HideMouse;
  1394.           {$ENDIF}
  1395.  
  1396.           Window(1, FirstRow, 80, LastRow);
  1397.           ClrScr;
  1398.           Window(1, 1, 80, 25);
  1399.           ClrStatLine;
  1400.  
  1401.           {$IFDEF UseMouse}
  1402.           if MouseInstalled then
  1403.             ShowMouse;
  1404.           {$ENDIF}
  1405.           Exit;
  1406.         end;
  1407.       end;
  1408.     until False;
  1409.   end;
  1410.  
  1411.   procedure Stop(Installed : Boolean);
  1412.     {-Clean up at end}
  1413.   begin
  1414.     {$IFDEF UseMouse}
  1415.     if MouseInstalled then
  1416.       HideMouse;
  1417.     {$ENDIF}
  1418.  
  1419.     if LastMode <> OrigMode then begin
  1420.       TextMode(OrigMode);
  1421.       TextAttr := OrigAttr;
  1422.     end
  1423.     else begin
  1424.       TextAttr := OrigAttr;
  1425.       ClrScr;
  1426.     end;
  1427.  
  1428.     if Installed then
  1429.       WriteLn('Changes saved')
  1430.     else
  1431.       WriteLn('Files not changed');
  1432.     Halt;
  1433.   end;
  1434.  
  1435.   procedure SaveAndExit;
  1436.     {-If modified, prompt to install changes}
  1437.   begin
  1438.     if Modified and PromptYesNo('Install changes permanently? (Y/N) ') then begin
  1439.       {pack the key arrays}
  1440.       Pack;
  1441.  
  1442.       {store the packed key arrays}
  1443.       Store;
  1444.  
  1445.       {done}
  1446.       Stop(True);
  1447.     end
  1448.     else
  1449.       {done}
  1450.       Stop(False);
  1451.   end;
  1452.  
  1453. begin
  1454.   {open TPU files and find installation areas}
  1455.   Open;
  1456.  
  1457.   {load the installation areas}
  1458.   Load;
  1459.  
  1460.   {unpack the keystroke arrays}
  1461.   Unpack;
  1462.  
  1463.   {set up display, colors, etc}
  1464.   Init;
  1465.  
  1466.   {Initialize the main menu}
  1467.   InitMenu(MainMenu);
  1468.  
  1469.   repeat
  1470.     {get menu choice}
  1471.     StatMessage('Select unit to install, or press <Esc> to quit');
  1472.     Key := MenuChoice(MainMenu, Ch);
  1473.  
  1474.     if MenuCmdNum = MKSSelect then begin
  1475.       case Key of
  1476.         1 :                  {TPEDIT}
  1477.           InstallKeys(EditFileName, EditUK, EditNames, RSuser9-2,
  1478.             EditMap, EditDisplay, EditKeyMax);
  1479.         2 :                  {TPENTRY}
  1480.           InstallKeys(EntryFileName, EntryUK, EntryNames, ESmouse-2,
  1481.             EntryMap, EntryDisplay, EntryKeyMax);
  1482.         3 :                  {TPHELP}
  1483.           InstallKeys(HelpFileName, HelpUK, HelpNames, HKSUser3-2,
  1484.             HelpMap, HelpDisplay, HelpKeyMax);
  1485.         4 :                  {TPMENU}
  1486.           InstallKeys(MenuFileName, MenuUK, MenuNames, MKSuser3-2,
  1487.             MenuMap, MenuDisplay, MenuKeyMax);
  1488.         5 :                  {TPPICK}
  1489.           InstallKeys(PickFileName, PickUK, PickNames, PKSUser3-2,
  1490.             PickMap, PickDisplay, PickKeyMax);
  1491.       end;
  1492.     end;
  1493.   until MenuCmdNum = MKSExit;
  1494.  
  1495.   {clean up}
  1496.   SaveAndExit;
  1497. end.
  1498.