Die Mysteriöse Linie

Übersicht BlitzBasic Blitz3D

Neue Antwort erstellen

Silver_Knee

Betreff: Die Mysteriöse Linie

BeitragSo, März 04, 2007 0:25
Antworten mit Zitat
Benutzer-Profile anzeigen
Normalerweise Bekommt man auf dem Bildschirm was man programmiert...
Bei meinem Net.Me Sogar noch eie Linie Gratis.

Bewegt euch mal garnicht. Bei 2 PCs hab ich's getestet Da der hintergrund Blau ist wird die linie Auffallen.

Wird mal ein Ego Shooter Bei dem du Eigene Welten Bauen kannst.

surcecode:

Code: [AUSKLAPPEN]

AppTitle "NET Me"
Global dome
Local con.Entity,PickedType.Entity
EndGraphics
ClearWorld
Graphics3D 800,600,0,1
Const envioren_coll=1,player_coll=2

Type Entity
   Field ent,sur,brush,tex,mirr
   Field info$,indo$,indone
   Field action$,input_type$,oaction$
End Type

Type info
   Field txt$
End Type

Type do
   Field txt$,self$
End Type

player=CreateCube()

Camera=CreateCamera(player)
CameraClsMode Camera,1,1
CameraClsColor Camera,0,0,128
CameraRange Camera,1,200
PositionEntity Camera,0,1,0
CameraProjMode camera,1
CameraClsMode camera,1,1

EntityType player,player_coll
PositionEntity player,0,2,0

plane=boden()

mir=CreateMirror()

light=CreateLight()
TurnEntity light,90,0,0

Collisions player_coll,envioren_coll,2,3
dome=1
Repeat
   
   If KeyHit(41)
      FlushKeys
      SetBuffer FrontBuffer()
      Color 0,0,0
      Rect 0,0,gfx(),FontHeight()
      Locate 0,0
      Color 255,0,0
      todo2.do=New do
      todo2\txt=Input(">")
      todo2\self="Player"
      SetBuffer BackBuffer()
      FlushKeys
   EndIf
   
   Select Play
   Case 0
      Text gfx(2),gfy(2),"Press [ENTER] to start!",1,1
      If KeyHit(28) play=1
   Case 1
      LoadWorld("default.wld")
      play=2
   End Select
   
   If dome=1
      If todo.do<>Null
         todo2.do=todo
         todo=After todo
         Delete todo2
      Else
         todo.do=First do
      EndIf
      
      If todo<>Null
         res=Do(todo\txt,todo\self)
         i.info=New info:Insert i Before First info
         i\txt=todo\txt
         action$=todo\txt
         Repeat
            oaction$=action$;get old action to look for changing
            action=Replace(action,"%myself%",todo\self);Kill %myself% and get myself
            For countc.entity=Each entity;search...
               re$="%indo"+countc\info+"%";...to find and...
               action$=Replace(action,re,countc\indo);...to kill other variables
            Next
         Until oaction=action;Until nothing changed
         i.info=New info:Insert i Before First info
         i\txt=YesNo(res=1,"+","-")+">"+action
      EndIf
   Else
      todo=First do
      If todo<>todo2
         i.info=New info:Insert i Before First info
         i\txt=todo\txt
         action$=todo\txt
         Repeat
            oaction$=action$;get old action to look for changing
            action=Replace(action,"%myself%",todo\self);Kill %myself% and get myself
            For countc.entity=Each entity;search...
               re$="%indo"+countc\info+"%";...to find and...
               action$=Replace(action,re,countc\indo);...to kill other variables
            Next
         Until oaction=action;Until nothing changed
         i.info=New info:Insert i Before First info
         i\txt="?>"+action
      EndIf
      If KeyHit(29) And todo<>Null
         res=Do(todo\txt,todo\self)
         i.info=New info:Insert i Before First info
         i\txt=YesNo(res=1,"+","-")+">"+action
         Delete todo
      EndIf
      If KeyHit(56) And todo<>Null
         i.info=New info:Insert i Before First info
         i\txt="X>"+action
         Delete todo
      EndIf
      todo2=todo
   EndIf
   
   ent=KeyHit(28)Or MouseHit(1)
   If con=Null
      CameraPick camera,400,400
      For c.entity=Each entity
         Select c\input_type
         Case "Console"
            If ent And PickedType=c
               ent=0
               Con=c
               txt$=con\indo
               work$=""
               time=MilliSecs()
               FlushKeys
            EndIf
         Case "Collide"
            For count=1 To 2
               c\indo=EntityCollided(c\ent,count)
               If c\indo<>0 Then c\indone=1:Exit
            Next
         Case "OnOff"
            If ent And PickedType=c
               Con=c
            EndIf
         Case "Go"
            If ent And PickedType=c
               Con=c
            EndIf
         End Select
         If PickedEntity()=c\ent
            PickedType.entity=c
         EndIf
         UpdateObject(c)
      Next
   EndIf   
   If con.Entity=Null
      If KeyDown(205)
         TurnEntity player,0,-1,0
      ElseIf KeyDown(203)
         TurnEntity player,0,1,0
      EndIf
   
      If KeyDown(200)
         TurnEntity camera,-1,0,0
      ElseIf KeyDown(208)
         TurnEntity camera,1,0,0
      EndIf
   
      TurnEntity camera,MouseYSpeed(),0,0
      TurnEntity player,0,-MouseXSpeed(),0
      
      MoveMouse 400,300
      
      If KeyDown(17)
         MoveEntity player,0,0,0.1
      EndIf
      If KeyDown(31)
         MoveEntity player,0,0,-.1
      EndIf
      If KeyDown(32)
         MoveEntity player,0.1,0,0
      EndIf
      If KeyDown(30)
         MoveEntity player,-.1,0,0
      EndIf
   Else
      Select con\input_type
      Case "Console"
         If cur$="" cur=" "
         If time>MilliSecs()-100
            time=MilliSecs()
            cur$=YesNo(a,"|"," ")
            a=Not a
         EndIf
         
         key$=Chr(GetKey())
         If key=Chr(13) Or ent
            con\indo=txt+work
            con\indone=1
            cur$=""
            FlushKeys
         ElseIf key=Chr(04)
            If work$<>""
               work$=Right(work,Len(work)-1)      
            EndIf
         ElseIf key=Chr(30)
            If work$<>""
               txt$=txt$+Mid(work$,1,1)
               work$=Right(work,Len(work)-1)      
            EndIf
         ElseIf key=Chr(31)
            If txt$<>""
               work$=Mid(txt,Len(txt),1)+work
               txt$=Left(txt,Len(txt)-1)
            EndIf
         ElseIf key=Chr(27)
            txt$=""
            work$=""
         ElseIf key=Chr(08)
            If txt$<>""
               txt$=Left(txt,Len(txt)-1)
            EndIf
         ElseIf key=Chr(0)
         Else
            txt$=txt+key
            time=MilliSecs()
         EndIf
                  
         SetBuffer TextureBuffer(con\tex)
            Color 128,128,128
            Rect 0,0,128,128
            Color 0,0,0
            Text 64,20,con\info,1,1
            Rect 10,50,108,28,0
            Text 64,64,txt+cur+work,1,1
            
            If con\mirr Then mirror(0,0,128,128)
         SetBuffer BackBuffer()
         
         BrushTexture con\brush,con\tex
         PaintSurface GetSurface(con\ent,1),con\brush
         
         If cur="" con=Null
      Case "OnOff"
         con\indo=Not con\indo
         SetBuffer TextureBuffer(con\tex)
            If con\indo=1
               Color 0,255,0
            Else
               Color 255,0,0
            EndIf
            Rect 0,0,128,128
            If con\mirr Then mirror(0,0,128,128)
         SetBuffer BackBuffer()
         
         BrushTexture con\brush,con\tex
         PaintSurface GetSurface(con\ent,1),con\brush
         con\indone=1
         con=Null
      Case "Go"
         con\indone=1
         con=Null
      End Select
   EndIf
   
   TranslateEntity player,0,-0.1,0
   
   count=0
   bed=0
   
   For i.info=Each info
      Color 255*(gfx(3)-count)/gfx(3),0,0
      Text 0,count,i\txt
      If count>gfy(3) Delete i
      count=count+FontHeight()+1
   Next
      
   If PickedEntity()<>0
      ProjectEntity PickedEntity(),camera
      Color 255,0,0
      Text ProjectedX(),ProjectedY(),"["+PickedType\info+"]",1,1
   EndIf
   Color 255,0,0
   Plot 400,400
   
   
   Flip
   UpdateWorld
   RenderWorld
Until KeyHit(1)
ClearWorld
EndGraphics
End
;example
mesh=CreateMesh()
brush=CreateBrush(255,255,255)
sur=CreateSurface(mesh,brush)

v1=AddVertex(sur,-10,0,-100)
v2=AddVertex(sur,+10,0,-100)
v3=AddVertex(sur,-10,20,+100)
v4=AddVertex(sur,+10,20,+100)
For count=0 To 3
   VertexColor sur,count,255,255,255
Next

AddTriangle sur,v2,v1,v3
AddTriangle sur,v3,v4,v2

AddTriangle sur,v1,v2,v3
AddTriangle sur,v4,v3,v2
UpdateNormals mesh
EntityType mesh,envioren_coll

Dim Function_mirror_pix(0,0)
Function mirror(sx,sy,w,h)
   Dim Function_mirror_pix(w,h)
   LockBuffer
   For y=0 To h
   For x=0 To w
      Function_mirror_pix(x,y)=ReadPixelFast(x+sx,y+sy)
   Next
   Next
   UnlockBuffer
   
   LockBuffer
   For y=0 To h
   For x=0 To w
      WritePixelFast x+sx,y+sy,Function_mirror_pix(w-x,y)
   Next
   Next
   UnlockBuffer
End Function

Function boden()
   
   tex=CreateTexture(128,128,8)
   SetBuffer TextureBuffer(tex)
      Color 0,0,100
      Rect 0,0,128,128,1
      Color 200,0,0
      Rect 0,0,128+1,128+1,0
   SetBuffer BackBuffer()

   plane=CreatePlane()
   EntityTexture plane,tex
   EntityAlpha plane,0.9
   FreeTexture tex
   PositionEntity plane,.5,0,.5
   EntityType plane,envioren_coll
   
   Return plane
End Function

Function Projectentity(ent,cam)
   CameraProject cam,EntityX(ent),EntityY(ent),EntityZ(ent)
End Function

Function YesNo$(bed,yes$=1,no$=0)
   If bed
      Return yes
   Else
      Return no
   EndIf
End Function

Function CreateConsole()
   m=CreateMesh()
   
   cu=CreateCube ()
      
   b=CreateBrush(254,254,254)
   ;------------------------------------------------------------------
   s=CreateSurface(m,b)
   ;            Texture: x,y   ;v0-----v1 }
   v0=AddVertex(s,-1,3,1   ,0,0);   ;| t2  /|   }
   v1=AddVertex(s,+1,3,1   ,1,0);   ;|   /  |    }Alles vorne
   v2=AddVertex(s,-1,1,-1   ,0,1);   ;| /  t3|   }
   v3=AddVertex(s,+1,1,-1   ,1,1);   ;v2-----v3 }
   
   t2=AddTriangle(s,v0,v1,v2)
   t3=AddTriangle(s,v2,v1,v3)
   ;------------------------------------------------------------------
   b=CreateBrush(255,255,255)
   s=CreateSurface(m,b)
   ;                        ;                v1      
   v0=AddVertex(s,1,1,-1);         ;              /  |      
   v1=AddVertex(s,1,3,1);         ;Vorne<---   / t0 |      
   v2=AddVertex(s,1,1,1);         ;          /      |      
   ;                        ;         v0-----v2      
   ;
   ;                        ;v5                  ;v1-----v5 }
   v3=AddVertex(s,-1,1,-1);      ;|  \               ;| \  t4|   }
   v4=AddVertex(s,-1,1,1);         ;| t1 \   --->Vorne      ;|   \  |    }Alles hinten
   v5=AddVertex(s,-1,3,1);         ;|      \            ;| t5  \|   }
   ;                        ;v4------v3            ;v2-----v4 }
   
   t0=AddTriangle(s,v0,v1,v2)
   t1=AddTriangle(s,v3,v4,v5)
   
   t2=AddTriangle(s,v4,v1,v5)
   t3=AddTriangle(s,v1,v4,v2)
   ;-------------------------------------------------------------------
   
   AddMesh cu,m
   
   FreeEntity cu
   
   ScaleEntity m,0.5,0.5,0.5
   PositionMesh m,0,1,0
   EntityType m,envioren_coll
   EntityPickMode m,2,1
   UpdateNormals m
      
   Return m
End Function

Function AfterLast$(txt$,find$)
   While Not Instr(txt,find)=0
      txt=Mid(txt,Instr(txt,find)+Len(find))
   Wend
   Return txt
End Function

Function Between$(s$,b$,e$,fl=1)
   f=Instr( s,b,fl )+Len(b)
   l=Instr( s,e,f )
   r$=Mid( s,f,l-f)
   Return r
End Function

Function UpdateObject(c.entity)
   If c\indone
      todo.do=New do
      todo\txt=c\action
      todo\self=c\info
   EndIf
   c\indone=0;stop doing after ... doing
End Function

Function Do(action$,me$="")   
   RenderWorld
   Text 400,300,"Buisy",1,1
   Flip
   ;Variable-Update
   Repeat
      oaction$=action$;get old action to look for changing
      action=Replace(action,"%myself%",me);Kill %myself% and get myself
      For countc.entity=Each entity;search...
         re$="%indo"+countc\info+"%";...to find and...
         action$=Replace(action,re,countc\indo);...to kill other variables
      Next
   Until oaction=action;Until nothing changed
   
   ;Do something
   If Instr(action,"Login")=1;login to a game
      If net<>0 StopNetGame;Stop old one - if there is one -
      game$=between(action," "," ");get game-name
      ip$=Afterlast(action," ");get host-ip
      net=JoinNetGame(game,ip);do it
      If net<>0 res=True
   EndIf


   If Instr(action,"Host")=1;Host a game
      If net<>0 StopNetGame;Stop old one - if there is one -
      game$=Afterlast(action," ");get game-name
      net=HostNetGame(game);host it!
      If net<>0 res=True
   EndIf


   If Instr(action,"Refresh")=1;Refresh state of all objects
      refresh
      res=True
   EndIf

   If Instr(action,"Dome No")=1;Refresh state of all objects
      dome=0
      res=True
   EndIf

   If Instr(action,"Dome Yes")=1;Refresh state of all objects
      dome=1
      res=True
   EndIf


   If Instr(action,"Load")=1;load an object
      name$=between(action," "," ");
      fn$=between(action,name+" "," ");
      typ$=afterlast(action," ");
      c.Entity=New Entity
      
      Select True
      Case fn="<AutoSphere>"
         c\ent=CreateSphere()
      Case fn="<AutoConsole>"
         c\ent=CreateConsole()
      Case Instr(fn,"<BSP>")=1
         c\ent=LoadBSP(afterlast(fn,">"))
      Default
         c\ent=LoadMesh(fn)
      End Select
      
      If c\ent=0
         Delete c
         res=False
      Else
         c\brush=CreateBrush(255,255,255)
         c\tex=CreateTexture(128,128)
         c\info=name
         c\input_type=typ$
         c\indo=""
      
         res=True
      EndIf
   EndIf
   
   If Instr(action,"Do")=1;Indone
      obj$=between(action," "," ");get the Object
      For countc.entity=Each entity;search for the obj
         If obj=countc\info Or obj="";if found... or all are selected
            countc\indone=1;DO IT!
         EndIf;   }
      Next;       }Close
      res=True
   EndIf;         }

   If Instr(action,"SetAction")=1;Set the Action of sth
      obj$=between(action," "," ");get the Object
      newaction$=between(action,Chr(34),Chr(34));get new action
      newaction=Replace(newaction,"$","%");get new action
      For countc.entity=Each entity;search for the obj
         If obj=countc\info;if found...
            countc\action=newaction;DO IT!
            res=True
         EndIf;   }
      Next;       }Close
   EndIf;         }

   If Instr(action,"SetIndo")=1;Set the Indo of sth
      obj$=between(action," "," ");get the Object
      newindo$=Afterlast(action," ");get new indo
      For countc.entity=Each entity;search for the obj
         If obj=countc\info;if found...
            countc\indo=newindo;DO IT!
            res=True
         EndIf;   }
      Next;       }Close
   EndIf;         }

   If Instr(action,"Place")=1;Place sth. whereever
      obj$=Between(action,"Place "," ");get that sth.
      x$=Between(action,"Place "+obj+" "," ");get x-coord
      y$=Between(action,"Place "+obj+" "+x+" "," ");get y-coord
      z$=AfterLast(action," ");get z-coord
   
      For countc.entity=Each entity;search for that !sth!
         If obj=countc\info;if that sth.is curr object
            PositionEntity countc\ent,x,y,z;DO IT
            res=True
         EndIf;   }
      Next;       }Close
   EndIf;         }
   
   If Instr(action,"Turn")=1;Place sth. whereever
      obj$=Between(action,"Turn "," ");get that sth.
      x$=Between(action,"Turn "+obj+" "," ");get x-coord
      y$=Between(action,"Turn "+obj+" "+x+" "," ");get y-coord
      z$=AfterLast(action," ");get z-coord
   
      For countc.entity=Each entity;search for that !sth!
         If obj=countc\info;if that sth.is curr object
            TurnEntity countc\ent,x,y,z;DO IT
            res=True
         EndIf;   }
      Next;       }Close
   EndIf;         }

   If Instr(action,"Rotate")=1;Place sth. whereever
      obj$=Between(action,"Rotate "," ");get that sth.
      x$=Between(action,"Rotate "+obj+" "," ");get x-coord
      y$=Between(action,"Rotate "+obj+" "+x+" "," ");get y-coord
      z$=AfterLast(action," ");get z-coord
   
      For countc.entity=Each entity;search for that !sth!
         If obj=countc\info;if that sth.is curr object
            RotateEntity countc\ent,x,y,z;DO IT
            res=True
         EndIf;   }
      Next;       }Close
   EndIf;         }

   If Instr(action,"If")=1;IMPORTANT: IF!!
      strBed$=Between(action,"If"," Then");get the condition
      strVar1$=Between(strBed$," "," "); first var
      strVar2$=Afterlast(strBed$," "); sercond var
      If strVar1=strVar2;equal?
         res=Do(Between(action,"Then "," Else"));do the action between Then And else
      Else
         res=Do(Afterlast(action$,"Else "));do the action with else case
      EndIf
   EndIf
   
   Return res
End Function

Function LoadWorld(filen$)
   file=ReadFile(filen)
   If file=0 Return
   Repeat
      todo.do=New do
      todo\txt=ReadLine(file)
      todo\self=filen
   Until Eof(file)
   Return
End Function

Function gfx(divide=1)
   Return GraphicsWidth()/divide
End Function

Function gfy(divide=1)
   Return GraphicsHeight()/divide   
End Function

Function refresh()
   For con.entity=Each entity
      Select con\input_type
      Case "Console"
         SetBuffer TextureBuffer(con\tex)
            Color 128,128,128
            Rect 0,0,128,128
            Color 0,0,0
            Text 64,20,con\info,1,1
            Rect 10,50,108,28,0
            Text 64,64,con\indo,1,1
            
            If con\mirr Then mirror(0,0,128,128)
         SetBuffer BackBuffer()
         
         BrushTexture con\brush,con\tex
         PaintSurface GetSurface(con\ent,1),con\brush
      Case "OnOff"
         SetBuffer TextureBuffer(con\tex)
            If con\indo=1
               Color 0,255,0
            Else
               Color 255,0,0
            EndIf
            Rect 0,0,128,128
            If con\mirr Then mirror(0,0,128,128)
         SetBuffer BackBuffer()
         
         BrushTexture con\brush,con\tex
         PaintSurface GetSurface(con\ent,1),con\brush
      Case "Go"
      End Select
   Next
End Function

1. dieses EndGraphics usw am Anfang bringt das Programm beider B3d Demo zum Laufen sonst Bleibt es beim Graphics3d Stehen und macht garnichts mehr. In der Vollversion (ohne Updates) musste ich nach jedem run die IDE schließen und wieder öffnen, weil es sonst bei entweder bei CreateSurface stehenbleibt oder garnicht erst läuft.

2. ich hab ne ordnung wie n elefant ich weiß

3. wenn ihr (wie beim start erwähnt) Enter drücktVersucht Ds Programm Die Datei "default.wld" zu laden: Einfach eine machen. Ist ne standartwelt zum einlogen usw.

Meine Sieht So aus:

Load Console <AutoConsole> Console
Place Console 0 0 4
SetAction Console "$indo$myself$$"

Load LoginToServer <AutoConsole> Console
Place LoginToServer 0 0 8
SetAction LoginToServer "Login Net.Me $indo$myself$$"

Load LoadWorld <AutoConsole> Console
Place LoadWorld 4 0 4
SetAction LoadWorld "LoadW $indo$myself$$"

Load SaveWorld <AutoConsole> Console
Place SaveWorld -4 0 4
SetAction SaveWorld "SaveW $indo$myself$$"

Refresh

Achtung Meine Programmiersprache im Spiel ist leider Case sensetive
(war zu faul das wegzumachen^_^')

Viel Spass beim tüfteln^^

Silver_Knee

Betreff: sry

BeitragSo, März 04, 2007 0:36
Antworten mit Zitat
Benutzer-Profile anzeigen
hätte nicht gedacht dass mein code so lang ist.
hab aber schon früher versucht irgend wie alles so zu kürzen dass nurnoch das wichtigste da war aber wie das so ist ... zwischen 1375893. und 1375894. Kürzung ist die linie weg und man weis net wie...

Gameprogman

BeitragSo, März 04, 2007 2:06
Antworten mit Zitat
Benutzer-Profile anzeigen
Benutze das nächste mal Bitte das "Code" tool:

Beispiel:

Code: [AUSKLAPPEN]

Print "WOW"
Print "Ich hab soeben das Code tool benutzt"
Print "Man ist das Cool"

For i=0 to 273
   Print "Das ist so cool das ich diesen text nun 274 mal schreibe"
next

end
www.bandradr.de ! Awesome !
 

FWeinb

ehemals "ich"

BeitragSo, März 04, 2007 10:00
Antworten mit Zitat
Benutzer-Profile anzeigen
Also ich sehe da nicht und ist ausßerdem gut geworden

also bei mir ist der Fehler mit dre Line nicht.
"Wenn die Menschen nur über das sprächen, was sie begreifen, dann würde es sehr still auf der Welt sein." Albert Einstein (1879-1955)
"If you live each day as if it was your last, someday you'll most certainly be right." Steve Jobs

FreetimeCoder

BeitragSo, März 04, 2007 13:54
Antworten mit Zitat
Benutzer-Profile anzeigen
Hm unten wo die Taskleiste ist, da flimmerts bei mir manchmal. Meinst du das?

(PS: WAS fällt dir ein die Abkürzung meines Nicks als deinen zu nehmen? Twisted Evil Very Happy Laughing )
"Wir haben keine Chance, aber wir werden sie nutzen!"
Projekte:
Dexterity Ball (100%)
Aquatic Atmosfear (22 % ca 4700 Zeilen) eingefrohren mangels OOP Fähigkeiten von Blitz
(ehemals Uboot)
PC: Intel D 3 GHz | NVidiaGforce 6700 256 Mb | 1024 Mb DDR RAM 400 Mhz | 2x160 GB S-ATA

Black Spider

BeitragSo, März 04, 2007 13:54
Antworten mit Zitat
Benutzer-Profile anzeigen
bei mir ist auch keine Linie zu sehen...
Coming soon:
http://img132.imageshack.us/im...im2ab6.gif

Silver_Knee

Betreff: sry

BeitragSo, März 04, 2007 13:58
Antworten mit Zitat
Benutzer-Profile anzeigen
Embarassed Sorry Free Time Coder aber "Frani The Coolman" hat einfach zuviele Buchstaben... Embarassed

Und Noch was Das Spiel ist eh die hölle Es kann irgentwie alles musste ich feaststellen wenn du sagst bei dir flimmerts ...
bei nem Freund Erscheint manhmal mit einer wahscheinlichkeit dass 1:123 im Fenstermodus eine verrückte Textur.. zusätzlich gabes eie zeit lang die möglichkeit nach einemFehlgeschlagenen Login eifach das Progamm duch eine Höhere Macht zu beenden: "Visual C++ Runtime Error"
Auf einmal ging wieder....

Neue Antwort erstellen


Übersicht BlitzBasic Blitz3D

Gehe zu:

Powered by phpBB © 2001 - 2006, phpBB Group