🚀 go-pugleaf

program spell;

const
  {$i gemconst}

  { length of largest possible word }
  max_word_length    =             30;

  { number of entries in the hash table }
  table_size         =            1000;

  small_length       =               4;
  medium_length      =               8;
  large_length       =              10;
  largest_length     = max_word_length;
  name_of_dictionary =     'words.txt';
  temp_dict_name     =     'words.xxx';

  { Color of text }
  color              =           $1180;

type
  {$i gemtype}

  word_string      = string[max_word_length];
  string_index     = 1..max_word_length;
  hash_index       = 1..table_size;

  length_type      = (small, medium, large, largest);

  small_string     = string[small_length];
  medium_string    = string[medium_length];
  large_string     = string[large_length];
  largest_string   = string[largest_length];

  { pointer to a small, medium, large, or largest string }
  word_pointer     = record

                       case tag_field : length_type of

                         small   : (small_ptr   : ^small_string);
                         medium  : (medium_ptr  : ^medium_string);
                         large   : (large_ptr   : ^large_string);
                         largest : (largest_ptr : ^largest_string);

                     end;

  list             = ^cell;

  cell             = record

                         word : word_pointer;
                         next : list;

                       end;

  hash_table       = array[hash_index] of list;

  word_list        = record

                       words   : hash_table;
                       changed : boolean;

                     end;

  char_file        = packed file of char;

var
  { memory-resident dictionary }
  dictionary,

  {
  list of words that are spelled correctly but will not be inserted into
  a dictionary.
  }
  secondary_dict   : word_list;

  done,
  cancel,
  out_of_memory    : boolean;
  word             : word_string;
  in_file_name,
  out_file_name,
  in_file_type     : string;
  spell_file,
  spelled_file,
  new_spelled_file : char_file;
  next_char        : char;
  button           : integer;


{$i gemsubs}


procedure io_check(switch : boolean); external;
function io_result : integer; external;


function file_exists(filename : string) : boolean;

{
Return true if the file specified by filename exists on the default disk.
}

const
  { File operation was successfull }
  no_error = 0;

var
  input_file : char_file;

begin

  { Turn off i/o checking. }
  io_check(false);

  { Attempt to open the named file. }
  reset(input_file, filename);

  { If there was no error opening the file, it is assumed to exist. }
  file_exists := io_result = no_error;

  close(input_file);

  { Turn i/o checking back on. }
  io_check(true);

end;


procedure remove_white(var str : string);

{
Remove all whitespace characters from a character string.  Whitespace
characters are assumed to have character codes less than or equal to
the code for space (' ').
}

var
  new_string : string;
  index      : integer;

begin

  new_string := '';

  for index := 1 to length(str) do
    if str[index] > ' '
      then new_string := concat(new_string, str[index]);

  str := new_string;

end;


procedure read_char(var input_file : char_file; var ch : char);

{
Read a character from a file.
}

begin

  ch := input_file^;
  get(input_file);

end;


procedure write_char(var output_file : char_file; ch : char);

{
Write a character to a file.
}

begin

  output_file^ := ch;
  put(output_file);

end;


procedure write_word(var output_file : char_file; word : word_string);

{
Write a character string to a file.
}

var
  index : string_index;

begin

  for index := 1 to length(word) do
    write_char(output_file, word[index]);

end;


procedure get_word(var input_file, output_file : char_file;
             var word : word_string; var next_char : char);

{
Retrieve the next word from the input file.  When the file is completely read,
(word) will be the empty string.
}

var
  ch         : char;
  letters,
  apostrophe : set of char;

begin

  word := '';

  letters := ['a'..'z', 'A'..'Z'];
  apostrophe := [''''];

  if not eof(input_file)
    then begin

      { Get the initial letter of the word. }
      repeat

        read_char(input_file, ch);

        { Send all letters not in the word to the output file. }
        if not (ch in letters)
          then write_char(output_file, ch);

      until (ch in letters) or eof(input_file);

      { If the initial letter of the word was found, get the other letters. }
      if ch in letters
        then begin

          word := ch;

          repeat

            read_char(input_file, ch);

            if ch in letters + apostrophe
              then word := concat(word, ch)
              else { Save character following word to write to output file. }
                next_char := ch;

          until (not (ch in letters + apostrophe)) or eof(input_file) or
                (length(word) = max_word_length);

        end;

    end;

end;


function min(a, b : integer) : integer;

{
Return the smaller of a and b.
}

begin

  if a < b
    then min := a
    else min := b;

end;


function capital(ch : char) : char;

{
Return the capital of a lowercase letter.  Return the original
letter otherwise.
}

begin

  if ch in ['a'..'z']
    then capital := chr(ord(ch) - (ord('a') - ord('A')))
    else capital := ch;

end;


function hash(word : word_string) : hash_index;

{
Return an index into the hash table based on a key (word).
}

var
  index       : string_index;
  number      : long_integer;
  power_of_10 : integer;

begin

  { Convert the key to a number. }
  number := 0;
  power_of_10 := 1;

  for index := min(4, length(word)) downto 1 do begin

    number := number + power_of_10 * ord(capital(word[index]));
    power_of_10 := power_of_10 * 10;

  end;

  { Compute a valid hash index. }
  hash := int(number mod table_size) + 1;

end;


procedure get_word_from_dictionary(var word : word_string;
                                        word_cell : list);

{
Retrieve a word from a cell of the hash table.
}

begin

  case word_cell^.word.tag_field of

    small   : word := word_cell^.word.small_ptr^;
    medium  : word := word_cell^.word.medium_ptr^;
    large   : word := word_cell^.word.large_ptr^;
    largest : word := word_cell^.word.largest_ptr^;

  end;

end;


procedure word_capitalize(var word : word_string);

{
Make all alphabetic characters of a word upper-case.
}

var
  index : string_index;

begin

  for index := 1 to length(word) do
    word[index] := capital(word[index]);

end;


function words_equal(word_1, word_2 : word_string) : boolean;

{
Return true if two words are equal (alphabetic case of characters is
ignored.
}

begin

  if length(word_1) <> length(word_2)
    then words_equal := false
    else begin

      word_capitalize(word_1);
      word_capitalize(word_2);

      words_equal := word_1 = word_2;

    end;

end;


function word_in_dictionary(word : word_string; dictionary : word_list) :
                                                                 boolean;

{
Return true when a word is found in the dictionary.
}

var
  index          : hash_index;
  retrieved_word : word_string;
  word_found     : boolean;

begin

  index := hash(word);

  { Single letters will be considered valid words. }
  word_found := length(word) = 1;

  { Search for the word in the hash table. }
  while (dictionary.words[index] <> nil) and (not word_found) do begin

    get_word_from_dictionary(retrieved_word, dictionary.words[index]);
    word_found := words_equal(word, retrieved_word);

    dictionary.words[index] := dictionary.words[index]^.next;

  end;

  word_in_dictionary := word_found;

end;


procedure insert_word(word : word_string; var dictionary : word_list;
                                        var out_of_memory : boolean);

{
Insert a word into the dictionary if it is not already there.
}

const
  min_free_memory = 1024;

var
  index     : hash_index;
  word_cell : word_pointer;
  new_cell  : list;


  procedure get_word_cell(word : word_string; var word_cell : word_pointer);

  {
  Return a pointer to a word.
  }

  begin

    {
    Depending on the length of the word, allocate the proper amount of
    memory.
    }

    if length(word) in [1..small_length]
      then begin

        word_cell.tag_field := small;
        new(word_cell.small_ptr);
        word_cell.small_ptr^ := word;

      end;

    if length(word) in [small_length + 1 .. medium_length]
      then begin

        word_cell.tag_field := medium;
        new(word_cell.medium_ptr);
        word_cell.medium_ptr^ := word;

      end;

    if length(word) in [medium_length + 1 .. large_length]
      then begin

        word_cell.tag_field := large;
        new(word_cell.large_ptr);
        word_cell.large_ptr^ := word;

      end;

    if length(word) in [large_length + 1 .. largest_length]
      then begin

        word_cell.tag_field := largest;
        new(word_cell.largest_ptr);
        word_cell.largest_ptr^ := word;

      end;

  end;


begin

  { Find out if memory is getting low. }
  out_of_memory := memavail < min_free_memory;

  if (not out_of_memory) and (not word_in_dictionary(word, dictionary)) and
     (length(word) in [1..largest_length])
    then begin

      { Get a pointer to a cell containing the word. }
      get_word_cell(word, word_cell);

      { Insert the word into the hash table. }
      new(new_cell);
      new_cell^.word := word_cell;

      index := hash(word);

      new_cell^.next := dictionary.words[index];
      dictionary.words[index] := new_cell;

    end;

end;


procedure clear_dictionary(var dictionary : word_list);

{
Initialize the dictionary to empty.
}

var
  index : hash_index;

begin

  for index := 1 to table_size do
    dictionary.words[index] := nil;

  dictionary.changed := false;

end;


procedure load_dictionary(var dictionary : word_list;
                        var out_of_memory : boolean);

{
Load the dictionary with words from a disk file.
}

var
  word_file : text;
  word      : word_string;

begin

  { Make mouse a "busy bee". }
  set_mouse(m_bee);

  { Load the dictionary into memory. }

  { Make the dictionary empty. }
  clear_dictionary(dictionary);

  { If the dictionary disk file does not exist, create a new (empty) one. }
  if not file_exists(name_of_dictionary)
    then begin

      rewrite(word_file, name_of_dictionary);
      close(word_file);

    end;

  { Prepare to read words from the disk file. }
  reset(word_file, name_of_dictionary);

  out_of_memory := false;

  { Insert each word in the disk file into the dictionary. }

  while (not eof(word_file)) and (not out_of_memory) do begin

    readln(word_file, word);
    insert_word(word, dictionary, out_of_memory);

  end;

  { Make the mouse an arrow again. }
  set_mouse(m_arrow);

end;


procedure update_dictionary(dictionary : word_list);

{
Save all dictionary words in a disk file if the dictionary has changed.
}

var
  index         : hash_index;
  word          : word_string;
  word_file,
  new_word_file : text;
  button        : integer;

begin

  if dictionary.changed
    then begin

      { Find out if user wants to update the dictionary stored on disk. }
      button := do_alert('[0][Update Dictionary?][YES|NO]', 1);

      if button = 1
        then begin

          { Make the mouse a "busy bee." }
          set_mouse(m_bee);

          { Save dictionary with a temporary filename. }
          rewrite(word_file, temp_dict_name);

          { Save all words stored in each list of the hash table. }
          for index := 1 to table_size do begin

            { Save all words stored in current list of the hash table. }
            while dictionary.words[index] <> nil do begin

              get_word_from_dictionary(word, dictionary.words[index]);
              writeln(word_file, word);

              { Advance to next cell of current list. }
              dictionary.words[index] := dictionary.words[index]^.next;

            end;

          end;

          { Replace old dictionary with new dictionary. }
          rewrite(new_word_file, name_of_dictionary);
          rename(word_file, new_word_file);

          { Return mouse to arrow shape. }
          set_mouse(m_arrow);

        end;

    end;

end;


procedure process_word(var word : word_string; var dictionary,
     secondary_dict : word_list; var out_of_memory : boolean);

{
Process a misspelled word: either

i.   place word in dictionary
ii.  change spelling of word
iii. don't change word
}

var
  insert_wd : boolean;


  procedure get_option(var word : word_string; var insert_wd : boolean);

  {
  Allow user to correct the spelling of a possibly misspelled word and insert
  it into the dictionary.
  }

  const
    not_in_dict  = 'is not in the dictionary.';
    question     = 'Add this word to dictionary?';

    { Width (in characters) of dialog box }
    box_width    = 40;

  var
    word_line,
    line_2,
    line_3,
    button_pushed,
    no_button,
    yes_button     : integer;
    option_box     : dialog_ptr;
    word_string    : str255;

  begin

    { Get a dialog box. }
    option_box := new_dialog(5, 0, 0, box_width, 7);

    { Place possibly misspelled word in the dialog box. }
    word_line := add_ditem(option_box, g_ftext, editable, 1, 1, 30, 1, 0,
                                                                  color);

    line_2 := add_ditem(option_box, g_text, none, 1, 2, length(not_in_dict),
                                                               1, 0, color);

    line_3 := add_ditem(option_box, g_text, none, 1, 3, length(question),
                                                            1, 0, color);

    { Place YES and NO buttons in the dialog box. }
    yes_button := add_ditem(option_box, g_button, exit_btn | selectable, 10, 5,
                                                   length('YES'), 1, 0, color);

    no_button := add_ditem(option_box, g_button, exit_btn | selectable,
                                     28, 5, length('NO'), 1, 0, color);

    { Prepare to allow user to correct the spelling of the word. }
    set_dedit(option_box, word_line, '______________________________',
                                     'aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa',
                                          word, system_font, te_left);

    set_dtext(option_box, line_2, not_in_dict, system_font, te_center);
    set_dtext(option_box, line_3, question, system_font, te_center);

    { Prepare to have the YES or NO buttons pressed. }
    set_dtext(option_box, yes_button, 'YES', system_font, te_center);
    set_dtext(option_box, no_button, 'NO', system_font, te_center);

    center_dialog(option_box);

    { Get user input from dialog box. }
    button_pushed := do_dialog(option_box, word_line);

    { Retrieve the possibly edited word. }
    get_dedit(option_box, word_line, word_string);
    word := word_string;

    insert_wd := button_pushed = yes_button;

    end_dialog(option_box);
    delete_dialog(option_box);

  end;


begin

  {
  Allow user to correct spelling of word, and have him decide if it
  will be inserted into the dictionary.
  }

  get_option(word, insert_wd);

  {
  If the word is to be inserted into the dictionary, do so.  Otherwise
  insert the word into the secondary dictionary so that the user will
  not be asked about the word a second time.
  }
  if insert_wd
    then begin

      insert_word(word, dictionary, out_of_memory);
      dictionary.changed := true;

    end
    else insert_word(word, secondary_dict, out_of_memory);

end;


procedure get_input_filename(var in_file_name, in_file_type : string;
                                               var cancel : boolean);

{
Get the name the file to be corrected.  If cancel is true after this
procedure is called, the program is exited.
}

const
  fl_type_length = 3;

var
  button   : integer;
  path,
  filename : string;

begin

  { Default path for filename selection }
  path := 'A:\*.DOC';

  {
  Place file selection box on screen and allow user to choose a file or
  to press the cancel button.  Repeat until user enters a valid filename
  or presses the cancel button.
  }

  repeat

    cancel := not get_in_file(path, filename);

    {
    If the requested file does not exist, have the user choose an existing
    file or quit the program.
    }

    if (not cancel) and (not file_exists(filename))
      then begin

        button := do_alert('[2][Not found-Try again?][YES|NO]', 1);
        cancel := button = 2;

      end;

  until cancel or file_exists(filename);

  {
  If the filename of an existing filename has been given, extract
  the name and type of the file.
  }

  if not cancel
    then begin

      if pos('.', filename) <> 0
        then begin

          in_file_type := copy(filename, pos('.', filename) + 1,
                         length(filename) - pos('.', filename));
          in_file_name := copy(filename, 1, pos('.', filename) - 1);

        end
        else begin

          in_file_type := '';
          in_file_name := filename;

        end;

      remove_white(in_file_name);
      remove_white(in_file_type);

    end;

end;


procedure introduce_program;

{
Introduce the program with a dialog box.
}

const
  { Width (in characters) of dialog box }
  box_width = 64;

  { Strings that will be inserted into dialog box. }
  str_1     = 'Spell 1.3 - A Spelling Correction Program';
  str_2     = 'Written by Eric Bergman-Terrell';
  str_3     = 'of Cadenza Software, Ltd.';
  str_4     = '1704 Imperial Ridge, Las Cruces, NM  88001, USA';
  str_5     = 'Portions of this product are copyright (c) 1986, OSS and CCD';
  str_6     = 'Used by Permission of OSS';
  str_7     = 'This software has been placed in the public domain.';
  start_str = 'BEGIN';

var
  intro_box     : dialog_ptr;
  line_1,
  line_2,
  line_3,
  line_4,
  line_5,
  line_6,
  line_7,
  start_button,
  button_pushed : integer;
  start_item    : tree_index;

begin

  { Set up the mouse the be an arrow. }
  init_mouse;
  set_mouse(m_arrow);

  { Get a dialog box. }
  intro_box := new_dialog(8, 0, 0, box_width, 16);

  { Insert strings into dialog box. }
  line_1 := add_ditem(intro_box, g_text, none, 1, 1, box_width, 1, 0, color);
  line_2 := add_ditem(intro_box, g_text, none, 1, 3, box_width, 1, 0, color);
  line_3 := add_ditem(intro_box, g_text, none, 1, 4, box_width, 1, 0, color);
  line_4 := add_ditem(intro_box, g_text, none, 1, 5, box_width, 1, 0, color);
  line_5 := add_ditem(intro_box, g_text, none, 1, 7, box_width, 1, 0, color);
  line_6 := add_ditem(intro_box, g_text, none, 1, 8, box_width, 1, 0, color);
  line_7 := add_ditem(intro_box, g_text, none, 1, 11, box_width, 1, 0, color);
  start_button := add_ditem(intro_box, g_button,
                            exit_btn | selectable | default,
                            30, 14, length(start_str), 1, 0, color);

  { Adjust the strings in the dialog box. }
  set_dtext(intro_box, line_1, str_1, system_font, te_center);
  set_dtext(intro_box, line_2, str_2, system_font, te_center);
  set_dtext(intro_box, line_3, str_3, system_font, te_center);
  set_dtext(intro_box, line_4, str_4, system_font, te_center);
  set_dtext(intro_box, line_5, str_5, system_font, te_center);
  set_dtext(intro_box, line_6, str_6, system_font, te_center);
  set_dtext(intro_box, line_7, str_7, system_font, te_center);
  set_dtext(intro_box, start_button, start_str, system_font, te_center);

  center_dialog(intro_box);

  { Introduce the program. }
  button_pushed := do_dialog(intro_box, start_item);

  end_dialog(intro_box);
  delete_dialog(intro_box);

end;


begin

  if init_gem >= 0
    then begin

      introduce_program;

      load_dictionary(dictionary, out_of_memory);

      {
      Initialize list of correctly spelled words that will not be
      inserted into a dictionary.
      }
      clear_dictionary(secondary_dict);

      if not out_of_memory
        then begin

          get_input_filename(in_file_name, in_file_type, cancel);

          if not cancel
            then begin

              out_file_name := concat(in_file_name, '.XXX');

              reset(spell_file, concat(in_file_name, '.', in_file_type));
              rewrite(spelled_file, out_file_name);

              repeat

                get_word(spell_file, spelled_file, word, next_char);

                done := length(word) = 0;

                if not done
                  then begin

                    if (not word_in_dictionary(word, dictionary)) and
                       (not word_in_dictionary(word, secondary_dict))
                      then process_word(word, dictionary, secondary_dict,
                                                          out_of_memory);

                    write_word(spelled_file, word);
                    write_char(spelled_file, next_char);

                end;

              until done or out_of_memory;

              close(spell_file);

              { Replace old input file with file that has been corrected. }
              rewrite(new_spelled_file, concat(in_file_name, '.',
                                                  in_file_type));
              rename(spelled_file, new_spelled_file);

              { Update dictionary if it has changed. }
              update_dictionary(dictionary);

            end;

        end;

      if out_of_memory
        then button := do_alert('[1][Out of Memory][CANCEL]', 1);

    end;

end.