Print Page - Competition

Title: Competition
Post by: johnno56 on October 02, 2021, 08:25:34 am

Quick question... Is anyone from this site participating in the Syntaxbomb competition... or is that a bite of a taboo topic? Just curious...

Title: Re: Competition
Post by: SMcNeill on October 02, 2021, 08:27:21 am

Got a link? Never heard of it. 😘

Title: Re: Competition
Post by: bplus on October 02, 2021, 09:03:55 am

https://www.syntaxbomb.com/game-coding-competitions/code-a-game-comp-there-can-be-only-one-aug-14th-to-oct-24th-2021/

Title: Re: Competition
Post by: Pete on October 02, 2021, 12:50:26 pm

Unless the competition is exclusively in SCREEN 0, then no.

Kidding aside, I wish Rob had finished his Zaxon clone he made 10+ years ago. It really showcased the power of the then still infant QB64. I suppose that now a lot of the entries would be 3-D, but we do have a few OpenGL enthusiasts parked around here, somewhere. Did you intend to enter?

Pete

How can we prove intelligent life exists on other planets? Simple, they won't visit here!

Title: Re: Competition
Post by: jack on October 02, 2021, 01:02:34 pm

at first I thought: what a ridiculous limitation, only one key or button, how could one possibly write an interesting game with that limitation, but then I thought that it would be simple enough to make a "pop the balloons" game where a rectangle moves randomly across a screen full of balloons and you hit the key to pop the balloon that the rectangle targets, or you could make other similar games

Title: Re: Competition
Post by: bplus on October 02, 2021, 01:06:08 pm

Flappy Bird pretty much is a single key game.

Title: Re: Competition
Post by: bplus on October 02, 2021, 01:08:58 pm

I started a discussion about accessing all letters and numbers (for menu) with a single key here:
https://www.qb64.org/forum/index.php?topic=4239.msg136134#msg136134

Title: Re: Competition
Post by: Pete on October 03, 2021, 01:14:25 am

You could make a Defender clone with one button. Just have the ship shoot continuously as it simultaneously moves upwards to the top of the screen and reappears at the bottom. Take your finger off the button, and it stops elevating and shooting. You could make the ship in the shape of a hand, with the middle finger extended forward, and name it, Windows Offender.

By the way, the forum crashed again, while I was trying to post ths.

Pete

Title: Re: Competition
Post by: johnno56 on October 03, 2021, 04:49:02 am

How about that Trex runner? One click to duck; double-click to jump; release to run... Just a thought...

Title: Re: Competition
Post by: bplus on October 03, 2021, 08:28:06 am

This is Screen 0, One Key Game I made from my variation of Cryptogram Puzzle:

Code: QB64: [Select]

_Title "One Key Challenge - Cryptogram Puzzle" ' b+  started One Key Challenge 2021-09-25
' from Cryptogram Puzzle   2021-09-09
' 2021-09-07 intended for QB64 home programming entertainment use only."
' Thank you Best Life ref: https://bestlifeonline.com/funny-short-jokes/"
'
' 2021-10-02 installed new GetInput but it needs a chunk of screen space setup
' Have it basically working now for some cleanp. Move the file into data statements.
' Make a utility to do this.
 
Randomize Timer: Width 120, 30
Dim Shared Answer$ '  beginning phrase to be guessed    '   3 stages of the Puzzle
Dim Shared Coded$ '   hidden in code
Dim Shared Working$ ' decoded and solved when working$ becomes = ucase$(answer$)
Dim Shared Letters$(1 To 26) ' for coding and highlited letters
Dim Shared LCodes$(1 To 26) '  for code and decode by number 1 to 26
Dim Shared Guesses$(1 To 26) ' track all the guess to decode
Dim Shared HighLited ' cursor over letters to guess
Dim Shared Mode
_FullScreen 'I guess it does make it easier to tell E from F...
Dim jokes$(1 To 100)
For i = 1 To 100
    Read r$
    If r$ <> "EOD" Then jokes$(i) = r$: jCount = jCount + 1 Else Exit For
Next
restart:
Answer$ = jokes$(Int(Rnd * jCount) + 1)
For i = 1 To 26: Guesses$(i) = "-": Next 'setup the display guesses array
For i = 1 To 26 ' use letters for display of letters to pick second and to create a code
    Letters$(i) = Chr$(i + 64)
    LCodes$(i) = Letters$(i) ' these will convert between each other by index number
Next
For i = 26 To 2 Step -1 ' shuffle the letters in LCode$()
    Swap LCodes$(i), LCodes$(Int(Rnd * i) + 1)
Next
Coded$ = "": Working$ = "" ' reset for next go around
For i = 1 To Len(Answer$) 'third: put the phrase in coded$ and hide it in working$
    a = Asc(UCase$(Answer$), i)
    If a >= 65 And a <= 90 Then
        Coded$ = Coded$ + LCodes$(a - 64)
        Working$ = Working$ + "*"
    Else
        Coded$ = Coded$ + Mid$(Answer$, i, 1)
        Working$ = Working$ + Mid$(Answer$, i, 1)
    End If
Next
HighLited = 1 'setup done start game
Mode = 1
Do
    Mode = 1 - Mode
    DisplayScreen
    k$ = GetInput$(61, 22)
    If Mode = 0 Then ' highlight a letter
        'm replaces arrows and mouse select of highlited 1 to 26 for letters
        test = InStr("ABCDEFGHIJKLMNOPQRSTUVWXYZ", k$)
        If test > 0 Then HighLited = test
        test = InStr("1234", k$)
        If test > 0 Then
            Select Case test
                Case 1: GoSub do1: Mode = 1
                Case 2: GoSub do2: Mode = 1
                Case 3: GoSub do3: Mode = 1
                Case 4: GoSub do4: Mode = 1
            End Select
        End If
    Else
        Select Case k$
            Case "1": GoSub do1
            Case "2": GoSub do2
            Case "3": GoSub do3
            Case "4": GoSub do4
            Case "A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z"
                Guesses$(HighLited) = k$ ' for screen updates
                For i = 1 To Len(Working$)
                    If Letters$(HighLited) = Mid$(Coded$, i, 1) Then Mid$(Working$, i, 1) = k$
                Next
        End Select
    End If
    _Limit 60
Loop Until Working$ = UCase$(Answer$)
DisplayScreen
Color 1, 2
cp 17, "You got it!    5 secs to next puzzle..."
_Delay 5: Cls
GoTo restart
 
do1: ' display answer
Working$ = UCase$(Answer$) ' show the answer$ guesses correct moves to next puzzle
DisplayScreen
Return
 
do2: ' get decode letter for highlighted Letter
For i = 1 To 26
    If LCodes$(i) = Letters$(HighLited) Then c$ = Chr$(i + 64): Exit For
Next
Guesses$(HighLited) = c$ ' for screen updates
For i = 1 To Len(Working$)
    If Letters$(HighLited) = Mid$(Coded$, i, 1) Then Mid$(Working$, i, 1) = c$
Next
Return
 
do3: ' find a uncoded letter
Color 15, 2: Locate 24, 40: Print "Select Find Letter"
d$ = GetInput(61, 22)
c$ = LCodes$(Asc(d$) - 64)
Guesses$(Asc(c$) - 64) = d$
For i = 1 To Len(Working$)
    If c$ = Mid$(Coded$, i, 1) Then Mid$(Working$, i, 1) = d$
Next
Return
 
do4: ' clear guess letter from code letter
Guesses$(HighLited) = "-"
For i = 1 To Len(Working$)
    If Letters$(HighLited) = Mid$(Coded$, i, 1) Then Mid$(Working$, i, 1) = "*" ' clear the letter
Next
Return
 
'one liners
Data "What kind of exercise do lazy people do? Diddly-squats."
Data "What do you call a pony with a cough? A little horse!"
Data "What is Forrest Gump's password? 1Forrest1."
Data "Why did the M&M go to school? He wanted to be a Smartie."
Data "What did one traffic light say to the other? Stop looking at me, I'm changing!"
Data "What do you call bears with no ears? B."
Data "What's a foot long and slippery? A slipper!"
Data "Why do French people eat snails? They don't like fast food!"
Data "What's red and moves up and down? A tomato in an elevator!"
Data "I invented a new word today: Plagiarism."
Data "What is sticky and brown? A stick!"
Data "How does a rabbi make coffee? Hebrews it!"
Data "Rest in peace boiling water. You will be mist!"
Data "How do you throw a space party? You planet!"
Data "Want to hear a construction joke? Oh never mind, I'm still working on that one."
Data "Why don't scientists trust atoms? Because they make up everything!"
Data "I hate Russian dolls they're so full of themselves!"
Data "Talk is cheap? Have you ever talked to a lawyer?"
Data "Why did the gym close down? It just didn't work out!"
Data "Two artists had an art contest. It ended in a draw!"
Data "A plateau is the highest form of flattery."
Data "I have a fear of speed bumps. But I am slowly getting over it."
Data "You can only get spoiled milk from a pampered cow."
Data "What do you call a boomerang that doesn't come back? A stick!"
Data "You know what I saw today? Everything I looked at."
Data "What are a shark's two most favorite words? Man overboard!"
Data "If we shouldn't eat at night, why do they put a light in the fridge?"
Data "Have you ever tried eating a clock? It's really time-consuming, especially if you go for seconds."
Data "Why are ghosts such bad liars? Because they are easy to see through."
Data "It's cleaning day so naturally, I've already polished off a whole chocolate bar."
Data "What did the buffalo say when his son left for college? Bison!"
Data "Here, I bought you a calendar. Your days are numbered now."
Data "Where do fish sleep? In the riverbed."
Data "What did one plate say to his friend? Tonight, dinner's on me!"
Data "Where are average things manufactured? The satisfactory."
Data "I tried to sue the airport for misplacing my luggage. I lost my case."
Data "Why doesn't the sun go to college? Because it has a million degrees!"
Data "I was wondering why the Frisbee was getting bigger, then it hit me."
Data "I have many jokes about rich kids unfortunately none of them work."
Data "What do you call a singing laptop? A Dell!"
Data "Why was six afraid of seven? Because seven ate nine."
Data "Why are skeletons so calm? Because nothing gets under their skin."
Data "How do trees get online? They just log on!"
Data "Some people think prison is one word but to robbers it's the whole sentence."
Data "My girlfriend treats me like a god. She ignores my existence and only talks to me when she needs something."
Data "Where does the sheep get his hair cut? The baa baa shop!"
Data "Why did the orange stop? It ran out of juice!"
Data "I never make mistakes. I thought I did once, but I was wrong."
Data "What does the man in the moon do when his hair gets too long? Eclipse it!"
Data "What did 0 say to 8? Nice belt!"
Data "EOD"
 
Sub DisplayScreen
    Color 11, 2: Cls
    Color 1
    cp 2, "*** One Key Challenge - Cryptogram Puzzle ***"
    Color 7
    cp 4, "All selections are made by pressing spacebar when letter or menu number is highlighted."
    cp 5, "Solve by selecting a code letter then selecting a letter guess."
    cp 6, "Use the _ steps to move down or up on last row."
    cp 7, "Use the escape key to quit immediately."
    cp 9, "To get the answer and move onto next puzzle, select 1."
    cp 10, "To decode current highlighted letter, select 2."
    cp 11, "To solve a letter, select 3 and then select letter to find."
    cp 12, "To clear a guess at highlighted letter, select 4."
    Color 4
    Locate 15, (120 - Len(Answer$)) / 2: Print Coded$
    Color 11
    Locate 16, (120 - Len(Answer$)) / 2
    For i = 1 To Len(Answer$)
        w$ = Mid$(Working$, i, 1): c$ = Mid$(Coded$, i, 1)
        a$ = Mid$(Answer$, i, 1): h$ = Letters$(HighLited)
        If w$ = "*" Then
            pc$ = "*": If h$ = c$ Then Color 14, 0 Else Color 10, 2
        Else
            Color 10, 2: If w$ = UCase$(a$) Then pc$ = a$ Else pc$ = w$
        End If
        Print pc$;
    Next
    spaces = 9
    For i = 1 To 26
        If i = HighLited Then Color 14, 0 Else Color 4, 2
        Locate 19, spaces: Print Letters$(i)
        If i = HighLited Then Color 14, 0 Else Color 10, 2
        Locate 20, spaces: Print Guesses$(i)
        spaces = spaces + 4
    Next
    Color 15, 2: Locate 24, 40
    If Mode Then Print "Guess Letter|Menu#" Else Print "Select Code Letter"
End Sub
 
Sub cp (row, text$) ' center text on text screen
    Locate row, (_Width - Len(text$)) / 2: Print text$
End Sub
 
Function GetInput$ (LocateCol, LocateRow)
    Dim g$(5)
    g$(0) = "_ABCDE_"
    g$(1) = "_FGHIJ_"
    g$(2) = "_KLMNO_"
    g$(3) = "_PQRST_"
    g$(4) = "_UVWXY_"
    g$(5) = "_Z1234_"
    py = 0: px = 0
    Do
        If _KeyDown(27) Then System ' quit
        GoSub show
        lp = lp + 1
        If lp = 60 Then
            lp = 0
            px = px + 1
            If px > 6 Then px = 0
        End If
        If InKey$ = " " Then
            If pick$ = "_" Then
                py = py + 1
                If py > 5 Then py = 0
            Else
                GetInput$ = pick$: Exit Function
            End If
        Else
        End If
        'Locate 1, 40: Print py, px
        _Limit 60
    Loop
    show:
    For row = 0 To 5
        For col = 0 To 6
            If col = px And row = py Then Color 0, 15: pick$ = Mid$(g$(row), col + 1, 1) Else Color 15, 0
            Locate LocateRow + row, LocateCol + col: Print Mid$(g$(row), col + 1, 1);
        Next
    Next
    Color 15, 0
    Return
End Function
 
 
 

What do ya think? Competition ready? QB64 embarrassment?

Title: Re: Competition
Post by: SMcNeill on October 03, 2021, 08:58:39 am

Mini-golf would be great for this competition.

Imagine a bar with a slider going back and forth. Click a button to stop it to set your angle.

Like this is my bar: [……………………]

And then the slider moves back and forth: […………………|…]

In this case, that’s to the far right. (The | is my slider.)

Now, do the same thing a second time for power.

You now can shoot a ball, at various angles, with different levels of power, and try and get it to the target up the screen.

Simple interface. One button interactive. It’s a game — especially if you code it where 2 people can compete in it.

Title: Re: Competition
Post by: bplus on October 03, 2021, 09:34:36 am

Sounds interesting Steve, look forward to seeing it coded up ;-))

Title: Re: Competition
Post by: bplus on October 03, 2021, 10:02:37 am

How about a competition here?

Rules: One key, lets just say spacebar, and Screen 0 are only restrictions I can think of, by Halloween.
Maybe bonus consideration for Halloween themed game or puzzle.

Title: Re: Competition
Post by: TempodiBasic on October 03, 2021, 11:51:28 am

Hi boys and girls

@Steve you have described a my boxes demo with a power punch bar increasing pressing key and decreasing by time
So I could resume it from Ongoing folder.

@bplus yes one key but not one key of keyboard, we can use also one button of mouse or one button of joystick....
so with buttons and menu you can do many things.

@All QB64 coders....
in programs folder that ships with QB64 there is an ASCII game with loud sound, I have no found any reference to its author but he is Spanish or Latin people speaking Spanish language. I can argue watching the text used as output for users.
Right, the game can be optimized for output in ASCII graphic, for sound output, for input (now it uses two key, ESCAPE and UpArrow).
But it is politically uncorrect because the enemy to hit by bomb is always an antagonist of U.S.A. So I think to change the framework story using the Spectre of 007 as bomber and adding some others countries in the list of enemies of Spectre.

Title: Re: Competition
Post by: bplus on October 03, 2021, 12:49:12 pm

Quote from: TempodiBasic on October 03, 2021, 11:51:28 am

Hi boys and girls

@Steve you have described a my boxes demo with a power punch bar increasing pressing key and decreasing by time
So I could resume it from Ongoing folder.

@bplus yes one key but not one key of keyboard, we can use also one button of mouse or one button of joystick....
so with buttons and menu you can do many things.

@All QB64 coders....
in programs folder that ships with QB64 there is an ASCII game with loud sound, I have no found any reference to its author but he is Spanish or Latin people speaking Spanish language. I can argue watching the text used as output for users.
Right, the game can be optimized for output in ASCII graphic, for sound output, for input (now it uses two key, ESCAPE and UpArrow).
But it is politically uncorrect because the enemy to hit by bomb is always an antagonist of U.S.A. So I think to change the framework story using the Spectre of 007 as bomber and adding some others countries in the list of enemies of Spectre.

Yeah, Steve's thing sounds great for a gorilla throwing bananas at buildings sort of thing ;-))

Quote

@bplus yes one key but not one key of keyboard, we can use also one button of mouse or one button of joystick....
so with buttons and menu you can do many things.

What?
I am hoping to get a little forum competition going:
* one key (the spacebar)
* screen 0
* Halloween Theme is plus
* Done by Halloween
Are you interested?

@TempodiBasic the game you are describing from Samples sounds like something I dabbled with. Missile Command:
https://www.qb64.org/forum/index.php?topic=3978.msg133192#msg133192

It also reminds me of the throwing rocks thing with @SierraKen (Are you still looking in?)

Title: Re: Competition
Post by: johnno56 on October 03, 2021, 03:11:42 pm

The difficulty with 'one button' could all go away by using one simple neural interface... Am I wrong? (bplus... say nothing... lol)

Title: Re: Competition
Post by: SMcNeill on October 03, 2021, 03:37:51 pm

Here’s an idea for a one-button Halloween game: CANDY SUBMARINE!

Gameplay involves using the spacebar to inflate or deflate the ballasts on a sub to make it go up and down. The game is naturally a side scroller, which ceaselessly scrolls automatically.

The goal is to grab the various candies that have spilled overboard off a massive Halloween cargo ship in a storm and sunk into the ocean.

The challenge comes in maintaining your oxygen levels (it refills to 100% when you’re at the surface, decreases every second fully submerged), and avoiding the hazards of the deep — sharks, octopuses, squids, old war world ii mines…

Salvage all the candy you possibly can on the CANDY SUBMARINE!!

As you can probably tell, I’ve been working on writing and publishing my next book again…. At the moment I’m stuck in “creative mode”, instead of “technical mode” — that comes during the editing phase of the story, pre-publishing. Right now, I can brainstorm a thousand game ideas…. I’m just not in the right stage of mind to actually sit down and program them. LOL!!

Feel free to make use of any idea I share that one of you guys might want to take a run at making. 😉

Title: Re: Competition
Post by: SMcNeill on October 03, 2021, 04:23:29 pm

CURSE MASTER!

You’re a witch with a goal! Curse all the kids on Halloween night!

Gameplay is again a simple continual side scroller as you fly over the kids heads on your broom.

Kids come in four variations: boy/girl, young/old

To curse them, you have to use the right magic while they’re on the screen…

young boys require a press-hold-press action of the spacebar.
young girls are hold-press-press.
older boys are hold-press-hold.
Older girls are press-hold-hold.

Presses are generated by a quick up and down of the space bar.
Holds require the spacebar to go down for 0.2 seconds or more, then up.

You have a set amount of magic to curse an increasing number of children each level. As you progress, number of children increases per level, and so does your flying speed. Magic is renewed at the start of each new level.

Can you be the witch who curses the most children? Will you become The Curse Master?!!

Title: Re: Competition
Post by: SMcNeill on October 03, 2021, 04:45:40 pm

HILLBILLY HORSESHOES

A one-click game based off one we used to play here on the farm after the fall harvest, so it fits the Halloween theme somewhat. Now what we used to do involved a lot of drinking and spinning…. You grab a horseshoe, spin around in a circle and toss!! Whichever idiot lost had to drink a shot of fresh green apple shine!

Needless to say, it’s a Redneck Classic! Drinking and hurling heavy iron projectiles! What can go wrong??

To save you guys from learning, a one-click version of this would be simple:

Place two targets on the screen. Your goal is to hit as close to that target as possible. To do so, the player avatar stands behind their horseshoe and spins in a circle building up momentum. When ready, release the shoe and aim for the heavens!

Gameplay:

Press the spacebar to spin. The longer you hold it, the faster you spin and the farther the horseshoe travels.
Release to hurl in that direction, at that speed, and see how close you get to the target!

Bonus points for killing spectators!
Even more points if they’re on your side!

Title: Re: Competition
Post by: SMcNeill on October 03, 2021, 05:05:05 pm

Here’s an idea @bplus might enjoy making: WORD BUMP

Take a dictionary to gather a list of words.
Scroll one across the screen from left to right.
As it passed the center target area of the screen, you can hit the spacebar to BUMP out a letter to make a new word.

For example: PETE scrolls across the screen. As the T crosses the target, you hit the spacebar and bump it out to spell PEE. 1 word made via bumping!

The word then scrolls across the screen a second time. Bump the first E and make PET!

For a secondary challenge, you can form words with the discard letters as well.

Example: Word is BPLUS…

Bump the S, U, and B to make SUB!

You can form words from left to right, or from right to left, but the game ends when you fail to form a new word from either direction on your turn.

How many words can you form??

Title: Re: Competition
Post by: TempodiBasic on October 03, 2021, 05:14:04 pm

@bplus
yes it is not so near to Missile Command (fine!)
as you can see from the source code posted here

Code: QB64: [Select]

DECLARE SUB CentrarTexto (t$, y%)
 
 
menu:
Color 10, 0
Cls
CentrarTexto "ÛÛÛÛÛÛ»           ÛÛÛÛÛÛÛ» ÛÛ» ÛÛ»", 2
CentrarTexto "ÛÛÉÍÍÛÛ» ÛÛ»  ÛÛ» ÛÛÉÍÍÍÍ¼ ÛÛº ÛÛº", 3
CentrarTexto "ÛÛÛÛÛÛÉ¼ ÛÛº  ÛÛº ÛÛÛÛÛÛÛ» ÛÛÛÛÛÛº", 4
CentrarTexto "ÛÛÉÍÍÛÛ» ÛÛº  ÛÛº ÈÍÍÍÍÛÛº ÛÛÉ ÛÛº", 5
CentrarTexto "ÛÛÛÛÛÛÉ¼ ÛÛÛÛÛÛÛº ÛÛÛÛÛÛÛº ÛÛº ÛÛº", 6
CentrarTexto "ÈÍÍÍÍÍ¼  ÈÍÍÍÍÍÍ¼ ÈÍÍÍÍÍÍ¼ ÈÍ¼ ÈÍ¼", 7
Color 30
CentrarTexto "BOMBER - BOMBER - BOMBER - BOMBER", 8
Color 9
CentrarTexto "Ayuda a Bush en su mision de matar inocentes por el mundo!", 10
CentrarTexto "Pero ten cuidado! La gente cada vez corre mas rapido...", 11
CentrarTexto "Y tu helicoptero tambien!", 12
 
CentrarTexto "La unica tecla necesaria es Arriba (para dejar bombas).", 13
CentrarTexto "Este programa esta hecho 100% en Qbasic, y es un poco aburrido...", 14
 
Color 15
Play "o2 l16 df+af+df+af+df+af+df+af+eac+aeac+aeac+aeac+adf+bf+df+bf+df+bf+df+bf+d-f+ap16 d-f+ap16 d-f+ap16 d-f+aa"
CentrarTexto "(Presione cualquier tecla para continuar, ESC para salir)", 20
 
Do While InKey$ = ""
    Select Case InKey$
        Case Chr$(27)
            End
    End Select
Loop
 
Randomize Timer
Cls
bombas = 50
ac = 16000
columna = 1
linea = 3
lineaa = 3
x = 0
mn = 30
op = 4
dd = 1
we = 0
 
Do
 
    If dd = 1 Then
        Color 31
        CentrarTexto "Afghanistan", 10
    End If
 
    If dd = 2 Then
        Color 31
        CentrarTexto "Irak", 10
    End If
 
    If dd = 3 Then
        Color 31
        CentrarTexto "Iran", 10
    End If
 
    If dd = 4 Then
        Color 31
        CentrarTexto "Arabia Saudita", 10
    End If
 
    If dd = 5 Then
        Color 31
        CentrarTexto "Venezuela", 10
    End If
 
    If dd = 6 Then
        Color 31
        CentrarTexto "Colombia", 10
    End If
 
    If dd = 7 Then
        Color 31
        CentrarTexto "Brasil", 10
    End If
 
    If dd = 8 Then
        Color 31
        CentrarTexto "Cuba", 10
    End If
 
    If dd = 9 Then
        Color 31
        CentrarTexto "Uruguay", 10
    End If
 
    If dd = 10 Then
        Color 31
        CentrarTexto "India", 10
    End If
 
    If dd = 11 Then
        Color 31
        CentrarTexto "Libia", 10
    End If
 
    If dd = 12 Then
        Color 31
        CentrarTexto "Sudafrica", 10
    End If
 
    If dd = 13 Then
        Color 31
        CentrarTexto "Alemania", 10
    End If
 
    If dd = 14 Then
        Color 31
        CentrarTexto "Japon", 10
    End If
 
    If dd = 15 Then
        Color 31
        CentrarTexto "Rusia", 10
    End If
 
 
    If bombas = 0 Then
        Color 4
        CentrarTexto "Sin municiones!", 12
        op = op - 1
        bombas = 50
        Do While InKey$ = ""
        Loop
    End If
 
    Color 12
    Locate 1, 1
    Print "Nivel: "
    Locate 1, 8
    Print dd
 
    If op = 0 Then
        Color 2, 0
        Cls
        CentrarTexto "Perdiste!", 12
        Do While InKey$ = ""
        Loop
        Sleep
        GoTo menu
    End If
 
    Locate 1, 30
    Color 9
    Print "Oportunidades:"
    Locate 1, 45
    Print op
 
    Locate 1, 60
    Color 10
    Print "Bombas:"
    Locate 1, 69
    Print bombas
 
    If we = 15 Then
        Color 30
        CentrarTexto "Ultimo Nivel!", 12
    End If
 
    If we = 16 Then
        Color 4, 0
        Cls
        Color 15
        CentrarTexto "È=XO", 10
        Color 4
        CentrarTexto "*", 14
        Color 10
        Locate 23, 45
        Print ""
        Locate 23, 46
        Print ""
        Locate 23, 33
        Print ""
        Locate 23, 34
        Print ""
        Color 9
        CentrarTexto "ÉÍÍÍÍÍÍ»", 16
        CentrarTexto "ºÍþÍþÍþº", 17
        CentrarTexto "ºþÍþÍþÍº", 18
        CentrarTexto "ºÍþÍþÍþº", 19
        CentrarTexto "ºþÍþÍþÍº", 20
        CentrarTexto "ºÍþÍþÍþº", 21
        CentrarTexto "ºþÍþÍþÍº", 22
        CentrarTexto "ºÍþÍÛÍþº", 23
        Color 28
        CentrarTexto "Congratulations!", 1
        Color 2
        CentrarTexto "Lo has hecho, ahora todo el petroleo del mundo es de Bush!", 3
        CentrarTexto "Los Bush vuelven a ganar... Pero no se si felicitarte", 4
        CentrarTexto "por matar gente... Que deberia hacer?", 5
        CentrarTexto "Ganaste! GRACIAS POR JUGAR!", 6
        Play "T120 O2 L4"
        Play "F8 D8 <B- >D F B-2 >D8 C8 <B- D E F2 F8 F8 >D. C8 <B-"
        Play "A2 G8 A8 B- B- F D <B- >F8 D8 <B- >D F B-2 >D8 C8"
        Play "<B- D E F2 F8 F8 >D. C8 <B- A2 G8 A8 B- B- F D <B-"
        Play ">>D8 D8 D D E- F2. E-8 D8 C C D E-2 E- D2 C8 <B-8"
        Play "A2 G8 A8 B- D E F2 F B- B- B-8 A8 G G G"
        Play ">C E-8 D8 C8 <B-8 B- A2 P4"
        Play "F8 F8 B-. >C8 D8 E-8 F2 <B-8 >C8 D. E-8 C <B-2"
 
        GoTo menu
    End If
 
    If m = 1 Then
        lineaa = lineaa + 1
 
 
        If lineaa = 23 Then
            If tipitoc = mn Then
                Color 9
                CentrarTexto "                                    ", 10
                Color 4
                CentrarTexto "Le diste!", 10
                Play "o3 l15 cc < b > cc < b > cc < b > cc < b > c < b > c < bffeffeffeffefefg"
                dd = dd + 1
                we = we + 1
                bombas = 50
            End If
 
            If tipitoc = sd Then
                we = we + 1
                dd = dd + 1
                ac = ac - 1000
                Color 9
                CentrarTexto "                                    ", 10
                Color 4
                CentrarTexto "Le diste!", 10
                bombas = 50
                Play "o3 l15 cc < b > cc < b > cc < b > cc < b > c < b > c < bffeffeffeffefefg"
            End If
 
            If tipitoc = fd Then
                Color 4
                ac = ac - 1000
                Color 9
                CentrarTexto "                                    ", 10
                Color 4
                CentrarTexto "Le diste!", 10
                dd = dd + 1
                we = we + 1
                Play "o3 l15 cc < b > cc < b > cc < b > cc < b > c < b > c < bffeffeffeffefefg"
                bombas = 50
            End If
 
 
            m = 2
            lineaa = 2
        End If
 
        Locate lineaa, tipitoc
        Color 4
        Print "*"
    End If
 
    Color 15, 9
    columna = columna + 1
    If columna = 78 Then
        columna = 1
    End If
    Locate linea, columna
    Print "È=XO"
    Beep
 
    For i = 1 To ac
    Next i
 
    Cls
    vuelta:
 
    If we = 1 Then
        we = 2
    End If
 
    If x = 1 Then
        Color x
        Locate 23, z
        Print ""
        Locate 23, zy
        Print ""
        Locate 23, zu
        Print ""
        Locate 23, zi
        Print ""
        Locate 23, zo
        Print ""
    End If
 
    Select Case InKey$
        Case Chr$(0) + Chr$(72)
            tipitoc = columna
            m = 1
            bombas = bombas - 1
        Case Chr$(27)
            End
    End Select
 
 
    Randomize Timer
    h = Int(Rnd * 2) + 1
    sd = mn + 1
    fd = mn + 2
 
    If h = 1 Then
        mn = mn + 1
        sd = sd + 1
        fd = fd + 1
    End If
    If h = 2 Then
        mn = mn - 1
    End If
 
    If mn = 0 Then
        mn = mn + 1
    End If
 
    Color we
    Locate 23, mn
    Print ""
 
    If mn = 0 Then
        mn = mn + 1
    End If
 
    If mn = 70 Then
        mn = mn - 1
    End If
 
Loop
 
Sub CentrarTexto (t$, y%)
    xnum% = (80 - Len(t$)) / 2
    xspc% = Int((80 - Len(t$)) / 2)
    If y% = 0 Then Print Tab(xspc%); t$: Exit Sub
    Locate y%, xnum%: Print t$
    '
 
End Sub
 

About competition: it is a good thing ASCII + one keyboard Key for all the game + Halloween theme (colors and NPCs and User)
IMHO it need to define what is the game.... splashscreen/title and or music and or sounds and or options panel and or hall of fame and or kind/type of game any or a specified group [text game?, ASCII graphic ? Shooter? puzzle? Adventure? Dugeon? race? Fight?etc etc]

Title: Re: Competition
Post by: TempodiBasic on October 03, 2021, 05:25:12 pm

@SMcNeill
Great Steve! Your brainstorm is releasing good fruits:
1- WORD BUMP 1.0
2- WORD BUMP 2.0
3- HILLBILLY HORSESHOES
4- CURSE MASTER!
5- CANDY SUBMARINE!

who do take one of these ideas of Steve to develop and so he shares credits with Steve?

Title: Re: Competition
Post by: bplus on October 03, 2021, 08:30:38 pm

Quote

As you can probably tell, I’ve been working on writing and publishing my next book again…. At the moment I’m stuck in “creative mode”, instead of “technical mode” — that comes during the editing phase of the story, pre-publishing. Right now, I can brainstorm a thousand game ideas…. I’m just not in the right stage of mind to actually sit down and program them. LOL!!

Luv those moments, good idea to write them down.

Title: Re: Competition
Post by: bplus on October 03, 2021, 08:33:04 pm

Quote

IMHO it need to define what is the game.... splashscreen/title and or music and or sounds and or options panel and or hall of fame and or kind/type of game any or a specified group [text game?, ASCII graphic ? Shooter? puzzle? Adventure? Dugeon? race? Fight?etc etc]

Might be over-thinking this just a bit @TempodiBasic having only the spacebar to press and screen 0 (non graphics) is pretty restrictive already.

Title: Re: Competition
Post by: bplus on October 03, 2021, 10:55:44 pm

@johnno56

I came up with genius solution for easier input of letters with spacebar. I have puzzle reworked but it needs your assets magic specially for Halloween Theme. It would be really cool if a ghostly voice read back the selected letters or 1 thru 4 digits for verification, plus, any other effects that Moo ha ha mind of yours may come up with.

Title: Re: Competition
Post by: johnno56 on October 04, 2021, 12:39:21 am

Hmm... Manipulating sound files; To make them sound 'creepy'; 26 letters and 4 digits; For a Halloween theme you say?

There is a clueless percentage of the Australian population that seems to want to 'acquire' that dubious celebration... But 'this' household does not and will not support those sugar-craving little urchins... Sorry. I digress... Discussion for another time...

I am not a wizard, when it comes to sound files, but I can "give it a shot". Sounds (no pun intended) like fun...

Did you have a "background" track in mind (eg: graveyard sounds; music etc)?

Title: Re: Competition
Post by: Pete on October 04, 2021, 02:37:27 am

I tried programming Steve's Candy Submarine in SCREEN 0, but so far all I've got is a CANDY ASCII SUB.

t
Pe e

Title: Re: Competition
Post by: bplus on October 04, 2021, 08:41:21 am

Quote from: johnno56 on October 04, 2021, 12:39:21 am

Hmm... Manipulating sound files; To make them sound 'creepy'; 26 letters and 4 digits; For a Halloween theme you say?

Yes :)

Quote from: johnno56 on October 04, 2021, 12:39:21 am

There is a clueless percentage of the Australian population that seems to want to 'acquire' that dubious celebration... But 'this' household does not and will not support those sugar-craving little urchins... Sorry. I digress... Discussion for another time...

Remember Trick or Treat is 2 options, if you are not into rotting out children's teeth then you must treat them with a trick, something that will scare them away permanently eg, tell them how much coffee you drink every day! ;-))

Quote from: johnno56 on October 04, 2021, 12:39:21 am

I am not a wizard, when it comes to sound files, but I can "give it a shot". Sounds (no pun intended) like fun...
Did you have a "background" track in mind (eg: graveyard sounds; music etc)?

Nothing particular in my mind, I will leave it up to the Moo ha ha Dept.

I will post my Halloween Challenge game here with Screen 0 and start working on some graphics effects for Syntax where Screen 0 is not required. I found myself limited by weird color pallet of Screen 0 high red (12) looks pink to me.

Title: Re: Competition
Post by: johnno56 on October 04, 2021, 09:21:13 am

Fascinating. Trick OR treat, you say?

Ok. No sugar it is... My next question, in regards to 'Tricks', I wonder if it is illegal to set 'man traps' in Australia? I'm thinking of camouflaged, bamboo spiked, snake pits.... None of these woosie jumping spiders or meat-starved pit bulls.... Oh. Hang on. The parents may have developed an attachment to the little terrors and they may want them back... Ok. Scratch the woosie spiders...

Title: Re: Competition
Post by: SMcNeill on October 04, 2021, 09:53:46 am

@bplus Remember, with _PALETTECOLOR, you can set your own custom colors for a SCREEN 0 program. Might be important for setting the right tone for your game, since you're limited to a max of 16 colors.

Title: Re: Competition
Post by: bplus on October 04, 2021, 10:07:26 am

Great! Thanks @Steve ha, ha @SMcNeill

Title: Re: Competition
Post by: TempodiBasic on October 04, 2021, 07:53:24 pm

@bplus
ok man, so ANY kind of game is welcome, text adventure, dugeon, puzzle, card game, platform, shooter, fighting and so on... all in ASCII with 16 color plus blinking! (0-31 = 32 colors to use), yes sound and music.
Let's go!

Title: Re: Competition
Post by: bplus on October 04, 2021, 08:21:48 pm

Quote from: TempodiBasic on October 04, 2021, 07:53:24 pm

@bplus
ok man, so ANY kind of game is welcome, text adventure, dugeon, puzzle, card game, platform, shooter, fighting and so on... all in ASCII with 16 color plus blinking! (0-31 = 32 colors to use), yes sound and music.
Let's go!

Great, and the most important thing, One Key only (except maybe an esc to quit).

Title: Re: Competition
Post by: bplus on October 05, 2021, 03:32:39 am

You know, I was saying Screen 0 (Text) for Competition for this forum challenge but I am having 2nd thoughts.

It really should be Halloween Themed and for that graphic freedom is essential.

I was saying Screen 0 (Text) to maybe get @Pete involved but he was kidding and my program needs some graphics distractions :-)) (In fact the one key requirement makes it a bit of a pig that probably won't be fixed by graphics lipstick. I need to find some idea made for one key control like Flappy Bird.)

So if OK with you guys forget Screen 0 Text only requirement unless you've already started on something. Let's say extra points if you do pull off a Screen 0 Text only Game and that wouldn't need to be so Halloween themed.

So either one key control text game or one key control Halloween theme game and extra credit for doing both text and Halloween.

(Yeah, I want to get @Dav latest game qualified.)

Title: Re: Competition
Post by: johnno56 on October 05, 2021, 07:22:49 am

I have created 62 audio files.
Complete alphabet - includes 1-4 in wav and ogg (2 files)
30 individual letters - including 1-2 in wav and ogg (60 files)

They total to just over 6mb. Voice is female. No special effects.

[ This attachment cannot be displayed inline in 'Print Page' view ]
(sample - alphabet + 1 to 4)

If this is ok, let me know, and I will post the rest.

J

Title: Re: Competition
Post by: bplus on October 05, 2021, 09:46:42 am

Thanks @johnno56 I'll get to work on it today.

Title: Re: Competition
Post by: bplus on October 05, 2021, 01:16:31 pm

Hi @johnno56

Oh! It's just one sample ogg.

I thought you said 60 files, well what can I say didn't have my coffee yet.

Is it possible to get a deep, dark, Moo ha ha kind of voice saying or implying:
"So, you've selected B, (Moo ha ha, well let's just see how that works out for you, Moo ha ha)."

Or we could do good voice (female computer like when the guess is correct), bad voice (Moo ha ha devil may care like when the guess is wrong!) routine.

Title: Re: Competition
Post by: bplus on October 05, 2021, 01:32:01 pm

Quote from: bplus on October 05, 2021, 01:16:31 pm

Hi @johnno56

Oh! It's just one sample ogg.

I thought you said 60 files, well what can I say didn't have my coffee yet.

Is it possible to get a deep, dark, Moo ha ha kind of voice saying or implying:
"So, you've selected B, (Moo ha ha, well let's just see how that works out for you, Moo ha ha)."

Or we could do good voice (female computer like when the guess is correct), bad voice (Moo ha ha devil may care like when the guess is wrong!) routine.

Oh man, I've been watching to much TV, too much Me Too political correctness???
ie female = good, masculine deep voiced male = bad

Please reverse good and bad characterization stereotypes, please, let's buck this trend!

Title: Re: Competition
Post by: SMcNeill on October 05, 2021, 01:36:39 pm

@bplus So here's a quick question: Would something like this work as a valid entry for the One Input challenge?

Code: QB64: [Select]

$Color:32
$Console
_Console On
Screen _NewImage(640, 480, 32)
 
Do
    x = OneInput
    Print x; Chr$(x)
    _Limit 30
Loop Until _KeyDown(27)
 
Function OneInput
    Static InputScreen
    If StaticScreen = 0 Then
        StaticScreen = _NewImage(400, 400, 32)
        D = _Dest
        _Dest StaticScreen
        For i = 1 To 26
            x = 200 + 150 * Sin(_D2R(13.85 * i))
            y = 200 + 150 * Cos(_D2R(13.85 * i))
            CircleFill x, y, 16, &HFFFFFF00
            Color &HFFFF0000, 0
            _PrintString (x - 8, y - 4), Chr$(64 + i)
        Next
        temp$ = "Move mouse to choice"
        l = _PrintWidth(temp$)
        _Dest StaticScreen
        _PrintString ((400 - l) / 2, 196), temp$
        _Dest D
    End If
 
 
    PCopy 0, 1
    _PutImage ((_Width - 400) / 2, (_Height - 400) / 2), StaticScreen
    _MouseMove _Width / 2, _Height / 2
    _Delay .2
    While _MouseInput: Wend 'clear mousebuffer after move
    Do
        While _MouseInput: Wend
        mx = _MouseX: my = _MouseY
        For i = 1 To 26
            x = _Width / 2 + 150 * Sin(_D2R(13.85 * i))
            y = _Height / 2 + 150 * Cos(_D2R(13.85 * i))
            If InCircle(mx, my, x, y, 16) Then Exit Do
        Next
    Loop
    OneInput = 64 + i
    PCopy 1, 0
End Function
 
Sub CircleFill (CX As Integer, CY As Integer, R As Integer, C As _Unsigned Long)
    ' CX = center x coordinate
    ' CY = center y coordinate
    '  R = radius
    '  C = fill color
    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
 
Function InCircle (px, py, cx, cy, r)
    distX = px - cx
    distY = py - cy
    distance = Sqr((distX * distX) + (distY * distY))
    If (distance <= r) Then temp = -1
    InCircle = temp
End Function
 

I'm only using one input feed for my program here -- the mouse position itself. It doesn't care about mouseclicks, or up or down positions, or anything of that sort... Just how you move the trackball itself.

Is there any reason why a trackball wouldn't count as "One Input", since it's only that one input segment of a mouse, much like the "Spacebar" is only that single segment of our keyboard??

Personally, I find this to be perhaps the most intuitive of input methods that I can come up with that only involves a single input feed.

Title: Re: Competition
Post by: bplus on October 05, 2021, 02:01:34 pm

Hi Steve,

I had something like that in mind too, when I first read of this competition at Syntax.

I ruled it out for myself because I was sure that this part:

Code: QB64: [Select]

    DO
        WHILE _MOUSEINPUT: WEND
        mx = _MOUSEX: my = _MOUSEY
        FOR i = 1 TO 26
            x = _WIDTH / 2 + 150 * SIN(_D2R(13.85 * i))
            y = _HEIGHT / 2 + 150 * COS(_D2R(13.85 * i))
            IF InCircle(mx, my, x, y, 16) THEN EXIT DO
        NEXT
    LOOP
 

Decides in an analog manner by position instead of a simple On/Off signal from a button eg you can use the fact the mouse was clicked, On/Off, but you can't use the place where it was clicked, that would be analog position control.

If you want to appeal my ruling I can take your case to the Syntax Bomb forum for the Supreme Court judge to rule ie, just link Qube to this discussion. I am pretty sure he would agree with me, but again I could be wrong, it wouldn't be the first time.

Title: Re: Competition
Post by: bplus on October 05, 2021, 02:07:32 pm

@SMcNeill

BTW that is a nice realization in code of what I was thinking and I know you want to stress that you didn't click anything!

You could alternately use Atan2 after the mouse is a certain distance away to pick up the general direction of choice so that it's not forced to remain in a the circle.

Title: Re: Competition
Post by: SMcNeill on October 05, 2021, 02:09:49 pm

Quote from: bplus on October 05, 2021, 02:07:32 pm

@SMcNeill

BTW that is a nice realization in code of what I was thinking and I know you want to stress that you didn't click anything!

You could alternately use Atan2 after the mouse is a certain distance away to pick up the general direction of choice so that it's not forced to remain in a the circle.

Quote from: MikeHart on August 14, 2021, 06:56:10
Question: does one feature of a controlling device include an axxis of a Mouse or a Stick on a gamepad, an analog button on a gamepad? Or are we bound to Buttons with 2 states, on and off?

Answer:
Single on / off state be it a key on a keyboard, click on a mouse, button on a joystick / joypad ( X Y etc ). No analog input for main gameplay.

Title: Re: Competition
Post by: SMcNeill on October 05, 2021, 02:11:55 pm

So I guess the timed spacebar method is my best input idea so far.

Or morse code. LOL!

Title: Re: Competition
Post by: bplus on October 05, 2021, 02:25:50 pm

Quote from: SMcNeill on October 05, 2021, 02:11:55 pm

So I guess the timed spacebar method is my best input idea so far.

Or morse code. LOL!

Yes! Morse code I think is OK because timers are OK. Even though something in time is a position, whether it's past a certain point or not is On/Off or Yes/No or True/False = Digital. So Morse code would be acceptable but who wants to learn it. The game would have to teach it in fun way to be a winner. It's a possibility.

Title: Re: Competition
Post by: johnno56 on October 05, 2021, 03:33:56 pm

Oh, a neural interface is looking better all the time... Moo Ha Ha... "Igor! Throw the switch!" "Yes, master."

Title: Re: Competition
Post by: johnno56 on October 05, 2021, 03:37:38 pm

bplus,

Here is another "sample". Added a slight echo and modified the pitch... If you like it then I will whip up a batch....

[ This attachment cannot be displayed inline in 'Print Page' view ]

In reference to, "So you have selected..." Maybe better to have a small "pool" of responses rather than "selected B", "chosen B" "picked B". Play a random 'pool' response followed by the letter? Just a thought. By the way... The voice does not have a sinister laugh... Cool if it did... I will look for one... *sigh*

Title: Re: Competition
Post by: bplus on October 05, 2021, 05:20:39 pm

@johnno56

000.ogg is getting close, lower and stretch out more?

Yes, like idea of random Your selection was X, you chose X, OK x it is... I don't know how much work I am asking of you.

I don't know if I should encourage this but: (Moo ha ha help from Petr and something from Sound Bible I think.)

Title: Re: Competition
Post by: johnno56 on October 05, 2021, 07:46:12 pm

Slightly modified (deeper). Also a sample of comments.

[ This attachment cannot be displayed inline in 'Print Page' view ]
[ This attachment cannot be displayed inline in 'Print Page' view ]

Cool laugh tracks....

Title: Re: Competition
Post by: bplus on October 05, 2021, 09:06:53 pm

Yeah ominous nonhuman voice, pretty good. :)

Title: Re: Competition
Post by: random1 on October 05, 2021, 09:48:10 pm

This is a game I built a while back for my grand kids. It's controlled completely by left
mouse button. It has 10 repeating levels where the amount of time the shooter has is
reduced for each level. I think I made it to level 4 once. I did however add a cheat
that allowed me to kill all the bugs in time.
The only thing with entering the contest was that several of the background screens,
music and sounds downloaded from the web.

R1

Picture
https://i.postimg.cc/x1Qk9tmC/BUGS.png (https://i.postimg.cc/x1Qk9tmC/BUGS.png)

level 10
https://i.postimg.cc/Y2gnVCzH/level-10.png (https://i.postimg.cc/Y2gnVCzH/level-10.png)

Title: Re: Competition
Post by: johnno56 on October 05, 2021, 11:35:56 pm

bplus,

Here is the complete set of 'version 2' audio files. Alphabet, digits and comments.

[ This attachment cannot be displayed inline in 'Print Page' view ]

Let me know about the comments. It may be just my hearing, but some of them can be a little hard to make out. Let me know which ones and I will make them a bit louder.

J

Title: Re: Competition
Post by: bplus on October 06, 2021, 08:58:02 am

Thanks @johnno56

I just started converting to a graphics screen so I can add visual effects. I found some old code by Petr that was reading off letters from words input using data stored in the program. Voice too nice though. I also found a worm screen eater by @RhoSigma that seemed like a good idea for a Crypt setting. Probably code it my own way.

Title: Re: Competition
Post by: bplus on October 06, 2021, 09:03:27 am

Quote from: random1 on October 05, 2021, 09:48:10 pm

This is a game I built a while back for my grand kids. It's controlled completely by left
mouse button. It has 10 repeating levels where the amount of time the shooter has is
reduced for each level. I think I made it to level 4 once. I did however add a cheat
that allowed me to kill all the bugs in time.
The only thing with entering the contest was that several of the background screens,
music and sounds downloaded from the web.

R1

Picture
https://i.postimg.cc/x1Qk9tmC/BUGS.png (https://i.postimg.cc/x1Qk9tmC/BUGS.png)

level 10
https://i.postimg.cc/Y2gnVCzH/level-10.png (https://i.postimg.cc/Y2gnVCzH/level-10.png)

Did you use a rail gun that just went back and forth across the screen automatically, you shoot with spacebar for the one key control? Did bugs move?

Missile Command could be setup like that, you have to anticipate where your missile collides with enemy missile or bomb coming down.

Title: Re: Competition
Post by: bplus on October 06, 2021, 01:14:25 pm

Quote from: johnno56 on October 05, 2021, 11:35:56 pm

bplus,

Here is the complete set of 'version 2' audio files. Alphabet, digits and comments.

[ This attachment cannot be displayed inline in 'Print Page' view ]

Let me know about the comments. It may be just my hearing, but some of them can be a little hard to make out. Let me know which ones and I will make them a bit louder.

J

The most garbled confirmation of Choice to my ears is "The Letter Is", the rest are good or good enough.

Letter W is horrible! Try 2 words "Double You"??
N, U, X are weak, the rest are good or good enough.

Thank the gods that oggs are working a little better in Windows 10, not crashing but File Explorer not exactly happy with so many in one folder and sometimes hangs and sometimes just exits the folder. At least no crash! :)

I hope everyone knows even though this dialog is seems mostly between Johnno and I, the files can be shared (between QB64 forum members for Hobby Programming purposes only), right @johnno56 ?

Title: Re: Competition
Post by: johnno56 on October 06, 2021, 10:04:07 pm

I think that lowering the pitch of the audio may be the problem. I will attempt to "tweak" them or try your "double you" trick or even use a different comment...

Title: Re: Competition
Post by: Pete on October 07, 2021, 12:43:11 am

There's always my game...

Code: QB64: [Select]

DEFINT I
DIM SHARED lmargin%, rmargin%, topmargin%, screenwidth%, level, ibk, ileadingrow
DIM SHARED irow, icol, inextrnd, imaxalienmissiles, alienforce%, ileadingmax, imaxalienforce, ihits
 
imaxalienforce = 6
imaxalienmissiles = 3
lmargin% = 2
rmargin% = 79
topmargin% = 3
ialiencolstat = 6
iwin = 3
screenwidth% = rmargin% - lmargin% + 1
ibk = 1
 
DIM SHARED a(imaxalienforce) AS STRING * 68
 
RANDOMIZE TIMER
SCREEN 0, 0, 0, 0
COLOR 7, 1: CLS
 
REM Make aliens
a1$ = "-<" + CHR$(237) + ">-  "
a$ = a1$ + a1$ + a1$ + a1$ + a1$ + a1$ + a1$ + a1$ + a1$ + a1$
 
CALL qbide
CALL instructions
 
DO
    IF inextrnd = -1 THEN PCOPY 3, 0
    tank$ = CHR$(218) + CHR$(127) + CHR$(191): icolor = 7
    REDIM SHARED bullet%(5), bulletcol%(5), bulletdelay%(5), iltalien(imaxalienforce)
    REDIM SHARED ia(imaxalienmissiles), iy(imaxalienmissiles), ix(imaxalienmissiles)
    REDIM SHARED matrix(imaxalienforce) AS STRING * 10
    alienforce% = imaxalienforce
    level = .65
    iround = iround + 1
    level = level - iround / 15
    inextrnd = -1
    COLOR 7, ibk
 
    REM Set up aliens
    ialiencol = ialiencolstat
    LOCATE 2, ialiencol
    FOR i = 1 TO imaxalienforce
        IF i MOD 1 = 0 THEN PRINT
        LOCATE , ialiencol
        IF i = imaxalienforce THEN ileadingrow = CSRLIN: ileadingmax = ileadingrow
        a(i) = a$
        PRINT a(i)
    NEXT
 
    REM Station
    LOCATE 24, 40, 1, 7, 7
    PRINT tank$;: LOCATE , POS(1) - 2: tanky% = CSRLIN: tankx% = POS(1) + 1
    key$ = INKEY$: SLEEP 1
 
    DO
        z1 = TIMER
        DO
            IF topmargin% + ileadingmax - (imaxalienforce * 2) >= topmargin% + 2 THEN
                IF imothership <> 0 THEN CALL mship(imothership)
            END IF
            IF ABS(TIMER - z1aliens) > level THEN
                CALL movealiens(ialiencol, ialiencolstat, iresults)
                z1aliens = TIMER
            END IF
            IF iresults < 0 THEN EXIT DO
            IF ABS(TIMER - z1ia) > .3 THEN CALL alienmissile(iresults): z1ia = TIMER
 
            DEF SEG = 0
            IF PEEK(1047) MOD 16 = 7 OR PEEK(1047) MOD 16 = 8 THEN
                key$ = CHR$(32) ' Alt
            ELSE
                key$ = ""
            END IF
            DEF SEG
 
            SELECT CASE key$
                CASE CHR$(32)
                    IF flag = 0 THEN switch = switch * -1 - 1: flag = -1
                    SELECT CASE switch
                        CASE 0
                            IF ABS(z9 - TIMER) > .15 THEN
                                IF POS(1) < screenwidth% THEN COLOR icolor, ibk: LOCATE , POS(1) - 1: PRINT " " + tank$;: LOCATE , POS(1) - 2
                                tanky% = CSRLIN: tankx% = POS(1)
                                IF SCREEN(tanky%, tankx% - 2) = 25 OR SCREEN(tanky%, tankx% + 2) = 25 THEN result = -1: EXIT DO
                                z9 = TIMER
                            END IF
                        CASE -1
                            IF ABS(z9 - TIMER) > .15 THEN
                                IF POS(1) > lmargin% + 1 THEN COLOR icolor, ibk: LOCATE , POS(1) - 2: PRINT tank$ + " ";: LOCATE , POS(1) - 3
                                tanky% = CSRLIN: tankx% = POS(1)
                                IF SCREEN(tanky%, tankx% - 2) = 25 OR SCREEN(tanky%, tankx% + 2) = 25 THEN result = -1: EXIT DO
                                z9 = TIMER
                            END IF
                    END SELECT
                    IF icolor = 7 THEN
                        FOR i2 = 1 TO 5
                            IF bullet%(i2) = 0 THEN
                                icolor = 12: COLOR icolor, ibk: GOSUB redraw
                                bullet%(i2) = -1: reload = TIMER: EXIT FOR
                            END IF
                        NEXT
                    END IF
                CASE ""
                    IF flag THEN skip = 0: flag = 0
                CASE CHR$(27): SYSTEM
            END SELECT
 
            IF ABS(z1 - reload) > .6 AND reload <> 0 THEN
                GOSUB redraw
                icolor = 7: reload = 0
            END IF
 
            REM Fire
            FOR i = 1 TO 5
                SELECT CASE bullet%(i)
                    CASE -1: bullet%(i) = tanky% - 1: bulletcol%(i) = tankx%
                    CASE IS > 0
                        IF bulletdelay%(i) = -1 OR bullet%(i) = tanky% - 1 THEN
                            CALL checkcollision(ihitaliens, ialiencol, i4, i)
                            z2bullet = TIMER: bulletdelay%(i) = 0
                            COLOR 7, ibk
                            LOCATE bullet%(i), bulletcol%(i)
                            IF bullet%(i) = topmargin% AND imothership <> 0 THEN
                                IF SCREEN(ABS(bullet%(i)), bulletcol%(i)) <> 32 THEN
                                    SOUND 1000, .75
                                    LOCATE topmargin%, lmargin%: PRINT SPACE$(screenwidth%);
                                    imothership = 0
                                END IF
                            END IF
                            PRINT CHR$(24)
                            IF CSRLIN <> 24 THEN LOCATE , bulletcol%(i): PRINT " ";
                            IF ihitaliens <> 0 THEN CALL reprintaliens(ialiencol, ihitaliens, iresults, i4, i, imothership)
                            LOCATE tanky%, tankx%
                            IF bullet%(i) > topmargin% THEN
                                bullet%(i) = bullet%(i) - 1
                            ELSE
                                GOSUB erasebullet
                            END IF
                        END IF
                END SELECT
            NEXT
 
            REM Bullet timer delay
            IF z2bullet <> 0 THEN
                IF z1 < z2bullet THEN z2bullet = z2bullet - 86400
                IF z1 - z2bullet >= .06 THEN
                    FOR i2 = 1 TO 5
                        IF bullet%(i2) <> 0 THEN bulletdelay%(i2) = -1
                    NEXT i2
                END IF
                EXIT DO
            END IF
        LOOP
        IF iresults < 0 THEN EXIT DO
        IF alienforce% = 0 OR iresults = iwin THEN
            FOR i = 1 TO imaxalienmissiles
                IF ia(i) <> 0 THEN EXIT FOR
            NEXT
            IF i > imaxalienmissiles THEN iwait = -1
            IF iwait = -1 THEN
                EXIT DO
            END IF
        ELSE
            iwait = 1
        END IF
    LOOP
 
    key$ = INKEY$
    SLEEP 2
    IF iresults = iwin OR iresults < 0 THEN
        REM end game
        EXIT DO
    END IF
    inextrnd = -1
LOOP
SELECT CASE iresults
    CASE IS < 0
        COLOR 7, ibk
        LOCATE tanky% - 1, lmargin%
        PRINT SPACE$(screenwidth%);
        LOCATE tanky%, lmargin%
        PRINT SPACE$(screenwidth%);
        key$ = INKEY$
        SOUND 140, 2
        SLEEP 2
END SELECT
CALL qbide
CALL instructions
SYSTEM
 
erasebullet:
LOCATE ABS(bullet%(i)), bulletcol%(i): PRINT " ";
bullet%(i) = 0: bulletcol%(i) = 0: bulletdelay%(i) = 0
LOCATE tanky%, tankx%
RETURN
 
redraw:
COLOR , ibk: LOCATE tanky%, tankx% - 1: PRINT tank$;: LOCATE tanky%, tankx%: COLOR 7, ibk
RETURN
 
DATA " Loading..."
DATA "EOF"
DATA "Game Over. Thanks for playing..."
DATA "EOF2"
 
SUB alienattack (ialiencolstat, ialiencol)
    z2alienfire = TIMER
 
    i3 = INT(RND * 10)
    FOR i = 1 TO imaxalienmissiles
        IF ia(i) = 0 THEN
            FOR i2 = imaxalienforce TO 1 STEP -1
                IF RTRIM$(a(i2)) <> "" THEN
                    IF MID$(matrix(i2), i3 + 1, 1) <> "0" THEN
                        i4 = INSTR(i3 * 7 + 1, a(i2), CHR$(237)) + ialiencol
                        EXIT FOR
                    END IF
                END IF
            NEXT i2
            IF i4 <> 0 THEN
                ia(i) = (ileadingmax - (imaxalienforce - i2) * 2) * 80 + i4
                EXIT FOR
            END IF
        END IF
    NEXT i
 
END SUB
 
SUB alienmissile (iresults)
    irow = CSRLIN: icol = POS(1)
    FOR i = 1 TO imaxalienmissiles
        IF ia(i) <> 0 THEN
            IF iy(i) = 0 THEN
                iy(i) = ia(i) \ 80: ix(i) = ia(i) MOD 80
                IF ix(i) = 0 THEN ix(i) = screenwidth%
            END IF
            LOCATE iy(i) + 1, ix(i)
            COLOR 7, ibk
            IF CSRLIN <= 24 THEN
                IF CSRLIN = 24 THEN IF SCREEN(CSRLIN, ix(i)) <> 32 THEN iresults = -1
                PRINT CHR$(25);
            ELSE
                ia(i) = 0
                LOCATE iy(i), ix(i)
                PRINT " ";: iy(i) = 0
                ia(i) = 0
                LOCATE irow, icol
                EXIT SUB
            END IF
            LOCATE iy(i), ix(i): PRINT " ";
            iy(i) = iy(i) + 1
        END IF
    NEXT
    LOCATE irow, icol
 
END SUB
 
SUB checkcollision (ihitaliens, ialiencol, i4, i)
    ihitaliens = 0
    IF ileadingmax MOD 2 = bullet%(i) MOD 2 THEN
        i4 = imaxalienforce - (ileadingmax - bullet%(i)) \ 2
        IF bullet%(i) <= ileadingrow AND i4 > 0 AND i4 <= imaxalienforce THEN
            IF RTRIM$(a(i4)) <> "" THEN
                IF bulletcol%(i) >= iltalien(i4) AND bulletcol%(i) - ialiencol <= LEN(RTRIM$(a(i4))) THEN
                    IF MID$(a(i4), bulletcol%(i) - ialiencol, 1) > CHR$(32) THEN
                        ihitaliens = bulletcol%(i) - ialiencol + 1
                        i3 = ihitaliens - 7 + 1: IF i3 < 1 THEN i3 = 1: REM count from the "<" symbol.
                        i2 = INSTR(i3 + 1, a(i4), "<") - 1
                        MID$(a(i4), i2, 7) = SPACE$(7)
                        MID$(matrix(i4), (i2 + 1) \ 7 + 1, 1) = "0"
                    END IF
                END IF
            END IF
        END IF
    END IF
 
    FOR i2 = 1 TO imaxalienmissiles
        IF ia(i2) <> 0 THEN
            IF iy(i2) >= bullet%(i) AND ix(i2) = bulletcol%(i) THEN
                ihitaliens = -i2
                EXIT FOR
            END IF
        END IF
    NEXT
 
END SUB
 
SUB instructions
 
    ''in$ = "EOF"
    IF in$ = "" THEN
        key$ = INKEY$
        LOCATE 3, 3, 1, 7, 7: COLOR 7, ibk
        SLEEP 2
        DO
            READ in$
            IF MID$(in$, 1, 3) = "EOF" THEN EXIT DO
            FOR i = 1 TO LEN(in$)
                SOUND 400, .1
                LOCATE , 2 + i
                PRINT MID$(in$, i, 1);
                z = TIMER
                DO
                    IF ABS(z - TIMER) > .1 THEN EXIT DO
                LOOP
            NEXT
            LOCATE , , 0, 7, 0
            key$ = INKEY$
            SLEEP 1
            PRINT
            LOCATE , 3
        LOOP
        key$ = INKEY$
        SLEEP 1
    END IF
 
    IF in$ = "EOF" THEN
        COLOR 7, 1
        FOR i = 1 TO 5
            LOCATE 2 + i, 2: PRINT SPACE$(78)
        NEXT
        FOR i = 3 TO 24
            LOCATE i, 80: PRINT CHR$(179);
        NEXT
        LOCATE 21, 2: PRINT STRING$(78, " ");
        LOCATE 22, 1: PRINT CHR$(179);
        LOCATE 22, 80: PRINT CHR$(179);
        LOCATE 22, 2: PRINT STRING$(78, " ");
    ELSE
        COLOR 0, 3
    END IF
 
    COLOR 0, 3
    yy% = CSRLIN: xx% = POS(1)
    LOCATE 25, 76 - LEN(LTRIM$(STR$(ihits)))
    PRINT LTRIM$(STR$(ihits));
    LOCATE 25, 80 - LEN(LTRIM$(STR$(imaxalienforce - alienforce%)))
    PRINT "0";
    LOCATE yy%, xx%
 
    PCOPY 0, 3: REM save skin
 
END SUB
 
SUB marchdown (ialiencol, ialiencolstat, imotion, iresults)
    COLOR 7, ibk
    ileadingrow = ileadingrow + 1
    ileadingmax = ileadingmax + 1
    COLOR 7, ibk
    FOR i = 1 TO imaxalienforce
        IF RTRIM$(a(i)) <> "" THEN
            ialiencol = ialiencolstat + imotion
            LOCATE ileadingmax - (imaxalienforce * 2) + i * 2 - 1, lmargin%
            PRINT STRING$(screenwidth%, " ")
            LOCATE , ialiencol + INSTR(a(i), "-")
            iltalien(i) = POS(1)
            PRINT LTRIM$(RTRIM$(a(i)))
        END IF
    NEXT
    LOCATE irow, icol
    level = level - .025
    IF ileadingrow = 22 THEN iresults = -2
END SUB
 
DEFSNG I
DEFINT I
SUB movealiens (ialiencol, ialiencolstat, iresults)
    STATIC imotion, imarch, imotiondir
    IF inextrnd = -1 THEN inextrnd = 0: imotion = 0: imarch = 0: imotiondir = 0
    irow = CSRLIN: icol = POS(1)
    yy% = CSRLIN: xx% = POS(1)
    PCOPY 0, 1: SCREEN 0, 0, 1, 0: LOCATE yy%, xx%, 0, 7, 0
    IF imotiondir = 0 THEN imotion = imotion - 1 ELSE imotion = imotion + 1
    COLOR 7, ibk
 
    FOR i = imaxalienforce TO 1 STEP -1
        IF RTRIM$(a(i)) <> "" THEN
            i2 = i2 + 2
            SOUND 400, .03
            ialiencol = ialiencolstat + imotion
            LOCATE ileadingmax - (imaxalienforce - i) * 2, ialiencol + INSTR(a(i), "-")
            IF POS(1) = lmargin% THEN imarch = 1
            iltalien(i) = POS(1)
            IF imotiondir = 0 THEN
                PRINT LTRIM$(RTRIM$(a(i))); " "
            ELSE
                LOCATE , POS(1) - 1
                PRINT " "; LTRIM$(RTRIM$(a(i)))
            END IF
            IF ialiencol + LEN(RTRIM$(a(i))) = screenwidth% THEN imarch = -1
        END IF
    NEXT
 
    IF imarch = 1 THEN imotiondir = 1: CALL marchdown(ialiencol, ialiencolstat, imotion, iresults)
    IF imarch = -1 THEN imotiondir = 0: CALL marchdown(ialiencol, ialiencolstat, imotion, iresults)
    IF imarch = 0 THEN
        IF ABS(TIMER - z2alienfire) > firerate THEN
            firerate = (INT(RND * 10) + 1) / 20
            IF iwait = 0 THEN CALL alienattack(ialiencolstat, ialiencol)
        END IF
    ELSE
        imarch = 0
    END IF
    PCOPY 1, 0: SCREEN 0, 0, 0, 0
    LOCATE irow, icol, 1, 7, 7
END SUB
 
SUB mship (imothership)
    STATIC x%, mov%, z4, mothership$
 
    yy% = CSRLIN: xx% = POS(1): COLOR 7, ibk
    IF imothership = -1 THEN
        imothership = 1
        x% = lmargin%
        mothership$ = CHR$(254) + CHR$(254) + "O" + CHR$(254) + CHR$(254)
        mov% = 1
    END IF
 
    IF ABS(TIMER - z4) > .05 THEN GOSUB mothership: z4 = TIMER: LOCATE yy%, xx%: EXIT SUB
    ''IF ABS(TIMER - z2) > .2 THEN GOSUB bullets: z2 = TIMER
    LOCATE yy%, xx%
    EXIT SUB
 
    mothership:
    IF x% + LEN(mothership$) = screenwidth% + lmargin% THEN mov% = -1 ELSE IF x% = lmargin% THEN mov% = 1
    x% = x% + mov%
    LOCATE topmargin%, x%
    PRINT mothership$;
    IF x% > 1 AND mov% = 1 THEN
        LOCATE , POS(1) - LEN(mothership$) - 1: PRINT " ";
    END IF
    IF mov% = -1 THEN PRINT " ";
    RETURN
 
END SUB
 
DEFINT A-H, J-Z
SUB qbide
    PALETTE 2, 59
    COLOR 15, 1
    CLS
 
    COLOR 0, 7
    LOCATE 1, 1
    PRINT SPACE$(80)
    LOCATE 1, 1: PRINT "   File  Edit  View  Search  Run  Debug  Calls  Options                   Help"
 
    COLOR 7, 1
 
    LOCATE 2, 1: PRINT CHR$(218)
    LOCATE 2, 2: PRINT STRING$(78, CHR$(196))
    LOCATE 2, 80: PRINT CHR$(191)
 
    LOCATE 2, 76: PRINT CHR$(180)
    LOCATE 2, 78: PRINT CHR$(195)
 
    COLOR 1, 7
    LOCATE 2, 77: PRINT CHR$(24)
    LOCATE 2, 36: PRINT " Untitled "
 
    COLOR 7, 1
    FOR Rows = 3 TO 24
        LOCATE Rows, 1: PRINT CHR$(179);
        LOCATE Rows, 80: PRINT CHR$(179);
    NEXT Rows
 
    LOCATE 22, 1: PRINT CHR$(195)
    LOCATE 22, 80: PRINT CHR$(180)
    LOCATE 22, 2: PRINT STRING$(78, CHR$(196))
    LOCATE 22, 35
    PRINT " Immediate "
 
    COLOR 0, 7
    LOCATE 21, 3: PRINT STRING$(76, CHR$(176))
    LOCATE 21, 2: PRINT CHR$(27)
    LOCATE 21, 3: PRINT CHR$(219)
    LOCATE 21, 79: PRINT CHR$(26)
    FOR Rows = 4 TO 19
        LOCATE Rows, 80: PRINT CHR$(176)
    NEXT Rows
    LOCATE 3, 80: PRINT CHR$(24)
    LOCATE 4, 80: PRINT CHR$(219)
    LOCATE 20, 80: PRINT CHR$(25)
 
    COLOR 0, 3: LOCATE 25, 1: PRINT " <Shift+F1=Help> <F6=Window> <F2=Subs> <F5=Run> <F8=Step> ";
    LOCATE 25, 59: PRINT SPACE$(4);
    COLOR 0, 3
    LOCATE 25, 63: PRINT CHR$(179);
    LOCATE 25, 64: PRINT SPACE$(6);
    LOCATE 25, 68: PRINT "C  00001:001 ";
 
END SUB
 
DEFSNG A-H, J-Z
SUB reprintaliens (ialiencol, ihitaliens, iresults, i4, i, imothership)
    IF ihitaliens > 0 THEN
        ihits = ihits + 1
        IF (ihits + 15) MOD 20 = 0 AND imothership = 0 THEN imothership = -1
        LOCATE bullet%(i), lmargin%: PRINT SPACE$(screenwidth%);
        iltalien(i4) = POS(1)
 
        IF RTRIM$(a(i4)) = "" THEN
            alienforce% = alienforce% - 1
            IF alienforce% = 0 THEN iresults = iresults + 1
            IF bullet%(i) = ileadingrow THEN ileadingrow = ileadingrow - 2
        ELSE
            LOCATE bullet%(i), ialiencol + INSTR(a(i4), "-"): PRINT LTRIM$(RTRIM$(a(i4)))
        END IF
    ELSE
        i2 = ABS(ihitaliens)
        LOCATE iy(i2), ix(i2)
        PRINT " ";: iy(i2) = 0
        ia(i2) = 0
        LOCATE irow, icol
        SOUND 1000, .5
    END IF
 
    ihitaliens = 0
    bullet%(i) = -bullet%(i)
 
    COLOR 0, 3
    yy% = CSRLIN: xx% = POS(1)
    LOCATE 25, 76 - LEN(LTRIM$(STR$(ihits)))
    PRINT LTRIM$(STR$(ihits));
    LOCATE 25, 80 - LEN(LTRIM$(STR$(imaxalienforce - alienforce%)))
    PRINT LTRIM$(STR$(imaxalienforce - alienforce%));
    LOCATE yy%, xx%
    COLOR 7, ibk
END SUB
 

One key: Alt

Hold down to mve and shoot. Release to stop. Hold down again to reverse direction and shoot.

Pete

Title: Re: Competition
Post by: bplus on October 07, 2021, 12:52:31 am

Definitely nice one key game! Nice to see that every now and then.

Title: Re: Competition
Post by: Pete on October 07, 2021, 12:57:25 am

Thanks! I removed the mouse control option and got rid of the arrow right and left. Thanks to PEEK / POKE support, it which doesn't miss key held status, a single key can b used. It's actually more challenging this way. Not bad for a half days work, made over 12 years ago, as a spoof on why Rob hadn't got around to finishing the compiler!

Pete

Title: Re: Competition
Post by: johnno56 on October 07, 2021, 03:43:32 am

Cool game... Cleared the "first wave" (without dying!!!) but not so lucky with the second... A game that I could play without dying too much... A score / hiscore would be nice... I cannot boast about the fact that I survived without a score to convince others... This is so sad...

Title: Re: Competition
Post by: bplus on October 07, 2021, 11:37:38 am

@Pete Yeah add a high score record keeper, maybe update the spoof for less niche audience.

This game is real contender, it seemsmuch improved with one key control over the version using arrow keys.
You should see the cost cutting they did on my keyboard for arrow keys! I am considering recommending to Qwerkey for Samples, such a Classic in a new improved light, specially now that Johnno says you can actually get through level 1.

Title: Re: Competition
Post by: Pete on October 07, 2021, 03:26:25 pm

It would need some tweaking to be an actual game. BTW - I only tested it on level 1. Got through it, and I think the next two levels add a bit more difficulty. It's been so long since I've played the real Space Invaders, on an Atari. I think there was a bonus for each time you blew up the mother ship, and probably a set number of points for each alien fighter destroyed. I believe the game also had three barriers you could hide behind, but they were progressively broken apart by alien missiles. I can't remember if they regenerated or not in subsequent levels.

Anyway, if I had to give this thing a name, I'd guess I'd call it, QB64 ASCII Invaders

Pete

Title: Re: Competition
Post by: bplus on October 07, 2021, 03:36:49 pm

Hmm... what if mother ship were an ascii witch or harvest man in the moon and the alien fighters ascii bats?

You know, to get into Halloween spirit and extra credit ;-))

Title: Re: Competition
Post by: Pete on October 07, 2021, 04:24:25 pm

Consider you guys lucky I didn't code ASCII fighters as: (_|_)

And no, that's not a pumpkin.

Pete

Title: Re: Competition
Post by: Pete on October 07, 2021, 08:10:57 pm

Okay, fine...

Halloween theme engaged. Watch out for stormy weather.

Code: QB64: [Select]

DIM SHARED intro%: intro% = -1
skip_intro:
DEFINT I
DIM SHARED lmargin%, rmargin%, topmargin%, screenwidth%, level, ibk, ileadingrow
DIM SHARED irow, icol, inextrnd, imaxalienmissiles, alienforce%, ileadingmax, imaxalienforce, ihits, score$
 
_SCREENMOVE _MIDDLE
score$ = "000000"
imaxalienforce = 6
imaxalienmissiles = 3
lmargin% = 2
rmargin% = 79
topmargin% = 3
ialiencolstat = 6
iwin = 3 ' 3 Levels.
screenwidth% = rmargin% - lmargin% + 1
ibk = 0 ' Background color
 
DIM SHARED a(imaxalienforce) AS STRING * 68
 
RANDOMIZE TIMER
SCREEN 0, 0, 0, 0
COLOR 7, 0: CLS
 
REM Make aliens
a1$ = "^^" + CHR$(79) + "^^  "
a$ = a1$ + a1$ + a1$ + a1$ + a1$ + a1$ + a1$ + a1$ + a1$ + a1$
 
IF intro% THEN
    SCREEN 0, 0, 1, 1
    CALL qbideOrig
 
    SCREEN 0, 0, 2, 0
    CALL qbide
 
    SCREEN 0, 0, 1, 1
    _DELAY 2
 
    SOUND 1000, .3: SOUND 2400, .6:: SOUND 700, 2
    FOR i = 1 TO 15
        _DELAY i / 150
        IF i / 2 = i \ 2 THEN
            SOUND 250, .1
            SCREEN 0, 0, 1, 1
        ELSE
            SCREEN 0, 0, 2, 2
            IF i < 13 THEN _DELAY i / 100: SCREEN 0, 0, 3, 3: COLOR 0, 7: CLS
        END IF
    NEXT
    PCOPY 2, 0
    SCREEN 0, 0, 0, 0
ELSE
    CALL qbide
END IF
 
IF intro% = -1 THEN RESTORE first_play ELSE RESTORE replay
 
CALL instructions
 
DO
    IF inextrnd = -1 THEN PCOPY 3, 0
    tank$ = CHR$(218) + CHR$(127) + CHR$(191): icolor = 6
    REDIM SHARED bullet%(5), bulletcol%(5), bulletdelay%(5), iltalien(imaxalienforce)
    REDIM SHARED ia(imaxalienmissiles), iy(imaxalienmissiles), ix(imaxalienmissiles)
    REDIM SHARED matrix(imaxalienforce) AS STRING * 10
    alienforce% = imaxalienforce
    level = .65
    iround = iround + 1
    level = level - iround / 15
    inextrnd = -1
    COLOR 6, ibk
 
    REM Set up aliens
    ialiencol = ialiencolstat
    LOCATE 2, ialiencol
    FOR i = 1 TO imaxalienforce
        IF i MOD 1 = 0 THEN PRINT
        LOCATE , ialiencol
        IF i = imaxalienforce THEN ileadingrow = CSRLIN: ileadingmax = ileadingrow
        a(i) = a$
        PRINT a(i)
    NEXT
 
    COLOR 0 + 16, 3
    LOCATE 25, 68: PRINT "Score ";
    COLOR 0, 3
    PRINT score$;
    COLOR 6, ibk
 
    REM Station
    LOCATE 24, 40
    tanky% = CSRLIN: tankx% = POS(0) + 1
    PRINT tank$;: LOCATE , POS(0) - 2
 
    _DELAY 1
 
    DO
        z1 = TIMER
        DO
            IF zbonus THEN
                IF ABS(zbonus - TIMER) > 1.5 THEN
                    yy% = CSRLIN: xx% = POS(0)
                    COLOR 6, 0: LOCATE topmargin%, lmargin%: PRINT SPACE$(screenwidth%);
                    LOCATE yy%, xx%
                    zbonus = 0
                END IF
            END IF
 
            IF topmargin% + ileadingmax - (imaxalienforce * 2) >= topmargin% + 2 THEN
                IF imothership <> 0 THEN CALL mship(imothership)
            END IF
            IF ABS(TIMER - z1aliens) > level THEN
                CALL movealiens(ialiencol, ialiencolstat, iresults)
                z1aliens = TIMER
            END IF
            IF iresults < 0 THEN EXIT DO
            IF ABS(TIMER - z1ia) > .3 THEN CALL alienmissile(iresults): z1ia = TIMER
 
            DEF SEG = 0
            IF PEEK(1047) MOD 16 = 7 OR PEEK(1047) MOD 16 = 8 THEN
                key$ = CHR$(32) ' Alt
            ELSE
                key$ = ""
            END IF
            DEF SEG
 
            SELECT CASE key$
                CASE CHR$(32)
                    IF flag = 0 THEN switch = switch * -1 - 1: flag = -1
                    SELECT CASE switch
                        CASE 0
                            IF ABS(z9 - TIMER) > .15 THEN
                                IF POS(0) < screenwidth% THEN COLOR icolor, ibk: LOCATE , POS(0) - 1: PRINT " " + tank$;: LOCATE , POS(0) - 2
                                tanky% = CSRLIN: tankx% = POS(0)
                                IF SCREEN(tanky%, tankx% - 2) = 25 OR SCREEN(tanky%, tankx% + 2) = 25 THEN result = -1: EXIT DO
                                z9 = TIMER
                            END IF
                        CASE -1
                            IF ABS(z9 - TIMER) > .15 THEN
                                IF POS(0) > lmargin% + 1 THEN COLOR icolor, ibk: LOCATE , POS(0) - 2: PRINT tank$ + " ";: LOCATE , POS(0) - 3
                                tanky% = CSRLIN: tankx% = POS(0)
                                IF SCREEN(tanky%, tankx% - 2) = 25 OR SCREEN(tanky%, tankx% + 2) = 25 THEN result = -1: EXIT DO
                                z9 = TIMER
                            END IF
                    END SELECT
                    IF icolor = 6 THEN
                        FOR i2 = 1 TO 5
                            IF bullet%(i2) = 0 THEN
                                icolor = 12: COLOR icolor, ibk: GOSUB redraw
                                bullet%(i2) = -1: reload = TIMER: EXIT FOR
                            END IF
                        NEXT
                    END IF
                CASE ""
                    IF flag THEN skip = 0: flag = 0
                CASE CHR$(27): SYSTEM
            END SELECT
 
            IF ABS(z1 - reload) > .6 AND reload <> 0 THEN
                GOSUB redraw
                icolor = 6: reload = 0
            END IF
 
            REM Fire
            FOR i = 1 TO 5
                SELECT CASE bullet%(i)
                    CASE -1: bullet%(i) = tanky% - 1: bulletcol%(i) = tankx%
                    CASE IS > 0
                        IF bulletdelay%(i) = -1 OR bullet%(i) = tanky% - 1 THEN
                            CALL checkcollision(ihitaliens, ialiencol, i4, i)
                            z2bullet = TIMER: bulletdelay%(i) = 0
                            COLOR 6, ibk
                            LOCATE bullet%(i), bulletcol%(i)
                            IF bullet%(i) = topmargin% AND imothership <> 0 THEN ' Hit mother ship.
                                IF SCREEN(ABS(bullet%(i)), bulletcol%(i)) <> 32 THEN
                                    SOUND 1000, .75
                                    SELECT CASE iresults + 1
                                        CASE 1: bonus = 1500
                                        CASE 2: bonus = 2500
                                        CASE 3: bonus = 5000
                                    END SELECT
                                    score$ = LTRIM$(STR$(VAL(score$) + bonus))
                                    score$ = STRING$(6 - LEN(score$), "0") + score$
                                    yy% = CSRLIN: xx% = POS(0)
                                    SOUND 800, .5: SOUND 1600, .5: SOUND 2400, .5
                                    LOCATE topmargin%, lmargin%: PRINT SPACE$(screenwidth%);
                                    kbonus = bulletcol%(i) - 4
                                    IF kbonus < lmargin% THEN kbonus = lmargin%
                                    IF kbonus + 10 > screenwidth% THEN kbonus = screenwidth% - 11
                                    zbonus = TIMER
                                    LOCATE yy%, xx%
                                    imothership = 0
                                END IF
                            END IF
                            PRINT CHR$(24) ' Tank missile.
                            IF CSRLIN <> 24 THEN LOCATE , bulletcol%(i): PRINT " ";
                            IF ihitaliens <> 0 THEN CALL reprintaliens(ialiencol, ihitaliens, iresults, i4, i, imothership)
                            LOCATE tanky%, tankx%
                            IF bullet%(i) > topmargin% THEN
                                bullet%(i) = bullet%(i) - 1
                            ELSE
                                GOSUB erasebullet
                            END IF
 
                            IF zbonus THEN
                                yy% = CSRLIN: xx% = POS(0)
                                LOCATE topmargin%, kbonus: COLOR 2 + 16: PRINT "BONUS " + LTRIM$(STR$(bonus));
                                LOCATE yy%, xx%
                            END IF
 
                        END IF
                END SELECT
            NEXT
 
            REM Bullet timer delay
            IF z2bullet <> 0 THEN
                IF z1 < z2bullet THEN z2bullet = z2bullet - 86400
                IF z1 - z2bullet >= .06 THEN
                    FOR i2 = 1 TO 5
                        IF bullet%(i2) <> 0 THEN bulletdelay%(i2) = -1
                    NEXT i2
                END IF
                EXIT DO
            END IF
        LOOP
        IF iresults < 0 THEN EXIT DO
        IF alienforce% = 0 OR iresults = iwin THEN
            FOR i = 1 TO imaxalienmissiles
                IF ia(i) <> 0 THEN EXIT FOR
            NEXT
            IF i > imaxalienmissiles THEN iwait = -1
            IF iwait = -1 THEN
                EXIT DO
            END IF
        ELSE
            iwait = 1
        END IF
    LOOP
 
    IF iresults = iwin OR iresults < 0 THEN
        REM end game
        EXIT DO
    END IF
    inextrnd = -1
LOOP
 
SELECT CASE iresults
    CASE -1 ' Tank destroyed!
        SOUND 800, .3: SOUND 250, 1
 
        FOR i = 1 TO 5
            COLOR 14, 4
            LOCATE tanky%, tankx% - 1: PRINT tank$;
            _DELAY .1
 
            COLOR 8, ibk
            LOCATE tanky%, tankx% - 1: PRINT tank$;
            _DELAY .1
        NEXT
 
        COLOR 6, ibk
        LOCATE tanky% - 1, lmargin%
        PRINT SPACE$(screenwidth%);
        LOCATE tanky%, lmargin%
        PRINT SPACE$(screenwidth%);
 
        _DELAY 2
 
        CALL qbide
 
    CASE -2 ' Aliens have landed!
        SOUND 1000, .3: SOUND 2400, .6:: SOUND 700, 2
 
        COLOR 7, 0
        FOR i = 0 TO 21 ' Blank out screen.
            LOCATE topmargin% + i, lmargin%: PRINT SPACE$(screenwidth%);
        NEXT
 
        COLOR 6, ibk
        LOCATE tanky% - 1, lmargin%
        PRINT SPACE$(screenwidth%);
        LOCATE tanky%, lmargin%
        PRINT SPACE$(screenwidth%);
 
        COLOR 8, ibk
 
        FOR j = imaxalienforce TO 1 STEP -1
            IF a(j) <> "" THEN EXIT FOR
        NEXT
 
        FOR i = j TO 1 STEP -1
            LOCATE , ialiencol + INSTR(a(i), "^^")
            PRINT LTRIM$(RTRIM$(a(i)));
            LOCATE CSRLIN - 1
        NEXT
 
        _DELAY 2.5
 
    CASE ELSE ' Winner.
 
        l$ = "12"
        n$ = "n29": PLAY "L" + l$ + n$: _DELAY .5
        n$ = "n24": PLAY "L" + l$ + n$: _DELAY .5
        n$ = "n33": PLAY "L" + l$ + n$: _DELAY .5
        n$ = "n29": PLAY "L" + l$ + n$
 
        CALL qbide
 
        RESTORE winner
 
END SELECT
 
 
COLOR 0, 3
LOCATE 25, 68: PRINT "Score "; score$;
 
CALL instructions
 
COLOR 6, 0
LOCATE 5, 3: PRINT "Score "; score$
 
DEF SEG = 0
DO
    _LIMIT 30
    b$ = INKEY$
    IF b$ = CHR$(27) THEN SYSTEM
    IF PEEK(1047) MOD 16 = 7 OR PEEK(1047) MOD 16 = 8 THEN EXIT DO
LOOP
DEF SEG
 
RUN skip_intro
 
erasebullet:
LOCATE ABS(bullet%(i)), bulletcol%(i): PRINT " ";
bullet%(i) = 0: bulletcol%(i) = 0: bulletdelay%(i) = 0
LOCATE tanky%, tankx%
RETURN
 
redraw:
COLOR , ibk: LOCATE tanky%, tankx% - 1: PRINT tank$;: LOCATE tanky%, tankx%: COLOR 7, ibk
RETURN
 
first_play:
DATA "The Great Pumpkin is coming and has fired an EM pulse."
DATA ""
DATA "All that's left working is your Alt key."
DATA ""
DATA "Happy Halloween!"
DATA ""
replay:
DATA "Loading..."
DATA "EOF"
DATA "Game Over. Thanks for playing..."
DATA "EOF2"
winner:
DATA "Congratulations, you saved the planet!"
DATA "EOF3"
 
 
SUB alienattack (ialiencol)
    z2alienfire = TIMER
 
    i3 = INT(RND * 10)
    FOR i = 1 TO imaxalienmissiles
        IF ia(i) = 0 THEN
            FOR i2 = imaxalienforce TO 1 STEP -1
                IF RTRIM$(a(i2)) <> "" THEN
                    IF MID$(matrix(i2), i3 + 1, 1) <> "0" THEN
                        i4 = INSTR(i3 * 7 + 1, a(i2), CHR$(79)) + ialiencol
                        EXIT FOR
                    END IF
                END IF
            NEXT i2
            IF i4 <> 0 THEN
                ia(i) = (ileadingmax - (imaxalienforce - i2) * 2) * 80 + i4
                EXIT FOR
            END IF
        END IF
    NEXT i
 
END SUB
 
SUB alienmissile (iresults)
    irow = CSRLIN: icol = POS(0)
    FOR i = 1 TO imaxalienmissiles
        IF ia(i) <> 0 THEN
            IF iy(i) = 0 THEN
                iy(i) = ia(i) \ 80: ix(i) = ia(i) MOD 80
                IF ix(i) = 0 THEN ix(i) = screenwidth%
            END IF
            LOCATE iy(i) + 1, ix(i)
            COLOR 6, ibk
            IF CSRLIN <= 24 THEN
                IF CSRLIN = 24 THEN IF SCREEN(CSRLIN, ix(i)) <> 32 THEN iresults = -1
                PRINT CHR$(25);
            ELSE
                ia(i) = 0
                LOCATE iy(i), ix(i)
                PRINT " ";: iy(i) = 0
                ia(i) = 0
                LOCATE irow, icol
                EXIT SUB
            END IF
            LOCATE iy(i), ix(i): PRINT " ";
            iy(i) = iy(i) + 1
        END IF
    NEXT
    LOCATE irow, icol
 
END SUB
 
SUB checkcollision (ihitaliens, ialiencol, i4, i)
    ihitaliens = 0
    IF ileadingmax MOD 2 = bullet%(i) MOD 2 THEN
        i4 = imaxalienforce - (ileadingmax - bullet%(i)) \ 2
        IF bullet%(i) <= ileadingrow AND i4 > 0 AND i4 <= imaxalienforce THEN
            IF RTRIM$(a(i4)) <> "" THEN
                IF bulletcol%(i) >= iltalien(i4) AND bulletcol%(i) - ialiencol <= LEN(RTRIM$(a(i4))) THEN
                    IF MID$(a(i4), bulletcol%(i) - ialiencol, 1) > CHR$(32) THEN
                        ihitaliens = bulletcol%(i) - ialiencol + 1
                        i3 = ihitaliens - 7 + 1: IF i3 < 1 THEN i3 = 1: REM count from the "<" symbol.
                        i2 = INSTR(i3 + 1, a(i4), "^" + CHR$(79)) - 1
                        MID$(a(i4), i2, 7) = SPACE$(7)
                        MID$(matrix(i4), (i2 + 1) \ 7 + 1, 1) = "0"
                    END IF
                END IF
            END IF
        END IF
    END IF
 
    FOR i2 = 1 TO imaxalienmissiles
        IF ia(i2) <> 0 THEN
            IF iy(i2) >= bullet%(i) AND ix(i2) = bulletcol%(i) THEN
                ihitaliens = -i2
                EXIT FOR
            END IF
        END IF
    NEXT
 
END SUB
 
SUB instructions
    IF in$ = "" THEN
        key$ = INKEY$
        LOCATE 3, 3, 1, 7, 0: COLOR 6, ibk
        _DELAY 2
        DO
            READ in$
            IF MID$(in$, 1, 3) = "EOF" THEN EXIT DO
            FOR i = 1 TO LEN(in$)
                SOUND 400, .07
                LOCATE , 2 + i
                PRINT MID$(in$, i, 1);
                z = TIMER
                DO
                    IF ABS(z - TIMER) > .08 THEN EXIT DO
                LOOP
            NEXT
            LOCATE , , 0, 7, 0
            _DELAY 1
            PRINT
            LOCATE , 3
        LOOP
        _DELAY 1
    END IF
 
    IF in$ = "EOF" THEN
        COLOR 7, 0
        FOR i = 0 TO 19 ' Blank out intro message space.
            LOCATE topmargin% + i, lmargin%: PRINT SPACE$(screenwidth%);
        NEXT
        FOR i = 3 TO 24
            LOCATE i, 80: PRINT CHR$(179);
        NEXT
        LOCATE 21, 2: PRINT STRING$(screenwidth%, " ");
        LOCATE 22, 1: PRINT CHR$(179);
        LOCATE 22, 80: PRINT CHR$(179);
        LOCATE 22, 2: PRINT STRING$(screenwidth%, " ");
    ELSE
        COLOR 0, 3
    END IF
 
    IF in$ <> "EOF2" AND iresults <> iwin THEN COLOR 0 + 16, 3 ELSE COLOR 0, 3
    yy% = CSRLIN: xx% = POS(0)
    LOCATE 25, 68: PRINT "Score ";
    COLOR 0, 3
    PRINT score$;
    LOCATE yy%, xx%
 
    PCOPY 0, 3: REM save skin
 
END SUB
 
SUB marchdown (ialiencol, ialiencolstat, imotion, iresults)
    COLOR 6, ibk
    ileadingrow = ileadingrow + 1
    ileadingmax = ileadingmax + 1
    COLOR 6, ibk
    FOR i = 1 TO imaxalienforce
        REM SOUND 400, .2 ' Level down.
        IF RTRIM$(a(i)) <> "" THEN
            ialiencol = ialiencolstat + imotion
            LOCATE ileadingmax - (imaxalienforce * 2) + i * 2 - 1, lmargin%
            PRINT STRING$(screenwidth%, " ")
            LOCATE , ialiencol + INSTR(a(i), "^^")
            iltalien(i) = POS(0)
            PRINT LTRIM$(RTRIM$(a(i)))
        END IF
    NEXT
    LOCATE irow, icol
    level = level - .025
    IF ileadingrow = 22 THEN iresults = -2 ' Aliens have landed!
END SUB
 
DEFSNG I
DEFINT I
SUB movealiens (ialiencol, ialiencolstat, iresults)
    STATIC imotion, imarch, imotiondir
 
    SOUND 800, .1: SOUND 200, .33 ' Marching sound.
 
    IF inextrnd = -1 THEN inextrnd = 0: imotion = 0: imarch = 0: imotiondir = 0
    irow = CSRLIN: icol = POS(0)
    yy% = CSRLIN: xx% = POS(0)
    PCOPY 0, 1: SCREEN 0, 0, 1, 0: LOCATE yy%, xx%, 0, 7, 0
    IF imotiondir = 0 THEN imotion = imotion - 1 ELSE imotion = imotion + 1
    COLOR 6, ibk
 
    FOR i = imaxalienforce TO 1 STEP -1
        IF RTRIM$(a(i)) <> "" THEN
            i2 = i2 + 2
            ialiencol = ialiencolstat + imotion
            LOCATE ileadingmax - (imaxalienforce - i) * 2, ialiencol + INSTR(a(i), "^^")
            IF POS(0) = lmargin% THEN imarch = 1
            iltalien(i) = POS(0)
            IF imotiondir = 0 THEN
                PRINT LTRIM$(RTRIM$(a(i))); " "
            ELSE
                LOCATE , POS(0) - 1
                PRINT " "; LTRIM$(RTRIM$(a(i)))
            END IF
            IF ialiencol + LEN(RTRIM$(a(i))) = screenwidth% THEN imarch = -1
        END IF
    NEXT
 
    IF imarch = 1 THEN imotiondir = 1: CALL marchdown(ialiencol, ialiencolstat, imotion, iresults)
    IF imarch = -1 THEN imotiondir = 0: CALL marchdown(ialiencol, ialiencolstat, imotion, iresults)
    IF imarch = 0 THEN
        IF ABS(TIMER - z2alienfire) > firerate THEN
            firerate = (INT(RND * 10) + 1) / 20
            IF iwait = 0 THEN CALL alienattack(ialiencol)
        END IF
    ELSE
        imarch = 0
    END IF
    PCOPY 1, 0: SCREEN 0, 0, 0, 0
    LOCATE irow, icol, 1, 7, 0
END SUB
 
SUB mship (imothership)
    STATIC x%, mov%, z4, mothership$
 
    yy% = CSRLIN: xx% = POS(0): COLOR 6, ibk
    IF imothership = -1 THEN
        imothership = 1
        x% = lmargin%
        mothership$ = CHR$(254) + CHR$(254) + "O" + CHR$(254) + CHR$(254)
        mov% = 1
    END IF
 
    IF ABS(TIMER - z4) > .05 THEN GOSUB mothership: z4 = TIMER: LOCATE yy%, xx%: EXIT SUB
    LOCATE yy%, xx%
    EXIT SUB
 
    mothership:
    IF x% + LEN(mothership$) = screenwidth% + lmargin% THEN mov% = -1 ELSE IF x% = lmargin% THEN mov% = 1
    x% = x% + mov%
    LOCATE topmargin%, x%
    PRINT mothership$;
    IF x% > 1 AND mov% = 1 THEN
        LOCATE , POS(0) - LEN(mothership$) - 1: PRINT " ";
    END IF
    IF mov% = -1 THEN PRINT " ";
    RETURN
 
END SUB
 
DEFINT A-H, J-Z
SUB qbide
    PALETTE 2, 59
    COLOR 15, 0
    CLS
 
    COLOR 0, 7
    LOCATE 1, 1
    PRINT SPACE$(80)
    LOCATE 1, 1: PRINT "   File  Edit  View  Search  Run  Debug  Calls  Options                   Help"
 
    COLOR 7, 0 ' Black background.
 
    LOCATE 2, 1: PRINT CHR$(218)
    LOCATE 2, 2: PRINT STRING$(78, CHR$(196))
    LOCATE 2, 80: PRINT CHR$(191)
 
    LOCATE 2, 76: PRINT CHR$(180)
    LOCATE 2, 78: PRINT CHR$(195)
 
    COLOR 0, 7
    LOCATE 2, 77: PRINT CHR$(24)
    LOCATE 2, 36: PRINT " Untitled "
 
    COLOR 7, 0
    FOR Rows = 3 TO 24
        LOCATE Rows, 1: PRINT CHR$(179);
        LOCATE Rows, 80: PRINT CHR$(179);
    NEXT Rows
 
    LOCATE 22, 1: PRINT CHR$(195)
    LOCATE 22, 80: PRINT CHR$(180)
    LOCATE 22, 2: PRINT STRING$(78, CHR$(196))
    LOCATE 22, 35
    PRINT " Immediate "
 
    COLOR 0, 7
    LOCATE 21, 3: PRINT STRING$(76, CHR$(176))
    LOCATE 21, 2: PRINT CHR$(27)
    LOCATE 21, 3: PRINT CHR$(219)
    LOCATE 21, 79: PRINT CHR$(26)
    FOR Rows = 4 TO 19
        LOCATE Rows, 80: PRINT CHR$(176)
    NEXT Rows
    LOCATE 3, 80: PRINT CHR$(24)
    LOCATE 4, 80: PRINT CHR$(219)
    LOCATE 20, 80: PRINT CHR$(25)
 
    COLOR 0, 3: LOCATE 25, 1: PRINT " <Shift+F1=Help> <F6=Window> <F2=Subs> <F5=Run> <F8=Step> ";
    LOCATE 25, 59: PRINT SPACE$(4);
    COLOR 0, 3
    LOCATE 25, 63: PRINT CHR$(179);
    LOCATE 25, 64: PRINT SPACE$(6);
    LOCATE 25, 68: PRINT "C  00001:001 ";
 
END SUB
 
DEFSNG A-H, J-Z
SUB reprintaliens (ialiencol, ihitaliens, iresults, i4, i, imothership)
    IF ihitaliens > 0 THEN
        ihits = ihits + 1
 
        SELECT CASE iresults + 1
            CASE 1: score$ = LTRIM$(STR$(VAL(score$) + 150))
            CASE 2: score$ = LTRIM$(STR$(VAL(score$) + 250))
            CASE 3: score$ = LTRIM$(STR$(VAL(score$) + 350))
        END SELECT
 
        score$ = STRING$(6 - LEN(score$), "0") + score$
        IF (ihits + 15) MOD 20 = 0 AND imothership = 0 THEN imothership = -1
        LOCATE bullet%(i), lmargin%: PRINT SPACE$(screenwidth%);
        iltalien(i4) = POS(0)
 
        IF RTRIM$(a(i4)) = "" THEN
            alienforce% = alienforce% - 1
            IF alienforce% = 0 THEN iresults = iresults + 1 ' Level completed. Goto to next level.
            IF bullet%(i) = ileadingrow THEN ileadingrow = ileadingrow - 2
        ELSE
            LOCATE bullet%(i), ialiencol + INSTR(a(i4), "^^"): PRINT LTRIM$(RTRIM$(a(i4)))
        END IF
    ELSE
        i2 = ABS(ihitaliens)
        LOCATE iy(i2), ix(i2)
        PRINT " ";: iy(i2) = 0
        ia(i2) = 0
        LOCATE irow, icol
        SOUND 1000, .5
    END IF
 
    ihitaliens = 0
    bullet%(i) = -bullet%(i)
 
    COLOR 0, 3
    yy% = CSRLIN: xx% = POS(0)
    LOCATE 25, 74: PRINT score$;
    LOCATE yy%, xx%
    COLOR 6, ibk
 
END SUB
 
SUB qbideOrig
    PALETTE 2, 59
    COLOR 15, 1
    CLS
 
    COLOR 0, 7
    LOCATE 1, 1
    PRINT SPACE$(80)
    LOCATE 1, 1: PRINT "   File  Edit  View  Search  Run  Debug  Calls  Options                   Help"
 
    COLOR 7, 1
 
    LOCATE 2, 1: PRINT CHR$(218)
    LOCATE 2, 2: PRINT STRING$(78, CHR$(196))
    LOCATE 2, 80: PRINT CHR$(191)
 
    LOCATE 2, 76: PRINT CHR$(180)
    LOCATE 2, 78: PRINT CHR$(195)
 
    COLOR 1, 7
    LOCATE 2, 77: PRINT CHR$(24)
    LOCATE 2, 36: PRINT " Untitled "
 
    COLOR 7, 1
    FOR Rows = 3 TO 24
        LOCATE Rows, 1: PRINT CHR$(179);
        LOCATE Rows, 80: PRINT CHR$(179);
    NEXT Rows
 
    LOCATE 22, 1: PRINT CHR$(195)
    LOCATE 22, 80: PRINT CHR$(180)
    LOCATE 22, 2: PRINT STRING$(78, CHR$(196))
    LOCATE 22, 35
    PRINT " Immediate "
 
    COLOR 0, 7
    LOCATE 21, 3: PRINT STRING$(76, CHR$(176))
    LOCATE 21, 2: PRINT CHR$(27)
    LOCATE 21, 3: PRINT CHR$(219)
    LOCATE 21, 79: PRINT CHR$(26)
    FOR Rows = 4 TO 19
        LOCATE Rows, 80: PRINT CHR$(176)
    NEXT Rows
    LOCATE 3, 80: PRINT CHR$(24)
    LOCATE 4, 80: PRINT CHR$(219)
    LOCATE 20, 80: PRINT CHR$(25)
 
    COLOR 0, 3: LOCATE 25, 1: PRINT " <Shift+F1=Help> <F6=Window> <F2=Subs> <F5=Run> <F8=Step> ";
    LOCATE 25, 59: PRINT SPACE$(4);
    COLOR 0, 3
    LOCATE 25, 63: PRINT CHR$(179);
    LOCATE 25, 64: PRINT SPACE$(6);
    LOCATE 25, 68: PRINT "C  00001:001 ";
 
END SUB

Edited: Added scoring with 50 per hit and 500 bonus for mother ship.

Edited: Some sound and visual effects added. You can replay without the intro. Just press the Alt key at Game Over message. To end, you have to click the "x" in the program window.

Title: Re: Competition
Post by: bplus on October 07, 2021, 10:23:19 pm

Hey I got through level 1 and almost all level 2 with the bats.

Do miss a "Pete" comment at start :-))

Could be colorized a little? Even some Black and White would make the screen pop.

Title: Re: Competition
Post by: Pete on October 08, 2021, 04:05:46 pm

@bplus Ah color? Orange and black are Halloween colors, so I'm not sure what color scheme you are thinking of.

I added a couple of other effects, see edit info.

I wish I was better with SOUND. I would love to have a thunder sound at the beginning, but without including an .ogg file. I added a short note playing routine if the player completes level 3 for the win.

The counter looks like I should truncate it a bit, or maybe try a progressive scoring algorithm. Something simple like 5o- pts per hit on level 1, 200 pts per hit on level 2, and 500 pts per hit on level 3. Same with mother ship. 1000, 2000, and 5000 pt bonus based on level. Any thoughts on scoring?

Pete

Title: Re: Competition
Post by: bplus on October 08, 2021, 08:09:21 pm

Yeah nice changes @Pete. Haven't played game enough for help with scoring, numbers you have look OK.

Title: Re: Competition
Post by: Pete on October 08, 2021, 08:58:33 pm

I found one big, and fixed it. Also added a progressive scoring system.

Pete

Title: Re: Competition
Post by: johnno56 on October 08, 2021, 09:12:19 pm

Cool game... Nicely done... Yep. The Alt key does need a little practice... I actually got through the first wave!! For me that's 'Woo Hoo'... lol

Title: Re: Competition
Post by: Pete on October 08, 2021, 09:39:43 pm

@johnno56 Careful about saying Woo Hoo around here! (Someone could abuse his post privileges).

TheBOB added his thunder sound effects. I did a quick update at QBF and added them: https://www.tapatalk.com/groups/qbasic/viewtopic.php?p=213778#p213778

It made the intro sooooo much better. I left the initial afffect for anyone who does not include the .0gg files.

Pete

Title: Re: Competition
Post by: Pete on October 08, 2021, 11:08:03 pm

Some more cool-aberation with TheBOB. Remember I mentioned "The Great Pumpkin?"

Code: QB64: [Select]

DIM SHARED intro%: intro% = -1
skip_intro:
DEFINT I
DIM SHARED lmargin%, rmargin%, topmargin%, screenwidth%, level, ibk, ileadingrow
DIM SHARED irow, icol, inextrnd, imaxalienmissiles, alienforce%, ileadingmax, imaxalienforce, ihits, score$
 
_SCREENMOVE _MIDDLE
score$ = "000000"
imaxalienforce = 6
imaxalienmissiles = 3
lmargin% = 2
rmargin% = 79
topmargin% = 3
ialiencolstat = 6
iwin = 3 ' 3 Levels.
screenwidth% = rmargin% - lmargin% + 1
ibk = 0 ' Background color
 
DIM SHARED a(imaxalienforce) AS STRING * 68
 
RANDOMIZE TIMER
SCREEN 0, 0, 0, 0
COLOR 7, 0: CLS
 
REM Make aliens
a1$ = "^^" + CHR$(79) + "^^  "
a$ = a1$ + a1$ + a1$ + a1$ + a1$ + a1$ + a1$ + a1$ + a1$ + a1$
 
IF intro% THEN
    SCREEN 0, 0, 1, 1
    CALL qbideOrig
 
    SCREEN 0, 0, 2, 0
    CALL qbide
 
    SCREEN 0, 0, 1, 1
    _DELAY 2
 
    IF _FILEEXISTS("Thunder6.ogg") THEN
        Rain& = _SNDOPEN("RainBk.ogg", "SYNC")
        T1& = _SNDOPEN("Thunder1.ogg", "SYNC")
        T2& = _SNDOPEN("Thunder2.ogg", "SYNC")
        T3& = _SNDOPEN("Thunder3.ogg", "SYNC")
        T4& = _SNDOPEN("Thunder4.ogg", "SYNC")
        T5& = _SNDOPEN("Thunder5.ogg", "SYNC")
        T6& = _SNDOPEN("Thunder6.ogg", "SYNC")
        T7& = _SNDOPEN("Thunder7.ogg", "SYNC")
        T8& = _SNDOPEN("Thunder8.ogg", "SYNC")
 
        _SNDPLAY T6&
        _DELAY .1
        _SNDPLAY T7&
        _DELAY .1
        _SNDPLAY T8&
    ELSE
        SOUND 1000, .3: SOUND 2400, .6:: SOUND 700, 2
    END IF
 
    FOR i = 1 TO 15
        _DELAY i / 150
        IF i / 2 = i \ 2 THEN
            SOUND 250, .1
            SCREEN 0, 0, 1, 1
        ELSE
            SCREEN 0, 0, 2, 2
            IF i < 13 THEN _DELAY i / 100: SCREEN 0, 0, 3, 3: COLOR 0, 7: CLS
        END IF
    NEXT
 
    PCOPY 2, 0
    SCREEN 0, 0, 0, 0
    _DELAY 1
 
    CALL TheBOB
 
    CALL qbide
 
ELSE
    CALL qbide
END IF
 
IF intro% = -1 THEN RESTORE first_play ELSE RESTORE replay
 
CALL instructions
 
DO
    IF inextrnd = -1 THEN PCOPY 3, 0
    tank$ = CHR$(218) + CHR$(127) + CHR$(191): icolor = 6
    REDIM SHARED bullet%(5), bulletcol%(5), bulletdelay%(5), iltalien(imaxalienforce)
    REDIM SHARED ia(imaxalienmissiles), iy(imaxalienmissiles), ix(imaxalienmissiles)
    REDIM SHARED matrix(imaxalienforce) AS STRING * 10
    alienforce% = imaxalienforce
    level = .65
    iround = iround + 1
    level = level - iround / 15
    inextrnd = -1
    COLOR 6, ibk
 
    REM Set up aliens
    ialiencol = ialiencolstat
    LOCATE 2, ialiencol
    FOR i = 1 TO imaxalienforce
        IF i MOD 1 = 0 THEN PRINT
        LOCATE , ialiencol
        IF i = imaxalienforce THEN ileadingrow = CSRLIN: ileadingmax = ileadingrow
        a(i) = a$
        PRINT a(i)
    NEXT
 
    COLOR 0 + 16, 3
    LOCATE 25, 68: PRINT "Score ";
    COLOR 0, 3
    PRINT score$;
    COLOR 6, ibk
 
    REM Station
    LOCATE 24, 40
    tanky% = CSRLIN: tankx% = POS(0) + 1
    PRINT tank$;: LOCATE , POS(0) - 2
 
    _DELAY 1
 
    DO
        z1 = TIMER
        DO
            IF zbonus THEN
                IF ABS(zbonus - TIMER) > 1.5 THEN
                    yy% = CSRLIN: xx% = POS(0)
                    COLOR 6, 0: LOCATE topmargin%, lmargin%: PRINT SPACE$(screenwidth%);
                    LOCATE yy%, xx%
                    zbonus = 0
                END IF
            END IF
 
            IF topmargin% + ileadingmax - (imaxalienforce * 2) >= topmargin% + 2 THEN
                IF imothership <> 0 THEN CALL mship(imothership)
            END IF
            IF ABS(TIMER - z1aliens) > level THEN
                CALL movealiens(ialiencol, ialiencolstat, iresults)
                z1aliens = TIMER
            END IF
            IF iresults < 0 THEN EXIT DO
            IF ABS(TIMER - z1ia) > .3 THEN CALL alienmissile(iresults): z1ia = TIMER
 
            DEF SEG = 0
            IF PEEK(1047) MOD 16 = 7 OR PEEK(1047) MOD 16 = 8 THEN
                key$ = CHR$(32) ' Alt
            ELSE
                key$ = ""
            END IF
            DEF SEG
 
            SELECT CASE key$
                CASE CHR$(32)
                    IF flag = 0 THEN switch = switch * -1 - 1: flag = -1
                    SELECT CASE switch
                        CASE 0
                            IF ABS(z9 - TIMER) > .15 THEN
                                IF POS(0) < screenwidth% THEN COLOR icolor, ibk: LOCATE , POS(0) - 1: PRINT " " + tank$;: LOCATE , POS(0) - 2
                                tanky% = CSRLIN: tankx% = POS(0)
                                IF SCREEN(tanky%, tankx% - 2) = 25 OR SCREEN(tanky%, tankx% + 2) = 25 THEN result = -1: EXIT DO
                                z9 = TIMER
                            END IF
                        CASE -1
                            IF ABS(z9 - TIMER) > .15 THEN
                                IF POS(0) > lmargin% + 1 THEN COLOR icolor, ibk: LOCATE , POS(0) - 2: PRINT tank$ + " ";: LOCATE , POS(0) - 3
                                tanky% = CSRLIN: tankx% = POS(0)
                                IF SCREEN(tanky%, tankx% - 2) = 25 OR SCREEN(tanky%, tankx% + 2) = 25 THEN result = -1: EXIT DO
                                z9 = TIMER
                            END IF
                    END SELECT
                    IF icolor = 6 THEN
                        FOR i2 = 1 TO 5
                            IF bullet%(i2) = 0 THEN
                                icolor = 12: COLOR icolor, ibk: GOSUB redraw
                                bullet%(i2) = -1: reload = TIMER: EXIT FOR
                            END IF
                        NEXT
                    END IF
                CASE ""
                    IF flag THEN skip = 0: flag = 0
                CASE CHR$(27): SYSTEM
            END SELECT
 
            IF ABS(z1 - reload) > .6 AND reload <> 0 THEN
                GOSUB redraw
                icolor = 6: reload = 0
            END IF
 
            REM Fire
            FOR i = 1 TO 5
                SELECT CASE bullet%(i)
                    CASE -1: bullet%(i) = tanky% - 1: bulletcol%(i) = tankx%
                    CASE IS > 0
                        IF bulletdelay%(i) = -1 OR bullet%(i) = tanky% - 1 THEN
                            CALL checkcollision(ihitaliens, ialiencol, i4, i)
                            z2bullet = TIMER: bulletdelay%(i) = 0
                            COLOR 6, ibk
                            LOCATE bullet%(i), bulletcol%(i)
                            IF bullet%(i) = topmargin% AND imothership <> 0 THEN ' Hit mother ship.
                                IF SCREEN(ABS(bullet%(i)), bulletcol%(i)) <> 32 THEN
                                    SOUND 1000, .75
                                    SELECT CASE iresults + 1
                                        CASE 1: bonus = 1500
                                        CASE 2: bonus = 2500
                                        CASE 3: bonus = 5000
                                    END SELECT
                                    score$ = LTRIM$(STR$(VAL(score$) + bonus))
                                    score$ = STRING$(6 - LEN(score$), "0") + score$
                                    yy% = CSRLIN: xx% = POS(0)
                                    SOUND 800, .5: SOUND 1600, .5: SOUND 2400, .5
                                    LOCATE topmargin%, lmargin%: PRINT SPACE$(screenwidth%);
                                    kbonus = bulletcol%(i) - 4
                                    IF kbonus < lmargin% THEN kbonus = lmargin%
                                    IF kbonus + 10 > screenwidth% THEN kbonus = screenwidth% - 11
                                    zbonus = TIMER
                                    LOCATE yy%, xx%
                                    imothership = 0
                                END IF
                            END IF
                            PRINT CHR$(24) ' Tank missile.
                            IF CSRLIN <> 24 THEN LOCATE , bulletcol%(i): PRINT " ";
                            IF ihitaliens <> 0 THEN CALL reprintaliens(ialiencol, ihitaliens, iresults, i4, i, imothership)
                            LOCATE tanky%, tankx%
                            IF bullet%(i) > topmargin% THEN
                                bullet%(i) = bullet%(i) - 1
                            ELSE
                                GOSUB erasebullet
                            END IF
 
                            IF zbonus THEN
                                yy% = CSRLIN: xx% = POS(0)
                                LOCATE topmargin%, kbonus: COLOR 2 + 16: PRINT "BONUS " + LTRIM$(STR$(bonus));
                                LOCATE yy%, xx%
                            END IF
 
                        END IF
                END SELECT
            NEXT
 
            REM Bullet timer delay
            IF z2bullet <> 0 THEN
                IF z1 < z2bullet THEN z2bullet = z2bullet - 86400
                IF z1 - z2bullet >= .06 THEN
                    FOR i2 = 1 TO 5
                        IF bullet%(i2) <> 0 THEN bulletdelay%(i2) = -1
                    NEXT i2
                END IF
                EXIT DO
            END IF
        LOOP
        IF iresults < 0 THEN EXIT DO
        IF alienforce% = 0 OR iresults = iwin THEN
            FOR i = 1 TO imaxalienmissiles
                IF ia(i) <> 0 THEN EXIT FOR
            NEXT
            IF i > imaxalienmissiles THEN iwait = -1
            IF iwait = -1 THEN
                EXIT DO
            END IF
        ELSE
            iwait = 1
        END IF
    LOOP
 
    IF iresults = iwin OR iresults < 0 THEN
        REM end game
        EXIT DO
    END IF
    inextrnd = -1
LOOP
 
SELECT CASE iresults
    CASE -1 ' Tank destroyed!
        SOUND 800, .3: SOUND 250, 1
 
        FOR i = 1 TO 5
            COLOR 14, 4
            LOCATE tanky%, tankx% - 1: PRINT tank$;
            _DELAY .1
 
            COLOR 8, ibk
            LOCATE tanky%, tankx% - 1: PRINT tank$;
            _DELAY .1
        NEXT
 
        COLOR 6, ibk
        LOCATE tanky% - 1, lmargin%
        PRINT SPACE$(screenwidth%);
        LOCATE tanky%, lmargin%
        PRINT SPACE$(screenwidth%);
 
        _DELAY 2
 
        CALL qbide
 
    CASE -2 ' Aliens have landed!
        SOUND 1000, .3: SOUND 2400, .6:: SOUND 700, 2
 
        COLOR 7, 0
        FOR i = 0 TO 21 ' Blank out screen.
            LOCATE topmargin% + i, lmargin%: PRINT SPACE$(screenwidth%);
        NEXT
 
        COLOR 6, ibk
        LOCATE tanky% - 1, lmargin%
        PRINT SPACE$(screenwidth%);
        LOCATE tanky%, lmargin%
        PRINT SPACE$(screenwidth%);
 
        COLOR 8, ibk
 
        FOR j = imaxalienforce TO 1 STEP -1
            IF a(j) <> "" THEN EXIT FOR
        NEXT
 
        FOR i = j TO 1 STEP -1
            LOCATE , ialiencol + INSTR(a(i), "^^")
            PRINT LTRIM$(RTRIM$(a(i)));
            LOCATE CSRLIN - 1
        NEXT
 
        _DELAY 2.5
 
    CASE ELSE ' Winner.
 
        l$ = "12"
        n$ = "n29": PLAY "L" + l$ + n$: _DELAY .5
        n$ = "n24": PLAY "L" + l$ + n$: _DELAY .5
        n$ = "n33": PLAY "L" + l$ + n$: _DELAY .5
        n$ = "n29": PLAY "L" + l$ + n$
 
        CALL qbide
 
        RESTORE winner
 
END SELECT
 
 
COLOR 0, 3
LOCATE 25, 68: PRINT "Score "; score$;
 
CALL instructions
 
COLOR 6, 0
LOCATE 5, 3: PRINT "Score "; score$
 
DEF SEG = 0
DO
    _LIMIT 30
    b$ = INKEY$
    IF b$ = CHR$(27) THEN SYSTEM
    IF PEEK(1047) MOD 16 = 7 OR PEEK(1047) MOD 16 = 8 THEN EXIT DO
LOOP
DEF SEG
 
RUN skip_intro
 
erasebullet:
LOCATE ABS(bullet%(i)), bulletcol%(i): PRINT " ";
bullet%(i) = 0: bulletcol%(i) = 0: bulletdelay%(i) = 0
LOCATE tanky%, tankx%
RETURN
 
redraw:
COLOR , ibk: LOCATE tanky%, tankx% - 1: PRINT tank$;: LOCATE tanky%, tankx%: COLOR 7, ibk
RETURN
 
first_play:
DATA "The Great Pumpkin has fired an EM pulse at your computer."
DATA ""
DATA "All that's left working is your Alt key."
DATA ""
DATA "Happy Halloween!"
DATA ""
replay:
DATA "Loading..."
DATA "EOF"
DATA "Game Over. Thanks for playing..."
DATA "EOF2"
winner:
DATA "Congratulations, you saved the planet!"
DATA "EOF3"
 
 
SUB alienattack (ialiencol)
    z2alienfire = TIMER
 
    i3 = INT(RND * 10)
    FOR i = 1 TO imaxalienmissiles
        IF ia(i) = 0 THEN
            FOR i2 = imaxalienforce TO 1 STEP -1
                IF RTRIM$(a(i2)) <> "" THEN
                    IF MID$(matrix(i2), i3 + 1, 1) <> "0" THEN
                        i4 = INSTR(i3 * 7 + 1, a(i2), CHR$(79)) + ialiencol
                        EXIT FOR
                    END IF
                END IF
            NEXT i2
            IF i4 <> 0 THEN
                ia(i) = (ileadingmax - (imaxalienforce - i2) * 2) * 80 + i4
                EXIT FOR
            END IF
        END IF
    NEXT i
 
END SUB
 
SUB alienmissile (iresults)
    irow = CSRLIN: icol = POS(0)
    FOR i = 1 TO imaxalienmissiles
        IF ia(i) <> 0 THEN
            IF iy(i) = 0 THEN
                iy(i) = ia(i) \ 80: ix(i) = ia(i) MOD 80
                IF ix(i) = 0 THEN ix(i) = screenwidth%
            END IF
            LOCATE iy(i) + 1, ix(i)
            COLOR 6, ibk
            IF CSRLIN <= 24 THEN
                IF CSRLIN = 24 THEN IF SCREEN(CSRLIN, ix(i)) <> 32 THEN iresults = -1
                PRINT CHR$(25);
            ELSE
                ia(i) = 0
                LOCATE iy(i), ix(i)
                PRINT " ";: iy(i) = 0
                ia(i) = 0
                LOCATE irow, icol
                EXIT SUB
            END IF
            LOCATE iy(i), ix(i): PRINT " ";
            iy(i) = iy(i) + 1
        END IF
    NEXT
    LOCATE irow, icol
 
END SUB
 
SUB checkcollision (ihitaliens, ialiencol, i4, i)
    ihitaliens = 0
    IF ileadingmax MOD 2 = bullet%(i) MOD 2 THEN
        i4 = imaxalienforce - (ileadingmax - bullet%(i)) \ 2
        IF bullet%(i) <= ileadingrow AND i4 > 0 AND i4 <= imaxalienforce THEN
            IF RTRIM$(a(i4)) <> "" THEN
                IF bulletcol%(i) >= iltalien(i4) AND bulletcol%(i) - ialiencol <= LEN(RTRIM$(a(i4))) THEN
                    IF MID$(a(i4), bulletcol%(i) - ialiencol, 1) > CHR$(32) THEN
                        ihitaliens = bulletcol%(i) - ialiencol + 1
                        i3 = ihitaliens - 7 + 1: IF i3 < 1 THEN i3 = 1: REM count from the "<" symbol.
                        i2 = INSTR(i3 + 1, a(i4), "^" + CHR$(79)) - 1
                        MID$(a(i4), i2, 7) = SPACE$(7)
                        MID$(matrix(i4), (i2 + 1) \ 7 + 1, 1) = "0"
                    END IF
                END IF
            END IF
        END IF
    END IF
 
    FOR i2 = 1 TO imaxalienmissiles
        IF ia(i2) <> 0 THEN
            IF iy(i2) >= bullet%(i) AND ix(i2) = bulletcol%(i) THEN
                ihitaliens = -i2
                EXIT FOR
            END IF
        END IF
    NEXT
 
END SUB
 
SUB instructions
    IF in$ = "" THEN
        key$ = INKEY$
        LOCATE 3, 3, 1, 7, 0: COLOR 6, ibk
        _DELAY 2
        DO
            READ in$
            IF MID$(in$, 1, 3) = "EOF" THEN EXIT DO
            FOR i = 1 TO LEN(in$)
                SOUND 400, .07
                LOCATE , 2 + i
                PRINT MID$(in$, i, 1);
                z = TIMER
                DO
                    IF ABS(z - TIMER) > .08 THEN EXIT DO
                LOOP
            NEXT
            LOCATE , , 0, 7, 0
            _DELAY 1
            PRINT
            LOCATE , 3
        LOOP
        _DELAY 1
    END IF
 
    IF in$ = "EOF" THEN
        COLOR 7, 0
        FOR i = 0 TO 19 ' Blank out intro message space.
            LOCATE topmargin% + i, lmargin%: PRINT SPACE$(screenwidth%);
        NEXT
        FOR i = 3 TO 24
            LOCATE i, 80: PRINT CHR$(179);
        NEXT
        LOCATE 21, 2: PRINT STRING$(screenwidth%, " ");
        LOCATE 22, 1: PRINT CHR$(179);
        LOCATE 22, 80: PRINT CHR$(179);
        LOCATE 22, 2: PRINT STRING$(screenwidth%, " ");
    ELSE
        COLOR 0, 3
    END IF
 
    IF in$ <> "EOF2" AND iresults <> iwin THEN COLOR 0 + 16, 3 ELSE COLOR 0, 3
    yy% = CSRLIN: xx% = POS(0)
    LOCATE 25, 68: PRINT "Score ";
    COLOR 0, 3
    PRINT score$;
    LOCATE yy%, xx%
 
    PCOPY 0, 3: REM save skin
 
END SUB
 
SUB marchdown (ialiencol, ialiencolstat, imotion, iresults)
    COLOR 6, ibk
    ileadingrow = ileadingrow + 1
    ileadingmax = ileadingmax + 1
    COLOR 6, ibk
    FOR i = 1 TO imaxalienforce
        REM SOUND 400, .2 ' Level down.
        IF RTRIM$(a(i)) <> "" THEN
            ialiencol = ialiencolstat + imotion
            LOCATE ileadingmax - (imaxalienforce * 2) + i * 2 - 1, lmargin%
            PRINT STRING$(screenwidth%, " ")
            LOCATE , ialiencol + INSTR(a(i), "^^")
            iltalien(i) = POS(0)
            PRINT LTRIM$(RTRIM$(a(i)))
        END IF
    NEXT
    LOCATE irow, icol
    level = level - .025
    IF ileadingrow = 22 THEN iresults = -2 ' Aliens have landed!
END SUB
 
DEFSNG I
DEFINT I
SUB movealiens (ialiencol, ialiencolstat, iresults)
    STATIC imotion, imarch, imotiondir
 
    SOUND 800, .1: SOUND 200, .33 ' Marching sound.
 
    IF inextrnd = -1 THEN inextrnd = 0: imotion = 0: imarch = 0: imotiondir = 0
    irow = CSRLIN: icol = POS(0)
    yy% = CSRLIN: xx% = POS(0)
    PCOPY 0, 1: SCREEN 0, 0, 1, 0: LOCATE yy%, xx%, 0, 7, 0
    IF imotiondir = 0 THEN imotion = imotion - 1 ELSE imotion = imotion + 1
    COLOR 6, ibk
 
    FOR i = imaxalienforce TO 1 STEP -1
        IF RTRIM$(a(i)) <> "" THEN
            i2 = i2 + 2
            ialiencol = ialiencolstat + imotion
            LOCATE ileadingmax - (imaxalienforce - i) * 2, ialiencol + INSTR(a(i), "^^")
            IF POS(0) = lmargin% THEN imarch = 1
            iltalien(i) = POS(0)
            IF imotiondir = 0 THEN
                PRINT LTRIM$(RTRIM$(a(i))); " "
            ELSE
                LOCATE , POS(0) - 1
                PRINT " "; LTRIM$(RTRIM$(a(i)))
            END IF
            IF ialiencol + LEN(RTRIM$(a(i))) = screenwidth% THEN imarch = -1
        END IF
    NEXT
 
    IF imarch = 1 THEN imotiondir = 1: CALL marchdown(ialiencol, ialiencolstat, imotion, iresults)
    IF imarch = -1 THEN imotiondir = 0: CALL marchdown(ialiencol, ialiencolstat, imotion, iresults)
    IF imarch = 0 THEN
        IF ABS(TIMER - z2alienfire) > firerate THEN
            firerate = (INT(RND * 10) + 1) / 20
            IF iwait = 0 THEN CALL alienattack(ialiencol)
        END IF
    ELSE
        imarch = 0
    END IF
    PCOPY 1, 0: SCREEN 0, 0, 0, 0
    LOCATE irow, icol, 1, 7, 0
END SUB
 
SUB mship (imothership)
    STATIC x%, mov%, z4, mothership$
 
    yy% = CSRLIN: xx% = POS(0): COLOR 6, ibk
    IF imothership = -1 THEN
        imothership = 1
        x% = lmargin%
        mothership$ = CHR$(254) + CHR$(254) + "O" + CHR$(254) + CHR$(254)
        mov% = 1
    END IF
 
    IF ABS(TIMER - z4) > .05 THEN GOSUB mothership: z4 = TIMER: LOCATE yy%, xx%: EXIT SUB
    LOCATE yy%, xx%
    EXIT SUB
 
    mothership:
    IF x% + LEN(mothership$) = screenwidth% + lmargin% THEN mov% = -1 ELSE IF x% = lmargin% THEN mov% = 1
    x% = x% + mov%
    LOCATE topmargin%, x%
    PRINT mothership$;
    IF x% > 1 AND mov% = 1 THEN
        LOCATE , POS(0) - LEN(mothership$) - 1: PRINT " ";
    END IF
    IF mov% = -1 THEN PRINT " ";
    RETURN
 
END SUB
 
DEFINT A-H, J-Z
SUB qbide
    PALETTE 2, 59
    COLOR 15, 0
    CLS
 
    COLOR 0, 7
    LOCATE 1, 1
    PRINT SPACE$(80)
    LOCATE 1, 1: PRINT "   File  Edit  View  Search  Run  Debug  Calls  Options                   Help"
 
    COLOR 7, 0 ' Black background.
 
    LOCATE 2, 1: PRINT CHR$(218)
    LOCATE 2, 2: PRINT STRING$(78, CHR$(196))
    LOCATE 2, 80: PRINT CHR$(191)
 
    LOCATE 2, 76: PRINT CHR$(180)
    LOCATE 2, 78: PRINT CHR$(195)
 
    COLOR 0, 7
    LOCATE 2, 77: PRINT CHR$(24)
    LOCATE 2, 36: PRINT " Untitled "
 
    COLOR 7, 0
    FOR Rows = 3 TO 24
        LOCATE Rows, 1: PRINT CHR$(179);
        LOCATE Rows, 80: PRINT CHR$(179);
    NEXT Rows
 
    LOCATE 22, 1: PRINT CHR$(195)
    LOCATE 22, 80: PRINT CHR$(180)
    LOCATE 22, 2: PRINT STRING$(78, CHR$(196))
    LOCATE 22, 35
    PRINT " Immediate "
 
    COLOR 0, 7
    LOCATE 21, 3: PRINT STRING$(76, CHR$(176))
    LOCATE 21, 2: PRINT CHR$(27)
    LOCATE 21, 3: PRINT CHR$(219)
    LOCATE 21, 79: PRINT CHR$(26)
    FOR Rows = 4 TO 19
        LOCATE Rows, 80: PRINT CHR$(176)
    NEXT Rows
    LOCATE 3, 80: PRINT CHR$(24)
    LOCATE 4, 80: PRINT CHR$(219)
    LOCATE 20, 80: PRINT CHR$(25)
 
    COLOR 0, 3: LOCATE 25, 1: PRINT " <Shift+F1=Help> <F6=Window> <F2=Subs> <F5=Run> <F8=Step> ";
    LOCATE 25, 59: PRINT SPACE$(4);
    COLOR 0, 3
    LOCATE 25, 63: PRINT CHR$(179);
    LOCATE 25, 64: PRINT SPACE$(6);
    LOCATE 25, 68: PRINT "C  00001:001 ";
 
END SUB
 
DEFSNG A-H, J-Z
SUB reprintaliens (ialiencol, ihitaliens, iresults, i4, i, imothership)
    IF ihitaliens > 0 THEN
        ihits = ihits + 1
 
        SELECT CASE iresults + 1
            CASE 1: score$ = LTRIM$(STR$(VAL(score$) + 150))
            CASE 2: score$ = LTRIM$(STR$(VAL(score$) + 250))
            CASE 3: score$ = LTRIM$(STR$(VAL(score$) + 350))
        END SELECT
 
        score$ = STRING$(6 - LEN(score$), "0") + score$
        IF (ihits + 15) MOD 20 = 0 AND imothership = 0 THEN imothership = -1
        LOCATE bullet%(i), lmargin%: PRINT SPACE$(screenwidth%);
        iltalien(i4) = POS(0)
 
        IF RTRIM$(a(i4)) = "" THEN
            alienforce% = alienforce% - 1
            IF alienforce% = 0 THEN iresults = iresults + 1 ' Level completed. Goto to next level.
            IF bullet%(i) = ileadingrow THEN ileadingrow = ileadingrow - 2
        ELSE
            LOCATE bullet%(i), ialiencol + INSTR(a(i4), "^^"): PRINT LTRIM$(RTRIM$(a(i4)))
        END IF
    ELSE
        i2 = ABS(ihitaliens)
        LOCATE iy(i2), ix(i2)
        PRINT " ";: iy(i2) = 0
        ia(i2) = 0
        LOCATE irow, icol
        SOUND 1000, .5
    END IF
 
    ihitaliens = 0
    bullet%(i) = -bullet%(i)
 
    COLOR 0, 3
    yy% = CSRLIN: xx% = POS(0)
    LOCATE 25, 74: PRINT score$;
    LOCATE yy%, xx%
    COLOR 6, ibk
 
END SUB
 
SUB qbideOrig
    PALETTE 2, 59
    COLOR 15, 1
    CLS
 
    COLOR 0, 7
    LOCATE 1, 1
    PRINT SPACE$(80)
    LOCATE 1, 1: PRINT "   File  Edit  View  Search  Run  Debug  Calls  Options                   Help"
 
    COLOR 7, 1
 
    LOCATE 2, 1: PRINT CHR$(218)
    LOCATE 2, 2: PRINT STRING$(78, CHR$(196))
    LOCATE 2, 80: PRINT CHR$(191)
 
    LOCATE 2, 76: PRINT CHR$(180)
    LOCATE 2, 78: PRINT CHR$(195)
 
    COLOR 1, 7
    LOCATE 2, 77: PRINT CHR$(24)
    LOCATE 2, 36: PRINT " Untitled "
 
    COLOR 7, 1
    FOR Rows = 3 TO 24
        LOCATE Rows, 1: PRINT CHR$(179);
        LOCATE Rows, 80: PRINT CHR$(179);
    NEXT Rows
 
    LOCATE 22, 1: PRINT CHR$(195)
    LOCATE 22, 80: PRINT CHR$(180)
    LOCATE 22, 2: PRINT STRING$(78, CHR$(196))
    LOCATE 22, 35
    PRINT " Immediate "
 
    COLOR 0, 7
    LOCATE 21, 3: PRINT STRING$(76, CHR$(176))
    LOCATE 21, 2: PRINT CHR$(27)
    LOCATE 21, 3: PRINT CHR$(219)
    LOCATE 21, 79: PRINT CHR$(26)
    FOR Rows = 4 TO 19
        LOCATE Rows, 80: PRINT CHR$(176)
    NEXT Rows
    LOCATE 3, 80: PRINT CHR$(24)
    LOCATE 4, 80: PRINT CHR$(219)
    LOCATE 20, 80: PRINT CHR$(25)
 
    COLOR 0, 3: LOCATE 25, 1: PRINT " <Shift+F1=Help> <F6=Window> <F2=Subs> <F5=Run> <F8=Step> ";
    LOCATE 25, 59: PRINT SPACE$(4);
    COLOR 0, 3
    LOCATE 25, 63: PRINT CHR$(179);
    LOCATE 25, 64: PRINT SPACE$(6);
    LOCATE 25, 68: PRINT "C  00001:001 ";
 
END SUB
 
SUB TheBOB
   ' This sub routine created by Bob Seguin of the QBasic Forum. 
   SCREEN 12
 
    OUT &H3C8, 1: OUT &H3C9, 40: OUT &H3C9, 12: OUT &H3C9, 0
    OUT &H3C8, 2: OUT &H3C9, 6: OUT &H3C9, 12: OUT &H3C9, 0
    OUT &H3C8, 3: OUT &H3C9, 30: OUT &H3C9, 8: OUT &H3C9, 0
    OUT &H3C8, 4: OUT &H3C9, 3: OUT &H3C9, 8: OUT &H3C9, 0
    OUT &H3C8, 7: OUT &H3C9, 63: OUT &H3C9, 0: OUT &H3C9, 0
    OUT &H3C8, 8: OUT &H3C9, 46: OUT &H3C9, 0: OUT &H3C9, 0
    OUT &H3C8, 9: OUT &H3C9, 63: OUT &H3C9, 63: OUT &H3C9, 63
    OUT &H3C8, 12: OUT &H3C9, 20: OUT &H3C9, 20: OUT &H3C9, 20
    OUT &H3C8, 13: OUT &H3C9, 0: OUT &H3C9, 0: OUT &H3C9, 0
    OUT &H3C8, 14: OUT &H3C9, 55: OUT &H3C9, 35: OUT &H3C9, 0
 
    CIRCLE (320, 240), 100, 3, , , .9
    PAINT (320, 240), 3
    CIRCLE (320, 230), 90, 1, , , .9
    PAINT (320, 230), 1
    FOR Reps = 1 TO 4
        SELECT CASE Reps
            DATA 1,1.2,1.8,5
            CASE 1: Elipse = 1
            CASE 2: Elipse = 1.2
            CASE 3: Elipse = 1.8
            CASE 4: Elipse = 5
        END SELECT
        FOR E = Elipse TO Elipse + .1 STEP .01
            CIRCLE (320, 240), 100, 3, , , E
        NEXT E
    NEXT Reps
    FOR Radius = 38 TO 43
        CIRCLE (320, 160), Radius, 3, , , .4
    NEXT Radius
    CIRCLE (320, 160), 40, 14, 3.3, 6, .4
    CIRCLE (320, 240), 100, 5, , , .9
    PAINT (0, 0), 5
    CIRCLE (320, 240), 100, 0, , , .9
    PAINT (0, 0), 0
    FOR Radius = 12 TO 18
        CIRCLE (320, 153), Radius, 2, , , .3
    NEXT Radius
    CIRCLE (320, 150), 12, 2, , , .6
    PAINT STEP(0, 0), 2
    CIRCLE (300, 143), 32, 2, 6, 1.1
    CIRCLE (276, 143), 32, 2, 6, .6
    DRAW "BM302,125 C2 M+15,-10 BD10 P2,2"
    PAINT (320, 145), 2
    CIRCLE (282, 143), 32, 4, 6, .73
    CIRCLE (266, 156), 60, 4, .1, .68
    CIRCLE (320, 150), 12, 4, 3.14159, 0, .2
    DRAW "BM302,125 C4 M+15,-10 BD10"
    CIRCLE (276, 143), 32, 4, 6, .6
    PAINT STEP(35, 0), 4
    'Face begins
    CIRCLE (303, 316), 100, 14, 1.5, 2
    CIRCLE (337, 316), 100, 14, 1.1, 1.64
    PSET (310, 215), 14
    DRAW "H30 M-20,+40 M+12,-4 M+14,-29 BL2 P14,14 BF12 P15,14"
    PSET (330, 215), 14
    DRAW "E30 M+20,+40 M-12,-4 M-14,-29 BR2 P14,14 BG12 P15,14"
    PSET (320, 246), 14
    DRAW "R20 H20 G20 R20 U nL19 nR19 BU2 P15,14"
    CIRCLE (320, 170), 100, 14, 3.8, 4.1
    CIRCLE (320, 170), 100, 14, 4.42, 5.01
    CIRCLE (320, 170), 100, 14, 5.33, 5.62
    CIRCLE (320, 220), 80, 14, 3.29, 4.5
    CIRCLE (320, 220), 80, 14, 4.66, 6.15
    PSET (260, 250), 14
    DRAW "D10 F8 U13 M+10,+5 D12 M+12,+6 U12 BR60"
    DRAW "D12 M+12,-6 U12 M+10,-5 D13 E8 U10"
    PSET (300, 297), 14
    DRAW "U14 R16 D16"
    CIRCLE (320, 212), 80, 14, 3.42, 4.5
    CIRCLE (320, 212), 80, 14, 4.66, 6
    LINE (300, 280)-(316, 283), 14, BF
    PAINT (320, 296), 14
    PAINT (290, 292), 14
    PAINT (300, 278), 15, 14
    CIRCLE (100, 240), 32, 13
    PAINT STEP(0, 0), 13
    FOR x% = 58 TO 142
        FOR y% = 198 TO 282
            IF POINT(x%, y%) = 13 THEN
                IF POINT(x% + 220, y%) = 15 THEN PSET (x% + 220, y%), 9
            END IF
        NEXT y%
    NEXT x%
 
    COLOR 13: LOCATE 1, 1: PRINT "HAPPY HALLOWEEN!"
    xx = 64: yy = 360
    FOR x% = 0 TO 300
        FOR y% = 0 TO 16
            IF POINT(x%, y%) = 13 THEN
                IF y% > 6 THEN Colr = 8 ELSE Colr = 7
                LINE (x% * 4 + xx, y% * 4 + yy)-(x% * 4 + xx + 3, y% * 4 + yy + 3), Colr, BF
            END IF
        NEXT y%
    NEXT x%
    FOR x% = 0 TO 639
        IF POINT(x%, 368) <> 0 THEN PSET (x%, 368), 14
    NEXT x%
    LINE (5, 5)-(634, 474), 12, B
    LINE (8, 8)-(631, 471), 12, B
    LINE (50, 354)-(580, 420), 15, B
 
    z1 = TIMER
    DO UNTIL ABS(TIMER - z1) > 4
        FOR Reps = 1 TO 3
            WAIT &H3DA, 8
            WAIT &H3DA, 8, 8
        NEXT Reps
 
        Flicker = FIX(RND * 20)
        OUT &H3C8, 14
        OUT &H3C9, 40 + Flicker
        OUT &H3C9, 25 + Flicker
        OUT &H3C9, 10 + Flicker
 
        OUT &H3C8, 15
        OUT &H3C9, 43 + Flicker
        OUT &H3C9, 38 + Flicker
        OUT &H3C9, 20 + Flicker
    LOOP
    SCREEN 0, 0, 0, 0
END SUB

[ This attachment cannot be displayed inline in 'Print Page' view ]

Pete

Title: Re: Competition
Post by: bplus on October 08, 2021, 11:33:18 pm

@Pete Great (Pumpkin) Opening!

24750 is a level and almost the 2nd. Was it Black and Red before? good choice.

Title: Re: Competition
Post by: johnno56 on October 09, 2021, 12:48:52 am

Pete,

My apologies for my shameless display of ebullience. You are correct. Quite out of order.

J

Title: Re: Competition
Post by: Pete on October 09, 2021, 01:32:55 am

@johnno56 Did you see this thread from this link to page 2? https://www.qb64.org/forum/index.php?topic=4243.msg136169#msg136169

That's the one that also lead to my Elton John song parody. Quite logical!

Pete

Title: Re: Competition
Post by: SMcNeill on October 09, 2021, 03:26:16 am

Quote from: johnno56 on October 09, 2021, 12:48:52 am

Pete,

My apologies for my shameless display of ebullience. You are correct. Quite out of order.

J

E-bullies are NOT nice! No matter what you and your auto-correct might say.

Title: Re: Competition
Post by: johnno56 on October 09, 2021, 06:39:17 am

Did I miss something?

Title: Re: Competition
Post by: SMcNeill on October 09, 2021, 06:51:15 am

Quote from: johnno56 on October 09, 2021, 06:39:17 am

Did I miss something?

ebullience -- e-bullie nce! I can tell, you were saying “e-bullies, nice!”, and your autocorrect kicked in. Praising those mean old e-bullies! Bad johnno! Bad!

😂🤣😂

Nobody such use such dang confluting language round here!

Title: Re: Competition
Post by: johnno56 on October 09, 2021, 08:50:03 am

Ebullient = "cheerful and full of energy"... but I see what you mean...

Title: Re: Competition
Post by: bplus on October 09, 2021, 08:55:56 am

Is it just US patriots that like to take high faluting English sounding words and say things like, whats e bull'n ennce for anyway? What did ence every do to em?

Title: Re: Competition
Post by: bplus on October 09, 2021, 08:57:23 am

With there best English accent they can manage, of course.

Title: Re: Competition
Post by: johnno56 on October 09, 2021, 04:06:28 pm

Umm... 'their' ("Their" is a positive pronoun - "their car is red" and "there" can be used as an adjective - "he is always there for me" or a adverb - "stop right there"
But, my guess is, you had deliberately chosen that word to prove a point... Nicely done (should be - "well done") lol.

Title: Re: Competition
Post by: SMcNeill on October 09, 2021, 04:34:48 pm

Quote from: johnno56 on October 09, 2021, 04:06:28 pm

Umm... 'their' ("Their" is a positive pronoun - "their car is red" and "there" can be used as an adjective - "he is always there for me" or a adverb - "stop right there"
But, my guess is, you had deliberately chosen that word to prove a point... Nicely done (should be - "well done") lol.

Don’t be so uptight. It's just a typo. Everyone knows he meant to type they’re!

Title: Re: Competition
Post by: bplus on October 09, 2021, 06:44:37 pm

Quote from: SMcNeill on October 09, 2021, 04:34:48 pm

Don’t be so uptight. It's just a typo. Everyone knows he meant to type they’re!

LOL!

@johnno56
Yeah, umm... trying really hard to cut back on my edits. I guess my habit of posting had been to write, post, edit, edit, edit... until I'm accused of abusing the Modify privilege's. Hope this old dog can learn at least one new good habit.

Title: Re: Competition
Post by: bplus on October 09, 2021, 06:46:00 pm

It does look so much neater without and edit line at the bottom.

Title: Re: Competition
Post by: bplus on October 09, 2021, 06:50:51 pm

PS you missed one:

Quote

What did ence every do to em?

Meant to say "ever" not "every" and it's driving me crazy!

Well maybe just one, no, there was the usual "to" but meaning "too" back there to. ;-))

Title: Re: Competition
Post by: FellippeHeitor on October 09, 2021, 06:56:17 pm

Please, don't get me wrong. Fixing a typo is expected usage. Changing the contents after replies had already been posted was what was annoying.

The feature is back, it's just a matter of dosing usage really.

Title: Re: Competition
Post by: johnno56 on October 10, 2021, 09:04:06 am

My apologies. I will endeavour to do my best so as to not "poke at that hornets nest again".

Title: Re: Competition
Post by: Pete on October 11, 2021, 10:04:26 pm

Quote from: johnno56 on October 10, 2021, 09:04:06 am

My apologies. I will endeavour to do my best so as to not "poke at that hornets nest again".

When I was 9, I learned throwing crab apples at a hornet next was not a good idea, either. I also learned I could out run hornets. My cousin and I were having a contest, and I won. I hit the hornet nest first. We both saw a big black cloud emerge, and then we had our second, unscheduled event... we tied at that one. We both hit the woodshed door at the same time!

No hornets where I live now, but f there were, I'd recommend gasoline and fire. We do love barbecuing in California.

Pete

Title: Re: Competition
Post by: johnno56 on October 12, 2021, 05:00:25 am

Mmmm... barbecue...

Title: Re: Competition
Post by: Pete on October 12, 2021, 11:21:47 pm

Dogs and burgers tonight on the grill. I make the burgers with sauteed onions and mushrooms. 6 oz patties with garlic, onion, and seasonings.

Pete

Title: Re: Competition
Post by: bplus on October 12, 2021, 11:56:24 pm

BTW I've been wondering how this thing might be judged. I think all who have participated earn the right to vote. If everyone votes for them self or there is a tie, a person could be nominated and voted by for by the participants after Halloween to break the tie.

I was going to say voting day is November 2 but need a week after Halloween to try out the others to form a fair and balanced decision for your creation ha, ha! So yeah, that might be a rule, you aren't allowed to vote for yourself. And therefore the votes are to be made publicly. Or is all this just too formal for you guys?

Prize, did I hear someone wonder about that? How about a very strong recommendation by me to Qwerkey to immortalize your work in the Library?

Title: Re: Competition
Post by: Pete on October 13, 2021, 03:58:36 pm

Anyone up for invaders with FLAPPY BATS? Oh, and just edited in, The Great Pumpkin as the "Mother ship."

Code: QB64: [Select]

DIM SHARED intro%: intro% = -1
skip_intro:
DEFINT I
DIM SHARED lmargin%, rmargin%, topmargin%, screenwidth%, level, ibk, ileadingrow
DIM SHARED irow, icol, inextrnd, imaxalienmissiles, alienforce%, ileadingmax, imaxalienforce, ihits, score$
 
_SCREENMOVE _MIDDLE
 
score$ = "000000"
imaxalienforce = 6
imaxalienmissiles = 3
lmargin% = 2
rmargin% = 79
topmargin% = 3
ialiencolstat = 6
iwin = 3 ' 3 Levels.
screenwidth% = rmargin% - lmargin% + 1
ibk = 0 ' Background color
 
DIM SHARED a(imaxalienforce) AS STRING * 68
 
RANDOMIZE TIMER
SCREEN 0, 0, 0, 0
 
'fontpath$ = ENVIRON$("SYSTEMROOT") + "\fonts\lucon.ttf" 'Find Windows Folder Path.
'font& = _LOADFONT(fontpath$, 25, "monospace")
'_FONT font&
 
COLOR 7, 0: CLS
 
REM Make aliens
a1$ = "^^" + CHR$(79) + "^^  "
a$ = a1$ + a1$ + a1$ + a1$ + a1$ + a1$ + a1$ + a1$ + a1$ + a1$
alt1$ = "--" + CHR$(79) + "--  "
a$ = a1$ + alt1$ + a1$ + alt1$ + a1$ + alt1$ + a1$ + alt1$ + a1$ + alt1$
alt$ = alt1$ + a1$ + alt1$ + a1$ + alt1$ + a1$ + alt1$ + a1$ + alt1$ + a1$
 
IF intro% THEN
    SCREEN 0, 0, 1, 1
    CALL qbideOrig
 
    SCREEN 0, 0, 2, 0
    CALL qbide
 
    SCREEN 0, 0, 1, 1
    _DELAY 2
 
    IF _FILEEXISTS("Thunder6.ogg") THEN
        Rain& = _SNDOPEN("RainBk.ogg", "SYNC")
        T1& = _SNDOPEN("Thunder1.ogg", "SYNC")
        T2& = _SNDOPEN("Thunder2.ogg", "SYNC")
        T3& = _SNDOPEN("Thunder3.ogg", "SYNC")
        T4& = _SNDOPEN("Thunder4.ogg", "SYNC")
        T5& = _SNDOPEN("Thunder5.ogg", "SYNC")
        T6& = _SNDOPEN("Thunder6.ogg", "SYNC")
        T7& = _SNDOPEN("Thunder7.ogg", "SYNC")
        T8& = _SNDOPEN("Thunder8.ogg", "SYNC")
 
        _SNDPLAY T6&
        _DELAY .1
        _SNDPLAY T7&
        _DELAY .1
        _SNDPLAY T8&
    ELSE
        SOUND 1000, .3: SOUND 2400, .6:: SOUND 700, 2
    END IF
 
    FOR i = 1 TO 15
        _DELAY i / 150
        IF i / 2 = i \ 2 THEN
            SOUND 250, .1
            SCREEN 0, 0, 1, 1
        ELSE
            SCREEN 0, 0, 2, 2
            IF i < 13 THEN _DELAY i / 100: SCREEN 0, 0, 3, 3: COLOR 0, 7: CLS
        END IF
    NEXT
 
    PCOPY 2, 0
    SCREEN 0, 0, 0, 0
    _DELAY 1.5
 
    CALL TheBOB
 
    '_FREEFONT font&
    'fontpath$ = ENVIRON$("SYSTEMROOT") + "\fonts\lucon.ttf" 'Find Windows Folder Path.
    'font& = _LOADFONT(fontpath$, 25, "monospace")
    '_FONT font&
 
    CALL qbide
 
ELSE
    CALL qbide
END IF
 
 
IF intro% = -1 THEN RESTORE first_play ELSE RESTORE replay
 
CALL instructions
 
DO
    IF inextrnd = -1 THEN PCOPY 3, 0
    tank$ = CHR$(218) + CHR$(127) + CHR$(191): icolor = 6
    REDIM SHARED bullet%(5), bulletcol%(5), bulletdelay%(5), iltalien(imaxalienforce)
    REDIM SHARED ia(imaxalienmissiles), iy(imaxalienmissiles), ix(imaxalienmissiles)
    REDIM SHARED matrix(imaxalienforce) AS STRING * 10
    alienforce% = imaxalienforce
    level = .65
    iround = iround + 1
    level = level - iround / 15
    inextrnd = -1
    COLOR 6, ibk
 
    REM Set up aliens
    ialiencol = ialiencolstat
    LOCATE 2, ialiencol
    FOR i = 1 TO imaxalienforce
        IF i MOD 1 = 0 THEN PRINT
        LOCATE , ialiencol
        IF i = imaxalienforce THEN
            ileadingrow = CSRLIN: ileadingmax = ileadingrow
        END IF
        IF i \ 2 = i / 2 THEN a(i) = a$ ELSE a(i) = alt$
        PRINT a(i)
    NEXT
 
    COLOR 0 + 16, 3
    LOCATE 25, 68: PRINT "Score ";
    COLOR 0, 3
    PRINT score$;
    COLOR 6, ibk
 
    REM Station
    LOCATE 24, 40
    tanky% = CSRLIN: tankx% = POS(0) + 1
    PRINT tank$;: LOCATE , POS(0) - 2
 
    _DELAY 1
 
    DO
        z1 = TIMER
        DO
            IF zbonus THEN
                IF ABS(zbonus - TIMER) > 1.5 THEN
                    yy% = CSRLIN: xx% = POS(0)
                    COLOR 6, 0: LOCATE topmargin%, lmargin%: PRINT SPACE$(screenwidth%);
                    LOCATE yy%, xx%
                    zbonus = 0
                END IF
            END IF
 
            IF topmargin% + ileadingmax - (imaxalienforce * 2) >= topmargin% + 2 THEN
                IF imothership <> 0 THEN CALL mship(imothership)
            END IF
            IF ABS(TIMER - z1aliens) > level THEN
                CALL movealiens(ialiencol, ialiencolstat, iresults)
                z1aliens = TIMER
            END IF
            IF iresults < 0 THEN EXIT DO
            IF ABS(TIMER - z1ia) > .3 THEN CALL alienmissile(iresults): z1ia = TIMER
 
            DEF SEG = 0
            IF PEEK(1047) MOD 16 = 7 OR PEEK(1047) MOD 16 = 8 THEN
                key$ = CHR$(32) ' Alt
            ELSE
                key$ = ""
            END IF
            DEF SEG
 
            SELECT CASE key$
                CASE CHR$(32)
                    IF flag = 0 THEN switch = switch * -1 - 1: flag = -1
                    SELECT CASE switch
                        CASE 0
                            IF ABS(z9 - TIMER) > .15 THEN
                                IF POS(0) < screenwidth% THEN COLOR icolor, ibk: LOCATE , POS(0) - 1: PRINT " " + tank$;: LOCATE , POS(0) - 2
                                tanky% = CSRLIN: tankx% = POS(0)
                                IF SCREEN(tanky%, tankx% - 2) = 25 OR SCREEN(tanky%, tankx% + 2) = 25 THEN result = -1: EXIT DO
                                z9 = TIMER
                            END IF
                        CASE -1
                            IF ABS(z9 - TIMER) > .15 THEN
                                IF POS(0) > lmargin% + 1 THEN COLOR icolor, ibk: LOCATE , POS(0) - 2: PRINT tank$ + " ";: LOCATE , POS(0) - 3
                                tanky% = CSRLIN: tankx% = POS(0)
                                IF SCREEN(tanky%, tankx% - 2) = 25 OR SCREEN(tanky%, tankx% + 2) = 25 THEN result = -1: EXIT DO
                                z9 = TIMER
                            END IF
                    END SELECT
                    IF icolor = 6 THEN
                        FOR i2 = 1 TO 5
                            IF bullet%(i2) = 0 THEN
                                icolor = 12: COLOR icolor, ibk: GOSUB redraw
                                bullet%(i2) = -1: reload = TIMER: EXIT FOR
                            END IF
                        NEXT
                    END IF
                CASE ""
                    IF flag THEN skip = 0: flag = 0
                CASE CHR$(27): SYSTEM
            END SELECT
 
            IF ABS(z1 - reload) > .6 AND reload <> 0 THEN
                GOSUB redraw
                icolor = 6: reload = 0
            END IF
 
            REM Fire
            FOR i = 1 TO 5
                SELECT CASE bullet%(i)
                    CASE -1: bullet%(i) = tanky% - 1: bulletcol%(i) = tankx%
                    CASE IS > 0
                        IF bulletdelay%(i) = -1 OR bullet%(i) = tanky% - 1 THEN
                            CALL checkcollision(ihitaliens, ialiencol, i4, i)
                            z2bullet = TIMER: bulletdelay%(i) = 0
                            COLOR 6, ibk
                            LOCATE bullet%(i), bulletcol%(i)
                            IF bullet%(i) = topmargin% AND imothership <> 0 THEN ' Hit mother ship.
                                IF SCREEN(ABS(bullet%(i)), bulletcol%(i)) <> 32 THEN
                                    SOUND 1000, .75
                                    SELECT CASE iresults + 1
                                        CASE 1: bonus = 1500
                                        CASE 2: bonus = 2500
                                        CASE 3: bonus = 5000
                                    END SELECT
                                    score$ = LTRIM$(STR$(VAL(score$) + bonus))
                                    score$ = STRING$(6 - LEN(score$), "0") + score$
                                    yy% = CSRLIN: xx% = POS(0)
                                    SOUND 800, .5: SOUND 1600, .5: SOUND 2400, .5
                                    LOCATE topmargin%, lmargin%: PRINT SPACE$(screenwidth%);
                                    kbonus = bulletcol%(i) - 4
                                    IF kbonus < lmargin% THEN kbonus = lmargin%
                                    IF kbonus + 10 > screenwidth% THEN kbonus = screenwidth% - 11
                                    zbonus = TIMER
                                    LOCATE yy%, xx%
                                    imothership = 0
                                END IF
                            END IF
                            PRINT CHR$(24) ' Tank missile.
                            IF CSRLIN <> 24 THEN LOCATE , bulletcol%(i): PRINT " ";
                            IF ihitaliens <> 0 THEN CALL reprintaliens(ialiencol, ihitaliens, iresults, i4, i, imothership)
                            LOCATE tanky%, tankx%
                            IF bullet%(i) > topmargin% THEN
                                bullet%(i) = bullet%(i) - 1
                            ELSE
                                GOSUB erasebullet
                            END IF
 
                            IF zbonus THEN
                                yy% = CSRLIN: xx% = POS(0)
                                LOCATE topmargin%, kbonus: COLOR 2 + 16: PRINT "BONUS " + LTRIM$(STR$(bonus));
                                LOCATE yy%, xx%
                            END IF
 
                        END IF
                END SELECT
            NEXT
 
            REM Bullet timer delay
            IF z2bullet <> 0 THEN
                IF z1 < z2bullet THEN z2bullet = z2bullet - 86400
                IF z1 - z2bullet >= .06 THEN
                    FOR i2 = 1 TO 5
                        IF bullet%(i2) <> 0 THEN bulletdelay%(i2) = -1
                    NEXT i2
                END IF
                EXIT DO
            END IF
        LOOP
        IF iresults < 0 THEN EXIT DO
        IF alienforce% = 0 OR iresults = iwin THEN
            FOR i = 1 TO imaxalienmissiles
                IF ia(i) <> 0 THEN EXIT FOR
            NEXT
            IF i > imaxalienmissiles THEN iwait = -1
            IF iwait = -1 THEN
                EXIT DO
            END IF
        ELSE
            iwait = 1
        END IF
    LOOP
 
    IF iresults = iwin OR iresults < 0 THEN
        REM end game
        EXIT DO
    END IF
    inextrnd = -1
LOOP
 
SELECT CASE iresults
    CASE -1 ' Tank destroyed!
        SOUND 800, .3: SOUND 250, 1
 
        FOR i = 1 TO 5
            COLOR 14, 4
            LOCATE tanky%, tankx% - 1: PRINT tank$;
            _DELAY .1
 
            COLOR 8, ibk
            LOCATE tanky%, tankx% - 1: PRINT tank$;
            _DELAY .1
        NEXT
 
        COLOR 6, ibk
        LOCATE tanky% - 1, lmargin%
        PRINT SPACE$(screenwidth%);
        LOCATE tanky%, lmargin%
        PRINT SPACE$(screenwidth%);
 
        _DELAY 2
 
        CALL qbide
 
    CASE -2 ' Aliens have landed!
        SOUND 1000, .3: SOUND 2400, .6:: SOUND 700, 2
 
        COLOR 7, 0
        FOR i = 0 TO 21 ' Blank out screen.
            LOCATE topmargin% + i, lmargin%: PRINT SPACE$(screenwidth%);
        NEXT
 
        COLOR 6, ibk
        LOCATE tanky% - 1, lmargin%
        PRINT SPACE$(screenwidth%);
        LOCATE tanky%, lmargin%
        PRINT SPACE$(screenwidth%);
 
        COLOR 8, ibk
 
        FOR j = imaxalienforce TO 1 STEP -1
            IF a(j) <> "" THEN EXIT FOR
        NEXT
 
        FOR i = j TO 1 STEP -1
            LOCATE , ialiencol + INSTR(a(i), CHR$(79)) - 2
            PRINT LTRIM$(RTRIM$(a(i)));
            LOCATE CSRLIN - 2
        NEXT
 
        _DELAY 2.5
 
    CASE ELSE ' Winner.
 
        l$ = "12"
        n$ = "n29": PLAY "L" + l$ + n$: _DELAY .5
        n$ = "n24": PLAY "L" + l$ + n$: _DELAY .5
        n$ = "n33": PLAY "L" + l$ + n$: _DELAY .5
        n$ = "n29": PLAY "L" + l$ + n$
 
        CALL qbide
 
        RESTORE winner
 
END SELECT
 
 
COLOR 0, 3
LOCATE 25, 68: PRINT "Score "; score$;
 
CALL instructions
 
COLOR 6, 0
LOCATE 5, 3: PRINT "Score "; score$
 
DEF SEG = 0
DO
    _LIMIT 30
    b$ = INKEY$
    IF b$ = CHR$(27) THEN SYSTEM
    IF PEEK(1047) MOD 16 = 7 OR PEEK(1047) MOD 16 = 8 THEN EXIT DO
LOOP
DEF SEG
 
RUN skip_intro
 
erasebullet:
LOCATE ABS(bullet%(i)), bulletcol%(i): PRINT " ";
bullet%(i) = 0: bulletcol%(i) = 0: bulletdelay%(i) = 0
LOCATE tanky%, tankx%
RETURN
 
redraw:
COLOR , ibk: LOCATE tanky%, tankx% - 1: PRINT tank$;: LOCATE tanky%, tankx%: COLOR 7, ibk
RETURN
 
first_play:
DATA "The Great Pumpkin has fired an EM pulse at your computer."
DATA ""
DATA "All that's left working is your Alt key."
DATA ""
replay:
DATA "Loading..."
DATA "EOF"
DATA "Game Over. Press Alt to play again..."
DATA "EOF2"
winner:
DATA "Congratulations, you saved the planet!"
DATA "EOF3"
 
 
SUB alienattack (ialiencol)
    z2alienfire = TIMER
 
    i3 = INT(RND * 10)
    FOR i = 1 TO imaxalienmissiles
        IF ia(i) = 0 THEN
            FOR i2 = imaxalienforce TO 1 STEP -1
                IF RTRIM$(a(i2)) <> "" THEN
                    IF MID$(matrix(i2), i3 + 1, 1) <> "0" THEN
                        i4 = INSTR(i3 * 7 + 1, a(i2), CHR$(79)) + ialiencol
                        EXIT FOR
                    END IF
                END IF
            NEXT i2
            IF i4 <> 0 THEN
                ia(i) = (ileadingmax - (imaxalienforce - i2) * 2) * 80 + i4
                EXIT FOR
            END IF
        END IF
    NEXT i
 
END SUB
 
SUB alienmissile (iresults)
    irow = CSRLIN: icol = POS(0)
    FOR i = 1 TO imaxalienmissiles
        IF ia(i) <> 0 THEN
            IF iy(i) = 0 THEN
                iy(i) = ia(i) \ 80: ix(i) = ia(i) MOD 80
                IF ix(i) = 0 THEN ix(i) = screenwidth%
            END IF
            LOCATE iy(i) + 1, ix(i)
            COLOR 6, ibk
            IF CSRLIN <= 24 THEN
                IF CSRLIN = 24 THEN IF SCREEN(CSRLIN, ix(i)) <> 32 THEN iresults = -1
                PRINT CHR$(25);
            ELSE
                ia(i) = 0
                LOCATE iy(i), ix(i)
                PRINT " ";: iy(i) = 0
                ia(i) = 0
                LOCATE irow, icol
                EXIT SUB
            END IF
            LOCATE iy(i), ix(i): PRINT " ";
            iy(i) = iy(i) + 1
        END IF
    NEXT
    LOCATE irow, icol
 
END SUB
 
SUB checkcollision (ihitaliens, ialiencol, i4, i)
    ihitaliens = 0
    IF ileadingmax MOD 2 = bullet%(i) MOD 2 THEN
        i4 = imaxalienforce - (ileadingmax - bullet%(i)) \ 2
        IF bullet%(i) <= ileadingrow AND i4 > 0 AND i4 <= imaxalienforce THEN
            IF RTRIM$(a(i4)) <> "" THEN
                IF bulletcol%(i) >= iltalien(i4) AND bulletcol%(i) - ialiencol <= LEN(RTRIM$(a(i4))) THEN
                    IF MID$(a(i4), bulletcol%(i) - ialiencol, 1) > CHR$(32) THEN
                        ihitaliens = bulletcol%(i) - ialiencol + 1
                        i3 = ihitaliens - 7 + 1
                        IF i3 < 1 THEN i3 = 1: REM count from the "<" symbol.
                        i2 = INSTR(i3 + 1, a(i4), "^" + CHR$(79)) - 1
                        i2 = INSTR(i3 + 1, a(i4), CHR$(79)) - 2
                        MID$(a(i4), i2, 7) = SPACE$(7)
                        MID$(matrix(i4), (i2 + 1) \ 7 + 1, 1) = "0"
                    END IF
                END IF
            END IF
        END IF
    END IF
 
    FOR i2 = 1 TO imaxalienmissiles
        IF ia(i2) <> 0 THEN
            IF iy(i2) >= bullet%(i) AND ix(i2) = bulletcol%(i) THEN
                ihitaliens = -i2
                EXIT FOR
            END IF
        END IF
    NEXT
 
END SUB
 
SUB instructions
    IF in$ = "" THEN
        LOCATE 3, 3, 1, 7, 0: COLOR 6, ibk
        _DELAY 2
        DO
            READ in$
            IF MID$(in$, 1, 3) = "EOF" THEN EXIT DO
            FOR i = 1 TO LEN(in$)
                SOUND 400, .06
                LOCATE , 2 + i
                PRINT MID$(in$, i, 1);
                z = TIMER
                DO
                    IF ABS(z - TIMER) > .06 THEN EXIT DO
                LOOP
            NEXT
            LOCATE , , 0, 7, 0
            _DELAY 1
            PRINT
            LOCATE , 3
        LOOP
        _DELAY .75
    END IF
 
    IF in$ = "EOF" THEN
        COLOR 7, 0
        FOR i = 0 TO 19 ' Blank out intro message space.
            LOCATE topmargin% + i, lmargin%: PRINT SPACE$(screenwidth%);
        NEXT
        FOR i = 3 TO 24
            LOCATE i, 80: PRINT CHR$(179);
        NEXT
        LOCATE 21, 2: PRINT STRING$(screenwidth%, " ");
        LOCATE 22, 1: PRINT CHR$(179);
        LOCATE 22, 80: PRINT CHR$(179);
        LOCATE 22, 2: PRINT STRING$(screenwidth%, " ");
    ELSE
        COLOR 0, 3
    END IF
 
    IF in$ <> "EOF2" AND iresults <> iwin THEN COLOR 0 + 16, 3 ELSE COLOR 0, 3
    yy% = CSRLIN: xx% = POS(0)
    LOCATE 25, 68: PRINT "Score ";
    COLOR 0, 3
    PRINT score$;
    LOCATE yy%, xx%
 
    PCOPY 0, 3: REM save skin
 
END SUB
 
SUB marchdown (ialiencol, ialiencolstat, imotion, iresults)
    COLOR 6, ibk
    ileadingrow = ileadingrow + 1
    ileadingmax = ileadingmax + 1
    COLOR 6, ibk
    FOR i = 1 TO imaxalienforce
        REM SOUND 400, .2 ' Level down.
        IF RTRIM$(a(i)) <> "" THEN
            ialiencol = ialiencolstat + imotion
            LOCATE ileadingmax - (imaxalienforce * 2) + i * 2 - 1, lmargin%
            PRINT STRING$(screenwidth%, " ")
            LOCATE , ialiencol + INSTR(a(i), CHR$(79)) - 2
            iltalien(i) = POS(0)
            PRINT LTRIM$(RTRIM$(a(i)))
        END IF
    NEXT
    LOCATE irow, icol
    level = level - .025
    IF ileadingrow = 22 THEN iresults = -2 ' Aliens have landed!
END SUB
 
DEFSNG I
DEFINT I
SUB movealiens (ialiencol, ialiencolstat, iresults)
    STATIC imotion, imarch, imotiondir
 
    SOUND 800, .1: SOUND 200, .33 ' Marching sound.
 
    IF inextrnd = -1 THEN inextrnd = 0: imotion = 0: imarch = 0: imotiondir = 0
    irow = CSRLIN: icol = POS(0)
    yy% = CSRLIN: xx% = POS(0)
    PCOPY 0, 1: SCREEN 0, 0, 1, 0: LOCATE yy%, xx%, 0, 7, 0
    IF imotiondir = 0 THEN imotion = imotion - 1 ELSE imotion = imotion + 1
    COLOR 6, ibk
 
    FOR i = imaxalienforce TO 1 STEP -1
        IF RTRIM$(a(i)) <> "" THEN
            FOR k = 1 TO LEN(a(i))
                k$ = MID$(a(i), k, 1)
                IF k$ = "^" THEN
                    MID$(a(i), k, 1) = "-"
                ELSEIF k$ = "-" THEN
                    MID$(a(i), k, 1) = "^"
                END IF
            NEXT
            i2 = i2 + 2
            ialiencol = ialiencolstat + imotion
            LOCATE ileadingmax - (imaxalienforce - i) * 2, ialiencol + INSTR(a(i), CHR$(79)) - 2
            IF POS(0) = lmargin% THEN imarch = 1
            iltalien(i) = POS(0)
            IF imotiondir = 0 THEN
                PRINT LTRIM$(RTRIM$(a(i))); " "
            ELSE
                LOCATE , POS(0) - 1
                PRINT " "; LTRIM$(RTRIM$(a(i)))
            END IF
            IF ialiencol + LEN(RTRIM$(a(i))) = screenwidth% THEN imarch = -1
        END IF
    NEXT
 
    IF imarch = 1 THEN imotiondir = 1: CALL marchdown(ialiencol, ialiencolstat, imotion, iresults)
    IF imarch = -1 THEN imotiondir = 0: CALL marchdown(ialiencol, ialiencolstat, imotion, iresults)
    IF imarch = 0 THEN
        IF ABS(TIMER - z2alienfire) > firerate THEN
            firerate = (INT(RND * 10) + 1) / 20
            IF iwait = 0 THEN CALL alienattack(ialiencol)
        END IF
    ELSE
        imarch = 0
    END IF
    PCOPY 1, 0: SCREEN 0, 0, 0, 0
    LOCATE irow, icol, 1, 7, 0
END SUB
 
SUB mship (imothership)
    STATIC x%, mov%, z4, mothership$
 
    yy% = CSRLIN: xx% = POS(0): COLOR 6, ibk
    IF imothership = -1 THEN
        imothership = 1
        x% = lmargin%
        mothership$ = "(" + CHR$(127) + CHR$(179) + CHR$(127) + ")" 'CHR$(254) + CHR$(254) + "O" + CHR$(254) + CHR$(254)
        mov% = 1
    END IF
 
    IF ABS(TIMER - z4) > .05 THEN GOSUB mothership: z4 = TIMER
    LOCATE yy%, xx%
    EXIT SUB
 
    mothership:
    IF x% + LEN(mothership$) = screenwidth% + lmargin% THEN mov% = -1 ELSE IF x% = lmargin% THEN mov% = 1
    x% = x% + mov%
    LOCATE topmargin%, x%
    COLOR 7, 6: PRINT MID$(mothership$, 1, 1);
    COLOR 14, 6: PRINT MID$(mothership$, 2, 1);
    COLOR 7, 6: PRINT MID$(mothership$, 3, 1);
    COLOR 14, 6: PRINT MID$(mothership$, 4, 1);
    COLOR 7, 6: PRINT MID$(mothership$, 5, 1);
    COLOR 7, ibk
    IF x% > 1 AND mov% = 1 THEN
        LOCATE , POS(0) - LEN(mothership$) - 1: PRINT " ";
    END IF
    IF mov% = -1 THEN PRINT " ";
    RETURN
 
END SUB
 
DEFINT A-H, J-Z
SUB qbide
    PALETTE 2, 59
    COLOR 15, 0
    CLS
 
    COLOR 0, 7
    LOCATE 1, 1
    PRINT SPACE$(80)
    LOCATE 1, 1: PRINT "   File  Edit  View  Search  Run  Debug  Calls  Options                   Help"
 
    COLOR 7, 0 ' Black background.
 
    LOCATE 2, 1: PRINT CHR$(218)
    LOCATE 2, 2: PRINT STRING$(78, CHR$(196))
    LOCATE 2, 80: PRINT CHR$(191)
 
    LOCATE 2, 76: PRINT CHR$(180)
    LOCATE 2, 78: PRINT CHR$(195)
 
    COLOR 0, 7
    LOCATE 2, 77: PRINT CHR$(24)
    LOCATE 2, 36: PRINT " Untitled "
 
    COLOR 7, 0
    FOR Rows = 3 TO 24
        LOCATE Rows, 1: PRINT CHR$(179);
        LOCATE Rows, 80: PRINT CHR$(179);
    NEXT Rows
 
    LOCATE 22, 1: PRINT CHR$(195)
    LOCATE 22, 80: PRINT CHR$(180)
    LOCATE 22, 2: PRINT STRING$(78, CHR$(196))
    LOCATE 22, 35
    PRINT " Immediate "
 
    COLOR 0, 7
    LOCATE 21, 3: PRINT STRING$(76, CHR$(176))
    LOCATE 21, 2: PRINT CHR$(27)
    LOCATE 21, 3: PRINT CHR$(219)
    LOCATE 21, 79: PRINT CHR$(26)
    FOR Rows = 4 TO 19
        LOCATE Rows, 80: PRINT CHR$(176)
    NEXT Rows
    LOCATE 3, 80: PRINT CHR$(24)
    LOCATE 4, 80: PRINT CHR$(219)
    LOCATE 20, 80: PRINT CHR$(25)
 
    COLOR 0, 3: LOCATE 25, 1: PRINT " <Shift+F1=Help> <F6=Window> <F2=Subs> <F5=Run> <F8=Step> ";
    LOCATE 25, 59: PRINT SPACE$(4);
    COLOR 0, 3
    LOCATE 25, 63: PRINT CHR$(179);
    LOCATE 25, 64: PRINT SPACE$(6);
    LOCATE 25, 68: PRINT "C  00001:001 ";
 
END SUB
 
DEFSNG A-H, J-Z
SUB reprintaliens (ialiencol, ihitaliens, iresults, i4, i, imothership)
    IF ihitaliens > 0 THEN
        ihits = ihits + 1
 
        SELECT CASE iresults + 1
            CASE 1: score$ = LTRIM$(STR$(VAL(score$) + 150))
            CASE 2: score$ = LTRIM$(STR$(VAL(score$) + 250))
            CASE 3: score$ = LTRIM$(STR$(VAL(score$) + 350))
        END SELECT
 
        score$ = STRING$(6 - LEN(score$), "0") + score$
        IF (ihits + 15) MOD 20 = 0 AND imothership = 0 THEN imothership = -1
        LOCATE bullet%(i), lmargin%: PRINT SPACE$(screenwidth%);
        iltalien(i4) = POS(0)
 
        IF RTRIM$(a(i4)) = "" THEN
            alienforce% = alienforce% - 1
            IF alienforce% = 0 THEN iresults = iresults + 1 ' Level completed. Goto to next level.
            IF bullet%(i) = ileadingrow THEN ileadingrow = ileadingrow - 2
        ELSE
            LOCATE bullet%(i), ialiencol + INSTR(a(i4), CHR$(79)) - 2
            PRINT LTRIM$(RTRIM$(a(i4)))
        END IF
    ELSE
        i2 = ABS(ihitaliens)
        LOCATE iy(i2), ix(i2)
        PRINT " ";: iy(i2) = 0
        ia(i2) = 0
        LOCATE irow, icol
        SOUND 1000, .5
    END IF
 
    ihitaliens = 0
    bullet%(i) = -bullet%(i)
 
    COLOR 0, 3
    yy% = CSRLIN: xx% = POS(0)
    LOCATE 25, 74: PRINT score$;
    LOCATE yy%, xx%
    COLOR 6, ibk
 
END SUB
 
SUB qbideOrig
    PALETTE 2, 59
    COLOR 15, 1
    CLS
 
    COLOR 0, 7
    LOCATE 1, 1
    PRINT SPACE$(80)
    LOCATE 1, 1: PRINT "   File  Edit  View  Search  Run  Debug  Calls  Options                   Help"
 
    COLOR 7, 1
 
    LOCATE 2, 1: PRINT CHR$(218)
    LOCATE 2, 2: PRINT STRING$(78, CHR$(196))
    LOCATE 2, 80: PRINT CHR$(191)
 
    LOCATE 2, 76: PRINT CHR$(180)
    LOCATE 2, 78: PRINT CHR$(195)
 
    COLOR 1, 7
    LOCATE 2, 77: PRINT CHR$(24)
    LOCATE 2, 36: PRINT " Untitled "
 
    COLOR 7, 1
    FOR Rows = 3 TO 24
        LOCATE Rows, 1: PRINT CHR$(179);
        LOCATE Rows, 80: PRINT CHR$(179);
    NEXT Rows
 
    LOCATE 22, 1: PRINT CHR$(195)
    LOCATE 22, 80: PRINT CHR$(180)
    LOCATE 22, 2: PRINT STRING$(78, CHR$(196))
    LOCATE 22, 35
    PRINT " Immediate "
 
    COLOR 0, 7
    LOCATE 21, 3: PRINT STRING$(76, CHR$(176))
    LOCATE 21, 2: PRINT CHR$(27)
    LOCATE 21, 3: PRINT CHR$(219)
    LOCATE 21, 79: PRINT CHR$(26)
    FOR Rows = 4 TO 19
        LOCATE Rows, 80: PRINT CHR$(176)
    NEXT Rows
    LOCATE 3, 80: PRINT CHR$(24)
    LOCATE 4, 80: PRINT CHR$(219)
    LOCATE 20, 80: PRINT CHR$(25)
 
    COLOR 0, 3: LOCATE 25, 1: PRINT " <Shift+F1=Help> <F6=Window> <F2=Subs> <F5=Run> <F8=Step> ";
    LOCATE 25, 59: PRINT SPACE$(4);
    COLOR 0, 3
    LOCATE 25, 63: PRINT CHR$(179);
    LOCATE 25, 64: PRINT SPACE$(6);
    LOCATE 25, 68: PRINT "C  00001:001 ";
 
END SUB
 
SUB TheBOB
    SCREEN _NEWIMAGE(800, 600, 256)
    WIDTH 80, 25
 
    OUT &H3C8, 1: OUT &H3C9, 40: OUT &H3C9, 12: OUT &H3C9, 0
    OUT &H3C8, 2: OUT &H3C9, 6: OUT &H3C9, 12: OUT &H3C9, 0
    OUT &H3C8, 3: OUT &H3C9, 30: OUT &H3C9, 8: OUT &H3C9, 0
    OUT &H3C8, 4: OUT &H3C9, 3: OUT &H3C9, 8: OUT &H3C9, 0
    OUT &H3C8, 7: OUT &H3C9, 63: OUT &H3C9, 0: OUT &H3C9, 0
    OUT &H3C8, 8: OUT &H3C9, 46: OUT &H3C9, 0: OUT &H3C9, 0
    OUT &H3C8, 9: OUT &H3C9, 63: OUT &H3C9, 63: OUT &H3C9, 63
    OUT &H3C8, 12: OUT &H3C9, 20: OUT &H3C9, 20: OUT &H3C9, 20
    OUT &H3C8, 13: OUT &H3C9, 0: OUT &H3C9, 0: OUT &H3C9, 0
    OUT &H3C8, 14: OUT &H3C9, 55: OUT &H3C9, 35: OUT &H3C9, 0
 
    CIRCLE (320, 240), 100, 3, , , .9
    PAINT (320, 240), 3
    CIRCLE (320, 230), 90, 1, , , .9
    PAINT (320, 230), 1
 
    FOR Reps = 1 TO 4
        SELECT CASE Reps
            DATA 1,1.2,1.8,5
            CASE 1: Elipse = 1
            CASE 2: Elipse = 1.2
            CASE 3: Elipse = 1.8
            CASE 4: Elipse = 5
        END SELECT
        FOR E = Elipse TO Elipse + .1 STEP .01
            CIRCLE (320, 240), 100, 3, , , E
        NEXT E
    NEXT Reps
    FOR Radius = 38 TO 43
        CIRCLE (320, 160), Radius, 3, , , .4
    NEXT Radius
    CIRCLE (320, 160), 40, 14, 3.3, 6, .4
    CIRCLE (320, 240), 100, 5, , , .9
    PAINT (0, 0), 5
    CIRCLE (320, 240), 100, 0, , , .9
    PAINT (0, 0), 0
    FOR Radius = 12 TO 18
        CIRCLE (320, 153), Radius, 2, , , .3
    NEXT Radius
 
    CIRCLE (320, 150), 12, 2, , , .6
    PAINT STEP(0, 0), 2
    CIRCLE (300, 143), 32, 2, 6, 1.1
    CIRCLE (276, 143), 32, 2, 6, .6
    DRAW "BM302,125 C2 M+15,-10 BD10 P2,2"
    PAINT (320, 145), 2
    CIRCLE (282, 143), 32, 4, 6, .73
    CIRCLE (266, 156), 60, 4, .1, .68
    CIRCLE (320, 150), 12, 4, 3.14159, 0, .2
    DRAW "BM302,125 C4 M+15,-10 BD10"
    CIRCLE (276, 143), 32, 4, 6, .6
    PAINT STEP(35, 0), 4
    'Face begins
    CIRCLE (303, 316), 100, 14, 1.5, 2
    CIRCLE (337, 316), 100, 14, 1.1, 1.64
    PSET (310, 215), 14
    DRAW "H30 M-20,+40 M+12,-4 M+14,-29 BL2 P14,14 BF12 P15,14"
    PSET (330, 215), 14
    DRAW "E30 M+20,+40 M-12,-4 M-14,-29 BR2 P14,14 BG12 P15,14"
    PSET (320, 246), 14
    DRAW "R20 H20 G20 R20 U nL19 nR19 BU2 P15,14"
    CIRCLE (320, 170), 100, 14, 3.8, 4.1
    CIRCLE (320, 170), 100, 14, 4.42, 5.01
    CIRCLE (320, 170), 100, 14, 5.33, 5.62
    CIRCLE (320, 220), 80, 14, 3.29, 4.5
    CIRCLE (320, 220), 80, 14, 4.66, 6.15
    PSET (260, 250), 14
    DRAW "D10 F8 U13 M+10,+5 D12 M+12,+6 U12 BR60"
    DRAW "D12 M+12,-6 U12 M+10,-5 D13 E8 U10"
    PSET (300, 297), 14
    DRAW "U14 R16 D16"
    CIRCLE (320, 212), 80, 14, 3.42, 4.5
    CIRCLE (320, 212), 80, 14, 4.66, 6
    LINE (300, 280)-(316, 283), 14, BF
    PAINT (320, 296), 14
    PAINT (290, 292), 14
    PAINT (300, 278), 15, 14
    CIRCLE (100, 240), 32, 13
    PAINT STEP(0, 0), 13
 
    FOR x% = 58 TO 142
        FOR y% = 198 TO 282
            IF POINT(x%, y%) = 13 THEN
                IF POINT(x% + 220, y%) = 15 THEN PSET (x% + 220, y%), 9
            END IF
        NEXT y%
    NEXT x%
 
    COLOR 13: LOCATE 1, 1: PRINT "HAPPY HALLOWEEN!"
 
    xx = 64: yy = 360 - 330
    FOR x% = 0 TO 300
        FOR y% = 0 TO 16
            IF POINT(x%, y%) = 13 THEN
                IF y% > 6 THEN Colr = 8 ELSE Colr = 7
                LINE (x% * 4 + xx, y% * 4 + yy)-(x% * 4 + xx + 3, y% * 4 + yy + 3), Colr, BF
            END IF
        NEXT y%
    NEXT x%
    FOR x% = 0 TO 639
        IF POINT(x%, 368) <> 0 THEN PSET (x%, 368), 14
    NEXT x%
 
    z1 = TIMER
    DO UNTIL ABS(TIMER - z1) > 4
        FOR Reps = 1 TO 3
            WAIT &H3DA, 8
            WAIT &H3DA, 8, 8
        NEXT Reps
 
        Flicker = FIX(RND * 20)
        OUT &H3C8, 14
        OUT &H3C9, 40 + Flicker
        OUT &H3C9, 25 + Flicker
        OUT &H3C9, 10 + Flicker
 
        OUT &H3C8, 15
        OUT &H3C9, 43 + Flicker
        OUT &H3C9, 38 + Flicker
        OUT &H3C9, 20 + Flicker
    LOOP
    SCREEN 0, 0, 0, 0
END SUB

[ This attachment cannot be displayed inline in 'Print Page' view ]

If @johnno56 likes it, I'll add save high score routine.

Pete

Title: Re: Competition
Post by: jack on October 13, 2021, 04:34:30 pm

not bad Pete, actually quite good

Title: Re: Competition
Post by: Pete on October 13, 2021, 04:48:27 pm

Quote from: jack on October 13, 2021, 04:34:30 pm

not bad Pete, actually quite good

Thanks! I just edited in a "Great Pumpkin" rendition of the mother ship. I think it's about as Halloweenie as it can get now. Maybe same time I can get a couple more screen flashes for a missile to missile collision, and a firing time-out if that collision is too close to the tank. I think it could also use a couple more sound effects, but that's not something I'm well versed at. It was great having TheBOB toss his pumpkin in the ring, along with his .oog files for the thunder effect. Oh, that reminds me, I should update the post to include the .oog file download...

Pete

Title: Re: Competition
Post by: Dav on October 13, 2021, 07:06:54 pm

Nice one, Pete! Plays great.

- Dav

Title: Re: Competition
Post by: Pete on October 13, 2021, 07:45:02 pm

@Dav Thanks! I wish I had your abillty with sound effects. Any idea if SOUND can produce a "gloop" noise? I should probably start messing with PLAY and figure out some rendition for the Great Pumpkin mother ship while it's on the screen, too.

I just did another edit to make TheBOB's pumpkin animation more seamless. Maybe you guys have a better way, but it looks like by using...

SCREEN _NEWIMAGE(800, 600, 256)
WIDTH 80, 25

... for the graphics part, I can keep the screen from stretching, as it did when it was going from SCREEN 0 to SCREEN 12.

Pete

Title: Re: Competition
Post by: Dav on October 13, 2021, 08:36:12 pm

Hmm, I don't have a GLOOP code on hand, I'll look for something if you want. I had a whole folder of SOUND effect codes on a drive somewhere.

Lol, that EM pulse knocked out all the bats. They just froze all the sudden and I picked them off easy and moved around freely all alone for a while.

- Dav

[ This attachment cannot be displayed inline in 'Print Page' view ]

Title: Re: Competition
Post by: Pete on October 13, 2021, 08:52:50 pm

What you just described I have not experienced. The bats are never supposed to freeze. The missiles still on the screen after the last bat is shot always happens. If I recall right, a missile heading for your tank, after all the bats are gone, can still blow your tank up. The next level begins when the missiles complete their flight.

I'll look up some stuff and see what I can come up with for a gloop sound.

Pete

Title: Re: Competition
Post by: Dav on October 13, 2021, 08:59:24 pm

It only happened once for me. My bullets would just clear the characters off the screen when going up, not a whole bat, just pieces. Happened towards near the end of a wave of bats.

- Dav

Title: Re: Competition
Post by: Pete on October 13, 2021, 09:17:39 pm

Hmmm, some glitch in the redraw part. I'll have a look, but this one looks like it will be hard to reproduce.

Thanks!

Pete

Title: Re: Competition
Post by: bplus on October 14, 2021, 11:50:06 am

Very nice work Pete. Kind of surprised it's not pure Screen 0 from our Hero but always great to see TheBobs marvelous graphics!

Could you post code in it's own thread in Programs board for further updates if any, plus, comments and feedback related to that code. This is to help Librarians track things. It's a huge help for code postings to have an anchor thread in Programs Board. I think the Discussion Boards threads eventually get Locked up for new comments or updates...

I like how you have the bats flapping their wings now. If you get the code up in Programs Board, I have a question about TheBob's code.

Title: Re: Competition
Post by: bplus on October 14, 2021, 11:56:22 am

Also: If code is posted in their own thread in Programs Board, we can use what non participating contest forum members say for help breaking ties.

Title: Re: Competition
Post by: Pete on October 16, 2021, 10:53:41 pm

This version saves the top 5 highest scores.

To Play:

Use the alt key to move and fire. When you release the alt key, your tank will stop. When you press alt again, your tank will ove in the opposite direction.

Shoot all invaders before they shoot you. Bonus points for shooting the mother ship.

If invaders get a couple rows above your tank, they land and you die.

To win, you must complete all 3 levels.

If you get a top 5 high score, you get to enter your initials. To do so, follow these instructions.

Tap the alt key to display initials A-Z. Stop tapping when your initial appears. Wait 2-seconds and it will be auto-input. If you goofed, hold down the alt key while waiting. It will allow you to redo input from start.

When you input your 3rd and last initial, all your initials will begin to flash for 2.5 seconds, and then they will be recorded. If you goofed, press the alt key within the 2.5 second time period, and you will be able to redo input from start.

WARNING: This routine makes and overwrites a file in your local folder named: ascii-invaders-high-score.dat

Code: QB64: [Select]

$COLOR:32
_SCREENMOVE _MIDDLE
 
DIM SHARED intro%: intro% = -1
 
skip_intro:
title$ = "ASCII Invaders / Halloween Edition"
_TITLE title$
RANDOMIZE TIMER
DEFINT I
DIM SHARED Overlay, font, soundfile%, t1&, t2&, t3&, t4&, t5&, t6&, t7&, t8&
DIM SHARED lmargin%, rmargin%, topmargin%, screenwidth%, level, ibk, ileadingrow
DIM SHARED irow, icol, inextrnd, imaxalienmissiles, alienforce%, ileadingmax, imaxalienforce, ihits, score$
 
SCREEN 0, 0, 0, 0
swidth = _WIDTH
 
score$ = "000000"
imaxalienforce = 6
imaxalienmissiles = 3
lmargin% = 2
rmargin% = 79
topmargin% = 3
ialiencolstat = 6
iwin = 3 ' 3 Levels.
screenwidth% = rmargin% - lmargin% + 1
ibk = 0 ' Background color
 
DIM SHARED a(imaxalienforce) AS STRING * 68
 
'fontpath$ = ENVIRON$("SYSTEMROOT") + "\fonts\lucon.ttf" 'Find Windows Folder Path.
'font& = _LOADFONT(fontpath$, 25, "monospace")
'_FONT font&
 
REM Make aliens
a1$ = "^^" + CHR$(79) + "^^  "
a$ = a1$ + a1$ + a1$ + a1$ + a1$ + a1$ + a1$ + a1$ + a1$ + a1$
alt1$ = "--" + CHR$(79) + "--  "
a$ = a1$ + alt1$ + a1$ + alt1$ + a1$ + alt1$ + a1$ + alt1$ + a1$ + alt1$
alt$ = alt1$ + a1$ + alt1$ + a1$ + alt1$ + a1$ + alt1$ + a1$ + alt1$ + a1$
 
IF intro% THEN
    SCREEN 0, 0, 1, 1
    CALL qbideOrig
 
    SCREEN 0, 0, 2, 0
    CALL qbide
 
    CALL thunder
 
    CALL TheBOB
 
    '_FREEFONT font&
    'fontpath$ = ENVIRON$("SYSTEMROOT") + "\fonts\lucon.ttf" 'Find Windows Folder Path.
    'font& = _LOADFONT(fontpath$, 25, "monospace")
    '_FONT font&
 
    CALL qbide
 
ELSE
    SCREEN 0, 0, 2, 0
 
    CALL qbide
 
    CALL thunder
END IF
 
 
IF intro% = -1 THEN RESTORE first_play ELSE RESTORE replay
 
CALL instructions
 
DO
    IF inextrnd = -1 THEN PCOPY 3, 0
    tank$ = CHR$(218) + CHR$(127) + CHR$(191): icolor = 6
    REDIM SHARED bullet%(5), bulletcol%(5), bulletdelay%(5), iltalien(imaxalienforce)
    REDIM SHARED ia(imaxalienmissiles), iy(imaxalienmissiles), ix(imaxalienmissiles)
    REDIM SHARED matrix(imaxalienforce) AS STRING * 10
    alienforce% = imaxalienforce
    level = .65
    iround = iround + 1
    level = level - iround / 15
    inextrnd = -1
    COLOR 6, ibk
 
    REM Set up aliens
    ialiencol = ialiencolstat
    LOCATE 2, ialiencol
    FOR i = 1 TO imaxalienforce
        IF i MOD 1 = 0 THEN PRINT
        LOCATE , ialiencol
        IF i = imaxalienforce THEN
            ileadingrow = CSRLIN: ileadingmax = ileadingrow
        END IF
        IF i \ 2 = i / 2 THEN a(i) = a$ ELSE a(i) = alt$
        PRINT a(i)
    NEXT
 
    COLOR 0 + 16, 3
    LOCATE 25, 68: PRINT "Score ";
    COLOR 0, 3
    PRINT score$;
    COLOR 6, ibk
 
    REM Station
    LOCATE 24, 40
    tanky% = CSRLIN: tankx% = POS(0) + 1
    PRINT tank$;: LOCATE , POS(0) - 2
 
    _DELAY 1
 
    DO
        z1 = TIMER
        DO
            IF zbonus THEN
                IF ABS(zbonus - TIMER) > 1.5 THEN
                    yy% = CSRLIN: xx% = POS(0)
                    COLOR 6, 0: LOCATE topmargin%, lmargin%: PRINT SPACE$(screenwidth%);
                    LOCATE yy%, xx%
                    zbonus = 0
                END IF
            END IF
 
            IF topmargin% + ileadingmax - (imaxalienforce * 2) >= topmargin% + 2 THEN
                IF imothership <> 0 THEN CALL mship(imothership)
            END IF
            IF ABS(TIMER - z1aliens) > level THEN
                CALL movealiens(ialiencol, ialiencolstat, iresults)
                z1aliens = TIMER
            END IF
            IF iresults < 0 THEN EXIT DO
            IF ABS(TIMER - z1ia) > .3 THEN CALL alienmissile(iresults): z1ia = TIMER
 
            DEF SEG = 0
            IF PEEK(1047) MOD 16 = 7 OR PEEK(1047) MOD 16 = 8 THEN
                key$ = CHR$(32) ' Alt
            ELSE
                key$ = ""
            END IF
            DEF SEG
 
            SELECT CASE key$
                CASE CHR$(32)
                    IF flag = 0 THEN switch = switch * -1 - 1: flag = -1
                    SELECT CASE switch
                        CASE 0
                            IF ABS(z9 - TIMER) > .15 THEN
                                IF POS(0) < screenwidth% THEN COLOR icolor, ibk: LOCATE , POS(0) - 1: PRINT " " + tank$;: LOCATE , POS(0) - 2
                                tanky% = CSRLIN: tankx% = POS(0)
                                IF SCREEN(tanky%, tankx% - 2) = 25 OR SCREEN(tanky%, tankx% + 2) = 25 THEN result = -1: EXIT DO
                                z9 = TIMER
                            END IF
                        CASE -1
                            IF ABS(z9 - TIMER) > .15 THEN
                                IF POS(0) > lmargin% + 1 THEN COLOR icolor, ibk: LOCATE , POS(0) - 2: PRINT tank$ + " ";: LOCATE , POS(0) - 3
                                tanky% = CSRLIN: tankx% = POS(0)
                                IF SCREEN(tanky%, tankx% - 2) = 25 OR SCREEN(tanky%, tankx% + 2) = 25 THEN result = -1: EXIT DO
                                z9 = TIMER
                            END IF
                    END SELECT
                    IF icolor = 6 THEN
                        FOR i2 = 1 TO 5
                            IF bullet%(i2) = 0 THEN
                                icolor = 12: COLOR icolor, ibk: GOSUB redraw
                                bullet%(i2) = -1: reload = TIMER: EXIT FOR
                            END IF
                        NEXT
                    END IF
                CASE ""
                    IF flag THEN skip = 0: flag = 0
                CASE CHR$(27): SYSTEM
            END SELECT
 
            IF ABS(z1 - reload) > .6 AND reload <> 0 THEN
                GOSUB redraw
                icolor = 6: reload = 0
            END IF
 
            REM Fire
            FOR i = 1 TO 5
                SELECT CASE bullet%(i)
                    CASE -1: bullet%(i) = tanky% - 1: bulletcol%(i) = tankx%
                    CASE IS > 0
                        IF bulletdelay%(i) = -1 OR bullet%(i) = tanky% - 1 THEN
                            CALL checkcollision(ihitaliens, ialiencol, i4, i)
                            z2bullet = TIMER: bulletdelay%(i) = 0
                            COLOR 6, ibk
                            LOCATE bullet%(i), bulletcol%(i)
                            IF bullet%(i) = topmargin% AND imothership <> 0 THEN ' Hit mother ship.
                                IF SCREEN(ABS(bullet%(i)), bulletcol%(i)) <> 32 THEN
                                    SOUND 1000, .75
                                    SELECT CASE iresults + 1
                                        CASE 1: bonus = 1500
                                        CASE 2: bonus = 2500
                                        CASE 3: bonus = 5000
                                    END SELECT
                                    score$ = LTRIM$(STR$(VAL(score$) + bonus))
                                    score$ = STRING$(6 - LEN(score$), "0") + score$
                                    yy% = CSRLIN: xx% = POS(0)
                                    SOUND 800, .5: SOUND 1600, .5: SOUND 2400, .5
                                    LOCATE topmargin%, lmargin%: PRINT SPACE$(screenwidth%);
                                    kbonus = bulletcol%(i) - 4
                                    IF kbonus < lmargin% THEN kbonus = lmargin%
                                    IF kbonus + 10 > screenwidth% THEN kbonus = screenwidth% - 11
                                    zbonus = TIMER
                                    LOCATE yy%, xx%
                                    imothership = 0
                                END IF
                            END IF
                            PRINT CHR$(24) ' Tank missile.
                            IF CSRLIN <> 24 THEN LOCATE , bulletcol%(i): PRINT " ";
                            IF ihitaliens <> 0 THEN CALL reprintaliens(ialiencol, ihitaliens, iresults, i4, i, imothership)
                            LOCATE tanky%, tankx%
                            IF bullet%(i) > topmargin% THEN
                                bullet%(i) = bullet%(i) - 1
                            ELSE
                                GOSUB erasebullet
                            END IF
 
                            IF zbonus THEN
                                yy% = CSRLIN: xx% = POS(0)
                                LOCATE topmargin%, kbonus: COLOR 2 + 16: PRINT "BONUS " + LTRIM$(STR$(bonus));
                                LOCATE yy%, xx%
                            END IF
 
                        END IF
                END SELECT
            NEXT
 
            REM Bullet timer delay
            IF z2bullet <> 0 THEN
                IF z1 < z2bullet THEN z2bullet = z2bullet - 86400
                IF z1 - z2bullet >= .06 THEN
                    FOR i2 = 1 TO 5
                        IF bullet%(i2) <> 0 THEN bulletdelay%(i2) = -1
                    NEXT i2
                END IF
                EXIT DO
            END IF
        LOOP
        IF iresults < 0 THEN EXIT DO
        IF alienforce% = 0 OR iresults = iwin THEN
            FOR i = 1 TO imaxalienmissiles
                IF ia(i) <> 0 THEN EXIT FOR
            NEXT
            IF i > imaxalienmissiles THEN iwait = -1
            IF iwait = -1 THEN
                EXIT DO
            END IF
        ELSE
            iwait = 1
        END IF
    LOOP
 
    IF iresults = iwin OR iresults < 0 THEN
        REM end game
        EXIT DO
    END IF
    inextrnd = -1
LOOP
 
SELECT CASE iresults
    CASE -1 ' Tank destroyed!
        SOUND 800, .3: SOUND 250, 1
 
        FOR i = 1 TO 5
            COLOR 14, 4
            LOCATE tanky%, tankx% - 1: PRINT tank$;
            _DELAY .1
 
            COLOR 8, ibk
            LOCATE tanky%, tankx% - 1: PRINT tank$;
            _DELAY .1
        NEXT
 
        COLOR 6, ibk
        LOCATE tanky% - 1, lmargin%
        PRINT SPACE$(screenwidth%);
        LOCATE tanky%, lmargin%
        PRINT SPACE$(screenwidth%);
 
        _DELAY .5
 
        LOCATE 3, 3
        COLOR 8, 0
        FOR i = 1 TO 20
            LOCATE i + 2, 2
            FOR j = 1 TO _WIDTH - 2
                PRINT CHR$(SCREEN(CSRLIN, POS(0)));
            NEXT
        NEXT
        COLOR 6, 0
 
        _DELAY 2
 
        CALL displayhighscores
 
        CALL qbide
 
    CASE -2 ' Aliens have landed!
        SOUND 1000, .3: SOUND 2400, .6:: SOUND 700, 2
 
        COLOR 7, 0
        FOR i = 0 TO 21 ' Blank out screen.
            LOCATE topmargin% + i, lmargin%: PRINT SPACE$(screenwidth%);
        NEXT
 
        COLOR 6, ibk
        LOCATE tanky% - 1, lmargin%
        PRINT SPACE$(screenwidth%);
        LOCATE tanky%, lmargin%
        PRINT SPACE$(screenwidth%);
 
        COLOR 8, ibk
 
        FOR j = imaxalienforce TO 1 STEP -1
            IF a(j) <> "" THEN EXIT FOR
        NEXT
 
        FOR i = j TO 1 STEP -1
            IF INSTR(a(i), CHR$(79)) THEN
                LOCATE , ialiencol + INSTR(a(i), CHR$(79)) - 2
                PRINT LTRIM$(RTRIM$(a(i)));
                LOCATE CSRLIN - 2
            END IF
        NEXT
 
        _DELAY 2.5
 
        CALL displayhighscores
 
        CALL qbide
 
    CASE ELSE ' Winner.
 
        l$ = "4"
        n$ = "n29": PLAY "L" + l$ + n$
        n$ = "n24": PLAY "L" + l$ + n$
        n$ = "n33": PLAY "L" + l$ + n$
        n$ = "n29": PLAY "L" + l$ + n$
        _DELAY .75
        l$ = "7"
        n$ = "n24": PLAY "L" + l$ + n$
        n$ = "n28": PLAY "L" + l$ + n$
        n$ = "n28": PLAY "L" + l$ + n$
        l$ = "6"
        n$ = "n31": PLAY "L" + l$ + n$
        l$ = "8"
        n$ = "n28": PLAY "L" + l$ + n$
        l$ = "3"
        _DELAY 1
 
        CALL displayhighscores
 
        CALL qbide
 
        RESTORE winner
 
END SELECT
 
CALL instructions
 
DEF SEG = 0
DO
    _LIMIT 30
    b$ = INKEY$
    IF b$ = CHR$(27) THEN SYSTEM
    IF PEEK(1047) MOD 16 = 7 OR PEEK(1047) MOD 16 = 8 THEN EXIT DO
LOOP
DEF SEG
 
RUN skip_intro
 
erasebullet:
LOCATE ABS(bullet%(i)), bulletcol%(i): PRINT " ";
bullet%(i) = 0: bulletcol%(i) = 0: bulletdelay%(i) = 0
LOCATE tanky%, tankx%
RETURN
 
redraw:
COLOR , ibk: LOCATE tanky%, tankx% - 1: PRINT tank$;: LOCATE tanky%, tankx%: COLOR 7, ibk
RETURN
 
first_play:
DATA "The Great Pumpkin has fired an EM pulse at your computer."
DATA ""
DATA "All that's working is your Alt key."
DATA ""
replay:
DATA "Loading..."
DATA "EOF"
DATA "Game Over. Press Alt to play again..."
DATA "EOF2"
winner:
DATA "Congratulations, you saved the planet!"
DATA ""
DATA "Press Alt to play again..."
DATA "EOF3"
 
 
SUB alienattack (ialiencol)
    z2alienfire = TIMER
 
    i3 = INT(RND * 10)
    FOR i = 1 TO imaxalienmissiles
        IF ia(i) = 0 THEN
            FOR i2 = imaxalienforce TO 1 STEP -1
                IF RTRIM$(a(i2)) <> "" THEN
                    IF MID$(matrix(i2), i3 + 1, 1) <> "0" THEN
                        i4 = INSTR(i3 * 7 + 1, a(i2), CHR$(79)) + ialiencol
                        EXIT FOR
                    END IF
                END IF
            NEXT i2
            IF i4 <> 0 THEN
                ia(i) = (ileadingmax - (imaxalienforce - i2) * 2) * 80 + i4
                EXIT FOR
            END IF
        END IF
    NEXT i
 
END SUB
 
SUB alienmissile (iresults)
    irow = CSRLIN: icol = POS(0)
    FOR i = 1 TO imaxalienmissiles
        IF ia(i) <> 0 THEN
            IF iy(i) = 0 THEN
                iy(i) = ia(i) \ 80: ix(i) = ia(i) MOD 80
                IF ix(i) = 0 THEN ix(i) = screenwidth%
            END IF
            LOCATE iy(i) + 1, ix(i)
            COLOR 6, ibk
            IF CSRLIN <= 24 THEN
                IF CSRLIN = 24 THEN IF SCREEN(CSRLIN, ix(i)) <> 32 THEN iresults = -1
                PRINT CHR$(25);
            ELSE
                ia(i) = 0
                LOCATE iy(i), ix(i)
                PRINT " ";: iy(i) = 0
                ia(i) = 0
                LOCATE irow, icol
                EXIT SUB
            END IF
            LOCATE iy(i), ix(i): PRINT " ";
            iy(i) = iy(i) + 1
        END IF
    NEXT
    LOCATE irow, icol
 
END SUB
 
SUB checkcollision (ihitaliens, ialiencol, i4, i)
    ihitaliens = 0
    IF ileadingmax MOD 2 = bullet%(i) MOD 2 THEN
        i4 = imaxalienforce - (ileadingmax - bullet%(i)) \ 2
        IF bullet%(i) <= ileadingrow AND i4 > 0 AND i4 <= imaxalienforce THEN
            IF RTRIM$(a(i4)) <> "" THEN
                IF bulletcol%(i) >= iltalien(i4) AND bulletcol%(i) - ialiencol <= LEN(RTRIM$(a(i4))) THEN
                    IF MID$(a(i4), bulletcol%(i) - ialiencol, 1) > CHR$(32) THEN
                        SOUND 1100, .2: SOUND 334, .1: SOUND 590, .4
                        ihitaliens = bulletcol%(i) - ialiencol + 1
                        i3 = ihitaliens - 7 + 1
                        IF i3 < 1 THEN i3 = 1
                        i2 = INSTR(i3 + 1, a(i4), "^" + CHR$(79)) - 1
                        i2 = INSTR(i3 + 1, a(i4), CHR$(79)) - 2
                        MID$(a(i4), i2, 7) = SPACE$(7)
                        MID$(matrix(i4), (i2 + 1) \ 7 + 1, 1) = "0"
                    END IF
                END IF
            END IF
        END IF
    END IF
 
    FOR i2 = 1 TO imaxalienmissiles
        IF ia(i2) <> 0 THEN
            IF iy(i2) >= bullet%(i) AND ix(i2) = bulletcol%(i) THEN
                ihitaliens = -i2
                EXIT FOR
            END IF
        END IF
    NEXT
 
END SUB
 
SUB instructions
    IF in$ = "" THEN
        LOCATE 3, 3, 1, 7, 0: COLOR 6, ibk
        _DELAY 2
        DO
            READ in$
            IF MID$(in$, 1, 3) = "EOF" THEN EXIT DO
            FOR i = 1 TO LEN(in$)
                SOUND 400, .06
                LOCATE , 2 + i
                PRINT MID$(in$, i, 1);
                z = TIMER
                DO
                    IF ABS(z - TIMER) > .06 THEN EXIT DO
                LOOP
            NEXT
            LOCATE , , 0, 7, 0
            _DELAY 1
            PRINT
            LOCATE , 3
        LOOP
        _DELAY .75
    END IF
 
    IF in$ = "EOF" THEN
        COLOR 7, 0
        FOR i = 0 TO 19 ' Blank out intro message space.
            LOCATE topmargin% + i, lmargin%: PRINT SPACE$(screenwidth%);
        NEXT
        FOR i = 3 TO 24
            LOCATE i, 80: PRINT CHR$(179);
        NEXT
        LOCATE 21, 2: PRINT STRING$(screenwidth%, " ");
        LOCATE 22, 1: PRINT CHR$(179);
        LOCATE 22, 80: PRINT CHR$(179);
        LOCATE 22, 2: PRINT STRING$(screenwidth%, " ");
    ELSE
        COLOR 0, 3
    END IF
 
    IF in$ <> "EOF2" AND iresults <> iwin THEN COLOR 0 + 16, 3 ELSE COLOR 0, 3
    yy% = CSRLIN: xx% = POS(0)
    LOCATE 25, 68: PRINT "Score ";
    COLOR 0, 3
    PRINT score$;
    LOCATE yy%, xx%
 
    PCOPY 0, 3: REM save skin
 
END SUB
 
SUB marchdown (ialiencol, ialiencolstat, imotion, iresults)
    COLOR 6, ibk
    ileadingrow = ileadingrow + 1
    ileadingmax = ileadingmax + 1
    COLOR 6, ibk
    FOR i = 1 TO imaxalienforce
        REM SOUND 400, .2 ' Level down.
        IF RTRIM$(a(i)) <> "" THEN
            ialiencol = ialiencolstat + imotion
            LOCATE ileadingmax - (imaxalienforce * 2) + i * 2 - 1, lmargin%
            PRINT STRING$(screenwidth%, " ")
            LOCATE , ialiencol + INSTR(a(i), CHR$(79)) - 2
            iltalien(i) = POS(0)
            PRINT LTRIM$(RTRIM$(a(i)))
        END IF
    NEXT
    LOCATE irow, icol
    level = level - .025
    IF ileadingrow = 22 THEN iresults = -2 ' Aliens have landed!
END SUB
 
DEFSNG I
DEFINT I
SUB movealiens (ialiencol, ialiencolstat, iresults)
    STATIC imotion, imarch, imotiondir
 
    SOUND 800, .1: SOUND 200, .33 ' Marching sound.
 
    IF inextrnd = -1 THEN inextrnd = 0: imotion = 0: imarch = 0: imotiondir = 0
    irow = CSRLIN: icol = POS(0)
    yy% = CSRLIN: xx% = POS(0)
    PCOPY 0, 1: SCREEN 0, 0, 1, 0: LOCATE yy%, xx%, 0, 7, 0
    IF imotiondir = 0 THEN imotion = imotion - 1 ELSE imotion = imotion + 1
    COLOR 6, ibk
 
    FOR i = imaxalienforce TO 1 STEP -1
        IF RTRIM$(a(i)) <> "" THEN
            FOR k = 1 TO LEN(a(i))
                k$ = MID$(a(i), k, 1)
                IF k$ = "^" THEN
                    MID$(a(i), k, 1) = "-"
                ELSEIF k$ = "-" THEN
                    MID$(a(i), k, 1) = "^"
                END IF
            NEXT
            i2 = i2 + 2
            ialiencol = ialiencolstat + imotion
            LOCATE ileadingmax - (imaxalienforce - i) * 2, ialiencol + INSTR(a(i), CHR$(79)) - 2
            IF POS(0) = lmargin% THEN imarch = 1
            iltalien(i) = POS(0)
            IF imotiondir = 0 THEN
                PRINT LTRIM$(RTRIM$(a(i))); " "
            ELSE
                LOCATE , POS(0) - 1
                PRINT " "; LTRIM$(RTRIM$(a(i)))
            END IF
            IF ialiencol + LEN(RTRIM$(a(i))) = screenwidth% THEN imarch = -1
        END IF
    NEXT
 
    IF imarch = 1 THEN imotiondir = 1: CALL marchdown(ialiencol, ialiencolstat, imotion, iresults)
    IF imarch = -1 THEN imotiondir = 0: CALL marchdown(ialiencol, ialiencolstat, imotion, iresults)
    IF imarch = 0 THEN
        IF ABS(TIMER - z2alienfire) > firerate THEN
            firerate = (INT(RND * 10) + 1) / 20
            IF iwait = 0 THEN CALL alienattack(ialiencol)
        END IF
    ELSE
        imarch = 0
    END IF
    PCOPY 1, 0: SCREEN 0, 0, 0, 0
    LOCATE irow, icol, 1, 7, 0
END SUB
 
SUB mship (imothership)
    STATIC x%, mov%, z4, mothership$
 
    yy% = CSRLIN: xx% = POS(0): COLOR 6, ibk
    IF imothership = -1 THEN
        imothership = 1
        x% = lmargin%
        mothership$ = "(" + CHR$(127) + CHR$(179) + CHR$(127) + ")" 'CHR$(254) + CHR$(254) + "O" + CHR$(254) + CHR$(254)
        mov% = 1
    END IF
 
    IF ABS(TIMER - z4) > .05 THEN GOSUB mothership: z4 = TIMER
    LOCATE yy%, xx%
    EXIT SUB
 
    mothership:
    IF x% + LEN(mothership$) = screenwidth% + lmargin% THEN mov% = -1 ELSE IF x% = lmargin% THEN mov% = 1
    x% = x% + mov%
    LOCATE topmargin%, x%
    COLOR 7, 6: PRINT MID$(mothership$, 1, 1);
    COLOR 14, 6: PRINT MID$(mothership$, 2, 1);
    COLOR 7, 6: PRINT MID$(mothership$, 3, 1);
    COLOR 14, 6: PRINT MID$(mothership$, 4, 1);
    COLOR 7, 6: PRINT MID$(mothership$, 5, 1);
    COLOR 7, ibk
    IF x% > 1 AND mov% = 1 THEN
        LOCATE , POS(0) - LEN(mothership$) - 1: PRINT " ";
    END IF
    IF mov% = -1 THEN PRINT " ";
    RETURN
 
END SUB
 
DEFINT A-H, J-Z
SUB qbide
    PALETTE 2, 59
    COLOR 15, 0
    CLS
 
    COLOR 0, 7
    LOCATE 1, 1
    PRINT SPACE$(80)
    LOCATE 1, 1: PRINT "   File  Edit  View  Search  Run  Debug  Calls  Options                   Help"
 
    COLOR 7, 0 ' Black background.
 
    LOCATE 2, 1: PRINT CHR$(218)
    LOCATE 2, 2: PRINT STRING$(78, CHR$(196))
    LOCATE 2, 80: PRINT CHR$(191)
 
    LOCATE 2, 76: PRINT CHR$(180)
    LOCATE 2, 78: PRINT CHR$(195)
 
    COLOR 0, 7
    LOCATE 2, 77: PRINT CHR$(24)
    LOCATE 2, 36: PRINT " Untitled "
 
    COLOR 7, 0
    FOR Rows = 3 TO 24
        LOCATE Rows, 1: PRINT CHR$(179);
        LOCATE Rows, 80: PRINT CHR$(179);
    NEXT Rows
 
    LOCATE 22, 1: PRINT CHR$(195)
    LOCATE 22, 80: PRINT CHR$(180)
    LOCATE 22, 2: PRINT STRING$(78, CHR$(196))
    LOCATE 22, 35
    PRINT " Immediate "
 
    COLOR 0, 7
    LOCATE 21, 3: PRINT STRING$(76, CHR$(176))
    LOCATE 21, 2: PRINT CHR$(27)
    LOCATE 21, 3: PRINT CHR$(219)
    LOCATE 21, 79: PRINT CHR$(26)
    FOR Rows = 4 TO 19
        LOCATE Rows, 80: PRINT CHR$(176)
    NEXT Rows
    LOCATE 3, 80: PRINT CHR$(24)
    LOCATE 4, 80: PRINT CHR$(219)
    LOCATE 20, 80: PRINT CHR$(25)
 
    COLOR 0, 3: LOCATE 25, 1: PRINT " <Shift+F1=Help> <F6=Window> <F2=Subs> <F5=Run> <F8=Step> ";
    LOCATE 25, 59: PRINT SPACE$(4);
    COLOR 0, 3
    LOCATE 25, 63: PRINT CHR$(179);
    LOCATE 25, 64: PRINT SPACE$(6);
    LOCATE 25, 68: PRINT "C  00001:001 ";
 
END SUB
 
DEFSNG A-H, J-Z
SUB reprintaliens (ialiencol, ihitaliens, iresults, i4, i, imothership)
    IF ihitaliens > 0 THEN
        ihits = ihits + 1
 
        SELECT CASE iresults + 1
            CASE 1: score$ = LTRIM$(STR$(VAL(score$) + 150))
            CASE 2: score$ = LTRIM$(STR$(VAL(score$) + 250))
            CASE 3: score$ = LTRIM$(STR$(VAL(score$) + 350))
        END SELECT
 
        score$ = STRING$(6 - LEN(score$), "0") + score$
        IF (ihits + 15) MOD 20 = 0 AND imothership = 0 THEN imothership = -1
        LOCATE bullet%(i), lmargin%: PRINT SPACE$(screenwidth%);
        iltalien(i4) = POS(0)
 
        IF RTRIM$(a(i4)) = "" THEN
            alienforce% = alienforce% - 1
            IF alienforce% = 0 THEN iresults = iresults + 1 ' Level completed. Goto to next level.
            IF bullet%(i) = ileadingrow THEN ileadingrow = ileadingrow - 2
        ELSE
            LOCATE bullet%(i), ialiencol + INSTR(a(i4), CHR$(79)) - 2
            PRINT LTRIM$(RTRIM$(a(i4)))
        END IF
    ELSE
        i2 = ABS(ihitaliens)
        LOCATE iy(i2), ix(i2)
        PRINT " ";: iy(i2) = 0
        ia(i2) = 0
        LOCATE irow, icol
        IF soundfile% = 0 THEN
            SOUND 1000, .5
        ELSE
            z4 = TIMER
            DO
                IF eflag THEN
                    IF ABS(z4 - TIMER) > .1 THEN
                        eflag = 0
 
                        PALETTE 0, 0
 
                        EXIT DO
                    ELSE
                        j = -j * -1
                        IF j = 0 THEN
                            PALETTE 0, 63
                            _DELAY .05
                        ELSE
                            PALETTE 0, 0
                            _DELAY .05
                        END IF
                    END IF
                END IF
                IF eflag = 0 THEN
                    PALETTE 0, 36
                    IF soundfile% THEN
                        _SNDPLAY t1&
                        _DELAY .05
                        _SNDPLAY t7&
                    ELSE
                        _DELAY .075
                    END IF
 
                    eflag = -1
                    z4 = TIMER
                END IF
            LOOP
            SELECT CASE iresults + 1
                CASE 1: bonus = 500
                CASE 2: bonus = 1500
                CASE 3: bonus = 2500
            END SELECT
            score$ = LTRIM$(STR$(VAL(score$) + bonus))
            score$ = STRING$(6 - LEN(score$), "0") + score$
        END IF
    END IF
 
    ihitaliens = 0
    bullet%(i) = -bullet%(i)
 
    COLOR 0, 3
    yy% = CSRLIN: xx% = POS(0)
    LOCATE 25, 74: PRINT score$;
    LOCATE yy%, xx%
    COLOR 6, ibk
 
END SUB
 
SUB qbideOrig
    PALETTE 2, 59
    COLOR 15, 1
    CLS
 
    COLOR 0, 7
    LOCATE 1, 1
    PRINT SPACE$(80)
    LOCATE 1, 1: PRINT "   File  Edit  View  Search  Run  Debug  Calls  Options                   Help"
 
    COLOR 7, 1
 
    LOCATE 2, 1: PRINT CHR$(218)
    LOCATE 2, 2: PRINT STRING$(78, CHR$(196))
    LOCATE 2, 80: PRINT CHR$(191)
 
    LOCATE 2, 76: PRINT CHR$(180)
    LOCATE 2, 78: PRINT CHR$(195)
 
    COLOR 1, 7
    LOCATE 2, 77: PRINT CHR$(24)
    LOCATE 2, 36: PRINT " Untitled "
 
    COLOR 7, 1
    FOR Rows = 3 TO 24
        LOCATE Rows, 1: PRINT CHR$(179);
        LOCATE Rows, 80: PRINT CHR$(179);
    NEXT Rows
 
    LOCATE 22, 1: PRINT CHR$(195)
    LOCATE 22, 80: PRINT CHR$(180)
    LOCATE 22, 2: PRINT STRING$(78, CHR$(196))
    LOCATE 22, 35
    PRINT " Immediate "
 
    COLOR 0, 7
    LOCATE 21, 3: PRINT STRING$(76, CHR$(176))
    LOCATE 21, 2: PRINT CHR$(27)
    LOCATE 21, 3: PRINT CHR$(219)
    LOCATE 21, 79: PRINT CHR$(26)
    FOR Rows = 4 TO 19
        LOCATE Rows, 80: PRINT CHR$(176)
    NEXT Rows
    LOCATE 3, 80: PRINT CHR$(24)
    LOCATE 4, 80: PRINT CHR$(219)
    LOCATE 20, 80: PRINT CHR$(25)
 
    COLOR 0, 3: LOCATE 25, 1: PRINT " <Shift+F1=Help> <F6=Window> <F2=Subs> <F5=Run> <F8=Step> ";
    LOCATE 25, 59: PRINT SPACE$(4);
    COLOR 0, 3
    LOCATE 25, 63: PRINT CHR$(179);
    LOCATE 25, 64: PRINT SPACE$(6);
    LOCATE 25, 68: PRINT "C  00001:001 ";
 
END SUB
 
SUB TheBOB
    SCREEN _NEWIMAGE(800, 600, 256)
    WIDTH 80, 25
 
    OUT &H3C8, 1: OUT &H3C9, 40: OUT &H3C9, 12: OUT &H3C9, 0
    OUT &H3C8, 2: OUT &H3C9, 6: OUT &H3C9, 12: OUT &H3C9, 0
    OUT &H3C8, 3: OUT &H3C9, 30: OUT &H3C9, 8: OUT &H3C9, 0
    OUT &H3C8, 4: OUT &H3C9, 3: OUT &H3C9, 8: OUT &H3C9, 0
    OUT &H3C8, 7: OUT &H3C9, 63: OUT &H3C9, 0: OUT &H3C9, 0
    OUT &H3C8, 8: OUT &H3C9, 46: OUT &H3C9, 0: OUT &H3C9, 0
    OUT &H3C8, 9: OUT &H3C9, 63: OUT &H3C9, 63: OUT &H3C9, 63
    OUT &H3C8, 12: OUT &H3C9, 20: OUT &H3C9, 20: OUT &H3C9, 20
    OUT &H3C8, 13: OUT &H3C9, 0: OUT &H3C9, 0: OUT &H3C9, 0
    OUT &H3C8, 14: OUT &H3C9, 55: OUT &H3C9, 35: OUT &H3C9, 0
 
    CIRCLE (320, 240), 100, 3, , , .9
    PAINT (320, 240), 3
    CIRCLE (320, 230), 90, 1, , , .9
    PAINT (320, 230), 1
 
    FOR Reps = 1 TO 4
        SELECT CASE Reps
            DATA 1,1.2,1.8,5
            CASE 1: Elipse = 1
            CASE 2: Elipse = 1.2
            CASE 3: Elipse = 1.8
            CASE 4: Elipse = 5
        END SELECT
        FOR E = Elipse TO Elipse + .1 STEP .01
            CIRCLE (320, 240), 100, 3, , , E
        NEXT E
    NEXT Reps
    FOR Radius = 38 TO 43
        CIRCLE (320, 160), Radius, 3, , , .4
    NEXT Radius
    CIRCLE (320, 160), 40, 14, 3.3, 6, .4
    CIRCLE (320, 240), 100, 5, , , .9
    PAINT (0, 0), 5
    CIRCLE (320, 240), 100, 0, , , .9
    PAINT (0, 0), 0
    FOR Radius = 12 TO 18
        CIRCLE (320, 153), Radius, 2, , , .3
    NEXT Radius
 
    CIRCLE (320, 150), 12, 2, , , .6
    PAINT STEP(0, 0), 2
    CIRCLE (300, 143), 32, 2, 6, 1.1
    CIRCLE (276, 143), 32, 2, 6, .6
    DRAW "BM302,125 C2 M+15,-10 BD10 P2,2"
    PAINT (320, 145), 2
    CIRCLE (282, 143), 32, 4, 6, .73
    CIRCLE (266, 156), 60, 4, .1, .68
    CIRCLE (320, 150), 12, 4, 3.14159, 0, .2
    DRAW "BM302,125 C4 M+15,-10 BD10"
    CIRCLE (276, 143), 32, 4, 6, .6
    PAINT STEP(35, 0), 4
    'Face begins
    CIRCLE (303, 316), 100, 14, 1.5, 2
    CIRCLE (337, 316), 100, 14, 1.1, 1.64
    PSET (310, 215), 14
    DRAW "H30 M-20,+40 M+12,-4 M+14,-29 BL2 P14,14 BF12 P15,14"
    PSET (330, 215), 14
    DRAW "E30 M+20,+40 M-12,-4 M-14,-29 BR2 P14,14 BG12 P15,14"
    PSET (320, 246), 14
    DRAW "R20 H20 G20 R20 U nL19 nR19 BU2 P15,14"
    CIRCLE (320, 170), 100, 14, 3.8, 4.1
    CIRCLE (320, 170), 100, 14, 4.42, 5.01
    CIRCLE (320, 170), 100, 14, 5.33, 5.62
    CIRCLE (320, 220), 80, 14, 3.29, 4.5
    CIRCLE (320, 220), 80, 14, 4.66, 6.15
    PSET (260, 250), 14
    DRAW "D10 F8 U13 M+10,+5 D12 M+12,+6 U12 BR60"
    DRAW "D12 M+12,-6 U12 M+10,-5 D13 E8 U10"
    PSET (300, 297), 14
    DRAW "U14 R16 D16"
    CIRCLE (320, 212), 80, 14, 3.42, 4.5
    CIRCLE (320, 212), 80, 14, 4.66, 6
    LINE (300, 280)-(316, 283), 14, BF
    PAINT (320, 296), 14
    PAINT (290, 292), 14
    PAINT (300, 278), 15, 14
    CIRCLE (100, 240), 32, 13
    PAINT STEP(0, 0), 13
 
    FOR x% = 58 TO 142
        FOR y% = 198 TO 282
            IF POINT(x%, y%) = 13 THEN
                IF POINT(x% + 220, y%) = 15 THEN PSET (x% + 220, y%), 9
            END IF
        NEXT y%
    NEXT x%
 
    COLOR 13: LOCATE 1, 1: PRINT "HAPPY HALLOWEEN!"
 
    xx = 64: yy = 360 - 330
    FOR x% = 0 TO 300
        FOR y% = 0 TO 16
            IF POINT(x%, y%) = 13 THEN
                IF y% > 6 THEN Colr = 8 ELSE Colr = 7
                LINE (x% * 4 + xx, y% * 4 + yy)-(x% * 4 + xx + 3, y% * 4 + yy + 3), Colr, BF
            END IF
        NEXT y%
    NEXT x%
    FOR x% = 0 TO 639
        IF POINT(x%, 368) <> 0 THEN PSET (x%, 368), 14
    NEXT x%
 
    z1 = TIMER
    DO UNTIL ABS(TIMER - z1) > 4
        FOR Reps = 1 TO 3
            WAIT &H3DA, 8
            WAIT &H3DA, 8, 8
        NEXT Reps
 
        Flicker = FIX(RND * 20)
        OUT &H3C8, 14
        OUT &H3C9, 40 + Flicker
        OUT &H3C9, 25 + Flicker
        OUT &H3C9, 10 + Flicker
 
        OUT &H3C8, 15
        OUT &H3C9, 43 + Flicker
        OUT &H3C9, 38 + Flicker
        OUT &H3C9, 20 + Flicker
    LOOP
    SCREEN 0, 0, 0, 0
END SUB
 
SUB displayhighscores
 
    COLOR 0, 3
    LOCATE 25, 68: PRINT "Score "; score$;
 
    DIM hs AS STRING * 25
    REDIM highscore$(6), hsdata$(6)
    DO
        IF _FILEEXISTS("ascii-invaders-high-score.dat") THEN
            OPEN "ascii-invaders-high-score.dat" FOR RANDOM AS #1 LEN = 25
            FOR i = 1 TO 5
                GET #1, i, hs
                highscore$(i) = MID$(hs, 10, 6): hsdata$(i) = hs
            NEXT
            CLOSE #1
        ELSE
            FOR i = 1 TO 5
                hsdata$(i) = SPACE$(25)
            NEXT
        END IF
 
        IF VAL(score$) > VAL(highscore$(5)) THEN
 
            IF VAL(score$) > VAL(highscore$(1)) THEN
                msg$ = " HIGH SCORE / Enter Your Initials! "
            ELSE
                msg$ = " Top 5 Score. Enter Your Initials! "
            END IF
 
            GOSUB hiscore
 
            a = 14
            OUT &H3C8, 0
            OUT &H3C9, 20 - a
            OUT &H3C9, 20 - a
            OUT &H3C9, 20 - a
 
            OUT &H3C8, 8
            OUT &H3C9, 30 - a
            OUT &H3C9, 30 - a
            OUT &H3C9, 30 - a
 
            OUT &H3C8, 7
            OUT &H3C9, 30 - a
            OUT &H3C9, 30 - a
            OUT &H3C9, 30 - a
 
            OUT &H3C8, 3
            OUT &H3C9, 30 - a
            OUT &H3C9, 30 - a
            OUT &H3C9, 30 - a
 
            GOSUB hardware_overlay
 
            _FONT 16
 
            COLOR White, 0
            t$ = msg$
            PSLC 4.6, 41 - LEN(msg$) \ 2, t$
 
            font = _LOADFONT("lucon.ttf", 20, "monospace")
            IF font <= 0 THEN font = 16
            _FONT font
 
            DEF SEG = 0
            delay = .4
            lscr = 19
            z3 = TIMER
            DO
                initials$ = "": i = 0: nxt = 0
                COLOR , _RGB(24, 24, 24): t$ = "   " ' Blank initials for redo. Okay to blank at start.
                PSL 5 + rank * 2, lscr, t$
                _DISPLAY
                DO
                    _LIMIT 60
                    IF ABS(z3 - TIMER) > .3 AND kflag > -2 THEN
                        underline 5 + rank * 2, lscr + nxt, 0
                        _DISPLAY
                        z3 = TIMER
                    END IF
 
                    SELECT CASE kflag
                        CASE 0
                            IF ABS(z1 - TIMER) > 1.5 AND i AND nxt < 3 THEN
                                SOUND 1500, 1
                                underline 5 + rank * 2, lscr + nxt, -1: uflag = 0
                                _DISPLAY
                                initials$ = initials$ + CHR$(64 + i)
                                nxt = nxt + 1 ' Next initial
                                i = 0 ' Reset alphabet.
                                z1 = TIMER
                                IF nxt = 3 THEN
                                    kflag = -2 ' All 3 initials have been input.
                                    underline 5 + rank * 2, lscr + nxt, -1: uflag = 0
                                    _DISPLAY
                                END IF
                            END IF
 
                            IF PEEK(1047) MOD 16 = 7 OR PEEK(1047) MOD 16 = 8 THEN
                                kflag = -1 ' Alt key pressed.
                                z1 = TIMER: z2 = TIMER
                                i = i + 1: IF i > 26 THEN i = 1
                                COLOR , _RGB(24, 24, 24): t$ = " "
                                PSL 5 + rank * 2, lscr + nxt, t$
                                COLOR DarkOrange: t$ = CHR$(64 + i)
                                SOUND 1000, .1
                                PSL 5 + rank * 2, lscr + nxt, t$
                                underline 5 + rank * 2, lscr + nxt, 0
                                _DISPLAY
                            END IF
                        CASE -1
                            IF ABS(z2 - TIMER) > 2 THEN ' Key down long enough to indicate redo input.
                                IF nxt > 0 THEN ' Redo last initial input.
                                    SOUND 300, .5
                                    FOR nxt = 0 TO 3
                                        underline 5 + rank * 2, lscr + nxt, -1: uflag = 0
                                    NEXT
                                    nxt = 0: i = 0
                                    initials$ = ""
                                    COLOR , _RGB(24, 24, 24): t$ = "   "
                                    PSL 5 + rank * 2, lscr, t$
                                    _DISPLAY
                                    z1 = TIMER ' Reset enter timer.
                                ELSE
                                    SOUND 300, .5
                                    i = 0
                                    COLOR , _RGB(24, 24, 24): t$ = " "
                                    PSL 5 + rank * 2, lscr, t$
                                    _DISPLAY
                                    z1 = TIMER ' Reset enter timer.
                                END IF
                                z2 = TIMER
                            END IF
 
                            IF PEEK(1047) MOD 16 <> 7 AND PEEK(1047) MOD 16 <> 8 THEN ' Alt key was released.
                                kflag = 0 ' Alt key up
                                z1 = TIMER
                            END IF
                        CASE -2 ' Finished. Initials will flash until confirmed by 2-second timer.
                            z1 = TIMER: z2 = TIMER
                            j = 0
                            DO
                                IF ABS(z1 - TIMER) > .3 THEN j = -j - 1: z1 = TIMER
                                IF j THEN
                                    COLOR DarkOrange: t$ = initials$
                                    PSL 5 + rank * 2, lscr, t$
                                    _DISPLAY
                                ELSE
                                    COLOR _RGB(24, 24, 24): t$ = initials$
                                    PSL 5 + rank * 2, lscr, t$
                                    _DISPLAY
                                END IF
 
                                IF ABS(z2 - TIMER) > 2.5 AND j THEN
                                    kflag = -3
                                    EXIT DO
                                END IF
 
                                IF PEEK(1047) MOD 16 = 7 OR PEEK(1047) MOD 16 = 8 THEN
                                    BEEP
                                    kflag = -4
                                    EXIT DO
                                END IF
                            LOOP
                        CASE -3
                            _DELAY 1
                            l$ = "8"
                            n$ = "n24": PLAY "L" + l$ + n$
                            n$ = "n28": PLAY "L" + l$ + n$
                            n$ = "n28": PLAY "L" + l$ + n$
                            l$ = "7"
                            n$ = "n31": PLAY "L" + l$ + n$
                            l$ = "9"
                            n$ = "n28": PLAY "L" + l$ + n$
                            l$ = "3"
                            n$ = "n31": PLAY "L" + l$ + n$
                            kflag = 1
                            _DELAY 1: EXIT DO
                        CASE -4
                            kflag = 0 ' Repeat enter initials
                            nxt = 0
                            i = 0
                            EXIT DO
                    END SELECT
                LOOP
                IF kflag > 0 THEN kflag = 0: EXIT DO ' Exit routine.
            LOOP
            DEF SEG
 
            hsname$ = initials$
 
            MID$(hsdata$(rank), 5, 3) = hsname$ + SPACE$(3 - LEN(hsname$))
            OPEN "ascii-invaders-high-score.dat" FOR RANDOM AS #1 LEN = 25
            FOR i = 1 TO 5
                hs = hsdata$(i)
                IF LEFT$(hs, 1) = "" THEN MID$(hs, 1, 2) = "0" + LTRIM$(STR$(i))
                PUT #1, i, hs
            NEXT
            CLOSE #1
 
            _DELAY 1
            _DISPLAY ' Remove scoreboard.
            _DELAY 1
            _FREEIMAGE Overlay
            _FONT 16 'select inbuilt 8x16 default font
            _FREEFONT font
 
            _DEST 0 'Reset dest back to the normal screen 0.
 
            _AUTODISPLAY
            COLOR 6, 0
            msg$ = SPACE$(40)
            LOCATE 4, 41 - LEN(msg$) \ 2
            PRINT msg$;
            PALETTE
            _DELAY 1
 
            EXIT DO
        ELSE
            EXIT DO ' Not in the top 5 highest scores so exit sub.
        END IF
    LOOP
    EXIT SUB
 
    hardware_overlay:
    Overlay = _NEWIMAGE(_WIDTH * _FONTWIDTH, _HEIGHT * _FONTHEIGHT, 32)
 
    _DEST Overlay
    _DISPLAY ' Turn autodisplay off.
 
    font = _LOADFONT("lucon.ttf", 20, "monospace")
    IF font <= 0 THEN font = 16
    _FONT font
 
    bxy% = 3
    bxx% = 13
    COLOR DarkOrange, 0
    t$ = " " + CHR$(218) + STRING$(27, CHR$(196)) + CHR$(191) + " "
    PSL bxy%, bxx% - 1, t$
    FOR i = 1 TO 12
        t$ = " " + CHR$(179) + STRING$(27, CHR$(32)) + CHR$(179) + " "
        PSL bxy% + i, bxx% - 1, t$
    NEXT
    t$ = " " + CHR$(192) + STRING$(27, CHR$(196)) + CHR$(217) + " "
    PSL bxy% + i, bxx% - 1, t$
 
    bxy% = 4
    COLOR Black, DarkOrange
    t$ = "    NAME   SCORE    DATE   "
    PSL bxy% + 1, bxx% + 1, t$
 
    COLOR DarkOrange, 0
    FOR i = 1 TO 5
        t$ = hsdata$(i)
        PSL bxy% + 1 + i * 2, bxx% + 2, t$
    NEXT
 
    _DISPLAY
 
    RETURN
 
    hiscore:
    FOR i = 1 TO 5
        IF VAL(score$) > VAL(highscore$(i)) THEN rank = i: EXIT FOR
    NEXT
 
    hsdata$(6) = SPACE$(25)
    MID$(hsdata$(6), 10, 6) = score$
    MID$(hsdata$(6), 18, 8) = MID$(DATE$, 1, 6) + MID$(DATE$, 9, 2)
    highscore$(6) = score$
    FOR i = 1 TO 6
        FOR j = 1 TO 6
            IF i <> j THEN
                IF VAL(highscore$(i)) > VAL(highscore$(j)) THEN
                    SWAP highscore$(i), highscore$(j)
                    SWAP hsdata$(i), hsdata$(j)
                END IF
            END IF
        NEXT
    NEXT
    FOR i = 1 TO 5
        MID$(hsdata$(i), 1, 2) = "0" + LTRIM$(STR$(i))
    NEXT
 
    RETURN
 
END SUB
 
SUB PSLC (y, x, t$)
    _PRINTSTRING ((x - 1) * 8, (y - 1) * 16), t$
END SUB
 
SUB PSL (y, x, t$)
    _PRINTSTRING ((x - 1) * _FONTWIDTH, (y - 1) * _FONTHEIGHT), t$
    Overlay_Hardware = _COPYIMAGE(Overlay, 33)
    _PUTIMAGE (0, 0), Overlay_Hardware
END SUB
 
SUB underline (y, x, uflag)
    STATIC ucnt
    ucnt = -ucnt - 1
    IF ucnt OR uflag THEN
        LINE ((x - 1) * _FONTWIDTH, y * _FONTHEIGHT)-((x - 1) * _FONTWIDTH + 12, y * _FONTHEIGHT), _RGB(24, 24, 24), BF
    ELSE
        LINE ((x - 1) * _FONTWIDTH, y * _FONTHEIGHT)-((x - 1) * _FONTWIDTH + 12, y * _FONTHEIGHT), DarkOrange, BF
    END IF
 
    Overlay_Hardware = _COPYIMAGE(Overlay, 33)
    _PUTIMAGE (0, 0), Overlay_Hardware
END SUB
 
SUB thunder
    SCREEN 0, 0, 1, 1
    _DELAY 2
 
    IF _FILEEXISTS("Thunder6.ogg") AND _FILEEXISTS("Thunder6.ogg") AND _FILEEXISTS("Thunder6.ogg") THEN
        soundfile% = -1
    END IF
 
    IF soundfile% THEN
        t1& = _SNDOPEN("Thunder1.ogg", "SYNC")
        t2& = _SNDOPEN("Thunder2.ogg", "SYNC")
        t3& = _SNDOPEN("Thunder3.ogg", "SYNC")
        t4& = _SNDOPEN("Thunder4.ogg", "SYNC")
        t5& = _SNDOPEN("Thunder5.ogg", "SYNC")
        t6& = _SNDOPEN("Thunder6.ogg", "SYNC")
        t7& = _SNDOPEN("Thunder7.ogg", "SYNC")
        t8& = _SNDOPEN("Thunder8.ogg", "SYNC")
 
        _SNDPLAY t6&
        _DELAY .1
        _SNDPLAY t7&
        _DELAY .1
        _SNDPLAY t8&
    ELSE
        SOUND 1000, .3: SOUND 2400, .6:: SOUND 700, 2
    END IF
 
    FOR i = 1 TO 15
        _DELAY i / 150
        IF i / 2 = i \ 2 THEN
            SOUND 250, .1
            SCREEN 0, 0, 1, 1
        ELSE
            SCREEN 0, 0, 2, 2
            IF i < 13 THEN _DELAY i / 100: SCREEN 0, 0, 3, 3: COLOR 0, 7: CLS
        END IF
    NEXT
 
    PCOPY 2, 0
    SCREEN 0, 0, 0, 0
    _DELAY 1.5
END SUB

[ This attachment cannot be displayed inline in 'Print Page' view ]

I still have to look into a couple more effects before I'm ready to open a "programs" thread. I've also been puttering around adding a spell check function to my WP, and I need to spend some time looking over what Steve posted for me on some new screen 0 hardware rendering effects.

Pete

Edit: Completed the switch to hardware rendering overlay for high score board. Also fixed a bug Jack found.

Edit: New improved system to enter high score initials. See post revisons on how to play, at top of post.

Edit: Added a title and a new explosion effect plus point scoring when your tank's missile blows up an enemy's missile.

Title: Re: Competition
Post by: bplus on October 16, 2021, 11:30:19 pm

Oh yeah! way to stay with one key requirement for High Scores.

I read that request for an effect with screen 0, wondered if the command to print without back ground would work in screen 0 and basically take care of what you wanted???

Cobalt showed us the word, unfortunately it didn't stick in my memory, maybe it was two keywords.

Title: Re: Competition
Post by: SMcNeill on October 17, 2021, 12:10:35 am

Quote from: bplus on October 16, 2021, 11:30:19 pm

I read that request for an effect with screen 0, wondered if the command to print without back ground would work in screen 0 and basically take care of what you wanted???

You guys need to study up on SCREEN 0 and how it’s stored in memory...

Every point in SCREEN 0 is represented by 2 bytes -- character and color.

COLOR 15,4
LOCATE 1, 1: PRINT “A”

Now the above stores 2 bytes in memory for that position. 65 (for A) and 15 * 16 + 4 for the color. (15 foreground + 4 background... Gives us a max value of 255 with blinking off so a single byte holds both values.)

So CHR$(65) + CHR$(244) represents that bright white “A” on a red background.

Now, how can you merge *ANYTHING* onto that spot, without overwriting those 2 bytes of info?

LOCATE 1, 1: PRINT “/”

Now if if we magically make the background of that slash have X alpha with _PALETTECOLOR, how the heck do we blend that color with the COLOR 4 background?

And how does that slash print over the A? There’s no ASCII character representing a slashed-A symbol, so which of our 256 ASCII values do we store for that combination A + /?

SCREEN 0 is a very simple WYSIWYG interface. You can LOOK at the screen and basically decode how it's represented in memory byte-by-byte. It doesn’t allow for color blends, alpha levels, character merging or overlapping...

It just stores 2 bytes for each location: ASCII character to display, color to display it.

Of course, this layout also has ADVANTAGES over other modes.

SCREEN 0 is the *only* screen that can tell the difference in a CHR$(32) and a CHR$(255) printed on. Both are basically spaces, but SCREEN 0 can still tell the difference in them by the way it stores screen information.

Title: Re: Competition
Post by: Pete on October 17, 2021, 12:58:49 am

I helped shed light on the difference with how the SCREEN function cannot function as perfectly in graphics screens ass it does in screen 0. The ability to store the color and character in a graphics project requires mapping with a matrix. I made a graphics GUI using that approach. Maybe someday I'll see why it displayed correctly in the SDL version, but had a slight misalignment problem when we switched to GL.

So for this overlay idea, I took Steve's code and modified it a bit, to get a little bit closer to what I'm thinking about as a use.

Code: QB64: [Select]

$COLOR:32
Screen0 = _NEWIMAGE(80, 25, 0)
SCREEN Screen0
 
'font = _LOADFONT("courbd.ttf", 48, "monospace")
'IF font <= 0 THEN font = 16
'_FONT font
 
'This is going to be the screen I use as an overlay.
Overlay = _NEWIMAGE(_WIDTH * _FONTWIDTH, _HEIGHT * _FONTHEIGHT, 32)
 
COLOR 0, 7
FOR x = 1 TO 25
    LOCATE x, 1: PRINT STRING$(80, 176);
NEXT
 
'Now the above is just Pete's background in Screen0.
'Now I'm going to create the Overly
 
_DEST Overlay
COLOR MidnightBlue, 0
'IF font <= 0 THEN font = 16
'_FONT font
text$ = "This is text wrote over the background"
_PRINTSTRING ((_WIDTH - _PRINTWIDTH(text$)) \ 2, _HEIGHT \ 2), text$
 
_DEST 0 'reset our dest back to the normal screen 0 screen
 
'Turn our software overlay into a hardware image
Overlay_Hardware = _COPYIMAGE(Overlay, 33)
 
'And then my impressive main program to toggle between showing and not
'showing the overlay.
DO
    k = _KEYHIT
    IF k = 32 THEN Show_Overlay = NOT Show_Overlay
    IF Show_Overlay THEN _PUTIMAGE (0, 0), Overlay_Hardware
    _DISPLAY
    _LIMIT 30
LOOP UNTIL k = 27
 
SYSTEM
 

That's pretty cool how the overlay effect, using hardware imaging, does not disturb the screen 0 screen contents.

Pete

Title: Re: Competition
Post by: bplus on October 17, 2021, 08:58:13 am

@Pete

I found the stuff I was talking about and it turns out graphics screen using _PrintMode. But I think this game of yours might have you ready to grad-e-ate to graphics :) screen 12 might be a gentle transition. If you need to know what characters you have printed on screen you can keep am array to track. If you need to know if a chr$(32) or a chr$(255) then I have to ask why? ;-))

Title: Re: Competition
Post by: Pete on October 17, 2021, 11:53:06 am

LOL @ "grad-e-ate" You used the term improperly, though. Every varmint knows ya sez, "Ain't ya grad-e-ate your breakfast!"

- Sam

Title: Re: Competition
Post by: jack on October 19, 2021, 12:28:06 pm

Pete, there's a problem in line 350, illegal function call
the error happened in second wave about half way trough

Title: Re: Competition
Post by: Pete on October 19, 2021, 12:51:44 pm

That's the part where the aliens have landed.

FOR i = j TO 1 STEP -1
LOCATE , ialiencol + INSTR(a(i), CHR$(79)) - 2
PRINT LTRIM$(RTRIM$(a(i)));
LOCATE CSRLIN - 2
NEXT

The error line: LOCATE , ialiencol + INSTR(a(i), CHR$(79)) - 2

This may be some instance where the variable ialiencol = 2 and the INSTR() function is not detecting CHR$(79) in the array. That would make the equation 2 + 0 - 2, leaving a zero in the LOCATE statement, and thus the error. I'll have to run a few tests.

Can you recall how many alien ships (bats) were in the bottom row of the screen when it errored out?

Thanks,

Pete

Title: Re: Competition
Post by: jack on October 19, 2021, 01:01:01 pm

no, mayby less than half

Title: Re: Competition
Post by: Pete on October 20, 2021, 03:37:29 am

Okay, fixed the bug Jack found and finished switching out the hardware overlay scoreboard.

https://www.qb64.org/forum/index.php?topic=4245.msg137017#msg137017

Pete

Title: Re: Competition
Post by: bplus on October 20, 2021, 11:51:15 am

Hi @Pete

Assuming reply #102 in this thread is latest, I tested last night and this morning and am having a very hard time getting initials correct. It seems you have to hold alt key down to move letters at all and I am always going past letter stop by one and am getting farther and farther right having to backspace a bunch. At one point I swear the backspace never appears! Anyway result is always wrong or quit. Shouldn't it be press alt key one to move up letter one time? I press once and no move, again once and no move, I have to hold down for it to cycle letters. Just some feed back, luv everything else, the look of the High Score Dialog is great!

Title: Re: Competition
Post by: Pete on October 20, 2021, 03:19:50 pm

That's a really valid criticism of the enter your initials part. Okay, let's scrap that crap, and how about giving this a go...

Input routine demo only. Not the game. Tap the alt key to advance initials. Leave it unpressed for 2 seconds, and the initial showing will be automatically input. If you make a mistake, hold the Alt key down for a short time, and you can redo from start. It finishes when the last initial is input, and starts flashing your initials for 2.5 seconds. Press the Alt key anytime while initials flash to redo from start; otherwise, just wait until they stop flashing, and your initials are entered.

Oh, and for Mark, it will rerun after ending...

Code: QB64: [Select]

DIM SHARED rank: rank = 1
$COLOR:32
_SCREENMOVE _MIDDLE
 
DIM SHARED intro%: intro% = -1
 
skip_intro:
RANDOMIZE TIMER
DEFINT I
DIM SHARED Overlay, font
DIM SHARED lmargin%, rmargin%, topmargin%, screenwidth%, level, ibk, ileadingrow
DIM SHARED irow, icol, inextrnd, imaxalienmissiles, alienforce%, ileadingmax, imaxalienforce, ihits, score$
 
SCREEN 0, 0, 0, 0
swidth = _WIDTH
 
score$ = "000000"
imaxalienforce = 6
imaxalienmissiles = 3
lmargin% = 2
rmargin% = 79
topmargin% = 3
ialiencolstat = 6
iwin = 3 ' 3 Levels.
screenwidth% = rmargin% - lmargin% + 1
ibk = 0 ' Background color
 
DIM SHARED a(imaxalienforce) AS STRING * 68
 
'fontpath$ = ENVIRON$("SYSTEMROOT") + "\fonts\lucon.ttf" 'Find Windows Folder Path.
'font& = _LOADFONT(fontpath$, 25, "monospace")
'_FONT font&
 
score$ = "069000": CALL displayhighscores: RUN
 
SUB displayhighscores
 
    COLOR 0, 3
    LOCATE 25, 68: PRINT "Score "; score$;
 
    DIM hs AS STRING * 25
    REDIM highscore$(6), hsdata$(6)
    DO
        ''' IF _FILEEXISTS("ascii-invaders-high-score.dat") THEN
        ''' OPEN "ascii-invaders-high-score.dat" FOR RANDOM AS #1 LEN = 25
        ''' FOR i = 1 TO 5
        ''' GET #1, i, hs
        ''' highscore$(i) = MID$(hs, 10, 6): hsdata$(i) = hs
        ''' NEXT
        ''' CLOSE #1
        ''' ELSE
        FOR i = 1 TO 5
            hsdata$(i) = SPACE$(25)
        NEXT
        ''' END IF
 
        IF VAL(score$) > VAL(highscore$(5)) THEN
 
            IF VAL(score$) > VAL(highscore$(1)) THEN
                msg$ = " HIGH SCORE / Enter Your Initials! "
            ELSE
                msg$ = " Top 5 Score. Enter Your Initials! "
            END IF
 
            GOSUB hiscore
 
            a = 14
            OUT &H3C8, 0
            OUT &H3C9, 20 - a
            OUT &H3C9, 20 - a
            OUT &H3C9, 20 - a
 
            OUT &H3C8, 8
            OUT &H3C9, 30 - a
            OUT &H3C9, 30 - a
            OUT &H3C9, 30 - a
 
            OUT &H3C8, 7
            OUT &H3C9, 30 - a
            OUT &H3C9, 30 - a
            OUT &H3C9, 30 - a
 
            OUT &H3C8, 3
            OUT &H3C9, 30 - a
            OUT &H3C9, 30 - a
            OUT &H3C9, 30 - a
 
            GOSUB hardware_overlay
 
            _FONT 16
 
            COLOR White, 0
            t$ = msg$
            PSLC 4.6, 41 - LEN(msg$) \ 2, t$
 
            font = _LOADFONT("lucon.ttf", 20, "monospace")
            IF font <= 0 THEN font = 16
            _FONT font
 
            DEF SEG = 0
            delay = .4
            lscr = 19
            z3 = TIMER
            DO
                initials$ = "": i = 0: nxt = 0
                COLOR , _RGB(24, 24, 24): t$ = "   " ' Blank initials for redo. Okay to blank at start.
                PSL 5 + rank * 2, lscr, t$
                _DISPLAY
                DO
                    _LIMIT 60
                    IF ABS(z3 - TIMER) > .3 AND kflag > -2 THEN
                        underline 5 + rank * 2, lscr + nxt, 0
                        _DISPLAY
                        z3 = TIMER
                    END IF
 
                    SELECT CASE kflag
                        CASE 0
                            IF ABS(z1 - TIMER) > 1.5 AND i AND nxt < 3 THEN
                                SOUND 1500, 1
                                underline 5 + rank * 2, lscr + nxt, -1: uflag = 0
                                _DISPLAY
                                initials$ = initials$ + CHR$(64 + i)
                                nxt = nxt + 1 ' Next initial
                                i = 0 ' Reset alphabet.
                                z1 = TIMER
                                IF nxt = 3 THEN
                                    kflag = -2 ' All 3 initials have been input.
                                    underline 5 + rank * 2, lscr + nxt, -1: uflag = 0
                                    _DISPLAY
                                END IF
                            END IF
 
                            IF PEEK(1047) MOD 16 = 7 OR PEEK(1047) MOD 16 = 8 THEN
                                kflag = -1 ' Alt key pressed.
                                z1 = TIMER: z2 = TIMER
                                i = i + 1: IF i > 26 THEN i = 1
                                COLOR , _RGB(24, 24, 24): t$ = " "
                                PSL 5 + rank * 2, lscr + nxt, t$
                                COLOR DarkOrange: t$ = CHR$(64 + i)
                                SOUND 1000, .1
                                PSL 5 + rank * 2, lscr + nxt, t$
                                underline 5 + rank * 2, lscr + nxt, 0
                                _DISPLAY
                            END IF
                        CASE -1
                            IF ABS(z2 - TIMER) > 2 THEN ' Key down long enough to indicate redo input.
                                IF nxt > 0 THEN ' Redo last initial input.
                                    SOUND 300, .5
                                    FOR nxt = 0 TO 3
                                        underline 5 + rank * 2, lscr + nxt, -1: uflag = 0
                                    NEXT
                                    nxt = 0: i = 0
                                    initials$ = ""
                                    COLOR , _RGB(24, 24, 24): t$ = "   "
                                    PSL 5 + rank * 2, lscr, t$
                                    _DISPLAY
                                    z1 = TIMER ' Reset enter timer.
                                ELSE
                                    SOUND 300, .5
                                    i = 0
                                    COLOR , _RGB(24, 24, 24): t$ = " "
                                    PSL 5 + rank * 2, lscr, t$
                                    _DISPLAY
                                    z1 = TIMER ' Reset enter timer.
                                END IF
                                z2 = TIMER
                            END IF
 
                            IF PEEK(1047) MOD 16 <> 7 AND PEEK(1047) MOD 16 <> 8 THEN ' Alt key was released.
                                kflag = 0 ' Alt key up
                                z1 = TIMER
                            END IF
                        CASE -2 ' Finished. Initials will flash until confirmed by 2-second timer.
                            z1 = TIMER: z2 = TIMER
                            j = 0
                            DO
                                IF ABS(z1 - TIMER) > .3 THEN j = -j - 1: z1 = TIMER
                                IF j THEN
                                    COLOR DarkOrange: t$ = initials$
                                    PSL 5 + rank * 2, lscr, t$
                                    _DISPLAY
                                ELSE
                                    COLOR _RGB(24, 24, 24): t$ = initials$
                                    PSL 5 + rank * 2, lscr, t$
                                    _DISPLAY
                                END IF
 
                                IF ABS(z2 - TIMER) > 2.5 AND j THEN
                                    kflag = -3
                                    EXIT DO
                                END IF
 
                                IF PEEK(1047) MOD 16 = 7 OR PEEK(1047) MOD 16 = 8 THEN
                                    BEEP
                                    kflag = -4
                                    EXIT DO
                                END IF
                            LOOP
                        CASE -3
                            _DELAY 1
                            l$ = "8"
                            n$ = "n24": PLAY "L" + l$ + n$
                            n$ = "n28": PLAY "L" + l$ + n$
                            n$ = "n28": PLAY "L" + l$ + n$
                            l$ = "7"
                            n$ = "n31": PLAY "L" + l$ + n$
                            l$ = "9"
                            n$ = "n28": PLAY "L" + l$ + n$
                            l$ = "3"
                            n$ = "n31": PLAY "L" + l$ + n$
                            kflag = 1
                            _DELAY 1: EXIT DO
                        CASE -4
                            kflag = 0 ' Repeat enter initials
                            nxt = 0
                            i = 0
                            EXIT DO
                    END SELECT
                LOOP
                IF kflag > 0 THEN kflag = 0: EXIT DO ' Exit routine.
            LOOP
            DEF SEG
 
            hsname$ = initials$
 
            MID$(hsdata$(rank), 5, 3) = hsname$ + SPACE$(3 - LEN(hsname$))
            '''OPEN "ascii-invaders-high-score.dat" FOR RANDOM AS #1 LEN = 25
            '''FOR i = 1 TO 5
            ''' hs = hsdata$(i)
            '''IF LEFT$(hs, 1) = "" THEN MID$(hs, 1, 2) = "0" + LTRIM$(STR$(i))
            '''PUT #1, i, hs
            '''NEXT
            '''CLOSE #1
 
            _DELAY 1
            _DISPLAY ' Remove scoreboard.
            _DELAY 1
            _FREEIMAGE Overlay
            _FONT 16 'select inbuilt 8x16 default font
            _FREEFONT font
 
            _DEST 0 'Reset dest back to the normal screen 0.
 
            _AUTODISPLAY
            COLOR 6, 0
            msg$ = SPACE$(40)
            LOCATE 4, 41 - LEN(msg$) \ 2
            PRINT msg$;
            PALETTE
            _DELAY 1
 
            EXIT DO
        ELSE
            EXIT DO ' Not in the top 5 highest scores so exit sub.
        END IF
    LOOP
    EXIT SUB
 
    hardware_overlay:
    Overlay = _NEWIMAGE(_WIDTH * _FONTWIDTH, _HEIGHT * _FONTHEIGHT, 32)
 
    _DEST Overlay
    _DISPLAY ' Turn autodisplay off.
 
    font = _LOADFONT("lucon.ttf", 20, "monospace")
    IF font <= 0 THEN font = 16
    _FONT font
 
    bxy% = 3
    bxx% = 13
    COLOR DarkOrange, 0
    t$ = " " + CHR$(218) + STRING$(27, CHR$(196)) + CHR$(191) + " "
    PSL bxy%, bxx% - 1, t$
    FOR i = 1 TO 12
        t$ = " " + CHR$(179) + STRING$(27, CHR$(32)) + CHR$(179) + " "
        PSL bxy% + i, bxx% - 1, t$
    NEXT
    t$ = " " + CHR$(192) + STRING$(27, CHR$(196)) + CHR$(217) + " "
    PSL bxy% + i, bxx% - 1, t$
 
    bxy% = 4
    COLOR Black, DarkOrange
    t$ = "    NAME   SCORE    DATE   "
    PSL bxy% + 1, bxx% + 1, t$
 
    COLOR DarkOrange, 0
    FOR i = 1 TO 5
        t$ = hsdata$(i)
        PSL bxy% + 1 + i * 2, bxx% + 2, t$
    NEXT
 
    _DISPLAY
 
    RETURN
 
    hiscore:
    FOR i = 1 TO 5
        IF VAL(score$) > VAL(highscore$(i)) THEN rank = i: EXIT FOR
    NEXT
 
    hsdata$(6) = SPACE$(25)
    MID$(hsdata$(6), 10, 6) = score$
    MID$(hsdata$(6), 18, 8) = MID$(DATE$, 1, 6) + MID$(DATE$, 9, 2)
    highscore$(6) = score$
    FOR i = 1 TO 6
        FOR j = 1 TO 6
            IF i <> j THEN
                IF VAL(highscore$(i)) > VAL(highscore$(j)) THEN
                    SWAP highscore$(i), highscore$(j)
                    SWAP hsdata$(i), hsdata$(j)
                END IF
            END IF
        NEXT
    NEXT
    FOR i = 1 TO 5
        MID$(hsdata$(i), 1, 2) = "0" + LTRIM$(STR$(i))
    NEXT
 
    RETURN
 
END SUB
 
SUB PSLC (y, x, t$)
    _PRINTSTRING ((x - 1) * 8, (y - 1) * 16), t$
END SUB
 
SUB PSL (y, x, t$)
    _PRINTSTRING ((x - 1) * _FONTWIDTH, (y - 1) * _FONTHEIGHT), t$
    Overlay_Hardware = _COPYIMAGE(Overlay, 33)
    _PUTIMAGE (0, 0), Overlay_Hardware
END SUB
 
SUB underline (y, x, uflag)
    STATIC ucnt
    ucnt = -ucnt - 1
    IF ucnt OR uflag THEN
        LINE ((x - 1) * _FONTWIDTH, y * _FONTHEIGHT)-((x - 1) * _FONTWIDTH + 12, y * _FONTHEIGHT), _RGB(24, 24, 24), BF
    ELSE
        LINE ((x - 1) * _FONTWIDTH, y * _FONTHEIGHT)-((x - 1) * _FONTWIDTH + 12, y * _FONTHEIGHT), DarkOrange, BF
    END IF
 
    Overlay_Hardware = _COPYIMAGE(Overlay, 33)
    _PUTIMAGE (0, 0), Overlay_Hardware
END SUB

Pete

Title: Re: Competition
Post by: bplus on October 20, 2021, 04:42:18 pm

OK Pete what did you edit? :)

I tested before edit and was going to request you cycle back through capital letters if missed on first run through, you are or were cycling through all of ASCII yikes!

But I was able to get my initials a couple of times if I was careful not to accidently go past the letter to wait on, I would say much improved but more tweaks ahead.

Also I put the call to sub in loop and it never looped around again and again for practice, just one run in sub and it quits.

Title: Re: Competition
Post by: Pete on October 20, 2021, 05:01:56 pm

Yeah, I noticed that loop situation and edited it, along with a couple of other small tweaks. I'm thinking of having it flash the initials once the last one is input, and if the user doesn't engage the Alt key while flashing, it finishes. If the user does engage the Alt key, it does a redo.

Pete

Title: Re: Competition
Post by: Pete on October 20, 2021, 06:26:45 pm

Okay, see newly edited and revised version with flashing 3-initials at end of input so user can press Alt to redo.

Pete

Title: Re: Competition
Post by: bplus on October 20, 2021, 08:53:33 pm

Yes that's working for me, just need to remember if it's flashing and correct to leave it alone. Good by me.

Title: Re: Competition
Post by: Pete on October 20, 2021, 09:03:21 pm

I added one more small tweak, the ability to redo the first initial if you go past it.

Yes, this one-button challenge is certainly doable, but waiting as input instead of action for input is a bit hard to get used to at first.

Thanks for taking it for a test run!

Pete

Title: Re: Competition
Post by: jack on October 20, 2021, 09:52:20 pm

Pete, that last initials routine works really well

Title: Re: Competition
Post by: Pete on October 20, 2021, 10:40:42 pm

@jack Yep. it's a keeper.

I incorporated it just now to the game at: https://www.qb64.org/forum/index.php?topic=4245.msg137017#msg137017

Thanks for trying it out!

Pete

Title: Re: Competition
Post by: bplus on October 21, 2021, 04:05:28 pm

@Pete Just tested latest update with High Score tracking, excellent!

[ This attachment cannot be displayed inline in 'Print Page' view ]

Title: Re: Competition
Post by: bplus on October 21, 2021, 04:07:47 pm

@Pete Have you thought about a _Title " ??? "

Title: Re: Competition
Post by: Pete on October 21, 2021, 11:23:54 pm

Okay, I just made another update with a title. See Edit notes for additions.

https://www.qb64.org/forum/index.php?topic=4245.msg137017#msg137017

Pete

Title: Re: Competition
Post by: bplus on November 01, 2021, 12:41:12 pm

Well I am voting for Pete's, a great remake of an old program with plenty of mods to make it new and better. Nice application of the one key restriction specially including entering initials in high scores section. Great Halloween theme adaptation plus we get one of The Bob's masterpieces included.

And besides me who else tried? Dav had a couple of abandoned projects, the Witch and Candy thing had potential, maybe next year! Steve also had half hearted thing started but maybe saving for the Christmas rush :-))

@Pete nice strategy to post early and scare everyone off! :) Would you (or with your permission I will) post a copy in Programs section so that it might be accessed later from Library Games section for comments and feedback from the future.

Title: Re: Competition
Post by: SMcNeill on November 01, 2021, 01:00:18 pm

Aye. I just didn't have time. Halloween is always crazy busy here on the farm.

Title: Re: Competition
Post by: Qwerkey on November 01, 2021, 01:08:51 pm

Quote from: bplus on November 01, 2021, 12:41:12 pm

Well I am voting for Pete's

Are we ready to place in the Library?

By the way, Fellippe pointed out to me that "Library" has its Special Meaning in the coding sphere. @bplus & I are Librarians, but can anybody think of an alternative word for our curated works section?

Title: Re: Competition
Post by: bplus on November 01, 2021, 01:18:22 pm

Quote from: Qwerkey on November 01, 2021, 01:08:51 pm

Are we ready to place in the Library?

By the way, Fellippe pointed out to me that "Library" has its Special Meaning in the coding sphere. @bplus & I are Librarians, but can anybody think of an alternative word for our curated works section?

Well I did say a week for voting and no one (me) can't vote for them self so, but give it a week, no hurry. It'd be a shame if Pete won by only one vote. Dav, Steve and TempodiBasic can say something because they participated in the one key part. Pete has to stay quiet or he'll cause a tie LOL!

@Qwerkey, how about Curators? or Caretakers?
Google says for synonyms:

Quote

curator
noun
custodian
keeper
conservator
guardian
caretaker
steward

PS I forgot to mention Cobalt who also gave one key a try with Halloween theme, sorry I saved best for last ;-))

Title: Re: Competition
Post by: bplus on November 08, 2021, 11:01:38 am

OK @Qwerkey 1 week wait is over, thanks to all who participated.

I made a zip package of Pete's One Key Halloween code, Winner of the One Key Halloween 2021 Competition.
I am pretty sure it is the most up-to-date copy of Pete's edits, just source and sound files.
See if it works OK for you and check with Pete about credits and permission to post in Programs Board.

Title: Re: Competition
Post by: Qwerkey on November 08, 2021, 12:45:45 pm

@bplus Aye, aye cap'n will do.

Title: Re: Competition
Post by: xra7en on November 08, 2021, 05:57:25 pm

long thread on this

I thought of a good one (too lazy right now ) but how about a woodpecker on a tree.

1 key move left and right - to avoid falling walnuts (or w/e) sorta like a flappy bird but one key!
each hit of the key switches sides :-)

random nuts fall

time speed up.

could be addictive.
humans are weird like that

Title: Re: Competition
Post by: bplus on November 08, 2021, 06:43:39 pm

@xra7en

Interesting idea, save it for Christmas to help Santa get down chimney :-))

Title: Re: Competition
Post by: xra7en on November 08, 2021, 08:05:44 pm

Ho ho ho!

love it.

dodging coal!

Text Only | Text with Attachments

QB64.org Forum

Active Forums => QB64 Discussion => Topic started by: johnno56 on October 02, 2021, 08:25:34 am