| cube der hammer codder unbekant von ??? |
| hi echt stark [code:1:8bf70cdd3c]Graphics3D 640,480,16,3 fnt=LoadFont("Arial Black",170,True,False,False) If Not fnt Then End SetFont fnt camera=CreateCamera() MoveEntity camera,0,0,-10 CameraZoom camera,1.6 Global texture=CreateImage (64,68) ;Image is higher than texture.. See further down for explanation Global txtr=CreateTexture (64,64) cube=CreateCube() EntityTexture cube,txtr,0,0 licht=CreateLight(1) LightColor licht,150,120,190 PointEntity camera,cube PointEntity licht,cube MoveEntity licht,-20,0,-6 MoveEntity cube,.4,0,-6 ; Creating an array of 26 textures for letters A-Z Dim letter(26) ClsColor 90,0,210 For i=0 To 25 letter(i)=CreateTexture (128,128) SetBuffer TextureBuffer(letter(i)) Cls Text 62,63,Chr$(65+i),True,True Next ClsColor 0,0,0 ; Define a type for scrolltext-cubes: entitiyhandle, x- and y position. Type wuerfel Field hand Field xpos# Field ypos# End Type Global scroll$=" JUST A LITTLE DEMO FOR REALTIME CALCULATED TEXTURES AND TYPE BASED SCROLLTEXT CHEERS TXW " newscrollitem=0 ;Delaycounter for next scrolltext-cube Global sc_offset=1 ;Offset for relevant character of scroll$ flp=1 ;switch for only rendering texture every second loop SeedRnd MilliSecs() Color 40,0,90 While Not KeyHit(1) newscrollitem=newscrollitem+1 If newscrollitem > 24 ;Is it time for engaging the next scrollcube? char=Asc(Mid$(scroll$,sc_offset,1))-65 ;compute ASCIIcode of relevant character into Array-Index for letter(X) If char >= 0 And char < 26 ;create new cube object and initialize its fields. sci.wuerfel=New wuerfel scixpos#=-4.8 sciypos#=-7 scihand=CreateCube () ScaleEntity scihand,.5,.5,.5 EntityTexture scihand,letter(char),0,1 ;Assign appropriate texture for relevant character EntityTexture scihand,txtr ;...just as the color-texture EndIf newscrollitem=0 ;reset delaycounter sc_offset=sc_offset+1 ;update relevant character of scroll$ If sc_offset > Len(scroll$) Then sc_offset=1 ;wrap scrolltext if ended EndIf For sci.wuerfel=Each wuerfel ;Update entity-positions and delete if necessary... PositionEntity scihand,scixpos#,sciypos#,0 TurnEntity scihand,.2,.3,.4 sciypos#=sciypos#+.07 If sciypos#>7 FreeEntity scihand Delete sci.wuerfel EndIf Next flp=1-flp ;flp switches between 1 and 0 (1-1=0 -> 1-0=1) If Flp=1 Then updatetexture() ;updatetexture() will therefor only be called every 2nd loop SetBuffer BackBuffer() TurnEntity cube,.3,.7,.8 UpdateWorld RenderWorld Rect 20,0,2,479 ;just for optics.. Rect 123,0,2,479 Flip Wend FreeSound musc ClearWorld() End Function updatetexture() SetBuffer ImageBuffer(texture) LockBuffer ImageBuffer(texture) For i=1 To Rnd(0,20) ;Add random number of pixels in random colors r=Rnd(0,255) g=Rnd(0,255) b=Rnd(0,255) WritePixelFast Rnd(0,64),33,r Shl 16+g Shl 8+b Next For x=0 To 64 ;Recalculate color if every pixel from upper half of texture from color- For y=33 To 0 Step -1 ;values of itself and its x-neighbours heinz=ReadPixelFast (x,y) heinz2=ReadPixelFast (x+1,y) heinz3=ReadPixelFast (x-1,y) heinz4=(heinz3+heinz2)/2 heinz=(heinz4+heinz)/2 WritePixelFast x,y-1,heinz ;Write pixel in upper half WritePixelFast x,67-y,heinz ;...and lower half Next Next UnlockBuffer ImageBuffer(texture) SetBuffer TextureBuffer(txtr) ;Finally blit the texture image into texture DrawBlockRect texture,0,0,0,0,64,32 ;but leave out the four pixel-rows in the middle for DrawBlockRect texture,0,32,0,36,64,32 ;better look. Just try DrawBlock texture,0,0 to End Function[/code:1:8bf70cdd3c] cu MAUPA |
| von ??? |
| Code Tag Benutzen!!!!! Ansonsten siehts nett aus, gab hier aber schonmal bloß mit anderem Text. Um es schneller zu machen die 3 bei Graphics3d auskommentieren |