Global gw%=1024
Global gh%=768
Global gd%=32
Global gm%=1
Global gt$="pick up"
Graphics3D gw,gh,gd,gm
setbuffer backbuffer()
AppTitle gt
seedrnd millisecs()
Const carr=1
const cpick=2
const cover=3
const chigh=4
const cend=0
phase=carr
timer=createtimer(60)
midx=(gw/2)
midy=(gh/2)
kon=100
st=MilliSecs()
ot=st
Global ti#
speed#=0.2
global max=9
Dim n$(max)
Dim sco#(max)
global path$="score.dat"
readscore()
f1=loadfont("arial",20)
f2=loadfont("arial",50,1)
setfont(f1)
ocampiv=createpivot()
ocam=createcamera(ocampiv)
cameraclscolor ocam,128,0,255
rotateentity ocam,90,0,0
positionentity ocam,0,3,0
olight=createlight()
rotateentity olight,90,0,0
ambientlight 128,128,128
dim tex(7,3)
for j=0 to 3
for i=0 to 7
tex(i,j)=loadtexture("cards/"+i+"_"+j+".png",4)
next
next
spr=createsprite()
positionentity spr,0,0,0
scalesprite spr,50,50
entitycolor spr,255,0,0
entityalpha spr,0
entityorder spr,-1
createcards()
repeat
mxs=mousexspeed()
mys=mouseyspeed()
mh1=mousehit(1)
kh_esc=keyhit(1)
kh_ret=keyhit(28)
kd_spc=keydown(57)
key=getkey()
if kh_esc  phase=cend
if kon < 50
entityalpha spr,(50-kon)*.02
else
entityalpha spr,0
endif
select phase
Case carr
For c.Tc=Each Tc
moveentity c\spr,sin(c\rot)*c\speed,-cos(c\rot)*c\speed,0
c\speed=c\speed* .75
if c\speed <=0.0001 
phase=cpick
st=MilliSecs()
endif
next
renderworld
case cpick
if mxs or mys
moveentity ocampiv,(mxs/200.0),0,-(mys/200.0)
movemouse midx,midy
endif
if kd_spc
positionentity ocam,0,1.5 ,0
if kon > 0
If (MilliSecs()-ot) > 50
kon=kon-1
ot=MilliSecs()
endif
endif
else
positionentity ocam,0,3,0
if (kon < 100)
If (MilliSecs()-ot) > 50
kon=kon+2
ot=MilliSecs()
endif
elseif kon > 100 
kon=100
endif
endif
For c.Tc=Each Tc
pick=camerapick(ocam,midx,midy)
if pick=c\spr 
entitycolor c\spr,255,255,255
if mh1 and kd_spc
ind=0
For cc.Tc=Each Tc
If (cc\ind> c\ind)  ind=ind+1
next
If (ind=0)
freeentity c\spr
Delete c.Tc
kon=kon+5
endif
endif
else
entitycolor c\spr,192,192,192
endif
next
renderworld
lcards=countcards()
if (kon=0) or (lcards=0)
deletecards()
phase=cover
ot= MilliSecs()
endif
For c.Tc=Each Tc
cameraproject ocam,entityx(c\spr),entityy(c\spr),entityz(c\spr)
px=projectedx()
py=projectedy()
next
ti#=(MilliSecs()-st)/1000.0
color 192,32,32
rect 10,7,kon*10,25
color 255,255,255
Text midx,10,"Kondition: ",1
color 255,255,255
Text 20,40,"Zeit: "+ti
Text midx,gh-30,"Kamera bewegen: Maus | Bücken: Leertaste | erst hohe(A),dann niedrige(7) Karten",1,1
color 225,192,0
oval midx-5,midy-5,10,10,0
case cover
if kon=0
if key phase=chigh
else
if kh_ret
updatescore(in$,ti#)
phase=chigh
endif
endif
setfont(f2)
color 192,64,64
Text midx,midy-200,"GAME OVER",1,1
if kon=0
color 255,32,32
Text midx,midy+200,"Verloren",1,1
else
color 32,255,32
Text midx,midy-50,"Gewonnen",1,1
color 192,192,0
Text midx,midy+50,"Deine Zeit: "+ti+" sekunden",1,1
in$=inp(in,key)
setfont(f1)
color 225,225,225
Text midx,midy+200,"Name: "+in+"_",1,1
endif
case chigh
if kh_esc
phase=cend
elseif kh_ret
phase=carr
createcards()
kon=100
endif
setfont(f2)
color 192,225,0
Text midx,50,"Bestenliste",1,1
setfont (f1)
for i=0 to max
If ti=sco(i)
color 255,32,32
else
color 225,225,225
endif
Text midx,100+(i*30),(LSet((i+1),5)+LSet(n(i),20)+LSet(sco(i),7)),1
next
text midx-200,midy+300,"esc-beenden",1,1
text midx+200,midy+300,"enter-neu",1,1
end select
flip
cls
waittimer(timer)
Until phase=cend
deletecards()
end
Type Tc
Field ind$
field spr
field typ
field rot
field speed#
end type
function createcards()
size#=.1
pick#=1
for j=0 to 3
for i=0 to 7
c.Tc=New Tc
c\spr=createsprite()
spriteviewmode c\spr,2
rotateentity c\spr,90,0,0
positionentity c\spr,0,.1,0
scalesprite c\spr,size,size
entitypickmode c\spr,1,1
entityradius c\spr,size
entitytexture c\spr,tex(i,j)
c\typ=j
c\ind=i
c\rot=rand(360)
c\speed=rnd(.1,.5)
next
next
end function
function countcards()
ind=0
For c.Tc=Each Tc
If c.Tc <> Null  ind=ind+1
next
Return ind
end function
function deletecards()
For c.Tc=Each Tc
freeentity c\spr
Delete c.Tc
next
end function
function inp$(in$,key)
if key > 32
in=in+chr$(key)
elseif key=8
in=left$(in,len(in)-1)
endif
return in
end function
function readscore()
file=readfile(path)
if file
for i=0 to max
n(i)=ReadString(file)
sco(i)=ReadFloat(file)
next
closefile file
else
for i=0 to max
n(i)="unknown"
sco(i)=999.999
next
endif
end function
Function updatescore(in$,s#)
for i=max to 0 step-1
If s < sco(i)  pos=i
next
for i=max-1 to 0 step-1
if i >=pos
n(i+1)=n(i)
sco(i+1)=sco(i)
endif
if i=pos
n(i)=in
sco(i)=s
endif
next
file=writefile(path$)
for i=0 to max
WriteString(file,n(i))
WriteFloat(file,sco(i))
next
closefile file
end function