Sorry your browser is not supported!

set display mode 800,600,32
hide mouse

white=rgb(255,255,255)
ink white,0
gosub make_cursor
cls 0

max=40
size=3
white=rgb(255,255,255)

sync on

selx=20
sc=(100/max)*((selx-19)/size)
skincol=rgb(255-sc,192-sc,128-sc)

DO
   mx=mousex() : my=mousey()
   if mx<144 and mx>19 and my<31 and my>19
      sc=(100/max)*((mx-19)/size)
      mcol= rgb(255-sc,192-sc,128-sc)
      if mouseclick()=1 then selx=mx : skincol=mcol
   endif

   `display
   for c = 0 to max
      sc=(100/max)*c
      ink rgb(255-sc,192-sc,128-sc),0
      box c*size+20,20,c*size+size+20,30
   next c

   ink 0,0
   line 19,18,19,32 : line 144,18,144,32
   line 20,18,143,18 : line 20,32,144,32
   line 20,19,143,19 : line 20,31,144,31

   ink mcol,0
   box 200,20,250,45
   ink skincol,0
   box 200,46,250,70

   ink white,0
   dot selx,18 : dot selx,32
   dot selx,19 : dot selx,31
   line selx-1,18,selx-1,32
   line selx+1,18,selx+1,32

   sprite 1,mx,my,1

   sync
LOOP

`-------------------------------
` GOSUBS
`-------------------------------
make_cursor:
   line 0,0,0,2 : line 0,0,2,0
   for d=1 to 4
      dot d,d
   next d

   get image 1,0,0,5,5
return

set display mode 640,480,32
sync on : sync rate 30
x = 100 : y = 50

do
cls 3680296
   draw_bar(50,50,100,7884864,x,12582912)
   draw_bar(50,55,100,7884864,y,12582912)
   draw_bar(50,60,200,7884864,z,12582912)
   draw_bar(50,65,200,7884864,201-z,12582912)
   z = cos(q)*100+101
   q=q+1
sync
loop

function draw_bar(x,y,width,color,fill,fillcolor)
   ink color,0
   line x+1,y,x+width-1,y
   box x,y+1,x+1,y+2
   box x+width-1,y+1,x+width,y+2
   line x+1,y+3,x+width-1,y+3
   ink 0,0
   box x+2,y+1,x+width-2,y+2
   draw_status(x,y,fill,fillcolor)
endfunction

function draw_status(x,y,width,color)
   ink color,0
   box x+2,y+1,x+width-2,y+2
endfunction

hide mouse
sync on : sync rate 30

DO
s1 = wrapvalue(s1+1)
s2 = wrapvalue(s2+5)
s3 = wrapvalue(s3+3)

ink rgb(128,128,128),0
for r=0 to 3
   circle 320,240,r*10
next r

ink rgb(255,0,0),0
line 320+cos(s1),240+sin(s1),320+cos(s1)*9,240+sin(s1)*9
line 320+cos(s2)*11,240+sin(s2)*11,320+cos(s2)*19,240+sin(s2)*19
line 320+cos(s3)*21,240+sin(s3)*21,320+cos(s3)*29,240+sin(s3)*29

sync : CLS
LOOP

`chracter challenge
`by tone3e
gosub setup
`main loop
do
   cls
   gosub set_bars
   `setting up bars
      gosub speed
      gosub strenght
      gosub stamina
      gosub intelligence
      `choosing bar
      if downkey()=1 and tag=0
         place=place+1
         tag=1
      endif
      if upkey()=1 and tag=0
         place=place-1
         tag=1
      endif
      if upkey()=0 and downkey()=0 then tag=0
      if place=<1 then place=1
      if place>4 then place=4
      set text size 10
      text 200,180,"<<<[Press SpaceKey To Finalize Character]>>>"
      if spacekey()=1
         cls
         Print "IFORMATION"
         Print "Character Name: ";Name$
         Print "Character Sex: ";Sex$
         Print "Character Guild: ";Guild$
         Print "Character Body Type:";Body$
         pRINT "ATTRIBUTES"
         pRINT "Speed: ";z;"%"
         Print "Strenght: ";z2;"%"
         Print "Stamina: ";z3;"%"
         Print "Intelligence: ";z4;"%"
         end
      endif
   sync
loop
end

setup:
set display mode 640,480,32
sync on: sYNC rATE 0
hide mouse
`set variables
total_points=0:place=0
tag=0:tag2=0
z=0:z2=0:z3=0:z4=0
`collect information
input "Character Name?> ";Name$
Input "Character Guild?> ";Guild$
Input "Character Sex?> ";Sex$
Input "Character Body Type?> ";Body$
return

set_bars:
    total_points=200-(z+z2+z3+z4)
    if total_points<0 then total_points=0
    PRINT "Total Points: ";total_points
    `draw bars
    `speed
    draw_bar(100,60,100,7884864,z,12582912)
    draw_bar(100,90,100,7884864,z2,12582912)
    draw_bar(100,120,100,7884864,z3,12582912)
    draw_bar(100,150,100,7884864,z4,12582912)
return

speed:
   `speed
   if place=1
      draw_bar(100,60,100,884864,z,12582912)
      SET CURSOR 0,55
      PRINT "Speed: ";Z
      if rightkey()=1 AND Z<100 and total_points>0 then z=z+1
      if leftkey()=1 AND Z>0 then z=z-1
   endif
return

strenght:
   `strenght
   if place=2
      draw_bar(100,90,100,884864,z2,12582912)
      SET CURSOR 0,85
      PRINT "Strenght: ";Z2
      if rightkey()=1 AND Z2<100 and total_points>0 then z2=z2+1
      if leftkey()=1 AND Z2>0 then z2=z2-1
    endif
return


stamina:
`stamina
   if place=3
      draw_bar(100,120,100,884864,z3,12582912)
      SET CURSOR 0,115
      PRINT "Stamina: ";Z3
      if rightkey()=1 AND Z3<100 and total_points>0 then z3=z3+1
      if leftkey()=1 AND Z3>0 then z3=z3-1
    endif
return
return

intelligence:
`intelligence
   if place=4
      draw_bar(100,150,100,884864,z4,12582912)
      SET CURSOR 0,145
      PRINT "Intelligence: ";Z4
      if rightkey()=1 AND Z4<100 and total_points>0 then z4=z4+1
      if leftkey()=1 AND Z4>0 then z4=z4-1
    endif
return
return
`functions
function draw_bar(x,y,width,color,fill,fillcolor)
   ink color,0
   line x+1,y,x+width-1,y
   box x,y+1,x+1,y+2
   box x+width-1,y+1,x+width,y+2
   line x+1,y+3,x+width-1,y+3
   ink 0,0
   box x+2,y+1,x+width-2,y+2
   draw_status(x,y,fill,fillcolor)
endfunction

function draw_status(x,y,width,color)
   ink color,0
   box x+2,y+1,x+width-2,y+2
endfunction

REMSTART
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   How To Make Stastic Bars
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
Statistic bars require 3 variables: minimum value, maximum value and current value.
Statistic bars do not require the use of an image (simple lines are fine) but for this example we will use one.
REMEND

`* Making the Stat Bar Image *
remstart
There are two methods of using stastic bar images: Cutting and Stretching.
_CUTTING
If we want a fancy bar that looks different all along its length we will have to draw the entire bar and then
cut the right percentage from the image to be displayed in the game.
_STRETCHING
If our bar looks the same along the entirety of its length, we only need to make 1% of the bar and then
stretch it to the right percentage.
For this example we will use a stretching bar.
remend

`draw 1% image
ink rgb(0,255,0),0 : `base colour
line 0,0,0,8
ink rgb(0,191,0),0 : `shade level 1
dot 0,7
ink rgb(0,128,0),0 : `shade level 2
dot 0,8
ink rgb(255,255,255),0 : `shine
dot 0,1
`grab the image
get image 1,0,0,1,9

cls 128
`draw a frame for our bar
line 200,190,200,200
line 300,190,300,200
set text size 7
center text 200,180,"0%"
center text 300,180,"100%"

sprite 1,201,201,1

sync on

rem 100% on the bar is 10000% of the images original length
rem in a game x would be replaced by the statistic variable
for x = 0 to 100
   stretch sprite 1,100*x,100
   sync
next x

end

for n = 0 to 9
  text 50,100+(n*20),"Hello"
next n

DIM stat$(3)
stat$(1)="Intelligence"
stat$(2)="Strength"
stat$(3)="Speed"
DIM stat(3)
stat(1)=58
stat(2)=96
stat(3)=74

Int=1
Str=2
Spd=3
DIM stat$(3)
stat$(Int)="Intelligence"
stat$(Str)="Strength"
stat$(Spd)="Speed"
DIM stat(3)
stat(Int)=58
stat(Str)=96
stat(Spd)=74

DIM stat$(3)
stat$(1)="Intelligence"
stat$(2)="Strength"
stat$(3)="Speed"
DIM stat(3)
stat(1)=58
stat(2)=96
stat(3)=74

`save cpu having to calculate rgb every loop
white=rgb(255,255,255)

for n = 1 to 3
  ink white,0
  text 50,100+n*20,stat$(n)
  draw_bar(150,105+n*20,100,884864,stat(n),12582912)
next n

END
`---------------------------
` FUNCTIONS
`---------------------------
function draw_bar(x,y,width,color,fill,fillcolor)
   ink color,0
   line x+1,y,x+width-1,y
   box x,y+1,x+1,y+2
   box x+width-1,y+1,x+width,y+2
   line x+1,y+3,x+width-1,y+3
   ink 0,0
   box x+2,y+1,x+width-2,y+2

   ink fillcolor,0
   box x+2,y+1,x+fill-2,y+2
endfunction

DIM stat$(3)
stat$(1)="Intelligence"
stat$(2)="Strength"
stat$(3)="Speed"
DIM stat(3)
stat(1)=58
stat(2)=96
stat(3)=74

`save cpu having to calculate rgb every loop
white=rgb(255,255,255)
red=rgb(255,0,0)
blue=884864
gold=rgb(191,160,64)

`set initial cursor point
place=1

sync on

`-------------------------
` MAIN LOOP
`-------------------------
DO
   `#Input
   if upkey()=1 then dec place,1
   if downkey()=1 then inc place,1
   if upkey()+downkey()>0 then repeat : until upkey()+downkey()=0 : `single press only
   if place<1 then place=3
   if place>3 then place=1
   rem using arrays makes stats easy to adjust
   if rightkey()=1 then stat(place)=stat(place)+1
   if leftkey()=1 then stat(place)=stat(place)-1
   if stat(place)<0 then stat(place)=0
   if stat(place)>100 then stat(place)=100

   `#Display
   for n = 1 to 3
     `set colours depending on whether the stat is selected
     if n=place
       ink red,0
       FrameColor=gold
     else
       ink white,0
       FrameColor=blue
     endif
     `draw to screen
     text 50,100+n*20,stat$(n)
     draw_bar(150,105+n*20,100,FrameColor,stat(n),red)
   next n

   `update screen and then clear for next loop
   sync:cls
LOOP

END
`---------------------------
` FUNCTIONS
`---------------------------
function draw_bar(x,y,width,color,fill,fillcolor)
   ink color,0
   line x+1,y,x+width-1,y
   box x,y+1,x+1,y+2
   box x+width-1,y+1,x+width,y+2
   line x+1,y+3,x+width-1,y+3
   ink 0,0
   box x+2,y+1,x+width-2,y+2

   ink fillcolor,0
   box x+2,y+1,x+fill-2,y+2
endfunction

DIM stat$(3)
stat$(1)="Intelligence"
stat$(2)="Strength"
stat$(3)="Speed"
DIM stat(3)
stat(1)=58
stat(2)=96
stat(3)=74

`save cpu having to calculate rgb every loop
white=rgb(255,255,255)
red=rgb(255,0,0)

`set initial cursor point
place=1

gosub make_bar_image

sync on

`-------------------------
` MAIN LOOP
`-------------------------
DO
   `#Input
   if upkey()=1 then dec place,1
   if downkey()=1 then inc place,1
   if upkey()+downkey()>0 then repeat : until upkey()+downkey()=0 : `single press only
   if place<1 then place=3
   if place>3 then place=1
   rem using arrays makes stats easy to adjust
   if rightkey()=1 then stat(place)=stat(place)+1
   if leftkey()=1 then stat(place)=stat(place)-1
   if stat(place)<0 then stat(place)=0
   if stat(place)>100 then stat(place)=100

   `#Display
   for n = 1 to 3
     `set colours depending on whether the stat is selected
     if n=place
       ink red,0 : i=2
     else
       ink white,0 : i=1
     endif
     `draw to screen
     text 50,100+n*20,stat$(n)
     sprite n,150,105+n*20,i
     stretch sprite n,100*stat(n),100
   next n

   `update screen and then clear for next loop
   sync:cls
LOOP

END
`---------------------------
` GOSUBS
`---------------------------
make_bar_image:
   FOR i= 1 to 2
      `draw 1% image
      ink rgb(75+i*90,0,0),0 : `base colour
      line 0,0,0,6
      ink rgb(31+i*80,0,0),0 : `shade level 1
      dot 0,5
      ink rgb(8+i*60,0,0),0 : `shade level 2
      dot 0,6
      ink rgb(255,255,255),0 : `shine
      dot 0,1
      `grab the image
      get image i,0,0,1,7
   NEXT i
RETURN

Tone3e, as his entry fulfilled all the challenge criteria

Obese87, who so generously provided very useful code snippits and functions, 
and is always ready to help out others with their code!

DIM menu$(3)
menu$(0)="New Game"
menu$(1)="Load Game"
menu$(2)="Options"
menu$(3)="Quit"

white=rgb(255,255,255)
yellow=rgb(255,255,0)

hide mouse
sync on : sync rate 60

`# Main Program
DO
   `#input
   u=upkey() : d=downkey()

   `#process
   sel=sel+d-u
   if sel<0 then sel=0
   if sel>3 then sel=3

   `#display
   for n = 0 to 3
      if n=sel
         ink yellow,0
         m$="["+menu$(n)+"]"
      else
         ink white,0
         m$=menu$(n)
      endif
      center text 320,140+n*40,m$
   next n

   `don't let the program loop until keys are released
   repeat
      u=upkey() : d=downkey()
      sync
   until u+d=0
   cls
LOOP

Gosub Setup
Gosub Menu_Screen
Rem Main Program Loop
Do
  Rem Gosub All Game Procedures Here
  Sync
Loop
End

Menu_Screen:
  Rem Display Menu Screen
  PlayGame=0
  Repeat
    Rem Detect Which Buttons Clicked on...
    If Start Game Button Clicked then PlayGame=1
    If End Game Button Clicked then End
    If Options Button Clicked then Gosub Options
  Until PlayGame=1
Return

Options:
  Rem Set up options screen here
  ExitOptions = 0
  Repeat
    If Button X Clicked Then Do Whatever
    If Button X Clicked Then Do Whatever
    If Button X Clicked Then Do Whatever
    If Exit Options Screen Button Clicked then ExitOptions = 1
  Until ExitOptions = 1
Return

Setup:
  Rem Set up screen mode and game variables etc here
Return

Rem Rest of Game Procedures Follow Here...

Rem Any Game Functions Follow Here...

Rem DBC Menu Challenge
Rem TDK_Man December 2007
Rem Hopefully something a little different...

Gosub Setup
Rem Main Program Loop
Do
  If LeftKey()=1 Then Gosub Clockwise
  If RightKey()=1 Then Gosub AntiClockwise
  If ReturnKey()=1 Then Gosub DecodeButton
  Sync
  Ink RGB(255,255,255),0: Center Text 400,580,ButtonText$(CurrentButton)
  Center Text 400,0,"TDK_Man's TR-Style 3D Menu.  Left/Right Cursor Keys To Highlight, Enter Key To Select"
Loop
End

Rem ******************************************************************************************
Rem ***                                    PROCEDURES                                      ***
Rem ******************************************************************************************

DecodeButton:
  Select CurrentButton
    Case 1
      Rem Start Game
      A$="Start Game Selected From The Menu"
    EndCase
    Case 2
      Rem Options
      A$="Options Screen Selected From The Menu"
    EndCase
    Case 3
      Rem Help
      A$="Help Screen Selected From The Menu"
    EndCase
    Case 4
      Rem HiScores
      A$="HiScores Screen Selected From The Menu"
    EndCase
    Case 5
      Rem MultiPlay
      A$="Multiplayer Screen Selected From The Menu"
    EndCase
    Case 6
      Rem Exit Game
      A$="Exit Program Selected From The Menu"
    EndCase
  EndSelect
  Set Camera View 0,0,1,1
  CLS
  Print A$
  Print
  End
Return

Clockwise:
  Rem Rotate Front Row Left
  Hide Object 100
  For N=1 To AngleSpacing
    For I=1 To MenuOptions
      X#(I) = WrapValue(X#(I) + 1)
      Z#(I) = WrapValue(Z#(I) + 1)
      Position Object I, NewXValue(0,X#(I),XDist#),0.0,NewZValue(0,Z#(I),ZDist#)
    Next I
    Sync
  Next N
  Show Object 100
  Dec CurrentButton: If CurrentButton < 1 Then CurrentButton = MenuOptions
  Repeat
  Until LeftKey()=0
Return

AntiClockwise:
  Rem Rotate Front Row Right
  Hide Object 100
  For N=1 To AngleSpacing
    For I=1 To MenuOptions
      X#(I) = WrapValue(X#(I) - 1)
      Z#(I) = WrapValue(Z#(I) - 1)
      Position Object I, NewXValue(0,X#(I),XDist#),0.0,NewZValue(0,Z#(I),ZDist#)
    Next I
    Sync
  Next N
  Show Object 100
  Inc CurrentButton: If CurrentButton > MenuOptions Then CurrentButton = 1
  Repeat
  Until RightKey()=0
Return

Setup:
  Set Display Mode 800,600,16
  Sync On
  Sync Rate 0
  Hide Mouse

  MenuOptions = 6: Rem Number of buttons on menu screen
  Dim ButtonText$(6)
  ButtonText$(1) = "Start Game"
  ButtonText$(2) = "Options"
  ButtonText$(3) = "Help"
  ButtonText$(4) = "HiScores"
  ButtonText$(5) = "MultiPlay"
  ButtonText$(6) = "Exit Game"

  Rem Make Menu Option Textures
  Create Bitmap 1,800,600

  Rem Highlight texture
  CLS 0
  Ink RGB(140,10,80),0
  Box 0,10,300,90: Box 30,0,270,100
  Get Image 101,0,0,300,101

  Rem Main Button texture
  CLS 0
  Ink RGB(240,240,255),0
  Box 0,10,300,90: Box 30,0,270,100
  Ink RGB(90,90,150),0
  Box 1,11,300,90: Box 31,1,270,100
  Ink RGB(120,120,255),0
  Box 1,11,298,88: Box 31,1,268,98
  Get Image 100,0,0,300,101

  Rem Set Font
  Set Text Font "Comic Sans MS",1
  Set Text Size 64

  Rem Play Game Button
  Ink RGB(0,0,10),0: Center Text 150,15,ButtonText$(1)
  Ink RGB(255,255,255),0: Center Text 149,14,ButtonText$(1)
  Get Image 1,0,0,301,101
  Rem Options Button
  Paste Image 100,0,0
  Ink RGB(0,0,10),0: Center Text 150,15,ButtonText$(2)
  Ink RGB(255,255,255),0: Center Text 149,14,ButtonText$(2)
  Get Image 2,0,0,301,101
  Rem Options Button
  Paste Image 100,0,0
  Ink RGB(0,0,10),0: Center Text 150,15,ButtonText$(3)
  Ink RGB(255,255,255),0: Center Text 149,14,ButtonText$(3)
  Get Image 3,0,0,301,101
  Rem HiScores Button
  Paste Image 100,0,0
  Ink RGB(0,0,10),0: Center Text 150,15,ButtonText$(4)
  Ink RGB(255,255,255),0: Center Text 149,14,ButtonText$(4)
  Get Image 4,0,0,301,101
  Rem HiScores Button
  Paste Image 100,0,0
  Ink RGB(0,0,10),0: Center Text 150,15,ButtonText$(5)
  Ink RGB(255,255,255),0: Center Text 149,14,ButtonText$(5)
  Get Image 5,0,0,301,101
  Rem Exit Button
  Paste Image 100,0,0
  Ink RGB(0,0,10),0: Center Text 150,15,ButtonText$(6)
  Ink RGB(255,255,255),0: Center Text 149,14,ButtonText$(6)
  Get Image 6,0,0,301,101

  Set Current Bitmap 0
  Delete Bitmap 1

  Backdrop On
  Color Backdrop 0
  AutoCam Off

  AngleSpacing = 360/MenuOptions
  CurrentButton = 1
  XDist#=6.0: XDistInc=0-AngleInc
  ZDist#=4.0: ZDistInc=AngleInc
  Dim ButtonPosition(MenuOptions)
  Dim X#(MenuOptions)
  Dim Z#(MenuOptions)

  For N=0 To MenuOptions-1
    X#(N+1) = WrapValue(N*AngleSpacing+180.0)
    Z#(N+1) = X#(N+1)
    Make Object Box N+1,3,1,1
    XRotate Object N+1,30
    Texture Object N+1,N+1
    Scale Object N+1,100,100,.1
    Set Object N+1,1,0,1
    Position Object N+1,NewXValue(0,X#(N+1),XDist#),0.0,NewZValue(0,Z#(N+1),ZDist#)
  Next N

  Rem Highlight Current Option
  Make Object Box 100,3,1,1
  Set Object 100,1,0,1
  XRotate Object 100,30
  Texture Object 100,101
  Scale Object 100,100,100,.1
  Ghost Object On 100
  Position Object 100,Object Position X(1),Object Position Y(1),Object Position Z(1)-0.01

  Rem Reset Font
  Set Text Font "Arial",1
  Set Text Size 16

  Position Camera 0,5,-10
  Point Camera 0,0,0
Return