Unit Bull;



interface

{***************************************************************************}

{***************************************************************************}

uses

  Glob,

  BBSGlbls;



const

  BSALen = 25;   {* length of datum in a BSA File *}

  BullFileChildrenLines = 2;

  BullFileParentsLines  = 2;

  BullFileSubjectsLines = 3;



const

  BullTopSubjectStr = 'TOP LEVEL SUBJECT AREA  ';

  NextSubjFile = 'NextSubj.BBS';

  SABFileTopLine    = 'SUBJECT AREA BULLETINS...';

  SACFileTopLine    = 'CHILD SUBJECT AREAS......';

  SAPFileTopLine    = 'PARENT SUBJECT AREAS.....';





var

  BullAreaDir : array[0..NumPorts] of W10k;

  BullAreaID  : array[0..NumPorts] of W10k;

  BullAreaSubj: array[0..NumPorts] of string;



Function  BullCountBulls(SA: W10k): W10k;

Function  BullCountChildren(SA: W10k): W10k;

Function  BullCountParents(SA: W10k): W10k;

Function  BullFile(BD,SA,BullPicked:integer;var BullFileStr:string): boolean;

Function  BullHeaderAuthor(BullFileStr: string; var Author: string): boolean;

Function  BullHeaderSubject(BullFileStr: string;var Subject:string): boolean;

Function  BullID(BullIDStr: string): integer;

Function  BullListBulls(StartBull, StopBull: integer): W10k;

Function  BullListChildren(BD, SA: W10k): W10k;

Function  BullListParents(BD, SA: W10k): W10k;

Procedure BullMenu;

Function  BullNextBulletin: string;

Function  BullNextSubjectArea: W10k;

Function  BullReadFile: string;

Procedure BullReadMark(BullNum: W10k);

Function  BullSABFile(BD, SA: W10k): string;

Function  BullSACFile(BD, SA: W10k): string;

Function  BullSADFile(ChildStr: string): string;

Function  BullSAPFile(BD, SA: W10k): string;

Function  BullSAConnect(ParentStr, ChildStr: string): boolean;

Function  BullSADisconnect(ParentStr, ChildStr: string): boolean;

Function  BullSAFileSearch(FileStr,SearchStr: string;Var Index:W10k):boolean;

Function  BullsPosted: integer;

Procedure BullSwitchSubjectArea(NewSubjectArea: integer);

Procedure SubjAreaDataChange(SubjAreaFile: string);

Function  SubjAreaFlip(BD, SA, ChildPicked: integer): boolean;

Function  SubjAreaMarkNext: boolean;

Function  SubjAreaStat(ChildStr: string): char;



implementation

{***************************************************************************}

{***************************************************************************}

uses

  BBSFuncs,

  Bits,

  Data,

  Disk,

  IOPorts, {* SayL *}

  Misc;



Function BullCountBulls(SA: W10k): W10k;

{***************************************************************************}

var

  Temp: integer;

  BullSABFileStr: string;

begin

  BullSABFileStr := BullSABFile(BullAreaDir[Port], SA);

  Temp := (FileSizeAny(BullSABFileStr) div (BSALen + 2)) - 1;

  if Temp = -1 then

    Temp := 0;

  BullCountBulls := Temp;

end;



Function BullCountChildren(SA: W10k): W10k;

{***************************************************************************}

var

  Temp: integer;

  BullSACFileStr: string;

begin

  BullSACFileStr := BullSACFile(BullAreaDir[Port], SA);

  Temp := (FileSizeAny(BullSACFileStr) div (BSALen + 2)) - 1;

  if Temp = -1 then

    Temp := 0;

  BullCountChildren := Temp;

end;



Function BullCountParents(SA: W10k): W10k;

{***************************************************************************}

var

  Temp: integer;

  BullSAPFileStr: string;

begin

  BullSAPFileStr := BullSAPFile(BullAreaDir[Port], SA);

  Temp := (FileSizeAny(BullSAPFileStr) div (BSALen + 2)) - 1;

  if Temp = -1 then

    Temp := 0;

  BullCountParents := Temp;

end;



Function BullFile(BD,SA,BullPicked:integer;var BullFileStr: string): boolean;

{***************************************************************************}

var

  BullIDStr: string;

  BullSABFileStr: string;

  Temp: boolean;

begin

  inc(BullPicked);

  BullSABFileStr := BullSABFile(BD, SA);

  Temp := FileLine('R', BullSABFileStr, BullPicked, BullIDStr);

  if Temp then

    BullFileStr := UsersDir + '\' + BullIDStr;

  BullFile := Temp;

end;



Function BullID(BullIDStr: string): integer;

{***************************************************************************}

begin

  BullID := IntStr(copy(BullIDStr, length(BullIDStr)-7, 4));

end;



Function BullHeaderAuthor(BullFileStr: string; var Author: string): boolean;

{***************************************************************************}

var

  Temp: boolean;

begin

  Temp := FileLine('R', BullFileStr, 2, Author);

  Author := copy(Author, 11, length(Author) - 10);

  BullHeaderAuthor := Temp;

end;



Function BullHeaderSubject(BullFileStr: string; var Subject:string): boolean;

{***************************************************************************}

var

  Temp: boolean;

begin

  Temp := Disk.LineRead(BullFileStr, 1, Subject);

  if Temp then

    Subject := copy(Subject, 11, length(Subject) - 10);

  BullHeaderSubject := Temp;

end;



Function  BullListBulls(StartBull, StopBull: integer): W10k;

{***************************************************************************}

var

  alpha: W10k;

  BB:  text;

  BullStr: string;

  BullReadChar: char;

  BullID: W10k;

  BullReadBool: boolean;

  BullSABFileStr: string;

  Subject: string;

begin

  BullSABFileStr := BullSABFile(BullAreaDir[Port], BullAreaID[Port]);

  if Disk.AssignReset(BB, BullSABFileStr) then

    begin

{$I-}

      if StartBull < 1 then

        StartBull := 1;

      for alpha := 0 to StartBull - 1 do

        readln(BB);

      while not(EOF(BB)) and (alpha < StopBull) do

        begin

          Inc(alpha);

          ReadLn(BB, BullStr);

          BullStr := UsersDir + '\' + BullStr;

          BullReadChar := ' ';

          BullID := IntStr(copy(BullStr, length(BullStr) - 7, 4));

          if FileDataBool('R',BullReadFile,BullID-1,BullReadBool) then

            if BullReadBool then

              BullReadChar := 'R';

          if BullHeaderSubject(BullStr, Subject) then

            SayL(StrInt(alpha)+')'+ BullReadChar + ' ' + Subject)

          else

            SayL('X)  Deleted bulletin.');

        end;

      Close(BB);

{$I+}

    end;

  if alpha = 0 then

    SayL('There are no bulletin subject areas under this one.');

  BullListBulls := alpha;

end;



Function  BullListChildren(BD, SA: W10k): W10k;

{***************************************************************************}

var

  alpha: W10k;

  BB,

  BC: text;

  BullStr: string;

  ChildStr: string;

begin

  alpha := 0;

  if Disk.AssignReset(BC, BullSACFile(BD, SA)) then

    begin

{$I-}

      ReadLn(BC, DumStr);

      while not(EOF(BC)) do

        begin

          inc(alpha);

          ReadLn(BC, ChildStr);

          DumBool := Disk.AssignReset(BB, UsersDir + '\' + ChildStr);

          ReadLn(BB, BullStr);

          Close(BB);

          SayL(StrInt(alpha) + ')' + SubjAreaStat(ChildStr) + ' ' + BullStr);

        end;

      Close(BC);

{$I+}

    end;

  if alpha = 0 then

    SayL('There are no bulletin subject areas below this one.');

  BullListChildren := alpha;

end;





Function  BullListParents(BD, SA: W10k): W10k;

{***************************************************************************}

var

  alpha: W10k;

  BB,

  BP: text;

  BullStr: string;

begin

  alpha := 0;

  if Disk.AssignReset(BP, BullSAPFile(BD, SA)) then

    begin

{$I-}

      ReadLn(BP, BullStr);

      while not(EOF(BP)) do

        begin

          inc(alpha);

          ReadLn(BP, BullStr);

          Assign(BB, UsersDir + '\' + BullStr);

          Reset(BB);

          if IOResult = 2 then

            BullStr := BullTopSubjectStr

          else

            begin

              ReadLn(BB, BullStr);

              Close(BB);

            end;

          SayL(StrInt(alpha)+') '+BullStr);

        end;

      Close(BP);

{$I+}

    end;

  if alpha = 0 then

    SayL('There are no bulletin subject areas above this one.');

  BullListParents := alpha;

end;



Procedure BullMenu;

{***************************************************************************}

begin

  SayL('');

  SayL('                              BULLETIN HELP MENU');

  SayL('');

  SayL(

    'SUBJECT AREA PATH Commands              BULLETIN Commands');

  SayL(

    '--------------------------------------  --------------------------------------');

  Say ('D - Down a subject area path            ');

  SayL('N - locate and read the Next ');

  Say ('U - Up a subject area path              ');

  SayL('    unread bulletin anywhere');

  Say ('A - Add a subject area                  ');

  SayL('R - Read a bulletin');

  Say ('B - Break off a subject area            ');

  SayL('P - Post/write a bulletin');

  Say ('S - Shut/open a subject area to the     ');

{*  Konnect this subject area to        ');

*}

  SayL('E - Edit a bulletin');

{*  Say ('    another subject area                ');

*}

  Say ('    view of the Next search command     ');

  SayL('T - Trash/erase a bulletin');



{*  SayL('X ----- Cross-Reference a bulletin to another subject area');

*}

  SayL(

    '--------------------------------------  --------------------------------------');

  SayL('C ----- Chat/Comment to the SYSOP');

  SayL('G ----- Goodbye (log off)');

  SayL('H ----- Help (this menu)');

  SayL('Q ----- Quit back to the menu that calls this one');

end;



Function BullNextBulletin: string;

{***************************************************************************}

var

  MaxBltn: integer;

  MaxBltnStr: string;

begin

  MaxBltn := BullsPosted;

  MaxBltn := MaxBltn + 1;

  MaxBltnStr := StrInt(MaxBltn);

  DumBool := FileLine('O', StatFile, 1, MaxBltnStr);

  BullNextBulletin := copy(UserDir(UserID[Port]), 14, 12)

    + '\' + 'BULL' + StrIntZer(MaxBltn, 4) + '.BBS';

end;



Function BullNextSubjectArea: W10k;

{***************************************************************************}

var

  MaxSubjArea: integer;

  MaxSubjAreaStr: string;

begin

  if not(FileExists(StatFile)) then

    begin

      DumBool := FileCreate(StatFile);

      MaxSubjAreaStr := '1';

      DumBool := FileLine('O', StatFile, 2, MaxSubjAreaStr);

      BullNextSubjectArea := 1;

      exit;

    end;

  if FileLine('R', StatFile, 2, MaxSubjAreaStr) then

    begin

      if MaxSubjAreaStr = '' then

        MaxSubjAreaStr := '0';

      MaxSubjArea := IntStr(MaxSubjAreaStr) + 1;

      MaxSubjAreaStr := StrInt(MaxSubjArea);

      DumBool := FileLine('O', StatFile, 2, MaxSubjAreaStr);

    end;

  BullNextSubjectArea := MaxSubjArea;

end;



Function BullReadFile: string;

{***************************************************************************}

begin

  BullReadFile := UserDir(UserID[Port]) + '\BULLREAD.BBS';

end;



Procedure BullReadMark(BullNum: W10k);

{***************************************************************************}

var

  Mark: boolean;

begin

  Mark := true;

  DumBool := FileDataBool('W', BullReadFile, BullNum - 1, Mark);

end;



Function BullSABFile(BD, SA: W10k): string;

{***************************************************************************}

var

  Temp: string;

begin

  Temp := UsersDir + '\' + copy(UserDir(BD), 14, 12)

    + '\BSAB' + StrIntZer(SA, 4) + '.BBS';

  BullSABFile := Temp;

end;



Function BullSACFile(BD, SA: W10k): string;

{***************************************************************************}

var

  Temp: string;

begin

  Temp := UsersDir + '\' + copy(UserDir(BD), 14, 12)

    + '\BSAC' + StrIntZer(SA, 4) + '.BBS';

  BullSACFile := Temp;

end;



Function  BullSADFile(ChildStr: string): string;

{***************************************************************************}

{* Data file

{***************************************************************************}

var

  Temp: string;

begin

  Temp :=  UsersDir + '\' + copy(ChildStr, 1, length(ChildStr) - 9) + 'D'

      + copy(ChildStr, length(ChildStr) - 7, 7);

  BullSADFile := Temp;

end;



Function BullSAPFile(BD, SA: W10k): string;

{***************************************************************************}

begin

  BullSAPFile := UsersDir + '\' + copy(UserDir(BD), 14, 12)

    + '\BSAP' + StrIntZer(SA, 4) + '.BBS';

end;



Function  BullSAConnect(ParentStr, ChildStr: string): boolean;

{***************************************************************************}

var

  Temp: boolean;

  B: text;

  BullStr: string;

begin

  Temp := true;

{$I-}

  Assign(B, ParentStr);

  if FileSizeAny(ParentStr) < 1 then

    begin

      Rewrite(B);

      writeln(B, Bull.SAPFileTopLine);

      Close(B);

    end;

  Append(B);

  BullStr := BullSABFile(BullAreaDir[Port], BullAreaID[Port]);

  BullStr := copy(BullStr, length(BullStr) - 24, 25);

  writeln(B, BullStr);

  close(B);

  if IOResult <> 0 then

    Temp := false;

  if Temp then

    begin

      Assign(B, ChildStr);

      if FileSizeAny(ChildStr) < 1  then

        begin

          Rewrite(B);

          writeln(B, Bull.SACFileTopLine);

          Close(B);

        end;

      Append(B);

      BullStr := BullSABFile(

        UserID[Port], IntStr(copy(ParentStr,length(ParentStr)-7,4)));

      BullStr := copy(BullStr, length(BullStr) - 24, 25);

      writeln(B, BullStr);

      close(B);

      if IOResult <> 0 then

        Temp := false;

    end;

  BullSAConnect := Temp;

{$I+}

end;



Function  BullSADisconnect(ParentStr, ChildStr: string): boolean;

{***************************************************************************}

var

  Temp: boolean;

  Index: W10k;

begin

  Temp := BullSAFileSearch(ParentStr, ChildStr, Index);

  if Temp then

    Temp := FileLine('D', ParentStr, Index, DumStr);

  if Temp then

    Temp := BullSAFileSearch(ChildStr, ParentStr, Index);

  if Temp then

    Temp := FileLine('D', ChildStr, Index, DumStr);

  BullSADisconnect := Temp;

end;



Function  BullSAFileExistMake(FileStr: string): boolean;

{***************************************************************************}

var

  BF: text;

  IOTest: integer;

begin

  Assign(BF, FileStr);

{$I-}

  Reset(BF);

  IOTest := IOResult;

  case IOTest of

    2: Rewrite(BF);

    3: DumBool := DirMake(copy(FileStr, 1, length(FileStr) - 13));

  end; {case}

  Close(BF);

{$I+}

  BullSAFileExistMake := IOResult = 0;

end;



Function BullSAFileSearch(FileStr, SearchStr: string;Var Index:W10k):boolean;

{***************************************************************************}

var

  TempIndex: integer;

  F: text;

  CompareStr: string;

begin

  Assign(F, FileStr);

  {$I-}

  Reset(F);

  CompareStr := '';

  TempIndex := -1;

  while not(EOF(F)) and (CompareStr <> SearchStr) do

    begin

      ReadLn(F, CompareStr);

      Inc(TempIndex);

    end;

  Close(F);

  {$I+}

  if CompareStr = SearchStr then

    begin

      Index := TempIndex;

      BullSAFileSearch := true;

    end

  else

    BullSAFileSearch := false;

end;



Function BullsPosted: integer;

{***************************************************************************}

var

  Temp: integer;

  TempStr: string;

begin

  Temp := 0;

  if FileLine('R', StatFile, 1, TempStr) then

    Temp := IntStr(TempStr);

  BullsPosted := Temp;

end;



Procedure BullSwitchSubjectArea(NewSubjectArea: integer);

{***************************************************************************}

var

  BullString: string;

  Found: boolean;

  NewSubj: string;

begin

  if NewSubjectArea = 0 then {* Abort *}

    exit;

  if NewSubjectArea > 0 then

    inc(NewSubjectArea)

  else

    dec(NewSubjectArea);

  Found := false;

  if NewSubjectArea < 0 then

    Found := FileLine('R', BullSAPFile(BullAreaDir[Port], BullAreaID[Port]),

        NewSubjectArea*(-1), BullString)

  else

    Found := FileLine('R', BullSACFile(BullAreaDir[Port], BullAreaID[Port]),

        NewSubjectArea, BullString);

  if Found then

    SubjAreaDataChange(UsersDir + '\' + BullString);

end;



Procedure SubjAreaDataChange(SubjAreaFile: string);

{***************************************************************************}

var

  NewSubj: string;

begin

  BullAreaID[Port] := IntStr(copy(SubjAreaFile, length(SubjAreaFile) - 7, 4));

  BullAreaDir[Port] := IntStr(copy(SubjAreaFile, length(SubjAreaFile)-20, 4));

  if BullAreaID[Port] = 0 then

    BullAreaSubj[Port] := BullTopSubjectStr

  else

    if FileLine('R', SubjAreaFile, 1, NewSubj) then

      BullAreaSubj[Port] := NewSubj

    else

      BullAreaSubj[Port] := 'UNKNOWN SUBJECT AREA';

end;



Function  SubjAreaFlip(BD, SA, ChildPicked: integer): boolean;

{***************************************************************************}

var

  BullSACFileStr: string;

  BullSADFileStr: string;

  ChildStr: string;

  StatusByte: byte;

  Temp: boolean;

begin

  BullSACFileStr := BullSACFile(BD, SA);

  ChildPicked := ChildPicked + 1;

  Temp := FileLine('R', BullSACFileStr, ChildPicked, ChildStr);

  BullSADFileStr := BullSADFile(ChildStr);

  if not(Disk.DataByte('R', BullSADFileStr, UserID[Port], StatusByte)) then

    StatusByte := 0;

  StatusByte := Bits.Flip(StatusByte, 0);

  Temp := Disk.DataByte('W', BullSADFileStr, UserID[Port], StatusByte);

  SubjAreaFlip := Temp;

end;



Function  SubjAreaStat(ChildStr: string): char;

{***************************************************************************}

var

  BullSADFileStr: string;

  StatusByte: byte;

  Temp: char;

begin

  Temp := ' ';

  BullSADFileStr := BullSADFile(ChildStr);

  if Disk.DataByte('R', BullSADFileStr, UserID[Port], StatusByte) then

    if Bits.IsHigh(StatusByte, 0) then

      Temp := 'S';

  SubjAreaStat := Temp;

end;



Function SubjAreaMarkNext: boolean;

{***************************************************************************}

var

  Line: W10k;

  LineFound: boolean;

  Mark: boolean;

  Marked: boolean;

  NewID: integer;

  NewSA: string;

  WasRead: boolean;

begin

  Line := 2;

  Marked := true;

  repeat

    LineFound := Disk.LineRead(BullSACFile(BullAreaDir[Port],

      BullAreaID[Port]), Line, NewSA);

    if LineFound and (SubjAreaStat(NewSA) <> 'S') then

      begin

        NewID := IntStr(copy(NewSA, length(NewSA) - 7, 4));

        NewSA := UsersDir + '\' + NewSA;

        WasRead := FileDataBool('R', UserDir(UserID[Port]) + '\'

          + Bull.NextSubjFile, NewID, Marked);

        if not(WasRead) or (WasRead and not(Marked)) then

          begin

            SubjAreaDataChange(NewSA);

            SubjAreaMarkNext := true;

            exit;

          end;

      end;

    inc(Line);

  until not(LineFound);

  Mark := true;

  if not(FileDataBool('W', UserDir(UserID[Port]) + '\'

    + Bull.NextSubjFile, BullAreaID[Port], Mark)) then

      begin

        SubjAreaMarkNext := false;

        exit;

      end;

  if BullAreaID[Port] = 0 then

    begin

      SubjAreaMarkNext := false;

      exit;

    end;

  if FileLine('R', BullSAPFile(BullAreaDir[Port], BullAreaID[Port]),

    1, NewSA) then

      begin

        SubjAreaDataChange(NewSA);

        SubjAreaMarkNext := true;

        exit;

      end;

  SubjAreaMarkNext := false;

end;



{***************************************************************************}

{***************************************************************************}

{***************************************************************************}

begin

end.