PK-WARS for SMILEBASIC ver2.0

PKWARS.BAS

'PK-WARS @en45masao
' First release: 2012-03-31
' Last updated:  2012-04-07

'Initialization
ACLS:PNLTYPE "OFF":GPAGE 1
VISIBLE 0,0,0,0,0,0
BGMSTOP

CLEAR
CHMAX=50
DIM X(CHMAX),Y(CHMAX)
DIM VX(CHMAX),VY(CHMAX)
DIM SC(2),FHIT(2)

'Constants
STMAX=1
EW=0.9:EB=1:ES=0.8
RM=4:RS=2
MVY=2:SVX=3
WLX=8:WRX=248:WTY=8:WBY=184
CWAIT=15

CHURRY=60*15
ESBASE=1

PDISP=0
COMLV=1
ROUND=0

'Set sprites for my ships
FOR I=0 TO 1:SID=48+I
SPSET SID,176,2,1-I,0,1
SPHOME SID,8,8
SPCOL SID,-RM,-RM,RM*2,RM*2,TRUE,&H4
SPANIM SID,2,4
SPSETV SID,0,0
SPSETV SID,1,RM
NEXT I

'Set sprites for shots
FOR I=0 TO 15:SID=32+I
SPSET SID,40,2-FLOOR(I/8),I/8,0,1
SPHOME SID,8,8
SPCOL SID,-RS,-RS,RS*2,RS*2,TRUE,&H3
SPANIM SID,2,2
SPSETV SID,0,3
SPSETV SID,1,RS
SPSETV SID,2,ES
SPSETV SID,3,0
NEXT I

'Set sprites for effects
FOR I=0 TO 15:SID=I
SPSET SID,249,4+I%4,I/4 AND 1,I/8 AND 1,1
SPHOME SID,8,8
SPANIM SID,2,6
NEXT I

'Set sprites for balls (dummy)
FOR I=0 TO 15:SID=16+I
SPSET SID,0,0,0,0,0
NEXT I

'Erase all
FOR SID=0 TO 49:GOSUB @CLEAR_OBJ:NEXT SID

'Draw BG
FOR I=0 TO 255
BGPUT 1,RND(64),RND(64),859+32*RND(2),0,RND(2),RND(2)
NEXT I
BGFILL 0,0,0,63,0,902,12,0,1
BGFILL 0,0,23,31,23,902,12,0,0
BGFILL 0,3,1,3,22,790,2,0,0
BGFILL 0,28,1,28,22,790,2,0,0

'Set panel
ICONSET 0,44:ICONSET 1,46:ICONSET 3,50
SPPAGE 1
SPSET 99,48+COMLV,0,0,0,0
SPOFS 99,213,173
SPPAGE 0

VISIBLE 1,1,1,1,1,1

GOSUB @TITLE

CLS
BGMPLAY 3

@START
'Erase all
FOR SID=0 TO 49:GOSUB @CLEAR_OBJ:NEXT SID

'Initialize my ships
FOR I=0 TO 1:SID=48+I
X(SID)=(I==0)*WLX+(I==1)*WRX
Y(SID)=96
VY(SID)=MVY-MVY*2*I
SPSETV SID,7,0
NEXT I

'Read a stage data
@STAGE_DATA
DATA 1,5,"24642"
DATA 3,3,".3.262.3."
DATA 3,5,"...2.2.D.2.2..."
DATA 4,4,".3.....33.....3."
DATA 5,1,"63136"
DATA 5,3,".3.3.2.F.2.3.3."
DATA 3,5,".A.2.2.A.2.2.A."
DATA 4,2,"B234432B"
DATA 3,3,"2A2A4A2A2"
DATA 1,1,"1"
DATA 3,5,".2.B4..6..4B.2."
DATA 5,5,"....6...5...4...5...6...."
DATA 5,5,"..2...B.B.2.2.2.B.B...2.."
DATA 7,1,"A24642A"
DATA 1,11,"...11111..."
DATA 3,2,"161161"
DATA 3,6,"A...2AA4..4AA2...A"
DATA 4,4,"..B.B34..43B.B.."
DATA 1,9,"2A2A2A2A2A2"
DATA 1,1,"6"
DATA 3,7,"....F.1.1.F.1.1.F...."
DATA 5,5,"A...2.A.3...4...3.A.2...A"
DATA 4,5,".22.AAAA.22.AAAA.22."
DATA 5,5,".A.A.A.4.A.424.A.4.A.A.A."
DATA 7,3,"2.....21..C..12. ...2"
DATA 0,0,""

READ MW,MH,M$
IF !(MW==0 OR MH==0) THEN @_SKIP_ROUND
IF CHURRY>0 THEN CHURRY=0 ELSE ESBASE=ESBASE+0.25
RESTORE @STAGE_DATA
GOTO @STAGE_DATA
@_SKIP_ROUND
ROUND=ROUND+1

'Set sprites for balls
BNUM=0
FOR MY=0 TO MH-1:FOR MX=0 TO MW-1
SID=16+BNUM
V=VAL("&H"+MID$(M$,MX+MY*MW,1))
IF V==0 THEN @_SKIP_REGBALL

KN=(V>9):SZ=V-9*KN
RB=(SZ+2)*2
X(SID)=(256-32*(MW-1))/2+32*MX
Y(SID)=192/(MH+1)*(MY+1)
SPSET SID,179-KN*4,3,BNUM%2,0,1
SPHOME SID,8,8
SPCOL SID,-8,-8,16,16,TRUE,&H1 OR (KN==0)*&H7
SPSCALE SID,100*RB/8
SPSETV SID,0,1+KN
SPSETV SID,1,RB
SPSETV SID,2,EB
SPSETV SID,3,((256-RB)/256)*(1-KN)
BNUM=BNUM+1
@_SKIP_REGBALL
NEXT MX:NEXT MY

FOR I=16 TO 49
IF Y(I)<256 THEN SPOFS I,X(I),Y(I)
NEXT I

'Reset BG
BGX=0:BGY=0
BGOFS 1,BGX,BGY

GOSUB @READY
CNT=0

@LOOP
'Update my ships
FOR I=0 TO 1:SID=48+I
SHT=0
FOR J=32+I*8 TO 32+I*8+STMAX-1
IF Y(J)>=256 THEN SHT=J
NEXT J

W=SPGETV(SID,7)
IF W>0 THEN SHT=0:W=W-1

ON (I+1) AND GTYPE GOTO @_COM_SHIP,@_HUM_SHIP

@_HUM_SHIP
KBIT=&H10F XOR (&H3FF*I)
IF !(BUTTON(1) AND KBIT) THEN @_NEXT_SHIP
IF SHT==0 THEN GOSUB @SFX_EMPTY:GOTO @_NEXT_SHIP
GOTO @_SHOT_SHIP

@_COM_SHIP
IF SHT==0 THEN @_NEXT_SHIP
IF COMLV<=2 AND CNT<CWAIT THEN @_NEXT_SHIP
IF RND(32*COMLV*COMLV)==0 THEN @_SHOT_SHIP
TGT=16+RND(BNUM)
IF SPGETV(TGT,0)==2 THEN @_NEXT_SHIP
IF COMLV>=3 AND SPHITRC(TGT,192*I,Y(SID)-1,64,2) THEN @_SHOT_SHIP
IF COMLV>=2 AND SPHITRC(TGT,192*(1-I),Y(SID)-1,64,2) THEN @_SHOT_SHIP
IF RND(4)==0 AND SPHITRC(TGT,0,Y(SID)-2,255,4) THEN @_SHOT_SHIP
GOTO @_NEXT_SHIP

@_SHOT_SHIP
X(SHT)=X(SID):Y(SHT)=Y(SID)
VX(SHT)=SVX-SVX*2*I
W=CWAIT
GOSUB @SFX_SHOT

@_NEXT_SHIP
IF Y(SID)<WTY+(8-RS*2) THEN VY(SID)=MVY
IF Y(SID)>WBY-(8-RS*2) THEN VY(SID)=-MVY
SPSETV SID,7,W
NEXT I

'Update shots
FOR I=32 TO 47:SID=I
IF VX(I)<0 AND X(I)<=WLX+16 THEN GOSUB @EFX:GOSUB @CLEAR_OBJ
IF VX(I)>0 AND X(I)>=WRX-16 THEN GOSUB @EFX:GOSUB @CLEAR_OBJ
NEXT I

'Update balls
FOR I=16 TO 16+BNUM-1:SID=I
KI=SPGETV(I,0)
IF KI==2 THEN @_NEXT_BALL

'Bounce
RB=SPGETV(I,1)
IF !(Y(I)<WTY+RB AND SGN(VY(I))<0) AND !(Y(I)>WBY-RB AND SGN(VY(I))>0) THEN @_SKIP_BALL
SGNY=SGN(Y(I)-96)
ABSVY=ABS(VY(I))
VY(I)=SGNY*ABSVY*-EW

'Effect
IF ABSVY<0.5 THEN @_SKIP_BALL
OFX=0:OFY=SGNY*RB:GOSUB @EFX_OFS
GOSUB @SFX_B_W
@_SKIP_BALL

'Decay
M=SPGETV(I,3)
VX(I)=VX(I)*M:VY(I)=VY(I)*M
IF ABS(VX(I))+ABS(VY(I))<0.125 THEN VX(I)=0:VY(I)=0

'Rotation
SPREAD(I),TMP,TMP,AI
VA=SPGETV(I,4)
IF VA==0 THEN @_SKIP_ROT
AI=(AI+VA+360.5)%360
SPANGLE I,AI
VA=VA*M
IF ABS(VA)<0.25 THEN VA=0
SPSETV I,4,VA
@_SKIP_ROT

@_NEXT_BALL
NEXT I

'Move&bounce all objects
FHIT(0)=0:FHIT(1)=0
ESMAG=ESBASE
IF CNT>=CHURRY THEN ESMAG=ESBASE+(CNT-CHURRY)/2048

FOR I=16 TO 49:SID=I
IF Y(I)>=256 THEN @_NEXT_COL

KI=SPGETV(I,0)
IF KI==2 THEN @_NEXT_COL

'Move
X(I)=X(I)+VX(I):Y(I)=Y(I)+VY(I)
IF X(I)<WLX THEN X(I)=WLX
IF X(I)>WRX THEN X(I)=WRX
SPOFS I,X(I),Y(I)

IF !(KI==1 OR KI==3) THEN @_NEXT_COL

'Collision
IF !SPHIT(I,16) THEN @_NEXT_COL
J=SPHITNO
DX=X(I)-X(J):DY=Y(I)-Y(J)
DABS=SQR(DX*DX+DY*DY)
RI=SPGETV(I,1):RJ=SPGETV(J,1)
IF DABS>RI+RJ THEN @_NEXT_COL

KJ=SPGETV(J,0)
IF KJ==0 THEN FHIT(J-48)=1:GOTO @_NEXT_COL

DVX=VX(I)-VX(J):DVY=VY(I)-VY(J)
NX=DX/DABS:NY=DY/DABS
SPD=DVX*NX+DVY*NY

'Adjustment
IF !(KI==1 AND KJ!=3 AND DABS<RI+RJ) THEN @_SKIP_ADJ
X(I)=X(I)+NX:Y(I)=Y(I)+NY
@_SKIP_ADJ

'Bounce
IF SPD==0 THEN @_NEXT_COL
EI=SPGETV(I,2):EJ=SPGETV(J,2)
IF KI==3 THEN EI=EI*ESMAG
IF KJ==3 THEN EJ=EJ*ESMAG
IF KI==1 THEN VX(I)=VX(I)-NX*SPD*EJ
IF KI==1 THEN VY(I)=VY(I)-NY*SPD*EJ
IF KJ==1 THEN VX(J)=VX(J)+NX*SPD*EI
IF KJ==1 THEN VY(J)=VY(J)+NY*SPD*EI

'Rotation
IF !(KI==3 AND KJ==1) THEN @_SKIP_SPIN
VA=SPGETV(J,7)
SPSETV J,4,VA-VX(I)*DY
@_SKIP_SPIN

'Effect
IF ABS(SPD)<0.25 THEN @_SKIP_EFX
OFX=-DX/2:OFY=-DY/2:GOSUB @EFX_OFS
ON KI+KJ-2 GOSUB @SFX_B_B,@SFX_OBS,@SFX_B_S,@SFX_OBS,@SFX_S_S
@_SKIP_EFX

'Erase the shot(s)
IF KI==3 THEN SID=I:GOSUB @CLEAR_OBJ
IF KJ==3 THEN SID=J:GOSUB @CLEAR_OBJ
@_NEXT_COL
NEXT I

'Scroll BG
SUM=0:FOR I=16 TO 16+BNUM-1:SUM=SUM+X(I):NEXT I
BGX=BGX+(128-SUM/BNUM)/64
BGY=BGY+(ESMAG-1)
BGOFS 1,BGX%512,BGY%512

IF BUTTON() AND &H400 THEN FHIT(0)=1:FHIT(1)=1
WAI=1:GOSUB @VWAIT
CNT=CNT+1
IF !(FHIT(0) OR FHIT(1)) GOTO @LOOP

'Game set
FOR I=0 TO 1
IF !FHIT(I) AND FHIT(1-I) THEN SC(I)=SC(I)+1
NEXT I
GOSUB @DRAW_SCORE

FOR L=0 TO 29
FOR I=0 TO 1:SID=48+I
IF !FHIT(I) THEN @_SKIP_HIT
OFX=RND(16)-8:OFY=RND(16)-8:GOSUB @EFX_OFS
IF L==0 THEN GOSUB @SFX_HIT
@_SKIP_HIT
WAI=1:GOSUB @VWAIT
NEXT I
NEXT L
WAI=15:GOSUB @VWAIT
GOTO @START

@TITLE
GTYPE=-1:TCNT=0
LOCATE 6,4:COLOR 15:?"┣┏┓┛┗  ┻ ┓┻┳┏┫┻┏┫┳┏┏"
LOCATE 6,5:COLOR  9:?"┯┠━┣┓┳┠┻ ┛┻┻┠┨┻┠┗ ┏┫"
LOCATE 6,6:COLOR 11:?"┛  ┛┃┓ ┃┠┫┗┻ ┻┻ ┫┳┠┗"

LOCATE  8,8:COLOR  9:?"1UP"
LOCATE 22,8:COLOR 12:?"2UP"

COLOR 15
LOCATE 8,10:?"К               н"
LOCATE 8,11:?" ↑             Ф "
LOCATE 8,12:?"← →   FIRE    Х А"
LOCATE 8,13:?" ↓   BUTTON    Б "

@_LOOP_TITLE
IF GTYPE<0 THEN COLOR MAINCNTL/3%16 ELSE COLOR 15
LOCATE 8,15:?"PRESS FIRE BUTTON"

IF GTYPE==1 THEN COLOR MAINCNTL%16 ELSE COLOR 15
LOCATE 8,17:?"LEFT:  1UP VS COM"
IF GTYPE==2 THEN COLOR MAINCNTL%16 ELSE COLOR 15
LOCATE 8,18:?"RIGHT: COM VS 2UP"
IF GTYPE==3 THEN COLOR MAINCNTL%16 ELSE COLOR 15
LOCATE 8,19:?"BOTH:  1UP VS 2UP"

BRAW=BUTTON(0):BREL=BUTTON(3)
IF GTYPE<0 AND (BREL AND &H400)!=0 THEN GTYPE=0
IF GTYPE<0 AND (BREL AND &H10F)!=0 THEN GTYPE=1
IF GTYPE<0 AND (BREL AND &H2F0)!=0 THEN GTYPE=2
IF GTYPE<0 AND (BRAW AND &H10F)!=0 AND (BRAW AND &H2F0)!=0 THEN GTYPE=3

IF GTYPE>=0 AND TCNT==0 THEN BEEP 3

BGOFS 1,0,MAINCNTL%512
IF GTYPE>=0 THEN TCNT=TCNT+1
WAI=1:GOSUB @VWAIT
IF TCNT<60 THEN @_LOOP_TITLE
RETURN

@READY
FOR I=0 TO 2
GCLS:GOSUB @DRAW_SCORE
LX=68:LY=48:LS=4:LSTR$="READY":GOSUB @DRAW_LSCR
LX=104:LY=96:LS=8:LSTR$=STR$(3-I):GOSUB @DRAW_LSCR
BEEP 2,-4096
WAI=15:GOSUB @VWAIT
NEXT I
GCLS:GOSUB @DRAW_SCORE
BEEP 7,-(4096/12)*3
RETURN

@EFX
OFX=0:OFY=0
@EFX_OFS
SPSCALE EID,100:SPSCALE EID,0,30
SPANGLE EID,RND(360)
SPOFS EID,X(SID)+OFX,Y(SID)+OFY
EID=(EID+1)%16
RETURN

@SFX_SHOT
BEEP 10,-410*(SID-48),48,X(SID)/2
RETURN
@SFX_EMPTY
BEEP 9,0,127,X(SID)/2
RETURN
@SFX_B_W
BEEP 33,-4096+ABS(VY(SID))*410,64,X(SID)/2
RETURN
@SFX_B_B
VOL=32+ABS(SPD)*48:IF VOL>127 THEN VOL=127
BEEP 12,0,VOL,X(SID)/2
RETURN
@SFX_B_S
VOL=64-ABS(DY)*3:IF VOL<0 THEN VOL=0
BEEP 7,0,VOL,X(SID)/2
RETURN
@SFX_S_S
BEEP 11,0,64,X(SID)/2
RETURN
@SFX_OBS
BEEP 12,4096,64,X(SID)/2
RETURN
@SFX_HIT
BEEP 13,0,127,X(SID)/2
RETURN

@CLEAR_OBJ
IF Y(SID)>=256 THEN RETURN
X(SID)=256:Y(SID)=256
VX(SID)=0:VY(SID)=0
SPOFS SID,256,256
RETURN

@DRAW_SCORE
GFILL 0,0,255,31,0
LSTR$="ROUND "+STR$(ROUND)
LS=2:LX=(128-LEN(LSTR$)*6*LS)/2:LY=8
GOSUB @DRAW_LSCR
LSTR$=STR$(SC(0))+" - "+STR$(SC(1))
LS=2:LX=128+(128-LEN(LSTR$)*6*LS)/2:LY=8
GOSUB @DRAW_LSCR
RETURN

@DRAW_LSCR
FOR TMP=0 TO LEN(LSTR$)-1
GPUTCHR LX,LY,"BGF0",ASC(MID$(LSTR$,TMP,1)),0,LS
LX=LX+6*LS
NEXT TMP
RETURN

@PANEL_CHECK
ICK=ICONCHK()
IF ICK<0 THEN @_SKIP_PANEL
IF ICK==3 THEN PDISP=!PDISP:IF PDISP THEN PNLTYPE "PNL" ELSE PNLTYPE "OFF"
IF !(ICK==0 OR ICK==1) THEN @_SKIP_PANEL
COMLV=COMLV+(ICK==0)-(ICK==1)
IF COMLV<=0 THEN COMLV=1
IF COMLV>3 THEN COMLV=3
SPPAGE 1:SPCHR 99,48+COMLV:SPPAGE 0
@_SKIP_PANEL
RETURN

@VWAIT
FOR TMP=0 TO WAI-1
GOSUB @PANEL_CHECK
VSYNC 1
NEXT TMP
RETURN