Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Combine Charlies Ghosts with 40 LOC Game
#1
Here is Charlies cute scrolly ghosts from BAM:
https://basicanywheremachine.neocities.o...s.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 SUB

40 (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 Sub

   

The 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! ;-))
b = b + ...
Reply
#2
Holy moly that's good stuff !
Reply
#3
The running version of Scroly Ghosts: https://basicanywheremachine.neocities.o...s.prod.run
Reply
#4
Thumbs Up 
(11-03-2023, 01:26 AM)CharlieJV Wrote: The running version of Scroly Ghosts: https://basicanywheremachine.neocities.o...s.prod.run

Yes that's my inspriration. Thanks Charlie!
b = b + ...
Reply
#5
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 Function

Then 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 Function

Then 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 Function

so 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 Function
b = b + ...
Reply
#6
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.
Reply




Users browsing this thread: 3 Guest(s)