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