home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload / ShartewareOverload.cdr / games / jots.zip / WORDS.BAS < prev   
BASIC Source File  |  1989-03-15  |  9KB  |  352 lines

  1. ' WORDS.BAS -- This module handles the word list and picking the secret
  2. '  word.
  3. ' $INCLUDE: 'J.INC'
  4.  
  5. DECLARE SUB SetPrefPtr ()
  6. DECLARE SUB WPstring (Msg$, Row)
  7. DECLARE SUB FillDisplay ()
  8. DECLARE SUB MarkWord (Num)
  9. DECLARE SUB UnmarkWord (Num)
  10. DECLARE SUB ViewList ()
  11. DECLARE SUB AddToList ()
  12. DIM SHARED MyBox AS BoxType, TopRow, BotRow, LftCol, RtCol
  13. DIM SHARED FirstWord
  14. DIM SHARED WordCount, ExtraCount, MaxAdds, AddedWordFlag
  15. REDIM SHARED WordList(1) AS STRING * 5
  16. REDIM SHARED PrefPtr(1, 1)
  17. DIM SHARED PickedWord$
  18.  
  19. FileError:
  20.     CLS
  21.     PRINT "Error trying to read JWORDS.JOT file"
  22.     PRINT "Program stopping."
  23.     END
  24.  
  25. ' File format of JWORDS.JOT:
  26. ' 2-byte count of # of words in file (binary integer format)
  27. ' |  Binary count 1 to 31 (1-byte) + 2-letter prefix (caps only)
  28. ' |  count tells how many 3-letter suffixes follow.
  29. ' |
  30. ' |_ repeat as necessary
  31.  
  32.  
  33. SUB AddToList
  34.     COLOR Normal, Background, Background
  35.     CLS
  36.     PRINT
  37.     PRINT "   Enter the words you want to add, one per line."
  38.     PRINT "   Press <Return> at the beginning of a line to end."
  39.     PRINT
  40.     DO
  41.         LINE INPUT "==> ", NewWord$
  42.         NewWord$ = UCASE$(RTRIM$(LTRIM$(NewWord$)))
  43.         IF LEN(NewWord$) = 5 THEN
  44.             IF WordExists(NewWord$) THEN
  45.                 PRINT CHR$(7); "          That word is already in the list"
  46.             ELSEIF ExtraCount >= MaxAdds THEN
  47.                 PRINT CHR$(7); "          The word list is presently full."
  48.                 PRINT "          End the program and restart it to add more words"
  49.                 Pause
  50.                 EXIT SUB
  51.             ELSE
  52.                 Valid = TRUE
  53.                 For lp = 1 to 5
  54.                     Letter$ = Mid$(NewWord$,Lp,1)
  55.                     If Letter$ < "A" or Letter$ > "Z" THEN
  56.                         Valid = FALSE
  57.                     END if
  58.                 Next Lp
  59.                 If Valid THEN
  60.                     AddWord (NewWord$)
  61.                 ELSE
  62.                     Print chr$(7); "         You may not use punctuation or numbers"
  63.                 END IF
  64.             END IF
  65.         ELSEIF LEN(NewWord$) <> 0 THEN
  66.             PRINT CHR$(7); "          Words must be 5 letters long"
  67.         END IF
  68.     LOOP WHILE LEN(NewWord$)
  69. END SUB
  70.  
  71. SUB AddWord (Word$)
  72.     IF ExtraCount < MaxAdds THEN
  73.         ExtraCount = ExtraCount + 1
  74.         WordList$(WordCount + ExtraCount) = Word$
  75.         AddedWordFlag = TRUE
  76.     END IF
  77. END SUB
  78.  
  79. SUB FillDisplay
  80.     FOR Lp = 0 TO 7      'For 8 Cols
  81.         Cword = FirstWord + Lp * 20
  82.         Col = 3 + Lp * 10
  83.         FOR Lp2 = 0 TO 19
  84.             LOCATE Lp2 + 2, Col, 0
  85.             PRINT WordList$(Cword + Lp2);
  86.         NEXT Lp2
  87.     NEXT Lp
  88. END SUB
  89.  
  90. SUB InitWordList
  91.     COLOR Normal, Background, Background
  92.     PRINT
  93.     PRINT "  One moment please...";
  94.     OPEN "JWORDS.JOT" FOR BINARY AS 1
  95.     GET 1, , WordCount
  96.     MaxAdds = 200
  97.     REDIM WordList(1 TO WordCount + MaxAdds) AS STRING * 5
  98.     Instring$ = STRING$(3, " ")
  99.     wcount = 0
  100.     Print "reading"; WordCount; "words from JWORDS.JOT"
  101.     DO WHILE wcount < WordCount
  102.         GET 1, , Instring$
  103.         PrefCount = ASC(Instring$)
  104.         Prefix$ = MID$(Instring$, 2)
  105.         FOR Lp = 1 TO PrefCount
  106.             GET 1, , Instring$
  107.             wcount = wcount + 1
  108.             WordList$(wcount) = Prefix$ + Instring$
  109.         NEXT Lp
  110.     LOOP
  111.     CLOSE #1
  112.     SetPrefPtr
  113.     ExtraPtr = WordCount + 1
  114.     ExtraCount = 0
  115.     AddedWordFlag = FALSE
  116.     
  117. END SUB
  118.  
  119. SUB MarkWord (Num)
  120.     Row = Num MOD 20
  121.     IF Row = 0 THEN Row = 20
  122.     Col = (Num - 1) \ 20
  123.     Word$ = WordList$(FirstWord + Num - 1)
  124.     LOCATE Row + 1, Col * 10 + 2, 0
  125.     COLOR Known, Background, Background
  126.     PRINT CHR$(175); Word$; CHR$(174);
  127.     COLOR Normal, Background, Background
  128. END SUB
  129.  
  130. SUB PickAWord
  131.     RANDOMIZE TIMER
  132.     DO
  133.         Pick = INT(RND(1) * (WordCount + ExtraCount)) + 1
  134.         PickedWord$ = WordList$(Pick)
  135.     LOOP WHILE LEN(PickedWord$) <> 5
  136. END SUB
  137.  
  138. SUB SaveWordList
  139.     IF AddedWordFlag = FALSE THEN
  140.         EXIT SUB
  141.     END IF
  142.     COLOR Normal, Background, Background
  143.     CLS
  144.     PRINT "Sorting and saving new word list ";
  145.     
  146.     Count = WordCount + ExtraCount
  147.     FirstWordPtr = 1
  148.     FOR Lp = 2 TO Count
  149.         IF WordList$(Lp) < WordList$(FirstWordPtr) THEN
  150.             FirstWordPtr = Lp
  151.         END IF
  152.     NEXT Lp
  153.     IF FirstWordPtr <> 1 THEN
  154.         SWAP WordList$(1), WordList$(FirstWordPtr)
  155.     END IF
  156.     FOR Lp = 2 TO Count
  157.         Ptr = Lp
  158.         DO WHILE WordList$(Ptr) < WordList$(Ptr - 1)
  159.             SWAP WordList$(Ptr), WordList$(Ptr - 1)
  160.             Ptr = Ptr - 1
  161.         LOOP
  162.         IF Lp MOD 100 = 0 THEN PRINT ".";
  163.     NEXT Lp
  164.     DO WHILE WordList$(Count) > "ZZZZZ"
  165.         Count = Count - 1
  166.     LOOP
  167.     WordCount = Count
  168.     ExtraCount = 0
  169.  
  170.     OPEN "JWORDS.JOT" FOR BINARY AS 1
  171.     PUT 1, , Count
  172.     Ptr = 1
  173.     Suffix$ = STRING$(3, " ")
  174.     DO WHILE Ptr <= Count
  175.         PrefPtr = Ptr
  176.         Prefix$ = LEFT$(WordList$(Ptr), 2)
  177.         DO WHILE LEFT$(WordList$(PrefPtr + 1), 2) = Prefix$ AND PrefPtr < Ptr + 30
  178.             PrefPtr = PrefPtr + 1
  179.         LOOP
  180.         PrefCount = PrefPtr - Ptr + 1
  181.         Prefix$ = CHR$(PrefCount) + Prefix$
  182.         PUT 1, , Prefix$
  183.         FOR Lp = Ptr TO PrefPtr
  184.             LSET Suffix$ = MID$(WordList$(Lp), 3)
  185.             PUT 1, , Suffix$
  186.         NEXT Lp
  187.         Ptr = PrefPtr + 1
  188.     LOOP
  189.     CLOSE
  190.     SetPrefPtr
  191.     ExtraPtr = WordCount + 1
  192.     ExtraCount = 0
  193.     AddedWordFlag = FALSE
  194.     MaxAdds = UBOUND(WordList$) - WordCount
  195. END SUB
  196.  
  197. FUNCTION SecretWord$
  198.     SecretWord$ = PickedWord$
  199. END FUNCTION
  200.  
  201. SUB SetPrefPtr
  202.     REDIM PrefPtr(ASC("A") TO ASC("Z"), ASC("A") TO ASC("Z"))
  203.     Pref1$ = " "
  204.     Pref2$ = " "
  205.     Temp$ = STRING$(5, " ")
  206.     FOR Lp = 1 TO WordCount
  207.         LSET Temp$ = WordList$(Lp)
  208.         IF LEFT$(Temp$, 1) <> Pref1$ OR MID$(Temp$, 2, 1) <> Pref2$ THEN
  209.             Pref1$ = MID$(Temp$, 1, 1)
  210.             Pref2$ = MID$(Temp$, 2, 1)
  211.             PrefPtr(ASC(Pref1$), ASC(Pref2$)) = Lp
  212.         END IF
  213.     NEXT Lp
  214. END SUB
  215.  
  216. SUB UnmarkWord (Num)
  217.     Row = Num MOD 20
  218.     IF Row = 0 THEN Row = 20
  219.     Col = (Num - 1) \ 20
  220.     Word$ = WordList$(FirstWord + Num - 1)
  221.     LOCATE Row + 1, Col * 10 + 2, 0
  222.     COLOR Normal, Background, Background
  223.     PRINT " "; Word$; " ";
  224. END SUB
  225.  
  226. SUB ViewList
  227.     COLOR Normal, Background, Background
  228.     CLS
  229.     InitMessage
  230.     ShowMessage ("Use arrows, PgUp and PgDn, Del to delete, Esc to end")
  231.     FirstWord = 1
  232.     DO
  233.         IF FirstWord > WordCount + ExtraCount - 159 THEN
  234.             FirstWord = WordCount + ExtraCount - 159
  235.         END IF
  236.         IF FirstWord < 1 THEN FirstWord = 1
  237.         FillDisplay
  238.         Marked = 1
  239.         DO
  240.             DO
  241.                 Marked = (Marked + 160) MOD 160
  242.             LOOP WHILE Marked < 0
  243.             IF Marked = 0 THEN Marked = 160
  244.             MarkWord (Marked)
  245.             DO
  246.                 Char$ = INKEY$
  247.             LOOP UNTIL LEN(Char$)
  248.             IF Char$ = CHR$(27) THEN               'ESC
  249.                 EXIT SUB
  250.             END IF
  251.             IF LEN(Char$) = 2 THEN
  252.                 Char$ = MID$(Char$, 2)
  253.                 UnmarkWord (Marked)
  254.                 SELECT CASE Char$
  255.                     CASE CHR$(73)                    'PgUp
  256.                         FirstWord = FirstWord - 160
  257.                         EXIT DO
  258.                     CASE CHR$(81)                    'PgDn
  259.                         FirstWord = FirstWord + 160
  260.                         EXIT DO
  261.                     CASE CHR$(72)                    'Up arrow
  262.                         Marked = Marked - 1
  263.                     CASE CHR$(80)                    'Dn Arrow
  264.                         Marked = Marked + 1
  265.                     CASE CHR$(75)                    'Left arrow
  266.                         Marked = Marked - 20
  267.                     CASE CHR$(77)                    'Right arrow
  268.                         Marked = Marked + 20
  269.                     CASE CHR$(71)                    'Home
  270.                         Marked = 1
  271.                     CASE CHR$(79)                    'End
  272.                         Marked = 160
  273.                     CASE CHR$(83)                    'DEL
  274.                             MarkWord (Marked)
  275.                         CurWord = FirstWord + Marked - 1
  276.                         PushMsg
  277.                         ShowMessage ("Do you want to delete " + WordList$(CurWord) + "?")
  278.                         YN$ = YesNo$
  279.                         PopMsg
  280.                         UnmarkWord (Marked)
  281.                         IF YN$ = "Y" THEN
  282.                             WordList$(CurWord) = STRING$(5, 255)
  283.                             AddedWordFlag = TRUE
  284.                             FillDisplay
  285.                         END IF
  286.                     CASE ELSE
  287.                         MarkWord (Marked)
  288.                 END SELECT
  289.             END IF
  290.         LOOP
  291.     LOOP
  292. END SUB
  293.  
  294. FUNCTION WordExists (Word$)
  295.     Pref1$ = MID$(Word$, 1, 1)
  296.     Pref2$ = MID$(Word$, 2, 1)
  297.     Ptr = PrefPtr(ASC(Pref1$), ASC(Pref2$))
  298.     DO WHILE WordList$(Ptr) < Word$
  299.         Ptr = Ptr + 1
  300.     LOOP
  301.     IF WordList$(Ptr) = Word$ THEN
  302.         WordExists = TRUE
  303.         EXIT FUNCTION
  304.     END IF
  305.     ListEnd = WordCount + ExtraCount
  306.     FOR Lp = WordCount + 1 TO ListEnd
  307.         IF WordList$(Lp) = Word$ THEN
  308.             WordExists = TRUE
  309.             EXIT FUNCTION
  310.         END IF
  311.     NEXT Lp
  312.     WordExists = FALSE
  313. END FUNCTION
  314.  
  315. SUB WordMaintenance
  316.     CALL BoxCoords(MaintMenuBox, MyBox)
  317.     TopRow = MyBox.TopRow
  318.     BotRow = MyBox.BotRow
  319.     LftCol = MyBox.LftCol
  320.     RtCol = MyBox.RtCol
  321.  
  322.     DO
  323.         COLOR Normal, Background, Background
  324.         CLS
  325.         NormalBox (MaintMenuBox)
  326.         CALL WPstring("Word List Maintenance", 1)
  327.         CALL WPstring("1. View and Delete Words", 3)
  328.         CALL WPstring("2. Add Words to List", 5)
  329.         CALL WPstring("3. Return to Main Menu", 7)
  330.         CALL WPstring("   Enter number of your choice", 9)
  331.         DO
  332.             choice$ = INPUT$(1)
  333.         LOOP UNTIL choice$ >= "1" AND choice$ <= "4"
  334.         SELECT CASE choice$
  335.             CASE "1"
  336.                     ViewList
  337.             CASE "2"
  338.                     AddToList
  339.             CASE "3"
  340.                 SaveWordList
  341.                 EXIT SUB
  342.             CASE ELSE
  343.         END SELECT
  344.     LOOP
  345. END SUB
  346.  
  347. SUB WPstring (Msg$, Row)
  348.     LOCATE TopRow + Row, LftCol + (RtCol - LftCol - LEN(Msg$)) / 2, 0
  349.     PRINT Msg$;
  350. END SUB
  351.  
  352.