Another update! have some shine on the sphere and the world that you play in is a little brighter, also fixed the win, want another go or quit part at the end.
Rem Project: d3connect5
Rem Created: 6/11/2005 10:33:46 AM
rem @howdo.
Rem ***** Main Source File *****
rem Standard Setup Code
rem will need a skysphere picture to make the background to work.
rem on ai yet will have to find a friend to play.
sync on : sync rate 0 :
backdrop on
color backdrop rgb(0,0,0) : hide mouse
set text font "arial" : set text size 26 : set text transparent
set text to bold
for w=1 to 4
:read text$:text 0,0, text$
get image W+1,0,0,text width(text$),text height(text$)
cls
NEXT W
box 0,0,200,200,RGB(0,255,0),RGB(0,255,0),RGB(0,255,0),RGB(0,255,0)
get image 6,0,0,200,200
cls
box 0,0,200,200,RGB(255,0,0),RGB(255,0,0),RGB(255,0,0),RGB(255,0,0)
get image 7,0,0,200,200
cls
set text size 16
data "BACK","FRONT","RIGHT","LEFT"
set text to normal
rem some globals may not be need
global rowdcount rowlrcount plainposz plainposy plainposx won gameover
global pressedl pressedr pressedu pressedd ob done dist# player sky
global f current score sky ob1 obposx level obposz
global Music_Number=1
global current_track=0
global proceed$="no"
global cd_tracks=0
global repeat$="No"
global status$="Stopped"
global rightkey$="free"
global leftkey$="free"
global upkey$="free"
global downkey$="free"
global rightkey_button=0
global leftkey_button=0
global upkey_button=0
global downkey_button=0
global rightkey_switch_button$="off"
global leftkey_switch_button$="off"
global upkey_switch_button$="off"
global downkey_switch_button$="off"
dist#=-180
autocam off : position camera 0,0,10,dist#
rem -------------------------------------------------
sky=1:rem change to 1 if you have a skysphere to load
rem -------------------------------------------------
gosub setup
plainposy=-8:plainposx=60:plainposz=0
gosub platform
turns=0:ob1=1:ob2=1:obposy=0:player=1:playeronewins=0:playertwowins=0
gameover=1
audio_cd()
if (proceed$="yes")
downkey_switch_button$="on"
locate_track("play")
endif
new = 0
make light 1
do
if (proceed$="no") or GET NUMBER OF CD TRACKS()=0 or new<>0
`if MUSIC EXIST(Music_Number)=1 then delete music Music_Number
audio_cd()
current_track=0
status$="Stopped"
proceed$="no"
text 0,310,"no proceeds current_track="+str$(current_track)+"status="+status$
`if MUSIC EXIST(Music_Number)=1 then delete music Music_Number
new = 1
else
if (proceed$="yes") or new=1
if new = 1
new = 0
locate_track("play")
endif
endif
endif
`if GET NUMBER OF CD TRACKS()=0
`
`current_track=0
`status$="Stopped"
`proceed$="no"
`text 0,320,"get number of cd tracks current_track="+str$(current_track)+"status="+status$
`endif
if (proceed$="yes")
text 0,300,"yes play "+str$(MUSIC VOLUME (Music_Number))+"Music_Number="+str$(Music_Number)+"current_track="+str$(current_track)+"status="+status$
update_music_sequence()
if inkey$()="m" then stop music Music_Number : status$="Stopped"
if inkey$()="p" then play music Music_Number : status$="Playing"
endif
rem setup screen
gosub screen
rem rotate skysphere image
gosub rotateskysphere
rem colour player text
if player=1
ink RGB(255,0,0),0
else
if player=2
ink RGB(128,255,0),0
else
ink rgb(255,255,255),0
endif
endif
rem show who's go
set text size 20
center text screen width()/2,80,"Player "+str$(player)+ " turn."
rem move carmera around object
` set camera to follow object position x(217),object position y(217),object position z(217),wrapvalue(360)+rt#,dist#,0,1,1
position object 218,plainposx,plainposy,plainposz
rem store object 218
gosub moveview
obposx=plainposx
obposz=plainposz
rem check which keys have been pressed
gosub checkkeys
oldplayer=player:OLDrk=rk:oldturns=turns:level=-20:col=0
rem return key check if pressed
rk=returnkey()
If rk=1
rem player1 red
If OLDrk=0 and oldplayer=1
done=0
if col<=6
repeat
if putted(col,rowdcount,rowlrcount)=0 and done=0
putted(col,rowdcount,rowlrcount)=1
done=1
if col=<6
inc level,20
inc col,1
endif
endif
if done=0 then inc col,1:inc level,20
until done=1 or col=6
if col<7 and done=1
show object ob1
color object ob1,RGB(255,0,0)
for j=200 to 0 step -1
position object ob1,obposx,level+j,obposz
gosub screen
sync
` wait 5
next j
inc ob1
`oldturns=turns:
who(col,rowdcount,rowlrcount)=1
placed(turns,0)=1
placed(turns,1)=obposx:placed(turns,2)=level:placed(turns,3)=obposz
inc turns
sync
gosub checkifwon
if won=1
gosub winscreen
inc playeronewins
else
player=2
endif
endif
endif
Else
rem player 2 green
If OLDrk=0 and oldplayer=2
done=0
if col=<6
repeat
if putted(col,rowdcount,rowlrcount)=0 and done=0
putted(col,rowdcount,rowlrcount)=1
done=1
if col=<6
inc level,20
inc col,1
endif
endif
if done=0 then inc col,1: inc level,20
until done=1 or col=6
if col<7 and done=1
show object ob2+108
color object ob2+108,RGB(0,255,0)
oldcol=col
`position object ob2+108,obposx,level,obposz
for j=200 to 0 step -1
position object ob2+108,obposx,level+j,obposz
gosub screen
sync
` wait 5
next j
inc ob2
who(col,rowdcount,rowlrcount)=2
placed(turns,0)=2
placed(turns,1)=obposx:placed(turns,2)=level:placed(turns,3)=obposz:oldturns=turns
inc turns
sync
gosub checkifwon
if won=1
gosub winscreen
inc playertwowins
else
player=1
endif
endif
else
endif
else
` text 30,0, "holding"
`Holding click
endif
endif
Endif
rem update screen
sync
loop
rem works ok if messy
checkkeys:
if upkey()=1 and pressedd=0
pressedd=1
if rowdcount>=5
rowdcount=5
else
inc rowdcount,1
inc plainposz,20
endif
else
if downkey()<>1
pressedd=0
endif
endif
rem
if downkey()=1 and pressedu=0
pressedu=1
if rowdcount<=0
rowdcount=0
else
dec rowdcount,1
dec plainposz,20
endif
else
if upkey()<>1
pressedu=0
endif
endif
rem
if rightkey()=1 and pressedl=0
pressedl=1
if rowlrcount<=0
rowlrcount=0
else
dec rowlrcount,1
dec plainposx,-20
endif
else
if leftkey()<>1
pressedl=0
endif
endif
if leftkey()=1 and pressedr=0
pressedr=1
if rowlrcount>=5
rowlrcount=5
else
inc rowlrcount,1
inc plainposx,-20
endif
else
if rightkey()<>1
pressedr=0
endif
endif
return
platform:
rem when i fig in out it will shorten
rem put gery platforms in a grid
obn=219
for pl=0 to 100 step 20
for xb=60 to -40 step -20
position object obn,xb,plainposy-1,pl
show object obn
inc obn,1
next xb
next pl
position object 256,10,plainposy-1,120
position object 257,10,plainposy-1,-20
position object 258,80,plainposy-1,50
position object 259,-60,plainposy-1,50
return
rem setup setup setup setup
setup:
dim placed(216,4)
dim putted(6,6,6)
dim who(6,6,6)
placed(0,0)=-1
placed(0,1)=-1
placed(0,2)=-1
placed(0,3)=-1
if sky=1 then gosub skybox
sizeofsphere=15
startcount=1
endcount=108
for colorobject=1 to 2
for objectnumber=startcount to endcount
make object sphere objectnumber,sizeofsphere
if colorobject=1
color object objectnumber,RGB(255,0,0)
endif
if colorobject=2
color object objectnumber,RGB(128,255,0)
endif
position object objectnumber,-1000,0,0
next objectnumber
startcount=109
endcount=216
next colorobject
rem invisable sphere
MAKE OBJECT TRIANGLE 217,0,0,0,0,0,0,0,0,0:
rotate object 217,-180,-180,-180
position object 217,10,50,50
objectnumber=0
posx=-40:posz=0:posy=0:count=1
for rows=1 to 6
for col=1 to 6
for plains=1 to 6
objectnumber=objectnumber+count
position object objectnumber,posx,posy,posz
if objectnumber<=108
set sphere mapping on objectnumber,7
set object specular objectnumber,RGB(255,0,0)
else
set sphere mapping on objectnumber,6
set object specular objectnumber,RGB(0,255,0)
endif
set object cull objectnumber,1
hide object objectnumber
inc posz,20
next plains
inc posy,20
posz=0
next col
posx=posx+20:posz=0:posy=0
next rows
make object plain 218,20,20
color object 218,RGB(255,255,255)
xrotate object 218,-90
rem make gery platform squares
for k=219 to 255
make object plain k,19,19
color object k,RGB(250,250,0)
position object k,0,-8,0
xrotate object k,-90
hide object k
next k
make object plain 256,50,20
texture object 256,2
rotate object 256,-90,0,0
set object transparency 256,1
make object plain 257,50,20
texture object 257,3
rotate object 257,-90,180,0
set object transparency 257,1
make object plain 258,50,20
texture object 258,4
rotate object 258,-90,90,0
set object transparency 258,1
make object plain 259,50,20
texture object 259,5
rotate object 259,-90,-90,0
set object transparency 259,1
MAKE OBJECT TRIANGLE 261,0,0,0,0,0,0,0,0,0:`261
`Make a mesh from the object
MAKE MESH FROM OBJECT 217,261:`217,261
`Add a limb onto the object using the mesh we just made
ADD LIMB 261,1,217:261,1,217`
`Offset the limb 700 units away
OFFSET LIMB 261,1,0,0,-180:`261,1
`Hide the limb for lag reduction
HIDE LIMB 261,1:`261
`Hide the dummy object for lag reduction
HIDE OBJECT 261:`261
`Start program loop
position object 261,10,50,50
return
checkifwon:
rem across and down and up rows
col=1
repeat
row=0
repeat
if won<>1
if who(col,row,0)=player and who(col,row,1)=player and who(col,row,2)=player and who(col,row,3)=player and who(col,row,4)=player
won=1
endif
endif
if won<>1
if who(col,row,1)=player and who(col,row,2)=player and who(col,row,3)=player and who(col,row,4)=player and who(col,row,5)=player
won=1
endif
endif
if won<>1
if who(col,0,row)=player and who(col,1,row)=player and who(col,2,row)=player and who(col,3,row)=player and who(col,4,row)=player
won=1
endif
endif
if won<>1
if who(col,1,row)=player and who(col,2,row)=player and who(col,3,row)=player and who(col,4,row)=player and who(col,5,row)=player
won=1
endif
endif
inc row,1
until row=6
if col=6 then exit :else inc col,1
until won=1
rem
rem
col=1
repeat
if won<>1
if who(col,0,0)=player and who(col,1,1)=player and who(col,2,2)=player and who(col,3,3)=player and who(col,4,4)=player
won=1
endif
endif
if won<>1
if who(col,1,1)=player and who(col,2,2)=player and who(col,3,3)=player and who(col,4,4)=player and who(col,5,5)=player
won=1
endif
endif
if col=6 then exit :else inc col
until won=1
rem front left to back right
col=0
repeat
if won<>1
if who(col,5,0)=player and who(col,4,1)=player and who(col,3,2)=player and who(col,2,3)=player and who(col,1,4)=player
won=1
endif
endif
if won<>1
if who(col,4,1)=player and who(col,3,2)=player and who(col,2,3)=player and who(col,1,4)=player and who(col,0,5)=player
won=1
endif
endif
if col=6 then exit :else inc col
until won=1
`rem ******************************************************************
rem inside front left to inside back right
col=1
repeat
if won<>1
if who(col,4,0)=player and who(col,3,1)=player and who(col,2,2)=player and who(col,1,3)=player and who(col,0,4)=player
won=1
endif
endif
rem
rem outside front left to outside back right
if won<>1
if who(col,5,1)=player and who(col,4,2)=player and who(col,3,3)=player and who(col,2,4)=player and who(col,1,5)=player
won=1
endif
endif
if col=6 then exit :else inc col,1
until won=1
rem inside back left to inside front right
col=1
repeat
if won<>1
if who(col,0,1)=player and who(col,1,2)=player and who(col,2,3)=player and who(col,3,4)=player and who(col,4,5)=player
won=1
endif
endif
rem outside back left to outside front right
if won<>1
if who(col,1,0)=player and who(col,2,1)=player and who(col,3,2)=player and who(col,4,3)=player and who(col,5,4)=player
won=1
endif
endif
if col=6 then exit: else inc col,1
until won=1
return
reset:
center text screen width()/2,100, "Do You whis to play again? Y / N"
sync
fo=0
won=0
for turns = 1 to 216
hide object turns
next turns
turns=0
undim who()
undim placed()
undim putted()
dim who(6,6,6)
dim placed(216,4)
dim putted(6,6,6)
placed(0,0)=-1
placed(0,1)=-1
placed(0,2)=-1
placed(0,3)=-1
turns=0:ob1=1:ob2=1:obposy=0:player=1
gameover=1
rowdcount=0
rowlrcount=0
plainposy=-8:plainposx=60:plainposz=0
return
skybox:
load image "earthmap.bmp",1
make object sphere 1000,-1000
texture object 1000,1
sky=1
return
screen:
rem screen key info
set text size 16
set text to normal
ink RGB(255,255,255),0
center text screen width()/2,0,"A'rrowskeys to move white square"
center text screen width()/2,16,"Press Return Key to place a sphere"
center text screen width()/2,32,"Rotate Platform View using the mouse"
center text screen width()/2,48,"Press Spacebar to Reset View"
`text 10,48,"F="+str$(f)+" score="+str$(score)+" bestmove="+Str$(bestmove)+" Current="+str$(current)+" winningscore="+str$(winningscore)
p1$="Player 1 wins = "+str$(playeronewins)
p2$="Player 2 wins = "+str$(playertwowins)
center text text width(p1$),0,p1$
center text screen width()-text width(p2$),0,p2$
return
rotateskysphere:
if sky=1
turn object right 1000,ro#
inc ro#,.0000001
endif
return
winscreen:
set text to normal
gosub screen
set text size 32
set text to bold
center text screen width()/2,screen height()/2-text height("W")," We have a Winner you've WON! "
if player=1 then ink rgb(255,0,0),0:center text screen width()/2,screen height()/2,"Player One"
if player=2 then ink rgb(0,255,0),0:center text screen width()/2,screen height()/2,"Player Two"
sync
wait 5000
repeat
set text to normal
gosub screen
set text size 32
set text to bold
center text screen width()/2,screen height()/2,"Play again Yes No"
gosub moveview
sync
until inkey$()="y"
if inkey$()="y"
gosub reset
set text to normal
else
center text screen width()/2,screen height()/2,"Goodbye play again soon."
sync
wait 3000
end
endif
return
moveview:
if spacekey()=1 then camy#=0:camx#=0
CAMY#=CAMY#+MOUSEMOVEX()*.1
CAMX#=CAMX#+MOUSEMOVEY()*.1
`Position the dummy object at the object to be looked at
POSITION OBJECT 217,OBJECT POSITION X(261),OBJECT POSITION Y(261),OBJECT POSITION Z(261)
`Position the camera at the dummy object's limb
POSITION CAMERA LIMB POSITION X(261,1),LIMB POSITION Y(261,1),LIMB POSITION Z(261,1)
`Point the camera at the object to be looked at
POINT CAMERA OBJECT POSITION X(261),OBJECT POSITION Y(261),OBJECT POSITION Z(261)
YROTATE OBJECT 261,CAMY#
XROTATE OBJECT 261,CAMX#
return
function update_music_sequence()
if (status$="Playing")
if (MUSIC PLAYING(Music_Number)=0)
if (current_track <> cd_tracks)
current_track=current_track+1
loadandplay_audio_CD("play")
endif
endif
endif
if (status$="Playing")
if (repeat$="Yes")
if (current_track=cd_tracks)
if (MUSIC PLAYING(Music_Number)=0)
current_track=1
loadandplay_audio_CD("play")
endif
endif
endif
endif
endfunction
function locate_track(command$)
if (command$="forward")then:current_track=current_track+1
if (command$="backward")then:current_track=current_track-1
if (current_track<1)then:current_track=cd_tracks
if (current_track>cd_tracks)then:current_track=1
if (command$="play") then: loadandplay_audio_CD("play")
if (command$="stop") then: loadandplay_audio_CD("stop")
if (command$="loop") then: repeat_audio_CD("loop")
if (command$="noloop") then: repeat_audio_CD("noloop")
endfunction
function repeat_audio_CD(command$)
if (command$="loop")
if (repeat$="No")
repeat$="Yes"
endif
endif
if (command$="noloop")
if (repeat$="Yes")
repeat$="No"
endif
endif
endfunction
function loadandplay_audio_CD(command$)
delete music Music_Number
LOAD CDMUSIC current_track,Music_Number
if (command$="play")
if (MUSIC PLAYING(Music_Number)=0)
delete music Music_Number
LOAD CDMUSIC current_track,Music_Number
PLAY MUSIC Music_Number
status$="Playing"
endif
endif
if (command$="stop")
if (MUSIC PLAYING(Music_Number)=0)
stop music Music_Number
status$="Stopped"
endif
endif
endfunction
function audio_cd()
if (GET NUMBER OF CD TRACKS()=0)
proceed$="no":exitfunction
else
proceed$="yes"
cd_tracks=GET NUMBER OF CD TRACKS()
current_track=1
LOAD CDMUSIC current_track,Music_Number
endif
endfunction
I'm not getting you down am I, Ho Look! another fancy Door?
