DECLARE FUNCTION EnterNumber% (KeyPress$)
DECLARE FUNCTION MouseTrap$ ()
DECLARE SUB ArrowTrap (KeyPress$)
DECLARE SUB ChangeFocus (NewTabStop%)
DECLARE SUB DrawBox (x%, y%, w%, h%, f%, b%, fill%)
DECLARE SUB DrawList ()
DECLARE SUB EraseList ()
DECLARE SUB FindNumber ()
DECLARE SUB GetHelp ()
DECLARE SUB HighLight (YPos%, XPos1%, XPos2%)
DECLARE SUB Interface ()
DECLARE SUB Mouse ()
DECLARE SUB SetInit ()
DECLARE SUB ShowCursor ()
DECLARE SUB TestNumber (Number$)
REM ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
REM ³Purpose: To find all phrases that can be made with a phone number
REM ³Author: ComputerGhost
REM ³Start Date: 3/28/05
REM ³Start Time: 5:20 PM
REM ³End Date: 4/1/2005
REM ³End Time: 11:15 PM
REM ³Notes: Before running, change the directory to whereever the
REM ³ file WordList.txt is.
REM ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
TYPE Registers
ax AS INTEGER
bx AS INTEGER
cx AS INTEGER
dx AS INTEGER
bp AS INTEGER
si AS INTEGER
di AS INTEGER
flags AS INTEGER
END TYPE
DIM SHARED regs AS Registers 'Used with the mouse
DIM SHARED CloseProg%
DIM SHARED Beginning$ 'See SUB TestNumber(Number$)
DIM SHARED StopSearch% '1 if search should be aborted
DIM SHARED PhoneNumber$
DIM SHARED LenPhone%, OldLenPhone% 'length of PhoneNumber$
DIM SHARED TabStop% '1=menu, 2=enter number, 3=phrase list
DIM SHARED OldTabStop%
DIM SHARED TransNum%(25)
DIM SHARED WordList$(849)
DIM SHARED UpdateResults% '1 if results list has been updated
DIM SHARED ResultCount%
DIM SHARED ResultPos% 'Which result is the first being displayed
DIM SHARED OldMousePosX%, OldMousePosY%, MouseStatus%
DIM SHARED HighLightStat% '1=Exit,2=Unused,3=Help,4=Search,5=UP,6=DOWN
DIM SHARED OldHighLightStat% '7=Help Box's OKAY
IF KeyPress$ = "MS_EXIT" THEN KeyPress$ = CHR$(27)
IF KeyPress$ = "MS_SCROLLUP" THEN KeyPress$ = CHR$(0) + "I"
IF KeyPress$ = "MS_SCROLLDOWN" THEN KeyPress$ = CHR$(0) + "Q"
IF KeyPress$ = "MS_HELP" THEN KeyPress$ = CHR$(0) + ";"
REM MS_SEARCH is not changed here
REM ----Keyboard Event Handler----
SELECT CASE KeyPress$
CASE CHR$(9) 'TAB
ChangeFocus (TabStop% MOD 3 + 1)
CASE CHR$(0) + CHR$(15) 'SHIFT+TAB
ChangeFocus ((TabStop% + 1) MOD 3 + 1)
CASE CHR$(27) 'ESC
CloseProg% = 1 'change to confirmation box later
CASE CHR$(0) + ";" 'HELP
CALL GetHelp
CASE ELSE
IF TabStop% = 2 THEN Find% = EnterNumber(KeyPress$)
IF Find% = 1 OR KeyPress$ = "MS_SEARCH" THEN
CALL FindNumber
Find% = 0
END IF
END SELECT
IF LEN(KeyPress$) = 2 AND INSTR(ArrowKeys$, KeyPress$) THEN
CALL ArrowTrap(KeyPress$)
END IF
IF UpdateResults% = 1 THEN CALL DrawList
CALL ShowCursor 'Keyboard cursor, NOT mouse
LOOP WHILE CloseProg% = 0
REM Close Program
COLOR 7, 0
CLS
KILL "temporar.txt"
SYSTEM
SUB ArrowTrap (KeyPress$)
'PURPOSE: Event trapping for the arrow keys and the Page Up/Down keys
SELECT CASE KeyPress$
CASE CHR$(0) + "H" 'UP
IF TabStop% = 3 THEN GOSUB ResultUP
CASE CHR$(0) + "P" 'DOWN
IF TabStop% = 3 THEN GOSUB ResultDOWN
CASE CHR$(0) + "K" 'LEFT
IF TabStop% = 3 THEN GOSUB ResultUP
CASE CHR$(0) + "M" 'RIGHT
IF TabStop% = 3 THEN GOSUB ResultDOWN
CASE CHR$(0) + "I" 'PAGE UP
IF TabStop% = 3 THEN GOSUB ResultUP
CASE CHR$(0) + "Q" 'PAGE DOWN
IF TabStop% = 3 THEN GOSUB ResultDOWN
END SELECT
EXIT SUB
ResultUP:
IF ResultPos% > 3 THEN
ResultPos% = ResultPos% - 3
UpdateResults% = 1
END IF
RETURN
ResultDOWN:
IF ResultPos% < (ResultCount% \ 3) * 3 - 30 THEN
ResultPos% = ResultPos% + 3
UpdateResults% = 1
END IF
RETURN
SUB DrawBox (x%, y%, w%, h%, f%, b%, fill%)
'PURPOSE: Draw a dialog box
'PARAMS: X-coord, Y-coord, Width, Height, Forground Color,
' Background Color, Fill Color
COLOR f%, b%
LOCATE y%, x%
PRINT "Ú"; STRING$(w% - 2, "Ä"); "¿";
FOR Y2% = (y% + 1) TO (y% + h% - 2)
LOCATE Y2%, x%
PRINT "³";
COLOR , fill%
PRINT SPACE$(w% - 2);
COLOR f%, b%
PRINT "³";
NEXT Y2%
LOCATE y% + h% - 1, x%
PRINT "À"; STRING$(w% - 2, "Ä"); "Ù";
END SUB
SUB DrawList
UpdateResults% = 0
CALL EraseList
OPEN "Temporar.txt" FOR INPUT AS #1
REM Move to certain record:
FOR i% = 1 TO ResultPos% - 1
IF EOF(1) THEN GOTO ExitSub
LINE INPUT #1, nul$
NEXT i%
REM Draw the rest
FOR i% = 0 TO 32
IF EOF(1) THEN GOTO ExitSub
LINE INPUT #1, Result$
LOCATE i% \ 3 + 12, ((i% MOD 3) * 18) + 12
PRINT Result$
NEXT i%
CLOSE #1
EXIT SUB
ExitSub: 'if eof(1)
CLOSE #1
END SUB
FUNCTION EnterNumber% (KeyPress$)
SELECT CASE KeyPress$
CASE CHR$(13)
EnterNumber% = 1
CASE CHR$(8)
IF LenPhone% > 1 THEN
PhoneNumber$ = LEFT$(PhoneNumber$, LenPhone% - 1)
ELSEIF LenPhone% = 1 THEN
PhoneNumber$ = ""
END IF
CASE ELSE
AscKey% = ASC(KeyPress$)
IF (AscKey% > 47 AND AscKey% < 58) OR AscKey% = 45 THEN
PhoneNumber$ = PhoneNumber$ + KeyPress$
END IF
END SELECT
IF LEN(PhoneNumber$) > 14 THEN PhoneNumber$ = RIGHT$(PhoneNumber$, 14)
COLOR 15, 6
LOCATE 8, 27
PRINT PhoneNumber$
LenPhone% = LEN(PhoneNumber$)
END FUNCTION
SUB EraseList
'PURPOSE: Erase all text in the result box
COLOR 15, 6
FOR i% = 12 TO 22 'list box's contents
LOCATE i%, 12: PRINT SPACE$(55)
NEXT i%
END SUB
SUB FindNumber
'PURPOSE: Find phrases for the number in PhoneNumber$
CALL EraseList
COLOR 31, 6
LOCATE 12, 13
PRINT "Please wait while the number is being processed..."
COLOR 15
LOCATE , 13
PRINT "Press [C] or [ESC] to stop."
OPEN "Temporar.txt" FOR OUTPUT AS #2
ResultCount% = 0
StopSearch% = 0
Beginning$ = ""
Number$ = "": GOSUB RemoveDash
CALL TestNumber(Number$)
CLOSE #2
'Erase Number EditBox
COLOR 7, 6
LOCATE 8, 27
PRINT SPACE$(15) '1 short of the total lenght, but last pos isn't used
PhoneNumber$ = ""
LenPhone% = 0
UpdateResults% = 1
ResultPos% = 1
CALL ChangeFocus(3) 'Set TabStop to 3 (results list box)
IF HighLightStat% = 4 THEN CALL HighLight(8, 45, 52)
EXIT SUB
RemoveDash:
'PURPOSE: Remove Dashes from PhoneNumber$
'RETURN: Number$ (PhoneNumber$ without dashes)
FOR i% = 1 TO LEN(PhoneNumber$)
Test$ = MID$(PhoneNumber$, i%, 1)
IF Test$ <> "-" THEN Number$ = Number$ + Test$
NEXT i%
RETURN
END SUB
SUB GetHelp
COLOR 15, 7
LOCATE 5, 3
PRINT "Ú"; STRING$(72, "Ä"); "¿"
FOR y% = 6 TO 20
LOCATE y%, 3
PRINT "³";
COLOR , 6: PRINT SPACE$(72);
COLOR , 7: PRINT "³"
NEXT y%
LOCATE 21, 3
PRINT "À"; STRING$(72, "Ä"); "Ù"
COLOR 15, 6
LOCATE 6, 35
PRINT "OPERATION"
LOCATE 7, 5
COLOR 11: PRINT "0123456789";
COLOR 15: PRINT " Numbers; used to type a phone number."
LOCATE 8, 5
COLOR 11: PRINT "BACKSPACE",
COLOR 15: PRINT " Erase the previous digit in the "; CHR$(34); "Search Number"; CHR$(34); " input."
LOCATE 9, 5
COLOR 11: PRINT "ENTER",
COLOR 15: PRINT " Submit the number to be processed."
LOCATE 10, 5
COLOR 11: PRINT "UP,DOWN",
COLOR 15: PRINT " Scroll the results window up or down."
LOCATE 11, 5
COLOR 11: PRINT "PAGEUP,PAGEDOWN";
COLOR 15: PRINT " Same as the UP and DOWN keys."
LOCATE 12, 5
COLOR 11: PRINT "TAB,SHIFT+TAB";
COLOR 15: PRINT " Switch focus between "; CHR$(34); "Search Number"; CHR$(34); " input to Results."
LOCATE 13, 5
COLOR 11: PRINT "F1",
COLOR 15: PRINT " Display help."
LOCATE 14, 5
COLOR 11: PRINT "ESC",
COLOR 15: PRINT " Exit this program."
LOCATE 16, 5
PRINT "Made by ComputerGhost (Nathan Belue)"
LOCATE , 5: PRINT "Contact at ComputerGhost@hotmail.com"
LOCATE , 5: PRINT "For more information, e-mail me."
LOCATE 20, 38
COLOR 15, 1: PRINT " OKAY "
regs.ax = 1: CALL Mouse
DO
key$ = INKEY$
regs.ax = 3: CALL Mouse
MouseX% = regs.cx \ 8 + 1
MouseY% = regs.dx \ 8 + 1
IF MouseX% > 37 AND MouseX% < 44 AND MouseY% = 20 THEN
IF HighLightStat% < 7 THEN
CALL HighLight(20, 38, 43)
HighLightStat% = 7
END IF
ELSE 'Not on the button
IF HighLightStat% = 7 THEN CALL HighLight(20, 38, 43)
HighLightStat% = 0
END IF
IF regs.bx > 0 AND MouseX% > 37 AND MouseX% < 44 AND MouseY% = 20 THEN
key$ = CHR$(27)
END IF
LOOP UNTIL key$ = CHR$(13) OR key$ = CHR$(27)
regs.ax = 2: CALL Mouse
CALL Interface
UpdateResults% = 1
END SUB
SUB HighLight (YPos%, XPos1%, XPos2%)
regs.ax = 2: CALL Mouse
REM Find the forground and background colors:
DEF SEG = &HB800
Colour% = PEEK((YPos% - 1) * 160 + (XPos1% - 1) * 2 + 1)
Back% = Colour% \ 16
Frgrnd% = Colour% MOD 16
IF Frgrnd% = 15 THEN Bckgrnd% = 0 ELSE Bckgrnd% = Frgrnd% - 8
IF Back% = 0 THEN Frgrnd% = 15 ELSE Frgrnd% = Back% + 8
REM Change it:
COLOR Frgrnd%, Bckgrnd%
FOR x% = XPos1% TO XPos2%
' DEF SEG = &HB800
' POKE ((YPos% - 1) * 160 + (x% - 1) * 2 + 1), Colour%
LOCATE YPos%, x% 'same as the poke stuff
PRINT CHR$(SCREEN(YPos%, x%))
NEXT x%
DEF SEG
regs.ax = 1: CALL Mouse
END SUB
SUB Interface
'Background
COLOR 3, 1
LOCATE 1, 1
PRINT STRING$(1920, "Å");
SUB Mouse
CALL interrupt(&H33, regs, regs)
END SUB
FUNCTION MouseTrap$
'PURPOSE: Event trapping for the mouse
regs.ax = 3
CALL Mouse
MouseX% = regs.cx \ 8 + 1 '0 to 640 -> 1 to 80
MouseY% = regs.dx \ 8 + 1 '0 to 200 -> 1 to 25
Button% = regs.bx
REM Highlights:
OldHighLightStat% = HighLightStat%
HighLightStat% = 0
IF MouseY% = 2 THEN
IF MouseX% > 1 AND MouseX% < 14 THEN HighLightStat% = 1
IF MouseX% > 16 AND MouseX% < 28 THEN HighLightStat% = 3
END IF
IF MouseY% = 8 AND MouseX% > 45 AND MouseX% < 54 THEN HighLightStat% = 4
IF MouseX% = 67 THEN
IF MouseY% = 12 THEN HighLightStat% = 5
IF MouseY% = 22 THEN HighLightStat% = 6
END IF
IF HighLightStat% <> OldHighLightStat% THEN
SWAP HighLightStat%, OldHighLightStat%
GOSUB HighLights
SWAP HighLightStat%, OldHighLightStat%
GOSUB HighLights
END IF
REM Clicks:
IF regs.bx = 0 THEN EXIT FUNCTION
regs.ax = 2: CALL Mouse
'Search box:
IF MouseX% > 24 AND MouseX% < 56 AND MouseY% > 6 AND MouseY% < 10 AND Button% THEN
ChangeFocus (2)
RetMouseTrap$ = "FOCUS"
REM GOTO StopFunction 'Didn't let buttons work
END IF
'Results box:
IF MouseX% > 10 AND MouseX% < 69 AND MouseY% > 10 AND MouseY% < 24 AND Button% THEN
ChangeFocus (3)
GOSUB HighLights
RetMouseTrap$ = "FOCUS"
REM GOTO StopFunction 'Didn't let buttons work
END IF
'Search Button
IF MouseX% > 45 AND MouseX% < 54 AND MouseY% = 8 AND Button% THEN
RetMouseTrap$ = "SEARCH"
GOTO StopFunction
END IF
'Scroll Up Button
IF MouseY% = 12 AND MouseX% = 67 AND Button% THEN
RetMouseTrap$ = "SCROLLUP"
GOTO StopFunction
END IF
'Scroll Down Button
IF MouseY% = 22 AND MouseX% = 67 AND Button% THEN
RetMouseTrap$ = "SCROLLDOWN"
GOTO StopFunction
END IF
'Exit button
IF MouseX% > 1 AND MouseX% < 14 AND MouseY% = 2 AND Button% THEN
RetMouseTrap$ = "EXIT"
GOTO StopFunction
END IF
'Help Button
IF MouseX% > 16 AND MouseX% < 28 AND MouseY% = 2 AND Button% THEN
RetMouseTrap$ = "HELP"
END IF
HighLights:
'PURPOSE: Toggle highlight on a button
SELECT CASE HighLightStat%
CASE 1
CALL HighLight(2, 2, 13)
REM CASE 2
REM CALL HighLight(2, 17, 32)
CASE 3
CALL HighLight(2, 17, 27)
CASE 4
CALL HighLight(8, 45, 52)
CASE 5
CALL HighLight(12, 67, 67)
CASE 6
CALL HighLight(22, 67, 67)
END SELECT
RETURN
END FUNCTION
SUB SetInit
SCREEN 0
WIDTH 80, 25
COLOR 7, 0
CLS
OPEN "Temporar.txt" FOR OUTPUT AS #1: CLOSE #1
REM Initialize Mouse
regs.ax = 0
CALL Mouse
'Set TransNum%(25)
FOR Letter% = 0 TO 25
IF Letter% < 16 THEN TransNum%(Letter%) = (Letter% - 1) / 3 + 2
IF Letter% > 16 THEN TransNum%(Letter%) = (Letter% - 2) / 3 + 2
NEXT Letter%
' 2 3 4 5 6 7 8 9
'1234567890123456 89012345
'Get Word List:
OPEN "WordList.txt" FOR INPUT AS #1
FOR i% = 0 TO 849
LINE INPUT #1, Word$
WordList$(i%) = UCASE$(Word$)
NEXT i%
CLOSE #1
TabStop% = 2
OldTabStop% = 0
ResultPos% = 1
END SUB
SUB ShowCursor
SELECT CASE TabStop%
CASE 2
COLOR 31, 6
LOCATE 8, 27 + LenPhone%
PRINT "Û "
END SELECT
OldLenPhone% = LenPhone%
IF OldTabStop% = TabStop% THEN EXIT SUB
'HIDE THE OLD TABSTOP:
SELECT CASE OldTabStop%
CASE 2
COLOR 31, 6
LOCATE 8, 27 + OldLenPhone%
PRINT " "
END SELECT
OldTabStop% = TabStop%
END SUB
SUB TestNumber (Number$)
'PURPOSE: Test Number for a phrase that matches it
cmd$ = INKEY$
IF cmd$ = CHR$(27) OR UCASE$(cmd$) = "C" THEN StopSearch% = 1
IF StopSearch% = 1 THEN EXIT SUB
'------USED TO BE GOSUBED TO, BUT COULD INCLUDE IT AFTER FEW ALTERATIONS---
FOR WordNum% = 0 TO 849
Word$ = WordList$(WordNum%)
Trans$ = ""': TransInt@ = 0
FOR i% = 1 TO LEN(Word$)
Trans$ = Trans$ + LTRIM$(STR$(TransNum%(ASC(MID$(Word$, i%, 1)) - 65)))
NEXT i%
'TransInt@ = VAL(Trans$)
'IF TestNum@ = TransInt@ THEN
IF TestPhrase$ = Trans$ THEN
ResultCount% = ResultCount% + 1
PRINT #2, Beginning$ + Prev$ + Word$ + After$
OldBeginning$ = Beginning$ 'Must save Beginning$
Beginning$ = Beginning$ + Prev$ + Word$ 'because TestNumber
CALL TestNumber(After$) 'may change it.
Beginning$ = OldBeginning$ '<-Restore it here
END IF
NEXT WordNum%
'------------------------------------------------------------------
NEXT Length%
NEXT Position%
END SUB
This message has been edited by ComputerGhost on Apr 1, 2005 9:32 PM This message has been edited by ComputerGhost on Apr 1, 2005 9:28 PM