infocom/compilers/inform6/library/contributions/fkeys.h

!===============================================================================
!     FKeys.h                         An Inform 6 library extension
!                                     Copyright 2000-2014 by David Fillmore
!     Release 1.1                
! This work is licensed under the Creative Commons Attribution-NonCommercial    
! 4.0 International License.                                                    
! To view a copy of this license, visit                                         
! http://creativecommons.org/licenses/by-nc/4.0/ 
! or send a letter to Creative Commons, 444 Castro Street, Suite 900, Mountain 
! View, California, 94041, USA. 
!===============================================================================
! This library file should enable the use of Function Keys as command shortcuts
! in your games.
! To make it work, Replace Keyboard and KeyboardPrimitive before inclusion of
! Parser.h, include this file after Parser.h, and put the line 'SetupFKeys();' 
! somewhere in the initialise routine.
!
! The arrays containing the commands that will be used when various shortcut
! keys are pressed are set up in the SetupFKeys routine. There is a default
! SetupFKeys routine, but you can provide your own if you define it before
! including this file.
! 
! It is highly recommended that you use exclusively lowercase characters
! if you define your own arrays, as some interpreters will break slightly when 
! uppercase characters are used.
!
! If you have any problems, questions, or suggesctions, please e-mail me at
! marvin@frobnitz.co.uk
!
!===============================================================================

#Ifndef TARGET_ZCODE;
Message fatalerror "*** The FKeys library extension only works with Z-Machine games ***";
#Endif; 

#Iffalse (LIBRARY_VERSION == 612);
#Iffalse (LIBRARY_VERSION == 611);
Message fatalerror "*** The FKeys library extension requires version 6/11 or version 6/12 of the standard Inform library ***";
#Endif; 
#Endif; 

Array F1 -> 36;
Array F2 -> 36;
Array F3 -> 36;
Array F4 -> 36;
Array F5 -> 36;
Array F6 -> 36;
Array F7 -> 36;
Array F8 -> 36;
Array F9 -> 36;
Array F10 -> 36;
Array F11 -> 36;
Array F12 -> 36;

Array NP1 -> 36;
Array NP2 -> 36;
Array NP3 -> 36;
Array NP4 -> 36;
Array NP6 -> 36;
Array NP7 -> 36;
Array NP8 -> 36;
Array NP9 -> 36;


#ifndef WORDSIZE;
Constant TARGET_ZCODE;
Constant WORDSIZE 2;
#endif;

ZCharacter terminating 133 134 135 136 137 138 139 140 141 142 143 144 146 147 148 149 151 152 153 154;

Global termchar;

#ifndef SetupFKeys;
[ SetupFKeys;
  F1->0=4;
  F1->1='l';
  F1->2='o';
  F1->3='o';
  F1->4='k';
  F1->5=124;

  F2->0=9;
  F2->1='i';
  F2->2='n';
  F2->3='v';
  F2->4='e';
  F2->5='n';
  F2->6='t';
  F2->7='o';
  F2->8='r';
  F2->9='y';
  F2->10=124;

  F3->0=5;
  F3->1='o';
  F3->2='p';
  F3->3='e';
  F3->4='n';
  F3->5=' ';

  F4->0=8;
  F4->1='e';
  F4->2='x';
  F4->3='a';
  F4->4='m';
  F4->5='i';
  F4->6='n';
  F4->7='e';
  F4->8=' ';

  F5->0=5;
  F5->1='t';
  F5->2='a';
  F5->3='k';
  F5->4='e';
  F5->5=' ';

  F6->0=5;
  F6->1='d';
  F6->2='r';
  F6->3='o';
  F6->4='p';
  F6->5=' ';

  F7->0=7;
  F7->1='a';
  F7->2='t';
  F7->3='t';
  F7->4='a';
  F7->5='c';
  F7->6='k';
  F7->7=' ';

  F8->0=5;
  F8->1='a';
  F8->2='g';
  F8->3='a';
  F8->4='i';
  F8->5='n';
  F8->6=124;

  F9->0=4;
  F9->1='u';
  F9->2='n';
  F9->3='d';
  F9->4='o';
  F9->5=124;

  F10->0=5;
  F10->1='o';
  F10->2='o';
  F10->3='p';
  F10->4='s';
  F10->5=' ';

  F11->0=4;
  F11->1='a';
  F11->2='s';
  F11->3='k';
  F11->4=' ';

  F12->0=5;
  F12->1='t';
  F12->2='e';
  F12->3='l';
  F12->4='l';
  F12->5=' ';

  NP1->0=9;
  NP1->1='s';
  NP1->2='o';
  NP1->3='u';
  NP1->4='t';
  NP1->5='h';
  NP1->6='w';
  NP1->7='e';
  NP1->8='s';
  NP1->9='t';
  NP1->10=124;

  NP2->0=5;
  NP2->1='s';
  NP2->2='o';
  NP2->3='u';
  NP2->4='t';
  NP2->5='h';
  NP2->6=124;

  NP3->0=9;
  NP3->1='s';
  NP3->2='o';
  NP3->3='u';
  NP3->4='t';
  NP3->5='h';
  NP3->6='e';
  NP3->7='a';
  NP3->8='s';
  NP3->9='t';
  NP3->10=124;

  NP4->0=4;
  NP4->1='w';
  NP4->2='e';
  NP4->3='s';
  NP4->4='t';
  NP4->5=124;

  NP6->0=4;
  NP6->1='e';
  NP6->2='a';
  NP6->3='s';
  NP6->4='t';
  NP6->5=124;

  NP7->0=9;
  NP7->1='n';
  NP7->2='o';
  NP7->3='r';
  NP7->4='t';
  NP7->5='h';
  NP7->6='w';
  NP7->7='e';
  NP7->8='s';
  NP7->9='t';
  NP7->10=124;

  NP8->0=5;
  NP8->1='n';
  NP8->2='o';
  NP8->3='r';
  NP8->4='t';
  NP8->5='h';
  NP8->6=124;

  NP9->0=9;
  NP9->1='n';
  NP9->2='o';
  NP9->3='r';
  NP9->4='t';
  NP9->5='h';
  NP9->6='e';
  NP9->7='a';
  NP9->8='s';
  NP9->9='t';
  NP9->10=124;

];
#endif;

[ PressedKey a_buffer charnum x y z fkey max_chars current_chars total_chars;
  switch(termchar)
  { 133 to 154: switch(termchar)
                { 133: fkey=F1;
                  134: fkey=F2;
                  135: fkey=F3;
                  136: fkey=F4;
                  137: fkey=F5;
                  138: fkey=F6;
                  139: fkey=F7;
                  140: fkey=F8;
                  141: fkey=F9;
                  142: fkey=F10;
                  143: fkey=F11;
                  144: fkey=F12;
                  146: fkey=NP1;
                  147: fkey=NP2;
                  148: fkey=NP3;
                  149: fkey=NP4;
                  151: fkey=NP6;
                  152: fkey=NP7;
                  153: fkey=NP8;
                  154: fkey=NP9;
                }
   
                max_chars = a_buffer->0;
                current_chars = a_buffer->1;
                total_chars = (fkey->0) + current_chars;
                if (total_chars > max_chars-1) ! the new characters will not fit on the line
                { @sound_effect 2;
                  rtrue;
                }
                a_buffer->1=total_chars;

                x=(fkey->0)+1;
                @buffer_mode false;
                for (y=1:y<x:y++)
                { a_buffer->(y+1+current_chars)=(fkey->y);
                  print (char) a_buffer->(y+1+current_chars);
                  if (a_buffer->(y+1+current_chars) > $40 && a_buffer->(y+1+current_chars) < $5b)
                  { a_buffer->(y+1+current_chars)=(a_buffer->(y+1+current_chars)+$20);
                  }
                }


                if (fkey->y==124)
                { print "^";
                  z=0;
                }
                else
                z=1;
                @buffer_mode true;
  }
  charnum=a_buffer->1;
  return z;
];


[ KeyboardPrimitive  a_buffer a_table;
    a_buffer->0 = 120;
    @aread a_buffer a_table -> termchar;

    #Iftrue (#version_number == 6);
    @output_stream -1;
    @loadb a_buffer 1 -> sp;
    @add a_buffer 2 -> sp;
    @print_table sp sp;
    new_line;
    @output_stream 1;
    #Endif;
];

#Iftrue (LIBRARY_VERSION == 612);
[ Keyboard  a_buffer a_table  nw i w w2 x1 x2 a;
  DisplayStatus();
  .FreshInput;

  ! Save the start of the buffer, in case "oops" needs to restore it
  ! to the previous time's buffer

  for (i=0 : i<OOPS_WORKSPACE_LEN : i++) oops_workspace->i = a_buffer->i;

  ! In case of an array entry corruption that shouldn't happen, but would be
  ! disastrous if it did:

  #Ifdef TARGET_ZCODE;
  a_buffer->0 = INPUT_BUFFER_LEN - WORDSIZE;
  a_table->0  = MAX_BUFFER_WORDS; ! Allow to split input into this many words
  #Endif; ! TARGET_

  ! Print the prompt, and read in the words and dictionary addresses

  L__M(##Prompt);
  if (AfterPrompt() == 0) LibraryExtensions.RunAll(ext_afterprompt);
  a_buffer->1=0;
  .xyzzy;
  #IFV5; DrawStatusLine(); #ENDIF;
  KeyboardPrimitive(a_buffer, a_table);
  if (termchar~=13 or 10)
  { if (PressedKey(a_buffer)==1)
    { jump xyzzy;
    }
    
    @tokenise a_buffer a_table;
  }
    
   nw = NumberWords(a_table);

  ! If the line was blank, get a fresh line
  if (nw == 0) {
      L__M(##Miscellany, 10);
      jump FreshInput;
  }

  ! Unless the opening word was "oops", return
  ! Conveniently, a_table-->1 is the first word in both ZCODE and GLULX.

  w = a_table-->1;
  if (w == OOPS1__WD or OOPS2__WD or OOPS3__WD) jump DoOops;

  if (a_buffer->WORDSIZE == COMMENT_CHARACTER) {
      #Ifdef TARGET_ZCODE;
      if ((HDR_GAMEFLAGS-->0) & $0001 || xcommsdir)
                                         L__M(##Miscellany, 54);
      else                               L__M(##Miscellany, 55);
      #Ifnot; ! TARGET_GLULX
      if (gg_scriptstr || gg_commandstr) L__M(##Miscellany, 54);
      else                               L__M(##Miscellany, 55);
      #Endif; ! TARGET_

      jump FreshInput;
  }

  #IfV5;
  ! Undo handling

  if ((w == UNDO1__WD or UNDO2__WD or UNDO3__WD) && (nw==1)) {
      if (turns == START_MOVE) {
          L__M(##Miscellany, 11);
          jump FreshInput;
      }
      if (undo_flag == 0) {
          L__M(##Miscellany, 6);
          jump FreshInput;
      }
      if (undo_flag == 1) jump UndoFailed;
      #Ifdef TARGET_ZCODE;
      @restore_undo i;
      #Ifnot; ! TARGET_GLULX
      @restoreundo i;
      i = (~~i);
      #Endif; ! TARGET_
      if (i == 0) {
        .UndoFailed;
          L__M(##Miscellany, 7);
      }
      jump FreshInput;
   }
    #Ifdef TARGET_ZCODE;
    @save_undo i;
    #Ifnot; ! TARGET_GLULX
    @saveundo i;
    if (i == -1) {
        GGRecoverObjects();
        i = 2;
    }
    else  i = (~~i);
    #Endif; ! TARGET_
    just_undone = 0;
    undo_flag = 2;
    if (i == -1) undo_flag = 0;
    if (i == 0) undo_flag = 1;
    if (i == 2) {
        RestoreColours();
        #Ifdef TARGET_ZCODE;
        style bold;
        #Ifnot; ! TARGET_GLULX
        glk($0086, 4); ! set subheader style
        #Endif; ! TARGET_
        print (name) location, "^";
        #Ifdef TARGET_ZCODE;
        style roman;
        #Ifnot; ! TARGET_GLULX
        glk($0086, 0); ! set normal style
        #Endif; ! TARGET_
        L__M(##Miscellany, 13);
        just_undone = 1;
        jump FreshInput;
    }
    #Endif; ! V5

    return nw;

  .DoOops;
    if (oops_from == 0) {
        L__M(##Miscellany, 14);
        jump FreshInput;
    }
    if (nw == 1) {
        L__M(##Miscellany, 15);
        jump FreshInput;
    }
    if (nw > 2) {
        L__M(##Miscellany, 16);
        jump FreshInput;
    }

    ! So now we know: there was a previous mistake, and the player has
    ! attempted to correct a single word of it.

    for (i=0 : i<INPUT_BUFFER_LEN : i++) buffer2->i = a_buffer->i;
    #Ifdef TARGET_ZCODE;
    x1 = a_table->9;  ! Start of word following "oops"
    x2 = a_table->8;  ! Length of word following "oops"
    #Ifnot; ! TARGET_GLULX
    x1 = a_table-->6; ! Start of word following "oops"
    x2 = a_table-->5; ! Length of word following "oops"
    #Endif; ! TARGET_

    ! Repair the buffer to the text that was in it before the "oops"
    ! was typed:

    for (i=0 : i < OOPS_WORKSPACE_LEN : i++) a_buffer->i = oops_workspace->i;
    Tokenise__(a_buffer, a_table);

    ! Work out the position in the buffer of the word to be corrected:

    #Ifdef TARGET_ZCODE;
    w = a_table->(4*oops_from + 1); ! Start of word to go
    w2 = a_table->(4*oops_from);    ! Length of word to go
    #Ifnot; ! TARGET_GLULX
    w = a_table-->(3*oops_from);      ! Start of word to go
    w2 = a_table-->(3*oops_from - 1); ! Length of word to go
    #Endif; ! TARGET_

    ! Write spaces over the word to be corrected:

    for (i=0 : i<w2 : i++) a_buffer->(i+w) = ' ';

    if (w2 < x2) {
        ! If the replacement is longer than the original, move up...
        for (i=INPUT_BUFFER_LEN-1 : i>=w+x2 : i--)
            a_buffer->i = a_buffer->(i-x2+w2);

        ! ...increasing buffer size accordingly.
        SetKeyBufLength(GetKeyBufLength(a_buffer) + (x2-w2), a_buffer);
    }

    ! Write the correction in:

    for (i=0 : i<x2 : i++) a_buffer->(i+w) = buffer2->(i+x1);

    Tokenise__(a_buffer, a_table);
    nw=NumberWords(a_table);

    return nw;
]; ! end of Keyboard
#Endif; 

#Iftrue (LIBRARY_VERSION == 611);
[ Keyboard  a_buffer a_table  nw i w w2 x1 x2;
    DisplayStatus();

  .FreshInput;

    ! Save the start of the buffer, in case "oops" needs to restore it
    ! to the previous time's buffer

    for (i=0 : i<64 : i++) oops_workspace->i = a_buffer->i;

    ! In case of an array entry corruption that shouldn't happen, but would be
    ! disastrous if it did:

    #Ifdef TARGET_ZCODE;
    a_buffer->0 = INPUT_BUFFER_LEN;
    a_table->0 = 15;  ! Allow to split input into this many words
    #Endif; ! TARGET_

    ! Print the prompt, and read in the words and dictionary addresses

    L__M(##Prompt);
    AfterPrompt();
    a_buffer->1=0;
    .xyzzy;
    #IFV5; DrawStatusLine(); #ENDIF;
    KeyboardPrimitive(a_buffer, a_table);
    if (termchar~=13 or 10)
    { if (PressedKey(a_buffer)==1)
      { jump xyzzy;
      }
    
      @tokenise a_buffer a_table;
    }

    #Ifdef TARGET_ZCODE;
    nw = a_table->1;
    #Ifnot; ! TARGET_GLULX
    nw = a_table-->0;
    #Endif; ! TARGET_

    ! If the line was blank, get a fresh line
    if (nw == 0) {
        L__M(##Miscellany, 10);
        jump FreshInput;
    }

    ! Unless the opening word was "oops", return
    ! Conveniently, a_table-->1 is the first word in both ZCODE and GLULX.

    w = a_table-->1;
    if (w == OOPS1__WD or OOPS2__WD or OOPS3__WD) jump DoOops;

    if (a_buffer->WORDSIZE == COMMENT_CHARACTER) {
        #Ifdef TARGET_ZCODE;
        if ((HDR_GAMEFLAGS-->0) & 1 || xcommsdir)
                                           L__M(##Miscellany, 54);
        else                               L__M(##Miscellany, 55);
        #Ifnot; ! TARGET_GLULX
        if (gg_scriptstr || gg_commandstr) L__M(##Miscellany, 54);
        else                               L__M(##Miscellany, 55);
        #Endif; ! TARGET_

        jump FreshInput;
    }

    #IfV5;
    ! Undo handling

    if ((w == UNDO1__WD or UNDO2__WD or UNDO3__WD) && (nw==1)) {
        if (turns == START_MOVE) {
            L__M(##Miscellany, 11);
            jump FreshInput;
        }
        if (undo_flag == 0) {
            L__M(##Miscellany, 6);
            jump FreshInput;
        }
        if (undo_flag == 1) jump UndoFailed;
        #Ifdef TARGET_ZCODE;
        @restore_undo i;
        #Ifnot; ! TARGET_GLULX
        @restoreundo i;
        i = (~~i);
        #Endif; ! TARGET_
        if (i == 0) {
          .UndoFailed;
            L__M(##Miscellany, 7);
        }
        jump FreshInput;
    }
    #Ifdef TARGET_ZCODE;
    @save_undo i;
    #Ifnot; ! TARGET_GLULX
    @saveundo i;
    if (i == -1) {
        GGRecoverObjects();
        i = 2;
    }
    else  i = (~~i);
    #Endif; ! TARGET_
    just_undone = 0;
    undo_flag = 2;
    if (i == -1) undo_flag = 0;
    if (i == 0) undo_flag = 1;
    if (i == 2) {
        RestoreColours();
        #Ifdef TARGET_ZCODE;
        style bold;
        #Ifnot; ! TARGET_GLULX
        glk($0086, 4); ! set subheader style
        #Endif; ! TARGET_
        print (name) location, "^";
        #Ifdef TARGET_ZCODE;
        style roman;
        #Ifnot; ! TARGET_GLULX
        glk($0086, 0); ! set normal style
        #Endif; ! TARGET_
        L__M(##Miscellany, 13);
        just_undone = 1;
        jump FreshInput;
    }
    #Endif; ! V5

    return nw;

  .DoOops;
    if (oops_from == 0) {
        L__M(##Miscellany, 14);
        jump FreshInput;
    }
    if (nw == 1) {
        L__M(##Miscellany, 15);
        jump FreshInput;
    }
    if (nw > 2) {
        L__M(##Miscellany, 16);
        jump FreshInput;
    }

    ! So now we know: there was a previous mistake, and the player has
    ! attempted to correct a single word of it.

    for (i=0 : i<INPUT_BUFFER_LEN : i++) buffer2->i = a_buffer->i;
    #Ifdef TARGET_ZCODE;
    x1 = a_table->9;  ! Start of word following "oops"
    x2 = a_table->8;  ! Length of word following "oops"
    #Ifnot; ! TARGET_GLULX
    x1 = a_table-->6; ! Start of word following "oops"
    x2 = a_table-->5; ! Length of word following "oops"
    #Endif; ! TARGET_

    ! Repair the buffer to the text that was in it before the "oops"
    ! was typed:

    for (i=0 : i<64 : i++) a_buffer->i = oops_workspace->i;
    Tokenise__(a_buffer,a_table);

    ! Work out the position in the buffer of the word to be corrected:

    #Ifdef TARGET_ZCODE;
    w = a_table->(4*oops_from + 1); ! Start of word to go
    w2 = a_table->(4*oops_from);    ! Length of word to go
    #Ifnot; ! TARGET_GLULX
    w = a_table-->(3*oops_from);      ! Start of word to go
    w2 = a_table-->(3*oops_from - 1); ! Length of word to go
    #Endif; ! TARGET_

    ! Write spaces over the word to be corrected:

    for (i=0 : i<w2 : i++) a_buffer->(i+w) = ' ';

    if (w2 < x2) {
        ! If the replacement is longer than the original, move up...
        for (i=INPUT_BUFFER_LEN-1 : i>=w+x2 : i--)
            a_buffer->i = a_buffer->(i-x2+w2);

        ! ...increasing buffer size accordingly.
        #Ifdef TARGET_ZCODE;
        a_buffer->1 = (a_buffer->1) + (x2-w2);
        #Ifnot; ! TARGET_GLULX
        a_buffer-->0 = (a_buffer-->0) + (x2-w2);
        #Endif; ! TARGET_
    }

    ! Write the correction in:

    for (i=0 : i<x2 : i++) a_buffer->(i+w) = buffer2->(i+x1);

    Tokenise__(a_buffer, a_table);
    #Ifdef TARGET_ZCODE;
    nw = a_table->1;
    #Ifnot; ! TARGET_GLULX
    nw = a_table-->0;
    #Endif; ! TARGET_

    return nw;
]; ! end of Keyboard
#Endif;