Print Page - Tutorials etc

DEFINT I
DECLARE SUB instructions ()
DECLARE SUB qbide ()
DECLARE SUB mship (imothership)
REM Adds multiple bullets (5) max.
REM Adds firing delay and ship turns red while reloading.
REM Adds aliens.
REM Adds collision for bullets from base to aliens.
REM Adds Mouse support.
REM Adds alien motion.
REM Adds 3 progressive levels.
REM Adds aliens move all the way to both sides.
REM Adds Aliens shoot back.
REM Adds sub-routines.
REM Adds counter.
REM Adds alien bullets finish before moving on to next level.
REM Adds mothership.
DECLARE SUB alienattack (ialiencolstat, ialiencol)
DECLARE SUB alienmissile (iresults)
DECLARE SUB checkcollision (ihitaliens, ialiencol, i4, i)
DECLARE SUB mdriver (ex%, key$, tankx%)
DECLARE SUB marchdown (ialiencol, ialiencolstat, imotion, iresults)
DECLARE SUB movealiens (ialiencol, ialiencolstat, iresults)
DECLARE SUB reprintaliens (ialiencol, ihitaliens, iresults, i4, i, imothership)
TYPE RegType
AX AS INTEGER
BX AS INTEGER
CX AS INTEGER
DX AS INTEGER
BP AS INTEGER
SI AS INTEGER
DI AS INTEGER
FLAGS AS INTEGER
DS AS INTEGER
ES AS INTEGER
END TYPE
DIM SHARED MOUSE$
DIM SHARED Registers AS RegType
DIM SHARED LB%, RB%, MB%, DX, CX
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
ex% = 1: CALL mdriver(ex%, key$, tankx%)
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
key$ = INKEY$
IF key$ = "" THEN ex% = 2: CALL mdriver(ex%, key$, tankx%)
SELECT CASE key$
CASE CHR$(0) + "K"
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
CASE CHR$(0) + "M"
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
CASE CHR$(32)
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 CHR$(27): SYSTEM
END SELECT
IF ABS(z1 - reload) > .7 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
ex% = -1: CALL mdriver(ex%, key$, tankx%)
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 "Well, I better get busy and finish the compiler..."
DATA "Or... I'll just do some more work on this IDE, instead..."
DATA ""
DATA " Loading..."
DATA "EOF"
DATA "Game Over. Thanks for playing..."
DATA ""
DATA "Now finish the compiler!"
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
SUB mdriver (ex%, key$, tankx%)
STATIC MOUSEACT%
REM INITIATE MOUSE
IF MOUSEACT% = 0 OR ex% = -1 THEN
Registers.AX = 0: GOSUB CALLI
MOUSEACT% = 1
END IF
IF ex% = 1 THEN
Registers.AX = 4: Registers.DX = 184: Registers.CX = 304
Registers.AX = 8: Registers.DX = 184: Registers.CX = 184
GOSUB CALLI
EXIT SUB
END IF
Registers.AX = 3: GOSUB CALLI
DX = Registers.DX
CX = Registers.CX
y% = DX \ 8 + 1: x% = CX \ 8 + 1
REM MOUSE BUTTONS
LB% = Registers.BX AND 1
RB% = (Registers.BX AND 2) \ 2
MB% = (Registers.BX AND 4) \ 4
IF LB% <> 0 THEN
key$ = CHR$(32)
ELSE
IF x% > tankx% THEN key$ = CHR$(0) + "M"
IF x% < tankx% THEN key$ = CHR$(0) + "K"
END IF
EXIT SUB
CALLI:
CALL INTERRUPT(&H33, Registers, Registers)
RETURN
END SUB
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

QB64.org Forum

Active Forums => QB64 Discussion => Topic started by: johnno56 on May 28, 2018, 10:09:33 pm