db (Dark Basic) Code (Tutorial) nach bb

Übersicht Sonstiges Smalltalk

Neue Antwort erstellen

 

vanjolo

Betreff: db (Dark Basic) Code (Tutorial) nach bb

 BeitragMi, Jan 07, 2009 21:22
Antworten mit Zitat
Benutzer-Profile anzeigen
Hi,
ich habe einen db code (tutorial für eine einfache Flugphysik. Ich würde mir diesen gerne in bb anschauen, nur leider komme ich beim umschreiben nicht weiter.

Hat jemand mit Dark Basic Erfahrung und kann den umschreiben?

Code: [AUSKLAPPEN]
Flight angles demo by David Lawrence ( muddleglum in the dark basic forums)  September 2007.
`                 email -    muddle( at) orcon.net.nz

`   If you want a scientific simulator you will have to use a different system
` that works out the  effects of rotation and position change seperately.  ... but this method, using
` angular change to represent the forces,  is simple,  convincing to most appearances,
`  and pleasingly natural to control for most uses.

`  The method can be matched to specific  aerodynamic factors,
`  ie.  scaling  of  turn radius to plane size,  scaling of  gravity,
`    specific  inertia ,  drag,   control reaction rate according to speed or plane type,
`    improved rudder yaw action  etc etc.   so that the whole system  is almost
`     indistinguishable from the scientific method.
`   Note that this  is a fixed frame rate method, which make a lot of things simpler, and does not
`   normally cause a visual problem because of the smoothness of the movement.

`  ` The essential flight rotation code is only two lines and without complicated maths -- much of the
`    program is 'setting  up'--- however, the imitation inertia inputs  are an essential
`    part of the natural feel.  You also get a few simple but effective methods for power and views.
`       Please use  a joystick if you have one.  It is much more satisfying.

`     ( This version is for classic DB  1.2  with the new light commands  ..  db pro should also work I believe,
`      but my trial version just expired .. maybe minor changes?)

`  -----------------------------------------------------------------------------------
`                                       NOTE  NOTE
` The simulation method contained in this code may be freely copied
`If found useful for commercial purposes acknowledgment would be nice,  or even reward for this author!
`  -------------------------------------------------------------------- ----------------------

`set up a world stuff
set display mode 1024,768,16

hide mouse
sync on
`make a ground texture
cls rgb(80,130,90)

ink rgb(90,110,60),0
for x=0 to 56
dot x,rnd(56):dot x,rnd(56):dot x,rnd(56):dot x,rnd(56)
dot x,rnd(56):dot x,rnd(56):dot x,rnd(56):dot x,rnd(56)
next x

ink rgb(70,120,70),0
for x=0 to 56
dot x,rnd(56):dot x,rnd(56):dot x,rnd(56):dot x,rnd(56)
dot x,rnd(56):dot x,rnd(56):dot x,rnd(56):dot x,rnd(56)
next x

ink rgb(95,115,90),0
for x=0 to 56
dot x,rnd(56):dot x,rnd(56):dot x,rnd(56):dot x,rnd(56)
dot x,rnd(56):dot x,rnd(56):dot x,rnd(56):dot x,rnd(56)
next x

get image 1,0,0,56,56


cls rgb(50,90,90)
sync rate 30

set camera range 1,9000
set camera view 25,55,1000,700
autocam off

make matrix 1,20000,20000,45,45
prepare matrix texture 1,1,2,2
randomize matrix 1,150.0

ink rgb(250,125,20),0

set cursor 10,1: print "F1  cockpit view"
set cursor 540,1: print "F4 follow view level"
set cursor 270,1: print "F2  follow view rolling"
set cursor 850,1:print "F3  fly by view"

set cursor 10, 18:print "A -accelerate ,  S  slow"
set cursor 270,18:print "R  reset position to start"
set cursor 540,18:print " arrow keys for roll/pitch"
set cursor 850,18:print "Q left yaw ,   W right yaw"
set cursor 10,36:print " J -  use joystick control  ... or  .... ... K -  use Arrow key controls(default)"
set cursor 540,36:print  "Elevator is used to pull a sharp banked turn "

ink rgb(250,225,220),0

view=2
auto=0
control=0

`make an 'aircraft'
make object cube 4, 20
scale object 4,130,3,20
`set object diffuse 4,rgb(255,255,255)
`set object ambient 4,rgb(66,66,66)

make object cone 5,25
scale object 5,8,600,400
pitch object down 5,90
fix object pivot 5

glue object to limb 5,4,0
color object 5,rgb(255,40,40)
`set object diffuse 5,rgb(255,255,255)
``set object ambient 5,rgb(66,66,66)

set ambient light 10
fog on
fog color rgb(60,140,150)
color backdrop rgb(70,150,170)
fog distance 3500

sync on
direction#=0
climb#=0
speed# = 0
power#=2
position object 4, 3400,250,3200
rotate object 4,0,0,0


mainloop:
` ///////////////////////////////////////////-MAIN LOOP ////////////////////////////////
do

` if hit ground
if object position y(4) < get ground height(1,object position x(4), object position z(4))
  set cursor 250,250
  print "THUD!  CRASH!"
  position object 4,object position x(4),object position y(4)+20,object position z(4)
  pitch object up 4,20
endif


`  view control Inputs
if scancode()=59 then view =2 : ` F1
if scancode()=60 then view =0
if scancode()=62 then view =1
if scancode()=61 then view=3


`  power  input
if inkey$()="a" then power#=power#+.15
if power#>15 then power#=15
if inkey$()="s"
power#=power# -.2
if power#<0 then power#=0
endif

if inkey$()="j" then control =1
if inkey$()="k" then control=0

arrowkeycontrol:
if control =0
  if rightkey() = 1 then   rollstep#=rollstep#+.4
  if leftkey() = 1  then    rollstep#=rollstep#-.4
     rollstep#=rollstep#*.9
roll object right 4,rollstep#:` basic aileron / roll action of plane.

  if downkey() = 1 then pitchstep#=pitchstep#+.2
  if upkey() = 1 then pitchstep#=pitchstep#-.2
  pitchstep#=pitchstep#*.9
  pitch object up 4, pitchstep#: `basic pitch action of plane
endif


alternatejoystick:
if control =1

joyr#=joystick x()/180.0
joyp#=joystick y()/180.0

`  apply aileron

rollstep#=rollstep#+(joyr#/8) :` provides an intertia effect
rollstep#=rollstep#*.9  :` provides a damping effect..   a value like .95 or higher  will also allow a
` wandering effect such as you get with some less laterally stable model aircraft.
roll object right 4,rollstep#:` basic aileron / roll action of plane

` apply elevator

pitchstep#=pitchstep#+(joyp#/20)
pitchstep#=pitchstep#*.9
pitch object up 4, pitchstep#
endif

 ` -----------------------------------------------------------
` the critical code follows  ...
` -----------------------------------------------------

` get a roll angle  related to WORLD horizontal. When the plane is tilted or pitched this provides
`  a  result different from  the plane relative roll angle.  This difference  makes the system work.

alt#=object position y(4)
turn object right 4,90
move object 4,1
sineroll#= object position y(4) -alt#
move object 4, -1
turn object left 4, 90


`then split the tilted lift vector of the wings between the WORLD horizontal and vertical axis using sineroll.

turn object left 4,sineroll#
pitch object up 4, abs(sineroll#)/2

` The above lines are the approximate lift split version, but are better for common use as they
`  include a slight over elevation effect which require less pilot input.

`                                 ----------------------
` The ACCURATE force split is shown just below .... BUT..  it is actually more demandng
` of the pilot , especially without the rest of a full code, and effects of wing/tailplane  incidence at speed.
` The following may still be simple, but it  was a giant and ORIGINAL effort to discover (geometric-graphically?).

  `     turn object left 4, sineroll#
  `     if sinroll#<0 then cotilt#=(1+sineroll#)*-1 else cotilt#=1-sineroll#
  `     pitch object up 4, (abs(sineroll#) - abs(sineroll#*cotilt#))

`  The split code also imitates the  gravity effect when the rolled wing loses vertical lift
` and the plane turns towards the ground.   When correctly scaled to match a 1G turn radius ( which is
` when the height remains constant through the turn)  with a correct forward speed increase for G
` then the turn downwards matches gravity quite accurately.
`                                   ---------------------------

` then continue with some simple  rudder yaw input -------- good for aiming at things  ( a true yaw does not
` necessarily alter the plane flight direction as this does).

if inkey$()="w" then rudder#=rudder#+.1
if inkey$()="q" then rudder#=rudder#-.1
rudder#=rudder#*.9
turn object right 4,rudder#


` -------------If you want to add simple gravity and gliding effects ---------------

`get world related pitch.
 move object 4,1
  truepitch#= alt# -object position y(4)
 move object 4, -1
gravity#=truepitch#*2 :` gravity can  be  accurately calculated against world scale and frame rate if desired.
` ie.. the speed increase exactly vertical ( without drag) should be an additional 32 ft every sec.
` You can simply add this each time  and though it is fractionally  different from the 'official'
` calculation over the first frames  it is absolutely accurate therafter.

`add  a cheap glide effect!
if speed#<2.5 and truepitch#<.3 then pitch object down 4,.15
` the nose down attitude will mean gravity#  provides a basic glide speed#  even with power at zero.

`                             -----------------------------------
` To do gliding 'properly' you need
` 1. a  'pitching up' that results from tailplane incidence and speed .. different degree for different designs.
` 2. a 'pitching down'  that results from how far the planes center of gravity is ahead ( usually) of the `
`     centre of lift of the wings.  This pitching is 0 when pitch is vertical.  max when horizontal.
`     i.e. it matches the  cosine of the pitch angle.  Obtain with a 'move' similar to the pitch angle above.
`          (This  cosine is relative to the world again, since the drop from the wing being tilted /rolled
`              is handled previously)
` 3. an accurate speed increase for gravity.
` 4. an accurate drag coeficient.


 `   The whole is a delicate and interactive balance.   You can see its  operation with a simple real
  ` model plane  or nose weighted paper dart by dropping  and throwing it in different ways.
  `  ( which is how  I confirmed this theory.   Then saw similar formula on the internet. )

`  One thing I want to perfect later is  the transition when elevator is used to hold the wing
`   at a steeper angle (and greater drag)  as the speed drops close to the wings stall speed and
 `  the inertia and/or  propeller may still maintains  a 'flare' for a short time.
 `                            ------------------------------------


rem  ....     some basic speed  control
coefdrag#=.05
drag#=coefdrag#*speed#*speed# : ` airdrag increases with square of airspeed and limits the maximum
speed#=speed#+gravity# + power#-drag#

if speed#<1 then speed#= 1  : ` because this  demo  has no stall routine etc.!

move object 4,speed#


 ` ................... camera  views ....................
views:

if view =0
 position camera object position x(4),object position y(4),object position z(4)
  set camera to object orientation 4
  pitch camera down 8
  move camera -70
    endif

if view=1
position camera object position x(4),object position y(4),object position z(4)
  set camera to object orientation 4
  pitch camera down 8
  move camera -70
point camera object position x(4),object position y(4),object position z(4)
endif

if view=2
 position camera object position x(4),object position y(4),object position z(4)
  set camera to object orientation 4
  endif

if view =3:` fly by view
if count<1
position camera object position x(4),object position y(4),object position z(4)
set camera to object orientation 4
move camera   100+(speed#*50)
if camera position y() < 120 then  position camera  camera position x(),130, camera position z()
count= 120
endif
dec count
point camera object position x(4),object position y(4),object position z(4)

endif

` reset to start position
if inkey$()="r"
speed# = 0
power#=2
position object 4, 3400,250,3200
rotate object 4,0,0,0
endif

set cursor 400,90
print "Power  "; int(power#*10)
set cursor 400,110
print "Speed  "; int(speed#)

sync


loop

Xaymar

ehemals "Cgamer"

BeitragMi, Jan 07, 2009 21:48
Antworten mit Zitat
Benutzer-Profile anzeigen
sicher, ich werd mal gucken in wie weit ich es schaffe. ergebnis kommt als edit hier rein.


------

Den ersten Teil habe ich nun:
Code: [AUSKLAPPEN]
Graphics3D 1024,768,16
SetBuffer BackBuffer()

HidePointer()

Grass=CreateTexture(64,64)
SetBuffer TextureBuffer(Grass)
   ClsColor 80,130,90
   Cls
   RGB = (90 Shl 16) + (110 Shl 8) + 60
   For A = 0 To 64
      WritePixel A,Rand(64),RGB:WritePixel A,Rand(64),RGB:WritePixel A,Rand(64),RGB
      WritePixel A,Rand(64),RGB:WritePixel A,Rand(64),RGB:WritePixel A,Rand(64),RGB
   Next
   
   RGB = (70 Shl 16) + (120 Shl 8) + 70
   For A = 0 To 64
      WritePixel A,Rand(64),RGB:WritePixel A,Rand(64),RGB:WritePixel A,Rand(64),RGB
      WritePixel A,Rand(64),RGB:WritePixel A,Rand(64),RGB:WritePixel A,Rand(64),RGB
   Next
   
   RGB = (95 Shl 16) + (115 Shl 8) + 90
   For A = 0 To 64
      WritePixel A,Rand(64),RGB:WritePixel A,Rand(64),RGB:WritePixel A,Rand(64),RGB
      WritePixel A,Rand(64),RGB:WritePixel A,Rand(64),RGB:WritePixel A,Rand(64),RGB
   Next
   
SetBuffer BackBuffer()


weiteres unter diesem Strich
----

Darkbasic ist sehr ähnlich mit ASM:) ASM lernen und du kannst den Code nach bb selbst umschreiben

----

Code: [AUSKLAPPEN]

;-------------------------------Einleiten des Graphics3D
Graphics3D 1024,768,16
SetBuffer BackBuffer()
HidePointer()
FPST = CreateTimer(30)         ;60 wär besser

;-------------------------------Boden Textur
Grass = CreateTexture(64,64)
SetBuffer TextureBuffer(Grass)
   ClsColor 80,130,90
   Cls
   RGB = (90 Shl 16) + (110 Shl 8) + 60
   For A = 0 To 64
      WritePixel A,Rand(64),RGB:WritePixel A,Rand(64),RGB:WritePixel A,Rand(64),RGB
      WritePixel A,Rand(64),RGB:WritePixel A,Rand(64),RGB:WritePixel A,Rand(64),RGB
   Next
   
   RGB = (70 Shl 16) + (120 Shl 8) + 70
   For A = 0 To 64
      WritePixel A,Rand(64),RGB:WritePixel A,Rand(64),RGB:WritePixel A,Rand(64),RGB
      WritePixel A,Rand(64),RGB:WritePixel A,Rand(64),RGB:WritePixel A,Rand(64),RGB
   Next
   
   RGB = (95 Shl 16) + (115 Shl 8) + 90
   For A = 0 To 64
      WritePixel A,Rand(64),RGB:WritePixel A,Rand(64),RGB:WritePixel A,Rand(64),RGB
      WritePixel A,Rand(64),RGB:WritePixel A,Rand(64),RGB:WritePixel A,Rand(64),RGB
   Next
   
SetBuffer BackBuffer()

;-------------------------------3D Camera
Cam = CreateCamera()

CameraClsColor Cam,50,90,90
CameraRange Cam,1,9000
CameraViewport Cam,25,55,1000,700

;-------------------------------Terrain
Ter01 = CreateTerrain(512,512)
RandomizeTerrain(Ter,512,512,.02,10)
EntityTexture Ter01,Grass




;-------------------------------Funktionen
Function RandomizeTerrain(Ter,W,H,MaxH#,Runs)
   For A = 1 To Runs
      For X = 0 To W
         For Y = 0 To H
            CurH# = TerrainHeight#(Ter, X, Y)
            CurH# = CurH# + Rnd#(0,MaxH#)
            ModifyTerrain Ter, X, Y, CurH#
         Next
      Next
   Next
End Function


-------

Code: [AUSKLAPPEN]

;-------------------------------Einleiten des Graphics3D
Graphics3D 1024,768,32
SetBuffer BackBuffer()

SeedRnd MilliSecs()
HidePointer()
FPST = CreateTimer(60)         ;30 war im tutorial

;-------------------------------Boden Textur
Grass = CreateTexture(64,64,8)
SetBuffer TextureBuffer(Grass)
   ClsColor 80,130,90
   Cls
   RGB = (90 Shl 16) + (110 Shl 8) + 60
   For A = 0 To 64
      WritePixel A,Rand(64),RGB:WritePixel A,Rand(64),RGB:WritePixel A,Rand(64),RGB
      WritePixel A,Rand(64),RGB:WritePixel A,Rand(64),RGB:WritePixel A,Rand(64),RGB
   Next
   
   RGB = (70 Shl 16) + (120 Shl 8) + 70
   For A = 0 To 64
      WritePixel A,Rand(64),RGB:WritePixel A,Rand(64),RGB:WritePixel A,Rand(64),RGB
      WritePixel A,Rand(64),RGB:WritePixel A,Rand(64),RGB:WritePixel A,Rand(64),RGB
   Next
   
   RGB = (95 Shl 16) + (115 Shl 8) + 90
   For A = 0 To 64
      WritePixel A,Rand(64),RGB:WritePixel A,Rand(64),RGB:WritePixel A,Rand(64),RGB
      WritePixel A,Rand(64),RGB:WritePixel A,Rand(64),RGB:WritePixel A,Rand(64),RGB
   Next
   
SetBuffer BackBuffer()
ScaleTexture Grass,5,5

;-------------------------------3D Camera
Cam = CreateCamera()

CameraClsColor Cam,50,90,90
CameraRange Cam,1,9000
CameraViewport Cam,25,55,1000,700
;CameraFogMode Cam, 1
CameraFogColor Cam, 50, 90, 90
CameraFogRange Cam, 3500, 4000

;random
light=CreateLight():MoveEntity light, 0, -500, 500: PointEntity light, Cam

;-------------------------------Terrain
Ter01 = CreateTerrain(512)
RandomizeTerrain(Ter01,.05,15)
SmoothTerrain(Ter01):SmoothTerrain(Ter01):SmoothTerrain(Ter01):SmoothTerrain(Ter01):SmoothTerrain(Ter01)
EntityTexture Ter01,Grass
TerrainDetail Ter01, 5000, 1
TerrainShading Ter01, 1

ScaleEntity Ter01, 50, 10000, 50
MoveEntity Ter01, -256 * 50, -(10000/2), -256 * 50

;-------------------------------Mainloop
PositionEntity Cam, 0, 100, 0
While Not KeyHit(1)
   RotateEntity Cam, EntityPitch#(Cam)+(MouseYSpeed()/10.0), EntityYaw#(Cam)-(MouseXSpeed()/10.0), 0
   If EntityPitch#(Cam) < -89.5 RotateEntity Cam, -89.5, EntityYaw(Cam),0
   If EntityPitch#(Cam) > 89.5 RotateEntity Cam, 89.5, EntityYaw(Cam),0
   If MouseDown(1) MoveEntity Cam, 0,0,10
   If MouseDown(2) MoveEntity Cam, 0,0,100
   
   RenderWorld
   
   MoveMouse 400,300
   Flip 0
   
   WaitTimer FPST
Wend

;-------------------------------Funktionen
Function RandomizeTerrain(Ter,MaxH#,Runs)
   WH=TerrainSize(Ter)
   For A = 1 To Runs
      For X = 0 To WH
         For Y = 0 To WH
            CurH# = TerrainHeight#(Ter, X, Y)
            If Rand(50) >= 25
               CurH# = CurH# + Rnd#(0,MaxH#)*Rand(MaxH#*2)
            EndIf
            ModifyTerrain Ter, X, Y, CurH#
         Next
      Next
   Next
End Function

Function SmoothTerrain(Ter)
   WH=TerrainSize(Ter)
   For X = 0 To WH
      For Y = 0 To WH
         HL#=0:HR#=0:HU#=0:Hd#=0
         If X-1 >= 0 HL#=TerrainHeight#(Ter,X-1,Y)
         If X+1 <= WH HR#=TerrainHeight#(Ter,X+1,Y)
         If Y-1 >= 0 HU#=TerrainHeight#(Ter,X,Y-1)
         If Y+1 <= WH HD#=TerrainHeight#(Ter,X,Y+1)
         HM#=TerrainHeight#(Ter,X,Y)
         NewH# = (HL#+HR#+HU#+HD#+HM#)/5
         ModifyTerrain Ter,X,Y,NewH#
      Next
   Next
End Function
Warbseite
 

vanjolo

 BeitragDo, Jan 08, 2009 12:33
Antworten mit Zitat
Benutzer-Profile anzeigen
Cool das Du es versuchst.

Der Mittelteil das eigentliche Flugverhalten fehlt aber noch? So ist es ja nur ein generiertes Terrain in dem man eine Kamera verschiebt. Das steht so nicht im Code Wink

tedy

 BeitragDo, Jan 08, 2009 22:05
Antworten mit Zitat
Benutzer-Profile anzeigen
@CGamer
hnlich wie ASM ? ...
Also vieleicht hat darkbasic etwas mit der befehls länge von ASM gemeinsam aber sonst nichts :O
ASM hat ein paar befehle zum rechnen und stacks verschieben mehr nicht...
01010100 01100101 01000100 01111001 00100000 00111010 01000100
 

vanjolo

 BeitragDo, Jan 08, 2009 22:11
Antworten mit Zitat
Benutzer-Profile anzeigen
Kann niemand das Flugverhalten umschreiben? Crying or Very sad - Schade

Xaymar

ehemals "Cgamer"

BeitragDo, Jan 08, 2009 22:59
Antworten mit Zitat
Benutzer-Profile anzeigen
bin noch dabei:)

war gestern nur ausversehen auf den ausschalte mehrfach gekommen:(
Warbseite
 

vanjolo

 BeitragFr, Jan 09, 2009 11:11
Antworten mit Zitat
Benutzer-Profile anzeigen
Super danke. Ich bin gespannt Very Happy

Xaymar

ehemals "Cgamer"

BeitragFr, Jan 09, 2009 19:48
Antworten mit Zitat
Benutzer-Profile anzeigen
ich habe bereits 85% des Codes fertig. bin bereits bei zeile 192
frühestens heute abend oder spätestens morgena bend bin ich fertig

[Edit]
bin soweit fertig. Habe die Joystick steuerung rausgelassen.
bei der Camera fehlen auch noch 2 sachen die ich allerdings wegen der Größe des Terrains nicht realisieren kann.
Code: [AUSKLAPPEN]

;-------------------------------Einleiten des Graphics3D
Graphics3D 1024,768,32
SetBuffer BackBuffer()

SeedRnd MilliSecs()
HidePointer()
FPST = CreateTimer(60)         ;30 war im tutorial

;-------------------------------Boden Textur
Grass = CreateTexture(64,64,8)
SetBuffer TextureBuffer(Grass)
   ClsColor 80,130,90
   Cls
   RGB = (90 Shl 16) + (110 Shl 8) + 60
   For A = 0 To 64
      WritePixel A,Rand(64),RGB:WritePixel A,Rand(64),RGB:WritePixel A,Rand(64),RGB
      WritePixel A,Rand(64),RGB:WritePixel A,Rand(64),RGB:WritePixel A,Rand(64),RGB
   Next
   
   RGB = (70 Shl 16) + (120 Shl 8) + 70
   For A = 0 To 64
      WritePixel A,Rand(64),RGB:WritePixel A,Rand(64),RGB:WritePixel A,Rand(64),RGB
      WritePixel A,Rand(64),RGB:WritePixel A,Rand(64),RGB:WritePixel A,Rand(64),RGB
   Next
   
   RGB = (95 Shl 16) + (115 Shl 8) + 90
   For A = 0 To 64
      WritePixel A,Rand(64),RGB:WritePixel A,Rand(64),RGB:WritePixel A,Rand(64),RGB
      WritePixel A,Rand(64),RGB:WritePixel A,Rand(64),RGB:WritePixel A,Rand(64),RGB
   Next
   
SetBuffer BackBuffer()

;-------------------------------3D Camera
Cam = CreateCamera()

CameraClsColor Cam,50,90,90
CameraRange Cam,1,9000
CameraViewport Cam,25,55,1000,700
CameraFogMode Cam, 1
CameraFogColor Cam, 50, 90, 90
CameraFogRange Cam, 3500, 4000

;Licht
light=CreateLight():MoveEntity light, 0, -500, 500: PointEntity light, Cam

;-------------------------------Terrain
Ter01 = CreateTerrain(512)
RandomizeTerrain(Ter01,.1,15)
EntityTexture Ter01, Grass, 0, 0
TerrainDetail Ter01, 10000, 1
TerrainShading Ter01, 1

ScaleEntity Ter01, 50, 10000, 50
MoveEntity Ter01, -256 * 50, -(10000/2), -256 * 50

;-------------------------------2. Boden Textur
SaveTerrain(Ter01, "Ter01.bmp")
Lightmap = LoadTexture("Ter01.bmp")
TextureBlend Lightmap, 5
EntityTexture Ter01, Lightmap, 0, 1
ScaleTexture Lightmap, 512, 512

;-------------------------------Flieger
Pivot = CreatePivot()

FlgFront = CreateCone(16,0,Pivot)
ScaleEntity FlgFront, 2, 2, 2
MoveEntity FlgFront, 0, 0, 6
RotateEntity FlgFront, 90, 0, 0
EntityColor FlgFront, 66, 66, 66

Flg = CreateCube(Pivot)
ScaleEntity Flg, 2, 2, 4
MoveEntity Flg, 0, 0, 0
EntityColor Flg, 66, 66, 66

;-------------------------------Variablen
Viewmode = 0
Speed# = 0
Power# = 2
Pitch# = 0
Roll# = 0
Rudder# = 0

;-------------------------------Mainloop
While Not KeyHit(1)
   Cls
   
   RenderWorld
   
      ;Steuerung: Geschwindigkeit, Roll, Pitch
      If KeyDown(17) Power# = Power# + .15
      If KeyDown(31) Power# = Power# - .2
      If Power# > 15 Power# = 15
      If Power# < 0 Power# = 0
      
      If KeyDown(203) Roll# = Roll#+.4
      If KeyDown(205) Roll# = Roll#-.4
      Roll# = Roll# * .9
      TurnEntity Pivot, 0, 0, Roll#
      
      If KeyDown(200) Pitch# = Pitch#+.4
      If KeyDown(208) Pitch# = Pitch#-.4
      Pitch# = Pitch# * .9
      TurnEntity Pivot, Pitch#, 0, 0
      
      ;
      Alt# = EntityY(Pivot)
      TurnEntity Pivot, 0, 90, 0
      MoveEntity Pivot, 0, 0, 1
      SineRoll# = EntityY(Pivot) - Alt#
      MoveEntity Pivot, 0, 0, -1
      TurnEntity Pivot, 0, -90, 0
      
      TurnEntity Pivot, 0, -SineRoll#, 0
      TurnEntity Pivot, Abs(SineRoll#)/2, 0, 0
      
      ;Steuerung: Ruder
      If KeyDown(30) Rudder# = Rudder# + .1
      If KeyDown(32) Rudder# = Rudder# - .1
      Rudder# = Rudder# * .9
      TurnEntity Pivot, 0, Rudder#, 0
      
      ;Schwerkraft
      MoveEntity Pivot, 0, 0, 1
      TruePitch# = Alt# - EntityY#(Pivot)
      MoveEntity Pivot, 0, 0, -1
      Gravity# = TruePitch# * 2
      
      ;Geschwindigkeit
      CoefDrag# = .05
      Drag# = CoefDrag# * Speed# * Speed#
      Speed# = Speed# + Gravity# + Power# - Drag#
      
      If Speed# < 0 Speed# = 0
      MoveEntity Pivot, 0, 0, Speed#
      
      ;Reset
      If KeyHit(19)
         PositionEntity Pivot, 0, 0, 0
         Speed# = 0
         Power# = 2
         Pitch# = 0
         Yaw# = 0
         RotateEntity Pivot, 0, 0, 0
      EndIf
      
      ;Camera
      If Viewmode = 0
         PositionEntity Cam, EntityX(Pivot), EntityY(Pivot), EntityZ(Pivot)
         RotateEntity Cam, EntityPitch(Pivot), EntityYaw(Pivot), EntityRoll(Pivot)
      ElseIf Viewmode = 1
      ElseIf Viewmode = 2
         YSpeed# = MouseYSpeed()
            YSpeed# = YSpeed# / 5
         XSpeed# = MouseXSpeed()
            XSpeed# = XSpeed# / 5
            
         RotateEntity Cam, EntityPitch#(Cam)+YSpeed#, EntityYaw#(Cam)-Xspeed#, 0
         If EntityPitch#(Cam) < -89.5 RotateEntity Cam, -89.5, EntityYaw(Cam),0
         If EntityPitch#(Cam) > 89.5 RotateEntity Cam, 89.5, EntityYaw(Cam),0
         
         If MouseDown(1) MoveEntity Cam, 0, 0, 1
         If MouseDown(2) MoveEntity Cam, 0, 0, 10
         If MouseDown(3) MoveEntity Cam, 0, 0, 100
      ElseIf Viewmode = 3
         
      EndIf
   
   If KeyHit(59) Viewmode = 0
   If KeyHit(60) Viewmode = 1
   If KeyHit(61) Viewmode = 2
   If KeyHit(62) Viewmode = 3
      
   Color 250,125,20
   Text 10,10,"F1 - Cockpit View"
   Text 10,25,"F2 - Follow View Roll"
   Text 10,40,"F3 - Fly by View"
   Text 10,55,"F4 - Follow View Level"
   Text 10,75,"W  - Accelerate"
   Text 10,90,"S  - Slow down"
   Text 10,105,"A  - Turn Left"
   Text 10,120,"D  - Turn Right"
   Text 10,150,"R  - Reset Position"
   
   Text 10,180,"Aircraft: "
   Text 20,195,"Power: " + Power#
   Text 20,210,"Speed: " + Speed#
   
   
   If MouseX() < 10 Or MouseX() > 1014 Or MouseY() < 10 Or MouseY() > 758 MoveMouse 512,368
   Flip 0
   
   WaitTimer FPST
Wend

;-------------------------------Funktionen
Function RandomizeTerrain(Ter,MaxH#,Runs)
   WH=TerrainSize(Ter)
   For A = 1 To Runs:For X = 0 To WH:For Y = 0 To WH
      CurH# = TerrainHeight#(Ter, X, Y)
      If Rand(50) >= 25
         CurH# = CurH# + Rnd#(-MaxH#*0.75,MaxH#)
      EndIf
      ModifyTerrain Ter, X, Y, CurH#
   Next:Next:SmoothTerrain(Ter):SmoothTerrain(Ter):SmoothTerrain(Ter):Next
End Function

Function SmoothTerrain(Ter)
   WH=TerrainSize(Ter)
   For X = 0 To WH:For Y = 0 To WH
      HL#=0:HR#=0:HU#=0:Hd#=0
      If X-1 >= 0 HL#=TerrainHeight#(Ter,X-1,Y)
      If X+1 <= WH HR#=TerrainHeight#(Ter,X+1,Y)
      If Y-1 >= 0 HU#=TerrainHeight#(Ter,X,Y-1)
      If Y+1 <= WH HD#=TerrainHeight#(Ter,X,Y+1)
      HM#=TerrainHeight#(Ter,X,Y)
      NewH# = (HL#+HR#+HU#+HD#+HM#)/5
      ModifyTerrain Ter,X,Y,NewH#
   Next:Next
End Function

Function SaveTerrain(Ter, File$)
   WH = TerrainSize(Ter)
   IMG = CreateImage(WH,WH)
   SetBuffer ImageBuffer(IMG):LockBuffer ImageBuffer(IMG)
   For X = 0 To WH:For Y = 0 To WH
      W = TerrainHeight(Ter, X, Y) * 255
      RGB = (W Shl 16) + (W Shl 8) + W
      WritePixel X, Y, RGB
   Next:Next
   SetBuffer BackBuffer():UnlockBuffer ImageBuffer(IMG)
   SaveImage IMG, File$
   FreeImage IMG
End Function
Warbseite
 

vanjolo

 BeitragFr, Jan 09, 2009 22:11
Antworten mit Zitat
Benutzer-Profile anzeigen
Danke CGamer für die Mühe und ein großes Dankeschön.
Ich habe es eben ausprobiert und es läuft. Ich habe zum vergleich mal die compilierte DarkBasic Version zum ausprobieren im Download. Irgendwie "fliegt" sich das anders.

Bitte mal ausprobieren wo da die Unterschiede sein könnten. Für eine Flugsim sicher gut zu gebrauchen.

https://www.blitzforum.de/upload/file.php?id=4277

Gruß
VanJolo

Xaymar

ehemals "Cgamer"

BeitragSa, Jan 10, 2009 0:46
Antworten mit Zitat
Benutzer-Profile anzeigen
ich werd mich nochmal dransetzen

[edit]behoben:
Code: [AUSKLAPPEN]

;-------------------------------Einleiten des Graphics3D
Graphics3D 1024,768,32
SetBuffer BackBuffer()

SeedRnd MilliSecs()
HidePointer()
FPST = CreateTimer(60)         ;30 war im tutorial

;-------------------------------Boden Textur
Grass = CreateTexture(64,64,8)
SetBuffer TextureBuffer(Grass)
   ClsColor 80,130,90
   Cls
   RGB = (90 Shl 16) + (110 Shl 8) + 60
   For A = 0 To 64
      WritePixel A,Rand(64),RGB:WritePixel A,Rand(64),RGB:WritePixel A,Rand(64),RGB
      WritePixel A,Rand(64),RGB:WritePixel A,Rand(64),RGB:WritePixel A,Rand(64),RGB
   Next
   
   RGB = (70 Shl 16) + (120 Shl 8) + 70
   For A = 0 To 64
      WritePixel A,Rand(64),RGB:WritePixel A,Rand(64),RGB:WritePixel A,Rand(64),RGB
      WritePixel A,Rand(64),RGB:WritePixel A,Rand(64),RGB:WritePixel A,Rand(64),RGB
   Next
   
   RGB = (95 Shl 16) + (115 Shl 8) + 90
   For A = 0 To 64
      WritePixel A,Rand(64),RGB:WritePixel A,Rand(64),RGB:WritePixel A,Rand(64),RGB
      WritePixel A,Rand(64),RGB:WritePixel A,Rand(64),RGB:WritePixel A,Rand(64),RGB
   Next
   
SetBuffer BackBuffer()

;-------------------------------3D Camera
Cam = CreateCamera()

CameraClsColor Cam,50,90,90
CameraRange Cam,1,9000
CameraViewport Cam,25,55,1000,700
CameraFogMode Cam, 1
CameraFogColor Cam, 50, 90, 90
CameraFogRange Cam, 3500, 4000

;Licht
light=CreateLight():MoveEntity light, 0, -500, 500: PointEntity light, Cam

;-------------------------------Terrain
Ter01 = CreateTerrain(512)
RandomizeTerrain(Ter01,.1,15)
EntityTexture Ter01, Grass, 0, 0
TerrainDetail Ter01, 10000, 1
TerrainShading Ter01, 1

ScaleEntity Ter01, 50, 10000, 50
MoveEntity Ter01, -256 * 50, -(10000/2), -256 * 50

;-------------------------------2. Boden Textur
SaveTerrain(Ter01, "Ter01.bmp")
Lightmap = LoadTexture("Ter01.bmp")
TextureBlend Lightmap, 5
EntityTexture Ter01, Lightmap, 0, 1
ScaleTexture Lightmap, 512, 512

;-------------------------------Flieger
Pivot = CreatePivot()

FlgFront = CreateCone(16,0,Pivot)
ScaleEntity FlgFront, 2, 2, 2
MoveEntity FlgFront, 0, 0, 6
RotateEntity FlgFront, 90, 0, 0
EntityColor FlgFront, 66, 66, 66

Flg = CreateCube(Pivot)
ScaleEntity Flg, 2, 2, 4
MoveEntity Flg, 0, 0, 0
EntityColor Flg, 66, 66, 66

;-------------------------------Variablen
Viewmode = 0
Speed# = 0
Power# = 2
Pitch# = 0
Roll# = 0
Rudder# = 0

;-------------------------------Mainloop
While Not KeyHit(1)
   Cls
   
   RenderWorld
   
      ;Steuerung: Geschwindigkeit, Roll, Pitch
      If KeyDown(17) Power# = Power# + .15
      If KeyDown(31) Power# = Power# - .2
      If Power# > 15 Power# = 15
      If Power# < 0 Power# = 0
      
      If KeyDown(203) Roll# = Roll#+.4
      If KeyDown(205) Roll# = Roll#-.4
      Roll# = Roll# * .9
      TurnEntity Pivot, 0, 0, Roll#
      
      If KeyDown(200) Pitch# = Pitch#+.4
      If KeyDown(208) Pitch# = Pitch#-.4
      Pitch# = Pitch# * .9
      TurnEntity Pivot, Pitch#, 0, 0
      
      ;
      Alt# = EntityY(Pivot)
      TurnEntity Pivot, 0, 90, 0
      MoveEntity Pivot, 0, 0, 1
      SineRoll# = EntityY(Pivot) - Alt#
      MoveEntity Pivot, 0, 0, -1
      TurnEntity Pivot, 0, -90, 0
      
      TurnEntity Pivot, -Abs(SineRoll#)/2, 0, 0
      TurnEntity Pivot, 0, -SineRoll#, 0
      
      
      ;Steuerung: Ruder
      If KeyDown(30) Rudder# = Rudder# + .1
      If KeyDown(32) Rudder# = Rudder# - .1
      Rudder# = Rudder# * .9
      TurnEntity Pivot, 0, Rudder#, 0
      
      ;Schwerkraft
      MoveEntity Pivot, 0, 0, 1
      TruePitch# = Alt# - EntityY#(Pivot)
      MoveEntity Pivot, 0, 0, -1
      Gravity# = TruePitch# * 2
      If Speed# < 2.5 And TruePitch# < .3 Then TurnEntity Pivot, .15, 0, 0
      
      ;Geschwindigkeit
      CoefDrag# = .05
      Drag# = CoefDrag# * Speed# * Speed#
      Speed# = Speed# + Gravity# + Power# - Drag#
      
      If Speed# < 1 Speed# = 1
      MoveEntity Pivot, 0, 0, Speed#
      
      ;Reset
      If KeyHit(19)
         PositionEntity Pivot, 0, 0, 0
         Speed# = 0
         Power# = 2
         Pitch# = 0
         Yaw# = 0
         RotateEntity Pivot, 0, 0, 0
      EndIf
      
      ;Camera
      If Viewmode = 0
         PositionEntity Cam, EntityX(Pivot), EntityY(Pivot), EntityZ(Pivot)
         RotateEntity Cam, EntityPitch(Pivot), EntityYaw(Pivot), EntityRoll(Pivot)
      ElseIf Viewmode = 1
      ElseIf Viewmode = 2
         YSpeed# = MouseYSpeed()
            YSpeed# = YSpeed# / 5
         XSpeed# = MouseXSpeed()
            XSpeed# = XSpeed# / 5
            
         RotateEntity Cam, EntityPitch#(Cam)+YSpeed#, EntityYaw#(Cam)-Xspeed#, 0
         If EntityPitch#(Cam) < -89.5 RotateEntity Cam, -89.5, EntityYaw(Cam),0
         If EntityPitch#(Cam) > 89.5 RotateEntity Cam, 89.5, EntityYaw(Cam),0
         
         If MouseDown(1) MoveEntity Cam, 0, 0, 1
         If MouseDown(2) MoveEntity Cam, 0, 0, 10
         If MouseDown(3) MoveEntity Cam, 0, 0, 100
      ElseIf Viewmode = 3
         
      EndIf
   
   If KeyHit(59) Viewmode = 0
   If KeyHit(60) Viewmode = 1
   If KeyHit(61) Viewmode = 2
   If KeyHit(62) Viewmode = 3
      
   Color 250,125,20
   Text 10,10,"F1 - Cockpit View"
   Text 10,25,"F2 - Follow View Roll"
   Text 10,40,"F3 - Fly by View"
   Text 10,55,"F4 - Follow View Level"
   Text 10,75,"W  - Accelerate"
   Text 10,90,"S  - Slow down"
   Text 10,105,"A  - Turn Left"
   Text 10,120,"D  - Turn Right"
   Text 10,150,"R  - Reset Position"
   
   Text 10,180,"Aircraft: "
   Text 20,195,"Power: " + Power#
   Text 20,210,"Speed: " + Speed#
   
   If MouseX() < 10 Or MouseX() > 1014 Or MouseY() < 10 Or MouseY() > 758 MoveMouse 512,368
   Flip 0
   
   WaitTimer FPST
Wend

;-------------------------------Funktionen
Function RandomizeTerrain(Ter,MaxH#,Runs)
   WH=TerrainSize(Ter)
   For A = 1 To Runs:For X = 0 To WH:For Y = 0 To WH
      CurH# = TerrainHeight#(Ter, X, Y)
      If Rand(50) >= 25
         CurH# = CurH# + Rnd#(-MaxH#*0.75,MaxH#)
      EndIf
      ModifyTerrain Ter, X, Y, CurH#
   Next:Next:SmoothTerrain(Ter):SmoothTerrain(Ter):SmoothTerrain(Ter):Next
End Function

Function SmoothTerrain(Ter)
   WH=TerrainSize(Ter)
   For X = 0 To WH:For Y = 0 To WH
      HL#=0:HR#=0:HU#=0:Hd#=0
      If X-1 >= 0 HL#=TerrainHeight#(Ter,X-1,Y)
      If X+1 <= WH HR#=TerrainHeight#(Ter,X+1,Y)
      If Y-1 >= 0 HU#=TerrainHeight#(Ter,X,Y-1)
      If Y+1 <= WH HD#=TerrainHeight#(Ter,X,Y+1)
      HM#=TerrainHeight#(Ter,X,Y)
      NewH# = (HL#+HR#+HU#+HD#+HM#)/5
      ModifyTerrain Ter,X,Y,NewH#
   Next:Next
End Function

Function SaveTerrain(Ter, File$)
   WH = TerrainSize(Ter)
   IMG = CreateImage(WH,WH)
   SetBuffer ImageBuffer(IMG):LockBuffer ImageBuffer(IMG)
   For X = 0 To WH:For Y = 0 To WH
      W = TerrainHeight(Ter, X, Y) * 255
      RGB = (W Shl 16) + (W Shl 8) + W
      WritePixel X, Y, RGB
   Next:Next
   SetBuffer BackBuffer():UnlockBuffer ImageBuffer(IMG)
   SaveImage IMG, File$
   FreeImage IMG
End Function
Warbseite
 

vanjolo

 BeitragSa, Jan 10, 2009 11:16
Antworten mit Zitat
Benutzer-Profile anzeigen
Find ich jetzt richtig gut! Danke Cgamer.
Was halten die anderen davon?
***************************
in Entwicklung:
Tank Battles - Panzeraction
Pacific Battles - Rundenstrategie
abgeschlossenes Projekt: Harrier Assault

Blackside

 BeitragSa, Jan 10, 2009 13:04
Antworten mit Zitat
Benutzer-Profile anzeigen
Super Wink
Hier sollte eigentlich eine Signatur stehen!

Xaymar

ehemals "Cgamer"

BeitragSa, Jan 10, 2009 16:24
Antworten mit Zitat
Benutzer-Profile anzeigen
so ich hab jetzt noch den rest hinzugefügt.
-Crashen ejtzt möglich
-Cam mode 1 und 3 nun auch verfügbar(F2,F4)

Code: [AUSKLAPPEN]

;-------------------------------Einleiten des Graphics3D
Graphics3D 1024,768,32
SetBuffer BackBuffer()

SeedRnd MilliSecs()
HidePointer()
FPST = CreateTimer(60)         ;30 war im tutorial

;-------------------------------Boden Textur
Grass = CreateTexture(64,64,8)
SetBuffer TextureBuffer(Grass)
   ClsColor 80,130,90
   Cls
   RGB = (90 Shl 16) + (110 Shl 8) + 60
   For A = 0 To 64
      WritePixel A,Rand(64),RGB:WritePixel A,Rand(64),RGB:WritePixel A,Rand(64),RGB
      WritePixel A,Rand(64),RGB:WritePixel A,Rand(64),RGB:WritePixel A,Rand(64),RGB
   Next
   
   RGB = (70 Shl 16) + (120 Shl 8) + 70
   For A = 0 To 64
      WritePixel A,Rand(64),RGB:WritePixel A,Rand(64),RGB:WritePixel A,Rand(64),RGB
      WritePixel A,Rand(64),RGB:WritePixel A,Rand(64),RGB:WritePixel A,Rand(64),RGB
   Next
   
   RGB = (95 Shl 16) + (115 Shl 8) + 90
   For A = 0 To 64
      WritePixel A,Rand(64),RGB:WritePixel A,Rand(64),RGB:WritePixel A,Rand(64),RGB
      WritePixel A,Rand(64),RGB:WritePixel A,Rand(64),RGB:WritePixel A,Rand(64),RGB
   Next
   
SetBuffer BackBuffer()

;-------------------------------3D Camera
Cam = CreateCamera()

CameraClsColor Cam,50,90,90
CameraRange Cam,1,9000
CameraViewport Cam,25,55,1000,700
CameraFogMode Cam, 1
CameraFogColor Cam, 50, 90, 90
CameraFogRange Cam, 3500, 4000

;Licht
light=CreateLight():MoveEntity light, 0, -500, 500: PointEntity light, Cam

;-------------------------------Terrain
Ter01 = CreateTerrain(512)
RandomizeTerrain(Ter01,.1,15)
EntityTexture Ter01, Grass, 0, 0
TerrainDetail Ter01, 10000, 1
TerrainShading Ter01, 1

ScaleEntity Ter01, 50, 10000, 50
MoveEntity Ter01, -256 * 50, -(10000/2), -256 * 50

;-------------------------------2. Boden Textur
SaveTerrain(Ter01, "Ter01.bmp")
Lightmap = LoadTexture("Ter01.bmp")
TextureBlend Lightmap, 5
EntityTexture Ter01, Lightmap, 0, 1
ScaleTexture Lightmap, 512, 512

;-------------------------------Flieger
Pivot = CreatePivot()

FlgFront = CreateCone(16,1,Pivot)
ScaleEntity FlgFront, 2, 2, 2
MoveEntity FlgFront, 0, 0, 6
RotateEntity FlgFront, 90, 0, 0
EntityColor FlgFront, 66, 66, 66

Flg = CreateCube(Pivot)
ScaleEntity Flg, 8, 1, 4
MoveEntity Flg, 0, 0, 0
EntityColor Flg, 66, 66, 66

;-------------------------------Variablen
Viewmode = 0
Speed# = 0
Power# = 2
Pitch# = 0
Roll# = 0
Rudder# = 0

;-------------------------------Mainloop
While Not KeyHit(1)
   Cls
   
   RenderWorld
   
      ;Steuerung: Geschwindigkeit, Roll, Pitch
      If KeyDown(17) Power# = Power# + .15
      If KeyDown(31) Power# = Power# - .2
      If Power# > 15 Power# = 15
      If Power# < 0 Power# = 0
      
      If KeyDown(203) Roll# = Roll#+.4
      If KeyDown(205) Roll# = Roll#-.4
      Roll# = Roll# * .9
      TurnEntity Pivot, 0, 0, Roll#
      
      If KeyDown(200) Pitch# = Pitch#+.4
      If KeyDown(208) Pitch# = Pitch#-.4
      Pitch# = Pitch# * .9
      TurnEntity Pivot, Pitch#, 0, 0
      
      ;
      Alt# = EntityY(Pivot)
      TurnEntity Pivot, 0, 90, 0
      MoveEntity Pivot, 0, 0, 1
      SineRoll# = EntityY(Pivot) - Alt#
      MoveEntity Pivot, 0, 0, -1
      TurnEntity Pivot, 0, -90, 0
      
      TurnEntity Pivot, -Abs(SineRoll#)/2, 0, 0
      TurnEntity Pivot, 0, -SineRoll#, 0
      
      
      ;Steuerung: Ruder
      If KeyDown(30) Rudder# = Rudder# + .1
      If KeyDown(32) Rudder# = Rudder# - .1
      Rudder# = Rudder# * .9
      TurnEntity Pivot, 0, Rudder#, 0
      
      ;Schwerkraft
      MoveEntity Pivot, 0, 0, 1
      TruePitch# = Alt# - EntityY#(Pivot)
      MoveEntity Pivot, 0, 0, -1
      Gravity# = TruePitch# * 2
      If Speed# < 2.5 And TruePitch# < .3 Then TurnEntity Pivot, .15, 0, 0
      
      ;Geschwindigkeit
      CoefDrag# = .05
      Drag# = CoefDrag# * Speed# * Speed#
      Speed# = Speed# + Gravity# + Power# - Drag#
      
      If Speed# < 1 Speed# = 1
      MoveEntity Pivot, 0, 0, Speed#
      
      ;Reset
      If KeyHit(19)
         PositionEntity Pivot, 0, 0, 0
         Speed# = 0
         Power# = 2
         Pitch# = 0
         Yaw# = 0
         RotateEntity Pivot, 0, 0, 0
      EndIf
      
      ;Camera
      If Viewmode = 0
         PositionEntity Cam, EntityX(Pivot), EntityY(Pivot), EntityZ(Pivot)
         RotateEntity Cam, EntityPitch(Pivot), EntityYaw(Pivot), EntityRoll(Pivot)
         MoveEntity Cam, 0, 0, 4
      ElseIf Viewmode = 1
         PositionEntity Cam, 0, 0, 0
         PointEntity Cam, Pivot
         RotateEntity Cam, EntityPitch(Cam), EntityYaw(Cam), EntityRoll(Pivot)
      ElseIf Viewmode = 2
         YSpeed# = MouseYSpeed()
            YSpeed# = YSpeed# / 5
         XSpeed# = MouseXSpeed()
            XSpeed# = XSpeed# / 5
            
         RotateEntity Cam, EntityPitch#(Cam)+YSpeed#, EntityYaw#(Cam)-Xspeed#, 0
         If EntityPitch#(Cam) < -89.5 RotateEntity Cam, -89.5, EntityYaw(Cam),0
         If EntityPitch#(Cam) > 89.5 RotateEntity Cam, 89.5, EntityYaw(Cam),0
         
         If MouseDown(1) MoveEntity Cam, 0, 0, 1
         If MouseDown(2) MoveEntity Cam, 0, 0, 10
         If MouseDown(3) MoveEntity Cam, 0, 0, 100
      ElseIf Viewmode = 3
         PositionEntity Cam, EntityX(Flg,1), EntityY(Flg,1), EntityZ(Flg,1)
         RotateEntity Cam, EntityPitch(Flg,1), EntityYaw(Flg,1), EntityRoll(Flg,1)
         MoveEntity Cam, 0, 10, -30
         PointEntity Cam, Pivot
      EndIf
      
      If EntityY(Pivot) < TerrainY(Ter01, EntityX(Pivot), EntityY(Pivot), EntityZ(Pivot))+5
         FlushKeys()
         Color 255,255,255
         Text 512,368,"Crashed! Press any Key",1,1
         Flip
         WaitKey()
         PositionEntity Pivot, 0, 0, 0
         Speed# = 0
         Power# = 2
         Pitch# = 0
         Yaw# = 0
         RotateEntity Pivot, 0, 0, 0
      EndIf
   
   If KeyHit(59) Viewmode = 0
   If KeyHit(60) Viewmode = 1
   If KeyHit(61) Viewmode = 2
   If KeyHit(62) Viewmode = 3
      
   Color 250,125,20
   Text 10,10,"F1 - Cockpit View"
   Text 10,25,"F2 - Follow View Roll"
   Text 10,40,"F3 - Fly by View"
   Text 10,55,"F4 - Follow View Level"
   Text 10,75,"W  - Accelerate"
   Text 10,90,"S  - Slow down"
   Text 10,105,"A  - Turn Left"
   Text 10,120,"D  - Turn Right"
   Text 10,150,"R  - Reset Position"
   
   Text 10,180,"Aircraft: "
   Text 20,195,"Power: " + Power#
   Text 20,210,"Speed: " + Speed#
   
   If MouseX() < 10 Or MouseX() > 1014 Or MouseY() < 10 Or MouseY() > 758 MoveMouse 512,368
   Flip 0
   
   WaitTimer FPST
Wend

;-------------------------------Funktionen
Function RandomizeTerrain(Ter,MaxH#,Runs)
   WH=TerrainSize(Ter)
   For A = 1 To Runs:For X = 0 To WH:For Y = 0 To WH
      CurH# = TerrainHeight#(Ter, X, Y)
      If Rand(50) >= 25
         CurH# = CurH# + Rnd#(-MaxH#*0.80,MaxH#)
      EndIf
      ModifyTerrain Ter, X, Y, CurH#
   Next:Next:SmoothTerrain(Ter):SmoothTerrain(Ter):SmoothTerrain(Ter):Next
End Function

Function SmoothTerrain(Ter)
   WH=TerrainSize(Ter)
   For X = 0 To WH:For Y = 0 To WH
      HL#=0:HR#=0:HU#=0:Hd#=0
      If X-1 >= 0 HL#=TerrainHeight#(Ter,X-1,Y)
      If X+1 <= WH HR#=TerrainHeight#(Ter,X+1,Y)
      If Y-1 >= 0 HU#=TerrainHeight#(Ter,X,Y-1)
      If Y+1 <= WH HD#=TerrainHeight#(Ter,X,Y+1)
      HM#=TerrainHeight#(Ter,X,Y)
      NewH# = (HL#+HR#+HU#+HD#+HM#)/5
      ModifyTerrain Ter,X,Y,NewH#
   Next:Next
End Function

Function SaveTerrain(Ter, File$)
   WH = TerrainSize(Ter)
   IMG = CreateImage(WH,WH)
   SetBuffer ImageBuffer(IMG):LockBuffer ImageBuffer(IMG)
   For X = 0 To WH:For Y = 0 To WH
      W = TerrainHeight(Ter, X, Y) * 255
      RGB = (W Shl 16) + (W Shl 8) + W
      WritePixel X, Y, RGB
   Next:Next
   SetBuffer BackBuffer():UnlockBuffer ImageBuffer(IMG)
   SaveImage IMG, File$
   FreeImage IMG
End Function
Warbseite
 

vanjolo

 BeitragSa, Jan 10, 2009 18:18
Antworten mit Zitat
Benutzer-Profile anzeigen
Genial!
Very Happy
***************************
in Entwicklung:
Tank Battles - Panzeraction
Pacific Battles - Rundenstrategie
abgeschlossenes Projekt: Harrier Assault

Xaymar

ehemals "Cgamer"

BeitragSa, Jan 10, 2009 20:40
Antworten mit Zitat
Benutzer-Profile anzeigen
ein kleines update, damit es nicht so aussieht als sei man im nichts gecrasht
Code: [AUSKLAPPEN]

;-------------------------------Einleiten des Graphics3D
Graphics3D 1024,768,32
SetBuffer BackBuffer()

SeedRnd MilliSecs()
HidePointer()
FPST = CreateTimer(60)         ;30 war im tutorial

;-------------------------------Boden Textur
Grass = CreateTexture(64,64,8)
SetBuffer TextureBuffer(Grass)
   ClsColor 80,130,90
   Cls
   RGB = (90 Shl 16) + (110 Shl 8) + 60
   For A = 0 To 64
      WritePixel A,Rand(64),RGB:WritePixel A,Rand(64),RGB:WritePixel A,Rand(64),RGB
      WritePixel A,Rand(64),RGB:WritePixel A,Rand(64),RGB:WritePixel A,Rand(64),RGB
   Next
   
   RGB = (70 Shl 16) + (120 Shl 8) + 70
   For A = 0 To 64
      WritePixel A,Rand(64),RGB:WritePixel A,Rand(64),RGB:WritePixel A,Rand(64),RGB
      WritePixel A,Rand(64),RGB:WritePixel A,Rand(64),RGB:WritePixel A,Rand(64),RGB
   Next
   
   RGB = (95 Shl 16) + (115 Shl 8) + 90
   For A = 0 To 64
      WritePixel A,Rand(64),RGB:WritePixel A,Rand(64),RGB:WritePixel A,Rand(64),RGB
      WritePixel A,Rand(64),RGB:WritePixel A,Rand(64),RGB:WritePixel A,Rand(64),RGB
   Next
   
SetBuffer BackBuffer()

;-------------------------------3D Camera
Cam = CreateCamera()

CameraClsColor Cam,50,90,90
CameraRange Cam,1,9000
CameraViewport Cam,25,55,1000,700
CameraFogMode Cam, 1
CameraFogColor Cam, 50, 90, 90
CameraFogRange Cam, 3500, 4000

;Licht
light=CreateLight():MoveEntity light, 0, -500, 500: PointEntity light, Cam

;-------------------------------Terrain
Ter01 = CreateTerrain(512)
RandomizeTerrain(Ter01,.1,15)
EntityTexture Ter01, Grass, 0, 0
TerrainDetail Ter01, 10000, 1
TerrainShading Ter01, 1

ScaleEntity Ter01, 50, 10000, 50
MoveEntity Ter01, -256 * 50, -(10000/2), -256 * 50

Plane = CreatePlane(16)
MoveEntity Plane, 0, -512*9.75, 0
EntityTexture Plane, Grass
EntityColor Plane, 12.5, 12.5, 12.5

;-------------------------------2. Boden Textur
SaveTerrain(Ter01, "Ter01.bmp")
Lightmap = LoadTexture("Ter01.bmp")
TextureBlend Lightmap, 5
EntityTexture Ter01, Lightmap, 0, 1
ScaleTexture Lightmap, 512, 512

;-------------------------------Flieger
Pivot = CreatePivot()

FlgFront = CreateCone(16,1,Pivot)
ScaleEntity FlgFront, 2, 2, 2
MoveEntity FlgFront, 0, 0, 6
RotateEntity FlgFront, 90, 0, 0
EntityColor FlgFront, 204, 66, 66

Flg = CreateCube(Pivot)
ScaleEntity Flg, 8, 1, 4
MoveEntity Flg, 0, 0, 0
EntityColor Flg, 66, 66, 66

;-------------------------------Variablen
Viewmode = 0
Speed# = 0
Power# = 2
Pitch# = 0
Roll# = 0
Rudder# = 0

;-------------------------------Mainloop
While Not KeyHit(1)
   Cls
   
   RenderWorld
   
      ;Steuerung: Geschwindigkeit, Roll, Pitch
      If KeyDown(17) Power# = Power# + .15
      If KeyDown(31) Power# = Power# - .2
      If Power# > 15 Power# = 15
      If Power# < 0 Power# = 0
      
      If KeyDown(203) Roll# = Roll#+.4
      If KeyDown(205) Roll# = Roll#-.4
      Roll# = Roll# * .9
      TurnEntity Pivot, 0, 0, Roll#
      
      If KeyDown(200) Pitch# = Pitch#+.4
      If KeyDown(208) Pitch# = Pitch#-.4
      Pitch# = Pitch# * .9
      TurnEntity Pivot, Pitch#, 0, 0
      
      ;
      Alt# = EntityY(Pivot)
      TurnEntity Pivot, 0, 90, 0
      MoveEntity Pivot, 0, 0, 1
      SineRoll# = EntityY(Pivot) - Alt#
      MoveEntity Pivot, 0, 0, -1
      TurnEntity Pivot, 0, -90, 0
      
      TurnEntity Pivot, -Abs(SineRoll#)/2, 0, 0
      TurnEntity Pivot, 0, -SineRoll#, 0
      
      
      ;Steuerung: Ruder
      If KeyDown(30) Rudder# = Rudder# + .1
      If KeyDown(32) Rudder# = Rudder# - .1
      Rudder# = Rudder# * .9
      TurnEntity Pivot, 0, Rudder#, 0
      
      ;Schwerkraft
      MoveEntity Pivot, 0, 0, 1
      TruePitch# = Alt# - EntityY#(Pivot)
      MoveEntity Pivot, 0, 0, -1
      Gravity# = TruePitch# * 2
      If Speed# < 2.5 And TruePitch# < .3 Then TurnEntity Pivot, .15, 0, 0
      
      ;Geschwindigkeit
      CoefDrag# = .05
      Drag# = CoefDrag# * Speed# * Speed#
      Speed# = Speed# + Gravity# + Power# - Drag#
      
      If Speed# < 1 Speed# = 1
      MoveEntity Pivot, 0, 0, Speed#
      
      ;Reset
      If KeyHit(19)
         PositionEntity Pivot, 0, 0, 0
         Speed# = 0
         Power# = 2
         Pitch# = 0
         Yaw# = 0
         RotateEntity Pivot, 0, 0, 0
      EndIf
      
      ;Camera
      If Viewmode = 0
         PositionEntity Cam, EntityX(Pivot), EntityY(Pivot), EntityZ(Pivot)
         RotateEntity Cam, EntityPitch(Pivot), EntityYaw(Pivot), EntityRoll(Pivot)
         MoveEntity Cam, 0, 0, 4
      ElseIf Viewmode = 1
         PositionEntity Cam, 0, 0, 0
         PointEntity Cam, Pivot
         RotateEntity Cam, EntityPitch(Cam), EntityYaw(Cam), EntityRoll(Pivot)
      ElseIf Viewmode = 2
         YSpeed# = MouseYSpeed()
            YSpeed# = YSpeed# / 5
         XSpeed# = MouseXSpeed()
            XSpeed# = XSpeed# / 5
            
         RotateEntity Cam, EntityPitch#(Cam)+YSpeed#, EntityYaw#(Cam)-Xspeed#, 0
         If EntityPitch#(Cam) < -89.5 RotateEntity Cam, -89.5, EntityYaw(Cam),0
         If EntityPitch#(Cam) > 89.5 RotateEntity Cam, 89.5, EntityYaw(Cam),0
         
         If MouseDown(1) MoveEntity Cam, 0, 0, 1
         If MouseDown(2) MoveEntity Cam, 0, 0, 10
         If MouseDown(3) MoveEntity Cam, 0, 0, 100
      ElseIf Viewmode = 3
         PositionEntity Cam, EntityX(Flg,1), EntityY(Flg,1), EntityZ(Flg,1)
         RotateEntity Cam, EntityPitch(Flg,1), EntityYaw(Flg,1), EntityRoll(Flg,1)
         MoveEntity Cam, 0, 10, -30
         PointEntity Cam, Pivot
      EndIf
      
      If EntityY(Pivot) < TerrainY(Ter01, EntityX(Pivot), EntityY(Pivot), EntityZ(Pivot))+5
         FlushKeys()
         Color 255,255,255
         Text 512,368,"Crashed! Press any Key",1,1
         Flip
         WaitKey()
         PositionEntity Pivot, 0, 0, 0
         Speed# = 0
         Power# = 2
         Pitch# = 0
         Yaw# = 0
         RotateEntity Pivot, 0, 0, 0
      EndIf
   
   If KeyHit(59) Viewmode = 0
   If KeyHit(60) Viewmode = 1
   If KeyHit(61) Viewmode = 2
   If KeyHit(62) Viewmode = 3
      
   Color 250,125,20
   Text 10,10,"F1 - Cockpit View"
   Text 10,25,"F2 - Follow View Roll"
   Text 10,40,"F3 - Fly by View"
   Text 10,55,"F4 - Follow View Level"
   Text 10,75,"W  - Accelerate"
   Text 10,90,"S  - Slow down"
   Text 10,105,"A  - Turn Left"
   Text 10,120,"D  - Turn Right"
   Text 10,150,"R  - Reset Position"
   
   Text 10,180,"Aircraft: "
   Text 20,195,"Power: " + Power#
   Text 20,210,"Speed: " + Speed#
   
   If MouseX() < 10 Or MouseX() > 1014 Or MouseY() < 10 Or MouseY() > 758 MoveMouse 512,368
   Flip 0
   
   WaitTimer FPST
Wend

;-------------------------------Funktionen
Function RandomizeTerrain(Ter,MaxH#,Runs)
   WH=TerrainSize(Ter)
   For A = 1 To Runs:For X = 0 To WH:For Y = 0 To WH
      CurH# = TerrainHeight#(Ter, X, Y)
      If Rand(50) >= 25
         CurH# = CurH# + Rnd#(-MaxH#*0.80,MaxH#)
      EndIf
      ModifyTerrain Ter, X, Y, CurH#
   Next:Next:SmoothTerrain(Ter):SmoothTerrain(Ter):SmoothTerrain(Ter):Next
End Function

Function SmoothTerrain(Ter)
   WH=TerrainSize(Ter)
   For X = 0 To WH:For Y = 0 To WH
      HL#=0:HR#=0:HU#=0:Hd#=0
      If X-1 >= 0 HL#=TerrainHeight#(Ter,X-1,Y)
      If X+1 <= WH HR#=TerrainHeight#(Ter,X+1,Y)
      If Y-1 >= 0 HU#=TerrainHeight#(Ter,X,Y-1)
      If Y+1 <= WH HD#=TerrainHeight#(Ter,X,Y+1)
      HM#=TerrainHeight#(Ter,X,Y)
      NewH# = (HL#+HR#+HU#+HD#+HM#)/5
      ModifyTerrain Ter,X,Y,NewH#
   Next:Next
End Function

Function SaveTerrain(Ter, File$)
   WH = TerrainSize(Ter)
   IMG = CreateImage(WH,WH)
   SetBuffer ImageBuffer(IMG):LockBuffer ImageBuffer(IMG)
   For X = 0 To WH:For Y = 0 To WH
      W = TerrainHeight(Ter, X, Y) * 255
      RGB = (W Shl 16) + (W Shl 8) + W
      WritePixel X, Y, RGB
   Next:Next
   SetBuffer BackBuffer():UnlockBuffer ImageBuffer(IMG)
   SaveImage IMG, File$
   FreeImage IMG
End Function
Warbseite
 

vanjolo

 BeitragSo, Jan 11, 2009 2:19
Antworten mit Zitat
Benutzer-Profile anzeigen
Wirkt wirklich sehr gut CGamer.
***************************
in Entwicklung:
Tank Battles - Panzeraction
Pacific Battles - Rundenstrategie
abgeschlossenes Projekt: Harrier Assault

Neue Antwort erstellen


Übersicht Sonstiges Smalltalk

Nach Oben

Gehe zu:

Powered by phpBB © 2001 - 2006, phpBB Group