Function Collection - GameCreators Forum

Author

Message

Benji

18

Years of Service

User Offline

Joined: 17th Dec 2005

Location: Mount Doom

Posted: 8th Jul 2006 02:32 Edited at: 5th Oct 2006 23:47

Link

Someone was wanting a place to post your functions, well, here it is. Post any complete or wip function here, and with your permission, I might add it to a pack that i'll be makeing. Don't forget to post required media. Remember, if you post it up, I can put it in the pack, and It's Royalty Free to anyone who wants it. If you want your function to be withdrawn, I'll do it for you.

With each new version of the collection, I'll put it on my first post.

Post Away!

~Benji~

Visit my Airplane Engine thread in the WIP board.

Back to top

Profile PM

Zerk

17

Years of Service

User Offline

Joined: 13th May 2006

Location: Orbiting Jupiter

Posted: 8th Jul 2006 03:28 Edited at: 8th Jul 2006 03:56

Link

I'll start. A simple function to play a music file in your game. Call the function when wanted to change the music.

+ Code Snippet

function loadMusic(file as string)
 if file exist(file) = 0 then exitfunction
 if music exist(1) = 1
  delete music 1
 endif
 load music file, 1
 loop music 1
endfunction

I am putting myself to the fullest possible use, which is all I think that any conscious entity can ever hope to do. ~Hal-9000

Back to top

Profile PM Website

Zerk

17

Years of Service

User Offline

Joined: 13th May 2006

Location: Orbiting Jupiter

Posted: 8th Jul 2006 03:41 Edited at: 8th Jul 2006 03:42

Link

Why not... Have another useful one I use all the time. A token value function to return the value of a token. Great for making config files or parsing data.

+ Code Snippet

Usage:

s$ = "command=hi:World,t1:1,t2:5,msg:Hello"
data$ = getTokenValue(s$,2,"=")
hello$ = getTokenValue(getTokenValue(data$,4,","),2,":")
world$ = getTokenValue(getTokenValue(data$,1,","),2,":")

print hello$+" "+world$

Output:
  Hello World

+ Code Snippet

function getTokenValue(st as string, index as integer, parse as string)
 ret$ = ""
 is = 0
 if len(st) <= 0 then exitfunction ""
 if Instr(st,parse) = 0 then exitfunction st
 for s = 1 to len(st)
  if mid$(st, s) = parse
   inc is
   if is = index
    exitfunction ret$
   endif
   ret$ = ""
  else
   ret$ = ret$ + mid$(st, s)
  endif
 next s
endfunction ret$

I am putting myself to the fullest possible use, which is all I think that any conscious entity can ever hope to do. ~Hal-9000

Back to top

Profile PM Website

Benji

18

Years of Service

User Offline

Joined: 17th Dec 2005

Location: Mount Doom

Posted: 8th Jul 2006 03:41

Link

I'll have to test it later, I'm leaving now. I'll be back soon.

My Specs: Geforce 6200 128 MB.,3.0 GHZ Pentium 4 Processer, 512 MB Ram.

Back to top

Profile PM

Three Score

19

Years of Service

User Offline

Joined: 18th Jun 2004

Location: behind you

Posted: 8th Jul 2006 03:53 Edited at: 8th Jul 2006 03:56

Link

heres something
not sure if it works but anyway

+ Code Snippet

function x_copy(passive,source$,taget$)
rem x-copy 1.0
rem a copier designed without using any standard copy commands

`global source$
`global target$
if passive=1 then goto pas
start:
`source$="C:test.jpg"
`target$="C:test1233.jpg"
input "Source file: ",source$
if file exist(source$)=0
print "File does not exist"
goto start
endif
tar:
input "Target file: ",target$
if file exist(target$)=1
er12:
input "do you want to overwrite target file y/n: ",tmp$
if tmp$="y"
delete file target$
goto done1
endif
if tmp$="n"
print "please choose another file"
goto tar
endif
print "please type y for yes or n for no"
goto er12
endif
done1:
pas:
open to read 1,source$
open to write 2,target$
`b# = timer()
do
if file end(1)=1 then exit
copy_byte(1,2)
loop
`print "completed in "+str$((timer() - b#))+" millisecs"
`print "done"
`wait key
endfunction

function copy_byte(source,target)
read byte source,tmp
write byte target,tmp
endfunction

+ Code Snippet

function get_ending(file$)
ending as string
for z=1 to len(file$)
tmp$=mid$(file$,z)
if tmp$="."
dim temp$(32)
for i=1 to len(file$)-z
temp$(i)=mid$(file$,z+i)
next i
for i=1 to len(file$)-z
ending=ending+temp$(i)
next i
endif
next i
undim temp$()
endfunction ending

and that I know works

function xmsgbox(title$,msg$,msg2$,msg3$)
dim tmp$(1024)
line 300,100,700,100
line 300,100,700,100
line 700,100,700,300
line 300,100,300,300
line 300,300,700,300

line 300,120,700,120
if text width(title$)>350

for z=1 to 1024
if text width(title$)<=350 then exit
for i=1 to len(title$)-1
tmp$(i)=mid$(title$,i)
next i
tmp2$=""
for i=1 to len(title$)-1
tmp2$=tmp2$+tmp$(i)
next i
title$=tmp2$
next z

endif
text 310,105,title$

if text width(msg$)>350

for z=1 to 1024
if text width(msg$)<=350 then exit
for i=1 to len(msg$)-1
tmp$(i)=mid$(msg$,i)
next i
tmp2$=""
for i=1 to len(msg$)-1
tmp2$=tmp2$+tmp$(i)
next i
msg$=tmp2$
next z

endif
text 310,130,msg$

if text width(msg2$)>350

for z=1 to 1024
if text width(msg2$)<=350 then exit
for i=1 to len(msg2$)-1
tmp$(i)=mid$(msg2$,i)
next i
tmp2$=""
for i=1 to len(msg2$)-1
tmp2$=tmp2$+tmp$(i)
next i
msg2$=tmp2$
next z

endif
text 310,150,msg2$

if text width(msg3$)>350

for z=1 to 1024
if text width(msg3$)<=350 then exit
for i=1 to len(msg3$)-1
tmp$(i)=mid$(msg3$,i)
next i
tmp2$=""
for i=1 to len(msg3$)-1
tmp2$=tmp2$+tmp$(i)
next i
msg3$=tmp2$
next z

endif
text 310,170,msg3$

wait key
endfunction

+ Code Snippet

function xmsgbox(title$,msg$,msg2$,msg3$)
dim tmp$(1024)
line 300,100,700,100
line 300,100,700,100
line 700,100,700,300
line 300,100,300,300
line 300,300,700,300

line 300,120,700,120
if text width(title$)>350

for z=1 to 1024
if text width(title$)<=350 then exit
for i=1 to len(title$)-1
tmp$(i)=mid$(title$,i)
next i
tmp2$=""
for i=1 to len(title$)-1
tmp2$=tmp2$+tmp$(i)
next i
title$=tmp2$
next z

endif
text 310,105,title$

if text width(msg$)>350

for z=1 to 1024
if text width(msg$)<=350 then exit
for i=1 to len(msg$)-1
tmp$(i)=mid$(msg$,i)
next i
tmp2$=""
for i=1 to len(msg$)-1
tmp2$=tmp2$+tmp$(i)
next i
msg$=tmp2$
next z

endif
text 310,130,msg$

if text width(msg2$)>350

for z=1 to 1024
if text width(msg2$)<=350 then exit
for i=1 to len(msg2$)-1
tmp$(i)=mid$(msg2$,i)
next i
tmp2$=""
for i=1 to len(msg2$)-1
tmp2$=tmp2$+tmp$(i)
next i
msg2$=tmp2$
next z

endif
text 310,150,msg2$

if text width(msg3$)>350

for z=1 to 1024
if text width(msg3$)<=350 then exit
for i=1 to len(msg3$)-1
tmp$(i)=mid$(msg3$,i)
next i
tmp2$=""
for i=1 to len(msg3$)-1
tmp2$=tmp2$+tmp$(i)
next i
msg3$=tmp2$
next z

endif
text 310,170,msg3$







wait key
endfunction

not sure if that works, makes a little messagebox thingy

+ Code Snippet

function DisableX(window$)
hwnd as integer
hmnu as integer
  freedll=1 : while dll exist(freedll) : freedll=freedll+1 : endwhile

  load dll "user32.dll",freedll
  hwnd=call dll(freedll,"FindWindowA",0,"Test")
  hmnu=call dll(freedll,"GetSystemMenu",hwnd,0)
  call dll freedll,"ModifyMenuA",hmnu,6,1025,0,"Close"+chr$(9)+"Alt+F4"
  call dll freedll,"DrawMenuBar",hwnd
  delete dll freedll
endfunction

This isn't mine but it disables the close button on your window

JouleOS and friends
great thanks to http://galekus.com for FREE HOSTING!

Back to top

Profile PM Email Website

Sixty Squares

17

Years of Service

User Offline

Joined: 7th Jun 2006

Location: Somewhere in the world

Posted: 8th Jul 2006 04:25 Edited at: 8th Jul 2006 23:09

Link

Here's mine, if you want to see it. It's got lots of functions!
http://forum.thegamecreators.com/?m=forum_view&t=83452&b=6
Maybe we could merge them into one big thread?

My Functions: Mine
Post yours: Post

Back to top

Profile PM Email

Benji

18

Years of Service

User Offline

Joined: 17th Dec 2005

Location: Mount Doom

Posted: 8th Jul 2006 08:59 Edited at: 8th Jul 2006 09:00

Link

@ Three Score

I tried this code on you msgbox function and it returned 0s:

+ Code Snippet

xmsgbox(str$(MedalofhonorAirborne),str$(Crysis),str$(COD2),str$(bf1942))

What's your second function do? I hav'nt tested it yet.

For the last function you posted, what do you enter in the paramater? And you should ask the person who made it if you can post it before you do.

@ Sixty Squares

Nice functions

May I use the third person camera one? I know DBPro already has that command(set camera to follow) but yours works better.

About your idea, maybe we could join functions together once we've got a bunch.

I had my own idea. Is it possible to take these functions and make them into commands for DBPro? That way you wouldn't need to enter the function code into each program.

My Specs: Geforce 6200 128 MB.,3.0 GHZ Pentium 4 Processer, 512 MB Ram.

Back to top

Profile PM

Mickm

18

Years of Service

User Offline

Joined: 22nd Apr 2006

Location: Kingston, ON

Posted: 8th Jul 2006 09:40

Link

Here a quick list of functions that I like to use when creating objects,

FreeAnimation()
FreeBitmap()
FreeCamera()
FreeImage()
FreeLight()
FreeMatrix()
FreeMemblock()
FreeMesh()
FreeMusic()
FreeObject()
FreeParticles()
FreeSprite()
FreeSound()
FreeTerrain()

Function Code

FUNCTION FreeAnimation()
   iStart = 1
   DO
      IF ANIMATION EXIST(iStart) = 0
         EXIT
      ELSE
         INC iStart
      ENDIF
   LOOP
ENDFUNCTION iStart

FUNCTION FreeBitmap()
   iStart = 0
   DO
      IF BITMAP EXIST(iStart) = 0
         IF iStart > 32
            iStart = -1 `Illegal no Bitmaps left
         ENDIF

EXIT
      ELSE
         INC iStart
      ENDIF
   LOOP
ENDFUNCTION iStart

FUNCTION FreeCamera()
   iStart = 1
   DO
      IF CAMERA EXIST(iStart) = 0
         EXIT
      ELSE
         INC iStart
      ENDIF
   LOOP
ENDFUNCTION iStart

FUNCTION FreeImage()
   iStart = 1
   DO
      IF IMAGE EXIST(iStart) = 0
         EXIT
      ELSE
         INC iStart
      ENDIF
   LOOP
ENDFUNCTION iStart

FUNCTION FreeLight()
   iStart = 1
   DO
      IF LIGHT EXIST(iStart) = 0
         EXIT
      ELSE
         INC iStart
      ENDIF
   LOOP
ENDFUNCTION iStart

FUNCTION FreeMatrix()
   iStart = 1
   DO
      IF MATRIX EXIST(iStart) = 0
         EXIT
      ELSE
         INC iStart
      ENDIF
   LOOP
ENDFUNCTION iStart

FUNCTION FreeMemblock()
   iStart = 1
   DO
      IF MEMBLOCK EXIST(iStart) = 0
         EXIT
      ELSE
         INC iStart
      ENDIF
   LOOP
ENDFUNCTION iStart

FUNCTION FreeMesh()
   iStart = 1
   DO
      IF MESH EXIST(iStart) = 0
         EXIT
      ELSE
         INC iStart
      ENDIF
   LOOP
ENDFUNCTION iStart

FUNCTION FreeMusic()
   iStart = 1
   DO
      IF MUSIC EXIST(iStart) = 0
         EXIT
      ELSE
         INC iStart
      ENDIF
   LOOP
ENDFUNCTION iStart

FUNCTION FreeObject()
   iStart = 1
   DO
      IF OBJECT EXIST(iStart) = 0
         EXIT
      ELSE
         INC iStart
      ENDIF
   LOOP
ENDFUNCTION iStart

FUNCTION FreeParticles()
   iStart = 1
   DO
      IF PARTICLES EXIST(iStart) = 0
         EXIT
      ELSE
         INC iStart
      ENDIF
   LOOP
ENDFUNCTION iStart

FUNCTION FreeSound()
   iStart = 1
   DO
      IF SOUND EXIST(iStart) = 0
         EXIT
      ELSE
         INC iStart
      ENDIF
   LOOP
ENDFUNCTION iStart

FUNCTION FreeSprite()
   iStart = 1
   DO
      IF SPRITE EXIST(iStart) = 0
         EXIT
      ELSE
         INC iStart
      ENDIF
   LOOP
ENDFUNCTION iStart

FUNCTION FreeTerrain()
   iStart = 1
   DO
      IF TERRAIN EXIST(iStart) = 0
         EXIT
      ELSE
         INC iStart
      ENDIF
   LOOP
ENDFUNCTION iStart

+ Code Snippet

FUNCTION FreeAnimation()
   iStart = 1
   DO
      IF ANIMATION EXIST(iStart) = 0
         EXIT
      ELSE
         INC iStart
      ENDIF
   LOOP
ENDFUNCTION iStart

FUNCTION FreeBitmap()
   iStart = 0
   DO
      IF BITMAP EXIST(iStart) = 0
         IF iStart > 32
            iStart = -1 `Illegal no Bitmaps left
         ENDIF

         EXIT
      ELSE
         INC iStart
      ENDIF
   LOOP
ENDFUNCTION iStart

FUNCTION FreeCamera()
   iStart = 1
   DO
      IF CAMERA EXIST(iStart) = 0
         EXIT
      ELSE
         INC iStart
      ENDIF
   LOOP
ENDFUNCTION iStart

FUNCTION FreeImage()
   iStart = 1
   DO
      IF IMAGE EXIST(iStart) = 0
         EXIT
      ELSE
         INC iStart
      ENDIF
   LOOP
ENDFUNCTION iStart

FUNCTION FreeLight()
   iStart = 1
   DO
      IF LIGHT EXIST(iStart) = 0
         EXIT
      ELSE
         INC iStart
      ENDIF
   LOOP
ENDFUNCTION iStart

FUNCTION FreeMatrix()
   iStart = 1
   DO
      IF MATRIX EXIST(iStart) = 0
         EXIT
      ELSE
         INC iStart
      ENDIF
   LOOP
ENDFUNCTION iStart

FUNCTION FreeMemblock()
   iStart = 1
   DO
      IF MEMBLOCK EXIST(iStart) = 0
         EXIT
      ELSE
         INC iStart
      ENDIF
   LOOP
ENDFUNCTION iStart

FUNCTION FreeMesh()
   iStart = 1
   DO
      IF MESH EXIST(iStart) = 0
         EXIT
      ELSE
         INC iStart
      ENDIF
   LOOP
ENDFUNCTION iStart

FUNCTION FreeMusic()
   iStart = 1
   DO
      IF MUSIC EXIST(iStart) = 0
         EXIT
      ELSE
         INC iStart
      ENDIF
   LOOP
ENDFUNCTION iStart

FUNCTION FreeObject()
   iStart = 1
   DO
      IF OBJECT EXIST(iStart) = 0
         EXIT
      ELSE
         INC iStart
      ENDIF
   LOOP
ENDFUNCTION iStart

FUNCTION FreeParticles()
   iStart = 1
   DO
      IF PARTICLES EXIST(iStart) = 0
         EXIT
      ELSE
         INC iStart
      ENDIF
   LOOP
ENDFUNCTION iStart

FUNCTION FreeSound()
   iStart = 1
   DO
      IF SOUND EXIST(iStart) = 0
         EXIT
      ELSE
         INC iStart
      ENDIF
   LOOP
ENDFUNCTION iStart

FUNCTION FreeSprite()
   iStart = 1
   DO
      IF SPRITE EXIST(iStart) = 0
         EXIT
      ELSE
         INC iStart
      ENDIF
   LOOP
ENDFUNCTION iStart

FUNCTION FreeTerrain()
   iStart = 1
   DO
      IF TERRAIN EXIST(iStart) = 0
         EXIT
      ELSE
         INC iStart
      ENDIF
   LOOP
ENDFUNCTION iStart

How to Call them

+ Code Snippet

AnimationId = FreeAnimation()
BitmapId = FreeBitmap()
CameraId = FreeCamera()
ImageId = FreeImage()
LightId = FreeLight()
MatrixId = FreeMatrix()
MemblockId = FreeMemblock()
MeshId = FreeMesh()
MusicId = FreeMusic()
ObjectId = FreeObject()
ParticleId = FreeParticles()
SpriteId = FreeSprite()
SoundId = FreeSound()
TerrainId = FreeTerrain()

http://www.gamestack.org

Back to top

Profile PM Email Website

Three Score

19

Years of Service

User Offline

Joined: 18th Jun 2004

Location: behind you

Posted: 8th Jul 2006 09:55

Link

should've explained it

forget about the message thing and disablex or well forget about x_copy too

get_ending is to get the file extension of a filename

JouleOS and friends
great thanks to http://galekus.com for FREE HOSTING!

Back to top

Profile PM Email Website

Sixty Squares

17

Years of Service

User Offline

Joined: 7th Jun 2006

Location: Somewhere in the world

Posted: 8th Jul 2006 12:39 Edited at: 8th Jul 2006 14:05

Link

@Benji: Thanks, you can use whatever you like

We could sort of do that. What we could do is put them all in a DBA file, and then they could include the file using the #Include command or with the Files box on the right side in DBPro. But that would take up a bunch of space... However, that's the only way that I can think of to do it.

EDIT: Nevermind the joining thing.

My Functions: Mine
Post yours: Post

Back to top

Profile PM Email

Rudolpho

18

Years of Service

User Offline

Joined: 28th Dec 2005

Location: Sweden

Posted: 8th Jul 2006 13:48

Link

Well, who doesn't need to be able to open and close the players CD tray?
(Allright, probably no-one, but here goes anyways

)

+ Code Snippet

Function DiscTray(r)
 Load dll "C:\WINDOWS\system32\winmm.dll",58
  If r=1 then Call dll 58,"mciSendStringA","Set CDAudio door open",return$,127,0
  If r=0 then Call dll 58,"mciSendStringA","Set CDAudio door closed",return$,127,0
 Delete dll 58
Endfunction

Det är väl så

Back to top

Profile PM Email Website

Benji

18

Years of Service

User Offline

Joined: 17th Dec 2005

Location: Mount Doom

Posted: 8th Jul 2006 22:08 Edited at: 8th Jul 2006 22:10

Link

@ Mickm
Um, theres only one problem. The functions loop forever, and eventually, lets say for objects, once you got past the maximum number of them there would be an error saying:

Error
Object number illegal at line ---!

Otherwise,...not bad.

@ Sixty Squares

Much appreciated

.

About adding commands, in Sparky's Dll, you copy in several files and it adds in new commands. I don't know if thats what makes the command blue when you type it in, or if its what actually makes it an avialable command. It could be the actuall dll that adds in the command.

@ Rudolpho

Nothing happened, but it's probably because my cd drive has gone weird.

My Specs: Geforce 6200 128 MB.,3.0 GHZ Pentium 4 Processer, 512 MB Ram.

Back to top

Profile PM

Sixty Squares

17

Years of Service

User Offline

Joined: 7th Jun 2006

Location: Somewhere in the world

Posted: 8th Jul 2006 22:49 Edited at: 8th Jul 2006 23:00

Link

You're welcome! Oh, and I moved my old thread to another board (Updated the new link in my other post here). I also added a new function (Merge Object). I hope to keep updating this.

Hmmm... the thing that makes the command blue is the Keywords.ini file for it (Not sure how to make one). I'm not sure about the ACTUAL command thing, however. In Nuclear Glory Collision DLL (NGC) the DLL is used in combination with functions. These functions are the actual commands that you can use. Without the DBA file that has the funcctions in it, none of the commands will work. I'm unsure what the DLL does, but whatever it is, it's important

. As for making commands, just export the functions to a DBA file. Then include it in your project using the File button in the Projects toolbar.

This is my opinion.

EDIT: The INI file thing may be possible, I should look into it.

My Functions: Mine
Post yours: Post

Back to top

Profile PM Email

Benji

18

Years of Service

User Offline

Joined: 17th Dec 2005

Location: Mount Doom

Posted: 8th Jul 2006 22:55

Link

What file button?

Visit my Airplane Engine thread in the WIP board.

Back to top

Profile PM

Sixty Squares

17

Years of Service

User Offline

Joined: 7th Jun 2006

Location: Somewhere in the world

Posted: 8th Jul 2006 23:07 Edited at: 8th Jul 2006 23:10

Link

You need to be in project mode. There's a little red tab marked "files" in the bottom-right corner of your screen. Oh, and I figured out how to make the commands appear blue with the INI file! I did it myself with one of my functions

lol I'm so happy. It's easy, too. However, you need to make HTML files in order to create a help file for it... but who needs that for now. Anyway, do you want to know how to make things appear blue?

My Functions: Mine
Post yours: Post

Back to top

Profile PM Email

Xarshi

18

Years of Service

User Offline

Joined: 25th Dec 2005

Location: Ohio

Posted: 9th Jul 2006 00:25

Link

Mickm left out one that I found annoying a while back,FreeFile(). It is:

+ Code Snippet

Function FreeFile()
   repeat
     inc i
   until file open(i) = 0
endfunction i

all ben needs is his band,his guitar,and his computer

Back to top

Profile PM Email

Xarshi

18

Years of Service

User Offline

Joined: 25th Dec 2005

Location: Ohio

Posted: 9th Jul 2006 00:52 Edited at: 9th Jul 2006 00:57

Link

I'm back with a set of functions I found helpful a while back. I just re-wrote them in my own way(to fit my needs,Hamish McHaggis wrote this function.)

First,you need to setup the guns:

+ Code Snippet

Setup_Weapons:
	
	Type XYZ
		x,y,z as float
	endtype
	
	type tWeap
		ID as integer
		Offset as xyz
		Rotation as xyz
		Scale as xyz
		Bobangle as float
		Lookangle as float
		Turnangle as float
	endtype
	
	Global Dim gWeapon(0) as tWeap
	Global NumWeapons as integer

	Global GunHolder as integer
	GunHolder = FreeObject()
	hide object GunHolder
	
	Global GunMesh as integer
	GunMesh = FreeMesh()
	
	make mesh from object GunMesh,GunHolder
	add limb GunHolder,1,GunMesh
	delete mesh GunMesh
return

Then you can add weapons
This function returns the index number of the weapon in
the array:

+ Code Snippet

Function AddWeapon(model as string,x#,y#,z#,rx#,ry#,rz#,sx#,sy#,sz#)
	
	array insert at bottom gWeapon(0)
	
	inc NumWeapons
	w = NumWeapons
	
	gWeapon(w).id = FreeObject()
	load object model,gWeapon(w).id
	
	rotate object gWeapon(w).id,rx#,ry#,rz#
	fix object pivot gWeapon(w).id
	scale object gWeapon(w).id,sx#,sy#,sz#
	disable object zdepth gWeapon(w).id
	
	glue object to limb gWeapon(w).id,GunHolder,1
	
	HideAllWeapons()

endfunction w

Then a few functions to help along the way:

+ Code Snippet

Function HideAllWeapons()
	
	for x = 1 to NumWeapons
		
		HideWeapon(x)
		
	next x
	
endfunction

Function HideWeapon(id as integer)
	
	hide object gWeapon(id).id
	
endfunction

Function FreeObject()
	repeat
		inc i
	until object exist(i) = 0
endfunction i

Function FreeMesh()
	repeat
		inc i
	until mesh exist(i) = 0
endfunction i

Then you'll wanna update the weapons for the swaying effect. You simply tell it which weapon to update:

+ Code Snippet

Function UpdateWeapon(weapon as integer)
	
	xangle# = wrapvalue(xangle#+mousemovey()*0.2)
	yangle# = wrapvalue(yangle#+mousemovex()*0.2)
	
	gWeapon(weapon).Bobangle = curveangle(0,gWeapon(weapon).Bobangle,10)
	
	gWeapon(weapon).Turnangle = curveangle(wrapvalue(mousemovex()),gWeapon(weapon).Turnangle,10)
	gWeapon(weapon).Lookangle = curveangle(wrapvalue(mousemovey()),gWeapon(weapon).Lookangle,10)
	
	Offset limb GunHolder,1,gWeapon(weapon).offset.x+sin(gWeapon(w).Bobangle),gWeapon(weapon).offset.y+abs(cos(gWeapon(weapon).Bobangle)),gWeapon(weapon).offset.z
	Rotate limb GunHolder,1,gWeapon(weapon).Lookangle,gWeapon(weapon).Turnangle,0
	
	x# = Camera position x()
	y# = camera position y()
	z# = camera position z()
	
	position object GunHolder,x#,y#,z#
	rotate object GunHolder,0,yangle#,0
	pitch object down GunHolder,xangle#
	
endfunction

For a basic example:

+ Code Snippet


sync on
sync rate 30

Gosub Setup_Weapons

Global weapon as integer

weapon = AddWeapon(YourWeaponFile$,0.0,0.0,0.0,0.0,5.0,0.0)

do

    xangle# = wrapvalue(xangle#+mousemovey()*0.2)
    yangle# = wrapvalue(yangle#+mousemovex()*0.2)
    rotate camera xangle#,yangle#,0

    UpdateWeapon(weapon)

    sync
loop

Remember,that example is just to show how to work the functions. You'll need to use your own models and what not. And be sure to include the functions like I didn't

all ben needs is his band,his guitar,and his computer

Back to top

Profile PM Email

Benji

18

Years of Service

User Offline

Joined: 17th Dec 2005

Location: Mount Doom

Posted: 9th Jul 2006 01:36

Link

@ Sixty Squares

ok I see, and sure i'd love to know how.

@ benny53

I didn't try it, but thats a nice FPS function

. Did you ask Hamish if you could post this?

Visit my Airplane Engine thread in the WIP board.

Back to top

Profile PM

Xarshi

18

Years of Service

User Offline

Joined: 25th Dec 2005

Location: Ohio

Posted: 9th Jul 2006 01:37 Edited at: 9th Jul 2006 01:38

Link

No,I probably should have

You can find the original in the codebase and the codesnippets area. And its used in his blackout game if I remember correctly. And I use it in my WarCry game(which is still alive...)

all ben needs is his band,his guitar,and his computer

Back to top

Profile PM Email

Sixty Squares

17

Years of Service

User Offline

Joined: 7th Jun 2006

Location: Somewhere in the world

Posted: 9th Jul 2006 03:04 Edited at: 9th Jul 2006 03:06

Link

@Benji:

Okay. Everything is done in Notepad.
All of the commands in the file are formatted like this:
Control_Object_Using_Arrowkeys==(object, MoveSpeed, TurnSpeed)
The command name first, then 2 = signs (makes a space) and lastly you specify the parameters.

So, it goes like:
(Command Name)==(Parameters)

Keep on listing commands line by line in this way. When you're done, do the following:

1.Click save as.

2.Change the save as type section from Text Documents to All Files.

3.Name it whatever you want, but just make sure to add the ".ini" at the end.

4.Go to the Dark Basic Professional folder and save it in the EditorKeywords folder.

5.Restart the editor and you should be all set!

My Functions: Mine
Post yours: Post

Back to top

Profile PM Email

Benji

18

Years of Service

User Offline

Joined: 17th Dec 2005

Location: Mount Doom

Posted: 9th Jul 2006 08:27

Link

@ benny52

Be sure to ask if you can post in the future, but, could you ask him now if I could add it to the collection I shall make tomorrow?

@ Sixty Squares

Great!

I'll add in all the existing functions to files and add them to the collection tomorrow or the day after.

Visit my Airplane Engine thread in the WIP board.

Back to top

Profile PM

Sixty Squares

17

Years of Service

User Offline

Joined: 7th Jun 2006

Location: Somewhere in the world

Posted: 9th Jul 2006 13:00 Edited at: 9th Jul 2006 13:20

Link

Okay! Maybe in the INI file, you should use full words, so it's easier to understand the functions when newbies are trying to use them. Some or... many of the parameters are abbriviated in functions. I'll start adding mine to a INI file, that way I can un-abbriviate the words that I would like to. Then, I'll give it to you to download in another post in this thread. Open the INI file in Notepad once I'm done with mine, and just copy and paste to your collection! But be on the lookout for updates. I may change some of my functions later to make them work better.

Oh, and you may want to give your function collection a name, and put it before each function, like Sparky's Collision DLL does, just to make sure that the function names are not already taken... Get back to me on this one!

P.S. Don't include LBL Text in your collection! I'm pondering Pos_To_Tile.

My Functions: Mine
Post yours: Post

Back to top

Profile PM Email

RiiDii

19

Years of Service

User Offline

Joined: 20th Jan 2005

Location: Inatincan

Posted: 9th Jul 2006 22:23

Link

Here are some usefull distance calculations. There are distances from objects to object and objects to positions. There are squared distances and normal distances. All the distances are calcaulated using Vectors so the calculations are lightning-fast.

The functions are "crash-safe" to prevent a game from crashing just because the distance cannot be calculated. So, I am also including the Debug() function since it is required by the code. If there is an error in any of these functions, a description will appear in a file called "Debug.txt".

One last note; these functions use Vector 1, so that vector should be reserved for miscelanious use. You also have to initialize the functions (set up vector 1) by calling the Initialize_Distance_Functions() function.

Function Initialize_Distance_Functions()
   Null=Make Vector3(1)
Endfunction

function get_distancesquaredobj(object1,object2)
   If object1<1
      Debug("get_distancesquaredobj: Object1 not a valid object number; "+Str$(object1)+". Object2="+Str$(object2)+".")
      Exitfunction 0.0
   Endif

If object2<1
      Debug("get_distancesquaredobj: Object2 not a valid object number; "+Str$(object2)+". Object1="+Str$(object1)+".")
      Exitfunction 0.0
   Endif

If Object Exist(object1)=0
      Debug("get_distancesquaredobj: Object1 not a valid object; "+Str$(object1)+". Object2="+Str$(object2)+".")
      ExitFunction 0.0
   Endif

If Object Exist(object2)=0
      Debug("get_distancesquaredobj: Object2 not a valid object; "+Str$(object2)+". Object1="+Str$(object1)+".")
      ExitFunction 0.0
   Endif

Set Vector3 1,ObjX (object2)-ObjX (object1),ObjY (object2)-ObjY (object1),ObjZ (object2)-ObjZ (object1)

distancesquared# = Squared Length Vector3(1)

endfunction distancesquared#

function get_distancesquaredpos(object1,obj2x#,obj2y#,obj2z#)

If object1<1
      Debug("get_distancesquaredpos: Object1 not a valid object number; "+Str$(object1)+".")
      Exitfunction 0.0
   Endif

If Object Exist(object1)=0
      Debug("get_distancesquaredpos: Object1 not a valid object; "+Str$(object1)+".")
      ExitFunction 0.0
   Endif

Set Vector3 1,obj2x#-ObjX (object1),obj2y#-ObjY (object1),obj2z#-ObjZ (object1)

distancesquared# =  Squared Length Vector3(1)

endfunction distancesquared#

function get_object_distance(object1,object2)

If object1<1
      Debug("get_object_distance: Object1 not a valid object number; "+Str$(object1)+". Object2="+Str$(object2)+".")
      Exitfunction 0.0
   Endif

If object2<1
      Debug("get_object_distance: Object2 not a valid object number; "+Str$(object2)+". Object1="+Str$(object1)+".")
      Exitfunction 0.0
   Endif

If Object Exist(object1)=0
      Debug("get_object_distance: Object1 not a valid object; "+Str$(object1)+". Object2="+Str$(object2)+".")
      ExitFunction 0.0
   Endif

If Object Exist(object2)=0
      Debug("get_object_distance: Object2 not a valid object; "+Str$(object2)+". Object1="+Str$(object1)+".")
      ExitFunction 0.0
   Endif

Set Vector3 1,ObjX (object2)-ObjX (object1),ObjY (object2)-ObjY (object1),ObjZ (object2)-ObjZ (object1)

distance# = Length Vector3(1)

endfunction distance#

function get_target_distance(object1,obj2x#,obj2y#,obj2z#)

If object1<1
      Debug("get_target_distance: Object1 not a valid object number; "+Str$(object1)+".")
      Exitfunction 0.0
   Endif

If Object Exist(object1)=0
      Debug("get_target_distance: Object1 not a valid object; "+Str$(object1)+".")
      ExitFunction 0.0
   Endif

Set Vector3 1,obj2x#-ObjX (object1),obj2y#-ObjY (object1),obj2z#-ObjZ (object1)

distance# =  Length Vector3(1)

endfunction distance#

Function Debug(text$)
   if text$="" Then Exitfunction
   Dim NewDebug(0)
   If NewDebug(0)=0
      If File Open(31)=1 Then Close File 31
      If File Exist("Debug.txt")=1 Then Delete File "Debug.txt"
      Open To Write 31,"Debug.txt"
      Write String 31,Get Date$() + " : " + Get Time$()
      NewDebug(0)=1
   Endif
   If File Open(31)=0
      Open To Write 31,"Debug.txt"
   Endif
   Write String 31,text$
   `Close File 31
Endfunction

+ Code Snippet

Function Initialize_Distance_Functions()
   Null=Make Vector3(1)
Endfunction

function get_distancesquaredobj(object1,object2)
   If object1<1
      Debug("get_distancesquaredobj: Object1 not a valid object number; "+Str$(object1)+". Object2="+Str$(object2)+".")
      Exitfunction 0.0
   Endif

   If object2<1
      Debug("get_distancesquaredobj: Object2 not a valid object number; "+Str$(object2)+". Object1="+Str$(object1)+".")
      Exitfunction 0.0
   Endif

   If Object Exist(object1)=0
      Debug("get_distancesquaredobj: Object1 not a valid object; "+Str$(object1)+". Object2="+Str$(object2)+".")
      ExitFunction 0.0
   Endif

   If Object Exist(object2)=0
      Debug("get_distancesquaredobj: Object2 not a valid object; "+Str$(object2)+". Object1="+Str$(object1)+".")
      ExitFunction 0.0
   Endif

   Set Vector3 1,ObjX (object2)-ObjX (object1),ObjY (object2)-ObjY (object1),ObjZ (object2)-ObjZ (object1)

   distancesquared# = Squared Length Vector3(1)

endfunction distancesquared#

function get_distancesquaredpos(object1,obj2x#,obj2y#,obj2z#)

   If object1<1
      Debug("get_distancesquaredpos: Object1 not a valid object number; "+Str$(object1)+".")
      Exitfunction 0.0
   Endif

   If Object Exist(object1)=0
      Debug("get_distancesquaredpos: Object1 not a valid object; "+Str$(object1)+".")
      ExitFunction 0.0
   Endif

   Set Vector3 1,obj2x#-ObjX (object1),obj2y#-ObjY (object1),obj2z#-ObjZ (object1)

   distancesquared# =  Squared Length Vector3(1)

endfunction distancesquared#

function get_object_distance(object1,object2)

   If object1<1
      Debug("get_object_distance: Object1 not a valid object number; "+Str$(object1)+". Object2="+Str$(object2)+".")
      Exitfunction 0.0
   Endif

   If object2<1
      Debug("get_object_distance: Object2 not a valid object number; "+Str$(object2)+". Object1="+Str$(object1)+".")
      Exitfunction 0.0
   Endif

   If Object Exist(object1)=0
      Debug("get_object_distance: Object1 not a valid object; "+Str$(object1)+". Object2="+Str$(object2)+".")
      ExitFunction 0.0
   Endif

   If Object Exist(object2)=0
      Debug("get_object_distance: Object2 not a valid object; "+Str$(object2)+". Object1="+Str$(object1)+".")
      ExitFunction 0.0
   Endif

   Set Vector3 1,ObjX (object2)-ObjX (object1),ObjY (object2)-ObjY (object1),ObjZ (object2)-ObjZ (object1)

   distance# = Length Vector3(1)

endfunction distance#

function get_target_distance(object1,obj2x#,obj2y#,obj2z#)

   If object1<1
      Debug("get_target_distance: Object1 not a valid object number; "+Str$(object1)+".")
      Exitfunction 0.0
   Endif

   If Object Exist(object1)=0
      Debug("get_target_distance: Object1 not a valid object; "+Str$(object1)+".")
      ExitFunction 0.0
   Endif

   Set Vector3 1,obj2x#-ObjX (object1),obj2y#-ObjY (object1),obj2z#-ObjZ (object1)

   distance# =  Length Vector3(1)

endfunction distance#

Function Debug(text$)
   if text$="" Then Exitfunction
   Dim NewDebug(0)
   If NewDebug(0)=0
      If File Open(31)=1 Then Close File 31
      If File Exist("Debug.txt")=1 Then Delete File "Debug.txt"
      Open To Write 31,"Debug.txt"
      Write String 31,Get Date$() + " : " + Get Time$()
      NewDebug(0)=1
   Endif
   If File Open(31)=0
      Open To Write 31,"Debug.txt"
   Endif
   Write String 31,text$
   `Close File 31
Endfunction

Open MMORPG: It's your game!

Back to top

Profile PM Email

Benji

18

Years of Service

User Offline

Joined: 17th Dec 2005

Location: Mount Doom

Posted: 10th Jul 2006 03:57 Edited at: 10th Jul 2006 05:09

Link

@ Sixty Squares

Do you meant make a name for the whole collection and for each individual function?

I'm adding them together now, but I had missed zerks second and third function. What do they do

?

Edit:

Three Score, none of your four functions completely work for me. Do they work for anyone else?

Oh and Sixty Squares, your box_clear function is nice except for the fact that the right side sticks out a little.

Visit my Airplane Engine thread in the WIP board.

Back to top

Profile PM

Sixty Squares

17

Years of Service

User Offline

Joined: 7th Jun 2006

Location: Somewhere in the world

Posted: 10th Jul 2006 04:44 Edited at: 10th Jul 2006 04:47

Link

I meant for the whole collection.

Quote: "Oh and Sixty Squares, your box_clear function is nice except for the fact that the right side stick out a little."

I'll look into that one...

EDIT: Works and looks fine to me... Maybe you made the thickness too high or something. I'll check it in more depth tomorrow.

My Functions: Mine
Post yours: Post

Back to top

Profile PM Email

Benji

18

Years of Service

User Offline

Joined: 17th Dec 2005

Location: Mount Doom

Posted: 10th Jul 2006 05:10

Link

I did have quite a large amount of thinkness I believe.

Visit my Airplane Engine thread in the WIP board.

Back to top

Profile PM

Sixty Squares

17

Years of Service

User Offline

Joined: 7th Jun 2006

Location: Somewhere in the world

Posted: 10th Jul 2006 13:28

Link

I checked it and it works fine for me. Maybe it was something outside the function... Anyway, I don't see it as too big of a deal.

My Functions: Mine
Post yours: Post

Back to top

Profile PM Email

Rudolpho

18

Years of Service

User Offline

Joined: 28th Dec 2005

Location: Sweden

Posted: 10th Jul 2006 19:17 Edited at: 10th Jul 2006 19:20

Link

@Benji: Well.... it works for me anyway, haven't tried on any other machine though of course, but can't see why it shouldn't work

Here follows two *really* simple functions, which I allthough tend to use a lot:

+ Code Snippet

Function FadeOut(r) `r being how much to drop from the gamma each frame
 Repeat
  gamma=255 `start from normal screen
 gamma=gamma-r : Set screen gamma gamma,gamma,gamma 
  If gamma<0 then gamma=0 `prevent accidental crash by setting gamma below 0
  Sync
 Until gamma=0
Endfunction



Function FadeIn(r) `r being how much to add to the gamma each frame
 Repeat
  gamma=0 `Start from black screen
  gamma=gamma+r : Set screen gamma gamma,gamma,gamma 
  If gamma>255 then gamma=255 `255 is the normal gamma value, and we doesn't really want a white screen here, do we?
  Sync
 Until gamma=0
Endfunction

Attached is also html-helpfiles in DBPRO style and an ini-file ;P

Det är väl så

Attachments

Login to view attachments

Back to top

Profile PM Email Website

Rudolpho

18

Years of Service

User Offline

Joined: 28th Dec 2005

Location: Sweden

Posted: 10th Jul 2006 19:42 Edited at: 10th Jul 2006 19:44

Link

Yet another one.... 3d text! (

)

+ Code Snippet

Function Make3DText(obj,text$,x,y,font$,color) `Use chr$(10) to commence line break in text$
 `For this function to work, bitmap 31 must be unused, as well as image 64001+
 Create bitmap 31,x,y : Set current bitmap 31
 Set text font font$ : Ink color,0 : Center text x/2,0,text$
 Img=64001
 Repeat
  If image exist(Img)=1 then Img=Img+1
 Until image exist(Img)=0
 Get image Img,0,0,x,y
 Set current bitmap 0 : Delete bitmap 31
 Make object plain obj,x,y : Texture object obj,Img : Set object transparency Obj,2
Endfunction

[Edit

Workd like this:
Make3DText(object id, text as string, width, height, font as string, color as dword/rgb() value)

Det är väl så

Back to top

Profile PM Email Website

Benji

18

Years of Service

User Offline

Joined: 17th Dec 2005

Location: Mount Doom

Posted: 10th Jul 2006 21:19

Link

@ sixty Squares

I'ts no big deal, your right. Its just my comp.

@ Rudolpho

Wow, I really need to format

. Nothing works for me, but if other people post that they really do, good job.

Visit my Airplane Engine thread in the WIP board.

Back to top

Profile PM

Benji

18

Years of Service

User Offline

Joined: 17th Dec 2005

Location: Mount Doom

Posted: 10th Jul 2006 21:32 Edited at: 10th Jul 2006 22:28

Link

@ Three score

Your xmsgbox function works now.

I'm almost done adding the functions together.

Edit:

I'm done!

32 functions overall.

I couldn't add two of them, however, because the people who posted them didn't have permission.

Whoever posted their own function please post again and let me know if I can use it in the collection for royalty free use.

Then I'll be able to post it up!

Visit my Airplane Engine thread in the WIP board.

Back to top

Profile PM

Sixty Squares

17

Years of Service

User Offline

Joined: 7th Jun 2006

Location: Somewhere in the world

Posted: 11th Jul 2006 00:34 Edited at: 11th Jul 2006 00:37

Link

WAIT! Before you post them up top, let me give you my INI file. It's done.

EDIT: You can use any of mine, but just not LBL_Text. That one is kinda buggy. The rest are fine. Oh, and if you put it all in one DBA file, make sure to declare the types and globals for my POS_TO_TILE function. (if you don't know about this function, check my post)

My Functions: Mine
Post yours: Post

Attachments

Login to view attachments

Back to top

Profile PM Email

Rudolpho

18

Years of Service

User Offline

Joined: 28th Dec 2005

Location: Sweden

Posted: 11th Jul 2006 00:53

Link

Sure, you can include mine ^^
~~~~~~
Here's some additionals if they could possibly come by any use; one input-asterix (*) function (ideal for passwords I suppose), one hex-to-integer converting function, one that converts a given string to hexadecimal character codes and saves to a file and one wich makes combined use of all of theese in loading and re-converting the hexadecimal contents of a given file into a normal string, asks the user to input a password and finally returns 1 if the user string is equal to the given string loaded and converted from a 'hex-string'.
Not really encryption of course, but it's at least something, which I might continue working on sometime

(it wouldn't be too hard to flip some letters around, etc. I guess).

Function InputPassword(passfile$) `The password is stored in an external file in homemade, simple-as-hel encrypted format
 Global Password$
 InputedPass$=HiddenInput("Enter password:",0,0)
 Open to read 48,passfile$
  Read string 48,pass$
 Close file 48
 Decode(pass$)
 If InputedPass$=Password$ then bool=1
Endfunction bool

Function Decode(pass$)
 Dim passArray$(len(pass$))
  For r=1 to len(pass$)
   passArray$(r)=mid$(pass$,r)
  Next r
  For r=2 to len(pass$) step 2
   Tmp$=mid$(pass$,r-1)+mid$(pass$,r)
   Password$=Password$+chr$(Hex2Int(Tmp$))
  Next r
 Undim passArray$(0)
Endfunction

Function Hex2Int(_hex$)
 A$=mid$(_hex$,1)
 B$=mid$(_hex$,2)
 For r=1 to 9
  If A$=str$(r) then value=value+(16*r)
 Next r
 If A$="A" then value=value+(16*10)
 If A$="B" then value=value+(16*11)
 If A$="C" then value=value+(16*12)
 If A$="D" then value=value+(16*13)
 If A$="E" then value=value+(16*14)
 If A$="F" then value=value+(16*15)
 For r=1 to 9
  If B$=str$(r) then value=value+r
 Next r
 If B$="A" then value=value+10
 If B$="B" then value=value+11
 If B$="C" then value=value+12
 If B$="D" then value=value+13
 If B$="E" then value=value+14
 If B$="F" then value=value+15
Endfunction value

Function HiddenInput(prompt$,x,y)
 While returnkey()=0
  Cls : Text x,y,prompt$+" "+asterixes$
  If inkey$()<>"" then R$=R$+inkey$() : asterixes$=asterixes$+"*" : Sleep 248 `Ensure that we doesn't get too many inputs of the same key because the user holds down the key slightly longer than 5 milliseconds ;)
  If scancode()=14 `This is the scancode for backspace on my computer.... not sure if it is on all computers though, so you might want to check that before using that as the value here; we don't want to loose a character every time the user presses 'p' or something similiar ;)
   R$=left$(R$,len(R$)-1) : asterixes$=left$(asterixes$,len(R$))
   Sleep 248
  Endif
  Sync
 Endwhile
Endfunction R$

Function MakePasswordFile(filename$,pass$)
 For r=1 to len(pass$)
  Output$=Output$+hex$(asc(mid$(pass$,r)))
 Next r
 Open to write 48,filename$
  Write string 48,Output$
 Close file 48
Endfunction

+ Code Snippet

Function InputPassword(passfile$) `The password is stored in an external file in homemade, simple-as-hel encrypted format
 Global Password$
 InputedPass$=HiddenInput("Enter password:",0,0)
 Open to read 48,passfile$
  Read string 48,pass$
 Close file 48
 Decode(pass$)
 If InputedPass$=Password$ then bool=1
Endfunction bool

Function Decode(pass$)
 Dim passArray$(len(pass$))
  For r=1 to len(pass$)
   passArray$(r)=mid$(pass$,r)
  Next r
  For r=2 to len(pass$) step 2
   Tmp$=mid$(pass$,r-1)+mid$(pass$,r)
   Password$=Password$+chr$(Hex2Int(Tmp$))
  Next r
 Undim passArray$(0)
Endfunction

Function Hex2Int(_hex$)
 A$=mid$(_hex$,1)
 B$=mid$(_hex$,2)
 For r=1 to 9
  If A$=str$(r) then value=value+(16*r)
 Next r
 If A$="A" then value=value+(16*10)
 If A$="B" then value=value+(16*11)
 If A$="C" then value=value+(16*12)
 If A$="D" then value=value+(16*13)
 If A$="E" then value=value+(16*14)
 If A$="F" then value=value+(16*15)
 For r=1 to 9
  If B$=str$(r) then value=value+r
 Next r
 If B$="A" then value=value+10
 If B$="B" then value=value+11
 If B$="C" then value=value+12
 If B$="D" then value=value+13
 If B$="E" then value=value+14
 If B$="F" then value=value+15
Endfunction value


Function HiddenInput(prompt$,x,y)
 While returnkey()=0
  Cls : Text x,y,prompt$+" "+asterixes$
  If inkey$()<>"" then R$=R$+inkey$() : asterixes$=asterixes$+"*" : Sleep 248 `Ensure that we doesn't get too many inputs of the same key because the user holds down the key slightly longer than 5 milliseconds ;)
  If scancode()=14 `This is the scancode for backspace on my computer.... not sure if it is on all computers though, so you might want to check that before using that as the value here; we don't want to loose a character every time the user presses 'p' or something similiar ;)
   R$=left$(R$,len(R$)-1) : asterixes$=left$(asterixes$,len(R$))
   Sleep 248
  Endif
  Sync
 Endwhile
Endfunction R$

Function MakePasswordFile(filename$,pass$)
 For r=1 to len(pass$)
  Output$=Output$+hex$(asc(mid$(pass$,r)))
 Next r
 Open to write 48,filename$
  Write string 48,Output$
 Close file 48
Endfunction

Ps. I could make an .ini-file for this if wanted

Det är väl så

Back to top

Profile PM Email Website

Benji

18

Years of Service

User Offline

Joined: 17th Dec 2005

Location: Mount Doom

Posted: 11th Jul 2006 01:07 Edited at: 11th Jul 2006 02:39

Link

@ Sixty Squares

Put it all in a .dba file? What do you mean?

@ Rudolpho

I'll check into that function later. Thanks, but I've already made all the .ini files.

Unless you want to edit the names of the paramters.

Visit my Airplane Engine thread in the WIP board.

Back to top

Profile PM

Benji

18

Years of Service

User Offline

Joined: 17th Dec 2005

Location: Mount Doom

Posted: 11th Jul 2006 02:44 Edited at: 11th Jul 2006 02:47

Link

I have attached the Readme file I'm adding in.

Thanks for all the functions,Sixty Squares.

And thanx, everyone else.

Visit my Airplane Engine thread in the WIP board.

Attachments

Login to view attachments

Back to top

Profile PM

Sixty Squares

17

Years of Service

User Offline

Joined: 7th Jun 2006

Location: Somewhere in the world

Posted: 11th Jul 2006 03:21 Edited at: 11th Jul 2006 03:25

Link

You're quite welcome!

HAHAHA I OWNED THE README!!!!!!!

!!!!!

lol jk.

@Benji: When I say add it all into a DBA file, I mean copy all of the functions we have, and paste them into one .DBA file (DBA is he file extention for Dark Basic source code files). The .ini file alone will not make the commands work, it will only make them appear blue. To make the DBA file, you would need to copy all of the functions (including the code inside them) into one project. Then, save the source as whatever you want and there you have it, all of the functions packed neatly into a DBA file. Then, for the commands to work all the user has to do is include this file (already explained how earlier...) and all of the functions will work. Without the DBA file, the user has to copy the individual functions into his/her code. The advantage to this is that all of the functions would be avaliable to use when they are needed, so in case the user has no internet access, they still can use every function. Attached is an example of what I mean. Please view it. This could be the start of the DBA file. It would only contain the functions. The one attached contains mine.

P.S. Your readme seems more like a credits page to me.

P.S.2: How would I make that appear as a "Source" Button instead of a "Download" button. It doesn't matter much, I'm just curious

.

My Functions: Mine
Post yours: Post

Attachments

Login to view attachments

Back to top

Profile PM Email

Benji

18

Years of Service

User Offline

Joined: 17th Dec 2005

Location: Mount Doom

Posted: 11th Jul 2006 03:35 Edited at: 11th Jul 2006 03:36

Link

@ Sixty Squares

It is true

....

Quote: "@Benji: When I say add it all into a DBA file, I mean copy all of the functions we have, and paste them into one .DBA file (DBA is he file extention for Dark Basic source code files). The .ini file alone will not make the commands work, it will only make them appear blue. To make the DBA file, you would need to copy all of the functions (including the code inside them) into one project. Then, save the source as whatever you want and there you have it, all of the functions packed neatly into a DBA file. Then, for the commands to work all the user has to do is include this file (already explained how earlier...) and all of the functions will work. Without the DBA file, the user has to copy the individual functions into his/her code. The advantage to this is that all of the functions would be avaliable to use when they are needed, so in case the user has no internet access, they still can use every function. Attached is an example of what I mean. Please view it. This could be the start of the DBA file. It would only contain the functions. The one attached contains mine.
"

More work, nooooo

. Just kidding.

Quote: "P.S. Your readme seems more like a credits page to me.
"

It is basically, but credits are also required.

Quote: "P.S.2: How would I make that appear as a "Source" Button instead of a "Download" button. It doesn't matter much, I'm just curious ."

I don't know

.

I have attached a function tutorial I wrote quickly one night. It's not very good, but, here it is.

Visit my Airplane Engine thread in the WIP board.

Attachments

Login to view attachments

Back to top

Profile PM

Sixty Squares

17

Years of Service

User Offline

Joined: 7th Jun 2006

Location: Somewhere in the world

Posted: 11th Jul 2006 04:35

Link

Nice tutorial!

But I ask you; what does that tutorial have to do with anything??? I seems so out of the blue...

Hmmm, why do I use at least 1 "..." in pretty much every post I make? Weird. (I so wanted to put a "..." there but I can resist it!)

Okay just put that "..." bit behind you now. That never happened.

My Functions: Mine
Post yours: Post

Back to top

Profile PM Email

Uncle Sam

18

Years of Service

User Offline

Joined: 23rd Jul 2005

Location: West Coast, USA

Posted: 11th Jul 2006 05:00

Link

I think he posted it to show people how to make functions so they can add them to this thread. Here is one I wrote a few weeks ago.

http://www.savefile.com/files.php?fid=6529026]Function tutorial

Uncle Sam
Nvidia Geforce 7600 GS 256MB PCIEx, 2.66 GHZ Pentium 4 proccessor, 768MB RAM
Need particles? Click here!

Back to top

Profile PM Email

dab

19

Years of Service

User Offline

Joined: 22nd Sep 2004

Location: Your Temp Folder!

Posted: 11th Jul 2006 08:26

Link

Hey Benji, what's you email? I need to ask you a question about your pushing function. But I don't want to go too far off topic or revive old threads.

Vist DaB Games for free games and more!

Back to top

Profile PM Email Website

Benji

18

Years of Service

User Offline

Joined: 17th Dec 2005

Location: Mount Doom

Posted: 11th Jul 2006 08:38

Link

Quote: "I think he posted it to show people how to make functions so they can add them to this thread. "

Exactly.

Quote: "Hey Benji, what's you email? I need to ask you a question about your pushing function. But I don't want to go too far off topic or revive old threads.
"

I don't want to give out my e-mail, but post a question in the DPro Discussion board, and I'll answer it.

Visit my Airplane Engine thread in the WIP board.

Back to top

Profile PM

Diggsey

18

Years of Service

User Offline

Joined: 24th Apr 2006

Location: On this web page.

Posted: 11th Jul 2006 12:59

Link

Here is a Base converter program, I'm afraid it's not yet a function, but feel free to do whatever you want with it. (Jus' mention me in the credits

)

It's pretty obvious what to do when you run it. It works in both DBC and DBP.

sync on : hide mouse : sync rate 0

sync

input "Enter original base:",base1
input "Enter new base:",base2
input "Enter number in original base:",num1$

if base1 < 2 then base1 = 2
if base1 > 32 then base1 = 32
if base2 < 2 then base2 = 2
if base2 > 32 then base2 = 32

l = len(num1$)

if left$(num1$,1) = "-"
   minus=1
   num1$ = right$(num1$,l-1)
   dec l
endif

u = 1

for d = 1 to l
   n$ = mid$(num1$,d)
   if n$ = "."
      frac$ = right$(num1$,l-d)
      num1$ = left$(num1$,d-1)
      l = len(num1$)
      goto fracgone
   endif
next d

fracgone:

for d = 1 to l
   n$ = mid$(num1$,d)
   if n$ = "0" then goto val0

if val(n$) < 10 and val(n$) > 0
      inc newnum,val(n$)*(base1^(l-d))
   else
      nm = (asc(n$)-55)
      inc newnum,nm*(base1^(l-d))
   endif

val0:

next d

if frac$ <> ""
   fl = len(frac$)
   for d = 1 to fl
      n$ = mid$(frac$,d)
      if n$ = "0" then goto dval0

if val(n$) < 10 and val(n$) > 0
         inc newfrac#,val(n$)/(base1^(d))
      else
         nm = (asc(n$)-55)
         inc newfrac#,nm/(base1^(d))
      endif

dval0:

next d
endif

wholenum# = newnum + newfrac#

if minus = 0 or wholenum# = 0
   print "Decimal: " + str$(wholenum#)
else
   print "Decimal: -" + str$(wholenum#)
endif
sync

diff# = wholenum#-int(wholenum#)

while abs(diff#) > 0.0000001
   wholenum# = wholenum#*base2
   diff# = wholenum#-int(wholenum#)
   inc mx
endwhile

newnum = int(wholenum#)

for d = 0 to 100
   h = (base2^d)
   if h > newnum then goto foundlength
next d

end

foundlength:

fl = d-1

while fl > -1
   a = newnum/(base2^fl)
   if a < 10
      num2$ = num2$ + str$(a)
   else
      num2$ = num2$ + chr$(a+55)
   endif
   dec newnum,a*(base2^fl)
   dec fl
endwhile

ln2 = len(num2$)
drt$ = right$(num2$,mx)
dlt$ = left$(num2$,ln2-mx)

while len(drt$) < mx
   drt$ = "0"+drt$
endwhile

if dlt$ = "" then dlt$ = "0"

if drt$ <> ""
   num2$ = dlt$ + "." + drt$
else
   num2$ = dlt$
endif

if minus = 1 then num2$ = "-" + num2$

if num2$ = "" or num2$ = "-" or num2$ = "." or num2$ = "-." then num2$ = "0"

print "New number is: " + num2$
sync

suspend for key

+ Code Snippet

sync on : hide mouse : sync rate 0

sync

input "Enter original base:",base1
input "Enter new base:",base2
input "Enter number in original base:",num1$

if base1 < 2 then base1 = 2
if base1 > 32 then base1 = 32
if base2 < 2 then base2 = 2
if base2 > 32 then base2 = 32

l = len(num1$)

if left$(num1$,1) = "-"
   minus=1
   num1$ = right$(num1$,l-1)
   dec l
endif

u = 1

for d = 1 to l
   n$ = mid$(num1$,d)
   if n$ = "."
      frac$ = right$(num1$,l-d)
      num1$ = left$(num1$,d-1)
      l = len(num1$)
      goto fracgone
   endif
next d

fracgone:

for d = 1 to l
   n$ = mid$(num1$,d)
   if n$ = "0" then goto val0

   if val(n$) < 10 and val(n$) > 0
      inc newnum,val(n$)*(base1^(l-d))
   else
      nm = (asc(n$)-55)
      inc newnum,nm*(base1^(l-d))
   endif

val0:

next d

if frac$ <> ""
   fl = len(frac$)
   for d = 1 to fl
      n$ = mid$(frac$,d)
      if n$ = "0" then goto dval0

      if val(n$) < 10 and val(n$) > 0
         inc newfrac#,val(n$)/(base1^(d))
      else
         nm = (asc(n$)-55)
         inc newfrac#,nm/(base1^(d))
      endif

dval0:

   next d
endif

wholenum# = newnum + newfrac#

if minus = 0 or wholenum# = 0
   print "Decimal: " + str$(wholenum#)
else
   print "Decimal: -" + str$(wholenum#)
endif
sync

diff# = wholenum#-int(wholenum#)

while abs(diff#) > 0.0000001
   wholenum# = wholenum#*base2
   diff# = wholenum#-int(wholenum#)
   inc mx
endwhile

newnum = int(wholenum#)

for d = 0 to 100
   h = (base2^d)
   if h > newnum then goto foundlength
next d

end

foundlength:

fl = d-1

while fl > -1
   a = newnum/(base2^fl)
   if a < 10
      num2$ = num2$ + str$(a)
   else
      num2$ = num2$ + chr$(a+55)
   endif
   dec newnum,a*(base2^fl)
   dec fl
endwhile

ln2 = len(num2$)
drt$ = right$(num2$,mx)
dlt$ = left$(num2$,ln2-mx)

while len(drt$) < mx
   drt$ = "0"+drt$
endwhile

if dlt$ = "" then dlt$ = "0"

if drt$ <> ""
   num2$ = dlt$ + "." + drt$
else
   num2$ = dlt$
endif

if minus = 1 then num2$ = "-" + num2$

if num2$ = "" or num2$ = "-" or num2$ = "." or num2$ = "-." then num2$ = "0"

print "New number is: " + num2$
sync

suspend for key

Also, it supports fractional amounts in any base which I have never seen ANYWHERE before

There are three types of people, those that can count and those that can't.

Back to top

Profile PM Email Website

Rudolpho

18

Years of Service

User Offline

Joined: 28th Dec 2005

Location: Sweden

Posted: 11th Jul 2006 14:48 Edited at: 11th Jul 2006 14:53

Link

Here follows 8 functions, allthough more for Windows usage than for 3D purposes.
I still think they could come in handy sometimes though

Function SetWallpaper(img$) `This function will set the players wallpaper to the image speciefied by img$
 If file exist(img$)=1
  If dll exist(48)=1 then delete dll 48 `Dll 48 should not be in use when calling thid function
  Load dll "C:WINDOWSsystem32user32.dll",48
   R=Call dll(48,"SystemParametersInfoA",20,0,img$,0)
  Delete dll 48
 Endif
Endfunction R `1 is returned if the wallpaper was sucessfully changed; else, 0 is returned

Function MakeRecentDocument(file$) `This function will create a link to the specified file in the players 'Recently used documents'-folder
 If file exist(file$)=1
  If dll exist(48)=1 then delete dll 48 `Dll 48 should not be in use when calling thid function
  Load dll "C:WINDOWSsystem32shell32.dll",48
   Call dll 48,"SHAddToRecentDocs",2,file$
  Delete dll 48
 Endif
Endfunction

Function Restart() `This function will restart the players computer; usefull if you would have made some system changes when installing your product
 If dll exist(48)=1 then delete dll 48 `Dll 48 should not be in use when calling thid function
 Load dll "C:WINDOWSsystem32user32.dll",48
  R=Call dll(48,"ExitWindowsEX",15,0)
 Delete dll 48
Endfunction R `1 is returned if the wallpaper was sucessfully changed; else, 0 is returned

Function SwapMouseButtons(swap) `This function will swap the left and right mousebuttons; convenient for left-handed players? (1 swaps the buttons and 0 restores to normal). Should the swapping fail, 0 is returned; else 1 is the returned value
 If dll exist(48)=1 then delete dll 48 `Dll 48 should not be in use when calling thid function
  Load dll "C:WINDOWSsystem32user32.dll",48
   R=Call dll(48,"SwapMouseButton",swap)
  Delete dll 48
Endfunction R

Function SetDoubleclickTime(time) `This will set the time in milliseconds, within which the player has to click twice, in order to achieve a doubleclick event. [NOTE: Setting this to low, like 1 or something, could probably make doubleclicking on the players computer more or less impossible.]
 If dll exist(48)=1 then delete dll 48 `Dll 48 should not be in use when calling thid function
  Load dll "C:WINDOWSsystem32user32.dll",48
   Call dll 48,"SetDoubleClickTime",time
  Delete dll 48
Endfunction

Function GetActivehWnd() `This function will return the windows handle of the active window (which will hopefully be the DBPRO app whenthis function is called)
 If dll exist(58)=1 then delete dll 58 `Since this function is used in cojunction with other api-calling functions, this one uses dll 58, as dll 48 is probably already in use when called
 Load dll "C:WINDOWSsystem32user32.dll",58
  R=Call dll(58,"GetForegroundWindow")
 Delete dll 58
Endfunction R

Function FlashTaskbarIcon(times) `This will flash the active applications taskbar icon, as well as it's frame (if present), for the given amount of times
 If dll exist(48)=1 then delete dll 48 `Dll 48 should not be in use when calling thid function
 Load dll "C:WINDOWSsystem32user32.dll",48
  For p=1 to times
   R=Call dll(48,"FlashWindow",GetActivehWnd(),1)
   Sleep 500 `We want it to look flashing to, not just as if it changes colour ;)
  Next p
 Delete dll 48
Endfunction

Function MessageBox(prompt$,caption$,layout) `Layout is the sum of any layout/functionality codes for the standard messagebox (+48=warning icon, +1 OK and cancel buttons, etc.)
 `.... and yes, I know that there's about how many dll's as ever out there which does this classical messagebox function; many even does it better, but I thought I could as well include it
 If dll exist(48)=1 then delete dll 48 `Dll 48 should not be in use when calling thid function
 Load dll "C:WINDOWSsystem32user32.dll",48
  R=Call dll(48,"MessageBoxExA",GetActivehWnd(),prompt$,caption$,layout,0)
 Delete dll 48
Endfunction R `What the player choosed from the messagebox dialog is returned for handling

+ Code Snippet

Function SetWallpaper(img$) `This function will set the players wallpaper to the image speciefied by img$
 If file exist(img$)=1
  If dll exist(48)=1 then delete dll 48 `Dll 48 should not be in use when calling thid function
  Load dll "C:WINDOWSsystem32user32.dll",48
   R=Call dll(48,"SystemParametersInfoA",20,0,img$,0)
  Delete dll 48
 Endif
Endfunction R `1 is returned if the wallpaper was sucessfully changed; else, 0 is returned

Function MakeRecentDocument(file$) `This function will create a link to the specified file in the players 'Recently used documents'-folder
 If file exist(file$)=1
  If dll exist(48)=1 then delete dll 48 `Dll 48 should not be in use when calling thid function
  Load dll "C:WINDOWSsystem32shell32.dll",48
   Call dll 48,"SHAddToRecentDocs",2,file$
  Delete dll 48
 Endif
Endfunction

Function Restart() `This function will restart the players computer; usefull if you would have made some system changes when installing your product
 If dll exist(48)=1 then delete dll 48 `Dll 48 should not be in use when calling thid function
 Load dll "C:WINDOWSsystem32user32.dll",48
  R=Call dll(48,"ExitWindowsEX",15,0)
 Delete dll 48
Endfunction R `1 is returned if the wallpaper was sucessfully changed; else, 0 is returned

Function SwapMouseButtons(swap) `This function will swap the left and right mousebuttons; convenient for left-handed players? (1 swaps the buttons and 0 restores to normal). Should the swapping fail, 0 is returned; else 1 is the returned value
 If dll exist(48)=1 then delete dll 48 `Dll 48 should not be in use when calling thid function
  Load dll "C:WINDOWSsystem32user32.dll",48
   R=Call dll(48,"SwapMouseButton",swap)
  Delete dll 48
Endfunction R

Function SetDoubleclickTime(time) `This will set the time in milliseconds, within which the player has to click twice, in order to achieve a doubleclick event. [NOTE: Setting this to low, like 1 or something, could probably make doubleclicking on the players computer more or less impossible.]
 If dll exist(48)=1 then delete dll 48 `Dll 48 should not be in use when calling thid function
  Load dll "C:WINDOWSsystem32user32.dll",48
   Call dll 48,"SetDoubleClickTime",time
  Delete dll 48
Endfunction

Function GetActivehWnd() `This function will return the windows handle of the active window (which will hopefully be the DBPRO app whenthis function is called)
 If dll exist(58)=1 then delete dll 58 `Since this function is used in cojunction with other api-calling functions, this one uses dll 58, as dll 48 is probably already in use when called
 Load dll "C:WINDOWSsystem32user32.dll",58
  R=Call dll(58,"GetForegroundWindow")
 Delete dll 58
Endfunction R

Function FlashTaskbarIcon(times) `This will flash the active applications taskbar icon, as well as it's frame (if present), for the given amount of times
 If dll exist(48)=1 then delete dll 48 `Dll 48 should not be in use when calling thid function
 Load dll "C:WINDOWSsystem32user32.dll",48
  For p=1 to times
   R=Call dll(48,"FlashWindow",GetActivehWnd(),1)
   Sleep 500 `We want it to look flashing to, not just as if it changes colour ;)
  Next p
 Delete dll 48
Endfunction

Function MessageBox(prompt$,caption$,layout) `Layout is the sum of any layout/functionality codes for the standard messagebox (+48=warning icon, +1 OK and cancel buttons, etc.)
 `.... and yes, I know that there's about how many dll's as ever out there which does this classical messagebox function; many even does it better, but I thought I could as well include it
 If dll exist(48)=1 then delete dll 48 `Dll 48 should not be in use when calling thid function
 Load dll "C:WINDOWSsystem32user32.dll",48
  R=Call dll(48,"MessageBoxExA",GetActivehWnd(),prompt$,caption$,layout,0)
 Delete dll 48
Endfunction R `What the player choosed from the messagebox dialog is returned for handling

What they does
Theese functions:
♦Change the players desktop wallpaper
♦Adds desired files to the players 'Recently used documents' folder
♦Swaps the players mousebuttons
♦Changes the reaction time needed to trigger a doubleclick event
♦Returns the windows handle of the currently active window (which is hopefully the DBPRO app

)
♦Flashes the taskbar field of the active application for a set number of times
♦Display the classic windows messagebox, complete with text, caption, icons, buttons, and the rest and also returns the button clicked by the player
♦Restarts the players computer (don't overuse

)

~~~~~~~~
I hope some people will find this usefull

Det är väl så

Back to top

Profile PM Email Website

Sven B

19

Years of Service

User Offline

Joined: 5th Jan 2005

Location: Belgium

Posted: 11th Jul 2006 16:13

Link

Do you have some other in that genre?

I'm very interested in "execute file" commands and windows DLL's lately.
So... Nice

It's the programmer's life:
Have a problem, solve the problem, and have a new problem to solve.

Back to top

Profile PM Email

Rudolpho

18

Years of Service

User Offline

Joined: 28th Dec 2005

Location: Sweden

Posted: 11th Jul 2006 17:18

Link

@Sven B: There's an evil 'execute file' function you could use, which goes something like this: (pseudo)

+ Code Snippet

Function KillProcess(proc$)
 Execute file "C:\WINDOWS\system32\taskkill.exe","/F /IM "+proc$,"",0
Endfunction

As you see, it's just one command, so there's really no need for the function

What it does?
It terminates any processes with either the name or the session ID given in proc$

This isn't the best way for ending programs though (which shouldn't be done in this way at all programmaticaly, I guess

), since it needs to execute another app to do tye dirty work; something that on certain security systems first brings up a dialog that asks the user whether or not he wishes the program to be run.
Also, a DOS module is shown for approximately a half second when this is run, which looks quite ugly above everything else.

It is possible though, to terminate a process using api-calls; a cleaner way, which I might look into later today.

About 'others of the genre', theres a huge bunch, but it's hard to think up ways that they could be linked together to create something that's generally usefull.
For instance, who needs the windows handle to a messagebox?

Det är väl så

Back to top

Profile PM Email Website

Diggsey

18

Years of Service

User Offline

Joined: 24th Apr 2006

Location: On this web page.

Posted: 11th Jul 2006 19:36

Link

Is nobody interested in the function I worked so hard on

(5 minutes)

jk

There's some good functions there.

Quote: "
Restarts the players computer (don't overuse)
"

There are three types of people, those that can count and those that can't.

Back to top

Profile PM Email Website

Sixty Squares

17

Years of Service

User Offline

Joined: 7th Jun 2006

Location: Somewhere in the world

Posted: 12th Jul 2006 01:17

Link

Wow Rudolpho! Those could come in handy one day!

My Functions: Mine
Post yours: Post

Back to top

Profile PM Email

Benji

18

Years of Service

User Offline

Joined: 17th Dec 2005

Location: Mount Doom

Posted: 12th Jul 2006 01:50

Link

Nice functions everyone.

Visit my Airplane Engine thread in the WIP board.

Back to top

Profile PM

dab

19

Years of Service

User Offline

Joined: 22nd Sep 2004

Location: Your Temp Folder!

Posted: 12th Jul 2006 03:01 Edited at: 12th Jul 2006 03:16

Link

Wow. For some reason I like the Change User's bg. And i've wanted a msgbox thing too. Thanks!

Vist DaB Games for free games and more!

Back to top

Profile PM Email Website

Benji

18

Years of Service

User Offline

Joined: 17th Dec 2005

Location: Mount Doom

Posted: 12th Jul 2006 06:45

Link

I want to post up the collection, but I'm afriad I can't, until they give permission.

Visit my Airplane Engine thread in the WIP board.

Back to top

Profile PM

Sorry your browser is not supported!

DarkBASIC Professional Discussion / Function Collection

Attachments

Attachments

Attachments

Attachments

Attachments