+- QB64 Phoenix Edition (https://qb64phoenix.com/forum)
+-- Forum: QB64 Rising (https://qb64phoenix.com/forum/forumdisplay.php?fid=1)
+--- Forum: Code and Stuff (https://qb64phoenix.com/forum/forumdisplay.php?fid=3)
+---- Forum: Works in Progress (https://qb64phoenix.com/forum/forumdisplay.php?fid=9)
+---- Thread: Combine Charlies Ghosts with 40 LOC Game (/showthread.php?tid=2138)
Combine Charlies Ghosts with 40 LOC Game - bplus - 11-02-2023
Here is Charlies cute scrolly ghosts from BAM:
https://basicanywheremachine.neocities.org/sample_programs/Scroly%20Ghosts.prod.bas
I modefied this ghost maker into 3subs for drawing ghosts
Code: (Select All)
ghostWidth% = 14
ghostHeight% = 14
ghostBod$ = _
".....XXXX....." + _
"...XXXXXXXX..." + _
"..XXXXXXXXXX.." + _
".XXXXXXXXXXXX." + _
".XXXXXXXXXXXX." + _
".XXXXXXXXXXXX." + _
"XXXXXXXXXXXXXX" + _
"XXXXXXXXXXXXXX" + _
"XXXXXXXXXXXXXX" + _
"XXXXXXXXXXXXXX" + _
"XXXXXXXXXXXXXX" + _
"XXXXXXXXXXXXXX" + _
"XX.XXX..XXX.XX" + _
"X...XX..XX...X"
ghostEyeballLeft$ = _
".............." + _
".............." + _
".............." + _
"..XX....XX...." + _
".XXXX..XXXX..." + _
"...XX....XX..." + _
"...XX....XX..." + _
"..XX....XX...." + STRING$(6*14,".")
ghostEyeballRight$ = _
".............." + _
".............." + _
".............." + _
"....XX....XX.." + _
"...XXXX..XXXX." + _
"...XX....XX..." + _
"...XX....XX..." + _
"....XX....XX.." + STRING$(6*14,".")
ghostIrisLeft$ = _
".............." + _
".............." + _
".............." + _
".............." + _
".............." + _
".XX....XX....." + _
".XX....XX....." + STRING$(7*14,".")
ghostIrisRight$ = _
".............." + _
".............." + _
".............." + _
".............." + _
".............." + _
".....XX....XX." + _
".....XX....XX." + STRING$(7*14,".")
'??? ??? Main Program ??? ???
SCREEN _NEWIMAGE(300,100,12)
_ALERT("Click/touch the screen to pause the program.")
loopCount% = 1
➔another_ghost:
IF loopCount% MOD 3 = 0 THEN _
?PrintGhost( _
INT(RND*(100)), _
INT(RND*(_HEIGHT-ghostHeight%)) )
_DELAY 0.025
IF _MOUSEBUTTON THEN WHILE _MOUSEBUTTON : WEND
SCROLL 1,0,FALSE
loopCount% += 1
GOTO ➔another_ghost
END
'??? Subroutines ???
SUB ?PrintGhost(x%,y%)
bodyColor% = INT(RND*14)+1
eyeDirection% = INT(RND*2)
ghostEyeball$ = IFF(eyeDirection%,ghostEyeballLeft$,ghostEyeballRight$)
ghostIris$ = IFF(eyeDirection%,ghostIrisLeft$,ghostIrisRight$)
irisColor% = IFF(INT(RND*2), 1, 6)
FOR thisY = 1 TO ghostHeight%
FOR thisX = 1 TO ghostWidth%
IF MID$(ghostBod$, (thisY-1) * ghostWidth% + thisX, 1) <> "." THEN PSET (x% + thisX - 1, y% + thisY - 1), bodyColor%
IF MID$(ghostEyeball$, (thisY-1) * ghostWidth% + thisX, 1) <> "." THEN PSET (x% + thisX - 1, y% + thisY - 1), 15
IF MID$(ghostIris$, (thisY-1) * ghostWidth% + thisX, 1) <> "." THEN PSET (x% + thisX - 1, y% + thisY - 1), irisColor%
NEXT thisX
NEXT thisY
END SUB40 (with double parking) LOC QB64 Game:
Code: (Select All)
_Title "40 Line Game Revised" 'b+ mod of some game 2022-03-18 new way to score
Dim As Long sw, sh, goalR, hx, hy, i, hits, score, stars, nEnemies
sw = 640: sh = 480: nEnemies = 35: goalR = -1: hx = 10: hy = 400 ' hero stuff (you)
Dim EX(nEnemies), EY(nEnemies), EC(nEnemies) As _Unsigned Long ' enemy stuff
Screen _NewImage(sw, sh, 32): stars = _NewImage(sw, sh, 32)
For i = 1 To 1000
PSet (Int(Rnd * sw), Int(Rnd * sh)), _RGB32(55 + Rnd * 200, 55 + Rnd * 200, 55 + Rnd * 200)
Next
_PutImage , 0, stars
For i = 1 To nEnemies
EX(i) = Int(Rnd * (sw - 20) + 10): EY(i) = -2 * sh * Rnd + sh: EC(i) = _RGB32(55 + Rnd * 200, 55 + Rnd * 200, 55 + Rnd * 200)
Next
Do
Cls
_PutImage , stars, 0
Print "Hits:"; hits, "Score:"; score
Line (hx - 10, hy - 10)-Step(20, 20), &HFFFFFF00, BF
If hx >= sw - 13 And goalR Then score = score + 100: goalR = 0
If hx <= 13 And goalR = 0 Then score = score + 100: goalR = -1
For i = 1 To nEnemies ' the enemies
Circle (EX(i), EY(i)), 10, EC(i)
If Sqr((EX(i) - hx) ^ 2 + (EY(i) - hy) ^ 2) < 20 Then 'collision
Sound 2000, 3: hits = hits + 1
EX(i) = Int(Rnd * 600 + 20): EY(i) = -_Height * Rnd ' move that bad boy!
If hits = 10 Then Print "Too many hits, goodbye!": _Delay 10
End If
EY(i) = EY(i) + Int(Rnd * 5)
If EY(i) > 470 Then EX(i) = Int(Rnd * 600 + 20): EY(i) = -sh * Rnd
Next
If _KeyDown(20480) Then hy = hy + 3
If _KeyDown(18432) Then hy = hy - 3
If _KeyDown(19200) Then hx = hx - 3
If _KeyDown(19712) Then hx = hx + 3
If hx < 10 Then hx = 10
If hx > sw - 10 Then hx = sw - 10
If hy < 10 Then hy = 10
If hy > sh - 10 Then hy = sh - 10
_Display
_Limit 60
Loop Until _KeyDown(27)I now have this:
Code: (Select All)
Option _Explicit
_Title "Charlies Ghost plus 40 LOC Game" ' bplus confab mod 2023-11-02
'_Title "40 Line Game Revised" 'b+ mod of some game 2022-03-18 new way to score
Dim Shared As Long SW, SH ' screen width and height
SW = 640: SH = 640
'for setup and drawing ghosts, run SetupGhost once
Dim Shared gWidth%, gHeight%, gBod$, ghostEyeballLeft$, ghostEyeballRight$, ghostIrisLeft$, ghostIrisRight$
SetupGhost
' for creating new ghosts x, y, color, eye direction, eye color
Dim Shared As Long NGhosts
NGhosts = 15
Dim Shared As Long GX(1 To NGhosts), GY(1 To NGhosts), GED(1 To NGhosts), GDIR(1 To NGhosts)
Dim Shared As _Unsigned Long GBC(1 To NGhosts), GIC(1 To NGhosts)
Dim As Long goalR, hx, hy, i, hits, score, stars
Dim rr
goalR = -1
hx = SW / 2 - 14: hy = 28 ' hero stuff (you)
For i = 1 To NGhosts
NewGhost (i), 0
Next
Screen _NewImage(SW, SH, 32): stars = _NewImage(SW, SH, 32)
Randomize Timer
' test debug drawing ghosts , way too small double width and triple height
'For i = 1 To NGhosts
' Cls
' DrawGhost 320 - 14, 240 - 28, GBC(i), GED(i), GIC(i) ' ghosts are 28 x 56
' Sleep
'Next
'End
'setup stars ?
For i = 1 To 1000
PSet (Int(Rnd * SW), Int(Rnd * SH)), _RGB32(55 + Rnd * 200, 55 + Rnd * 200, 55 + Rnd * 200)
Next
_PutImage , 0, stars
Do
Cls
_PutImage , stars, 0
Print "Hits:"; hits, "Score:"; score
Line (hx - 14, hy - 26)-Step(28, 52), &HFFFFAA77, BF
'door
Line (hx - 10, hy - 22)-(hx - 2, hy - 2), &HFFCC6633, BF
Line (hx + 2, hy - 22)-(hx + 10, hy - 2), &HFFCC6633, BF
Line (hx - 10, hy + 2)-(hx + 10, hy + 22), &HFFCC6633, BF
For rr = 0 To 2 Step .25
Circle (hx + 12, hy), rr, _RGB32(255 - rr * 125, 255 - rr * 125, 255 - rr * 125)
Next
'score the door
If hy >= SH - 28 And goalR Then score = score + 100: goalR = 0
If hy <= 28 And goalR = 0 Then score = score + 100: goalR = -1
For i = 1 To NGhosts ' the enemies
If Rnd < .025 Then
If GED(i) Then GED(i) = 0 Else GED(i) = 1
End If
DrawGhost GX(i) - 14, GY(i) - 26, GBC(i), GED(i), GIC(i)
If Abs(GX(i) - hx) < 28 And Abs(GY(i) - hy) < 56 Then 'collision
Sound 38, 5, , , 2
hits = hits + 1
NewGhost i, 1 ' move that bad boy!
If hits = 10 Then
Print "Too many hits, goodbye!"
_Display
_Delay 10
End
End If
End If
GX(i) = GX(i) + GDIR(i) * Int(Rnd * 5)
If (GX(i) > SW + 14 And GDIR(i) > 0) Or (GX(i) < -14 And GDIR(i) < 0) Then
NewGhost i, 1
End If
Next
If _KeyDown(20480) Then hy = hy + 3
If _KeyDown(18432) Then hy = hy - 3
If _KeyDown(19200) Then hx = hx - 3
If _KeyDown(19712) Then hx = hx + 3
If hx < 14 Then hx = 14
If hx > SW - 14 Then hx = SW - 14
If hy < 26 Then hy = 26
If hy > SH - 26 Then hy = SH - 26
_Display
_Limit 60
Loop Until _KeyDown(27)
Sub NewGhost (i As Long, beyondScreenTF As Long)
' a ghost needs a starting place leave safe zone on either edge
If Rnd < .5 Then GDIR(i) = -1 Else GDIR(i) = 1
If beyondScreenTF Then
If GDIR(i) > 0 Then
GX(i) = -SW * Rnd - 14
Else
GX(i) = SW + SW * Rnd + 14
End If
Else
GX(i) = SW * Rnd
End If
GY(i) = 56 + 28 + Int((SH - 3 * 56) * Rnd)
' a ghost needs a body color
GBC(i) = _RGB32(155 + Rnd * 100, 155 + Rnd * 100, 155 + Rnd * 100, 80)
' a ghost needs an eyedirection
GED(i) = Int(Rnd * 2)
' a ghost needs an iris color
If Int(Rnd * 2) Then GIC~&(i) = _RGB32(255, 0, 0) Else GIC~&(i) = _RGB32(0, 0, 255)
End Sub
Sub DrawGhost (x%, y%, ghostBodyC~&, EyeDir%, IrisC~&) ' make ghost 28 x 56
Dim gEyeBall$, gIris$
Dim As Long yy, xx
'gEyeball$ = IFF(EyeDir%,ghostEyeballLeft$,ghostEyeballRight$)
If EyeDir% Then gEyeBall$ = ghostEyeballLeft$ Else gEyeBall$ = ghostEyeballRight$
'gIris$ = IFF(EyeDir%,ghostIrisLeft$,ghostIrisRight$)
If EyeDir% Then gIris$ = ghostIrisLeft$ Else gIris$ = ghostIrisRight$
'irisC~& = IFF(Int(Rnd * 2), 1, 6)
For yy = 1 To gHeight%
For xx = 1 To gWidth%
If Mid$(gBod$, (yy - 1) * gWidth% + xx, 1) <> "." Then
'PSet (x% + XX - 1, y% + YY - 1), bodyC~&
Line (x% + (xx - 1) * 2, y% + (yy - 1) * 4)-Step(1, 3), ghostBodyC~&, BF
End If
If Mid$(gEyeBall$, (yy - 1) * gWidth% + xx, 1) <> "." Then
'PSet (x% + XX - 1, y% + YY - 1), _RGB32(255, 255, 255)
Line (x% + (xx - 1) * 2, y% + (yy - 1) * 3)-Step(1, 2), _RGB32(255, 255, 255), BF
End If
If Mid$(gIris$, (yy - 1) * gWidth% + xx, 1) <> "." Then
'PSet (x% + XX - 1, y% + YY - 1), IrisC~&
Line (x% + (xx - 1) * 2, y% + (yy - 1) * 3)-Step(1, 2), IrisC~&, BF
End If
Next xx
Next yy
End Sub
Sub SetupGhost
' setup shared variables in main, this sub sets the values for them
'dim shared gWidth%, gHeight%, gBod$, ghostEyeballLeft$, ghostEyeballRight$, ghostIrisLeft$, ghostIrisRight$
gWidth% = 14
gHeight% = 14
gBod$ = _
".....XXXX....." + _
"...XXXXXXXX..." + _
"..XXXXXXXXXX.." + _
".XXXXXXXXXXXX." + _
".XXXXXXXXXXXX." + _
".XXXXXXXXXXXX." + _
"XXXXXXXXXXXXXX" + _
"XXXXXXXXXXXXXX" + _
"XXXXXXXXXXXXXX" + _
"XXXXXXXXXXXXXX" + _
"XXXXXXXXXXXXXX" + _
"XXXXXXXXXXXXXX" + _
"XX.XXX..XXX.XX" + _
"X...XX..XX...X"
ghostEyeballLeft$ = _
".............." + _
".............." + _
".............." + _
"..XX....XX...." + _
".XXXX..XXXX..." + _
"...XX....XX..." + _
"...XX....XX..." + _
"..XX....XX...." + STRING$(6*14,".")
ghostEyeballRight$ = _
".............." + _
".............." + _
".............." + _
"....XX....XX.." + _
"...XXXX..XXXX." + _
"...XX....XX..." + _
"...XX....XX..." + _
"....XX....XX.." + STRING$(6*14,".")
ghostIrisLeft$ = _
".............." + _
".............." + _
".............." + _
".............." + _
".............." + _
".XX....XX....." + _
".XX....XX....." + STRING$(7*14,".")
ghostIrisRight$ = _
".............." + _
".............." + _
".............." + _
".............." + _
".............." + _
".....XX....XX." + _
".....XX....XX." + STRING$(7*14,".")
End SubThe object is to go from bottom of screen to top or vice versa without running into a ghost, 100 points for every trek, see how many points you can rack up before 10 hits.
ie you don't want any ghosts knocking on your door! ;-))
RE: Combine Charlies Ghosts with 40 LOC Game - CharlieJV - 11-03-2023
Holy moly that's good stuff !
RE: Combine Charlies Ghosts with 40 LOC Game - CharlieJV - 11-03-2023
The running version of Scroly Ghosts: https://basicanywheremachine.neocities.org/sample_programs/Scroly%20Ghosts.prod.run
RE: Combine Charlies Ghosts with 40 LOC Game - bplus - 11-03-2023
(11-03-2023, 01:26 AM)CharlieJV Wrote: The running version of Scroly Ghosts: https://basicanywheremachine.neocities.org/sample_programs/Scroly%20Ghosts.prod.run
Yes that's my inspriration. Thanks Charlie!
RE: Combine Charlies Ghosts with 40 LOC Game - bplus - 11-04-2023
I created allot of reusable code today for updating this app.
First I liked the IFF things so I made a set for various Types, test and demo code:
Code: (Select All)
_Title "IFFs of a Type" ' bplus handy little functions for toolbox
Randomize Timer
Print IfS$(_Width > _Height, "Landscape", "Portrait")
Print
For i = 1 To 100
test& = IfL&(Rnd < .5, -1, 1) ' this one I might use allot!
Print test&;
If test& = 1 Then one = one + 1 Else NotOne = NotOne + 1
Next
Print: Print "About 50/50 one and not one ? : One ="; one; " and not one ="; NotOne
Print
For i = .0025 To .015 Step .0025 ' not sure how much this will get used
Print i, IfD#(Abs(i) < .01, 0, -1) ' is a number close enough to 0
Next
Print "First 3 = 0 the rest -1 ?"
Function IfS$ (Bool&, tru$, fals$) ' IF Boolean Return True$ else False$
If Bool& Then IfS$ = tru$ Else IfS$ = fals$
End Function
Function IfL& (Bool&, tru&, fals&) ' IF Boolean Return True& else False&
If Bool& Then IfL& = tru& Else IfL& = fals&
End Function
Function IfD# (Bool&, tru#, fals#) ' IF Boolean Return True# else False#
If Bool& Then IfD# = tru# Else IfD# = fals#
End Function
'tested in Charlies ghosts 11/03/2023
Function IfUL~& (Bool&, tru~&, fals~&) ' IF Boolean Return True~& else False~&
If Bool& Then IfUL~& = tru~& Else IfUL~& = fals~&
End FunctionThen I do skys with stars allot so I made some reusable code for that. Drawing a sky background according to light from 0 to 100, 0 to 50 is with stars, 50 and up it gets pretty bright.
Here is test and demo code for that:
Code: (Select All)
Option _Explicit
_Title "MakeSky& function image handle" 'bplus 2023-11-03
Screen _NewImage(800, 600, 32)
Color _RGB32(255, 255, 255), &HFF0000FF
Cls
Print _DefaultColor
'End
Dim sky&, l
For l = 0 To 100 Step 10
Cls
If sky& <> -1 And sky& <> 0 Then _FreeImage sky& ' clear handle
sky& = MakeSky&(l)
_PutImage , sky&, 0
Print "Light:"; l; _DefaultColor ' wth???
_Display
Sleep
Next
Function MakeSky& (light As Long)
' light = 0 to 100
' needs MidInk~&() Function
Dim As _Unsigned Long saveColor, c
Dim As Long i, rtn, saveDest
Dim r, rn, xx, yy, lite
lite = 2 * light
saveDest = _Dest
saveColor = _DefaultColor(saveDest)
rtn = _NewImage(_Width, _Height, 32)
_Dest rtn&
For i = 0 To _Height - 1
c = midInk(.75 * lite + 10, .75 * lite + 5, 35 + .75 * lite, 25 + lite, lite, 55 + lite, i / (_Height - 1))
Line (0, i)-(_Width, i), c
Next
'stars only in low lite
If lite <= 100 Then
For i = 1 To _Width * _Height / 1500
rn = Rnd: xx = Rnd * _Width: yy = Rnd * _Height
If rn < .01 Then
For r = 0 To 2 Step .5
Circle (xx, yy), r, _RGB32(185, 185, 185)
Next
ElseIf rn < .2 Then
Circle (xx, yy), 1, _RGB32(185, 185, 185)
PSet (xx, yy), _RGB32(185, 185, 185)
Else
PSet (xx, yy), _RGB32(185, 185, 185)
End If
Next
End If
_Dest saveDest
Color saveColor
MakeSky& = rtn
End Function
Function midInk~& (r1%, g1%, b1%, r2%, g2%, b2%, fr##)
midInk~& = _RGB32(r1% + (r2% - r1%) * fr##, g1% + (g2% - g1%) * fr##, b1% + (b2% - b1%) * fr##)
End FunctionThen I thought having a drawn door might be handy so I did one for that:
Code: (Select All)
Option _Explicit
_Title "MakeDoor& function image handle" 'bplus 2023-11-03
Screen _NewImage(800, 600, 32)
Dim As Long door, i
door = MakeDoor&
For i = 0 To 50 Step 5
Cls
_PutImage (400 - 100 + i, 300 - 200 + 2 * i)-Step(200 - 2 * i, 400 - 4 * i), door, 0
Sleep
Next
Function MakeDoor& () ' door is width X 3*width
' make huge door and use putimage to shrink into rectangle needed
Dim As Long saveD, rtn, hx, hy, i
Dim rr
saveD = _Dest
rtn = _NewImage(280, 560, 32)
_Dest rtn
hx = 140: hy = 280 'center
Line (hx - 140, hy - 280)-Step(280, 560), &HFFFFAA77, BF
Line (hx - 100, hy - 240)-(hx - 20, hy - 20), &HFFDD8853, BF
For i = 0 To 9
Line (hx - 100 + i, hy - 240 + i)-(hx - 20 - i, hy - 20 - i), &HFF000000 + _RGB32(i * 12, 50), B
Next
Line (hx + 20, hy - 240)-(hx + 100, hy - 20), &HFFDD8853, BF
For i = 0 To 9
Line (hx + 20 + i, hy - 240 + i)-(hx + 100 - i, hy - 20 - i), &HFF000000 + _RGB32(i * 12, 50), B
Next
Line (hx - 100, hy + 20)-(hx + 100, hy + 240), &HFFDD8853, BF
For i = 0 To 9
Line (hx - 100 + i, hy + 20 + i)-(hx + 100 - i, hy + 240 - i), &HFF000000 + _RGB32(i * 12, 50), B
Next
For rr = 0 To 12 Step .25
Circle (hx + 120, hy), rr, _RGB32(255 - rr * 17, 255 - rr * 17, 255 - rr * 17, 100)
Next
MakeDoor& = rtn
_Dest saveD
End Functionso add all that into the app and clean up code a bit and get this:
Code: (Select All)
Option _Explicit
_Title "Charlies Ghost plus 40 LOC Game" ' bplus confab mod 2023-11-02
'_Title "40 Line Game Revised" 'b+ mod of some game 2022-03-18 new way to score
'2023-11-02 posts at PE and Discord GotBasic WIP1
'2023-11-03 add reusable IFFs of a type
'2023-11-03 add MakeSky& ' reusabe sky and stars maker depending on light 0 to 100
'2023-11-03 add MakeDoor& ' nice reusable door image
Dim Shared As Long SW, SH ' screen width and height
SW = 640: SH = 640
'for setup and drawing ghosts, run SetupGhost once
Dim Shared gWidth%, gHeight%, gBod$, ghostEyeballLeft$, ghostEyeballRight$, ghostIrisLeft$, ghostIrisRight$
SetupGhost
' for creating new ghosts x, y, color, eye direction, eye color
Dim Shared As Long NGhosts
NGhosts = 15
Dim Shared As Long GX(1 To NGhosts), GY(1 To NGhosts) ' Ghost position
Dim Shared GED(1 To NGhosts) ' Ghost Eye Direction
Dim Shared GDIR(1 To NGhosts) ' Ghost moving Direction
Dim Shared As _Unsigned Long GBC(1 To NGhosts) ' Ghost Body Color
Dim Shared As _Unsigned Long GIC(1 To NGhosts) ' Ghost Iris (eye) Color
Dim As Long stars, door 'these are images background stars and hero/player door image
Dim As Long goalR, hx, hy, i, hits, score
goalR = -1 ' player target side top or screen or bottom
hx = SW / 2 - 14: hy = 28 ' hero position (you) the door image
For i = 1 To NGhosts
NewGhost (i), 0
Next
Screen _NewImage(SW, SH, 32)
_ScreenMove 300, 60
Randomize Timer
'setup images stars background and player door
stars = MakeSky&(0)
door = MakeDoor&
Do
Cls
_PutImage , stars, 0
Print "Hits:"; hits, "Score:"; score
_PutImage (hx - 14, hy - 28)-Step(28, 56), door, 0
'score the door
If hy >= SH - 28 And goalR Then score = score + 100: goalR = 0
If hy <= 28 And goalR = 0 Then score = score + 100: goalR = -1
For i = 1 To NGhosts ' the enemies
If Rnd < .025 Then
If GED(i) Then GED(i) = 0 Else GED(i) = 1
End If
DrawGhost GX(i) - 14, GY(i) - 26, GBC(i), GED(i), GIC(i)
If Abs(GX(i) - hx) < 28 And Abs(GY(i) - hy) < 56 Then 'collision
Sound 38, 5, , , 2
hits = hits + 1
NewGhost i, 1 ' move that bad boy!
If hits = 10 Then
Print "Too many hits, goodbye!"
_Display
_Delay 10
End
End If
End If
GX(i) = GX(i) + GDIR(i) * Int(Rnd * 5)
If (GX(i) > SW + 14 And GDIR(i) > 0) Or (GX(i) < -14 And GDIR(i) < 0) Then
NewGhost i, 1
End If
Next
If _KeyDown(20480) Then hy = hy + 3
If _KeyDown(18432) Then hy = hy - 3
If _KeyDown(19200) Then hx = hx - 3
If _KeyDown(19712) Then hx = hx + 3
If hx < 14 Then hx = 14
If hx > SW - 14 Then hx = SW - 14
If hy < 28 Then hy = 28
If hy > SH - 28 Then hy = SH - 28
_Display
_Limit 60
Loop Until _KeyDown(27)
Sub NewGhost (i As Long, beyondScreenTF As Long)
' a ghost needs a starting place leave safe zone on either edge
GDIR(i) = IfL&(Rnd < .5, -1, 1)
If beyondScreenTF Then
If GDIR(i) > 0 Then
GX(i) = -SW * Rnd - 14
Else
GX(i) = SW + SW * Rnd + 14
End If
Else
GX(i) = SW * Rnd
End If
GY(i) = 56 + 28 + Int((SH - 3 * 56) * Rnd)
' a ghost needs a body color
GBC(i) = _RGB32(200 + Rnd * 55, 200 + Rnd * 55, 200 + Rnd * 55, 80)
' a ghost needs an eyedirection
GED(i) = Int(Rnd * 2)
' a ghost needs an iris color
GIC~&(i) = IfUL~&(Rnd < .5, _RGB32(255, 0, 0), _RGB32(0, 0, 255))
End Sub
Sub DrawGhost (x%, y%, ghostBodyC~&, EyeDir&, IrisC~&) ' make ghost 28 x 56
Dim gEyeBall$, gIris$
Dim As Long yy, xx
gEyeBall$ = IfS$(EyeDir&, ghostEyeballLeft$, ghostEyeballRight$)
gIris$ = IfS$(EyeDir&, ghostIrisLeft$, ghostIrisRight$)
For yy = 1 To gHeight%
For xx = 1 To gWidth%
If Mid$(gBod$, (yy - 1) * gWidth% + xx, 1) <> "." Then
Line (x% + (xx - 1) * 2, y% + (yy - 1) * 4)-Step(1, 3), ghostBodyC~&, BF
End If
If Mid$(gEyeBall$, (yy - 1) * gWidth% + xx, 1) <> "." Then
Line (x% + (xx - 1) * 2, y% + (yy - 1) * 3)-Step(1, 2), _RGB32(255, 255, 255), BF
End If
If Mid$(gIris$, (yy - 1) * gWidth% + xx, 1) <> "." Then
Line (x% + (xx - 1) * 2, y% + (yy - 1) * 3)-Step(1, 2), IrisC~&, BF
End If
Next xx
Next yy
End Sub
Sub SetupGhost ' Charlie made these!
' setup shared variables in main, this sub sets the values for them
'dim shared gWidth%, gHeight%, gBod$, ghostEyeballLeft$, ghostEyeballRight$, ghostIrisLeft$, ghostIrisRight$
gWidth% = 14
gHeight% = 14
gBod$ = _
".....XXXX....." + _
"...XXXXXXXX..." + _
"..XXXXXXXXXX.." + _
".XXXXXXXXXXXX." + _
".XXXXXXXXXXXX." + _
".XXXXXXXXXXXX." + _
"XXXXXXXXXXXXXX" + _
"XXXXXXXXXXXXXX" + _
"XXXXXXXXXXXXXX" + _
"XXXXXXXXXXXXXX" + _
"XXXXXXXXXXXXXX" + _
"XXXXXXXXXXXXXX" + _
"XX.XXX..XXX.XX" + _
"X...XX..XX...X"
ghostEyeballLeft$ = _
".............." + _
".............." + _
".............." + _
"..XX....XX...." + _
".XXXX..XXXX..." + _
"...XX....XX..." + _
"...XX....XX..." + _
"..XX....XX...." + STRING$(6*14,".")
ghostEyeballRight$ = _
".............." + _
".............." + _
".............." + _
"....XX....XX.." + _
"...XXXX..XXXX." + _
"...XX....XX..." + _
"...XX....XX..." + _
"....XX....XX.." + STRING$(6*14,".")
ghostIrisLeft$ = _
".............." + _
".............." + _
".............." + _
".............." + _
".............." + _
".XX....XX....." + _
".XX....XX....." + STRING$(7*14,".")
ghostIrisRight$ = _
".............." + _
".............." + _
".............." + _
".............." + _
".............." + _
".....XX....XX." + _
".....XX....XX." + STRING$(7*14,".")
End Sub
' IFFs of a Type 2023-11-03
Function IfS$ (Bool&, tru$, fals$) ' IF Boolean Return True$ else False$
If Bool& Then IfS$ = tru$ Else IfS$ = fals$
End Function
Function IfL& (Bool&, tru&, fals&) ' IF Boolean Return True& else False&
If Bool& Then IfL& = tru& Else IfL& = fals&
End Function
'mod for this app & added to test code
Function IfUL~& (Bool&, tru~&, fals~&) ' IF Boolean Return True~& else False~&
If Bool& Then IfUL~& = tru~& Else IfUL~& = fals~&
End Function
Function MakeSky& (light As Long) ' light = 0 to 100, 50+ no stars
' needs MidInk~&() Function
Dim As _Unsigned Long saveColor, c
Dim As Long i, rtn, saveDest
Dim r, rn, xx, yy, lite
lite = 2 * light
saveDest = _Dest
saveColor = _DefaultColor(saveDest)
rtn = _NewImage(_Width, _Height, 32)
_Dest rtn&
For i = 0 To _Height - 1
c = midInk(.75 * lite + 10, .75 * lite + 5, 35 + .75 * lite, 25 + lite, lite, 55 + lite, i / (_Height - 1))
Line (0, i)-(_Width, i), c
Next
'stars only in low lite
If lite <= 100 Then
For i = 1 To _Width * _Height / 1500
rn = Rnd: xx = Rnd * _Width: yy = Rnd * _Height
If rn < .01 Then
For r = 0 To 2 Step .5
Circle (xx, yy), r, _RGB32(185, 185, 185)
Next
ElseIf rn < .2 Then
Circle (xx, yy), 1, _RGB32(185, 185, 185)
PSet (xx, yy), _RGB32(185, 185, 185)
Else
PSet (xx, yy), _RGB32(185, 185, 185)
End If
Next
End If
_Dest saveDest
Color saveColor
MakeSky& = rtn
End Function
Function midInk~& (r1%, g1%, b1%, r2%, g2%, b2%, fr##)
midInk~& = _RGB32(r1% + (r2% - r1%) * fr##, g1% + (g2% - g1%) * fr##, b1% + (b2% - b1%) * fr##)
End Function
Function MakeDoor& () ' door is width X 3*width
' make huge door and use putimage to shrink into rectangle needed
Dim As Long saveD, rtn, hx, hy, i
Dim rr
saveD = _Dest
rtn = _NewImage(280, 560, 32)
_Dest rtn
hx = 140: hy = 280 'center
Line (hx - 140, hy - 280)-Step(280, 560), &HFFFFAA77, BF
Line (hx - 100, hy - 240)-(hx - 20, hy - 20), &HFFDD8853, BF
For i = 0 To 9
Line (hx - 100 + i, hy - 240 + i)-(hx - 20 - i, hy - 20 - i), &HFF000000 + _RGB32(i * 12, 50), B
Next
Line (hx + 20, hy - 240)-(hx + 100, hy - 20), &HFFDD8853, BF
For i = 0 To 9
Line (hx + 20 + i, hy - 240 + i)-(hx + 100 - i, hy - 20 - i), &HFF000000 + _RGB32(i * 12, 50), B
Next
Line (hx - 100, hy + 20)-(hx + 100, hy + 240), &HFFDD8853, BF
For i = 0 To 9
Line (hx - 100 + i, hy + 20 + i)-(hx + 100 - i, hy + 240 - i), &HFF000000 + _RGB32(i * 12, 50), B
Next
For rr = 0 To 12 Step .25
Circle (hx + 120, hy), rr, _RGB32(255 - rr * 17, 255 - rr * 17, 255 - rr * 17, 100)
Next
MakeDoor& = rtn
_Dest saveD
End FunctionRE: Combine Charlies Ghosts with 40 LOC Game - CharlieJV - 11-04-2023
Those IF functions are kind of handy, eh?
I figure best to only use IF functions when the IF function arguments are not complex expressions. Well, for QB64pe's blazing performance, it probably wouldn't ever matter any.