This entry was for a competition to design a game using only ONE key.
To Play:
Use ONLY 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 move 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.
FILE WARNING: This routine makes and overwrites a file in your local folder named: ascii-invaders-high-score.dat
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
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
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
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
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
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
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
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
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
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
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
For much better sound effects, download and unzip the .ogg files, in the attachment, to your local folder.
This should detect a space bar press, when other keys are held down like arrow key combinations. It does, except in the code snippet below...
If you hold down the ARROW UP and ARROW LEFT keys at the same time, and press the space bar, you won't hear the sound. Other combos like arrow up and arrow right held down while pressing the space bar will produce the sound.
So what's up? I further tested noted in my QB64 version 2.1 Development Build that the software is blocking INKEY$, _KEYHIT, and _KEYDOWN from registering CHR$(32). the space bar, under some key combination conditions, but not others.
Code: (Select All)
DO
IF INKEY$ = CHR$(32) THEN SOUND 1000, .2 ' Fails detection while holding down arrow up and arrow left keys.
LOOP
Change CHR$(32) to CHR$(9), no problem.
Code: (Select All)
DO
IF INKEY$ = CHR$(9) THEN SOUND 1000, .2 ' Works with all one or two arrow key combinations, including arrow up + arrow left.
LOOP
Change INKEY$ to _KEYHIT = 32 and it gets blocked again.
Code: (Select All)
DO
IF _KEYHIT = 32 THEN SOUND 1000, .2 ' Works with all one or two arrow key combinations, including arrow up + arrow left.
LOOP
Same issue with _KEYDOWN (I swapped out sound for print to avoid annoying build up of sound.)
Code: (Select All)
DO
_LIMIT 30
IF _KEYDOWN(32) = -1 THEN PRINT _KEYDOWN(32); ' Works with all one or two arrow key combinations, including arrow up + arrow left.
LOOP
Any ideas as to why, or is this a bug that's been fixed in a newer version?
UPDATE: I made changes to the code with great suggestions and code examples from Pete. The routine is much more stable now. Thanks Pete!
By the way - writing text parsing routines is much harder than it looks. So much to consider in their design.
While writing the library for lesson 20 of the tutorial I wrote a text parser that's fairly efficient. I needed a parsing routine that reported the number of lines the input text string would be parsed to and could deliver one line of text at a time on demand. This is what I came up with:
Code: (Select All)
FUNCTION ParseText$ (TextIn AS STRING, MaxWidth AS INTEGER, Action AS INTEGER) STATIC
'-> Modifications added suggested by Pete 10/03/22. Corrects issue of crashing and mishandling of text
' in certain situations. (additions remarked in code below)
' - Function exit if text sent in is null
' - Handles non-breaking strings larger than space allocated
' - Handles end of text that has no trailing space
' - Clear text for next parsing event
'-> Parses the string passed in into multiple lines of the maximum width desired
' The first time the function is called, regardless of action, the TextIn string is fully parsed
' Subsequent calls to the function with the same text will not parse the TextIn string again
'-> INPUT PARAMETERS:
' TextIn - the text string sent into the function
' MaxWidth - maximum width of text on a line
' Action - 1 reports number of lines created, 0 returns lines of parsed text ("" = finished)
'-> EXAMPLE:
' t$ = "The rain in Spain falls mainly on the plain. The weather in Spain seems pretty good!"
' Lines = VAL(ParseText$(t$, 40, 1)) ' report number of lines the text was parsed into
' DO ' get all parsed lines of text
' TextLine$ = ParseText$(t$, 40, 0) ' return the next line of parsed text
' IF TextLine$ <> "" THEN PRINT TextLine$ ' could easily be saved to an array as well
' LOOP UNTIL TextLine$ = "" ' ParseText$ returns null when all lines returned
'-> There is no need to have ParseText$ report the number of lines needed. A simple counter could be
' placed within the DO...LOOP as well. The report for the number of lines the text was parsed into will
' be returned as a string and need converted to a value VAL() as seen in the 2nd line of the example.
DIM PText AS STRING ' previous text that was sent in
DIM Index AS INTEGER ' array index counter
DIM Plen AS INTEGER ' parse string length
DIM Char AS STRING * 1 ' character analyzer
DIM Parse AS STRING ' parsed string
DIM WText AS STRING ' working text string
DIM Done AS INTEGER ' flag to indicate parsing finished
IF MaxWidth <= 0 THEN ParseText$ = "": EXIT FUNCTION ' (Pete) leave if null text sent in
IF PText <> TextIn THEN ' was a new text string sent in?
PText = TextIn ' yes, remember text that was sent in
WText = TextIn ' get text sent in to work with
Index = 0 ' reset index counter
Done = 0 ' reset finished flag
REDIM Text(0) AS STRING ' reset text array
END IF
IF NOT Done THEN ' has parsing already been performed?
DO ' no, begin array loop
Index = Index + 1 ' increment index counter
REDIM _PRESERVE Text(Index) AS STRING ' increase size of array
' (Pete) Non-breaking string larger than space alloted checked below.
IF LEN(WText) > MaxWidth AND INSTR(MID$(WText, 1, MaxWidth + 1), " ") = 0 THEN ' (Pete)
Plen = MaxWidth ' (Pete) set length to maximum size
Parse = MID$(WText, 1, Plen) ' (Pete) get the maximum size string allowed
ELSE
IF MID$(WText, MaxWidth + 1, 1) <> " " THEN ' (Pete) text with no trailing space?
Plen = MaxWidth ' (Pete) yes, set length to remaining text
ELSE ' no, there is a a trailing space
Plen = MaxWidth + 1 ' (+1 for trailing spaces) set length to include space
END IF
DO ' begin parse loop
IF LEN(WText) <= Plen THEN ' remaining text all that is left?
Parse = MID$(WText, 1, Plen) ' yes, get remaining text
Done = -1 ' parsing is done
ELSE ' no, text still longer than max width
IF INSTR(MID$(WText, 1, Plen), " ") = 0 THEN ' space found in text? (Pete)
Plen = Plen + 1 ' (Pete) no, increment length
ELSE
DO ' begin space search loop
Char = MID$(WText, Plen, 1) ' get last character
IF Char <> " " THEN Plen = Plen - 1 ' if not a space then move back one
LOOP UNTIL Char = " " ' leave when space found
Parse = LEFT$(WText, Plen - 1) ' get parsed string without space at end
END IF
END IF
LOOP UNTIL Char = " " OR Done ' leave when space found or parsing done
END IF
Text(Index) = Parse ' save the parsed text
IF NOT Done THEN WText = MID$(WText, Plen + 1, LEN(WText)) ' remove parsed text from string
LOOP UNTIL Done ' leave when parsing done
Index = 0 ' reset index counter for reporting
END IF
IF Action = 1 THEN ' report number of lines?
ParseText$ = STR$(UBOUND(Text)) ' yes, return number of lines as a string
ELSE ' no, report parsed lines found
Index = Index + 1 ' increment index counter
IF Index > UBOUND(Text) THEN ' have all lines been reported?
ParseText$ = "" ' yes, report nothing remaining
PText = "" ' (Pete) clear for next parsing event
ELSE ' no, parsed text remains
ParseText$ = Text(Index) ' report next line of text
END IF
END IF
END FUNCTION
Drop the function into your own code and parse away.
I've noticed people posting code snippets and referring to the game tutorial as inspiration. If you write a game and wish it to be included in the list of games on the tutorial site let me know. I'm more than happy to showcase your game for you.
One thing you'll need to agree to though is that the source code must be included for others to learn from. I won't post pre-compiled .EXEs since there's no learning value there and no way to verify the program is destructive in any way.
I wanted to learn more about collisions, so I tried this.
I'm sure most people here already know about this but I figured I'd share anyway. The subject that is central here is "collision response", and in this case it's the "dynamic / static" variety. Interesting stuff for a mathematician I'm sure. Rather than deep dive into the physics I was able to accomplish a decent result using Terry's game tutorial (have I mentioned how great that is yet? haha)
Sound files are attached.
(Edit: use mouse to position chip and click to drop it)
Code: (Select All)
'Plinko
'james2464
'Oct 2022
Dim Shared scx, scy As Integer
'screen size
scx = 500 '
scy = 700 '
Screen _NewImage(scx, scy, 32)
Type movingchip
x As Single
y As Single
xv As Single
yv As Single
spd As Single
live As Integer
age As Integer
rad As Integer
colour As Integer
x1 As Integer
x2 As Integer
y1 As Integer
y2 As Integer
End Type
Dim Shared ch(10) As movingchip
Type fixedpin
x As Single
y As Single
rad As Integer
colour As Integer
x1 As Integer
x2 As Integer
y1 As Integer
y2 As Integer
End Type
Dim Shared pin(200) As fixedpin
Line (0, 0)-(scx, scy), c0(10), BF 'background colour
Line (1, 1)-(30, scy), c0(5), BF 'side borders
Line (scx, 1)-(scx - 30, scy), c0(5), BF
Line (30, 637)-(scx - 30, 639), c0(0), BF 'result position slots
Line (29, 600)-(31, 639), c0(0), BF
Line (scx - 29, 600)-(scx - 31, 639), c0(0), BF
For t = 1 To 8
Line (24 + 50 * t, 600)-(26 + 50 * t, 637), c0(0), BF
Next t
'result slot colours
Line (31, 640)-(75, scy), c0(11), BF
Line (76, 640)-(125, scy), c0(12), BF
Line (126, 640)-(175, scy), c0(13), BF
Line (176, 640)-(225, scy), c0(14), BF
Line (226, 640)-(275, scy), c0(15), BF
Line (276, 640)-(325, scy), c0(16), BF
Line (326, 640)-(375, scy), c0(17), BF
Line (376, 640)-(425, scy), c0(18), BF
Line (426, 640)-(scx - 30, scy), c0(19), BF
Dim Shared vx, vy, lv1, vx2, vy2, vx3, vy3, lv2, sp As Single
Dim Shared j As Integer
'define chip and pin
ch(1).rad = 16
Dim pintot As Integer
pintot = 93
t = 0
t2 = 0
t3 = 0
Do
t3 = t3 + 1
If t2 = 0 Then
For t1 = 1 To 8
t = t + 1
pin(t).x = 25 + t1 * 50
pin(t).y = 30 + t3 * 50
Next t1
t2 = 1
Else
For t1 = 1 To 9
t = t + 1
pin(t).x = 0 + t1 * 50
pin(t).y = 30 + t3 * 50
Next t1
t2 = 0
End If
Loop Until t = pintot
For t = 1 To pintot
pin(t).rad = 4
pin(t).x1 = pin(t).x - pin(t).rad
pin(t).x2 = pin(t).x + pin(t).rad
pin(t).y1 = pin(t).y - pin(t).rad
pin(t).y2 = pin(t).y + pin(t).rad
Next t
'draw pins
For t = 1 To pintot
_PutImage (pin(t).x - 10, pin(t).y - 10)-(pin(t).x + 10, pin(t).y + 10), pin1&, 0 ' draw pin
Next t
For j = 1 To pintot 'check for collision
If collide1 = 1 Then 'quick rectangle check
If collide2 = 1 Then 'if rectangle check confirmed, then circle collision check
vectorupdate 'change chip vector based on collision angle
End If
End If
Next j
Function collide1 'rectangle - early detection
collide1 = 0
If ch(1).x2 >= pin(j).x1 Then
If ch(1).x1 <= pin(j).x2 Then
If ch(1).y2 >= pin(j).y1 Then
If ch(1).y1 <= pin(j).y2 Then
collide1 = 1
End If
End If
End If
End If
End Function
Function collide2 'circle detection
Dim SideA%
Dim SideB%
Dim Hypot&
If ch(1).x = pin(j).x Then 'prevent chip from being perfectly above a pin (randomize and nudge)
t = Rnd * 100
If t > 49 Then
ch(1).x = ch(1).x + .05
Else
ch(1).x = ch(1).x - .05
End If
End If
collide2 = 0
SideA% = ch(1).x - pin(j).x
SideB% = ch(1).y - pin(j).y
Hypot& = SideA% * SideA% + SideB% * SideB%
If Hypot& <= ((ch(1).rad + pin(j).rad) * (ch(1).rad + pin(j).rad) + 4) Then 'added + 4 to prevent late detection
_SndPlayCopy click&
collide2 = 1
End If
End Function
Sub vectorupdate 'change chip movement based on collision
'update chip velocity vectors
If sp > .5 Then sp = sp * .65 'govern speed to prevent craziness
If ch(1).x <= pin(j).x Then
ch(1).xv = sp * vx3
If ch(1).xv > -.3 Then ch(1).xv = -.3 'keep things moving - override
Else
ch(1).xv = sp * vx3
If ch(1).xv < .3 Then ch(1).xv = .3 'keep things moving - override
End If
If ch(1).y <= pin(j).y Then
ch(1).yv = vy3 * sp
If ch(1).yv > -.3 Then ch(1).yv = -.3 'keep things moving - override
Else
ch(1).yv = 0 - vy3 * sp
If ch(1).yv < .3 Then ch(1).yv = .3 'keep things moving - override
End If
If you ever wanted to move a player in any direction by holding down the cursor arrow keys while still being able to process other events and even type other keys while still moving, this might be of interest to you.
Controls: (Hold down keys for perpetual movement.)
Right arrow = move right.
Left arrow = move left.
Up arrow = move up
Down arrow = move down... Duh, this sounds so stupid up to now, but wait...
Up arrow + left arrow = diagonal up and to the left.
Up arrow + right arrow = diagonal up and to the right.
Down arrow + left arrow = diagonal down and to the left.
Down arrow + right arrow = diagonal down and to the right.
Left ctrl + or without any arrow keys held and while or while not moving increases speed.
Left alt + or without any arrow keys held and while or while not moving decreases speed.
Type any key to print key character to the upper right screen while or while not moving.
space bar honks horn.
esc to quit.
An old problem with QBasic was not being able to detect more than two key presses. Special keys like ctrl, alt, and shift all had to be recognized with DEF SEG PEEK/POKE routines. (BTW - we can still use those PEKK/POKE (1046) routines in QB64.)
Anyway, here's the demo...
Code: (Select All)
' Note: timer is not adjusted for stroke of midnight event, so don't stay up late playing this.
WIDTH 140, 42
_SCREENMOVE 0, 0
DIM move_speed AS DOUBLE
top = 2: bottom = _HEIGHT: left = 1: right = _WIDTH
PRINT "Press single or combo of arrow keys to move. Rt. Ctrl = faster / Rt. Alt = slower. "
LOCATE 2, 1: PRINT STRING$(_WIDTH, "_");
move_speed = 25
player_y = _HEIGHT \ 2 + 1: player_x = _WIDTH \ 2
LOCATE player_y, player_x: PRINT "*";
_KEYCLEAR
DO
_LIMIT 60
LOCATE 1, 50: PRINT "Movement y, x: "; mpy; mpx; " Speed Delay ="; move_speed;
' If you only want speed changes when a player moves then remove the timer and move this routine to: IF move_player = -1 AND ABS(z1 - TIMER) > .07 THEN
IF ABS(z3 - TIMER) > .1 THEN ' Check every .1 seconds for a speed change.
IF _KEYDOWN(100307) AND move_speed < 50 THEN move_speed = move_speed + 1
IF _KEYDOWN(100305) AND move_speed > 0 THEN move_speed = move_speed - 1
z3 = TIMER
END IF
IF ABS(z2 - TIMER) > move_speed / 100 THEN ' Moving lag. Note: Division needed because computer math can't add decimal numbers correctly.
IF move_player = 0 THEN
IF _KEYDOWN(18432) OR _KEYDOWN(19200) OR _KEYDOWN(19712) OR _KEYDOWN(20480) THEN ' Arrow keys.
move_player = -1
z1 = TIMER ' Delay timer for key lag.
END IF
END IF
END IF
IF move_player = -1 THEN
IF ABS(z1 - TIMER) > .05 THEN ' Key lag. A slight delay to allow player to press two keys together within a reasonable amout of time.
DO ' Falx loop to throw out illegal key combos like up + down.
mpx = 0: mpy = 0
' Eliminate illegal combos.
IF _KEYDOWN(18432) AND _KEYDOWN(20480) THEN move_player = 0: z2 = TIMER: EXIT DO
IF _KEYDOWN(19712) AND _KEYDOWN(19200) THEN move_player = 0: z2 = TIMER: EXIT DO
' IF female THEN STOP AND GET #1, directions.
IF _KEYDOWN(18432) THEN ' Up-arrow.
mpy = -1
END IF
IF _KEYDOWN(19712) THEN ' Right-arrow.
mpx = 1
END IF
IF _KEYDOWN(20480) THEN ' Down-arrow.
mpy = 1
END IF
IF _KEYDOWN(19200) THEN ' Left-arrow.
mpx = -1
END IF
IF mpx AND mpy THEN ' Routine to cancel keys as a double hold is being lifted. This allows for the difference of both keys cannot be released at exactly the same time.
combo = -1
ELSE
IF combo THEN combo = 0: move_player = 0: EXIT DO
END IF
' Move player
IF player_y + mpy > top AND player_y + mpy <= bottom AND player_x + 2 * mpx > left AND player_x + 2 * mpx < right THEN
LOCATE player_y, player_x
PRINT " ";
player_y = player_y + mpy: player_x = player_x + 2 * mpx
LOCATE player_y, player_x
PRINT "*";
ELSE
BEEP ' Hit the wall!
END IF
move_player = 0
z2 = TIMER ' Timer for moving lag regulated by the move_speed variable.
EXIT DO
LOOP
END IF
ELSE ' If you want additional key routines, put them here...
ky$ = INKEY$
IF LEN(ky$) = 1 THEN ' For demo, exclude keys that start with chr$(0). Note without this arrow keys would still register here.
LOCATE 1, _WIDTH - 22: PRINT SPACE$(22);
LOCATE 1, _WIDTH - 22
PRINT "You pressed key: "; ky$;
SELECT CASE ky$
CASE CHR$(32) ' Space bar
BEEP
CASE CHR$(27) ' Esc
END
END SELECT
END IF
END IF
LOOP
'Spooky pentagram of doom for Halloween
'juts a little halloween season fun
Screen _NewImage(800, 500, 32)
_Define K As _UNSIGNED LONG
_FullScreen
'good music here
Play "MB O0 L4 cdccdcecdccdccdccdcecdccababcddcddcdde O2 L2 e e e e e"
'well not really
For d = 0 To 360
_Limit 20
Cls
circleBF 400, 250, (d * 1.1) / 2, _RGB32(250, 250, 0)
circleBF 400, 250, ((d * 1) / 2) - 2, _RGB32(0, 0, 0)
bumpypoly 400, 250, d / 2, 72, 180 + d, 1 + Int(d / 120), _RGB32(0, 250, 10)
bumpypentagram 400, 250, d / 2, 72, 180 + d, 1 + Int(d / 90), _RGB32(250, 2, 5)
_Display
Next d
_AutoDisplay
For n = 1 To 900
_Limit 400
sx = Int(Rnd * 800)
sy = Int(Rnd * 500)
klr = _RGB32(240 + Int(Rnd * 16), Int(Rnd * 10), Int(Rnd * 10))
rd = Int(Rnd * 12)
circleBF sx, sy, 8 + rd, klr
circleBF sx + Int(Rnd * (rd / 2)), sy + Int(Rnd * (rd / 2)), 4 + rd, klr
circleBF sx + Int(Rnd * (rd / 2)), sy + Int(Rnd * (rd / 2)), 2 + rd, klr
Next
Line (0, 0)-(800, 500), klr, BF
klr2 = _RGB32(250, 250, 0)
For t = 1 To 360
_Limit 180
pp = 1 + Int(Rnd * 3)
For reps = 1 To pp
sx = Int(Rnd * 800)
sy = Int(Rnd * 500)
rd = 3 + Int(Rnd * 24)
pentagram sx, sy, rd, 72, Int(Rnd * 360), .5 + Rnd * 2.5, klr2
Next reps
bumpypentagram 400, 250, 180, 72, 360, 1 + Int(t / 90), _RGB32(75 + t / 2, 75 + t / 2, 5)
Next t
For n = 0 To 255
_Limit 180
Line (0, 0)-(800, 500), _RGB32(0, 0, 0, n), BF
bumpypentagram 400, 250, 180, 72, 360, 5, _RGB32(255, 255, 5)
Next n
For n = 0 To 255
_Limit 180
bumpypentagram 400, 250, 180, 72, 360, 5, _RGB32(255, 255, 5)
Line (0, 0)-(800, 500), _RGB32(0, 0, 0, n), BF
Sub pentagram (cx, cy, rr, shapedeg, turn, thk, klr As _Unsigned Long)
Dim p(6, 2)
x = rr * Sin(0.01745329 * turn)
y = rr * Cos(0.01745329 * turn)
'Line (cx + x, cy + y)-(cx + x, cy + y), klr
lx = cx + x: ly = cy + y
n = 0
For deg = turn To turn + 360 Step shapedeg
x2 = rr * Sin(0.01745329 * deg)
y2 = rr * Cos(0.01745329 * deg)
' tv = (Rnd * 6 + Rnd * 6 + 3) / 10
' bumpyline lx, ly, cx + x2, cy + y2, thk * tv, klr
lx = cx + x2: ly = cy + y2
n = n + 1
p(n, 1) = cx + x2
p(n, 2) = cy + y2
Next
Line (p(1, 1), p(1, 2))-(p(3, 1), p(3, 2)), klr
Line (p(3, 1), p(3, 2))-(p(5, 1), p(5, 2)), klr
Line (p(5, 1), p(5, 2))-(p(2, 1), p(2, 2)), klr
Line (p(2, 1), p(2, 2))-(p(4, 1), p(4, 2)), klr
Line (p(4, 1), p(4, 2))-(p(6, 1), p(6, 2)), klr
End Sub
Sub bumpypoly (cx, cy, rr, shapedeg, turn, thk, klr As _Unsigned Long)
x = rr * Sin(0.01745329 * turn)
y = rr * Cos(0.01745329 * turn)
'Line (cx + x, cy + y)-(cx + x, cy + y), klr
lx = cx + x: ly = cy + y
For deg = turn To turn + 360 Step shapedeg
x2 = rr * Sin(0.01745329 * deg)
y2 = rr * Cos(0.01745329 * deg)
tv = (Rnd * 6 + Rnd * 6 + 3) / 10
bumpyline lx, ly, cx + x2, cy + y2, thk * tv, klr
lx = cx + x2: ly = cy + y2
Next
End Sub
Sub bumpylineLow (x0, y0, x1, y1, r, klr As _Unsigned Long)
dx = x1 - x0
dy = y1 - y0
yi = 1
If dy < 0 Then
yi = -1
dy = -dy
End If
'D = (2 * dy) - dx
d = (dy + dy) - dx
y = y0
For x = x0 To x1
tv = (Rnd * 12 + Rnd * 6 + 3) / 10
circleBF x, y, r * tv, klr
If d > 0 Then
y = y + yi
' D = D + (2 * (dy - dx))
d = d + ((dy - dx) + (dy - dx))
Else
' D = D + 2 * dy
d = d + dy + dy
End If
Next x
End Sub
Sub bumpylineHigh (x0, y0, x1, y1, r, klr As _Unsigned Long)
dx = x1 - x0
dy = y1 - y0
xi = 1
If dx < 0 Then
xi = -1
dx = -dx
End If
' D = (2 * dx) - dy
D = (dx + dx) - dy
x = x0
For y = y0 To y1
tv = (Rnd * 12 + Rnd * 6 + 3) / 10
circleBF x, y, r * tv, klr
If D > 0 Then
x = x + xi
' D = D + (2 * (dx - dy))
D = D + ((dx - dy) + (dx - dy))
Else
' D = D + 2 * dx
D = D + dx + dx
End If
Next y
End Sub
Sub bumpyline (x0, y0, x1, y1, r, klr As _Unsigned Long)
If Abs(y1 - y0) < Abs(x1 - x0) Then
If x0 > x1 Then
bumpylineLow x1, y1, x0, y0, r, klr
Else
bumpylineLow x0, y0, x1, y1, r, klr
End If
Else
If y0 > y1 Then
bumpylineHigh x1, y1, x0, y0, r, klr
Else
bumpylineHigh x0, y0, x1, y1, r, klr
End If
End If
End Sub
Sub circleBF (cx As Long, cy As Long, r As Long, klr As _Unsigned Long)
rsqrd = r * r
y = -r
While y <= r
x = Sqr(rsqrd - y * y)
Line (cx - x, cy + y)-(cx + x, cy + y), klr, BF
y = y + 1
Wend
End Sub
Is there a command that can identify two keys pressed together, like up-curor+left-cursor? and if so, how can I ensure that enough time is allowed for any slight discrepancy in the time they were pressed?
Android Nim is a version of the mathematical strategy game Nim programmed by Leo Christopherson for the TRS-80 computer in 1978. I programmed this version for the QB64 environment during the Covid-19 pandemic. Android Nim features real-time animation of the androids on a TRS-80.
The object of the game is to remove the last android from three rows of androids. The game's premise is simple, but its animation is impressive given the limitations of the TRS-80's display. Throughout the game androids are animated to face different directions, as if bored or engaging in conversation with one another.
The game starts with three rows of androids which contain 7, 5, and 3 androids respectively. An animated android asks the player if they would like to go first. The player chooses a row and types in how many droids to remove. An animated droid at the head of the row then nods its head and raises a gun and the other androids turn to look at the selected row. The specified number of androids are then zapped with a laser beam. It is then the computer's turn—with similar effect—and play continues until the last android is removed.
If the human wins, the computer is an amusingly poor sport and displays astonishment; if it wins, the computer displays a huge "I WIN!".
With this QB64 version I wanted to revive the screen and graphics of the TRS-80 computers.
Only the sound was not programmed.
Hopefully you like this version of Android Nim.
Soon there will be a new version of Android Nim, with sound and use of the mouse.
Below is the code, more than 1300 lines long. I hope the codepage and ASCII characters are copied correctly. If not, the source is also attached.
More of the original game at http://www.trs-80.org/android-nim
Code: (Select All)
$RESIZE:SMOOTH
DEFINT A-Z
DIM SHARED LucGev$, Belgium$, Version$, AndroidNim$, CURRENT_WORD$
'DIM SHARED TRUE, FALSE AS INTEGER
DIM SHARED AN_ANTENNE_00$, AN_ANTENNE_01$, AN_ANTENNE_L1$, AN_ANTENNE_L2$, AN_ANTENNE_R1$, AN_ANTENNE_R2$
DIM SHARED AN_HOOFD_01$, AN_HOOFD_02$, AN_HOOFD_03$, AN_HOOFD_04$, AN_HOOFD_05$, AN_HOOFD_06$
DIM SHARED AN_HOOFD_07$, AN_HOOFD_08$, AN_HOOFD_09$, AN_HOOFD_10$, AN_HOOFD_11$, AN_HOOFD_12$
DIM SHARED AN_HOOFD_13$, AN_HOOFD_14$, AN_HOOFD_15$, AN_HOOFD_16$, AN_HOOFD_17$, AN_HOOFD_18$
DIM SHARED AN_BODY_01$, AN_BODY_02$, AN_BODY_03$, AN_BODY_04$, AN_BODY_05$, AN_BODY_06$
DIM SHARED AN_BODY_07$, AN_BODY_08$, AN_BODY_09$, AN_BODY_10$, AN_BODY_11$, AN_BODY_12$
DIM SHARED AN_BODY_13$, AN_BODY_14$, AN_BODY_15$, AN_BODY_16$, AN_BODY_17$, AN_BODY_18$
DIM SHARED AN_BODY_19$, AN_BODY_20$, AN_BODY_21$, AN_BODY_22$, AN_BODY_23$, AN_BODY_24$
DIM SHARED AN_BODY_25$, AN_BODY_26$, AN_BODY_27$, AN_BODY_28$, AN_BODY_29$, AN_BODY_30$
DIM SHARED AN_BODY_31$, AN_BODY_32$, AN_BODY_33$, AN_BODY_34$
DIM SHARED AN_BENEN_01$, AN_BENEN_02$
DIM SHARED AIR(3) AS INTEGER 'Aantal in rij in getal
DIM SHARED BIR(3) AS STRING 'Aantal in rij binaire voorstelling
DIM SHARED KOL(3) AS STRING * 1 'E of O in de kolom.
DIM SHARED ALOC_KOL(3, 7) AS INTEGER 'locatie van de androids
DIM SHARED ALOC_RIJ(3) AS INTEGER 'de 3 rijen waar de androids starten
DIM SHARED SR, NR 'SelectROW, NR of Androids to shoot
DIM SHARED Wie 'Wie is aan de beurt; indien negatief dan is dit de winnaar. 1=MENS, 2=PC
DIM SHARED I_ColorScheme$(0 TO 10)
DIM SHARED H_ColorScheme AS INTEGER
DIM SHARED CHOSEN_WORDS(80)
DIM SHARED WORD$(80)
TYPE InitType
FullScreen AS INTEGER ' True of False
ColorScheme AS STRING ' TRS-80 Green|2|0|7
ForeColor AS INTEGER ' 2
BackColor AS INTEGER ' 0
AltForeColor AS INTEGER ' 7
AltShooter AS INTEGER '0
END TYPE
DIM SHARED INIT AS InitType
'Constants
CONST TRUE = -1
CONST FALSE = NOT TRUE
WORD_DATA:
DATA "DISGUSTING","STUPID","RIDICULOUS","IDIOTIC","GROTESQUE","ABSURD","NONSENSICAL","FARCICIAL","PREPOSTEROUS","SILLY","SENSELESS","IRRATIONAL","FANTASTIC"
DATA "ODD","RUDE","BRUTISH","BARBARIC","PLEBEIAN","UNCIVIL","DISCOURTEOUS","VULGAR","COARSE","GROSS","MONSTROUS","HORRID","SHOCKING","CHEAP"
DATA "INCONSIQUENTIAL","BULBOUS","DASTERDLY","MORONIC","IMMATURE","IMPOSSIBLE","ILLOGICAL","ELEPHANTINE","IRRESPONSIBLE","HUMANISTIC","DUMB-DUMB","RECKLESS"
DATA "NEGLIGENT","UNFEASIBLE","UNBEARABLE","INTOLERABLE","INSUFFERABLE","AWKWARD","OFFENSIVE","NAUGHTY","IMPROPER","UNCOUTH","ILL-MANNERED","LOUTISH","BOORISH"
DATA "BRASH","OUTLANDISH","TASTELESS","UNBEARABLE","INSUPPORTABLE","UNENDURABLE","UNSPEAKABLE","NEGLECTFUL","CARELESS","INATTENTIVE","SLIPSHOD","LAX","FORGETFUL"
DATA "UNINTELLIGENT","DIM-WITTED","BRAINLESS","OBTUSE","FOOLISH","IMPRUDENT","INJUDICIOUS","LAUGHABLE","TRADGIC","DISASTROUS","CATASTROPHIC","HEARTBREAKING","DREADFUL","APPALLING","WRETCHED"
VOLGENDE_ZET:
DO
COLOR INIT.ForeColor, INIT.BackColor: LOCATE 49, 60
IF Wie = 1 THEN
PRINT " * It's your turn *";
'clear input buffer
_KEYCLEAR
VRAAG_RIJ_KOL_2
ELSE
PRINT " * It's my turn *";
ANIMATE_SHOOTERS
ANIMATE_ANDROIDS
Bereken_Zet
END IF
IF SpelGedaan = 0 THEN
Wie = Wie * -1 'speler Wie heeft gewonnen
ELSEIF SpelGedaan <> 15 AND Wie <> -255 THEN 'bij 15 opgegeven, spel is herstart
Wie = Wie XOR 3
END IF
LOOP UNTIL Wie < 0
IF Wie = -1 THEN 'mens gewonnen
HUMAN_WIN
ELSEIF Wie = -2 THEN 'android nim gewonnen
I_WIN
END IF
IF Wie = -255 THEN 'spel gedaan
WIS_VELD
LOCATE 25, 30: PRINT "Thank you for playing Android Nim."
DO
x$ = INKEY$
ANIMATE_SHOOTERS
LOOP UNTIL x$ <> ""
WIDTH 80, 25: COLOR 7, 0: CLS: SYSTEM 0
ELSE 'opnieuw spelen
WIS_VELD
INIT_CONFIG
INIT_ANDROIDS
Plaats_Alle_Androids
GOTO VOLGENDE_ZET
END IF
'Convert_To_BIN
'WIDTH 80, 25: COLOR 7, 0: CLS: END
SYSTEM 1
SUB STARTSCHERM
'Init name and the rest
LucGev$ = "Luc Gevaert": Belgium$ = "Belgium": Version$ = "1.02": AndroidNim$ = "Android Nim"
x$ = LucGev$ + Belgium$ + AndroidNim$: som = 0 'som moet 2780 zijn om correct te zijn.
'check for zappers in the code.
FOR A = 1 TO LEN(x$)
som = som + ASC(MID$(x$, A, 1))
NEXT
IF som <> 2780 THEN
'please, no!
PRINT: PRINT "Please do not change the code. Thanks in advance.": PRINT "Press ANY key..."
x$ = INPUT$(1): SYSTEM 1
END IF
'screen in 80x50 fullscreen.
_TITLE AndroidNim$
SCREEN 0, 1, 0, 0: IF INIT.FullScreen = 1 THEN _FULLSCREEN _SQUAREPIXELS , _SMOOTH ELSE _FULLSCREEN _OFF
_BLINK OFF
_SCREENMOVE _MIDDLE
STARTSCHERM2:
COLOR INIT.ForeColor, INIT.BackColor: CLS
'teken startscherm
PRINT "ÛßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßÛ";
PRINT "Û Û";
PRINT "Û Û";
PRINT "Û Û Û Û";
PRINT "Û Û Û Û";
PRINT "Û ÛÛÛÛÛÛ ÜÛÛÛÛÛÜ ÜÛÛÛÛÛÜ ÛÛÛÛÛÛÜ ÛÛÛÛÛÛÜ ÜÛÛÛÛÛÜ ÞÛÛÝ ÛÛÛÛÛÛÜ Û";
PRINT "Û ÛÛ ÛÛ ÛÛ ÛÛÜÜÜÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ Û";
PRINT "Û ÛÛÛ ÛÛÛ ÛÛßßßÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛÛÛÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ Û";
PRINT "Û ÛÛÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛÛÛÛÛß ÛÛ ßÛÛ ßÛÛÛÛÛß ÞÛÛÝ ÛÛÛÛÛÛß Û";
PRINT "Û ÛÛÛÛÛÛÛÛ Û";
PRINT "Û ÛÛ ÛÛÛÛ ÛÛ Û";
PRINT "Û ÛÛ ÛÛÛÛ ÛÛ ÜÛÛÛÛÛÜ ÞÛÛÝ ÜÛÛÛÛÛÛÜ Û";
PRINT "Û ÛÛ ÛÛÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ Û";
PRINT "Û ÛÛÛ ÛÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ Û";
PRINT "Û Û Û ÛÛ ÛÛ ÞÛÛÝ ÛÛ ÛÛ ÛÛ Û";
PRINT "Û Û Û Û";
PRINT "Û ÛÛÛÛ ÛÛÛÛ Û";
PRINT "Û ";: COLOR INIT.AltForeColor: PRINT AndroidNim$; " - Version "; Version$; " - By "; LucGev$; SPACE$(10);: COLOR INIT.ForeColor: PRINT "Û";
PRINT "Û ";: COLOR INIT.AltForeColor: PRINT " Original by Leo Christopherson, 1979-1986";: COLOR INIT.ForeColor: PRINT " Û";
PRINT "Û Û";
PRINT "Û Û";
PRINT "Û Û";
PRINT "Û Û";
PRINT "ßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßß";
LOCATE 25, 1: PRINT "Press ";: COLOR INIT.BackColor, INIT.ForeColor: PRINT " ÄÄÙ ";: COLOR INIT.ForeColor, INIT.BackColor: PRINT " to start, ";
COLOR INIT.BackColor, INIT.ForeColor: PRINT " H ";: COLOR INIT.ForeColor, INIT.BackColor: PRINT " for Help, ";: COLOR INIT.BackColor, INIT.ForeColor
PRINT " I ";: COLOR INIT.ForeColor, INIT.BackColor: PRINT " for Info, ";
COLOR INIT.BackColor, INIT.ForeColor: PRINT " S ";: COLOR INIT.ForeColor, INIT.BackColor: PRINT " for Setup, ";: COLOR INIT.BackColor, INIT.ForeColor: PRINT " ESC ";
COLOR INIT.ForeColor, INIT.BackColor: PRINT " to exit";:
WHILE INKEY$ <> "": WEND 'Clear keyboard buffer
x$ = ""
STARTSCHERM1:
x$ = LCASE$(INKEY$)
IF x$ = CHR$(27) THEN 'end program
SCREEN 0, 1, 0, 0: _FULLSCREEN _OFF: COLOR 7, 0: CLS
SYSTEM 0
END IF
IF x$ = "s" THEN
INIT_SETUP
GOTO STARTSCHERM2
END IF
IF x$ = "i" THEN
START_INFO
GOTO STARTSCHERM2
END IF
IF x$ = "h" THEN
START_HELP
GOTO STARTSCHERM2
END IF
IF x$ <> CHR$(13) THEN GOTO STARTSCHERM1
ff = FREEFILE
IF _FILEEXISTS(FN$) THEN
OPEN FN$ FOR INPUT AS ff
IF NOT EOF(ff) THEN INPUT #ff, INIT.FullScreen
IF NOT EOF(ff) THEN INPUT #ff, INIT.ColorScheme
IF NOT EOF(ff) THEN INPUT #ff, INIT.ForeColor
IF NOT EOF(ff) THEN INPUT #ff, INIT.BackColor
IF NOT EOF(ff) THEN INPUT #ff, INIT.AltForeColor
IF NOT EOF(ff) THEN INPUT #ff, INIT.AltShooter
ELSE
OPEN FN$ FOR OUTPUT AS ff
PRINT #ff, INIT.FullScreen
PRINT #ff, INIT.ColorScheme
PRINT #ff, INIT.ForeColor
PRINT #ff, INIT.BackColor
PRINT #ff, INIT.AltForeColor
PRINT #ff, INIT.AltShooter
END IF
CLOSE ff
RESTORE WORD_DATA
FOR X = 1 TO 80
READ WORD$(X)
CHOSEN_WORDS(X) = 0
NEXT X
'bepaal de rij en kolommen van de androids
'elke android is 15 hoog + 2 spaties (=17), Startlocatie eerste android op rij 5
FOR a = 1 TO 3
ALOC_RIJ(a) = 17 * (a - 1) + 2
NEXT
'elke android is 6 breed + 4 spaties (=10), startlocatie rij 1 is 25
FOR a = 1 TO 7
ALOC_KOL(1, a) = 9 * (a - 1) + 17 '9 breed ipv 10
NEXT
FOR a = 1 TO 7
IF a < 6 THEN ALOC_KOL(2, a) = 10 * (a - 1) + 25 ELSE ALOC_KOL(2, a) = 0
NEXT
FOR a = 1 TO 7
IF a < 4 THEN ALOC_KOL(3, a) = 10 * (a - 1) + 33 ELSE ALOC_KOL(3, a) = 0
NEXT
'ALOC_KOL(rij,0) = locatie van de Chef.
ALOC_KOL(1, 0) = 5: ALOC_KOL(2, 0) = ALOC_KOL(1, 0) + 3: ALOC_KOL(3, 0) = ALOC_KOL(1, 0) + 1
'zet de Androids voor de eerste maal op 't scherm.
'Plaats_Alle_Androids
END SUB
SUB Convert_To_BIN
FOR A = 1 TO 3
number = AIR(A)
Binary$ = ""
DO
remain = ABS(number MOD 2) ' remainder is used to create binary number
number = number \ 2 ' move up one exponent of 2 with integer division
Bin$ = LTRIM$(STR$(remain)) ' make remainder a string number
Binary$ = Bin$ + Binary$ ' add remainder to binary number
LOOP UNTIL number = 0
BIR(A) = RIGHT$("00" + Binary$, 3)
NEXT
FOR k = 1 TO 3
number = 0
FOR r = 1 TO 3
number = number + VAL(MID$(BIR(r), k, 1))
NEXT
IF number AND NOT -2 THEN KOL(k) = "O" ELSE KOL(k) = "E"
NEXT
END SUB
FUNCTION SpelGedaan
SpelGedaan = AIR(1) + AIR(2) + AIR(3)
END FUNCTION
SUB Bereken_Zet
sw = 0
FOR r = 1 TO 3 '3 rijen androids
NR = 0: SR = 0 'nr of androids to shoot, select row
O_AIR = AIR(r) 'Bewaar vorige # androids in rij
FOR A = O_AIR - 1 TO 0 STEP -1
AIR(r) = A: sw = 1
Convert_To_BIN
IF KOL(1) + KOL(2) + KOL(3) = "EEE" THEN 'een gunstige situatie
NR = O_AIR - A: SR = r: AIR(r) = O_AIR - NR
'LOCATE 42, 60: PRINT "EEE => NR="; NR; " SR="; SR;
'_DELAY 4
EXIT FOR
END IF
NEXT
IF NR + SR = 0 THEN
AIR(r) = O_AIR
ELSE
EXIT FOR
END IF
NEXT
'''''IF NR + SR <> 0 THEN EXIT SUB
IF NR + SR <> 0 THEN GOTO BEREKEN_ZET_1
'niets gevonden. ofwel zijn er geen androids meer en is er een winnaar ofwel moet android nim zelf beslissen
'android nim beslist zelf. haal 1 weg van de beschikbare rij
IF SpelGedaan = 0 THEN EXIT SUB
RANDOMIZE TIMER
DO
SR = INT(RND * 3) + 1
LOOP UNTIL AIR(SR) <> 0
'SR = willekeurige rij waar androids staan
NR = INT(RND * AIR(SR)) + 1 'nr = willekeurig aantal androids
'LOCATE 41, 60: PRINT "GEEN EEE => NR="; NR; " SR="; SR;
'_DELAY 4
BEREKEN_ZET_1:
LOCATE ALOC_RIJ(SR) + 3, 1: COLOR INIT.BackColor, INIT.ForeColor: PRINT " ";
LOCATE ALOC_RIJ(SR) + 4, 1: PRINT STR$(SR); " ";
LOCATE ALOC_RIJ(SR) + 5, 1: PRINT " ";: COLOR INIT.ForeColor, INIT.BackColor
_DELAY 1
LOCATE ALOC_RIJ(SR) + 7, 1: COLOR INIT.BackColor, INIT.ForeColor: PRINT " ";
LOCATE ALOC_RIJ(SR) + 8, 1: PRINT STR$(NR); " ";
LOCATE ALOC_RIJ(SR) + 9, 1: PRINT " ";: COLOR INIT.ForeColor, INIT.BackColor
_DELAY 1
WIS_ANDROIDS
'IF sw = 0 THEN AIR(SR) = NR
Convert_To_BIN
END SUB
SUB VRAAG_RIJ_KOL_2
VRAAG_R_K_2:
'Vraag rij
DO
x$ = INKEY$
ANIMATE_SHOOTERS
ANIMATE_ANDROIDS
LOOP UNTIL x$ <> ""
IF x$ = "r" OR x$ = "R" THEN
WIS_VELD
INIT_CONFIG
INIT_ANDROIDS
Plaats_Alle_Androids
EXIT SUB
END IF
IF x$ = CHR$(27) THEN Wie = -255: EXIT SUB
SR = VAL(x$)
IF SR < 1 OR SR > 3 THEN GOTO VRAAG_R_K_2
IF AIR(SR) = 0 THEN
Knik_Nee
GOTO VRAAG_R_K_2
END IF
LOCATE ALOC_RIJ(SR) + 3, 1: COLOR INIT.BackColor, INIT.ForeColor: PRINT " ";
LOCATE ALOC_RIJ(SR) + 4, 1: PRINT STR$(SR); " ";
LOCATE ALOC_RIJ(SR) + 5, 1: PRINT " ";: COLOR INIT.ForeColor, INIT.BackColor
'Vraag aantal
VRAAG_R_K_3:
DO
x$ = INKEY$
ANIMATE_SHOOTERS
ANIMATE_ANDROIDS
LOOP UNTIL x$ <> ""
IF x$ = "r" OR x$ = "R" THEN
WIS_VELD
INIT_CONFIG
INIT_ANDROIDS
Plaats_Alle_Androids 'tijdelijk
EXIT SUB
END IF
IF x$ = CHR$(27) THEN Wie = -255: EXIT SUB
IF x$ = " " THEN
LOCATE ALOC_RIJ(SR) + 3, 1: COLOR INIT.ForeColor, INIT.BackColor: PRINT " ";
LOCATE ALOC_RIJ(SR) + 4, 1: PRINT " ";
LOCATE ALOC_RIJ(SR) + 5, 1: PRINT " ";
GOTO VRAAG_R_K_2
END IF
NR = VAL(x$)
IF NR < 1 OR NR > AIR(SR) THEN
Knik_Nee
GOTO VRAAG_R_K_2
END IF
LOCATE ALOC_RIJ(SR) + 7, 1: COLOR INIT.BackColor, INIT.ForeColor: PRINT " ";
LOCATE ALOC_RIJ(SR) + 8, 1: PRINT STR$(NR); " ";
LOCATE ALOC_RIJ(SR) + 9, 1: PRINT " ";: COLOR INIT.ForeColor, INIT.BackColor
WIS_ANDROIDS
'AIR(SR) = AIR(SR) - NR
Convert_To_BIN
END SUB
SUB Plaats_Alle_Androids
COLOR INIT.ForeColor, INIT.BackColor
CLS 'wis scherm
'Plaats de 3 chefs
IF INIT.AltShooter = 1 THEN COLOR INIT.AltForeColor, INIT.BackColor
FOR a = 1 TO 3
k = ALOC_KOL(a, 0)
LOCATE ALOC_RIJ(a), k: PRINT AN_ANTENNE_01$;
LOCATE ALOC_RIJ(a) + 1, k: PRINT AN_ANTENNE_01$;
LOCATE ALOC_RIJ(a) + 2, k: PRINT AN_HOOFD_01$;
LOCATE ALOC_RIJ(a) + 3, k: PRINT AN_HOOFD_02$;
LOCATE ALOC_RIJ(a) + 4, k: PRINT AN_HOOFD_03$;
LOCATE ALOC_RIJ(a) + 5, k: PRINT AN_HOOFD_04$;
LOCATE ALOC_RIJ(a) + 6, k: PRINT AN_BODY_01$;
LOCATE ALOC_RIJ(a) + 7, k: PRINT AN_BODY_06$;
LOCATE ALOC_RIJ(a) + 8, k: PRINT AN_BODY_03$;
LOCATE ALOC_RIJ(a) + 9, k: PRINT AN_BODY_04$;
LOCATE ALOC_RIJ(a) + 10, k: PRINT AN_BODY_05$;
LOCATE ALOC_RIJ(a) + 11, k: PRINT AN_BENEN_01$;
LOCATE ALOC_RIJ(a) + 12, k: PRINT AN_BENEN_01$;
LOCATE ALOC_RIJ(a) + 13, k: PRINT AN_BENEN_02$;
NEXT
COLOR INIT.ForeColor, INIT.BackColor
Wie = 0
LOCATE 25, 30: PRINT "First move by You (1) or Me (2) ?"
DO
x$ = INKEY$
ANIMATE_SHOOTERS
LOOP UNTIL x$ = "1" OR x$ = "2"
Wie = VAL(x$): LOCATE 25, 30: PRINT SPACE$(33);: LOCATE 25, 30
IF Wie = 1 THEN
PRINT "Very well, you may start !";
ELSE
PRINT "OK,I'll start !";
END IF
_DELAY 1.6
LOCATE 25, 30: PRINT SPACE$(33);
COLOR INIT.ForeColor, INIT.BackColor
FOR r = 1 TO 3
FOR k = 1 TO AIR(r)
l = ALOC_KOL(r, k)
LOCATE ALOC_RIJ(r), l: PRINT AN_ANTENNE_01$;
LOCATE ALOC_RIJ(r) + 1, l: PRINT AN_ANTENNE_01$;
LOCATE ALOC_RIJ(r) + 2, l: PRINT AN_HOOFD_01$;
LOCATE ALOC_RIJ(r) + 3, l: PRINT AN_HOOFD_02$;
LOCATE ALOC_RIJ(r) + 4, l: PRINT AN_HOOFD_03$;
LOCATE ALOC_RIJ(r) + 5, l: PRINT AN_HOOFD_04$;
LOCATE ALOC_RIJ(r) + 6, l: PRINT AN_BODY_01$;
LOCATE ALOC_RIJ(r) + 7, l: PRINT AN_BODY_02$;
LOCATE ALOC_RIJ(r) + 8, l: PRINT AN_BODY_03$;
LOCATE ALOC_RIJ(r) + 9, l: PRINT AN_BODY_04$;
LOCATE ALOC_RIJ(r) + 10, l: PRINT AN_BODY_05$;
LOCATE ALOC_RIJ(r) + 11, l: PRINT AN_BENEN_01$;
LOCATE ALOC_RIJ(r) + 12, l: PRINT AN_BENEN_01$;
LOCATE ALOC_RIJ(r) + 13, l: PRINT AN_BENEN_02$;
NEXT
NEXT
INIT_SETUP1:
IF INIT.FullScreen = 1 THEN _FULLSCREEN ELSE _FULLSCREEN _OFF 'Gaan we in Window of Full Screen?
COLOR INIT.ForeColor, INIT.BackColor: CLS
PRINT "ÛßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßÛ";
PRINT "Û Û";
PRINT "Û Û";
PRINT "Û Û Û ";: COLOR INIT.AltForeColor: PRINT AndroidNim$; " Setup";: PRINT SPACE$(38);: COLOR INIT.ForeColor: PRINT "Û";
PRINT "Û Û Û ";: COLOR INIT.AltForeColor: PRINT STRING$(48, "Ä");: COLOR INIT.ForeColor: PRINT " Û";
PRINT "Û ÛÛÛÛÛÛ Û";
PRINT "Û ÛÛ ÛÛ ÛÛ Fullscreen? Yes No Û";
PRINT "Û ÛÛÛ ÛÛÛ Û";
PRINT "Û ÛÛÛÛ Color Scheme: X Û";
PRINT "Û ÛÛÛÛÛÛÛÛ Û";
PRINT "Û ÛÛ ÛÛÛÛ ÛÛ Shooters: Normal Second Color Û";
PRINT "Û ÛÛ ÛÛÛÛ ÛÛ Û";
PRINT "Û ÛÛ ÛÛÛÛ ÛÛ ";: COLOR INIT.AltForeColor: PRINT STRING$(48, "Ä");: COLOR INIT.ForeColor: PRINT " Û";
PRINT "Û ÛÛÛ ÛÛÛ Û";
PRINT "Û Û Û Û";
PRINT "Û Û Û Û";
PRINT "Û ÛÛÛÛ ÛÛÛÛ Û";
PRINT "Û Û";
PRINT "Û Û";
PRINT "Û Û";
PRINT "Û Û";
PRINT "Û Û";
PRINT "ßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßß";
LOCATE 24, 1: PRINT " Use ";: COLOR INIT.BackColor, INIT.ForeColor: PRINT " ";: COLOR INIT.ForeColor, INIT.BackColor: PRINT " and ";
COLOR INIT.BackColor, INIT.ForeColor: PRINT " ";: COLOR INIT.ForeColor, INIT.BackColor: PRINT " to select - ";: COLOR INIT.BackColor, INIT.ForeColor
PRINT " SPACE ";: COLOR INIT.ForeColor, INIT.BackColor: PRINT " to change setting";
LOCATE 25, 1: PRINT " ";: COLOR INIT.BackColor, INIT.ForeColor: PRINT " ÄÄÙ ";: COLOR INIT.ForeColor, INIT.BackColor: PRINT " Return and use changes - ";
COLOR INIT.BackColor, INIT.ForeColor: PRINT " S ";: COLOR INIT.ForeColor, INIT.BackColor: PRINT " Save changes to disk - ";
COLOR INIT.BackColor, INIT.ForeColor: PRINT " Esc ";: COLOR INIT.ForeColor, INIT.BackColor: PRINT " Aborts";
LOCATE rijp, K - 20: COLOR INIT.AltForeColor, INIT.BackColor: PRINT "ÍÍ";
'*** Vul scherm aan met de waarden
IF INIT.FullScreen = 1 THEN
LOCATE rij, K: COLOR INIT.BackColor, INIT.ForeColor: PRINT " Yes ";: COLOR INIT.ForeColor, INIT.BackColor: PRINT " No ";
ELSE
LOCATE rij, K: COLOR INIT.ForeColor, INIT.BackColor: PRINT " Yes ";: COLOR INIT.BackColor, INIT.ForeColor: PRINT " No ";
END IF
a = INSTR(INIT.ColorScheme, "|")
IF a > 1 AND LEN(INIT.ColorScheme) > 7 THEN
x$ = LEFT$(INIT.ColorScheme, a - 1): IF LEN(x$) > 33 THEN x$ = LEFT$(x$, 33)
LOCATE rij + 2, K: COLOR INIT.BackColor, INIT.ForeColor: PRINT " "; x$; " ";
ELSE
LOCATE rij + 2, K: COLOR INIT.ForeColor, INIT.BackColor: PRINT " *Error* ";
END IF
IF INIT.AltShooter = 0 THEN
LOCATE rij + 4, K: COLOR INIT.BackColor, INIT.ForeColor: PRINT " Normal ";: COLOR INIT.ForeColor, INIT.BackColor: PRINT " Second Color ";
ELSE
LOCATE rij + 4, K: COLOR INIT.ForeColor, INIT.BackColor: PRINT " Normal ";: COLOR INIT.BackColor, INIT.ForeColor: PRINT " Second Color ";
END IF
init_setup2:
DO: x$ = INKEY$: LOOP UNTIL x$ <> ""
'ESC = terugplaatsen van de waarden en uit init gaan
IF x$ = CHR$(27) THEN
INIT.FullScreen = O_FS
INIT.ColorScheme = O_CS$
INIT.ForeColor = O_FC
INIT.BackColor = O_BC
INIT.AltForeColor = O_AC
INIT.AltShooter = O_AS
EXIT SUB
END IF
'ENTER = gewoon terug gaan
IF x$ = CHR$(13) THEN EXIT SUB
'Save
IF x$ = "S" OR x$ = "s" THEN
FN$ = "AndroidNim.CFG"
ff = FREEFILE
OPEN FN$ FOR OUTPUT AS ff
PRINT #ff, INIT.FullScreen
PRINT #ff, INIT.ColorScheme
PRINT #ff, INIT.ForeColor
PRINT #ff, INIT.BackColor
PRINT #ff, INIT.AltForeColor
PRINT #ff, INIT.AltShooter
CLOSE ff
EXIT SUB
END IF
LOCATE rijp, K - 20: COLOR INIT.AltForeColor, INIT.BackColor: PRINT " ";
IF x$ = CHR$(0) + CHR$(80) THEN 'pijn beneden
rijp = rijp + 2: IF rijp = 13 THEN rijp = rij
END IF
IF x$ = CHR$(0) + CHR$(72) THEN 'pijl boven
rijp = rijp - 2: IF rijp = rij - 2 THEN rijp = 11
END IF
LOCATE rijp, K - 20: COLOR INIT.AltForeColor, INIT.BackColor: PRINT "ÍÍ";
IF x$ = " " THEN 'spatiebalk
SELECT CASE rijp
CASE 7 'fullscreen
IF INIT.FullScreen = 0 THEN INIT.FullScreen = 1 ELSE INIT.FullScreen = 0
CASE 9 'color scheme
H_ColorScheme = H_ColorScheme + 1: IF H_ColorScheme = 11 THEN H_ColorScheme = 1
INIT.ColorScheme = I_ColorScheme$(H_ColorScheme)
a = INSTR(INIT.ColorScheme, "|") + 1
INIT.ForeColor = VAL(MID$(INIT.ColorScheme, a, 2))
INIT.BackColor = VAL(MID$(INIT.ColorScheme, a + 3, 2))
INIT.AltForeColor = VAL(MID$(INIT.ColorScheme, a + 6, 2))
CASE 11 'Shooters
IF INIT.AltShooter = 0 THEN INIT.AltShooter = 1 ELSE INIT.AltShooter = 0
END SELECT
GOTO INIT_SETUP1
END IF
GOTO init_setup2
END SUB
SUB START_INFO
CLS
PRINT "ÛßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßÛ";
PRINT "Û Android Nim was originally programmed by Leo Christopherson Û";
PRINT "Û on the TRS-80 model 1, 3 and 4. This version of Android Nim Û";
PRINT "Û Û Û was reprogrammed in the Windows environment by Luc Gevaert. Û";
PRINT "Û Û Û This program is programmed completely in text mode. Û";
PRINT "Û ÛÛÛÛÛÛ Û";
PRINT "Û ÛÛ ÛÛ ÛÛ Android Nim was Leo Christopherson's first game for the Û";
PRINT "Û ÛÛÛ ÛÛÛ TRS-80. It was featured on the cover of 80-Northwest Journal Û";
PRINT "Û ÛÛÛÛ (later 80-U.S. Journal) in November 1978 and was released by Û";
PRINT "Û ÛÛÛÛÛÛÛÛ 80-NW Publishing (later 80-U.S. Software). The cost was $8.00 Û";
PRINT "Û ÛÛ ÛÛÛÛ ÛÛ for cassette and $13.00 for disk, with a $2.00 discount for Û";
PRINT "Û ÛÛ ÛÛÛÛ ÛÛ 80-Northwest Journal subscribers. This great game helped to Û";
PRINT "Û ÛÛ ÛÛÛÛ ÛÛ popularize the magazine, and 80-U.S. Journal used an android Û";
PRINT "Û ÛÛÛ ÛÛÛ for its mascot until 1981. Û";
PRINT "Û Û Û Soon after the original release, Leo Christopherson enhanced Û";
PRINT "Û Û Û Android Nim with sound and more animation, developing the Û";
PRINT "Û ÛÛÛÛ ÛÛÛÛ techniques known as 'string-packing' and 'line-packing' in Û";
PRINT "Û the process. The enhanced version of Android Nim cost $14.95. Û";
PRINT "Û Like all of Leo Christopherson's TRS-80 games, Android Nim Û";
PRINT "Û was written in combination of BASIC and machine language. Û";
PRINT "Û Û";
PRINT "Û Û";
PRINT "Û Û";
PRINT "ßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßß";
LOCATE 22, 18: COLOR INIT.AltForeColor: PRINT AndroidNim$; ", version "; Version$; " by "; LucGev$; ", "; Belgium$;
LOCATE 25, 1: COLOR INIT.ForeColor: PRINT "Press ANY key to return...";
DO UNTIL INKEY$ <> "": LOOP
END SUB
SUB START_HELP
CLS
PRINT "ÛßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßÛ";
PRINT "Û Û";
PRINT "Û ÜÛÛÛÛÛÜ ÜÛÛÛÛÛÜ ÛÛÛÛÛÛÜ ÛÛÛÛÛÛÜ ÜÛÛÛÛÛÜ ÛÛÛÛ ÛÛÛÛÛÛÜ Û";
PRINT "Û Û Û ÛÛÜÜÜÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ Û";
PRINT "Û Û Û ÛÛßßßÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛÛÛÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ Û";
PRINT "Û ÛÛÛÛÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛÛÛÛÛß ÛÛ ßÛÛ ßÛÛÛÛÛß ÛÛÛÛ ÛÛÛÛÛÛß Û";
PRINT "Û ÛÛ ÛÛ ÛÛ Û";
PRINT "Û ÛÛÛ ÛÛÛ ÜÛÛÛÛÛÜ ÛÛÛÛ ÜÛÛÛÛÛÛÜ Û";
PRINT "Û ÛÛÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ Û";
PRINT "Û ÛÛÛÛÛÛÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ Û";
PRINT "Û ÛÛ ÛÛÛÛ ÛÛ ÛÛ ÛÛ ÛÛÛÛ ÛÛ ÛÛ ÛÛ Û";
PRINT "Û ÛÛ ÛÛÛÛ ÛÛ Û";
PRINT "Û ÛÛ ÛÛÛÛ ÛÛ At the bottom right you see whose turn it is. Then press Û";
PRINT "Û ÛÛÛ ÛÛÛ the number '";: COLOR INIT.AltForeColor: PRINT "1";:: COLOR INIT.ForeColor: PRINT "', '";
COLOR INIT.AltForeColor: PRINT "2";: COLOR INIT.ForeColor: PRINT "' or '";: COLOR INIT.AltForeColor: PRINT "3";: COLOR INIT.ForeColor: PRINT "', of the row you wish to remove Û";
PRINT "Û Û Û Androids from. Û";
PRINT "Û Û Û If you change your mind, press the '";: COLOR INIT.AltForeColor:: PRINT "Spacebar";: COLOR INIT.ForeColor: PRINT "', it erases. Û";
PRINT "Û ÛÛÛÛ ÛÛÛÛ If you wish to give up, press the '";: COLOR INIT.AltForeColor: PRINT "R";: COLOR INIT.ForeColor: PRINT "' key. Û";
PRINT "Û After you choose the row, press the number of Androids Û";
PRINT "Û you wish to remove. Û";
PRINT "Û ";: COLOR INIT.AltForeColor: PRINT "Rules:";: COLOR INIT.ForeColor: PRINT " you may remove as many Androids as you wish from Û";
PRINT "Û any row when it's your turn. To win, you must remove Û";
PRINT "Û the last Android. Û";
PRINT "Û Û";
PRINT "ßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßß";
LOCATE 25, 1: PRINT "Press ANY key to return...";
DO UNTIL INKEY$ <> "": LOOP
SUB WIS_VELD
COLOR INIT.ForeColor, INIT.BackColor
FOR a = 2 TO 49
LOCATE a, 14
PRINT SPACE$(65);
NEXT
END SUB
SUB I_WIN
_DELAY 1
WIS_VELD
LOCATE 22, 30: PRINT "ÞÛÛÝ ÛÛ ÛÛ ÛÛ ÞÛÛÝ ÜÛÛÛÛÛÜ";
LOCATE 23, 30: PRINT " ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ";
LOCATE 24, 30: PRINT " ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ";
LOCATE 25, 30: PRINT "ÞÛÛÝ ßÛÛÛÛÛÛß ÞÛÛÝ ÛÛ ÛÛ";
LOCATE 28, 29: PRINT "Another game? Press ";
COLOR INIT.BackColor, INIT.ForeColor: PRINT " Y ";: COLOR INIT.ForeColor, INIT.BackColor: PRINT " or ";
COLOR INIT.BackColor, INIT.ForeColor: PRINT " N ";: COLOR INIT.ForeColor, INIT.BackColor
DO
x$ = LCASE$(INKEY$)
ANIMATE_SHOOTERS
LOOP UNTIL x$ = "y" OR x$ = "n"
IF x$ = "n" THEN Wie = -255 ELSE Wie = 0
END SUB
SUB HUMAN_WIN
_DELAY 1
WIS_VELD
LOCATE 22, 30: PRINT "Through Some Amazingly Graceful"
LOCATE 24, 30: PRINT "but"
LOCATE 26, 30: PRINT "Personal Miscalculation,"
LOCATE 28, 36: PRINT "YOU WIN !?"
COLOR INIT.AltForeColor, INIT.BackColor
FOR x = 1 TO 10
CHOOSE_WORD:
W = INT(RND * 80) + 1
IF CHOSEN_WORDS(W) = 1 THEN GOTO CHOOSE_WORD
CHOSEN_WORDS(W) = 1
CURRENT_WORD$ = WORD$(W)
LOCATE 24, 34: PRINT SPACE$(20);
LOCATE 24, 34: PRINT CURRENT_WORD$;
_DELAY (RND * 0.7) + 1
ANIMATE_SHOOTERS
NEXT
LOCATE 30, 30: PRINT "Another game? Press ";
COLOR INIT.BackColor, INIT.ForeColor: PRINT " Y ";: COLOR INIT.ForeColor, INIT.BackColor: PRINT " or ";
COLOR INIT.BackColor, INIT.ForeColor: PRINT " N ";: COLOR INIT.ForeColor, INIT.BackColor
DO
x$ = LCASE$(INKEY$)
ANIMATE_SHOOTERS
LOOP UNTIL x$ = "y" OR x$ = "n"
IF x$ = "n" THEN Wie = -255 ELSE Wie = 0
This does work but its use of registers I don't like.
Has there been a command introduced that reports the current screen mode? I didn't know about the _HYPOT, _D2R, and _R2D statements until recently so perhaps something I need has been added and I'm just having trouble finding it?
