Convert BBCW programs to BBC SDL

[Repton]

Is anyone interested in converting this program for example to run on BBC SDL

REM Planetoid Defender

REM All systems are a compromise. Generally, the more one plans a program in advance,
REM then fewer lines of code are required, and fewer bugs are introduced.

REM In this instance, less time was spent preparing how the data would be stored and
REM processed. So, the program design could be streamlined.

REM Although this program is based on an old Arcade game, it still contains routines
REM that haven't been used before (by the author), so development included testing
REM the odd new concept and idea.

REM Prevent resize
SYS "GetWindowLong", @hwnd%, -16 TO ws%
SYS "SetWindowLong", @hwnd%, -16, ws% AND NOT &40000 AND NOT &10000
MODE 9:OFF
*ESC off
VDU 23,23,2;0;0;0;:REM Line thickness
ON CLOSE:PROCcleanup_bmp:PROCsave_scores:QUIT
PROCinit_bmp
bmpxo=0:bmpyo=511:REM Origin co-ordinates to be used for bitmaps (see radar)

REM Arena = 3200 real pixels across, 800 gnd() units
REM All object positions are horizontally relative to Player -1600 to +1599

DIM hi{(9) sc,name$}:PROCload_scores:REM Hi-Scores

MAXbmp=40:DIM bmp{(MAXbmp) bmphnd%,w,h,mskhnd%}:REM Bitmap graphics index

DIM gnd(799):PROCmake_ground:REM Ground, uses 2 bitmaps

REM sts (standard values common to various object types)
REM 0 = empty slot/inactive
REM 1 = counting down to appearance/inactive
REM 2 = imploding/inactive
REM 3 = exploding/inactive

REM type
REM 1 = UFO (special)
REM 4 = Alien/mutant
REM 6 = Astronaut
REM 7 = Minelayer
REM 8 = Box
REM 9 = Tiny Saucer
MAXobj=99:REM 99 absolute max
DIM obj{(MAXobj) sts,type,x,y,xv,yv,tgt,c,viz,w,h,fire,strb}
DIM stk(MAXobj):FOR a=0 TO MAXobj:stk(a)=a:NEXT
stkptr=0:REM Pointer to next available stack entry

MAXlaser=4:REM Laser bolts fired by ship (player)
DIM laz{(MAXlaser) sts,x,y,dir,c}
DIM lzstk(MAXlaser):FOR a=0 TO MAXlaser:lzstk(a)=a:NEXT
lzptr=0

MAXdebris=50:REM Debris from ship (player) explosion
DIM deb{(MAXdebris) x,y,xv,yv,g}

MAXbullets=40:REM Enemy bullets & mines
DIM bul{(MAXbullets) sts,x,y,xv,yv,life}
DIM blstk(MAXbullets):FOR a=0 TO MAXbullets:blstk(a)=a:NEXT
blptr=0

MAXbonus=5:REM Bonus value bitmap display control: '250', '500'
DIM bns{(MAXbonus) sts,gfx,x,y,xv,yv,life}
DIM bsstk(MAXbonus):FOR a=0 TO MAXbonus:bsstk(a)=a:NEXT
bsptr=0

REM Define/create the graphics to be used, within the program...
REM Ship Right
PROCmake_bmp(2,20,11,"0,0,0,960,1020,252,0,0,0,0,0",0,0,240)
PROCmake_bmp(2,20,11,"0,0,0,0,0,786432,786432,196608,49152,0,0",240,0,240)
PROCmake_bmp(2,20,11,"0,0,0,0,0,196608,62211,0,0,0,0",0,240,240)
PROCmake_bmp(2,20,11,"983040,245760,995328,850944,261120,65283,199932,62460,4032,16128,64512",240,240,240)
REM Ship Left
PROCmake_bmp(3,20,11,"0,0,0,15360,261120,258048,0,0,0,0,0",0,0,240)
PROCmake_bmp(3,20,11,"0,0,0,0,0,3,3,12,48,0,0",240,0,240)
PROCmake_bmp(3,20,11,"0,0,0,0,0,12,789744,0,0,0,0",0,240,240)
PROCmake_bmp(3,20,11,"15,60,207,1011,1020,790512,258816,261360,16128,4032,1008",240,240,240)
REM Ship radar blip & bullet
PROCmake_bmp(22,2,2,"3,3",240,240,240)
REM Alien
PROCmake_bmp(4,14,8,"0,0,15567,15567,4092,192,3276,12483",0,240,0)
PROCmake_bmp(4,14,8,"1008,4092,0,0,0,816,0,0",240,240,0)
REM Alien radar blip yellow & green
PROCmake_bmp(24,2,2,"0,3",0,240,0)
PROCmake_bmp(24,2,2,"3,0",240,240,0)
REM Mutant
PROCmake_bmp(5,14,8,"0,3900,12291,12291,7180,816,3084,12291",0,240,0)
PROCmake_bmp(5,14,8,"1008,192,3276,3276,1008,192,192,192",240,0,240)
REM Mutant radar blip magenta & green
PROCmake_bmp(25,2,2,"0,3",0,240,0)
PROCmake_bmp(25,2,2,"3,0",240,0,240)
REM Astronaut
PROCmake_bmp(6,4,8,"15,12,12,15,0,0,0,0",0,240,0)
PROCmake_bmp(6,4,8,"0,3,3,0,0,0,0,0",240,240,0)
PROCmake_bmp(6,4,8,"0,0,0,0,15,3,3,3",240,0,240)
REM Astronaut radar blip cyan
PROCmake_bmp(26,2,2,"3,3",0,240,240)
REM Minelayer
PROCmake_bmp(7,10,8,"0,48,48,204,204,48,48,0",240,0,0)
PROCmake_bmp(7,10,8,"0,76,207,0,0,463,204,204",240,240,0)
PROCmake_bmp(7,10,8,"204,128,768,0,0,512,0,0",240,240,240)
REM Minelayer radar blip magenta
PROCmake_bmp(27,2,2,"3,3",240,0,240)
REM Box
PROCmake_bmp(8,10,8,"0,48,16,190,511,48,48,48",240,0,0)
PROCmake_bmp(8,10,8,"0,0,76,0,0,76,76,0",240,240,0)
PROCmake_bmp(8,10,8,"48,0,32,833,512,0,0,0",240,0,240)
PROCmake_bmp(8,10,8,"0,204,128,0,0,128,128,0",240,240,240)
REM Box radar blip magenta & yellow
PROCmake_bmp(28,2,2,"0,3",240,240,0)
PROCmake_bmp(28,2,2,"3,0",240,0,240)
REM Tiny Saucer
PROCmake_bmp(9,10,4,"48,252,819,252",240,0,0)
PROCmake_bmp(9,10,4,"0,0,204,0",240,240,0)
REM Tiny Saucer radar blip red
PROCmake_bmp(29,2,2,"3,3",240,0,0)
REM Saucer
PROCmake_bmp(10,20,4,"65520,196620,786435,262140",0,240,0)
PROCmake_bmp(10,20,4,"0,0,249660,0",240,240,0)
REM Saucer radar blip green
PROCmake_bmp(30,2,2,"3,3",0,240,0)

REM Bonus 250 magenta
PROCmake_bmp(16,14,5,"15855,1417,15853,12333,15855",240,0,240)
REM Bonus 250 yellow
PROCmake_bmp(17,14,5,"15855,1417,15853,12333,15855",240,240,0)
REM Bonus 500 magenta
PROCmake_bmp(18,14,5,"15855,12585,15789,1453,15855",240,0,240)
REM Bonus 500 yellow
PROCmake_bmp(19,14,5,"15855,12585,15789,1453,15855",240,240,0)

REM Explosion Yellow blip
PROCmake_bmp(31,2,2,"3,3",240,240,0)
REM Explosion Cyan blip
PROCmake_bmp(32,2,1,"3",0,240,240)
REM Large debris
PROCmake_bmp(33,4,4,"1,7,7,15",0,240,240)
PROCmake_bmp(33,4,4,"14,8,8,0",240,240,240)
REM Implosion Green blip (small)
PROCmake_bmp(34,2,1,"3",0,240,0)
REM Explosion Red blip (small)
PROCmake_bmp(35,2,1,"3",240,0,0)
REM Bright light
PROCmake_bmp(36,9,9,"16,16,0,0,387,0,0,16,16",0,0,240)
PROCmake_bmp(36,9,9,"0,0,16,40,68,40,16,0,0",0,240,240)
PROCmake_bmp(36,9,9,"0,0,0,16,56,16,0,0,0",240,240,240)

fallv=4:REM Alien drop velocity
visible=FALSE:REM Bitmap overlaps window (draw_bmp)
viz$="":REM Stores list of visible objects (for collision detection)
fired=TRUE:REM Hit the fire key
ship_w=40:REM Ship width & height for collision detection
ship_h=20
rate_of_fire=10:REM Out of 1000
armed$="491":REM Object types that can shoot at ship

PROCintro
REPEAT:WAIT 1:UNTILINKEY(-99)

REPEAT
*FONT Arial,12,B
*REFRESH OFF
ship_lives=3
ship_bombs=3
score=0
spaced=TRUE:REM Pressed space bar
smarted=FALSE:REM pressed TAB
astro$="":REM pointers to astronauts
level=0
newlevel=TRUE
extra=10000:REM Next multiple of 10000 for extra life & bomb
normal=TRUE:REM Exit 'normal' mode when no astronauts left
ufocount=0:REM total UFOs active
ufodelay=0:REM counter for no scoring period

REM Life/Level loop
REPEAT
IF newlevel THEN
level+=1
IF (level MOD 4)=0 normal=TRUE
PROCpopulate
ENDIF
PROCinit_ship:REM Reset ship position etc
PROCinit_blow:REM Initialise ship explosion
REM Main animation loop
REPEAT
TIME=0:CLS

ufodelay+=1:IF ufodelay>125+RND(50) PROCmake_ufo

IF astro$="" normal=FALSE:REM No more astronauts

IF ship_alive PROCflight_controls ELSE ship_wait-=1:REM Player input

IF normal PROCshow_ground

viz$="":PROCthink_and_draw:REM All other objects (not player)

PROCmove_bolt:REM Ship's laser bolts

IF ship_alive type=1:fade=-1 ELSE type=3:fade=(ship_wait MOD 4)*64+32
IF ship_alive OR ship_wait>0 THEN
PROCdraw_bmp(type,ship_dir+2,ship_wx,ship_y,2,fade)
PROCon_radar(22,0,ship_y)
ELSE
PROCblow
ENDIF

PROCfly_bullet:REM Bullet animation & collision testing
PROCshow_bonus:REM Bonus points animation
PROCzapped:REM Laser bolt collision testing
PROCcrunch:REM Ship collision detection

PROChud:REM Score etc

REM Nothing left but astronauts?
IF stkptr=LEN(astro$)DIV 3 newlevel=TRUE

REM Force Windows to update display to show bitmaps drawn
SYS "InvalidateRect",@hwnd%,0,0
*REFRESH
*FX21
REPEAT
IF TIME<=2 WAIT 1
UNTIL TIME>=4

UNTIL ship_wait<-80 OR newlevel AND ship_alive
REM Clear all bullets & bonuses when killed or new level
PROCclear_bullets
REM Reposition existing objects when killed
IF NOT ship_alive ship_lives-=1:PROCreset_places
REM Show bonus on new level!
IF ship_lives>0 AND newlevel PROCmultiplier
REM Clear all objects when game over or a new level
IF ship_lives=0 OR newlevel PROCdepopulate

UNTIL ship_lives=0

*REFRESH ON
PROCnew_score(score)
PROCshow_scores(FALSE)
REPEAT:WAIT 1:UNTILINKEY(-99)
UNTIL0
END

DEF PROChud
GCOL 0,4:RECTANGLEFILL 0,408*2,1280,6
COLOUR 2
PRINTTAB(1,0);"Score"
PRINTTAB(1,2);"Level"
PRINTTAB(1,3);"Lives"
PRINTTAB(1,4);"Bombs"
COLOUR 3
PRINTTAB(1,1);score
PRINTTAB(10,2);level
PRINTTAB(10,3);ship_lives
PRINTTAB(10,4);ship_bombs
ENDPROC

REM Bonus multiplication display for surviving astronauts
DEF PROCmultiplier
LOCAL a
*REFRESH ON
CLS:PROChud
*FONT Arial,16,B
COLOUR 3
PRINTTAB(19,8);"Attack wave ";level;" defeated"
COLOUR 2
PRINTTAB(24,11);"Bonus x ";STR$(level*100)
IF astro$="" THEN
COLOUR 1:PRINTTAB(26,15);"No Bonus"
ELSE
FOR a=0 TO (LEN(astro$)DIV 3)-1
PROCdraw_bmp(1,6,160+a*32,128,2,-1)
SYS "InvalidateRect",@hwnd%,0,0
WAIT 10
NEXT
score+=(LEN(astro$)DIV 3)*level*100
ENDIF
TIME=0:REPEAT:WAIT 1:UNTIL TIME>=250
*FONT Arial,12,B
*REFRESH OFF
ENDPROC

DEF PROCinit_ship
ship_gx=0:REM x pos above ground (0-3199)
ship_wx=160:REM x pos within window
ship_dir=0:REM 0=right, 1=left
ship_y=256:REM Height
ship_xv=0:REM x velocity
ship_alive=TRUE:REM Ship is valid target
ship_wait=0:REM Pause while exploding
ufodelay=0
ENDPROC

DEF PROCflight_controls
REM A,Z
IF INKEY(-66) AND ship_y<392 ship_y+=8
IF INKEY(-98) AND ship_y>16 ship_y-=8
REM Reverse direction
IF NOT spaced AND INKEY(-99) spaced=TRUE:ship_dir EOR=1 ELSE IF NOT INKEY(-99) spaced=FALSE
IF ship_dir=0 AND ship_wx>160 ship_wx-=12
IF ship_dir=1 AND ship_wx<480 ship_wx+=12
REM Smart Bomb
IF NOT smarted AND INKEY(-97) smarted=TRUE:PROCdetonate ELSE IF NOT INKEY(-97) smarted=FALSE
REM Thrust (M)
IF INKEY(-102) THEN
IF ship_dir=0 ship_xv+=2 ELSE ship_xv-=2
IF ABS(ship_xv)>24 ship_xv=SGN(ship_xv)*24
ELSE
ship_xv-=SGN(ship_xv)*0.5
ENDIF
ship_gx+=ship_xv
IF ship_gx<0 ship_gx+=3200
IF ship_gx>=3200 ship_gx-=3200
REM Fire (K)
IF NOT fired AND INKEY(-71) PROCinit_bolt:fired=TRUE
IF NOT INKEY(-71) fired=FALSE
ENDPROC

DEF PROCship_destruct
IF ship_alive ship_alive=FALSE:ship_wait=19:ship_xv=0
ENDPROC

DEF PROCon_radar(g,x,y)
bmpxo=320:bmpyo=100:REM Origin co-ordinates to be used for bitmaps
PROCdraw_bmp(1,g,x DIV 8,y DIV 4,2,-1)
bmpxo=0:bmpyo=511:REM Origin co-ordinates to be used for bitmaps
ENDPROC

DEF FNdig(n,v)
=STRING$(n-LEN(STR$(v)),"0")+STR$(v)

REM Remove a substring from a larger string, if present
DEF PROCrmv_str(a$,RETURN b$)
LOCAL i
i=INSTR(b$,a$):IF i>0 b$=LEFT$(b$,i-1)+RIGHT$(b$,LEN(b$)-i-LEN(a$)+1)
ENDPROC

REM Collision detection between ship and visible objects
DEF PROCcrunch
LOCAL a,i
IF NOT ship_alive OR viz$="" ENDPROC
FOR a=1 TO LEN(viz$)DIV 3
i=VAL(MID$(viz$,a*3-1,2))
IF obj{(i)}.x+obj{(i)}.w/2>-ship_w/2 THEN
IF obj{(i)}.x-obj{(i)}.w/2<ship_w/2 THEN
IF obj{(i)}.y+obj{(i)}.h/2>ship_y-ship_h/2 THEN
IF obj{(i)}.y-obj{(i)}.h/2<ship_y+ship_h/2 THEN
CASE obj{(i)}.type OF
WHEN 4,9,1
obj{(i)}.sts=3:obj{(i)}.c=0
PROCinc_score(obj{(i)}.type)
PROCship_destruct
WHEN 7
obj{(i)}.sts=3:obj{(i)}.c=0
PROCinc_score(obj{(i)}.type)
PROCship_destruct
PROCmake_saucers(4,obj{(i)}.x,obj{(i)}.y)
WHEN 8
obj{(i)}.sts=3:obj{(i)}.c=0
PROCinc_score(obj{(i)}.type)
PROCship_destruct
PROCmake_saucers(8,obj{(i)}.x,obj{(i)}.y)
WHEN 6 : REM Catch a falling astronaut
IF obj{(i)}.sts=16 THEN
obj{(i)}.sts=17
score+=500:PROCmake_bonus(18,obj{(i)}.x,obj{(i)}.y)
ENDIF
ENDCASE
ENDIF
ENDIF
ENDIF
ENDIF
NEXT
ENDPROC

DEF PROCdetonate
LOCAL a,i
IF ship_bombs=0 OR NOT ship_alive OR viz$="" ENDPROC
ship_bombs-=1
FOR a=1 TO LEN(viz$)DIV 3
i=VAL(MID$(viz$,a*3-1,2))
CASE obj{(i)}.type OF
WHEN 4,9,7,1
obj{(i)}.sts=3:obj{(i)}.c=0
PROCinc_score(obj{(i)}.type)
ENDCASE
NEXT
GCOL 0,7:RECTANGLEFILL 240,824,800,200:REM Scanner flash
ENDPROC

REM *********************************************************************
REM Bullets & Bonuses
REM *********************************************************************

DEF PROCmake_bullet(type,x,y)
LOCAL i
IF blptr>MAXbullets ENDPROC
i=blstk(blptr):blptr+=1
bul{(i)}.sts=1
bul{(i)}.x=x:bul{(i)}.y=y
IF type=0 THEN
bul{(i)}.xv=ship_xv-x/20
bul{(i)}.yv=(ship_y-bul{(i)}.y)/20
ELSE
bul{(i)}.xv=0:bul{(i)}.yv=0
ENDIF
bul{(i)}.life=75
ENDPROC

DEF PROCfly_bullet
LOCAL a
FOR a=0 TO MAXbullets
IF bul{(a)}.sts=1 THEN
bul{(a)}.x+=bul{(a)}.xv-ship_xv
bul{(a)}.y+=bul{(a)}.yv
PROCdraw_bmp(1,22,bul{(a)}.x+ship_wx,bul{(a)}.y,3,-1)
REM Hit ship?
IF bul{(a)}.x>-ship_w/2 AND bul{(a)}.x<ship_w/2 THEN
IF bul{(a)}.y>ship_y-ship_h/2 AND bul{(a)}.y<ship_y+ship_h/2 THEN
PROCship_destruct:bul{(a)}.life=0
ENDIF
ENDIF
bul{(a)}.life-=1
IF bul{(a)}.life<=0 PROCkill_bullet(a)
ENDIF
NEXT
ENDPROC

DEF PROCkill_bullet(i)
blptr-=1:blstk(blptr)=i:bul{(i)}.sts=0
ENDPROC

DEF PROCmake_bonus(gfx,x,y)
LOCAL i
IF bsptr>MAXbonus ENDPROC
i=bsstk(bsptr):bsptr+=1
bns{(i)}.sts=1
bns{(i)}.gfx=gfx
bns{(i)}.x=x:bns{(i)}.y=y
IF gfx=18 bns{(i)}.xv=ship_xv/2 ELSE bns{(i)}.xv=0
IF bns{(i)}.xv=0 bns{(i)}.yv=1 ELSE bns{(i)}.yv=0
bns{(i)}.life=40
ENDPROC

DEF PROCshow_bonus
LOCAL a,b
FOR a=0 TO MAXbonus
IF bns{(a)}.sts=1 THEN
bns{(a)}.x+=bns{(a)}.xv-ship_xv
bns{(a)}.y+=bns{(a)}.yv
b=bns{(a)}.life MOD 2
PROCdraw_bmp(3,bns{(a)}.gfx+b,bns{(a)}.x+ship_wx,bns{(a)}.y,3,192)
bns{(a)}.life-=1
IF bns{(a)}.life<=0 PROCkill_bonus(a)
ENDIF
NEXT
ENDPROC

DEF PROCkill_bonus(i)
bsptr-=1:bsstk(bsptr)=i:bns{(i)}.sts=0
ENDPROC

REM Clear bullets and bonus arrays for new data
DEF PROCclear_bullets
LOCAL a
FOR a=0 TO MAXbullets:blstk(a)=a:bul{(a)}.sts=0:NEXT
FOR a=0 TO MAXbonus:bsstk(a)=a:bns{(a)}.sts=0:NEXT
blptr=0:bsptr=0
ENDPROC

REM *********************************************************************
REM Ship's laser & Ship destruction
REM *********************************************************************

REM Initialise a laser bolt, relative to ship
DEF PROCinit_bolt
LOCAL i
IF lzptr>MAXlaser ENDPROC
i=lzstk(lzptr):lzptr+=1
laz{(i)}.sts=1
IF ship_dir=0 THEN
laz{(i)}.x=40:laz{(i)}.dir=1
ELSE
laz{(i)}.x=-40:laz{(i)}.dir=-1
ENDIF
laz{(i)}.y=ship_y
laz{(i)}.c=0
ENDPROC

REM Move & draw ship's laser bolt (Collision testing is independent)
REM N.b Bolt not updated by ship movement
DEF PROCmove_bolt
LOCAL a,x1,y,x2,c
FOR a=0 TO MAXlaser
IF laz{(a)}.sts=1 THEN
laz{(a)}.c+=1:c=laz{(a)}.c
IF c=8 THEN
PROCkill_bolt(a)
ELSE
laz{(a)}.x+=laz{(a)}.dir*60:REM Update bolt position
x1=laz{(a)}.x+ship_wx
x2=laz{(a)}.x-c*0.75*laz{(a)}.dir*60+ship_wx
y=laz{(a)}.y
GCOL 0,VAL(MID$("6633355",c,1))
LINE x1*2,y*2,x2*2,y*2
ENDIF
ENDIF
NEXT
ENDPROC

REM Check if any laser bolt has collided with an object
DEF PROCzapped
LOCAL b,x1,x2,y,c$,a,i,xmin,ymin,xmax,ymax,hit,d,dist
IF viz$="" ENDPROC
FOR b=0 TO MAXlaser
IF laz{(b)}.sts=1 THEN
x1=laz{(b)}.x
x2=laz{(b)}.x-laz{(b)}.dir*80
y=laz{(b)}.y
c$=viz$
hit=-1:dist=999
FOR a=1 TO LEN(viz$)DIV 3
i=VAL(MID$(c$,2,2)):c$=RIGHT$(c$,LEN(c$)-3)
xmin=obj{(i)}.x-obj{(i)}.w/2
xmax=obj{(i)}.x+obj{(i)}.w/2
ymin=obj{(i)}.y-obj{(i)}.h/2
ymax=obj{(i)}.y+obj{(i)}.h/2
IF x1<xmin AND x2<xmin OR x1>xmax AND x2>xmax OR y<ymin OR y>ymax THEN
REM Not overlapping
ELSE
d=ABS(obj{(i)}.x):REM Find closest object to ship hit by this bolt
IF hit=-1 hit=i:dist=d ELSE IF d<dist hit=i:dist=d
ENDIF
NEXT
IF hit>-1 THEN
obj{(hit)}.sts=3:obj{(hit)}.c=0
PROCkill_bolt(b)
PROCinc_score(obj{(hit)}.type)
IF obj{(hit)}.type=7 PROCmake_saucers(4,obj{(hit)}.x,obj{(hit)}.y)
IF obj{(hit)}.type=8 PROCmake_saucers(8,obj{(hit)}.x,obj{(hit)}.y)
ufodelay=0
ENDIF
ENDIF
NEXT
ENDPROC

REM Use object type to determine score increase
DEF PROCinc_score(t)
CASE t OF
WHEN 4 : score+=150
WHEN 7 : score+=200
WHEN 8 : score+=1000
WHEN 9 : score+=250
WHEN 1 : score+=150
ENDCASE
IF score>=extra THEN
ship_lives+=1:ship_bombs+=1
extra=extra+10000
ENDIF
ENDPROC

DEF PROCkill_bolt(i)
lzptr-=1:lzstk(lzptr)=i:laz{(i)}.sts=0
ENDPROC

REM Initialise ship explosion
DEF PROCinit_blow
LOCAL a
FOR a=0 TO MAXdebris
deb{(a)}.x=0:deb{(a)}.y=0
deb{(a)}.xv=(RND(128)-64)/4
deb{(a)}.yv=(RND(128)-64)/4
deb{(a)}.g=RND(1)*-0.5
NEXT
ENDPROC

REM Animate ship explosion
DEF PROCblow
LOCAL a
FOR a=0 TO MAXdebris
deb{(a)}.yv+=deb{(a)}.g
deb{(a)}.x+=deb{(a)}.xv
deb{(a)}.y+=deb{(a)}.yv
PROCdraw_bmp(1,33,deb{(a)}.x+ship_wx,deb{(a)}.y+ship_y,2,-1)
NEXT
ENDPROC

REM *********************************************************************
REM Object control
REM *********************************************************************

REM Each object entry can contain a different ship or object
REM Statuses>3 are unique and determine a specific behaviour
DEF PROCthink_and_draw
LOCAL a,h,xd,yd,grab,x,y,gfx,d,dist,dropdelay
dropdelay=FALSE:REM Prevent more than one astronaut from being dropped off per turn
FOR a=0 TO MAXobj
obj{(a)}.strb+=1:IF obj{(a)}.strb>=16 obj{(a)}.strb=0:REM Strobe light

REM Mutate all alien landers when astronauts gone
IF NOT normal AND obj{(a)}.type=4 AND obj{(a)}.sts<>7 AND obj{(a)}.sts<>3 obj{(a)}.sts=7

CASE obj{(a)}.sts OF

WHEN 1 : REM Countdown
PROCx_adjust
obj{(a)}.c-=1
IF obj{(a)}.c<=0 obj{(a)}.sts=2:obj{(a)}.c=32

WHEN 2 : REM Implode
PROCx_adjust
obj{(a)}.c-=1:h=obj{(a)}.c/4
IF obj{(a)}.c=12 THEN
CASE obj{(a)}.type OF
WHEN 1 : obj{(a)}.sts=30
WHEN 4 : obj{(a)}.sts=4
WHEN 8 : obj{(a)}.sts=25
ENDCASE
ENDIF
FOR y=-1 TO 1:FOR x=-1 TO 1
IF x<>0 OR y<>0 THEN
PROCdraw_bmp(1,34,1.5*x*2^h+obj{(a)}.x+ship_wx,y*2^h+obj{(a)}.y,2,-1)
PROCon_radar(31,obj{(a)}.x,obj{(a)}.y)
ENDIF
NEXT:NEXT

WHEN 3 : REM Explode
PROCx_adjust
obj{(a)}.c+=1
CASE obj{(a)}.type OF
WHEN 4,7,8,1 : gfx=31
WHEN 6 : gfx=32
WHEN 9 : gfx=35
ENDCASE
FOR y=-1 TO 1:FOR x=-1 TO 1
IF x<>0 OR y<>0 THEN
IF ABS(x)=ABS(y) h=obj{(a)}.c*16 ELSE h=obj{(a)}.c*12
PROCdraw_bmp(1,gfx,x*h+obj{(a)}.x+ship_wx,0.75*y*h+obj{(a)}.y,2,-1)
ENDIF
NEXT:NEXT
IF obj{(a)}.c=12 PROCkill_obj(a)

WHEN 4 :REM Alien following landscape (hunting)
REM Target selection
IF obj{(a)}.tgt=-1 AND astro$<>"" THEN
IF LEN(astro$)=3 THEN
obj{(a)}.tgt=VAL(RIGHT$(astro$,2))
ELSE
h=RND(LEN(astro$)DIV 3)*3-1
obj{(a)}.tgt=VAL(MID$(astro$,h,2))
ENDIF
ENDIF
REM Target viable and within capture envelope?
IF obj{(a)}.tgt<>-1 THEN
IF obj{(obj{(a)}.tgt)}.sts<>14 THEN
obj{(a)}.tgt=-1
ELSE
xd=obj{(obj{(a)}.tgt)}.x-obj{(a)}.x
IF ABS(xd)<ABS(obj{(obj{(a)}.tgt)}.y-obj{(a)}.y)/2 obj{(a)}.sts=5
ENDIF
ENDIF
REM Alien movement
obj{(a)}.yv-=1:REM gravity
IF ABS(obj{(a)}.yv)>fallv obj{(a)}.yv=SGN(obj{(a)}.yv)*fallv
obj{(a)}.x+=obj{(a)}.xv
obj{(a)}.y+=obj{(a)}.yv
PROCx_adjust
h=FNaltitude(obj{(a)}.x)
IF obj{(a)}.y<h+80 THEN
IF obj{(a)}.yv<0 obj{(a)}.y=h+80
obj{(a)}.yv+=2
ENDIF
PROCdraw_bmp(1,4,obj{(a)}.x+ship_wx,obj{(a)}.y,2,-1)
obj{(a)}.viz=visible:IF visible viz$+=":"+FNdig(2,a)
PROCon_radar(24,obj{(a)}.x,obj{(a)}.y)

WHEN 5 : REM Alien chasing astronaut
IF obj{(obj{(a)}.tgt)}.sts<>14 THEN
obj{(a)}.tgt=-1:obj{(a)}.sts=4:REM Return to hunting
obj{(a)}.yv=2:REM If chase fails, we want a smooth transition back to hunting
ELSE
REM Close distance horizontally & vertically
xd=obj{(obj{(a)}.tgt)}.x-obj{(a)}.x
IF ABS(xd)>=ABS(obj{(a)}.xv) xd=SGN(xd)*ABS(obj{(a)}.xv):grab=FALSE ELSE grab=TRUE
obj{(a)}.x+=xd
yd=obj{(obj{(a)}.tgt)}.y+20-obj{(a)}.y
IF ABS(yd)>=ABS(fallv) yd=SGN(yd)*ABS(fallv):grab=FALSE
obj{(a)}.y+=yd
IF grab obj{(obj{(a)}.tgt)}.tgt=a:obj{(obj{(a)}.tgt)}.sts=15:obj{(a)}.sts=6
ENDIF
PROCx_adjust
PROCdraw_bmp(1,4,obj{(a)}.x+ship_wx,obj{(a)}.y,2,-1)
obj{(a)}.viz=visible:IF visible viz$+=":"+FNdig(2,a)
PROCon_radar(24,obj{(a)}.x,obj{(a)}.y)

WHEN 6 : REM Alien Rising
IF obj{(a)}.tgt<>-1 THEN
IF obj{(obj{(a)}.tgt)}.sts<>15 obj{(a)}.tgt=-1:REM Lost astronaut?
ENDIF
obj{(a)}.y+=fallv DIV 2
PROCx_adjust
PROCdraw_bmp(1,4,obj{(a)}.x+ship_wx,obj{(a)}.y,2,-1)
obj{(a)}.viz=visible:IF visible viz$+=":"+FNdig(2,a)
PROCon_radar(24,obj{(a)}.x,obj{(a)}.y)
IF obj{(a)}.tgt=-1 AND obj{(a)}.y>=400 PROCreset_alien(a)
IF obj{(a)}.tgt<>-1 AND obj{(a)}.y>=400 obj{(a)}.sts=7:PROCkill_obj(obj{(a)}.tgt)

WHEN 7 : REM Mutant chasing ship
h=16:dist=SQR(obj{(a)}.x^2+(obj{(a)}.y-ship_y)^2)
REPEAT
x=(RND(3)-2)*h:y=(RND(3)-2)*h
x+=obj{(a)}.x:y+=obj{(a)}.y
IF x>=1600 x-=3200
IF x<-1600 x+=3200
IF y<8 y=400
IF y>400 y=8
d=SQR(x^2+(y-ship_y)^2)
UNTIL d<dist OR dist<h
obj{(a)}.x=x:obj{(a)}.y=y
PROCx_adjust
PROCdraw_bmp(1,5,obj{(a)}.x+ship_wx,obj{(a)}.y,2,-1)
obj{(a)}.viz=visible:IF visible viz$+=":"+FNdig(2,a)
PROCon_radar(25,obj{(a)}.x,obj{(a)}.y)

WHEN 14 : REM Astronaut following landscape (roaming)
obj{(a)}.yv+=1:REM Tendency to move to high ground
IF ABS(obj{(a)}.yv)>1 obj{(a)}.yv=SGN(obj{(a)}.yv)*1
obj{(a)}.x+=obj{(a)}.xv
obj{(a)}.y+=obj{(a)}.yv
PROCx_adjust
h=FNaltitude(obj{(a)}.x)
IF obj{(a)}.y>h+32 obj{(a)}.y=h+32:obj{(a)}.yv=0
PROCdraw_bmp(1,6,obj{(a)}.x+ship_wx,obj{(a)}.y,2,-1)
obj{(a)}.viz=visible:IF visible viz$+=":"+FNdig(2,a)
PROCon_radar(26,obj{(a)}.x,obj{(a)}.y)

WHEN 15 : REM Astronaut captured by alien
IF obj{(obj{(a)}.tgt)}.sts<>6 THEN
obj{(a)}.tgt=-1:obj{(a)}.sts=16
ELSE
obj{(a)}.y=obj{(obj{(a)}.tgt)}.y-20
ENDIF
PROCx_adjust
PROCdraw_bmp(1,6,obj{(a)}.x+ship_wx,obj{(a)}.y,2,-1)
obj{(a)}.viz=visible:IF visible viz$+=":"+FNdig(2,a)
PROCon_radar(26,obj{(a)}.x,obj{(a)}.y)

WHEN 16 : REM Astronaut falling
obj{(a)}.yv-=0.25:REM Tendency to move to high ground
obj{(a)}.y+=obj{(a)}.yv
IF ABS(obj{(a)}.yv)>6 obj{(a)}.yv=SGN(obj{(a)}.yv)*6
PROCx_adjust
h=FNaltitude(obj{(a)}.x)
IF obj{(a)}.y<h+32 THEN
IF obj{(a)}.yv=-6 THEN
obj{(a)}.sts=3:obj{(a)}.c=0
ELSE
obj{(a)}.yv=0:obj{(a)}.sts=14
score+=250:PROCmake_bonus(16,obj{(a)}.x,obj{(a)}.y+18)
ENDIF
ENDIF
PROCdraw_bmp(1,6,obj{(a)}.x+ship_wx,obj{(a)}.y,2,-1)
obj{(a)}.viz=visible:IF visible viz$+=":"+FNdig(2,a)
PROCon_radar(26,obj{(a)}.x,obj{(a)}.y)

WHEN 17 : REM Astronaut hanging on to ship
obj{(a)}.x=0
obj{(a)}.y=ship_y-20
h=FNaltitude(obj{(a)}.x)
IF obj{(a)}.y<h+32 AND NOT dropdelay THEN
obj{(a)}.sts=14
score+=500:PROCmake_bonus(18,obj{(a)}.x,obj{(a)}.y+18)
dropdelay=TRUE
ENDIF
IF NOT ship_alive obj{(a)}.sts=16
PROCdraw_bmp(1,6,obj{(a)}.x+ship_wx,obj{(a)}.y,2,-1)
obj{(a)}.viz=visible:IF visible viz$+=":"+FNdig(2,a)
PROCon_radar(26,obj{(a)}.x,obj{(a)}.y)

WHEN 21 : REM Minelayer
IF obj{(a)}.y<200 h=0.08 ELSE h=-0.08
obj{(a)}.yv+=h:REM attraction towards centre of display
obj{(a)}.x+=obj{(a)}.xv
obj{(a)}.y+=obj{(a)}.yv
PROCx_adjust
PROCdraw_bmp(1,7,obj{(a)}.x+ship_wx,obj{(a)}.y,2,-1)
obj{(a)}.viz=visible:IF visible viz$+=":"+FNdig(2,a)
PROCon_radar(27,obj{(a)}.x,obj{(a)}.y)
IF ABS(obj{(a)}.x)<640 THEN
IF RND(250)<=rate_of_fire PROCmake_bullet(1,obj{(a)}.x,obj{(a)}.y)
ENDIF

WHEN 25 : REM Box
obj{(a)}.x+=obj{(a)}.xv
obj{(a)}.y+=obj{(a)}.yv
IF obj{(a)}.y<8 obj{(a)}.y=400
IF obj{(a)}.y>400 obj{(a)}.y=8
PROCx_adjust
PROCdraw_bmp(1,8,obj{(a)}.x+ship_wx,obj{(a)}.y,2,-1)
PROCdraw_bmp(3,36,obj{(a)}.x+ship_wx-4,obj{(a)}.y+2,3,192-2^(obj{(a)}.strb/2))
obj{(a)}.viz=visible:IF visible viz$+=":"+FNdig(2,a)
PROCon_radar(28,obj{(a)}.x,obj{(a)}.y)

WHEN 28 : REM Tiny Saucer
h=(12+(a MOD 8))/10:REM Accel varies
d=8+(a MOD 8)/4:REM Max velocity varies
IF RND(4)>2 obj{(a)}.xv-=SGN(obj{(a)}.x)*h
IF RND(4)>2 obj{(a)}.yv+=SGN(ship_y-obj{(a)}.y)*h
IF ABS(obj{(a)}.xv)>d obj{(a)}.xv=d*SGN(obj{(a)}.xv)
IF ABS(obj{(a)}.yv)>d obj{(a)}.yv=d*SGN(obj{(a)}.yv)
obj{(a)}.x+=obj{(a)}.xv
obj{(a)}.y+=obj{(a)}.yv
IF obj{(a)}.y<8 obj{(a)}.y=400
IF obj{(a)}.y>400 obj{(a)}.y=8
PROCx_adjust
PROCdraw_bmp(1,9,obj{(a)}.x+ship_wx,obj{(a)}.y,2,-1)
obj{(a)}.viz=visible:IF visible viz$+=":"+FNdig(2,a)
PROCon_radar(29,obj{(a)}.x,obj{(a)}.y)

WHEN 30 : REM UFO
obj{(a)}.y+=SGN(ship_y-obj{(a)}.y)*0.5
REM Limit UFO velocity
obj{(a)}.xv-=SGN(obj{(a)}.x)*4
IF ABS(obj{(a)}.x)>480 THEN h=24 ELSE h=ABS(obj{(a)}.xv*1.25):IF h>24 h=24
IF ABS(obj{(a)}.x)<320 h=18
IF ABS(obj{(a)}.x)<64 h=4
IF ABS(obj{(a)}.xv)>h THEN obj{(a)}.xv=SGN(obj{(a)}.xv)*h
obj{(a)}.x+=obj{(a)}.xv
PROCx_adjust
PROCdraw_bmp(1,10,obj{(a)}.x+ship_wx,obj{(a)}.y,2,-1)
obj{(a)}.viz=visible:IF visible viz$+=":"+FNdig(2,a)
PROCon_radar(30,obj{(a)}.x,obj{(a)}.y)

ENDCASE

REM Firing at ship (Minelaying handled separately)
IF obj{(a)}.sts>3 AND obj{(a)}.viz AND obj{(a)}.fire=TRUE AND ship_alive THEN
IF ABS(obj{(a)}.x)<460 THEN
IF obj{(a)}.type=1 h=100 ELSE h=1000:REM UFO rate of fire is higher
IF RND(h)<=rate_of_fire PROCmake_bullet(0,obj{(a)}.x,obj{(a)}.y)
ENDIF
ENDIF

NEXT
ENDPROC

REM Adjust object x for ship movement and edge of wrap-around
DEF PROCx_adjust
obj{(a)}.x-=ship_xv
IF obj{(a)}.x>=1600 obj{(a)}.x-=3200
IF obj{(a)}.x<-1600 obj{(a)}.x+=3200
ENDPROC

REM Reposition alien at the top of the display
DEF PROCreset_alien(i)
LOCAL xv
obj{(i)}.x=FNrndx
obj{(i)}.y=400
xv=RND(2)*2:IF RND(2)=1 xv*=-1
obj{(i)}.xv=xv
IF obj{(i)}.sts<>0 obj{(i)}.sts=2:obj{(i)}.c=32
ENDPROC

REM Initial Status & Type:
REM 1 & 4 = Alien lander
REM 14 & 6 = Astronaut
REM 21 & 7 = Minelayer
REM 1 & 8 = Box
DEF PROCpopulate
LOCAL a,d,xv,yv,max
REM Standard number of alien landers
FOR a=0 TO 17
xv=RND(2)*2:IF RND(2)=1 xv*=-1
d=FNnew_obj(1,4,FNrndx,400,xv,0,28,16):REM base sts 4 - Alien
obj{(d)}.c=(a DIV 6)*25*8:REM Countdown to appearance (waves of ships)
NEXT
IF astro$="" OR (level MOD 4)=0 THEN max=10 ELSE max=LEN(astro$)DIV 3
astro$=""
REM Limit to astronauts still alive
IF max>0 AND normal THEN
FOR a=0 TO max-1
xv=1:IF RND(2)=1 xv*=-1
d=FNnew_obj(14,6,FNrndx,0,xv,0,8,16):REM base sts 14 - Astronaut
astro$+=":"+FNdig(2,d)
NEXT
ENDIF
REM Minelayers
max=(score+4000) DIV 5000:IF max>8 max=8
IF max>0 THEN
FOR a=0 TO max-1
xv=4:IF RND(2)=1 xv*=-1
d=FNnew_obj(21,7,FNrndxb,RND(300)+50,xv,0,20,16):REM base sts 21 - Minelayer
NEXT
ENDIF
REM Boxes
IF max>0 THEN
max=(score+4000) DIV 8000:IF max>8 max=8
FOR a=0 TO max-1
xv=RND(10)/10:IF RND(2)=1 xv*=-1
yv=RND(5)/10:IF RND(2)=1 yv*=-1
d=FNnew_obj(1,8,FNrndxc,RND(300)+50,xv,yv,20,16):REM base sts 25 - Box
obj{(d)}.c=0
NEXT
ENDIF
newlevel=FALSE
ENDPROC

REM When the player loses a life, all objects need to assume
REM new starting positions, based on type & current status
DEF PROCreset_places
LOCAL a
FOR a=0 TO MAXobj
CASE obj{(a)}.type OF
WHEN 1 : REM UFO
PROCkill_obj(a)
WHEN 4 : REM Alien (including mutants)
CASE obj{(a)}.sts OF
WHEN 2,4,5,6
obj{(a)}.sts=2:obj{(a)}.c=32:REM Implode
obj{(a)}.x=FNrndx
obj{(a)}.y=400
obj{(a)}.yv=0
obj{(a)}.tgt=-1
WHEN 7 :REM Mutant
obj{(a)}.x=FNrndxb
obj{(a)}.y=RND(200)+100
ENDCASE
WHEN 6 : REM Astronaut
obj{(a)}.sts=14
obj{(a)}.x=FNrndx
obj{(a)}.y=0
obj{(a)}.tgt=-1
WHEN 7,9 : REM Minelayer & Tiny Saucer
obj{(a)}.x=FNrndxb
obj{(a)}.y=RND(300)+50
obj{(a)}.yv=0
WHEN 8 : REM Box
obj{(a)}.sts=2:obj{(a)}.c=32:REM Implode
obj{(a)}.x=FNrndxc
obj{(a)}.y=RND(300)+50
ENDCASE
NEXT
ENDPROC

DEF PROCmake_saucers(N,x,y)
LOCAL a,d,xo,yo,xv,yv
FOR a=0 TO N-1
xo=x+(RND(20)-10)*2:yo=y+(RND(20)-10)*2
IF yo<8 yo=400
IF yo>400 yo=8
xv=RND(8)-4:yv=RND(4)-2
d=FNnew_obj(28,9,xo,yo,xv,yv,20,8):REM base sts 28 - Tiny saucer
NEXT
ENDPROC

DEF PROCmake_ufo
LOCAL d
IF ufocount=8 ENDPROC
ufodelay=0
d=FNnew_obj(1,1,FNrndxb,RND(300)+50,0,0,40,8):REM base sts 30 - UFO
IF d<>-1 obj{(d)}.c=0:ufocount+=1
ENDPROC

DEF FNrndx
=RND(3200)-1601

DEF FNrndxb
LOCAL x
x=RND(800)+600:IF RND(2)=1 x*=-1
=x

DEF FNrndxc
=RND(800)-400

DEF FNnew_obj(sts,type,x,y,xv,yv,w,h)
LOCAL i
IF stkptr>MAXobj THEN =-1
i=stk(stkptr):stkptr+=1
obj{(i)}.sts=sts
obj{(i)}.type=type
obj{(i)}.x=x
obj{(i)}.y=y
obj{(i)}.xv=xv
obj{(i)}.yv=yv
obj{(i)}.w=w:REM For collision testing
obj{(i)}.h=h
obj{(i)}.tgt=-1:REM Alien chosen astronaut
IF INSTR(armed$,STR$(type))>0 obj{(i)}.fire=TRUE ELSE obj{(i)}.fire=FALSE
obj{(i)}.strb=RND(16)-1:REM Strobe
=i

DEF PROCkill_obj(i)
IF obj{(i)}.type=1 ufocount-=1
stkptr-=1:stk(stkptr)=i
obj{(i)}.sts=0:obj{(i)}.type=0
PROCrmv_str(":"+FNdig(2,i),astro$)
ENDPROC

REM Clear all objects etc
DEF PROCdepopulate
LOCAL a
FOR a=0 TO MAXobj:obj{(a)}.sts=0:obj{(a)}.type=0:stk(a)=a:NEXT
stkptr=0
ENDPROC

REM *********************************************************************
REM Ground
REM *********************************************************************

DEF FNaltitude(x)
x=x+ship_gx
IF x<0 x+=3200
IF x>=3200 x-=3200
=gnd(x DIV 4)*4

REM Create bitmap from gnd() table based on ship position, to be stretched
DEF PROCshow_ground
LOCAL gx,x,y,i,w,h,col
REM Create colour for level
i=((level DIV 4)+1)MOD 8
IF (i AND 1)>0 col+=&F0
IF (i AND 2)>0 col+=&F000
IF (i AND 4)>0 col+=&F00000
w=bmp{(0)}.w:h=bmp{(0)}.h
REM CLS
SYS "SelectObject",mDC%,bmp{(0)}.bmphnd%
SYS "SelectObject",cDC%,bmp{(1)}.bmphnd%
SYS "BitBlt",cDC%,0,0,w,h,mDC%,0,0,&CC0020
REM Find start position
gx=ship_gx DIV 4
gx-=ship_wx DIV 4
x=0
REPEAT
i=gx+x:IF i<0 i+=800 ELSE IF i>=800 i-=800
SYS "SetPixel",cDC%,x,h-gnd(i)-2,col
x+=1
UNTIL x=162
x=(ship_wx MOD 4)-(ship_gx MOD 4)
SYS "StretchBlt",@memhdc%,x,511-40*4-32,w*4,h*4,cDC%,0,0,w-1,h,&CC0020
ENDPROC

REM Create an undulating landscape of 800 units (0-39 height)
DEF PROCmake_ground
LOCAL x,y,a,d
FOR x=0 TO 799
a=x/800*360
d=SIN(RAD(a*5))*0.8+SIN(RAD(27+a*23))+SIN(RAD(47+a*31))+SIN(RAD(51+a*47))*1.5
IF d<=-1 y-=1
IF d>=1 y+=1
gnd(x)=y
NEXT
REM Create bitmaps for use in displaying stretched landscape
w=160+1:h=40
N=0:bmp{(N)}.w=w:bmp{(N)}.h=h:REM Will remain blank to use as CLS
SYS "CreateCompatibleBitmap",@memhdc%,w,h TO bmp{(N)}.bmphnd%
N=1:bmp{(N)}.w=w:bmp{(N)}.h=h
SYS "CreateCompatibleBitmap",@memhdc%,w,h TO bmp{(N)}.bmphnd%
ENDPROC

REM *********************************************************************
REM Windows API for Bitmaps
REM *********************************************************************

DEF PROCdraw_bmp(type,N,x,y,scale,fade)
LOCAL w,h,tempbm%
w=bmp{(N)}.w:h=bmp{(N)}.h:visible=FALSE
REM Adjust x,y for Windows origin and to centre bitmap
x=x+bmpxo-w*scale DIV 2
y=-y+bmpyo-h*scale DIV 2
IF x+w*scale<0 OR x>=640 OR y+h*scale<0 OR y>=512 ENDPROC
CASE type OF
WHEN 0 : REM Stretch
SYS "SelectObject",cDC%,bmp{(N)}.bmphnd%
SYS "StretchBlt",@memhdc%,x,y,w*scale,h*scale,cDC%,0,0,w,h,&CC0020
WHEN 1 : REM Transparent (&000000=black not plotted)
SYS "SelectObject",cDC%,bmp{(N)}.bmphnd%
SYS `TransparentBlt,@memhdc%,x,y,w*scale,h*scale,cDC%,0,0,w,h,&000000
WHEN 2 : REM Alphabland
SYS "SelectObject",cDC%,bmp{(N)}.bmphnd%
SYS `AlphaBlend,@memhdc%,x,y,w*scale,h*scale,cDC%,0,0,w,h,fade<<16
WHEN 3 : REM Alphablend with mask
REM Create a temporary bitmap to store data copied from display
REM (We will use this to replace portions of the background)
SYS "CreateCompatibleBitmap",@memhdc%,w*scale,h*scale TO tempbm%
SYS "SelectObject",cDC%,tempbm%
SYS "BitBlt",cDC%,0,0,w*scale,h*scale,@memhdc%,x,y,&CC0020
REM Use the mask to black out portions of the data just copied
SYS "SelectObject",mDC%,bmp{(N)}.mskhnd%
SYS `TransparentBlt,cDC%,0,0,w*scale,h*scale,mDC%,0,0,w,h,&FFFFFF
REM Alphablend the bitmap with the display
SYS "SelectObject",cDC%,bmp{(N)}.bmphnd%
SYS `AlphaBlend,@memhdc%,x,y,w*scale,h*scale,cDC%,0,0,w,h,fade<<16
REM Replace portions of the background that we wanted to remain unaffected
SYS "SelectObject",cDC%,tempbm%
SYS `TransparentBlt,@memhdc%,x,y,w*scale,h*scale,cDC%,0,0,w*scale,h*scale,&000000
REM Tidy up
SYS "DeleteObject",tempbm%
ENDCASE
visible=TRUE
ENDPROC

DEF PROCinit_bmp
REM Funky Windows stuff for handling bitmaps
SYS "LoadLibrary","MSIMG32.DLL" TO msimg32%
SYS "GetProcAddress",msimg32%,"TransparentBlt" TO `TransparentBlt
SYS "GetProcAddress",msimg32%,"AlphaBlend" TO `AlphaBlend
REM Create DC compatible with current display (for use with any bitmap created)
SYS "CreateCompatibleDC",0 TO cDC%
SYS "CreateCompatibleDC",0 TO mDC%:REM For use with mask bitmaps
ENDPROC

REM Create a user-defined bitmap: our_ID,width,height,coded description,colour
REM Coded description is similar to user-defined character creation, but variable size.
REM Colours defined by Red, Green & Blue.
REM User can add layers of different colours with more than one call to this procedure.
REM This version also creates a mask for use with Alphablend
DEF PROCmake_bmp(N,w,h,d$,r,g,b)
LOCAL x,y,i,v,col,new:new=FALSE
col=r+(g<<8)+(b<<16)
d$+=","
IF bmp{(N)}.bmphnd%=0 THEN
new=TRUE
bmp{(N)}.w=w:bmp{(N)}.h=h
SYS "CreateCompatibleBitmap",@memhdc%,w,h TO bmp{(N)}.bmphnd%
SYS "CreateCompatibleBitmap",@memhdc%,w,h TO bmp{(N)}.mskhnd%
ENDIF
SYS "SelectObject",cDC%,bmp{(N)}.bmphnd%
SYS "SelectObject",mDC%,bmp{(N)}.mskhnd%
IF new FOR y=0 TO h-1:FOR x=0 TO w-1:SYS "SetPixel",mDC%,x,y,&FFFFFF:NEXT:NEXT:REM Mask white
FOR y=0 TO h-1
i=INSTR(d$,",")
IF i<>0 THEN
v=VAL(LEFT$(d$,i-1)):d$=RIGHT$(d$,LEN(d$)-i)
FOR x=w-1 TO 0 STEP-1
IF v>=2^x THEN
v-=2^x
SYS "SetPixel",cDC%,w-x-1,y,col
SYS "SetPixel",mDC%,w-x-1,y,&000000:REM Mask
ENDIF
NEXT
ENDIF
NEXT
ENDPROC

REM Make a reasonable effort to release used Windows resources
DEF PROCcleanup_bmp
LOCAL a
FOR a=0 TO MAXbmp
IF bmp{(a)}.bmphnd%<>0 SYS "DeleteObject",bmp{(a)}.bmphnd%
IF bmp{(a)}.mskhnd%<>0 SYS "DeleteObject",bmp{(a)}.mskhnd%
NEXT
SYS "DeleteObject",cDC%
SYS "DeleteObject",mDC%
SYS "FreeLibrary",msimg32%
ENDPROC

REM *********************************************************************
REM Intro & Hi-Score Table
REM *********************************************************************

DEF PROCnew_score(sc)
LOCAL a,b
IF sc<=hi{(9)}.sc ENDPROC
a=0:WHILE sc<=hi{(a)}.sc:a+=1:ENDWHILE
IF a<9 THEN
FOR b=9 TO a+1 STEP-1
hi{(b)}.sc=hi{(b-1)}.sc
hi{(b)}.name$=hi{(b-1)}.name$
NEXT
ENDIF
hi{(a)}.sc=sc:hi{(a)}.name$=""
PROCshow_scores(TRUE)
PROCget_name(a)
ENDPROC

DEF PROCget_name(y)
LOCAL n$,k$,k,okay
ON:COLOUR 3
REPEAT
PRINTTAB(30,y+8);n$;" " TAB(30+LEN(n$),y+8);
k$=INKEY$(12)
k=ASC(k$):IF k>=32 AND k<=122 okay=TRUE ELSE okay=FALSE
CASE k OF
WHEN 8 : n$=LEFT$(n$,LEN(n$)-1)
OTHERWISE : IF okay AND LEN(n$)<10 n$+=k$
ENDCASE
UNTIL k=13
hi{(y)}.name$=n$
OFF
ENDPROC

DEF PROCshow_scores(needname)
LOCAL a
CLS:OFF
*FONT Courier New,24,BU
COLOUR 1:PRINTTAB(7,1);"Planetoid Defender"
GCOL 3,1:RECTANGLEFILL 0,860,1279,100
*FONT Courier New,24,B
COLOUR 2:PRINTTAB(12,3);"Hi-Scores"
COLOUR 7
*FONT Courier New,16,B
FOR a=0 TO 9
COLOUR 7:PRINTTAB(10,a+8);FNpad(7,hi{(a)}.sc)
COLOUR 6:PRINTTAB(20,a+8);"........"
COLOUR 7:PRINTTAB(30,a+8);hi{(a)}.name$
NEXT
*FONT Courier New,16,B
COLOUR 3
IF needname THEN
PRINTTAB(12,20);"Please enter your name"
ELSE
PRINTTAB(14,20);"Press SPACE to play"
ENDIF
ENDPROC

DEF FNpad(n,v)
=STRING$(n-LEN(STR$(v))," ")+STR$(v)

DEF PROCintro
CLS:OFF
*FONT Courier New,24,BU
COLOUR 1:PRINTTAB(7,1);"Planetoid Defender"
GCOL 3,1:RECTANGLEFILL 0,860,1279,100
COLOUR 7
*FONT Courier New,16,B
PRINTTAB(14,6);"A - Up"
PRINTTAB(14,8);"Z - Down"
PRINTTAB(14,10);"M - Thrust"
PRINTTAB(14,12);"K - Fire"
PRINTTAB(10,14);"SPACE - Reverse direction"
PRINTTAB(12,16);"TAB - Smart Bomb"
COLOUR 3:PRINTTAB(14,20);"Press SPACE to play"
ENDPROC

DEF PROCsave_scores
LOCAL x,a
x=OPENOUT("hi.txt")
IF x=0 ENDPROC
FOR a=0 TO 9
PRINT#x,hi{(a)}.sc,hi{(a)}.name$
NEXT
CLOSE#x
ENDPROC

DEF PROCload_scores
LOCAL x,a
x=OPENIN("hi.txt")
IF x=0 THEN
FOR a=0 TO 9
hi{(a)}.sc=(10-a)*100
hi{(a)}.name$="BB4W"
NEXT
ELSE
FOR a=0 TO 9
INPUT#x,hi{(a)}.sc,hi{(a)}.name$
NEXT
CLOSE#x
ENDIF
ENDPROC

window specific operations need replacing with SDL calls

[Ric]

Hi Repton

I am afraid i have no knowledge of SDL so it would not be possible for me to convert at this moment in time, but it is a nice play on an old game and performs well. I like it a lot.

Regards Ric

[p_m21987]

You should put your code in code tags when you post it on the forums.