{------------------------------------}
{                                    }
{   m   a   k   e   d   e   s   k    }
{                                    }
{ This program reads a file of text  }
{ containing a mixture of descrip-   }
{ tions and commands. It creates     }
{ output files which may be used as  }
{ a database of textual passages.    }
{ An index file contains information }
{ about each passage: start and stop }
{ indices in the data file (which is }
{ a file of strings of fixed length  }
{ 80), an identifier which may be    }
{ used if desired to retrieve the    }
{ passage by name - say using a hash }
{ scheme, etc. A data file is also   }
{ created containing all the text    }
{ lines from the input, either padded}
{ with blanks if the original line   }
{ was less than 80 characters long,  }
{ or truncated to 80 characters if   }
{ original line was too long.        }
{                                    }
{-----------------------------------*} 
PROGRAM makedescriptions;
CONST 

  hashmax = 30;
  blank40 = '                                        ';

TYPE

  whichsection =   (indexsection,descsection);
  pname        =   STRING[40];
  storyline    =   STRING[80];
  
  byte         =   0..255;

  procs        =   (pnamelookup, pentername, pdescribe, pmakename, pfindrec);
  placerec     =
    
    RECORD 
    
      CASE section:whichsection OF 
        
        indexsection: ( tableentry: INTEGER );
        descsection:  ( name:       pname;
                        id:         INTEGER;
                        dbegin:     INTEGER;
                        dend:       INTEGER;
                        link:       byte    ); 
    END; 

VAR
  infile:       text;
  narrate:      FILE OF STRING[80];
  indexfile:    FILE OF placerec; 

  hash:         ARRAY[0..hashmax] OF byte;
  symhash:      INTEGER;

  where:        INTEGER;
  { index TO symbol table }

  places:       ARRAY[0..255] OF placerec;
  dumprec:      placerec;
  lastrec:      placerec;

  nextplace:    byte; { init=31 }
  outrec:       INTEGER;
  { index TO descriptions. init=0 }

  placename:    pname;
  line:         storyline;
  blank80:      storyline;

  iname,
  nname,
  xname:        STRING;

  i:            INTEGER;
  ditto:        BOOLEAN;
  { was last data line a ditto line? }

  tracing:      BOOLEAN;

  ch:           CHAR;
  warnset:      SET OF CHAR;
  { init = ['$','"','>'] }


{------------------------------------} 
{       t    r    a    c    e        }
{                                    }
{ This procedure allows a trace of   }
{ all procedure calls made by the    }
{ program. This is most useful in    }
{ the program debugging phase.       }
{ -----------------------------------}
PROCEDURE trace (who:procs);
BEGIN

  CASE who OF

    pnamelookup:   writeln ( 'namelookup' );
    pentername:    writeln ( 'entername' );
    pdescribe:     writeln ( 'describe' );
    pmakename:     writeln ( 'makename' );
    pfindrec:      writeln ( 'findrec' );

  END { CASE who };

END { FROCEDURE trace };

{------------------------------------} 
{         i    n    t    o           }
{                                    }
{ Called by procedures on entry - it }
{ checks to see if tracing is in     }
{ effect and if so, calls the trace  }
{ procedure to print the name of the }
{ procedure ar functian which is     }
{ being entered.                     }
{------------------------------------} 
PROCEDURE into (who: procs);
BEGIN

  IF tracing THEN
  BEGIN

    write ('entering ');
    trace (who);

  END;

END { PROCEDURE into };

{------------------------------------} 
{   n  a  m  e  l  o  o  k  u  p     }
{                                    }
{ Called by entername. Its job is    }
{ to a determine if a given name has }
{ already been entered into the name }
{ table. The technique used is to    }
{ traverse a linked list of name     }
{ entries, all of which have the     }
{ game hashvalue. The hashvalue is   }
{ computed by the caller and left in }
{ the global variable “symhagsh’.    }
{------------------------------------} 
FUNCTION namelookup  ( thisname: pname ): BOOLEAN;
BEGIN

  into (pnamelookup);
  places[0].name := thisname;
  where          := hash[symhash];

  WHILE places[where].name <> thisname
  DO

    where := places[where].link
  { enddo };

  namelookup := ( where <> 0 );

END { FUNCTION namelookup };

{------------------------------------} 
{     e  n  t  e  r  n  a  m  e      }
{                                    }
{ This procedure is called in order  }
{ to enter a placename in the symbol }
{ table. It is called whenever a     }
{ placename instruction line (line   }
{ beginning with a '$') is scanned   }
{ in the make80 source file. It      }
{ calls namelookup to determine if   }
{ the placename has been used before.}
{------------------------------------} 
PROCEDURE entername;
VAR
  i: INTEGER;

BEGIN

  into (pentername);
  symhash := 0;
  FOR i := 1 TO length (placename)
  DO
    symhash := (symhash + ord (placename[i])) MOD (hashmax+1)
  { endo };

  writeln ('placename: ',placename);
  writeln ('hashvalue: ',symhash);

  IF namelookup (placename) THEN
  BEGIN

    writeln ('*** duplicate place:');
    writeln (placename);

  END
  ELSE
  BEGIN
    IF NOT ditto THEN
      places[nextplace].dend := outrec - 1;
    { endif };

    IF nextplace > 0 THEN
      lastrec := places[nextplace];
    { endif };

    nextplace := nextplace + 1;

    WITH places[nextplace] DO
    BEGIN
      
      id            := nextplace;
      link          := hash[symhash];
      dbegin        := outrec;
      name          := placename;
      hash[symhash] := nextplace;
    
    END;

  END { IF namelookup };
  ditto := false;

END { PROCEDURE entername };

{------------------------------------} 
{       d  e  s  c  r  i  b  e       }
{                                    }
{ Adds a line of text to the des-    }
{ criptions file. It first adjusts   }
{ the input line to be exactly 80    }
{ characters long. It accomplishes   }
{ this by padding the line with      }
{ blanks.                            }
{------------------------------------} 
PROCEDURE describe ( thisline: storyline );
BEGIN

  into (pdescribe);

  IF length (thisline) < 80 THEN
    thisline := concat (thisline, copy (blank80, 1, 80 - length (thisline)))
  { endif };

  seek (narrate, outrec);
  write (narrate, thisline);

  outrec := outrec + 1;

END { FROCEDURE describe };

{------------------------------------} 
{      m  a  k  e  n  a  m  e        }
{------------------------------------}
PROCEDURE makename ( VAR thisname: pname) ;
BEGIN

  into (pmakename);
  IF length(thisname) < 40 THEN
    
    thisname :=
      concat (thisname,
      copy (blank40, 1, 40-length(thisname)))
  
  { endif };

  writeln ('placename: ',thisname);

END { PROCEDURE makename };

{------------------------------------} 
{    f   i   n   d   r   e   c       }
{                                    }
{ Handles the ditto instruction lines}
{ from the make80 source file. It    }
{ must distinguish between the case  }
{ where a name is specified and the  }
{ case in which only a ditto was     }
{ used.                              }
{------------------------------------}
PROCEDURE findrec;
BEGIN

  into (pfindrec);

  IF length (line) = 1 THEN
  BEGIN

    places[nextplace].dbegin := lastrec.dbegin;
    places[nextplace].dend   :=  lastrec.dend;
    lastrec := places[nextplace];

  END
  ELSE
  BEGIN

    line := copy (line, 2, length (line) - 1); 
    makename (line);
    symhash := 0;
    FOR i := 1 TO length (line) DO
      symhash := (symhash + ord (line[i])) MOD (hashmax+1)
    { enddo };

    IF NOT namelookup (line) THEN
    BEGIN

      writeln('error: ditto name does not exist');
      writeln (line);

    END
    ELSE
    BEGIN
      places[nextplace].dbegin := places[where].dbegin;
      places[nextplace].dend   := places[where].dend;
      lastrec                  := places[where];

    END { IF NOT namelookup };

  END { IF length (line)>1 };

  ditto := true;

END { PROCEDURE findrec };

{----------------------------------------------}
{                                              }
{  m   m  aaaaa  k   k  eeeee  88888  00000    }
{  mm mm  a   a  k  k   e      8   8  0   0    }
{  m m m  a   a  k k    e       8 8   0   0    }
{  m   m  aaaaa  kk     eee      8    0   0    }
{  m   m  a   a  k k    e       8 8   0   0    }
{  m   m  a   a  k  k   e      8   8  0   0    }
{  m   m  a   a  k   k  e      88888  00000    }
{                                              }
{ Here begins the main program block of make80 }
{ The processing loop scans each line and      }
{ decides whether to add it to the text part   }
{ of the descriptions database, or whether to  }
{ interpret it as a makedesc instruction line. }
{ The instruction lines are handled by a case  }
{ statement which uses the special character   }
{ at the beginning of the line to determine    }
{ which makedesc instruction to carry out.     }
{----------------------------------------------}
BEGIN
  
  blank80   := concat (blank40, blank40);
  nextplace := 0;
  outrec    := 0;
  warnset   := ['$','"','>'];
  ditto     := false;

  FOR i := 0 TO hashmax DO
    hash[i] := 0
  { end do };

  write ('tracing? ==>');
  readln (ch);
  IF ch='y' THEN
    tracing := true
  ELSE
    tracing := false
  { endif };

  iname := '';

  WHILE length (iname) = 0 DO
  BEGIN

    write ('input file===>');
    readln (iname);

  END { DO };

  nname := '';

  WHILE length (nname) = 0 DO
  BEGIN

    write ('description file===>');
    readln (nname);
  
  END { DO };

  xname := concat (nname,'.x');

  assign (infile, iname);
  reset (infile);

  assign (narrate, nname);
  rewrite (narrate);

  {----------------------}
  { main processing loop }
  {----------------------}
  REPEAT
  
    readln (infile, line);

    IF length (line) > 0 THEN
    BEGIN

      ch := line[1];

      CASE ch OF

        '$':
        BEGIN

          line := copy (line, 2, length (line) - 1);
          IF length (line) > 40 THEN
          BEGIN
            writeln ('placename too long');
            write ('chopping to: ');
            line := copy (line, 1, 40);
            writeln (line);
          END {IF };

          IF length (line) < 40 THEN
            line := concat (line,copy (blank40, 1, 40 - length(line)))
          { endif };
          placename :=line;
          entername;

        END;

        '"':    findrec;
      
        '>':
        BEGIN
      
          close (infile);
          iname := copy (line, 2, length (line)-1);
          assign (infile, iname);
          reset (infile);
    
        END;
      END { CASE ch OF };

      IF NOT (ch IN warnset) THEN
        describe(line)
      { endif };

      { note: this takes advantage of the u.c.s.d.
              "fall through" semantics of the case
              statement and in general will not
              be transportable code.              }

    END { IF length (line)>0 };
  
  UNTIL eof (infile);

  places[nextplace].dend := outrec - 1; 
  { finish last placerec }

  nextplace := nextplace + 1;
  places[nextplace].name := 'nowhere';

  {----------------------}
  { write out index file }
  {----------------------}
  
  close (narrate);

  assign (indexfile, xname);
  rewrite (indexfile);

  dumprec.section := indexsection;
  { SET variant TO accept hash table entries }

  FOR i:= 0 TO hashmax DO
  BEGIN
    
    dumprec.tableentry := hash[i];
    seek (indexfile, i);
    write (indexfile, dumprec);

  END { DO };

  dumprec.section := descsection;
  { SET variant TD accept place table entries }

  FOR i := 1 TO nextplace DO
  BEGIN
  
  dumprec := places[i];
  seek (indexfile, i + hashmax);
  write (indexfile, dumprec);

  END { DO };

  close (indexfile);

END.