Sorry your browser is not supported!

`Green XP MEter
INK RGB(0,200,0),0
box 419,47,xp,61

` now for your actual health, colour change to red
INK RGB(200,0,0),0
` and then draw a box, 1 pixel smaller than the previous one in each direction (so that the white box will be an outline) and this box is as long as your health bariable
box 419,3,playerhealth*2/2+494,17

sync on
make_menu()

add_menu("Objects")

add_sub_menu("Objects","Add")

add_sub_sub_menu("Objects","Add","Cube")
add_sub_sub_menu("Objects","Add","Plain")
add_sub_sub_menu("Objects","Add","Sphere")
add_sub_sub_menu("Objects","Add","Cone")

global Obj as integer
Obj=1

backdrop on

do

return$=run_menu()

if return$="Cube"
gosub AddCube
endif

if return$="Plain"
gosub AddPlain
endif

if return$="Sphere"
gosub AddSphere
endif

if return$="Cone"
gosub AddCone
endif

sync
loop



`==================================
function make_menu()
 dim names(50,50,50) as string
 dim count(50,50)
 dim sel(10)
 dim check(50,50,50)
 set text font "tahoma"
 set text size 15
endfunction
`==================================
function add_menu(name as string)
 count(0,0)=count(0,0)+1
 names(count(0,0),0,0)=name
endfunction
`==================================
function add_sub_menu(pos as string,name as string)
for i=1 to count(0,0)
 if names(i,0,0)=pos then men=i
next i
 count(men,0)=count(men,0)+1
 names(men,count(men,0),0,0)=name
endfunction

function asm(pos,name as string)
 count(pos,0)=count(men,0)+1
 names(pos,count(pos,0),0,0)=name
endfunction
`==================================
function add_sub_sub_menu(pos as string,down as string,name as string)
for i=1 to count(0,0)
 if names(i,0,0)=pos then men=i
next i
for i=1 to count(men,0)
 if names(men,i,0)=down then men2=i
next i
 count(men,men2)=count(men,men2)+1
 names(men,men2,count(men,men2))=name
endfunction

function assm(pos,down,name as string)
 count(pos,down)=count(pos,down)+1
 names(pos,down,count(pos,down))=name
endfunction
`==================================
function check_sub_box(pos as string ,down as string)
for i=1 to count(0,0)
 if names(i,0,0)=pos then men=i
next i
for i=1 to count(men,0)
 if names(men,i,0)=down then men2=i
next i
 check(men,men2,0)=check(men,men2,0)+1
 if check(men,men2,0)>1 then check(men,men2,0)=0
endfunction

function csb(pos,down)
 check(pos,down,0)=check(pos,down,0)+1
 if check(pos,down,0)>1 then check(pos,down,0)=0
endfunction
`==================================
function check_sub_sub_box(pos as string ,down as string,dow as string)
for i=1 to count(0,0)
 if names(i,0,0)=pos then men=i
next i
for i=1 to count(men,0)
 if names(men,i,0)=down then men2=i
next i
for i=1 to count(men,0)
 if names(men,men2,i)=dow then men3=i
next i
 check(men,men2,men3)=check(men,men2,men3)+1
 if check(men,men2,men3)>1 then check(men,men2,men3)=0
endfunction

function cssb(pos,down,dow)
 check(pos,down,dow)=check(pos,down,dow)+1
 if check(pos,down,dow)>1 then check(pos,down,dow)=0
endfunction
`==================================
function run_menu()
 colour(1) : box 0,0,screen width(),21
 colour(2) : line 0,21,screen width(),21
 colour(4) : line 1,22,screen width(),22
  `==
   mx=mousex()
   my=mousey()
   m2=sel(10)
   mg=mouseclick()
   mc=0
   if m2=0 and mg=1 then mc=1
   sel(10)=mg
  `==/
check=1
if mc=1 then check=0

   if count(0,0)>0
   menux=6
    for i=1 to count(0,0)
     colour(4)
     text menux,2,names(i,0,0)
     line menux-1,15,menux-1+text width(mid$(names(i,0,0),1)),15
     tw=text width(names(i,0,0))
     if mx>(menux-6) and mx<(tw+menux+4) and my>1 and my<18
     if sel(0)>0 then sel(0)=i : sel(3)=menux
      if mc=1 and sel(0)>0
       if sel(0)=i then sel(0)=0 : mc=0 : sel(4)=0
      endif
     if mc=1 then sel(0)=i : check=1 : sel(3)=menux : sel(4)=0
     if sel(0)=0
      colour(3) : line menux-6,1,tw+menux+4,1 : line menux-6,1,menux-6,18
      colour(2) : line menux-6,18,tw+menux+4,18 : line tw+menux+4,1,tw+menux+4,18
     endif
     endif
     if sel(0)>0 and sel(0)=i
      colour(2) : line menux-6,1,tw+menux+4,1 : line menux-6,1,menux-6,18
      colour(3) : line menux-6,18,tw+menux+4,18 : line tw+menux+4,1,tw+menux+4,18
     endif
    menux=menux+12+tw
   next i
  endif

`=============================================================== SUB MENU

  if sel(0)>0
   if count(sel(0),0)>0
    tex2len=0
    for i=1 to count(sel(0),0)
     if text width(names(sel(0),i,0))>tex2len then tex2len=text width(names(sel(0),i,0))
    next i
     boxz(sel(3)-6,19,sel(3)+tex2len+80,19+(20*count(sel(0),0)))
    for i=1 to count(sel(0),0)
      if mx>sel(3)-4 and mx<sel(3)+tex2len+80 and my>19 and my<19+(20*count(sel(0),0)) and mc=1 then check=1
     if mx>sel(3)-4 and mx<(sel(3)+tex2len+78) and my>(1+(20*i)) and my<(19+(20*i))
     if mc=1 and sel(4)=i then mc=0 : sel(4)=0
       if mc=1 then sel(4)=i : sel(5)=tex2len : sel(6)=sel(3)+tex2len+80
     if names(sel(0),i,0)="---"
     else
      colour(2)
      box (sel(3)-4),(1+(20*i)),(sel(3)+tex2len+78),(17+(20*i))
      if mc=1 and count(sel(0),i)=0 then return$=names(sel(0),i,0)
      switch=1
     endif
     endif
    if names(sel(0),i,0)="---"
     colour(2) : line sel(3),i*20+9,sel(3)+tex2len+75,i*20+9
     colour(3) : line sel(3),i*20+10,sel(3)+tex2len+75,i*20+10
    else
     if switch=0
      colour(4)
     else
      colour(5)
     endif
     switch=0
     if count(sel(0),i)>0
      a=(sel(3)+tex2len+70)
      h=2+i*20+6
      dot a,h : dot a-1,h : dot a-2,h : dot a-3,h : dot a-1,h+1 : dot a-1,h-1
      dot a-2,h+1 : dot a-2,h+2 : dot a-2,h-1 : dot a-2,h-2 : dot a-3,h+3
      dot a-3,h-1 : dot a-3,h-2 : dot a-3,h-3 : dot a-3,h+1 : dot a-3,h+2
     endif
      if check(sel(0),i,0)=1
       a=(sel(3)+7)
       h=2+i*20+8
       dot a,h:dot a,h-1:dot a-1,h-1:dot a-1,h-2:dot a-2,h-2:dot a-2,h-3:dot a+3,h-3:dot a+4,h-4
       dot a,h:dot a,h-1:dot a+1,h-1:dot a+1,h-2:dot a+2,h-2:dot a+2,h-3:dot a+3,h-4:dot a+4,h-5
      endif
     text sel(3)+20,2+i*20-1,names(sel(0),i,0)
    endif
    next i
   endif
  endif
`=============================================================== SUB SUB MENU
if count(sel(0),sel(4))>0
 if sel(4)>0
   tex2len=0
  for i=1 to count(sel(0),sel(4))
   if text width(names(sel(0),sel(4),i))>tex2len then tex2len=text width(names(sel(0),sel(4),i))
  next i
    boxz(sel(6),-1+(sel(4))*20,sel(6)+tex2len+80,-1+(sel(4)+count(sel(0),sel(4)))*20)
    if mx>sel(6) and mx<sel(6)+tex2len+80 and my>-1+(sel(4))*20 and my<-1+(sel(4)+count(sel(0),sel(4)))*20 and mc=1 then check=1
 for i=1 to count(sel(0),sel(4))
   colour(4)
  if mx>sel(6) and mx<sel(6)+tex2len+80 and my>-19+(sel(4)+i)*20 and my<-19+(sel(4)+i+1)*20
   colour(2)
   if names(sel(0),sel(4),i)="---"
   else
    box sel(6)+2,-18+(sel(4)+i)*20,sel(6)+tex2len+78,-23+(sel(4)+i+1)*20
    if mc=1 then return$=names(sel(0),sel(4),i)
   endif
   colour(5)
  endif
   if names(sel(0),sel(4),i)="---"
     colour(2) : line sel(6)+5,-18+(sel(4)+i)*20+6,sel(6)+tex2len+75,-18+(sel(4)+i)*20+6
     colour(3) : line sel(6)+5,-18+(sel(4)+i)*20+7,sel(6)+tex2len+75,-18+(sel(4)+i)*20+7
   else
      if check(sel(0),sel(4),i)=1
       a=(sel(6)+7)
       h=-9+(sel(4)+i)*20
       dot a,h:dot a,h-1:dot a-1,h-1:dot a-1,h-2:dot a-2,h-2:dot a-2,h-3:dot a+3,h-3:dot a+4,h-4
       dot a,h:dot a,h-1:dot a+1,h-1:dot a+1,h-2:dot a+2,h-2:dot a+2,h-3:dot a+3,h-4:dot a+4,h-5
      endif
    text sel(6)+20,-18+(sel(4)+i)*20,names(sel(0),sel(4),i)
   endif
 next i
 endif
endif
`============================================================================

if return$=""
else
 check=0
endif
if check=0 then sel(0)=0 : sel(4)=0

endfunction return$
`==================================
function colour(num)
 if num=1 then ink get_colour(4),0
 if num=2 then ink get_colour(16),0
 if num=3 then ink get_colour(20),0
 if num=4 then ink get_colour(21),0
 if num=5 then ink rgb(255,255,255),0
endfunction

function get_colour(num)
  local col as dword
  load dll "user32.dll",1
  col = call dll(1,"GetSysColor", num)
  delete dll 1
  col = rgb(rgbb(col), rgbg(col), rgbr(col))
endfunction col
`==================================
function boxz(x1,y1,x2,y2)

colour(1) : box x1,y1,x2,y2
colour(3) : line x1+1,y1+1,x2-1,y1+1 : line x1+1,y1+1,x1+1,y2-1
colour(2) : line x2-1,y1+1,x2-1,y2-1 : line x1+1,y2-1,x2-1,y2-1
colour(4) : line x2,y1+1,x2,y2-1 : line x1+1,y2,x2-1,y2

endfunction
`==================================

AddCube:
make object cube Obj,10
Obj=Obj+1
return

AddPlain:
make object plain Obj,10,10
Obj=Obj+1
return

AddSphere:
make object sphere Obj,10
Obj=Obj+1
return

AddCone:
make object cone Obj,10
Obj=Obj+1
return

sync on
make_menu()

add_menu("File")
add_menu("Objects")

add_sub_menu("File","New")
add_sub_menu("File","Open")
add_sub_menu("File","Save")
add_sub_menu("File","Save As...")
add_sub_menu("File","Exit")
add_sub_menu("Objects","Add")

add_sub_sub_menu("Objects","Add","Cube")
add_sub_sub_menu("Objects","Add","Plain")
add_sub_sub_menu("Objects","Add","Sphere")
add_sub_sub_menu("Objects","Add","Cone")

global Obj as integer
Obj=1

global p as integer
global oldp as integer
global move as integer

backdrop on

do

oldp=p

return$=run_menu()

if return$="Exit" then end

if return$="Cube"
gosub AddCube
endif

if return$="Plain"
gosub AddPlain
endif

if return$="Sphere"
gosub AddSphere
endif

if return$="Cone"
gosub AddCone
endif

if mouseclick()=1 then p=pick object(mousex(),mousey(),1,65535)
if p>0 then ghost object on p
if oldp>0 and p<>oldp then ghost object off oldp

if keystate(211)>0
gosub Delete
endif

if p>0
if move=0
if keystate(72)=1
move object p,1
move=1
endif
if keystate(80)=1
move object p,-1
move=1
endif
if keystate(75)=1
move object left p,1
move=1
endif
if keystate(77)=1
move object right p,1
move=1
endif
if keystate(74)=1
move object down p,1
move=1
endif
if keystate(78)=1
move object up p,1
move=1
endif
endif
endif
if scancode()=0 then move=0

sync
loop



`==================================
function make_menu()
 dim names(50,50,50) as string
 dim count(50,50)
 dim sel(10)
 dim check(50,50,50)
 set text font "tahoma"
 set text size 15
endfunction
`==================================
function add_menu(name as string)
 count(0,0)=count(0,0)+1
 names(count(0,0),0,0)=name
endfunction
`==================================
function add_sub_menu(pos as string,name as string)
for i=1 to count(0,0)
 if names(i,0,0)=pos then men=i
next i
 count(men,0)=count(men,0)+1
 names(men,count(men,0),0,0)=name
endfunction

function asm(pos,name as string)
 count(pos,0)=count(men,0)+1
 names(pos,count(pos,0),0,0)=name
endfunction
`==================================
function add_sub_sub_menu(pos as string,down as string,name as string)
for i=1 to count(0,0)
 if names(i,0,0)=pos then men=i
next i
for i=1 to count(men,0)
 if names(men,i,0)=down then men2=i
next i
 count(men,men2)=count(men,men2)+1
 names(men,men2,count(men,men2))=name
endfunction

function assm(pos,down,name as string)
 count(pos,down)=count(pos,down)+1
 names(pos,down,count(pos,down))=name
endfunction
`==================================
function check_sub_box(pos as string ,down as string)
for i=1 to count(0,0)
 if names(i,0,0)=pos then men=i
next i
for i=1 to count(men,0)
 if names(men,i,0)=down then men2=i
next i
 check(men,men2,0)=check(men,men2,0)+1
 if check(men,men2,0)>1 then check(men,men2,0)=0
endfunction

function csb(pos,down)
 check(pos,down,0)=check(pos,down,0)+1
 if check(pos,down,0)>1 then check(pos,down,0)=0
endfunction
`==================================
function check_sub_sub_box(pos as string ,down as string,dow as string)
for i=1 to count(0,0)
 if names(i,0,0)=pos then men=i
next i
for i=1 to count(men,0)
 if names(men,i,0)=down then men2=i
next i
for i=1 to count(men,0)
 if names(men,men2,i)=dow then men3=i
next i
 check(men,men2,men3)=check(men,men2,men3)+1
 if check(men,men2,men3)>1 then check(men,men2,men3)=0
endfunction

function cssb(pos,down,dow)
 check(pos,down,dow)=check(pos,down,dow)+1
 if check(pos,down,dow)>1 then check(pos,down,dow)=0
endfunction
`==================================
function run_menu()
 colour(1) : box 0,0,screen width(),21
 colour(2) : line 0,21,screen width(),21
 colour(4) : line 1,22,screen width(),22
  `==
   mx=mousex()
   my=mousey()
   m2=sel(10)
   mg=mouseclick()
   mc=0
   if m2=0 and mg=1 then mc=1
   sel(10)=mg
  `==/
check=1
if mc=1 then check=0

   if count(0,0)>0
   menux=6
    for i=1 to count(0,0)
     colour(4)
     text menux,2,names(i,0,0)
     line menux-1,15,menux-1+text width(mid$(names(i,0,0),1)),15
     tw=text width(names(i,0,0))
     if mx>(menux-6) and mx<(tw+menux+4) and my>1 and my<18
     if sel(0)>0 then sel(0)=i : sel(3)=menux
      if mc=1 and sel(0)>0
       if sel(0)=i then sel(0)=0 : mc=0 : sel(4)=0
      endif
     if mc=1 then sel(0)=i : check=1 : sel(3)=menux : sel(4)=0
     if sel(0)=0
      colour(3) : line menux-6,1,tw+menux+4,1 : line menux-6,1,menux-6,18
      colour(2) : line menux-6,18,tw+menux+4,18 : line tw+menux+4,1,tw+menux+4,18
     endif
     endif
     if sel(0)>0 and sel(0)=i
      colour(2) : line menux-6,1,tw+menux+4,1 : line menux-6,1,menux-6,18
      colour(3) : line menux-6,18,tw+menux+4,18 : line tw+menux+4,1,tw+menux+4,18
     endif
    menux=menux+12+tw
   next i
  endif

`=============================================================== SUB MENU

  if sel(0)>0
   if count(sel(0),0)>0
    tex2len=0
    for i=1 to count(sel(0),0)
     if text width(names(sel(0),i,0))>tex2len then tex2len=text width(names(sel(0),i,0))
    next i
     boxz(sel(3)-6,19,sel(3)+tex2len+80,19+(20*count(sel(0),0)))
    for i=1 to count(sel(0),0)
      if mx>sel(3)-4 and mx<sel(3)+tex2len+80 and my>19 and my<19+(20*count(sel(0),0)) and mc=1 then check=1
     if mx>sel(3)-4 and mx<(sel(3)+tex2len+78) and my>(1+(20*i)) and my<(19+(20*i))
     if mc=1 and sel(4)=i then mc=0 : sel(4)=0
       if mc=1 then sel(4)=i : sel(5)=tex2len : sel(6)=sel(3)+tex2len+80
     if names(sel(0),i,0)="---"
     else
      colour(2)
      box (sel(3)-4),(1+(20*i)),(sel(3)+tex2len+78),(17+(20*i))
      if mc=1 and count(sel(0),i)=0 then return$=names(sel(0),i,0)
      switch=1
     endif
     endif
    if names(sel(0),i,0)="---"
     colour(2) : line sel(3),i*20+9,sel(3)+tex2len+75,i*20+9
     colour(3) : line sel(3),i*20+10,sel(3)+tex2len+75,i*20+10
    else
     if switch=0
      colour(4)
     else
      colour(5)
     endif
     switch=0
     if count(sel(0),i)>0
      a=(sel(3)+tex2len+70)
      h=2+i*20+6
      dot a,h : dot a-1,h : dot a-2,h : dot a-3,h : dot a-1,h+1 : dot a-1,h-1
      dot a-2,h+1 : dot a-2,h+2 : dot a-2,h-1 : dot a-2,h-2 : dot a-3,h+3
      dot a-3,h-1 : dot a-3,h-2 : dot a-3,h-3 : dot a-3,h+1 : dot a-3,h+2
     endif
      if check(sel(0),i,0)=1
       a=(sel(3)+7)
       h=2+i*20+8
       dot a,h:dot a,h-1:dot a-1,h-1:dot a-1,h-2:dot a-2,h-2:dot a-2,h-3:dot a+3,h-3:dot a+4,h-4
       dot a,h:dot a,h-1:dot a+1,h-1:dot a+1,h-2:dot a+2,h-2:dot a+2,h-3:dot a+3,h-4:dot a+4,h-5
      endif
     text sel(3)+20,2+i*20-1,names(sel(0),i,0)
    endif
    next i
   endif
  endif
`=============================================================== SUB SUB MENU
if count(sel(0),sel(4))>0
 if sel(4)>0
   tex2len=0
  for i=1 to count(sel(0),sel(4))
   if text width(names(sel(0),sel(4),i))>tex2len then tex2len=text width(names(sel(0),sel(4),i))
  next i
    boxz(sel(6),-1+(sel(4))*20,sel(6)+tex2len+80,-1+(sel(4)+count(sel(0),sel(4)))*20)
    if mx>sel(6) and mx<sel(6)+tex2len+80 and my>-1+(sel(4))*20 and my<-1+(sel(4)+count(sel(0),sel(4)))*20 and mc=1 then check=1
 for i=1 to count(sel(0),sel(4))
   colour(4)
  if mx>sel(6) and mx<sel(6)+tex2len+80 and my>-19+(sel(4)+i)*20 and my<-19+(sel(4)+i+1)*20
   colour(2)
   if names(sel(0),sel(4),i)="---"
   else
    box sel(6)+2,-18+(sel(4)+i)*20,sel(6)+tex2len+78,-23+(sel(4)+i+1)*20
    if mc=1 then return$=names(sel(0),sel(4),i)
   endif
   colour(5)
  endif
   if names(sel(0),sel(4),i)="---"
     colour(2) : line sel(6)+5,-18+(sel(4)+i)*20+6,sel(6)+tex2len+75,-18+(sel(4)+i)*20+6
     colour(3) : line sel(6)+5,-18+(sel(4)+i)*20+7,sel(6)+tex2len+75,-18+(sel(4)+i)*20+7
   else
      if check(sel(0),sel(4),i)=1
       a=(sel(6)+7)
       h=-9+(sel(4)+i)*20
       dot a,h:dot a,h-1:dot a-1,h-1:dot a-1,h-2:dot a-2,h-2:dot a-2,h-3:dot a+3,h-3:dot a+4,h-4
       dot a,h:dot a,h-1:dot a+1,h-1:dot a+1,h-2:dot a+2,h-2:dot a+2,h-3:dot a+3,h-4:dot a+4,h-5
      endif
    text sel(6)+20,-18+(sel(4)+i)*20,names(sel(0),sel(4),i)
   endif
 next i
 endif
endif
`============================================================================

if return$=""
else
 check=0
endif
if check=0 then sel(0)=0 : sel(4)=0

endfunction return$
`==================================
function colour(num)
 if num=1 then ink get_colour(4),0
 if num=2 then ink get_colour(16),0
 if num=3 then ink get_colour(20),0
 if num=4 then ink get_colour(21),0
 if num=5 then ink rgb(255,255,255),0
endfunction

function get_colour(num)
  local col as dword
  load dll "user32.dll",1
  col = call dll(1,"GetSysColor", num)
  delete dll 1
  col = rgb(rgbb(col), rgbg(col), rgbr(col))
endfunction col
`==================================
function boxz(x1,y1,x2,y2)

colour(1) : box x1,y1,x2,y2
colour(3) : line x1+1,y1+1,x2-1,y1+1 : line x1+1,y1+1,x1+1,y2-1
colour(2) : line x2-1,y1+1,x2-1,y2-1 : line x1+1,y2-1,x2-1,y2-1
colour(4) : line x2,y1+1,x2,y2-1 : line x1+1,y2,x2-1,y2

endfunction
`==================================

AddCube:
make object cube Obj,10
Obj=Obj+1
return

AddPlain:
make object plain Obj,10,10
Obj=Obj+1
return

AddSphere:
make object sphere Obj,10
Obj=Obj+1
return

AddCone:
make object cone Obj,10
Obj=Obj+1
return

Delete:
if p>0
delete object p
p=0
endif
return

`action rpg
`www.dougsworld.tk

sync on:sync rate 30
color backdrop rgb(50,50,255)
ink rgb(0,0,0),rgb(0,0,0)
randomize timer()

dim key(256)

type enem
   health as integer
   startx as integer
   startz as integer
   endx as integer
   endz as integer
   move as integer
   scale as integer
endtype

dim enemy(100) as enem

make object box 9,10000,5,10000
move object down 9,5
color object 9,rgb(100,255,100)

for a=10 to 100
   make object sphere a,3,6,6
   position object a,rnd(1000),0,rnd(1000)
   color object a,rgb(255,0,0)
   enemy(a).health=100
   enemy(a).startx=object position x(a)
   enemy(a).startz=object position z(a)
   enemy(a).endx=object position x(a)+rnd(60)
   enemy(a).endz=object position z(a)+rnd(60)
   enemy(a).scale=100
next a

make object cube 1,1
playerhealth=100
make object box 2,.2,.2,4
color object 2,rgb(0,0,0)
hide object 2
offset limb 2,0,0,0,2

do
    if upkey()=1 then move object 1,1
    if downkey()=1 then move object 1,-1
    if leftkey()=1 then yrotate object 1,object angle y(1)-5
    if rightkey()=1 then yrotate object 1,object angle y(1)+5
    if keyready(57)=1 and attack=0
       rotate object 2,object angle x(1),object angle y(1)-70,object angle z(1)
       attack=16
       show object 2
    endif
     if attack>0
        attack=attack-1
        position object 2,object position x(1),0,object position z(1)
        yrotate object 2,object angle y(2)+10
        for a=10 to 100
          if object exist(a)=1
           if object collision(2,a)=1
              enemy(a).health=enemy(a).health-30
              move object a,-20
              enemy(a).scale=enemy(a).scale-20
              scale object a,enemy(a).scale,enemy(a).scale,enemy(a).scale
         endif
           if enemy(a).health<10 then delete object a
           endif
        next a
     endif
     if attack=1 then hide object 2

     for a=10 to 100
     if object exist(a)=1
     if distance(1,a)<50 and attack>0 and attack<8 then move object a,-1
        if distance(1,a)>50
           patrol(a)
        else
           point object a,object position x(1),0,object position z(1)
           move object a,.5
           if object collision(a,1)=1
              playerhealth=playerhealth-5
              move object a,-15
              endif
           endif
        endif
     next a

  position camera (object position x(1)-sin(object angle y(1))*5),object position y(1)+2,(object position z(1)-cos(object angle y(1))*5)
   point camera object position x(1),object position y(1),object position z(1)
   text 1,1,str$(playerhealth)

   sync
loop



function patrol(object)
   if threeD_distance(object position x(object),enemy(object).endx,0,0,object position z(object),enemy(object).endz)<2 then enemy(object).move=1
   if threeD_distance(object position x(object),enemy(object).startx,0,0,object position z(object),enemy(object).startz)<2 then enemy(object).move=0
   if enemy(object).move=0
      point object object,enemy(object).endx,0,enemy(object).endz
      move object object,1
   endif
   if enemy(object).move=1
      point object object,enemy(object).startx,0,enemy(object).startz
      move object object,1
   endif
endfunction




function distance(obj1,obj2)
dist=sqrt(((object position x(obj1)-object position x(obj2))*(object position x(obj1)-object position x(obj2)))+((object position z(obj1)-object position z(obj2))*(object position z(obj1)-object position z(obj2))))
endfunction dist

FUNCTION threeD_distance(x1# AS float, x2# AS float, y1# AS float, y2# AS float, z1# AS float, z2# AS float)

   temp = 1
   null = make vector3(temp)
     set vector3 temp, x1# - x2#, y1# - y2#, z1# - z2#
     length_vector = abs(length vector3(temp))
     null = delete vector3(temp)

ENDFUNCTION length_vector

function keyready(keyz)
vl=0
if keystate(keyz)=1 and key(keyz) = 0
      key(keyz) = 1
      vl=1
   endif
if keystate(keyz)=0
      key(keyz) = 0
      vl = 0
   endif
endfunction vl

  for a=10 to 100
     if object exist(a)=1
     if distance(1,a)<50 and attack>0 and attack<8 then move object a,-1
        if distance(1,a)>50
           patrol(a)

`action rpg
`www.dougsworld.tk

sync on:sync rate 30
color backdrop rgb(50,50,255)
ink rgb(0,0,0),rgb(0,0,0)
randomize timer()

RemStart
Change this value to change the chance of the enemy casting
magic. Make it bigger to lower the chance and vice versa.
RemEnd
global ChanceOfCast as integer
ChanceOfCast=30

dim key(256)

type enem
   health as integer
   startx as integer
   startz as integer
   endx as integer
   endz as integer
   move as integer
   scale as integer
   cast as integer
endtype

dim enemy(100) as enem

make object box 9,10000,5,10000
move object down 9,5
color object 9,rgb(100,255,100)

for a=10 to 100
   make object sphere a,3,6,6
   position object a,rnd(1000),0,rnd(1000)
   color object a,rgb(255,0,0)
   enemy(a).health=100
   enemy(a).startx=object position x(a)
   enemy(a).startz=object position z(a)
   enemy(a).endx=object position x(a)+rnd(60)
   enemy(a).endz=object position z(a)+rnd(60)
   enemy(a).scale=100
   make object sphere a+100,3,6,6
   color object a+100,rgb(0,100,250)
   ghost object on a+100
   hide object a+100
next a

make object cube 1,1
playerhealth=100
make object box 2,.2,.2,4
color object 2,rgb(0,0,0)
hide object 2
offset limb 2,0,0,0,2

set global collision on

do
    if upkey()=1 then move object 1,1
    if downkey()=1 then move object 1,-1
    if leftkey()=1 then yrotate object 1,object angle y(1)-5
    if rightkey()=1 then yrotate object 1,object angle y(1)+5
    if keyready(57)=1 and attack=0
       rotate object 2,object angle x(1),object angle y(1)-70,object angle z(1)
       attack=16
       show object 2
    endif
     if attack>0
        attack=attack-1
        position object 2,object position x(1),0,object position z(1)
        yrotate object 2,object angle y(2)+10
        for a=10 to 100
          if object exist(a)=1
           if object collision(2,a)=1
              enemy(a).health=enemy(a).health-30
              move object a,-20
              enemy(a).scale=enemy(a).scale-20
              scale object a,enemy(a).scale,enemy(a).scale,enemy(a).scale
              enemy(a).cast=0
              hide object a+100
         endif
           if enemy(a).health<10 then delete object a : delete object a+100
           endif
        next a
     endif
     if attack=1 then hide object 2

     for a=10 to 100
     if object exist(a)=1
     if distance(1,a)<50 and attack>0 and attack<8 then move object a,-1
        if distance(1,a)>50
           enemy(a).cast=0
           hide object a+100
           scale object a+100,100,100,100
           patrol(a)
        else
        if enemy(a).cast=0
           point object a,object position x(1),0,object position z(1)
           move object a,.5
           if object collision(a,1)=1
              playerhealth=playerhealth-5
              move object a,-15
              endif
           if object collision(a+100,1)=1
              playerhealth=playerhealth-1
              endif
              testforcast=0
              if distance(1,a)<50
              testforcast=rnd(ChanceOfCast)
              endif
              if testforcast=3
              enemy(a).cast=100
              show object a+100
              endif
              endif
              if enemy(a).cast>0
              enemy(a).cast=enemy(a).cast+3
              scale object a+100,enemy(a).cast,enemy(a).cast,enemy(a).cast
           if object collision(a+100,1)=1
              playerhealth=playerhealth-1
              endif
            endif
              if enemy(a).cast>500
              enemy(a).cast=0
              hide object a+100
              endif
           endif
position object a+100,object position x(a),object position y(a)-1.5,object position z(a)
   endif
     next a

  position camera (object position x(1)-sin(object angle y(1))*5),object position y(1)+2,(object position z(1)-cos(object angle y(1))*5)
   point camera object position x(1),object position y(1),object position z(1)
   text 1,1,str$(playerhealth)

   sync
loop



function patrol(object)
   if threeD_distance(object position x(object),enemy(object).endx,0,0,object position z(object),enemy(object).endz)<2 then enemy(object).move=1
   if threeD_distance(object position x(object),enemy(object).startx,0,0,object position z(object),enemy(object).startz)<2 then enemy(object).move=0
   if enemy(object).move=0
      point object object,enemy(object).endx,0,enemy(object).endz
      move object object,1
   endif
   if enemy(object).move=1
      point object object,enemy(object).startx,0,enemy(object).startz
      move object object,1
   endif
endfunction




function distance(obj1,obj2)
dist=sqrt(((object position x(obj1)-object position x(obj2))*(object position x(obj1)-object position x(obj2)))+((object position z(obj1)-object position z(obj2))*(object position z(obj1)-object position z(obj2))))
endfunction dist

FUNCTION threeD_distance(x1# AS float, x2# AS float, y1# AS float, y2# AS float, z1# AS float, z2# AS float)

   temp = 1
   null = make vector3(temp)
     set vector3 temp, x1# - x2#, y1# - y2#, z1# - z2#
     length_vector = abs(length vector3(temp))
     null = delete vector3(temp)

ENDFUNCTION length_vector

function keyready(keyz)
vl=0
if keystate(keyz)=1 and key(keyz) = 0
      key(keyz) = 1
      vl=1
   endif
if keystate(keyz)=0
      key(keyz) = 0
      vl = 0
   endif
endfunction vl

RemStart
Change this value to change the chance of the enemy casting
magic. Make it bigger to lower the chance and vice versa.
RemEnd
global ChanceOfCast as integer
ChanceOfCast=30

cast as integer

   make object sphere a+100,3,6,6
   color object a+100,rgb(0,100,250)
   ghost object on a+100
   hide object a+100

 
              enemy(a).cast=0
              hide object a+100

 : delete object a+100

           enemy(a).cast=0
           hide object a+100

        if enemy(a).cast=0
           point object a,object position x(1),0,object position z(1)
           move object a,.5
           if object collision(a,1)=1
              playerhealth=playerhealth-5
              move object a,-15
              endif
           if object collision(a+100,1)=1
              playerhealth=playerhealth-1
              endif
              testforcast=0
              if distance(1,a)<50
              testforcast=rnd(ChanceOfCast)
              endif
              if testforcast=3
              enemy(a).cast=100
              show object a+100
              endif
              endif
              if enemy(a).cast>0
              enemy(a).cast=enemy(a).cast+3
              scale object a+100,enemy(a).cast,enemy(a).cast,enemy(a).cast
           if object collision(a+100,1)=1
              playerhealth=playerhealth-1
              endif
            endif
              if enemy(a).cast>500
              enemy(a).cast=0
              hide object a+100
              endif
           endif
position object a+100,object position x(a),object position y(a)-1.5,object position z(a)