Sorry your browser is not supported!

rem Box Collision 2004
sync on : sync rate 0 : hide mouse

for x = 1 to 10
make object cube x,10
position object x,(-50+rnd(100)),0,(-50+rnd(100))
next x

make object cube 11,3
color object 11,rgb(196,255,196)
player=11

do
if leftkey()=1 then yrotate object player,wrapvalue(object angle y( player )-3.0)
if rightkey()=1 then yrotate object player,wrapvalue(object angle y( player )+3.0)

if upkey()=1
  x# = object position x(player) : y# = object position y(player) : z# = object position z(player)
  position object player,x#+sin(object angle y(player)),y#,z#

  for c = 1 to 10
     if box_collision(player,c)=1 then position object player, x#, y#, z#
  next c
  x#= object position x(player)

  position object player, x#,y#,z#+cos(object angle y(player))

  for c = 1 to 10
     if box_collision(player,c)=1 then position object player, x#, y#, z#
  next c
endif


position camera object position x(11),50,object position z(11)
point camera object position x(11),0,object position z(11)
sync:loop

function box_collision(nr1,nr2)
  x1# = object position x(nr1) : y1# = object position y(nr1) : z1# = object position z(nr1)
  x2# = object position x(nr2) : y2# = object position y(nr2) : z2# = object position z(nr2)
  xs2# = object size x(nr2) : ys2# = object size y(nr2) : zs2# = object size z(nr2)
  if x1# > x2# - xs2# / 2
   if x1# < x2# + xs2# / 2
    if y1# > y2# - ys2# / 2
     if y1# < y2# + ys2# / 2
      if z1# > z2# - zs2# / 2
       if z1# < z2# + zs2# / 2
        exitfunction 1
       endif
      endif
     endif
    endif
   endif
  endif
endfunction 0

rem Sphere Collision 2004
sync on : sync rate 0 : hide mouse

for x = 1 to 10
make object sphere x,10
position object x,(-50+rnd(100)),0,(-50+rnd(100))
next x

make object cube 11,3
color object 11,rgb(196,255,196)
player=11

do
if leftkey()=1 then yrotate object player,wrapvalue(object angle y( player )-3.0)
if rightkey()=1 then yrotate object player,wrapvalue(object angle y( player )+3.0)

if upkey()=1
  x# = object position x(player) : y# = object position y(player) : z# = object position z(player)
  position object player,x#+sin(object angle y(player)),y#,z#

  for c = 1 to 10
     if sphere_collision(player,c,5)=1 then position object player, x#, y#, z#
  next c
  x#= object position x(player)

  position object player, x#,y#,z#+cos(object angle y(player))

  for c = 1 to 10
     if sphere_collision(player,c,5)=1 then position object player, x#, y#, z#
  next c
endif

position camera object position x(11),50,object position z(11)
point camera object position x(11),0,object position z(11)
sync:loop

function sphere_collision(nr1,nr2,dist)
  x1# = object position x(nr1) : y1# = object position y(nr1) : z1# = object position z(nr1)
  x2# = object position x(nr2) : y2# = object position y(nr2) : z2# = object position z(nr2)
  if sqrt( (x1#-x2#)^2 + (y1#-y2#)^2 + (z1#-z2#)^2 ) < dist then exitfunction 1
endfunction 0

rem 3D Intro
rem written by: Lukas Wadenhof a.k.a n0id 2004
rem =======================

sync on : sync rate 0 : cls 0

print "N0ID" : get image 1,0,0,40,15      : rem You Can Make An Image and Use the command 'Load Image image$,1'
make object plain 1,100,100 : texture object 1,1
backdrop on : color backdrop rgb(0,0,0)

do : xscale#=xscale#+0.3 : yscale#=yscale#+0.1 : zscale#=zscale#+0.3 : scale object 1,xscale#,yscale#,zscale#
  if xscale#>150 then xscale#=150 else xrotate object 1,wrapvalue(object angle x(1)-2.88)
  if yscale#>50 then yscale#=50: xrotate object 1,0
  if zscale#>150 then zscale#=150:center text 300,400,"N0iDs 3D -intro . v.1.1":center text 300,415,"This and More can be found at my webpage: www.n0id.tk"
  if mouseclick()>0 or returnkey()>0 or spacekey()>0 then delete image 1:delete object 1:goto something
sync:loop

something:
  end

remstart
  -------------------------------------------------------------------
  program name: A.I. Function
  -------------------------------------------------------------------
  written by: Lukas Wadenhof a.k.a n0id
  date:       04 Oct. 2004
  -------------------------------------------------------------------
  comments:   Today is 2 months to my birthday!;D (and till we (my band) plays our secound concert!!) (and that is exact count!)
              This is a simple AI demo

              If I knew slide collision, I would use that, but I dont know it,
              so I had to use this bad, sucky, but easy Static collision type thing.

              Total Lines: 175
              Time Spent:  about 5-6 hours.. (yes, I suck at programming, I allready know that :) )

              This was written in dbc 1.13
  -------------------------------------------------------------------
remend

_total = 10 : ` total enemies
bullet = 16 : ` bullet object number

rem AI arrays
dim _AI(0)                      :` object number to start counting AI objects from
dim _Pos#( _total , 3 )         :` A.I. position x, y, z
dim _View_Distance( _total , 2) :` A.I view and hear distance
dim _Distance#( _total )        :` A.I. distance check
dim _State$( _total )           :` A.I. state
dim _Timer( _total, 2 )         :` A.I. timer

rem Other nescesary arrays for function to work properly.
dim _Player_Lives(0)            :` Player life
dim _player(0)                  :` player object


rem VARIABLES
_AI(0) = 500                    :` start counting AI objects from 500 and up
_Player_Lives(0) = 200          :` player lives
_Player(0) = 1                  :` player object

` _______________________________________________________________________
set display mode 640,480,16    :` you can change this command, I like to use 1024x768
sync on : sync rate 0 : hide mouse : randomize timer : set normalization on : autocam off  :` this is just for setting up the demo

` _______________________________________________________________________
` make ai objects
for x = 1 to _total
  make object cube x+_AI(0), 25
  set object rotation zyx x+_AI(0)
  position object x+_AI(0) , rnd(1000) , 12.5 , rnd(1000)
  yrotate object x+_AI(0), rnd(359)
  _State$(x) = "idle"
  _View_Distance( x , 1) = 400     :` seeing range
  _View_Distance( x , 2) =  50     :` hearing range
next x

` ----------------- this is nothing important. (it makes a cone that displays where the AI is looking)
for x = 1 to _total
  id = (x+_AI(0)) +100
  make object cone id, 100 : scale object id, 100, 100, 100 : rotate object id, 90, 180, 0 : fix object pivot id : ghost object on id
next x
` -----------------

` _______________________________________________________________________
` make player
make object box _player(0),25,50,25

` _______________________________________________________________________
` make room and boxes
make object box 5, 1000,10,1000 : position object 5,500,-10,500   : color object 5,rgb(64,64,64)
make object box 6, 1000,250,10  : position object 6,500,75,0      : color object 6,rgb(64,64,64)
make object box 7, 10,250,1000  : position object 7,0,75,500      : color object 7,rgb(64,64,64)
make object box 8, 10,250,1000  : position object 8,1000,75,500   : color object 8,rgb(64,64,64)
make object box 9, 1000,250,10  : position object 9,500,75,1000   : color object 9,rgb(64,64,64)
` and make some boxes inside scene that AI can collide with
for x = 10 to 15
  make object box x, 50+rnd(50),50+rnd(50),50+rnd(50)
  position object x, rnd(1000), 0+(object size y(x)/2), rnd(1000)
  color object x, rgb(rnd(255) , rnd(255) , rnd(255))
next x

` _______________________________________________________________________
do
  rem Print some info
  ink 0,0  :text 0,0, "fps: "+str$( screen fps() )
  ink 0,0  :text 0,15, "polys: "+str$( statistic(1) )
  ink 255,0: text 0,45, "life: "+str$( _Player_Lives(0) )
  ink rgb(255,255,255), 0

  rem Handle Player Movement
  if upkey()   =1 then x#=newxvalue(x#, cya#,    10):z#=newzvalue(z#, cya#,    10)
  if downkey() =1 then x#=newxvalue(x#, cya#,   -10):z#=newzvalue(z#, cya#,   -10)
  if leftkey() =1 then x#=newxvalue(x#, cya#-90, 10):z#=newzvalue(z#, cya#-90, 10)
  if rightkey()=1 then x#=newxvalue(x#, cya#+90, 10):z#=newzvalue(z#, cya#+90, 10)
  position camera x#, 25, z#
  position object _player(0), x#, 25, z#

  cya#=wrapvalue(cya#+mousemovex()/3)
  cxa#=wrapvalue(cxa#+mousemovey()/3)

  rotate camera cxa#,cya#,0
  rotate object _player(0), 0, cya#, 0

  rem HANDLE AI
  for x = 1 to _total : Handle_AI(x) : next x

  rem fire
  Fire_bullet( _total, bullet )

  rem Color backdrop
  color backdrop rgb(64, 95, 64)

  ` ----------------- this is nothing important. (This displays where AI is looking)
  for x = 1 to _total
     id = (x+_AI(0)) +100
     position object id, object position x(id-100), object position y(id-100), object position z(id-100)
     rotate object id, object angle x(id-100), object angle y(id-100), object angle z(id-100)
     move object id, 50
  next x
  ` -----------------

  sync
loop

` _______________________________________________________________________
` FUNCTIONS
function Handle_AI( id )
  ` get object number
  id2 = id+_AI(0)

  ` get ai position
  _Pos#(id , 1 ) = object position x( id2 )
  _Pos#(id , 2 ) = object position y( id2 )
  _Pos#(id , 3 ) = object position z( id2 )

  ` get camera position
  camx# = camera position x()
  camy# = camera position y()
  camz# = camera position z()

  ` get distance
  _Distance#(id) = sqrt( (camx#-_Pos#(id , 1 ))^2 + (camz#-_Pos#(id , 3 ))^2 )

  if _State$(id)<>"attack" and _State$(id)<>"die"
     ` Check if AI see player
     if (_Distance#(id) < _View_Distance( id , 1)) and AI_See_Me(id2)=1 then _State$(id)="goto"
     ` Check if AI hear player
     if _distance#(id) < _View_Distance( id , 2) then _State$(id)="goto"
     ` Check if AI is idle
     if (_Distance#(id) > _View_Distance( id , 2)) and (_Distance#(id) > _View_Distance( id , 1)) then _State$(id)="idle"
  endif

  if _State$(id)="goto"
     Move_AI( id , 2.5 , 1)
     color object id2, rgb( 0, 0, 255 )
     if _Distance#(id) < 50 then _State$(id) = "attack"
  endif

  if _State$(id)="idle"
     Move_AI( id , 0.0 , 0)
     color object id2, rgb( 255, 255, 255 )
     _Timer(id, 1) = _Timer(id, 1) + 1
     if _Timer(id, 1) > 20+rnd(300) then _Timer(id, 1)=0:_State$(id)="move around"
  endif

  if _state$(id)="attack"
     Move_AI( id , 0.0 , 1)
     color object id2, rgb( 255, 0, 0 )
     _Timer(id, 1) = _Timer(id, 1) + 1
     if _Timer(id, 1) > 10
        _Player_Lives(0)=_Player_Lives(0)-5+rnd(5)
        _Timer(id, 1)=0
        _state$(id)="goto"
     endif
  endif

  if _state$(id)="die"
     color object id2, rgb(255,255,255) : ghost object on id2
     Move_AI( id , 0.0 , 0)
     _Timer( id, 1 ) = _Timer( id, 1 ) +  5
     _Timer( id, 2 ) = _Timer( id, 1 ) * -1
     color object id2, rgb(_Timer( id, 2 ), _Timer( id, 2 ), _Timer( id, 2 ))
     if _Timer( id, 1 ) > 255
        ghost object off id2 : position object id2 , rnd(1000) , 12.5 , rnd(1000) : yrotate object id2, rnd(359)
        _state$(id)="idle" : _Timer( id, 1 ) = 0
     endif
  endif

  if _State$(id)="move around"
     color object id2, rgb(0,255,0)
     Move_AI( id, 2.5, 0)
     _Timer( id, 1 ) = _Timer( id, 1 ) + 1
     _Timer( id, 2 ) = _Timer( id, 2 ) + 1
     if _Timer( id, 1 ) > 100+rnd(50)
        yrotate object id2, rnd(359)
     endif
     _Timer( id, 2 ) = _Timer( id, 2 ) + 1
     if _Timer( id, 2 ) > 200+rnd(500)
        _State$(id)="idle"
        _Timer(id, 1)=0 : _Timer(id, 2)=0
     endif
  endif

  if object in screen(id2) then text object screen x(id2), object screen y(id2)-(object size(id2)), _state$(id)
endfunction

function Move_AI( id , speed#, check)
  id2 = id+_AI(0)

  oldx# = object position x(id2)
  oldy# = object position y(id2)
  oldz# = object position z(id2)

  move object id2, speed#
  if check=1 then point object id2, camera position x() , 12.5 , camera position z()

  x# = object position x(id2)
  y# = object position y(id2)
  z# = object position z(id2)

  collide = Check_AI_Collision(id2,0)
  if collide > 0
     x# = oldx#
     z# = oldz#
  endif

  position object id2, x# , y# , z#
endfunction

function Fire_Bullet(total,bullet)
  if mouseclick() > 0
     make object box bullet,10,10,50000
     color object bullet, rgb(128,128,0)
     yrotate object bullet, camera angle y()
     position object bullet, camera position x(), camera position y() - 10, camera position z()

     for x = 1 to total
        if object collision(bullet,x+_AI(0))
           _state$(x) = "die"
        endif
     next x

     sync
     delete object bullet
  endif
endfunction

function Check_AI_Collision(id1, id2)
  if object collision(id1,id2)>0 then exitfunction 1
endfunction 0

function AI_See_Me(id)

  oldx# = camera position x() : oldy# = camera position y() : oldz# = camera position z()
  oldax# = camera angle x() : olday# = camera angle y() : oldaz# = camera angle z()

  position camera _Pos#(id-_AI(0) , 1 ), _Pos#(id-_AI(0) , 2 ), _Pos#(id-_AI(0) , 3 )
  rotate camera object angle x(id), object angle y(id), object angle z(id)

  if object in screen(_Player(0))
     position camera oldx#, oldy#, oldz#
     rotate camera oldax#, olday#, oldaz#
     exitfunction 1
  endif

  position camera oldx#, oldy#, oldz#
  rotate camera oldax#, olday#, oldaz#

endfunction 0

sync on
sync rate 0

hide mouse
disable escapekey


do:cls rgb(32,96,128)

  a=scancode()
  b=mouseclick()

  if a>0 then gosub Keys
  if b>0 then gosub Keys
  if a=0 then a$="no key"
  if b=0 then b$="no mouse"

  set text font "Copperplate Gothic Bold",3
  print "Key Number: "+str$(a)
  print "Key Name  : "+a$
  print
  print "Mouse Number: "+str$(b)
  print "Mouse Name  : "+b$
  print
  print
  print
  print "------------------------------------------"
  print "         Scancode Finder v1.01"
  print "------------------------------------------"
  print "         written by n0id -2004"
  print "more free stuff, goto 'http:www.n0id.tk'"
  print "------------------------------------------"
  print
  print "note:"
  print " * Press: 'Alt + F4'  to shut down program!"

sync:loop


Keys:
  if a=1 then a$ = "Escape"
  if a=2 then a$ = "1"
  if a=3 then a$ = "2"
  if a=4 then a$ = "3"
  if a=5 then a$ = "4"
  if a=6 then a$ = "5"
  if a=7 then a$ = "6"
  if a=8 then a$ = "7"
  if a=9 then a$ = "8"
  if a=10 then a$ = "9"
  if a=11 then a$ = "0"
  if a=12 then a$ = "Minus (-)"
  if a=13 then a$ = "Equals (=)"
  if a=14 then a$ = "Backspace"
  if a=15 then a$ = "Tab"
  if a=16 then a$ = "Q"
  if a=17 then a$ = "W"
  if a=18 then a$ = "E"
  if a=19 then a$ = "R"
  if a=20 then a$ = "T"
  if a=21 then a$ = "Y"
  if a=22 then a$ = "U"
  if a=23 then a$ = "I"
  if a=24 then a$ = "O"
  if a=25 then a$ = "P"
  if a=26 then a$ = "Left Bracket ([)"
  if a=27 then a$ = "Right Bracket (])"
  if a=28 then a$ = "Return/Enter"
  if a=29 then a$ = "Left Control"
  if a=30 then a$ = "A"
  if a=31 then a$ = "S"
  if a=32 then a$ = "D"
  if a=33 then a$ = "F"
  if a=34 then a$ = "G"
  if a=35 then a$ = "H"
  if a=36 then a$ = "J"
  if a=37 then a$ = "K"
  if a=38 then a$ = "L"
  if a=39 then a$ = "Semi-Colon (;)"
  if a=40 then a$ = "Apostrophe (')"
  if a=41 then a$ = "`"
  if a=42 then a$ = "Left Shift"
  if a=43 then a$ = "Right Backslash ()"
  if a=44 then a$ = "Z"
  if a=45 then a$ = "X"
  if a=46 then a$ = "C"
  if a=47 then a$ = "V"
  if a=48 then a$ = "B"
  if a=49 then a$ = "N"
  if a=50 then a$ = "M"
  if a=51 then a$ = "Comma (,)"
  if a=52 then a$ = "Period (.)"
  if a=53 then a$ = "Slash (/)"
  if a=54 then a$ = "Right Shift"
  if a=55 then a$ = "Multiply (*)"
  if a=56 then a$ = "Left Alt"
  if a=57 then a$ = "Space"
  if a=58 then a$ = "CapsLock"
  if a=59 then a$ = "F1"
  if a=60 then a$ = "F2"
  if a=61 then a$ = "F3"
  if a=62 then a$ = "F4"
  if a=63 then a$ = "F5"
  if a=64 then a$ = "F6"
  if a=65 then a$ = "F7"
  if a=66 then a$ = "F8"
  if a=67 then a$ = "F9"
  if a=68 then a$ = "F10"
  if a=69 then a$ = "Num Lock"
  if a=70 then a$ = "Scroll Lock"
  if a=71 then a$ = "NumPad 7"
  if a=72 then a$ = "NumPad 8"
  if a=73 then a$ = "NumPad 9"
  if a=74 then a$ = "Subtract (-)"
  if a=75 then a$ = "NumPad 4"
  if a=76 then a$ = "NumPad 5"
  if a=77 then a$ = "NumPad 6"
  if a=78 then a$ = "Add (+)"
  if a=79 then a$ = "NumPad 1"
  if a=80 then a$ = "NumPad 2"
  if a=81 then a$ = "NumPad 3"
  if a=82 then a$ = "NumPad 0"
  if a=83 then a$ = "Decimal (.)"
  if a=86 then a$ = "Left Backslash ()"
  if a=87 then a$ = "F11"
  if a=88 then a$ = "F12"
  if a=156 then a$ = "Enter"
  if a=157 then a$ = "Right Control"
  if a=179 then a$ = "Comma (,)"
  if a=181 then a$ = "Divide (/)"
  if a=183 then a$ = "Print Screen/SysRq"
  if a=184 then a$ = "Right Alt"
  if a=197 then a$ = "Pause"
  if a=199 then a$ = "Home"
  if a=200 then a$ = "Up Arrow"
  if a=201 then a$ = "Page Up"
  if a=203 then a$ = "Left Arrow"
  if a=205 then a$ = "Right Arrow"
  if a=207 then a$ = "End"
  if a=208 then a$ = "Down Key"
  if a=209 then a$ = "Page Down"
  if a=210 then a$ = "Insert"
  if a=211 then a$ = "Delete"
  if a=219 then a$ = "Left Windows Key"
  if a=220 then a$ = "Right Windows Key"
  if a=221 then a$ = "Open 'Right Mouse click menu'"
  if b=1 then b$ = "Left Mouse"
  if b=2 then b$ = "Right Mouse"
  if b=3 then b$ = "Left + Right Mouse"
  if b=4 then b$ = "Middle Mouse"
  if b=5 then b$ = "Left + Middle Mouse"
  if b=6 then b$ = "Right + Middle Mouse"
return

rem ***********************************************************************************************
rem *  2D MENU SYSTEM                                                                             *
rem ***********************************************************************************************
rem *  Written By Lukas Wadenhof a.k.a n0id                                                       *
rem ***********************************************************************************************
rem *  This Is A Game Menu In 2d For use with your game, if you don't want to make your own menu. *
rem *  Please feel free to edit and use this code like it was your own                            *
rem *  for more :: http address: 'www.lukashangout.tk'                                                 *
rem ***********************************************************************************************
rem
rem if you want more buttons, then just write...
rem "if makebutton(xposition,yposition,"ButtonCaption")>0 then buttonselected=button Nr
rem  if buttonselected=button Nr then 'Code goes here'"
rem ... OkaY? If you don't understand english than hope you find
rem out on your own. It's not Hard at all!!
rem ***********************************************************************************************
rem and no, i didnt invent this menu.. Lee Bamber did;) its with darkbasic when you install it.
rem ***********************************************************************************************
rem Written: sometime in 2002/2003 i dont remember...

` SETUP
sync on:sync rate 30
Menu:
` MENU LOOP
do:cls
  ink rgb(00,00,200),0
  set text size 32
  center text screen width()/2,screen height()/2-100,"[GAME TITLE]"
  set text size 16
  center text screen width()-100,screen height()-20,"created by [your name]"
  buttonpressed=0
  if makebutton(screen width()/2,screen height()/2,"NEW GAME")>0 then buttonselected=1
  if makebutton(screen width()/2,screen height()/2+50,"OPTIONS")>0 then buttonselected=2
  if makebutton(screen width()/2,screen height()/2+100,"CREDITS")>0 then buttonselected=3
  if makebutton(screen width()/2,screen height()/2+150,"QUIT")>0 then buttonselected=4

  if buttonselected=1 then goto game
  if buttonselected=2 then goto options
  if buttonselected=3 then goto credits
  if buttonselected=4 then end
sync:loop

options:
  buttonselected=0
do:cls
  buttonpressed=0
  if makebutton(100,350,"BACK")>0 then buttonselected=1
  if makebutton(100,300,"DIFFICULTY")>0 then buttonselected=2
  if makebutton(100,250,"MUSIC")>0 then buttonselected=6
  if makebutton(100,200,"VIDEO")>0 then buttonselected=7

  if buttonselected=1:buttonselected=0:buttonpressed=0:goto menu:endif
  if buttonselected=2
     if makebutton(300,250,"EASY")>0 then buttonselected=3
     if makebutton(300,300,"NORMAL")>0 then buttonselected=4
     if makebutton(300,350,"HARD")>0 then buttonselected=5
     if buttonselected=3 then difficulty#=1
     if buttonselected=4 then difficulty#=2
     if buttonselected=5 then difficulty#=3
     line 200,250,220,250:line 180,300,220,300:line 200,350,220,350:line 200,250,200,350
  endif
  if buttonselected=6
     if makebutton(300,225,"ON")>0 then buttonselected=8
     if makebutton(300,275,"OFF")>0 then buttonselected=9
     if buttonselected=9 then music=0
     if buttonselected=8 then music=1
     line 200,225,220,225:line 200,275,220,275:line 180,250,200,250:line 200,225,200,275
  endif
  if buttonselected=7
     if makebutton(300,150,"640 x 480")>0 then buttonselected=10
     if makebutton(300,200,"800 x 600")>0 then buttonselected=11
     if makebutton(300,250,"1024 x 768")>0 then buttonselected=12
     if buttonselected=10 then set display mode 640,480,16
     if buttonselected=11 then set display mode 800,600,16
     if buttonselected=12 then set display mode 1024,768,16
     line 200,150,220,150:line 180,200,220,200:line 200,250,220,250:line 200,150,200,250
  endif
sync:loop

credits:
  cls:texty#=screen height()
do:cls
  texty#=texty#-0.5
  set text size 20
  center text screen width()/2,texty#,"[ GAME TITLE ]"
  set text size 15
  center text screen width()/2,texty#+20,"by [ Your name ]"
  set text size 12
  center text screen width()/2,texty#+45,"Programmer: [your name]"
  center text screen width()/2,texty#+60,"Menu Programmer: N0iD"
  center text screen width()/2,texty#+75,"2D Arts: [your name]"
  center text screen width()/2,texty#+90,"3D Arts: [your name]"
  center text screen width()/2,texty#+105,"Programming language: DarkBASIC"
  center text screen width()/2,texty#+120,"2D graph. program: [program name]"
  center text screen width()/2,texty#+135,"3D graph. program: [program name]"

  if returnkey()=1:buttonpressed=0:buttonselected=0:goto menu:endif
  if texty#+120<0 then texty#=500
sync:loop

game:
end

function makebutton(x,y,name$)
  buttonpressed=0
  ink rgb(255,255,255),0
  mx=mousex() : my=mousey()
  if mx>x-80 and mx<x+80
     if my>y-15 and my<y+15
        buttonpressed=1
     endif
  endif
  if buttonpressed=1
     ink rgb(100,100,255),0
  endif
  box x-80,y-15,x+80,y+15
  ink rgb(0,0,255),0
  box x-78,y-13,x+78,y+13
  ink rgb(255,255,255),0
  set text size 12 : set text font "arial" : set text to bold : center text x,y-8,name$
  if mouseclick()=0 then buttonpressed=0
endfunction buttonpressed

rem Lukas W 2004
` Initialize
sync on : sync rate 0

` write browser arrays
Dim File$(9999)         : ` Do NOT edit this line!!
Dim EntryY(9999)        : ` Do NOT edit this line!!
Dim File(2)             : ` Do NOT edit this line!!
Dim Filename$(1)        : ` Do NOT edit this line!!
Dim FileDir$(1)         : ` Do NOT edit this line!!
Dim Title$(1)           : ` Do NOT edit this line!!
Dim Drive(1)            : ` Do NOT edit this line!!
Dim Drive$(26)          : ` Do NOT edit this line!!
Dim DriveY(26)          : ` Do NOT edit this line!!
Dim Filter(1)           : ` Do NOT edit this line!!
` number of filters
Filter(1)=5             : ` Nr of Total Filters, you CAN edit this line. (only to replace the '5' number with something else...)
Filter(1)=Filter(1)+1   : ` Do NOT edit this line!!
nr_filter=Filter(1)     : ` Do NOT edit this line!!
` continue arrays
Dim Filter$(nr_filter,2): ` Do NOT edit this line!!
Dim FilterY(nr_filter)  : ` Do NOT edit this line!!

` browser setup
title$(1) = "Browser System v2"
dir$ = get dir$()

` filter setup
Filter$(0,1) = "Any File"
Filter$(1,1) = "Image file"
Filter$(2,1) = "Object file"
Filter$(3,1) = "Movie file"
Filter$(4,1) = "Sound File"
Filter$(5,1) = "Music File"
Filter$(0,2) = "*.*"
Filter$(1,2) = "bmp"
Filter$(2,2) = "3ds"
Filter$(3,2) = "avi"
Filter$(4,2) = "wav"
Filter$(5,2) = "mid"

` call browser
result = Browser_System_v2( dir$ , 100 , 50 )
  ` variable info:
   ` result = 1 : OK button was pressed
   ` result = 2 : CANCEL button was pressed
   ` result = 0 : an error must have happen, it cannot be 0

` if OK was pressed, print File name and File Path, else if cancel was pressed, Exit Demo.
if result = 1
  do:cls rgb(64,196,100)
     ink rgb(0,96,0),0
     print "Hello there!"
     print "This is where the demo ends"
     print "check out for more demos at"
     print "www.n0id.tk"
     print
     ink rgb(32,128,32),0
     print "By the Way:"
     print "Dir: "+FileDir$(1)
     print "File: "+FileName$(1)
     print "Path: "+FileDir$(1)+""+FileName$(1)
     print
     ink rgb(96,128,32),0
     print "Thank you for trying this demo"
     print "Hope you use it in your programgame,"
     print "but dont forget to add me to the credits;)"
     print
     ink rgb(0,32,0),0
     print "Press a Key To Exit Demo"
     print
     ink rgb(0,0,0),0
     print "  -Lukas Wadenhof"

     wait 100
     if mouseclick()>0 then end
     if scancode()>0 then end

  sync:loop
else
  do:cls rgb(64,196,100)
     ink rgb(0,96,0),0
     print "Hello there!"
     print "This is where the demo ends"
     print "check out for more demos at"
     print "www.n0id.tk"
     print
     ink rgb(32,128,32),0
     print "You pressed cancel so nothing happened..    haha*"
     print
     ink rgb(96,128,32),0
     print "Thank you for trying this demo"
     print "Hope you use it in your programgame,"
     print "but dont forget to add me to the credits;)"
     print
     ink rgb(0,32,0),0
     print "Press a Key To Exit Demo"
     print
     ink rgb(0,0,0),0
     print "  -Lukas Wadenhof"
     print
     print
     print
     print
     ink rgb(32,128,32),0
     print "* = loser"

     wait 100
     if mouseclick()>0 then end
     if scancode()>0 then end

  sync:loop
endif


rem ******************************
rem      BROWSER v2 FUNCTION
rem ******************************
function Browser_System_v2( dir$ , x , y )
  cls rgb(64,196,100) : cd dir$ : Cancel = 2 : OK = 1 : selected_filter = 0 : selected=0

  get_browser( x , y )
  get_drives()
  get_filter( x , y )
  get_drive_menu( x , y )
  get_current_dir()
  refresh_list( x , y , selected_filter )

  repeat
     cls rgb(64,196,100)
     paste image 1 , x , y
     mx=mousex()
     my=mousey()
     mc=mouseclick()
     timer=timer+1

     ink 0,0
      print_list( x , y )
     ink 0,0
      if len(FileDir$(1))>=30 then text x+12,y+35,Drive$(Drive(1))+".."+right$(FileDir$(1),23)
      if len(FileDir$(1))<30 then text x+12,y+35,right$(FileDir$(1),29)
      text x+50,y+270,FileName$(1)
      text x+20,y+294,Filter$(selected_filter,1) + "     ["+Filter$(selected_filter,2)+"]"


     rem --------------------
     rem SELECT DRIVE
     rem --------------------
     if mc=1
        if mx>=x+191 and mx<=x+212 and my>=y+28 and my<=y+47
           if (display_it=0 and timer>9) or (display_it=1 and timer>9) then display_it=2:timer=0
        endif
     endif
     if display_it=2
        paste image 3,x+159,y+28
        if mx>= x+159 and mx<= x+(158+32)
           for xd = 1 to DriveY(0)
              if my>= y+28+DriveY(xd)+1 and my<= y+28+DriveY(xd)+14
                 ink rgb(64,196,64),0
                 line x+159,y+28+DriveY(xd)+9,x+171,y+28+DriveY(xd)+9
                 if mc= 1
                    Drive(1)=xd
                    FileDir$(1) = Left$(Drive$(Drive(1)),1)
                    FileDir$(1) = FileDir$(1)+":"
                    set dir FileDir$(1)
                    get_current_dir()
                    refresh_list( x , y , selected_filter )
                 endif
              endif
           next xd
        endif
        if mc>0
           if timer>9 then display_it=0:timer=0
        endif
     endif
     rem --------------------

     rem ------------------
     rem SHOW FILTER BOX
     rem ------------------
     if mx>=x+181 and mx<= x+198 and my>= y+288 and my<= y+304
        if mc = 1
           if (display_it=0 and timer>9) or (display_it=2 and timer>9) then display_it=1:timer=0
        endif
     endif
     if display_it = 1
        paste image 2,x+14,y+305
        if mx>= x+14 and mx<= x+174
           for xd = 0 to Filter(1)
              if my>= y+305+FilterY(xd)+1 and my<= y+305+FilterY(xd)+14
                 ink rgb(64,196,64),0
                 line x+14,y+305+FilterY(xd)+9,x+172,y+305+FilterY(xd)+9
                 if mc= 1
                    filter$=Filter$(xd,2)
                    selected_filter=xd
                    refresh_list( x , y , selected_filter )
                 endif
              endif
           next xd
        endif
        if mc>0
           if timer>9 then display_it=0:timer=0
        endif
     endif
     rem ------------------


     rem -------------------
     rem SELECT FILE
     rem -------------------
     if mx>=x+35 and mx<=x+233 and display_it=0
        for xd = File(1) to File(2)
           if my>= EntryY(xd)+1 and my<= EntryY(xd)+14
              ink rgb(64,196,64),0
              line x+35,EntryY(xd)+9,x+233,EntryY(xd)+9

              if mc=1 and timer>9
                 timer=0 : FileName$(1) = File$(xd)
                 if left$(FileName$(1),1)="[" and right$(FileName$(1),1)="]"
                    letters=len(FileName$(1))
                    poop1$=right$(FileName$(1),letters-1)
                    letters=len(poop1$)
                    poop2$=left$(poop1$,letters-1)
                    FileName$(1)=poop2$
                    set dir FileDir$(1)+"/"+FileName$(1)
                    get_current_dir()
                    refresh_list( x , y , selected_filter )
                 endif
              endif
           endif
        next xd
     endif
     rem --------------------


     rem --------------------
     rem SCROLL ITEMS
     rem --------------------
     if mc=1
        if mx>=x+241 and mx<=x+258
           if my>= y+53 and my<= y+70
              if File(1)>3 then File(1) = File(1) - 1 : File(2) = File(2) - 1
           endif
           if my>= y+239 and my<= y+257
              if File(2)<File(0) then File(1) = File(1) + 1 : File(2) = File(2) + 1
           endif
        endif
     endif
     rem --------------------



     rem --------------------------------------------
     rem PREVIOUS FOLDER AND NEW FOLDER BUTTON
     rem --------------------------------------------
     if mc=1 and timer>9
        timer=0
        if mx>=x+220 and mx<=x+237 and my>=y+29 and my<=y+46
           FileName$(1)=".."
           set dir FileDir$(1)+"/"+FileName$(1)
           get_current_dir()
           refresh_list( x , y , selected_filter )
        endif
        if mx>=x+241 and mx<=x+258 and my>=y+29 and my<=y+46
           FileName$(1)=""
           clear entry buffer
           line$="New Folder"
           repeat
              new$=entry$()
              for n=1 to len(new$)
                 if asc(mid$(new$,n))=8
                    line$=left$(line$,len(line$)-1)
                 else
                    line$=line$+mid$(new$,n)
                 endif
              next n
              clear entry buffer
              if flash$="" then flash$="|" else flash$=""
              cls rgb(64,196,100)
              paste image 1 , x , y
              ink 0,0
               text x+45,y+270,line$+flash$
              mx=mousex()
              my=mousey()
              mc=mouseclick()
              timer=timer+1
              ink 0,0
               print_list( x , y )
              ink 0,0
               text x+12,y+35,right$(FileDir$(1),29)
               text x+50,y+270,FileName$(1)
               text x+20,y+294,Filter$(selected_filter,1) + "     ["+Filter$(selected_filter,2)+"]"
              sync
           until returnkey()=1
           FolderName$=line$
           if Path exist(FileDir$(1)+""+FolderName$)=0
              make directory FolderName$
              FileName$(1)=""
              get_current_dir()
              refresh_list( x , y , selected_filter )
           endif
        endif
     endif
     rem --------------------------------------------

     rem --------------
     rem OK BUTTON
     rem --------------
     if mc=1
        if mx>=x+203 and mx<=x+258 and my>=y+266 and my<=y+280
           if FileName$(1)<>""
              selected=OK
           endif
        endif
     endif
     rem --------------


     rem --------------
     rem CANCEL BUTTON
     rem --------------
     if mc=1
        if mx>=x+203 and mx<=x+258 and my>=y+289 and my<=y+304
           selected=CANCEL
        endif
     endif
     rem --------------
  sync
  until selected>0
endfunction selected


function get_current_dir()
  FileDir$(1) = get dir$()
  perform checklist for files
  File(0)=checklist quantity()
  File(1)=3
  File(2)=File(0)
  if File(2)>9 then File(2)=9
  FileName$(1)=""
endfunction

function refresh_list( x , y , s)
  perform checklist for files
  File(0)=checklist quantity()
  EntryY(File(1))=(y+57)
  file2=1
  for xd = 1 to file(0)
     file$=checklist string$(xd)
     letters=len(file$)
     for t= 1 to letters
        file2$=lower$(file$)
     next t
     if checklist value a(xd)=1
        file2=file2+1
        file$(file2)="["+file2$+"]"
     else
        if Filter$(s,2)="*.*"
           file2=file2+1
           file$(file2)=file2$
        else
           if right$(file2$,1)=Filter$(s,2) then file2=file2+1:file$(file2)=file2$
           if right$(file2$,2)=Filter$(s,2) then file2=file2+1:file$(file2)=file2$
           if right$(file2$,3)=Filter$(s,2) then file2=file2+1:file$(file2)=file2$
           if right$(file2$,4)=Filter$(s,2) then file2=file2+1:file$(file2)=file2$
        endif
     endif
  next x
  File(1)=3
  File(2)=file2
  File(0)=file2
  if File(2)>15 then File(2)=15
endfunction

function print_list( x , y )
  EntryY(File(1)) = y+57
  for xd = File(1) to File(2)
     ink 0,0
     text x+35,EntryY(xd),file$(xd)
     if left$(file$(xd),2)="[." and right$(file$(xd),2)=".]"
        draw_folder_image(x+13,(EntryY(xd)-2))
        draw_arrow_up(x+22,(EntryY(xd)-2))
     endif
     if left$(file$(xd),1)="[" and right$(file$(xd),1)="]"
        draw_folder_image(x+13,(EntryY(xd)-2))
     else
        draw_file_image(x+13,(EntryY(xd)-2))
     endif
     EntryY(xd+1)=EntryY(xd)+15
  next x
endfunction

function draw_folder_image( x , y )
  ink 0,0
   line x,y,x+5,y
   line x,y,x,y+10
   line x,y+10,x+10,y+10
   line x+10,y+10,x+10,y+3
   line x+5,y+3,x+10,y+3
   line x+5,y+0,x+5,y+3
  ink rgb(240,201,128),0
   box x+1,y+1,x+4,y+4
   box x+1,y+4,x+9,y+9
endfunction

function draw_arrow_up( x , y )
  ink 0,0
   line x+4,y,x,y+3
   line x+4,y,x+7,y+2
   dot  x+7,y+2
   line x,y+3,x+2,y+3
   line x+2,y+3,x+2,y+8
   line x+3,y+8,x+5,y+8
   line x+5,y+8,x+5,y+3
   line x+5,y+3,x+7,y+3
  ink rgb(250,64,64),0
   line x+3,y+2,x+3,y+7
   line x+4,y+2,x+4,y+7
   line x+1,y+2,x+6,y+2
   dot x+3,y+1
   dot x+4,y+1
endfunction

function draw_arrow_down( x , y )
  ink 0,0
   line x+2,y,x+5,y
   line x+2,y,x+2,y+5
   line x+5,y,x+5,y+5
   dot x,y+5
   dot x+1,y+5
   dot x+6,y+5
   dot x+7,y+5
   dot x,y+6
   dot x+7,y+6
   dot x+1,y+7
   dot x+2,y+7
   dot x+6,y+7
   dot x+5,y+7
   dot x+3,y+8
   dot x+4,y+8
  ink rgb(250,64,64),0
   dot x+3,y+1
   dot x+4,y+1
   dot x+3,y+2
   dot x+4,y+2
   dot x+3,y+3
   dot x+4,y+3
   dot x+3,y+4
   dot x+4,y+4
   dot x+3,y+5
   dot x+4,y+5
   dot x+1,y+6
   dot x+2,y+6
   dot x+3,y+6
   dot x+4,y+6
   dot x+5,y+6
   dot x+6,y+6
   dot x+3,y+7
   dot x+4,y+7
endfunction


function draw_file_image( x , y )
  ink 0,0
   line x,y,x+5,y
   line x,y,x,y+10
   line x,y+10,x+7,y+10
   line x+7,y+10,x+7,y+3
   line x+5,y,x+7,y+3
  ink rgb(255,255,255),0
   box x+1,y+1,x+5,y+9
   line x+5,y+4,x+5,y+9
   line x+6,y+4,x+6,y+9
endfunction


function get_filter( x , y )
  ink 0,0
   box 0,0,167,Filter(1)*16
  ink rgb(255,255,255),0
   box 1,1,165,(Filter(1)*16)-2
  ink 0,0
   FilterY(0)=3
   for xx = 0 to (Filter(1)-1)
     text 3,FilterY(xx),Filter$(xx,1)+"    ["+Filter$(xx,2)+"]"
     FilterY(xx+1)=FilterY(xx)+16
   next xx
  get image 2,0,0,167,Filter(1)*16
endfunction


function get_drives()
  Perform Checklist For Drives
  DriveY(0)=checklist quantity()
  For x= 1 To DriveY(0)
    a$ = Checklist String$(x)
    Drive$(x)=left$(a$,2)
  Next x
endfunction


function get_drive_menu( x , y )
  ink 0,0
   box 0,0,32,DriveY(0)*15
  ink rgb(255,255,255),0
   box 1,1,30,((DriveY(0)*15)-2)

  ink 0,0
   DriveY(1)=3
   for xx = 1 to DriveY(0)
     text 3,DriveY(xx),Drive$(xx)
     DriveY(xx+1)=DriveY(xx)+16
   next xx
  get image 3,0,0,32,DriveY(0)*15
endfunction

function get_browser( x , y )
  Ink 0,0
   box x,y,x+266,y+316
  ink rgb(116,255,116),0
   box x+1,y+1,x+265,y+21
  ink rgb(64,200,64),0
   box x+2,y+2,x+265,y+21
  ink rgb(116,255,116),0
   set text to normal
   set text font "Terminal",3
   text x+5,y+8,Title$(1)
  ink 0,0
   line x+0,y+21,x+265,y+21
  ink rgb(255,255,255),0
   box x+1,y+22,x+265,y+315
  ink rgb(215,215,215),0
   box x+2,y+23,x+265,y+315
  ink 0,0
   box x+9,y+28,x+212,y+47
   box x+219,y+28,x+238,y+47
   box x+240,y+28,x+259,y+47
   box x+9,y+52,x+238,y+258
   box x+240,y+52,x+259,y+258
   text x+8,y+270,"Name:"
   box x+42,y+264,x+199,y+281
   box x+201,y+264,x+259,y+281
   box x+201,y+287,x+259,y+305
   box x+9,y+287,x+199,y+305
  ink rgb(192,192,192),0
   box x+10,y+29,x+211,y+46
   box x+31,y+53,x+237,y+257
   box x+241,y+53,x+258,y+257
   box x+43,y+265,x+198,y+280
   box x+10,y+288,x+179,y+304
  ink rgb(255,255,255),0
   box x+11,y+30,x+211,y+46
   box x+32,y+54,x+237,y+257
   box x+242,y+54,x+258,y+257
   box x+44,y+266,x+198,y+280
   box x+11,y+289,x+178,y+304
  ink 0,0
   box x+241,y+53,x+258,y+70
   box x+241,y+239,x+258,y+257
   box x+191,y+28,x+212,y+47
   box x+180,y+287,x+199,y+305
  ink rgb(255,255,255),0
   box x+220,y+29,x+237,y+46
   box x+241,y+29,x+258,y+46
   box x+202,y+265,x+258,y+280
   box x+202,y+288,x+258,y+304
   box x+241,y+53,x+258,y+69
   box x+241,y+240,x+258,y+257
   box x+192,y+29,x+211,y+46
   box x+181,y+288,x+198,y+304
  ink rgb(215,215,215),0
   box x+221,y+30,x+237,y+46
   box x+242,y+30,x+258,y+46
   box x+203,y+266,x+258,y+280
   box x+203,y+289,x+258,y+304
   box x+242,y+54,x+258,y+69
   box x+242,y+241,x+258,y+257
   box x+193,y+30,x+211,y+46
   box x+182,y+289,x+198,y+304
  ink 0,0
   box x+10,y+53,x+30,y+257
  ink rgb(116,255,116),0
   box x+10,y+53,x+29,y+257
  ink rgb(64,200,64),0
   box x+11,y+54,x+29,y+257
  ink 0,0
   text x+223,y+269,"OK"
   text x+212,y+293,"Cancel"
   line x+198,y+37,x+204,y+37
   line x+199,y+38,x+203,y+38
   line x+200,y+39,x+202,y+39
   line x+201,y+40,x+201,y+40
   line x+187,y+295,x+193,y+295
   line x+188,y+296,x+192,y+296
   line x+189,y+297,x+191,y+297
   line x+190,y+298,x+190,y+298
   draw_folder_image( x+222 , y+34 )
   draw_arrow_up( x+228 , y+31 )
   draw_folder_image( x+243 , y+34 )
  ink rgb(250,64,64),0
   text x+250,y+30,"+"
  draw_arrow_up( x+246 , y+57 )
  draw_arrow_down( x+246 , y+244 )
  get image 1,x,y,x+267,y+317
endfunction

rem n0id. 2004

sync on : sync rate 0

perform checklist for files

files = checklist quantity()
filetot = 0

dim Filename$(files+1)
dim Filenam$(files+1)

for x = 1 to files
  name$ = checklist string$(x)
  name2$ = lower$(name$)

  if right$(name2$,4)=".3ds"
     fl = len(name2$)
     filetot = filetot +1
     Filename$(filetot) = name2$
     Filenam$(filetot) = left$( name2$ , fl-4 )
     Filenam$(filetot) = Filenam$(filetot)+".x"
  endif
next x

if filetot>0
print "welcome to the 3ds to x converter."
print "press a key to start converting the 3ds files in this folder into x files."
wait key
cls
print "list of files in dir:"
print

for x = 1 to filetot
  print filename$(x);
  print "  ->  ";
  print filenam$(x)
next x
wait key


cls
print "working..."
for x = 1 to filetot
  if file exist(Filenam$(x))=1
     print "WARNING!!"
     print "File Already exist: "+Filenam$(x)
     print
     print "Overwrite?? y/n"
     input overw$
     if overw$ = "y" or overw$ = "Y"
        delete file Filenam$(x)
     else
        skip=1
     endif
  endif
  if skip=0 then 3ds2x filename$(x),Filenam$(x)
  skip=0
next x

cls
print "converting complete"
print
print "do you want to delete the old 3ds files? y/n"
input answer$

if answer$ = "y" or answer$ = "Y"
  goto ending3
else
  goto ending
endif
else
  goto ending2
endif

ending:
cls
print "thank you for trying out my converter."
print "check out my website for more free stuff!"
print
print "http://www.n0id.tk"
print
print
print "n0id"
wait key
end

ending2:
cls
print "there where no files to be converted. please copy files to this folder and try again"
print
print "thank you for trying out my converter."
print "check out my website for more free stuff!"
print
print "http://www.n0id.tk"
print
print "n0id."
wait key
end

ending3:
cls
for x = 1 to filetot
  if file exist(filename$(x))=1 then delete file filename$(x)
next x
print "thank you for trying out my converter."
print "check out my website for more free stuff!"
print
print "http://www.n0id.tk"
print
print
print "n0id"
wait key
end

rem 3D Intro
rem written by: Lukas Wadenhof a.k.a n0id 2004
rem =======================

sync on : sync rate 80 : cls 0

print "N0ID" : get image 1,0,0,40,15      : rem You Can Make An Image and Use the command 'Load Image image$,1'
make object plain 1,100,100 : texture object 1,1
backdrop on : color backdrop rgb(0,0,0)

do : xscale#=xscale#+0.3 : yscale#=yscale#+0.1 : zscale#=zscale#+0.3 : scale object 1,xscale#,yscale#,zscale#
  if xscale#>150 then xscale#=150 else xrotate object 1,wrapvalue(object angle x(1)-2.88)
  if yscale#>50 then yscale#=50: xrotate object 1,0
  if zscale#>150 then zscale#=150:center text 300,400,"N0iDs 3D -intro . v.1.1":center text 300,415,"This and More can be found at my webpage: www.n0id.tk"
  if mouseclick()>0 or returnkey()>0 or spacekey()>0 then delete image 1:delete object 1:goto something
sync:loop

something:
  end

rem Lukas W 2004
` Initialize
sync on : sync rate 0

` write browser arrays
Dim File$(9999)         : ` Do NOT edit this line!!
Dim EntryY(9999)        : ` Do NOT edit this line!!
Dim File(2)             : ` Do NOT edit this line!!
Dim Filename$(1)        : ` Do NOT edit this line!!
Dim FileDir$(1)         : ` Do NOT edit this line!!
Dim Title$(1)           : ` Do NOT edit this line!!
Dim Drive(1)            : ` Do NOT edit this line!!
Dim Drive$(26)          : ` Do NOT edit this line!!
Dim DriveY(26)          : ` Do NOT edit this line!!
Dim Filter(1)           : ` Do NOT edit this line!!
` number of filters
Filter(1)=5             : ` Nr of Total Filters, you CAN edit this line. (only to replace the '5' number with something else...)
Filter(1)=Filter(1)+1   : ` Do NOT edit this line!!
nr_filter=Filter(1)     : ` Do NOT edit this line!!
` continue arrays
Dim Filter$(nr_filter,2): ` Do NOT edit this line!!
Dim FilterY(nr_filter)  : ` Do NOT edit this line!!

` browser setup
title$(1) = "Browser System Pro version"
dir$ = get dir$()

` filter setup
Filter$(0,1) = "Any File"
Filter$(1,1) = "Image file"
Filter$(2,1) = "Object file"
Filter$(3,1) = "Movie file"
Filter$(4,1) = "Sound File"
Filter$(5,1) = "Music File"
Filter$(0,2) = "*.*"
Filter$(1,2) = "bmp"
Filter$(2,2) = "3ds"
Filter$(3,2) = "avi"
Filter$(4,2) = "wav"
Filter$(5,2) = "mid"

` call browser
result = Browser_System_v2( dir$ , 100 , 50 )
  ` variable info:
   ` result = 1 : OK button was pressed
   ` result = 2 : CANCEL button was pressed
   ` result = 0 : an error must have happen, it cannot be 0

` if OK was pressed, print File name and File Path, else if cancel was pressed, Exit Demo.
if result = 1
  do:sync
     cls rgb(64,196,100)
     ink rgb(0,96,0),0
     print "Hello there!"
     print "This is where the demo ends"
     print "check out for more demos at"
     print "www.n0id.tk"
     print
     ink rgb(32,128,32),0
     print "By the Way:"
     print "Dir: "+FileDir$(1)
     print "File: "+FileName$(1)
     print "Path: "+FileDir$(1)+""+FileName$(1)
     print
     ink rgb(96,128,32),0
     print "Thank you for trying this demo"
     print "Hope you use it in your programgame,"
     print "but dont forget to add me to the credits;)"
     print
     ink rgb(0,32,0),0
     print "Press a Key To Exit Demo"
     print
     ink rgb(0,0,0),0
     print "  -Lukas Wadenhof"

     wait 100
     if mouseclick()>0 then end
     if scancode()>0 then end

  loop
else
  do:sync:cls rgb(64,196,100)
     ink rgb(0,96,0),0
     print "Hello there!"
     print "This is where the demo ends"
     print "check out for more demos at"
     print "www.n0id.tk"
     print
     ink rgb(32,128,32),0
     print "You pressed cancel so nothing happened..    haha*"
     print
     ink rgb(96,128,32),0
     print "Thank you for trying this demo"
     print "Hope you use it in your programgame,"
     print "but dont forget to add me to the credits;)"
     print
     ink rgb(0,32,0),0
     print "Press a Key To Exit Demo"
     print
     ink rgb(0,0,0),0
     print "  -Lukas Wadenhof"
     print
     print
     print
     print
     ink rgb(32,128,32),0
     print "* = loser"

     wait 100
     if mouseclick()>0 then end
     if scancode()>0 then end

  loop
endif


rem ******************************
rem      BROWSER v2 FUNCTION
rem ******************************
function Browser_System_v2( dir$ , x , y )
  cls rgb(64,196,100) : cd dir$ : Cancel = 2 : OK = 1 : selected_filter = 0 : selected=0

  get_browser( x , y )
  get_drives()
  get_filter( x , y )
  get_drive_menu( x , y )
  get_current_dir()
  refresh_list( x , y , selected_filter )

  repeat
     cls rgb(64,196,100)
     paste image 1 , x , y
     mx=mousex()
     my=mousey()
     mc=mouseclick()
     timerr=timerr+1

     ink 0,0
      print_list( x , y )
     ink 0,0
      if len(FileDir$(1))>=30 then text x+12,y+35,Drive$(Drive(1))+".."+right$(FileDir$(1),23)
      if len(FileDir$(1))<30 then text x+12,y+35,right$(FileDir$(1),29)
      text x+50,y+270,FileName$(1)
      text x+20,y+294,Filter$(selected_filter,1) + "     ["+Filter$(selected_filter,2)+"]"


     rem --------------------
     rem SELECT DRIVE
     rem --------------------
     if mc=1
        if mx>=x+191 and mx<=x+212 and my>=y+28 and my<=y+47
           if (display_it=0 and timerr>9) or (display_it=1 and timerr>9) then display_it=2:timerr=0
        endif
     endif
     if display_it=2
        paste image 3,x+159,y+28
        if mx>= x+159 and mx<= x+(158+32)
           for xd = 1 to DriveY(0)
              if my>= y+28+DriveY(xd)+1 and my<= y+28+DriveY(xd)+14
                 ink rgb(64,196,64),0
                 line x+159,y+28+DriveY(xd)+9,x+171,y+28+DriveY(xd)+9
                 if mc= 1
                    Drive(1)=xd
                    FileDir$(1) = Left$(Drive$(Drive(1)),1)
                    FileDir$(1) = FileDir$(1)+":"
                    set dir FileDir$(1)
                    get_current_dir()
                    refresh_list( x , y , selected_filter )
                 endif
              endif
           next xd
        endif
        if mc>0
           if timerr>9 then display_it=0:timerr=0
        endif
     endif
     rem --------------------

     rem ------------------
     rem SHOW FILTER BOX
     rem ------------------
     if mx>=x+181 and mx<= x+198 and my>= y+288 and my<= y+304
        if mc = 1
           if (display_it=0 and timerr>9) or (display_it=2 and timerr>9) then display_it=1:timerr=0
        endif
     endif
     if display_it = 1
        paste image 2,x+14,y+305
        if mx>= x+14 and mx<= x+174
           for xd = 0 to Filter(1)
              if my>= y+305+FilterY(xd)+1 and my<= y+305+FilterY(xd)+14
                 ink rgb(64,196,64),0
                 line x+14,y+305+FilterY(xd)+9,x+172,y+305+FilterY(xd)+9
                 if mc= 1
                    filter$=Filter$(xd,2)
                    selected_filter=xd
                    refresh_list( x , y , selected_filter )
                 endif
              endif
           next xd
        endif
        if mc>0
           if timerr>9 then display_it=0:timerr=0
        endif
     endif
     rem ------------------


     rem -------------------
     rem SELECT FILE
     rem -------------------
     if mx>=x+35 and mx<=x+233 and display_it=0
        for xd = File(1) to File(2)
           if my>= EntryY(xd)+1 and my<= EntryY(xd)+14
              ink rgb(64,196,64),0
              line x+35,EntryY(xd)+9,x+233,EntryY(xd)+9

              if mc=1 and timerr>9
                 timerr=0 : FileName$(1) = File$(xd)
                 if left$(FileName$(1),1)="[" and right$(FileName$(1),1)="]"
                    letters=len(FileName$(1))
                    poop1$=right$(FileName$(1),letters-1)
                    letters=len(poop1$)
                    poop2$=left$(poop1$,letters-1)
                    FileName$(1)=poop2$
                    set dir FileDir$(1)+"/"+FileName$(1)
                    get_current_dir()
                    refresh_list( x , y , selected_filter )
                 endif
              endif
           endif
        next xd
     endif
     rem --------------------


     rem --------------------
     rem SCROLL ITEMS
     rem --------------------
     if mc=1
        if mx>=x+241 and mx<=x+258
           if my>= y+53 and my<= y+70
              if File(1)>3 then File(1) = File(1) - 1 : File(2) = File(2) - 1
           endif
           if my>= y+239 and my<= y+257
              if File(2)<File(0) then File(1) = File(1) + 1 : File(2) = File(2) + 1
           endif
        endif
     endif
     rem --------------------



     rem --------------------------------------------
     rem PREVIOUS FOLDER AND NEW FOLDER BUTTON
     rem --------------------------------------------
     if mc=1 and timerr>9
        timerr=0
        if mx>=x+220 and mx<=x+237 and my>=y+29 and my<=y+46
           FileName$(1)=".."
           set dir FileDir$(1)+"/"+FileName$(1)
           get_current_dir()
           refresh_list( x , y , selected_filter )
        endif
        if mx>=x+241 and mx<=x+258 and my>=y+29 and my<=y+46
           FileName$(1)=""
           clear entry buffer
           line$="New Folder"
           repeat
              new$=entry$()
              for n=1 to len(new$)
                 if asc(mid$(new$,n))=8
                    line$=left$(line$,len(line$)-1)
                 else
                    line$=line$+mid$(new$,n)
                 endif
              next n
              clear entry buffer
              if flash$="" then flash$="|" else flash$=""
              cls rgb(64,196,100)
              paste image 1 , x , y
              ink 0,0
               text x+45,y+270,line$+flash$
              mx=mousex()
              my=mousey()
              mc=mouseclick()
              timerr=timerr+1
              ink 0,0
               print_list( x , y )
              ink 0,0
               text x+12,y+35,right$(FileDir$(1),29)
               text x+50,y+270,FileName$(1)
               text x+20,y+294,Filter$(selected_filter,1) + "     ["+Filter$(selected_filter,2)+"]"
              sync
           until returnkey()=1
           FolderName$=line$
           if Path exist(FileDir$(1)+""+FolderName$)=0
              make directory FolderName$
              FileName$(1)=""
              get_current_dir()
              refresh_list( x , y , selected_filter )
           endif
        endif
     endif
     rem --------------------------------------------

     rem --------------
     rem OK BUTTON
     rem --------------
     if mc=1
        if mx>=x+203 and mx<=x+258 and my>=y+266 and my<=y+280
           if FileName$(1)<>""
              selected=OK
           endif
        endif
     endif
     rem --------------


     rem --------------
     rem CANCEL BUTTON
     rem --------------
     if mc=1
        if mx>=x+203 and mx<=x+258 and my>=y+289 and my<=y+304
           selected=CANCEL
        endif
     endif
     rem --------------
  sync
  until selected>0
endfunction selected

function get_current_dir()
  FileDir$(1) = get dir$()
  perform checklist for files
  File(0)=checklist quantity()
  File(1)=3
  File(2)=File(0)
  if File(2)>9 then File(2)=9
  FileName$(1)=""
endfunction

function refresh_list( x , y , s)
  perform checklist for files
  File(0)=checklist quantity()
  EntryY(File(1))=(y+57)
  file2=1
  for xd = 1 to file(0)
     file$=checklist string$(xd)
     letters=len(file$)
     for t= 1 to letters
        file2$=lower$(file$)
     next t
     if checklist value a(xd)=1
        file2=file2+1
        file$(file2)="["+file2$+"]"
     else
        if Filter$(s,2)="*.*"
           file2=file2+1
           file$(file2)=file2$
        else
           if right$(file2$,1)=Filter$(s,2) then file2=file2+1:file$(file2)=file2$
           if right$(file2$,2)=Filter$(s,2) then file2=file2+1:file$(file2)=file2$
           if right$(file2$,3)=Filter$(s,2) then file2=file2+1:file$(file2)=file2$
           if right$(file2$,4)=Filter$(s,2) then file2=file2+1:file$(file2)=file2$
        endif
     endif
  next x
  File(1)=3
  File(2)=file2
  File(0)=file2
  if File(2)>15 then File(2)=15
endfunction

function print_list( x , y )
  EntryY(File(1)) = y+57
  for xd = File(1) to File(2)
     ink 0,0
     text x+35,EntryY(xd),file$(xd)
     if left$(file$(xd),2)="[." and right$(file$(xd),2)=".]"
        draw_folder_image(x+13,(EntryY(xd)-2))
        draw_arrow_up(x+22,(EntryY(xd)-2))
     endif
     if left$(file$(xd),1)="[" and right$(file$(xd),1)="]"
        draw_folder_image(x+13,(EntryY(xd)-2))
     else
        draw_file_image(x+13,(EntryY(xd)-2))
     endif
     EntryY(xd+1)=EntryY(xd)+15
  next x
endfunction

function draw_folder_image( x , y )
  ink 0,0
   line x,y,x+5,y
   line x,y,x,y+10
   line x,y+10,x+10,y+10
   line x+10,y+10,x+10,y+3
   line x+5,y+3,x+10,y+3
   line x+5,y+0,x+5,y+3
  ink rgb(240,201,128),0
   box x+1,y+1,x+4,y+4
   box x+1,y+4,x+9,y+9
endfunction

function draw_arrow_up( x , y )
  ink 0,0
   line x+4,y,x,y+3
   line x+4,y,x+7,y+2
   dot  x+7,y+2
   line x,y+3,x+2,y+3
   line x+2,y+3,x+2,y+8
   line x+3,y+8,x+5,y+8
   line x+5,y+8,x+5,y+3
   line x+5,y+3,x+7,y+3
  ink rgb(250,64,64),0
   line x+3,y+2,x+3,y+7
   line x+4,y+2,x+4,y+7
   line x+1,y+2,x+6,y+2
   dot x+3,y+1
   dot x+4,y+1
endfunction

function draw_arrow_down( x , y )
  ink 0,0
   line x+2,y,x+5,y
   line x+2,y,x+2,y+5
   line x+5,y,x+5,y+5
   dot x,y+5
   dot x+1,y+5
   dot x+6,y+5
   dot x+7,y+5
   dot x,y+6
   dot x+7,y+6
   dot x+1,y+7
   dot x+2,y+7
   dot x+6,y+7
   dot x+5,y+7
   dot x+3,y+8
   dot x+4,y+8
  ink rgb(250,64,64),0
   dot x+3,y+1
   dot x+4,y+1
   dot x+3,y+2
   dot x+4,y+2
   dot x+3,y+3
   dot x+4,y+3
   dot x+3,y+4
   dot x+4,y+4
   dot x+3,y+5
   dot x+4,y+5
   dot x+1,y+6
   dot x+2,y+6
   dot x+3,y+6
   dot x+4,y+6
   dot x+5,y+6
   dot x+6,y+6
   dot x+3,y+7
   dot x+4,y+7
endfunction

function draw_file_image( x , y )
  ink 0,0
   line x,y,x+5,y
   line x,y,x,y+10
   line x,y+10,x+7,y+10
   line x+7,y+10,x+7,y+3
   line x+5,y,x+7,y+3
  ink rgb(255,255,255),0
   box x+1,y+1,x+5,y+9
   line x+5,y+4,x+5,y+9
   line x+6,y+4,x+6,y+9
endfunction

function get_filter( x , y )
  ink 0,0
   box 0,0,167,Filter(1)*16
  ink rgb(255,255,255),0
   box 1,1,165,(Filter(1)*16)-2
  ink 0,0
   FilterY(0)=3
   for xx = 0 to (Filter(1)-1)
     text 3,FilterY(xx),Filter$(xx,1)+"    ["+Filter$(xx,2)+"]"
     FilterY(xx+1)=FilterY(xx)+16
   next xx
  get image 2,0,0,167,Filter(1)*16
endfunction

function get_drives()
  Perform Checklist For Drives
  DriveY(0)=checklist quantity()
  For x= 1 To DriveY(0)
    a$ = Checklist String$(x)
    Drive$(x)=left$(a$,2)
  Next x
endfunction

function get_drive_menu( x , y )
  ink 0,0
   box 0,0,32,DriveY(0)*15
  ink rgb(255,255,255),0
   box 1,1,30,((DriveY(0)*15)-2)

  ink 0,0
   DriveY(1)=3
   for xx = 1 to DriveY(0)
     text 3,DriveY(xx),Drive$(xx)
     DriveY(xx+1)=DriveY(xx)+16
   next xx
  get image 3,0,0,32,DriveY(0)*15
endfunction

function get_browser( x , y )
  Ink 0,0
   box x,y,x+266,y+316
  ink rgb(116,255,116),0
   box x+1,y+1,x+265,y+21
  ink rgb(64,200,64),0
   box x+2,y+2,x+265,y+21
  ink rgb(116,255,116),0
   set text to normal
   set text font "Terminal",3
   set text size 9
   text x+5,y+8,Title$(1)
  ink 0,0
   line x+0,y+21,x+265,y+21
  ink rgb(255,255,255),0
   box x+1,y+22,x+265,y+315
  ink rgb(215,215,215),0
   box x+2,y+23,x+265,y+315
  ink 0,0
   box x+9,y+28,x+212,y+47
   box x+219,y+28,x+238,y+47
   box x+240,y+28,x+259,y+47
   box x+9,y+52,x+238,y+258
   box x+240,y+52,x+259,y+258
   text x+8,y+270,"Name:"
   box x+42,y+264,x+199,y+281
   box x+201,y+264,x+259,y+281
   box x+201,y+287,x+259,y+305
   box x+9,y+287,x+199,y+305
  ink rgb(192,192,192),0
   box x+10,y+29,x+211,y+46
   box x+31,y+53,x+237,y+257
   box x+241,y+53,x+258,y+257
   box x+43,y+265,x+198,y+280
   box x+10,y+288,x+179,y+304
  ink rgb(255,255,255),0
   box x+11,y+30,x+211,y+46
   box x+32,y+54,x+237,y+257
   box x+242,y+54,x+258,y+257
   box x+44,y+266,x+198,y+280
   box x+11,y+289,x+178,y+304
  ink 0,0
   box x+241,y+53,x+258,y+70
   box x+241,y+239,x+258,y+257
   box x+191,y+28,x+212,y+47
   box x+180,y+287,x+199,y+305
  ink rgb(255,255,255),0
   box x+220,y+29,x+237,y+46
   box x+241,y+29,x+258,y+46
   box x+202,y+265,x+258,y+280
   box x+202,y+288,x+258,y+304
   box x+241,y+53,x+258,y+69
   box x+241,y+240,x+258,y+257
   box x+192,y+29,x+211,y+46
   box x+181,y+288,x+198,y+304
  ink rgb(215,215,215),0
   box x+221,y+30,x+237,y+46
   box x+242,y+30,x+258,y+46
   box x+203,y+266,x+258,y+280
   box x+203,y+289,x+258,y+304
   box x+242,y+54,x+258,y+69
   box x+242,y+241,x+258,y+257
   box x+193,y+30,x+211,y+46
   box x+182,y+289,x+198,y+304
  ink 0,0
   box x+10,y+53,x+30,y+257
  ink rgb(116,255,116),0
   box x+10,y+53,x+29,y+257
  ink rgb(64,200,64),0
   box x+11,y+54,x+29,y+257
  ink 0,0
   text x+223,y+269,"OK"
   text x+212,y+293,"Cancel"
   line x+198,y+37,x+204,y+37
   line x+199,y+38,x+203,y+38
   line x+200,y+39,x+202,y+39
   line x+201,y+40,x+201,y+40
   line x+187,y+295,x+193,y+295
   line x+188,y+296,x+192,y+296
   line x+189,y+297,x+191,y+297

   line x+190,y+298,x+190,y+298
   draw_folder_image( x+222 , y+34 )
   draw_arrow_up( x+228 , y+31 )
   draw_folder_image( x+243 , y+34 )
  ink rgb(250,64,64),0
   text x+250,y+30,"+"
  draw_arrow_up( x+246 , y+57 )
  draw_arrow_down( x+246 , y+244 )
  get image 1,x,y,x+267,y+317
endfunction

rem Lukas W August 2005

sync on : sync rate 0

perform checklist for files

files = checklist quantity()
filetot = 0

dim Filename$(files+1)
dim Filenam$(files+1)

for x = 1 to files
 name$ = checklist string$(x)
 name2$ = lower$(name$)

 if right$(name2$,4)=".3ds"
    fl = len(name2$)
    filetot = filetot +1
    Filename$(filetot) = name2$
    Filenam$(filetot) = left$( name2$ , fl-4 )
    Filenam$(filetot) = Filenam$(filetot)+".dbo"
 endif

 if right$(name2$,2)=".x"
    fl = len(name2$)
    filetot = filetot +1
    Filename$(filetot) = name2$
    Filenam$(filetot) = left$( name2$ , fl-2 )
    Filenam$(filetot) = Filenam$(filetot)+".dbo"
 endif

 if right$(name2$,4)=".mdl"
    fl = len(name2$)
    filetot = filetot +1
    Filename$(filetot) = name2$
    Filenam$(filetot) = left$( name2$ , fl-4 )
    Filenam$(filetot) = Filenam$(filetot)+".dbo"
 endif

 if right$(name2$,4)=".md2"
    fl = len(name2$)
    filetot = filetot +1
    Filename$(filetot) = name2$
    Filenam$(filetot) = left$( name2$ , fl-4 )
    Filenam$(filetot) = Filenam$(filetot)+".dbo"
 endif

 if right$(name2$,4)=".md3"
    fl = len(name2$)
    filetot = filetot +1
    Filename$(filetot) = name2$
    Filenam$(filetot) = left$( name2$ , fl-4 )
    Filenam$(filetot) = Filenam$(filetot)+".dbo"
 endif
next x

if filetot>0
sync
print "welcome to the object converter."
print "press a key to start converting the object files in this folder into .dbo files."
sync
wait key
cls : sync
print "list of files in dir:"
print

for x = 1 to filetot
 print filename$(x);
 print "  ->  ";
 print filenam$(x)
next x
sync
wait key


cls : sync
print "working..." : sync
for x = 1 to filetot
 if file exist(Filenam$(x))=1
    print "WARNING!!"
    print "File Already exist: "+Filenam$(x)
    print
    print "Overwrite?? y/n"
    sync
    input overw$
    sync
    if overw$ = "y" or overw$ = "Y"
       delete file Filenam$(x)
    else
       skip=1
    endif
 endif
 if skip=0 then load object Filename$(x),1 : save object Filenam$(x), 1 : delete object 1
 skip=0 : backdrop off
next x

cls : sync
print "converting complete"
print
print "do you want to delete the old object files? y/n" : sync
input answer$ : sync

if answer$ = "y" or answer$ = "Y"
 goto ending3
else
 goto ending
endif
else
 goto ending2
endif

ending:
cls
sync
print "thank you for trying out my converter."
print "check out my website for more free stuff!"
print
print "http://www.lukashangout.tk"
print
print
print "n0id"
sync
wait key
end

ending2:
cls
sync
print "there where no files to be converted. please copy files to this folder and try again"
print
print "thank you for trying out my converter."
print "check out my website for more free stuff!"
print
print "http://www.lukashangout.tk"
print
print "Lukas W"
sync
wait key
end

ending3:
cls
sync
for x = 1 to filetot
 if file exist(filename$(x))=1 then delete file filename$(x)
next x
print "thank you for trying out my converter."
print "check out my website for more free stuff!"
print
print "http://www.n0id.tk"
print
print
print "n0id"
sync
wait key
end

rem
rem   DARK BASIC PROFESSIONAL BEGINNER TUTORIALS 2005
rem   ===============================================
rem           Lukas W http://lukashangout.tk
rem   -----------------------------------------------
rem
rem   BASIC INPUT
rem   ===============================================
rem    Tutorial  Shows  a  Realy  Basic Input  Method
rem    Everyone has started  with print "hello world"
rem    I think Now is a good time  to learn something
rem    More,  something  a little  bit more advanced.
rem   -----------------------------------------------
rem

rem You should probably know by now that 'REM' means 'REMARK'
rem And is used to write down messages so you will remember
rem What this particular code snippet does, incase you would
rem Forget. REMARKS are also good for tutorials. A REMARK is
rem A Command That DarkBASIC Pro Will Ignore. So you can write
rem Whatever you feel like, after the 'REM'. and you can never
rem Have to many of them :)




SYNC ON
SYNC RATE 40
rem SYNC ON   - Means we are turning on Manual Syncing, or
rem             Manual updating of the Screen. by using this
rem             Command we will be able to boost up the
rem             Performance of the Application.
rem
rem SYNC RATE - This will make sure we have a Maximum Rate
rem             The screen can be updated at. The human eye
rem             has a sync rate at 60, Movies use 30. so 40
rem             will be a comfortable speed to play at.
rem             When making 3D games it is recommended that
rem             you use a Sync Rate of 60 or more, because
rem             alot more data can be calculated and we will
rem             be able to skip the Lag of the game. :)




HIDE MOUSE
rem HIDE MOUSE - This command is quite self explaining
rem              It will hide the mouse cursor ;) to
rem              Display the mouse again, use SHOW MOUSE



SYNC
INPUT "What is your name? >", Name$
PRINT "Your name seems to be ", Name$
SYNC
rem SYNC      - This Command will update the screen
rem
rem INPUT     - This Command will halt the Application
rem             until ENTER is pressed. when ENTER is
rem             pressed the Value you entered will be
rem             Stored in the Variable you Select.
rem             In this case we ask for a name, the
rem             name you enter is stored in a variable
rem             called 'Name$' which is a string.
rem             if the variable is a string we can press
rem             any keys on the keyboard that is considered
rem             a letter, number or symbol.
rem             if we use an integer or float we can only
rem             press keys that are considered Numbers.
rem
rem PRINT     - This command will print something to the
rem             screen at where the cursor is currently
rem             located. the cursors startpoint is 0,0.
rem             Change the Position of the Cursor using
rem             'SET CURSOR xPos, yPos' where xPos equals
rem             the xPosition on the screen and yPos
rem             equals the yPosition on the screen.
rem             You can use commas (,) to include variables
rem             or text that should be printed on the same
rem             line. When using the PRINT command and not
rem             actually printing anything, you will make
rem             an empty line. (see below for more examples)

SYNC
PRINT
INPUT "What is your Age? >", Age
PRINT "Ok, you are ", Age, "years old"
SYNC

PRINT
PRINT "Press any key to Clear The Screen and exit"

WAIT KEY
CLS
rem WAIT KEY - this command will make the
rem            application halt until a
rem            keyboard button is pressed.
rem
rem CLS      - cls is short for Clear the Screen
rem            in the old days one had to make a
rem            loop that each loop would color a
rem            pixel on the screen to black. That
rem            would take up lots of lines of code
rem            using DarkBASIC we can do this in
rem            one word with only three letters :D

` Setup Screen
SYNC ON : SYNC RATE 0 : HIDE MOUSE



` Create Globals
GLOBAL G_MAXIMUMLIFE  AS FLOAT
GLOBAL G_CURRENTLIFE  AS FLOAT
GLOBAL G_HEALTHBARX   AS INTEGER
GLOBAL G_HEALTHBARY   AS INTEGER
GLOBAL G_HEALTHBARW   AS INTEGER
GLOBAL G_HEALTHBARH   AS INTEGER
GLOBAL G_DIRECTION    AS STRING
GLOBAL G_TRIGGER      AS STRING



` Give the Variables some values... quite self explaining ;)
G_MAXIMUMLIFE  = 500
G_CURRENTLIFE  = 500
G_HEALTHBARX   =  50
G_HEALTHBARY   = 120
G_HEALTHBARW   = 200
G_HEALTHBARH   =   5
G_DIRECTION    = "horizontal"
`G_DIRECTION    = "vertical"
`G_TRIGGER      = "positive"
G_TRIGGER      = "negative"





` Start the Loop
While Not EscapeKey()

 ` We are Using 2D rendering in this example, so we need to clear
 ` the screen before new data is printed ;)
 CLS 0

 ` If Player Press a key, change this variable by 1
 if scancode()>0 then dec G_CURRENTLIFE, 1

 ` This Function Will Draw Our Bar
 createBar( G_HEALTHBARX, G_HEALTHBARY, G_HEALTHBARW, G_HEALTHBARH, G_CURRENTLIFE, G_MAXIMUMLIFE, G_DIRECTION, G_TRIGGER )

 ` Print Screen FPS
 SET CURSOR SCREEN WIDTH()-50, SCREEN HEIGHT()-25 : PRINT SCREEN FPS()

 SYNC
EndWhile : End




` CREATEBAR FUNCTION
`  EXPLANATION;
`   xPos - xPosition of Bar | yPos - yPosition of Bar
`   xSize - Width of Bar | ySize - Height of Bar
`   current - Current Value of Variable
`   maximum - Maximum Value of Variable
`   direction - Horizontal or Vertical
`   trigger - Positive or Negative (add or subract)
`  RETURNS;
`   0 - Nothing
`   +1 - Below 0
`   +2 - Above Maximum
Function createBar( xPos, yPos, xSize, ySize, current as float, maximum as float, direction as string, trigger as string)

 ` First Make a Background That Will Never Change Size
 INK RGB(255,255,255),0
  if direction="horizontal" then BOX xPos, yPos, xSize, yPos+ySize
  if direction="vertical"   then BOX xPos, yPos, xPos+xSize, ySize

 ` Calcuate How Many Percent of the Bar is to be Drawned
 if trigger = "negative" then Temp1# = current / maximum
 if trigger = "positive" then Temp1# = (maximum / current) -1.0

 ` Calculate The Width of the Bar
 if direction="horizontal" then Temp2 = int(xSize * Temp1#)
 if direction="vertical"   then Temp2 = int(ySize * Temp1#)

 ` Draw the Box over the Background
 INK RGB(255,0,0),0
  if direction="horizontal" then BOX xPos, yPos, Temp2, yPos+ySize
  if direction="vertical"   then BOX xPos, yPos, xPos+xSize, Temp2

 ` Print Some Info | (Remove these Four Lines)
 INK RGB(255,255,255),0
 text 50, 50, str$(int(Temp1#*100))+"% or the Bar is Drawed"
 text 50, 65, "Width: "+str$(Temp2)+" / "+str$( xSize )
 text 50, 80, "Life: "+str$(current)+" / "+str$( maximum )
 ` -------------------------------------------

EndFunction

rem + =not yet implemented

rem Here is a little FADING example.. This is in 2D incase you didnt know..
rem written by: Lukas Wadenhod a.k.a n0id

set gamma 0,0,0 : ink rgb(255,255,255),0

   CENTER TEXT 320,200,"FADING DEMO"

   for x = 0 to 200 step 4
      set gamma x,x,x
   next x

   wait 200

   for x = 0 to 200 step 4
      r = 200-x
      set gamma r,r,r
   next x

   wait 200

   CENTER TEXT 320,230,"By N0iD"

   for x = 0 to 200 step 4
      set gamma x,x,x
   next x

   wait 200

   for x = 0 to 200 step 4
      r = 200-x
      set gamma r,r,r
   next x

   ELLIPSE 320,240,100,100
   CENTER TEXT 320,260,"This and More can be found at my webpage. www.n0id.tk"

   for x = 0 to 200 step 4
      set gamma x,x,x
   next x

   do
      if scancode()>0 or mouseclick()>0 then end
   loop

rem shooting, by lukas w : January 2005
rem --------------------
sync on : sync rate 60 : hide mouse





Dim Bullets(1)  : rem Bullets for 1 weapons
Bullets(1) = 12 : rem Weapon Have 12 Bullets

Dim Max_Bullets(1) : rem Maximum Bullets availiable for weapon
Max_Bullets(1) = Bullets(1) : rem 12 ;)

Dim Fired(1,Bullets(1)) : rem Variable to check if Current Bullet is fired from weapon

Dim Bullet_Speed(1) : rem Speed for Bullets
Bullet_Speed(1) = 250 : rem If the bullet is a rocket, better make speed slower and bullet_life longer ;)

Dim Ammo(1)  : rem This is how much ammo you have in inventory for weapon 1
Ammo(1) = 48 : rem 48 bullets in inventory







rem Make all Bullets
for X = 500 to (Max_Bullets(1)+500)
   Make Object Sphere x, 2
   Hide Object x
next X

rem Make Weapon
make object cylinder 1, 50
scale object 1, 99, 100, 99
xrotate object 1, 90
fix object pivot 1






rem Make World
make matrix 1, 5000, 5000, 100, 100
set matrix wireframe off 1
randomize matrix 1, 50
update matrix 1

fog on
fog distance 3000
fog color rgb(200, 200, 200)
color backdrop rgb(200, 200, 200)

make object box 2, 75, 200, 75
position object 2,rnd(2000), 25, rnd(2000)






do

   mc = mouseclick()





   rem Handle Camera and GUI
   xang# = wrapvalue( xang# + mousemovey()*1.5 )
   yang# = wrapvalue( yang# + mousemovex()*1.5 )

   if upkey()=1 then xpos# = newxvalue(xpos#, yang#, 10):zpos# = newzvalue(zpos#, yang#, 10)
   if downkey()=1 then xpos# = newxvalue(xpos#, yang#, -10):zpos# = newzvalue(zpos#, yang#, -10)
   if leftkey()=1 then xpos# = newxvalue(xpos#, yang#*90, 10):zpos# = newzvalue(zpos#, yang#*90, 10)
   if rightkey()=1 then xpos# = newxvalue(xpos#, yang#*-90, 10):zpos# = newzvalue(zpos#, yang#*-90, 10)

   ypos# = get ground height(1, xpos#, zpos#)+ 50

   position camera xpos#, ypos#, zpos#
   rotate camera xang#, yang#, 0

   position object 1,xpos#,ypos#,zpos#
   yrotate object 1,wrapvalue(yang#)
   xrotate object 1,wrapvalue(xang#)


   ink rgb(255, 0, 0), 0
   dot screen width()/2, screen height()/2
   text 0,0, str$(Bullets(1))+" / "+str$(ammo(1))





   rem Check if Player Wants to- and Can Fire
   if mc=1 and Bullets(1)>0 and waiting<=0
     Pistol_Fire=1
     waiting=25
   endif

   rem Check if There are No More Bullets Left
   if mc=1 and Bullets(1)<=0 and waiting<=0
      Pistol_Fire=4
      waiting=25
   endif

   rem Check if Player Want To Reload
   if Keystate(19)=1 or mc=4 : ` 19 = R
      Reload = 1
   endif





   rem This Code Will Check For Free Bullet To Fire
   if Pistol_Fire=1
      ready_bullet=0
      repeat
         if ready_bullet>12 then ready_bullet=0 : rem If variable goes over 12 (12 is max bullets) go to bullet 0 again
         inc ready_bullet

         rem Now we check if This Bullet Can Be fired, or if it allready is fired
         if fired(1,ready_bullet)=0
            fired(1,ready_bullet)=1
            current_bullet = ready_bullet
            Pistol_Fire=2
            Bullets(1)=Bullets(1) -1
         endif
      until Pistol_Fire=2
   endif





   rem This Code Will Position Bullet in front of Camera
   if Pistol_Fire=2

      rem We Show the Free Bullet
      free_bullet = (Max_Bullets(1) + 500 ) - current_bullet

      show object free_bullet
      position object free_bullet,camera position x(),camera position y(),camera position z()
      set object to camera orientation free_bullet

      ` play gun fire sound here
      Pistol_Fire=3
   endif





   rem This Code Will Move Bullet Forward until it dies
   rem now with added bullet collision.. but its buggy
   if Pistol_Fire=3
      inc Bullet_Life

      Move object free_bullet, Bullet_Speed(1)

      rem bullet collision
      collide = object collision(free_bullet, 0)
      if collide > 0
         yrotate object collide, rnd(180)
      endif

      if Bullet_Life >= 15
         Bullet_Life = 0
         Hide object free_bullet
         fired(1,current_bullet)=0
         Pistol_Fire=0
         waiting=0
      endif
   endif





   rem What to do if There are No More Bullets Left
   if Pistol_Fire=4
      repeat
         dec waiting
      until waiting<=0
      ` play no ammo sound here
      Pistol_Fire=0
   endif





   rem How to Reload Weapon
   if Reload = 1
      if Bullets(1) < 12 : rem if bullets are not at maximum then you can reload
         if Ammo(1) > 0
            Ammo(1) = Ammo(1) + Bullets(1) : rem Move Remaining Bullets in Gun to inventory
            Bullets(1) = 0 : rem Bullets in Gun is 0
            if Ammo(1)>=12 : rem Check if player have more that 12 Bullets in Inventory
               Bullets(1)=Bullets(1)+12 : rem If true, then add 12 Bullets to Gun...
               ` Play Reload Sound here

            else
               Bullets(1)=Bullets(1)+Ammo(1) : rem  ...else Move Bullets from Inventory and Put Them in the Gun
               ` Play Reload Sound here
            endif
            Ammo(1)=Ammo(1)-Bullets(1)
            pistol_reload=0
         else
            pistol_reload=0
         endif
      else
         pistol_reload=0
      endif
   endif

Sync : Loop

rem ==========================
rem     n0ids Small Library
rem        NSL-2D Library
rem ==========================

Rem First Command is:
SetFont$("arial narrow",16,0,0,0,255,255,255,255,0,0)

Rem Secound Command is:
Rem Usage: REPLACE$(string$, letter to replace, letter to replace with)
print "function replace$("Cate","t","k")"
print replace$("Cate","t","k")
print
rem This function will start a search for a letter in a word or a string..
rem if the letter exist in the word or string,
rem all letters of that kind will be replaced with the specified letter.
rem In this example The Name 'Cate' will be replaced by 'Cake'

Rem Then we have this:
Rem Usage: FindLetterNumber(string$, letter to find, letter to start search from)
rem        .. Remember that if the letter you search for is in UPPER state then the search letter must be so also.
print "function FindLetterNumber("The Number is three","N",2)"
print FindLetterNumber("The Number is three","N",2)
print
rem This function will start a search for a letter in a word or in a string..
rem Then if the letter that you searched for exists, the function will get its letter position
rem ..in the word or string (starting from the number you give).
rem In this example we start searching from letter nr. 2 and search for the letter 'N'
rem If it can find it.. the result will be '3'

Rem Now This is something cool:
Rem Usage: Hacker$(string$, type) ( 1 or 2)
Print "function Leet$('Hello there all you small dicks!!')"
Print Leet$("Hello there all you small dicks!!")
print
Rem This function will Change the string you give into Hacker style!!
Rem choose between 2 types; 1=vocals is UPPER state, 2=consonants are UPPER state

rem Now here is something I made today.
rem Usage: Print_Message$( string$ )
print "function Print_Message$( 'This will print text as if someone was writing.' )"
Print_Message$( "This will print text as if someone was writing." )
Print
print
rem Now Lets take a combination of them
print "combinatoion of 'Leet$' and 'Print_Message$':"
Print_Message$( Leet$("This will print text as if someone was writing.") )
print
print
print "'/' is at character: "+str$(FindLetterNumber(Leet$("This will print text as if someone was writing."),"/",0))





do
   if scancode()>0 or mouseclick()>0 then end
sync:loop



rem ::::::::::::::::::::::::::::::::::::::::::::
rem ::::::::::::::::::::::::::::::::::::::::::::
REM               THE FUNCTIONS
rem ::::::::::::::::::::::::::::::::::::::::::::
rem ::::::::::::::::::::::::::::::::::::::::::::

function SetFont$(font$,size,bold,italic,transparent,tr,tg,tb,br,bg,bb)
   ink rgb(tr,tg,tb),rgb(br,bg,bb)
   set text font font$
   set text size size
   if transparent=1 then set text transparent else set text opaque
   if bold=1 and italic=1 then set text to bolditalic
   if bold=1 and italic=0 then set text to bold
   if bold=0 and italic=1 then set text to italic
   if bold=0 and italic=0 then set text to normal
endfunction

REM :::::::::COMMANDS THAT WORKS:::::::::
function replace$(string$,old_letter$,new_letter$)
   total_letters=len(string$)
   string2$=""
   for x = 1 to total_letters
      Letter$=mid$(string$,x)
      if Letter$=old_letter$
         Letter$=new_letter$
      else
         Letter$=Letter$
      endif
      string2$=string2$+Letter$
   next x
endfunction string2$

function FindLetterNumber(string$,letter$,start)
   total=len(string$)
   for x = start to total
      letter2$=mid$(string$,x)
      if letter2$=letter$ then number=(x-start)
   next x
endfunction number


function Leet$( string$ )
   total=len(string$)
   string2$=""
   for x = 1 to total
      letter$=lower$(mid$(string$, x))
      if letter$="a" then letter$="4"
      if letter$="b" then letter$="6"
      if letter$="c" then letter$="C"
      if letter$="d" then letter$="D"
      if letter$="e" then letter$="3"
      if letter$="f" then letter$="ph"
      if letter$="g" then letter$="G"
      if letter$="h" then letter$="||"
      if letter$="i" then letter$="1"
      if letter$="j" then letter$="J"
      if letter$="k" then letter$="K"
      if letter$="a" then letter$="4"
      if letter$="m" then letter$="/'"
      if letter$="n" then letter$="//"
      if letter$="o" then letter$="0"
      if letter$="p" then letter$="P"
      if letter$="q" then letter$="Q"
      if letter$="r" then letter$="7"
      if letter$="s" then letter$="$"
      if letter$="t" then letter$="+"
      if letter$="u" then letter$="_"
      if letter$="v" then letter$="/"
      if letter$="w" then letter$=",/"
      if letter$="x" then letter$="x"
      if letter$="y" then letter$="Y"
      if letter$="z" then letter$="Z"
      string2$=String2$+letter$
   next x
endfunction string2$

function print_message$(mes$)
   a = len(mes$)
   dim a$(a+1)
   for x = 1 to a
      a$(x) = mid$(mes$,x)
      `play sound 1
      print a$(x);
      if a$(x)="."
         wait 50
      else
        wait 50+rnd(300)
      endif
      if scancode()>0 then exitfunction 1
   next x
endfunction

rem ==========================
rem     n0ids Small Library
rem        NSL-3D Library
rem ==========================
sync on : sync rate 0
set display mode 640,480,32
hide mouse : backdrop on : draw to front

Dim x(10)
Dim y(10)
Dim z(10)

for x = 1 to 10
   make object cube x,10
   red=rnd(255)
   green=rnd(255)
   blue=rnd(255)
   color object x,rgb(red,green,blue)
   x(x)=rnd(150):y(x)=rnd(150):z(x)=rnd(150)
   position object x,x(x),y(x),z(x)
next x

position camera -50,75,-50
yrotate camera 45

do
   if scancode()>0 or mouseclick()>0 then end

   for x = 1 to 10
      x(x)=wrapvalue(1+x(x))
      y(x)=wrapvalue(1+y(x))
      z(x)=wrapvalue(1+z(x))
      rotate object x,x(x),y(x),z(x)
   next x

   text screen width()-128,screen height()-15,"Screen FPS("+str$(screen fps())+")"

   REM HERE ARE THE FUNCTION CALLS
   ` note: remove the 'rem' statement on the command you wich to try out.. remember to put a new rem on that command you last used.
   UnderWaterScreen()
sync:loop



rem ::::::::::::::::::::::::::::::::::::::::::::
rem ::::::::::::::::::::::::::::::::::::::::::::
REM               THE FUNCTIONS
rem ::::::::::::::::::::::::::::::::::::::::::::
rem ::::::::::::::::::::::::::::::::::::::::::::
function UnderWaterScreen()
   if state=0 then a=a+1
   if a=30 then state=1
   if state=1 then a=a-1
   if a=0 then state=0
   set camera view 0+(a*0.2),0+a,screen width()-(a*0.5),screen height()-a
   sync
endfunction

remstart
   -------------------------------------------------------------------
   program name: How To Create Bulletholes
   -------------------------------------------------------------------
   written by: Lukas W
   date: 2. Oct. 2005
   -------------------------------------------------------------------
   comments: Using Sparkys Collision DLL
   -------------------------------------------------------------------
remend






rem ********************************
rem     INITIALIZING
rem ********************************
rem The First Thing We Need to Do is to Turn On Manual Syncing
   Sync On : Sync Rate 60

rem Next Step is to include the Functions for DBCcollision.dll
#include "functions.dba"
rem ********************************
rem ********************************






rem ********************************
rem     THE WORLD
rem ********************************
rem Load The Level we will use in this tutorial
   WORLD = 1 : Load Object "map.x", WORLD

rem Now Setup This Objects Collision
   setupObjectDBC( WORLD, 1, 0 )
` setupObjectDBC(objNum,groupNum,objectType)
` ..objNum = Object To Setup
` ..groupNum = which group object belongs to
` ..objectType = i dont remember what this is for.. :
   setObjectCollisionOnDBC(1)
` setObjectCollisionOnDBC(objNum)
` ..objNum = object to affect
rem ********************************
rem ********************************




rem ********************************
rem    THE PLAYER
rem ********************************
   PLAYER = 2 : playerspeed = 10
   camx# = 0.0 : camy# = 5.0 : camz# = 0.0
   make object box player, 6, 80, 6
   set object collision on player
   position object player, camx#, camy#, camz#
   hide object player
   make object collision box player,-16,-40,-16,16,40,16,0
rem ********************************
rem ********************************




rem ********************************
rem    CREATION OF BULLETHOLES
rem ********************************
   bullet_holes = 99
   bullet_holes_start_on_object = 100
   load image "hole.bmp",2
   for x = 1 to bullet_holes
      make object plain x+bullet_holes_start_on_object,4,4
      texture object x+bullet_holes_start_on_object,2
      ghost object on x+bullet_holes_start_on_object
      hide object x+bullet_holes_start_on_object
      fade object x+bullet_holes_start_on_object,-100
   next x
rem ********************************
rem ********************************





rem Start Game Loop
REPEAT

   Gosub PLAYER

 SYNC
UNTIL ESCAPEKEY() > 0






PLAYER:
   Gosub MOVEMENT
   Gosub WEAPON
RETURN

MOVEMENT:
   rem Store Old Player Position
  oldx# = camera position x() : oldy# = camera position y() : oldz# = camera position z()

   rem Move Using Arrows
  if upkey()    then x#=newxvalue(x#, camay#, playerspeed)   :z#=newzvalue(z#, camay#, playerspeed)   :humanwalk= wrapvalue( humanwalk + playerspeed*4 )
  if downkey()  then x#=newxvalue(x#, camay#, playerspeed*-1):z#=newzvalue(z#, camay#, playerspeed*-1):humanwalk= wrapvalue( humanwalk + playerspeed*4 )
  if rightkey() then x#=newxvalue(x#, camay#+90, playerspeed):z#=newzvalue(z#, camay#+90, playerspeed):humanwalk= wrapvalue( humanwalk + playerspeed*4 )
  if leftkey()  then x#=newxvalue(x#, camay#-90, playerspeed):z#=newzvalue(z#, camay#-90, playerspeed):humanwalk= wrapvalue( humanwalk + playerspeed*4 )

   rem Rotate Using Mouse
  camay#   = wrapvalue( camay# + mousemovex() /3 )
  camax#   = wrapvalue( camax# + mousemovey() /3 )
  rotate camera camax#, camay#, 0

   rem Check for Collision
  collide = intersectObjectDBC(1,0,oldx#,oldy#,oldz#,x#,y#,z#,65535)
  ` intersectObjectDBC(objNum,groupFlag,oldx#,oldy#,oldz#,x#,y#,z#,excludeObj)
  ` ..objNum = Check for Collision on this object
  ` ..groupFlag = Check for Collision on objects in this group
  ` ..oldx#, oldy#, oldz# = from this location
  ` ..x#, y#, z# = to this location
  ` ..excludeObj = Dont check for collision on this object


  rem WALL COLLISION
  if collide>0
   newx# = getStaticCollisionX() : normx# = getCollisionNormalX()
   newz# = getStaticCollisionZ() : normz# = getCollisionNormalZ()
   x# = newx# + normx#
   z# = newz# + normz#
   position camera x#, y#+40, z#
   position object player, x#, y#, z#
  endif

  rem HUMAN WALK
  humancalc=cos(humanwalk)*4
  if humanwalk>190 and humanwalk<211 and jump=0 and ground=1
    player_footsound=25+rnd(5)
    play sound player_footsound
    player_footsound_timer=0
   humanwalk=humanwalk+10
  endif

   position camera x#,y#+humancalc+40,z#
   position object player,x#,y#+40,z#
   position listener x#,y#+humancalc+40,z#
   rotate camera camax#,camay#,0
   rotate listener camax#,camay#,0
RETURN





WEAPON:
   If MouseClick() = 1 And Latch = 0
     Latch = 1
     GOSUB BULLET
   EndIf

   If MouseClick() = 0 Then Latch = 0
RETURN




BULLET:
rem ********************************
rem    BULLETHOLES
rem ********************************
   rem First Store the current position from where we are firing from
   oldx22# = camera position x()
   oldy22# = camera position y()
   oldz22# = camera position z()

   rem We use the camera and camera angle to determie where we hit *first person shooter*
   move camera 3000

   rem Get New Position (the position where the bullet hits
   x22# = camera position x()
   y22# = camera position y()
   z22# = camera position z()

   rem Restore Camera
   move camera -3000

   rem Check for Collision
   collide2 = intersectObjectDBC( 1, 0, oldx22#, oldy22#, oldz22#, x22#, y22#, z22#, 0 )
   ` intersectObjectDBC(objNum,groupFlag,oldx#,oldy#,oldz#,x#,y#,z#,excludeObj)
   ` ..objNum = Check for Collision on this object
   ` ..groupFlag = Check for Collision on objects in this group
   ` ..oldx#, oldy#, oldz# = from this location
   ` ..x#, y#, z# = to this location
   ` ..excludeObj = Dont check for collision on this object


   rem Did we get a collision??
   if collide2 <> 0
    rem Yes.

      rem Get The Position of the collision
      newx# = getStaticCollisionX()
      newy# = getStaticCollisionY()
      newz# = getStaticCollisionZ()

      rem Get The Angle of the collision
      normx# = getCollisionNormalX()
      normy# = getCollisionNormalY()
      normz# = getCollisionNormalZ()

      rem !CREATE A BULLETHOLE!
      if bullet_holes >0
         ` is the counter below the first bullethole?
         if bullethole_counter < (bullet_holes_start_on_object+1) then bullethole_counter = 101

         bh = bullethole_counter

         ` position the bullethole
         position object bh, newx#+normx#/10.0, newy#+normy#/10.0, newz#+normz#/10.0

         ` rotate the bullethole
         point object bh, newx#+normx#, newy#+normy#, newz#+normz#

         ` give the bullethole a spin
         zrotate object bh, rnd(359)

         ` and show it
         show object bh

         ` inc the counter
         bullethole_counter = bullethole_counter + 1

         ` if maximum bulletholes reached then START OVER ON THE FIRST BULLETHOLE
         if bullethole_counter > (bullet_holes_start_on_object + bullet_holes) then bullethole_counter = 0
      endif

         rem PLAY SOUND
`         impact = 74+rnd(3)
`         position sound impact, newx#+normx#/10.0, newy#+normy#/10.0, newz#+normz#/10.0 : play sound impact
   endif
RETURN

x = xposition of text | integer
y = yposition of text | integer
name$ = text caption | string
active = is button active or not? | boolean

Function hRef( x , y , name$ , active )
  Pressed = 0
  raise = 0
  mx = MouseX()
  my = MouseY()
  Width  = text width(name$)
  Height = 16

  If mx > x And mx < x+Width
     If my > y And my< y+Height
        If active = 1   Then raise   = 1
        If MouseClick() Then Pressed = 1
     EndIf
  EndIf

  If raise = 1
     INK RGB( 255, 0, 0 ), 0
  Else
     INK RGB( 255, 255, 255 ), 0
  Endif

  If Pressed = 1
     INK RGB( 125, 125, 125 ), 0
  EndIf

  Text x , y , name$
  If Not MouseClick() Then Pressed=0
EndFunction Pressed

0000000     ........     00/00/00     00:00:00
0000000     ........     00/00/00     00:00:00
0000000     ........     00/00/00     00:00:00
0000000     ........     00/00/00     00:00:00
0000000     ........     00/00/00     00:00:00
0000000     ........     00/00/00     00:00:00
0000000     ........     00/00/00     00:00:00
0000000     ........     00/00/00     00:00:00
0000000     ........     00/00/00     00:00:00
0000000     ........     00/00/00     00:00:00
0000000     ........     00/00/00     00:00:00
0000000     ........     00/00/00     00:00:00
0000000     ........     00/00/00     00:00:00
0000000     ........     00/00/00     00:00:00
0000000     ........     00/00/00     00:00:00
0000000     ........     00/00/00     00:00:00
0000000     ........     00/00/00     00:00:00
0000000     ........     00/00/00     00:00:00
0000000     ........     00/00/00     00:00:00
0000000     ........     00/00/00     00:00:00

rem LUKAS W - 2006 - Online Highscore Thing,
rem List of best 20 ranks. :)

   FTP CONNECT "server", "login", "password"
   FTP GET FILE "list.txt", "list.txt"

   DIM highscore(40,4) AS STRING
   DIM oldhscore(40,4) AS STRING

   OPEN TO READ 1, "list.txt"
      FOR x = 1 TO 20
         READ STRING 1, T$
         `get score
         highscore(x,1) = LEFT$( T$, 7 )
         oldhscore(x,1) = highscore(x,1)
         `get name
         T2$ = RIGHT$( T$, LEN(T$)-12 )
         T3$ = LEFT$( T2$, 8 )
         highscore(x,2) = T3$
         oldhscore(x,2) = T3$
         `get date
         T2$ = RIGHT$( T$, LEN(T$)-25 )
         T3$ = LEFT$( T2$, 8 )
         highscore(x,3) = T3$
         oldhscore(x,3) = T3$
         `get time
         T2$ = RIGHT$( T$, 8 )
         highscore(x,4) = T2$
         oldhscore(x,4) = T2$
      NEXT x
   CLOSE FILE 1

   FOR x = 1 TO 20
      highscore = val(highscore(x,1))
      IF PLAYER.SCORE => highscore
         _t = x
         score_ = len(str$(PLAYER.SCORE))
         score1$ = str$(PLAYER.SCORE)
         REPEAT
            score2$ = score2$ + "0"
         UNTIL LEN(score1$+score2$) = 7
         score3$ = score2$+score1$
         REPEAT
            name2$ = name2$ + "."
         UNTIL LEN(name$+name2$) = 8
         name3$ = name2$ + name$
         highscore(_t,1) = score3$
         highscore(_t,2) = name3$
         highscore(_t,3) = GET DATE$()
         highscore(_t,4) = GET TIME$()
         EXIT
      ENDIF
   NEXT x

   FOR t = _t+1 TO 20
      highscore(t,1) = oldhscore(t-1,1)
      highscore(t,2) = oldhscore(t-1,2)
      highscore(t,3) = oldhscore(t-1,3)
      highscore(t,4) = oldhscore(t-1,4)
   NEXT t

   DELETE FILE "list.txt"
   OPEN TO WRITE 1, "list.txt"
      FOR x = 1 TO 20
         WRITE STRING 1, highscore(x,1)+"     "+highscore(x,2)+"     "+highscore(x,3)+"     "+highscore(x,4)
      NEXT x
   CLOSE FILE 1

   FTP DELETE FILE "list.txt"
   FTP PUT FILE "list.txt"

   DELETE FILE "list.txt"
   FTP DISCONNECT
   UNDIM highscore()
   UNDIM oldhscore()

    <table border=1 cellspacing=2 cellpadding=2>
     <tr>
      <td><center><font size=2 face="Lucida Console"><b>RANK</td>
      <td><center><font size=2 face="Lucida Console"><b>SCORE</td>
      <td><center><font size=2 face="Lucida Console"><b>NAME</td>
      <td><center><font size=2 face="Lucida Console"><b>DATE</td>
      <td><center><font size=2 face="Lucida Console"><b>TIME</td>
     </tr>
     
		<?php
			$lines = file('list.txt');
		    $linenr = 0;
		   	foreach($lines as $line)
		   	{
			   	$linenr = $linenr + 1;
		   		$check_entry = explode("     ", $line);
		   		echo( "<tr><td align='left'><font size=2 face='Lucida Console'>#".$linenr."</td>" );
		                echo( "<td><center><font size=2 face='Lucida Console'>".$check_entry[0]."</td>" );
		                echo( "<td><center><font size=2 face='Lucida Console'>".$check_entry[1]."</td>");
		                echo( "<td><center><font size=2 face='Lucida Console'>".$check_entry[2]."</td>");
		                echo( "<td><center><font size=2 face='Lucida Console'>".$check_entry[3]."</td></tr>");
		   	}
		?>
	</table>

rem LUKAS W - 2006 - Online Highscore Thing,
rem List of best 20 ranks. :)

SCORE = 100+RND(9999)
name$ = "test"
print "got data"
set window on


   FTP CONNECT "server", "login", "password"
   FTP GET FILE "list.txt", "list.txt"
   print "got ftp file"

   DIM highscore$(40,4)
   DIM oldhscore$(40,4)

   OPEN TO READ 1, "list.txt"
      FOR x = 1 TO 20
         READ STRING 1, T$
         `get score
         highscore$(x,1) = LEFT$( T$, 7 )
         oldhscore$(x,1) = highscore$(x,1)
         `get name
         T2$ = RIGHT$( T$, LEN(T$)-12 )
         T3$ = LEFT$( T2$, 8 )
         highscore$(x,2) = T3$
         oldhscore$(x,2) = T3$
         `get date
         T2$ = RIGHT$( T$, LEN(T$)-25 )
         T3$ = LEFT$( T2$, 8 )
         highscore$(x,3) = T3$
         oldhscore$(x,3) = T3$
         `get time
         T2$ = RIGHT$( T$, 8 )
         highscore$(x,4) = T2$
         oldhscore$(x,4) = T2$
      NEXT x
   CLOSE FILE 1
   print "got highscore list"

   FOR x = 1 TO 20
      highscore = val(highscore$(x,1))
      IF SCORE => highscore
         _t = x
         score_ = len(str$(SCORE))
         score1$ = str$(SCORE)
         REPEAT
            score2$ = score2$ + "0"
         UNTIL LEN(score1$+score2$) = 7
         score3$ = score2$+score1$
         REPEAT
            name2$ = name2$ + "."
         UNTIL LEN(name$+name2$) = 8
         name3$ = name2$ + name$
         highscore$(_t,1) = score3$
         highscore$(_t,2) = name3$
         highscore$(_t,3) = GET DATE$()
         highscore$(_t,4) = GET TIME$()
         EXIT
      ENDIF
   NEXT x
   print "got new data"

   FOR t = _t+1 TO 20
      highscore$(t,1) = oldhscore$(t-1,1)
      highscore$(t,2) = oldhscore$(t-1,2)
      highscore$(t,3) = oldhscore$(t-1,3)
      highscore$(t,4) = oldhscore$(t-1,4)
   NEXT t
   print "got new list"

   DELETE FILE "list.txt"
   OPEN TO WRITE 1, "list.txt"
      FOR x = 1 TO 20
         WRITE STRING 1, highscore$(x,1)+"     "+highscore$(x,2)+"     "+highscore$(x,3)+"     "+highscore$(x,4)
      NEXT x
   CLOSE FILE 1
   print "wrote new list"

   FTP DELETE FILE "list.txt"
   FTP PUT FILE "list.txt"
   print "uploaded new list"

   DELETE FILE "list.txt"
   FTP DISCONNECT
   UNDIM highscore$()
   UNDIM oldhscore$()
   print "done"

rem Multiplayer demo by Alex Schmidt
rem host

set display mode 640,480,32
set window on
set window position 400,400
set window title "client2"


create net game "Server","Host",2,1


make matrix 1,10000.0,10000.0,25,25
load bitmap "rock1.bmp",1
get image 1,0,0,256,256
delete bitmap 1
prepare matrix texture 1,1,1,1


rem Create characters to see
make object sphere 1,100.0
color object 1,rgb(0,0,255)


rem Create characters to see enemy
make object sphere 2,100.0

color object 2,rgb(255,0,0)


rem Setzte Charakterposition
x#=5000
z#=5000



rem Manuelle Synchronisation
sync on
sync rate 30

rem Hauptschleife
do

rem Kontrolliere die Kamera mit den Pfeiltasten
if upkey()=1 then x#=newxvalue(x#,a#,10) : z#=newzvalue(z#,a#,10)
if downkey()=1 then x#=newxvalue(x#,a#,-10) : z#=newzvalue(z#,a#,-10)
if leftkey()=1 then a#=wrapvalue(a#-10.0)
if rightkey()=1 then a#=wrapvalue(a#+10.0)

rem Aktualisiere Charakter
y#=get ground height(1,x#,z#)+50.0
position object 1,x#,y#,z#
yrotate object 1,a#




rem multiplayer start



get net message
set cursor 0,100
print "get message...."
if NET MESSAGE TYPE()=4
set cursor 0,120
print "get memblock..."
set cursor 200,200

net message memblock 1
myX = memblock float(1,4)
myY = memblock float(1,8)
myZ = memblock float(1,12)
myAX = memblock float(1,16)
myAY = memblock float(1,20)
myAZ = memblock float(1,24)


print myX
print myY
print myZ
print myAX
print mYAY
print myAZ



rem my aber vom host my
position object 2,myX,myY,myZ

rotate object 2,myAX,myAY,myAZ
endif
if memblock exist(1)=1 then delete memblock 1




make memblock 1,64

OtherX=object position x(1)
OtherY=object position y(1)
OtherZ=object position z(1)
OtherAX=object angle x(1)
OtherAY=object angle y(1)
OtherAZ=object angle Z(1)

write memblock float 1,4,OtherX
write memblock float 1,8,OtherY
write memblock float 1,12,OtherZ
write memblock float 1,16,OtherAX
write memblock float 1,20,OtherAY
write memblock float 1,24,OtherAZ

send net message memblock 0,1,1
print "sending memblock"
if memblock exist(1)=1 then delete memblock 1




perform checklist for net players
for i = 1 to checklist quantity()
name$=checklist string$(i)
text 10,10+(i*20),name$
next i




if net player destroyed()>0
end
endif

rem !! Multiplayer end







rem Positioniere Kamera hinter dem Charackter
ca#=wrapvalue(curveangle(a#,ca#,12.0))
cx#=newxvalue(x#,wrapvalue(ca#+180),300)
cz#=newzvalue(z#,wrapvalue(ca#+180),300)
cy#=get ground height(1,cx#,cz#)+100.0
position camera cx#,cy#,cz#
yrotate camera wrapvalue(ca#)





rem Synchronisiere Bildschirm
sync

rem Ende Hauptschleife
loop

rem Multiplayer demo by Alex Schmidt
rem Client

set display mode 640,480,32
set window on
set window position 400,400
set window title "client"


join net game 1,"client"


make matrix 1,10000.0,10000.0,25,25
load bitmap "rock1.bmp",1
get image 1,0,0,256,256
delete bitmap 1
prepare matrix texture 1,1,1,1


rem Create characters to see
make object sphere 1,100.0
color object 1,rgb(0,0,255)


rem Create characters to see enemy
make object sphere 2,100.0

color object 2,rgb(255,0,0)


rem Setzte Charakterposition
x#=5000
z#=5000



rem Manuelle Synchronisation
sync on
sync rate 30

rem Hauptschleife
do

rem Kontrolliere die Kamera mit den Pfeiltasten
if upkey()=1 then x#=newxvalue(x#,a#,10) : z#=newzvalue(z#,a#,10)
if downkey()=1 then x#=newxvalue(x#,a#,-10) : z#=newzvalue(z#,a#,-10)
if leftkey()=1 then a#=wrapvalue(a#-10.0)
if rightkey()=1 then a#=wrapvalue(a#+10.0)

rem Aktualisiere Charakter
y#=get ground height(1,x#,z#)+50.0
position object 1,x#,y#,z#
yrotate object 1,a#




rem multiplayer start



get net message
set cursor 0,100
print "get message...."
if NET MESSAGE TYPE()=4
set cursor 0,120
print "get memblock..."
set cursor 200,200

net message memblock 1
myX = memblock float(1,4)
myY = memblock float(1,8)
myZ = memblock float(1,12)
myAX = memblock float(1,16)
myAY = memblock float(1,20)
myAZ = memblock float(1,24)


print myX
print myY
print myZ
print myAX
print mYAY
print myAZ



rem my aber vom host my
position object 2,myX,myY,myZ

rotate object 2,myAX,myAY,myAZ
endif
if memblock exist(1)=1 then delete memblock 1




make memblock 1,64

OtherX=object position x(1)
OtherY=object position y(1)
OtherZ=object position z(1)
OtherAX=object angle x(1)
OtherAY=object angle y(1)
OtherAZ=object angle Z(1)

write memblock float 1,4,OtherX
write memblock float 1,8,OtherY
write memblock float 1,12,OtherZ
write memblock float 1,16,OtherAX
write memblock float 1,20,OtherAY
write memblock float 1,24,OtherAZ

send net message memblock 0,1,1
print "sending memblock"
if memblock exist(1)=1 then delete memblock 1




perform checklist for net players
for i = 1 to checklist quantity()
name$=checklist string$(i)
text 10,10+(i*20),name$
next i




if net player destroyed()>0
end
endif

rem !! Multiplayer end







rem Positioniere Kamera hinter dem Charackter
ca#=wrapvalue(curveangle(a#,ca#,12.0))
cx#=newxvalue(x#,wrapvalue(ca#+180),300)
cz#=newzvalue(z#,wrapvalue(ca#+180),300)
cy#=get ground height(1,cx#,cz#)+100.0
position camera cx#,cy#,cz#
yrotate camera wrapvalue(ca#)





rem Synchronisiere Bildschirm
sync

rem Ende Hauptschleife
loop

` Setup Screen
SYNC ON : SYNC RATE 0 : HIDE MOUSE



` Create Globals
GLOBAL G_MAXIMUMLIFE  AS FLOAT
GLOBAL G_CURRENTLIFE  AS FLOAT
GLOBAL G_HEALTHBARX   AS INTEGER
GLOBAL G_HEALTHBARY   AS INTEGER
GLOBAL G_HEALTHBARW   AS INTEGER
GLOBAL G_HEALTHBARH   AS INTEGER
GLOBAL G_DIRECTION    AS STRING
GLOBAL G_TRIGGER      AS STRING



` Give the Variables some values... quite self explaining ;)
G_MAXIMUMLIFE  = 500
G_CURRENTLIFE  = 500
G_HEALTHBARX   =  50
G_HEALTHBARY   = 120
G_HEALTHBARW   = 200
G_HEALTHBARH   =   5

#CONSTANT horizontal 			0
#CONSTANT vertical			1
#CONSTANT positive			2
#CONSTANT negative			3



` Start the Loop
While Not EscapeKey()

 ` We are Using 2D rendering in this example, so we need to clear
 ` the screen before new data is printed ;)
 CLS 0

 ` If Player Press a key, change this variable by 1
 if scancode()>0 then dec G_CURRENTLIFE, 1

 ` This Function Will Draw Our Bar
 createBar( G_HEALTHBARX, G_HEALTHBARY, G_HEALTHBARW, G_HEALTHBARH, G_CURRENTLIFE, G_MAXIMUMLIFE, G_DIRECTION, G_TRIGGER )

 ` Print Screen FPS
 SET CURSOR SCREEN WIDTH()-50, SCREEN HEIGHT()-25 : PRINT SCREEN FPS()

 SYNC
EndWhile : End




` CREATEBAR FUNCTION
`  EXPLANATION;
`   xPos - xPosition of Bar | yPos - yPosition of Bar
`   xSize - Width of Bar | ySize - Height of Bar
`   current - Current Value of Variable
`   maximum - Maximum Value of Variable
`   direction - Horizontal or Vertical
`   trigger - Positive or Negative (add or subract)
`  RETURNS;
`   0 - Nothing
`   +1 - Below 0
`   +2 - Above Maximum
Function createBar( xPos, yPos, xSize, ySize, current as float, maximum as float, direction as string, trigger as string)

 ` First Make a Background That Will Never Change Size
 INK RGB(255,255,255),0


		select direction


			case horizontal				` Calcuate How Many Percent of the Bar is to be Drawn
			     BOX xPos, yPos, xSize, yPos+ySize
			     BOX xPos, yPos, Temp2, yPos+ySize
			endcase

			case vertical
			     BOX xPos, yPos, xPos+xSize, ySize
			     BOX xPos, yPos, xPos+xSize, Temp2
			endcase

			case positive				 ` Calcuate How Many Percent of the Bar is to be Drawn
			     Temp1# = current / maximum
			endcase

			case negative
			     Temp1# = (maximum / current) -1.0
			endcase

		end select


 ` Print Some Info | (Remove these Four Lines)
 INK RGB(255,255,255),0
 text 50, 50, str$(int(Temp1#*100))+"% or the Bar is Drawed"
 text 50, 65, "Width: "+str$(Temp2)+" / "+str$( xSize )
 text 50, 80, "Life: "+str$(current)+" / "+str$( maximum )
 ` -------------------------------------------

EndFunction

rem + =not yet implemented

sync on : sync rate 60


#CONSTANT   C_TRUE            0x000001
#CONSTANT   C_FALSE           0x000000
#CONSTANT   C_MOUSELEFTCLICK  0x000001
#CONSTANT   C_MOUSERIGHTCLICK 0x000002
setupRightClickMenu()




Do
   CLS RGB( 0, 78, 152 )

   Result = updateRightClickMenu()

   If Result > 0
      `If Result = 1 Then blablabla...
      Ink Rgb(255, 255, 255), 0
      Text 100, 100, "You Selected ItemNo. "+str$(Result)+" Which was "+szItemsRMenu( Result )
   EndIf
Sync : Loop



Function setupRightClickMenu()
   Local txtWidth  As Integer
   Local txtHeight As Integer

   Global iTrueTXTHeight   As Integer
   Global iTrueTXTWidth    As Integer
   Global items            As Integer
   Global iMenuImage       As Integer
   Global iRMenuLatch      As Integer
   Global iRMenuActivated  As Integer
   Global iRMenuX          As Integer
   Global iRMenuY          As Integer
   Global iRMMC            As Integer
   Global iRMenuTrueX      AS Integer
   Global iRMenuTrueY      AS Integer

   items = 5

   Dim szItemsRMenu( items ) As String

   szItemsRMenu(1) = "Cut"
   szItemsRMenu(2) = "Copy"
   szItemsRMenu(3) = "Paste"
   szItemsRMenu(4) = "-"
   szItemsRMenu(5) = "Properties"

   for x = 1 to items
      txtWidth = text width( szItemsRMenu( x ) )
      txtHeight = 16
      If txtWidth > oldTxtWidth Then iTrueTXTWidth = txtWidth+30
      oldTxtWidth = txtWidth
   next x

   iTrueTXTHeight = (txtHeight*items)+5
   makeRightClickMenu( iTrueTXTHeight, iTrueTXTWidth )
EndFunction

Function makeRightClickMenu( iHeight As Integer, iWidth As Integer )
   Ink RGB( 172, 168, 153 ), 0 : Box 0, 0, iWidth, iHeight
   Ink RGB( 255, 255, 255 ), 0 : Box 1, 1, iWidth, iHeight-1

   iMenuImage = FindImage()
   Get Image iMenuImage, 0, 0, iWidth, iHeight
EndFunction

Function updateRightClickMenu()
   Local iMX            As Integer
   Local iMY            As Integer

   iMX   = MouseX()
   iMY   = MouseY()
   iRMMC = MouseClick()

   If iRMMC = C_MOUSERIGHTCLICK  And iRMenuLatch = C_FALSE
      iRMenuLatch     = C_TRUE
      iRMenuX         = iMX    : iRMenuY = iMY
      iRMenuActivated = C_TRUE
   EndIf

   If iRMenuActivated = C_TRUE
      If iRMenuY > Screen Height() - iTrueTXTHeight
         If iRMenuX > Screen Width() - iTrueTXTWidth
            iRMenuTrueX = iRMenuX - iTrueTXTWidth
            iRMenuTrueY = iRMenuY - iTrueTXTHeight
         Else
            iRMenuTrueX = iRMenuX
            iRMenuTrueY = iRMenuY - iTrueTXTHeight
         EndIf
      Else
         If iRMenuX > Screen Width() - iTrueTXTWidth
            iRMenuTrueX = iRMenuX - iTrueTXTWidth
            iRMenuTrueY = iRMenuY
         Else
            iRMenuTrueX = iRMenuX
            iRMenuTrueY = iRMenuY
         EndIf
      EndIf

      Paste Image iMenuImage, iRMenuTrueX, iRMenuTrueY

      For x = 1 to items
         If szItemsRMenu( x ) <> "-"
            Ink RGB( 000, 000, 000 ), 0
            Text iRMenuTrueX+15, 5+iRMenuTrueY+(x*15)-15, szItemsRMenu( x )
         Else
            Ink RGB( 172, 168, 153 ), 0
            Line iRMenuTrueX+5, (5+iRMenuTrueY+(x*15)-15)+6, iRMenuTrueX+iTrueTXTWidth-5, (5+iRMenuTrueY+(x*15)-15)+6
         EndIf

         If iMX > 5+iRMenuTrueX And iMX < iRMenuTrueX + iTrueTXTWidth-5
            If iMY > (5+iRMenuTrueY+(x*15)-17) And iMY < 4+iRMenuTrueY+(x*15)
               If szItemsRMenu( x ) <> "-"
                  Ink RGB( 049, 106, 197 ), 0
                  Box iRMenuTrueX+5, (6+iRmenuTrueY+(x*15)-17), iRMenuTrueX+iTrueTXTWidth-5, (4+iRMenuTrueY+(x*15)+2)
                  Ink RGB( 255, 255, 255 ), 0
                  Text iRMenuTrueX+15, 5+iRMenuTrueY+(x*15)-15, szItemsRMenu( x )

                  If iRMMC = C_MOUSELEFTCLICK Then iRMenuActivated = C_FALSE : ExitFunction x
               EndIf
            EndIf
         EndIf
      Next x

      If iRMMC > 0 And iRMenuLatch = C_FALSE Then iRMenuActivated = C_FALSE
   EndIf

   If iRMMC <> C_FALSE And iRMenuLatch = C_TRUE  Then iRMenuLatch = C_FALSE
EndFunction C_FALSE

Function FindImage()
   Repeat : Inc image, 1 : Until Not Image Exist( image )
EndFunction image