REM Choplifter 2012 by RWJ MMXII
MODE 19:OFF
SYS "SetWindowText", @hwnd%,"Choplifter"
REM Inhibit resize
SYS "GetWindowLong", @hwnd%, -16 TO ws%
SYS "SetWindowLong", @hwnd%, -16, ws% AND NOT &50000
*FONT ARIAL,18,B
*ESC OFF
*REFRESH OFF
ONERROR OSCLI("REFRESH ON"):REPORT:END
COLOUR 8,128,128,128:REM Grey
COLOUR 9,0,128,255:REM House blue
COLOUR 10,240,80,0:REM Orange
COLOUR 11,32,192,0:REM Green
COLOUR 12,32,32,32:REM Dark Grey moon
COLOUR 13,148,0,224:REM Ground purple
COLOUR 14,80,80,80:REM Medium Grey
COLOUR 15,0,128,0:REM Dark Green
VDU 23,224,96,240,240,96,0,0,0,0
REM Vertex: vertices, max_r^2,x,y,x,y,...,nmlx,nmly,nmlx,nmly,...
MAXvtx=99:DIM vtx(MAXvtx,33)
REM 'Drawing' vertices, Index pointers(start, vertices), Store of helicopter co-ords, Store of tank barrel
DIM waldo(299,1),waldo_index(39,1),store(33,1),barrel(10,1)
REM Mountain graphics control strings, mountain range, running man, tank base, tank gun
DIM hill_c$(4),peak_c$(9),run_c$(5),tbase_c$(4),ttop_c$(4),ufo_c$(3)
PROCread_dots:PROCstore_barrel
REM Objects
MAXobj=299:DIM obj(MAXobj,10)
DIM active$(4),stk$(4):REM Depth levels 0-4 (depth relates to plotting sequence)
REM Difficulty Control
DIM dc(9)
ox=320:oy=80:sky=480-oy-80:REM Graphics origin & 'sky' limit
REM Text alignment
DIM size{cx%,cy%},ra(1)
PROCget_len("8888"):ra(0)=ox*2+size.cx%
PROCget_len("Best"):ra(1)=ox*4-size.cx%*2-40
REM Starfield
MAXstars=99:DIM stars(MAXstars,1)
FOR A=0 TO MAXstars-1
stars(A,0)=RND(640)-1:stars(A,1)=RND(sky)+8
NEXT
wave=0:REM Flag flutter
moonglow=RND(1):wax=RND(2):REM Moon stuff
gravity=0.05:REM Helicopter 'gravity'
HELunit=12:REM heli_R=SQR(HELunit^2*2)
BANGunit=16:REM Explosion radius
MANunit=4:REM Man scale
TNKunit=4:REM Tank scale
PRDunit=4:REM Predator scale
MSSunit=4:REM Missile unit
UFOunit=6
egress=0:REM Delay
tnkstk$="123":prdstk$="12":ufostk$="12":REM Tanks, Predator drones & UFOs
dropzone=500:REM Width of area within which drone missiles are dropped
ctrl_type$="J":REM Joystick input
REM *** Joystick limits ***
MAXjoyx=65408:MAXjoyy=65408
MINjoyx=0:MINjoyy=0
ACCELrange=80:MAXxv=16:MAXyv=4
y_axis=1:REM For reversing joystick y-axis
REM Button pauses
but1pause=0:but4pause=0:jpause=0
ZONEwidth=640
WANDERmin=0:WANDERmax=6*ZONEwidth:REM People & Tank movement limits
best_score=0
REPEAT
PROCmenu:fin=FALSE
lives=3:passengers=0:rescued=0:dead=0:nearest$="":REM 'wandering' people (not passengers)
PROCset_stage:build_count=1:PROCrebuild:obj(13,1)=2:REM Hole the first building
REM Main animation loop
REPEAT
TIME=0:CLS:PROCbackground
IF build_count<rescued+dead AND (rescued+dead)MOD64=0 build_count=rescued+dead:PROCrebuild:REM Rebuild all 4 houses
PROCuser:PROCflight_model
view_x=heli_x:REM View centred on helicopter
REM Rotor animation (overrides stored values in data)
waldo(6,0)=3*FNblade_r:waldo(7,0)=-3*FNblade_l:REM Helicopter
waldo(waldo_index(2,0)+26,1)=1.5*FNblade_r:waldo(waldo_index(2,0)+27,1)=-1.5*FNblade_l:REM Predator
rotor+=90:IF rotor>=360 rotor-=360:REM Rotor spin
PROCobjects(0)
PROCobjects(1)
emp=FALSE:PROCobjects(2)
PROCobjects(3)
shrapnel$="":PROCobjects(4)
PROCeol
IF ctrl_type$="M" GCOL0,7:@vdu%!248=2:LINE mx,0,mx,4:LINE 1278,my,1274,my:@vdu%!248=1
*REFRESH
WAIT 4-TIME
UNTIL lives=0 OR fin=TRUE
PROCrelease_mouse
UNTIL0
END
REM **********************************************************************
REM ******************** Object Animation & Control ********************
REM **********************************************************************
REM Set/Reset environment variables
REM Object types:
REM 1 = House
REM 2 = Safe House
REM 3 = Mountain range
REM 4 = Fence
REM 5 = Helicopter
REM 6 = Bullet
REM 7 = Bomb
REM 8 = Explosion
REM 9 = Tank shell
REM 10 = Missile
REM 11 = UFO
REM 12 = Person
REM 13 = Tank
REM 14 = Tank barrel
REM 15 = Predator drone
REM Depth plotting: active$()
REM 0 = Scenery (mountains, houses, safe house, fence) 0-19
REM 1 = People & Missiles 20-49
REM 2 = Vehicles (tanks, planes, UFOs) 50-59
REM 3 = Helicopter 60
REM 4 = Ordnance (bombs, bullets, explosions etc) 61-MAXobj
DEF PROCset_stage
LOCAL start,M,i,A,house
REM Difficulty level
PROCamend_difficulty
REM level=2:REM Game difficulty/aggressiveness
highroad$="":REM Quick lookup for predator altitudes in use
shrapnel$=""
active$()=""
REM Load stack with pointers to free object elements
stk$()=""
FOR i=20 TO 49:stk$(1)+=FNtri(i):NEXT
FOR i=50 TO 59:stk$(2)+=FNtri(i):NEXT
REM *** Depth 0 ***
REM Mountain scenery
start=1
FOR M=1 TO 6
i=start+M-1
obj(i,0)=3:REM Mountain range comprised of 3 random segments
obj(i,1)=M-1:REM Easy ref pointer to peak_c$()
obj(i,2)=(M-2)*ZONEwidth*2+ZONEwidth:obj(i,3)=2
active$(0)+=FNtri(i)
peak_c$(M-1)="":FOR A=1 TO 3:peak_c$(M-1)+=CHR$(64+RND(11)):NEXT
NEXT
REM Buildings in Zones
start=10
FOR house=1 TO 4
i=start+house-1
obj(i,0)=1:REM House
obj(i,1)=2:REM 1=Intact, 2=Holed
obj(i,2)=(house-1)*ZONEwidth+ZONEwidth/2:obj(i,3)=0
active$(0)+=FNtri(i)
NEXT
house=8:i=start+house-1:REM Safe House
obj(i,0)=2:REM Safe Houses (obj type=2)
obj(i,2)=(house-1)*ZONEwidth+ZONEwidth/2:obj(i,3)=0
active$(0)+=FNtri(i)
REM Fence
start=19:i=start:obj(i,0)=4:obj(i,2)=6*ZONEwidth+ZONEwidth/2:active$(0)+=FNtri(i)
REM *** Depth 2 ***
REM Initialise tanks
livetnk$="":REM Quick lookup for collision detection
FOR M=1 TO LEN(tnkstk$)
i=FNget_free_cell(2):IF i<>-1 obj(i,0)=14:obj(i,1)=0:obj(i,3)=VAL(MID$(tnkstk$,M,1)):livetnk$+=FNtri(i)
NEXT
REM Initialise drones
liveprd$="":REM Quick lookup for collision detection
FOR M=1 TO LEN(prdstk$)
i=FNget_free_cell(2):IF i<>-1 obj(i,0)=15:obj(i,1)=0:obj(i,6)=VAL(MID$(prdstk$,M,1)):liveprd$+=FNtri(i)
NEXT
REM Initialise UFOs
liveufo$="":REM Quick lookup for collision detection
FOR M=1 TO LEN(ufostk$)
i=FNget_free_cell(2):IF i<>-1 obj(i,0)=11:obj(i,1)=0:obj(i,6)=VAL(MID$(ufostk$,M,1)):liveufo$+=FNtri(i)
NEXT
REM *** Depth 3 ***
REM Helicopter variables
start=60:i=start:obj(i,0)=5:active$(3)=FNtri(i):REM Obj060 reserved for helicopter
FOR i=61 TO MAXobj:stk$(4)+=FNtri(i):NEXT
REM Helicopter variables
heli_x=4680:heli_y=0
heli_xv=0:heli_yv=0:REM Velocity vectors
heli_xa=0:heli_ya=0:REM Acceleration vectors. Target acceleration set by joystick, amended by environment
heli_mass=10:REM Mass affects acceleration (fill up with people - NOT USED)
heli_o=-1:REM orientation (left/right)
heli_fly=TRUE:REM User in control
heli_shoot=FALSE
landed=TRUE:rotor=0
candb_sts=0:splat=1:REM Crash & burn status, helicopter stretch
ENDPROC
REM Reset buildings when all occupants dead or rescued
DEF PROCrebuild
LOCAL start,i
start=10
FOR house=1 TO 4
i=start+house-1
obj(i,1)=1:REM 1=Intact, 2=Holed
obj(i,4)=16:REM Occupants
obj(i,5)=10:REM Countdown to first escapee release
NEXT
ENDPROC
REM Main routine to process all objects
DEF PROCobjects(depth)
LOCAL A$,i,gx,ctrl$,p,r$,x,y,xv,yv,type,a,ey
A$=active$(depth)
WHILE A$<>""
i=VAL(MID$(A$,2,3)):A$=RIGHT$(A$,LEN(A$)-4)
CASE obj(i,0) OF
WHEN 1
REM Houses: type, sts, x, 3, occupants, countdown
IF obj(i,1)=1 THEN
IF FNshrapnel_hit(obj(i,2),8*4) obj(i,1)=2
ELSE
REM holed (spit out people)
obj(i,5)-=1
IF obj(i,5)<=0 THEN
obj(i,5)=6+RND(8)
IF obj(i,4)>0 THEN
IF LEN(nearest$)<24 THEN
p=FNget_free_cell(1):REM People section
IF p<>-1 THEN
obj(i,4)-=1:PROCinit_obj(p,12,0,obj(i,2),0,0,0):nearest$+=FNtri(p):REM Add person
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
gx=obj(i,2)-view_x
IF FNonscreen(gx,8*4) THEN
IF obj(i,1)=1 ctrl$=house_c1$ ELSE ctrl$=house_c2$:PROCexplode(gx+ox,oy+2,.75,.5,1,.25)
PROCdrawing(1,gx,obj(i,3),8,ctrl$,0,1,FALSE)
ENDIF
WHEN 2
REM Lawn & Safe House
gx=obj(i,2)-48-view_x
IF FNonscreen(gx,12*12) THEN
PROCdrawing(4,gx,obj(i,3),12,lawn_c$,0,1,FALSE)
PROCflag(gx+ox+112,oy+32,wave,24,16):wave+=36:IF wave>=360 wave-=360
ENDIF
gx=obj(i,2)-view_x
IF FNonscreen(gx,6*12) THEN
PROCdrawing(3,gx,obj(i,3),6,safe_c$,0,1,FALSE)
ENDIF
WHEN 3
REM Mountains
gx=(obj(i,2)-view_x)/2
IF FNonscreen(gx,12*5) THEN
FOR p=1 TO 3:r$=MID$(peak_c$(obj(i,1)),p,1):x=(p-2)*3*12
CASE r$ OF
WHEN "A","B","C","D","E" : PROCdrawing(ASC(r$)-60,gx+x,obj(i,3),12,hill_c$(ASC(r$)-65),0,.5,FALSE)
WHEN "F","G","H","I","J" : PROCdrawing(ASC(r$)-65,gx+x,obj(i,3),12,hill_c$(ASC(r$)-70),0,.5,TRUE)
ENDCASE
NEXT
ENDIF
WHEN 4
REM Fence
FOR x=0 TO 4
gx=(obj(i,2)-view_x)*(1+x/4):w=3+2*x/4
IF FNonscreen(gx,w*3) PROCdrawing(10,gx,0-x*10,w,fence_c$,0,1,FALSE)
NEXT
WHEN 5
REM Helicopter
CASE heli_o OF
WHEN -1 : c$=heli_c1$
WHEN 0 : c$=heli_c3$
WHEN 1 : c$=heli_c2$
ENDCASE
PROCstore_heli(heli_x,heli_y,HELunit,heli_xa):REM Store vertex co-ords for later use
PROCdrawing(0,heli_x-view_x,heli_y+4-(2*HELunit*(1-splat)),HELunit,c$,heli_xa,splat,FALSE)
IF heli_shoot THEN
heli_shoot=FALSE:p=FNget_free_cell(4):REM Ordnance section
IF p<>-1 THEN
IF heli_o=0 THEN
x=store(24,0):y=store(24,1):xv=(store(24,0)-heli_x)*2:yv=(store(24,1)-heli_y)*2
type=7:PROCinit_obj(p,type,20,x,y,xv,yv):REM Bomb
ELSE
x=heli_x:y=heli_y:xv=(store(9,0)-heli_x)*heli_o*3:yv=(store(9,1)-heli_y)*heli_o*3
xv+=heli_xv/2:type=6:PROCinit_obj(p,type,20,x,y,xv,yv):REM Bullet
ENDIF
ENDIF
ENDIF
IF landed AND FNshrapnel_hit(heli_x,HELunit) PROCcandb
WHEN 6
REM Bullet
obj(i,1)-=1
IF obj(i,1)<=0 THEN
PROCput_cell(depth,i)
ELSE
obj(i,2)+=obj(i,4):obj(i,3)+=obj(i,5)
IF obj(i,3)<=0 THEN
obj(i,0)=8:obj(i,1)=0:obj(i,3)=0:shrapnel$+=FNquad(INT(obj(i,2))):REM Hit ground
ELSE
IF FNpred_hit(obj(i,2),obj(i,3)) OR FNufo_hit(obj(i,2),obj(i,3)) obj(i,0)=8:obj(i,1)=0:REM Hit drone or UFO
ENDIF
gx=(obj(i,2)-view_x):GCOL0,3:VDU5:MOVE (ox+gx)*2-4,(oy+obj(i,3))*2+4:VDU224,4
ENDIF
WHEN 7
REM Bomb
obj(i,2)+=obj(i,4):obj(i,3)+=obj(i,5):obj(i,4)*=.75
IF obj(i,3)<=-oy THEN
REM obj(i,0)=8:obj(i,1)=0:REM obj(i,3)=-oy+BANGunit:REM Hit ground
PROCput_cell(depth,i)
ELSE
IF FNtank_hit(obj(i,2),obj(i,3)) obj(i,0)=8:obj(i,1)=0:REM Hit tank
ENDIF
gx=(obj(i,2)-view_x):GCOL0,3:VDU5:MOVE (ox+gx)*2-4,(oy+obj(i,3))*2+4:VDU224,4
WHEN 8
REM Explosion
obj(i,1)+=.3
IF obj(i,1)=3 THEN
PROCput_cell(depth,i)
ELSE
gx=(obj(i,2)-view_x):IF FNonscreen(gx,BANGunit) PROCexplode(ox+gx,oy+obj(i,3),obj(i,1),1,.5,1)
ENDIF
WHEN 9
REM Shell
obj(i,2)+=obj(i,4):obj(i,3)+=obj(i,5):obj(i,5)-=1
gx=(obj(i,2)-view_x)
IF obj(i,3)<=0 AND obj(i,5)<0 obj(i,0)=8:obj(i,1)=0:obj(i,3)=0:shrapnel$+=FNquad(INT(obj(i,2))):REM Hit ground
GCOL0,3:VDU5:MOVE (ox+gx)*2-4,(oy+obj(i,3))*2+4:VDU224,4
WHEN 10
REM Missile: type, sts, x, y, angle, velocity, rotation, 7, parent ptr
CASE obj(i,1) OF
WHEN 0
REM Carried by drone
gx=(obj(obj(i,8),2)-view_x+obj(obj(i,8),4))
IF obj(obj(i,8),4)<0 a=-90 ELSE a=90
IF FNonscreen(gx,MSSunit*2) PROCdrawing(15,gx,obj(obj(i,8),3)-PRDunit*2,MSSunit,missile_c$,a,1,FALSE)
WHEN 1,2
REM Tumbling
IF obj(i,1)=1 THEN
obj(i,3)-=4:obj(i,4)+=obj(i,6):IF obj(i,4)>=360 obj(i,4)-=360 ELSE IF obj(i,4)<0 obj(i,4)+=360
ey=RND(2):IF ey=2 ey=-1
ey=ey*RND(1)*(1-dc(6))*HELunit*5:REM Add targeting error
IF FNget_angle(SIN(RAD(obj(i,4))),COS(RAD(obj(i,4))),heli_x-obj(i,2),heli_y-obj(i,3)-ey)<=5 obj(i,1)=2
ELSE
REM Rocketing
IF obj(i,1)=2 THEN
obj(i,2)+=SIN(RAD(obj(i,4)))*12:obj(i,3)+=COS(RAD(obj(i,4)))*12
ENDIF
ENDIF
REM If hit ground then deactivate missile, initiate bullet (for explosion with shrapnel)
IF obj(i,3)<=0 THEN
PROCput_cell(1,i)
p=FNget_free_cell(4):REM Ordnance section
IF p<>-1 PROCinit_obj(p,6,99,obj(i,2),0,0,0)
ELSE
REM Out of bounds?
IF ABS(obj(i,2)-heli_x)>ZONEwidth OR obj(i,3)>sky+80 THEN
PROCput_cell(1,i)
ELSE
REM Hit Helicopter?
IF FNheli_hit(obj(i,2),obj(i,3)) THEN
PROCcandb
PROCput_cell(1,i)
p=FNget_free_cell(4):REM Ordnance section
IF p<>-1 PROCinit_obj(p,8,0,obj(i,2),obj(i,3),0,0)
ENDIF
ENDIF
ENDIF
gx=(obj(i,2)-view_x):IF FNonscreen(gx,MSSunit*2) PROCdrawing(15,gx,obj(i,3),MSSunit,missile_c$,obj(i,4),1,FALSE)
ENDCASE
WHEN 11
REM UFO: type, sts, x, y, xv, 5, #, spin, 8, delay, msg
CASE obj(i,1) OF
WHEN 0
REM Activation & respawn control
IF obj(i,9)>0 THEN
obj(i,9)-=1
ELSE
IF obj(i,6)<=dc(8) THEN
x=RND(2):IF x=2 x=-1
x=heli_x+(ZONEwidth/2+UFOunit*4+RND(50))*x
REM UFO creation points - stepped limitations (& Prevent first vehicle always appearing at same place)
IF x<WANDERmax-ZONEwidth*obj(i,6) THEN
PROCinit_obj(i,11,1,INT(x),sky-UFOunit*3,0,0):obj(i,7)=0:REM Update object details
ELSE
obj(i,9)=RND(25):REM Prevent first vehicle always appearing at same place
ENDIF
ENDIF
ENDIF
WHEN 1
REM Out of range?
IF ABS(obj(i,2)-heli_x)>ZONEwidth OR obj(i,3)>sky+80+UFOunit*2 THEN
obj(i,1)=0:obj(i,9)=dc(9)/4+RND(20)-10:REM respawn countdown
ELSE
REM Check for clobbered
IF obj(i,10)=1 THEN
obj(i,10)=0
obj(i,1)=0:obj(i,9)=dc(9)+RND(20)-10:REM respawn countdown
p=FNget_free_cell(4):IF p<>-1 PROCinit_obj(p,8,0,obj(i,2),obj(i,3),0,0):REM Boom
ENDIF
ENDIF
REM Calculate zig-zagging target waypoint base on height above helicopter
IF obj(i,3)<heli_y+HELunit*4 y=0 ELSE y=(obj(i,3)-(heli_y+HELunit*4))DIV 20
IF y MOD 2=0 x=1 ELSE x=-1
x=x*y*30+heli_x:y=(heli_y+HELunit*4)+y*20:IF obj(i,2)>WANDERmax y=sky+100
IF RND(8)<8 THEN
IF obj(i,2)<x obj(i,4)+=1 ELSE IF obj(i,2)>x obj(i,4)-=1:REM Inject a little randomness into homing
ENDIF
IF ABS(obj(i,4))>12 obj(i,4)=SGN(obj(i,4))*12
obj(i,2)+=obj(i,4)
IF obj(i,3)<y obj(i,5)+=0.25 ELSE IF obj(i,3)>y obj(i,5)-=0.25
IF ABS(obj(i,5))>2 obj(i,5)=SGN(obj(i,5))*2
obj(i,3)+=obj(i,5)
REM Draw UFO (movement varies when visible)
gx=(obj(i,2)-view_x)
IF FNonscreen(gx,UFOunit*4) THEN
obj(i,7)+=1
PROCdrawing(16,gx,obj(i,3),UFOunit,saucer_c$,0,1,FALSE)
PROCdrawing(17,gx,obj(i,3),UFOunit,ufo_c$((obj(i,7) DIV 3)MOD4),0,1,FALSE)
REM Interfere with controls?
IF SQR((heli_x-obj(i,2))^2+(heli_y-obj(i,3))^2)<HELunit*5 THEN
emp=TRUE
PROCdrawing(16,gx,obj(i,3),UFOunit,light_c$,0,1,FALSE)
ENDIF
ENDIF
ENDCASE
WHEN 12
REM Person: type, sts, x, y, tick, speed, tgt_x, wave_frame, run_frame, temp_sts_store
CASE obj(i,1) OF
WHEN 0
obj(i,1)=1:obj(i,3)=MANunit*3:obj(i,4)=0:obj(i,5)=2:obj(i,6)=FNget_waypoint(obj(i,2)):obj(i,8)=RND(6)-1
WHEN 1,2
IF ABS(obj(i,2)-obj(i,6))<MANunit*2 obj(i,6)=FNget_waypoint(obj(i,2)):obj(i,1)=1:REM Set new waypoint if reached current
obj(i,4)+=1:REM Frame tick (1 or 2 to change frame and move person)
IF obj(i,4)>=obj(i,5) obj(i,4)=0:obj(i,2)+=SGN(obj(i,6)-obj(i,2))*MANunit*1.5:obj(i,8)+=1:IF obj(i,8)>=6 obj(i,8)=0
IF obj(i,6)-obj(i,2)<0 p=TRUE ELSE p=FALSE
gx=(obj(i,2)-view_x):IF FNonscreen(gx,MANunit*3) PROCdrawing(11,gx,obj(i,3),MANunit,run_c$(obj(i,8)),0,1,p)
REM Set helicopter as waypoint
IF obj(i,1)=1 AND landed AND passengers<16 AND heli_x>WANDERmin AND heli_x<WANDERmax AND heli_fly THEN
obj(i,6)=heli_x:obj(i,1)=2
ENDIF
IF obj(i,1)=1 AND NOT landed AND RND(1000)=1 obj(i,9)=obj(i,1):obj(i,1)=5:obj(i,7)=RND(4)*16:REM Random wave off
REM Attempt to board helicopter (NOT_was_in_air gives wiggle room for squished)
IF obj(i,1)=2 THEN
IF (NOT was_in_air) AND landed AND passengers<16 AND heli_fly THEN
IF ABS(obj(i,2)-obj(i,6))<MANunit*5 obj(i,1)=3:passengers+=1:PROCremove_from_nearest(i):REM Becomes passenger
ELSE
obj(i,1)=1:obj(i,6)=FNget_waypoint(obj(i,2)):REM New waypoint on heli liftoff or full
IF landed AND (passengers=16 OR heli_fly=FALSE) AND VAL(MID$(nearest$,2,3))=i obj(i,9)=obj(i,1):obj(i,1)=5:obj(i,7)=RND(4)*16:REM Wave off
ENDIF
ENDIF
WHEN 3
REM Passenger
IF landed AND (NOT was_in_air) AND heli_x>4640 AND heli_x<4720 AND egress=0 THEN
egress+=1:passengers-=1:obj(i,1)=4:obj(i,2)=heli_x+HELunit*1.5:obj(i,6)=ZONEwidth*7.5
ENDIF
WHEN 4
REM Walk to exit having disembarked
IF ABS(obj(i,2)-obj(i,6))<MANunit*2 THEN
PROCrescued(depth,i)
ELSE
IF RND(500)=1 obj(i,9)=obj(i,1):obj(i,1)=5:obj(i,7)=RND(4)*16:REM Random wave off
ENDIF
obj(i,4)+=1:REM Frame tick (1 or 2 to change frame and move person)
IF obj(i,4)>=obj(i,5) obj(i,4)=0:obj(i,2)+=SGN(obj(i,6)-obj(i,2))*MANunit*1.5:obj(i,8)+=1:IF obj(i,8)>=6 obj(i,8)=0
IF obj(i,6)-obj(i,2)<0 p=TRUE ELSE p=FALSE
gx=(obj(i,2)-view_x):IF FNonscreen(gx,MANunit*3) PROCdrawing(11,gx,obj(i,3),MANunit,run_c$(obj(i,8)),0,1,p)
WHEN 5
REM Temp override: waving
obj(i,7)-=1:IF obj(i,7)<=0 obj(i,1)=obj(i,9):REM Return to previous status when finished waving
IF (obj(i,7) AND 4)=4 r$=wave_c1$ ELSE r$=wave_c2$
gx=(obj(i,2)-view_x):IF FNonscreen(gx,MANunit*3) PROCdrawing(12,gx,MANunit*3,MANunit,r$,0,1,FALSE)
ENDCASE
REM Unless a passenger, test for shrapnel & squished
IF obj(i,1)<>3 THEN
IF FNshrapnel_hit(obj(i,2),MANunit*2) THEN
PROCkia(depth,i)
ENDIF
REM Check for squished
IF was_in_air AND landed THEN
IF ABS(obj(i,2)-heli_x)<2*HELunit PROCkia(depth,i)
ENDIF
ENDIF
WHEN 14
REM Tank: type, sts, x, y, motion, delay, tgt_x, tgt_y, barrel aim, reload delay, msg
CASE obj(i,1) OF
WHEN 0
REM Activation & respawn control
IF obj(i,9)>0 THEN
obj(i,9)-=1
ELSE
IF obj(i,3)<=dc(0) THEN
x=RND(2):IF x=2 x=-1
x=heli_x+(ZONEwidth/2+TNKunit*9+RND(50))*x
REM Tank creation points - stepped limitations (& Prevent first vehicle always appearing at same place)
IF x<WANDERmax-ZONEwidth*obj(i,3) obj(i,2)=INT(x):obj(i,1)=1 ELSE obj(i,9)=RND(25)
ENDIF
ENDIF
WHEN 1
REM Choose target
IF heli_x<WANDERmin OR heli_x>WANDERmax OR RND(100)>dc(1)*100 THEN
obj(i,6)=FNget_waypoint(obj(i,2)):obj(i,7)=100:obj(i,1)=3
ELSE
obj(i,6)=INT(heli_x):obj(i,7)=heli_y:obj(i,1)=2:REM Target is helicopter
ENDIF
obj(i,4)=0:IF obj(i,2)<obj(i,6) obj(i,4)=TNKunit ELSE IF obj(i,2)>obj(i,6) obj(i,4)=-TNKunit
WHEN 2,3
REM Motion control
IF obj(i,1)=2 THEN
obj(i,6)=heli_x:obj(i,7)=heli_y:IF heli_x<WANDERmin OR heli_x>WANDERmax obj(i,1)=1
ENDIF
REM On reaching target delay target reset
IF ABS(obj(i,2)-obj(i,6))<10 AND obj(i,5)=0 obj(i,5)=RND(20)+5
IF obj(i,5)=0 obj(i,2)+=obj(i,4) ELSE obj(i,5)-=1:IF obj(i,5)=0 obj(i,1)=1
ENDCASE
IF obj(i,1)>0 THEN
REM Out of range?
IF ABS(obj(i,2)-heli_x)>ZONEwidth THEN
obj(i,1)=0:obj(i,9)=dc(3)/4+RND(20)-10:REM respawn countdown
ELSE
REM Check for clobbered
IF obj(i,10)=1 THEN
obj(i,10)=0
obj(i,1)=0:obj(i,9)=dc(3)+RND(20)-10:REM respawn countdown
p=FNget_free_cell(4):IF p<>-1 PROCinit_obj(p,8,0,obj(i,2),FNtanky(obj(i,3))+4*TNKunit,0,0):REM Boom
ENDIF
ENDIF
REM Aiming & Firing
p=FNtank_aim(obj(i,2),-52-obj(i,3)*8,obj(i,6),obj(i,7)):IF obj(i,8)<p obj(i,8)+=1 ELSE IF obj(i,8)>p obj(i,8)-=1
obj(i,9)-=1
IF obj(i,9)<=0 THEN
obj(i,9)=RND(20)-10+dc(2)
p=FNget_free_cell(4):REM Ordnance section
IF p<>-1 THEN
a=(obj(i,8)-2)*30
x=SIN(RAD(a))*6*TNKunit+obj(i,2):y=COS(RAD(a))*6*TNKunit+FNtanky(obj(i,3))+6*TNKunit
xv=SIN(RAD(a))*12:yv=9
type=9:PROCinit_obj(p,type,0,x,y,xv,yv):REM Shell
ENDIF
ENDIF
REM Draw tank
gx=(obj(i,2)-view_x)
IF FNonscreen(gx,TNKunit*8) THEN
PROCrotate_barrel(obj(i,8))
PROCdrawing(14,gx,FNtanky(obj(i,3)),TNKunit,ttop_c$,0,1,FALSE)
p=4-((obj(i,2) DIV TNKunit) MOD 5):IF p>4 p-=5
PROCdrawing(13,gx,FNtanky(obj(i,3)),TNKunit,tbase_c$(p),0,1,FALSE)
ENDIF
ENDIF
WHEN 15
REM Predator drone: type, sts, x, y, xvel, dropzone(1-5), #, height, missile ptr, delay, msg
CASE obj(i,1) OF
WHEN 0
REM Activation & respwan control
IF obj(i,9)>0 THEN
obj(i,9)-=1
ELSE
REM Activate drone
IF obj(i,6)<=dc(4) THEN
a=RND(2):IF a=2 a=-1
x=heli_x+(ZONEwidth/2+PRDunit*9+RND(50))*a
xv=PRDunit*2*-a
IF x<WANDERmax-ZONEwidth*obj(i,6) THEN
obj(i,1)=1:obj(i,2)=INT(x):obj(i,4)=xv:obj(i,5)=0
obj(i,7)=FNatc:obj(i,3)=sky-PRDunit*4-obj(i,7)*PRDunit*9
obj(i,5)=RND(5):REM 5 possible drop zones
obj(i,9)=150:REM 6 second timeout for entering missile dropzone
REM Attempt to create linked missile
p=FNget_free_cell(1):REM People/Missile section
IF p<>-1 THEN
obj(i,8)=p
type=10:PROCinit_obj(p,type,0,0,0,0,0):obj(p,6)=10*a:obj(p,8)=i
ELSE
obj(i,8)=-1
ENDIF
ELSE
obj(i,9)=RND(25):REM Prevent first vehicle always appearing at same place
ENDIF
ENDIF
ENDIF
WHEN 1,2
IF obj(i,1)=1 AND obj(i,8)=-1 obj(i,1)=2:REM If no missile attached (whatever reason) then trigger status 2
obj(i,2)+=obj(i,4):IF obj(i,1)=2 obj(i,3)+=PRDunit
REM Out of range?
IF ABS(obj(i,2)-heli_x)>ZONEwidth OR obj(i,3)>sky+80+PRDunit*3 THEN
obj(i,1)=0:highroad$=FNremove_from_string(highroad$,STR$(obj(i,7))):obj(i,9)=dc(7)/4+RND(20)-10:REM respawn countdown
REM Deactivate missile
IF obj(i,8)<>-1 PROCput_cell(1,obj(i,8)):obj(i,8)=-1
ELSE
REM Check for clobbered
IF obj(i,10)=1 THEN
obj(i,10)=0
obj(i,1)=0:highroad$=FNremove_from_string(highroad$,STR$(obj(i,7)))::obj(i,9)=dc(7)+RND(20)-10:REM respawn countdown
p=FNget_free_cell(4):IF p<>-1 PROCinit_obj(p,8,0,obj(i,2),obj(i,3),0,0):REM Boom
REM Deactivate missile
IF obj(i,8)<>-1 PROCput_cell(1,obj(i,8)):obj(i,8)=-1
ENDIF
ENDIF
REM Missile launch control (missile fitted? Run timed out?)
IF obj(i,1)=1 THEN
IF obj(i,9)>0 THEN
obj(i,9)-=1
x=obj(i,2)-view_x+dropzone/2
IF obj(i,2)<WANDERmax THEN
IF x>0 AND x<dropzone AND obj(i,5)=(x DIV(dropzone DIV5))+1 OR obj(i,9)=1 AND FNonscreen(obj(i,2)-view_x,1) THEN
x=obj(i,2):y=obj(i,3)-PRDunit*2:yv=0
IF obj(i,4)<0 xv=270 ELSE xv=90
PROCinit_obj(obj(i,8),10,1,x,y,xv,yv):REM Update linked missile with last data from parent drone
obj(i,8)=-1
ENDIF
ENDIF
ELSE
obj(i,1)=2:REM On timeout drone rises, but with missile intact
ENDIF
ENDIF
REM Draw drone
gx=(obj(i,2)-view_x)
IF FNonscreen(gx,PRDunit*8) THEN
IF obj(i,4)<0 p=TRUE ELSE p=FALSE
PROCdrawing(2,gx,obj(i,3),PRDunit,pred_cr$,0,1,p)
ENDIF
ENDCASE
ENDCASE
ENDWHILE
ENDPROC
REM Crash & burn initialise
DEF PROCcandb
LOCAL A,a$,i
IF candb_sts=0 THEN
heli_fly=FALSE:candb_sts=1
REM Passengers perish
a$=active$(1)
IF a$<>"" THEN
FOR A=1 TO LEN(a$)DIV4
i=VAL(MID$(a$,A*4-2,3)):IF obj(i,0)=12 AND obj(i,1)=3 THEN passengers-=1:dead+=1:PROCput_cell(1,i)
NEXT
ENDIF
ENDIF
ENDPROC
DEF PROCeol
LOCAL x,a$
CASE candb_sts OF
WHEN 0 : candb_flames=0:IF emp heli_fly=FALSE ELSE heli_fly=TRUE:REM Alive and well
WHEN 1 : candb_flames+=30:IF landed candb_sts+=1:candb_paws=30
WHEN 2 : candb_flames+=30:candb_paws-=.5:splat=(candb_paws+20)/50:IF candb_paws<=0 candb_sts+=1
WHEN 3 : lives-=1:heli_fly=TRUE heli_x=4680:heli_y=0:heli_o=-1:candb_sts=0:splat=1
ENDCASE
REM Burning wreckage
IF candb_sts>0 THEN
FOR x=-1 TO 1
PROCexplode(ox+heli_x-view_x+x*HELunit,oy+heli_y-(2*HELunit*(1-splat)),(1+SIN(RAD(x*90+candb_flames)))/2,1,0.8,1)
NEXT
ENDIF
ENDPROC
REM Return angle between two vectors: A.B=|A||B|COS(theta)
DEF FNget_angle(a,b,x,y)
=DEG(ACS((a*x+b*y)/(SQR(a^2+b^2)*SQR(x^2+y^2))))
REM Return a valid altitude level for a drone
DEF FNatc
LOCAL h
REPEAT:h=RND(dc(5)+2)-1:UNTIL INSTR(highroad$,STR$(h))=0
highroad$+=STR$(h)
=h
REM Return true/false that tank was hit by 'bomb' at (x,y)
REM Send message to vehicle 'hit'
DEF FNtank_hit(x,y)
LOCAL hit,T,e,tnky
hit=FALSE:T=1
WHILE T<=LEN(livetnk$)DIV4 AND hit=FALSE
e=VAL(MID$(livetnk$,T*4-2,3))
IF obj(e,1)>0 THEN
IF x>obj(e,2)-9*TNKunit AND x<obj(e,2)+9*TNKunit THEN
tnky=FNtanky(obj(e,3))
IF y>tnky THEN
IF y<tnky+6*TNKunit THEN
hit=TRUE:obj(e,10)=1
ELSE
IF y<tnky+8.5*TNKunit AND x>obj(e,2)-4*TNKunit AND x<obj(e,2)+4*TNKunit hit=TRUE:obj(e,10)=1
ENDIF
ENDIF
ENDIF
ENDIF
T+=1
ENDWHILE
=hit
REM Return true/false that drone was hit by 'bullet' at (x,y)
REM Send message to vehicle 'hit'
DEF FNpred_hit(x,y)
LOCAL hit,T,e
hit=FALSE:T=1
WHILE T<=LEN(liveprd$)DIV4 AND hit=FALSE
e=VAL(MID$(liveprd$,T*4-2,3))
IF obj(e,1)>0 THEN
IF x>obj(e,2)-9*PRDunit AND x<obj(e,2)+9*PRDunit THEN
IF y>obj(e,3)-5*PRDunit AND y<obj(e,3)+5*PRDunit hit=TRUE:obj(e,10)=1
ENDIF
ENDIF
T+=1
ENDWHILE
=hit
REM Return true/false that UFO was hit by 'bullet' at (x,y)
REM Send message to vehicle 'hit'
DEF FNufo_hit(x,y)
LOCAL hit,T,e
hit=FALSE:T=1
WHILE T<=LEN(liveufo$)DIV4 AND hit=FALSE
e=VAL(MID$(liveufo$,T*4-2,3))
IF obj(e,1)>0 THEN
IF x>obj(e,2)-5*UFOunit AND x<obj(e,2)+5*UFOunit THEN
IF y>obj(e,3)-3*UFOunit AND y<obj(e,3)+3*UFOunit hit=TRUE:obj(e,10)=1
ENDIF
ENDIF
T+=1
ENDWHILE
=hit
REM Return true/false that Helicopter was hit by 'missile' at (x,y)
DEF FNheli_hit(x,y)
IF x>heli_x-HELunit AND x<heli_x+HELunit AND y>heli_y-HELunit AND y<heli_y+HELunit =TRUE ELSE =FALSE
REM Very basic object initiation (more fields to follow & some of these fields may vary)
DEF PROCinit_obj(cell,type,life,x,y,xv,yv)
obj(cell,0)=type
obj(cell,1)=life
obj(cell,2)=x
obj(cell,3)=y
obj(cell,4)=xv
obj(cell,5)=yv
ENDPROC
REM Tank Y, derived from value 1 to 3
DEF FNtanky(v)
=-52-v*8
REM Object within horizontal screen bounds?
DEF FNonscreen(X,w)
IF X<-ox-w OR X>ox+w =FALSE ELSE =TRUE
REM Return T/F if object hit by bullet shrapnel (object x, width)
DEF FNshrapnel_hit(x,w)
LOCAL hit,A$,v
hit=FALSE:A$=shrapnel$
REPEAT
v=VAL(LEFT$(A$,5)):A$=RIGHT$(A$,LEN(A$)-5)
IF v>=(x-w) AND v<=(x+w) hit=TRUE
UNTIL hit OR A$=""
=hit
REM Get random waypoint relative to current position (people & tanks)
DEF FNget_waypoint(x)
LOCAL d,v
v=200+RND(10)*10:d=RND(2):IF d=2 d=-1
IF x+v*d<WANDERmin OR x+v*d>WANDERmax d*=-1
=INT(x+v*d)
DEF PROCbackground
LOCAL T,L,f,h,y
REM Scoreboard
GCOL0,9:RECTANGLEFILL 400,480*2-1,1279-400,-128:MOVE 400,480*2-1:MOVE 400,480*2-128:PLOT 85,400-128,480*2-1
REM Lives
IF lives>0 THEN
FOR T=1 TO lives:PROCdrawing(18,90+((T-1) MOD5)*10+((T-1) DIV5)*44,sky+65-((T-1) MOD5)*8,8,tiny_c$,0,1,FALSE):NEXT
ENDIF
REM Passengers
IF passengers=16 GCOL0,7 ELSE GCOL0,0
y=480*2:x=ox*2-20*8:T=passengers:WHILE T>0:RECTANGLEFILL x+(T-1)*20,y-110,16:T-=1:ENDWHILE
VDU5:GCOL0,0
REM Rescued
PROCget_len(STR$(rescued)):MOVE ra(0)-size.cx%*2,y-20:PRINT;rescued
IF rescued>best_score best_score=rescued
REM Best score
MOVE ra(1),y-10:PRINT;"Best"
PROCget_len(STR$(best_score)):MOVE ox*4-40-size.cx%*2,y-50:PRINT;best_score
VDU4
REM Ground
T=oy*2+4:FOR L=0 TO 4:f=(5-L)/5:h=INT(4+2^(L+1)):COLOUR 5,148*f,0,224*f:GCOL0,5:RECTANGLEFILL 0,T,1279,-h:T-=h:NEXT
REM Stars
FOR A=0 TO MAXstars-1
IF RND(4)=1 GCOL0,7 ELSE IF RND(3)=1 GCOL0,3 ELSE IF RND(2)=1 GCOL0,8 ELSE GCOL0,6
PLOT 69,stars(A,0)*2,(stars(A,1)+oy)*2
NEXT
PROCmoon(480,300,24,moonglow,wax)
ENDPROC
DEF FNtri(n)
=":"+STRING$(3-LEN(STR$(n)),"0")+STR$(n)
REM Returns 5 character string of +ve/-ve value
DEF FNquad(v)
LOCAL n$
IF v<0 n$="-" ELSE n$="0"
=n$+STRING$(4-LEN(STR$(ABS(v))),"0")+STR$(ABS(v))
DEF FNget_free_cell(depth)
LOCAL v,A$
IF stk$(depth)="" THEN
v=-1
ELSE
A$=LEFT$(stk$(depth),4):active$(depth)+=A$:v=VAL(RIGHT$(A$,3))
stk$(depth)=RIGHT$(stk$(depth),LEN(stk$(depth))-4)
ENDIF
=v
DEF PROCput_cell(depth,v)
LOCAL A$,i
A$=FNtri(v):stk$(depth)+=A$:i=INSTR(active$(depth),A$)
active$(depth)=LEFT$(active$(depth),i-1)+RIGHT$(active$(depth),LEN(active$(depth))-(i+3))
ENDPROC
REM Kill off person
DEF PROCkia(depth,v)
PROCremove_from_nearest(v):PROCput_cell(depth,v):dead+=1
PROCamend_difficulty
ENDPROC
DEF PROCremove_from_nearest(v)
nearest$=FNremove_from_string(nearest$,FNtri(v))
ENDPROC
REM Person rescued
DEF PROCrescued(depth,v)
PROCput_cell(depth,v):rescued+=1:IF rescued MOD 50=0 AND lives<10 lives+=1
PROCamend_difficulty
ENDPROC
REM Sort nearest$ to find person closest to helicopter
DEF PROChierarchy
LOCAL A,a,b
IF LEN(nearest$)>4 THEN
FOR A=1 TO (LEN(nearest$)DIV4)-1
a=VAL(MID$(nearest$,A*4-2,3)):b=VAL(MID$(nearest$,(A+1)*4-2,3))
IF ABS(obj(b,2)-heli_x)<ABS(obj(a,2)-heli_x) nearest$=LEFT$(nearest$,(A-1)*4)+FNtri(b)+FNtri(a)+RIGHT$(nearest$,LEN(nearest$)-(A+1)*4)
NEXT
ENDIF
ENDPROC
DEF FNremove_from_string(b$,a$)
LOCAL L,i
L=LEN(a$):i=INSTR(b$,a$):IF i>0 b$=LEFT$(b$,i-1)+RIGHT$(b$,LEN(b$)-(i+L-1))
=b$
REM Difficulty control
REM Tanks:
REM 0 = No. of tanks (1-3)
REM 1 = Probability of targeting helicopter (0-1)
REM 2 = Av. reload delay (seconds)
REM 3 = Av. respawn time (seconds) non-destroyed is 1/4 of this
REM Drones:
REM 4 = No. of predators (1-2)
REM 5 = Height range (0-2)+2
REM 6 = Missile accuracy (0-1)
REM 7 = Av. respawn time (seconds) non-destroyed is 1/4 of this
REM UFOs:
REM 8 = No. of UFOs (1-2)
REM 9 = Av. respawn time (seconds) non-destroyed is 1/4 of this
DEF PROCset_difficulty(a,b,c,d,e,f,g,h,k,m)
dc(0)=a:dc(1)=b:dc(2)=c*25:dc(3)=d*25:dc(4)=e:dc(5)=f:dc(6)=g:dc(7)=h*25
dc(8)=k:dc(9)=m*25
ENDPROC
REM Based on no. of people rescued, adjust level
DEF PROCamend_difficulty
LOCAL r
r=(rescued MOD 100)DIV 15
CASE r OF
WHEN 0 : PROCset_difficulty(2,0.8,1,8,0,0,0,0,0,0)
WHEN 1 : PROCset_difficulty(2,0.8,1,7,0,0,0,0,0,0)
WHEN 2 : PROCset_difficulty(2,0.8,1,7,1,0,0,20,0,0)
WHEN 3 : PROCset_difficulty(2,0.8,1,7,1,1,0,20,1,20)
WHEN 4 : PROCset_difficulty(2,0.6,.8,6,1,1,0,20,1,20)
OTHERWISE : PROCset_difficulty(3,0.8,.8,6,2,1,0,28,1,20)
ENDCASE
ENDPROC
REM **********************************************************************
REM *********************** Input & Flight Model ************************
REM **********************************************************************
DEF PROCuser
LOCAL K$,click,c
IF but1pause>0 but1pause-=1
IF but4pause>0 but4pause-=1
IF jpause>0 jpause-=1
K$=INKEY$(0):OSCLI("FX21")
IF K$="J" OR K$="j" AND jpause=0 THEN
IF ctrl_type$="J" THEN
REM Switch to mouse control
PROCtrap_mouse
ELSE
REM Switch to joystick control
PROCrelease_mouse
ENDIF
ENDIF
IF K$="Y" OR K$="y" THEN
IF y_axis=1 y_axis=-1 ELSE y_axis=1
ENDIF
IF ASC(K$)=27 fin=TRUE
click=0
CASE ctrl_type$ OF
WHEN "J"
IF (ADVAL(4) AND 1)=1 AND but1pause=0 click=1:but1pause=4
IF ADVAL(4)>1 AND but4pause=0 click=2:but4pause=4
joy_x=ADVAL(1)+MINjoyx
joy_y=ADVAL(2)+MINjoyy
tgt_xa=INT(ACCELrange*(joy_x/(MAXjoyx-MINjoyx)-0.5))
tgt_ya=INT(ACCELrange*(1-joy_y/(MAXjoyy-MINjoyy)))
WHEN "M"
MOUSE mx,my,mz
IF (mz AND 4)=4 AND but1pause=0 click=1:but1pause=4
IF (mz AND 1)=1 AND but4pause=0 click=2:but4pause=4
tgt_xa=INT(ACCELrange*(mx/1280-0.5))
tgt_ya=INT(ACCELrange*(my/960))
ENDCASE
IF y_axis=-1 tgt_ya=ACCELrange-tgt_ya:REM Allow joystick y-axis to be reversed (just in case)
IF heli_fly THEN
CASE click OF
WHEN 1 : IF NOT landed heli_shoot=TRUE
WHEN 2 : c=SGN(tgt_xa):heli_o+=c:IF ABS(heli_o)>1 heli_o=0
ENDCASE
ENDIF
ENDPROC
DEF PROCtrap_mouse
MOUSERECTANGLE 0,0,1279,959:MOUSEOFF:ctrl_type$="M"
ENDPROC
DEF PROCrelease_mouse
MOUSERECTANGLEOFF:MOUSEON:ctrl_type$="J"
ENDPROC
REM Helicopter flight model
DEF PROCflight_model
LOCAL Xchg,Ychg,FX,FY,aerolift,h,sgn,ge,R
was_in_air=NOT landed:landed=FALSE
R=SQR(HELunit^2*2)
IF heli_fly=FALSE tgt_xa=0:tgt_ya=0:REM Lost control, engine out
heli_Py=store(3,1):heli_Qy=store(4,1)
REM Into ground, even when level?
IF heli_y<HELunit THEN
heli_y=HELunit:landed=TRUE:REM Landed
tgt_xa=0:tgt_ya=0
heli_yv=0:heli_xv=0
ELSE
REM Corner into ground?
IF heli_Py<heli_Qy h=heli_Py:sgn=-1 ELSE h=heli_Qy:sgn=1
Xchg=4:REM Sluggishness of response (n.b. use here to keep calculated angles tidy)
IF h<0 THEN
heli_xa=((Xchg/2)+45-DEG(ACS(heli_y/R)))DIV Xchg:heli_xa*=Xchg*sgn:tgt_xa=heli_xa
ENDIF
IF INT(heli_y)=HELunit AND INT(heli_xv)=0 heli_xa=0:tgt_xa=0:landed=TRUE:REM Landed
REM Tilt
IF heli_xa>tgt_xa heli_xa-=Xchg:IF heli_xa<ACCELrange/-2 heli_xa=ACCELrange/-2
IF heli_xa<tgt_xa heli_xa+=Xchg:IF heli_xa>ACCELrange/2 heli_xa=ACCELrange/2
REM Collective
Ychg=4
IF heli_ya<tgt_ya heli_ya+=Ychg:IF heli_ya<0 heli_ya=0
IF heli_ya>tgt_ya heli_ya-=Ychg:IF heli_ya>ACCELrange heli_ya=ACCELrange
REM Horizontal limits
IF heli_x<-ZONEwidth heli_x=-ZONEwidth:heli_xa=0:heli_xv*=-.25
IF heli_x>ZONEwidth*9 heli_x=ZONEwidth*9:heli_xa=0:heli_xv*=-.25
REM Xvel
FX=8:REM Fudge factor
heli_xv+=heli_xa/(ACCELrange*heli_mass)*FX
heli_xv*=.995:REM Friction/energy loss
IF ABS(heli_xv)>MAXxv heli_xv=MAXxv*SGN(heli_xv)
heli_x+=heli_xv
aerolift=.75+.25*ABS(heli_xv)/MAXxv:REM Lift increased as air flows over rotary wings
REM Ground effect & Altitude limit
IF heli_y<HELunit*3 AND heli_y>0 ge=heli_y/(HELunit*3) ELSE ge=1
IF ge<.75 ge=.75
IF heli_y>sky heli_ya=0:heli_yv=0
REM Yvel
FY=8
heli_yv+=(aerolift*heli_ya/(ACCELrange*heli_mass)-gravity*ge)*FY
IF INT(heli_y)=HELunit AND heli_yv<0 heli_yv=0:heli_xv=0:REM Resting on ground
IF heli_yv>MAXyv heli_yv=MAXyv*SGN(heli_yv)
IF heli_yv<MAXyv*-2 heli_yv=MAXyv*2*SGN(heli_yv):REM Freefall 2*faster than vertical accel
heli_y+=heli_yv
ENDIF
REM Terminal deceleration
IF INT(heli_y)<=HELunit AND (ABS(heli_yv)>6 OR ABS(heli_xv)>8 AND ABS(heli_yv)>4) PROCcandb
egress+=1:IF egress>=10 egress=0:REM Passenger exit cycle
ENDPROC
REM **********************************************************************
REM ************************** Misc Graphics ***************************
REM **********************************************************************
REM Explosion/Fireball
REM r=explosion step from 0 to 3, w=whole/half, heat=0-1 (inverse to amount of smoke), intensity of particles
DEF PROCexplode(x,y,r,w,heat,intense)
LOCAL maxr,flames,bar,R,a,i,j
r=SIN(RAD(r*50+15))
maxr=BANGunit:flames=INT(80*intense*r)
FOR bar=1 TO flames
R=RND(1):GCOL0,7:IF R<heat GCOL0,1:IF RND(3)=1 GCOL0,10:IF RND(2)=1 GCOL0,3
R=R*r*maxr:IF w=1 a=RND(360) ELSE a=RND(180)-90
i=SIN(RAD(a))*R:j=COS(RAD(a))*R:RECTANGLEFILL (i+x)*2-4,(j+y)*2-4,8
NEXT
ENDPROC
PROCmoon(480,300,24,RND(1),RND(2))
DEF PROCmoon(X,Y,R,p,w)
LOCAL A,i,j
IF w=1 col1=12:col2=7 ELSE col1=7:col2=12
i=R-1:j=p*(i*2)-i:GCOL0,col1:MOVE (X-i)*2,Y*2:DRAW (X+j)*2,Y*2:GCOL0,col2:DRAW (X+i)*2,Y*2
FOR A=1 TO R-1
i=INT(SQR(R^2-A^2)):j=INT(p*(i*2)-i)
GCOL0,col1:MOVE (X-i)*2,(Y+A)*2:DRAW (X+j)*2,(Y+A)*2:GCOL0,col2:DRAW (X+i)*2,(Y+A)*2
GCOL0,col1:MOVE (X-i)*2,(Y-A)*2:DRAW (X+j)*2,(Y-A)*2:GCOL0,col2:DRAW (X+i)*2,(Y-A)*2
NEXT
ENDPROC
DEF PROCflag(x,y,a,w,h)
LOCAL i,q
@vdu%!248=2:GCOL0,7:LINE (x-1)*2,(y+h+1)*2,(x-1)*2,(y-32)*2:@vdu%!248=1
FOR i=0 TO w
IF i>4 q=SIN(RAD(a+i/w*480))*2 ELSE q=SIN(RAD(a+i/w*480))*i/2
IF i>=w/2-1 AND i<=w/2+1 GCOL0,1 ELSE GCOL0,7
LINE (x+i)*2,(y+q)*2,(x+i)*2,(y+h+q)*2
GCOL0,1:LINE (x+i)*2,(y+q+h/2-1)*2,(x+i)*2,(y+q+h/2+1)*2
NEXT
ENDPROC
DEF FNblade_r
=(2+SIN(RAD(rotor)))/3
DEF FNblade_l
=(2+COS(RAD(rotor)))/3
DEF PROCget_len(string$)
SYS "GetTextExtentPoint32", @memhdc%, string$, LEN(string$), size{}
ENDPROC
REM **********************************************************************
REM ****************************** Menu ********************************
REM **********************************************************************
DEF PROCmenu
LOCAL h,top,K$,play
top=480*2-200:GCOL0,7
REPEAT
TIME=0:CLS
GCOL0,7:PROCcentre("Choplifter 2012",480*2-20)
*FONT Arial,16
PROCcentre("Best score today: "+STR$(best_score),480*2-80)
PROCget_len("Test"):h=size.cy%*2
PROCpara("Airlift the refugees back to base, but watch out for the tanks when landing in the hostile zone.",500,top)
PROCpara("Game based on the Apple II version and designed for use with Sidewinder joystick (press 'C' to calibrate).",500,top-h*3)
PROCpara("'J' toggles between joystick and mouse control.",500,top-h*6)
PROCpara("Fire/Left click to fire.",500,top-h*8)
PROCpara("Button 2/Right click to change orientation.",500,top-h*9)
PROCcentre("Joystick FIRE or SPACE to begin...",top-h*12)
*FONT Arial,18,B
*REFRESH
K$=INKEY$(0):IF K$="C" OR K$="c" PROCcalibrate
WAIT 4-TIME
UNTIL FNget_fire
ENDPROC
DEF FNget_fire
LOCAL play,x,z,y
play=FALSE
SYS "GetForegroundWindow" TO hw%
IF hw% = @hwnd% THEN
IF INKEY-99 play=TRUE:PROCtrap_mouse ELSE IF ADVAL(4)=1 play=TRUE:ctrl_type$="J"
ENDIF
=play
DEF PROCcalibrate
LOCAL h,top,first
first=TRUE:top=480*2-100:GCOL0,7
*FONT Arial,16
PROCget_len("Test"):h=size.cy%*2
REPEAT
TIME=0:CLS
PROCcentre("Joystick calibration",480*2-20)
PROCpara("Move the joystick to its extreme positions and press SPACE when finished.",500,top)
PROCpara("Min X: "+STR$(MINjoyx),180,top-h*3)
PROCpara("Max X: "+STR$(MAXjoyx),180,top-h*4)
PROCpara("Min Y: "+STR$(MINjoyy),180,top-h*5)
PROCpara("Max Y: "+STR$(MAXjoyy),180,top-h*6)
PROCpara("Press 'Y' in the game to reverse the Y-axis.",500,top-h*8)
joy_x=ADVAL(1)
joy_y=ADVAL(2)
IF first THEN
first=FALSE
MAXjoyx=joy_x:MAXjoyy=joy_y
MINjoyx=joy_x:MINjoyy=joy_y
ELSE
IF joy_x>MAXjoyx MAXjoyx=joy_x
IF joy_x<MINjoyx MINjoyx=joy_x
IF joy_y>MAXjoyy MAXjoyy=joy_y
IF joy_y<MINjoyy MINjoyy=joy_y
ENDIF
*REFRESH
WAIT 4-TIME
UNTIL INKEY-99
IF MINjoyx=MAXjoyx OR MINjoyy=MAXjoyy THEN
MAXjoyx=65408:MAXjoyy=65408:MINjoyx=0:MINjoyy=0:REM prevent div by zero
ENDIF
REPEAT:WAIT 4:UNTILNOTINKEY-99:*FX21
*FONT Arial,18,B
ENDPROC
DEF PROCcentre(T$,y)
PROCget_len(T$):VDU5:MOVE ox*2-size.cx%,y:PRINT;T$:VDU4
ENDPROC
DEF PROCpara(T$,w,y)
LOCAL L,X
L=-1:VDU5
REPEAT:L+=1:X=0
REPEAT:X+=1:PROCget_len(LEFT$(T$,X)):UNTIL size.cx%>w OR X>LEN(T$)
IF X<LEN(T$) THEN
WHILE MID$(T$,X,1)<>" ":X-=1:ENDWHILE
ELSE
X=LEN(T$)
ENDIF
MOVE 640-w,y-L*size.cy%*2:PRINT;LEFT$(T$,X):T$=RIGHT$(T$,LEN(T$)-X)
UNTIL T$=""
VDU4
ENDPROC
REM **********************************************************************
REM **************************** Drawings ******************************
REM **********************************************************************
REM Special vertex image of helicopter stored separately (real co-ords)
DEF PROCstore_heli(x,y,u,a)
LOCAL i,D,X,Y
i=waldo_index(0,0)
FOR D=0 TO waldo_index(0,1)-1
IF a<>0 THEN
X=COS(RAD(a))*waldo(D+i,0)*u+SIN(RAD(a))*waldo(D+i,1)*u
Y=COS(RAD(a))*waldo(D+i,1)*u-SIN(RAD(a))*waldo(D+i,0)*u
ELSE
X=waldo(D+i,0)*u:Y=waldo(D+i,1)*u
ENDIF
store(D+1,0)=x+X:store(D+1,1)=y+Y
NEXT
ENDPROC
REM Special vertex image of tank barrel stored separately
DEF PROCstore_barrel
LOCAL i,D
i=waldo_index(14,0):FOR D=0 TO waldo_index(14,1)-1:barrel(D,0)=waldo(D+i,0):barrel(D,1)=waldo(D+i,1):NEXT
ENDPROC
REM Special rotation of tank barrel - waldo amended using specially stored values
DEF PROCrotate_barrel(a)
LOCAL i,D,X,Y
a=(a-2)*30:i=waldo_index(14,0)
FOR D=1 TO waldo_index(14,1)-1
X=barrel(D,0)-barrel(0,0):Y=barrel(D,1)-barrel(0,1)
waldo(D+i,0)=COS(RAD(a))*X+SIN(RAD(a))*Y+barrel(0,0)
waldo(D+i,1)=COS(RAD(a))*Y-SIN(RAD(a))*X+barrel(0,1)
NEXT
ENDPROC
REM For a given (x,y) of a tank, calc best sight line to helicopter
DEF FNtank_aim(x,y,tx,ty)
LOCAL v,sgn
x=tx-x:y=ty-y:sgn=SGN(x):x=ABS(x)
IF y>x*4 THEN
v=0
ELSE
IF y>x v=1 ELSE v=2
ENDIF
v=2+v*sgn
=v
REM Draw image 'f' at real x,y of unit size 'u' using control string C$, angle a, stretch in Y, flip X
DEF PROCdrawing(f,x,y,u,C$,a,strchy,flip)
LOCAL i,D,i$,col,v,X,Y
i=waldo_index(f,0)
FOR D=1 TO LEN(C$)DIV4
i$=LEFT$(C$,1):col=EVAL("&"+MID$(C$,2,1)):v=i-1+VAL(MID$(C$,3,2)):C$=RIGHT$(C$,LEN(C$)-4)
IF a<>0 THEN
X=COS(RAD(a))*waldo(v,0)*u+SIN(RAD(a))*waldo(v,1)*u
Y=COS(RAD(a))*waldo(v,1)*u-SIN(RAD(a))*waldo(v,0)*u
ELSE
X=waldo(v,0)*u:Y=waldo(v,1)*u*SIN(RAD(strchy*90))
ENDIF
IF flip X*=-1
X=2*(ox+x+X):Y=2*(oy+y+Y)
CASE i$ OF
WHEN "M" : MOVE X,Y
WHEN "D" : GCOL0,col:@vdu%!248=2:DRAW X,Y:@vdu%!248=1
WHEN "T" : GCOL0,col:PLOT 85,X,Y
WHEN "P" : GCOL0,col:PLOT 69,X,Y
ENDCASE
NEXT
ENDPROC
REM Read drawing data (waldo, waldo_index)
DEF PROCread_dots
LOCAL drw,start,p,x,y
drw=0:start=0:p=0
REPEAT
READ x,y
IF x<999 THEN
waldo(p,0)=x:waldo(p,1)=y:p+=1
ENDIF
IF x=999 waldo_index(drw,0)=start:waldo_index(drw,1)=p-start:start=p:drw+=1
UNTIL x=1000
REM Drawing control strings
heli_c1$="M001M002T704T703M005D706M007D708M009D710M011T712M003D717D718D704M017D719M003M021T702M025M027TC29"
heli_c2$="M001M002T704T703M005D706M007D708M013D714M015T716M003D717D718D704M018D720M004M022T701M026M028TC30"
heli_c3$="M001M002T704T703M005D706M007D708M003D717M004D718M003M004T827T828M027M028TC25TC26M029D730"
house_c1$="M002M001T903T906T904T905M012M011T913T914M006M010T705T709T704T708T703T707M016M015T017T018M017D718"
house_c2$="M015M001T924T906T923T905T922T904T921T903T920T902T919T916M012M011T913T914M006M010T705T709T704T708T703T707"
pred_cr$="M013M014T716T715M009M010T712T711M002M003T101T104TD08TD05M007TD06M017M018T720T719M021M022T726T723T725T724M027D728"
safe_c$="M020M019T721T722M002M001TA03TA04T705T706M008M007T009T010M012M011T013T014M016M015T017T018M009D710M012D711M016D715"
lawn_c$="M002M001TF03TF04"
hill_c$()="M001M002T803M004T805","M002M001T803T804","M001M002T803M004T805","M004M005T803T801T802","M001M002T803M004T805"
fence_c$="M002M001T709T712M004M003T710T709M010M011T705T706M011M012T707T708M010M009T711T712"
run_c$(0)="M015D716D717M011M012T714T713M001DE04M001D708D709"
run_c$(1)="M015D716D717M011M012T714T713M001DE05M001D702D710"
run_c$(2)="M015D716D717M011M012T714T713M001DE06DE07M001D702D703"
run_c$(3)="M015D716D717M011M012T714T713M001DE08DE09M001D704"
run_c$(4)="M015D716D717M011M012T714T713M001DE02DE10M001D705"
run_c$(5)="M015D716D717M011M012T714T713M001DE02DE03M001D706D707"
stand_c$="M001D704D706D702M005D709M003D708D710D707M011M012T714T713"
help_c$="M001D704D706D702M005D709M016D708D710D715M011M012T714T713"
wave_c1$="M001D704D706D702M005D709M018D717D708D710D707M011M012T714T713"
wave_c2$="M001D704D706D702M005D709M019D717D708D710D707M011M012T714T713"
tbase_c$(0)="M018D019D020M024D026D027D025M021D022D023M001M017TC02TC16TC03TC15M001D702D703D704M006D709M011D714M016D717M019M018TF20TF23TF21TF22M024M025TF26TF27M020D221M026D227"
tbase_c$(1)="M018D019D020M024D026D027D025M021D022D023M001M017TC02TC16TC03TC15M002D703D705M007D710M012D715M017D717M019M018TF20TF23TF21TF22M024M025TF26TF27M020D221M026D227"
tbase_c$(2)="M018D019D020M024D026D027D025M021D022D023M001M017TC02TC16TC03TC15M001D701M003D706M008D711M013D715D716M019M018TF20TF23TF21TF22M024M025TF26TF27M020D221M026D227"
tbase_c$(3)="M018D019D020M024D026D027D025M021D022D023M001M017TC02TC16TC03TC15M001D702M004D707M009D712M014D715D716D717M019M018TF20TF23TF21TF22M024M025TF26TF27M020D221M026D227"
tbase_c$(4)="M018D019D020M024D026D027D025M021D022D023M001M017TC02TC16TC03TC15M001D702D703M005D708M010D713M015D716D717M019M018TF20TF23TF21TF22M024M025TF26TF27M020D221M026D227"
ttop_c$="M002D006D007D008D009D005M007M008TF06TF09TF02TF05"
missile_c$="M003M004T105M001D702"
saucer_c$="M001M002T108T103TA07TA04TA06TA05M009M013T912T914T911T910M015D316P717"
ufo_c$(0)="M001M003T711M012M014T704M005M007T715M016M018T708"
ufo_c$(1)="M001M002T710M011M013T703M004M006T714M015M017T707M008M009T718"
ufo_c$(2)="M010M012T702M003M005T713M014M016T706M007M009T717"
ufo_c$(3)="M010M011T701M002M004T712M013M015T705M006M008T716M017M018T709"
light_c$="M020M018T322T719T723T321"
tiny_c$="M002D705M008D709M001M002T704T703M005M006T707"
ENDPROC
REM Vertices of drawings
REM 0=Helicopter (composite of left, right & forward facing)
DATA 1,1,-1,1,-1,-1,1,-1,0,1,0,2,3,2,-3,2,1,0,4,0,4,1.5,3,0,-1,0,-4,0,-4,1.5,-3,0
DATA -1.25,-1.5,1.25,-1.5,-1.5,-1.25,1.5,-1.25,-2,0,2,0,0,0,0,-1
DATA -0.8,0.8,0.8,0.8,-0.5,0,0.5,0,-1.6,0,1.6,0,999,999
REM 1=House (composite of intact and holed)
DATA -4,0,4,0,4,3,1,6,-1,6,-4,3,4,4,1,7,-1,7,-4,4,-3,5,-2,6,-2,7,-3,7,-1,0,1,0,1,3.5,-1,3.5
DATA 2,1,2,3,1,4,-1,4,-2,3,-2,1,999,999
REM 2=Predator (facing right)
DATA -8,0,-7,-1,6,-1,8,0,7.5,1,5,2,3,1,-7,1
DATA -6,1,-4,1,-6,4,-7,4,-6,-1,-4,-1,-5,-3,-6,-3,-3,-0.5,2,-0.5,1.5,0.5,-1,0.5
DATA 4,-2,5,-2,5.5,-1.5,5,-1,4,-1,3.5,-1.5
DATA -8,2,-8,-2,999,999
REM 3=Safe House
DATA -8,0,8,0,8,6,-8,6,6,7,-6,7,-1,0,1,0,1,4.5,-1,4.5,-6,2,-3,2,-3,4,-6,4,3,2,6,2,6,4,3,4,-12,-2,12,-2,10,0,-10,0,999,999
REM 4=Lawn
DATA -12,-2,12,-2,10,0,-10,0,999,999
REM Mountain segments 5-9
DATA -2,0,-1,2,0,0,1,1,2,0,999,999
DATA -2,0,-1,2,1,1,2,0,999,999
DATA -2,0,-1,1.5,0,0,1,2,2,0,999,999
DATA -2,0,-1,1,0,1,1,2,2,0,999,999
DATA -2,0,-1,1,0,0,1,.5,2,0,999,999
REM 10=Fence X
DATA -3,0,-2,0,2,0,3,0,3,6,2,6,-2,6,-3,6,0,2,1,3,0,4,-1,3,999,999
REM 11=Running Man (facing right)
DATA 0,0,1.06,-1.06,1.06,-2.56,0,-3,-1.5,-2.6,-1.06,-1.06,-2.56,-1.06,0,-1.5,-1.5,-1.5,0,-2.12
DATA -0.5,2.5,0.5,2.5,0.5,3.5,-0.5,3.5
DATA 0,2,-0.5,1,1,1,999,999
REM 12=Standing Man
DATA -1,-3,1,-3,-1,0,-0.25,0,0,0,0.25,0,1,0,-0.5,2,0,2,0.5,2,-0.5,2.5,0.5,2.5,0.5,3.5,-0.5,3.5,1,4,-1,4,-1,2,-2,3,-1,3.5,999,999
REM 13=Tank Base
DATA -7.5,2,-7,1,-6,0,-5,0,-4,-0,-3,0,-2,0,-1,0,0,0,1,0,2,0,3,0,4,0,5,0,6,0,7,1,7.5,2
DATA -8,2,-8,4,-7,5,7,5,8,4,8,2
DATA -4,5,4,5,-3,7.5,3,7.5,999,999
REM 14=Tank top (gun): Special routines applied to store additional copy for rotation
DATA 0,6,-1,6,-0.6,6,0.6,6,1,6,-1,10.5,-0.6,11,0.6,11,1,10.5,999,999
REM 15=Missile
DATA 0,2,0,-2,-1,-2,1,-2,0,-1,999,999
REM 16=UFO saucer
DATA -3,-2,3,-2,4,-1,4,1,3,2,-3,2,-4,1,-4,-1,-2,2,2,2,1,3,-1,3,-1,1.5,1,1.5,-2,-2,2,-2,-1,2.5
DATA -1,-2,1,-2,-2,-5,2,-5,-1,-5.5,1,-5.5,999,999
REM 17=UFO lights
DATA -4,-1,-3,-1,-2,-1,-1,-1,0,-1,1,-1,2,-1,3,-1,4,-1
DATA -4,1,-3,1,-2,1,-1,1,0,1,1,1,2,1,3,1,4,1,999,999
REM 18=Tiny helicopter
DATA 0,-1,1,0,0,1,-1,0,3,0,3,1,2,0,2,1,-2,1,999,999
DATA 1000,1000