| Welcome, Guest |
You have to register before you can post on our site.
|
| Forum Statistics |
» Members: 472
» Latest member: JonnyWi
» Forum threads: 2,754
» Forum posts: 26,111
Full Statistics
|
|
|
| Pete's Handy Dandy File Compare Tool |
|
Posted by: Pete - 11-12-2024, 02:39 AM - Forum: Utilities
- No Replies
|
 |
Code: (Select All)
_Title"File Compare Tool"
' Keys...
' If the files are identical, it will instantly inform you.
' If the files are different, it will display both codes, line by line and pause with a "No Match!" alert were the code is different.
' When paused you can...
' F1 Copy to the clipboard the no match line (last line shown) of the 1st file.
' F2 Copy to the clipboard the no match line (last line shown) of the 2nd file.
' Note: Copy the line and paste it into an IDE search to find the code in your program.
' 1 Scroll to the next line of the 1st file.
' 2 Scroll to the next line of the 2nd file.
' Spacebar Toggle to pause/resume code while it is scrolling.
' Enter Auto continue (scroll both) to the next no match.
' Esc Quit
Width 150, 41
_Font 16
_ScreenMove 20, 0
v1top = 2: v1btm = 20
v2top = 22: v2btm = 40
View Print
Cls
target1$ = _OpenFileDialog$("Select First File to Compare", "", "*.*", "", 0)
target2$ = _OpenFileDialog$("Select Second File to Compare", "", "*.*", "", 0)
dir1$ = Mid$(target1$, 1, _InStrRev(target1$, "\"))
file1$ = Mid$(target1$, _InStrRev(target1$, "\") + 1)
dir2$ = Mid$(target2$, 1, _InStrRev(target2$, "\"))
file2$ = Mid$(target2$, _InStrRev(target2$, "\") + 1)
If dir1$ + file1$ = dir2$ + file2$ Then
Beep
Print: Print " Error: Both directory and file names are the same. Cannot compare the same file. Any key to redo": Sleep
If InKey$ = Chr$(27) Then System Else Run
End If
_Delay 1
start:
Cls
Locate 1, 1: Color 15, 1: Print Space$(_Width);
Locate 21, 1: Print Space$(_Width);
Locate 1, 2: Color 15, 1: Print dir1$;: Color 14, 1: Print file1$;
Locate 21, 2: Color 15, 1: Print dir2$;: Color 14, 1: Print file2$;
Color 7, 0
ReDim c1$(20000), c2$(20000): c1 = 0: p1 = 0: c2 = 0: p2 = 0
' Quick compare...
If Not _FileExists(dir1$ + file1$) Then
Print: Print: Print " Cannot find file: " + dir1$ + file1$ + ". Any key to retry.": _Delay 1: Sleep
End If
If Not _FileExists(dir2$ + file2$) Then
Print: Print: Print " Cannot find file: " + dir2$ + file2$ + ". Any key to retry.": _Delay 1: Sleep
End If
Open dir1$ + file1$ For Binary As #1
Open dir2$ + file2$ For Binary As #2
x1$ = Space$(LOF(1))
x2$ = Space$(LOF(2))
Get #1, , x1$
Get #2, , x2$
Close #1, 2
If x1$ = x2$ Then
Locate 41, 2: Print "Both files are identical. Press Enter to rerun or Esc to quit...";
Do
_Limit 30
b$ = InKey$
If Len(b$) Then
Select Case b$
Case Chr$(27)
System
Case Chr$(13): Cls: _Delay 1: Run
End Select
End If
Loop
End If
Open dir1$ + file1$ For Input As #1
Open dir2$ + file2$ For Input As #2
Do Until EOF(1)
Line Input #1, a$
a$ = RTrim$(LTrim$(a$))
If Mid$(a$, 1, 1) > " " Then
c1 = c1 + 1
c1$(c1) = a$
End If
Loop
Close #1
Do Until EOF(2)
Line Input #2, a$
a$ = RTrim$(LTrim$(a$))
If Mid$(a$, 1, 1) > " " Then
c2 = c2 + 1
c2$(c2) = a$
End If
Loop
Close #2
Locate 2, 1
onscr1$ = c1$(1)
onscr2$ = c1$(1)
yy1 = v1top: yy2 = v2top
p1 = 0: p2 = 0: auto = -1
Do
_Limit 300 ' Controls speed of screen display.
If auto = -1 And b$ <> Chr$(13) Then
If onscr1$ <> onscr2$ Then
Locate 41, 2
Color 14, 0
Print "No Match! ";
auto = 0
Color 7, 0
End If
End If
If auto Then
p$ = InKey$
Select Case p$
Case Chr$(27): System
Case Chr$(32)
y = CsrLin: x = Pos(0): Locate 41, 2: Color 14, 0: Print " Paused...";: Color 7, 0
Do: _Limit 30: p$ = InKey$: Loop Until p$ = Chr$(32)
Locate 41, 2: Print " ";
Locate y, x
Case "r", "R"
View Print: Run
Case Chr$(8), "V", "v"
View Print: GoTo start
End Select
If auto < 0 Then b$ = "1": auto = 1 Else b$ = "2": auto = -1
Else
b$ = InKey$
End If
If Len(b$) Then
Select Case b$
Case Chr$(27): System
Case "r", "R": View Print: Run
Case "v", "V", Chr$(8): View Print: GoTo start
Case Chr$(0) + Chr$(59): _Clipboard$ = c1$(p1)
Case Chr$(0) + Chr$(60): _Clipboard$ = c2$(p2)
Case Chr$(13), Chr$(0) + "P": b$ = Chr$(13): auto = -1: Locate 41, 2, 1, 7, 0: Print " ";
Case "1", "2"
Locate 41, 2, 1, 7, 0: Print " ";
If b$ = "1" And Len(c1$(p1 + 1)) Then
View Print v1top To v1btm
p1 = p1 + 1
Locate yy1, 1: Print p1; c1$(p1): yy1 = CsrLin
onscr1$ = c1$(p1)
End If
If b$ = "2" And Len(c2$(p2 + 1)) Then
View Print v2top To v2btm
p2 = p2 + 1
Locate yy2, 1: Print p2; c2$(p2): yy2 = CsrLin
onscr2$ = c2$(p2)
End If
End Select
End If
If p1 = c1 And p2 = c2 Then Exit Do
Loop
Close
Locate _Height, 2: Color 14, 0: Print "Finished. [R]un [V]iew Again [Q]uit: ";
Color 7, 0
Do
_Limit 30
b$ = InKey$
If Len(b$) Then
If UCase$(b$) = "Q" Or b$ = Chr$(27) Then System
If UCase$(b$) = "R" Then View Print: Cls: Run
If UCase$(b$) = "V" Or b$ = Chr$(8) Then View Print: GoTo start
End If
Loop
System
Much appreciation to the QB64 Dev Team for the _OpenFileDialog statement. It chopped my code required in half!
Here is a screen shot:
Pete
|
|
|
| Html to QB64 Quote Converter |
|
Posted by: Pete - 11-11-2024, 11:30 PM - Forum: Utilities
- Replies (3)
|
|
Ever get sick and tired of typing endless CHR$(34) additions to quoted text so it can be used in the IDE. Really, just me? Well I'll post this anyway.
Code: (Select All)
' Automatically adds quotes in correct places to convert html to QB64.
Width 20, 5: _Font 16: _ScreenHide
a$ = _Clipboard$
For i = 1 To Len(a$)
If Asc(Mid$(a$, i, 1)) < 32 Then _Continue
b$ = b$ + Mid$(a$, i, 1)
If Mid$(a$, i, 1) = Chr$(34) Then b$ = b$ + " + chr$(34) + " + Chr$(34)
Next
b$ = "a$ = " + Chr$(34) + b$ + Chr$(34)
seed = 1 ' Adjust for alt = ""
Do
c = c + 1
q = InStr(seed, b$, Chr$(34) + Chr$(34))
If q Then
b$ = Mid$(b$, 1, InStr(seed, b$, Chr$(34) + Chr$(34)) - 2) + Mid$(b$, InStr(seed, b$, Chr$(34) + Chr$(34)) + 4)
Else
Exit Do
End If
seed = q + 3
If c > 1000 Then Beep: System
Loop
If Right$(b$, 2) = " +" Then b$ = Mid$(b$, 1, Len(b$) - 2) ' Remove any trailing + sign.
_Clipboard$ = b$
System
So just compile and make a desktop shortcut. When you need to us it, just copy the text you want converted to your clipboard, click the short cut, and paste the converted results. Nothing will show up on your screen, it's all handled in the background.
PRINT CHR$(34) + "Pete" + CHR$(34)
|
|
|
|
| Happy Veterans Day Terry - And all others who served. |
|
Posted by: Pete - 11-11-2024, 06:09 PM - Forum: Announcements
- Replies (1)
|
|
With our world often a powder keg, it takes great courage and patriotism to sign up to serve. We should all appreciate our freedom in America and remember we all have a stake in protecting it.
Happy Veterans Day
Pete
- Oh who's kidding who, I was just getting tired of seeing "Happy Birthday Steve!" in the announcements.
Side note: And folks like Terry are why I can joke around the way I do. Thanks, sincerely.
|
|
|
|
| Find Replace with Wrap |
|
Posted by: Pete - 11-10-2024, 10:10 PM - Forum: Utilities
- Replies (10)
|
|
Use the mouse or keyboard to make menu selections.
There is a right click menu for find and replace to cut/copy/paste, etc.
You can find or replace text or sentences across line-breaks.
The edited file can be saved with a -new addition to the file name.
Note this utility is not a WP, so you cannot type to the file. It also was not made to scroll files longer than the page height, but it will tell you how many finds/replace, it encountered.
Code: (Select All)
DEFINT A-Z
main find$, replace$
SYSTEM
SUB main (find$, replace$)
WIDTH 140, 43: _FONT 16: _SCREENMOVE 0, 0
mypalette
COLOR 7, 1: CLS
target$ = _OPENFILEDIALOG$("Open a file to to be searched:", "", "*.*", "", 0)
IF target$ = "" THEN SYSTEM
file$ = MID$(target$, _INSTRREV(target$, "\") + 1)
DO
IF orig$ = "" THEN
COLOR 7, 1: CLS
IF _FILEEXISTS(target$) THEN ELSE PRINT "Error, file not found: " + target$: END
OPEN target$ FOR BINARY AS #1
a$ = SPACE$(LOF(1))
GET #1, , a$
CLOSE #1
orig$ = a$
GOSUB show1
END IF
msg$ = "[Ctrl + F] Search [Esc] Quit"
LOCATE _HEIGHT, 1, 0: PRINT SPACE$(_WIDTH);
g = _WIDTH / 2 - LEN(msg$) / 2
LOCATE _HEIGHT, g, 0: PRINT msg$;
map$ = SPACE$(_WIDTH)
MID$(map$, g) = msg$
DO
IF redo THEN
redo = 0: b$ = CHR$(6)
ELSE
my_mse_kbd lb, mb, rb, my, mx, mw, shift%, clkcnt, drag, b$, mhovery, mhoverx
END IF
IF lb = 1 THEN
f = _INSTRREV(mx, map$, "[") + 1
g = INSTR(mx, map$, "]") - f
msel$ = MID$(map$, f, g)
SELECT CASE LCASE$(msel$)
CASE "esc": b$ = CHR$(27)
CASE "ctrl + f": b$ = CHR$(6)
END SELECT
END IF
SELECT CASE b$
CASE CHR$(6)
LOCATE _HEIGHT, 1: PRINT SPACE$(_WIDTH);: LOCATE 1, 1
myform fld, yfield(), xfield(), flen(), maxlen(), text$(), mtop, mleft, mhovery, mhoverx, b1TopLtx, b1BtmRtx, b1TopRty, b1BtmLty, b2TopLtx, b2BtmRtx, b2TopRty, b2BtmLty, inpclose, find$, replace$, findreplace
IF inpclose THEN inpclose = 0: EXIT DO ELSE inpclose = 0 ' Popup input window closed.
CASE CHR$(27)
SYSTEM
END SELECT
LOOP
LOCATE , , 0
IF find$ <> replace$ THEN ' Note Len(find$) was set in input mode so it cannot be zero.
a2$ = a$: fnd = 0: lb = 0: c = 0
DO ' Strip out line-breaks and substitute a space for a single line-break.
q = INSTR(seed, a$, CHR$(13) + CHR$(10))
IF q THEN
IF MID$(a$, q + 2, 2) = CHR$(13) + CHR$(10) OR MID$(a$, q + 2) = "" THEN
sp$ = "": sp2$ = ""
FOR j = 0 TO LEN(a2$) STEP 2
IF MID$(a2$, q + j, 2) <> CHR$(13) + CHR$(10) THEN EXIT FOR
NEXT
IF j THEN lb = lb + 1: REDIM _PRESERVE line_break(lb) AS INTEGER: line_break(lb) = j / 2
ELSE
sp$ = " ": sp2$ = CHR$(10): IF j THEN sp2$ = CHR$(13)
j = 0
END IF
a$ = MID$(a$, 1, q - 1) + sp$ + MID$(a$, q + 2)
a2$ = MID$(a2$, 1, q - 1) + sp2$ + MID$(a2$, q + 2)
seed = q
ELSE
EXIT DO
END IF
c = c + 1: IF c > 1000 THEN PRINT "Oops. We went over 1000 loops without completing the routine.": END ' For beta version this prevents an endless loop for any unhandled condition.
LOOP
' So now a$ is stripped of line-breaks and a2$ is the same length as a$, but
' has single control characters Chr$(10) for a single line-break and chr$(13)
' for multiple line-breaks. So 1 character instead of 2 for Chr$(13) + Chr$(10).
seed = 1: r1 = 0: r2 = 0
DO ' Find and Replace.
q = INSTR(seed, LCASE$(a$), LCASE$(find$))
IF q THEN
i = INSTR(MID$(a2$, q, LEN(find$)), CHR$(10))
IF i = 0 THEN i = INSTR(MID$(a2$, q, LEN(find$)), CHR$(13))
IF LTRIM$(find$) = "" AND i = 0 OR LTRIM$(find$) <> "" THEN ' Space over Chr$(10) exception.
fnd = fnd + 1
r1 = r1 + 1: REDIM _PRESERVE r1(r1): r1(r1) = q ' Position of the 1st character of the found string.
r2 = r2 + 1: REDIM _PRESERVE r2(r2)
ELSE
falseflag = 1
END IF
k = 0: seed2 = 1
DO
i = INSTR(seed2, MID$(a2$, 1, q), CHR$(10))
IF i THEN k = k + 1 ELSE EXIT DO
seed2 = i + 1
LOOP
l = 0: m = 0: seed2 = 1
DO
i = INSTR(seed2, MID$(a2$, 1, q), CHR$(13))
IF i THEN
l = l + 1: m = m + line_break(l) * 2 - 1
ELSE
EXIT DO
END IF
seed2 = i + 1
LOOP
IF falseflag = 0 THEN r2(r2) = q + k + m ELSE falseflag = 0
seed = q + LEN(find$)
ELSE
IF LEN(find2$) THEN find2$ = "": EXIT DO
IF fnd THEN
EXIT DO
ELSE ' Perform a marquee vertical search.
x$ = ""
find2$ = find$
FOR i = 1 TO LEN(find2$)
x$ = x$ + MID$(find2$, i, 1) + " "
NEXT
find$ = MID$(x$, 1, LEN(x$) - 1) ' Remove trailing space
x$ = ""
END IF
END IF
LOOP
UBr1 = r1: UBr2 = r2
LOCATE _HEIGHT, 1, 0
COLOR 7, 1
IF fnd THEN
IF fnd = 1 THEN msg$ = " match " ELSE msg$ = " matches "
PRINT LTRIM$(STR$(fnd)) + msg$ + "found:";
LOCATE 1, 1
IF findreplace THEN ' Replace. See Else statement for Find only.
j = 0: a$ = ""
CLS
r1 = 1: r2 = 1
DO
i1 = INSTR(a2$, CHR$(10))
i3 = INSTR(a2$, CHR$(13))
i4 = r1(r1): IF i4 THEN i4 = i4 - chop
WHILE -1
IF i1 THEN
IF i1 < i3 OR i3 = 0 THEN
IF i1 < i4 OR i4 = 0 THEN
q = i1
x$ = CHR$(13) + CHR$(10)
GOSUB assemble
EXIT WHILE
END IF
END IF
END IF
IF i3 THEN
IF i3 < i1 OR i1 = 0 THEN
IF i3 < i4 OR i4 = 0 THEN
q = i3
j = j + 1: x$ = ""
FOR k = 1 TO line_break(j): x$ = x$ + CHR$(13) + CHR$(10): NEXT
GOSUB assemble
EXIT WHILE
END IF
END IF
END IF
IF i4 THEN
IF i4 < i1 OR i1 = 0 THEN
IF i4 < i3 OR i3 = 0 THEN
x$ = replace$
q = i4
GOSUB assemble
x$ = MID$(a2$, 1, LEN(find$))
FOR i = 1 TO LEN(find$) - 1
SELECT CASE MID$(a2$, i, 1)
CASE CHR$(10)
lb$ = CHR$(13) + CHR$(10)
CASE CHR$(13)
j = j + 1: x$ = ""
FOR k = 1 TO line_break(j): lb$ = lb$ + CHR$(13) + CHR$(10): NEXT
END SELECT
NEXT
a$ = a$ + lb$: lb$ = ""
q = LEN(find$)
IF MID$(a2$, q, 1) = " " AND RIGHT$(a$, 2) = CHR$(13) + CHR$(10) THEN
q = q + 1 ' Remove leading space.
END IF
a2$ = MID$(a2$, q)
chop = chop + q - 1
IF r1 < UBr1 THEN r1 = r1 + 1 ELSE r1 = 0 ' Turn off.
IF r2 < UBr2 THEN r2 = r2 + 1 ELSE r2 = 0 ' Turn off.
EXIT WHILE
END IF
END IF
END IF
a$ = a$ + a2$: a2$ = "": EXIT DO ' End of file.
EXIT WHILE
WEND
LOOP
GOSUB show2
ELSE ' Find
GOSUB showfind
j = 0
END IF
ELSE
PRINT "No match found:";
END IF
REM Shell _DontWait _Hide "start notepad"
ELSE
findreplace = 0 ' Cancel replace.
msg$ = "Find and Replace are the same."
LOCATE _HEIGHT, 1: PRINT msg$;
END IF ' Completed replace.
IF findreplace THEN
LOCATE _HEIGHT, 1: PRINT "Replacement count:"; fnd;
msg$ = "[S]ave File [R]evert to Saved [Enter] Run [Ctrl + F] Search Again [Esc] Quit"
ELSE
msg$ = "[Enter] Run [Ctrl + F] Search Again [Esc] Quit"
END IF
g = _WIDTH / 2 - LEN(msg$) / 2
LOCATE _HEIGHT, g, 0: PRINT msg$;
map$ = SPACE$(_WIDTH)
MID$(map$, g) = msg$
WHILE -1
my_mse_kbd lb, mb, rb, my, mx, mw, shift%, clkcnt, drag, b$, mhovery, mhoverx
IF lb = 1 THEN
f = _INSTRREV(mx, map$, "[") + 1
g = INSTR(mx, map$, "]") - f
msel$ = MID$(map$, f, g)
SELECT CASE LCASE$(msel$)
CASE "enter": b$ = CHR$(13)
CASE "esc": b$ = CHR$(27)
CASE "ctrl + f": b$ = CHR$(6)
CASE "r": b$ = "R"
CASE "s": b$ = "S"
END SELECT
END IF
SELECT CASE b$
CASE "R", "r"
IF findreplace THEN
GOSUB clrvars: orig$ = ""
EXIT WHILE
END IF
CASE "S", "s"
IF findreplace THEN
save$ = MID$(file$, 1, _INSTRREV(file$, ".") - 1) + "-new" + MID$(file$, _INSTRREV(file$, "."))
save$ = _SAVEFILEDIALOG$("Save File As", save$, "*" + MID$(file$, _INSTRREV(file$, ".")), "")
IF LEN(save$) THEN
OPEN save$ FOR OUTPUT AS #1
PRINT #1, a$
CLOSE #1
orig$ = a$
GOSUB clrvars: CLS: LOCATE 1, 1: GOSUB show2
EXIT WHILE
END IF
END IF
CASE CHR$(13): CLS: _DELAY .5: RUN
CASE CHR$(27): SYSTEM
CASE CHR$(6)
IF findreplace THEN orig$ = a$ ELSE a$ = orig$
GOSUB clrvars: CLS: LOCATE 1, 1: GOSUB show2
redo = 1: EXIT WHILE
END SELECT
WEND
LOCATE _HEIGHT, 1: PRINT SPACE$(_WIDTH);: LOCATE 1, 1
LOOP
EXIT SUB
assemble:
a$ = a$ + MID$(a2$, 1, q - 1) + x$
a2$ = MID$(a2$, q + 1): chop = chop + q
RETURN
show1:
FOR i = 1 TO LEN(a$)
x$ = MID$(a$, i, 1)
IF x$ = CHR$(13) THEN PRINT: i = i + 1: _CONTINUE
PRINT x$;
IF CSRLIN > _HEIGHT - 2 THEN EXIT FOR
NEXT
LOCATE 1, 1: x$ = ""
RETURN
showfind:
y = CSRLIN: x = POS(0)
j = 1: k = 0
FOR i = 1 TO LEN(orig$)
x$ = MID$(orig$, i, 1)
IF x$ = CHR$(13) THEN
IF k AND breaks = 0 THEN
k = k + 1 ' Line-break eliminated one space.
breaks = 1
END IF
PRINT: i = i + 1: _CONTINUE
END IF
IF i = r2(j) THEN
j = j + 1: IF j > UBr1 THEN j = 0
COLOR 0, 4: k = 1
END IF
IF k > LEN(find$) THEN k = 0: COLOR 7, 1
PRINT x$;
breaks = 0
IF k THEN k = k + 1
IF CSRLIN > _HEIGHT - 2 THEN EXIT FOR
NEXT
x$ = "": j = 0: k = 0: breaks = 0
LOCATE y, x
RETURN
show2:
FOR i = 1 TO LEN(a$)
x$ = MID$(a$, i, 1)
IF x$ = CHR$(13) THEN PRINT: i = i + 1: _CONTINUE
PRINT x$;
IF CSRLIN > _HEIGHT - 2 THEN EXIT FOR
NEXT
x$ = ""
RETURN
clrvars:
a2$ = "": x$ = "": sp$ = "": sp2$ = "": find$ = "": find2$ = "": replace$ = ""
i = 0: j = 0: k = 0: l = 0: m = 0: lb = 0: q = 0: fnd = 0: breaks = 0
seed = 0: seed1 = 0: seed2 = 0: findreplace = 0: falseflag = 0
ERASE line_break: ERASE r1: ERASE r2
chop = 0: UBr1 = 0: UBr2 = 0
RETURN
END SUB
SUB myform (fld, yfield(), xfield(), flen(), maxlen(), text$(), mtop, mleft, mhovery, mhoverx, b1TopLtx, b1BtmRtx, b1TopRty, b1BtmLty, b2TopLtx, b2BtmRtx, b2TopRty, b2BtmLty, inpclose, find$, replace$, findreplace)
myform_c1 = _DEFAULTCOLOR: myform_c2 = _BACKGROUNDCOLOR
ctext = 15: hl1 = 0: hl2 = 4
PCOPY 0, 2
REM mypalette Already called in main for screen color.
mtop = 3: mwidth = 60: mheight = 11: mleft = 5
RESTORE myformdata
j = 0: noe = 7 ' Number of elements in each data field.
DO
j = j + 1
READ a$
IF a$ = "EOF" THEN EXIT DO
IF j MOD noe = 0 THEN j = 0: fld = fld + 1 ' Number of fields from our data statement.
LOOP
REDIM ncol(fld) ' Name start column.
REDIM nfield$(fld) ' Name.
REDIM yfield(fld) ' Row.
REDIM xfield(fld) ' Column.
REDIM flen(fld) ' Field length.
REDIM maxlen(fld) ' Max text length.
REDIM text$(fld) ' Text input
RESTORE myformdata
DO ' Falx loop.
FOR i = 1 TO fld
FOR j = 1 TO noe: READ a$: IF a$ = "EOF" THEN EXIT DO
SELECT CASE j
CASE 1: ncol(i) = VAL(a$) + mleft
CASE 2: nfield$(i) = a$
CASE 3: yfield(i) = VAL(a$) + mtop
CASE 4: xfield(i) = VAL(a$) + mleft
CASE 5: flen(i) = VAL(a$)
CASE 6: maxlen(i) = VAL(a$)
CASE 7: text$(i) = a$
' Edit # of cases if noe is changed from 5.
END SELECT
NEXT j
NEXT
LOOP
COLOR 0, 5
LOCATE mtop, mleft
COLOR 0, 5
PRINT CHR$(218) + STRING$(mwidth - 2, 196) + CHR$(191)
FOR i = 1 TO mheight - 2
LOCATE , mleft
PRINT CHR$(179); SPACE$(mwidth - 2) + CHR$(179)
NEXT
COLOR 0, 5: LOCATE , mleft
PRINT CHR$(192) + STRING$(mwidth - 2, 196) + CHR$(217)
' Shadow below.
LOCATE , mleft + 1: COLOR 8, 0
FOR i = 1 TO mwidth + 1
x = SCREEN(CSRLIN, POS(0))
PRINT CHR$(x);
NEXT
' Shadow to right.
LOCATE mtop + 1
FOR i = 1 TO mheight - 1
LOCATE , mleft + mwidth
x = SCREEN(CSRLIN, POS(0))
PRINT CHR$(x);
x = SCREEN(CSRLIN, POS(0))
PRINT CHR$(x)
NEXT
' Close symbol.
COLOR 0, 5: LOCATE mtop, mleft + mwidth - 4: PRINT " x ";
mhoverx = mleft + mwidth - 3: mhovery = mtop
' Buttons
LOCATE mtop + 7, mleft + 14: b1TopRty = CSRLIN: b1TopLtx = POS(0)
PRINT CHR$(218) + STRING$(12, 196) + CHR$(191)
LOCATE , mleft + 14
PRINT CHR$(179); SPACE$(12) + CHR$(179);
LOCATE CSRLIN + 1, mleft + 14
PRINT CHR$(192) + STRING$(12, 196) + CHR$(217);: b1BtmLty = CSRLIN: b1BtmRtx = POS(0) - 1
LOCATE mtop + 8, mleft + 17: PRINT "Find All"
LOCATE mtop + 7, mleft + 32: b2TopRty = CSRLIN: b2TopLtx = POS(0)
PRINT CHR$(218) + STRING$(13, 196) + CHR$(191)
LOCATE , mleft + 32
PRINT CHR$(179); SPACE$(13) + CHR$(179)
LOCATE , mleft + 32
PRINT CHR$(192) + STRING$(13, 196) + CHR$(217);: b2BtmLty = CSRLIN: b2BtmRtx = POS(0) - 1
LOCATE mtop + 8, mleft + 34: PRINT "Replace All"
' Fields.
FOR i = 1 TO fld
LOCATE yfield(i), ncol(i)
COLOR 0, 5
PRINT nfield$(i); ":";
LOCATE yfield(i), xfield(i) - 1
COLOR 0, 5: PRINT CHR$(222);
COLOR 15, 0: PRINT SPACE$(flen(i));
NEXT
COLOR 15, 0
fld = 1 ' Set to first field.
LOCATE yfield(fld), xfield(fld)
DO
myinput find$, replace$, findreplace, ctext, hl1, hl2, fld, inpclose, yfield(), xfield(), flen(), maxlen(), text$(), mtop, mleft, mhovery, mhoverx, b1TopLtx, b1BtmRtx, b1TopRty, b1BtmLty, b2TopLtx, b2BtmRtx, b2TopRty, b2BtmLty
IF inpclose THEN EXIT DO
LOOP
COLOR myform_c1, myform_c2
EXIT SUB '--------------------------------------------------------->
myformdata: ' Name column, name, input row, input column, input length, max length, initial text
DATA 3,"Find",2,12,43,250,""
DATA 3,"Replace",5,12,43,250,""
DATA EOF
END SUB
SUB myinput (find$, replace$, findreplace, ctext, hl1, hl2, fld, inpclose, yfield(), xfield(), flen(), maxlen(), text$(), mtop, mleft, mhovery, mhoverx, b1TopLtx, b1BtmRtx, b1TopRty, b1BtmLty, b2TopLtx, b2BtmRtx, b2TopRty, b2BtmLty)
' Single line keyboard routine for input.
STATIC tabx AS INTEGER, tabmax AS INTEGER, mhlinput AS _BIT, menu$()
IF tabx = 0 THEN tabx = 1: tabmax = 4
LOCATE , , 1 ' Show cursor.
start_column = xfield(fld) ' Margin right.
mr = start_column + flen(fld)
y = yfield(fld): x = xfield(fld) ' Initial cursor position.
DO
_LIMIT 60
string_pos = POS(0) - start_column ' Track cursor and word position.
my_mse_kbd lb, mb, rb, my, mx, mw, shift%, clkcnt, drag, b$, mhovery, mhoverx
bmovr = mx > b1TopLtx AND mx < b1BtmRtx AND my > b1TopRty AND my < b1BtmLty
IF tabx = 3 OR bmovr THEN
y = CSRLIN: x = POS(0)
mc1 = 1: mycolor mc1
IF tabx = 3 AND NOT bmovr THEN COLOR 9, 5 ELSE COLOR 12, 5
LOCATE mtop + 7, mleft + 14, 0 ' Hide cursor.
PRINT CHR$(218) + STRING$(12, 196) + CHR$(191)
LOCATE , mleft + 14
PRINT CHR$(179);: LOCATE , POS(0) + 12: PRINT CHR$(179);
LOCATE CSRLIN + 1, mleft + 14
PRINT CHR$(192) + STRING$(12, 196) + CHR$(217);
b1hover = 1
LOCATE y, x
IF tabx < 3 THEN LOCATE , , 1 ' Show cursor.
mc1 = 2: mycolor mc1
ELSE
IF b1hover THEN
y = CSRLIN: x = POS(0)
mc1 = 1: mycolor mc1
COLOR 0, 5
LOCATE mtop + 7, mleft + 14, 0 ' Hide cursor.
PRINT CHR$(218) + STRING$(12, 196) + CHR$(191)
LOCATE , mleft + 14
PRINT CHR$(179);: LOCATE , POS(0) + 12: PRINT CHR$(179);
LOCATE CSRLIN + 1, mleft + 14
PRINT CHR$(192) + STRING$(12, 196) + CHR$(217);
b1hover = 0
LOCATE y, x
IF tabx < 3 THEN LOCATE , , 1 ' Show cursor.
mc1 = 2: mycolor mc1
END IF
END IF
bmovr = mx > b2TopLtx AND mx < b2BtmRtx AND my > b2TopRty AND my < b2BtmLty
IF tabx = 4 OR bmovr THEN
y = CSRLIN: x = POS(0)
mc1 = 1: mycolor mc1
IF tabx = 4 AND NOT bmovr THEN COLOR 9, 5 ELSE COLOR 12, 5
LOCATE mtop + 7, mleft + 32, 0 ' Hide cursor.
PRINT CHR$(218) + STRING$(13, 196) + CHR$(191)
LOCATE , mleft + 32
PRINT CHR$(179);: LOCATE , POS(0) + 13: PRINT CHR$(179);
LOCATE CSRLIN + 1, mleft + 32
PRINT CHR$(192) + STRING$(13, 196) + CHR$(217);
b2hover = 1
LOCATE y, x
IF tabx < 3 THEN LOCATE , , 1 ' Show cursor.
mc1 = 2: mycolor mc1
ELSE
IF b2hover THEN
y = CSRLIN: x = POS(0)
mc1 = 1: mycolor mc1
COLOR 0, 5
LOCATE mtop + 7, mleft + 32, 0 ' Hide cursor.
PRINT CHR$(218) + STRING$(13, 196) + CHR$(191)
LOCATE , mleft + 32
PRINT CHR$(179);: LOCATE , POS(0) + 13: PRINT CHR$(179);
LOCATE CSRLIN + 1, mleft + 32
PRINT CHR$(192) + STRING$(13, 196) + CHR$(217);
b2hover = 0
LOCATE y, x
IF tabx < 3 THEN LOCATE , , 1 ' Show cursor.
mc1 = 2: mycolor mc1
END IF
END IF
IF drag = 0 AND mhlinput THEN mhlinput = 0 ' Quit mouse input line highlighting.
IF lb > 0 OR drag THEN ' Mouse button events.
DO
IF drag THEN
IF my = yfield(fld) OR mhlinput THEN
IF mx >= start_column - hscr AND mx <= start_column + LEN(text$(fld)) - hscr OR mhlinput THEN
mhlinput = -1
IF drag > 0 THEN
IF mx > POS(0) - 1 THEN
shift% = -1: GOSUB cursor_forward
string_pos = POS(0) - start_column
y = CSRLIN: x = POS(0)
END IF
ELSE
IF mx < POS(0) THEN
shift% = -1: GOSUB cursor_back
string_pos = POS(0) - start_column
y = CSRLIN: x = POS(0)
END IF
END IF
END IF
EXIT DO
END IF
END IF
IF lb = 1 OR clkcnt THEN
FOR i = 1 TO UBOUND(yfield) ' Locate input line.
IF my = yfield(i) AND mx >= xfield(i) AND mx <= xfield(i) + flen(i) THEN i = -i: EXIT FOR
NEXT
IF i < 0 THEN ' Mouse cursor in an input field.
IF hl THEN GOSUB hl_off
i = ABS(i)
IF i <> 1 THEN IF text$(1) = "" THEN BEEP: EXIT DO ' Unique restriction when no text is present in first input field.
fld = i: tabx = i
IF clkcnt THEN GOSUB select_all ELSE GOSUB relocate
y = CSRLIN: x = POS(0)
END IF
EXIT DO
END IF
IF lb = 2 THEN ' Mouse button pressed and released.
IF mx > b1TopLtx AND mx < b1BtmRtx AND my > b1TopRty AND my < b1BtmLty THEN
IF LEN(text$(1)) THEN
' Form button 1 selected.
y = CSRLIN: x = POS(0)
mc1 = 1: mycolor mc1
FOR i = 1 TO 2
IF i = 1 THEN COLOR 1, 5 ELSE COLOR 0, 5
LOCATE mtop + 7, mleft + 14, 1
PRINT CHR$(218) + STRING$(12, 196) + CHR$(191)
LOCATE , mleft + 14
PRINT CHR$(179);: LOCATE , POS(0) + 12: PRINT CHR$(179);
LOCATE CSRLIN + 1, mleft + 14
PRINT CHR$(192) + STRING$(12, 196) + CHR$(217);
_DELAY .1
NEXT
mc1 = 2: mycolor mc1
b1hover = 0
find$ = text$(1)
text$(1) = "": text$(2) = ""
inpclose = 1
LOCATE y, x, 1
EXIT DO
ELSE
BEEP
END IF
END IF
IF mx > b2TopLtx AND mx < b2BtmRtx AND my > b2TopRty AND my < b2BtmLty THEN
IF LEN(text$(1)) THEN
' Form button 2 selected.
y = CSRLIN: x = POS(0)
mc1 = 1: mycolor mc1
FOR i = 1 TO 2
IF i = 1 THEN COLOR 1, 5 ELSE COLOR 0, 5
LOCATE mtop + 7, mleft + 32, 1
PRINT CHR$(218) + STRING$(13, 196) + CHR$(191)
LOCATE , mleft + 32
PRINT CHR$(179);: LOCATE , POS(0) + 13: PRINT CHR$(179);
LOCATE CSRLIN + 1, mleft + 32
PRINT CHR$(192) + STRING$(13, 196) + CHR$(217);
_DELAY .1
NEXT
b2hover = 0
mc1 = 2: mycolor mc1
IF hl THEN GOSUB hl_off
find$ = text$(1): replace$ = text$(2)
findreplace = 1
text$(1) = "": text$(2) = ""
inpclose = 1
LOCATE y, x, 1
EXIT DO
ELSE
BEEP
END IF
END IF
IF mx = mhoverx AND my = mhovery THEN
y = CSRLIN: x = POS(0)
inpclose = -1
LOCATE my, mx - 1, 0
mc1 = 2: mycolor mc1
PALETTE 2, 44
COLOR 7, 6
PRINT " x ";
_DELAY .2
PALETTE 2, 36
LOCATE my, mx - 1
COLOR 15, 6
PRINT " x ";
mc1 = 2: mycolor mc1
_DELAY .1
LOCATE y, x
END IF
EXIT DO
END IF
PRINT "error": END ' No condition should end up here.
LOOP
IF inpclose THEN EXIT DO
END IF
IF rb = 2 THEN
IF menu.var < 1 THEN
IF my <> yfield(fld) THEN ' Check for change input field click.
FOR i = 1 TO UBOUND(yfield)
IF my = yfield(i) THEN ' Change input fields.
IF i <> 1 THEN IF text$(1) = "" THEN BEEP: EXIT DO ' Unique restriction when no text is present in first input field.
fld = i: tabx = i
GOSUB relocate
EXIT FOR
END IF
NEXT
END IF
MyPopup menu$(), text$(), fld, hl, menu.var, b$
LOCATE , , 1 ' Show cursor
COLOR ctext, 0 ' Note for future changes: This should be done in popup.
SELECT CASE menu.var
CASE 1: b$ = CHR$(24)
CASE 2: b$ = CHR$(3)
CASE 3: b$ = CHR$(22)
CASE 4: b$ = CHR$(0) + "S"
CASE 5: b$ = CHR$(1)
CASE 6 ' Do nothing.
CASE 7: b$ = CHR$(27)
END SELECT
menu.var = 0
END IF
END IF
IF LEN(b$) THEN
SELECT CASE b$
CASE CHR$(27) ' Esc key.
inpclose = -1
ERASE text$
EXIT DO ' Leave sub and close window.
CASE CHR$(9) ' Tab key. Change text fields.
IF hl THEN GOSUB hl_off: GOSUB cur_home
SELECT CASE tabx
CASE 1
IF LEN(text$(fld)) THEN
fld = fld + 1: IF fld > UBOUND(yfield) THEN fld = 1
LOCATE yfield(fld), xfield(fld)
tabx = tabx + 1: IF tabx > tabmax THEN tabx = 1
EXIT DO ' Leave sub but maintain window.
ELSE
BEEP
_CONTINUE
END IF
CASE 2
LOCATE , , 0
tabx = tabx + 1: IF tabx > tabmax THEN tabx = 1
CASE 3
tabx = tabx + 1: IF tabx > tabmax THEN tabx = 1
CASE 4
tabx = tabx + 1: IF tabx > tabmax THEN tabx = 1
fld = fld + 1: IF fld > UBOUND(yfield) THEN fld = 1
LOCATE yfield(fld), xfield(fld), 1
END SELECT
CASE CHR$(13) ' Enter key.
IF text$(1) = "" THEN BEEP: _CONTINUE
IF hl THEN GOSUB hl_off
SELECT CASE tabx
CASE 1
find$ = text$(1)
text$(1) = "": text$(2) = ""
inpclose = 1
EXIT DO ' Leave sub but maintain window.
CASE 2
find$ = text$(1): replace$ = text$(2)
findreplace = 1
text$(1) = "": text$(2) = ""
inpclose = 1
EXIT DO ' Leave sub but maintain window.
CASE 3
find$ = text$(1)
text$(1) = "": text$(2) = ""
inpclose = 1
EXIT DO ' Leave sub but maintain window.
CASE 4
find$ = text$(1): replace$ = text$(2)
findreplace = 1
text$(1) = "": text$(2) = ""
inpclose = 1
EXIT DO ' Leave sub but maintain window.
END SELECT
fld = fld + 1: IF fld > UBOUND(yfield) THEN
fld = 1
ELSE
LOCATE yfield(fld), xfield(fld)
END IF
EXIT DO ' Leave sub but maintain window.
CASE CHR$(8) ' Backspace key.
GOSUB backspace
CASE CHR$(0) + "S" ' Delete key.
GOSUB delete
CASE CHR$(0) + "M" ' Arrow right key.
GOSUB cursor_forward
CASE CHR$(0) + "K" ' Arrow left key.
GOSUB cursor_back
CASE CHR$(0) + "t" ' Ctrl + Arrow right key.
GOSUB ctrl_rt
CASE CHR$(0) + "s" ' Ctrl + Arrow left key.
GOSUB ctrl_lt
CASE CHR$(0) + "G" ' Home
GOSUB cur_home
CASE CHR$(0) + "O" ' End
GOSUB cur_end
CASE CHR$(0) + "R" ' Insert/overwrite toggel
ovw = 1 - ovw
IF ovw = 0 THEN LOCATE , , 1, 7, 7 ELSE LOCATE , , 1, 7, 30
CASE CHR$(22) ' Ctrl + V - Paste
GOSUB paste
CASE CHR$(3) ' Ctrl + C - Copy
GOSUB copy
CASE CHR$(24) ' Ctrl + X - Cut
GOSUB cut
CASE CHR$(1) ' Select all.
GOSUB select_all
CASE CHR$(32) TO "z"
IF tabx < 3 THEN GOSUB print_chr
END SELECT
y = CSRLIN: x = POS(0) ' Track cursor.
END IF
LOOP
IF inpclose THEN ' Close window.
hscr = 0: mhovery = 0: mhoverx = 0: mhlinput = 0: tabx = 0: fld = 0
PCOPY 2, 0
LOCATE , , 0
END IF
EXIT SUB
print_chr:
IF hl THEN GOSUB cut: string_pos = POS(0) - start_column
IF string_pos + start_column < mr - 1 AND LEN(text$(fld)) < mr - start_column - 1 THEN
IF start_column + LEN(text$(fld)) < mr THEN
text$(fld) = MID$(text$(fld), 1, string_pos) + b$ + MID$(text$(fld), string_pos + 1 + ovw)
LOCATE , start_column: PRINT SPACE$(mr - start_column);: LOCATE , start_column
PRINT text$(fld);
LOCATE , start_column + string_pos + 1
END IF
ELSE ' Horizontal scrolling.
IF LEN(text$(fld)) < maxlen(fld) THEN
IF string_pos = mr - start_column - 1 OR string_pos = mr - start_column - 2 AND string_pos < LEN(text$(fld)) - hscr - 1 THEN
j = 1 ' At right margin.
ELSEIF string_pos = LEN(text$(fld)) - hscr THEN
j = 0 ' Cursor leading text.
ELSE
j = 0 ' Cursor inside text.
END IF
text$(fld) = MID$(text$(fld), 1, hscr + string_pos) + b$ + MID$(text$(fld), hscr + string_pos + 1 + ovw)
hscr = hscr + j
LOCATE , start_column
IF ovw THEN PRINT SPACE$(mr - start_column);: LOCATE , start_column
PRINT MID$(text$(fld), hscr + 1, mr - start_column);
LOCATE , start_column + string_pos + 1 - j
END IF
END IF
RETURN
backspace:
IF hl AND shift% = 0 THEN GOSUB cut
IF string_pos = 0 AND hscr > 0 OR string_pos > 0 THEN
IF hl THEN GOSUB hl_off
text$(fld) = MID$(text$(fld), 1, hscr + string_pos - 1) + MID$(text$(fld), hscr + string_pos + 1)
IF hscr THEN hscr = hscr - 1: j = 0 ELSE j = 1
LOCATE , start_column: PRINT SPACE$(mr - start_column);
LOCATE , start_column
PRINT MID$(text$(fld), hscr + 1, mr - start_column);
LOCATE , x - j
END IF
RETURN
delete:
IF hl THEN
GOSUB cut
ELSE
text$(fld) = MID$(text$(fld), 1, hscr + string_pos) + MID$(text$(fld), hscr + string_pos + 2)
LOCATE , start_column: PRINT SPACE$(mr - start_column);
LOCATE , start_column
PRINT MID$(text$(fld), hscr + 1, mr - start_column);
LOCATE , x
END IF
RETURN
cur_home:
DO
GOSUB cursor_back
string_pos = POS(0) - start_column
LOOP UNTIL hscr = 0 AND string_pos = 0
RETURN
cur_end:
DO
GOSUB cursor_forward
string_pos = POS(0) - start_column
LOOP UNTIL string_pos + 1 > LEN(text$(fld)) - hscr
RETURN
cursor_forward:
IF hl AND shift% = 0 THEN GOSUB hl_off
IF string_pos + 1 <= LEN(text$(fld)) - hscr THEN
IF start_column + string_pos + 1 = mr AND LEN(text$(fld)) > mr - start_column AND shift% = 0 THEN
hscr = hscr + 1
LOCATE , start_column: PRINT SPACE$(mr - start_column);: LOCATE , start_column
PRINT MID$(text$(fld), hscr + 1, mr - start_column);
IF string_pos <> LEN(text$(fld)) - hscr THEN LOCATE , POS(0) - 1
ELSEIF shift% AND string_pos < LEN(text$(fld)) - hscr THEN
IF string_pos = mr - start_column - 1 THEN
hscr = hscr + 1
COLOR ctext, 0
LOCATE , start_column: PRINT SPACE$(mr - start_column);: LOCATE , start_column
IF string_pos - hl > mr - start_column THEN
PRINT MID$(text$(fld), hscr + 1, (mr - start_column) - 1);
ELSE
PRINT MID$(text$(fld), hscr + 1, string_pos - hl - 1);
END IF
IF hl < 0 THEN COLOR ctext, 0 ELSE COLOR hl1, hl2
hl = hl + 1
IF POS(0) = start_column THEN
PRINT MID$(text$(fld), hscr + 1, mr - start_column - 1);
ELSE
PRINT MID$(text$(fld), hscr + 1 + string_pos - hl, (mr - start_column) - (string_pos - hl) - 1);
END IF
ELSE
IF hl < 0 THEN COLOR ctext ELSE COLOR hl1, hl2
hl = hl + 1
PRINT MID$(text$(fld), hscr + string_pos + 1, 1);
END IF
ELSE
IF hl THEN GOSUB hl_off
IF POS(0) < mr THEN LOCATE , POS(0) + 1
END IF
COLOR ctext
END IF
RETURN
cursor_back:
IF hl AND shift% = 0 THEN GOSUB hl_off
IF string_pos = 0 AND shift% = 0 THEN
IF hscr THEN hscr = hscr - 1: PRINT MID$(text$(fld), hscr + 1, mr - start_column);: LOCATE , start_column
ELSEIF shift% THEN
IF string_pos = 0 THEN
IF hscr THEN
hscr = hscr - 1
IF hl > 0 THEN COLOR ctext, 0 ELSE COLOR hl1, hl2
hl = hl - 1
j = ABS(hl): IF j > (mr - start_column) THEN j = mr - start_column
PRINT MID$(text$(fld), hscr + 1, j);
COLOR ctext, 0: PRINT MID$(text$(fld), hscr + 1 + j, (mr - start_column) - j);
LOCATE , start_column
END IF
ELSE
LOCATE , POS(0) - 1
IF hl > 0 THEN COLOR ctext, 0 ELSE COLOR hl1, hl2
PRINT MID$(text$(fld), hscr + string_pos, 1);
LOCATE , POS(0) - 1
hl = hl - 1
END IF
COLOR ctext, 0
ELSE
IF hl THEN GOSUB hl_off
LOCATE , POS(0) - 1
END IF
RETURN
ctrl_rt:
DO
GOSUB cursor_forward
string_pos = POS(0) - start_column
LOOP UNTIL MID$(text$(fld), hscr + string_pos, 1) = " " OR string_pos >= LEN(text$(fld)) - hscr
RETURN
ctrl_lt:
DO
GOSUB cursor_back
string_pos = POS(0) - start_column
LOOP UNTIL MID$(text$(fld), hscr + string_pos, 1) = " " OR POS(0) = start_column AND hscr = 0
RETURN
hl_off:
j = POS(0)
LOCATE , start_column
COLOR ctext, 0
PRINT MID$(text$(fld), hscr + 1, mr - start_column);
LOCATE , j
hl = 0
RETURN
cut:
COLOR ctext, 0
SELECT CASE hl
CASE IS > 0
IF b$ = CHR$(24) THEN _CLIPBOARD$ = MID$(text$(fld), string_pos + 1 + hscr - hl, hl) ' Only copy to clipboard for 'cut' and not delete or paste over highlighted text calls.
j = start_column + string_pos - hl
LOCATE , start_column
PRINT SPACE$(mr - start_column);
text$(fld) = MID$(text$(fld), 1, hscr + string_pos - hl) + MID$(text$(fld), hscr + string_pos + 1)
LOCATE , start_column
IF j < start_column THEN hscr = hscr + string_pos - hl: j = start_column
PRINT MID$(text$(fld), hscr + 1, mr - start_column);
LOCATE , j
CASE 0
' Do nothing
CASE IS < 0
IF b$ <> CHR$(0) + "S" THEN _CLIPBOARD$ = MID$(text$(fld), string_pos + 1 + hscr, ABS(hl))
LOCATE , start_column
PRINT SPACE$(mr - start_column);
text$(fld) = MID$(text$(fld), 1, hscr + string_pos) + MID$(text$(fld), hscr + string_pos + 1 + ABS(hl))
LOCATE , start_column
PRINT MID$(text$(fld), hscr + 1, mr - start_column);
LOCATE , start_column + string_pos
END SELECT
hl = 0 ' No need for hl_off.
RETURN
copy:
SELECT CASE hl
CASE LEN(text$(fld)) ' Select all.
_CLIPBOARD$ = text$(fld)
CASE 1 TO LEN(text$(fld)) - 1
_CLIPBOARD$ = MID$(text$(fld), string_pos + 1 - hl, hl)
CASE 0
' Do nothing
CASE IS < 0
_CLIPBOARD$ = MID$(text$(fld), string_pos + 1, ABS(hl))
END SELECT
RETURN
paste:
IF LEN(_CLIPBOARD$) THEN
IF INSTR(_CLIPBOARD$, CHR$(13)) THEN
tmp$ = "": j = 0
FOR i = 1 TO LEN(_CLIPBOARD$)
x$ = MID$(_CLIPBOARD$, i, 1)
IF x$ = CHR$(13) AND j = 0 THEN
tmp$ = tmp$ + " "
j = -1
ELSE
IF ASC(x$) > 32 THEN j = 0
IF j = 0 THEN tmp$ = tmp$ + x$
END IF
NEXT
ELSE
tmp$ = _CLIPBOARD$
END IF
IF LEN(text$(fld)) - ABS(hl) + LEN(tmp$) <= maxlen(fld) THEN
IF hl THEN GOSUB cut
s1 = CSRLIN: s2 = POS(0): LOCATE 1, 1: PRINT hscr; LEN(tmp$), s2, string_pos, mr, start_column; " ": LOCATE s1, s2
text$(fld) = MID$(text$(fld), 1, hscr + string_pos) + tmp$ + MID$(text$(fld), hscr + string_pos + 1)
IF POS(0) + LEN(tmp$) + 1 >= mr THEN
i = hscr
hscr = hscr + POS(0) + LEN(tmp$) + 1 - mr
s1 = CSRLIN: s2 = POS(0): LOCATE 1, 1: PRINT hscr; LEN(tmp$), s2, string_pos, mr, start_column; " ": LOCATE s1, s2
j = POS(0) + LEN(tmp$) - (hscr - i)
ELSE
j = POS(0) + LEN(tmp$)
END IF
LOCATE , start_column: PRINT SPACE$(mr - start_column);
LOCATE , start_column: PRINT MID$(text$(fld), hscr + 1, mr - start_column);
LOCATE , j
ELSE
BEEP ' Too many characters to paste.
END IF
END IF
RETURN
select_all:
GOSUB cur_end
hl = LEN(text$(fld))
LOCATE , start_column
COLOR hl1, hl2
PRINT MID$(text$(fld), hscr + 1, mr - start_column);
COLOR ctext, 0
RETURN
relocate:
IF text$(i) = "" THEN
LOCATE yfield(i), start_column: PRINT MID$(text$(fld), 1, mr - start_column);
ELSE
IF mx <= xfield(fld) + LEN(text$(fld)) THEN
LOCATE my, mx
ELSE
IF LEN(text$) >= flen(fld) - 1 THEN
LOCATE yfield(fld), xfield(fld) + flen(fld) - 1
ELSE
LOCATE yfield(fld), xfield(fld) + LEN(text$(fld))
END IF
END IF
END IF
RETURN
END SUB
SUB MyPopup (menu$(), text$(), fld, hl, menu.var, b$) ' Self-contained subroutine.
STATIC initialize_menu, WinCon.noi, oldmy
IF initialize_menu = 0 THEN
initialize_menu = 1
RESTORE WinMenuData
WinCon.noi = 0
DO
READ tmp$
IF tmp$ = "eof" THEN EXIT DO
WinCon.noi = WinCon.noi + 1
REDIM _PRESERVE menu$(WinCon.noi)
menu$(WinCon.noi) = tmp$
LOOP
WinMenuData:
'-------------------------------------User Defined here.--------------------------------------
DATA Cut.........Ctrl+X,Copy........Ctrl+C,Paste.......Ctrl+V,Clear..........Del,Select All..Ctrl+A
'---------------------------------------------------------------------------------------------
DATA Close..........Esc,Exit Find...Alt+F4,eof
END IF
y = CSRLIN: x = POS(0)
LOCATE , , 0 ' Hide cursor
DIM atmp AS STRING
REDIM menu_restrict(WinCon.noi)
GOSUB restrict
DO
_LIMIT 30
REM z = GetCursorPos(WinMse)
my_mse_kbd lb, mb, rb, my, mx, mw, shift%, clkcnt, drag, b$, mhovery, mhoverx
mxalt = 0
IF b$ = CHR$(0) + "H" OR mw = -1 THEN
IF (MenuHL - MenuT + 1) \ 2 > 1 THEN
myalt = MenuHL - 2: mxalt = -1
END IF
ELSEIF b$ = CHR$(0) + "P" OR mw = 1 THEN
IF MenuHL = 0 THEN
myalt = MenuT + 1: mxalt = -1
ELSE
IF (MenuHL - MenuT + 1) \ 2 < WinCon.noi THEN
myalt = MenuHL + 2: mxalt = -1
END IF
END IF
ELSEIF b$ = CHR$(13) OR mb = 2 THEN
IF menu_restrict((MenuHL - MenuT + 1) \ 2) = 0 THEN
menu.var = (MenuHL - MenuT + 1) \ 2
EXIT DO
END IF
END IF
SELECT CASE menu.var
CASE -1 ' Hover.
IF mxalt = 0 THEN myalt = my: mxalt = mx
i = myalt > MenuT AND myalt < MenuB AND mxalt > MenuL AND mxalt < MenuR
IF i OR mxalt = -1 THEN
i = (myalt - MenuT) \ 2 <> (myalt - MenuT) / 2 AND myalt <> oldmy
IF i OR mxalt = -1 THEN ' Works for odd or even number top margins.
IF MenuHL THEN ' Remove highlighting from previous hover.
atmp = SPACE$(mwidth - 2)
MID$(atmp, 2, LEN(menu$((MenuHL - MenuT + 1) \ 2))) = menu$((MenuHL - MenuT + 1) \ 2)
LOCATE MenuHL, MenuL + 2 - 1
IF menu_restrict((MenuHL - MenuT + 1) \ 2) THEN COLOR 7, 5 ELSE COLOR 0, 5
PRINT atmp
END IF
atmp = SPACE$(mwidth - 2)
MID$(atmp, 2, LEN(menu$((myalt - MenuT + 1) \ 2))) = menu$((myalt - MenuT + 1) \ 2)
LOCATE myalt, MenuL + 2 - 1
IF menu_restrict((myalt - MenuT + 1) \ 2) THEN COLOR 5, 7 ELSE COLOR 5, 0
PRINT atmp;
COLOR 0, 5
MenuHL = myalt
oldmy = my
END IF
IF lb = 2 THEN
IF menu_restrict((myalt - MenuT + 1) \ 2) = 0 THEN
menu.var = (myalt - MenuT + 1) \ 2
EXIT DO
END IF
END IF
ELSE
' Toggle close menu.
IF lb = 1 THEN
IF myalt >= _SCREENY AND my <= _SCREENY + 24 AND mx >= _SCREENX + 36 AND mx <= _SCREENX + 48 THEN
menu.var = 0: EXIT DO ' Close menu.
ELSE
IF myalt >= _SCREENY AND my <= _SCREENY + _FONTHEIGHT * (_HEIGHT + 1) AND mx >= _SCREENX AND mx <= _SCREENX + _FONTWIDTH * _WIDTH THEN
ELSE ' Outside of app window.
menu.var = 0: EXIT DO ' Close menu.
END IF
END IF
END IF
IF lb = 1 THEN ' Outside of menu closes menu.
menu.var = 0 ' Close.
EXIT DO
END IF
END IF
IF b$ = CHR$(27) THEN b$ = "": EXIT DO ' Simply close popup.
IF LEN(b$) THEN
'-----------------------------------------------------------------------------------------------------------
' Valid menu shortcut key list here.
SELECT CASE b$
CASE CHR$(0) + "S", CHR$(22), CHR$(24), CHR$(1), CHR$(3): EXIT DO
END SELECT
END IF
CASE ELSE ' Open menu.
menu_variety = 1
h = 5 ' Variable to determine margin spaces from the right of menu.
FOR i = 1 TO WinCon.noi
j = LEN(menu$(i))
IF j > k THEN k = j
NEXT
mwidth = k + h
mheight = WinCon.noi * 2 + 1 ' Add one for the separate border element.
SELECT CASE menu_variety
CASE 0 ' Fixed menu to left.
MenuT = 3: MenuL = 1: MenuR = MenuL + mwidth: MenuB = MenuT + mheight
CASE 1 ' Movable menu.
WHILE _MOUSEINPUT: WEND
MenuT = _MOUSEY + 1 ' One below input line.
MenuL = _MOUSEX
IF MenuT + mheight >= _HEIGHT THEN MenuT = _HEIGHT - mheight - 1 ' -1 for shadow.
IF MenuL + mwidth >= _WIDTH THEN MenuL = _WIDTH - mwidth - 1 ' -1 for shadow.
MenuR = MenuL + mwidth: MenuB = MenuT + mheight
END SELECT
menu.var = -1
PCOPY 0, 1
COLOR 0, 5
LOCATE MenuT, MenuL
PRINT CHR$(218) + STRING$(mwidth - 2, 196) + CHR$(191)
FOR i = 1 TO mheight - 2
COLOR 0, 5: LOCATE , MenuL
PRINT CHR$(179); SPACE$(mwidth - 2) + CHR$(179);
COLOR 5, 3: PRINT CHR$(SCREEN(CSRLIN, POS(0))) + CHR$(SCREEN(CSRLIN, POS(0) + 1)): COLOR 1, 5
NEXT
COLOR 0, 5: LOCATE , MenuL
PRINT CHR$(192) + STRING$(mwidth - 2, 196) + CHR$(217);
COLOR 5, 3: PRINT CHR$(SCREEN(CSRLIN, POS(0))) + CHR$(SCREEN(CSRLIN, POS(0) + 1))
LOCATE , MenuL + 2
FOR i = 1 TO mwidth
PRINT CHR$(SCREEN(CSRLIN, POS(0)));
NEXT
LOCATE MenuT + 2, MenuL + 2
FOR i = 0 TO WinCon.noi - 1
LOCATE MenuT + 1 + i * 2, MenuL + 2
IF menu_restrict(i + 1) THEN COLOR 7, 5 ELSE COLOR 0, 5
PRINT menu$(i + 1)
COLOR 0, 5
LOCATE , MenuL
IF i + 1 < WinCon.noi THEN PRINT "Ã" + STRING$(mwidth - 2, CHR$(196)) + "´";
NEXT
END SELECT
LOOP
PCOPY 1, 0
LOCATE y, x
_KEYCLEAR
EXIT SUB
restrict:
IF text$(fld) = "" THEN
FOR i = 1 TO WinCon.noi - 2: menu_restrict(i) = 1: NEXT
ELSE
IF hl = 0 THEN
FOR i = 1 TO 4: menu_restrict(i) = 1: NEXT
END IF
END IF
IF LEN(_CLIPBOARD$) THEN menu_restrict(3) = 0 ELSE menu_restrict(3) = 1
RETURN
END SUB
SUB my_mse_kbd (lb, mb, rb, my, mx, mw, shift%, clkcnt, drag, b$, mhovery, mhoverx)
STATIC oldmy, oldmx, z1, hover, mwy, oldmwy
b$ = INKEY$
IF z1 THEN IF ABS(TIMER - z1) > .3 THEN z1 = 0: clkcnt = 0
IF lb > 0 THEN
IF lb = 1 THEN
lb = -1
ELSE
lb = 0
END IF
END IF
IF rb > 0 THEN IF rb = 1 THEN rb = -1 ELSE rb = 0
IF mb > 0 THEN IF mb = 1 THEN mb = -1 ELSE mb = 0
WHILE _MOUSEINPUT
mwy = mwy + _MOUSEWHEEL
WEND
my = _MOUSEY
mx = _MOUSEX
IF lb = -1 THEN
IF oldmy AND oldmx <> mx OR oldmy AND oldmy <> my THEN
IF mx <> oldmx THEN drag = SGN(mx - oldmx) ' Prevent zero which can occur if mouse moves off row when being draged horizontally.
END IF
END IF
IF drag = 0 THEN
IF mwy <> oldmw THEN
mw = SGN(mwy - oldmwy): mwy = 0
ELSE
mw = 0
END IF
oldmwy = mwy
IF mhoverx AND mx = mhoverx AND my = mhovery THEN
i = SCREEN(my, mx)
y = CSRLIN: x = POS(0)
mc1 = 1: mycolor mc1
COLOR 15, 6: LOCATE my, mx - 1, 0: PRINT " x ";
mc1 = 2: mycolor mc1
LOCATE y, x, 1
hover = 1
ELSE
IF hover THEN
hover = 0
y = CSRLIN: x = POS(0)
LOCATE mhovery, mhoverx - 1, 0
mc1 = 2: mycolor mc1
COLOR 0, 5
PRINT " x ";
LOCATE y, x, 1
mc1 = 2: mycolor mc1
END IF
END IF
IF _KEYDOWN(100303) OR _KEYDOWN(100304) THEN shift% = -1 ELSE IF shift% THEN shift% = 0
END IF
IF lb = -1 AND _MOUSEBUTTON(1) = 0 THEN
lb = 2: drag = 0: hover = 0
ELSEIF rb = -1 AND _MOUSEBUTTON(2) = 0 THEN
rb = 2
ELSEIF mb = -1 AND _MOUSEBUTTON(3) = 0 THEN
mb = 2
END IF
IF _MOUSEBUTTON(1) THEN
IF lb = 0 THEN
lb = 1
IF z1 = 0 THEN
z1 = TIMER ' Let first click through.
ELSE
clkcnt = clkcnt + 1
END IF
END IF
ELSEIF _MOUSEBUTTON(2) AND rb = 0 THEN
rb = 1
ELSEIF _MOUSEBUTTON(3) AND mb = 0 THEN
mb = 1
END IF
oldmy = my: oldmx = mx
END SUB
SUB mypalette
PALETTE 1, 8 ' Page background. Blue
PALETTE 3, 56 ' Popup background shadow. Grey.
PALETTE 4, 62 ' Highlight text background. Yellow 11 15 59 Other choices.
PALETTE 5, 63 ' Window background. Bright white.
PALETTE 6, 36 ' Close x symbol. Bright red.
PALETTE 9, 1 ' Tab on a button. Medium Blue.
PALETTE 12, 43 ' Hover on a button. Light blue.
END SUB
SUB mycolor (mc1)
STATIC sc1~&, sc2~&
SELECT CASE mc1
CASE 1
sc1~& = _DEFAULTCOLOR: sc2~& = _BACKGROUNDCOLOR
CASE 2
COLOR sc1~&, sc2~&
END SELECT
END SUB
Let me know if you find any any bugs and, as always, use caution with any program that writes to files.
Pete
EDIT: I was so kind replacing your mishighlighted codebox, please use the QB64PE IDE File menu > ExportAs > Forum Codebox in the future. - RhoSigma
|
|
|
|
| Vantiro - A 2D Zombie Shooter |
|
Posted by: Bhsdfa - 11-10-2024, 08:34 PM - Forum: Games
- Replies (1)
|
 |
Vantiro is my second finished project in QB64pe, the project started out in august as a RPG originally meant as a simple school project, which with time got converted into a zombie shooter.
 
Check it out on Itch.io!
![[Image: vantirologo.png]](https://i.ibb.co/9Vf8cPd/vantirologo.png)
Source code below:
Code: (Select All) Rem File creation date: 27-Aug-24 (1:02 PM)
Rem Apps used: TILED e QB64pe
Rem TILED: https://www.mapeditor.org/ -=- QB64pe: https://qb64phoenix.com/
Rem Vantiro.bas:
'$Dynamic
$Resize:On
Icon = _LoadImage("assets/pc/vantirologo.png")
_Icon Icon, Icon
_Title "Vantiro"
MenuTransitionImage = _NewImage(32, 32, 32)
Const PI = 3.14159265359
Const PIDIV180 = PI / 180
Randomize Timer
Dim Shared MainScreen
Dim Shared SecondScreen
MainScreen = _NewImage(1230, 662, 32)
SecondScreen = _NewImage(1230, 662, 32)
Screen MainScreen
_Dest MainScreen
Type Mouse
x As Long
y As Long
x1 As Long
y1 As Long
x2 As Long
y2 As Long
xbz As Double
ybz As Double
xaz As Double
yaz As Double
click As Integer
click2 As Integer
scroll As Integer
End Type
Dim Shared Mouse As Mouse
Type Map
MaxWidth As Long
MaxHeight As Long
Layers As Long
TileSize As Long
Title As String
TextureSize As Long
Triggers As Long
End Type
Dim Shared Map As Map
Type Entity
x As Double
y As Double
x1 As Long
y1 As Long
x2 As Long
y2 As Long
size As Double
sizeFirst As Double
xm As Double
ym As Double
rotation As Double
health As Double
healthFirst As Double
damage As Double
attacking As Integer
attackcooldown As Integer
tick As Integer
active As Integer
DistanceFromPlayer As Integer
weight As Double
maxspeed As Integer
speeding As Double
knockback As Double
onfire As Integer
special As String
SpecialDelay As Double
DamageCooldown As Double
DamageTaken As Double
End Type
Type DefEntity
maxspeed As Double
maxhealth As Integer
minhealth As Integer
maxdelay As Integer
mindelay As Integer
tickrate As Integer
mindamage As Integer
maxdamage As Integer
size As Integer
End Type
Dim Shared ZombieMax As Long
Dim Shared VileMax As Integer
Dim Shared SnarkMax As Integer
Dim Shared SummonerMax As Integer
PlayerSkin = 1
Dim Shared PlayerSprite(4)
Dim Shared PlayerHand(4)
PlayerSprite(1) = _LoadImage("assets/pc/player/player1.png")
PlayerHand(1) = _LoadImage("assets/pc/player/hand1.png")
PlayerSprite(2) = _LoadImage("assets/pc/player/player2.png")
PlayerHand(2) = _LoadImage("assets/pc/player/hand1.png")
PlayerSprite(3) = _LoadImage("assets/pc/player/player3.png")
PlayerHand(3) = _LoadImage("assets/pc/player/hand3.png")
PlayerSprite(4) = _LoadImage("assets/pc/player/player4.png")
PlayerHand(4) = _LoadImage("assets/pc/player/hand4.png")
BloodDrop = _LoadImage("assets/pc/Blooddrop.png")
Dim Shared PlayerDamage
Dim Shared PlayerDeath
PlayerDamage = _SndOpen("assets/pc/player/sounds/au.wav")
PlayerDeath = _SndOpen("assets/pc/player/sounds/ua.wav")
FlameThrowerSound = _SndOpen("assets/pc/sounds/interior_fire01_stereo.wav")
Dim Shared ZombieWalk(4)
ZombieWalk(1) = _SndOpen("assets/pc/mobs/sounds/headless_1.wav")
ZombieWalk(2) = _SndOpen("assets/pc/mobs/sounds/headless_2.wav")
ZombieWalk(3) = _SndOpen("assets/pc/mobs/sounds/headless_3.wav")
ZombieWalk(4) = _SndOpen("assets/pc/mobs/sounds/headless_4.wav")
Dim Shared ZombieShot(16)
ZombieShot(1) = _SndOpen("assets/pc/mobs/sounds/shot/been_shot_01.wav")
ZombieShot(2) = _SndOpen("assets/pc/mobs/sounds/shot/been_shot_02.wav")
ZombieShot(3) = _SndOpen("assets/pc/mobs/sounds/shot/been_shot_03.wav")
ZombieShot(4) = _SndOpen("assets/pc/mobs/sounds/shot/been_shot_04.wav")
ZombieShot(5) = _SndOpen("assets/pc/mobs/sounds/shot/been_shot_05.wav")
ZombieShot(6) = _SndOpen("assets/pc/mobs/sounds/shot/been_shot_06.wav")
ZombieShot(7) = _SndOpen("assets/pc/mobs/sounds/shot/been_shot_07.wav")
ZombieShot(8) = _SndOpen("assets/pc/mobs/sounds/shot/been_shot_08.wav")
ZombieShot(9) = _SndOpen("assets/pc/mobs/sounds/shot/been_shot_09.wav")
ZombieShot(10) = _SndOpen("assets/pc/mobs/sounds/shot/been_shot_10.wav")
ZombieShot(11) = _SndOpen("assets/pc/mobs/sounds/shot/been_shot_11.wav")
ZombieShot(12) = _SndOpen("assets/pc/mobs/sounds/shot/been_shot_12.wav")
ZombieShot(13) = _SndOpen("assets/pc/mobs/sounds/shot/been_shot_13.wav")
ZombieShot(14) = _SndOpen("assets/pc/mobs/sounds/shot/been_shot_14.wav")
ZombieShot(15) = _SndOpen("assets/pc/mobs/sounds/shot/been_shot_15.wav")
ZombieShot(16) = _SndOpen("assets/pc/mobs/sounds/shot/been_shot_16.wav")
ZombieMax = 190
Dim Shared Zombie(ZombieMax) As Entity
Dim Shared DefZombie As DefEntity
DefZombie.maxspeed = 820
DefZombie.size = 26
DefZombie.tickrate = 15
DefZombie.maxdamage = 10
DefZombie.mindamage = 4
DefZombie.maxhealth = 100
DefZombie.minhealth = 70
Type Player
x As Double
y As Double
xb As Double
yb As Double
x1 As Long
x2 As Long
y1 As Long
y2 As Long
size As Integer
xm As Double
ym As Double
Rotation As Double
TouchX As Integer
TouchY As Integer
Health As Double
DamageToTake As Integer
DamageCooldown As Integer
Armor As Double
shooting As Double
weapon1id As Integer
weapon2id As Integer
End Type
PlayerLimit = 1
Dim Shared Player(PlayerLimit) As Player
Type PlayerMembers
x As Double
y As Double
xo As Double
yo As Double
xbe As Double
ybe As Double
angle As Single
xvector As Double
yvector As Double
mode As Double
visible As Double
speed As Double
angleanim As Double
distanim As Double
End Type
Dim Shared PlayerMember(2) As PlayerMembers
Type Raycast
x As Double
y As Double
angle As Double
damage As Double
knockback As Double
owner As Integer
End Type
Dim Shared Ray As Raycast
Dim Shared RayM(3) As Raycast
Type Tiles
ID As Long
solid As Integer
animationframe As Integer
rend_spritex As Long
rend_spritey As Long
PlayerStand As Integer
associated As Integer
x1y1 As Integer
x2y1 As Integer
x1y2 As Integer
x2y2 As Integer
fragile As Integer
transparent As Integer
End Type
Type Weapon
x As Double
y As Double
xm As Double
ym As Double
visible As Integer
cangrab As Integer
rotation As Double
wtype As Integer
shooting As Integer
End Type
Dim Shared Gun(2) As Weapon
Dim Shared GunDisplay(2) As Weapon
Type Menu
x1d As Double
x2d As Double
y1d As Double
y2d As Double
x1 As Long
x2 As Long
y1 As Long
y2 As Long
Colors As Long
red As Integer
green As Integer
blue As Integer
text As String
textsize As Integer
hex As String
style As Integer
clicktogo As String
extra As Integer
extra2 As Integer
extra3 As Integer
visual As Integer
visual2 As String
d_hover As Integer
d_clicked As Integer
OffsetY As Double
OffsetX As Double
End Type
Type Hud
x1 As Long
x2 As Long
y1 As Long
y2 As Long
x As Double
y As Double
xm As Double
ym As Double
xbe As Double
ybe As Double
rotation As Double
rotationbe As Double
rotationoffset As Double
stringered As Long
size As Long
textsize As Integer
End Type
Type Trigger
x1 As Double
y1 As Double
x2 As Double
y2 As Double
sizex As Double
sizey As Double
class As String
val1 As Double
val2 As Double
val3 As Double
val4 As Double
text As String
textspeed As Double
triggername As String
needclick As Integer
End Type
VantiroTitulo = _LoadImage("assets/pc/Vantiro.png")
Background1 = _LoadImage("assets/pc/Background.png")
Dim Shared Hud(9) As Hud
Dim Shared Minimap As Hud
TXTGlint = _LoadImage("assets/begs world/textures/glint.png")
Dim Shared MenuMax
MenuMax = 64
Dim Shared Menu(MenuMax) As Menu
Dim Shared MenuAnim As Menu
For i = 1 To MenuMax
Menu(i).x1 = 0: Menu(i).x2 = 0: Menu(i).y1 = 0: Menu(i).y2 = 0: Menu(i).Colors = 0: Menu(i).red = 0: Menu(i).green = 0: Menu(i).blue = 0
Menu(i).text = " "
Menu(i).textsize = -1
Menu(i).hex = ""
Menu(i).style = 0
Menu(i).clicktogo = ""
Menu(i).extra = 0
Menu(i).d_hover = 0
Menu(i).d_clicked = 0
Next
Dim Shared Colors As Long
Begsfont$ = "assets\begs world\mouse.ttf"
Dim Shared BegsFontSizes(1024)
Dim Shared MenusImages(128)
For i = 1 To 1024
BegsFontSizes(i) = _LoadFont(Begsfont$, i, "")
Next
CanLeave = 0
ToLoad$ = "menu"
ToLoad2$ = "menu"
GoSub load
_Dest MainScreen
Do
_Limit 75
Cls
GoSub MenuSystem
_Display
Loop While quit = 0
'Input "Select a map", Map$
Map$ = "Forest"
Cls
MinimapTxtSize = 8
MapLoaded = LoadMapSettings(Map$)
Dim Shared Trigger(Map.Triggers) As Trigger
MinimapIMG = _NewImage(Map.MaxWidth * 8, Map.MaxHeight * 8, 32)
Dim Shared Tile(Map.MaxWidth + 20, Map.MaxHeight + 20, Map.Layers) As Tiles
MapLoaded = LoadMap(Map$)
Dim Shared LastPart As Integer
Dim Shared Tileset
Tileset = _LoadImage("assets/pc/tileset.png")
E_KeyIcon = _LoadImage("assets/pc/items/ekeyicon.png")
Guns_Pistol = _LoadImage("assets/pc/items/pistol.png")
Guns_Shotgun = _LoadImage("assets/pc/items/shotgun.png")
Guns_SMG = _LoadImage("assets/pc/items/smg.png")
Guns_Flame = _LoadImage("assets/pc/items/flamethrower.png")
Guns_Grenade = _LoadImage("assets/pc/items/grenade.png")
HudSelected = _LoadImage("assets/pc/Selected.png")
HudNotSelected = _LoadImage("assets/pc/NotSelected.png")
HudNoAmmo = _LoadImage("assets/pc/NoAmmo.png")
Zombie = _LoadImage("assets/pc/mobs/zombie.png")
ZombieRunner = _LoadImage("assets/pc/mobs/fastzombie.png")
ZombieSlower = _LoadImage("assets/pc/mobs/slowzombie.png")
ZombieBomber = _LoadImage("assets/pc/mobs/bomberzombie.png")
ZombieBiohazard = _LoadImage("assets/pc/mobs/zombie.png") ' GIVE ME IMAGE
ZombieBrute = _LoadImage("assets/pc/mobs/zombie.png") 'GIVE ME IMAGE
ZombieFire = _LoadImage("assets/pc/mobs/firezombie.png")
ShellShotgunAmmo = _LoadImage("assets/pc/items/shotgunammo.png")
PistolShellAmmo = _LoadImage("assets/pc/items/pistolammo.png")
GasCanAmmo = _LoadImage("assets/pc/items/gascan.png")
Dim Shared WallShot
WallShot = _LoadImage("assets/pc/items/wallshot.png")
GlassShard = _LoadImage("assets/pc/items/glassshard.png")
Dim Shared Bloodsplat
BloodsplatGreen = _LoadImage("assets/pc/items/bloodsplatgreen.png")
BloodsplatRed = _LoadImage("assets/pc/items/bloodsplatred.png")
Gib_Skull = _LoadImage("assets/pc/items/skull.png")
Gib_Bone = _LoadImage("assets/pc/items/bone.png")
Dim Shared Bloodonground
Bloodonground = _LoadImage("assets/pc/items/bloodonground.png")
Guns_Sound_PistolShot = _SndOpen("assets/pc/sounds/pistolshot.wav")
Guns_Sound_ShotgunShot = _SndOpen("assets/pc/sounds/shotgunshot.wav")
Dim Shared FireParticles(3)
FireParticle = _LoadImage("assets/pc/items/fire1.png")
FireParticles(1) = _LoadImage("assets/pc/items/fire1.png")
FireParticles(2) = _LoadImage("assets/pc/items/fire2.png")
FireParticles(3) = _LoadImage("assets/pc/items/fire3.png")
Dim SMGSounds(3)
SMGSounds(1) = _SndOpen("assets/pc/sounds/hks1.wav")
SMGSounds(2) = _SndOpen("assets/pc/sounds/hks2.wav")
SMGSounds(3) = _SndOpen("assets/pc/sounds/hks3.wav")
Dim ShellSounds(3)
ShellSounds(1) = _SndOpen("assets/pc/sounds/sshell1.wav")
ShellSounds(2) = _SndOpen("assets/pc/sounds/sshell2.wav")
ShellSounds(3) = _SndOpen("assets/pc/sounds/sshell3.wav")
Dim PistolShellSounds(3)
PistolShellSounds(1) = _SndOpen("assets/pc/sounds/pl_shell1.wav")
PistolShellSounds(2) = _SndOpen("assets/pc/sounds/pl_shell2.wav")
PistolShellSounds(3) = _SndOpen("assets/pc/sounds/pl_shell3.wav")
Dim BloodSounds(6)
BloodSounds(1) = _SndOpen("assets/pc/sounds/flesh1.wav")
BloodSounds(2) = _SndOpen("assets/pc/sounds/flesh2.wav")
BloodSounds(3) = _SndOpen("assets/pc/sounds/flesh3.wav")
BloodSounds(4) = _SndOpen("assets/pc/sounds/flesh5.wav")
BloodSounds(5) = _SndOpen("assets/pc/sounds/flesh6.wav")
BloodSounds(6) = _SndOpen("assets/pc/sounds/flesh7.wav")
Dim Shared GlassShadder(3)
GlassShadder(1) = _SndOpen("assets/pc/sounds/bustglass1.wav")
GlassShadder(2) = _SndOpen("assets/pc/sounds/bustglass2.wav")
GlassShadder(3) = _SndOpen("assets/pc/sounds/bustglass3.wav")
Dim GlassSound(4)
GlassSound(1) = _SndOpen("assets/pc/sounds/glass1.wav")
GlassSound(2) = _SndOpen("assets/pc/sounds/glass2.wav")
GlassSound(3) = _SndOpen("assets/pc/sounds/glass3.wav")
GlassSound(4) = _SndOpen("assets/pc/sounds/glass4.wav")
HudImageHealth = _NewImage(128, 128, 32)
Hud_Health_Icon = _LoadImage("assets/pc/BloodIcon.png")
Hud_Health_Fluid = _LoadImage("assets/pc/BloodHealth.png")
SND_Explosion = _SndOpen("assets/pc/sounds/explode.mp3")
Particle_Shotgun_Shell = _LoadImage("assets/pc/items/shotgunshell.png")
Particle_Pistol_Shell = _LoadImage("assets/pc/items/pistolshell.png")
Particle_Smoke = _LoadImage("assets/pc/items/smoke.png")
Particle_Explosion = _LoadImage("assets/pc/items/explosion.png")
Dim Shared CameraX As Double
Dim Shared CameraY As Double
Dim Shared CameraXM As Double
Dim Shared CameraYM As Double
Dim Shared Zoom As Double
Type Particle
x As Double
y As Double
z As Double
txt As Integer
xm As Double
ym As Double
zm As Double
froozen As Integer
rotation As Double
rotationspeed As Double
visible As Integer
partid As String
playwhatsound As String
BloodColor As String
special As Integer
End Type
Dim Shared GrenadeMax
Dim Shared FireMax
FireMax = 80
GrenadeMax = 8
Dim Shared BloodPart(32) As Particle
Dim Shared ParticlesMax
Dim Shared BloodMax
Dim Shared LastBlood
ParticlesMax = 816
Dim Shared Grenade(GrenadeMax) As Particle
Dim Shared Fire(FireMax) As Particle
Dim Shared Part(ParticlesMax) As Particle
HudAmmo = _NewImage(300, 300, 32)
Dim Shared PlayerInteract
FlameAmmoMax = 200
SMGAmmoMax = 350
ShotgunAmmoMax = 40
GrenadeAmmoMax = 5
GoSub RestartEverything
PlayerSkin2 = PlayerSkin
Do
LastHealth = Player(1).Health
If FlameAmmo > FlameAmmoMax Then FlameAmmo = FlameAmmoMax
If SMGAmmo > SMGAmmoMax Then SMGAmmo = SMGAmmoMax
If ShotgunAmmo > ShotgunAmmoMax Then ShotgunAmmo = ShotgunAmmoMax
If GrenadeAmmo > GrenadeAmmoMax Then GrenadeAmmo = GrenadeAmmoMax
Mouse.scroll = 0
_KeyClear
Do While _MouseInput
Mouse.x = _MouseX
Mouse.y = _MouseY
Mouse.click = _MouseButton(1)
Mouse.click2 = _MouseButton(2)
If _MouseWheel <> 0 Then Mouse.scroll = _MouseWheel
Loop
PlayerInteract = 0
If PlayerInteract = 0 And _KeyDown(101) = -1 And PlayerInteractPre = 0 Then PlayerInteract = 1
PlayerInteractPre = _KeyDown(101)
If _KeyDown(15104) And delay = 0 And debug = 1 Then HideUI = HideUI + 1: delay = 20: If HideUI = 2 Then HideUI = 0
If _KeyDown(17408) And delay = 0 And debug = 1 Then NoAI = NoAI + 1: delay = 20: If NoAI = 2 Then NoAI = 0
If _KeyDown(118) And delay = 0 And debug = 1 Then Noclip = Noclip + 1: delay = 20: If Noclip = 2 Then Noclip = 0
If Player(1).Health > 101 Then Player(1).Health = Player(1).Health - 0.1
If Player(1).Health < -1 Then Player(1).Health = -1
_Limit 62
Cls
ff% = ff% + 1
If Timer - start! >= 1 Then fps% = ff%: ff% = 0: start! = Timer
If delay > 0 Then delay = delay - 1
If ShootDelay > 0 Then ShootDelay = ShootDelay - 1
'Camera Control
If _KeyDown(114) And debug = 1 Then Player(1).Health = 100: PlayerCantMove = 0: DeathTimer = 0
GoSub RenderSprites
GoSub ParticleLogic
If PlayerCantMove = 0 Then GoSub PlayerMovement
GoSub HandsCode
GoSub GrenadeLogic
If NoAI = 0 Then GoSub ZombieAI
GoSub RenderMobs
GoSub RenderPlayer
Player(1).shooting = 0
GoSub GunCode
GoSub Fire
GoSub RenderLayer3
GoSub TriggerPlayer
CameraXM = CameraXM / 1.1
CameraYM = CameraYM / 1.1
If Freecam = 0 Then CameraX = (Player(1).x / Map.TileSize) - (_Width / (Map.TileSize * 2)): CameraY = (Player(1).y / Map.TileSize) - (_Height / (Map.TileSize * 2)): CameraX = CameraX + CameraXM / 100: CameraY = CameraY + CameraYM / 100
' If Debug = 1 Then Tile(Fix(Player(1).x / Map.TileSize), Fix(Player(1).y / Map.TileSize), 1).PlayerStand = 1
If _KeyDown(15616) And delay = 0 Then debug = debug + 1: delay = 20: If debug = 2 Then debug = 0
If _KeyDown(102) And delay = 0 And debug = 1 Then Freecam = Freecam + 1: delay = 20: If Freecam = 2 Then Freecam = 0
If Freecam = 1 Then
If _KeyDown(19200) Then CameraX = CameraX - 0.1
If _KeyDown(19712) Then CameraX = CameraX + 0.1
If _KeyDown(18432) Then CameraY = CameraY - 0.1
If _KeyDown(20480) Then CameraY = CameraY + 0.1
End If
Player(1).Health = Player(1).Health - Player(1).DamageToTake: Player(1).DamageToTake = 0
If Player(1).Health <= 0 And DeathTimer = 0 Then DeathTimer = 1
If DeathTimer > 0 Then GoSub PlayerDeath
If Mouse.scroll = -1 And PlayerCantMove = 0 Then HudChange = 1: WantSlot = 0
If Mouse.scroll = 1 And PlayerCantMove = 0 Then HudChange = -1: WantSlot = 0
Line (0, 0)-(_Width, _Height), _RGBA32(ShadeRed, 0, 0, DayAmount), BF
If WaveWait > 0 Then GoSub WaveChange
GoSub DrawHud
If HideUI = 0 Then GoSub MiniMapCode
If WaveBudget = 0 Then GoSub WaveChange
If Wave = 16 Then GoSub TurningDay
If HideUI = 0 Then _PutImage (_Width - 128, _Height - 128)-(_Width, _Height), HudImageHealth
_Display
GoSub HealthHud
If _WindowHasFocus Then GoSub ResizeScreen
Loop
HealthHud:
If LastHealth > Player(1).Health Then
For x = 1 To Fix(Fix((LastHealth) - Int(Player(1).Health)) / 4)
LastBloodPart = LastBloodPart + 1: If LastBloodPart > 32 Then LastBloodPart = 1
BloodPart(LastBloodPart).x = 64 ' Int(Rnd * _Width(HeartPercent))
BloodPart(LastBloodPart).y = _Width(HeartPercent)
BloodPart(LastBloodPart).xm = Int(Rnd * 100) - 50
BloodPart(LastBloodPart).ym = -(80 + Int(Rnd * 50))
BloodPart(LastBloodPart).visible = 1
Next
End If
If LastHealth <> Player(1).Health Then
FontSizeUse = 60
If Player(1).Health < 0 Then Player(1).Health = 0
Text$ = LTrim$(Str$(Fix(Player(1).Health)) + "%")
GoSub HudText
HeartThx = thx
HeartThy = thy
If HeartPercent <> 0 Then _FreeImage HeartPercent
HeartPercent = _CopyImage(ImgToMenu)
_SetAlpha 64, _RGBA32(1, 1, 1, 1) To _RGBA32(255, 255, 255, 255), HeartPercent
End If
_Dest HudImageHealth
Line (0, 0)-(_Width, _Height), _RGB32(0, 0, 0), BF
For i = 1 To 32
If BloodPart(i).visible = 1 Then
BloodPart(i).x = BloodPart(i).x + BloodPart(i).xm / 10
BloodPart(i).y = BloodPart(i).y + BloodPart(i).ym / 10
If BloodPart(i).x > _Width Then BloodPart(i).x = _Width: BloodPart(i).xm = -BloodPart(i).xm
If BloodPart(i).x < 0 Then BloodPart(i).x = 0: BloodPart(i).xm = -BloodPart(i).xm
If BloodPart(i).ym > 0 Then RotoZoom BloodPart(i).x, BloodPart(i).y, BloodDrop, 1.5, BloodPart(i).xm / 15
If BloodPart(i).ym < 0 Then RotoZoom BloodPart(i).x, BloodPart(i).y, BloodDrop, 1.5, 180 + BloodPart(i).xm / 15
If BloodPart(i).y > _Width(HeartPercent) + 10 Then BloodPart(i).visible = 0
If BloodPart(i).y < -32 Then BloodPart(i).visible = 0
End If
Next
RotHeartDisplay = -(Player(1).xm / 6)
If RotHeartDisplay > 45 Then RotHearDisplay = 45
If RotHeartDisplay < -45 Then RotHearDisplay = -45
RotoZoom _Width / 2 + (Player(1).xm / 50), ((Abs(Player(1).Health - 100) * (_Height / 100))), Hud_Health_Fluid, 2.2, RotHeartDisplay
'_PutImage ((_Width / 2) + (_Width(HeartPercent) / 2), (_Height / 2) + (_Height(HeartPercent) / 2)), HeartPercent
_PutImage ((_Width / 2) - HeartThx / 2, (_Height / 2) - HeartThy / 2), HeartPercent
If PlayerIsOnFire > 0 Then firechoosen = (Int(Rnd * 3) + 1): _PutImage (0, 0)-(_Width, _Height), FireParticles(firechoosen)
_PutImage (0, 0)-(_Width, _Height), Hud_Health_Icon
_Dest MainScreen
_ClearColor _RGB32(0, 255, 0), HudImageHealth
If Player(1).Health < 60 And ShadeRed > Abs(60 - Player(1).Health) Then ShadeRed = ShadeRed - 1
If Player(1).Health < 60 And ShadeRed < Abs(60 - Player(1).Health) Then ShadeRed = ShadeRed + 1
If Player(1).Health > 60 And ShadeRed > 0 Then ShadeRed = ShadeRed - 1
Return
RestartEverything:
SizeDelayMinimap = 6
Hud(1).rotation = 200
Wave = 0
WaveWait = 0
WaveBudget = 0
FlameAmmo = 0
SMGAmmo = 200
ShotgunAmmo = 5
GrenadeAmmo = 1
'Generate Minimap Texture
GoSub GenerateMiniMap
PlayerOnFire = 0
RayM(1).x = (_Width / 2) - (_Height / 2)
RayM(1).y = 0
RayM(2).x = (_Width / 2) + (_Height / 2)
RayM(2).y = _Height
MiniMapGoBack = 20
DayAmount = 138
Player(1).x = 2064 * 2
Player(1).y = 2064 * 2
Player(1).size = 25
GunDisplay(1).visible = 1
GunDisplay(1).wtype = 2
Mouse.click = 0
For i = 1 To GrenadeMax
Grenade(i).x = 64
Grenade(i).y = 64
Grenade(i).z = 1
Grenade(i).xm = 64
Grenade(i).ym = 64
Grenade(i).froozen = 0
Grenade(i).rotation = 0
Grenade(i).rotationspeed = 0
Grenade(i).visible = 0
Next
For i = 1 To ZombieMax
Zombie(i).active = 0
Zombie(i).onfire = 0
Next
For i = 1 To FireMax
Fire(i).visible = 0
Fire(i).txt = 0
Fire(i).xm = 0
Fire(i).ym = 0
Fire(i).froozen = 0
Next
RenderLayer1 = 1
RenderLayer2 = 1
RenderLayer3 = 1
delay = 100
For i = 1 To ParticlesMax
Part(i).froozen = 0
Part(i).visible = 0
Next
Zoom = 1
PlayerCantMove = 0
DeathTimer = 0
PlayerIsOnFire = 0
Player(1).Health = 150
Player(1).DamageToTake = 0
Return
TurningDay:
If Player(1).Health <= 0 Then Wave = 1
If DelayUntilStart > 0 Then DelayUntilStart = DelayUntilStart - 1
If DelayUntilStart = 0 And DayAmount > 0 Then DayAmount = DayAmount / 1.005
If DayAmount < 20 And Tile(Fix(Player(1).x / Map.TileSize), Fix(Player(1).y / Map.TileSize), 1).ID = 66 Then PlayerIsOnFire = 5
If DayAmount < 1 Then DayAmount = 0
If DayAmount = 0 And Player(1).Health > 0 Then
If Showtext = 1 Then WaveDisplayY = -thy * 2
Showtext = 2
Darkening = Darkening + 0.5
If Darkening > 400 Then System
Line (0, 0)-(_Width, _Height), _RGBA32(0, 0, 0, Darkening), BF
Text$ = "Rest Well"
FontSizeUse = 70
GoSub HudText
dist = (Abs(WaveDisplayY - _Width / 2) / 50): WaveDisplayY = WaveDisplayY + 1 / (dist / 15)
WaveDisplayTHX = thx: WaveDisplayTHY = thy
_PutImage (_Width / 2 - WaveDisplayTHX / 2, WaveDisplayY - WaveDisplayTHY / 2), ImgToMenu
Text$ = ("They will return tomorrow...")
FontSizeUse = 40
GoSub HudText
WaveDisplayTHX = thx
_PutImage (_Width / 2 - WaveDisplayTHX / 2, WaveDisplayY + WaveDisplayTHY / 2), ImgToMenu
End If
If Showtext = 1 Then
Text$ = "Go inside the house."
FontSizeUse = 70
GoSub HudText
dist = (Abs(WaveDisplayY - _Width / 2) / 50): WaveDisplayY = WaveDisplayY + 1 / (dist / 15)
WaveDisplayTHX = thx: WaveDisplayTHY = thy
_PutImage (_Width / 2 - WaveDisplayTHX / 2, WaveDisplayY - WaveDisplayTHY / 2), ImgToMenu
Text$ = ("The sun is coming.")
FontSizeUse = 40
GoSub HudText
WaveDisplayTHX = thx
_PutImage (_Width / 2 - WaveDisplayTHX / 2, WaveDisplayY + WaveDisplayTHY / 2), ImgToMenu
End If
Return
MiniMapCode:
RenderZombiesMinimap = 1
UpdateMiniMap = UpdateMiniMap - 1
If UpdateMiniMap < 0 Then GoSub GenerateMiniMap
If MiniMapGoBack > 0 Then MiniMapGoBack = MiniMapGoBack - 1
CheckMiniMapKey = 0
If CheckMiniMapKey = 0 And _KeyDown(9) = -1 And CheckMiniMapKeyPre = 0 Then CheckMiniMapKey = 1
CheckMiniMapKeyPre = _KeyDown(9)
If CheckMiniMapKey = 1 Then ToggleMinimapBig = ToggleMinimapBig + 1: If ToggleMinimapBig = 2 Then ToggleMinimapBig = 0
If MiniMapGoBack = 1 Then ToggleMinimapBig = 0: CheckMiniMapKey = 1
If ToggleMinimapBig = 1 And CheckMiniMapKey = 1 Then
RayM(1).x = Minimap.x1: RayM(1).y = Minimap.y1
RayM(1).damage = (_Width / 2) - (_Height / 2)
RayM(1).knockback = 0: RayM(1).owner = 1
RayM(2).x = Minimap.x2: RayM(2).y = Minimap.y2
RayM(2).damage = (_Width / 2) + (_Height / 2)
RayM(2).knockback = _Height
RayM(2).owner = 1
MiniMapGoBack = 360
End If
If ToggleMinimapBig = 0 And CheckMiniMapKey = 1 Then
RayM(1).x = Minimap.x1: RayM(1).y = Minimap.y1
RayM(1).damage = _Width - 200
RayM(1).knockback = 0: RayM(1).owner = 1
RayM(2).x = Minimap.x2: RayM(2).y = Minimap.y2
RayM(2).damage = _Width
RayM(2).knockback = 200
RayM(2).owner = 1
MiniMapGoBack = 0
End If
For i = 1 To 2
If RayM(i).owner = 1 Then
dx = RayM(i).x - RayM(i).damage: dy = RayM(i).y - RayM(i).knockback
rotation = ATan2(dy, dx) ' Angle in radians
RayM(i).angle = (rotation * 180 / PI) + 90
If RayM(i).angle > 180 Then RayM(i).angle = RayM(i).angle - 179.9
xvector = Sin(RayM(i).angle * PIDIV180): yvector = -Cos(RayM(i).angle * PIDIV180)
RayM(i).x = RayM(i).x + xvector * (0.1 + (Distance(RayM(i).x, RayM(i).y, RayM(i).damage, RayM(i).knockback) / 5))
RayM(i).y = RayM(i).y + yvector * (0.1 + (Distance(RayM(i).x, RayM(i).y, RayM(i).damage, RayM(i).knockback) / 5))
If Int(RayM(i).x) = Int(RayM(i).damage) And Int(RayM(i).y) = Int(RayM(i).knockback) Then RayM(i).owner = 0
End If
Next
Minimap.x1 = RayM(1).x
Minimap.y1 = RayM(1).y
Minimap.x2 = RayM(2).x
Minimap.y2 = RayM(2).y
If MiniMapGoBack = 0 Then MinimapSize = Int((Minimap.x2 - Minimap.x1) / SizeDelayMinimap): If SizeDelayMinimap < 6 Then SizeDelayMinimap = SizeDelayMinimap + 0.5
If MiniMapGoBack <> 0 Then MinimapSize = Int((Minimap.x2 - Minimap.x1) / SizeDelayMinimap): If SizeDelayMinimap > 2 Then SizeDelayMinimap = SizeDelayMinimap - 1
Offset = Abs((Int(Player(1).xm) + Int(Player(1).ym) / 2) / 10) + 100 + MinimapSize
_PutImage (Minimap.x1, Minimap.y1)-(Minimap.x2, Minimap.y2), MinimapIMG, MainScreen, ((Player(1).x / 8) - Offset, (Player(1).y / 8) - Offset)-((Player(1).x / 8) + Offset, (Player(1).y / 8) + Offset)
Line (Minimap.x1, Minimap.y1)-(Minimap.x2, Minimap.y2), _RGBA32(0, 255, 0, UpdateMiniMap / 1.5), BF
Return
GenerateMiniMap:
UpdateMiniMap = 60
_Dest MinimapIMG
For x = 0 To Map.MaxWidth
For y = 0 To Map.MaxHeight
z = 1
xs = x * MinimapTxtSize
ys = y * MinimapTxtSize
If Tile(x, y, z).ID <> 0 Then _PutImage (xs, ys)-(xs + (MinimapTxtSize), ys + (MinimapTxtSize)), Tileset, MinimapIMG, (Tile(x, y, z).rend_spritex * Map.TextureSize, Tile(x, y, z).rend_spritey * Map.TextureSize)-(Tile(x, y, z).rend_spritex * Map.TextureSize + (Map.TextureSize - 1), Tile(x, y, z).rend_spritey * Map.TextureSize + (Map.TextureSize - 1))
Line (xs, ys)-(xs + (MinimapTxtSize), ys + (MinimapTxtSize)), _RGBA32(0, 0, 0, 64), BF
z = 2
If Tile(x, y, z).ID <> 0 Then _PutImage (xs, ys)-(xs + (MinimapTxtSize), ys + (MinimapTxtSize)), Tileset, MinimapIMG, (Tile(x, y, z).rend_spritex * Map.TextureSize, Tile(x, y, z).rend_spritey * Map.TextureSize)-(Tile(x, y, z).rend_spritex * Map.TextureSize + (Map.TextureSize - 1), Tile(x, y, z).rend_spritey * Map.TextureSize + (Map.TextureSize - 1))
Next
Next
If RenderZombiesMinimap = 1 Then
For i = 1 To ZombieMax
If Zombie(i).active = 1 Then
If Zombie(i).special = "Runner" Then Line (Zombie(i).x1 / 8, Zombie(i).y1 / 8)-(Zombie(i).x2 / 8, Zombie(i).y2 / 8), _RGB32(255, 0, 255), BF
If Zombie(i).special = "Brute" Then Line (Zombie(i).x1 / 8, Zombie(i).y1 / 8)-(Zombie(i).x2 / 8, Zombie(i).y2 / 8), _RGB32(255, 0, 0), BF
If Zombie(i).special = "Slower" Then Line (Zombie(i).x1 / 8, Zombie(i).y1 / 8)-(Zombie(i).x2 / 8, Zombie(i).y2 / 8), _RGB32(64, 0, 64), BF
If Zombie(i).special = "Bomber" Then Line (Zombie(i).x1 / 8, Zombie(i).y1 / 8)-(Zombie(i).x2 / 8, Zombie(i).y2 / 8), _RGB32(128, 128, 128), BF
If Zombie(i).special = "Fire" Then Line (Zombie(i).x1 / 8, Zombie(i).y1 / 8)-(Zombie(i).x2 / 8, Zombie(i).y2 / 8), _RGB32(255, 128, 0), BF
If Zombie(i).special = "Biohazard" Then Line (Zombie(i).x1 / 8, Zombie(i).y1 / 8)-(Zombie(i).x2 / 8, Zombie(i).y2 / 8), _RGB32(0, 255, 0), BF
If Zombie(i).special = "Normal" Then Line (Zombie(i).x1 / 8, Zombie(i).y1 / 8)-(Zombie(i).x2 / 8, Zombie(i).y2 / 8), _RGB32(28, 125, 46), BF
End If
Next
End If
Line (Player(1).x1 / 8, Player(1).y1 / 8)-(Player(1).x2 / 8, Player(1).y2 / 8), _RGB32(255, 255, 255), BF
_Dest MainScreen
Return
Fire:
For i = 1 To FireMax
If Fire(i).visible > 0 Then
If Fire(i).froozen > Fire(i).visible Then Fire(i).visible = Fire(i).visible + 1: If Fire(i).froozen = Fire(i).visible Then Fire(i).froozen = 0
Fire(i).x = Fire(i).x + (Fire(i).xm / 10)
Fire(i).y = Fire(i).y + (Fire(i).ym / 10)
Fire(i).xm = Fire(i).xm / 1.01
Fire(i).ym = Fire(i).ym / 1.01
' RotoZoom ETSX(Fire(i).x), ETSY(Fire(i).y), FireParticle(Int(Rnd * 3) + 1), 0.1 + (Fire(i).visible / 10), Int(Rnd * 10) - 5
Size = 0.1 + Fire(i).visible
_PutImage (ETSX(Fire(i).x) - Size, ETSY(Fire(i).y) - Size)-(ETSX(Fire(i).x) + Size, ETSY(Fire(i).y) + Size), FireParticle
If Fire(i).txt = 0 Then
For z = 1 To ZombieMax
If Zombie(z).active = 1 Then If Distance(Fire(i).x, Fire(i).y, Zombie(z).x, Zombie(z).y) < (Size * 2) Then Zombie(z).onfire = Fire(i).visible * 5
Next
End If
If Int(Rnd * 20) = 3 Then Fire(i).visible = Fire(i).visible - 1
If Fire(i).visible > 10 And Fire(i).txt <> 4 And Distance(Fire(i).x, Fire(i).y, Player(1).x, Player(1).y) < Int(Size * 1.5) Then PlayerIsOnFire = 10 * Fire(i).visible
If Fire(i).visible > 20 And Fix(Fire(i).visible / 1.5) > 5 And Int(Rnd * 10) = 3 Then
FireLast = FireLast + 1: If FireLast > FireMax Then FireLast = 1
Fire(FireLast).txt = Fire(i).txt
Fire(i).visible = Fire(i).visible - 5
Fire(FireLast).froozen = Fix(Fire(i).visible * 2.5)
Fire(FireLast).visible = 2
Fire(FireLast).x = Fire(i).x + (Int(Rnd * 30) - 15) * 2
Fire(FireLast).y = Fire(i).y + (Int(Rnd * 30) - 15) * 2
For k = 1 To FireMax
If k <> i Then
If Distance(Fire(i).x, Fire(i).y, Fire(k).x, Fire(k).y) < (Size * 2) Then Fire(FireLast).visible = 5
End If
Next
End If
If Fire(i).visible = 0 Then
Fire(i).txt = 0
Fire(i).xm = 0
Fire(i).ym = 0
Fire(i).froozen = 0
End If
End If
Next
Return
ResizeScreen:
If ResizeDelay > 0 Then ResizeDelay = ResizeDelay - 1
If _Resize And ResizeDelay = 0 And _WindowHasFocus Then
Cls
Screen SecondScreen
_FreeImage MainScreen
ScreenSizeX = _ResizeWidth
ScreenSizeY = _ResizeHeight
If ScreenSizeX < 128 Then ScreenSizeX = 128
If ScreenSizeY < 128 Then ScreenSizeY = 128
MainScreen = _NewImage(ScreenSizeX, ScreenSizeY, 32)
Screen MainScreen
ResizeDelay = 5
End If
Return
TriggerPlayer:
For i = 1 To Map.Triggers
If TriggerPlayerCollide(Player(1), Trigger(i)) Then
Select Case Trigger(i).class
Case "TP"
Player(1).x = Trigger(i).val1 * 2
Player(1).y = Trigger(i).val2 * 2
Case "DoorUse"
If PlayerInteract = 1 Then
DoorX = Fix(((Trigger(i).x2 + Trigger(i).x1) / 2) / Map.TileSize)
DoorY = Fix(((Trigger(i).y2 + Trigger(i).y1) / 2) / Map.TileSize)
Trigger(i).val3 = Trigger(i).val3 + 1: If Trigger(i).val3 > 1 Then Trigger(i).val3 = 0
If Trigger(i).val3 = 0 Then Tile(DoorX, DoorY, 2).ID = Trigger(i).val1: Tile(DoorX, DoorY, 2).solid = 1
If Trigger(i).val3 = 1 Then Tile(DoorX, DoorY, 2).ID = Trigger(i).val2: Tile(DoorX, DoorY, 2).solid = 0
IDTOTEXTURE = Tile(DoorX, DoorY, 2).ID: Tile(DoorX, DoorY, 2).rend_spritey = 0
Do
If IDTOTEXTURE > 16 Then Tile(DoorX, DoorY, 2).rend_spritey = Tile(DoorX, DoorY, 2).rend_spritey + 1: IDTOTEXTURE = IDTOTEXTURE - 16
Tile(DoorX, DoorY, 2).rend_spritex = IDTOTEXTURE
Loop While IDTOTEXTURE > 16
End If
End Select
End If
Next
Return
PlayerDeath:
If DeathTimer = 1 Then _SndPlay PlayerDeath
If DeathTimer < 1000 Then DeathTimer = DeathTimer + 3
Hud(1).ym = DeathTimer * 2
If Int(Rnd * 6) + 1 = 3 And DeathTimer < 400 Then SpawnBloodParticle Player(1).x - 20 + Int(Rnd * 21), Player(1).y - 20 + Int(Rnd * 21), -180 + Int(Rnd * 361), 20, "red": Part(LastPart).xm = Int(Rnd * 500) - 250: Part(LastPart).ym = Int(Rnd * 500) - 250: Part(LastPart).zm = Int(Part(LastPart).zm / 4)
DayAmount = DayAmount + 1
PlayerCantMove = 1
If DayAmount > 480 Then GoSub RestartEverything
Return
WaveChange:
Randomize Timer
If WaveWait = 0 Then
WaveWait = 600: WaveDisplayY = -thy: Wave = Wave + 1: WaveBudget = (Wave * 10) + Int(Rnd * 22)
If WaveBudget > 128 Then WaveBudget = 128
End If
If Wave = 16 Then WaveWait = -9999999: DelayUntilStart = 2000: Showtext = 1: WaveDisplayY = -thy * 2: GoTo EndWaveCode
If WaveWait = 1 Then
DayAmount = DayAmount - 1
For i = 1 To WaveBudget
CreateZombie:
Special = 0
If Int(Rnd * 3) + 1 = 1 Then Special = 1
If Special = 1 Then SpecialType = Int(Rnd * 6) + 1
If Special <> 1 Then
Rand = Int(Rnd * 80)
If Rand = 47 Then
Zombie(i).size = Int(Rnd * (DefZombie.size - 20 + 1)) + 20 ' DefZombie.size
Else
Zombie(i).size = DefZombie.size
End If
Zombie(i).active = 1
Zombie(i).maxspeed = Int(Rnd * (500 - 300 + 1)) + 300
Zombie(i).damage = Int(Rnd * (10 - 2 + 1)) + 2
Zombie(i).speeding = Int(Rnd * (20 - 10 + 1)) + 10
Zombie(i).knockback = Int(Rnd * (8 - 5 + 1)) + 5
Zombie(i).special = "Normal"
Zombie(i).health = Int(Rnd * (DefZombie.maxhealth - DefZombie.minhealth + 1)) + DefZombie.minhealth
Zombie(i).weight = 1
End If
If Special = 1 Then
Zombie(i).active = 1
Select Case SpecialType
Case 1 ' Runner
Rand = Int(Rnd * 20120)
Zombie(i).size = Int(Rnd * (34 - 25 + 1)) + 25
Zombie(i).health = Int(Rnd * (Int(DefZombie.maxhealth / 1.5) - Fix(DefZombie.minhealth / 1.5) + 1)) + Fix(DefZombie.minhealth / 2)
Zombie(i).maxspeed = Int(Rnd * (1200 - 900 + 1)) + 900
Zombie(i).damage = Int(Rnd * (10 - 2 + 1)) + 2
Zombie(i).speeding = Int(Rnd * (40 - 30 + 1)) + 30
Zombie(i).knockback = Int(Rnd * (10 - 5 + 1)) + 5
Zombie(i).special = "Runner"
Zombie(i).weight = 2
Case 2 ' Brute
Rand = Int(Rnd * 5)
If Rand = 3 Then GoTo CreateZombie
Zombie(i).size = Int(Rnd * (100 - 70 + 1)) + 70
Zombie(i).health = Int(Rnd * ((DefZombie.maxhealth + 500) - DefZombie.minhealth + 1)) + DefZombie.minhealth + (Zombie(i).size * 2)
Zombie(i).maxspeed = Int(Rnd * (650 - 500 + 1)) + 500
Zombie(i).damage = Int(Rnd * (80 - 40 + 1)) + 40
Zombie(i).speeding = Int(Rnd * (20 - 10 + 1)) + 10
Zombie(i).knockback = Int(Rnd * (50 - 30 + 1)) + 30
Zombie(i).special = "Brute"
Zombie(i).weight = 20
Case 3 ' Slower
Zombie(i).size = Int(Rnd * (34 - 25 + 1)) + 25
Zombie(i).health = Int(Rnd * (Int(DefZombie.maxhealth + 20) - Fix(DefZombie.minhealth) + 1)) + Fix(DefZombie.minhealth)
Zombie(i).damage = Int(Rnd * (30 - 20 + 1)) + 20
Zombie(i).maxspeed = DefZombie.maxspeed
Zombie(i).speeding = Int(Rnd * (7 - 4 + 1)) + 4
Zombie(i).weight = 3
Zombie(i).knockback = Int(Rnd * (10 - 5 + 1)) + 5
Zombie(i).special = "Slower"
Case 4 ' Bomber
Rand = Int(Rnd * 7)
If Rand = 5 Then GoTo CreateZombie
Zombie(i).size = Int(Rnd * (34 - 25 + 1)) + 25
Zombie(i).health = Int(Rnd * (Int(DefZombie.maxhealth / 2) - Fix(DefZombie.minhealth / 2) + 1)) + Fix(DefZombie.minhealth / 2)
Zombie(i).maxspeed = Int(Rnd * (850 - 700 + 1)) + 700
Zombie(i).damage = Int(Rnd * (10 - 2 + 1)) + 2
Zombie(i).speeding = Int(Rnd * (30 - 20 + 1)) + 20
Zombie(i).knockback = Int(Rnd * (10 - 5 + 1)) + 5
Zombie(i).special = "Bomber"
Zombie(i).weight = 6
Case 5 ' Fire
Rand = Int(Rnd * 10)
If Rand = 5 Then GoTo CreateZombie
Zombie(i).size = Int(Rnd * (37 - 27 + 1)) + 27
Zombie(i).health = Int(Rnd * (Int(DefZombie.maxhealth) - Fix(DefZombie.minhealth) + 1)) + Fix(DefZombie.minhealth)
Zombie(i).maxspeed = Int(Rnd * (850 - 500 + 1)) + 500
Zombie(i).damage = Int(Rnd * (10 - 2 + 1)) + 2
Zombie(i).speeding = Int(Rnd * (10 - 5 + 1)) + 5
Zombie(i).knockback = Int(Rnd * (10 - 5 + 1)) + 5
Zombie(i).special = "Fire"
Zombie(i).weight = 2
Case 6 ' Biohazard
Rand = Int(Rnd * 200)
Zombie(i).size = Int(Rnd * (37 - 27 + 1)) + 27
Zombie(i).health = Int(Rnd * (Int(DefZombie.maxhealth) - Fix(DefZombie.minhealth) + 1)) + Fix(DefZombie.minhealth)
Zombie(i).maxspeed = Int(Rnd * (850 - 500 + 1)) + 500
Zombie(i).damage = Int(Rnd * (10 - 2 + 1)) + 2
Zombie(i).speeding = Int(Rnd * (10 - 5 + 1)) + 5
Zombie(i).knockback = -Int(Rnd * (10 - 5 + 1)) + 5
Zombie(i).special = "Biohazard"
Zombie(i).weight = 2
End Select
End If
Zombie(i).x = 4 + Int(Rnd * (Map.MaxWidth - 8))
Zombie(i).y = 4 + Int(Rnd * (Map.MaxHeight - 8))
If Tile(Fix(Zombie(i).x), Fix(Zombie(i).y), 2).solid = 1 Then GoTo CreateZombie
Zombie(i).x = Zombie(i).x * Map.TileSize
Zombie(i).y = Zombie(i).y * Map.TileSize
Zombie(i).healthFirst = Zombie(i).health
Zombie(i).sizeFirst = Zombie(i).size
Next
End If
If WaveWait > 0 Then WaveWait = WaveWait - 1
Text$ = "Wave: " + Str$(Wave)
FontSizeUse = 70
GoSub HudText
dist = (Abs(WaveDisplayY - _Width / 2) / 50): WaveDisplayY = WaveDisplayY + 1 / (dist / 15)
WaveDisplayTHX = thx: WaveDisplayTHY = thy
_PutImage (_Width / 2 - WaveDisplayTHX / 2, WaveDisplayY - WaveDisplayTHY / 2), ImgToMenu
Text$ = (_Trim$(Str$(WaveBudget)) + " Infecteds coming...")
FontSizeUse = 40
GoSub HudText
WaveDisplayTHX = thx
_PutImage (_Width / 2 - WaveDisplayTHX / 2, WaveDisplayY + WaveDisplayTHY / 2), ImgToMenu
EndWaveCode:
Return
DrawHud:
If DelayHud > 0 Then DelayHud = DelayHud - 1
If DelayHud > 0 Then HudChange = 0
If DelayHud = 0 And HudChange <> 0 Then DelayHud = 20: Hud(1).xm = HudChange * 800: Hud(1).ym = -200
If HudChange <> 0 Then SlotRotation = SlotRotation + HudChange * 20
SlotRotation = SlotRotation / 1.1
HudSlotSelected = HudSlotSelected + HudChange
HudSize = _Width + _Height
Hud(1).x = _Width / 2 + (Hud(1).xm / 10)
Hud(1).y = _Height + (Hud(1).ym / 10)
Hud(1).xm = Hud(1).xm / 1.025
Hud(1).ym = Hud(1).ym / 1.025
'If HudChangeOld = 0 And HudChange <> 0 Then Hud(1).rotation = Hud(1).rotation + HudChange * 5
HudChangeOld = HudChange
Hud(1).rotation = Hud(1).rotation + SlotRotation 'Hud(1).rotation + Distance
HighestHudAmount = 9999999
For i = 2 To 6
Hud(i).xm = Hud(i).xm / 1.2
Hud(i).ym = Hud(i).ym / 1.2
degree = i * 72
Hudxv = Sin((Hud(1).rotation + degree) * PIDIV180)
Hudyv = -Cos((Hud(1).rotation + degree) * PIDIV180)
Hud(i).x = (Hud(1).x + Hudxv * 128)
Hud(i).y = (Hud(1).y + Hudyv * 64)
If Hud(i).y < HighestHudAmount Then HighestHudAmount = Hud(i).y: HighestHud = i
Next
If HudChange = 0 Then HudTopDistance = (Hud(HighestHud).x - Hud(1).x)
Hud(1).rotation = Hud(1).rotation - (HudTopDistance) / 7.5
HudChange = 0
For i = 2 To 6
Hud(i).size = 32
Hud(i).x1 = Hud(i).x - Hud(i).size + Hud(i).xm
Hud(i).x2 = Hud(i).x + Hud(i).size + Hud(i).xm
Hud(i).y1 = Hud(i).y - Hud(i).size + Hud(i).ym
Hud(i).y2 = Hud(i).y + Hud(i).size + Hud(i).ym
Side0 = HighestHud - 2: If Side0 <= 1 Then Side0 = Side0 + 5
Side3 = HighestHud + 2: If Side3 >= 7 Then Side3 = Side3 - 5
Side1 = HighestHud - 1: If Side1 = 1 Then Side1 = 6
Side2 = HighestHud + 1: If Side2 = 7 Then Side2 = 2
If HideUI = 0 Then
If i = HighestHud Then _MapTriangle (0, 0)-(16, 32)-(32, 0), HudSelected To(Hud(i).x1, Hud(i).y2)-(Hud(1).x, Hud(1).y)-(Hud(i).x2, Hud(i).y2) ' Line (Hud(1).x, Hud(1).y)-(Hud(i).x1, Hud(i).y2), _RGB32(255, 255, 255): Line (Hud(1).x, Hud(1).y)-(Hud(i).x2, Hud(i).y2), _RGB32(255, 255, 255)
If i = Side1 Then _MapTriangle (0, 0)-(16, 32)-(32, 0), HudNotSelected To(Hud(i).x2, Hud(i).y1)-(Hud(1).x, Hud(1).y)-(Hud(i).x2, Hud(i).y2) ' Line (Hud(1).x, Hud(1).y)-(Hud(i).x1, Hud(i).y2), _RGB32(255, 255, 255): Line (Hud(1).x, Hud(1).y)-(Hud(i).x2, Hud(i).y2), _RGB32(255, 255, 255)
If i = Side2 Then _MapTriangle (0, 0)-(16, 32)-(32, 0), HudNotSelected To(Hud(i).x1, Hud(i).y1)-(Hud(1).x, Hud(1).y)-(Hud(i).x1, Hud(i).y2) ' Line (Hud(1).x, Hud(1).y)-(Hud(i).x1, Hud(i).y2), _RGB32(255, 255, 255): Line (Hud(1).x, Hud(1).y)-(Hud(i).x2, Hud(i).y2), _RGB32(255, 255, 255)
If i = Side3 Then _MapTriangle (0, 0)-(16, 32)-(32, 0), HudNotSelected To(Hud(i).x2, Hud(i).y1)-(Hud(1).x, Hud(1).y)-(Hud(i).x2, Hud(i).y2) ' Line (Hud(1).x, Hud(1).y)-(Hud(i).x1, Hud(i).y2), _RGB32(255, 255, 255): Line (Hud(1).x, Hud(1).y)-(Hud(i).x2, Hud(i).y2), _RGB32(255, 255, 255)
If i = Side0 Then _MapTriangle (0, 0)-(16, 32)-(32, 0), HudNotSelected To(Hud(i).x1, Hud(i).y1)-(Hud(1).x, Hud(1).y)-(Hud(i).x1, Hud(i).y2) ' Line (Hud(1).x, Hud(1).y)-(Hud(i).x1, Hud(i).y2), _RGB32(255, 255, 255): Line (Hud(1).x, Hud(1).y)-(Hud(i).x2, Hud(i).y2), _RGB32(255, 255, 255)
_PutImage (Hud(1).x - 5, Hud(1).y - 5)-(Hud(1).x + 5, Hud(1).y + 5), PlayerHand(1)
' If i <> HighestHud Then Line (Hud(1).x, Hud(1).y)-(Hud(i).x, Hud(i).y), _RGB32(255, 255, 255)
If i = HighestHud Then Line (Hud(i).x1, Hud(i).y1)-(Hud(i).x2, Hud(i).y2), _RGB32(255, 255, 255), BF
If i <> HighestHud Then Line (Hud(i).x1, Hud(i).y1)-(Hud(i).x2, Hud(i).y2), _RGB32(128, 128, 128), BF
If i = 2 Then
_PutImage (Hud(i).x1, Hud(i).y1)-(Hud(i).x2, Hud(i).y2), Guns_Pistol
percent = CalculatePercentage(SMGAmmoMax, SMGAmmo) / 10
pc = Fix(percent * 25.5)
pc2 = Abs(pc - 255)
Line (Hud(i).x1, Hud(i).y2 - (Hud(i).size / 5))-(Hud(i).x2, Hud(i).y2), _RGB32(0, 0, 0), BF
Line (Hud(i).x1, Hud(i).y2 - (Hud(i).size / 5))-(Hud(i).x1 + (percent * 6.4), Hud(i).y2), _RGB32(pc2, pc, 0), BF
End If
If i = 3 Then
_PutImage ((Hud(i).x + Hud(i).xm) - (_Width(Guns_Shotgun) / 4), (Hud(i).y + Hud(i).ym) - (_Height(Guns_Shotgun) / 4))-(Hud(i).x + Hud(i).xm + (_Width(Guns_Shotgun) / 4), Hud(i).y + Hud(i).ym + (_Height(Guns_Shotgun) / 4)), Guns_Shotgun
percent = CalculatePercentage(ShotgunAmmoMax, ShotgunAmmo) / 10
pc = Fix(percent * 25.5)
pc2 = Abs(pc - 255)
Line (Hud(i).x1, Hud(i).y2 - (Hud(i).size / 5))-(Hud(i).x2, Hud(i).y2), _RGB32(0, 0, 0), BF
Line (Hud(i).x1, Hud(i).y2 - (Hud(i).size / 5))-(Hud(i).x1 + (percent * 6.4), Hud(i).y2), _RGB32(pc2, pc, 0), BF
End If
If i = 4 Then
_PutImage (Hud(i).x1, Hud(i).y1)-(Hud(i).x2, Hud(i).y2), Guns_SMG
percent = CalculatePercentage(SMGAmmoMax, SMGAmmo) / 10
pc = Fix(percent * 25.5)
pc2 = Abs(pc - 255)
Line (Hud(i).x1, Hud(i).y2 - (Hud(i).size / 5))-(Hud(i).x2, Hud(i).y2), _RGB32(0, 0, 0), BF
Line (Hud(i).x1, Hud(i).y2 - (Hud(i).size / 5))-(Hud(i).x1 + (percent * 6.4), Hud(i).y2), _RGB32(pc2, pc, 0), BF
End If
If i = 5 Then
_PutImage (Hud(i).x1, Hud(i).y1)-(Hud(i).x2, Hud(i).y2), Guns_Grenade
percent = CalculatePercentage(GrenadeAmmoMax, GrenadeAmmo) / 10
pc = Fix(percent * 25.5)
pc2 = Abs(pc - 255)
Line (Hud(i).x1, Hud(i).y2 - (Hud(i).size / 5))-(Hud(i).x2, Hud(i).y2), _RGB32(0, 0, 0), BF
Line (Hud(i).x1, Hud(i).y2 - (Hud(i).size / 5))-(Hud(i).x1 + (percent * 6.4), Hud(i).y2), _RGB32(pc2, pc, 0), BF
End If
If i = 6 Then
_PutImage (Hud(i).x1, Hud(i).y1)-(Hud(i).x2, Hud(i).y2), Guns_Flame
percent = CalculatePercentage(FlameAmmoMax, FlameAmmo) / 10
pc = Fix(percent * 25.5)
pc2 = Abs(pc - 255)
Line (Hud(i).x1, Hud(i).y2 - (Hud(i).size / 5))-(Hud(i).x2, Hud(i).y2), _RGB32(0, 0, 0), BF
Line (Hud(i).x1, Hud(i).y2 - (Hud(i).size / 5))-(Hud(i).x1 + (percent * 6.4), Hud(i).y2), _RGB32(pc2, pc, 0), BF
End If
End If
Next
Return
HudText:
_Font BegsFontSizes(FontSizeUse)
thx = _PrintWidth(Text$)
thy = _FontHeight(BegsFontSizes(FontSizeUse))
If ImgToMenu <> 0 Then _FreeImage ImgToMenu
ImgToMenu = _NewImage(thx * 3, thy * 3, 32)
_Dest ImgToMenu
_ClearColor _RGB32(0, 0, 0): _PrintMode _KeepBackground: _Font BegsFontSizes(FontSizeUse): Print Text$
_Dest MainScreen
_Font BegsFontSizes(20)
Return
GrenadeLogic:
For i = 1 To GrenadeMax
If Grenade(i).visible = 0 Then GoTo EndOfGrenadeLogic
Grenade(i).x = Grenade(i).x + (Grenade(i).xm / 10)
Grenade(i).y = Grenade(i).y + (Grenade(i).ym / 10)
Grenade(i).z = Grenade(i).z + (Grenade(i).zm / 10)
If Grenade(i).z > 0 Then Grenade(i).zm = Grenade(i).zm - 2
If Grenade(i).z < 0 And Grenade(i).zm < 0 Then
_SndPlayCopy ShellSounds(Int(1 + Rnd * 3)), 0.25
Grenade(i).zm = Int(Grenade(i).zm * -0.5)
Grenade(i).xm = Int(Grenade(i).xm / 2): Grenade(i).ym = Int(Grenade(i).ym / 2)
End If
If Grenade(i).froozen = -1 Then
x1 = Fix(Grenade(i).x / Map.TileSize) - 3
x2 = Fix(Grenade(i).x / Map.TileSize) + 3
y1 = Fix(Grenade(i).y / Map.TileSize) - 3
y2 = Fix(Grenade(i).y / Map.TileSize) + 3
If x1 < 0 Then x1 = 0
If y1 < 0 Then y1 = 0
If x2 > Map.MaxWidth Then x2 = Map.MaxWidth
If y2 > Map.MaxHeight Then y2 = Map.MaxHeight
For x = x1 To x2
For y = y1 To y2
If Tile(x, y, 2).fragile = 1 Then
For o = 1 To 5
Part(LastPart).x = x * Map.TileSize + Int(Rnd * Map.TileSize): Part(LastPart).y = y * Map.TileSize + Int(Rnd * Map.TileSize): Part(LastPart).z = 2: Part(LastPart).xm = Int(Rnd * 128) - 64: Part(LastPart).ym = Int(Rnd * 128) - 64: Part(LastPart).zm = 2 + Int(Rnd * 7)
Part(LastPart).froozen = -30: Part(LastPart).visible = 1600: Part(LastPart).partid = "GlassShard": Part(LastPart).playwhatsound = "Glass"
Part(LastPart).rotation = Int(Rnd * 360) - 180: Part(LastPart).rotationspeed = Int(Rnd * 60) - 30: LastPart = LastPart + 1: If LastPart > ParticlesMax Then LastPart = 0
Next
If Tile(x, y, 2).ID = 56 Then _SndPlayCopy GlassShadder(Int(1 + Rnd * 3)), 0.4
Tile(x, y, 2).ID = 0
Tile(x, y, 2).solid = 0
Tile(x, y, 2).rend_spritex = 0
Tile(x, y, 2).rend_spritey = 0
End If
Next
Next
Grenade(i).visible = 0
Grenade(i).froozen = 0
Explosion Grenade(i).x, Grenade(i).y, 100, 350
Circle (ETSX(Grenade(i).x), ETSY(Grenade(i).y)), 200, _RGB32(255, 255, 255)
_SndPlay SND_Explosion
End If
If Grenade(i).froozen < 0 Then Grenade(i).froozen = Grenade(i).froozen + 1
If Fix(Grenade(i).z) <= 0 Then Grenade(i).z = 0
If Grenade(i).xm > 0 Then Grenade(i).xm = Grenade(i).xm - 1
If Grenade(i).ym > 0 Then Grenade(i).ym = Grenade(i).ym - 1
If Grenade(i).xm < 0 Then Grenade(i).xm = Grenade(i).xm + 1
If Grenade(i).ym < 0 Then Grenade(i).ym = Grenade(i).ym + 1
If Tile(Fix((Grenade(i).x + 8) / Map.TileSize), Fix(Grenade(i).y / Map.TileSize), 2).solid = 1 Then Grenade(i).xm = Grenade(i).xm * -1.1: Grenade(i).ym = 0
If Tile(Fix((Grenade(i).x - 8) / Map.TileSize), Fix(Grenade(i).y / Map.TileSize), 2).solid = 1 Then Grenade(i).xm = Grenade(i).xm * -1.1: Grenade(i).ym = 0
If Tile(Fix(Grenade(i).x / Map.TileSize), Fix((Grenade(i).y + 8) / Map.TileSize), 2).solid = 1 Then Grenade(i).xm = 0: Grenade(i).ym = Grenade(i).ym * -1.1
If Tile(Fix(Grenade(i).x / Map.TileSize), Fix((Grenade(i).y - 8) / Map.TileSize), 2).solid = 1 Then Grenade(i).xm = 0: Grenade(i).ym = Grenade(i).ym * -1.1
Grenade(i).rotation = Grenade(i).rotation + Grenade(i).rotationspeed
If Grenade(i).rotationspeed > 0 Then Grenade(i).rotationspeed = Grenade(i).rotationspeed - 1
If Grenade(i).rotationspeed < 0 Then Grenade(i).rotationspeed = Grenade(i).rotationspeed + 1
RotoZoom ETSX(Grenade(i).x), ETSY(Grenade(i).y), Guns_Grenade, .6 + (Grenade(i).z / 50), Grenade(i).rotation + 90
EndOfGrenadeLogic:
Next
Return
RenderMobs:
For i = 1 To ZombieMax
If Zombie(i).active = 1 Then
' If debug = 1 Then
Select Case Zombie(i).special
Case "Runner"
'If Debug = 1 Then Line (ETSX(Zombie(i).x1), ETSY(Zombie(i).y1))-(ETSX(Zombie(i).x2), ETSY(Zombie(i).y2)), _RGB32(255, 0, 255), BF
RotoZoom ETSX(Zombie(i).x), ETSY(Zombie(i).y), ZombieRunner, Zombie(i).size / 90, Zombie(i).rotation
Case "Brute"
' If Debug = 1 Then Line (ETSX(Zombie(i).x1), ETSY(Zombie(i).y1))-(ETSX(Zombie(i).x2), ETSY(Zombie(i).y2)), _RGB32(255, 0, 0), BF
RotoZoom ETSX(Zombie(i).x), ETSY(Zombie(i).y), ZombieBrute, Zombie(i).size / 90, Zombie(i).rotation
Case "Slower"
' If Debug = 1 Then Line (ETSX(Zombie(i).x1), ETSY(Zombie(i).y1))-(ETSX(Zombie(i).x2), ETSY(Zombie(i).y2)), _RGB32(64, 0, 64), BF
RotoZoom ETSX(Zombie(i).x), ETSY(Zombie(i).y), ZombieSlower, Zombie(i).size / 90, Zombie(i).rotation
Case "Bomber"
' If Debug = 1 Then Line (ETSX(Zombie(i).x1), ETSY(Zombie(i).y1))-(ETSX(Zombie(i).x2), ETSY(Zombie(i).y2)), _RGB32(128, 128, 128), BF
RotoZoom ETSX(Zombie(i).x), ETSY(Zombie(i).y), ZombieBomber, Zombie(i).size / 90, Zombie(i).rotation
Case "Fire"
' If Debug = 1 Then Line (ETSX(Zombie(i).x1), ETSY(Zombie(i).y1))-(ETSX(Zombie(i).x2), ETSY(Zombie(i).y2)), _RGB32(255, 128, 0), BF
RotoZoom ETSX(Zombie(i).x), ETSY(Zombie(i).y), ZombieFire, Zombie(i).size / 90, Zombie(i).rotation
Case "Biohazard"
' If Debug = 1 Then Line (ETSX(Zombie(i).x1), ETSY(Zombie(i).y1))-(ETSX(Zombie(i).x2), ETSY(Zombie(i).y2)), _RGB32(0, 255, 0), BF
RotoZoom ETSX(Zombie(i).x), ETSY(Zombie(i).y), ZombieBiohazard, Zombie(i).size / 90, Zombie(i).rotation
Case "Normal"
' If Debug = 1 Then Line (ETSX(Zombie(i).x1), ETSY(Zombie(i).y1))-(ETSX(Zombie(i).x2), ETSY(Zombie(i).y2)), _RGB32(255, 255, 128), BF
RotoZoom ETSX(Zombie(i).x), ETSY(Zombie(i).y), Zombie, Zombie(i).size / 90, Zombie(i).rotation
End Select
' End If
End If
Next
Return
ZombieAI:
For i = 1 To ZombieMax
If Zombie(i).active = 1 Then
If Zombie(i).special <> "" And Zombie(i).DistanceFromPlayer < 900 Then
If Zombie(i).special = "Runner" Then If Zombie(i).tick > 0 Then Zombie(i).tick = Zombie(i).tick - 1
If Zombie(i).special = "Fire" Then
If Zombie(i).DistanceFromPlayer < 450 And Int(Rnd * 10) = 4 Then
FireLast = FireLast + 1: If FireLast > FireMax Then FireLast = 1
Fire(FireLast).visible = 40: Fire(FireLast).froozen = 800
Fire(FireLast).x = Zombie(i).x + (Int(Rnd * 8) - 4): Fire(FireLast).y = Zombie(i).y + (Int(Rnd * 8) - 4)
Fire(FireLast).txt = 1: speed = (90 + Int(Rnd * 80))
angle = Zombie(i).rotation + Int(Rnd * 10) - 5: Fire(FireLast).xm = Sin(angle * PIDIV180) * speed
Fire(FireLast).ym = -Cos(angle * PIDIV180) * speed
End If
If Int(Rnd * 40) = 23 Then
FireLast = FireLast + 1: If FireLast > FireMax Then FireLast = 1
Fire(FireLast).x = Zombie(i).x + (Int(Rnd * 30) - 15) * 2
Fire(FireLast).txt = 1
Fire(FireLast).y = Zombie(i).y + (Int(Rnd * 30) - 15) * 2
If Distance(Fire(FireLast).x, Fire(FireLast).y, Player(1).x, Player(1).y) > 80 Then
Fire(FireLast).xm = Int(Rnd * 100) - 50: Fire(FireLast).ym = Int(Rnd * 100) - 50
If Int(Rnd * 100) = 54 Then
Fire(FireLast).froozen = 500 + Int(Rnd * 250): Fire(FireLast).visible = 10
Else
Fire(FireLast).froozen = 70 + Int(Rnd * 120): Fire(FireLast).visible = 10
End If
End If
End If
End If
If Zombie(i).special = "Bomber" Then
If Zombie(i).DistanceFromPlayer < 400 And Zombie(i).DistanceFromPlayer > 6 Then
Zombie(i).SpecialDelay = Zombie(i).SpecialDelay + 1
If Zombie(i).SpecialDelay < 120 Then
Zombie(i).size = Zombie(i).size * 1.001: If Zombie(i).sizeFirst + 20 < Zombie(i).size Then Zombie(i).size = Zombie(i).sizeFirst + 20
End If
If Zombie(i).SpecialDelay > 120 Then
Zombie(i).size = Zombie(i).size * 1.05: If Zombie(i).size > 120 Then Zombie(i).size = 120
Zombie(i).health = (Zombie(i).health / 1.1) - 0.1
End If
Else
If Zombie(i).SpecialDelay > 0 Then Zombie(i).SpecialDelay = Zombie(i).SpecialDelay - 1
dif = Zombie(i).sizeFirst - Zombie(i).size
Zombie(i).size = Zombie(i).size + (dif / 10)
dif = Zombie(i).healthFirst - Zombie(i).health
Zombie(i).health = Zombie(i).health + (dif / 10)
End If
End If
End If
'Burn
If Zombie(i).special <> "Fire" Then
If Zombie(i).onfire > 0 Then
Zombie(i).onfire = Zombie(i).onfire - 1
If Int(Rnd * 6) = 2 Then
Zombie(i).health = Zombie(i).health - 2
FireLast = FireLast + 1: If FireLast > FireMax Then FireLast = 1
Fire(FireLast).visible = 6
Fire(FireLast).froozen = 20
Fire(FireLast).txt = 0
Fire(FireLast).x = Zombie(i).x + (Int(Rnd * 30) - 15) * 2
Fire(FireLast).y = Zombie(i).y + (Int(Rnd * 30) - 15) * 2
Fire(FireLast).xm = (Zombie(i).xm / 10) + (Int(Rnd * 30) - 15) * 2
Fire(FireLast).ym = (Zombie(i).ym / 10) + (Int(Rnd * 30) - 15) * 2
End If
End If
End If
If Zombie(i).DamageTaken > 0 Then
For S = 1 To Int(Zombie(i).DamageTaken / 4)
SpawnBloodParticle Zombie(i).x, Zombie(i).y, Int(Rnd * 360) - 180, Steps, "green"
Next
Zombie(i).health = Zombie(i).health - Zombie(i).DamageTaken: Zombie(i).DamageTaken = 0
End If
If Zombie(i).tick > 0 Then Zombie(i).tick = Zombie(i).tick - 1
Zombie(i).x = Zombie(i).x + Zombie(i).xm / 100: Zombie(i).y = Zombie(i).y + Zombie(i).ym / 100
Zombie(i).x1 = Zombie(i).x - Zombie(i).size: Zombie(i).x2 = Zombie(i).x + Zombie(i).size: Zombie(i).y1 = Zombie(i).y - Zombie(i).size: Zombie(i).y2 = Zombie(i).y + Zombie(i).size
Zombie(i).xm = Zombie(i).xm + Fix(Sin(Zombie(i).rotation * PIDIV180) * Zombie(i).speeding)
Zombie(i).ym = Zombie(i).ym + Fix(-Cos(Zombie(i).rotation * PIDIV180) * Zombie(i).speeding)
If Zombie(i).xm > Zombie(i).maxspeed Then Zombie(i).xm = Zombie(i).maxspeed
If Zombie(i).ym > Zombie(i).maxspeed Then Zombie(i).ym = Zombie(i).maxspeed
If Zombie(i).xm < -Zombie(i).maxspeed Then Zombie(i).xm = -Zombie(i).maxspeed
If Zombie(i).ym < -Zombie(i).maxspeed Then Zombie(i).ym = -Zombie(i).maxspeed
Zombie(i).xm = Zombie(i).xm / (1.010 + (Zombie(i).speeding / 2000))
Zombie(i).ym = Zombie(i).ym / (1.010 + (Zombie(i).speeding / 2000))
If CollisionWithWallsEntity(Zombie(i)) Then
End If
If Zombie(i).tick = 0 Then
If Int(Rnd * 60) = 27 And Zombie(i).DistanceFromPlayer < 400 Then _SndPlayCopy ZombieWalk(Int(Rnd * 4) + 1), 0.08
o = 1: Do
o = o + 1
If i <> o And Zombie(o).active = 1 Then
dist = Distance(Zombie(i).x, Zombie(i).y, Zombie(o).x, Zombie(o).y)
If dist < Zombie(i).size Then
dx = Zombie(i).x - Zombie(o).x: dy = Zombie(i).y - Zombie(o).y
RotDist = ATan2(dy, dx) ' Angle in radians
RotDist = (RotDist * 180 / PI) + 90
If RotDist > 180 Then RotDist = RotDist - 179.9
Zombie(i).xm = Zombie(i).xm - Fix(Sin(RotDist * PIDIV180) * 250)
Zombie(i).ym = Zombie(i).ym - Fix(-Cos(RotDist * PIDIV180) * 250)
End If
End If
Loop While o <> ZombieMax
Zombie(i).tick = DefZombie.tickrate + (Int(Rnd * 20) - 10)
dx = Zombie(i).x - Player(1).x: dy = Zombie(i).y - Player(1).y
Zombie(i).rotation = ATan2(dy, dx) ' Angle in radians
Zombie(i).rotation = (Zombie(i).rotation * 180 / PI) + 90 + (-20 + Int(Rnd * 40))
If Zombie(i).rotation > 180 Then Zombie(i).rotation = Zombie(i).rotation - 179.9
Zombie(i).DistanceFromPlayer = Int(Distance(Zombie(i).x, Zombie(i).y, Player(1).x, Player(1).y))
If Zombie(i).DistanceFromPlayer < (Zombie(i).size * 1.8) Then
If Zombie(i).attacking = 0 Then Zombie(i).attacking = Int(Zombie(i).knockback / 3)
If Zombie(i).attacking = Int(Zombie(i).knockback / 3) Then
Zombie(i).xm = Zombie(i).xm / 15
Zombie(i).ym = Zombie(i).ym / 15
Player(1).DamageToTake = Int(Rnd * (DefZombie.maxdamage - DefZombie.mindamage + 1)) + DefZombie.mindamage
PlayerTakeDamage Player(1), Zombie(i).x, Zombie(i).y, Player(1).DamageToTake, Zombie(i).knockback
Player(1).DamageToTake = 0
End If
End If
If Zombie(i).attacking > 0 Then Zombie(i).attacking = Zombie(i).attacking - 1
End If
If Zombie(i).health <= 0 Then
Zombie(i).SpecialDelay = 0 ' ------------------- Ammo Dropping --------------------
If Int(Rnd * 2) + 1 = 2 Then
If Zombie(i).special = "Normal" Then
Rand = Int(Rnd * 2) + 1
If Rand = 1 Then
SpawnBloodParticle Zombie(i).x, Zombie(i).y, Int(Rnd * 360) - 180, 5, "ShotgunAmmo"
Else
For y = 1 To Int(Rnd * 2) + 1
SpawnBloodParticle Zombie(i).x, Zombie(i).y, Int(Rnd * 360) - 180, 5, "PistolAmmo"
Next
End If
End If
If Zombie(i).special = "Fire" Then SpawnBloodParticle Zombie(i).x, Zombie(i).y, Int(Rnd * 360) - 180, 5, "GasAmmo"
If Zombie(i).special = "Bomber" Then SpawnBloodParticle Zombie(i).x, Zombie(i).y, Int(Rnd * 360) - 180, 5, "GrenadeAmmo"
End If
If Zombie(i).special = "Brute" Then
Rand = Int(Rnd * 4)
For b = 1 To Rand
SpawnBloodParticle Zombie(i).x, Zombie(i).y, Int(Rnd * 360) - 180, 7, "ShotgunAmmo"
SpawnBloodParticle Zombie(i).x, Zombie(i).y, Int(Rnd * 360) - 180, 7, "PistolAmmo"
SpawnBloodParticle Zombie(i).x, Zombie(i).y, Int(Rnd * 360) - 180, 5, "GrenadeAmmo"
Next
End If
If Zombie(i).special = "Bomber" Then
Explosion Zombie(i).x, Zombie(i).y, 80, 320: _SndPlay SND_Explosion
For b = 1 To 80
SpawnBloodParticle Zombie(i).x, Zombie(i).y, Int(Rnd * 360) - 180, Int(Rnd * 100), "green"
Next
End If
If Zombie(i).health <= -30 Then SpawnBloodParticle Zombie(i).x, Zombie(i).y, Int(Rnd * 360) - 180, 5, "GibSkull"
Zombie(i).active = 0
Zombie(i).onfire = 0
WaveBudget = WaveBudget - 1
For o = 1 To 10
SpawnBloodParticle Zombie(i).x, Zombie(i).y, Int(Rnd * 360) - 180, Steps, "green"
If Zombie(i).health <= -30 And Int(Rnd * 3) = 2 Then SpawnBloodParticle Zombie(i).x, Zombie(i).y, Int(Rnd * 360) - 180, 5, "GibBone"
If Zombie(i).health >= -30 And Int(Rnd * 8) = 2 Then SpawnBloodParticle Zombie(i).x, Zombie(i).y, Int(Rnd * 360) - 180, 5, "GibBone"
Next
End If
If Zombie(i).x < 0 Or Zombie(i).y < 0 Then
Zombie(i).x = 100: Zombie(i).y = 100: Zombie(i).ym = 0: Zombie(i).xm = 0
Zombie(i).health = 0
Beep: Print "Zombie(" + Str$(i) + ") Out of bounds!!!!!!!!!!!!!!!!"
_Display
Beep: Beep
_Delay 0.6
End If
End If
Next
Return
ParticleLogic:
For i = 1 To ParticlesMax
If Part(i).visible = 0 Then GoTo EndOfParticleLogic
If Part(i).playwhatsound = "Blood" And Part(i).froozen = 0 Then
dist = Distance(Player(1).x, Player(1).y, Part(i).x, Part(i).y)
If dist > 900 Then Part(i).visible = Part(i).visible - 1
If dist < 600 And Player(1).Health > 0 Then
If dist < 25 And Part(i).partid = "BloodSplat" Then
LastBloodPart = LastBloodPart + 1: If LastBloodPart > 32 Then LastBloodPart = 1
BloodPart(LastBloodPart).x = 64 ' Int(Rnd * _Width(HeartPercent))
BloodPart(LastBloodPart).y = -8
BloodPart(LastBloodPart).xm = Int(Rnd * 100) - 50
BloodPart(LastBloodPart).ym = 80 + Int(Rnd * 50)
BloodPart(LastBloodPart).visible = 1
Part(i).visible = 0: Part(i).xm = 0: Part(i).ym = 0: Part(i).playwhatsound = "": Player(1).Health = Player(1).Health + 0.1: GoTo EndOfParticleLogic
End If
If dist < 25 And Part(i).partid = "PistolAmmo" Then SMGAmmo = SMGAmmo + 40: Part(i).playwhatsound = "": Part(i).visible = 0: Part(i).xm = 0: Part(i).ym = 0: GoTo EndOfParticleLogic
If dist < 25 And Part(i).partid = "ShotgunAmmo" Then ShotgunAmmo = ShotgunAmmo + 9: Part(i).playwhatsound = "": Part(i).visible = 0: Part(i).xm = 0: Part(i).ym = 0: GoTo EndOfParticleLogic
If dist < 25 And Part(i).partid = "GasAmmo" Then FlameAmmo = FlameAmmo + 100: Part(i).playwhatsound = "": Part(i).visible = 0: Part(i).xm = 0: Part(i).ym = 0: GoTo EndOfParticleLogic
If dist < 25 And Part(i).partid = "GrenadeAmmo" Then GrenadeAmmo = GrenadeAmmo + 2: Part(i).playwhatsound = "": Part(i).visible = 0: Part(i).xm = 0: Part(i).ym = 0: GoTo EndOfParticleLogic
dx = Player(1).x - Part(i).x: dy = Player(1).y - Part(i).y
Part(i).rotation = ATan2(dy, dx) ' Angle in radians
Part(i).rotation = (Part(i).rotation * 180 / PI) + 90
If Part(i).rotation > 180 Then Part(i).rotation = Part(i).rotation - 179.9
Part(i).xm = Part(i).xm / 1.05
Part(i).ym = Part(i).ym / 1.05
Part(i).xm = Part(i).xm + -Sin(Part(i).rotation * PIDIV180) * 10 / (dist / 150)
Part(i).ym = Part(i).ym + Cos(Part(i).rotation * PIDIV180) * 10 / (dist / 150)
Part(i).x = Part(i).x + (Part(i).xm / 10)
Part(i).y = Part(i).y + (Part(i).ym / 10)
Part(i).z = 3 / (dist / 70)
If Part(i).z > 15 Then Part(i).z = 15
End If
End If
If Part(i).froozen <> 0 Then
Part(i).x = Part(i).x + (Part(i).xm / 10)
Part(i).y = Part(i).y + (Part(i).ym / 10)
Part(i).z = Part(i).z + (Part(i).zm / 10)
If Part(i).z > 0 Then Part(i).zm = Part(i).zm - 1
If Part(i).z < 0 And Part(i).zm < 0 Then
If Part(i).playwhatsound = "ShotgunShell" Then
_SndPlayCopy ShellSounds(Int(1 + Rnd * 3)), 0.2
Part(i).zm = Int(Part(i).zm * -0.9)
Part(i).xm = Int(Part(i).xm / 2): Part(i).ym = Int(Part(i).ym / 2)
Part(i).froozen = -200
End If
If Part(i).playwhatsound = "PistolShell" Then
pistsndold = pistsnd
pistsnd = Int(1 + Rnd * 3)
If pistsnd = pistsndold Then pistsnd = Int(1 + Rnd * 3)
_SndPlayCopy PistolShellSounds(pistsnd), 0.25
Part(i).zm = Int(Part(i).zm * -0.9)
Part(i).xm = Int(Part(i).xm / 2): Part(i).ym = Int(Part(i).ym / 2)
Part(i).froozen = -200
End If
If Part(i).playwhatsound = "Blood" Then
_SndPlayCopy BloodSounds(Int(1 + Rnd * 6)), 0.1
Part(i).zm = Int(Part(i).zm * -0.7)
Part(i).xm = Int(Part(i).xm / 1.4): Part(i).ym = Int(Part(i).ym / 1.4)
Part(i).froozen = -200
End If
If Part(i).playwhatsound = "Glass" Then
_SndPlayCopy GlassSound(Int(1 + Rnd * 4)), 0.2
Part(i).zm = Int(Part(i).zm * -0.9)
Part(i).xm = Int(Part(i).xm / 2): Part(i).ym = Int(Part(i).ym / 2)
Part(i).froozen = -200
End If
End If
If Part(i).froozen < 0 Then Part(i).froozen = Part(i).froozen + 1
If Fix(Part(i).z) <= 0 Then Part(i).z = 0
If Part(i).xm > 0 Then Part(i).xm = Part(i).xm - 1
If Part(i).ym > 0 Then Part(i).ym = Part(i).ym - 1
If Part(i).xm < 0 Then Part(i).xm = Part(i).xm + 1
If Part(i).ym < 0 Then Part(i).ym = Part(i).ym + 1
x = Fix(Part(i).x / Map.TileSize)
y = Fix(Part(i).y / Map.TileSize)
If x < 0 Then x = 0
If y < 0 Then y = 0
If x > Map.MaxWidth Then x = Map.MaxWidth
If y > Map.MaxHeight Then y = Map.MaxHeight
If Tile(x, y, 2).solid = 1 Then Part(i).xm = 0: Part(i).ym = 0
Part(i).rotation = Part(i).rotation + Part(i).rotationspeed
If Part(i).rotationspeed > 0 Then Part(i).rotationspeed = Part(i).rotationspeed - 1
If Part(i).rotationspeed < 0 Then Part(i).rotationspeed = Part(i).rotationspeed + 1
End If
If Not Part(i).playwhatsound = "Blood" Then Part(i).visible = Part(i).visible - 1
'_PutImage (ETSX(Part(i).x), ETSY(Part(i).y)), Particle_Shotgun_Shell
If Part(i).visible > 0 Then
If Part(i).partid = "PistolShell" Then RotoZoom ETSX(Part(i).x), ETSY(Part(i).y), Particle_Pistol_Shell, 0.3 + (Part(i).z / 4), Part(i).rotation
If Part(i).partid = "ShotgunShell" Then RotoZoom ETSX(Part(i).x), ETSY(Part(i).y), Particle_Shotgun_Shell, 0.3 + (Part(i).z / 4), Part(i).rotation
If Part(i).partid = "WallShot" Then RotoZoom ETSX(Part(i).x), ETSY(Part(i).y), WallShot, 0.8 + (Part(i).z / 4), Part(i).rotation
If Part(i).partid = "Smoke" Then RotoZoom ETSX(Part(i).x), ETSY(Part(i).y), Particle_Smoke, 0.05 + (Part(i).z / 4), Part(i).rotation
If Part(i).partid = "Explosion" Then RotoZoom ETSX(Part(i).x), ETSY(Part(i).y), Particle_Explosion, 0.1 + (Part(i).z / 4), Part(i).rotation
If Part(i).partid = "BloodSplat" Then
If Part(i).BloodColor = "green" Then RotoZoom ETSX(Part(i).x), ETSY(Part(i).y), BloodsplatGreen, 1 + (Part(i).z / 4), Part(i).rotation
If Part(i).BloodColor = "red" Then RotoZoom ETSX(Part(i).x), ETSY(Part(i).y), BloodsplatRed, 1 + (Part(i).z / 4), Part(i).rotation
End If
If Part(i).partid = "GlassShard" Then RotoZoom ETSX(Part(i).x), ETSY(Part(i).y), GlassShard, 1 + (Part(i).z / 2), Part(i).rotation
If Part(i).partid = "GibSkull" Then RotoZoom ETSX(Part(i).x), ETSY(Part(i).y), Gib_Skull, 2 + (Part(i).z / 3), Part(i).rotation
If Part(i).partid = "GibBone" Then RotoZoom ETSX(Part(i).x), ETSY(Part(i).y), Gib_Bone, 2 + (Part(i).z / 3), Part(i).rotation
If Part(i).partid = "PistolAmmo" Then RotoZoom ETSX(Part(i).x), ETSY(Part(i).y), PistolShellAmmo, 1 + (Part(i).z / 3), Part(i).rotation
If Part(i).partid = "GrenadeAmmo" Then RotoZoom ETSX(Part(i).x), ETSY(Part(i).y), Guns_Grenade, 1 + (Part(i).z / 3), Part(i).rotation
If Part(i).partid = "ShotgunAmmo" Then RotoZoom ETSX(Part(i).x), ETSY(Part(i).y), ShellShotgunAmmo, 1 + (Part(i).z / 3), Part(i).rotation
If Part(i).partid = "GasAmmo" Then RotoZoom ETSX(Part(i).x), ETSY(Part(i).y), GasCanAmmo, 1 + (Part(i).z / 3), Part(i).rotation
End If
EndOfParticleLogic:
Next
Return
GunCode:
If WeaponHeat > 0 Then WeaponHeat = WeaponHeat - 1
If WeaponHeat > 45 Then WeaponHeat = 45
GoSub LoadingFromSlots
For i = 1 To 1
o = -1
If GunDisplay(i).visible = 1 Then
o = o + 1
GunDisplay(i).x = ((PlayerMember(i + o).x + PlayerMember(i * 2).x) / 2) 'Player(i).x + (Sin(Player(i).Rotation * PIDIV180) * 38)
GunDisplay(i).y = ((PlayerMember(i + o).y + PlayerMember(i * 2).y) / 2) 'Player(i).y + (-Cos(Player(i).Rotation * PIDIV180) * 38)
GunDisplay(i).x = GunDisplay(i).x + GunDisplay(i).xm
GunDisplay(i).y = GunDisplay(i).y + GunDisplay(i).ym
GunDisplay(i).xm = Int(GunDisplay(i).xm / 2)
GunDisplay(i).ym = Int(GunDisplay(i).ym / 2)
If Player(1).shooting = 0 Then FlameSoundPlaying = 0: _SndStop FlameThrowerSound
GoSub Shooting
If Player(1).shooting = 1 Then
GunDisplay(i).xm = -Int(Sin(GunDisplay(i).rotation * PIDIV180) * GunForce * 2)
GunDisplay(i).ym = -Int(-Cos(GunDisplay(i).rotation * PIDIV180) * GunForce * 2)
If Aiming = 0 Then
CameraXM = CameraXM + -Int(Sin(GunDisplay(i).rotation * PIDIV180) * GunForce)
CameraYM = CameraYM + -Int(-Cos(GunDisplay(i).rotation * PIDIV180) * GunForce)
End If
If Aiming = 1 Then
CameraXM = CameraXM + -Int(Sin(GunDisplay(i).rotation * PIDIV180) * (GunForce / 2))
CameraYM = CameraYM + -Int(-Cos(GunDisplay(i).rotation * PIDIV180) * (GunForce / 2))
End If
Hud(1).xm = Hud(1).xm - Int(Sin(GunDisplay(i).rotation * PIDIV180) * GunForce) * 5
Hud(1).ym = Hud(1).ym - Int(-Cos(GunDisplay(i).rotation * PIDIV180) * GunForce) * 2
Hud(HighestHud).xm = Hud(HighestHud).xm - Int(Sin(GunDisplay(i).rotation * PIDIV180) * GunForce)
Hud(HighestHud).ym = Hud(HighestHud).ym - Int(-Cos(GunDisplay(i).rotation * PIDIV180) * GunForce)
End If
dx = Player(i).x - GunDisplay(i).x: dy = Player(i).y - GunDisplay(i).y
GunDisplay(i).rotation = ATan2(dy, dx) ' Angle in radians
GunDisplay(i).rotation = (GunDisplay(i).rotation * 180 / PI) + 90
If GunDisplay(i).rotation > 180 Then GunDisplay(i).rotation = GunDisplay(i).rotation - 180
'GunDisplay(i).rotation = Player(i).Rotation + 90
If debug = 1 Then Line (ETSX(GunDisplay(i).x - 16), ETSY(GunDisplay(i).y - 16))-(ETSX(GunDisplay(i).x + 16), ETSY(GunDisplay(i).y + 16)), _RGBA32(255, 255, 255, 75), BF
If GunDisplay(i).wtype = 1 Then RotoZoom ETSX(GunDisplay(i).x), ETSY(GunDisplay(i).y), Guns_Pistol, .3, GunDisplay(i).rotation + 90
If GunDisplay(i).wtype = 2 Then RotoZoom ETSX(GunDisplay(i).x), ETSY(GunDisplay(i).y), Guns_Shotgun, .45, GunDisplay(i).rotation + 90
If GunDisplay(i).wtype = 3 Then RotoZoom ETSX(GunDisplay(i).x), ETSY(GunDisplay(i).y), Guns_SMG, .5, GunDisplay(i).rotation + 90
If GunDisplay(i).wtype = 4 Then RotoZoom ETSX(GunDisplay(i).x), ETSY(GunDisplay(i).y), Guns_Grenade, .6, GunDisplay(i).rotation + 90
If GunDisplay(i).wtype = 5 Then RotoZoom ETSX(GunDisplay(i).x), ETSY(GunDisplay(i).y), Guns_Flame, .6, GunDisplay(i).rotation + 90
End If
Next
Return
Shooting:
If Mouse.click And ShootDelay = 0 And PlayerCantMove = 0 Then
Player(1).shooting = 1
If GunDisplay(1).wtype = 1 And SMGAmmo = 0 Then
Player(1).shooting = 0
End If
If GunDisplay(1).wtype = 2 And ShotgunAmmo = 0 Then
Player(1).shooting = 0
End If
If GunDisplay(1).wtype = 3 And SMGAmmo = 0 Then
Player(1).shooting = 0
End If
If GunDisplay(1).wtype = 4 And GrenadeAmmo = 0 Then
Player(1).shooting = 0
End If
If GunDisplay(1).wtype = 5 And FlameAmmo = 0 Then
Player(1).shooting = 0
_SndStop FlameThrowerSound
End If
If GunDisplay(1).wtype = 1 And SMGAmmo > 0 Then
_SndPlayCopy Guns_Sound_PistolShot, 0.3: If raycasting(GunDisplay(1).x, GunDisplay(1).y, GunDisplay(1).rotation + (Int(Rnd * 3) - 1), 14, 1) Then Beep
Line (ETSX(GunDisplay(1).x), ETSY(GunDisplay(1).y))-(ETSX(Ray.x), ETSY(Ray.y)), _RGB32(255, 0, 0)
ShootDelay = 14: GunForce = 10
Part(LastPart).x = GunDisplay(1).x: Part(LastPart).y = GunDisplay(1).y: Part(LastPart).z = 2 + Int(Rnd * 2)
Part(LastPart).xm = Int(Rnd * 80) - 40
Part(LastPart).ym = Int(Rnd * 80) - 40
Part(LastPart).zm = 2 + Int(Rnd * 4)
Part(LastPart).froozen = 12: Part(LastPart).visible = 800
Part(LastPart).partid = "PistolShell": Part(LastPart).playwhatsound = "PistolShell"
Part(LastPart).rotation = Int(Rnd * 360) - 180
Part(LastPart).rotationspeed = Int(Rnd * 60) - 30
LastPart = LastPart + 1: If LastPart > ParticlesMax Then LastPart = 0
End If
If GunDisplay(1).wtype = 2 And ShotgunAmmo > 0 Then
_SndPlayCopy Guns_Sound_ShotgunShot, 0.3: GunForce = 50
ShotgunAmmo = ShotgunAmmo - 1
For S = 1 To 5
If raycasting(GunDisplay(1).x, GunDisplay(1).y, GunDisplay(1).rotation - (Int(Rnd * 20) - 10), 10, 1) Then Beep
Line (ETSX(GunDisplay(1).x), ETSY(GunDisplay(1).y))-(ETSX(Ray.x), ETSY(Ray.y)), _RGB32(255, 0, 0)
Next
ShootDelay = 50
Part(LastPart).x = GunDisplay(1).x: Part(LastPart).y = GunDisplay(1).y: Part(LastPart).z = 3 + Int(Rnd * 2)
Part(LastPart).xm = Int(Rnd * 120) - 60: Part(LastPart).ym = Int(Rnd * 120) - 60: Part(LastPart).zm = 2 + Int(Rnd * 4)
Part(LastPart).froozen = 12: Part(LastPart).visible = 800
Part(LastPart).partid = "ShotgunShell": Part(LastPart).playwhatsound = "ShotgunShell"
Part(LastPart).rotation = Int(Rnd * 360) - 180
Part(LastPart).rotationspeed = Int(Rnd * 60) - 30
LastPart = LastPart + 1: If LastPart > ParticlesMax Then LastPart = 0
End If
If GunDisplay(1).wtype = 3 And SMGAmmo > 0 Then
_SndPlayCopy SMGSounds(1 + Int(Rnd * 3)), 0.125
SMGAmmo = SMGAmmo - 1: GunForce = 13
WeaponHeat = WeaponHeat + 4
If raycasting(GunDisplay(1).x, GunDisplay(1).y, GunDisplay(1).rotation + ((Int(Rnd * Int(WeaponHeat / 2)) - Int(WeaponHeat / 4)) + Int(Rnd * 10) - 5), 8, 1) Then Beep
Line (ETSX(GunDisplay(1).x), ETSY(GunDisplay(1).y))-(ETSX(Ray.x), ETSY(Ray.y)), _RGB32(255, 0, 0): ShootDelay = 6
Part(LastPart).x = GunDisplay(1).x: Part(LastPart).y = GunDisplay(1).y: Part(LastPart).z = 2 + Int(Rnd * 2)
Part(LastPart).xm = Int(Rnd * 120) - 60: Part(LastPart).ym = Int(Rnd * 120) - 60: Part(LastPart).zm = 1 + Int(Rnd * 5)
Part(LastPart).froozen = 12: Part(LastPart).visible = 800
Part(LastPart).partid = "PistolShell": Part(LastPart).playwhatsound = "PistolShell"
Part(LastPart).rotation = Int(Rnd * 360) - 180
Part(LastPart).rotationspeed = Int(Rnd * 60) - 30
LastPart = LastPart + 1: If LastPart > ParticlesMax Then LastPart = 0
End If
If GunDisplay(1).wtype = 4 And GrenadeAmmo > 0 Then
GrenadeAmmo = GrenadeAmmo - 1
ShootDelay = 30
GunForce = 35
'LastGrenade = LastGrenade + 1
LastGrenade = LastGrenade + 1: If LastGrenade > GrenadeMax Then LastGrenade = 1
Grenade(LastGrenade).x = GunDisplay(1).x
Grenade(LastGrenade).y = GunDisplay(1).y
Grenade(LastGrenade).z = 15
Force = Distance(Mouse.x, Mouse.y, _Width / 2, _Height / 2) / 3: If Force > 200 Then Force = 200
Grenade(LastGrenade).xm = Sin(GunDisplay(1).rotation * PIDIV180) * Force
Grenade(LastGrenade).ym = -Cos(GunDisplay(1).rotation * PIDIV180) * Force
Grenade(LastGrenade).zm = 15 + Int(Rnd * 20)
Grenade(LastGrenade).rotation = -5 + Int(Rnd * 10)
Grenade(LastGrenade).rotationspeed = -30 + Int(Rnd * 15)
Grenade(LastGrenade).visible = 1
Grenade(LastGrenade).froozen = -160
End If
If GunDisplay(1).wtype = 5 And FlameAmmo > 0 Then
If FlameSoundPlaying = 0 Then _SndVol FlameThrowerSound, 0.09: _SndLoop FlameThrowerSound
FlameSoundPlaying = 1
FlameAmmo = FlameAmmo - 1
ShootDelay = 2
GunForce = 6
FireLast = FireLast + 1: If FireLast > FireMax Then FireLast = 1
Fire(FireLast).visible = 2
Fire(FireLast).froozen = 100
Fire(FireLast).txt = 0
Fire(FireLast).x = GunDisplay(1).x + (Int(Rnd * 8) - 4)
Fire(FireLast).y = GunDisplay(1).y + (Int(Rnd * 8) - 4)
speed = (70 + Int(Rnd * 80))
angle = GunDisplay(1).rotation + Int(Rnd * 40) - 20
Fire(FireLast).xm = Sin(angle * PIDIV180) * speed
Fire(FireLast).ym = -Cos(angle * PIDIV180) * speed
End If
End If
Return
LoadingFromSlots:
'If _KeyDown(49) Then WantSlot = 2
'If _KeyDown(50) Then WantSlot = 3
'If _KeyDown(51) Then WantSlot = 4
If HighestHud = 2 Then
GunDisplay(1).wtype = 1
PlayerMember(1).angleanim = -36: PlayerMember(1).distanim = 40
PlayerMember(2).angleanim = 36: PlayerMember(2).distanim = 40
End If
If HighestHud = 3 Then
GunDisplay(1).wtype = 2
PlayerMember(1).angleanim = -29: PlayerMember(1).distanim = 67
PlayerMember(2).angleanim = 50: PlayerMember(2).distanim = 42
End If
If HighestHud = 4 Then
GunDisplay(1).wtype = 3
PlayerMember(1).angleanim = -29: PlayerMember(1).distanim = 67
PlayerMember(2).angleanim = 50: PlayerMember(2).distanim = 42
End If
If HighestHud = 5 Then
GunDisplay(1).wtype = 4
PlayerMember(1).angleanim = -29: PlayerMember(1).distanim = 67
PlayerMember(2).angleanim = 50: PlayerMember(2).distanim = 42
End If
If HighestHud = 6 Then
GunDisplay(1).wtype = 5
PlayerMember(1).angleanim = -29: PlayerMember(1).distanim = 67
PlayerMember(2).angleanim = 50: PlayerMember(2).distanim = 42
End If
Return
HandsCode:
'Xbe and 'Ybe
ArmLeftOrigin = Player(1).Rotation + 90
ArmRightOrigin = Player(1).Rotation - 90
PlayerMember(1).xo = Sin(ArmLeftOrigin * PIDIV180)
PlayerMember(1).yo = -Cos(ArmLeftOrigin * PIDIV180)
PlayerMember(2).xo = Sin(ArmRightOrigin * PIDIV180)
PlayerMember(2).yo = -Cos(ArmRightOrigin * PIDIV180)
xo1 = Player(1).x + PlayerMember(1).xo * 32
yo1 = Player(1).y + PlayerMember(1).yo * 32
xo2 = Player(1).x + PlayerMember(2).xo * 32
yo2 = Player(1).y + PlayerMember(2).yo * 32
If debug = 1 Then
Line (ETSX(xo1) - 2, ETSY(yo1) - 2)-(ETSX(xo1) + 2, ETSY(yo1) + 2), _RGB32(255, 0, 255), BF
Line (ETSX(xo2) - 2, ETSY(yo2) - 2)-(ETSX(xo2) + 2, ETSY(yo2) + 2), _RGB32(255, 0, 255), BF
End If
PlayerMember(1).xo = Player(1).x + PlayerMember(1).xo * 32
PlayerMember(1).yo = Player(1).y + PlayerMember(1).yo * 32
PlayerMember(2).xo = Player(1).x + PlayerMember(2).xo * 32
PlayerMember(2).yo = Player(1).y + PlayerMember(2).yo * 32
RotationDifference = Abs(Player(1).Rotation - PlayerRotOld)
If RotationDifference > 90 Then RotationDifference = 180 - RotationDifference
For i = 1 To 2
Angleadded = PlayerMember(i).angleanim + Player(1).Rotation ' If Angleadded > 180 Then Angleadded = Angleadded - 180
PlayerMember(i).xbe = PlayerMember(i).xo + Sin((Angleadded) * PIDIV180) * PlayerMember(i).distanim
PlayerMember(i).ybe = PlayerMember(i).yo + -Cos((Angleadded) * PIDIV180) * PlayerMember(i).distanim
If debug = 1 Then Print "Member(" + Str$(i) + "): "; Angleadded
If Not PlayerMember(i).x = PlayerMember(i).xbe And Not PlayerMember(i).y = PlayerMember(i).ybe Then
dx = (PlayerMember(i).x - PlayerMember(i).xbe): dy = (PlayerMember(i).y - PlayerMember(i).ybe)
PlayerMember(i).angle = ATan2(dy, dx) ' Angle in radians
PlayerMember(i).angle = (PlayerMember(i).angle * 180 / PI) + 90
If PlayerMember(i).angle >= 180 Then PlayerMember(i).angle = PlayerMember(i).angle - 179.9
End If
If Int(PlayerMember(i).x) = Int(PlayerMember(i).xbe) And Int(PlayerMember(i).y) = Int(PlayerMember(i).ybe) Then PlayerMember(i).xvector = 0: PlayerMember(i).yvector = 0
If debug = 1 Then Print "MemberRot(" + Str$(i) + "): "; PlayerMember(i).angle
PlayerMember(i).xvector = Sin(PlayerMember(i).angle * PIDIV180)
PlayerMember(i).yvector = -Cos(PlayerMember(i).angle * PIDIV180)
moving2 = moving: If moving2 > 12 Then moving2 = 12
If moving2 > 0 Then PlayerMember(i).speed = moving2 / 10 + Distance(PlayerMember(i).x, PlayerMember(i).y, PlayerMember(i).xbe, PlayerMember(i).ybe) / 20
'Alterar este codigo, causa bug envolvendo 180 graus.
'https://gamedev.stackexchange.com/questions/74986/how-can-i-find-the-difference-between-rotations-represented-as-angles-in-0-360
If moving = 0 Then PlayerMember(i).speed = 0.2 + Distance(PlayerMember(i).x, PlayerMember(i).y, PlayerMember(i).xbe, PlayerMember(i).ybe) / 20
If moving > 0 Then
PlayerMember(i).x = PlayerMember(i).x - Int(Player(1).xm / moving2)
PlayerMember(i).y = PlayerMember(i).y - Int(Player(1).ym / moving2)
End If
' If Int(PlayerMember(i).y) = Int(PlayerMember(i).ybe) Then PlayerMember(i).y = PlayerMember(i).ybe: PlayerMember(i).speed = 0
'If Int(PlayerMember(i).x) = Int(PlayerMember(i).xbe) Then PlayerMember(i).x = PlayerMember(i).xbe: PlayerMember(i).speed = 0
PlayerMember(i).x = PlayerMember(i).x + PlayerMember(i).xvector * PlayerMember(i).speed
PlayerMember(i).y = PlayerMember(i).y + PlayerMember(i).yvector * PlayerMember(i).speed
If Distance(PlayerMember(i).x, PlayerMember(i).y, PlayerMember(i).xbe, PlayerMember(i).ybe) > 100 Then PlayerMember(i).x = Player(1).x: PlayerMember(i).y = Player(1).y
'_PutImage (PlayerMember(i).x - 8 - CameraX * Map.TileSize, PlayerMember(i).y - 8 - CameraY * Map.TileSize)-(PlayerMember(i).x + 8 - CameraX * Map.TileSize, PlayerMember(i).y + 8 - CameraY * Map.TileSize), PlayerHand
If debug = 1 Then Line (ETSX(PlayerMember(i).x), ETSY(PlayerMember(i).y))-(ETSX(PlayerMember(i).xbe), ETSY(PlayerMember(i).ybe)), _RGB(0, 0, 0)
'Line (ETSX(PlayerMember(i).x), ETSY(PlayerMember(i).y))-(ETSX(PlayerMember(i).x), ETSY(PlayerMember(i).y)), _RGB(255, 255, 255)
Next
If debug = 1 Then Line (ETSX(xo1), ETSY(yo1))-(ETSX(PlayerMember(1).x), ETSY(PlayerMember(1).y)), _RGB32(255, 255, 0)
If debug = 1 Then Line (ETSX(xo2), ETSY(yo2))-(ETSX(PlayerMember(2).x), ETSY(PlayerMember(2).y)), _RGB32(255, 255, 0)
Return
PlayerMovement:
Aiming = 0
If Mouse.click2 Then
Aiming = 1
If Fix(AimingTime) = 0 Then AimingTime = 15
AimingTime = AimingTime * 1.1
If AimingTime > 600 Then AimingTime = 600
CameraXM = CameraXM + (Sin(GunDisplay(1).rotation * PIDIV180) * (10 + (AimingTime / 20)))
CameraYM = CameraYM + (-Cos(GunDisplay(1).rotation * PIDIV180) * (10 + (AimingTime / 20)))
Player(1).xm = Int(Player(1).xm / 1.1)
Player(1).ym = Int(Player(1).ym / 1.1)
Else
AimingTime = 0
End If
Player(1).xb = Player(1).x
Player(1).yb = Player(1).y
PlayerRotOld = Player(1).Rotation
dx = Int(_Width / 2) - Mouse.x: dy = Int(_Height / 2) - Mouse.y
Player(1).Rotation = ATan2(dy, dx) ' Angle in radians
Player(1).Rotation = (Player(1).Rotation * 180 / PI) + 90
If debug = 1 Then Print "Player Rotation: "; Player(1).Rotation
If PlayerIsOnFire > 0 Then
PlayerIsOnFire = PlayerIsOnFire - 1
If Int(Rnd * 6) = 2 Then
Player(1).Health = Player(1).Health - 0.5
FireLast = FireLast + 1: If FireLast > FireMax Then FireLast = 1
Fire(FireLast).visible = 5
Fire(FireLast).froozen = 18
Fire(FireLast).x = Player(1).x + (Int(Rnd * 30) - 15) * 2
Fire(FireLast).y = Player(1).y + (Int(Rnd * 30) - 15) * 2
Fire(FireLast).txt = 4
Fire(FireLast).xm = (-Player(1).xm) + (Int(Rnd * 30) - 15) * 2
Fire(FireLast).ym = (-Player(1).ym) + (Int(Rnd * 30) - 15) * 2
End If
End If
If Player(1).Rotation > 180 Then Player(1).Rotation = Player(1).Rotation - 180
If Int(Player(1).Rotation) > -7 And Int(Player(1).Rotation) < 1 And Mouse.y > _Height / 2 Then Player(1).Rotation = 180
'If Int(Player(1).Rotation) = -2 And Mouse.y > _Height / 2 Then Player(1).Rotation = 180
movingx = 0: movingy = 0: If ismoving = 0 And moving > 0 Then moving = moving - 1
If moving > 20 Then moving = 20
ismoving = 0:
If Player(1).TouchX = 0 Then
If _KeyDown(100) Then Player(1).xm = Player(1).xm - 3: movingx = 1: If ismoving = 0 Then moving = moving + 1: ismoving = 1
If _KeyDown(97) Then Player(1).xm = Player(1).xm + 3: movingx = 1: If ismoving = 0 Then moving = moving + 1: ismoving = 1
End If
If Player(1).TouchY = 0 Then
If _KeyDown(119) Then Player(1).ym = Player(1).ym + 3: movingy = 1: If ismoving = 0 Then moving = moving + 1: ismoving = 1
If _KeyDown(115) Then Player(1).ym = Player(1).ym - 3: movingy = 1: If ismoving = 0 Then moving = moving + 1: ismoving = 1
End If
If Player(1).TouchX > 0 Then Player(1).TouchX = Player(1).TouchX - 1
If Player(1).TouchX < 0 Then Player(1).TouchX = Player(1).TouchX + 1
If Player(1).TouchY > 0 Then Player(1).TouchY = Player(1).TouchY - 1
If Player(1).TouchY < 0 Then Player(1).TouchY = Player(1).TouchY + 1
For i = 1 To 5
If movingx = 0 Then If Player(1).xm < 0 Then Player(1).xm = Player(1).xm + 1
If movingx = 0 Then If Player(1).xm > 0 Then Player(1).xm = Player(1).xm - 1
If movingy = 0 Then If Player(1).ym < 0 Then Player(1).ym = Player(1).ym + 1
If movingy = 0 Then If Player(1).ym > 0 Then Player(1).ym = Player(1).ym - 1
Next
If Player(1).xm < -70 Then Player(1).xm = Player(1).xm + 5
If Player(1).xm > 70 Then Player(1).xm = Player(1).xm - 5
If Player(1).ym < -70 Then Player(1).ym = Player(1).ym + 5
If Player(1).ym > 70 Then Player(1).ym = Player(1).ym - 5
Player(1).y = Player(1).y - Player(1).ym / 10: Player(1).x = Player(1).x - Player(1).xm / 10
If Player(1).y > Map.MaxHeight * Map.TileSize Then Player(1).y = Map.MaxHeight * Map.TileSize
If Player(1).y < Map.TileSize Then Player(1).y = Map.TileSize
If Player(1).x > Map.MaxWidth * Map.TileSize Then Player(1).x = Map.MaxWidth * Map.TileSize
If Player(1).x < Map.TileSize Then Player(1).x = Map.TileSize
MakeHitBoxPlayer Player(1)
If Noclip = 0 Then If CollisionWithWallsPlayer(Player(1)) Then donebetween = 1
Return
RenderSprites:
rendcamerax1 = Fix(Fix(CameraX * Map.TileSize) / Map.TileSize)
rendcamerax2 = Fix((Fix(CameraX * Map.TileSize) + _ResizeWidth) / Map.TileSize) + 1
rendcameray1 = Fix(Fix(CameraY * Map.TileSize) / Map.TileSize)
rendcameray2 = Fix((Fix(CameraY * Map.TileSize) + _ResizeHeight) / Map.TileSize) + 1
If rendcamerax1 < 0 Then rendcamerax1 = 0
If rendcameray1 < 0 Then rendcameray1 = 0
If rendcamerax2 > Map.MaxWidth Then rendcamerax2 = Map.MaxWidth
If rendcameray2 > Map.MaxHeight Then rendcameray2 = Map.MaxHeight
For x = rendcamerax1 To rendcamerax2 'Map.MaxWidth
For y = rendcameray1 To rendcameray2 'Map.MaxHeight
z = 1
If RenderLayer1 = 1 Then If Tile(x, y, z).ID <> 0 Then _PutImage (WTS(x, CameraX), WTS(y, CameraY))-(WTS(x, CameraX) + (Map.TileSize * Zoom), WTS(y, CameraY) + (Map.TileSize * Zoom)), Tileset, 0, (Tile(x, y, z).rend_spritex * Map.TextureSize, Tile(x, y, z).rend_spritey * Map.TextureSize)-(Tile(x, y, z).rend_spritex * Map.TextureSize + (Map.TextureSize - 1), Tile(x, y, z).rend_spritey * Map.TextureSize + (Map.TextureSize - 1))
z = 2
If RenderLayer2 = 1 Then If Tile(x, y, z).ID <> 0 Then _PutImage (WTS(x, CameraX), WTS(y, CameraY))-(WTS(x, CameraX) + (Map.TileSize * Zoom), WTS(y, CameraY) + (Map.TileSize * Zoom)), Tileset, 0, (Tile(x, y, z).rend_spritex * Map.TextureSize, Tile(x, y, z).rend_spritey * Map.TextureSize)-(Tile(x, y, z).rend_spritex * Map.TextureSize + (Map.TextureSize - 1), Tile(x, y, z).rend_spritey * Map.TextureSize + (Map.TextureSize - 1))
Next
Next
Return
RenderLayer3:
For x = rendcamerax1 To rendcamerax2 'Map.MaxWidth
For y = rendcameray1 To rendcameray2 'Map.MaxHeight
z = 3
If RenderLayer3 = 1 Then If Tile(x, y, z).ID <> 0 Then _PutImage (WTS(x - 1, CameraX), WTS(y, CameraY))-(WTS(x - 1, CameraX) + (Map.TileSize * Zoom), WTS(y, CameraY) + (Map.TileSize * Zoom)), Tileset, 0, (Tile(x, y, z).rend_spritex * Map.TextureSize, Tile(x, y, z).rend_spritey * Map.TextureSize)-(Tile(x, y, z).rend_spritex * Map.TextureSize + (Map.TextureSize - 1), Tile(x, y, z).rend_spritey * Map.TextureSize + (Map.TextureSize - 1))
Next
Next
Return
RenderPlayer:
For P = 1 To PlayerLimit
If debug = 1 Then Line (ETSX(Player(P).x1), ETSY(Player(P).y1))-(ETSX(Player(P).x2), ETSY(Player(P).y2)), _RGB32(P * 120, 255, 255), BF
RotoZoom ETSX(Player(P).x), ETSY(Player(P).y), PlayerSprite(PlayerSkin2), 0.25, Player(P).Rotation
For i = 1 To 2
_PutImage (PlayerMember(i).x - 8 - CameraX * Map.TileSize, PlayerMember(i).y - 8 - CameraY * Map.TileSize)-(PlayerMember(i).x + 8 - CameraX * Map.TileSize, PlayerMember(i).y + 8 - CameraY * Map.TileSize), PlayerHand(PlayerSkin2)
Next
Next
Return
MenuSystem:
Do
Mouse.x = _MouseX
Mouse.y = _MouseY
Mouse.click = _MouseButton(1)
Loop While _MouseInput
MenuClicking = 0
If MenuClicking = 0 And Mouse.click = 0 And MenuClickingPre = 1 Then MenuClicking = 1
MenuClickingPre = -Mouse.click
If LastToUse < 0 Then LastToUse = 0
If Mouse.click = 0 Then LastToUse = LastToUse * -1
If delay > 0 Then delay = delay - 1
Mouse.x1 = Mouse.x - 1: Mouse.x2 = Mouse.x + 1: Mouse.y1 = Mouse.y - 1: Mouse.y2 = Mouse.y + 1
DontRepeatFor = 0
'If ResizeDelay2 > 0 Then ResizeDelay2 = ResizeDelay2 - 1
'If _Resize Then GoSub ScreenAdjustForSize
'MenuAnimCode:
For i = 1 To 3
If RayM(i).owner = 1 Then
dx = RayM(i).x - RayM(i).damage: dy = RayM(i).y - RayM(i).knockback
rotation = ATan2(dy, dx) ' Angle in radians
RayM(i).angle = (rotation * 180 / PI) + 90
If RayM(i).angle > 180 Then RayM(i).angle = RayM(i).angle - 179.9
xvector = Sin(RayM(i).angle * PIDIV180): yvector = -Cos(RayM(i).angle * PIDIV180)
RayM(i).x = RayM(i).x + xvector * (1 + (Distance(RayM(i).x, RayM(i).y, RayM(i).damage, RayM(i).knockback) / 5))
RayM(i).y = RayM(i).y + yvector * (1 + (Distance(RayM(i).x, RayM(i).y, RayM(i).damage, RayM(i).knockback) / 5))
End If
Next
For i = lasti To 1 Step -1
If DontRepeatFor = 1 Or CantClickAnymoreOnHud = 1 Then Exit For
If LastToUse > 0 Then DontRepeatFor = 1: i = LastToUse
If Menu(i).d_hover > 32 Then Menu(i).d_hover = Menu(i).d_hover - 2
If MenuAnim.extra < 29 And UICollide(Mouse, Menu(i)) Or LastToUse > 0 Then
menx = Int((Menu(i).x1 + Menu(i).x2) / 2)
meny = Int((Menu(i).y1 + Menu(i).y2) / 2)
dx = menx - Mouse.x
dy = meny - Mouse.y
rotation = ATan2(dy, dx) ' Angle in radians
TempAngle = (rotation * 180 / PI) + 90
If TempAngle > 180 Then TempAngle = TempAngle - 179.5
Menu(i).OffsetX = Sin(TempAngle * PIDIV180) * (Distance(menx, meny, Mouse.x, Mouse.y) / 17): Menu(i).OffsetY = -Cos(TempAngle * PIDIV180) * (Distance(menx, meny, Mouse.x, Mouse.y) / 17)
For o = 1 To 5
If Menu(i).d_hover < 32 Then Menu(i).d_hover = Menu(i).d_hover + 1
Next
DontRepeatFor = 1
If Mouse.click = -1 And delay = 0 Then
_KeyClear
GoSub MenuButtonStyle
clicked = i
End If
If MenuClicking = 1 And Menu(i).clicktogo <> "" Then
RayM(1).x = Menu(i).x1 + Menu(i).OffsetX
RayM(1).y = Menu(i).y1 + Menu(i).OffsetY
RayM(1).damage = 0
RayM(1).knockback = 0
RayM(1).owner = 1
RayM(2).x = Menu(i).x2 + Menu(i).OffsetX
RayM(2).y = Menu(i).y2 + Menu(i).OffsetY
RayM(2).damage = _Width
RayM(2).knockback = _Height
RayM(2).owner = 1
RayM(3).x = ((Menu(i).x1 + Menu(i).x2) / 2) + Menu(i).OffsetX
RayM(3).y = ((Menu(i).y1 + Menu(i).y2) / 2) + Menu(i).OffsetY
RayM(3).damage = Fix(_Width / 2)
RayM(3).knockback = Fix(_Height / 2)
RayM(3).owner = 1
MenuClickedID = i
MenuTransitionImage = _CopyImage(MenusImages(MenuClickedID))
MenuAnim.red = Int(Menu(i).red / 1.03)
MenuAnim.green = Int(Menu(i).green / 1.03)
MenuAnim.blue = Int(Menu(i).blue / 1.03)
MenuAnim.extra = 255
CanChangeMenu = 0
If Menu(i).clicktogo <> "" Then
ToLoad$ = Menu(i).clicktogo
End If
End If
End If
Next
For i = 1 To lasti
If Menu(i).style = 3 And Menu(i).d_clicked = 2 Then GoSub InputStyleKeyGet
Next
GoSub MenuWhatClicked
If CanChangeMenu = 0 Then
If Loaded$ <> ToLoad$ Then GoSub load
CanChangeMenu = 0
End If
'Drawing Routine:
For i = 1 To lasti
Menu(i).x1 = Menu(i).x1 + Menu(i).OffsetX
Menu(i).x2 = Menu(i).x2 + Menu(i).OffsetX
Menu(i).y1 = Menu(i).y1 + Menu(i).OffsetY
Menu(i).y2 = Menu(i).y2 + Menu(i).OffsetY
For o = 1 To 3
If Menu(i).d_hover < 0 Then Menu(i).d_hover = Menu(i).d_hover + 1
Next
If Menu(i).d_hover >= 4 Then Menu(i).d_hover = Menu(i).d_hover - 4
If Menu(i).text <> "No Draw" Then Line ((Menu(i).x1 - Menu(i).d_hover / 4) - 16, (Menu(i).y1 - Menu(i).d_hover / 4) + 16)-((Menu(i).x2 + Menu(i).d_hover / 4) - 16, (Menu(i).y2 + Menu(i).d_hover / 4) + 16), _RGBA32(0, 0, 0, 100), BF
Next
For i = 1 To lasti
If Menu(i).text <> "No Draw" Then Line (Menu(i).x1 - Menu(i).d_hover / 4, Menu(i).y1 - Menu(i).d_hover / 4)-(Menu(i).x2 + Menu(i).d_hover / 4, Menu(i).y2 + Menu(i).d_hover / 4), _RGB32(Menu(i).red, Menu(i).green, Menu(i).blue), BF
If Menu(i).style = 1 Then If Menu(i).text <> "W Bh" Then If Menu(i).text <> "No Draw" Or Menu(i).textsize < 2 Then _PutImage ((Menu(i).x1 / 2 + Menu(i).x2 / 2) - _Width(MenusImages(i)) / 2 - Menu(i).d_hover / 4, (Menu(i).y1 / 2 + Menu(i).y2 / 2) - _Height(MenusImages(i)) / 2 - Menu(i).d_hover / 4)-((Menu(i).x1 / 2 + Menu(i).x2 / 2) + _Width(MenusImages(i)) / 2 + Menu(i).d_hover / 4, (Menu(i).y1 / 2 + Menu(i).y2 / 2) + _Height(MenusImages(i)) / 2 + Menu(i).d_hover / 4), MenusImages(i)
If Menu(i).style = 2 Then
_PutImage ((Menu(i).x1 / 2 + Menu(i).x2 / 2) - _Width(MenusImages(i)) / 2 - Menu(i).d_hover / 4, (Menu(i).y1 / 2 + Menu(i).y2 / 2) - _Height(MenusImages(i)) / 2 - Menu(i).d_hover / 4)-((Menu(i).x1 / 2 + Menu(i).x2 / 2) + _Width(MenusImages(i)) / 2 + Menu(i).d_hover / 4, (Menu(i).y1 / 2 + Menu(i).y2 / 2) + _Height(MenusImages(i)) / 2 + Menu(i).d_hover / 4), MenusImages(i)
Line (Menu(i).x1 + CalculatePercentage((Menu(i).x2 - Menu(i).x1), 5) - Menu(i).d_hover / 8, Menu(i).y1 + CalculatePercentage((Menu(i).y2 - Menu(i).y1), 48) - Menu(i).d_hover / 8)-(Menu(i).x2 - CalculatePercentage((Menu(i).x2 - Menu(i).x1), 5) + Menu(i).d_hover / 8, Menu(i).y2 - CalculatePercentage((Menu(i).y2 - Menu(i).y1), 48) + Menu(i).d_hover / 8), _RGBA32(0, 0, 0, 128), BF
Line (Menu(i).x1 + Menu(i).visual - CalculatePercentage((Menu(i).x2 - Menu(i).x1), 2), Menu(i).y1 + CalculatePercentage((Menu(i).y2 - Menu(i).y1), 5))-(Menu(i).x1 + Menu(i).visual + CalculatePercentage((Menu(i).x2 - Menu(i).x1), 2), Menu(i).y2 - CalculatePercentage((Menu(i).y2 - Menu(i).y1), 5)), _RGBA32(0, 255, 0, 128), BF
End If
If Menu(i).style = 3 Then If Menu(i).text <> "W Bh" Or Menu(i).text <> "No Draw" Or Menu(i).textsize < 2 Then _PutImage ((Menu(i).x1 / 2 + Menu(i).x2 / 2) - _Width(MenusImages(i)) / 2 - Menu(i).d_hover / 4, (Menu(i).y1 / 2 + Menu(i).y2 / 2) - _Height(MenusImages(i)) / 2 - Menu(i).d_hover / 4)-((Menu(i).x1 / 2 + Menu(i).x2 / 2) + _Width(MenusImages(i)) / 2 + Menu(i).d_hover / 4, (Menu(i).y1 / 2 + Menu(i).y2 / 2) + _Height(MenusImages(i)) / 2 + Menu(i).d_hover / 4), MenusImages(i)
Menu(i).x1 = Menu(i).x1 - Menu(i).OffsetX
Menu(i).x2 = Menu(i).x2 - Menu(i).OffsetX
Menu(i).y1 = Menu(i).y1 - Menu(i).OffsetY
Menu(i).y2 = Menu(i).y2 - Menu(i).OffsetY
Menu(i).OffsetX = Menu(i).OffsetX / 1.06
Menu(i).OffsetY = Menu(i).OffsetY / 1.06
Next
'Loop While CanLeave = 0
For i = 1 To 32
If Menu(i).extra3 <> 0 And Menu(i).d_hover <> 0 Then
End If
Next
If MenuAnim.extra > 0 Then
MenuAnim.x1 = RayM(1).x
MenuAnim.y1 = RayM(1).y
MenuAnim.x2 = RayM(2).x
MenuAnim.y2 = RayM(2).y
If Fix(MenuAnim.x1) <= 0 Then If Fix(MenuAnim.y1) <= 0 Then RayM(1).owner = 0
If Int(MenuAnim.x2) >= _Width Then If Int(MenuAnim.y2) >= _Height Then RayM(2).owner = 0
Line (MenuAnim.x1, MenuAnim.y1)-(MenuAnim.x2, MenuAnim.y2), _RGBA32(MenuAnim.red, MenuAnim.green, MenuAnim.blue, MenuAnim.extra), BF
'_SetAlpha Fix(MenuAnim.extra), MenusImages(MenuClickedID)
'If Menu(MenuClickedID).text <> "W Bh" Or Menu(MenuClickedID).textsize < 2 Then _PutImage (RayM(3).x - _Width(MenusImages(MenuClickedID)) / 2, RayM(3).y - _Height(MenusImages(MenuClickedID)) / 2)-(RayM(3).x + _Width(MenusImages(MenuClickedID)) / 2, RayM(3).y + _Height(MenusImages(MenuClickedID)) / 2), MenusImages(MenuClickedID)
_SetAlpha Fix(MenuAnim.extra), _RGBA32(1, 1, 1, 1) To _RGB32(255, 255, 255, 255), MenuTransitionImage
If Menu(MenuClickedID).text <> "W Bh" Or Menu(MenuClickedID).textsize < 2 Then _PutImage (RayM(3).x - _Width(MenuTransitionImage) / 2, RayM(3).y - _Height(MenuTransitionImage) / 2)-(RayM(3).x + _Width(MenuTransitionImage) / 2, RayM(3).y + _Height(MenuTransitionImage) / 2), MenuTransitionImage
If RayM(1).x <= 1 Then
If RayM(1).y <= 1 Then
If RayM(2).x >= _Width - 1 Then
If RayM(2).y >= _Height - 1 Then
RayM(1).x = RayM(1).damage: RayM(2).x = RayM(2).damage
RayM(1).y = RayM(1).knockback: RayM(2).y = RayM(2).knockback
RayM(1).owner = 0: RayM(2).owner = 0: RayM(3).owner = 0
MenuAnim.extra = (MenuAnim.extra / 1.05) - 0.5
CanChangeMenu = 1
End If
End If
End If
End If
End If
'_SetAlpha 255, MenusImages(MenuClickedID)
_SetAlpha 255, _RGBA32(1, 1, 1, 1) To _RGB32(255, 255, 255, 255), MenuTransitionImage
Return
ScreenAdjustForSize:
If ResizeDelay2 = 0 Then
Cls
Screen SecondScreen
_FreeImage MainScreen
MainScreen = _NewImage(_ResizeWidth, _ResizeHeight, 32)
Screen MainScreen
For i = 1 To lasti
GoSub redosize
GoSub redotexts
Next
ResizeDelay2 = 80
End If
Return
MenuButtonStyle:
If Menu(i).style = 1 Then
LastToUse = i
Menu(i).d_hover = 50
Menu(i).d_clicked = 1
End If
If Menu(i).style = 2 Then
LastToUse = i
Menu(i).d_hover = 50
Menu(i).extra3 = ((Mouse.x - Menu(i).x1) * 100) / (Menu(i).x2 - Menu(i).x1)
If Mouse.x < Menu(i).x1 Then Menu(i).extra3 = 0
If Mouse.x > Menu(i).x2 Then Menu(i).extra3 = 100
Menu(i).visual = CalculatePercentage((Menu(i).x2 - Menu(i).x1), Menu(i).extra3)
Menu(i).extra3 = Menu(i).extra3 * (Menu(i).extra2 / 100)
Menu(i).text = RTrim$(LTrim$(Str$(Menu(i).extra3)))
GoSub redotexts
End If
If Menu(i).style = 3 Then
Menu(i).d_clicked = 2
CantClickAnymoreOnHud = 1
End If
Return
InputStyleKeyGet:
key$ = InKey$
keyhit = _KeyHit
If keyhit = 8 Then
key$ = ""
If Len(Menu(i).text) > 0 Then Menu(i).text = Mid$(Menu(i).text, 0, Len(Menu(i).text))
_Dest MainScreen
GoSub redotexts
End If
If keyhit = 13 Then
key$ = ""
CantClickAnymoreOnHud = 0: Menu(i).d_clicked = 0: key$ = ""
Menu(i).text = LTrim$(RTrim$(Menu(i).text))
End If
If key$ <> "" And Len(Menu(i).text) < Menu(i).extra2 Then
Menu(i).text = Menu(i).text + key$
GoSub redotexts
End If
If key$ <> "" And Len(Menu(i).text) >= Menu(i).extra2 Then
_NotifyPopup "Begs World", ("Text Limit for this box is " + LTrim$(RTrim$(Str$(Menu(i).extra2)))) + ".", "info"
End If
_Dest MainScreen
Return
MenuWhatClicked:
webpage$ = "https://www.qb64phoenix.com/"
If Loaded$ = "menu" Then GoSub Menu
If Loaded$ = "choosedificulty" Then GoSub Difficulty
For i = 1 To lasti
Menu(i).d_clicked = 0
Next
Return
Menu:
_PutImage (0, 0)-(_Width, _Height), Background1
menx = ((Menu(1).x2 + Menu(1).x1) / 2) + Menu(1).OffsetX
meny = ((Menu(1).y2 + Menu(1).y1) / 2) + Menu(1).OffsetY
_PutImage (menx - _Width(VantiroTitulo) / 2, meny - _Height(VantiroTitulo) / 2)-(menx + _Width(VantiroTitulo) / 2, meny + _Height(VantiroTitulo) / 2), VantiroTitulo
menx = ((Menu(4).x2 + Menu(4).x1) / 2) + Menu(4).OffsetX
meny = ((Menu(4).y2 + Menu(4).y1) / 2) + Menu(4).OffsetY
SkinRot = SkinRot / 1.005
SkinRot = SkinRot + RotateSkinSpeed
RotateSkinSpeed = RotateSkinSpeed / 1.05
RotoZoom menx, meny, PlayerSprite(PlayerSkin), 0.7, SkinRot
If Menu(5).d_clicked = 1 Then
Beep
System
End If
If Menu(3).d_clicked = 1 Then
quit = 1
End If
If Menu(4).d_clicked = 1 And delay = 0 Then
delay = 10
RotateSkinSpeed = Int(Rnd * 100) - 50
_SndPlay PlayerDamage
End If
If Menu(6).d_clicked = 1 And delay = 0 Then
delay = 20
PlayerSkin = PlayerSkin - 1
If PlayerSkin < 1 Then PlayerSkin = 1
Menu(7).text = ("(" + Str$(PlayerSkin) + "/4)")
i = 7
GoSub redotexts
End If
If Menu(8).d_clicked = 1 And delay = 0 Then
delay = 20
PlayerSkin = PlayerSkin + 1
If PlayerSkin > 4 Then PlayerSkin = 4
Menu(7).text = ("(" + Str$(PlayerSkin) + "/4)")
i = 7
GoSub redotexts
End If
Return
Difficulty:
If Menu(2).d_clicked = 1 Then
GameDificulty = 0.5
quit = 6
End If
If Menu(3).d_clicked = 1 Then
GameDificulty = 1
quit = 6
End If
If Menu(4).d_clicked = 1 Then
GameDificulty = 2
quit = 6
End If
Return
RedoSlider:
Menu(i).visual = (Menu(i).extra3 * 100) / (Menu(i).x2 - Menu(i).x1)
Menu(i).text = RTrim$(LTrim$(Str$(Menu(i).extra3)))
GoSub redotexts
Return
WarningWebsite:
If Menu(5).d_clicked = 1 Then ToLoad$ = ToLoad2$: GoSub load
If Menu(6).d_clicked = 1 Then Shell _Hide _DontWait webpage$: ToLoad$ = ToLoad2$: GoSub load
Return
PlayerSettings:
If Menu(17).d_clicked Then
username$ = Menu(4).text
Open "assets/begs world/settings/PlayerSettings.bhconfig" For Output As #1
Print #1, Menu(4).text
Close #1
End If
Return
load:
If ToLoad$ = "Back$" Then ToLoad$ = ToLoad2$
_Dest MainScreen
If Not _FileExists("assets/pc/menu/" + RTrim$(LTrim$(ToLoad$)) + ".bhmenu") Then
Beep
FileMissing$ = ToLoad$
FileMissingtype$ = "Menu file"
ToLoad$ = "warningfilemissing"
End If
Open ("assets/pc/menu/" + RTrim$(LTrim$(ToLoad$)) + ".bhmenu") For Input As #1
Input #1, lasti
For i = 1 To lasti
Input #1, i, Menu(i).x1d, Menu(i).y1d, Menu(i).x2d, Menu(i).y2d, Menu(i).Colors, Menu(i).text, Menu(i).textsize, Menu(i).style, Menu(i).clicktogo, Menu(i).extra, Menu(i).extra2
GoSub redosize
Menu(i).textsize = Menu(i).y2 - Menu(i).y1
Menu(i).red = _Red32(Menu(i).Colors)
Menu(i).green = _Green32(Menu(i).Colors)
Menu(i).blue = _Blue32(Menu(i).Colors)
Menu(i).OffsetX = 0
Menu(i).OffsetY = 0
GoSub LoadingExtraSignatures
If Not Menu(i).text = "W Bh" Then GoSub redotexts
Next
Close #1
delay = 60
ToLoad2$ = Loaded$
Loaded$ = ToLoad$
Mouse.click = 0
For i = 1 To MenuMax
Menu(i).d_clicked = 0
Menu(i).d_hover = 0
Next
Return
LoadingExtraSignatures:
If Menu(i).text = "webpage$" Then Menu(i).text = webpage$
If Menu(i).text = "$username$" Then Menu(i).text = username$
If Menu(i).text = "$WhatMissingType$" Then Menu(i).text = (FileMissingtype$ + " Not found!")
If Menu(i).text = "$WhatMissing$" Then Menu(i).text = (FileMissing$ + " Is missing!")
Return
redotexts:
If Menu(i).text = "" Then Menu(i).text = " "
If ImgToMenu <> 0 Then _FreeImage ImgToMenu
'If MenusImages(i) <> 0 Then _FreeImage MenusImages(i)
If Menu(i).textsize = -1 Then Menu(i).textsize = Menu(i).y2 - Menu(i).y1
_Font BegsFontSizes(Menu(i).textsize)
thx = _PrintWidth(Menu(i).text)
thy = _FontHeight(BegsFontSizes(Menu(i).textsize))
ImgToMenu = _NewImage(thx * 3, thy * 3, 32)
_Dest ImgToMenu
_ClearColor _RGB32(0, 0, 0): _PrintMode _KeepBackground: _Font BegsFontSizes(Menu(i).textsize - 1): Print Menu(i).text + " "
If MenusImages(i) <> 0 Then _FreeImage MenusImages(i)
MenusImages(i) = _NewImage(thx, thy, 32)
_Dest MainScreen
_PutImage (0, 0), ImgToMenu, MenusImages(i)
_Font BegsFontSizes(20)
Return
redosize:
Menu(i).x1 = Menu(i).x1d * _Width / 2
Menu(i).x2 = Menu(i).x2d * _Width / 2
Menu(i).y1 = Menu(i).y1d * _Height / 2
Menu(i).y2 = Menu(i).y2d * _Height / 2
If Menu(i).x1d < 0 Then Menu(i).x1 = Menu(i).x1 * -1
If Menu(i).x2d < 0 Then Menu(i).x2 = Menu(i).x2 * -1
If Menu(i).y1d < 0 Then Menu(i).y1 = Menu(i).y1 * -1
If Menu(i).y2d < 0 Then Menu(i).y2 = Menu(i).y2 * -1
Return
Sub Explosion (x As Double, y As Double, strength As Double, Size As Double)
For o = 1 To 5
Part(LastPart).x = x
Part(LastPart).y = y
Part(LastPart).z = 4
Part(LastPart).xm = Int(Rnd * 512) - 256
Part(LastPart).ym = Int(Rnd * 512) - 256
Part(LastPart).zm = 8 + Int(Rnd * 10)
Part(LastPart).froozen = -90
Part(LastPart).visible = 30
Part(LastPart).partid = "Smoke"
Part(LastPart).playwhatsound = "None"
Part(LastPart).rotation = Int(Rnd * 360) - 180
Part(LastPart).rotationspeed = Int(Rnd * 128) - 64
LastPart = LastPart + 1: If LastPart > ParticlesMax Then LastPart = 0
Next
Part(LastPart).x = x
Part(LastPart).y = y
Part(LastPart).z = 1
Part(LastPart).xm = Int(Rnd * 8) - 4
Part(LastPart).ym = Int(Rnd * 8) - 4
Part(LastPart).zm = 20 + Int(Size / 40)
Part(LastPart).froozen = -64
Part(LastPart).visible = 5
Part(LastPart).partid = "Explosion"
Part(LastPart).playwhatsound = "None"
Part(LastPart).rotation = Int(Rnd * 360) - 180
Part(LastPart).rotationspeed = Int(Rnd * 128) - 64
LastPart = LastPart + 1: If LastPart > ParticlesMax Then LastPart = 0
Part(LastPart).x = x
Part(LastPart).y = y
Part(LastPart).z = 25
Part(LastPart).xm = Int(Rnd * 8) - 4
Part(LastPart).ym = Int(Rnd * 8) - 4
Part(LastPart).zm = 10
Part(LastPart).froozen = -200
Part(LastPart).visible = 90
Part(LastPart).partid = "Smoke"
Part(LastPart).playwhatsound = "None"
Part(LastPart).rotation = Int(Rnd * 360) - 180
Part(LastPart).rotationspeed = Int(Rnd * 100) - 50
LastPart = LastPart + 1: If LastPart > ParticlesMax Then LastPart = 0
For i = 1 To ZombieMax
If Zombie(i).health > 0 Then
dist = Distance(x, y, Zombie(i).x, Zombie(i).y)
If dist < Size Then
Zombie(i).DamageTaken = Int(strength / (dist / 50))
End If
End If
Next
dist = Distance(x, y, Player(1).x, Player(1).y)
If dist < Size Then
'Player(1).DamageToTake = Int(strength / (dist / 30))
PlayerTakeDamage Player(1), x, y, Int(strength / (dist / 30)), Int(dist / 10)
End If
End Sub
Function raycastingsimple (x As Double, y As Double, angle As Double, limit As Integer)
Dim xvector As Double: Dim yvector As Double
xvector = Sin(angle * PIDIV180): yvector = -Cos(angle * PIDIV180)
Ray.x = x: Ray.y = y
Do
limit = limit - 1
Ray.x = Ray.x + xvector * 6: Ray.y = Ray.y + yvector * 6
If limit = 0 Then Exit Do
tx = Fix((Ray.x) / Map.TileSize): ty = Fix((Ray.y) / Map.TileSize): If Tile(tx, ty, 2).transparent = 0 Then Exit Do
Loop While quit < 4
raycastingsimple = 1
End Function
Function raycasting (x As Double, y As Double, angle As Double, damage As Double, owner As Double)
Dim xvector As Double: Dim yvector As Double
xvector = Sin(angle * PIDIV180): yvector = -Cos(angle * PIDIV180)
Ray.x = x: Ray.y = y: Ray.owner = owner
quit = 0
Do
Steps = Steps + 1
steps2 = steps2 + 1
Ray.x = Ray.x + xvector * 2: Ray.y = Ray.y + yvector * 2
If steps2 = 5 Then
tx = Fix((Ray.x) / Map.TileSize): ty = Fix((Ray.y) / Map.TileSize): If Tile(tx, ty, 2).solid = 1 Then
quit = quit + 2
If Tile(tx, ty, 2).fragile = 1 Then
For o = 1 To 5
Part(LastPart).x = Ray.x
Part(LastPart).y = Ray.y
Part(LastPart).z = 2
Part(LastPart).xm = Int(Rnd * 128) - 64
Part(LastPart).ym = Int(Rnd * 128) - 64
Part(LastPart).zm = 2 + Int(Rnd * 7)
Part(LastPart).froozen = -20
Part(LastPart).visible = 900
Part(LastPart).partid = "GlassShard"
Part(LastPart).playwhatsound = "Glass"
Part(LastPart).rotation = Int(Rnd * 360) - 180
Part(LastPart).rotationspeed = Int(Rnd * 60) - 30
LastPart = LastPart + 1: If LastPart > ParticlesMax Then LastPart = 0
Next
If Tile(tx, ty, 2).ID = 56 Then _SndPlayCopy GlassShadder(Int(1 + Rnd * 3)), 0.4
Tile(tx, ty, 2).ID = 0
Tile(tx, ty, 2).solid = 0
'Tile(tx, ty, 2).rend_spritex = 0
'Tile(tx, ty, 2).rend_spritey = 0
End If
If Tile(tx, ty, 2).fragile = 0 Then
Part(LastPart).x = Ray.x
Part(LastPart).y = Ray.y
Part(LastPart).z = 2
Part(LastPart).xm = 0
Part(LastPart).ym = 0
Part(LastPart).zm = 2 + Int(Rnd * 3)
Part(LastPart).froozen = -20
Part(LastPart).visible = 800
Part(LastPart).partid = "WallShot"
Part(LastPart).playwhatsound = "Wall"
Part(LastPart).rotation = Int(Rnd * 360) - 180
Part(LastPart).rotationspeed = Int(Rnd * 60) - 30
LastPart = LastPart + 1: If LastPart > ParticlesMax Then LastPart = 0
Exit Do
End If
End If
steps2 = 0
For i = 1 To ZombieMax
If Zombie(i).active = 1 Then
If RayCollideEntity(Ray, Zombie(i)) Then
If Int(Rnd * 20) = 11 Then _SndPlayCopy ZombieShot(Int(Rnd * 16) + 1), 0.2
If Zombie(i).DamageTaken = 0 Then EntityTakeDamage Zombie(i), Ray.x, Ray.y, damage
changeofblood = Int(Rnd * 30)
If changeofblood < damage + 5 Then SpawnBloodParticle Ray.x, Ray.y, angle, Steps, "green"
If GunDisplay(1).wtype = 2 Then quit = quit + 1: If damage > 0 Then damage = damage - 1
If GunDisplay(1).wtype <> 2 Then quit = 99999
End If
End If
Next
End If
Loop While quit < 7
For i = 1 To ZombieMax
If Zombie(i).active = 1 Then
Zombie(i).health = Zombie(i).health - Zombie(i).DamageTaken: Zombie(i).DamageTaken = 0
End If
Next
End Function
Sub SpawnBloodParticle (x As Double, y As Double, angle As Double, Steps As Long, BloodType As String)
LastPart = LastPart + 1: If LastPart > ParticlesMax Then LastPart = 0
Part(LastPart).x = x
Part(LastPart).y = y
Part(LastPart).z = 2 + Int(Rnd * 12)
rand = 20 + Int(Rnd * 100)
Part(LastPart).xm = Int(Sin((angle + Int(Rnd * 40) - 20) * PIDIV180) * (rand))
Part(LastPart).ym = Int(-Cos((angle + Int(Rnd * 40) - 20) * PIDIV180) * (rand))
Part(LastPart).zm = (2 + Int(Rnd * 14))
Part(LastPart).froozen = -60
Part(LastPart).visible = 2000
Part(LastPart).BloodColor = BloodType
Part(LastPart).partid = "BloodSplat"
Part(LastPart).playwhatsound = "Blood"
If Part(LastPart).BloodColor = "GibSkull" Then Part(LastPart).partid = BloodType: Part(LastPart).playwhatsound = "Bone"
If Part(LastPart).BloodColor = "GibBone" Then Part(LastPart).partid = BloodType: Part(LastPart).playwhatsound = "Bone"
If Part(LastPart).BloodColor = "PistolAmmo" Then Part(LastPart).partid = BloodType: Part(LastPart).playwhatsound = "Blood"
If Part(LastPart).BloodColor = "ShotgunAmmo" Then Part(LastPart).partid = BloodType: Part(LastPart).playwhatsound = "Blood"
If Part(LastPart).BloodColor = "GasAmmo" Then Part(LastPart).partid = BloodType: Part(LastPart).playwhatsound = "Blood"
If Part(LastPart).BloodColor = "GrenadeAmmo" Then Part(LastPart).partid = BloodType: Part(LastPart).playwhatsound = "Blood"
Part(LastPart).rotation = Int(Rnd * 360) - 180
Part(LastPart).rotationspeed = Int(Rnd * 60) - 30
End Sub
Function Distance (x1, y1, x2, y2)
Distance = 0
Dist = Sqr(((x1 - x2) ^ 2) + ((y1 - y2) ^ 2))
Distance = Dist
End Function
Sub PlayerTakeDamage (Player As Player, X, Y, Damage, Knockback)
dx = Player.x - X: dy = Player.y - Y
Rotation = ATan2(dy, dx) ' Angle in radians
Rotation = (Rotation * 180 / PI) + 90
If Rotation > 180 Then Rotation = Rotation - 180
xvector = Sin(Rotation * PIDIV180)
yvector = -Cos(Rotation * PIDIV180)
Player.Health = Player.Health - Damage
Player.xm = Player.xm / 5
Player.ym = Player.ym / 5
Player.ym = Int(Player.ym + yvector * (Damage * Knockback))
Player.xm = Int(Player.xm + xvector * (Damage * Knockback))
SpawnBloodParticle Player.x - Player.size + Int(Rnd * Player.size * 2), Player.y - Player.size + Int(Rnd * Player.size * 2), Rotation + 180, 2, "red"
If Player.Health > 0 Then _SndPlay PlayerDamage
End Sub
Sub EntityTakeDamage (Player As Entity, X, Y, Damage)
dx = Player.x - X: dy = Player.y - Y
Rotation = ATan2(dy, dx) ' Angle in radians
Rotation = (Rotation * 180 / PI) + 90
If Rotation > 180 Then Rotation = Rotation - 180
xvector = Sin(Rotation * PIDIV180)
yvector = -Cos(Rotation * PIDIV180)
Player.ym = Int(Player.ym - ((yvector * (Damage * 35) / Player.weight)))
Player.xm = Int(Player.xm - ((xvector * (Damage * 35) / Player.weight)))
If (Player.health * 10) < Damage Then gib = 1
Player.DamageTaken = Abs(Damage)
If gib = 0 And Player.health - Damage < 0 Then Player.health = 0
End Sub
Sub MakeHitBoxPlayer (Player As Player)
Player.x1 = Player.x - Player.size: Player.x2 = Player.x + Player.size: Player.y1 = Player.y - Player.size: Player.y2 = Player.y + Player.size
End Sub
Function CollisionWithWallsPlayer (Player As Player)
CollisionWithWallsPlayer = 0
PY1 = Player.y1 - Player.ym / 10: PY2 = Player.y2 - Player.ym / 10: PX1 = Player.x1 - Player.xm / 10: PX2 = Player.x2 - Player.xm / 10
tx1 = Fix((PX1 - 1) / Map.TileSize): ty1 = Fix((PY1 + 10) / Map.TileSize)
If Tile(tx1, ty1, 2).solid = 1 Then If Player.xm > 0 Then Player.x = Player.x + Player.xm / 10: Player.xm = -5: Player.TouchX = 3
tx1 = Fix((PX1 - 1) / Map.TileSize): ty1 = Fix((PY2 - 10) / Map.TileSize)
If Tile(tx1, ty1, 2).solid = 1 Then If Player.xm > 0 Then Player.x = Player.x + Player.xm / 10: Player.xm = -5: Player.TouchX = 3
tx1 = Fix((PX2 + 1) / Map.TileSize): ty1 = Fix((PY1 + 10) / Map.TileSize)
If Tile(tx1, ty1, 2).solid = 1 Then If Player.xm < 0 Then Player.x = Player.x + Player.xm / 10: Player.xm = 5: Player.TouchX = 3
tx1 = Fix((PX2 + 1) / Map.TileSize): ty1 = Fix((PY2 - 10) / Map.TileSize)
If Tile(tx1, ty1, 2).solid = 1 Then If Player.xm < 0 Then Player.x = Player.x + Player.xm / 10: Player.xm = 5: Player.TouchX = 3
tx1 = Fix((PX1 + 10) / Map.TileSize): ty1 = Fix((PY1 - 1) / Map.TileSize)
If Tile(tx1, ty1, 2).solid = 1 Then If Player.ym > 0 Then Player.y = Player.y + Player.ym / 10: Player.ym = -5: Player.TouchY = 3
tx1 = Fix((PX1 + 10) / Map.TileSize): ty1 = Fix((PY2 + 1) / Map.TileSize)
If Tile(tx1, ty1, 2).solid = 1 Then If Player.ym < 0 Then Player.y = Player.y + Player.ym / 10: Player.ym = 5: Player.TouchY = 3
tx1 = Fix((PX2 - 10) / Map.TileSize): ty1 = Fix((PY1 - 1) / Map.TileSize)
If Tile(tx1, ty1, 2).solid = 1 Then If Player.ym > 0 Then Player.y = Player.y + Player.ym / 10: Player.ym = -5: Player.TouchY = 3
tx1 = Fix((PX2 - 10) / Map.TileSize): ty1 = Fix((PY2 + 1) / Map.TileSize)
If Tile(tx1, ty1, 2).solid = 1 Then If Player.ym < 0 Then Player.y = Player.y + Player.ym / 10: Player.ym = 5: Player.TouchY = 3
CollisionWithWallsPlayer = -1
End Function
Function CollisionWithWallsEntity (Player As Entity)
CollisionWithWallsEntity = 0
PY1 = Player.y1 + Player.ym / 100: PY2 = Player.y2 + Player.ym / 100: PX1 = Player.x1 + Player.xm / 100: PX2 = Player.x2 + Player.xm / 100
tx1 = Fix((PX1 - 1) / Map.TileSize): ty1 = Fix((PY1 + 10) / Map.TileSize)
If Tile(tx1, ty1, 2).solid = 1 Then If Player.xm < 0 Then Player.x = Player.x - Player.xm / 100: Player.xm = 5
tx1 = Fix((PX1 - 1) / Map.TileSize): ty1 = Fix((PY2 - 10) / Map.TileSize)
If Tile(tx1, ty1, 2).solid = 1 Then If Player.xm < 0 Then Player.x = Player.x - Player.xm / 100: Player.xm = 5
tx1 = Fix((PX2 + 1) / Map.TileSize): ty1 = Fix((PY1 + 10) / Map.TileSize)
If Tile(tx1, ty1, 2).solid = 1 Then If Player.xm > 0 Then Player.x = Player.x - Player.xm / 100: Player.xm = -5
tx1 = Fix((PX2 + 1) / Map.TileSize): ty1 = Fix((PY2 - 10) / Map.TileSize)
If Tile(tx1, ty1, 2).solid = 1 Then If Player.xm > 0 Then Player.x = Player.x - Player.xm / 100: Player.xm = -5
tx1 = Fix((PX1 + 10) / Map.TileSize): ty1 = Fix((PY1 - 1) / Map.TileSize)
If Tile(tx1, ty1, 2).solid = 1 Then If Player.ym < 0 Then Player.y = Player.y - Player.ym / 100: Player.ym = 5
tx1 = Fix((PX1 + 10) / Map.TileSize): ty1 = Fix((PY2 + 1) / Map.TileSize)
If Tile(tx1, ty1, 2).solid = 1 Then If Player.ym > 0 Then Player.y = Player.y - Player.ym / 100: Player.ym = -5
tx1 = Fix((PX2 - 10) / Map.TileSize): ty1 = Fix((PY1 - 1) / Map.TileSize)
If Tile(tx1, ty1, 2).solid = 1 Then If Player.ym < 0 Then Player.y = Player.y - Player.ym / 100: Player.ym = 5
tx1 = Fix((PX2 - 10) / Map.TileSize): ty1 = Fix((PY2 + 1) / Map.TileSize)
If Tile(tx1, ty1, 2).solid = 1 Then If Player.ym > 0 Then Player.y = Player.y - Player.ym / 100: Player.ym = -5
CollisionWithWallsEntity = -1
End Function
Sub Angle2Vector (Angle!, xv!, yv!)
xv! = Sin(Angle! * PIDIV180)
yv! = -Cos(Angle! * PIDIV180)
End Sub
Function CalculatePercentage (Number As Double, Percentage As Double)
Dim Result As Double
'Result = (Percentage / 100) * Number
Result = (Percentage / Number) * 100
CalculatePercentage = Result
End Function
Function ATan2 (y As Single, x As Single)
Dim AtanResult As Single
If x = 0 Then
If y > 0 Then
AtanResult = PI / 2
ElseIf y < 0 Then
AtanResult = -PI / 2
Else
AtanResult = 0
End If
Else
AtanResult = Atn(y / x)
If x < 0 Then
If y >= 0 Then AtanResult = AtanResult + PI
Else AtanResult = AtanResult - PI
End If
End If
ATan2 = AtanResult
End Function
Function ETSX (e)
s = e - CameraX * Map.TileSize
ETSX = Int(s)
End Function
Function ETSY (e)
s = e - CameraY * Map.TileSize
ETSY = Int(s)
End Function
Function WTS (w, Camera)
s = (w - Camera) * Map.TileSize
WTS = Int(s)
End Function
Function STW (s, m, Camera)
w = (s / m) + Camera
STW = w
End Function
Sub RotoZoom (X As Long, Y As Long, Image As Long, Scale As Single, Rotation As Single)
Dim px(3) As Single: Dim py(3) As Single
W& = _Width(Image&): H& = _Height(Image&)
px(0) = -W& / 2: py(0) = -H& / 2: px(1) = -W& / 2: py(1) = H& / 2
px(2) = W& / 2: py(2) = H& / 2: px(3) = W& / 2: py(3) = -H& / 2
sinr! = Sin(-Rotation / 57.2957795131): cosr! = Cos(-Rotation / 57.2957795131)
For i& = 0 To 3
x2& = (px(i&) * cosr! + sinr! * py(i&)) * Scale + X: y2& = (py(i&) * cosr! - px(i&) * sinr!) * Scale + Y
px(i&) = x2&: py(i&) = y2&
Next
_MapTriangle (0, 0)-(0, H& - 1)-(W& - 1, H& - 1), Image& To(px(0), py(0))-(px(1), py(1))-(px(2), py(2))
_MapTriangle (0, 0)-(W& - 1, 0)-(W& - 1, H& - 1), Image& To(px(0), py(0))-(px(3), py(3))-(px(2), py(2))
End Sub
Sub FireLogic
End Sub
Function LoadMapSettings (MapName As String)
LoadMapSettings = 0
Open ("assets/pc/maps/" + MapName + ".map") For Input As #1
Input #1, trash$ 'Layers header
Input #1, Map.Layers
Input #1, trash$ 'Max Width for map
Input #1, Map.MaxWidth
Input #1, trash$ 'Max Height for map
Input #1, Map.MaxHeight
Input #1, trash$ 'Tile size per tile
Input #1, Map.TileSize
Input #1, trash$ 'Triggers on the map
Input #1, Map.Triggers
Input #1, trash$ 'Tile texture size
Input #1, Map.TextureSize
Input #1, currentlayer
'Close #1
LoadMapSettings = -1
Map.TileSize = Map.TileSize * 4
End Function
Function LoadMap (MapName As String)
LoadMap = 0
limit = Map.MaxHeight * Map.MaxWidth * Map.Layers
For z = 1 To Map.Layers
For y = 0 To Map.MaxHeight
For x = 0 To Map.MaxWidth
' If x <> Map.MaxWidth Then
Input #1, Tile(x, y, z).ID
If Tile(x, y, z).ID = -404 Then NVM = 1
If NVM = 1 Then Exit For
If z = 2 And Tile(x, y, z).ID <> 0 Then Tile(x, y, z).solid = 1
If Tile(x, y, z).ID = 0 Then Tile(x, y, z).transparent = 1
IDTOTEXTURE = Tile(x, y, z).ID
If Tile(x, y, z).ID = 56 Then Tile(x, y, z).fragile = 1: Tile(x, y, z).transparent = 1
Do
If IDTOTEXTURE > 16 Then
Tile(x, y, z).rend_spritey = Tile(x, y, z).rend_spritey + 1
IDTOTEXTURE = IDTOTEXTURE - 16
End If
Tile(x, y, z).rend_spritex = IDTOTEXTURE - 1
Loop While IDTOTEXTURE > 16
Next
If NVM = 1 Then Exit For
Next
If NVM = 1 Then Exit For
If NVM = 0 Then If z <> Map.Layers - 1 Then Input #1, trash$
Next
Input #1, trash$
Input #1, trash$
Input #1, trash$
Input #1, trash$
For r = 1 To Map.Triggers
Input #1, Line$
poss = InStr(Line$, "name=") + 6
endpos = InStr(poss, Line$, Chr$(34))
Trigger(r).triggername = Mid$(Line$, poss, endpos - poss)
poss = InStr(Line$, "x=") + 3
endpos = InStr(poss, Line$, Chr$(34))
Trigger(r).x1 = Val(Mid$(Line$, poss, endpos - poss)) * 2
poss = InStr(Line$, "y=") + 3
endpos = InStr(poss, Line$, Chr$(34))
Trigger(r).y1 = Val(Mid$(Line$, poss, endpos - poss)) * 2
poss = InStr(Line$, "width=") + 7
endpos = InStr(poss, Line$, Chr$(34))
Trigger(r).sizex = Val(Mid$(Line$, poss, endpos - poss)) * 2
poss = InStr(Line$, "height=") + 8
endpos = InStr(poss, Line$, Chr$(34))
Trigger(r).sizey = Val(Mid$(Line$, poss, endpos - poss)) * 2
Trigger(r).x2 = Trigger(r).x1 + Trigger(r).sizex
Trigger(r).y2 = Trigger(r).y1 + Trigger(r).sizey
Input #1, trash$
Input #1, Line$
poss = InStr(Line$, "value=") + 7
endpos = InStr(poss, Line$, Chr$(34))
Trigger(r).class = Mid$(Line$, poss, endpos - poss)
Input #1, Line$
poss = InStr(Line$, "value=") + 7
endpos = InStr(poss, Line$, Chr$(34))
Trigger(r).val1 = Val(Mid$(Line$, poss, endpos - poss))
Input #1, Line$
poss = InStr(Line$, "value=") + 7
endpos = InStr(poss, Line$, Chr$(34))
Trigger(r).val2 = Val(Mid$(Line$, poss, endpos - poss))
Input #1, Line$
poss = InStr(Line$, "value=") + 7
endpos = InStr(poss, Line$, Chr$(34))
Trigger(r).val3 = Val(Mid$(Line$, poss, endpos - poss))
Input #1, Line$
poss = InStr(Line$, "value=") + 7
endpos = InStr(poss, Line$, Chr$(34))
Trigger(r).val4 = Val(Mid$(Line$, poss, endpos - poss))
Input #1, Line$
poss = InStr(Line$, "value=") + 7
endpos = InStr(poss, Line$, Chr$(34))
Trigger(r).needclick = Val(Mid$(Line$, poss, endpos - poss))
Input #1, Line$
poss = InStr(Line$, "value=") + 7
endpos = InStr(poss, Line$, Chr$(34))
Trigger(r).text = Mid$(Line$, poss, endpos - poss)
Input #1, trash$
Input #1, trash$
Next
Close #1
LoadMap = -1
End Function
Function RayCollideEntity (Rect1 As Raycast, rect2 As Entity)
RayCollideEntity = 0
If Rect1.x >= rect2.x1 Then
If Rect1.x <= rect2.x2 Then
If Rect1.y >= rect2.y1 Then
If Rect1.y <= rect2.y2 Then
RayCollideEntity = -1
End If
End If
End If
End If
End Function
Function UICollide (Rect1 As Mouse, Rect2 As Menu)
UICollide = 0
If Rect1.x2 >= Rect2.x1 + Rect2.OffsetX Then
If Rect1.x1 <= Rect2.x2 + Rect2.OffsetX Then
If Rect1.y2 >= Rect2.y1 + Rect2.OffsetY Then
If Rect1.y1 <= Rect2.y2 + Rect2.OffsetY Then
UICollide = -1
End If
End If
End If
End If
End Function
Function TriggerPlayerCollide (Rect1 As Player, Rect2 As Trigger)
TriggerPlayerCollide = 0
If Rect1.x2 >= Rect2.x1 Then
If Rect1.x1 <= Rect2.x2 Then
If Rect1.y2 >= Rect2.y1 Then
If Rect1.y1 <= Rect2.y2 Then
TriggerPlayerCollide = -1
End If
End If
End If
End If
End Function
|
|
|
|
| bplus Plinko Christmas Theme |
|
Posted by: bplus - 11-10-2024, 04:48 PM - Forum: Christmas Code
- Replies (1)
|
 |
Combining old Bonker's Symphony #37 and Bplus Plinko, I came up with this to start the season early:
Code: (Select All)
Option _Explicit
_Title "bplus Plinko Christmas Theme" ' b+ 2024-11-09 messing around with speed and gravity
' from bplus Plinko to Christmas version
Const XMax = 800
Const YMax = 720
Dim Shared BX, BY, BA, BCnt
Dim gravity, br, speed, pR, maxRow, np, pxo, pyo, row, col
Dim pidx, i, r, j, dx, dy, slotSpace, slot, score, backg
Dim slots(11), s$, f32 As Long, f16 As Long
Screen _NewImage(XMax, YMax, 32): _ScreenMove 250, 0
Randomize Timer: _PrintMode _KeepBackground
f32 = _LoadFont("arial.ttf", 32)
f16 = _LoadFont("arial.ttf", 20)
gravity = 2.0: slotSpace = XMax / 12
br = 24: speed = 3.75 'balls ' speed orig 4.0 4.0 keeps payout for 1000 balls low 300$
pR = 9: maxRow = 11: np = maxRow * (maxRow + 1) * .5 - 3 ' pins
pxo = XMax / (maxRow + 1) 'pin space along x
pyo = YMax / (maxRow + 1) 'pin spacing along y
Dim px(np), py(np), pc(np) As _Unsigned Long
For row = 3 To maxRow
For col = 1 To row
pidx = pidx + 1
px(pidx) = pxo * col + (maxRow - row) * .5 * pxo
py(pidx) = pyo * row
pc(pidx) = _RGB32(Rnd * 100 + 155, (pidx Mod 2) * (Rnd * 155 + 100), 0)
Next
Next
backg = BackImageHandle&: _PutImage , backg, 0: NewBall
While 1
' clear top score line
_PutImage (0, 0)-(_Width, 60), backg, 0, (0, 0)-(_Width, 60)
' clear bottom text area
_PutImage (0, _Height - 45)-(_Width, _Height), backg, 0, (0, _Height - 45)-(_Width, _Height)
For i = 1 To np ' draw pins
FC3 px(i), py(i), pR, pc(i)
FC3 px(i), py(i), 6, &H88999999
FC3 px(i), py(i), 2, &H88FFFFFF
Next
For j = 1 To np ' calc collsions
If Sqr((BX - px(j)) ^ 2 + (BY - py(j)) ^ 2) < br + pR Then
BA = _Atan2(BY - py(j), BX - px(j))
FC3 px(j), py(j), pR, &HFF000000
Sound 120 + (YMax - py(j)) / YMax * 2000, .25
Exit For
End If
Next
dx = Cos(BA) * speed: dy = Sin(BA) * speed + gravity ' update ball
BA = _Atan2(dy, dx)
BX = BX + Cos(BA) * speed: BY = BY + Sin(BA) * speed ' + 2 * Rnd - 1
If BX < br Or BX > XMax + br Or BY > YMax + br Then
slot = Int(BX / slotSpace): slots(slot) = slots(slot) + 1
BCnt = BCnt + 1: NewBall ' Now the time is right to count a ball
End If
For r = br To 1 Step -1
FC3 BX, BY, r, _RGB32(0, 255 - (r / br) * 220, 0)
Next
score = 0: Color &HFF990000 ' recalc and display slot counts and score
For i = 0 To 11
Select Case i
Case 0: s$ = " "
Case 11: s$ = " "
Case 1: score = score + slots(1) * 100: s$ = "x100$"
Case 10: score = score + slots(10) * 100: s$ = "x100$"
Case 2: score = score + slots(2) * 10: s$ = "x10$"
Case 9: score = score + slots(9) * 10: s$ = "x10$"
Case 3: score = score + slots(3) * 2: s$ = "x2$"
Case 8: score = score + slots(8) * 2: s$ = "x2$"
Case 4: score = score + slots(4) * 0: s$ = "x0$"
Case 7: score = score + slots(7) * 0: s$ = "x0$"
Case 5: score = score + slots(5) * -1: s$ = "x-1$"
Case 6: score = score + slots(6) * -1: s$ = "x-1$"
End Select
centerText i * slotSpace, (i + 1) * slotSpace, _Height - 30, _Trim$(Str$(slots(i)))
centerText i * slotSpace, (i + 1) * slotSpace, _Height - 10, s$
Next
Color &HFFFFFFFF: s$ = "Balls:" + Str$(BCnt) + " Score: $" + _Trim$(Str$(score))
_Font f32: centerText 0, _Width, 35, s$: _Font f16: _Display: _Limit 30
Wend
Sub NewBall ' get ready to drop
BX = XMax / 2 + 10 * Rnd - 5: BY = 150 - Rnd * 20
BA = _Pi(.5) + _Pi(2 / 90) * Rnd - _Pi(.9999 / 90)
End Sub
Sub FC3 (cx As Long, cy As Long, r As Long, clr~&) ' new fill circle
Dim As Long r2, x, y ' for Option _Explicit
If r < 1 Then Exit Sub
Line (cx - r, cy)-(cx + r, cy), clr~&, BF
r2 = r * r
Do
y = y + 1: x = Sqr(r2 - y * y)
Line (cx - x, cy + y)-(cx + x, cy + y), clr~&, BF
Line (cx - x, cy - y)-(cx + x, cy - y), clr~&, BF
Loop Until y = r
End Sub
Sub centerText (x1, x2, midy, s$) ' fit a string between two goal posts x1, and x2
_PrintString ((x1 + x2) / 2 - _PrintWidth(s$) / 2, midy - _FontHeight(_Font) / 2), s$
End Sub
Function BackImageHandle& ' make background image and return it's handle
Dim As Long horizon, nStars, i, back, land, cc
horizon = YMax - 45: nStars = 150 ' making the stars
Dim xstar(nStars), ystar(nStars), rstar(nStars)
For i = 1 To nStars
xstar(i) = Rnd * (XMax): ystar(i) = Rnd * horizon
If i < .80 * nStars Then
rstar(i) = 1
ElseIf i < .97 * nStars Then
rstar(i) = 2
Else
rstar(i) = 3
End If
Next
back = _NewImage(_Width, _Height, 32): _Dest back
For i = 0 To horizon ' the nite sky
Line (0, i)-(XMax, i), _RGB32(i / horizon * 70, i / horizon * 22, 60 * (i) / horizon)
Next
land = YMax - horizon ' the winter snow on ground
For i = horizon To YMax
cc = 128 + (i - horizon) / land * 127
Line (0, i)-(XMax, i), _RGB32(cc, cc, cc)
Next
For i = 1 To nStars ' paint the sky with stars
FC3 xstar(i), ystar(i), rstar(i), &HFFEEEEFF
Next
BackImageHandle& = back: _Dest 0
End Function
|
|
|
|
| Trasparent color not being set correctly here... |
|
Posted by: Dav - 11-09-2024, 06:05 PM - Forum: Help Me!
- Replies (9)
|
 |
What am I missing in this code? I've done this before using _CLEARCOLOR, but for some reason it's not working this time. I must have forgotten how to use it correctly....
I was going to make a scrolling credits over the screen, using a separate screen image of text to scroll over the main display. Setting the background color of the credits screen as transparent it should work, but I'm not getting there. Using _CLEARCOLOR.
- Dav
Code: (Select All)
Screen _NewImage(800, 800, 32)
credits& = _NewImage(800, 800, 32)
_Dest credits&
_ClearColor _RGB(0, 0, 0), credits&
'just some sample text for now
For t = 1 To 1000
Print Rnd;
Next
_Dest 0
For x = 1 To _Width
For y = 1 To _Height
PSet (x, y), _RGB(Rnd * 100, Rnd * 100, Rnd * 100)
Next
Next
back& = _CopyImage(_Display)
y = _Height
Do
_PutImage (0, 0), back&
_PutImage (0, y), credits&
y = y - 10
_Display
_Limit 30
Loop Until y < -_Height
|
|
|
|
| Whats better to SHARED or not |
|
Posted by: doppler - 11-07-2024, 04:23 PM - Forum: General Discussion
- Replies (17)
|
 |
I plan to create a program using many SUB procedures. Values to change in a sub must be passed or DIM shared.
But which way makes more sense or is more efficient? Shared it all (variables), shared some variables ?
Questions like these is a big factor to size of program, speed of the program and forgetting to shared a value.
Common sense is out the windows when playing with QB64 code.
Thanks
|
|
|
|
|
