shmup.bas.txt

#program shmup
#autoline 10, 10
; NextBASIC Shmup!
RUN AT 3
PROC main()
;
DEFPROC playGame()
LOCAL %i, %c, %l, %f, %d
LET %s=0: LET %c=7: LET %l=0: LET %f=4: LET %d=0: LET %e=30: LET %h=20
LET %a=0: LET %u=0: LET %b=0: LET %v=0
REPEAT
SPRITE MOVE
; Checking kills
FOR %i=49 TO 56
IF %(SPRITE i) THEN LET %k=% SPRITE OVER (i,4 TO 30,4): IF %k THEN PROC kill(%k,%i)
IF %(SPRITE i) THEN LET %k=% SPRITE OVER (i,0 TO 3,7,7): IF %k THEN PROC damageBoss(%i)
NEXT %i
; Checking impact on player
IF %p(0)=1 THEN LET %k=% SPRITE OVER (48,0 TO 47,4,2): IF %k THEN PROC die(%k)
; Player movement FSM
IF %p(0) THEN PROC fInput() TO %i: ELSE LET %i=9: LET %s=0: LET %c=2
IF %(i=1) THEN IF %(s<>1) THEN PROC moveShip(%4,%0,%5,%p(0),%1)
IF %(i=2) THEN IF %(s<>2) THEN PROC moveShip(%-4,%0,%5,%p(0)+8,%2)
IF %(i=3) THEN IF %(s<>3) THEN PROC moveShip(%0,%-4,%4,%p(0),%3)
IF %(i=4) THEN IF %(s<>4) THEN PROC moveShip(%0,%4,%4,%p(0),%4)
IF %(i=5) THEN IF %(s<>5) THEN PROC moveShip(%3,%-3,%5,%p(0),%5)
IF %(i=6) THEN IF %(s<>6) THEN PROC moveShip(%3,%3,%5,%p(0),%6)
IF %(i=7) THEN IF %(s<>7) THEN PROC moveShip(%-3,%-3,%5,%p(0)+8,%7)
IF %(i=8) THEN IF %(s<>8) THEN PROC moveShip(%-3,%3,%5,%p(0)+8,%8)
IF %(i=0) THEN IF %(s<>0) THEN PROC stopShip()
; Firing weapon
IF %c>0 THEN %c=%c-1
IF %(c=0) THEN IF %( IN k(0)&k(1)=k(2)) THEN PROC shoot() TO %c
; Boss behaviour
IF %o(0)>0 THEN IF %o(0)<3 THEN IF % SPRITE CONTINUE 0=1 THEN PROC moveBoss()
IF %o(0)=3 THEN LET %o(2)=%o(2)-1: IF %o(2)=0 THEN PROC bossFire()
; Spawn enemies
LET %e=%e-1
IF %e=0 THEN PROC wave()
LET %h=%h-1
IF %h=0 THEN PROC enemyfire() TO %h
; Remove player invulnerability
IF %p(0)=241 THEN LET %p(3)=%p(3)-1: IF %p(3)=0 THEN PROC vulnerable()
; Verify if player can respawn... or show game over
IF %p(0)=0 THEN LET %p(3)=%p(3)-1: IF %p(3)=0 THEN PROC respawnShip() TO %d
; Scroll background
LET %f=%f-1
IF %f=0 THEN PROC scroll(%l) TO %l: LET %f=4
; Play buffered sounds
PROC playSounds()
; Reached Ending
IF %p(4) > 18 THEN IF %o(0)=0 THEN LET %d=2
REPEAT UNTIL %d
PROC psg(7, 255) : LET %m=23
IF %d=2 THEN PROC ending(): ELSE PRINT AT 11,11; INVERSE 1;" GAME OVER "
FOR %i=0 TO 63: PAUSE 1: NEXT %i: PROC scroll(1)
ENDPROC
;
DEFPROC unusedSpr(%l,%u)
LET %u=%u+1: ; Upper included in range
REPEAT : WHILE %(SPRITE l) : LET %l=%l+1 : REPEAT UNTIL %l=u
ENDPROC =%l
;
DEFPROC psg(%r,%v)
OUT 65533,%r: OUT 49149,%v
ENDPROC
; resolving SOCD to neutral
DEFPROC fInput()
LOCAL %r,%l,%u,%d
LET %r=%(IN k(3)&k(4)=k(5))
LET %l=%(IN k(6)&k(7)=k(8))
LET %u=%(IN k(9)&k(10)=k(11))
LET %d=%(IN k(12)&k(13)=k(14))
IF %(r&l) THEN LET %r=%0: LET %l=%0
IF %(u&d) THEN LET %u=%0: LET %d=%0
IF %(u&r) THEN ENDPROC =%5
IF %(d&r) THEN ENDPROC =%6
IF %(u&l) THEN ENDPROC =%7
IF %(d&l) THEN ENDPROC =%8
IF %r THEN ENDPROC =%1
IF %l THEN ENDPROC =%2
IF %u THEN ENDPROC =%3
IF %d THEN ENDPROC =%4
ENDPROC =%0
;
DEFPROC wave()
LOCAL %n,%i,%t,%x,%y
IF %p(4) MOD 5=0 THEN IF %o(0)=0 THEN PROC spawnBoss(): ENDPROC
READ %n, %e
; PRINT AT 1,0;"n=";%n;" e=";%e;"   "'"                             "
IF %(n=0) THEN IF %(e=0) THEN RESTORE: LET %p(4)=%p(4)+1: LET %e=40: ENDPROC
FOR %i=1 TO %n
READ %t, %x, %y
; PRINT AT 2,0;"t=";%t;" x=";%x;" y=";%y;"  "
PROC spawn(%t, %x, %y)
NEXT %i
READ %n
IF %n THEN RESTORE : LET %e=40: ; Abnormal DATA, does not add to wave cycles (%p(4))
ENDPROC
;
DEFPROC spawn(%t, %x, %y)
LOCAL %s,%u,%v,%m,%a
; Select which alien to spawn
LET %m= RND
IF %m=0 THEN LET %m=12: ELSE LET %m=14
PROC unusedSpr(4,30) TO %s
IF %s=31 THEN ENDPROC
SPRITE %s,%x,%y,%m,1
IF %t=1 THEN LET %u=0: LET %v=2
IF %t=2 THEN LET %u=2: LET %v=0
IF %t=3 THEN LET %u=-2: LET %v=0
IF %t=4 THEN LET %u=2: LET %v=2
IF %t=5 THEN LET %u=-2: LET %v=2
SPRITE CONTINUE %s, 16 TO 288 STEP % SGN {u} RUN, 16 TO 223 STEP % SGN {v} RUN, %m TO %m+1, BIN 11,0
ENDPROC
;
DEFPROC shoot()
LOCAL %l
; Find an unused player shot/laser sprite
PROC unusedSpr(49,56) TO %l
IF %l=57 THEN ENDPROC =%2
; Start shot from player position
SPRITE %l,% SPRITE AT (48,0),% SPRITE AT (48,1)-7,%16,%1
SPRITE CONTINUE %l,STOP,%18 TO 190 STEP -8 RUN,%16,% BIN 11
PROC addA(9): PROC addA(15): PROC addA(21)
PROC addA(27): PROC addA(30)
ENDPROC =%7
;
DEFPROC kill(%k,%s)
LOCAL %x,%y,%e
LET %x=% SPRITE AT (k,0): LET %y=% SPRITE AT (k,1)
; This will get a lot more complex...
SPRITE %s,,,,0: SPRITE %k,,,,0
LET %p(2)=%p(2)+1: ; Score up
PROC unusedSpr(60,75) TO %e
IF %e=76 THEN ENDPROC
SPRITE %e,%x,%y,6,1: ; Explosion
SPRITE CONTINUE %e,STOP,STOP, 6 TO 11, BIN 1100000
PROC addB(240,1,0): PROC addB(243,2,1): PROC addB(246,3,1)
PROC addB(249,4,1): PROC addB(252,5,0)
ENDPROC
;
DEFPROC enemyfire()
LOCAL %l, %e, %r
; Find an unused enemy shot sprite
PROC unusedSpr(31,47) TO %l
IF %l=48 THEN ENDPROC =%12
; Find an enemy who will shoot
LET %r=20: ; Attempts to find an enemy
REPEAT
LET %e=%RND 26 +4
IF % (SPRITE e) THEN LET %r=0: ELSE LET %r=%r-1
REPEAT UNTIL %r<2
IF %r=1 THEN ENDPROC =%6: ; No enemy found
; Start shot from enemy position
SPRITE %l,% SPRITE AT (e,0),% SPRITE AT (e,1)+7,%17,%1
SPRITE CONTINUE %l, STOP, %22 TO 223 STEP 4 RUN, %17, % BIN 11
PROC addB(9,1,0): PROC addB(15,2,1): PROC addB(21,3,1)
PROC addB(27,4,1): PROC addB(30,5,0)
ENDPROC =%20
;
DEFPROC die(%k)
LOCAL %x,%y
IF %(k>30) THEN IF %(k<>128) THEN SPRITE %k,,,,0: ; shots disappear
LET %x=% SPRITE AT (48,0): LET %y=% SPRITE AT (48,1)
SPRITE 48,,,,0
SPRITE 127,%x,%y,6,1: ; Explosion
SPRITE CONTINUE 127,STOP,STOP, 6 TO 11, BIN 1100000
PROC addB(240,1,0): PROC addB(243,2,1): PROC addB(246,3,1)
PROC addB(249,4,1): PROC addB(252,5,0)
; apply "dead state"
LET %p(0)=0: LET %p(3)=25
LET %e=%e+30: ; delay next wave of enemies
ENDPROC
;
DEFPROC respawnShip()
LET %p(1)=%p(1)-1
IF %p(1)=65535 THEN ENDPROC =%1
LET %p(0)=241: LET %p(3)=25: ; Invulnerable for 25 SPRITE MOVEs
PRINT #1; AT 1,31;%p(1): ; Update lives
SPRITE 48,150,160,4,241
ENDPROC =%0
;
DEFPROC vulnerable()
LET %p(0)=1
SPRITE 48,,,,1
ENDPROC
;
DEFPROC addA(%s)
IF %u=63 THEN LET %u=0: ELSE LET %u=%u+1
LET %a(u)=%s
ENDPROC
;
DEFPROC addB(%s, %c, %n)
IF %v=63 THEN LET %v=0: ELSE LET %v=%v+1
LET %b(v)=%s: LET %c(v)=%c: LET %n(v)=%n
ENDPROC
;
DEFPROC playSounds()
LOCAL %x, %y, %z, %w: ; x=AC y=B z=noise
; as PSG mixer, 1 = disabled, 0 = enabled
LET %x=%(a=u): LET %y=%(b=v):; disabled if empty queue
IF %y THEN LET %z=1: ELSE LET %z=%1-n(b): ; Invert %n(b)
LET %w=%(16*z)+(5*x)+(2*y): ; needed mixer settings
IF %(m<>w) THEN PROC psg(7, %232+w): LET %m=%w
IF %NOT x THEN PROC playA()
IF %NOT y THEN PROC playB()
ENDPROC
;
DEFPROC playA()
IF %a=63 THEN LET %a=0: ELSE LET %a=%a+1
PROC psg(0,%a(a)): ; ch A fine tone
PROC psg(4,%a(a)): ; ch C fine tone
ENDPROC
;
DEFPROC playB()
IF %b=63 THEN LET %b=0: ELSE LET %b=%b+1
PROC psg(3,%c(b)): ; ch B coarse tone
PROC psg(2,%b(b)): ; ch B fine tone
ENDPROC
;
DEFPROC moveShip(%x,%y,%p,%f,%n)
SPRITE 48,,,%p,%f
SPRITE CONTINUE 48, STEP % SGN {x} RUN , STEP % SGN {y} RUN ,%p
LET %s=%n
ENDPROC
;
DEFPROC stopShip()
SPRITE 48,,,4,%p(0)
SPRITE PAUSE 48
LET %s=0
ENDPROC
;
DEFPROC scroll(%p)
LET %p=%p-1
IF %p=65535 THEN LET %p=191
LAYER 2,1: LAYER AT %0,%p: LAYER 0
PRINT #1; AT 1,7;%p(2);"0": ; Update score
ENDPROC =%p
;
DEFPROC spawnBoss()
LET %e=140: LET %p(4)=%p(4)+1: LET %o(0)=1: LET %o(1)=12: LET %o(2)=% RND 9+1
SPRITE %0,%126,%0,%0,% BIN 0001,% BIN 001,%1,%1
SPRITE -1,16,0,%0,% BIN 1001,% BIN 110
SPRITE -2,0,-16,%2,%1,% BIN 110
SPRITE -3,16,-16,%2,% BIN 1001,% BIN 110
SPRITE CONTINUE %0, STOP, %58 TO %206 STEP %2 RUN, %0 TO %1, %BIN 10
ENDPROC
;
DEFPROC damageBoss(%s)
LOCAL %x,%y
SPRITE %s,,,,0: LET %o(1)=%o(1)-1
IF %o(1)>0 THEN LET %p(2)=%p(2)+1: ENDPROC
LET %x=% SPRITE AT (0,0): LET %y=% SPRITE AT (0,1)-34
SPRITE 0,,,,0: LET %p(2)=%p(2)+4: LET %o(0)=0
SPRITE 126,%x,%y,6,1,0,2,2:SPRITE CONTINUE 126,STOP,STOP,6 TO 11,96
PROC addB(240,1,0):PROC addB(243,2,1):PROC addB(246,3,1)
PROC addB(249,4,1):PROC addB(252,5,0)
ENDPROC
;
DEFPROC bossFire()
LOCAL %l
PROC unusedSpr(31,47) TO %l
IF %l=48 THEN LET %o(2)=10: ENDPROC
LET %o(2)=20
SPRITE %l,% SPRITE AT (0,0)+24,% SPRITE AT (0,1)+10,%18,%1
SPRITE CONTINUE %l,STOP,22 TO 223 STEP 4 RUN,%18,%3
PROC addB(9,1,0): PROC addB(15,2,1): PROC addB(21,3,1)
PROC addB(27,4,1): PROC addB(30,5,0)
ENDPROC
;
DEFPROC moveBoss()
LET %o(0)=%o(0)+1
IF %o(0)=2 THEN SPRITE CONTINUE 0,STOP,58 TO 206 STEP -4 RUN,,2
IF %o(0)=3 THEN SPRITE CONTINUE 0,20 TO 236 STEP -4 RUN,STOP,,0
ENDPROC
;
DEFPROC ending()
PRINT AT 8,7; INVERSE 1; " Congratulations "; AT 10,2; INVERSE 0;"You have defeated the alien"; AT 11,2;"menace and saved the galaxy"
RUN AT 0: PLAY "T180O6(CDEC)": RUN AT 3
PROC initSounds()
FOR %i=0 TO 150: PAUSE 1: NEXT %i
ENDPROC
;
DEFPROC initGame()
LAYER 2,1: SPRITE PRINT 1
LAYER OVER 6: LAYER 0: CLS
LET %p(0)=1:LET %p(1)=2:LET %p(2)=0:LET %p(4)=1:LET %o(0)=0
; Player Spaceship
SPRITE 48,150,160,4,1
SPRITE CONTINUE 48,32 TO 272 STOP,32 TO 208 STOP,4,BIN 10,0: ; player behaviour
PRINT #1; INK 6; AT 1,0;"Score"; AT 1,25;"Lives"; INK 7; AT 1,31;%p(1): ; display lives
RESTORE
ENDPROC
;
DEFPROC initSounds()
PROC psg(7,255): LET %m=23:; mixer
PROC psg(6,20): PROC psg(9,15): ; noise & ch B
PROC psg(8,13): PROC psg(10,13):; ch A & C
ENDPROC
;
DEFPROC main()
LOCAL %c
PAPER 0: INK 7: BORDER 0
LAYER CLEAR : PALETTE CLEAR
LAYER 2,0: PALETTE DIM 9
LOAD "assets/shmup_bg.sl2" LAYER
LOAD "assets/shmup_bg.pal" BANK 12
LAYER PALETTE 0 BANK 12,0
LAYER PALETTE 0: BANK 12 CLEAR
LOAD "assets/shmup.spr" BANK 12
SPRITE BANK 12: SPRITE STOP
PROC initSounds()
REPEAT
LET %c=0: LAYER 2,0: SPRITE CLEAR
LAYER OVER 0 : LAYER 0: CLS
POKE 23658,0: ; turn off CAPS LOCK
PRINT AT 3,6; INK 2; FLASH 1;" NextBASIC Shmup! "
PRINT AT 6,0;"Control options:"
PRINT AT 8,5;"Keyboard"; AT 9,6;"* Space + Q A O P"; AT 10,6;"* Symbol Shift + Arrows"
PRINT AT 12,5;"Kempston joystick"
PRINT AT 15,2; INK 5;"Press "; INVERSE 1;"FIRE"; INVERSE 0;" in your preferred"' TAB 4;"control option to start"
REPEAT
IF %(IN 32766&1=0) THEN PROC setInput(0): LET %c=1
IF %(IN 32766&2=0) THEN PROC setInput(1): LET %c=1
IF %(IN 31&16=16) THEN PROC setInput(2): LET %c=1
REPEAT UNTIL %c=1
PROC initGame()
PROC playGame()
REPEAT UNTIL 0
ENDPROC
;
DEFPROC setInput(%l)
LOCAL %i
RESTORE %9990+l
FOR %i=0 TO 14
READ %k(i)
NEXT %i
ENDPROC
;
; Data for enemy waves
DATA 2,40,1,130,0,1,170,0,0
DATA 2,40,2,16,32,3,288,48,0
DATA 2,30,4,16,16,5,288,0,0
; Obligatory ending to reset data and start again
DATA 0,0,0
STOP
#autoline
9990 DATA 32766,1,0,57342,1,0,57342,2,0,64510,1,0,65022,1,0: ; Keys - QAOP Sp
9991 DATA 32766,2,0,61438,4,0,63486,16,0,61438,8,0,61438,16,0: ; Keys - cursor SS
9992 DATA 31,16,16,31,1,1,31,2,2,31,8,8,31,4,4: ; Kempston
9999 CLEAR : SAVE "shmup.bas": .bas2txt shmup.bas