| Welcome, Guest |
You have to register before you can post on our site.
|
| Latest Threads |
The QB64 IDE shell
Forum: Utilities
Last Post: JasonPag
09-16-2024, 05:37 PM
» Replies: 9
» Views: 762
|
Importance regarding Ches...
Forum: Utilities
Last Post: JasonPag
09-01-2024, 06:34 PM
» Replies: 0
» Views: 31
|
Chess and Analysis and En...
Forum: Utilities
Last Post: JasonPag
08-28-2024, 02:37 PM
» Replies: 0
» Views: 32
|
DAY 009:_PutImage
Forum: Keyword of the Day!
Last Post: grymmjack
09-02-2023, 02:57 PM
» Replies: 54
» Views: 2,034
|
Fall Banner Contest?
Forum: Site Suggestions
Last Post: grymmjack
08-31-2023, 11:50 PM
» Replies: 36
» Views: 1,261
|
ColorPicker - Function th...
Forum: Dav
Last Post: Dav
08-31-2023, 11:04 PM
» Replies: 3
» Views: 315
|
Goals(1) = New Tile()
Forum: Works in Progress
Last Post: RhoSigma
08-31-2023, 09:45 PM
» Replies: 3
» Views: 127
|
micro(A)v11
Forum: QBJS, BAM, and Other BASICs
Last Post: bplus
08-31-2023, 09:14 PM
» Replies: 90
» Views: 3,589
|
Updating The Single Most ...
Forum: QBJS, BAM, and Other BASICs
Last Post: bplus
08-31-2023, 09:13 PM
» Replies: 7
» Views: 254
|
QBJS Image Question
Forum: QBJS, BAM, and Other BASICs
Last Post: bplus
08-31-2023, 05:49 PM
» Replies: 5
» Views: 155
|
|
|
| TCP/IP Printing |
|
Posted by: AtomicSlaughter - 05-21-2022, 09:53 PM - Forum: Utilities
- Replies (2)
|
 |
Code: (Select All) Sub TCPPrint (IP As String, Port As String, toPrint As String)
CRLF$ = Chr$(10) + Chr$(13)
x = _OpenClient("TCP/IP:" + Port + ":" + IP)
toPrint = toPrint + CRLF$
Put #x, , CRFF$
End Sub
Sub TCPEndPrint (IP As String, Port As String)
CRFF$ = Chr$(10) + Chr$(12)
x = _OpenClient("TCP/IP:" + Port + ":" + IP)
Put #x, , CRFF$
End Sub
Use the first sub to send the data, then when finished send the second sub and it will initiate the form feed and spit the sheet out.
|
|
|
| Space(d) Invaders! |
|
Posted by: Cobalt - 05-21-2022, 09:44 PM - Forum: Works in Progress
- Replies (2)
|
 |
SI_ResourcePack_1.MFI (Size: 2.1 MB / Downloads: 52)
With the weather what it is the past 2 days around my place I have taken a bit of a rest from workin to code a little something. Though its not quite done I thought I might share it with you folks and see what you think of it so far.
Space Invaders 2022.
Controls are pretty basic;
Right and Left arrow keys move your defense cannon.
Space bar shoots.
it does track your score, but there is only the initial wave to fight off. Its pretty bare bones at the moment too, so there is only the one scale and no options.
It has some issues with the invaders freezing from time to time. Almost like a time stop special, which I wish I could say was the intent.  But alas I haven't quite figured out why they freeze for a very specific amount of time!
There is also the occasional collision issue where your shot will pass through an Invader. Probably because I'm using a very VERY basic POINT approach to detecting if the shot hits an Invader, so if it happens to find one of the blank pixels in the invaders then it will tend to miss. Just haven't added a secondary POINT detection to help fix that.
The Invaders also cannot hit you with their weapons yet, so your invincible at the moment.
Beyond some special graphical elements I would like to add that about all that is left to finish.
Don't forget the MFI file too.
Code: (Select All) 'Space Invaders 2022
'Cobalt
'QB64
TYPE Invader
X AS INTEGER
Y AS INTEGER
Type AS INTEGER
END TYPE
TYPE Player
X AS INTEGER 'where player is
Y AS INTEGER
Shot_X AS INTEGER 'where player's shot is
Shot_Y AS INTEGER '(only 1 at a time allowed)
Hit_X AS INTEGER
Hit_Y AS INTEGER
Hit_Time AS INTEGER
Special AS _BYTE
END TYPE
TYPE Shot
X AS INTEGER
Y AS SINGLE
Type AS _BYTE
END TYPE
TYPE Impacts
X AS INTEGER
Y AS INTEGER
Time AS _BYTE
END TYPE
TYPE Game
Lives AS _BYTE
Level AS _BYTE
Score1 AS LONG
Score2 AS LONG
HScore AS LONG
Frame AS _BYTE
Remain AS _BYTE 'invaders remaining
Speed AS _BYTE
Difficulty AS _BYTE
Win AS _BYTE
UFO AS _BYTE
UFO_Shot AS _BYTE
END TYPE
CONST TRUE = -1, FALSE = NOT TRUE
CONST Key_Right = 19712, Key_Left = 19200, Key_Up = 18432, Key_Down = 20480
CONST Key_Space = 32, Key_Enter = 13
DIM SHARED G AS Game, I(11, 5) AS Invader, P AS Player, P_Shot AS _BYTE
DIM SHARED Layer(8) AS LONG, SFX(16) AS LONG, BGM(4) AS LONG
DIM SHARED Shots(17) AS Shot, Shot_Count AS _BYTE, Hits(16) AS Impacts, Hit_Count AS _BYTE
DIM SHARED Ex AS Invader, Exploding AS _BYTE, UFO AS Invader
'init
RANDOMIZE TIMER
SCREEN _NEWIMAGE(640, 700, 32)
_SCREENMOVE 10, 5
Layer(0) = _DISPLAY
Layer(1) = _NEWIMAGE(640, 700, 32)
'Layer(2) = _LOADIMAGE("invaders.bmp", 32)
'Layer(3) = _LOADIMAGE("spaceinvaders.bmp", 32)
'Layer(4) = _LOADIMAGE("si_cpo.bmp", 32)
'Layer(5) = _LOADIMAGE("invaddx.bmp", 32)
Layer(6) = _NEWIMAGE(640, 700, 32) 'console build layer
Layer(7) = _NEWIMAGE(640, 700, 32) 'shield layer
Layer(8) = _NEWIMAGE(640, 700, 32) 'invader layer
'SFX(1) = _SNDOPEN("SI_shoot.wav")
'SFX(2) = _SNDOPEN("SI_invaderkilled.wav")
'SFX(3) = _SNDOPEN("SI_Explode.wav")
'SFX(4) = _SNDOPEN("SI_fastinvader1.wav")
'SFX(5) = _SNDOPEN("SI_fastinvader2.wav")
'SFX(6) = _SNDOPEN("SI_fastinvader3.wav")
'SFX(7) = _SNDOPEN("SI_fastinvader4.wav")
'SFX(8) = _SNDOPEN("SI_ufo_highpitch.wav")
'SFX(9) = _SNDOPEN("SI_ufo_lowpitch.wav")
MFI_Loader "SI_ResourcePack_1.MFI"
_SNDVOL SFX(1), .5
_SNDVOL SFX(2), .5
_SNDVOL SFX(3), .5
_SNDVOL SFX(4), .5
_SNDVOL SFX(5), .5
_SNDVOL SFX(6), .5
_SNDVOL SFX(7), .5
_SNDVOL SFX(8), .5
_SNDVOL SFX(9), .5
_CLEARCOLOR _RGB32(0), Layer(3)
_CLEARCOLOR _RGB32(4), Layer(3)
_CLEARCOLOR _RGB32(4), Layer(5)
_CLEARCOLOR _RGB32(0), Layer(7)
TAnimate& = _FREETIMER
TSound& = _FREETIMER
ON TIMER(TSound&, .3682) Play_BGS
ON TIMER(TAnimate&, .256) Flip_Frame
_TITLE "Space Invaders 2022"
_DELAY .25
'Build Arcade Console
_PUTIMAGE (0, 0)-STEP(639, 499), Layer(2), Layer(6)
_PUTIMAGE (0, 0)-STEP(639, 499), Layer(5), Layer(6)
_PUTIMAGE (0, 500)-STEP(639, 199), Layer(4), Layer(6), (0, 0)-STEP(5999, 1799)
SI_Print "p1-score", 192, 204, Layer(6)
SI_Print "hi-score", 288, 204, Layer(6)
SI_Print "p2-score", 384, 204, Layer(6)
'--------------------
FOR i%% = 0 TO 3
_PUTIMAGE (160 + 100 * i%%, 352)-STEP(23, 15), Layer(3), Layer(7), (254, 31)-STEP(23, 15)
NEXT i%%
G.Frame = FALSE
G.Remain = 55
G.Speed = 30
P.X = 164: P.Y = 380
FOR y%% = 0 TO 4
FOR x%% = 0 TO 10
I(x%%, y%%).X = 96 + 32 * x%%: I(x%%, y%%).Y = 320 - 20 * y%%: I(x%%, y%%).Type = y%% + 1
NEXT x%%, y%%
TIMER(TAnimate&) ON
TIMER(TSound&) ON
ClearLayerTrans Layer(8)
DO
_PUTIMAGE , Layer(6), Layer(1)
_PUTIMAGE , Layer(7), Layer(1)
FOR y%% = 0 TO 4: FOR x%% = 0 TO 10
PlaceInvader x%%, y%%
NEXT x%%, y%%
IF Move_Counter%% >= G.Speed THEN Move_Counter%% = 0: Move_Invaders
IF INT(RND * 100) >= 75 THEN Invader_Shot
IF NOT G.UFO THEN
IF INT(RND * 100) > 90 THEN
IF Last_UFO%% > 120 THEN 'Only 1 out of 120 ufos appear
Last_UFO%% = 0: Start_UFO
ELSEIF Last_UFO%% <= 120 THEN
Last_UFO%% = Last_UFO%% + 1
END IF
END IF
ELSEIF G.UFO THEN
Move_UFO
Draw_UFO
END IF
Move_Invader_Shot
Draw_Invader_Shot
IF Hit_Count THEN Age_Impacts 'if any hits then age them
IF P.Hit_Time THEN Age_Impact_Player
IF P_Shot THEN Move_Player_Shot
Draw_Impacts
IF P.Hit_Time THEN Draw_Impact_Player
Nul%% = Controls
IF P_Shot THEN Draw_Player_Shot
Draw_Player
IF Exploding THEN Draw_Explode_Invader
Display_Scores
_PRINTSTRING (0, 0), STR$(Last_UFO%%), Layer(8)
_PUTIMAGE , Layer(8), Layer(1)
_PUTIMAGE , Layer(1), Layer(0)
ClearLayerTrans Layer(8)
_LIMIT 60
Move_Counter%% = Move_Counter%% + 1
IF Nul%% = TRUE THEN ExitFlag%% = TRUE
IF G.Remain = 0 THEN ExitFlag%% = TRUE: G.Win = TRUE
LOOP UNTIL ExitFlag%%
STOP_ALL_SNDs
TIMER(TSound&) OFF
TIMER(TAnimate&) OFF
IF G.Win THEN SI_Print "you win!", 288, 304, Layer(0)
SUB Start_UFO
G.UFO = TRUE
IF INT(RND * 100) > 49 THEN
UFO.X = 112
UFO.Type = TRUE
_SNDLOOP SFX(8)
ELSE
UFO.X = 512
UFO.Type = FALSE
_SNDLOOP SFX(9)
END IF
UFO.Y = 224
END SUB
SUB Move_UFO
IF UFO.Type THEN 'moving left to right
UFO.X = UFO.X + 1
ELSE 'moving right to left
UFO.X = UFO.X - 2
END IF
IF INT(RND * 100) > 50 THEN UFO_Shoot
IF UFO.X < 112 OR UFO.X > 512 THEN
_SNDSTOP SFX(8): _SNDSTOP SFX(9)
G.UFO = FALSE
END IF
END SUB
SUB Draw_UFO
_PUTIMAGE (UFO.X, UFO.Y)-STEP(15, 7), Layer(3), Layer(8), (210, 39)-STEP(15, 7)
END SUB
SUB UFO_Shoot
IF UFO.X - 8 >= P.X AND UFO.X + 8 <= P.X + 16 AND G.UFO_Shot = FALSE THEN
Shots(Shot_Count).X = UFO.X + 8
Shots(Shot_Count).Y = UFO.Y + 8
Shots(Shot_Count).Type = 6
Shot_Count = Shot_Count + 1
G.UFO_Shot = TRUE
END IF
END SUB
FUNCTION Controls
Result%% = FALSE
IF _KEYDOWN(Key_Right) THEN
P.X = P.X + 2
IF P.X >= 500 THEN P.X = 500
END IF
IF _KEYDOWN(Key_Left) THEN
P.X = P.X - 2
IF P.X <= 128 THEN P.X = 128
END IF
IF _KEYDOWN(Key_Space) AND P_Shot = FALSE AND P.Hit_Time = 0 THEN Player_Shot
IF _KEYHIT = 27 THEN Result%% = TRUE
Controls = Result%%
END FUNCTION
SUB Player_Shot
_SNDPLAY SFX(1)
P_Shot = TRUE
P.Shot_X = P.X + 7
P.Shot_Y = P.Y
END SUB
SUB PlaceInvader (X%%, Y%%)
SELECT CASE I(X%%, Y%%).Type
CASE 0 'Dead
CASE 1, 2
IF G.Frame THEN
_PUTIMAGE (I(X%%, Y%%).X, I(X%%, Y%%).Y)-STEP(15, 7), Layer(3), Layer(8), (246, 1)-STEP(15, 7)
ELSE
_PUTIMAGE (I(X%%, Y%%).X, I(X%%, Y%%).Y)-STEP(15, 7), Layer(3), Layer(8), (246, 11)-STEP(15, 7)
END IF
CASE 3, 4
IF G.Frame THEN
_PUTIMAGE (I(X%%, Y%%).X, I(X%%, Y%%).Y)-STEP(15, 7), Layer(3), Layer(8), (228, 1)-STEP(15, 7)
ELSE
_PUTIMAGE (I(X%%, Y%%).X, I(X%%, Y%%).Y)-STEP(15, 7), Layer(3), Layer(8), (228, 11)-STEP(15, 7)
END IF
CASE 5
IF G.Frame THEN
_PUTIMAGE (I(X%%, Y%%).X, I(X%%, Y%%).Y)-STEP(15, 7), Layer(3), Layer(8), (210, 1)-STEP(15, 7)
ELSE
_PUTIMAGE (I(X%%, Y%%).X, I(X%%, Y%%).Y)-STEP(15, 7), Layer(3), Layer(8), (210, 11)-STEP(15, 7)
END IF
END SELECT
END SUB
SUB Move_Invaders
STATIC Direction%% 'direction of invader movement
DIM Score(11) AS _BYTE 'track how many invaders are in each column
IF Direction%% THEN 'TRUE
'move all invaders regaurdless of exsistance
FOR y%% = 0 TO 4
FOR x%% = 0 TO 10
I(x%%, y%%).X = I(x%%, y%%).X + 3
Score(x%%) = Score(x%%) + I(x%%, y%%).Type 'monitor how many invaders are in each column
NEXT x%%, y%%
FOR z%% = 10 TO 0 STEP -1 'check right to left if moving right
IF Score(z%%) THEN 'if there are still invaders in this Column
IF I(z%%, 0).X >= 528 THEN
Direction%% = NOT Direction%% 'reverse invader movement
FOR y%% = 0 TO 4
FOR x%% = 0 TO 10
I(x%%, y%%).Y = I(x%%, y%%).Y + 4 'lower invaders each pass
NEXT x%%, y%%
END IF
z%% = -1 'good column so quit after move
END IF
NEXT z%%
ELSE 'FALSE
'move all invaders regaurdless of exsistance
FOR y%% = 0 TO 4
FOR x%% = 0 TO 10
I(x%%, y%%).X = I(x%%, y%%).X - 3
Score(x%%) = Score(x%%) + I(x%%, y%%).Type 'monitor how many invaders are in each column
NEXT x%%, y%%
FOR z%% = 0 TO 10 'check left to right if moving left
IF Score(z%%) THEN 'if there are still invaders in this Column
IF I(z%%, 0).X <= 96 THEN
Direction%% = NOT Direction%% 'reverse invader movement
FOR y%% = 0 TO 4
FOR x%% = 0 TO 10
I(x%%, y%%).Y = I(x%%, y%%).Y + 4 'lower invaders each pass
NEXT x%%, y%%
END IF
z%% = 11 'good column so quit after move
END IF
NEXT z%%
END IF
END SUB
SUB SI_Print (Txt$, X%, Y%, L&)
L%% = LEN(Txt$)
FOR i%% = 1 TO L%%
SELECT CASE ASC(MID$(Txt$, i%%, 1))
CASE 32
X% = X% + 6
CASE 45
_PUTIMAGE (X%, Y%)-STEP(7, 7), Layer(3), L&, (220, 119)-STEP(7, 7)
X% = X% + 8
CASE 48 TO 57
_PUTIMAGE (X%, Y%)-STEP(7, 7), Layer(3), L&, (1 + (ASC(MID$(Txt$, i%%, 1)) - 48) * 10, 146)-STEP(7, 7)
X% = X% + 8
CASE 97 TO 122
_PUTIMAGE (X%, Y%)-STEP(7, 7), Layer(3), L&, (1 + (ASC(MID$(Txt$, i%%, 1)) - 97) * 10, 137)-STEP(7, 7)
X% = X% + 8
END SELECT
NEXT i%%
END SUB
SUB Display_Scores
SI_Print LTRIM$(STR$(G.Score1)), 192, 214, Layer(1)
SI_Print LTRIM$(STR$(G.HScore)), 288, 214, Layer(1)
SI_Print LTRIM$(STR$(G.Score2)), 384, 214, Layer(1)
END SUB
SUB Shot_Impact (id%%)
Hit_Count = Hit_Count + 1
Hits(Hit_Count).X = Shots(id%%).X - 2
Hits(Hit_Count).Y = Shots(id%%).Y
Hits(Hit_Count).Time = 30
END SUB
SUB Shot_Impact_Player
P.Hit_X = P.Shot_X - 2
P.Hit_Y = P.Shot_Y - 3
P.Hit_Time = 30
P_Shot = FALSE
END SUB
SUB Invader_Shot
FOR y%% = 0 TO 4
FOR x%% = 0 TO 10
IF I(x%%, y%%).Type THEN 'make sure invader is alive
IF INT(RND * 100) >= 99 THEN 'random chance of shot
IF INT(RND * 5) = 3 THEN
IF Shot_Count < 15 THEN 'is there room for a shot?
Shots(Shot_Count).X = I(x%%, y%%).X + 8
Shots(Shot_Count).Y = I(x%%, y%%).Y + 4
Shots(Shot_Count).Type = INT(RND * 3) + 1
Shot_Count = Shot_Count + 1
END IF
END IF
END IF
END IF
NEXT x%%, y%%
END SUB
SUB Move_Invader_Shot
FOR i%% = 1 TO Shot_Count
Shots(i%%).Y = Shots(i%%).Y + Shots(i%%).Type / 2
IF Shots(i%%).Y > 400 THEN 'ground\bottom of screen, remove shot
Shots(i%%).Type = 0
Shots(i%%).Y = 0
FOR z%% = i%% TO Shot_Count
SWAP Shots(z%%), Shots(z%% + 1)
NEXT z%%
Shot_Count = Shot_Count - 1
END IF
IF Collide_Invader_Shot(i%%) THEN 'did the invader's shot hit a sheild or player?
Shot_Impact i%%
IF Shots(i%%).Type = 6 THEN G.UFO_Shot = FALSE
Shots(i%%).Type = 0
Shots(i%%).Y = 0
FOR z%% = i%% TO Shot_Count
SWAP Shots(z%%), Shots(z%% + 1)
NEXT z%%
Shot_Count = Shot_Count - 1
END IF
NEXT i%%
END SUB
SUB Move_Player_Shot
P.Shot_Y = P.Shot_Y - 3
IF P.Shot_Y <= 200 THEN Shot_Impact_Player
Test%% = Collide_Player_Shot
IF Test%% = 1 THEN Shot_Impact_Player 'cause impact GFX to display
IF Test%% = TRUE THEN P_Shot = FALSE 'Invader explodes and shot stops
END SUB
SUB Explode_Invader (x%%, y%%)
_SNDPLAY SFX(2)
G.Remain = G.Remain - 1
Ex.Type = 24
Ex.X = I(x%%, y%%).X
Ex.Y = I(x%%, y%%).Y
Exploding = TRUE
END SUB
SUB Draw_Explode_Invader
Ex.Type = Ex.Type - 1
IF Ex.Type = 0 THEN Exploding = FALSE
_PUTIMAGE (Ex.X, Ex.Y)-STEP(15, 7), Layer(3), Layer(1), (264, 1)-STEP(15, 7)
END SUB
SUB Draw_Impacts
FOR i%% = 1 TO Hit_Count
IF Hits(i%%).Time >= 2 THEN
_PUTIMAGE (Hits(i%%).X, Hits(i%%).Y)-STEP(5, 7), Layer(3), Layer(7), (270, 21)-STEP(5, 7)
ELSE
_PUTIMAGE (Hits(i%%).X, Hits(i%%).Y)-STEP(5, 7), Layer(3), Layer(7), (277, 21)-STEP(5, 7)
END IF
NEXT i%%
_CLEARCOLOR _RGB32(1), Layer(7)
END SUB
SUB Draw_Impact_Player
IF P.Hit_Time > 1 THEN
_PUTIMAGE (P.Hit_X, P.Hit_Y)-STEP(5, 7), Layer(3), Layer(7), (270, 21)-STEP(5, 7)
ELSE
_PUTIMAGE (P.Hit_X, P.Hit_Y)-STEP(5, 7), Layer(3), Layer(7), (277, 21)-STEP(5, 7)
END IF
END SUB
SUB Draw_Invader_Shot
STATIC Frame AS _BYTE, FC AS _BYTE
FOR i%% = 1 TO 15
SELECT CASE Shots(i%%).Type
CASE 0 'no shot
CASE 1
_PUTIMAGE (Shots(i%%).X, Shots(i%%).Y)-STEP(2, 7), Layer(3), Layer(1), (210 + 5 * Frame, 21)-STEP(2, 7)
CASE 2
_PUTIMAGE (Shots(i%%).X, Shots(i%%).Y)-STEP(2, 7), Layer(3), Layer(1), (230 + 5 * Frame, 21)-STEP(2, 7)
CASE 3
_PUTIMAGE (Shots(i%%).X, Shots(i%%).Y)-STEP(2, 7), Layer(3), Layer(1), (250 + 5 * Frame, 21)-STEP(2, 7)
CASE 6
_PUTIMAGE (Shots(i%%).X, Shots(i%%).Y)-STEP(2, 7), Layer(3), Layer(1), (250 + 15 * Frame, 21)-STEP(2, 7)
END SELECT
NEXT i%%
FC = FC + 1
IF FC = 7 THEN Frame = Frame + 1: FC = 0
IF Frame = 4 THEN Frame = 0
END SUB
SUB Draw_Player
_PUTIMAGE (P.X, P.Y)-STEP(15, 7), Layer(3), Layer(1), (210, 49)-STEP(15, 7)
END SUB
SUB Draw_Player_Shot
_PUTIMAGE (P.Shot_X, P.Shot_Y)-STEP(2, 7), Layer(3), Layer(1), (250, 21)-STEP(2, 7)
END SUB
FUNCTION Collide_Invader_Shot%% (id%%)
IF _SOURCE <> Layer(7) THEN _SOURCE Layer(7)
IF _RED32(POINT(Shots(id%%).X, Shots(id%%).Y + (3 + (INT(RND * 6) - 3)))) > 1 THEN Result%% = TRUE
Collide_Invader_Shot = Result%%
END FUNCTION
FUNCTION Collide_Player_Shot%%
IF _SOURCE <> Layer(7) THEN _SOURCE Layer(7) 'check for shield impact
IF _RED32(POINT(P.Shot_X, P.Shot_Y)) > 1 THEN Result%% = 1
_SOURCE Layer(8) 'then check for invader hit
IF _RED32(POINT(P.Shot_X, P.Shot_Y)) > 0 OR _RED32(POINT(P.Shot_X, P.Shot_Y + 1)) > 0 THEN 'see which invader was hit
FOR y%% = 0 TO 4
FOR x%% = 0 TO 10
IF P.Shot_X >= I(x%%, y%%).X AND P.Shot_X <= I(x%%, y%%).X + 16 AND P.Shot_Y >= I(x%%, y%%).Y AND P.Shot_Y <= I(x%%, y%%).Y + 8 THEN
'found invader being hit
Hit_Invader x%%, y%%
y%% = 5
x%% = 11
Result%% = TRUE
END IF
NEXT x%%, y%%
'UFO being hit?
IF P.Shot_X >= UFO.X AND P.Shot_X <= UFO.X + 16 AND P.Shot_Y >= UFO.Y AND P.Shot_Y <= UFO.Y + 8 THEN
_SNDPLAY SFX(2)
Ex.Type = 24
Ex.X = UFO.X
Ex.Y = UFO.Y
Exploding = TRUE
Result%% = TRUE
G.Score1 = G.Score1 + 100
_SNDSTOP SFX(8): _SNDSTOP SFX(9)
G.UFO = FALSE
END IF
END IF
Collide_Player_Shot = Result%%
END FUNCTION
SUB Hit_Invader (X%%, Y%%)
STATIC Speedup AS _BYTE
SELECT CASE I(X%%, Y%%).Type
CASE 1, 2
G.Score1 = G.Score1 + 10
CASE 3, 4
G.Score1 = G.Score1 + 20
CASE 5
G.Score1 = G.Score1 + 30
END SELECT
Explode_Invader X%%, Y%%
I(X%%, Y%%).Type = 0
Speedup = Speedup + 1
IF Speedup = 2 THEN Speedup = 0: G.Speed = G.Speed - 1
END SUB
SUB Age_Impacts
FOR i%% = 1 TO Hit_Count
Hits(i%%).Time = Hits(i%%).Time - 1
IF Hits(i%%).Time = 0 THEN
Hits(i%%).Time = 0
Hits(i%%).Y = 0
FOR z%% = i%% TO Hit_Count
SWAP Hits(z%%), Hits(z%% + 1)
NEXT z%%
Hit_Count = Hit_Count - 1
END IF
NEXT i%%
END SUB
SUB Age_Impact_Player
IF P.Hit_Time THEN 'if the player has an impact out there.
P.Hit_Time = P.Hit_Time - 1
END IF
END SUB
SUB Flip_Frame
G.Frame = NOT G.Frame
END SUB
SUB ClearLayer (L&)
old& = _DEST
_DEST L&
CLS ' ,0
_DEST old&
END SUB
SUB ClearLayerTrans (L&)
old& = _DEST
_DEST L&
CLS , 0
_DEST old&
END SUB
SUB Play_BGS
STATIC current_sound AS _BYTE
SELECT CASE current_sound
CASE 0
_SNDPLAY SFX(4)
CASE 1
_SNDPLAY SFX(5)
CASE 2
_SNDPLAY SFX(6)
CASE 3
_SNDPLAY SFX(7)
current_sound = -1
END SELECT
current_sound = current_sound + 1
END SUB
SUB STOP_ALL_SNDs
FOR i%% = 0 TO 9
_SNDSTOP SFX(i%%)
NEXT i%%
END SUB
SUB MFI_Loader (FN$)
DIM Size(128) AS LONG, FOffset(128) AS LONG
OPEN FN$ FOR BINARY AS #1
GET #1, , c~%% 'retrieve number of files
FOR I~%% = 1 TO c~%%
GET #1, , FOffset(I~%%)
GET #1, , Size(I~%%)
FOffset&(I~%%) = FOffset&(I~%%) + 1
NEXT I~%%
Layer(2) = LoadGFX(FOffset(1), Size(1)) 'invaders
Layer(3) = LoadGFX(FOffset(2), Size(2)) 'spaceinvaders(sprites)
Layer(4) = LoadGFX(FOffset(3), Size(3)) 'console control board
Layer(5) = LoadGFX(FOffset(4), Size(4)) 'cabnet decal
SFX(1) = LoadSFX(FOffset(5), Size(5)) '_SNDOPEN("SI_shoot.wav")
SFX(2) = LoadSFX(FOffset(6), Size(6)) '_SNDOPEN("SI_invaderkilled.wav")
SFX(3) = LoadSFX(FOffset(7), Size(7)) '_SNDOPEN("SI_Explode.wav")
SFX(4) = LoadSFX(FOffset(8), Size(8)) '_SNDOPEN("SI_fastinvader1.wav")
SFX(5) = LoadSFX(FOffset(9), Size(9)) '_SNDOPEN("SI_fastinvader2.wav")
SFX(6) = LoadSFX(FOffset(10), Size(10)) '_SNDOPEN("SI_fastinvader3.wav")
SFX(7) = LoadSFX(FOffset(11), Size(11)) '_SNDOPEN("SI_fastinvader4.wav")
SFX(8) = LoadSFX(FOffset(12), Size(12)) '_SNDOPEN("SI_ufo_highpitch.wav")
SFX(9) = LoadSFX(FOffset(13), Size(13)) '_SNDOPEN("SI_ufo_lowpitch.wav")
CLOSE #1
IF _FILEEXISTS("temp.dat") THEN KILL "temp.dat"
END SUB
FUNCTION LoadGFX& (Foff&, Size&)
IF _FILEEXISTS("temp.dat") THEN KILL "temp.dat"
OPEN "temp.dat" FOR BINARY AS #3
dat$ = SPACE$(Size&)
GET #1, Foff&, dat$
PUT #3, , dat$
CLOSE #3
LoadGFX& = _LOADIMAGE("temp.dat", 32)
END FUNCTION
FUNCTION LoadFFX& (Foff&, Size&, Fize%%)
IF _FILEEXISTS("temp.dat") THEN KILL "temp.dat"
OPEN "temp.dat" FOR BINARY AS #3
dat$ = SPACE$(Size&)
GET #1, Foff&, dat$
PUT #3, , dat$
CLOSE #3
LoadFFX& = _LOADFONT("temp.dat", Fize%%, "monospace")
END FUNCTION
FUNCTION LoadSFX& (Foff&, Size&)
IF _FILEEXISTS("temp.dat") THEN KILL "temp.dat"
OPEN "temp.dat" FOR BINARY AS #3
dat$ = SPACE$(Size&)
GET #1, Foff&, dat$
PUT #3, , dat$
CLOSE #3
LoadSFX& = _SNDOPEN("temp.dat")
END FUNCTION
|
|
|
|
| Long Date Function |
|
Posted by: AtomicSlaughter - 05-21-2022, 09:20 PM - Forum: Utilities
- Replies (2)
|
|
Code: (Select All) Function lDate$
p$ = "th"
If Val(Mid$(Date$, 4, 2)) <= 9 Then
day$ = Right$(Mid$(Date$, 4, 2), 1)
Else
day$ = Mid$(Date$, 4, 2)
End If
If Val(Mid$(Date$, 4, 2)) = 1 Or Val(Mid$(Date$, 4, 2)) = 21 Or Val(Mid$(Date$, 4, 2)) = 31 Then p$ = "st"
If Val(Mid$(Date$, 4, 2)) = 2 Or Val(Mid$(Date$, 4, 2)) = 22 Then p$ = "nd"
If Val(Mid$(Date$, 4, 2)) = 3 Or Val(Mid$(Date$, 4, 2)) = 23 Then p$ = "rd"
Select Case Val(Mid$(Date$, 1, 2))
Case 1: Month$ = "January"
Case 2: Month$ = "February"
Case 3: Month$ = "March"
Case 4: Month$ = "April"
Case 5: Month$ = "May"
Case 6: Month$ = "June"
Case 7: Month$ = "July"
Case 8: Month$ = "August"
Case 9: Month$ = "September"
Case 10: Month$ = "October"
Case 11: Month$ = "November"
Case 12: Month$ = "December"
End Select
lDate = day$ + p$ + " " + Month$ + " " + Mid$(Date$, 7, 4)
End Function
|
|
|
|
| What do you like to use for adding commas to numerical output? |
|
Posted by: Pete - 05-21-2022, 08:55 PM - Forum: General Discussion
- Replies (1)
|
 |
I've never used PRINT USING in my programs, so I usually code something like this demo...
Code: (Select All) DIM a AS _INTEGER64
DO
INPUT a
a$ = LTRIM$(STR$(ABS(a)))
j = LEN(a$) MOD 3: IF j = 0 THEN j = 3
DO UNTIL j >= LEN(a$)
a$ = MID$(a$, 1, j) + "," + MID$(a$, j + 1)
j = j + 4
LOOP
IF a < 0 THEN a$ = "-" + a$
PRINT a$ ' Output with commas.
LOOP
Pete
|
|
|
|
| INIEditor |
|
Posted by: AtomicSlaughter - 05-21-2022, 08:40 PM - Forum: Utilities
- No Replies
|
|
Code: (Select All) Type Sections
lineNum As Integer
section As String
End Type
Sub LoadINIFile (FileName As String, iniData() As String, iniSections() As Sections)
ReDim As String iniData(0)
ReDim As Sections iniSections(0)
If _FileExists(FileName) Then
file = FreeFile
Open FileName For Binary As #file
If LOF(file) = 0 Then Exit Sub
Do
Line Input #file, iniData(UBound(iniData))
If InStr(iniData(UBound(iniData)), "[") > 0 Then
iniSections(UBound(iniSections)).section = iniData(UBound(iniData))
iniSections(UBound(iniSections)).lineNum = x
ReDim _Preserve As Sections iniSections(UBound(iniSections) + 1)
End If
ReDim _Preserve iniData(UBound(iniData) + 1)
x = x + 1
Loop Until EOF(file)
Close
End If
iniSections(UBound(iniSections)).section = "End of File"
iniSections(UBound(iniSections)).lineNum = x
End Sub
Sub CheckSection (sec() As Sections, check As String, out1 As Single, out2 As Single, Ret As String)
For i = 0 To UBound(sec)
If LCase$(sec(i).section) = "[" + LCase$(check) + "]" Then
out1 = sec(i).lineNum + 1
out2 = sec(i + 1).lineNum - 1
Print out1, out2
Exit Sub
End If
Next
Ret = "New Section"
End Sub
Function ReadINI$ (FileName As String, Section As String, INIKey As String)
Dim sec(0) As Sections: Dim ini(0) As String
Dim As Single start, finish
LoadINIFile "Config.ini", ini(), sec()
If Section <> "" Then
CheckSection sec(), Section, start, finish, ret$
For i = start To finish
If Left$(LCase$(ini(i)), InStr(ini(i), "=") - 1) = LCase$(INIKey) Then
ReadINI = Right$(ini(i), (Len(ini(i)) - InStr(ini(i), "=")))
End If
Next
Else
Do
If Left$(LCase$(ini(i)), InStr(ini(i), "=") - 1) = LCase$(INIKey) Then
ReadINI = Right$(ini(i), (Len(ini(i)) - InStr(ini(i), "=")))
End If
i = i + 1
Loop Until ini(i) = ""
End If
End Function
Sub DelINI (FileName As String, Section As String, INIKey As String)
Dim sec(0) As Sections: Dim ini(0) As String
Dim As Single start, finish
LoadINIFile "Config.ini", ini(), sec()
If Section <> "" Then
CheckSection sec(), Section, start, finish, ret$
For i = start To finish
If Left$(LCase$(ini(i)), InStr(ini(i), "=") - 1) = LCase$(INIKey) Then
ReDim temp(UBound(ini) - 1) As String
For a = 0 To (i - 1)
temp(a) = ini(a)
Next
For a = i To UBound(temp)
temp(a) = ini(a + 1)
Next
End If
Next
Else
Do
If Left$(LCase$(ini(i)), InStr(ini(i), "=") - 1) = LCase$(INIKey) Then
ReDim temp(UBound(ini) - 1) As String
For a = 0 To i - 1
temp(a) = ini(a)
Next
For a = x To UBound(ini)
temp(x) = ini(x + 1)
Next
End If
i = i + 1
Loop Until ini(i) = ""
End If
Do
If temp(UBound(temp)) = "" Then ReDim _Preserve temp(UBound(temp) - 1)
Loop Until temp(UBound(temp)) <> ""
f = FreeFile
Open FileName For Output As #f
For i = 0 To UBound(temp)
Print #f, temp(i)
Next
Close
End Sub
Sub DelSec (FileName As String, Section As String)
Dim sec(0) As Sections: Dim ini(0) As String
Dim As Single start, finish
LoadINIFile "Config.ini", ini(), sec()
CheckSection sec(), Section, start, finish, ret$
Print start, finish
ReDim Temp(UBound(ini)) As String
For i = 0 To start
Temp(i) = ini(i)
Next
For i = finish To UBound(ini)
Temp(i - finish) = ini(i)
Next
Do
If Temp(UBound(Temp)) = "" Then ReDim _Preserve Temp(UBound(Temp) - 1)
Loop Until Temp(UBound(Temp)) <> ""
f = FreeFile
Open FileName For Output As #f
For i = 0 To UBound(Temp)
Print #f, Temp(i)
Next
Close
End Sub
Sub AddINI (FileName As String, Section As String, INIKey As String, INIData As String)
Dim sec(0) As Sections: Dim ini(0) As String
Dim As Single start, finish
LoadINIFile "Config.ini", ini(), sec()
CheckSection sec(), Section, start, finish, ret$
ReDim temp(UBound(ini) + 1) As String
If ret$ = "New Section" Then
ReDim temp(UBound(ini) + 3)
temp(0) = "[" + Section + "]"
temp(1) = INIKey + "=" + INIData
temp(2) = ""
For i = 3 To UBound(ini)
temp(i) = ini(i - 3)
Next
Else
If Section <> "" Then
For i = 0 To start
'Print ini(start): Sleep
temp(i) = ini(i)
Next
temp(start) = INIKey + "=" + INIData
For i = start + 1 To UBound(ini)
temp(i) = ini(i - 1)
Next
Else
temp(0) = INIKey + "=" + INIData
For i = 1 To UBound(ini)
temp(i) = ini(i - 1)
Next
End If
End If
Do
If temp(UBound(temp)) = "" Then ReDim _Preserve temp(UBound(temp) - 1)
Loop Until temp(UBound(temp)) <> ""
f = FreeFile
Open FileName For Output As #f
For i = 0 To UBound(temp)
Print #f, temp(i)
'Print temp(i): _Delay 1
Next
Close
End Sub
|
|
|
|
| Adding more Logical Operators |
|
Posted by: Dimster - 05-21-2022, 08:05 PM - Forum: General Discussion
- Replies (15)
|
 |
Would it be difficult to add more logical operators to the QB64 language?
I often come across math formulas which use some hieroglyics that I'm constantly looking us to decipher. When it comes to logical operators I see them so often I sometimes wonder if they may be useful in QB64. For example, a couple of them are:
V means the logical OR, so it would be "A V B" v's "A OR B". The inverted V means AND
A pyramid of dots . means "THEREFORE", so "HM = M and S = M . S = HM"
. . . .
(sorry, my depiction of a pyramid of dots leaves a lot to be desired)
And the inverse of the pyramid of dots means "Because" or "Since"
There are more, like << which means "much less than" and >> meaning "much more than" but I find personally I don't need those very much. The V and inverted V (or rotated 180 degree V) are just a short form of OR and AND so perhaps not as revolutionary for QB64, but the pyramid of dots may help with using the logical operator of IMP. (IMP being my pet peeve)
Is it too difficult to add more Logical Operators to QB64 math arsenal?
|
|
|
|
| A quick lesson on _DEFLATE and _INFLATE |
|
Posted by: SMcNeill - 05-20-2022, 01:05 AM - Forum: Learning Resources and Archives
- No Replies
|
 |
Code: (Select All) _CONTROLCHR OFF
_TITLE "Quick _DEFLATE Demo"
PRINT "First, let me give you a little story:"
PRINT
story$ = "The Boy Who Cried Wolf"
story$ = story$ + CHR$(13)
story$ = story$ + "A shepherd boy, who tended his flock not far from a village, used to amuse himself at times in crying out 'Wolf! Wolf!' Twice or thrice his trick succeeded; the whole village came running out to his assistance, when all the return they got was to be laughed at for their pains."
story$ = story$ + CHR$(13)
story$ = story$ + "At last one day the wolf came indeed. The boy cried out in earnest. His neighbors, supposing him to be at his old sport, paid no heed to his cries, and the wolf devoured the sheep. So the boy learned, when it was too late, that liars are not believed even when they tell the truth."
PRINT story$
PRINT
PRINT "Now, our story above is"; LEN(story$); "bytes long."
PRINT
COLOR 15
PRINT "But let's _DEFLATE it!"
deflated_story$ = _DEFLATE$(story$)
PRINT
PRINT deflated_story$
PRINT
PRINT "Doesn't look like much, now does it? The only thing is, the deflated story is now only"; LEN(deflated_story$); "bytes long!"
SLEEP
CLS
PRINT "Now, in this case, the original was"; LEN(story$); "bytes"
PRINT "And the compressed version was"; LEN(deflated_story$); "bytes"
PRINT
PRINT "So there's not a ton of compression in this limited example, as our original data set was rather small to begin with. But let's see what happens when we have a larger dataset to work with."
PRINT
FOR i = 1 TO 10
story$ = story$ + CHR$(13) + story$
NEXT
PRINT "If you check the source code, you'll see that I've basically doubled the size of our story 10 times."
PRINT "It's now:"; LEN(story$); "bytes in size."
PRINT
COLOR 7
deflated_story$ = _DEFLATE$(story$)
PRINT "And now when I deflate this massive file, it reduces down to"; LEN(deflated_story$); "bytes in size!"
PRINT
PRINT
PRINT "From about 600,000 bytes being used in memory to about 4,000 bytes to store the same data. That's less than 1/100th of the original size here!!"
PRINT
PRINT "So, if you wanted to send those 600,000 bytes across the internet, how would you rather send them? 600,00 bytes uncompressed, or 4,000 bytes compressed, and then let the end user uncompress them?? ;)"
SLEEP
CLS
COLOR 15
PRINT "Images take up a ton of space in memory. A 1000x1000, 32-bit screen, uses 4,000,000 bytes of memory/storage."
PRINT "Yet, how many times have you ever downloaded a picture that's that large?"
PRINT
PRINT "Most images use _DEFLATE style compression on that image data, to store and transfer that image information."
PRINT "And then when you load it into memory, it uses _INFLATE to restore the image back to its original size and structure."
PRINT
PRINT "_DEFLATE compresses a string of data. _INFLATE decompresses it."
PRINT "And that's about all there is to it. ;)"
Note that I didn't try to wordwrap any of these lines or such, as this is a truly quick little demo, but I think it highlights and explains fairly well what _DEFLATE and _INFLATE do for us. If anyone has any questions, feel free to ask them and I'll do my best to expand as wanted. 
|
|
|
|
| Smile - RotoZoom Example |
|
Posted by: SierraKen - 05-19-2022, 08:59 PM - Forum: Programs
- Replies (5)
|
 |
![[Image: Smile-Roto-Zoom-Example-by-Sierra-Ken.jpg]](https://i.ibb.co/6Y0LGnL/Smile-Roto-Zoom-Example-by-Sierra-Ken.jpg)
I think B+ or someone else made this once before, but I thought I would give it a try. It's a smiley face that turns around and around while bouncing off the sides. He also zooms larger and smaller. It's a really good example for the RotoZoom sub, the Fillcircle sub, and for anyone that wants to learn how to make animation with Copyimage using RotoZoom.
Code: (Select All) 'Smile - RotoZoom Example by SierraKen
'May 19, 2022
Dim image As Long
Screen _NewImage(200, 200, 32)
'Head
cx = 100: cy = 100: r = 95
c = _RGB32(255, 255, 0)
fillCircle cx, cy, r, c
'Right Eye
cx = 50: cy = 75: r = 15
c = _RGB32(0, 0, 0)
fillCircle cx, cy, r, c
'Left Eye
cx = 150: cy = 75: r = 15
c = _RGB32(0, 0, 0)
fillCircle cx, cy, r, c
'Mouth
Circle (100, 125), 70, _RGB32(0, 0, 0), _Pi, 2 * _Pi, .5
Line (30, 125)-(170, 125), _RGB32(0, 0, 0)
Paint (100, 140), _RGB32(0, 0, 0)
dirx = 1
diry = 1
x = 400
y = 400
scale = 1
_Title "Smile - RotoZoom Example by SierraKen"
image& = _CopyImage(0)
Cls
Screen _NewImage(800, 800, 32)
Do
_Limit 30
rotation = rotation + 1
If rotation > 359 Then rotation = 0
x = x + dirx
y = y + diry
If x > 700 Then dirx = -1 * Rnd * 3
If x < 100 Then dirx = 1 * Rnd * 3
If y > 700 Then diry = -1 * Rnd * 3
If y < 100 Then diry = 1 * Rnd * 3
If shrink = 0 Then scale = scale + .01
If scale > 5 Then shrink = 1
If shrink = 1 Then scale = scale - .01
If scale < .5 Then shrink = 0
RotoZoom x, y, image&, scale, rotation
_Display
Line (0, 0)-(800, 800), _RGB32(0, 0, 0, 10), BF
Loop Until InKey$ = Chr$(27)
'from Steve Gold standard
Sub fillCircle (CX As Integer, CY As Integer, R As Integer, C As _Unsigned Long)
Dim Radius As Integer, RadiusError As Integer
Dim X As Integer, Y As Integer
Radius = Abs(R): RadiusError = -Radius: X = Radius: Y = 0
If Radius = 0 Then PSet (CX, CY), C: Exit Sub
Line (CX - X, CY)-(CX + X, CY), C, BF
While X > Y
RadiusError = RadiusError + Y * 2 + 1
If RadiusError >= 0 Then
If X <> Y + 1 Then
Line (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
Line (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
End If
X = X - 1
RadiusError = RadiusError - X * 2
End If
Y = Y + 1
Line (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
Line (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
Wend
End Sub
Sub RotoZoom (X As Long, Y As Long, image&, 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
|
|
|
|
|
