Willkommen bei der 3D-Pilzsuche! Meine Idee ist ein kleines OpenGL-Spiel, welches sich wie ein Shooter spielt. Steuerung: W A S D + Maus
Die Low-Poly-Grafik verwendet generative Ansätze und besteht komplett aus Zylindern und Kugeln.
Der Code hat genau 4K (4096 Bytes) und läuft ohne Abhängigkeiten in XProfan X4 bis zu XProfan 11 sowie Profan2Cpp und FreeProfan. Durch Anpassung des Random Seeds in Zeile 79 bekommt man theoretisch unendlich neue Levels, es wird allerdings bei der Erstellung nicht geprüft ob Spieler oder Pilze in Bäumen hängen
Ich reiche gerne bei Gelegenheit eine besser lesbare 8K Version nach.
Hier als ausführbare EXE Datei als Download:
Viel Spaß beim Spielen!
Code
declare h&,ft&,wlk&,a#,u&,t!,r!,rb%,rxt!,rYT!,pXT!,pZT!,rx!,ry!,rzs!,rz!,posX!,posY!,posZ!,msx%,msy%,mx%,my%,list&,f&,t&,t2&,px!,py!,pz!,mxinc%,myinc%,pos#,p#,o#[220],tx!,tz!,col&,imp!,t_fl&,v_fl!,tp!,p&,p&[10]
Dim pos#,32:Dim p#,8:Dim a#,32
def r(0) -75+(Rnd(1500)*.1)
u& = UseDll("user32.dll"):ImportFunc(u&,"SetCursorPos","s"):ImportFunc(u&,"GetCursorPos","g")
o#[0]=new(xpDisk)
Proc mve
If iskey(2)
if (rb%=0) & (posY!=-1)
imp!=20:rb%=1
Endif
Else
rb%=0
Endif
posY!=posy!-(imp!*.01) +v_fl!
If posY!<-1:inc t_fl&:v_fl!=.01*t_fl&:Else:t_fl&=0:v_fl!=0:imp!=0:posY!=-1:Endif
mxinc%=mxinc%+msx%-mx%:myinc%=myinc%+msy%-my%:rYT!=(-mxinc%)*.1:rXT!=(-myinc%)*.1
Case (rXT!>60):rXT!=60
Case (rXT!<-60):rXT!=-60
Case (abs(rXT!-rX!)>.001):rX!=rX!+((rXT!-rX!)*.45)
Case (abs(rYT!-rY!)>.001):rY!=rY!+((rYT!-rY!)*.45)
If iskey(83):pz!=-.2:Elseif iskey(87):pz!=.2:Endif
If iskey(68):py!=-.2:Elseif iskey(65):py!=.2:Endif
If (pz!<>0) | (py!<>0)
If (pz!<>0) & (py!<>0):pz!=pz!*.7071:py!=py!*.7071:Endif
t!=py!
py!=cos(.0174533*ry!)*t!-sin(.01745*ry!)*pz!
pz!=sin(.0174533*ry!)*t!+cos(.01745*ry!)*pz!
col&=0
o#[0].posx!=pXT!+py!
o#[0].posy!=pZT!+pz!
o#[0].x!=.5
Whileloop 1,210
Case intersect("d",o#[&loop],o#[0]):col&=&loop
Wend
IfNot col&
pXT!=pXT!+py!:pZT!=pZT!+pz!
ElseIf col&>200
Inc p&
p&[col&-200]=1
o#[col&].posx!=9999
Endif
pz!=0:py!=0
Endif
Case (abs(pXT!-posX!)>.001):posX!=posX!+((pXT!-posX!)*.2)
Case (abs(pZT!-posZ!)>.001):posZ!=posZ!+((pZT!-posZ!)*.2)
If (mx%<20) | (mx%>%maxx-20) | (my%<20) | (my%>%maxy-20)
msx%=%maxx*.5
msy%=%maxy*.5
s(msx%,msy%)
Else
msx%=mx%
msy%=my%
Endif
g(p#):mx%=Long(p#,0):my%=Long(p#,4)
Endproc
Proc drw
oGL("Clear")
oGL("Push")
oGL("Rotate",rx!,ry!,rz!)
oGL("Move",posx!,posy!,posz!)
oGL("glLightfv",~GL_LIGHT0,~GL_POSITION,pos#)
oGL("glLightfv",~GL_LIGHT0,~GL_AMBIENT,a#)
Whileloop 20
oGL("Push")
oGL("Move",sin(&loop+f&*.001/&loop)*20*&loop,30,cos(&loop+f&*.001/&loop)*20*&loop)
oGL("Rotate",0,&loop+f&*.001/&loop,0)
oGL("Color",1,1,1,1)
IfNot wlk&
wlk&=ogl("StartList")
Whileloop 3
oGL("Move",0,0,6)
oGL("Sphere",8-(&loop MOD 2)*2,6,6)
Wend
ogl("EndList")
Endif
ogl("drawlist",wlk&)
oGL("Pop")
Wend
oGL("Push"):oGL("Rotate",-90,0,0):oGL("Move",-posx!-120,posz!-120,0):oGL("Color",.15,.2,0,1):oGL("Quad",480,480):oGL("Pop")
WhileLoop 10
Set("RandSeed",&loop+916)
If p&[&loop]<>1
oGL("Push")
tx!=r():tz!=r():tp!=1.8+rnd(150)*.01
if p&[&loop]=0
o#[&loop+200]=new(xpDisk):o#[&loop+200].posx!=-tx!:o#[&loop+200].posy!=-tz!:o#[&loop+200].x!=tp!*.15:p&[&loop]=2
endif
oGL("Move",tx!,.08,tz!):oGL("Color",.3,.2,.2,1):oGL("Cylinder",.08,.025,.2,5):oGL("Color",.7,.63,.5,1)
oGL("Move",0,.1,0)
oGL("Rotate",20-rnd(40),20-rnd(40),0)
oGL("glScalef",1.0,.5,1.0):oGL("Sphere",.25,5,5):oGL("Pop")
Endif
Wend
IfNot list&
list&=ogl("StartList")
WhileLoop 200
oGL("Push")
tx!=r():tz!=r():tp!=1.8+rnd(150)*.01
o#[&loop]=new(xpDisk)
o#[&loop].posx!=-tx!
o#[&loop].posy!=-tz!
o#[&loop].x!=tp!*.75
oGL("Move",tx!,0,tz!):oGL("Rotate",0,rnd(360),0):oGL("Color",.3,.2,.05,1):oGL("Cylinder",tp!*.2,tp!*.15,tp!,6):oGL("Color",.1,.2,.05,1):oGL("Move",0,.25*tp!,0)
WhileLoop 7+tp!
oGL("Move",0,.45*tp!,0):oGL("Cylinder",tp!*1.2-&loop*.25,0,tp!,6)
Wend
oGL("Pop")
Wend
WhileLoop 1,500
tx!=r():tz!=r():tp!=.2+rnd(200)*.005
oGL("Push"):oGL("Move",tx!,-tp!*.5,tz!):oGL("Rotate",0,rnd(360),rnd(360)):oGL("Color",.2,.2,.2,1):oGL("Sphere",tp!,4,6):oGL("Pop")
Wend
ogl("EndList")
Endif
ogl("DrawList",list&):oGL("Pop"):oGL("Origin",-6,3,-10):oGL("Print",ft&,str$(p&)+" / 10"):oGL("Show")
Endproc
windowstyle 80:cls:Showcursor 0:ShowMax
oGL("Init",%hWnd,.68,.80,1,1):oGL("PosMode",1):oGL("glShadeModel",~GL_FLAT):oGL("Fog",3,80,99):oGL("glEnable",$803A)
h&=create("Font","Arial",1,0,0,0,0):ft&=oGL("OutlineFont",h&,.1):deleteobject h&
Long pos#,0=single(0),single(40),single(0),single(1)
Long a#,0=single(.5),single(.5),single(.7),single(1)
WhileNot IsKey(27)
t2&=&gettickcount
Case (t2&-t&)<16:sleep 16-(t2&-t&)
t&=t2&
mve()
drw()
inc f&
Wend
FreeDll u&:Dispose p#,pos#,a#
Bisher war ich nur auf den anderen XProfan-Foren unterwegs und hier nur als Gast aber das möchte ich gerne ändern 
