Sorry your browser is not supported!

`weeble demo
`by: 29 games
`31 may 2010 (but only just as it's just gone midnight)

`set up screen
sync on
sync rate 60
hide mouse

`properties of the weeble
radius# = 5.0
c_gravity# = radius# - 1.0
weight# = 1.0
m_inertia# = 15.0

`add some friction (delt with like a torsional damper)
damp_coef# = 0.08

`starting angle of weeble (i.e. upright)
angle# = 180

`make weeble object
make object sphere 1, radius#*2
make object sphere 2, radius#*1.5
make mesh from object 1,2
delete object 2
add limb 1,1,1
offset limb 1,1, 0,-1.2*radius#,0
color object 1, rgb(200,200,0)

`make a floor
make matrix 1, 100, 100, 10 , 10
position matrix 1, -50,0,-50

`position and point camera
position camera 0,25,-50
point camera 0,0,20


`main loop
do

   `push weeble over
   if mouseclick() = 1
      ang_accel# = 0
      ang_vel# = 0
      angle# = angle# - mousemovex()
      if angle# < 95 then angle# = 95
      if angle# > 265 then angle# = 265
   else
      `perpendicular distance of centre of gravity from centre of rotation of the weeble
      s# = c_gravity# * sin(angle#)

      `calculate angular acceleration of weeble
      `uses: (sum of torques) = (moment of inertia) * (angular acceleration)
      `rearranged: (angular acceleration) = (sum of torques) / (moment of inertia)
      ang_accel# = (weight#*s# - damp_coef#*ang_vel#) / m_inertia#

      `caculate angular velocity of weeble
      ang_vel# = ang_vel# + ang_accel#

      `caculate angle of weeble
      angle# = angle# + ang_vel#
   endif

   `calculate x coordinate of weeble (so it looks like it's rolling)
   x_pos# = radius#*sin(angle#)

   `position and rotate weeble
   position object 1, x_pos#,radius#,0
   zrotate object 1, angle#

   set cursor 1,1 :print "Weeble demo"
   set cursor 1,20 : print "Click and hold LMB and drag mouse left or right. Release LMB to watch weeble wobble."

   sync

loop

  []
[][][][]
  []

set display mode 800,600,32
sync on
sync rate 60
autocam off
hide mouse


gosub _init
position camera 0,0,-30
do
   gosub _rotate_object

   sync
loop


_init:
   rem create 3d axis
   gosub _create_axis_textures

   `make plains
   make object plain 1,25,25
   texture object 1,1
   make mesh from object 1,1
   add limb 1,1,1
   rotate limb 1,1,0,270,0
   texture limb 1,1,2
   delete mesh 1

   set object 1,1,0,0
return

_rotate_object:
   xrotate object 1,wrapvalue(object angle x(1)+(upkey()-downkey()))
   yrotate object 1,wrapvalue(object angle y(1)+(rightkey()-leftkey()))
return

_create_axis_textures:
   rem create axis
   ink rgb(255,255,0),0
   text 124,0,"+Y"
   box 124,text height("Y"),130,256-text height("Y")-1
   text 124,256-text height("Y"),"-Y"

   ink rgb(255,0,0),0
   text 0,110,"-X"
   box text width("-X")+1,124,256-(text width("+X"))-1,130
   text 256-(text width("+X")),110,"+X"

   get image 1,0,0,256,256
   sync

   cls 0

   ink rgb(255,255,0),0
   text 124,0,"+Y"
   box 124,text height("Y"),130,256-text height("Y")-1
   text 124,256-text height("Y"),"-Y"

   ink rgb(0,0,255),0
   text 0,110,"-Z"
   box text width("-Z")+1,124,256-(text width("+Z"))-1,130
   text 256-(text width("+Z")),110,"+Z"

   get image 2,0,0,256,256
   sync
return

Latch

29 games!

rem RPG Character Editor
rem Made by Sinani201
rem The DB Classic Programming Challenge Thread

set display mode 800,600,32
rem A white background is more pleasing to the eye.
ink 0,rgb(255,255,255)
cls
sync on
sync rate 60
disable escapekey
hide mouse

dim stats(4)
stats(0) = 3 : stats(1) = 3
stats(2) = 3 : stats(3) = 3
stats(4) = 3 : ` Set the default stat values
dim stat$(4)
stat$(0) = "s" : stat$(1) = "i"
stat$(2) = "d" : stat$(3) = "e"
stat$(4) = "l" : ` Set the characters associated with each stat

dim class(1)

do
   cls
   rem This draws the text that will always be on the screen.
   gosub rawtext
   for c=0 to 4
      statcount(c)
   next c
   gosub checkForInput
   dot mousex(),mousey()
   mousepos$ = "X: " + str$(mousex()) + " Y: " + str$(mousey())
   text 0,0,mousepos$
   text 80,50,"87"
   sync
loop

rawtext:
rem We use a monospace font to align the text easily.
rem This is very useful for the stat pickers because
rem the @, -, and " " characters would normally have
rem different widths.
set text font "Courier New"

text 10,10,"Charater [N]ame:"

text 15,50,"Stats: (  /15 points left)"
text 30,70,"[S]trength:     [-]           [+]"
text 30,90,"[I]ntelligence: [-]           [+]"
text 30,110,"[D]exterity     [-]           [+]"
text 30,130,"[E]ndurance:    [-]           [+]"
text 30,150,"[L]uck:         [-]           [+]"

text 15,180,"Weapons:"

text 400,50,"Class:"
text 415,70,"[W]arrior"
text 415,110,"[M]age"
text 415,150,"[A]rcher"
return

checkForInput:
rem Check for keys that change stats.
if lower$(inkey$()) = "s" then statpick(0)
if lower$(inkey$()) = "i" then statpick(1)
if lower$(inkey$()) = "d" then statpick(2)
if lower$(inkey$()) = "e" then statpick(3)
if lower$(inkey$()) = "l" then statpick(4)

rem Check for keys that switch classes.
if lower$(inkey$()) = "w" then classpick(1)

rem Check if the user wants to quit.
if escapekey() = 1 then applicationWillTerminate
return

function statcount(i)
   for t = 1 to stats(i)
      starstr$ = statstr$ + "@"
   next t
   for c = 1 to 5-stats(i)
      statstr$ = statstr$ + "-"
   next c
   text 190,20*(t+1)+59,statstr$
return

function statpick(i)
   text 20,20*(i+1)+50,">"
   wait 500
   do
      if inkey$() = "+"
         if inkey$() = ""
            stats(i) = stats(i) + 1
            ` CODE FOR UPDATING DISPLAY GOES HERE
         endif
      endif
      if inkey$() = "-"
         if inkey$() = ""
            stats(i) = stats(i) - 1
            ` CODE FOR UPDATING DISPLAY GOES HERE
         endif
      endif
      if lower$(inkey$()) = stat$(i) then exit
   loop
   exitfunction
endfunction

function classpick(i)
   text 45,10*i+30,">"
   ` CODE FOR UPDATING STATS GOES HERE
   class(1) = i
endfunction

function applicationWillTerminate
   rem Release all objects
   undim stats(3)
   undim class(1)
   rem End our app with an error foar teh lulz
   killApp = 42 / 0
endfunction

print "10"
cls
print "20"
[your next command etc]

rem RPG Character Editor
rem Made by Sinani201
rem The DB Classic Programming Challenge Thread

set display mode 800,600,32
rem A white background is more pleasing to the eye.
ink 0,rgb(255,255,255)
cls
sync on
sync rate 60
disable escapekey
hide mouse

dim stats(4)
stats(0) = 3 : stats(1) = 3
stats(2) = 3 : stats(3) = 3
stats(4) = 3 : ` Set the default stat values
dim stat$(4)
stat$(0) = "s" : stat$(1) = "i"
stat$(2) = "d" : stat$(3) = "e"
stat$(4) = "l" : ` Set the characters associated with each stat

dim class(1)

do
   cls
   rem This draws the text that will always be on the screen.
   gosub rawtext
   for c=0 to 4
      statcount(c)
   next c
   gosub checkForInput
   dot mousex(),mousey()
   mousepos$ = "X: " + str$(mousex()) + " Y: " + str$(mousey())
   text 0,0,mousepos$
   text 80,50,"87"
   sync
loop

rawtext:
rem We use a monospace font to align the text easily.
rem This is very useful for the stat pickers because
rem the @, -, and " " characters would normally have
rem different widths.
set text font "Courier New"

text 10,10,"Charater [N]ame:"

text 15,50,"Stats: (  /15 points left)"
text 30,70,"[S]trength:     [-]           [+]"
text 30,90,"[I]ntelligence: [-]           [+]"
text 30,110,"[D]exterity     [-]           [+]"
text 30,130,"[E]ndurance:    [-]           [+]"
text 30,150,"[L]uck:         [-]           [+]"

text 15,180,"Weapons:"

text 400,50,"Class:"
text 415,70,"[W]arrior"
text 415,110,"[M]age"
text 415,150,"[A]rcher"
return

checkForInput:
rem Check for keys that change stats.
if lower$(inkey$()) = "s" then statpick(0)
if lower$(inkey$()) = "i" then statpick(1)
if lower$(inkey$()) = "d" then statpick(2)
if lower$(inkey$()) = "e" then statpick(3)
if lower$(inkey$()) = "l" then statpick(4)

rem Check for keys that switch classes.
if lower$(inkey$()) = "w" then classpick(1)

rem Check if the user wants to quit.
if escapekey() = 1 then applicationWillTerminate
return

function statcount(i)
   statstr$ = ""
   for t = 1 to stats(i)
      statstr$ = statstr$ + "@"
   next t
   for c = 1 to 5-stats(i)
      statstr$ = statstr$ + "-"
   next c
   text 190,20*(t+1)+59,statstr$
endfunction

function statpick(i)
   text 20,20*(i+1)+50,">"
   wait 500
   do
      if inkey$() = "+"
         if inkey$() = ""
            stats(i) = stats(i) + 1
            ` CODE FOR UPDATING DISPLAY GOES HERE
         endif
      endif
      if inkey$() = "-"
         if inkey$() = ""
            stats(i) = stats(i) - 1
            ` CODE FOR UPDATING DISPLAY GOES HERE
         endif
      endif
      if lower$(inkey$()) = stat$(i) then exit
   loop
   exitfunction
endfunction

function classpick(i)
   text 45,10*i+30,">"
   ` CODE FOR UPDATING STATS GOES HERE
   class(1) = i
endfunction

function applicationWillTerminate
   rem Release all objects
   undim stats(3)
   undim class(1)
   rem End our app with an error foar teh lulz
   killApp = 42 / 0
endfunction

function statpick(i)
   text 20,20*(i+1)+50,">"
   wait 500
   do
      if inkey$() = "+"
         if inkey$() = ""
            stats(i) = stats(i) + 1
            ` CODE FOR UPDATING DISPLAY GOES HERE
         endif
      endif
      if inkey$() = "-"
         if inkey$() = ""
            stats(i) = stats(i) - 1
            ` CODE FOR UPDATING DISPLAY GOES HERE
         endif
      endif
      if lower$(inkey$()) = stat$(i) then exit
   loop


   `this looks for the key to be released before exiting th function
   repeat
   until lower$(inkey$()) = ""

   exitfunction

   endfunction

remstart
*******************************************************
*           DBC Programming Challenge                 *
*******************************************************
*           RPG Character Maker                       *
*******************************************************
*           "Sons of Anarchy Character Maker"         *
*******************************************************
*           By Lucky 13                               *
*******************************************************
*           Date Created: 13/07/2010                  *
*******************************************************
remend


rem Declare Arrays
dim stat$(10)
dim stats(11)
dim fact$(13)

rem Use setup() and reset() functions to initialise the data for the arrays
setup()
reset()

rem The main loop of the program
main_loop:
sel = 1
total = 10

do
cls
gosub control
draw(sel,total)
sync
loop

rem Control gosub
control:

rem Up key and down key range restricted to first and last options respectively
if upkey() : dec sel : if sel < 1 then sel = 1 : endif
if downkey() : inc sel : if sel > 12 then sel = 12 : endif

rem Right key will behave differently according to which option is currently selected.
if rightkey()

   rem If the option the user wants to change is a stat (sel > 2), the program will first check whether the
   rem total will exceed the maximum number of allowed points. If this is fine, the user can add
   rem points to that stat, if it isn't - they can't. The total number of points used by the user
   rem is constantly tracked to ensure the restrictions are adhered to.
   if sel > 2
      inc total
      if total > 30
         total = 30
      else
         stat = stats(sel - 2)
         inc stat
         if stat > 5 : stat = 5 : dec total : endif
         stats(sel - 2) = stat
      endif
   endif

   rem If the selected option is #2 - "Faction" (sel = 2) then this will cycle through all of the factions.
   if sel = 2
      stat = stats(0)
      inc stat
      if stat > 12 then stat = 0
      stats(0) = stat
   endif
endif

rem Similar to right key, left key will behave differently according to which option is currently selected.
if leftkey()

   rem If the option is a stat option, the user will be able to decrease it as long as it is not less than 1.
   rem If changing the stat decreases it below 1 then it will be reset to 1 and the user will not be able to
   rem decrease its value. Total variable is tracked to ensure the user receives any points they decide to
   rem remove from a stat.
   if sel > 2
      if stats(sel - 2) = 1
         stats(sel - 2) = 1
      else
         stat = stats(sel - 2)
         dec stat
         if stat < 1 then stat = 1
         stats(sel - 2) = stat
         if total > 10 then dec total
      endif
   endif

   rem If the user is amending the Faction stat, they can cycle through the factions in the opposite direction
   rem to the right key cycle.
   if sel = 2
      stat = stats(0)
      dec stat
      if stat < 0 then stat = 12
      stats(0) = stat
   endif
endif

rem Code for accepting input from the keyboard for amending the name. The code method I've used does depend on
rem the knowledge of scancodes. However, a quick search of the TGC Forum presents several resources for getting
rem these codes quickly.
rem The inital IF/THEN checks to see whether a key is being pressed
if scancode() > 0

   rem The seconc IF/THEN checks whether the user has selected option 1 (sel = 1) so that the keyboard input will
   rem edit the string.
   if sel = 1

      rem Adds the input to the existing string if the scancode is a letter.
      if scancode() > 15
         stat$(0) = stat$(0) + inkey$()

         rem Checks to see whether the length of the name is longer than 32 characters and tapers accordingly.
         if len(stat$(0)) > 32 then stat$(0) = left$(stat$(0),32)
      endif
   endif

   rem A check for input from the Backspace key for the deletion of characters
   if scancode() = 14

      rem Providing the length of the string is greater than 1, it will remove the last character.
      if len(stat$(0)) > 0
         stat$(0) = left$(stat$(0),len(stat$(0)) - 1)
      endif
   endif
endif

rem Run the save routine if the return key is pressed and restart the program.
if returnkey() = 1
   save()
   goto main_loop
endif

rem Run the end routine if the escape key is pressed.
if escapekey() = 1 then endgame()
return

rem A function for setting up the program.
function setup()

rem System options
sync on
sync rate 18
disable escapekey

rem ** Creating the pips **
rem Clears the screen and ensures that red is the colour of choice.
cls
ink rgb(255,0,0),rgb(0,0,0)

rem A FOR/NEXT loop for creating the images we'll use for the sprites.
a = 0
for b = 1 to 45 step 11
   box b,1,b + 9,10
   inc a
   get image a,1,1,b + 9,10
next make

rem Reset the colour to black and white
ink rgb(255,255,255),rgb(0,0,0)

rem Sets the sprites to their correct positions and with the correct images.
cls
y = -18
for row = 1 to 10
   inc y,12
   sprite row,30,y,1
next row

rem Fill the arrays declared at the top of the program with the required data.
rem This first array defines the different names of the stats the user can amend.
stat$(1) = "Attack"
stat$(2) = "Defence"
stat$(3) = "Speed"
stat$(4) = "Strength"
stat$(5) = "Charisma"
stat$(6) = "Stealth"
stat$(7) = "Intelligence"
stat$(8) = "Weapons"
stat$(9) = "Motorcycle"
stat$(10) = "Mechanics"

rem The second array defines the factions that the user can be a member of.
fact$(0) = "Sons of Anarchy"
fact$(1) = "Mayans"
fact$(2) = "Cacuzza Family"
fact$(3) = "Lin Triad"
fact$(4) = "Russian Mafia"
fact$(5) = "League Of American Nationalists"
fact$(6) = "Nordics"
fact$(7) = "One-Niners"
fact$(8) = "Militia"
fact$(9) = "True IRA"
fact$(10) = "Charming Police Department"
fact$(11) = "ATF"
fact$(12) = "Townsperson"
fact$(13) = "Old Lady"
endfunction

rem A reset function.
function reset()

rem Reset the character Name to "Character".
stat$(0) = "Character"

rem Reset the stats all to 1.
for fill = 1 to 10
   stats(fill) = 1
next fill

rem Reset the Faction to "Townsperson"
stats(0) = 12
endfunction

rem A function to draw all of the information on screen.
function draw(sel,total)

rem A FOR/NEXT loop for drawing the sprites to screen according to the number stored in the stats array.
y = 49 : for pip = 1 to 10 : inc y,15 : sprite pip,90,y,stats(pip) : next pip

rem A series of IF/THEN statements that decides whether an arrow ("->") is printed next to the field names that
rem were defined in the stat$ array. If the option is not selected then no arrow is printed but spaces are placed
rem to ensure alignment.
if sel = 1 : set cursor 1,16 : print "-> Name (Max. 32): ";stat$(0) : else : set cursor 1,16 : print "    Name (Max. 32): ";stat$(0) : endif
if sel = 2 : set cursor 1,31 : print "-> Faction: ";fact$(stats(0)) : else : set cursor 1,31 : print "    Faction: ";fact$(stats(0)) : endif
if sel = 3 : set cursor 1,61 : print "-> ";stat$(1) : else : set cursor 1,61 : print "    ";stat$(1) : endif
if sel = 4 : set cursor 1,76 : print "-> ";stat$(2) : else : set cursor 1,76 : print "    ";stat$(2) : endif
if sel = 5 : set cursor 1,91 : print "-> ";stat$(3) : else : set cursor 1,91 : print "    ";stat$(3) : endif
if sel = 6 : set cursor 1,106 : print "-> ";stat$(4) : else : set cursor 1,106 : print "    ";stat$(4) : endif
if sel = 7 : set cursor 1,121 : print "-> ";stat$(5) : else : set cursor 1,121 : print "    ";stat$(5) : endif
if sel = 8 : set cursor 1,136 : print "-> ";stat$(6) : else : set cursor 1,136 : print "    ";stat$(6) : endif
if sel = 9 : set cursor 1,151 : print "-> ";stat$(7) : else : set cursor 1,151 : print "    ";stat$(7) : endif
if sel = 10 : set cursor 1,166 : print "-> ";stat$(8) : else : set cursor 1,166 : print "    ";stat$(8) : endif
if sel = 11 : set cursor 1,181 : print "-> ";stat$(9) : else : set cursor 1,181 : print "    ";stat$(9) : endif
if sel = 12 : set cursor 1,196 : print "-> ";stat$(10) : else : set cursor 1,196 : print "    ";stat$(10) : endif

rem a FOR/NEXT to print the total number of points allocated to each stat at the end of the each stat row.
y = 46 : for show = 1 to 10 : inc y,15 : set cursor sprite x(show) + 70,y : print "(";stats(show);")" : next show

rem Print commands for tracking total allocated points.
set cursor 1,226
print "Total Points Allocated (Max. 30): ";total

rem Print commands for informing user of control instructions.
set cursor 1,256
print "**  Control Instructions  **"
print "Up/Down Cursor Keys - Navigates between options."
print "Type name of character using keyboard."
print "Backspace Key - Deletes unwanted characters in Name field."
print "Right/Left Cursor Keys - Amends stat accordingly"
print "Enter Key - Export to CSV File"
print "Escape Key - End Program"
endfunction

rem A function for saving the data to file.
function save()

rem Checks to see whether the file exists and deletes it if so.
if file exist(stat$(0) + ".csv") = 1 then delete file stat$(0) + ".csv"

rem Routines for creating 2 lines for export to a CSV (comma seperated text file).
header$ = "Name"
data$ = stat$(0)
for save = 1 to 10
   header$ = header$ + ", " + stat$(save)
   data$ = data$ + ", " + str$(stats(save))
next save

rem Open to write the strings to a CSV.
open to write 1,stat$(0) + ".csv"
   write string 1,header$
   write string 1,data$
close file 1

rem Use the reset function to reset the stats to their defaults.
reset()
endfunction

rem An end function for freeing memory by undeclaring the arrays and deleting sprites and images.
function endgame()
undim stat$(10)
undim stats(11)
undim fact$(13)
for finish = 1 to 5
   delete sprite finish
   delete image finish
next finish
cls
end
endfunction

open to write 1,stat$(0) + ".csv"
   write string 1,header$
   write string 1,data$
close file 1

if down = 0
   down = 1
   if downkey() = 1 : inc sel : if sel > 12 then sel = 12 : endif
endif
if downkey() = 0 then down = 0

remstart
   ==============================================================
   =  Title  : RPG Charcter Stat Manager
   =  Author : latch
   =  Date   : 07/22/2010
   =  Update :
   =  Version: .01
   ==============================================================
   Comments
   ==============================================================
remend

rem =============================================================
rem = SET UP DISPLAY
rem =============================================================
   autocam off
   set display mode 800,600,32
   sync on
   sync rate 60

rem =============================================================
rem = MAIN
rem =============================================================
_main:
   gosub _textures
   gosub _init

   rem loop
   do
      cls

      text 500,0,"Editing character = "+str$(char)
      text 500,20,"Character Name is : "+cname$(char)
      text 500,40,"Press SPACEBAR to add a new character"

      os=ns
      ns=spacekey()
      if ns > os
         gosub _add_character
      endif

      rem redraw screen
      gosub _draw_screen


      sync
   loop

   end

rem =============================================================
rem = SUBROUTINES - PROCEDURES
rem =============================================================
_init:
   remstart
      set up an array to hold the character stats
      character#(id,stat)

      where id is the character identifier
      and stat is the character statistic

      character(0,0)            ==       the total count of all characters defined
      character

      character(0,1)            ==       default max sum of all stats for new characters
                                         since there are 5 controllable stats
                                         in this example, setting this to multiples
                                         of five will allow for even distribution
                                         of points between the stats.  However, to
                                         allow for varied character abilities, a less
                                         evenly divisible number may be preferred.

      character(id,0)           ==       the image or object number of the character

      character(id,1)           ==       strength
      character(id,2)           ==       dexterity
      character(id,3)           ==       constitution
      character(id,4)           ==       intelligence
      character(id,5)           ==       wisdom
      character(id,6)           ==       the max sum of all stats - this can be
                                         changed throughout the game by maybe level
                                         increases or some kinda of experience or
                                         enchantment

      character(id,7)           ==       current hit points
      character(id,8)           ==       max hit points
      character(id,9)           ==       current magic units
      character(id,10)          ==       max magic points
      character(id,11)          ==       constitution increment.  This is a percentage
                                         of the constitution that the hitpoints will
                                         increment each level.  This is set once
                                         at character creation.  As the game goes
                                         on, a higher constitution will of course
                                         mean more hit points
      character(id,12)          ==       wisdom increment - see constitution increment
                                         except this applies to magic points

      cname$(id)                ==       the name of the character
   remend
   dim character(1,12)
   character(0,0)=0
   character(0,1)=100

   dim cname$(1)

   gosub _add_character
return
`================================================================
   _textures:
      create bitmap 1,screen width(),screen height()
      rem stat container
      container=1
      for y=12 to 25
         ink rgb(255-(9*y),255-(9*y),255-(9*y)),0
         line 10+(5*(sin(15*y))),y,200-(5*(sin(15*y))),y
      next y
      for y=14 to 23
         ink 0,0
         line 12+(5*(sin(15*y))),y,198-(5*(sin(15*y))),y
      next y
      get image container,4,12,206,25
      sync
      delete bitmap 1

      rem stat bars
      str=2 :  `red
      dex=3 :  `white
      con=4 :  `yellow
      intl=5 :  `blue
      wis=6 :  `cyan

      hp=7 :   `green
      mp=8 :   `purple

      tot=9 :  `orange

      create bitmap 1,256,100

      for stat=2 to 9
         cls 0
         select stat
            case 2 : ink rgb(255,0,0),0 : endcase
            case 3 : ink rgb(255,255,255),0 : endcase
            case 4 : ink rgb(255,255,0),0 : endcase
            case 5 : ink rgb(0,0,255),0 : endcase
            case 6 : ink rgb(0,255,255),0 : endcase
            case 7 : ink rgb(0,255,0),0 : endcase
            case 8 : ink rgb(255,0,255),0 : endcase
            case 9 : ink RGB(255,128,0),0 : endcase
         endselect

         box 8,15,202,22

         for n=1 to 9
            blur bitmap 1,2
         next n

         line 10,16,200,16
         blur bitmap 1,2

         get image stat,7,12,203,25
         sync
         sprite stat,0,0,stat
         hide sprite stat
         set sprite stat,0,0
      next stat

      delete bitmap 1

   return
`================================================================
   _draw_screen:
      rem place buttons
      x1=220
      x2=240
      x3=245
      x4=265
      for y=1 to 5
         y1=(y*35)-5
         y2=y1+20
         draw_button(x1,y1,x2,y2)
         draw_button(x3,y1,x4,y2)
         ink 0,0
         set text to bold
         text x1+6,y1+2,"<"
         text x3+7,y1+2,">"

         rem check for mouse click
         if mouseclick()=1
            mx=mousex()
            my=mousey()

            rem decrease stat
            if mouse_within(mx,my,x1,y1,x2,y2)
               rem draw depressed button
               pressed_button(x1,y1,x2,y2)
               ink rgb(0,255,255),0
               text x1+6,y1+2,"<"

               rem reduce the stat
               character(char,y)=character(char,y)-1
               if character(char,y) < 1 then character(char,y)=1
            endif

            rem increase stat
            if mouse_within(mx,my,x3,y1,x4,y2)
               rem draw depressed button
               pressed_button(x3,y1,x4,y2)
               ink rgb(0,255,255),0
               text x3+7,y1+2,">"

               rem increase the stat
               character(char,y)=character(char,y)+1

               rem make sure the single stat doesn't go above
               rem the grand total for all stats
               total=0
               for t=1 to 5
                  inc total,character(char,t)
               next t

               while total > character(char,6)
                  character(char,y)=character(char,y)-1
                  dec total
               endwhile

            endif

         endif

      next y
      set text to normal
      ink rgb(255,255,255),0

      rem place containers
      for y=1 to 5
         rem figure out length of bars based on the array values
         maxlen=character(char,6)
         xstr=((character(char,y)+0.0)/(character(char,6)+0.0))*100
         stretch sprite y+1,xstr,100

         rem place the stat bars
         y1=y*35
         paste sprite y+1,14,y1-1
         paste image container,10,y1,1
      next y

      total=0
      for t=1 to 5
         inc total,character(char,t)
      next t

      tt$="Used Total / Max Possible ("+str$(total)+"/"+str$(character(char,6))+")"
      text 0,220,tt$
      txwd=241
      stretch sprite 9,((total+0.0)/(character(char,6)+0.0))*100,100
      paste sprite 9,txwd+9,221
      paste image container,txwd+6,222,1

      rem list the stats
      text x4+10,35,"Strength = "+str$(character(char,1))
      text x4+10,70,"Dexterity = "+str$(character(char,2))
      text x4+10,105,"Constitution = "+str$(character(char,3))
      text x4+10,140,"Intelligence = "+str$(character(char,4))
      text x4+10,175,"Wisdom = "+str$(character(char,5))

      rem reset the hp and mp
      text 0,280,"Click  DONE  to recalculate HP and MP"
      wdth=35
      draw_button(wdth,280,wdth+text width("DONE")+4,300)
      ink 0,0
      set text to bold
      text wdth+2,282,"DONE"
      ink rgb(255,255,255),0
      set text to normal

      if mouseclick()=1
         if mouse_within(mx,my,wdth,280,wdth+text width("DONE")+4,300)
            pressed_button(wdth,280,wdth+text width("DONE")+4,300)
            ink rgb(0,255,255),0
            `set text to bold
            text wdth+3,283,"DONE"
            ink rgb(255,255,255),0
            set text to normal

            rem set default hitpoints and magic points
            character(char,7)=character(char,3)*(character(char,11)/100.0)
            character(char,8)=character(char,7)
            character(char,9)=character(char,5)*(character(char,12)/100.0)
            character(char,10)=character(char,9)
         endif
      endif

      rem place the hit point and magic point bars
      hp$="Character Hitpoints = ("+str$(character(char,7))+"/"+str$(character(char,8))+")"
      mp$="Character Magic Points = ("+str$(character(char,9))+"/"+str$(character(char,10))+")"
      paste sprite 7,txwd+9,341
      paste image container,txwd+6,342,1
      text 0,340,hp$

      paste sprite 8,txwd+9,371
      paste image container,txwd+6,372,1
      text 0,370,mp$
   return
`================================================================
   _add_character:
      remstart
         A routine to expand the array(s) and setup a new
         character.
      remend

      rem check for existing characters
      if character(0,0)=0
         character(0,0)=1
         char=1
      else
         char=character(0,0)
         dim temp(char+1,12)
         dim temp$(char+1)

         rem copy old arrays to temp arrays
         for n=0 to char
            temp$(n)=cname$(n)
            for m=0 to 12
               temp(n,m)=character(n,m)
            next m
         next n

         rem redimension old arrays
         undim character(char,12)
         undim cname$(char)
         dim character(char+1,12)
         dim cname$(char+1)

         rem copy back old info
         for n=0 to char
            cname$(n)=temp$(n)
            for m=0 to 12
               character(n,m)=temp(n,m)
            next m
         next n
         undim temp(char,12)
         undim temp$(char)

         rem update count
         inc char
         character(0,0)=char
      endif

      rem update new character
      character(char,6)=character(0,1)

      rem set default stats
      for n=1 to 5
         character(char,n)=character(char,6)/5
      next n

      rem set constitution hp and wisdom mp percentage values
      character(char,11)=rnd(50)+10
      character(char,12)=rnd(65)+10

      rem set default hitpoints and magic points
      character(char,7)=character(char,3)*(character(char,11)/100.0)
      character(char,8)=character(char,7)
      character(char,9)=character(char,5)*(character(char,12)/100.0)
      character(char,10)=character(char,9)

      Input "Enter character Name : ";a$
      cname$(char)=a$
   return


rem =============================================================
rem = FUNCTIONS
rem =============================================================
   function mouse_within(mx,my,x1,y1,x2,y2)
      if mx > x1
         if mx < x2
            if my > y1
               if my < y2
                  exitfunction 1
               endif
            endif
         endif
      endif
   endfunction 0
`================================================================
   function draw_button(x1,y1,x2,y2)
      ink rgb(192,192,192),0
      box x1,y1,x2,y2
      ink rgb(255,255,255),0
      box x1,y1,x2,y1
      box x1,y1,x1,y2
      ink rgb(32,32,32),0
      box x2,y1+1,x2,y2
      box x1,y2,x2,y2
   endfunction
`================================================================
   function pressed_button(x1,y1,x2,y2)
      ink rgb(192,192,192),0
      box x1,y1,x2,y2
      ink rgb(32,32,32),0
      box x1,y1,x2,y1
      box x1,y1,x1,y2
      ink rgb(255,255,255),0
      box x2,y1+1,x2,y2
      box x1,y2,x2,y2
   endfunction
`================================================================

remstart
*******************************************************
*           DBC Programming Challenge                 *
*******************************************************
*           RPG Character Maker                       *
*******************************************************
*           "Sons of Anarchy Character Maker"         *
*******************************************************
*           By Lucky 13                               *
*******************************************************
*           Date Created: 13/07/2010                  *
*******************************************************
remend


rem Declare Arrays
dim stat$(10)
dim stats(11)
dim fact$(13)

rem Use setup() and reset() functions to initialise the data for the arrays
setup()
reset()

rem The main loop of the program
main_loop:
sel = 1
total = 10

do
cls
gosub control
draw(sel,total)
sync
loop

rem Control gosub
control:

rem Up key and down key range restricted to first and last options respectively
if up = 0
   up = 1
   if upkey() : dec sel : if sel < 1 then sel = 1 : endif
else
   if upkey() = 0 then up = 0
endif
if down = 0
   down = 1
   if downkey() : inc sel : if sel > 12 then sel = 12 : endif
else
   if downkey() = 0 then down = 0
endif

rem Right key will behave differently according to which option is currently selected.
if right = 0
   right = 1
   if rightkey()

      rem If the option the user wants to change is a stat (sel > 2), the program will first check whether the
      rem total will exceed the maximum number of allowed points. If this is fine, the user can add
      rem points to that stat, if it isn't - they can't. The total number of points used by the user
      rem is constantly tracked to ensure the restrictions are adhered to.
      if sel > 2
         inc total
         if total > 30
            total = 30
         else
            stat = stats(sel - 2)
            inc stat
            if stat > 5 : stat = 5 : dec total : endif
            stats(sel - 2) = stat
         endif
      endif

      rem If the selected option is #2 - "Faction" (sel = 2) then this will cycle through all of the factions.
      if sel = 2
         stat = stats(0)
         inc stat
         if stat > 12 then stat = 0
         stats(0) = stat
      endif
   endif
else
   if rightkey() = 0 then right = 0
endif

rem Similar to right key, left key will behave differently according to which option is currently selected.
if left = 0
   left = 1
   if leftkey()

      rem If the option is a stat option, the user will be able to decrease it as long as it is not less than 1.
      rem If changing the stat decreases it below 1 then it will be reset to 1 and the user will not be able to
      rem decrease its value. Total variable is tracked to ensure the user receives any points they decide to
      rem remove from a stat.
      if sel > 2
         if stats(sel - 2) = 1
            stats(sel - 2) = 1
         else
            stat = stats(sel - 2)
            dec stat
            if stat < 1 then stat = 1
            stats(sel - 2) = stat
            if total > 10 then dec total
         endif
      endif

      rem If the user is amending the Faction stat, they can cycle through the factions in the opposite direction
      rem to the right key cycle.
      if sel = 2
         stat = stats(0)
         dec stat
         if stat < 0 then stat = 12
         stats(0) = stat
      endif
   endif
else
   if leftkey() = 0 then left = 0
endif

rem Code for accepting input from the keyboard for amending the name. The code method I've used does depend on
rem the knowledge of scancodes. However, a quick search of the TGC Forum presents several resources for getting
rem these codes quickly.
rem The inital IF/THEN checks to see whether a key is being pressed
if scancode() > 0

   rem The seconc IF/THEN checks whether the user has selected option 1 (sel = 1) so that the keyboard input will
   rem edit the string.
   if sel = 1

      rem Adds the input to the existing string if the scancode is a letter.
      if scancode() > 15 and scancode() < 54 or scancode() > 1 and scancode() < 14
         if scancode() = 28 or scancode() = 42
            stat$(0) = stat$(0)
         else
            stat$(0) = stat$(0) + inkey$()

            rem Checks to see whether the length of the name is longer than 32 characters and tapers accordingly.
            if len(stat$(0)) > 32 then stat$(0) = left$(stat$(0),32)
         endif
      endif

      if scancode() = 57 then stat$(0) = stat$(0) + inkey$()

      rem A check for input from the Backspace key for the deletion of characters
      if scancode() = 14

         rem Providing the length of the string is greater than 1, it will remove the last character.
         if len(stat$(0)) > 0
            stat$(0) = left$(stat$(0),len(stat$(0)) - 1)
         endif
      endif
   endif
endif

rem Run the save routine if the return key is pressed and restart the program.
if returnkey() = 1
   if len(stat$(0)) > 0
      save()
      goto main_loop
   endif
endif

rem Run the end routine if the escape key is pressed.
if escapekey() = 1 then end
return

rem A function for setting up the program.
function setup()

rem System options
sync on
sync rate 30
disable escapekey

rem ** Creating the pips **
rem Clears the screen and ensures that red is the colour of choice.
cls
ink rgb(255,0,0),rgb(0,0,0)

rem A FOR/NEXT loop for creating the images we'll use for the sprites.
a = 0
for b = 1 to 45 step 11
   box b,1,b + 9,10
   inc a
   get image a,1,1,b + 9,10
next make

rem Reset the colour to black and white
ink rgb(255,255,255),rgb(0,0,0)

rem Sets the sprites to their correct positions and with the correct images.
cls
y = -18
for row = 1 to 10
   inc y,12
   sprite row,30,y,1
next row

rem Fill the arrays declared at the top of the program with the required data.
rem This first array defines the different names of the stats the user can amend.
stat$(1) = "Attack"
stat$(2) = "Defence"
stat$(3) = "Speed"
stat$(4) = "Strength"
stat$(5) = "Charisma"
stat$(6) = "Stealth"
stat$(7) = "Intelligence"
stat$(8) = "Weapons"
stat$(9) = "Motorcycle"
stat$(10) = "Mechanics"

rem The second array defines the factions that the user can be a member of.
fact$(0) = "Sons of Anarchy"
fact$(1) = "Mayans"
fact$(2) = "Cacuzza Family"
fact$(3) = "Lin Triad"
fact$(4) = "Russian Mafia"
fact$(5) = "League Of American Nationalists"
fact$(6) = "Nordics"
fact$(7) = "One-Niners"
fact$(8) = "Militia"
fact$(9) = "True IRA"
fact$(10) = "Charming Police Department"
fact$(11) = "ATF"
fact$(12) = "Townsperson"
fact$(13) = "Old Lady"
endfunction

rem A reset function.
function reset()

rem Reset the character Name to "Character".
stat$(0) = "Character"

rem Reset the stats all to 1.
for fill = 1 to 10
   stats(fill) = 1
next fill

rem Reset the Faction to "Townsperson"
stats(0) = 12
endfunction

rem A function to draw all of the information on screen.
function draw(sel,total)

rem A FOR/NEXT loop for drawing the sprites to screen according to the number stored in the stats array.
y = 49 : for pip = 1 to 10 : inc y,15 : sprite pip,90,y,stats(pip) : next pip

rem A series of IF/THEN statements that decides whether an arrow ("->") is printed next to the field names that
rem were defined in the stat$ array. If the option is not selected then no arrow is printed but spaces are placed
rem to ensure alignment.
if sel = 1 : set cursor 1,16 : print "-> Name (Max. 32): ";stat$(0) : else : set cursor 1,16 : print "    Name (Max. 32): ";stat$(0) : endif
if sel = 2 : set cursor 1,31 : print "-> Faction: ";fact$(stats(0)) : else : set cursor 1,31 : print "    Faction: ";fact$(stats(0)) : endif
if sel = 3 : set cursor 1,61 : print "-> ";stat$(1) : else : set cursor 1,61 : print "    ";stat$(1) : endif
if sel = 4 : set cursor 1,76 : print "-> ";stat$(2) : else : set cursor 1,76 : print "    ";stat$(2) : endif
if sel = 5 : set cursor 1,91 : print "-> ";stat$(3) : else : set cursor 1,91 : print "    ";stat$(3) : endif
if sel = 6 : set cursor 1,106 : print "-> ";stat$(4) : else : set cursor 1,106 : print "    ";stat$(4) : endif
if sel = 7 : set cursor 1,121 : print "-> ";stat$(5) : else : set cursor 1,121 : print "    ";stat$(5) : endif
if sel = 8 : set cursor 1,136 : print "-> ";stat$(6) : else : set cursor 1,136 : print "    ";stat$(6) : endif
if sel = 9 : set cursor 1,151 : print "-> ";stat$(7) : else : set cursor 1,151 : print "    ";stat$(7) : endif
if sel = 10 : set cursor 1,166 : print "-> ";stat$(8) : else : set cursor 1,166 : print "    ";stat$(8) : endif
if sel = 11 : set cursor 1,181 : print "-> ";stat$(9) : else : set cursor 1,181 : print "    ";stat$(9) : endif
if sel = 12 : set cursor 1,196 : print "-> ";stat$(10) : else : set cursor 1,196 : print "    ";stat$(10) : endif

rem a FOR/NEXT to print the total number of points allocated to each stat at the end of the each stat row.
y = 46 : for show = 1 to 10 : inc y,15 : set cursor sprite x(show) + 70,y : print "(";stats(show);")" : next show

rem Print commands for tracking total allocated points.
set cursor 1,226
print "Total Points Allocated (Max. 30): ";total

rem Print commands for informing user of control instructions.
set cursor 1,256
print "**  Control Instructions  **"
print "Up/Down Cursor Keys - Navigates between options."
print "Type name of character using keyboard."
print "Backspace Key - Deletes unwanted characters in Name field."
print "Right/Left Cursor Keys - Amends stat accordingly"
print "Enter Key - Export to CSV File"
print "Escape Key - End Program"
endfunction

rem A function for saving the data to file.
function save()

rem Checks to see whether the file exists and deletes it if so.
if file exist(stat$(0) + ".csv") = 1 then delete file stat$(0) + ".csv"

rem Routines for creating 2 lines for export to a CSV (comma seperated text file).
header$ = "Name"
data$ = stat$(0)
for save = 1 to 10
   header$ = header$ + ", " + stat$(save)
   data$ = data$ + ", " + str$(stats(save))
next save

rem Open to write the strings to a CSV.
open to write 1,stat$(0) + ".csv"
   write string 1,header$
   write string 1,data$
close file 1

rem Use the reset function to reset the stats to their defaults.
reset()
endfunction

rem RPG Character Editor
rem Made by Sinani201
rem The DB Classic Programming Challenge Thread

set display mode 1024,768,32
rem A white background is more pleasing to the eye.
ink 0,rgb(255,255,255)
cls
sync on
sync rate 60
disable escapekey
hide mouse

dim stats(4,1)
stats(0) = 3 : stats(1) = 3
stats(2) = 3 : stats(3) = 3
stats(4) = 3 : ` Set the default stat values
dim stat$(4)
stat$(0) = "s" : stat$(1) = "i"
stat$(2) = "d" : stat$(3) = "e"
stat$(4) = "l" : ` Set the characters associated with each stat

dim class(3,5) : ` Set the stat bonuses associated with each class
class(1,1) = 3 : class(1,3) = 2 : class(1,4) = 1
class(2,2) = 3 : class(2,5) = 2 : class(2,3) = 1
class(3,3) = 3 : class(3,4) = 2 : class(3,5) = 1

do
   cls
   rem This draws the text that will always be on the screen.
   gosub rawtext
   gosub pointsleft
   gosub showweapons
   gosub finalstats
   for c=0 to 4
      statcount(c)
      stats(c,1) = stats(c) + class(class(0),c+1)
   next c
   for d=1 to 3
      if class(d) = 1 then text 405,d*40+30,">"
   next d
   gosub checkForInput
   dot mousex(),mousey()
   mousepos$ = "X: " + str$(mousex()) + " Y: " + str$(mousey())
   text 0,0,mousepos$
   sync
loop

rawtext:
rem We use a monospace font to align the text easily.
rem This is very useful for the stat pickers because
rem the @, -, and " " characters would normally have
rem different widths.
set text font "Courier New"

text 10,10,"Charater [N]ame:"

text 15,50,"Stats: (  /15 points left)"
text 30,70,"[S]trength:     [-]           [+]"
text 30,90,"[I]ntelligence: [-]           [+]"
text 30,110,"[D]exterity:    [-]           [+]"
text 30,130,"[E]ndurance:    [-]           [+]"
text 30,150,"[L]uck:         [-]           [+]"

text 15,180,"Weapons:"

text 400,50,"Class:"
text 415,70,"[W]arrior"
text 430,90,"Str+3, Dex+2, End+1"
text 415,110,"[M]age"
text 430,130,"Int+3, Luk+2, Dex+1"
text 415,150,"[A]rcher"
text 430,170,"Dex+3, End+2, Luk+1"
return

checkForInput:
rem Check for keys that change stats.
if lower$(inkey$()) = "s" then statpick(0)
if lower$(inkey$()) = "i" then statpick(1)
if lower$(inkey$()) = "d" then statpick(2)
if lower$(inkey$()) = "e" then statpick(3)
if lower$(inkey$()) = "l" then statpick(4)

rem Check for keys that switch classes.
if lower$(inkey$()) = "w"
   class(1) = 1
   class(2) = 0
   class(3) = 0
endif
if lower$(inkey$()) = "m"
   class(1) = 0
   class(2) = 1
   class(3) = 0
endif
if lower$(inkey$()) = "a"
   class(1) = 0
   class(2) = 0
   class(3) = 1
endif

rem Check if the user wants to quit.
if escapekey() = 1 then applicationWillTerminate
return

pointsleft:
pleft = 0
for p = 0 to 4
   pleft = pleft + stats(p)
next p
pleft = 15 - pleft
text 80,50,str$(pleft)
return

showweapons:
rem Reverse select!
select 1
   case class(1)
      text 30,200,"S[c]imitar: 6dmg"
      text 45,220,"The local weaponsmith made this sword and sold it to your grandfather."
      text 30,240,"Da[r]k Edge: 5-7dmg"
      text 45,260,"This sword was stolen from the goblins during the Great War."
      text 30,280,"L[o]ng sword: 4-8dmg"
      text 45,300,"This was made by a weaponsmith from an unknown faraway land."
      text 30,320,"[G]ladius: 3-9dmg"
      text 45,340,"This sword was used by Ancient Romans."
      text 30,360,"[X]iphos: 2-10dmg"
      text 45,380,"This sword was used by Ancient Greeks."
      text 30,400,"[T]his one goes to 11: 1-11dmg"
      text 45,420,chr$(34)+"Most blokes are gonna be playin' up to 10, but where can you go from there? Tell me!"+chr$(34)
   endcase
   case class(2)
      text 30,200,"MAGE WEAPONS HERE"
   endcase
   case class(3)
      text 30,200,"ARCHER WEAPONS HERE"
   endcase
   case default
      text 30,200,"Select a class to get weapon choices!"
   endcase
endselect
return

finalstats:
text 30,460,"FINAL STATS:"
text 45,480,"Strength: " + str$(stats(0,1))
text 45,500,"Intelligence: " + str$(stats(1,1))
text 45,520,"Dexterity: " + str$(stats(2,1))
text 45,540,"Endurance: " + str$(stats(3,1))
text 45,560,"Luck: " + str$(stats(4,1))
return

function statcount(i)
   statstr$ = ""
   rem Generate and draw the string that represents selected stats.
   for t = 1 to stats(i)
      statstr$ = statstr$ + "@"
   next t
   for c = 1 to 9-stats(i)
      statstr$ = statstr$ + "-"
   next c
   text 190,20*(i+1)+50,statstr$
endfunction

function statpick(i)
   b$=""
   text 20,20*(i+1)+50,">"
   wait 155
   do
      if inkey$() = "+"
         if inkey$() = ""
            stats(i) = stats(i) + 1
            ink rgb(255,255,255),rgb(255,255,255)
            box 190,(i+1)*20+50,260,(i+1)*20+63
            ink 0,rgb(255,255,255)
            for t = 1 to stats(i)
               b$ = b$ + "@"
            next t
            for c = 1 to 9-stats(i)
               b$ = b$ + "@"
            next c
            text 190,20*(i+1)+50,b$
         endif
      endif
      if inkey$() = "-"
         if inkey$() = ""
            stats(i) = stats(i) - 1
            ` CODE FOR UPDATING DISPLAY GOES HERE
         endif
      endif
      if lower$(inkey$()) = stat$(i) then exit
      sync
   loop
   repeat : until inkey$() = ""
endfunction

function classpick(i)
   class(i) = 1
   class(0) = i
endfunction

function applicationWillTerminate
   rem Release all objects
   undim stats(4,1)
   undim class(3,5)
   undim stat$(4)
   rem End the app with an error foar teh lulz
   killApp = 42 / 0
endfunction