! mistype.h for Inform 6 with library 6/10
!
! A library to automatically correct single-letter typing errors, in a similar way
! to nitfol but on other interpreters.
!
! Written by Cedric Knight.  Not copyrighted.
! Comments and bug reports welcomed: please see www.metebelis3.free-online.co.uk to email.
!
! To use (ordinary Z5/Z8 version), you can simply include this file before 'parser'.
! Glulx or biplatform users: include the file after including 'parser', and put
! 'Replace KeyboardPrimitive;' before 'parser'.
!
! (Defining the constant 'QUICKCHECK' only looks for
! inserted or transposed letters, not substitutions or omissions, and
! may be useful on slow platforms.)
!
! You can also turn the feature off by setting mistype_off to 1.
!
! The entry point chosen should not conflict with many other
! contributed libraries, or non-English versions of Inform.
! You could instead trap LanguagetoInformese, BeforeParsing, KeyboardPrimitive or
! Tokenise__().
!
! Adds about 580 bytes to output Z-code file.
!
! Version history
! v 1.0, (beta) 2 May 03
! v 1.1, 6 May 03.  Added Glulx optimisations, 'off switch' (Gunther's idea)
!                   Also buffer length checks and garbage detector.
! v 1.11 8 May 03   Nitfol and Zip extreme issues addressed.  No deletions from 2-letter words (RF).
!
! (TODO: add context sensitivity, preferring verb words for first word and then in scope nouns)
! (TODO: multiple misspellings by comparing to streamed words)
! (TODO: structure better while retaining speed)
! (TODO: allow override of message using LibraryMessages?)
!

Global mistype_off = false;

#ifndef TARGET_GLULX;

!--------------------------------------------
! Replacement KeyboardPrimitive for Zcode
!--------------------------------------------

Replace KeyboardPrimitive;

[ KeyboardPrimitive  buffer parse  i start len j c1 c2 t n alt fail;
  read buffer parse;           ! variables renamed
#iftrue #version_number == 6;  ! part of patch L61022 by Kevin Bracey
  @output_stream -1;
  @loadb buffer 1 -> sp;
  @add buffer 2 -> sp;
  @print_table sp sp;
  new_line;
  @output_stream 1;
#endif;

  if (mistype_off || 0->31=='N') rtrue;  ! turn off in Nitfol

!#ifdef ZIP;
  ! JZIP has problems with overflow - can't CR if buffer is full
  ! if it's too many *words*, suppress the xzip/jzip warning
  if (parse->1 > parse->0) { 
    ! print "[Suppressing further 'too many words' warnings.]^";
    buffer->1 = parse->(1+4*parse->0)+parse->(4*parse->0)-2; ! truncate to 15 words
    buffer->(2+buffer->1)=0;
    }
!#endif;

! check for misspelled words

  if (buffer->1 < buffer->0)
    buffer->(2 + buffer->1) = 0; ! see library tokenise__

  for (i=0: i<parse->1 && fail<=alt+2: i++) 
    if (~~ (parse-->(n=i*2+1))) {  ! unrecognised word

      ! oops_from=saved_oops=i+1;
      ! it'd be nice to do this in case of a miscorrection - need more work
      ! suggest putting 'oops_word=saved_oops;' in ParserError()

      ! try fixing word
      start=parse->(i*4+5); 
      len=parse->(i*4+4);
      t = start+len-1;

      !first try transpositions
      for (j=start+len - (i+1==parse->1 || parse-->(i*2+3) || len<3): j>start: j--) {
        c1=buffer->j; 
        buffer->j=buffer->(j-1);
        buffer->(j-1)=c1;
        @tokenise buffer parse;
        if (parse-->n) jump NxtChk;  ! fixed!
        buffer->(j-1)=buffer->j; ! undo transposition
        buffer->j=c1;
        } ! end of for loop

      !now try deletions
      if (len>2) {      ! don't turn words into single letters
        c1 = ' ';
        for (j=t: j>=start: j--) { ! j represents the one that's missed out
          c2=buffer->j;
          buffer->j=c1;
          c1=c2;
          @tokenise buffer parse;
          if (parse-->n) jump NxtChk;  ! fixed!
          }
        ! and restore
        for (j=t: j>start: j--)
          buffer->j=buffer->(j-1);
        buffer->start=c2;
        }

#ifndef QUICKCHECK;
      ! could go through dictionary & check for inserting & substituting, but this is brute force
      ! substitutions
      for (j=t: j>=start: j--) {
        c2=buffer->j;
        for (c1='a': c1<='z': c1++) {
          buffer->j=c1;
          @tokenise buffer parse;
          if (parse-->n) jump NxtChk;  ! fixed!
          }
        buffer->j=c2;
        }

      ! additions
      ! print buffer->1, 1+buffer->0;
      if (buffer->1 >= buffer->0) jump NxtChk;  ! not if could overflow
      (buffer->1)++;
      buffer->(2 + buffer->1) = 0; ! see library tokenise__

      for (j=buffer->1+1: j>t: j--)
        buffer->(j+1)=buffer->j;
      for (j=t+1: j>=start: j--) {
        for (c1='a': c1<='z': c1++) {
          buffer->j=c1;
          @tokenise buffer parse;
          if (parse-->n) jump NxtChk;  ! fixed!
          }
        buffer->j=buffer->(j-1);
        }
      ! restore
      for (j=start: j<=buffer->1: j++)
        buffer->j=buffer->(j+1);
      (buffer->1)--;

#endif;

      .NxtChk; !outer loop
      if (parse-->n) alt++;
      else fail++;
      } ! end of 'if' word needs fixing

  if (alt && fail<=alt) {
    print "[The story read that as ~";
    for (i=2: i<=1+buffer->1: i++)
      print (char) buffer->i;
    print "~]^";
    }

  ]; ! end of LanguageToInformese
  
#ifnot;

!--------------------------------------------
! Replacement KeyboardPrimitive for Glulx
!--------------------------------------------

[ KeyboardPrimitive  buffer parse  i start len j c1 c2 t n alt fail
            done dictstart wordstart dictlen entrylen keylen res c3;

  done = false;
  glk($00D0, gg_mainwin, buffer+WORDSIZE, INPUT_BUFFER_LEN-WORDSIZE, 
    0); ! request_line_event
  while (~~done) {
    glk($00C0, gg_event); ! select
    switch (gg_event-->0) {
      5: ! evtype_Arrange
        DrawStatusLine();
      3: ! evtype_LineInput
        if (gg_event-->1 == gg_mainwin) {
          buffer-->0 = gg_event-->2;
          done = true;
        }
    }
    t = HandleGlkEvent(gg_event, 0, buffer);
    if (t == 2) {
      done = true;
    }
    else if (t == -1) {
      done = false;
    }
  }

  ! It's time to close any quote window we've got going.
  if (gg_quotewin) {
    glk($0024, gg_quotewin, 0); ! close_window
    gg_quotewin = 0;
  }

  if (mistype_off) rtrue;

! check for misspelled words

  Tokenise__(buffer, parse);
  dictlen = #dictionary_table-->0;             ! for use in later tokenisation
  entrylen = DICT_WORD_SIZE + 7;
  dictstart = #dictionary_table + WORDSIZE;
  
  for (i=0: i<parse-->0 && fail<=alt+2: i++)   ! loop over each word, with garbage escape
    if (~~ (parse-->(n=i*3+1))) {  ! unrecognised word

      ! oops_from=saved_oops=i+1;
      ! it's be nice to do this in case of a miscorrection - need more work
      ! suggest putting 'oops_word=saved_oops;' in ParserError()

      ! try fixing word

      start=parse-->(i*3+3); 
      len=parse-->(i*3+2);
      keylen=len+1; if (keylen>DICT_WORD_SIZE) keylen=DICT_WORD_SIZE;
      res=0; 
      wordstart=buffer+start;
      t = start+len-1;

      ! convert to lower case
      for (j=start: j<start+len: j++) {
        c1=buffer->j;
        if (c1>='A' && c1<='Z') buffer->j=c1+32;
        }

      !first try transpositions
      for (j=start+len - (i+1==parse-->0 || parse-->(i*3+4) || len<3): j>start: j--) {
        c1=buffer->j; 
        buffer->j=buffer->(j-1);
        buffer->(j-1)=c1;

        if (j>=start+len-1) { ! first pass may move spaces, second moves back.
          Tokenise__(buffer, parse);
          c3=buffer->(start+len); ! keep the original
          if (parse-->n) jump NxtChk;  ! fixed!
          }
        else {
          if (start+len<INPUT_BUFFER_LEN)
            buffer->(start+len)=0; ! end marker so search is accurate
          @binarysearch wordstart keylen dictstart entrylen dictlen 1 1 res;
          if (res) jump NxtChk;  ! fixed
          }
        
        buffer->(j-1)=buffer->j; ! undo transposition
        buffer->j=c1;
        } ! end of for loop

      !now try deletions
      if (len>2) {      ! don't turn words into single letters
        c1 = 0;
        for (j=t: j>=start: j--) { ! j represents the one that's missed out
          c2=buffer->j;
          buffer->j=c1;
          c1=c2;
          @binarysearch wordstart keylen dictstart entrylen dictlen 1 1 res;
          if (res) { ! fixed
            buffer->t = ' '; ! replace the extra zero
            jump NxtChk;  
            }
          }
        ! and restore
        for (j=t: j>start: j--)
          buffer->j=buffer->(j-1);
        buffer->start=c2;
        }

#ifndef QUICKCHECK;

      ! substitutions
      for (j=t: j>=start: j--) {
        c2=buffer->j;
        for (c1='a': c1<='z': c1++) {
          buffer->j=c1;
          @binarysearch wordstart keylen dictstart entrylen dictlen 1 1 res;
          if (res) jump NxtChk;  ! fixed
          }
        buffer->j=c2;
        }

      ! additions
      if (buffer-->0 >= INPUT_BUFFER_LEN-WORDSIZE) jump NxtChk;  ! not if could overflow
      (buffer-->0)++;
      for (j=buffer-->0+WORDSIZE-1: j>t: j--)
        buffer->(j+1)=buffer->j;
      keylen++; if (keylen>DICT_WORD_SIZE) keylen=DICT_WORD_SIZE;
      len++;
      if (start+len<INPUT_BUFFER_LEN)
        buffer->(start+len)=0; ! end marker so search is accurate

      for (j=t+1: j>=start: j--) {
        for (c1='a': c1<='z': c1++) {
          buffer->j=c1;
          @binarysearch wordstart keylen dictstart entrylen dictlen 1 1 res;
          if (res) jump NxtChk;  ! fixed
          }
        buffer->j=buffer->(j-1);
        }
      ! restore
      for (j=start: j<buffer-->0+WORDSIZE-1: j++)
        buffer->j=buffer->(j+1);
      (buffer-->0)--;
      len--;

#endif;

      .NxtChk; !outer loop

      ! remove any temporary zeroes from input
      buffer->(start+len)=c3;
      if (parse-->n || res) {
        alt++;
        Tokenise__(buffer, parse);  ! update ready for next word
        }
      else fail++;
      } ! end of 'if' word needs fixing

  if (alt && fail<=alt) {
    print "[The story read that as ~";
    for (i=WORDSIZE: i<WORDSIZE+buffer-->0: i++)
      print (char) buffer->i;
    print "~]^";
    }

  ]; ! end of LanguageToInformese


#endif;