' WORDS.BAS -- This module handles the word list and picking the secret
'  word.
' $INCLUDE: 'J.INC'

DECLARE SUB SetPrefPtr ()
DECLARE SUB WPstring (Msg$, Row)
DECLARE SUB FillDisplay ()
DECLARE SUB MarkWord (Num)
DECLARE SUB UnmarkWord (Num)
DECLARE SUB ViewList ()
DECLARE SUB AddToList ()
DIM SHARED MyBox AS BoxType, TopRow, BotRow, LftCol, RtCol
DIM SHARED FirstWord
DIM SHARED WordCount, ExtraCount, MaxAdds, AddedWordFlag
REDIM SHARED WordList(1) AS STRING * 5
REDIM SHARED PrefPtr(1, 1)
DIM SHARED PickedWord$

FileError:
	CLS
	PRINT "Error trying to read JWORDS.JOT file"
	PRINT "Program stopping."
	END

' File format of JWORDS.JOT:
' 2-byte count of # of words in file (binary integer format)
' |  Binary count 1 to 31 (1-byte) + 2-letter prefix (caps only)
' |  count tells how many 3-letter suffixes follow.
' |
' |_ repeat as necessary


SUB AddToList
	COLOR Normal, Background, Background
	CLS
	PRINT
	PRINT "   Enter the words you want to add, one per line."
	PRINT "   Press <Return> at the beginning of a line to end."
	PRINT
	DO
		LINE INPUT "==> ", NewWord$
		NewWord$ = UCASE$(RTRIM$(LTRIM$(NewWord$)))
		IF LEN(NewWord$) = 5 THEN
			IF WordExists(NewWord$) THEN
				PRINT CHR$(7); "          That word is already in the list"
			ELSEIF ExtraCount >= MaxAdds THEN
				PRINT CHR$(7); "          The word list is presently full."
				PRINT "          End the program and restart it to add more words"
				Pause
				EXIT SUB
			ELSE
				Valid = TRUE
				For lp = 1 to 5
					Letter$ = Mid$(NewWord$,Lp,1)
					If Letter$ < "A" or Letter$ > "Z" THEN
						Valid = FALSE
					END if
				Next Lp
				If Valid THEN
					AddWord (NewWord$)
				ELSE
					Print chr$(7); "         You may not use punctuation or numbers"
				END IF
			END IF
		ELSEIF LEN(NewWord$) <> 0 THEN
			PRINT CHR$(7); "          Words must be 5 letters long"
		END IF
	LOOP WHILE LEN(NewWord$)
END SUB

SUB AddWord (Word$)
	IF ExtraCount < MaxAdds THEN
		ExtraCount = ExtraCount + 1
		WordList$(WordCount + ExtraCount) = Word$
		AddedWordFlag = TRUE
	END IF
END SUB

SUB FillDisplay
	FOR Lp = 0 TO 7      'For 8 Cols
		Cword = FirstWord + Lp * 20
		Col = 3 + Lp * 10
		FOR Lp2 = 0 TO 19
			LOCATE Lp2 + 2, Col, 0
			PRINT WordList$(Cword + Lp2);
		NEXT Lp2
	NEXT Lp
END SUB

SUB InitWordList
	COLOR Normal, Background, Background
	PRINT
	PRINT "  One moment please...";
	OPEN "JWORDS.JOT" FOR BINARY AS 1
	GET 1, , WordCount
	MaxAdds = 200
	REDIM WordList(1 TO WordCount + MaxAdds) AS STRING * 5
	Instring$ = STRING$(3, " ")
	wcount = 0
	Print "reading"; WordCount; "words from JWORDS.JOT"
	DO WHILE wcount < WordCount
		GET 1, , Instring$
		PrefCount = ASC(Instring$)
		Prefix$ = MID$(Instring$, 2)
		FOR Lp = 1 TO PrefCount
			GET 1, , Instring$
			wcount = wcount + 1
			WordList$(wcount) = Prefix$ + Instring$
		NEXT Lp
	LOOP
	CLOSE #1
	SetPrefPtr
	ExtraPtr = WordCount + 1
	ExtraCount = 0
	AddedWordFlag = FALSE
	
END SUB

SUB MarkWord (Num)
	Row = Num MOD 20
	IF Row = 0 THEN Row = 20
	Col = (Num - 1) \ 20
	Word$ = WordList$(FirstWord + Num - 1)
	LOCATE Row + 1, Col * 10 + 2, 0
	COLOR Known, Background, Background
	PRINT CHR$(175); Word$; CHR$(174);
	COLOR Normal, Background, Background
END SUB

SUB PickAWord
	RANDOMIZE TIMER
	DO
		Pick = INT(RND(1) * (WordCount + ExtraCount)) + 1
		PickedWord$ = WordList$(Pick)
	LOOP WHILE LEN(PickedWord$) <> 5
END SUB

SUB SaveWordList
	IF AddedWordFlag = FALSE THEN
		EXIT SUB
	END IF
	COLOR Normal, Background, Background
	CLS
	PRINT "Sorting and saving new word list ";
	
	Count = WordCount + ExtraCount
	FirstWordPtr = 1
	FOR Lp = 2 TO Count
		IF WordList$(Lp) < WordList$(FirstWordPtr) THEN
			FirstWordPtr = Lp
		END IF
	NEXT Lp
	IF FirstWordPtr <> 1 THEN
		SWAP WordList$(1), WordList$(FirstWordPtr)
	END IF
	FOR Lp = 2 TO Count
		Ptr = Lp
		DO WHILE WordList$(Ptr) < WordList$(Ptr - 1)
			SWAP WordList$(Ptr), WordList$(Ptr - 1)
			Ptr = Ptr - 1
		LOOP
		IF Lp MOD 100 = 0 THEN PRINT ".";
	NEXT Lp
	DO WHILE WordList$(Count) > "ZZZZZ"
		Count = Count - 1
	LOOP
	WordCount = Count
	ExtraCount = 0

	OPEN "JWORDS.JOT" FOR BINARY AS 1
	PUT 1, , Count
	Ptr = 1
	Suffix$ = STRING$(3, " ")
	DO WHILE Ptr <= Count
		PrefPtr = Ptr
		Prefix$ = LEFT$(WordList$(Ptr), 2)
		DO WHILE LEFT$(WordList$(PrefPtr + 1), 2) = Prefix$ AND PrefPtr < Ptr + 30
			PrefPtr = PrefPtr + 1
		LOOP
		PrefCount = PrefPtr - Ptr + 1
		Prefix$ = CHR$(PrefCount) + Prefix$
		PUT 1, , Prefix$
		FOR Lp = Ptr TO PrefPtr
			LSET Suffix$ = MID$(WordList$(Lp), 3)
			PUT 1, , Suffix$
		NEXT Lp
		Ptr = PrefPtr + 1
	LOOP
	CLOSE
	SetPrefPtr
	ExtraPtr = WordCount + 1
	ExtraCount = 0
	AddedWordFlag = FALSE
	MaxAdds = UBOUND(WordList$) - WordCount
END SUB

FUNCTION SecretWord$
	SecretWord$ = PickedWord$
END FUNCTION

SUB SetPrefPtr
	REDIM PrefPtr(ASC("A") TO ASC("Z"), ASC("A") TO ASC("Z"))
	Pref1$ = " "
	Pref2$ = " "
	Temp$ = STRING$(5, " ")
	FOR Lp = 1 TO WordCount
		LSET Temp$ = WordList$(Lp)
		IF LEFT$(Temp$, 1) <> Pref1$ OR MID$(Temp$, 2, 1) <> Pref2$ THEN
			Pref1$ = MID$(Temp$, 1, 1)
			Pref2$ = MID$(Temp$, 2, 1)
			PrefPtr(ASC(Pref1$), ASC(Pref2$)) = Lp
		END IF
	NEXT Lp
END SUB

SUB UnmarkWord (Num)
	Row = Num MOD 20
	IF Row = 0 THEN Row = 20
	Col = (Num - 1) \ 20
	Word$ = WordList$(FirstWord + Num - 1)
	LOCATE Row + 1, Col * 10 + 2, 0
	COLOR Normal, Background, Background
	PRINT " "; Word$; " ";
END SUB

SUB ViewList
	COLOR Normal, Background, Background
	CLS
	InitMessage
	ShowMessage ("Use arrows, PgUp and PgDn, Del to delete, Esc to end")
	FirstWord = 1
	DO
		IF FirstWord > WordCount + ExtraCount - 159 THEN
			FirstWord = WordCount + ExtraCount - 159
		END IF
		IF FirstWord < 1 THEN FirstWord = 1
		FillDisplay
		Marked = 1
		DO
			DO
				Marked = (Marked + 160) MOD 160
			LOOP WHILE Marked < 0
			IF Marked = 0 THEN Marked = 160
			MarkWord (Marked)
			DO
				Char$ = INKEY$
			LOOP UNTIL LEN(Char$)
			IF Char$ = CHR$(27) THEN               'ESC
				EXIT SUB
			END IF
			IF LEN(Char$) = 2 THEN
				Char$ = MID$(Char$, 2)
				UnmarkWord (Marked)
				SELECT CASE Char$
					CASE CHR$(73)                    'PgUp
						FirstWord = FirstWord - 160
						EXIT DO
					CASE CHR$(81)                    'PgDn
						FirstWord = FirstWord + 160
						EXIT DO
					CASE CHR$(72)                    'Up arrow
						Marked = Marked - 1
					CASE CHR$(80)                    'Dn Arrow
						Marked = Marked + 1
					CASE CHR$(75)                    'Left arrow
						Marked = Marked - 20
					CASE CHR$(77)                    'Right arrow
						Marked = Marked + 20
					CASE CHR$(71)                    'Home
						Marked = 1
					CASE CHR$(79)                    'End
						Marked = 160
					CASE CHR$(83)                    'DEL
							MarkWord (Marked)
						CurWord = FirstWord + Marked - 1
						PushMsg
						ShowMessage ("Do you want to delete " + WordList$(CurWord) + "?")
						YN$ = YesNo$
						PopMsg
						UnmarkWord (Marked)
						IF YN$ = "Y" THEN
							WordList$(CurWord) = STRING$(5, 255)
							AddedWordFlag = TRUE
							FillDisplay
						END IF
					CASE ELSE
						MarkWord (Marked)
				END SELECT
			END IF
		LOOP
	LOOP
END SUB

FUNCTION WordExists (Word$)
	Pref1$ = MID$(Word$, 1, 1)
	Pref2$ = MID$(Word$, 2, 1)
	Ptr = PrefPtr(ASC(Pref1$), ASC(Pref2$))
	DO WHILE WordList$(Ptr) < Word$
		Ptr = Ptr + 1
	LOOP
	IF WordList$(Ptr) = Word$ THEN
		WordExists = TRUE
		EXIT FUNCTION
	END IF
	ListEnd = WordCount + ExtraCount
	FOR Lp = WordCount + 1 TO ListEnd
		IF WordList$(Lp) = Word$ THEN
			WordExists = TRUE
			EXIT FUNCTION
		END IF
	NEXT Lp
	WordExists = FALSE
END FUNCTION

SUB WordMaintenance
	CALL BoxCoords(MaintMenuBox, MyBox)
	TopRow = MyBox.TopRow
	BotRow = MyBox.BotRow
	LftCol = MyBox.LftCol
	RtCol = MyBox.RtCol

	DO
		COLOR Normal, Background, Background
		CLS
		NormalBox (MaintMenuBox)
		CALL WPstring("Word List Maintenance", 1)
		CALL WPstring("1. View and Delete Words", 3)
		CALL WPstring("2. Add Words to List", 5)
		CALL WPstring("3. Return to Main Menu", 7)
		CALL WPstring("   Enter number of your choice", 9)
		DO
			choice$ = INPUT$(1)
		LOOP UNTIL choice$ >= "1" AND choice$ <= "4"
		SELECT CASE choice$
			CASE "1"
					ViewList
			CASE "2"
					AddToList
			CASE "3"
				SaveWordList
				EXIT SUB
			CASE ELSE
		END SELECT
	LOOP
END SUB

SUB WPstring (Msg$, Row)
	LOCATE TopRow + Row, LftCol + (RtCol - LftCol - LEN(Msg$)) / 2, 0
	PRINT Msg$;
END SUB

