Between Heaven & Hell 2/BetweenHeavenHell.cdr/500/433/pyfiles.inc

Text File | 1986-10-17 | 31KB | 924 lines

FUNCTION Compress(CLine : Line) : Line;
VAR
  CompLen    : INTEGER;
  CompPtr    : INTEGER;
  OutComp    : Line;
  OutCompLen : BYTE ABSOLUTE OutComp;
BEGIN
  CompLen := LENGTH(Cline);
  CompPtr := 0;
  OutComp := '';
  IF LENGTH(CLine) > 0 THEN
  BEGIN
    REPEAT
      CompPtr := CompPtr + 1;
      OutCompLen := OutCompLen + 1;
      IF (CLine[CompPtr] <> ' ') OR (CompPtr = CompLen)
      THEN OutComp[OutCompLen] := CLine[CompPtr]
      ELSE
      BEGIN
        OutComp[OutCompLen] := CHR(ORD(CLine[CompPtr + 1]) + 128);
        CompPtr := CompPtr + 1;
      END;
    UNTIL CompPtr = CompLen;
  END;
  Compress := OutComp;
END;

FUNCTION DeCompress(CLine : Line) : Line;
VAR
  CompLen    : INTEGER;
  CompPtr    : INTEGER;
  OutComp    : Line;
  OutCompLen : BYTE ABSOLUTE OutComp;
BEGIN
  OutComp := '';
  IF LENGTH(CLine) > 0 THEN
  BEGIN
    FOR CompPtr := 1 TO LENGTH(CLine) DO
    BEGIN
      OutCompLen := OutCompLen + 1;
      IF ORD(CLine[CompPtr]) < 129
      THEN OutComp[OutCompLen] := CLine[CompPtr]
      ELSE
      BEGIN
        OutComp[OutCompLen] := ' ';
        OutCompLen := OutCompLen + 1;
        OutComp[OutCompLen] := CHR(ORD(CLine[CompPtr]) - 128);
      END;
    END;
  END;
  DeCompress := OutComp;
END;

PROCEDURE OpenFail(OFFile : FNType);
BEGIN
  WRITELN(#17#16+' Fatal error!  Can''t open '+OFFile);
  WRITELN(#17#16+' IORESULT = '+IntToStr(IORESULT));
  WRITELN(#17#16+' Check:  Installed wrong?  Wrong diskettes?');
  SysFail := TRUE;
END;

FUNCTION OpenFailed : BOOLEAN;
BEGIN
  IF IORESULT > 0
  THEN
  BEGIN
    OpenFailed := TRUE;
    XLn('* File Error; IORESULT = '+IntToStr(IOResult));
  END
  ELSE OpenFailed := FALSE;
END;

FUNCTION OpenFile(FileName : FNType) : BOOLEAN;
VAR
  OFX, OFY, OFY2 : INTEGER;
BEGIN
  FileName := Upper(FileName);
  IF POS(MFLocation,FileName) = 0 THEN FileName := DFLocation + FileName;
  ASSIGN(TxtFile,FileName);
  {$I-}
  RESET(TxtFile);
  {$I+}
  IF IOresult > 0
  THEN
  BEGIN
    OpenFile := FALSE;
    SysLog('W','Open Error on '+FileName);
  END
  ELSE
  BEGIN
    OpenFile := TRUE;
    OFX  := WHEREX;
    OFY  := WHEREY;
    IF OFY > 3
    THEN OFY2 := OFY - 3
    ELSE OFY2 := OFY;
    GOTOXY(76 - LENGTH(FileName),OFY2);
    WRITE(#17#16+' '+FileName);
    GOTOXY(OFX,OFY);
  END;
END;

FUNCTION MsgNumAfter(IMPNum : INTEGER) : INTEGER;
BEGIN
  IF IMPNum = MaxMsgs THEN IMPNum := 0;
  MsgNumAfter := IMPNum + 1;
END;

FUNCTION MsgNumBefore(IMPNum : INTEGER) : INTEGER;
BEGIN
  IF IMPNum = 1 THEN IMPNum := MaxMsgs + 1;
  MsgNumBefore := IMPNum - 1;
END;

FUNCTION XFile(FName : FNType) : SFType;
VAR
  CharPos     : INTEGER;
  Excluding   : BOOLEAN;
  InList      : BOOLEAN;
  InterCmd    : CHAR;
  Private     : BOOLEAN;
  SFLine      : Line;
  SFStat      : SFType;
  XNames      : Line;
BEGIN
  OutFiling := TRUE;
  Private := FALSE;
  IF (NOT OpenFile(FName))
  THEN SFStat := OpenError
  ELSE
  BEGIN
    ExplainKeys;
    InterCmd := '*';
    REPEAT
      {----- Get the line to print -----}
      {$I-} READLN(TxtFile,SFLine); {$I+}
      IF IORESULT > 0 THEN
      BEGIN
        XLn('File-read problem -- sorry.');
        SysLog('W','File-read error '+IntToStr(IORESULT)+' on '+FName);
        InterCmd := 'S';
      END;
      SFLine := DeCompress(SFLine);
      {----- Check for private or exclusive -----}
      IF (LENGTH(SFLine) > 2)
      THEN
      BEGIN
        IF (SFLine[1] IN ['>','<']) AND (SFLine[2] ='<') THEN
        BEGIN
          IF SFLine[1] = '>'
          THEN Excluding := TRUE
          ELSE Excluding := FALSE;
          {----- Find the >> or >< end-delimiter -----}
          CharPos := POS('>>',SFLine);
          IF CharPos = 0 THEN CharPos := LastPos('><',SFLine);
          IF CHARPos >= 4 THEN
          BEGIN
            IF Private THEN XLF;  { In case of previous one }
            XNames := Upper(COPY(SFLine,2,CHARPos-1));
            IF (POS('<'+UserName+'>',XNames) > 0)
            THEN InList := TRUE
            ELSE InList := FALSE;
            IF (    Excluding    AND    InList    AND (NOT WizOp) )
            OR ( (NOT Excluding) AND (NOT InList) AND (NOT WizOp) )
            THEN Private := TRUE
            ELSE Private := FALSE;
            IF Private THEN
            BEGIN
              X(COPY(SFLine,1,CHARPos+1));
              IF CHARPos + 22 > Width
              THEN XLF
              ELSE X('  ');
              IF Excluding
              THEN XLn('(Exclusive Message)')
              ELSE XLn('(Private Message)');
            END;  {  Valid reader }
          END;  { End delimiter is acceptable }
        END;   { Could be exclusive or private }
      END;  { Line is long enough to check }
      {----- Send line and check for interrupted output -----}
      IF NOT Private THEN
      BEGIN
        IF LENGTH(TuneString) > 0 THEN
        BEGIN
          IF POS(TuneString,Upper(SFLine)) > 0 THEN TuneMatch := TRUE;
        END;
        XLn(SFLine);
      END;
      IF CharDuringO THEN
      BEGIN
        OutFiling   := FALSE;
        CharDuringO := FALSE;
        IF DuringOChar = ' '
        THEN InterCmd := 'S'
        ELSE
        BEGIN
          IF SuppressOut THEN
          BEGIN
            SuppressOut := FALSE;
            XLF;
          END;
          REPEAT
            IF Multiple
            THEN
            BEGIN
              XLn(CR+LF+'Continue, Skip, Quit, Back-up, Re-read?');
              X('(C/S/Q/B/R)  '+XON)
            END
            ELSE X(CR+LF+'Continue or Quit? (C/Q)  '+XON);
            InterCmd := UPCASE(SerialIn);
            IF LostCarrier THEN InterCmd := 'Q';
            {----- Back-up and Re-read processing -----}
            IF Multiple THEN
            BEGIN
              IF InterCmd IN ['B','R'] THEN
              BEGIN
                IF InterCmd = 'B' THEN
                REPEAT
                  MsgPtr := MsgNumBefore(MsgPtr);
                UNTIL (MsgBands[MsgPtr] = ReadBand) OR (ReadBand = '*');
                MsgPtr := MsgNumBefore(MsgPtr);  { Make it "next message" }
              END;
            END;
          UNTIL InterCmd IN ['C','S','Q','B','R'];
          XLn(InterCmd);
          IF InterCmd IN ['B','R'] THEN InterCmd := 'S';
        END;  { Not a space }
        OutFiling := TRUE;
      END;  { CharDuringO }
    UNTIL EOF(TxtFile)                  { End of file }
    OR    (InterCmd IN ['S','Q'])       { User-interruption }
    OR    (TuneMatch AND SuppressOut);  { Tune-scanning successful }
    {----- Clean up -----}
    CLOSE(TxtFile);
    IF InterCmd = 'Q'
    THEN SFStat := Quit
    ELSE SFStat := Okay;
  END;  { File opened okay }
  OutFiling := FALSE;
  XFile := SFStat;
END;

FUNCTION FindUserRecPtr(FURPName : UNameType) : BOOLEAN;
VAR
  GotHim   : BOOLEAN;
  FURPTest : UNameType;
BEGIN
  GotHim := FALSE;
  UserRecPtr := 0;
  FURPTest := Upper(FURPName);
  REPEAT
    UserRecPtr := UserRecPtr + 1;
    IF Upper(UserNames[UserRecPtr]) = FURPTest THEN GotHim := TRUE;
  UNTIL GotHim OR (UserRecPtr = MaxUsers);
  IF NOT GotHim
  THEN FindUserRecPtr := FALSE
  ELSE
  BEGIN
    UserRecPtr := UserRecPtr - 1; { First Component is at 0 }
    FindUserRecPtr := TRUE;
  END;
END;

PROCEDURE GetReadDate(GRDChar : CHAR);
BEGIN
  IF Date_Warp > -1 THEN
  BEGIN
    ReadDate := Date_Warp;  ReadMint := Mint_Warp;  { Yummy }
  END
  ELSE
  BEGIN
    WITH UsersRec DO
    BEGIN
      CASE GRDChar OF
        '0' : BEGIN
                ReadDate := Date_X; ReadMint := Mint_X; Read_X := TRUE;
              END;
        'A' : BEGIN
                ReadDate := Date_A; ReadMint := Mint_A; Read_A := TRUE;
              END;
        'B' : BEGIN
                ReadDate := Date_B; ReadMint := Mint_B; Read_B := TRUE;
              END;
        'C' : BEGIN
                ReadDate := Date_C; ReadMint := Mint_C; Read_C := TRUE;
              END;
        'D' : BEGIN
                ReadDate := Date_D; ReadMint := Mint_D; Read_D := TRUE;
              END;
        'P' : BEGIN
                ReadDate := Date_P; ReadMint := Mint_P; Read_P := TRUE;
              END;
        'S' : BEGIN
                ReadDate := Date_S; ReadMint := Mint_S; Read_S := TRUE;
              END;
        'G' : BEGIN
                ReadDate := Date_Last; ReadMint := Mint_Last;
              END;
        '*' : BEGIN
                ReadDate := Date_Last; ReadMint := Mint_Last;
              END;
      END; { Case }
    END; { With }
  END; { Not warped }
END;

FUNCTION MsgFile(MFNum : INTEGER) : FNType;
VAR
  StrNum   : STRING[7];
  MFPad    : STRING[14];
BEGIN
  STR(MFNum,StrNum);
  MFPad := '0000000' + StrNum;
  StrNum := COPY( MFPad, LENGTH(MFPad)-6, 7 );
  MsgFile := MFLocation + 'B' + StrNum;
END;

FUNCTION OpenQuestFile : BOOLEAN;
BEGIN
  QuestFileName := DFLocation + File_Queries;
  ASSIGN(QuestFile,QuestFileName);
  {$I-}  RESET(QuestFile);  {$I+}
  OpenQuestFile := TRUE;  IF IOResult > 0 THEN OpenQuestFile := FALSE;
END;

FUNCTION AskMsgTimesPtr : INTEGER;
VAR
  MFCntr : INTEGER;
  MFDate : INTEGER;
  MFMint : INTEGER;
  MFGot  : BOOLEAN;
BEGIN
  MFDate := GetInt('What day was the message sent?  ');
  MFMint := GetInt('And what  minute  of that day?  '); XLF;
  IF (MFMint = 0) AND (MFDate = 1) THEN MFMint := 1;
  MFCntr := 0;
  MFGot := FALSE;
  REPEAT
    MFCntr := MFCntr + 1;
    IF (MsgDates[MFCntr] = MFDate) AND (MsgMints[MFCntr] = MFMint)
    THEN MFGot := TRUE;
  UNTIL MFGot OR (MFCntr = MaxMsgs);
  IF MFGot
  THEN AskMsgTimesPtr := MFCntr - 1
  ELSE AskMsgTimesPtr := MaxMsgs;  { Beyond EOF }
END;

FUNCTION Editor(EType : CHAR) : CHAR;
TYPE
  AddType  = (NoAdd, YesAdd, Doing);
VAR
  AddAgain : AddType;
  AddDone  : BOOLEAN;
  Added    : BOOLEAN;
  AvgBS    : REAL;
  AvgIT    : REAL;
  BlCntr   : INTEGER;
  ChAuto   : CHAR;
  ChCmd    : CHAR;
  ChDone   : BOOLEAN;
  ChFound  : BOOLEAN;
  ChExp    : INTEGER;
  ChFrom   : Line;
  ChLine   : Line;
  ChSpot   : INTEGER;
  ChTo     : Line;
  HighIT   : REAL;
  LowIT    : REAL;
  SpdRng   : REAL;
  TempBS   : REAL;
  TempIT   : REAL;
  TrackBS  : ARRAY[1..MaxMsgLen] OF REAL;
  TrackIT  : ARRAY[1..MaxMsgLen] OF REAL;
BEGIN
  AddAgain := NoAdd;
  AddDone  := TRUE;
  Added    := FALSE;
  ChDone   := FALSE;
  Communicative := TRUE;
  FOR ChPtr := 1 TO MaxMsgLen DO
  BEGIN
    TrackBS[ChPtr] := 0;
    TrackIT[ChPtr] := 0;
  END;
  IF EType = 'C' THEN ChAuto := '%';
  IF EType = 'S' THEN ChAuto := 'A';
  REPEAT
    CharDuringO := FALSE;
    IF ChAuto <> ' '
    THEN
    BEGIN
      ChCmd := ChAuto;
      IF AddAgain = YesAdd
      THEN
      BEGIN
        ChAuto := 'A';
        AddAgain := Doing;
      END
      ELSE ChAuto := ' ';
    END
    ELSE
    BEGIN
      X(LF+'OPTION?  '+XON);
      ChCmd := UPCASE(SerialIn);
      IF ChCmd = CR THEN ChCmd := 'S';
      XLn(ChCmd);
      XLF;
      CharDuringO := FALSE;
    END;
    CASE ChCmd OF
      '?' : BEGIN
              XLn('> Single-letter commands');
              XLF;
              IF AddAgain = Doing
              THEN X('E - Edit mode       ')
              ELSE X('A - Add more text   ');
              XLn('L - List the text');
              XLn('F - Find a word     C - Change a line');
              XLn('D - Delete a line   I - Insert a line');
              XLn('S - Save the text   Q - Quit, no save');
              IF Wrapping
              THEN XLn('W - Word-wrap off')
              ELSE XLn('W - Word-wrap on');
              XLF;
              XLn('While typing anywhere on this system:');
              XLn('Hold down  CTRL-X  to delete a  line.');
              XLn('Hold down  CTRL-H  to erase a letter.');
            END;
      'A' : BEGIN
              IF ChSize >= MaxMsgLen
              THEN
              BEGIN
                XLn('Message is full');
                AddAgain := NoAdd;
              END
              ELSE
              BEGIN
                IF AddAgain = NoAdd
                THEN XLn(LF+'For help:  enter  ?  on an empty line.')
                ELSE XLn(LF+'Continue entering text...');
                AddAgain := YesAdd;
                AddDone  := FALSE;
                Added    := TRUE;
                XLF;
                REPEAT
                  Adding := TRUE;
                  ChLine := GetInputLn;
                  Adding := FALSE;
                  IF Logoff THEN ChLine := 'S';
                  IF (LENGTH(ChLine) = 1) AND (ChLine <> ' ') THEN
                  BEGIN
                    ChAuto := UPCASE(ChLine[1]);
                    IF ChAuto IN ['E','L','C','D','I'] THEN
                    BEGIN
                      XLF;
                      X('Message contains '+IntToStr(ChSize)+' line');
                      IF ChSize <> 1 THEN X('s');
                      XLn('.');
                    END;
                    XLF;
                    IF ChAuto = 'E' THEN AddAgain := NoAdd;
                    AddDone := TRUE;
                  END
                  ELSE
                  BEGIN
                    ChSize := ChSize + 1;
                    EditBuffer[ChSize] := ChLine;
                    TrackBS[ChSize]    := BSCntr;
                    TrackIT[ChSize]    := InputTime;
                    LenCnt := LenCnt + LENGTH(ChLine);
                    IF ChSize = (MaxMsgLen - 5) THEN XLn('"FIVE LINES LEFT"');
                  END;
                  IF ChSize = MaxMsgLen THEN AddDone := TRUE;
                UNTIL AddDone;
              END; { Msg not full }
            END; { 'A' }
      'C' : BEGIN
              ChPtr := GetInt('Change which line?  ');
              IF (ChPtr > 0) AND (ChPtr <= ChSize) THEN
              BEGIN
                X('Change what? ');
                ChFrom := GetInputLn;
                IF LENGTH(ChFrom) <> 0 THEN
                BEGIN
                  ChSpot := POS(ChFrom,EditBuffer[ChPtr]);
                  IF ChSpot = 0
                  THEN XLn('Not found.')
                  ELSE
                  BEGIN
                    X('Change it to what? ');
                    ChTo := GetInputLn;
                    DELETE(EditBuffer[ChPtr],ChSpot,LENGTH(ChFrom));
                    INSERT(ChTo,EditBuffer[ChPtr],ChSpot);
                  END; { Found from }
                END; { Valid from }
              END; { Valid line }
            END; { C proc }
      'D' : BEGIN
              ChPtr := GetInt('Delete which line?  ');
              IF (ChPtr > 0) AND (ChPtr <= ChSize) THEN
              BEGIN
                WHILE ChPtr < ChSize DO
                BEGIN
                  EditBuffer[ChPtr] := EditBuffer[ChPtr + 1];
                  TrackBS[ChPtr]    := TrackBS[ChPtr + 1];
                  TrackIT[ChPtr]    := TrackIT[ChPtr + 1];
                  ChPtr := ChPtr + 1;
                END;
                ChSize := ChSize - 1;
              END
              ELSE XLn('Line '+IntToStr(ChPtr)+' not found.');
            END;
      'E' : ChAuto := '%';
      'F' : BEGIN
              ChFound := FALSE;
              X('Find what?  ');
              ChFrom := GetInputLn; XLF;
              IF LENGTH(ChFrom) <> 0 THEN
              BEGIN
                ChPtr := 1;
                REPEAT
                  IF POS(ChFrom,EditBuffer[ChPtr]) > 0
                  THEN
                  BEGIN
                    ChFound := TRUE;
                    XLn(Fmt(IntToStr(ChPtr),Left,3)+EditBuffer[ChPtr]);
                  END;
                  ChPtr := ChPtr + 1;
                UNTIL CharDuringO OR (ChPtr > ChSize);
                IF NOT ChFound THEN XLn('Can''t find that.');
              END;
            END;
      'I' : BEGIN
              IF ChSize < MaxMsgLen THEN
              BEGIN
                ChPtr := GetInt('Insert after which line?  '); XLF;
                IF (ChPtr > -1) AND (ChPtr <= ChSize) THEN
                IF ChPtr < ChSize THEN
                BEGIN
                  FOR ChExp := ChSize DOWNTO ChPtr + 1 DO
                  BEGIN
                    EditBuffer[ChExp+1] := EditBuffer[ChExp];
                    TrackBS[ChExp+1]    := TrackBS[ChExp];
                    TrackIT[ChExp+1]    := TrackIT[ChExp];
                  END;
                END;
                ChSize := ChSize + 1;
                XLn('Enter the text of your new line...');
                EditBuffer[ChPtr + 1] := GetInputLn;
              END
              ELSE XLn('Message is full -- can''t insert.');
            END;
      'L' : BEGIN
              ChPtr := GetInt('List from which line number?  '); XLF;
              IF ChPtr =  0 THEN ChPtr := 1;
              IF ChSize = 0
              THEN XLn('Nothing to list.')
              ELSE
              BEGIN
                IF ChPtr > ChSize THEN ChPtr := ChSize;
                CharDuringO := FALSE;
                REPEAT
                  X(Fmt(IntToStr(ChPtr),Right,2)+' ');
                  XLn(EditBuffer[ChPtr]);
                  ChPtr := ChPtr + 1;
                UNTIL CharDuringO OR (ChPtr > ChSize);
              END;
            END;
      'S' : BEGIN
              IF ChSize = 0
              THEN XLn('Nothing to send.')
              ELSE
              BEGIN
                IF EditBuffer[1] = '(SUMMARY LINE)' THEN
                BEGIN
                  XLn('Summarize your message (1 line):');
                  X('> ');
                  EditBuffer[1] := GetInputLn;
                  TrackBS[1]    := BSCntr;
                  TrackIT[1]    := InputTime;
                  XLF;
                  IF (LENGTH(EditBuffer[1]) < 10) AND (ChSize > 5)
                  THEN XLn('Not much of a summary...'+LF);
                END;
                ChDone := TRUE;
                Editor := 'S';
                {----- Analyze typing -----}
                IF (ChSize > 0) AND Added THEN
                BEGIN
                  AvgBS  := 0;
                  AvgIT  := 0;
                  BlCntr := 0;
                  HighIT := 0.0;
                  LowIT  := 10000.0;
                  FOR ChSpot := 1 TO ChSize DO
                  BEGIN
                    IF (LENGTH(EditBuffer[ChSpot]) < 5)
                    OR (TrackIT[ChSpot] < 1)
                    THEN BlCntr := BlCntr + 1
                    ELSE
                    BEGIN
                      {----- Calc backspacing -----}
                      TempBS := TrackBS[ChSpot] / (LENGTH(EditBuffer[ChSpot]));
                      AvgBS := AvgBS + TempBS;
                      {---- Calc CPS for this line -----}
                      TempIT := LENGTH(EditBuffer[ChSpot]) / TrackIT[ChSpot];
                      AvgIT := AvgIT + TempIT;
                      IF HighIT < TempIT THEN HighIT := TempIT;
                      IF LowIT  > TempIT THEN LowIT  := TempIT;
                    END;
                  END;
                  IF BlCntr < ChSize THEN
                  BEGIN
                    AvgBS  := AvgBS / (ChSize-BlCntr) * 100;
                    AvgIT  := AvgIT / (ChSize-BlCntr) * 12;
                    HighIT := HighIT * 12;
                    LowIT  := LowIT  * 12;
                    SpdRng := HighIT - LowIT;
                    WRITELN(#17#16+' ╓──Low WPM──╥─High  WPM─╥──Avg WPM──╥─Spd Range─╥─BS Factor─╖');
                    WRITE(#17#16+' ╙──',LowIT:5:0,' ───╨──',HighIT:5:0,' ───╨──',AvgIT:5:0);
                    WRITELN(' ───╨──',SpdRng:5:0,' ───╨──',AvgBS:5:0,' ───╜');
                    WRITELN;
                  END;  { Enough to analyze }
                END;  { Worth analyzing }
                {----- Save the message -----}
                X('Concentrate...');
                REWRITE(TxtFile); X('.');
                {$I-}
                ChPtr := 0;
                REPEAT
                  ChPtr := ChPtr + 1;
                  WRITELN(TxtFile,Compress(EditBuffer[ChPtr]));
                  IF ((ChPtr DIV 3) * 3) = ChPtr THEN X('.');
                UNTIL (ChPtr = ChSize) OR (IORESULT <> 0);
                IF IORESULT <> 0 THEN
                BEGIN
                  SysLog('W','Message disk error, IORESULT = '+IntToStr(IORESULT));
                  XLn('Disk space overflow!');
                  SysFail := TRUE;
                END;
                {$I+}
              END;
              CLOSE(TxtFile);
              IF EType = 'C' THEN XLF;
            END;
      'Q' : BEGIN
              IF EType = 'C'
              THEN XLn('Cancel all changes?')
              ELSE XLn('Cancel this message?');
              IF Yes THEN
              BEGIN
                ChDone := TRUE;
                Editor := 'Q';
                CLOSE(TxtFile);
              END;
            END;
      'W' : BEGIN
              Wrapping := NOT Wrapping;
              X('Word-wrapping text-entry ');
              IF Wrapping
              THEN XLn('turned on.')
              ELSE XLn('turned off.');
            END;
            ELSE XLn('Type  ?  for help.');
    END;  { Of CASE }
  UNTIL ChDone;
END;

FUNCTION XMsg : SFType;
VAR
  NiceLine : STRING[12];
  XMTime   : STRING[12];
  ScanCode : SFType;
BEGIN
  TuneMatch := TRUE;
  ScanCode  := Okay;
  {----- If we're tuned, check if this file is to print -----}
  IF LENGTH(TuneString) > 0 THEN
  BEGIN
    TuneMatch := FALSE;
    SuppressOut := TRUE;
    ScanCode := XFile(MsgFile(MsgPtr));
    SuppressOut := FALSE;
    IF TuneMatch
    THEN XLF
    ELSE
    BEGIN
      X(ShowDate(MsgDates[MsgPtr],MsgMints[MsgPtr])+' ');
      IF WHEREX + 11 > Width THEN XLF;
    END;
  END;
  {----- Print the header, then the file -----}
  IF TuneMatch AND (ScanCode <> Quit) THEN
  BEGIN
    NiceLine := '------------';
    CharDuringO := FALSE;
    XMTime := ShowDate(MsgDates[MsgPtr],MsgMints[MsgPtr]);
    XLF;
    XLn(COPY(NiceLine,1,LENGTH(XMTime)));
    XLn(XMTime + '  '+Upper(MsgPosters[MsgPtr]));
    X(COPY(NiceLine,1,LENGTH(XMTime)));
    IF ReadBand <> '*'
    THEN XLF
    ELSE XLn('  '+XlateBoard(MsgBands[MsgPtr]));
    XLF;
    XMsg := XFile(MsgFile(MsgPtr));
  END;
END;

FUNCTION ReadBoard(RBChar : CHAR) : BOOLEAN;
VAR
  RBStat   : SFType;
  GotMsgs  : BOOLEAN;
BEGIN
  ReadBand := RBChar;
  GotMsgs  := FALSE;
  GetReadDate(ReadBand);
  MsgPtr  := NextMsg;
  RBStat  := Okay;
  IF ReadBand <> '*' THEN
  BEGIN
    REPEAT
      IF Before(ReadDate, ReadMint, MsgDates[MsgPtr], MsgMints[MsgPtr])
      AND (MsgBands[MsgPtr] = ReadBand)
      AND (InFocus(MsgPosters[MsgPtr]))
      THEN GotMsgs := TRUE
      ELSE MsgPtr := MsgNumAfter(MsgPtr);
    UNTIL GotMsgs OR (MsgPtr = NextMsg);
  END
  ELSE GotMsgs := TRUE;
  IF NOT GotMsgs
  THEN ReadBoard := FALSE
  ELSE
  BEGIN
    Multiple := TRUE;
    IF ReadBand <> '*' THEN
    BEGIN
      Explained := FALSE;
      ExplainKeys;
      XLn('Tuning in the telepathic band used by');
      XLn('the ' + XlateBoard(ReadBand) + '.');
    END;
    REPEAT
      IF Before(ReadDate, ReadMint, MsgDates[MsgPtr], MsgMints[MsgPtr])
      AND ( (MsgBands[MsgPtr] = ReadBand) OR (ReadBand = '*') )
      AND (InFocus(MsgPosters[MsgPtr]))
      THEN RBStat := XMsg;
      MsgPtr := MsgNumAfter(MsgPtr);
    UNTIL (MsgPtr = NextMsg) OR (RBStat = Quit);
    IF (RBStat = Quit) AND (RBChar = 'G')
    THEN Postings := Postings - RANDOM(2);
    ReadBoard := TRUE;
    Multiple  := FALSE;
    IF (NOT TuneMatch) AND (LENGTH(TuneString) > 0) THEN XLF;
  END;
END;

PROCEDURE WriteBoard(WBChar : CHAR);
VAR
  AnCase   : INTEGER;
  AnComma  : INTEGER;
  AnCont   : INTEGER;
  AnOther  : INTEGER;
  AnPeriod : INTEGER;
  AnSpace  : INTEGER;
  Private  : BOOLEAN;
  Score    : INTEGER;
  WBCnt    : INTEGER;
  WBFile   : FNType;
  WBLine   : Line;
  WBPos    : INTEGER;
  WBStat   : CHAR;
BEGIN
  Private := FALSE;
  LenCnt := 0;
  XLn('Sending on the telepathic band used by');
  XLn('the ' + XlateBoard(WBChar)+'.');
  EditBuffer[1] := '(SUMMARY LINE)';
  EditBuffer[2] := '';
  ChSize := 2;
  WBFile := MsgFile(NextMsg);
  ASSIGN(TxtFile,WBFile);
  WBStat := Editor('S');
  IF (ChSize <= 2) OR (WBStat = 'Q')
  THEN XLn('Nothing sent.')
  ELSE
  BEGIN
    MsgBands[NextMsg]   := WBChar;     MsgTimesRec.MsgBand    := WBChar;
    MsgDates[NextMsg]   := Date;       MsgTimesRec.Date_Added := Date;
    MsgMints[NextMsg]   := Mint;       MsgTimesRec.Mint_Added := Mint;
    MsgPosters[NextMsg] := UserName;   MsgTimesRec.Poster     := UserName;
    X('.');  SEEK(MsgTimesFile,NextMsg-1);  { First Component is 0 }
    X('.');  WRITE(MsgTimesFile,MsgTimesRec);
    NextMsg := MsgNumAfter(NextMsg);
    X('.');  RESET(NextMsgFile);
    X('.');  WRITE(NextMsgFile,NextMsg);
    XLn(' ['+ShowDate(Date,Mint)+']');
    XLF;
    {--- Analyze message for content ---}
    IF Level = 0
    THEN Postings := Postings + 1
    ELSE
    BEGIN
      AnCase   := 0;
      AnComma  := 0;
      AnCont   := 0;
      AnOther  := 0;
      AnPeriod := 0;
      AnSpace  := 0;
      X('"HMM');
      FOR WBCnt := 1 TO ChSize DO
      BEGIN
        IF WBCnt DIV 6 * 6 = WBCnt THEN X('M');
        WBLine := Upper(EditBuffer[WBCnt]);
        {----- High-content indicators -----}
        IF POS( ' BUT ',WBLine) > 0 THEN AnCont   := AnCont + 2; { but }
        IF POS( 'N''T', WBLine) > 0 THEN AnCont   := AnCont + 1; { can't etc. }
        IF POS( 'OULD', WBLine) > 0 THEN AnCont   := AnCont + 2; { would could should }
        IF POS( 'IF Y', WBLine) > 0 THEN AnCont   := AnCont + 2; { if you }
        IF POS(' NOT ', WBLine) > 0 THEN AnCont   := AnCont + 2; { assertive }
        IF POS( '''S',  WBLine) > 0 THEN AnOther  := AnOther + 1;
        IF POS( '?',    WBLine) > 0 THEN AnOther  := AnOther + 1;
        IF POS( '(',    WBLine) > 0 THEN AnOther  := AnOther + 2;
        IF POS( '"',    WBLine) > 0 THEN AnOther  := AnOther + 2;
        {----- Garbage detectors -----}
        IF POS( '   ',  WBLine) > 0 THEN AnSpace  := AnSpace + 1;
        IF POS( '---',  WBLine) > 0 THEN AnOther  := AnOther - 2;
        {----- Punctuation -----}
        IF POS( ', ',   WBLine) > 0 THEN AnComma  := AnComma + 2;
        IF POS( '. ',   WBLine) > 0 THEN AnPeriod := AnPeriod + 1;
        IF POS( '.  ',  WBLine) > 0 THEN AnPeriod := AnPeriod + 2;
        IF POS( '-',    WBLine) > 0 THEN AnOther  := AnOther + 1;
        IF POS( ': ',   WBLine) > 0 THEN AnOther  := AnOther + 1;
        IF POS( '; ',   WBLine) > 0 THEN AnOther  := AnOther + 3;
        {----- "Noisey" indicators -----}
        IF LENGTH(WBLine) > 20
        THEN IF POS(' ',WBLine) = 0 THEN AnOther := AnOther - 1;
        IF AnCase = 0 THEN IF POS('e',EditBuffer[WBCnt]) > 0 THEN AnCase := 1;
        {----- Early-message downhills -----}
        IF WBCnt = 1 THEN
        BEGIN
          IF (POS('JUST ',WBLine) < 10)   { this is just }
          OR (POS('ONLY ',WBLine) < 10)   { this is only }
          THEN AnOther := AnOther - 1;
        END;
        IF WBCnt < 7 THEN
        BEGIN
          IF COPY(WBLine,1,2) = '<<' THEN Private  := TRUE;
          WBPos := POS('ESTEEM',WBLine) - POS('FOR',WBLine);
          IF (WBPos > 0) AND (WBPos <= 9) THEN AnOther := AnOther - 2;
          IF (POS('CK',WBLine) - 2) = POS('FU',WBLine) { Decorum, eh? }
          THEN AnCont  := AnCont - 1;
        END;
      END;
      {--- Reduce Content Scores ---}
      AnComma  := AnComma  DIV 2;
      AnCont   := AnCont   DIV 2;
      AnPeriod := AnPeriod DIV 3;
      {----- Restrict Content Scores -----}
      IF AnComma  > 2 THEN AnComma  := 2;
      IF AnCont   > 4 THEN AnCont   := 4;
      IF AnOther  > 8 THEN AnOther  := 8;
      IF AnPeriod > 2 THEN AnPeriod := 2;
      {----- Calculate Total Score -----}
      IF AnCase = 0 THEN AnCase := -1;
      Score := (LenCnt DIV 1200) + AnCase + AnComma + AnOther + AnPeriod + AnCont;
      IF LENGTH(EditBuffer[1]) < ChSize THEN Score := Score - 2;
      IF AnSpace > ChSize DIV 3 THEN Score := Score - 2;
      IF (LenCnt DIV ChSize) < 15 THEN Score := 0;
      IF Private THEN Score := Score - 3;
      {----- Deal with blabbermouths -----}
      NumSends := NumSends + 1;
      { Number of Sends    1  2  3  4  5  6 }
      { Score Adjustment   0  0  2  4  6  8 }
      IF NumSends > 2 THEN Score := Score - ((NumSends - 2) * 2);
      {--- Tell him about it ---}
      IF Score < 0 THEN Score := 0;
      XLn('."'+LF);
      CASE Score OF
        0..1 : BEGIN
                 XLn('TSOTL is annoyed by that message.');
                 IF NOT WizOp THEN
                 BEGIN
                   IF Level > 2 THEN
                   BEGIN
                     SetAltitude(Level - 2);
                     Level := Altitude;
                     XLN(LF+'"THIS IS YOUR NEW LEVEL!"');
                   END;
                   Postings := Postings - 1;
                   AscCnt := AscCnt + 3;
                   Pleaseable := FALSE;
                 END;
               END;
        2   : BEGIN
                 XLn('TSOTL is NOT impressed by that message.');
                 Postings := Postings - 1;
                AscCnt := AscCnt + 2;
               END;
        3   :  XLn('TSOTL says, "A LITTLE DISAPPOINTING."');
        4   :  XLn('TSOTL says, "NEARLY WORTH READING."');
        5   :  XLn('TSOTL found that almost interesting.');
        6..9 : BEGIN
                 XLn('TSOTL found that mildly interesting.');
                 Postings := Postings + 1;
               END;
        10..12:BEGIN
                 XLn('TSOTL thought that was quite good.');
                 Postings := Postings + 2;
                 AscCnt := AscCnt - 1;
               END;
        13..15:BEGIN
                 XLn('TSOTL liked that one.');
                 Postings := Postings + 3;
                 AscCnt := AscCnt - 2;
               END;
               ELSE
                 XLn('TSOTL liked that one very much.');
                 Postings := Postings + 3;
                 AscCnt := AscCnt - 3;
      END; { of CASE }
    END; { of > Alt 0 }
  END; { of something-sent }
END;