Subversion Repositories forest

Compare Revisions

No changes between revisions

Regard whitespace Rev 1 → Rev 2

/trunk/_private/Code Tests/Alter Mapgen/Unit1_old.pas
0,0 → 1,536
unit Unit1;
 
interface
 
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls;
 
type
TForm1 = class(TForm)
Button1: TButton;
PaintBox1: TPaintBox;
Button2: TButton;
Button3: TButton;
Memo1: TMemo;
Button4: TButton;
Button5: TButton;
Button6: TButton;
Button7: TButton;
CheckBox1: TCheckBox;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure Button6Click(Sender: TObject);
procedure Button7Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
 
var
Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
uses
Math;
 
procedure TForm1.Button1Click(Sender: TObject);
const
mapsizex = 400;
mapsizey = 400;
 
procedure _(size: integer);
var
posx, posy: integer;
begin
posx := Random(mapsizex);
posy := Random(mapsizey);
paintbox1.Canvas.Ellipse(posx, posy, posx+size, posy+size);
end;
 
var
i: integer;
begin
paintbox1.Canvas.Rectangle(0,0,mapsizex,mapsizey);
 
for i := 0 to 1 do
begin
_(100);
_(100);
_(100);
_(100);
 
_(50);
_(50);
_(50);
_(50);
_(50);
_(50);
_(50);
_(50);
 
_(25);
_(25);
_(25);
_(25);
_(25);
_(25);
_(25);
_(25);
_(25);
_(25);
_(25);
_(25);
_(25);
_(25);
_(25);
_(25);
end;
end;
 
function RandomBetween(a, b: integer): integer;
begin
result := RandomRange(a,b+1);
end;
 
function IsInCircle(p, q: TPoint; pr: integer): boolean;
begin
result := sqrt((p.x-q.x)*(p.x-q.x) + (p.y-q.y)*(p.y-q.y)) <= pr;
end;
 
procedure TForm1.Button2Click(Sender: TObject);
const
maxB = 50;
r = 30;
maxX = 400;
maxY = 400;
 
procedure _Draw(p: TPoint);
begin
paintbox1.Canvas.Ellipse(p.X-r,p.Y-r, p.X+r,p.Y+r);
end;
 
function findRandomOutline(p: TPoint): TPoint;
var
yg, xg: integer;
begin
xg := RandomBetween(p.X-r, p.X+r);
if RandomBetween(0,1) = 0 then
yg := Floor(p.y - sqrt(r*r - (p.x-xg)*(p.x-xg)))
else
yg := Floor(p.y + sqrt(r*r - (p.x-xg)*(p.x-xg)));
result.X := xg;
result.Y := yg;
end;
 
function CirclesOverlap(p, q: TPoint): boolean;
begin
result := (abs(p.x-q.x) < 2*r) and (abs(p.y-q.y) < 2*r);
end;
 
var
Circles: array[0..maxB] of TPoint;
i, j: integer;
p: TPoint;
feck: boolean;
begin
paintbox1.Canvas.Rectangle(0,0,maxx,maxy);
 
Circles[0].X := maxX div 2;
Circles[0].Y := maxY div 2;
_Draw(Circles[0]);
 
for i := 1 to maxB do
begin
 
repeat
feck := false;
p := findRandomOutline(Circles[i-1]);
for j := 0 to i-2 do
begin
if CirclesOverlap(p, Circles[j]) then
begin
feck := true;
break;
end;
end;
until not feck;
 
Circles[i] := p;
_Draw(Circles[i]);
end;
end;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
Randomize;
end;
 
procedure TForm1.Button3Click(Sender: TObject);
const
maxB = 50;
r = 30;
maxX = 400;
maxY = 400;
klebfaktor = 0.9;
 
procedure _Draw(p: TPoint);
begin
paintbox1.Canvas.Ellipse(p.X-r,p.Y-r, p.X+r,p.Y+r);
end;
 
function findRandomOutline(p: TPoint): TPoint;
var
yg, xg: integer;
newr: integer;
begin
newr := Round(1.5*r);
xg := RandomBetween(p.X-newr, p.X+newr);
if RandomBetween(0,1) = 0 then
yg := Floor(p.y - sqrt(newr*newr - (p.x-xg)*(p.x-xg)))
else
yg := Floor(p.y + sqrt(newr*newr - (p.x-xg)*(p.x-xg)));
result.X := xg;
result.Y := yg;
end;
 
function CirclesOverlap(p, q: TPoint): boolean;
begin
result := (abs(p.x-q.x) < 2*r) and (abs(p.y-q.y) < 2*r);
end;
 
var
Circles: array[0..maxB] of TPoint;
i, j: integer;
c: integer;
feck: boolean;
p: tpoint;
begin
memo1.lines.clear;
paintbox1.Canvas.Rectangle(0,0,maxx,maxy);
 
Circles[0].X := maxX div 2;
Circles[0].Y := maxY div 2;
_Draw(Circles[0]);
 
 
 
for i := 1 to maxB do
begin
c := RandomBetween(0,i-1);
 
repeat
// memo1.lines.add(IntTostr(i)+ ' -> ' + inttostr(c));
 
Circles[i] := findRandomOutline(Circles[c]);
 
 
feck := false;
(*
for j := 1 to i-2 do
begin
if CirclesOverlap(Circles[i], Circles[j]) then
begin
inc(fc);
feck := true;
break;
end;
end;
 
if fc > 100 then
begin
c := RandomBetween(0,i-1);
fc := 0;
end;
*)
 
// Application.ProcessMessages;
// Sleep(500);
 
until not feck;
_Draw(Circles[i]);
 
memo1.lines.add('Draw '+IntTostr(i)+ ' based on ' + inttostr(c));
 
end;
 
exit;
 
for i := 1 to maxB do
begin
 
repeat
feck := false;
p := findRandomOutline(Circles[i-1]);
for j := 0 to i-2 do
begin
if CirclesOverlap(p, Circles[j]) then
begin
feck := true;
break;
end;
end;
until not feck;
 
Circles[i] := p;
_Draw(Circles[i]);
end;
end;
 
procedure TForm1.Button4Click(Sender: TObject);
const
mapsizex = 400;
mapsizey = 400;
 
procedure _(size: integer);
var
posx, posy: integer;
begin
posx := Random(mapsizex);
posy := Random(mapsizey);
paintbox1.Canvas.Ellipse(posx, posy, posx+size, posy+size);
end;
 
var
i: integer;
begin
paintbox1.Canvas.Rectangle(0,0,mapsizex,mapsizey);
 
for i := 0 to 20 do
begin
_(RandomBetween(10,100));
end;
end;
 
procedure TForm1.Button5Click(Sender: TObject);
const
r = 5;
maxX = 545;
maxY = 545;
var
drawnCircles: integer;
 
procedure _Draw(p: TPoint);
begin
paintbox1.Canvas.Brush.Color := clGray;
paintbox1.Canvas.Pen.Color := clGray;
paintbox1.Canvas.Ellipse(p.X-r,p.Y-r, p.X+r,p.Y+r);
inc(drawnCircles);
 
// Sleep(10);
// application.processmessages;
end;
 
function RandBetween(a, b: integer): integer;
begin
result := Random(b-a+1)+a;
end;
 
procedure BeginAdventure(startx, starty, angle, dep: integer);
const
maxB = 200;
flexi = 25;
maxdep = 2;
anzahlZweige = 2;
rand = 2;
zielBaumZahl = 1000;
var
Circles: array[0..maxB] of TPoint;
Rad: array[0..maxB] of integer;
i: integer;
x: integer;
maxdrawn: integer;
begin
if dep > maxdep then exit;
if drawncircles >= zielBaumZahl then exit;
 
Rad[0] := angle;
Circles[0].X := startx;
Circles[0].Y := starty;
_Draw(Circles[0]);
 
repeat
maxdrawn := 0;
for i := 1 to maxB{ div (dep+1)} do
begin
Rad[i] := RandBetween(Rad[i-1]-flexi, Rad[i-1]+flexi);
Circles[i].X := Circles[i-1].X + round(r*cos(Rad[i]/360*2*pi));
Circles[i].Y := Circles[i-1].Y + round(r*sin(Rad[i]/360*2*pi));
 
if Circles[i].X > maxX-rand*r then break;
if Circles[i].Y > maxY-rand*r then break;
if Circles[i].X < rand*r then break;
if Circles[i].Y < rand*r then break;
 
maxdrawn := i;
end;
until maxdrawn = maxB div (dep+1);
 
for i := 1 to maxdrawn do
begin
_Draw(Circles[i]);
end;
 
if maxdrawn > dep*50 then
for i := 1 to anzahlZweige do
begin
x := RandBetween(maxdrawn div 2, maxdrawn);
if RandBetween(0,1)=0 then
BeginAdventure(Circles[x].X, Circles[x].Y, Rad[x]-90, dep+1)
else
BeginAdventure(Circles[x].X, Circles[x].Y, Rad[x]+90, dep+1);
end;
end;
 
begin
Randomize;
 
memo1.lines.clear;
drawnCircles := 0;
 
paintbox1.Canvas.Brush.Color := clGreen;
paintbox1.Canvas.Pen.Color := clBlack;
paintbox1.Canvas.Rectangle(0,0,maxx,maxy);
 
BeginAdventure(maxX div 2, maxY div 2, RandBetween(0, 360), 0);
end;
 
procedure TForm1.Button6Click(Sender: TObject);
const
r = 5;
maxX = 545;
maxY = 545;
zielBaumZahl = 1000;
var
drawnCircles: integer;
Circles: array[0..zielBaumZahl-1] of TPoint;
Rad: array[0..zielBaumZahl-1] of integer;
 
procedure _Draw(p: TPoint);
begin
paintbox1.Canvas.Brush.Color := clGray;
paintbox1.Canvas.Pen.Color := clGray;
paintbox1.Canvas.Ellipse(p.X-r,p.Y-r, p.X+r,p.Y+r);
inc(drawnCircles);
 
// Sleep(10);
// application.processmessages;
end;
 
function RandBetween(a, b: integer): integer;
begin
result := Random(b-a+1)+a;
end;
 
procedure BeginAdventure(startx, starty, angle: integer);
const
maxB = 200;
flexi = 15;
rand = 2;
var
i: integer;
x: integer;
maxdrawn: integer;
beg: integer;
begin
if drawncircles >= zielBaumZahl then exit;
 
Rad[0] := angle;
Circles[0].X := startx;
Circles[0].Y := starty;
_Draw(Circles[0]);
 
beg := 1;
 
while true do
begin
 
maxdrawn := 0;
for i := beg to beg+maxB do
begin
if i > High(Rad) then Exit;
 
Rad[i] := RandBetween(Rad[i-1]-flexi, Rad[i-1]+flexi);
Circles[i].X := Circles[i-1].X + round(r*cos(Rad[i]/360*2*pi));
Circles[i].Y := Circles[i-1].Y + round(r*sin(Rad[i]/360*2*pi));
 
if Circles[i].X > maxX-rand*r then break;
if Circles[i].Y > maxY-rand*r then break;
if Circles[i].X < rand*r then break;
if Circles[i].Y < rand*r then break;
 
_Draw(Circles[i]);
 
maxdrawn := i;
end;
 
x := RandBetween(0, maxdrawn);
Circles[maxdrawn+1] := Circles[x]; // virtual tree (not drawn)
 
if RandBetween(0,1) = 0 then
Rad[maxdrawn+1] := Rad[x]-90
else
Rad[maxdrawn+1] := Rad[x]+90;
 
beg := maxdrawn+2;
 
end;
end;
 
begin
Randomize;
 
memo1.lines.clear;
drawnCircles := 0;
 
paintbox1.Canvas.Brush.Color := clGreen;
paintbox1.Canvas.Pen.Color := clBlack;
paintbox1.Canvas.Rectangle(0,0,maxx,maxy);
 
BeginAdventure(maxX div 2, maxY div 2, RandBetween(0, 360));
end;
 
 
function TreePos(nTrees, treeRadius, mapX, mapY: integer; memblock: Pointer; debug: boolean): dword; cdecl; external 'd:\tdn\mapgen\mapgen32.dll';
 
procedure DrawCircle(x, y, r: integer);
begin
form1.paintbox1.Canvas.Brush.Color := clMaroon;
form1.paintbox1.Canvas.Pen.Color := clMaroon;
form1.paintbox1.Canvas.Ellipse(X-r,Y-r, X+r,Y+r);
end;
 
procedure TForm1.Button7Click(Sender: TObject);
const
miniature_factor = 20; // only viewer
treeradius = 100;
ntrees = 5000;
mapX = 10000;
mapY = 10000;
var
i: integer;
mb: array[0..ntrees-1, 0..1] of dword;
begin
paintbox1.Repaint;
 
TreePos(ntrees, treeradius, mapx, mapy, @mb[0][0], checkbox1.checked);
 
paintbox1.Canvas.Brush.Color := clGreen;
paintbox1.Canvas.Pen.Color := clBlack;
paintbox1.Canvas.Rectangle(0,0,mapx div miniature_factor,mapy div miniature_factor);
 
for i := 0 to ntrees-1 do
begin
DrawCircle(mb[i][0] div miniature_factor, mb[i][1] div miniature_factor, treeradius div miniature_factor);
end;
end;
 
end.
/trunk/_private/Code Tests/Blood/Blood2.bmp
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Added: svn:mime-type
+application/octet-stream
\ No newline at end of property
/trunk/_private/Code Tests/Blood/Blood3.bmp
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Added: svn:mime-type
+application/octet-stream
\ No newline at end of property
/trunk/_private/Code Tests/Blood/BloodSplat.bmp
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Added: svn:mime-type
+application/octet-stream
\ No newline at end of property
/trunk/_private/Code Tests/Blood/Blut.txt
0,0 → 1,61
rem Blut vorbereiten
remstart
load image "bitmap\BloodSplat.bmp", 6
dim grav#(300)
dim inuse(300)
dim posx#(300)
dim posy#(300)
dim droprate#(300)
dim life(300)
dim hpos#(300)
for x = 500 to 800
make object plain x, 15, 15
texture object x, 6
ghost object on x
hide object x
next x
remend
 
 
 
do
 
remstart
bloodok = 1
 
rem Blut
for tr = 1 to 3
for x = 100 to 300
if inuse(x) = 0 then goto skp
next x
x = 1
skp:
inuse(x) = 1
posx#(x) = 0 - mx
posy#(x) = 0 - my
droprate#(x) = 0 - (rnd(12) / 2)
if bloodok = 1 then droprate#(x) = 0 - (rnd(12))
grav#(x) = .2 + rnd(10) / 11
if grav#(x) = 0 then grav#(x) = .05
hpos#(x) = (rnd(300) / 300) - 1.5
if bloodok = 1 then hpos#(x) = (rnd(200) / 50) - 2
show object x + 500
next tr
actv = 0
for x = 100 to 300
if inuse(x) = 1
inc actv
posx#(x) = posx#(x) + hpos#(x)
posy#(x) = posy#(x) - droprate#(x)
droprate#(x) = droprate#(x) + grav#(x)
position object x + 500,posx#(x), posy#(x), 0 - life(x)
zrotate object x + 500, wrapvalue(life(x) * 5)
life(x) = life(x) + 3
if life(x) > 300 or posy#(x) < -300 then life(x) = 0
inuse(x) = 0
hide object x + 500
endif
next x
remend
 
loop
/trunk/_private/Code Tests/Blood/XTraBlood.bmp
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Added: svn:mime-type
+application/octet-stream
\ No newline at end of property
/trunk/_private/Code Tests/Blood/blood.bmp
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Added: svn:mime-type
+application/octet-stream
\ No newline at end of property
/trunk/_private/Code Tests/Clock/Application.exe
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Added: svn:mime-type
+application/octet-stream
\ No newline at end of property
/trunk/_private/Code Tests/Clock/Untitled1.BAK
0,0 → 1,82
Rem Project: Dark Basic Pro Project
Rem Created: Sunday, August 23, 2015
 
Rem ***** Main Source File *****
 
// Konfiguration
#constant framerate 30
 
sync on
sync rate framerate
 
set text font "arial" : set text size 30 : set text transparent
 
 
print "hallo"
sync
 
rem Level einlesen
open to read 1, "config.txt"
clockSpeedFactor = fileReadInt(1)
clockBlinksPerSecond = fileReadInt(1)
clockShowSeconds = fileReadInt(1)
close file 1
 
 
 
// Session variables
clockTickCounter=0
clockCurrentMidDot=0
clockSecs=0
 
do
ticksPerSecond = framerate
if mod(clockTickCounter*clockBlinksPerSecond,ticksPerSecond) = 0
clockCurrentMidDot = 1 - clockCurrentMidDot
gosub printClock
endif
if mod(clockTickCounter*clockSpeedFactor,ticksPerSecond) = 0
gosub printClock
clockSecs = clockSecs + 1
endif
 
clockTickCounter = clockTickCounter + 1
 
sync
LOOP
 
printclock:
cls
if clockCurrentMidDot = 0
middle$ = " "
else
middle$ = ":"
endif
min = clockSecs/60
hours = min/60
if clockShowSeconds
secsText$ = middle$+TwoDigit$(mod(clockSecs,60))
else
secsText$ = ""
endif
print TwoDigit$(mod(hours,24)), middle$, TwoDigit$(mod(min,60)), secsText$
return
 
function TwoDigit$(value)
if value < 10
ret$ = "0"+STR$(value)
else
ret$ = STR$(value)
ENDIF
ENDFUNCTION ret$
 
function mod(num,modulus)
value=num-((num/modulus)*modulus)
endfunction value
 
function fileReadInt(fileNum)
read string 1, s$
ret=val(s$)
ENDFUNCTION ret
/trunk/_private/Code Tests/Clock/Untitled1.dba
0,0 → 1,78
Rem Project: Dark Basic Pro Project
Rem Created: Sunday, August 23, 2015
 
Rem ***** Main Source File *****
 
// Konfiguration
#constant framerate 30
 
sync on
sync rate framerate
 
set text font "arial" : set text size 30 : set text transparent
 
 
open to read 1, "config.txt"
clockSpeedFactor = fileReadInt(1)
clockBlinksPerSecond = fileReadInt(1)
clockShowSeconds = fileReadInt(1)
close file 1
 
 
 
// Session variables
clockTickCounter=0
clockCurrentMidDot=0
clockSecs=0
 
do
ticksPerSecond = framerate
if mod(clockTickCounter*clockBlinksPerSecond,ticksPerSecond) = 0
clockCurrentMidDot = 1 - clockCurrentMidDot
gosub printClock
endif
if mod(clockTickCounter*clockSpeedFactor,ticksPerSecond) = 0
gosub printClock
clockSecs = clockSecs + 1
endif
 
clockTickCounter = clockTickCounter + 1
 
sync
LOOP
 
printclock:
cls
if clockCurrentMidDot = 0
middle$ = " "
else
middle$ = ":"
endif
min = clockSecs/60
hours = min/60
if clockShowSeconds
secsText$ = middle$+TwoDigit$(mod(clockSecs,60))
else
secsText$ = ""
endif
print TwoDigit$(mod(hours,24)), middle$, TwoDigit$(mod(min,60)), secsText$
return
 
function TwoDigit$(value)
if value < 10
ret$ = "0"+STR$(value)
else
ret$ = STR$(value)
ENDIF
ENDFUNCTION ret$
 
function mod(num,modulus)
value=num-((num/modulus)*modulus)
endfunction value
 
function fileReadInt(fileNum)
read string 1, s$
ret=val(s$)
ENDFUNCTION ret
/trunk/_private/Code Tests/Clock/clock.dbpro
0,0 → 1,68
; **** Dark BASIC Professional Project File ****
; **** Written by Synergy Editor ****
version=DBP1.00
project name=clock
 
; **** source file information ****
main=Untitled1.dba
LineMain=5
 
; **** Executable Information ***
; build types: exe, media, installer, alone
executable=Application.exe
build type=exe
; ** Media file compression **
compression=NO
 
; ** Media file encryption **
encryption=NO
; ** Display the card options screen window? **
card options window=NO
 
; **** debugger information ****
; If the editor sets this to yes, it is running in debug mode
CLI=NO
CommandLineArguments=
 
; **** display mode information ****
app title=Dark Basic Pro Project
 
; graphics mode options: fullscreen, window, desktop, fulldesktop, hidden
graphics mode=window
fullscreen resolution=640x480x32
 
; arbitrary sizes are valid for windowed mode
window resolution=640x480
 
; **** External Files Information ****
 
; **** Media ****
; Example entries: media1=graphics\*.jpg
media root path=C:\software_old\dbpro\Projects\Clock\
 
; **** Icons ****
 
; **** Cursors ****
 
; **** Version Info ****
VerComments=
VerCompany=
VerFileDesc=
VerFileNumber=v1.0
VerInternal=v1.0
VerCopyright=
VerTrademark=
VerFilename=
VerProduct=
VerProductNumber=v1.0
 
; **** To Do ****
 
; **** Comments ****
comments1=
 
; **** Advanced (setup.ini) configuration ****
RemoveSafetyCode=NO
SafeArrays=YES
LocalTempFolder=NO
ExternaliseDLLS=NO
/trunk/_private/Code Tests/Clock/config.txt
0,0 → 1,3
1 : clockSpeedFactor
2 : clockBlinksPerSecond
1 : clockShowSeconds
/trunk/_private/Code Tests/DynVideo/Video.txt
0,0 → 1,15
do
 
rem Video...
remstart
if started = 0
for i = 0 to 500 step 5
Y# = Get ground height(1, X#, Z#) + (600 - i)
Position Camera X# + i*2, Y#, Z# + i*2
sync
next i
started = 1
endif
remend
 
loop
/trunk/_private/Code Tests/Jump/Application.exe
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Added: svn:mime-type
+application/octet-stream
\ No newline at end of property
/trunk/_private/Code Tests/Jump/Jump.dbpro
0,0 → 1,68
; **** Dark BASIC Professional Project File ****
; **** Written by Synergy Editor ****
version=DBP1.00
project name=Jump
 
; **** source file information ****
main=Untitled1.dba
LineMain=0
 
; **** Executable Information ***
; build types: exe, media, installer, alone
executable=Application.exe
build type=exe
; ** Media file compression **
compression=NO
 
; ** Media file encryption **
encryption=NO
; ** Display the card options screen window? **
card options window=NO
 
; **** debugger information ****
; If the editor sets this to yes, it is running in debug mode
CLI=NO
CommandLineArguments=
 
; **** display mode information ****
app title=Dark Basic Pro Project
 
; graphics mode options: fullscreen, window, desktop, fulldesktop, hidden
graphics mode=window
fullscreen resolution=640x480x32
 
; arbitrary sizes are valid for windowed mode
window resolution=640x480
 
; **** External Files Information ****
 
; **** Media ****
; Example entries: media1=graphics\*.jpg
media root path=D:\tdn\_private\CodeTests\Jump\
 
; **** Icons ****
 
; **** Cursors ****
 
; **** Version Info ****
VerComments=
VerCompany=
VerFileDesc=
VerFileNumber=
VerInternal=
VerCopyright=
VerTrademark=
VerFilename=
VerProduct=
VerProductNumber=v1.0
 
; **** To Do ****
 
; **** Comments ****
comments1=
 
; **** Advanced (setup.ini) configuration ****
RemoveSafetyCode=NO
SafeArrays=YES
LocalTempFolder=NO
ExternaliseDLLS=NO
/trunk/_private/Code Tests/Jump/Untitled1.BAK
0,0 → 1,61
Rem Setup sync
Sync On
Sync Rate 30
 
Rem Create matrix
Make Matrix 1,2000,2000,50,50
 
Rem Position Camera above the matrix
Position Camera 0,1000,0
 
JumpKeyStatePrev = 0
 
positionY = 175.0
velocityY = 0.0
gravity = 1
onGround = 1
 
Do
JumpKeyStateNow=leftkey()
if (JumpKeyStatePrev=0) and (JumpKeyStateNow=1)
gosub startJump
ENDIF
 
if (JumpKeyStatePrev=1) and (JumpKeyStateNow=0)
gosub endJump
ENDIF
 
JumpKeyStatePrev = JumpKeyStateNow
 
 
gosub JumpUpdate
position camera 0, positionY, 0
 
Sync
Loop
 
StartJump:
if onGround=1
velocityY = 25.0
onGround = 0
endif
return
 
EndJump:
if velocityY > 6.0 then velocityY = 6.0
return
 
JumpUpdate:
dec velocityY, gravity
inc positionY, velocityY
if positionY < 175.0
positionY = 175.0
velocityY = 0.0
onGround = 1
endif
return
 
 
 
/trunk/_private/Code Tests/Jump/Untitled1.dba
0,0 → 1,61
Rem Setup sync
Sync On
Sync Rate 30
 
Rem Create matrix
Make Matrix 1,2000,2000,50,50
 
Rem Position Camera above the matrix
Position Camera 0,1000,0
 
JumpKeyStatePrev = 0
 
positionY = 175.0
velocityY = 0.0
gravity = 1
onGround = 1
 
Do
JumpKeyStateNow=leftkey()
if (JumpKeyStatePrev=0) and (JumpKeyStateNow=1)
gosub PressJumpKey
ENDIF
 
if (JumpKeyStatePrev=1) and (JumpKeyStateNow=0)
gosub ReleaseJumpKey
ENDIF
 
JumpKeyStatePrev = JumpKeyStateNow
 
 
gosub JumpUpdate
position camera 0, positionY, 0
 
Sync
Loop
 
PressJumpKey:
if onGround=1
velocityY = 25.0
onGround = 0
endif
return
 
ReleaseJumpKey:
if velocityY > 6.0 then velocityY = 6.0
return
 
JumpUpdate:
dec velocityY, gravity
inc positionY, velocityY
if positionY < 175.0
positionY = 175.0
velocityY = 0.0
onGround = 1
endif
return
 
 
 
/trunk/_private/Code Tests/LevelRead/Level.txt
0,0 → 1,12
rem Level einlesen
remstart
open to read 1, "zone\lev001.map"
while file end(1) = 0
read string 1, eingelesen$
rem Baum
if eingelesen$ = "Tree"
rem Nix
endif
endwhile
close file 1
remend
/trunk/_private/Code Tests/Particles/Application.exe
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Added: svn:mime-type
+application/octet-stream
\ No newline at end of property
/trunk/_private/Code Tests/Particles/Particles.dbpro
0,0 → 1,68
; **** Dark BASIC Professional Project File ****
; **** Written by Synergy Editor ****
version=DBP1.00
project name=Particles
 
; **** source file information ****
main=Untitled1.dba
LineMain=29
 
; **** Executable Information ***
; build types: exe, media, installer, alone
executable=Application.exe
build type=exe
; ** Media file compression **
compression=NO
 
; ** Media file encryption **
encryption=NO
; ** Display the card options screen window? **
card options window=NO
 
; **** debugger information ****
; If the editor sets this to yes, it is running in debug mode
CLI=NO
CommandLineArguments=
 
; **** display mode information ****
app title=Dark Basic Pro Project
 
; graphics mode options: fullscreen, window, desktop, fulldesktop, hidden
graphics mode=window
fullscreen resolution=640x480x32
 
; arbitrary sizes are valid for windowed mode
window resolution=640x480
 
; **** External Files Information ****
 
; **** Media ****
; Example entries: media1=graphics\*.jpg
media root path=D:\tdn\_private\CodeTests\Particles\
 
; **** Icons ****
 
; **** Cursors ****
 
; **** Version Info ****
VerComments=
VerCompany=
VerFileDesc=
VerFileNumber=
VerInternal=
VerCopyright=
VerTrademark=
VerFilename=
VerProduct=
VerProductNumber=v1.0
 
; **** To Do ****
 
; **** Comments ****
comments1=
 
; **** Advanced (setup.ini) configuration ****
RemoveSafetyCode=NO
SafeArrays=YES
LocalTempFolder=NO
ExternaliseDLLS=NO
/trunk/_private/Code Tests/Particles/Untitled1.BAK
0,0 → 1,127
rem https://forum.thegamecreators.com/thread/160210#msg1886513
 
// Screen settings
sync on
sync rate 60
autocam off
 
#constant SPREAD1_MAX 10
#constant SPREAD2_MAX 15
 
gosub _setup_particles
// Main loop
do
// Check when SPACE is pressed
if spacekey() = 1 and keySP = 0
gosub _splat_blood
endif
keySP = spacekey()
 
gosub _handle_blood
loop
 
// ---------------------
 
_setup_particles:
// Make 100 particle objects
particleIndex = 0
#constant PARTICLEMAX = 100
dim particle(PARTICLEMAX) as particleType
for i = 1 to PARTICLEMAX
make object plain i, 2, 2
color object i, rgb(128, 0, 0)
exclude object on i
next i
return
 
_handle_blood:
// Update particles
for i = 1 to PARTICLEMAX
UpdateParticle(i)
next i
// Update screen
sync
return
 
_splat_blood:
yoff = rnd(SPREAD1_MAX*2)-SPREAD1_MAX;
 
// Activate blood particles around box
for i = 1 to PARTICLEMAX
// The angle particles should fly
yAng# = 90+rnd(SPREAD2_MAX*2)-SPREAD2_MAX+yoff
 
// Calculate directions
xSpeed# = cos(yAng#)
zSpeed# = sin(yAng#)
// Calculate speeds
xSpeed# = xSpeed# * (rnd(20)/5.0)
ySpeed# = ((rnd(20)-rnd(20))/10.0)
zSpeed# = zSpeed# * (rnd(20)/5.0)
// Activate particle
x# = camera position x()
y# = camera position y()
z# = camera position z()
particleIndex = ActivateParticle(particleIndex, 30+rnd(30), x#, y#, z#, xSpeed#, ySpeed#, zSpeed#)
next i
return
// Activate the specified particle and give it an initial position/velocity
function ActivateParticle(i, life, x#, y#, z#, xSpeed#, ySpeed#, zSpeed#)
// Cycle through the particle objects to use
inc i
if i > PARTICLEMAX then dec i, PARTICLEMAX
// Set particle variables
particle(i).life = life
particle(i).x = x#
particle(i).y = y#
particle(i).z = z#
particle(i).xSpeed = xSpeed#
particle(i).ySpeed = ySpeed#
particle(i).zSpeed = zSpeed#
// Show particle object
exclude object off i
endfunction i
// Update positioning for specified particle
function UpdateParticle(i)
// Only update particles that are alive
if particle(i).life > 0
// Apply gravity
dec particle(i).ySpeed, 0.098
// Move the particle
inc particle(i).x, particle(i).xSpeed
inc particle(i).y, particle(i).ySpeed
inc particle(i).z, particle(i).zSpeed
// Position particle
position object i, particle(i).x, particle(i).y, particle(i).z
point object i, camera position x(), camera position y(), camera position z()
// Lower particle's life
dec particle(i).life
// Hide particles when they die
if particle(i).life <= 0 then exclude object on i
endif
endfunction
// Data type used by particles
type particleType
life as integer // Remaining life of particle (0=Dead)
x as float // Position
y as float // ...
z as float // ...
xSpeed as float // Velocity
ySpeed as float // ...
zSpeed as float // ...
endtype
/trunk/_private/Code Tests/Particles/Untitled1.dba
0,0 → 1,127
rem https://forum.thegamecreators.com/thread/160210#msg1886513 , modified
 
// Screen settings
sync on
sync rate 60
autocam off
 
#constant SPREAD1_MAX 10
#constant SPREAD2_MAX 15
 
gosub _setup_particles
// Main loop
do
// Check when SPACE is pressed
if spacekey() = 1 and keySP = 0
gosub _splat_blood
endif
keySP = spacekey()
 
gosub _handle_blood
loop
 
// ---------------------
 
_setup_particles:
// Make 100 particle objects
particleIndex = 0
#constant PARTICLEMAX = 100
dim particle(PARTICLEMAX) as particleType
for i = 1 to PARTICLEMAX
make object plain i, 2, 2
color object i, rgb(128, 0, 0)
exclude object on i
next i
return
 
_handle_blood:
// Update particles
for i = 1 to PARTICLEMAX
UpdateParticle(i)
next i
// Update screen
sync
return
 
_splat_blood:
yoff = rnd(SPREAD1_MAX*2)-SPREAD1_MAX;
 
// Activate blood particles around box
for i = 1 to PARTICLEMAX
// The angle particles should fly
yAng# = 90+rnd(SPREAD2_MAX*2)-SPREAD2_MAX+yoff
 
// Calculate directions
xSpeed# = cos(yAng#)
zSpeed# = sin(yAng#)
// Calculate speeds
xSpeed# = xSpeed# * (rnd(20)/5.0)
ySpeed# = ((rnd(20)-rnd(20))/10.0)
zSpeed# = zSpeed# * (rnd(20)/5.0)
// Activate particle
x# = camera position x()
y# = camera position y()
z# = camera position z()
particleIndex = ActivateParticle(particleIndex, 30+rnd(30), x#, y#, z#, xSpeed#, ySpeed#, zSpeed#)
next i
return
// Activate the specified particle and give it an initial position/velocity
function ActivateParticle(i, life, x#, y#, z#, xSpeed#, ySpeed#, zSpeed#)
// Cycle through the particle objects to use
inc i
if i > PARTICLEMAX then dec i, PARTICLEMAX
// Set particle variables
particle(i).life = life
particle(i).x = x#
particle(i).y = y#
particle(i).z = z#
particle(i).xSpeed = xSpeed#
particle(i).ySpeed = ySpeed#
particle(i).zSpeed = zSpeed#
// Show particle object
exclude object off i
endfunction i
// Update positioning for specified particle
function UpdateParticle(i)
// Only update particles that are alive
if particle(i).life > 0
// Apply gravity
dec particle(i).ySpeed, 0.098
// Move the particle
inc particle(i).x, particle(i).xSpeed
inc particle(i).y, particle(i).ySpeed
inc particle(i).z, particle(i).zSpeed
// Position particle
position object i, particle(i).x, particle(i).y, particle(i).z
point object i, camera position x(), camera position y(), camera position z()
// Lower particle's life
dec particle(i).life
// Hide particles when they die
if particle(i).life <= 0 then exclude object on i
endif
endfunction
// Data type used by particles
type particleType
life as integer // Remaining life of particle (0=Dead)
x as float // Position
y as float // ...
z as float // ...
xSpeed as float // Velocity
ySpeed as float // ...
zSpeed as float // ...
endtype
/trunk/_private/Code Tests/Scorpion Walking/room.dba
0,0 → 1,808
Rem * Title : The Room Demo
Rem * Author : DBS-LB
Rem * Date : 1st September 99
rem ********************************************
rem * ROOM *
rem ********************************************
rem * AUTHOR: Lee Bamber DATE: 1st Sep 1999 *
rem ********************************************
 
rem Setup environment
hide mouse
autocam off
sync on
 
rem Set up Scene
setup_room()
 
rem Activate forcefeedback
forceactive=setup_forcefeedback()
 
rem Set up Data
gosub _setupglobals
 
rem Init player position
a#=90.0
x#=150.0
 
rem Begin main loop
backdrop off
do
 
rem Handle Control Keys
mainaction=0 : subaction=0
if upkey()=1 then mainaction=1
if downkey()=1 then mainaction=2
if leftkey()=1 then subaction=3 : a#=wrapvalue(a#-6.0)
if rightkey()=1 then subaction=4 : a#=wrapvalue(a#+6.0)
 
rem Handle Control Stick
if control device y()<-500 then mainaction=1
if control device y()>500 then mainaction=2
if control device x()<-300 then subaction=3 : a#=wrapvalue(a#-6.0)
if control device x()>300 then subaction=4 : a#=wrapvalue(a#+6.0)
 
rem Handle Player Position
s#=handle_player_speed(s#,mainaction)
if mainaction>=1 and mainaction<=4
 
rem Update Player position
oldx#=x#
oldz#=z#
if mainaction=1
x#=newxvalue(x#,a#,s#)
z#=newzvalue(z#,a#,s#)
endif
if mainaction=2
x#=newxvalue(x#,a#,s#*-1.0)
z#=newzvalue(z#,a#,s#*-1.0)
endif
 
rem Make sure player not colliding with room (obj1)
position object 102,x#,-150,z#
if object collision(102,5)=1
position object 102,x#,-150,oldz#
if object collision(102,5)=0
z#=oldz#
else
position object 102,oldx#,-150,z#
if object collision(102,5)=0
x#=oldx#
else
x#=oldx#
z#=oldz#
endif
endif
endif
 
endif
 
rem Generate ripples when move
if mainaction>0 or subaction>0 then gosub _make_ripple
 
rem Handle Player
handle_player(x#,z#,a#,mainaction,subaction)
handle_camera(x#,z#,a#)
 
rem Handle Misc Effects
handle_player_shadow(x#,z#,a#)
handle_effects()
gosub _handle_bouncer
gosub _handle_rainforce
gosub _handle_face_fading
gosub _handle_drips
gosub _handle_facedecals
gosub _handle_ambience
gosub _handle_ripple_control
 
rem Update screen
sync
 
loop
 
rem Subroutines
_setupglobals:
 
dim ripple#(10)
for r=1 to 10 : ripple#(r)=0.0 : next r
 
dim drip(3)
for d=1 to 3 : drip(d)=0 : next d
 
return
 
_handle_bouncer:
 
rem scroll variable value
wh#=wrapvalue(wh#+8.0)
 
rem trigger bounce
position object 102,x#,-300,z#
col=object collision(21,0)
if col=102
by#=3.0+(s#/5.0)
ix#=(object position x(21)-x#)/((35.0-s#)/1.5)
iz#=(object position z(21)-z#)/((35.0-s#)/1.5)
benergy=5
play sound 3
set sound volume 3,95-(benergy*2)
endif
if col=5
ba#=wrapvalue(atanfull(bx#,bz#)+180.0)
is#=sqrt((ix#*ix#)+(iz#*iz#))/1.5
ix#=sin(ba#)*is#
iz#=cos(ba#)*is#
by#=by#+2.0
benergy=benergy+1
play sound 3
vol=95-(benergy*2)
if vol<1 then vol=0
if vol>100 then vol=100
set sound volume 3,vol
endif
 
rem manage bounce
bx#=object position x(21)
bz#=object position z(21)
if benergy>0
bx#=bx#+ix#
bz#=bz#+iz#
ix#=ix#*0.95
iz#=iz#*0.95
position object 21,bx#,object position y(21)+by#,bz#
position object 22,bx#,-280.0,bz#
position sound 3,bx#,0,bz#
by#=by#-1.0
if by#<((benergy*2.0)*-1.0) then by#=((benergy*2.0)*-1.0)
if object position y(21)<-250.0
by#=(by#*0.75)*-1.0
benergy=benergy-1
play sound 3
svol=95-(benergy*2)
if svol<0 then svol=0
if svol>100 then svol=100
set sound volume 3,svol
if benergy=0
bfloat#=object position y(21)
endif
endif
else
diff#=((-250+(cos(wh#)*9.0))-bfloat#)/12.0
bfloat#=bfloat#+diff#
position object 21,bx#,bfloat#,bz#
position object 22,bx#,-280.0,bz#
by#=0.0
endif
 
rem ripple from ball (9)
r=9
if ripple#(r)=0.0 and object position y(21)<-210.0
position object 10+r,bx#,-225,bz#
texture object 10+r,17
show object 10+r
ripple#(r)=1.0
endif
 
rem scale ball based on vertical inertia
diff#=(by#-boing#)/6.0
boing#=boing#+diff#
scale object 21,100,90+(boing#*4.0),100
scale object 22,90-(boing#*2.0)+(cos(wh#)*9.0),90-(boing#*2.0)+(cos(wh#)*9.0),100
`
return
 
_handle_rainforce:
 
rem rain force
dist#=sqrt((x#*x#)+(z#*z#))
if forceactive=1 and dist#<400
force angle 10-((9.0/400.0)*dist#),rnd(359),5
endif
 
return
 
_handle_face_fading:
 
rem handle wrapping rotation
sl#=wrapvalue(sl#+16.0)
rotate object 203,90,0,sl#
 
rem handle in-out fading
if lf=0
fd=fd+1
fade object 203,80
if fd=10 then lf=1
else
fd=fd-1
fade object 203,125
if fd=0 then lf=0
endif
 
rem twirl force
dx#=x#-800.0
dist#=sqrt((dx#*dx#)+(z#*z#))
if forceactive=1 and dist#<200.0
str#=((99.0/200.0)*dist#)
force angle 100-str#,wrapvalue(270.0-sl#),50
a#=wrapvalue(a#-5.0*(str#/99.0))
endif
 
rem Proximity to face opens door, else closes it
if dist#<400.0
position object 36,-1290,object position y(36)+5.0,0
if object position y(36)>500.0
position object 36,-1290,500.0,0
stop sound 4 : chl=0
else
if chl=0 then loop sound 4 : set sound speed 4,12000 : chl=1
endif
else
position object 36,-1290,object position y(36)-10.0,0
if object position y(36)<160.0
position object 36,-1290,160.0,0
stop sound 4 : chl=0
else
if chl=0 then loop sound 4 : set sound speed 4,15000 : chl=1
endif
endif
 
return
 
_handle_drips:
 
rem loop through all drip elements
for d=1 to 3
if drip(d)=0 and rnd(20)=0
 
rem start drip
drip(d)=1
position object 7+d,-700+rnd(1400),1000,-700+rnd(1400)
show object 7+d
 
else
if drip(d)=1
position object 7+d,object position x(7+d),object position y(7+d)-100,object position z(7+d)
if object position y(7+d)<-300
 
rem end drip
drip(d)=0
hide object 7+d
 
rem ripple from drips (6-8)
r=5+d
position object 10+r,object position x(7+d),-225,object position z(7+d)
texture object 10+r,17
show object 10+r
ripple#(r)=1.0
 
endif
endif
endif
next d
 
return
 
_handle_facedecals:
 
rem Point faces towards camera position
dx#=camera position x()
dz#=camera position z()
fa#=wrapvalue(atanfull(dx#,dz#)+180.0)
yrotate object 7,wrapvalue(fa#)
 
return
 
_handle_ambience:
 
rem controls strength of shadow
dist#=sqrt(abs(x#*x#)+abs(z#*z#))
set ambient light 20+(dist#/40.0)
 
return
 
_make_ripple:
 
rem spare ripple object?
r=1 : while ripple#(r)>0 and r<5 : r=r+1 : endwhile
if r<=5
oz#=-48.0
ox#=-70.0
oz#=oz#+(rnd(2)*50.0)
ox#=ox#+(rnd(1)*140.0)
tx#=(cos(a#)*ox#)+(sin(a#)*oz#)
tz#=(cos(a#)*oz#)-(sin(a#)*ox#)
rx#=x#+tx#
rz#=z#+tz#
position object 10+r,rx#,-225,rz#
yrotate object 10+r,a#
texture object 10+r,17
show object 10+r
ripple#(r)=1.0
endif
 
return
 
_handle_ripple_control:
 
rem loops through all ripple elements
for r=1 to 10
if object visible(10+r)=1
texture object 10+r,16+ripple#(r)
ripple#(r)=ripple#(r)+0.5
if ripple#(r)>=4.4
ripple#(r)=0.0
hide object 10+r
endif
endif
 
position object 10+r,object position x(10+r),-250+(cos(wh#)*9.0),object position z(10+r)
 
next r
 
return
 
rem Functions
function handle_player_speed(speed#,actionmode)
 
rem Handle Speed control
if actionmode=1 or actionmode=2
speed#=speed#+5.0
if actionmode=1 and speed#>30.0 then speed#=30.0
if actionmode=2 and speed#>30.0 then speed#=30.0
else
speed#=speed#-5.0
if speed#<0.0 then speed#=0.0
endif
 
endfunction speed#
 
function handle_player(px#,pz#,pa#,actionmode,subaction)
 
rem Handle player animation
handle_player_anim(actionmode,subaction)
 
rem Set Player Position and angle
position object 101,px#,0,pz#
yrotate object 101,pa#
 
rem Position listener at player
position listener px#/100.0,0,pz#/100.0
rotate listener 0,wrapvalue(360.0-pa#),0
 
rem Set players collision sphere
position object 102,px#,-150,pz#
 
endfunction
 
function handle_player_anim(actionmode,subactionmode)
 
if smoothing=0
if actionmode>0 or subactionmode>0
 
rem Switch to Walk
if object frame(101)<100 or object frame(101)>115
start=100
newanim=2
smoothing=4
loop sound 2
set sound speed 2,8500+rnd(1500)
endif
if rnd(4)=0 then set sound speed 2,8500+rnd(1500)
 
else
 
rem Switch to Idle
if object frame(101)>25
start=0
newanim=1
smoothing=4
endif
 
endif
 
rem Activate smoothing
if smoothing>0
 
rem Begin smoothing transition
stop object 101
set object interpolation 101,25
set object frame 101,start
 
rem Duplicate for shadow
stop object 4
set object interpolation 4,25
set object frame 4,start
 
endif
endif
 
rem Switch to new animation
if newanim>0
if smoothing=0
 
rem Trigger New Anim
if newanim=1 then length=20 : speed=10
if newanim=2 then length=15 : speed=50
 
rem Set Animation
set object interpolation 101,100
set object frame 101,start
loop object 101,start,start+length
set object speed 101,speed
 
rem Duplicate for shadow
set object interpolation 4,100
set object frame 4,start
loop object 4,start,start+length
set object speed 4,speed
 
rem Choose sound
if newanim=2
loop sound 2
else
play sound 2
set sound speed 2,8400
endif
 
rem Reset flag
newanim=0
 
else
smoothing=smoothing-1
endif
endif
 
endfunction
 
function handle_camera(px#,pz#,pa#)
 
rem Calc camera position and angle
ca#=wrapvalue(pa#+180.0)
cx#=newxvalue(px#,ca#,scdis#)
cz#=newzvalue(pz#,ca#,scdis#)
 
rem Record camera coords
oldx#=scx#
oldz#=scz#
 
rem Calc smoothed camera position and angle
diff#=(scx#-cx#)/6.0
scx#=scx#-diff#
diff#=(scz#-cz#)/6.0
scz#=scz#-diff#
sca#=curveangle(pa#,sca#,6.0)
 
rem Restrict camera if collide with walls
position object 103,scx#,-50,scz#
if object collision(103,5)=1
if object hit(103,5)=1 then cdis#=100.0
position object 103,scx#,-50,oldz#
if object collision(103,5)=0
scx#=oldx#
else
position object 103,oldx#,-50,scz#
if object collision(103,5)=0
scz#=oldz#
else
scx#=oldx#
scz#=oldz#
endif
endif
else
if cdis#<500.0
cdis#=cdis#+50.0
if cdis#>500.0 then cdis#=500.0
endif
endif
 
rem Smooth camera distance for next cycle
diff#=(scdis#-cdis#)/6.0
scdis#=scdis#-diff#
 
rem Set camera
position camera scx#,-50,scz#
point camera object position x(101),object position y(101)-100,object position z(101)
 
endfunction
 
function handle_effects()
 
rem Scroll rain texture
scroll object texture 2,0,-0.02
 
rem Simple rotate of water
wr#=wrapvalue(wr#+1.0)
yrotate object 3,wr#
wh#=wrapvalue(wh#+8.0)
position object 3,0,-250+(cos(wh#)*9.0),0
 
endfunction
 
function handle_player_shadow(px#,pz#,pa#)
 
rem Shadow follows player
position object 4,px#,-280.0,pz#
yrotate object 4,pa#
 
endfunction
 
function setup_forcefeedback()
 
rem Check for FF device
perform checklist for control devices
if checklist quantity()>0
for f=1 to checklist quantity()
if checklist value a(f)=1
set control device checklist string$(f)
force water effect 100,0
forceactive=1
endif
next f
else
forceactive=0
endif
 
endfunction forceactive
 
function setup_room()
 
rem Blacken Scene
if fog available()=1 then fog on : fog color 0 : fog distance 0
point camera 0,1000,0
set ambient light 0
 
rem Create bitmaps for room
load_image("bmp\floor.bmp",1)
load_image("bmp\roof.bmp",2)
load_image("bmp\wall1.bmp",3)
load_image("bmp\wall2.bmp",4)
load_image("bmp\wall3.bmp",5)
load_image("bmp\door.bmp",6)
load_image("bmp\portal.bmp",7)
 
rem Create special effects bitmaps
load_image("bmp\force.bmp",11)
load_image("bmp\water.bmp",12)
load_image("bmp\black.bmp",13)
` load_image("bmp\spray.bmp",14)
` load_image("bmp\spray.bmp",15)
load_image("bmp\ripple.bmp",16)
load_image("bmp\face.bmp",21)
` load_image("bmp\stattext.bmp",31)
load_image("bmp\shadow.bmp",32)
load_image("bmp\logo.bmp",33)
 
rem Create room (but hide the gate)
load object "obj\dome.x",1
set object collision off 1
texture limb 1,0,2
texture limb 1,1,2
texture limb 1,2,4
texture limb 1,3,3
texture limb 1,4,5
texture limb 1,5,5
texture limb 1,6,6
texture limb 1,7,4
hide limb 1,6
hide limb 1,8
 
rem Reload room (showing only the gate)
load object "obj\dome.x",200
set object collision off 200
set object 200,1,0,0
hide limb 200,1
hide limb 200,2
hide limb 200,3
hide limb 200,4
hide limb 200,5
hide limb 200,7
texture limb 200,6,6
hide limb 200,8
 
rem Create floor
make matrix 1,3200.0,2400.0,4,3
position matrix 1,-2000.0,-290.0,-1200.0
prepare matrix texture 1,1,2,2
set matrix tile 1,1,1,3
set matrix tile 1,3,1,2
set matrix tile 1,2,1,4
update matrix 1
 
rem Create Shaft of light
make object cone 2,300
scale object 2,200,800,200
position object 2,0,600,0
texture object 2,11
set object 2,1,0,0
ghost object on 2
set object collision off 2
if alphablending available()=0 then hide object 2
 
rem Create water on floor
make object plain 3,2900,2900
xrotate object 3,90
fix object pivot 3
texture object 3,12
ghost object on 3
set object collision off 3
 
rem Create Shadow for player
load object "obj\scorpidle.x",4
append object "obj\scorpwalk.x",4,100
yrotate object 4,180
fix object pivot 4
scale object 4,100,1,100
hide limb 4,1 : hide limb 4,2 : hide limb 4,3
hide limb 4,5 : hide limb 4,6 : hide limb 4,7
hide limb 4,12 : hide limb 4,13 : hide limb 4,14
hide limb 4,15 : hide limb 4,16 : hide limb 4,17
hide limb 4,18 : hide limb 4,19 : hide limb 4,20
texture object 4,13
set object collision off 4
 
rem Create collision walls
make object plain 5,1200,800
make mesh from object 1,5
position object 5,0,0,1200
for w=1 to 7 : add limb 5,w,1 : next w
w=1 : offset limb 5,w,-800,0,-350 : rotate limb 5,w,0,135,0
w=2 : offset limb 5,w,800,0,-350 : rotate limb 5,w,0,45,0
w=3 : offset limb 5,w,-1200,0,-1200 : rotate limb 5,w,0,270,0
w=4 : offset limb 5,w,1200,0,-1200 : rotate limb 5,w,0,90,0
w=5 : offset limb 5,w,-800,0,-2050 : rotate limb 5,w,0,45,0
w=6 : offset limb 5,w,800,0,-2050 : rotate limb 5,w,0,135,0
w=7 : offset limb 5,w,0,0,-2400 : rotate limb 5,w,0,180,0
hide object 5
 
rem Create Center Spray
make object cone 6,540
scale object 6,100,1,100
position object 6,0,-290,0
xrotate object 6,180
color object 6,rgb(235,235,255)
ghost object on 6
fade object 6,0
set object collision off 6
 
rem Create Logo
make object plain 7,400,300
texture object 7,33
position object 7,0,230,0
ghost object on 7
set object 7,1,0,1
set object collision off 7
 
rem Create drips
make object cylinder 8,2
scale object 8,100,1000,100
ghost object on 8
hide object 8
set object collision off 8
make object cylinder 9,2
scale object 9,100,1000,100
ghost object on 9
hide object 9
set object collision off 9
make object cylinder 10,2
scale object 10,100,1000,100
ghost object on 10
hide object 10
set object collision off 10
 
rem Create ripple objects
for r=1 to 10
make object plain 10+r,100,100
xrotate object 10+r,90
fix object pivot 10+r
ghost object on 10+r
set object 10+r,1,0,1
hide object 10+r
set object collision off 10+r
next r
 
rem Slightly rescale ball ripple
scale object 10+9,150,150,100
 
rem Create bouncing ball
make object sphere 21,100
position object 21,0,0,0
texture object 21,2
 
rem Create ball shadow
make object plain 22,100,100
xrotate object 22,90
fix object pivot 22
texture object 22,32
set object 22,1,0,0
set object collision off 22
 
rem Create Effective Door
make object plain 31,1000,1000
position object 31,-1400,100,0
yrotate object 31,90
texture object 31,3
fade object 31,0
set object collision off 31
make object plain 32,1000,1000
position object 32,-1320,100,900
yrotate object 32,100
texture object 32,3
set object collision off 32
make object plain 33,1000,1000
position object 33,-1320,100,-900
yrotate object 33,80
texture object 33,3
set object collision off 33
 
rem Create Door Portal
make object plain 36,1050,900
texture object 36,7
position object 36,-1290,100,0
set object 36,1,0,0
yrotate object 36,90
set object collision off 36
 
rem Create Character
load object "obj\scorpidle.x",101
append object "obj\scorpwalk.x",101,100
yrotate object 101,180
fix object pivot 101
loop object 101,0,20
hide limb 101,1
set object collision off 101
 
rem Collision Sphere for Character
make object sphere 102,300
scale object 102,100,60,100
hide object 102
 
rem Collision Sphere for Camera
make object sphere 103,150
hide object 103
 
rem Create spinning face
make object plain 203,400,400
position object 203,800,-280,0
texture object 203,21
ghost object on 203
xrotate object 203,90
set object collision off 203
 
rem Create ripple textures
create bitmap 2,256,64
paste image 16,0,0
get image 17,0,0,64,64
get image 18,64,0,64+64,64
get image 19,128,0,128+64,64
get image 20,192,0,192+64,64
delete bitmap 2
 
rem Create bitmap for effects (force)
create bitmap 2,256,256
set current bitmap 0
 
rem Create Sounds
load 3dsound "snd\rain.wav",1
position sound 1,0,10,0
set sound speed 1,3500
loop sound 1
load sound "snd\splash.wav",2 : set sound speed 2,7000 : set sound volume 2,85
load 3dsound "snd\bang.wav",3 : set sound volume 3,95
load 3dsound "snd\chain.wav",4 : set sound volume 4,90
position sound 4,-1200,0,0
 
rem Create Fog (show scene)
if fog available()=1 then fog on : fog color 0 : fog distance 3000
set ambient light 30
 
endfunction
 
function load_image(file$,imagenumber)
 
load bitmap file$,1
width=bitmap width(1)
height=bitmap height(1)
get image imagenumber,0,0,width,height
delete bitmap 1
 
endfunction
/trunk/_private/Code Tests/Text/Widmung.txt
0,0 → 1,57
remstart
Sync Rate 0
load music "music\darkness.mid", 1
loop music 1
load sound "sound\Type.wav", 1
lcd("The Dark Night...", 1, 10, 1, 1, 0)
sleep 500
lcd("Dies ist eine Beta. Das Spiel wird in den nächsten 5 Jahren", 1, 40, 0, 1, 0)
sleep 500
lcd("fertig sein. Benutzen Sie die Maus, um sich umzuschauen", 1, 55, 0, 1, 0)
sleep 500
lcd("und benutzen Sie die Pfeiltasten, um zu laufen. Mit der rechten", 1, 70, 0, 1, 0)
sleep 500
lcd("Maustaste springen Sie.", 1, 85, 0, 1, 0)
sleep 500
lcd("(C)Copyright 2001 - 2002 Daniel Marschall.", 1, 115, 1, 0, 0)
sleep 500
lcd("Alle Rechte vorbehalten!", 1, 130, 1, 0, 0)
sleep 500
lcd("Besuchen Sie meine Webseite!", 1, 160, 0, 0, 1)
sleep 500
lcd("http://www.d-m-home.de", 1, 175, 0, 0, 1)
sleep 500
lcd("Diese Version ist vom 6.9.2002.", 1, 205, 1, 1, 1)
sleep 5000
delete sound 1
delete music 1
remend
 
function lcd(rich$, x, y, r, g, b)
a = len(rich$) + 1
i = 0
s = 16
set text font "Courier"
repeat
sprite 1, s, y, 1
set cursor x * 8, y
x$ = mid$(rich$, x)
repeat
if r = 1 then ink rgb(i, 0, 0), 0
if g = 1 then ink rgb(0, i, 0), 0
if b = 1 then ink rgb(0, 0, i), 0
if r = 1 and g = 1 then ink rgb(i, i, 0), 0
if r = 1 and b = 1 then ink rgb(i, 0, i), 0
if g = 1 and b = 1 then ink rgb(0, i, i), 0
if b = 1 and g = 1 and b = 1 then ink rgb(i, i, i), 0
text x * 8, y, x$
inc i, 35
sync
until i => 255
inc x
inc s, 8
i = 0
play sound 1
until x = a
endfunction
 
/trunk/_private/Code Tests/Water/Wasser@Matrix.txt
0,0 → 1,11
rem Wasser
remstart
make matrix 2, 10000, 10000, 20, 20
load image "bitmap\GM01B02.bmp", 3
prepare matrix texture 2, 3, 1, 1
fill matrix 2, 0, 1
position matrix 2, 0, 100, 0
ghost matrix on 2
rem randomize matrix 2, 130
update matrix 2
remend
/trunk/_private/Code Tests/Wetter/Wetter.txt
0,0 → 1,77
rem Sound
load sound "sound\thunder.wav", 2
load sound "sound\thunder2.wav", 3
 
do
 
activate = 1
 
rem Wetter
if inkey$() = "3" and activate = 1 then Wetter$ = ""
if Wetter$ = ""
set ambient light 40
if fog available() = 1
fog on
fog distance 7500
fog color rgb(135, 119, 99)
endif
if sound exist(4) = 1
stop sound 4
delete sound 4
endif
endif
 
if inkey$() = "0" and activate = 1
Wetter$ = "day"
if fog available() = 1
Fog on
Fog distance 4000
Fog color RGB(128, 128, 128)
endif
Color Backdrop RGB(128, 128, 128)
Load sound "sound\crickets.wav", 4
Loop sound 4
endif
 
if inkey$() = "1" and activate = 1
Wetter$ = "thunder"
if fog available() = 1
Fog on
rem Nur wenn Lampe da: Fog distance 1000
Fog distance 500
Fog color RGB(0, 0, 0)
endif
Color Backdrop RGB(0, 0, 0)
Load sound "sound\rain.wav", 4
Loop sound 4
endif
 
if inkey$() = "2" and activate = 1
Wetter$ = "sun"
if fog available() = 1
Fog on
Fog distance 7000
Fog color RGB(255, 255, 255)
endif
Color Backdrop RGB(20, 150, 200)
Load sound "sound\river.wav", 4
Loop sound 4
endif
 
rem Donner
if wetter$ = "thunder"
if rnd(100) = 50
ink rgb(255, 0, 0), rgb(255, 255, 255)
cls
sync
if rnd(2) = 1
set sound pan 3, -5000 + rnd(10000)
play sound 3
else
set sound pan 2, -5000 + rnd(10000)
play sound 2
endif
endif
endif
 
loop
/trunk/_private/Code Tests/matrix_example.dba
0,0 → 1,54
sync on
hide mouse
`---------------
`create a matrix
`---------------
`the matrix will be 100 units square and be split up into 100 squares (10*10)
make matrix 1,100,100,10,10
`set the matrix heights
`I am going to use two for loops to do this
`the first loops through the xPoints, the second through the zPoints
for xPoint=0 to 10
for zPoint=0 to 10
`create a sinewave matrix
`I just made the following bit up and it looked nice
`you can just as easily use your own numbers/ math's to create terrain's
`you could also use a loop like this to read values you have saved from
`a text file created by an editor
height=(sin(xPoint*36)+cos(zPoint*36))*5
set matrix height 1,xPoint, zPoint, height
next zPoint
next xPoint
`----------------------
`set the matrix texture
`----------------------
`load matrix texture
load image "floor1.bmp",1
`prepare the matrix texture
prepare matrix texture 1, 1, 2,2
`loop through matrix tiles
for xTile=0 to 9
for zTile=0 to 9
`set the matrix tile texture
`the texture is a random value
set matrix tile 1,xTile,zTile,rnd(3)+1
next zTile
next xTile
`update the matrix after it has been changed
update matrix 1
`position the camera so that it has a good view
Position camera 50,50,-50
point camera 50,25,50
`main loop
do
`update the screen
sync
loop
/trunk/_private/Code Tests/zaxistest/Application.exe
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Added: svn:mime-type
+application/octet-stream
\ No newline at end of property
/trunk/_private/Code Tests/zaxistest/Standard Setup Sequence.BAK
0,0 → 1,19
rem Standard Setup Code
sync on : sync rate 0 :
color backdrop rgb(0,0,128) : hide mouse
set text font "arial" : set text size 12 : set text transparent
 
make object sphere 1,100
 
autocam on
 
do
x = object position x(1)
y = object position y(1)
z = object position z(1)+1
position object 1, x, y, z
 
sleep 100
 
sync
LOOP
/trunk/_private/Code Tests/zaxistest/Standard Setup Sequence.dba
0,0 → 1,19
rem Standard Setup Code
sync on : sync rate 0 :
color backdrop rgb(0,0,128) : hide mouse
set text font "arial" : set text size 12 : set text transparent
 
make object sphere 1,100
 
autocam on
 
do
x = object position x(1)+1
y = object position y(1)+1
z = object position z(1)+1
position object 1, x, y, z
 
sleep 100
 
sync
LOOP
/trunk/_private/Code Tests/zaxistest/zaxistest.dbpro
0,0 → 1,68
; **** Dark BASIC Professional Project File ****
; **** Written by Synergy Editor ****
version=DBP1.00
project name=zaxistest
 
; **** source file information ****
main=Standard Setup Sequence.dba
LineMain=10
 
; **** Executable Information ***
; build types: exe, media, installer, alone
executable=Application.exe
build type=exe
; ** Media file compression **
compression=NO
 
; ** Media file encryption **
encryption=NO
; ** Display the card options screen window? **
card options window=NO
 
; **** debugger information ****
; If the editor sets this to yes, it is running in debug mode
CLI=NO
CommandLineArguments=
 
; **** display mode information ****
app title=zaxistest
 
; graphics mode options: fullscreen, window, desktop, fulldesktop, hidden
graphics mode=window
fullscreen resolution=640x480x32
 
; arbitrary sizes are valid for windowed mode
window resolution=640x480
 
; **** External Files Information ****
 
; **** Media ****
; Example entries: media1=graphics\*.jpg
media root path=c:\software_old\dbpro\Projects\zaxistest\
 
; **** Icons ****
 
; **** Cursors ****
 
; **** Version Info ****
VerComments=
VerCompany=
VerFileDesc=
VerFileNumber=
VerInternal=
VerCopyright=
VerTrademark=
VerFilename=
VerProduct=
VerProductNumber=v1.0
 
; **** To Do ****
 
; **** Comments ****
comments1=
 
; **** Advanced (setup.ini) configuration ****
RemoveSafetyCode=NO
SafeArrays=YES
LocalTempFolder=NO
ExternaliseDLLS=NO