Net.Me

Übersicht BlitzBasic Codearchiv

Neue Antwort erstellen

Silver_Knee

Betreff: Net.Me

BeitragMo, Sep 17, 2007 21:11
Antworten mit Zitat
Benutzer-Profile anzeigen
so da ich das spiel eh nicht weiter machen werde ist es nun Allgemeingut. Augenmerk hab ich auf den script gelegt der zwar nie wirklich weit gekommen is doch trotzdem zeigt wie sich eine kleine skriptsprache aufbauen lässt
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(15) SaveBuffer FrontBuffer(),"Untitled.bmp"
   
   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


meine defaul.wld sieht so aus:
Zitat:
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


die befehle sind relativ selbsterklärend und die sprache mutet etwas an ms-dos an.

Neue Antwort erstellen


Übersicht BlitzBasic Codearchiv

Gehe zu:

Powered by phpBB © 2001 - 2006, phpBB Group