/************************************************************/
/*           Spot-Area Statistics Generator                 */
/*          $VER: AreaStat.spot 1.1 (5.8.93)                */
/*                                                          */
/* Author: Brian Jacobsen   FidoNet: 2:230/311.17           */
/************************************************************/

address 'SPOT'
signal on syntax
signal on failure
options results

VER = "1.1"											/* version               */
cr = '0d'X											/* Carriage return       */

UserNames. = ""										/* Userlist array        */
UserNames.0 = 0										/* Number of users       */
UserCounter = 0										/* Temp counter          */
Writers. = 0										/* User Written array    */
TotalNumberWriters = 0								/* Total writers counter */
Receivers. = 0										/* User Received array   */
TotalNumberReceivers = 0							/* Total receiver counter*/

SubjectCounter = 0									/* Temp counter          */
Subjects. = ""										/* Subjects array        */
Subjects.0 = 0										/* Number of Subjects    */
SubjectsC. = 0										/* Subject message array */

TopTen = 0											/* BOOL indicator        */
AllMessages = 0										/* BOOL All Messages     */
SelectedMessages = 0								/* Number of selected mes*/
BoxStr = '+----------------------------------------------------------------------+'


'lockgui'											/* Lock Spot's GUI       */

'requestresponse TITLE "Please choose..." PROMPT "Do you want the TopTen chart only'cr'or the complete statistics for this area?" GADGETS "Top10|Complete"'
IF rc ~= 0 THEN TopTen = 1

'requestresponse TITLE "Please choose..." PROMPT "Do you want stats for all messages'cr'or do you want select messages by date?" GADGETS "Date|All"'
IF rc = 0 THEN
	AllMessages = 1
ELSE												/* Get dates             */
	DO
		CALL SetupDates								/* Routine to get dates  */
		day = SUBSTR(StartDate,7,2)
		month = SUBSTR(StartDate,5,2)
		year = SUBSTR(StartDate,1,4)
		DispStartDate = day'.'month'.'year			/* For display in stats  */

		day = SUBSTR(StopDate,7,2)
		month = SUBSTR(StopDate,5,2)
		year = SUBSTR(StopDate,1,4)
		DispStopDate = day'.'month'.'year			/* For display in stats  */
	END

'messagelist'										/* Goto messagelist      */
'gotomessage 2'										/* Gotomessage 1 doesn't */
'prevmessage'										/* work properly in Spot1.1 */

StartTime = TIME('R')								/* Start time measure    */
'progressopen TITLE "Reading area..."'				/* Open progress window  */
preq = result

'getnummsgs'										/* Get total number of   */
TotalMessages=result								/* messages in area.     */
IF TotalMessages = 0 THEN signal exit

/* Now we start examining all messages in current area. */

DO count = 1 to TotalMessages
	'progressupdate' preq count TotalMessages		/* Update progress indicator */
	IF rc = 5 THEN signal exit

	'gotomessage' count								/* goto next message     */

	IF AllMessages = 0 THEN							/* Date stat selected */
		DO
			'getdatewritten'
			Parse VAR result day '.' month '.' year
			day = RIGHT(day,2,'0')
			month = RIGHT(month,2,'0')
			DateWritten = year||month||day
			IF DateWritten < StartDate | DateWritten > StopDate THEN
				ITERATE
		END

	'getfrom'										/* Get from username     */
	from_name = result
	'getto'											/* Get to username       */
	to_name = result
	'getsubject'									/* Get Subject           */
	subject = result

	SelectedMessages = SelectedMessages + 1
	IF Writers.from_name = 0 & Receivers.from_name = 0 THEN /* This is the first message from or to this bloke */
		DO
			UserCounter = UserCounter + 1			/* We found a new user */
			UserNames.0 = UserCounter				/* Total number of users in */
			UserNames.UserCounter = from_name		/* Add him to the list */
		END

	IF Writers.from_name = 0 THEN
		TotalNumberWriters = TotalNumberWriters + 1
	Writers.from_name = Writers.from_name + 1		/* Great, another message from this bloke */

	IF Writers.to_name = 0 & Receivers.to_name = 0 THEN /* This is the first message from or to this bloke */
		DO
			UserCounter = UserCounter + 1			/* We found a new user */
			UserNames.0 = UserCounter				/* Total number of users in */
			UserNames.UserCounter = to_name			/* Add him to the list */
		END

	IF Receivers.to_name = 0 THEN
		TotalNumberReceivers = TotalNumberReceivers + 1
	Receivers.to_name = Receivers.to_name + 1		/* Great, another message to this bloke */

	tempsubject = UPPER(subject)					/* Strip RE: */
	IF LEFT(tempsubject,3) = 'RE:' THEN
		DO
			subject = DELSTR(subject,1,3)
			subject = STRIP(subject,'L')
		END

	IF SubjectsC.subject = 0 THEN					/* Well, Well new subject */
		DO
			SubjectCounter = SubjectCounter + 1		/* New subject */
			Subjects.0 = SubjectCounter
			Subjects.SubjectCounter = subject
		END
	SubjectsC.subject = SubjectsC.subject + 1
END

'progressclose' preq

IF TopTen THEN
	DO
		WriterHeader1 = '                           | Top Ten Writers |'
		WriterHeader2 = '| No. Username                                                Wrote    |'
		ReceiverHeader1 = '                          | Top Ten Receivers |'
		ReceiverHeader2 = '| No. Username                                                Received |'
		SubjectHeader1 =  '                          | Top Ten Subjects |'
		SubjectHeader2 = '| No. Subjects                                                Count    |'
		IF UserNames.0 < 10 THEN
			UserCounter = UserNames.0
		ELSE
			UserCounter = 10
		IF Subjects.0 < 10 THEN
			SubjectCounter = Subjects.0
		ELSE
			SubjectCounter = 10
	END
ELSE
	DO
		WriterHeader1 = '                           |     Writers     |'
		WriterHeader2 = '| Username                                                    Wrote    |'
		ReceiverHeader1 = '                          |     Receivers     |'
		ReceiverHeader2 = '| Username                                                    Received |'
		SubjectHeader1 = '                          |     Subjects     |'
		SubjectHeader2 = '| Subjects                                                    Count    |'
		UserCounter = UserNames.0
		SubjectCounter = Subjects.0
	END
'getareaname'
AreaName = result

'progressopen TITLE "Creating List..."'
preq = result
CALL open out,"T:Area.stats",write

CALL WRITELN out, '          +-------------------------------------------------+'
CALL WRITELN out, '          | Stats for area   :' LEFT(AreaName,28) '|'
IF AllMessages THEN
	CALL WRITELN out, '          | Created          :' LEFT(date(),28) '|'
ELSE
	DO
		CALL WRITELN out, '          | Start Date       :' LEFT(DispStartDate,28) '|'
		CALL WRITELN out, '          | End Date         :' LEFT(DispStopDate,28) '|'
		DaysCovered = DATE('C',StopDate,'S') - DATE('C',StartDate,'S') + 1
		CALL WRITELN out, '          | Days covered     :' LEFT(DaysCovered,28) '|'
	END

CALL WRITELN out, '          | No of messages   :' LEFT(SelectedMessages,28) '|'

IF AllMessages = 0 THEN
	DO
		MessPerDay = SelectedMessages / DaysCovered
		Remainder = MessPerDay // 1
		MessPerDay = MessPerDay % 1
		IF Remainder > 0.5 THEN MessPerDay = MessPerDay + 1
		CALL WRITELN out, '          | Messages per day :' LEFT(MessPerDay,28) '|'
	END

CALL WRITELN out, '          +-------------------------------------------------+'
CALL WRITELN out, ''
CALL WRITELN out, ''
CALL WRITELN out, ''
CALL WRITELN out, '                           +-----------------+'
CALL WRITELN out, WriterHeader1
CALL WRITELN out, BoxStr
CALL WRITELN out, WriterHeader2
CALL WRITELN out, BoxStr

CALL WriterSort 1,UserNames.0							/* Sort list of Writers   */
DO i = 1 TO UserCounter
	Name = UserNames.i

	IF Writers.Name ~= 0 THEN
		DO
			PercentWritten = (Writers.Name * 100) / SelectedMessages
			Remainder = PercentWritten // 1
			PercentWritten = PercentWritten % 1
			IF Remainder > 0.5 THEN PercentWritten = PercentWritten + 1
			IF TopTen THEN
				CALL WRITELN out, '|' RIGHT(i,2)||'.' LEFT(Name,52) RIGHT(Writers.Name,4) '('||RIGHT(PercentWritten,3)'%) |'
			ELSE
				CALL WRITELN out, '|' LEFT(Name,56) RIGHT(Writers.Name,4) '('||RIGHT(PercentWritten,3)'%) |'
		END
END
CALL WRITELN out, BoxStr
CALL WRITELN out, ''

'progressupdate' preq 1 3
IF rc = 5 THEN signal exit

CALL ReceiverSort 1,UserNames.0							/* Sort list of Receivers   */

CALL WRITELN out, '                          +-------------------+'
CALL WRITELN out, ReceiverHeader1
CALL WRITELN out, BoxStr
CALL WRITELN out, ReceiverHeader2
CALL WRITELN out, BoxStr
DO i = 1 TO UserCounter
	Name = UserNames.i

	IF Receivers.Name ~= 0 THEN
		DO
			PercentReceived = Receivers.Name / SelectedMessages * 100
			Remainder = PercentReceived // 1
			PercentReceived = PercentReceived % 1
			IF Remainder > 0.5 THEN PercentReceived = PercentReceived + 1
			IF TopTen THEN
				CALL WRITELN out, '|' RIGHT(i,2)||'.' LEFT(Name,52) RIGHT(Receivers.Name,4) '('||RIGHT(PercentReceived,3)'%) |'
			ELSE
				CALL WRITELN out, '|' LEFT(Name,56) RIGHT(Receivers.Name,4) '('||RIGHT(PercentReceived,3)'%) |'
		END
END
CALL WRITELN out, BoxStr
CALL WRITELN out, ''
'progressupdate' preq 2 3
IF rc = 5 THEN signal exit


CALL SubjectSort 1,Subjects.0							/* Sort Subjects          */
'progressupdate' preq 3 3
IF rc = 5 THEN signal exit
CALL WRITELN out, '                          +------------------+'
CALL WRITELN out, SubjectHeader1
CALL WRITELN out, BoxStr
CALL WRITELN out, SubjectHeader2
CALL WRITELN out, BoxStr
DO i = 1 TO SubjectCounter
	Subject = Subjects.i
	IF SubjectsC.Subject ~= 0 THEN
		DO
			PercentSubject = SubjectsC.Subject / SelectedMessages * 100
			Remainder = PercentSubject // 1
			PercentSubject = PercentSubject % 1
			IF Remainder > 0.5 THEN PercentSubject = PercentSubject + 1
			IF TopTen THEN
				CALL WRITELN out, '|' RIGHT(i,2)||'.' LEFT(Subject,52) RIGHT(SubjectsC.Subject,4) '('||RIGHT(PercentSubject,3)'%) |'
			ELSE
				CALL WRITELN out, '|' LEFT(Subject,56) RIGHT(SubjectsC.Subject,4) '('||RIGHT(PercentSubject,3)'%) |'
		END
END
CALL WRITELN out, BoxStr
CALL WRITELN out, ''

CALL WRITELN out, ''
CALL WRITELN out, '-> Total number of participants in this area:' UserNames.0
CALL WRITELN out, '-> Total number of writers:' TotalNumberWriters
CALL WRITELN out, '-> Total number of receivers:' TotalNumberReceivers

CALL WRITELN out, ''
CALL WRITELN out, '-- This chart was created with AreaStat' VER 'written by Brian Jacobsen'

CALL close out
'progressclose' preq
'unlockgui'

EndTime = TIME('E')										/* Stop time measure */
TotalTime = TRUNC(EndTime - StartTime)

/* Ask user if he wants the result posted in area or to a file */
requestdata = 'TITLE "Please choose..." PROMPT "Finished. Took:' TotalTime 'seconds.'||cr'Do you want the result sent to a file'cr'or posted in this area?" GADGETS "File|Post in area"'
'requestresponse' requestdata
IF rc = 0 THEN											/* Post in area */
	DO
		'write TO "All" SUBJECT "Stats for this area." FILE "T:Area.stats" NOEDIT NOGUI REFLOW=OFF'
		'requestresponse TITLE "Please choose..." PROMPT "Do you wish to edit this message?"'
		IF rc = 0 THEN
			DO
				'messages'
				'lastmessage'
				'edit'
			END
	END
ELSE													/* Write to file */
	DO
		FileName = AreaName'.stat'
		requestdata = 'TITLE "Please choose a file..." PATH "RAM:" FILE "'FileName'"'
		'requestfile' requestdata
		IF rc = 0 THEN
			DO
				FileName = result
				address command 'Copy T:Area.Stats "'FileName'"'
			END
	END

address command 'Delete >NIL: T:Area.stats'
'messages'
'lastmessage'
EXIT

SetupDates: PROCEDURE EXPOSE StartDate StopDate
	StopDate = DATE('S')						/* Setup default dates   */
	day = SUBSTR(StopDate,7,2)
	month = SUBSTR(StopDate,5,2)
	year = SUBSTR(StopDate,1,4)
	DispStopDate = day'.'month'.'year
	DispStartDate = '01.'month'.'year

	'requestresponse TITLE "Please choose..." PROMPT "How far back do you want to go?" GADGETS "1 week|14 days|30 days|Specify dates"'

	SELECT
		WHEN RC = 1 THEN
			StartDate = DATE('S',DATE('I')-6)
		WHEN RC = 2 THEN
			StartDate = DATE('S',DATE('I')-13)
		WHEN RC = 3 THEN
			StartDate = DATE('S',DATE('I')-29)
		OTHERWISE
			DO
				RequestData = 'TITLE "Please Enter Start date" PROMPT "(Format DD.MM.YYYY) Example: 22.9.1966" DEFAULT' DispStartDate
				DO WHILE DATATYPE(StartDate,'N') ~= 1
					'requeststring' requestdata
					IF rc ~= 0 THEN signal exit
					Parse VAR result day '.' month '.' year
					day = RIGHT(day,2,'0')
					month = RIGHT(month,2,'0')
					StartDate = year||month||day
					IF LENGTH(StartDate) ~= 8 THEN DROP StartDate
				END

				DROP StopDate
				RequestData = 'TITLE "Please Enter Stop date" PROMPT "(Format DD.MM.YYYY) Example: 22.9.1966" DEFAULT' DispStopDate
				DO WHILE DATATYPE(StopDate,'N') ~= 1
					'requeststring' RequestData
					IF rc ~= 0 THEN signal exit
					Parse VAR result day '.' month '.' year
					day = RIGHT(day,2,'0')
					month = RIGHT(month,2,'0')
					StopDate = year||month||day
					IF LENGTH(StopDate) ~= 8 | StopDate < StartDate THEN DROP StopDate
				END
			END
	END

RETURN

/***************************************/
/* Sort-routines. QuickSort algoritm   */
/***************************************/
SubjectSort: PROCEDURE EXPOSE Subjects. SubjectsC.
ARG Left,Right
i = Left; j = Right
m = (Left + Right) % 2
TempSubject = Subjects.m
DO UNTIL (i > j)
	Tempi = Subjects.i
	DO WHILE (SubjectsC.Tempi > SubjectsC.TempSubject & i < Right)
		i = i + 1
		Tempi = Subjects.i
	END
	Tempj = Subjects.j

	DO WHILE (SubjectsC.Tempj < SubjectsC.TempSubject & j > Left)
		j = j - 1
		Tempj = Subjects.j
	END
	IF i <= j THEN
		DO
			Temp = Subjects.i
			Subjects.i = Subjects.j
			Subjects.j = Temp
			i = i + 1; j = j - 1
		END
END
IF Left < j  THEN CALL SubjectSort Left,j
IF i < Right THEN CALL SubjectSort i,Right
RETURN

WriterSort: PROCEDURE EXPOSE UserNames. Writers.
ARG Left,Right
i = Left; j = Right
m = (Left + Right) % 2
TempWritten = UserNames.m

DO UNTIL (i > j)
	Tempi = UserNames.i
	DO WHILE (Writers.Tempi > Writers.TempWritten & i < Right)
		i = i + 1
		Tempi = UserNames.i
	END
	Tempj = UserNames.j
	DO WHILE (Writers.Tempj < Writers.TempWritten & j > Left)
		j = j - 1
		Tempj = UserNames.j
	END
	IF i <= j THEN
		DO
			Temp = UserNames.i
			UserNames.i = UserNames.j
			UserNames.j = Temp
			i = i + 1; j = j - 1
		END
END
IF left < j  THEN CALL WriterSort Left,j
IF i < Right THEN CALL WriterSort i,Right
RETURN

ReceiverSort: PROCEDURE EXPOSE UserNames. Receivers.
ARG Left,Right
i = Left; j = Right
m = (Left + Right) % 2
TempWritten = UserNames.m

DO UNTIL (i > j)
	Tempi = UserNames.i
	DO WHILE (Receivers.Tempi > Receivers.TempWritten & i < Right)
		i = i + 1
		Tempi = UserNames.i
	END
	Tempj = UserNames.j
	DO WHILE (Receivers.Tempj < Receivers.TempWritten & j > Left)
		j = j - 1
		Tempj = UserNames.j
	END
	IF i <= j THEN
		DO
			Temp = UserNames.i
			UserNames.i = UserNames.j
			UserNames.j = Temp
			i = i + 1; j = j - 1
		END
END
IF left < j  THEN CALL ReceiverSort Left,j
IF i < Right THEN CALL ReceiverSort i,Right
RETURN

syntax:
say rc errortext(rc) 'in line' SIGL
failure:
exit:
'unlockgui'
IF preq ~= 'PREQ' THEN
	'progressclose' preq
'messages'
'lastmessage'
exit