Игростроение - Создание игр

;параметры инициализации =====================================================
;сервеа
Server$="irc.mgts.by"
Port=6667
;юзера, произвольно
UserName$="xAvaTARxsssss"
HostName$="Tanchiki"
ServerName$="Benchiki"
RealName$="Vasyasd"
Global MyNick$=Chr(Rand(65,90)) + Chr(Rand(65,90)) + Chr(Rand(65,90) )+ Chr(Rand(65,90))  ;наш ник  
GameChan$="#nikitafobian" ;канал/чатрум игры

;вход в сеть=================================================================
  Global Stream=OpenTCPStream (Server$,Port)
    If Stream=0 RuntimeError "Нет коннекта..."
   
    ; для регистрации на сервере нужно выполнить 2 команды user и nick
    ;user [username] [hostname] [IrcServername] [realname]
    ;nick [MyNick]
    WriteLine Stream,"USER "+UserName$+" "+HostName$+" "+ServerName$+" :"+RealName$
    WriteLine Stream,"NICK "+ MyNick$

      ;входим в чатрум игры
      WriteLine Stream,"JOIN "+ GameChan$

  ;соединение установлено, но реальная связь появится после лога, вход может занять около минуты
  ;основанием считать вход завершенным может служить команда JOIN (когда сервер оповестит нас что мы зашли на нужный канал)
  ;см. дебаглог
;конец входа=================================================================

;ноу коменс

Graphics3D 640,480,16,2
SetBuffer BackBuffer ()

  CameraPivot=CreatePivot ()
  Camera=CreateCamera (CameraPivot)
   MoveEntity camera,0,50,-55
   TurnEntity camera,45,0,0
    RotateEntity CreateLight (),33,33,0

Global BaseTankMesh=LoadMesh ("tank.3ds")
HideEntity BaseTankMesh
;тип танков
Type Tanks
  Field Body ;тело, "реальня" часть
  Field FarPivot ;пивот тела, расположенный впереди, на него будет поворачиваться Mesh (для удобства)
  Field Mesh ;отображаемая часть
  Field Nick$ ;ник игрока управляющего танком
  Field KeyBits ;байт, биты которого показывают состояние кнопок клавиатуры у "хозяина" танка
  Field ActivTimer ;таймер активности, будем считать если игрок не откликался скажем 30 сек например, то он типа умер
End Type  

   Plane=CreatePlane()
    c_map=LoadTexture ("color.jpg")
    ScaleTexture c_map,150,150
    EntityTexture Plane,c_map

    ; а вот со стенами будем коллидиться
    Global Coll_TankBody=1
    Global Coll_Walls=2
     Collisions Coll_TankBody,Coll_Walls,2,2

  ;будем использовать 1 байт на координаты, поэтому предел мира - 0...255
  Ograda=CreateCube ()
   MoveEntity Ograda,128,0,128
   ScaleEntity Ograda,-128,-128,-128
    EntityType Ograda,Coll_Walls

     ;стены
     SeedRnd 200
     For c=1 To 50
      cc=CreateCube ()
       ScaleEntity cc,Rnd(1,15),5+c/10.0,Rnd(1,15)
       PositionEntity cc, Rand(0,255),0,Rand(0,255)
       EntityColor cc,Rand(255),Rand(255),Rand(255)
       EntityType cc,Coll_Walls
     Next

  ;создаем свой танк, посреди мира
  MyHandle=CreateTank(MyNick$,127,127)

;определим натсройки движка
Global Speed#=0.45 ;скорость танка
Global Rotate#=1.5    ;скорость поворота

Global TranslateRate#=0.01    ;скорость плавного совмещения координат Mesh с Body  
Global TurnRate#=0.01    ;аналогично совмещение угла yaw
Global    SendLimitTime=3000    ;минимальный интервал отправки команд

While Not KeyHit (1)

LastMyKeyBits=MyKeyBits ;сохраняем состояние клавиш с прошлого цикла
MyKeyBits=0       ;переменную текущих нажатий сбрасываем
;каждой нажатой кнопке будет соответствовать свой бит
If KeyDown (200)    MyKeyBits=MyKeyBits + %10000000;%10000000    ;вперед
If KeyDown (208)    MyKeyBits=MyKeyBits + %01000000    ;назад  
If KeyDown (203)  MyKeyBits=MyKeyBits + %00100000    ;влево
If KeyDown (205)  MyKeyBits=MyKeyBits + %00010000    ;вправо

;встаем на переменную нашего танка
Tnk.Tanks=Object.Tanks(MyHandle)  

  ;пакуем угол, предсавляя его ввиде байта
  Yaw=EntityYaw(Tnk\Body)
   If Yaw<0 Yaw=360+Yaw
    Yaw=Yaw/2 ;угол будет кратный 2, круг=0...360, а байт=0..255, увы но нестрашно, для такна 1 градус ничто
    YawChar$ = Chr(Yaw ) ;1 байт выгоднее всего представить символом

;наш протокол, байты: X | Z | Yaw | Keys , итого 4 байта, это проще представить как строку
Command$= Chr(EntityX(Tnk\Body))  +  Chr(EntityZ(Tnk\Body))  +  YawChar$   +   Chr(MyKeyBits)

If LastMyKeyBits<>MyKeyBits ; если были нажатия клавы
  DoCommand(MyNick$,Command$) ;исполняем свои координаты тут же
  NeedSinc=1 ;требуется отправка и остальным
EndIf

If NeedSinc=1          ;требуется
   If SendLimitTimer<MilliSecs () ;но нужно подождать интревала, чтобы не убить сеть, сэкономить трафик и т.п.
    NeedSinc=0
     SendLimitTimer=MilliSecs ()+SendLimitTime

      ;отправить свою команду
      Msg$=Chr(20)+Pack(Command$) ;помечаем символом chr(20) и запаковываем команду
      WriteLine Stream,"PRIVMSG "+ GameChan$ + " :" + Msg$

   EndIf
EndIf

;========== прием сообщений =============
If  ReadAvail(Stream)
  Msg$=ReadLine(Stream)    : DebugLog Msg$

       ;сервер пингует клиентов, на запрос PING нужно отвечать PONG и возвращать параметр
       If GetPar(Msg$,0) = "PING"
        WriteLine Stream , "PONG " + GetPar(Msg$,1)
       EndIf

   ;выделяем из полученной строки irc команду
   IrcCom$=GetPar(Msg,1)
     If  IrcCom$="PRIVMSG" ;получено сообщение
        Channal$=GetPar(Msg$,2) ;сообщение из чатрума Channal$
        Nick$ = GetNick(GetPar(Msg,0)) ;от юзера Nick$
        ofs=Instr(Mid(Msg,2),":")
        Content$= Mid(Msg,ofs+2) ;содержание сообщения
         
                              If Mid(Content$,1,1)=Chr(20) ;если это игровая команда (первый символ Chr(20) )
                              Command$=Mid(Content$,2) ;убираем этот первый символ
                              Command$=UnPack(Command$) ;распаковываем команду
                              DoCommand(Nick$,Command$) ;исполняем
                              EndIf
                              
     EndIf

EndIf

If  IrcCom$="PRIVMSG" ;получено сообщение
        Channal$=GetPar(Msg$,2) ;сообщение из чатрума Channal$
        Nick$ = GetNick(GetPar(Msg,0)) ;от юзера Nick$
        ofs=Instr(Mid(Msg,2),":")
        Content$= Mid(Msg,ofs+2) ;содержание сообщения
         
                              If Mid(Content$,1,1)="ttt" ;если это игровая команда (первый символ Chr(20) )
End
                              EndIf
                              
     EndIf
;=========== конец приема ================

  SSPos(CameraPivot,Tnk\Body,0.1) ;движение камеры
  UpdateTanks()

RenderWorld ()
UpdateWorld ()

Flip
Wend
End

Function DoCommand(Nick$,Command$)

          x=Asc(Mid(Command$,1,1)) ;первый быйт =X
          z=Asc(Mid(Command$,2,1)) ;аналогично
          yaw=Asc(Mid(Command$,3,1))*2
          KeyBits=Asc(Mid(Command$,4,1))

    ;есть ли игрок по имени Nick$?
    For Tnk.Tanks=Each Tanks
     If Tnk\Nick=Nick
      PlayerIsOn=1
     EndIf
    Next

    ;если нет, создать
    If PlayerIsOn=0 Then CreateTank(Nick$,x,z)

    For Tnk.Tanks=Each Tanks
     If Tnk\Nick=Nick ;найти для кого команда
          Tnk\KeyBits=KeyBits
          PositionEntity Tnk\Body,x,0,z   ;ставим Body на место
          RotateEntity Tnk\Body,0,yaw,0

                              Tnk\ActivTimer=MilliSecs ()+30000 ;засекаем время
     EndIf
    Next

End Function

Function CreateTank(Nick$,x#,z#)
Tnk.Tanks=New Tanks
  Tnk\Nick$=Nick$
  Tnk\Body=CreatePivot ()
  PositionEntity Tnk\Body,x,0,z
  Tnk\FarPivot=CreatePivot (Tnk\Body) : MoveEntity Tnk\FarPivot,0,0,100000

     Tnk\Mesh=CopyEntity (BaseTankMesh)
     PositionEntity Tnk\Mesh,x,0,z

  EntityType Tnk\Body,Coll_TankBody
  EntityRadius  Tnk\Body,4

Return Handle (Tnk)
End Function

Function UpdateTanks()

For Tnk.Tanks=Each Tanks

      If Tnk\Nick$<>MyNick$
        ;если чужой танк, плавно совмещаем Mesh c Body
        SSPos(Tnk\Mesh,Tnk\Body,TranslateRate#)
        AlignXZ(Tnk\Mesh,Tnk\FarPivot,TurnRate#)

          If Tnk\ActivTimer<MilliSecs ();если 30 сек игрок молчал возможно он сдох, проверять не будем, удаляем, захочет вернуться нажмет на любую кнопку
                              FreeEntity Tnk\Mesh
                              FreeEntity Tnk\Body
                              Delete Tnk
                              Exit
          EndIf
      Else
        ;а если наш, пошустрее, чтобы управление было проще
        SSPos(Tnk\Mesh,Tnk\Body,0.02)
        AlignXZ(Tnk\Mesh,Tnk\FarPivot,0.1)
      EndIf

    ;исполняем нажатие кнопок, соответственно установленным битам
    If Tnk\KeyBits And %10000000 MoveEntity Tnk\Body,0,0,Speed# ;%10000000 MoveEntity Tnk\Body,0,0,Speed#  
    If Tnk\KeyBits And %01000000 MoveEntity Tnk\Body,0,0,-Speed#
    If Tnk\KeyBits And %00100000 TurnEntity   Tnk\Body,0,Rotate#,0,0
    If Tnk\KeyBits And %00010000 TurnEntity   Tnk\Body,0,-Rotate#,0,0

       
Next

End Function

Function AlignXZ(souce,dest,rate#)
     dx#=EntityX(dest,1)-EntityX(souce,1)
     dz#=EntityZ(dest,1)-EntityZ(souce,1)
     AlignToVector souce, dx# ,0 , dz# , 0 , rate
     RotateEntity souce,0,EntityYaw (souce,1), 0 , 1
End Function
Function SPos(source,dest)
  PositionEntity source,EntityX(dest,1),EntityY(dest,1),EntityZ(dest,1),1
End Function
Function SSPos(souce,dest,rate#)
     dx#=EntityX(dest,1)-EntityX(souce,1)
     dy#=EntityY(dest,1)-EntityY(souce,1)
     dz#=EntityZ(dest,1)-EntityZ (souce,1)
     TranslateEntity souce ,    dx# * rate  ,    dy# * rate    ,    dz# * rate ,1
End Function
Function SRot(source,dest)
  RotateEntity source, EntityPitch(dest,1),EntityYaw (dest,1), EntityRoll(dest,1),1
End Function

Function GetPar$(msg$,par%=0,bChr$=" ")

  fs$=msg
  For p=1 To par
    ofs=Instr(fs,bChr)
    fs$=Mid(fs,ofs+1)
    If ofs=0 Return  
  Next
  ofs=Instr(fs,bChr)
  fs$=Mid(fs,1,ofs-1)
  Return fs
   
End Function
  Function GetNick$(s$)
  Return Mid(GetPar(s,0,"!"),2)  
End Function

Function Pack$(s$)
  StopChar$=Chr(5)
l=Len(s)
us$=""
For n=1 To l
  cc$=Mid(s,n,1)
  ds$=""
  Select cc$
   Case Chr(0)
    ds$=StopChar$+Chr(1)  
   Case Chr(10)
    ds$=StopChar$+Chr(2)
   Case Chr(13)
    ds$=StopChar$+Chr(3)
   Case StopChar$
    ds$=StopChar$+Chr(4)
   Default
    ds$=cc$
  End Select
  us$=us$+ds$
Next

  Return us$
End Function
Function UnPack$(s$)
  StopChar$=Chr(5)
l=Len(s)
us$=""
n=0
Repeat
n=n+1
     cc$=Mid(s,n,1)
     ds$=""
       If cc$=StopChar$
         n=n+1
         cc2$=Mid(s,n,1)
          Select cc2$
                              Case Chr(1)
                              ds$=Chr(0)
                              Case Chr(2)
                              ds$=Chr(10)
                              Case Chr(3)
                              ds$=Chr(13)
                              Case Chr(4)
                              ds$=StopChar$
          End Select
        us$=us$+ds$
       Else
        us$=us$+cc$
       EndIf
Until cc$=""
  Return us$
End Function