Category : BASIC Source Code
Archive   : QBTINY12.ZIP
Filename : MWORD.BAS

DECLARE SUB XQPrint (St$, BYVAL Y%, BYVAL X%, BYVAL Attr%, BYVAL Page%, BYVAL Fast%)
DECLARE SUB Delay18th (BYVAL M%)
DECLARE FUNCTION Rand% (BYVAL Range%)

DECLARE SUB GetDisplay (Adapter%, Mono%)

DEFINT A-Z

GetDisplay Adapter, Mono
IF Adapter < 3 THEN
PRINT "Sorry, you must have a color adapter (CGA, EGA, MCGA, or VGA) to run MWORD."
END
END IF

SCREEN 0, , 0, 0

DEF FNR (X) = RAND(X) + 1

DIM X(1 TO 255), Y(1 TO 255)
DIM XVector(1 TO 255), YVector(1 TO 255)
DIM XPos(1 TO 255) AS STRING * 40, YPos(1 TO 255) AS STRING * 40
DIM Colour(1 TO 255), RevColour(1 TO 255)

Cmd$ = UCASE$(LTRIM$(RTRIM$(COMMAND$)))

IF LEN(Cmd$) = 0 THEN
PRINT "MultiWord 1.2 Copyright (c) 1992 Thomas G. Hanlin III"
PRINT
PRINT "Syntax:"
PRINT " MWORD [number of words] {/Wword} {/Ddelay} {/B} {/C} {/F}"
PRINT
PRINT "Use /B for monochrome systems."
PRINT "Use /C for crawling words or /F for flying words."
PRINT
PRINT "The /W switch specifies a word (default FOO)."
PRINT "The /D switch specifies a delay in 1/18th seconds (default 1)."
END
END IF

tmp = INSTR(Cmd$, "/B")
IF tmp THEN
Mono = -1
Cmd$ = LTRIM$(RTRIM$(LEFT$(Cmd$, tmp - 1) + MID$(Cmd$, tmp + 2)))
END IF

tmp = INSTR(Cmd$, "/C")
IF tmp THEN
Crawling = -1
Cmd$ = LTRIM$(RTRIM$(LEFT$(Cmd$, tmp - 1) + MID$(Cmd$, tmp + 2)))
END IF

tmp = INSTR(Cmd$, "/F")
IF tmp THEN
Flying = -1
Cmd$ = LTRIM$(RTRIM$(LEFT$(Cmd$, tmp - 1) + MID$(Cmd$, tmp + 2)))
END IF

IF NOT (Crawling OR Flying) THEN Flying = -1

tmp = INSTR(Cmd$, "/W")
IF tmp THEN
tmp1 = INSTR(tmp, Cmd$, " ")
IF tmp1 = 0 THEN tmp1 = LEN(Cmd$) + 1
Word$ = LEFT$(LTRIM$(RTRIM$(MID$(Cmd$, tmp + 2, tmp1 - tmp - 2))), 40)
Cmd$ = LTRIM$(RTRIM$(LEFT$(Cmd$, tmp - 1) + MID$(Cmd$, tmp1 + 1)))
END IF
IF LEN(Word$) = 0 THEN
Word$ = "Foo"
END IF

WordLen = LEN(Word$)

tmp = INSTR(Cmd$, "/D")
IF tmp THEN
Num$ = ""
c = tmp + 2
DO WHILE c <= LEN(Cmd$)
IF INSTR("0123456789", MID$(Cmd$, c, 1)) THEN
Num$ = Num$ + MID$(Cmd$, c, 1)
c = c + 1
ELSE
c = LEN(Cmd$) + 1
END IF
LOOP
IF LEN(Num$) > 0 AND LEN(Num$) < 3 THEN Waits = VAL(Num$)
IF Waits < 0 THEN
Waits = 0
ELSEIF Waits > 18 THEN
Waits = 18
END IF
Cmd$ = LTRIM$(RTRIM$(LEFT$(Cmd$, tmp - 1) + MID$(Cmd$, tmp + 2 + LEN(Num$))))
ELSE
Waits = 1
END IF

Capybara = VAL(Cmd$)
IF Capybara < 1 THEN
Capybara = 1 ' the loneliest number
ELSEIF Capybara > 255 THEN
Capybara = 255 ' an orgy
END IF

PCOPY 0, 1
APage = 1

FOR Banana = 1 TO Capybara
X(Banana) = FNR(81 - WordLen)
Y(Banana) = FNR(25)
XPos(Banana) = STRING$(WordLen, X(Banana))
YPos(Banana) = STRING$(WordLen, Y(Banana))
XVector(Banana) = 2 - FNR(3)
YVector(Banana) = 2 - FNR(3)
IF Mono THEN
Colour(Banana) = 7
RevColour(Banana) = &H70
ELSE
Colour(Banana) = FNR(15)
RevColour(Banana) = Colour(Banana) * 16 AND &H70
END IF
NEXT Banana

DO
IF Crawling THEN GOSUB CrawlWrite
IF Flying THEN GOSUB FlyWrite
APage = 1 - APage
VPage = 1 - VPage
SCREEN 0, , 0, VPage
PCOPY VPage, APage
Delay18th Waits
IF Flying THEN GOSUB FlyClear
IF Crawling THEN GOSUB CrawlClear
LOOP WHILE INKEY$ = ""

SCREEN 0, , 0, 0
CLS

END


' ------------------- words fly across the screen ----------------------------


FlyWrite:
FOR Banana = 1 TO Capybara
XQPrint Word$, Y(Banana), X(Banana), Colour(Banana), APage, 1
NEXT Banana
RETURN

FlyClear:
FOR Banana = 1 TO Capybara
XQPrint SPACE$(WordLen), Y(Banana), X(Banana), 7, APage, 1
X(Banana) = X(Banana) + XVector(Banana)
IF X(Banana) > 80 THEN
X(Banana) = 1
ELSEIF X(Banana) < 1 THEN
X(Banana) = 80
END IF
Y(Banana) = Y(Banana) + YVector(Banana)
IF Y(Banana) > 25 THEN
Y(Banana) = 1
ELSEIF Y(Banana) < 1 THEN
Y(Banana) = 25
END IF
IF FNR(20) = 1 THEN XVector(Banana) = 2 - FNR(3)
IF FNR(20) = 1 THEN YVector(Banana) = 2 - FNR(3)
NEXT Banana
RETURN


' ------------------- words crawl across the screen --------------------------


CrawlWrite:
FOR Banana = 1 TO Capybara
FOR Indian = 1 TO WordLen
Y = ASC(MID$(YPos(Banana), Indian, 1))
X = ASC(MID$(XPos(Banana), Indian, 1))
Ch$ = MID$(Word$, Indian, 1)
XQPrint Ch$, Y, X, RevColour(Banana), APage,1
NEXT Indian
NEXT Banana
RETURN

CrawlClear:
Delay18th 1
FOR Banana = 1 TO Capybara
Y = ASC(MID$(YPos(Banana), WordLen, 1))
X = ASC(MID$(XPos(Banana), WordLen, 1))
XQPrint " ", Y, X, 7, APage, 1
X(Banana) = X(Banana) + XVector(Banana)
IF X(Banana) > 81 - WordLen THEN
X(Banana) = 1
ELSEIF X(Banana) < 1 THEN
X(Banana) = 81 - WordLen
END IF
Y(Banana) = Y(Banana) + YVector(Banana)
IF Y(Banana) > 25 THEN
Y(Banana) = 1
ELSEIF Y(Banana) < 1 THEN
Y(Banana) = 25
END IF
MID$(YPos(Banana), 1, WordLen) = CHR$(Y(Banana)) + LEFT$(YPos(Banana), WordLen - 1)
MID$(XPos(Banana), 1, WordLen) = CHR$(X(Banana)) + LEFT$(XPos(Banana), WordLen - 1)
IF FNR(20) = 1 THEN XVector(Banana) = 2 - FNR(3)
IF FNR(20) = 1 THEN YVector(Banana) = 2 - FNR(3)
NEXT Banana
RETURN