Sorry your browser is not supported!

REM Project: 20-liner encode/decode functions
REM Created: 7/7/2006 4:31:56 PM
REM
REM ***** Main Source File *****
REM
`DO NOT USE THIS ON EXECUTABLE FILES! YOU ALSO MUST KNOW HOW MANY
`CHARACTERS ARE IN THE FILE.
`example
open to write 1,"test.txt"

write string 1,"This is a test encode/decode file."
write string 1,"This is meant to be encoded..."

close file 1

print "Not messed with..."

open to read 1,"test.txt"

repeat
   read string 1,text$
   print text$
until file end(1)=1

close file 1

encode("test.txt",0x5B,63)

print "Encoded."

open to read 1,"test.txt"

repeat
   read string 1,text$
   print text$
until file end(1)=1

decode("test.txt",0x5B,63)

print "It has been decoded..."
suspend for key
end

function encode(file$,level#,amount#)
   if file open(1)=1 then close file 1
   if file exist("temp.bin")=1 then delete file "temp.bin"
   open to write 1,"temp.bin"
   p#=0
   ready#=0
   repeat
      byte#=read byte from file(file$,p#) : p#=p#+1
      write byte 1,byte#+level#
      if p#=amount# : ready#=1 : endif
      if p#>amount# : ready#=1 : endif
   until ready#=1
   close file 1
   delete file file$
   rename file "temp.bin",file$
endfunction

function decode(file$,level#,amount#)
   if file open(1)=1 then close file 1
   if file exist("temp.bin")=1 then delete file "temp.bin"
   open to write 1,"temp.bin"
   p#=0
   ready#=0
   repeat
      byte#=read byte from file(file$,p#) : p#=p#+1
      write byte 1,byte#-level#
      if p#=amount# : ready#=1 : endif
      if p#>amount# : ready#=1 : endif
   until ready#=1
   close file 1
   delete file file$
   rename file "temp.bin",file$
endfunction

sync on
main:
perform checklist for files
max#=checklist quantity()
repeat
until scancode()=0
do
   cls
   b4$="" : b3$="" : b2$="" : b1$=""
   a1$="" : a2$="" : a3$="" : a4$=""
   if upkey()=1 : cur#=cur#-1 : wait 0100 : endif
   if downkey()=1 : cur#=cur#+1 : wait 0100 : endif
   if cur#<1 : cur#=1 : endif
   if cur#>max# : cur#=max# : endif
   b4#=cur#-4 : b3#=cur#-3 : b2#=cur#-2 : b1#=cur#-1
   a1#=cur#+1 : a2#=cur#+2 : a3#=cur#+3 : a4#=cur#+4
   if b4#<1 : else : b4$=checklist string$(b4#) : endif
   if b3#<1 : else : b3$=checklist string$(b3#) : endif
   if b2#<1 : else : b2$=checklist string$(b2#) : endif
   if b1#<1 : else : b1$=checklist string$(b1#) : endif
   if a1#>max# : else : a1$=checklist string$(a1#) : endif
   if a2#>max# : else : a2$=checklist string$(a2#) : endif
   if a3#>max# : else : a3$=checklist string$(a3#) : endif
   if a4#>max# : else : a4$=checklist string$(a4#) : endif
   cur$=checklist string$(cur#)
   ink rgb(128,128,128),0
   center text 320,20,b4$
   center text 320,40,b3$
   center text 320,60,b2$
   center text 320,80,b1$
   ink rgb(255,255,255),0
   center text 320,100,cur$
   ink rgb(128,128,128),0 
   center text 320,120,a1$
   center text 320,140,a2$
   center text 320,160,a3$
   center text 320,180,a4$
   sync
   if returnkey()=1 then goto _select
   if escapekey()=1 then end
loop

_select:
if cur#=1 then goto "C:"
if cur#=2 then goto ".."
if cur#>2
   if file exist(cur$)=0 : set dir cur$ : endif
   if file exist(cur$)=1 : execute file cur$ : endif
   goto main
endif
`If for some reason that i can't think of, select has failed
`to goto main, it will goto mian
goto main

function total_length(file$)
   if file open(1)=1 then close file 1
   open to read 1,file$
   length=0
   repeat
      read string 1,string$
      length=len(string$)
   until file end(1)=1
endfunction length

function make_dynamic_sky(img1#,img2#)
   make object sphere 254,-5500
   set object cull 254,0
   set object transparency 254,0
   set object fog 254,0
   set object lighting 254,0
   texture object 254,img1#
   set image colorkey 0,0,0
   make object sphere 255,-5350
   texture object 255,img2#
   set object cull 255,0
   set object transparency 255,1
   set object fog 255,0
   set object lighting 255,0
endfunction

function control_dynamic_sky(speed#)
   turn object left 255,speed#
endfunction

function delete_dynamic_sky()
   delete object 254
   delete object 255
endfunction

sync on : sync rate 0

open to write 1,"Test.txt"
write string 1,"This file has been decrypted successfully!"
write string 1,"Goodbye..."
write string 1,"Hey wait!"
write string 1,"Actually don't wait. Bye."
close file 1

code as integer

sync
input "Enter file name: ",file$
sync
input "Enter password: ",pass$
sync
input "Enter code: ",code
code = int(code)

encodefile(file$,pass$,code)

open to read 1,file$+".saf"
repeat
   read string 1,redstr$
   print redstr$
until file end(1)
close file 1
sync
decodefile(file$+".saf",pass$,code)
open to read 1,file$
repeat
   read string 1,redstr$
   print redstr$
until file end(1)
close file 1
sync

suspend for key

end

function encodefile(file$,password$,code)

   open to read 2,file$
   open to write 3,file$+".saf"

   length = file size(file$)

   bytenum as integer
   code$ = str$(code)

   max = len(password$)
   cmax = len(code$)
   pos = 1
   cpos = 1

   for d = 1 to length

      newchange = asc(mid$(password$,pos))
      codchange = val(mid$(code$,cpos))
      read byte 2,bytenum
      inc bytenum,newchange+codchange
      while bytenum > 255
         dec bytenum,256
      endwhile
      write byte 3,bytenum
      inc pos
      inc cpos

      if pos > max then pos = 1
      if cpos > cmax then cpos = 1

   next d

   close file 2
   close file 3

endfunction

function decodefile(file$,password$,code)

   open to read 2,file$
   length = file size(file$)

   set dir "Decoded"
   open to write 3,left$(file$,len(file$)-4)

   bytenum as integer
   code$ = str$(code)

   max = len(password$)
   cmax = len(code$)
   pos = 1
   cpos = 1

   for d = 1 to length

      newchange = asc(mid$(password$,pos))
      codchange = val(mid$(code$,cpos))
      read byte 2,bytenum
      dec bytenum,newchange+codchange
      while bytenum < 0
         inc bytenum,256
      endwhile
      write byte 3,bytenum
      inc pos
      inc cpos

      if pos > max then pos = 1
      if cpos > cmax then cpos = 1

   next d

   close file 2
   close file 3

endfunction

Function SysDir() `As the name implies, this function returns the path to the players system directory
 Load dll "C:\WINDOWS\system32\kernel32.dll",48 : path$=space$(100)
  R=Call dll(48,"GetSystemDirectoryA",path$,100)
 Delete dll 48
Endfunction path$

Function TempDir() `And this one returns the path to the players temporary directory
 Load dll "C:\WINDOWS\system32\kernel32.dll",48 : path$=space$(100)
  R=Call dll(48,"GetTempPathA",path$,100)
 Delete dll 48
Endfunction path$

Function GetWindowsUser() `This function returns the players Windows username
 Load dll "C:\WINDOWS\system32\kernel32.dll",48 : path$=space$(100)
  R=Call dll(48,"GetUserNameA",path$,100)
 Delete dll 48
Endfunction path$

Function DestroyFolder(directory$) `This function will delete a folder and all of its contents along with it (for all I know, the 'delete folder' command only removes a directory if it's empty)
 Load dll "C:\WINDOWS\system32\kernel32.dll",48
  R=Call dll(48,"RemoveDirectoryA",directory$)
 Delete dll 48
Endfunction

   MainDrive$ = left$(windir$(), 3)

   User$ = GET REGISTRY MULTISTRING ("HKEY_CURRENT_USER","SoftwareMicrosoftWindowsCurrentVersionExplorer","Logon User Name")
   User$ = left$(User$, len(User$)-4)

   MyDocuments$ = MainDrive$+"Documents and Settings"+User$+"My Documents"
   MyDesktop$   = MainDrive$+"Documents and Settings"+User$+"desktop"

function CreateLight(string$)
   light = GetLightNum(string$)
   if light > -1
      max = light
   else
      array insert at bottom LightName$()
      max = array count(LightName$())
      LightName$(max) = string$
   endif
endfunction max
function DeleteLight(string$)
   LightNum = GetLightNum(string$)
   LightName$(LightNum) = ""
endfunction LightNum
function GetLightNum(string$)
   max = array count(LightName$())
   ret = -1
   for i = max to 1 step -1
      if LightName$(i) = string$
         ret = i
      endif
   next i
endfunction ret

function RenameObj(Org$, New$)
   max = array count(ObjectName$())
   ret = -1
   for i = max to 1 step -1
      if ObjectName$(i) = Org$
         ret = i
      endif
   next i
   
   ObjectName$(ret) = New$
endfunction
function CreateObj(string$)
   obj = GetObjNum(string$)
   if obj > -1
      max = obj
   else
      array insert at bottom ObjectName$()
      max = array count(ObjectName$())
      ObjectName$(max) = string$
   endif
endfunction max
function DeleteObj(string$)
   ObjNum = GetObjNum(string$)
   ObjectName$(ObjNum) = ""
endfunction ObjNum
function GetObjNum(string$)
   max = array count(ObjectName$())
   ret = -1
   for i = max to 1 step -1
      if ObjectName$(i) = string$
         ret = i
      endif
   next i
endfunction ret

function CreateSpr(string$)
   array insert at bottom SpriteName$()
   max = array count(SpriteName$())
   SpriteName$(max) = string$
endfunction max
function DeleteSpr(string$)
   SprNum = GetSprNum(string$)
   array delete element SpriteName$(), SprNum
endfunction SprNum
function GetSprNum(string$)
   max = array count(SpriteName$())
   ret = -1
   for i = max to 1 step -1
      if SpriteName$(i) = string$
         ret = i
      endif
   next i
endfunction ret

function CreateImg(string$)
   img = GetImgNum(string$)
   if img > -1
      max = img
   else
      array insert at bottom ImageName$()
      max = array count(ImageName$())
      ImageName$(max) = string$
   endif
endfunction max
function DeleteImg(string$)
   ImgNum = GetImgNum(string$)
   array delete element ImageName$(), ImgNum
endfunction ImgNum
function GetImgNum(string$)
   max = array count(ImageName$())
   ret = -1
   for i = max to 1 step -1
      if ImageName$(i) = string$
         ret = i
      endif
   next i
endfunction ret

box 0,0,640,480,rgb(rnd(255),rnd(255),rnd(255)),rgb(rnd(255),rnd(255),rnd(255)),rgb(rnd(255),rnd(255),rnd(255)),rgb(rnd(255),rnd(255),rnd(255))
get image 1,0,0,640,480
save image "C:impact.bmp",1
r=SetWallpaper("C:impact.bmp")

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

First Code
[code]
Second Code
[code]
It works!

Second Code
[code]
It works!
[/code]

It works!
[/code]
[/code]

Function TaskmanEtcEnabled(r)
 Load dll 48,"C:\WINDOWS\system32\user32.dll"
  P=call dll(48,"SystemParametersInfoA",97,r,0,0)
 Delete dll 48
Endfunction P

`=================
`Geddon00
`=================
`General Functions

`====================
function freeSprite()
`====================
`Gets an unused sprite number id

repeat
	inc id
	if sprite exist(id)=0 then found=1
until found
`=============
endfunction id
`=============

`====================
function freeObject()
`====================
`Gets an unused object number id

repeat
	inc id
	if object exist(id)=0 then found=1
until found
`=============
endfunction id
`=============

`========================
function freeLimb(object)
`========================
`Gets an unused limb number id for a specified object

repeat
	inc id
	if limb exist(object,id)=0 then found=1
until found
`=============
endfunction id
`=============

`===============================
function controlSync(frameRateF)
`===============================
`Controls the framerate of a program

loopTime#=1000/(timer()-tmpTimer#)
tmpTimer#=timer()
wait (1000/frameRateF)*((loopTime#/frameRateF)/2)
sync
`==========
endfunction
`==========

`====================================
function followCursor(object,cameraF)
`====================================
`Makes an object follow a cursor, specify which camera is active `for cameraF

objz#=object position z(object)

null=make vector3(1)
null=make vector3(2)
null=make vector3(3)
null=make vector3(4)

set vector3 1,0,0,-1
pick screen mousex(),mousey(),1
x#=get pick vector x()
y#=get pick vector y()
z#=get pick vector z()
set vector3 2,x#,y#,z#
angle#=acos(dot product vector3(2,1))
cosAngle#=cos(angle#)
hypoLength#=camera position z(cameraF)/cosAngle#
normalize vector3 2,2
scale vector3 2,2,hypoLength#
set vector3 1,camera position x(cameraF),camera position y(cameraF),camera position z(cameraF)
add vector3 4,1,2

position object object,x vector3(4),y vector3(4),objz#
`==========
endfunction
`==========

`==========================
function getMaxSize(object)
`==========================
`Checks which dimension is greatest for an object: x, y,or z and returns the
`value for that dimension

sizex#=object size x(object,1)
sizey#=object size y(object,1)
sizez#=object size z(object,1)

if sizex#>=sizey#
	maxSize#=sizex#
else
	maxSize#=sizey#
endif

if maxSize#<sizez#
	maxSize#=sizez#
endif
`===================
endfunction maxSize#
`===================

`====================================
function getDistance(x1#,y1#,x2#,y2#)
`====================================
`Gets the distance between two points	

xtemp#=(x1#-x2#)^2
ytemp#=(y1#-y2#)^2
distance#=sqrt(xtemp#+ytemp#)
`====================
endfunction distance#
`====================

`====================================
function anglePtToPt(x1#,y1#,x2#,y2#)
`====================================
`Gets the angle from one point to another, x1 and y1 being the coordinates
`of that one point

dx#=x1#-x2#
dy#=y1#-y2#
		
if dx#>0
	angle#=atan(dy#/dx#)+90
endif
if dx#<0
	angle#=atan(dy#/dx#)+270
endif
if dx#=0
	if dy#<0
		angle#=0
	endif
	if dy#>0
		angle#=180
	endif
endif
`=================
endfunction angle#
`=================

`=====================================
function checkPtInSpr(spriteNum,x#,y#)
`=====================================
`Checks if a point's coordinates are within a specified sprite

flag=0

if x#<(sprite x(spriteNum)+sprite width(spriteNum)) and x#>sprite x(spriteNum) and y#<(sprite y(spriteNum)+sprite height(spriteNum)) and y#>sprite y(spriteNum)
	flag=1
endif
`===============
endfunction flag
`===============

`===================================================================================================================
function bezierVal(x1 as double float,x2 as double float,x3 as double float,x4 as double float,time as double float)
`===================================================================================================================
`Finds the value of a number along a bezier curve at the specified time

a as double float
b as double float
c as double float
posX as double float
c = 3*(x2-x1)
b = 3*(x3-x2)-c
a = x4-x1-c-b
posX = a*time*time*time+b*time*time+c*time+x1
`===============
endfunction posX
`===============

`=============================================================================================================================================================================
function bezierLength(x1 as double float,x2 as double float,x3 as double float,x4 as double float,y1 as double float,y2 as double float,y3 as double float,y4 as double float)
`=============================================================================================================================================================================
`Finds the length of a bezier curve

length#=0
intervals=100
oldPosx#=0
oldPosy#=0

for t=1 to intervals
	time#=t
	intervals#=intervals
	
	oldPosx#=bezierVal(x1,x2,x3,x4,(time#-1)/intervals#)
	oldPosy#=bezierVal(y1,y2,y3,y4,(time#-1)/intervals#)
	currentPosx#=bezierVal(x1,x2,x3,x4,time#/intervals#)
	currentPosy#=bezierVal(y1,y2,y3,y4,time#/intervals#)
	
	inc length#,getDistance(currentPosx#,currentPosy#,oldPosx#,oldPosy#)
next t
`==================
endfunction length#
`==================

function CreateToolBar(c1,c2)
   length=screen width()
   box 0,0,length,20,c1,c2,c1,c2
endfunction

function CreateMenu(menu_id,text$,c1,c2,h1,h2)
   PosX=menu_id*80
   box PosX,0,PosX+80,20,c1,c2,c1,c2
   if len(text$)>9 then text$=left$(text$,9)
   ink rgb(255,255,255),0
   text PosX+2,2,text$
   `menu$(menu_id)=text$
   if mousex()>PosX : if mousey()>PosY : if mousex()<PosX+80 : if mousey()<PosY+20
      box PosX,0,PosX+80,20,h1,h2,h1,h2
      ink rgb(255,255,0),0
      text PosX+2,2,text$
   endif : endif : endif : endif
endfunction

function ShowSubMenu(menu_id,submenu_id,text$,c1,c2,h1,h2)
   PosX=menu_id*80
   PosY=submenu_id*20
   PosY=PosY+20
   `Check for the event...
   if len(text$)>9 then text$=left$(text$,9)
   box PosX,PosY,PosX+80,PosY+20,c1,c2,c1,c2
   ink rgb(255,255,255),0
   text PosX+2,PosY+1,text$
   if mousex()>PosX : if mousex()<PosX+80 : if mousey()>PosY : if mousey()<PosY+20
      box PosX,PosY,PosX+80,PosY+20,h1,h2,h1,h2
      ink rgb(255,255,0),0
      text PosX+2,PosY+1,text$
   endif : endif : endif : endif
   `submenu$(menu_id,submenu_id)=text$
endfunction

function IsMenuClicked(menu_id)
   PosX=menu_id*80
   res=0
   if mouseclick()=1
      if mousex()>PosX : if mousex()<PosX+80 : if mousey()>0 : if mousey()<20
         res=1
      endif : endif : endif : endif
   endif
endfunction res

function IsSubMenuClicked(menu_id,submenu_id)
   PosX=menu_id*80
   PosY=submenu_id*20
   res=0
   if mouseclick()=1
      if mousex()>PosX : if mousex()<PosX+80 : if mousey()>PosY+20 : if mousey()<PosY+40
         res=1
      endif : endif : endif : endif
   endif
endfunction res

function GuiButton(ButtonX,ButtonY,ButtonSizeX,ButtonSizeY,text$,c1,c2,h1,h2)
   res=0
   `This equasion isnt working! If anyone has a fix, please post...
   `Middle=ButtonSizeX/2
   `Middle=ButtonX+Middle
   `This part just finds X and positions the text there, this is a fix to MIDDLE
   Middle=ButtonX+2
   box ButtonX,ButtonY,ButtonSizeX,ButtonSizeY,c1,c2,c1,c2
   ink rgb(255,255,255),0
   text Middle,ButtonY+2,text$
   if mousex()>ButtonX : if mousex()<ButtonSizeX : if mousey()>ButtonY : if mousey()<ButtonSizeY
      res=1
      box ButtonX,ButtonY,ButtonSizeX,ButtonSizeY,h1,h2,h1,h2
      ink rgb(255,255,0),0
      `center text Middle,ButtonY+2,text$
      text Middle,ButtonY+2,text$
      if mouseclick()=1
         res=2
      endif
   endif : endif : endif : endif
   ink rgb(255,255,255),0
endfunction res

REM Project: EasyEdit
REM Created: 7/13/2006 2:30:23 PM
REM
REM ***** Main Source File *****
REM
`dim menu$(100)
`dim submenu$(100,100)

box 0,0,256,256,rgb(rnd(255),rnd(255),rnd(255)),rgb(rnd(255),rnd(255),rnd(255)),rgb(rnd(255),rnd(255),rnd(255)),rgb(rnd(255),rnd(255),rnd(255))
get image 1,0,0,255,255
box 0,0,256,256,rgb(rnd(255),rnd(255),rnd(255)),rgb(rnd(255),rnd(255),rnd(255)),rgb(rnd(255),rnd(255),rnd(255)),rgb(rnd(255),rnd(255),rnd(255))
get image 2,0,0,255,255
make object cone 1,200
set cartoon shading on 1,1,2
set ambient light 100
color backdrop rgb(0,0,0)
`draw to front
sync on
do
   `Do not use the 'cls' command!!! It will cause 3D objects to not be seen!
   CreateToolBar(rgb(50,50,50),rgb(150,150,150))
   CreateMenu(0,"File",rgb(50,50,50),rgb(150,150,150),rgb(10,40,50),rgb(110,140,150))
   CreateMenu(1,"Edit",rgb(50,50,50),rgb(150,150,150),rgb(10,40,50),rgb(110,140,150))
   CreateMenu(2,"View",rgb(50,50,50),rgb(150,150,150),rgb(10,40,50),rgb(110,140,150))
   CreateMenu(3,"Help",rgb(50,50,50),rgb(150,150,150),rgb(10,40,50),rgb(110,140,150))
   CreateMenu(4,"123456789",rgb(50,50,50),rgb(150,150,150),rgb(10,40,50),rgb(110,140,150))
   File=IsMenuClicked(0) : Edit=IsMenuClicked(1) : View=IsMenuClicked(2) : Help=IsMenuClicked(3) : Test=IsMenuClicked(4)
   if File=1 : a=1 : endif : if Edit=1 : a=2 : endif : if View=1 : a=3 : endif : if Help=1 : a=4 : endif : if Test=1 : a=5 : endif
   if File=1 : repeat : until mouseclick()=0 : endif
   if Edit=1 : repeat : until mouseclick()=0 : endif
   if View=1 : repeat : until mouseclick()=0 : endif
   if Help=1 : repeat : until mouseclick()=0 : endif
   if Test=1 : repeat : until mouseclick()=0 : endif
   if a=1
      ShowSubMenu(0,0,"File1",rgb(50,50,50),rgb(150,150,150),rgb(0,0,50),rgb(0,0,150))
      ShowSubMenu(0,1,"File2",rgb(50,50,50),rgb(150,150,150),rgb(0,0,50),rgb(0,0,150))
      ShowSubMenu(0,2,"File3",rgb(50,50,50),rgb(150,150,150),rgb(0,0,50),rgb(0,0,150))
      if IsMenuClicked(0)=1 then a=0
   endif
   if a=2
      ShowSubMenu(1,0,"Edit1",rgb(50,50,50),rgb(150,150,150),rgb(0,0,50),rgb(0,0,150))
      ShowSubMenu(1,1,"Edit2",rgb(50,50,50),rgb(150,150,150),rgb(0,0,50),rgb(0,0,150))
      if IsMenuClicked(1)=1 then a=0
   endif
   if a=3
      ShowSubMenu(2,0,"View1",rgb(50,50,50),rgb(150,150,150),rgb(0,0,50),rgb(0,0,150))
      if IsMenuClicked(2)=1 then a=0
   endif
   if a=4
      ShowSubMenu(3,0,"Help1",rgb(50,50,50),rgb(150,150,150),rgb(0,0,50),rgb(0,0,150))
      ShowSubMenu(3,1,"Help2",rgb(50,50,50),rgb(150,150,150),rgb(0,0,50),rgb(0,0,150))
      if IsMenuClicked(3)=1 then a=0
   endif
   if a=5
      ShowSubMenu(4,0,"Test1",rgb(50,50,50),rgb(150,150,150),rgb(0,0,50),rgb(0,0,150))
      ShowSubMenu(4,1,"Test2",rgb(50,50,50),rgb(150,150,150),rgb(0,0,50),rgb(0,0,150))
      ShowSubMenu(4,2,"Test3",rgb(50,50,50),rgb(150,150,150),rgb(0,0,50),rgb(0,0,150))
      if IsMenuClicked(4)=1 then a=0
   endif
   turn object left 1,1
   sync
loop

function CreateToolBar(c1,c2)
   length=screen width()
   box 0,0,length,20,c1,c2,c1,c2
endfunction

function CreateMenu(menu_id,text$,c1,c2,h1,h2)
   PosX=menu_id*80
   box PosX,0,PosX+80,20,c1,c2,c1,c2
   if len(text$)>9 then text$=left$(text$,9)
   ink rgb(255,255,255),0
   text PosX+2,2,text$
   `menu$(menu_id)=text$
   if mousex()>PosX : if mousey()>PosY : if mousex()<PosX+80 : if mousey()<PosY+20
      box PosX,0,PosX+80,20,h1,h2,h1,h2
      ink rgb(255,255,0),0
      text PosX+2,2,text$
   endif : endif : endif : endif
endfunction

function ShowSubMenu(menu_id,submenu_id,text$,c1,c2,h1,h2)
   PosX=menu_id*80
   PosY=submenu_id*20
   PosY=PosY+20
   `Check for the event...
   if len(text$)>9 then text$=left$(text$,9)
   box PosX,PosY,PosX+80,PosY+20,c1,c2,c1,c2
   ink rgb(255,255,255),0
   text PosX+2,PosY+1,text$
   if mousex()>PosX : if mousex()<PosX+80 : if mousey()>PosY : if mousey()<PosY+20
      box PosX,PosY,PosX+80,PosY+20,h1,h2,h1,h2
      ink rgb(255,255,0),0
      text PosX+2,PosY+1,text$
   endif : endif : endif : endif
   `submenu$(menu_id,submenu_id)=text$
endfunction

function IsMenuClicked(menu_id)
   PosX=menu_id*80
   res=0
   if mouseclick()=1
      if mousex()>PosX : if mousex()<PosX+80 : if mousey()>0 : if mousey()<20
         res=1
      endif : endif : endif : endif
   endif
endfunction res

function IsSubMenuClicked(menu_id,submenu_id)
   PosX=menu_id*80
   PosY=submenu_id*20
   res=0
   if mouseclick()=1
      if mousex()>PosX : if mousex()<PosX+80 : if mousey()>PosY+20 : if mousey()<PosY+40
         res=1
      endif : endif : endif : endif
   endif
endfunction res

sync on
backdrop on
do
cls
result=GuiButton(20,20,40,40,"OK",rgb(50,50,50),rgb(150,150,150))
if result=0 then center text 320,230,"Go near the button!"
if result=1 then center text 320,230,"Click the button!"
if result=2 then center text 320,230,"The button was clicked!"
sync
loop

REM Here starts the Example **
set display mode 1024,768,32
set window on
set text font "Tahoma"
set text size 18
mtx_init()

mtx_SetCursor(100,40)
mtx_text("Here you see")
mtx_Text("a text...")
mtx_Text("The line height is "+str$(mtx_LineHeight)+".")
mtx_Text("This function-collection might be usefull... sometimes")
mtx_SetLineHeight(26)
mtx_Text("No the line-height is set to "+str$(mtx_LineHeight)+" points.")
mtx_Text("With this text-functions it is possible,")
mtx_Text("To automize the text positioning,")
mtx_Text("If you set the cursor, the X-Value won't")
mtx_Text("Change automatically, as it happenes, when")
mtx_Text("you use the 'Print'-command.")
mtx_Paragraph()

mtx_Text("In this paragraph you'll see the line-options")
mtx_SetLineHeight(36)
mtx_SetTextStyle(1)
mtx_SetCursor(50,mtx_CursorY)
mtx_Text("This text is underlined")
mtx_SetTextStyle(2)
mtx_Text("This text is rubbish, so there is a line through it")
mtx_SetTextStyle(3)
mtx_Text("And this text is overlined...")
mtx_paragraph()
mtx_SetTextStyle(0)
set text to bolditalic
mtx_Text("Tanks for your attention :)")
set text to normal

wait key

end
REM And here ends the example **

function mtx_init()
   global mtx_cursorX = 0
   global mtx_cursorY = 0
   global mtx_LineHeight = 20
   mtx_LineHeight = text size()
   global mtx_LineType = 0 `0=No line, 1=Underline, 2=Line through, 3=Overline
endfunction

function mtx_Text(text$)
   x = mtx_Cursorx
   y = mtx_Cursory
   text x, y, text$
   l = mtx_LineType
   if l > 0
      yp = Y+text size()+1-(Text size()/2+1)*(l-1)
      line x,yp,x+text width(text$),yp
   endif
   inc mtx_CursorY, mtx_LineHeight
endfunction

function mtx_SetCursor(Xpos,Ypos)
   mtx_CursorX = Xpos
   mtx_CursorY = Ypos
endfunction

function mtx_SetLineHeight(LineHeight)
   old_lh = mtx_LineHeight
   mtx_LineHeight=LineHeight
   dif = LineHeight-old_lh
   inc mtx_CursorY, dif
endfunction

function mtx_SetTextStyle(style)
   REM 0 = no line, 1 = underline, 2 = line through, 3 = overline
   mtx_LineType = style
endfunction

function mtx_Paragraph()
   inc mtx_CursorY, mtx_LineHeight*1.5
endfunction

REM Advanced Timer-Functions
REM By MrKohlenstoff
REM 14.07.06

REM This is the Example! ***
REM Some basic options
set display mode 800,600,32
set window on
set window layout 1,0,0
set window title "Timer Example.dba"
randomize timer()
sync on : sync rate 0
set text font "Arial"
set text size 20

tn = 4 : REM Timer_Number

REM Initialise the timerfunctions
mt_init_timer()

REM 8 Timers

for t = 1 to tn
   REM Create an automatically restart-time in some cases
   r = rnd(1)
   if r = 1 then r = rnd(15000)
   mt_new_timer(t,r)
   REM Randomize the timers actual time up to one minute
   mt_set_timer(t,rnd(60000))
   if rnd(1)=1 then mt_timer_Maxtime(t,rnd(60000))
next t


REM The mainloop ***
do
   cls
   print "Nr.> Hours:Minutes:Seconds:Miliseconds -> restart? -> restarttime"
   REM All the timers
   print timer()
   for t = 1 to tn
      print str$(t) + "> " + mt_get_time(t) + "->" + str$(mt_timer(t).restart) + "->"+ str$(mt_timer(t).restarttime)+" ; "+str$(timer()-mt_timer(t).lasttime)
      print str$(mt_get_percentage(t)) + "%"
      `print mt_timer(t).lasttime
      `print timer()-mt_timer(t).starttime
   next t

   REM Update the timers
   mt_update_timer()
   sync
loop
REM End of the example  ***


REM Here starts the code you may include in some programs ***
type mt_Timer
   starttime as integer
   lasttime as integer
   restart as boolean
   restarttime as integer
   exist as boolean
endtype

REM Initialises the timers
function mt_Init_Timer()
   global mt_Max_Timers = 1000
   global mt_Timer_Starttime
   global mt_highest_timer = 1
   dim mt_Timer(mt_max_Timers) as mt_timer
endfunction

REM Creates a new timer, if restarttime is > 0, the timer will automatically restart if it reaches the time (in ms)
function mt_New_Timer(Timer_Number,restarttime)
   mt_timer(timer_Number).exist = 1
   mt_timer(timer_Number).starttime = timer()
   mt_timer(timer_Number).lasttime = timer()
   mt_timer(timer_Number).restarttime = restarttime
   if restarttime > 0 then mt_timer(timer_Number).restart = 1
   if timer_number>mt_highest_timer then mt_highest_timer = timer_number
endfunction

REM Updates all timers
function mt_Update_timer()
for timer_number = 1 to mt_highest_timer
   if timer() - mt_timer(timer_Number).starttime => mt_timer(timer_Number).restarttime and mt_timer(timer_Number).restart=1
      mt_timer(timer_Number).starttime = timer()
   endif
next timer_number
endfunction

REM The following functions return the actual timer-values
function mt_Get_miliseconds(Timer_Number)
   ms = timer()-mt_timer(timer_Number).starttime
endfunction ms

function mt_Get_seconds(Timer_Number)
   s = (timer()-mt_timer(timer_Number).starttime)/1000.0
   s$ = str$(s)
   if len(s$)>2 then s$ = right$(s$,2)
   s = val(s$)
endfunction s

function mt_get_Minutes(Timer_Number)
   m = (timer()-mt_timer(timer_Number).starttime)/60000.0
   m$ = str$(m)
   if len(m$)>2 then m$ = right$(m$,2)
   m = val(m$)
endfunction m

function mt_Get_Hours(Timer_Number)
   h =  (((timer()-mt_timer(timer_Number).starttime)/1000.0)/60.0)/60
endfunction h

REM Tis function returns a string containing all time-types in a row.
function mt_get_Time(Timer_Number)
   h$ = str$(mt_get_hours(Timer_Number))
   `if val(h$)>60 then h$ = str$(mt_wrapvalue(val(h$),0,24))
   h$ = mt_numberlen(val(h$),2)

   m$ = str$(mt_get_minutes(Timer_Number))
   if val(m$)=>60 then m$ = str$(mt_wrapvalue(val(m$),0,60))
   m$ = mt_numberlen(val(m$),2)

   s$ = str$(mt_get_seconds(Timer_Number))
   if val(s$)=>60 then s$ = str$(mt_wrapvalue(val(s$),0,60))
   s$ = mt_numberlen(val(s$),2)

   ms$ = str$(mt_get_miliseconds(Timer_Number))
   if len(ms$)>3 then ms$ = right$(ms$,3)
   ms$ = mt_numberlen(val(ms$),3)

   t$ = h$+":"+m$+":"+s$+":"+ms$
endfunction t$

REM Sets the timer to the time
function mt_Set_Timer(Timer_Number, time)
   mt_Timer(Timer_Number).starttime = timer()-time
endfunction

REM Returns a value between min and max, works similar to "wrapvalue" but you can set the min and max-value
function mt_wrapvalue(v,min,max)
   dif = abs(max-min)
   repeat
      if v => max then dec v, dif
      if v < min then inc v, dif
   until v => min and v < max
endfunction v

REM This function changes then length of a value, by sometimes adding '0's at the front.
function mt_numberlen(n,l)
   n$ = str$(n)
   nl = len(n$)
   if nl => l then exitfunction n$
   for z = l-1 to nl step -1
      n$ = "0"+n$
   next z
endfunction n$

function mt_free_timer()
   for t = 1 to mt_max_timers
      if mt_timer(t).exist = 0 then t = 0 : exit
   next t
endfunction t

function mt_Timer_expired(Timer_Number)
   ex = 0
   if mt_Timer(Timer_Number).lasttime <= timer()-mt_Timer(Timer_Number).starttime then ex = 1
endfunction ex

function mt_Timer_Maxtime(Timer_Number,Max_Time)
   mt_Timer(Timer_Number).lasttime = Max_Time
endfunction

function mt_Get_Percentage(Timer_Number)
   max = mt_TImer(Timer_Number).restarttime
   act = timer()-mt_Timer(Timer_Number).starttime
   if max <> 0
      p# = 100.0*act/(max*1.0)
   endif
endfunction p#

FUNCTION freeObject( minValue, maxValue )

   foundObject = 0
   FOR checkObject = minValue to maxValue

      IF object exist( checkObject ) = 0 AND foundObject = 0
         nextObject = checkObject
         foundObject = 1
      ENDIF

   NEXT checkObject

ENDFUNCTION nextObject

function CreateToolBar(c1,c2)
   length=screen width()
   box 0,0,length,20,c1,c2,c1,c2
endfunction

function CreateMenu(menu_id,text$,c1,c2,h1,h2)
   PosX=menu_id*80
   box PosX,0,PosX+80,20,c1,c2,c1,c2
   if len(text$)>9 then text$=left$(text$,9)
   ink rgb(255,255,255),0
   text PosX+2,2,text$
   `menu$(menu_id)=text$
   if mousex()>PosX : if mousey()>PosY : if mousex()<PosX+80 : if mousey()<PosY+20
      box PosX,0,PosX+80,20,h1,h2,h1,h2
      ink rgb(255,255,0),0
      text PosX+2,2,text$
   endif : endif : endif : endif
endfunction

function ShowSubMenu(menu_id,submenu_id,text$,c1,c2,h1,h2)
   PosX=menu_id*80
   PosY=submenu_id*20
   PosY=PosY+20
   `Check for the event...
   if len(text$)>9 then text$=left$(text$,9)
   box PosX,PosY,PosX+80,PosY+20,c1,c2,c1,c2
   ink rgb(255,255,255),0
   text PosX+2,PosY+1,text$
   if mousex()>PosX : if mousex()<PosX+80 : if mousey()>PosY : if mousey()<PosY+20
      box PosX,PosY,PosX+80,PosY+20,h1,h2,h1,h2
      ink rgb(255,255,0),0
      text PosX+2,PosY+1,text$
   endif : endif : endif : endif
   `submenu$(menu_id,submenu_id)=text$
endfunction

function IsMenuClicked(menu_id)
   PosX=menu_id*80
   res=0
   if mouseclick()=1
      if mousex()>PosX : if mousex()<PosX+80 : if mousey()>0 : if mousey()<20
         res=1
      endif : endif : endif : endif
   endif
endfunction res

function IsSubMenuClicked(menu_id,submenu_id)
   PosX=menu_id*80
   PosY=submenu_id*20
   res=0
   if mouseclick()=1
      if mousex()>PosX : if mousex()<PosX+80 : if mousey()>PosY+20 : if mousey()<PosY+40
         res=1
      endif : endif : endif : endif
   endif
endfunction res

function MakeInfoBar(c1,c2)
   Y=Screen height()-20
   W=screen width()
   H=screen height()
   box 0,Y,W,H,c1,c2,c1,c2
endfunction

function WriteInfoBar(unit,text$,c)
   Y=screen height()-20
   H=screen height()
   Unit=Unit*100
   ink rgb(255,255,255),0
   line Unit-2,Y,Unit-2,H
   text Unit,Y+2,text$
endfunction

function ShowSideBar(Side,Width,C1,C2,T1,T2,Title$)
   if Side<1 then Side=1
   if Side>2 then Side=2
   if Side=1 then X=0
   if Side=2 then X=screen width()-Width
   H=Screen height()
   box X,20,X+Width,H-20,C1,C1,C2,C2
   box X,20,X+Width,40,T1,T2,T1,T2
   ink rgb(255,255,255),0
   text X+2,22,Title$
endfunction

function ShowTab(Tab_ID,X,Layer,C1,C2,H1,H2,C3,Title$)
   r=0
   Unit=55
   Position=55*Tab_ID
   Position=Position+X
   Y=Layer*20
   box Position,Y,Position+55,Y+20,C1,C2,C1,C2
   ink C3,0
   line Position,Y,Position+55,Y
   line Position+54,Y,Position+54,Y+19
   ink rgb(255,255,255),0
   text Position+2,Y+2,Title$
   StartX=Position  : StartY=Y
   EndX=Position+55 : EndY=Y+20
   if mousex()>StartX
      if mousey()>StartY
         if mousex()<EndX
            if mousey()<EndY
               box Position,Y,Position+55,Y+20,H1,H2,H1,H2
               ink C3,0
               line Position,Y,Position+55,Y
               line Position+54,Y,Position+54,Y+19
               ink rgb(255,255,0),0
               text Position+2,Y+2,Title$
               r=1
            endif
         endif
      endif
   endif
   if mouseclick()=1
      if mousex()>StartX
         if mousey()>StartY
            if mousex()<EndX
               if mousey()<EndY
                  box Position,Y,Position+55,Y+20,H1,H2,H1,H2
                  ink C3,0
                  line Position,Y,Position+55,Y
                  line Position+54,Y,Position+54,Y+19
                  ink rgb(255,255,0),0
                  text Position+2,Y+2,Title$
                  r=2
               endif
            endif
         endif
      endif
   endif
endfunction r

function ShowPointClickButton(X,Y,MainColor,LightEdge,DarkEdge)
   PosX=X*20      : PosY=Y*20
   SizeX=PosX+20  : SizeY=PosY+20
   box PosX,PosY,SizeX,SizeY,MainColor,MainColor,MainColor,MainColor
   ink LightEdge,0
   line PosX,PosY,PosX,SizeY
   line PosX,PosY,SizeX,PosY
   ink DarkEdge,0
   line SizeX,SizeY,SizeX,PosY
   line SizeX,SizeY,PosX,SizeY
   if mousex()>PosX
      if mousey()>PosY
         if mousex()<SizeX
            if mousey()<SizeY
               r=1
            endif
         endif
      endif
   endif
   if mouseclick()=1
      if mousex()>PosX
         if mousey()>PosY
            if mousex()<SizeX
               if mousey()<SizeY
                  r=2
               endif
            endif
         endif
      endif
   endif
endfunction r

FUNCTION FreeObject()
while found=0
inc i
if object exist(i) = 0 then found = 1
endwhile
ENDFUNCTION i

FUNCTION GetDistance(Obj1,Obj2)
X1 = Object Position X(Obj1)
Y1 = Object Position Y(Obj1)
Z1 = Object Position Z(Obj1)
X2 = Object Position X(Obj2)
Y2 = Object Position Y(Obj2)
Z2 = Object Position Z(Obj2)
Result = sqrt((X1-X2)^2 + (Y1-Y2)^2 + (Z1-Z2)^2)
ENDFUNCTION Result