DBC examples

rem ==================================================================
rem Cavern Dash - an OpenDBC example for the DarkBASIC Classic profile
rem Fly through an endless cave carved by two scrolling matrices.
rem Arrow keys steer and climb, SPACE boosts, ESCAPE quits.
rem Code and media are part of OpenDBC (MIT licence).
rem ==================================================================

sync on : sync rate 60
hide mouse
randomize 7
autocam off
backdrop on
color backdrop rgb(10, 8, 16)
set camera range 1, 900

rem --- Tunnel layout: a floor and a ceiling matrix of 10 x 20 tiles
tiles = 10 : rows = 20 : tile# = 40.0
width# = tiles * tile# : depth# = rows * tile#
ceiling# = 150.0

rem --- Texture atlas: four 1024 pixel tiles in one 2048 x 2048 image
load bitmap "textures/tiles.jpg", 1
get image 1, 0, 0, 2048, 2048
delete bitmap 1

make matrix 1, width#, depth#, tiles, rows
make matrix 2, width#, depth#, tiles, rows
prepare matrix texture 1, 1, 2, 2
prepare matrix texture 2, 1, 2, 2
rem The ceiling is seen from below, so it must not be back-face culled
set matrix 2, 0, 0, 0, 1, 1, 1, 1
gosub new_tunnel

rem --- Fog hides the far edge of the matrices
if fog available() = 1
   fog on
   fog color rgb(10, 8, 16)
   fog distance 700
endif

load sound "sounds/engine.wav", 1
load sound "sounds/crash.wav", 2
loop sound 1

ink rgb(255, 220, 160), 0
best = 0

do
   rem --- Steering, climbing and boost
   steer# = 0.0
   if leftkey() = 1 then steer# = -1.0
   if rightkey() = 1 then steer# = 1.0
   if upkey() = 1 then y# = y# + 1.5
   if downkey() = 1 then y# = y# - 1.5
   x# = x# + steer# * 2.5
   boost# = 0.0
   if spacekey() = 1 then boost# = 2.5
   speed# = curvevalue(3.0 + distance / 400.0 + boost#, speed#, 20)
   roll# = curvevalue(steer# * -20.0, roll#, 8)

   rem --- Scroll the cave towards the camera one tile row at a time
   scroll# = scroll# + speed#
   if scroll# >= tile#
      scroll# = scroll# - tile#
      shift matrix up 1
      shift matrix up 2
      row = rows
      gosub carve_row
      update matrix 1
      update matrix 2
      distance = distance + 1
   endif
   position matrix 1, 0, 0, 0 - scroll#
   position matrix 2, 0, ceiling#, 0 - scroll#

   rem --- Collision against the floor, the ceiling and the side walls
   local_z# = z# + scroll#
   ground# = get ground height(1, x#, local_z#)
   roof# = ceiling# + get ground height(2, x#, local_z#)
   if y# < ground# + 6 or y# > roof# - 6 then gosub crash

   position camera x#, y#, z#
   xrotate camera 8
   zrotate camera roll#
   set sound speed 1, 8000 + speed# * 1200

   center text screen width() / 2, 12, "DISTANCE " + str$(distance) + "   BEST " + str$(best)
   sync
loop

rem ------------------------------------------------------------------
rem Rebuild the whole tunnel and put the ship back at its entrance
new_tunnel:
   pathx = tiles / 2
   for row = 0 to rows
      gosub carve_row
   next row
   update matrix 1
   update matrix 2
   x# = (tiles / 2) * tile# : y# = 50.0 : z# = 60.0
   scroll# = 0.0 : speed# = 2.0 : roll# = 0.0 : distance = 0
return

rem ------------------------------------------------------------------
rem Carve one row of vertices around a path that wanders sideways
carve_row:
   rem The first rows stay straight so a new run starts in open space
   if row > 3 then pathx = pathx + rnd(2) - 1
   if pathx < 3 then pathx = 3
   if pathx > tiles - 3 then pathx = tiles - 3
   tile_row = row
   if tile_row > rows - 1 then tile_row = rows - 1
   for col = 0 to tiles
      gap = abs(col - pathx)
      if gap > 2
         floor_height# = 60 + rnd(40)
         roof_height# = 0 - 60 - rnd(40)
         tile = 3 + rnd(1)
      else
         floor_height# = rnd(12)
         roof_height# = 0 - rnd(12)
         tile = 1 + rnd(1)
      endif
      set matrix height 1, col, row, floor_height#
      set matrix height 2, col, row, roof_height#
      if col < tiles
         set matrix tile 1, col, tile_row, tile
         set matrix tile 2, col, tile_row, tile
      endif
   next col
return

rem ------------------------------------------------------------------
rem Flash the cave red, then restart
crash:
   play sound 2
   for flash = 1 to 20
      color backdrop rgb(255 - flash * 12, 40, 20)
      sync
   next flash
   color backdrop rgb(10, 8, 16)
   if distance > best then best = distance
   gosub new_tunnel
return

rem ==================================================================
rem Dune Armour - an OpenDBC example for the DarkBASIC Classic profile
rem Command a tank across the dunes and hold the outpost against a
rem patrol of six-wheeled raiders. The radar in the corner shows them.
rem UP/DOWN drive, LEFT/RIGHT steer, Z/X turn the turret, SPACE fires.
rem Without the keys the tank drives and fights by itself.
rem Code and media are part of OpenDBC (MIT code, CC0 media).
rem ==================================================================

sync on : sync rate 60
hide mouse
autocam off
randomize timer()
backdrop on
sky = rgb(200, 190, 160)
color backdrop sky
set camera range 1, 2500
set ambient light 55
fog_ok = fog available()
if fog_ok = 1 then fog on : fog color sky : fog distance 900

rem Limbs of the tank and of the raiders (from their .x files)
track_l = 2 : track_r = 3 : turret = 4 : dish = 7
wheel_first = 2 : wheel_last = 7 : gun_ring = 9

gosub build_desert
gosub build_outpost
gosub build_acacias
gosub build_tank
gosub build_raiders
gosub build_effects

load sound "sounds/rumble.wav", 1
load sound "sounds/cannon.wav", 2
load sound "sounds/blast.wav", 3
load sound "sounds/ping.wav", 4
load sound "sounds/raider_gun.wav", 5
loop sound 1

do

First 40 lines shown — 321 more in examples/dbc/demos/dune_armour/dune_armour.dba.

rem ==================================================================
rem Flooded Vault - an OpenDBC example for the DarkBASIC Classic profile
rem Walk a mechanical crab through a flooded cistern and catch the drops
rem that fall from the vault before they hit the water.
rem Arrow keys walk and turn, ESCAPE quits.
rem Code and media are part of OpenDBC (MIT code, CC0 media).
rem ==================================================================

sync on : sync rate 60
hide mouse
autocam off
randomize timer()
backdrop on
color backdrop rgb(4, 10, 12)
set camera range 1, 600
set ambient light 45

if fog available() = 1
   fog on
   fog color rgb(4, 10, 12)
   fog distance 260
endif

rem --- The cistern: one object whose limbs carry their own textures
load object "models/room.x", 1
perform checklist for object limbs 1
limbs = checklist quantity()

rem --- Water: an alpha-blended plain whose texture slowly drifts
load image "textures/water.jpg", 1
make object plain 2, 62, 62
texture object 2, 1
scale object texture 2, 3, 3
xrotate object 2, 90
position object 2, 0, 1.2, 0
ghost object on 2, 1
fade object 2, 60

rem --- The crab: idle frames 0 to 20, walk cycle appended at frame 100
load object "models/crab_idle.x", 3

First 40 lines shown — 118 more in examples/dbc/demos/flooded_vault/flooded_vault.dba.

rem ==================================================================
rem Frost Outpost - an OpenDBC example for the DarkBASIC Classic profile
rem Hold the snowy outpost against ice imps. Distant imps are cheap
rem camera-facing impostors; close ones are animated 3D models.
rem Mouse looks, W A S D or the arrow keys move, the mouse button fires.
rem Code and media are part of OpenDBC (MIT code, CC0 media).
rem ==================================================================

sync on : sync rate 60
hide mouse
autocam off
randomize timer()
backdrop on
sky_colour = rgb(150, 170, 195)
color backdrop sky_colour
set camera range 1, 1600
set ambient light 60
if fog available() = 1
   fog on
   fog color rgb(170, 185, 205)
   fog distance 700
endif

rem Clip ranges inside every imp object (each clip is appended after the idle one)
idle_start = 0 : idle_end = 20
walk_start = 30 : walk_end = 54
charge_start = 60 : charge_end = 76
punch_start = 80 : punch_end = 104
diea_start = 110 : diea_end = 140
dieb_start = 150 : dieb_end = 180

gosub build_terrain
gosub build_outpost
gosub build_sky
gosub build_weapon
gosub build_hud
gosub build_imps

load sound "sounds/pulse.wav", 1
load sound "sounds/impact.wav", 2

First 40 lines shown — 284 more in examples/dbc/demos/frost_outpost/frost_outpost.dba.

rem ==================================================================
rem Hive Defender - an OpenDBC example for the DarkBASIC Classic profile
rem Hold the line against a swarm of hive drones. They sway in formation,
rem then break off one by one to dive at your ship; now and then their
rem mothership crosses the sky for a bonus.
rem LEFT/RIGHT move, SPACE fires. Without the keys the ship fights alone.
rem Code and media are part of OpenDBC (MIT code, CC0 media).
rem ==================================================================

sync on : sync rate 60
hide mouse
autocam off
randomize timer()
color backdrop 0
set ambient light 70
position camera 0, -12, -115
point camera 0, 4, 0

cols = 8 : rows = 4 : drones = cols * rows
dim slotx(drones) : dim sloty(drones) : dim state(drones) : dim dx#(drones) : dim dy#(drones)
dim divet#(drones) : dim divedir(drones)
dim boltx#(8) : dim bolty#(8) : dim boltlife(8)
dim boom(8)

gosub build_scene
gosub new_wave
lives = 3 : score = 0 : wave = 1
px# = 0.0 : shot = 0 : invulnerable = 120

do
   t = t + 1
   gosub move_player
   gosub move_formation
   gosub launch_dive
   for d = 1 to drones
      if state(d) > 0 then gosub update_drone
   next d
   gosub move_bolts
   gosub move_mothership
   gosub update_explosions

First 40 lines shown — 265 more in examples/dbc/demos/hive_defender/hive_defender.dba.

rem ==================================================================
rem Wave Racer - an OpenDBC example for the DarkBASIC Classic profile
rem Race a jet scooter through eight buoy gates on a rolling sea, two
rem laps against the clock. Hit the ramp for a jump.
rem Up accelerates, Down brakes, Left and Right steer, SPACE restarts.
rem Code and media are part of OpenDBC (MIT code, CC0 media).
rem ==================================================================

sync on : sync rate 60
hide mouse
autocam off
backdrop on
color backdrop rgb(204, 219, 235)
set camera range 1, 4000
set ambient light 70
fog_ok = fog available()
if fog_ok = 1
   fog on
   fog color rgb(204, 219, 235)
   fog distance 900
endif

rem --- Sea: a matrix whose heights are recomputed every frame
segments = 30 : sea_size# = 2400.0 : half# = sea_size# / 2
load image "textures/sea.jpg", 1
make matrix 1, sea_size#, sea_size#, segments, segments
prepare matrix texture 1, 1, 1, 1
position matrix 1, 0 - half#, 0, 0 - half#

rem --- Sky dome that follows the camera; it is seen from inside
load image "textures/sky.jpg", 2
make object sphere 3, 3000
texture object 3, 2
set object 3, 1, 1, 0, 1, 0, 0, 1

rem --- Scooter and rider (limb 1 of the scooter is the hull, limb 5 the flag);
rem the glued rider inherits the scooter scale
load object "models/scooter.x", 10
load object "models/rider.x", 11
scale object 10, 300, 300, 300

First 40 lines shown — 222 more in examples/dbc/demos/wave_racer/wave_racer.dba.

rem ==================================================================
rem Colour Picker - an OpenDBC tutorial for the DarkBASIC Classic profile
rem Paints a palette with RGB colours, then reads the pixel under the
rem mouse back with POINT and splits it with RGBR, RGBG and RGBB.
rem Move the mouse over the palette; without a mouse a probe wanders.
rem Code is part of OpenDBC (MIT).
rem ==================================================================

sync on : sync rate 60
w = screen width() : h = screen height()
palette_h = h - 120

rem The palette: hue changes across, pale at the top and dark at the bottom
for y = 0 to palette_h - 1 step 6
   for x = 0 to w - 1 step 6
      ink palette_colour(x * 360.0 / w, y * 1.0 / palette_h), 0
      box x, y, x + 5, y + 5
   next x
next y

do
   mx = mousex() : my = mousey()
   rem No mouse movement yet: let a probe trace a slow loop over the palette
   if mx = 0 and my = 0
      t# = t# + 0.6
      mx = w / 2 + sin(t#) * (w / 2 - 20)
      my = palette_h / 2 + cos(t# * 1.7) * (palette_h / 2 - 10)
   endif
   if my > palette_h - 1 then my = palette_h - 1

   rem POINT reads the screen, so read before drawing anything new
   c = point(mx, my)
   red = rgbr(c) : green = rgbg(c) : blue = rgbb(c)

   rem The panel under the palette is redrawn every frame
   ink rgb(24, 24, 30), 0
   box 0, palette_h, w - 1, h - 1
   ink c, 0
   box 16, palette_h + 14, 116, h - 16
   ink rgb(230, 230, 230), 0
   text 136, palette_h + 10, "POINT(" + str$(mx) + "," + str$(my) + ")"
   text 136, palette_h + 34, "RGBR " + str$(red)
   text 136, palette_h + 56, "RGBG " + str$(green)
   text 136, palette_h + 78, "RGBB " + str$(blue)
   ink rgb(red, 0, 0), 0 : box 230, palette_h + 38, 230 + red, palette_h + 48
   ink rgb(0, green, 0), 0 : box 230, palette_h + 60, 230 + green, palette_h + 70
   ink rgb(0, 0, blue), 0 : box 230, palette_h + 82, 230 + blue, palette_h + 92
   sync
loop

rem Hue in degrees, height from 0 (top, pale) to 1 (bottom, dark)
function palette_colour(hue#, height#)
   sector = int(hue# / 60.0)
   f# = hue# / 60.0 - sector
   r# = 0.0 : g# = 0.0 : b# = 0.0
   select sector
      case 0 : r# = 1.0 : g# = f# : endcase
      case 1 : r# = 1.0 - f# : g# = 1.0 : endcase
      case 2 : g# = 1.0 : b# = f# : endcase
      case 3 : g# = 1.0 - f# : b# = 1.0 : endcase
      case 4 : r# = f# : b# = 1.0 : endcase
      case default : r# = 1.0 : b# = 1.0 - f# : endcase
   endselect
   if height# < 0.5
      rem Mix towards white
      mix# = (0.5 - height#) * 2.0
      r# = r# + (1.0 - r#) * mix# : g# = g# + (1.0 - g#) * mix# : b# = b# + (1.0 - b#) * mix#
   else
      rem Mix towards black
      mix# = 1.0 - (height# - 0.5) * 2.0
      r# = r# * mix# : g# = g# * mix# : b# = b# * mix#
   endif
   colour = rgb(int(r# * 255), int(g# * 255), int(b# * 255))
endfunction colour

rem ==================================================================
rem Night Town - an OpenDBC tutorial for the DarkBASIC Classic profile
rem Paints a town at night with the 2D drawing commands only:
rem LINE for the sky and for filling shapes, DOT for the stars, CIRCLE
rem and ELLIPSE for outlines, BOX for the buildings and windows.
rem Press any key to build another town.
rem Code is part of OpenDBC (MIT).
rem ==================================================================

randomize timer()
do
   gosub draw_town
   suspend for key
loop

draw_town:
   w = screen width() : h = screen height()
   cls

   rem A sky gradient: one horizontal LINE per row, a little bluer each time
   for y = 0 to h - 1
      ink rgb(8 + y / 24, 10 + y / 10, 40 + y / 5), 0
      line 0, y, w - 1, y
   next y

   rem Stars are single DOTs of random brightness, thinner near the horizon
   for s = 1 to 220
      sx = rnd(w - 1) : sy = rnd(h / 2)
      c = 120 + rnd(135) - sy / 2
      ink rgb(c, c, c + 20), 0
      dot sx, sy
   next s

   rem The moon: a disc filled with one LINE per row, shaded from the lit
   rem side, then CIRCLE outlines for its rim and a few craters
   moonx = w - 130 : moony = 90 : moonr = 44
   for dy = 0 - moonr to moonr
      half = sqrt(moonr * moonr - dy * dy)
      c = 235 - (dy + moonr) / 2
      ink rgb(c, c - 6, c - 50), 0
      line moonx - half, moony + dy, moonx + half, moony + dy
   next dy
   ink rgb(255, 250, 210), 0
   circle moonx, moony, moonr
   ink rgb(190, 180, 130), 0
   circle moonx - 14, moony - 10, 9
   circle moonx + 12, moony + 14, 6
   circle moonx + 18, moony - 16, 4

   rem Clouds: overlapping puffs filled row by row, each with an ELLIPSE rim
   for cloud = 1 to 4
      cx = rnd(w) : cy = 70 + rnd(110)
      for puff = 0 to 3
         px = cx + puff * 34 - 50 : py = cy - (puff mod 2) * 10
         rx = 40 + rnd(20) : ry = 14 + rnd(6)
         ink rgb(48 + puff * 4, 54 + puff * 4, 92 + puff * 4), 0
         for dy = 0 - ry to ry
            half = rx * sqrt(1.0 - (dy * dy * 1.0) / (ry * ry))
            line px - half, py + dy, px + half, py + dy
         next dy
         ink rgb(90, 98, 140), 0
         ellipse px, py, rx, ry
      next puff
   next cloud

   rem Buildings: a filled BOX each, then small boxes for the windows
   x = 0
   while x < w
      bw = 36 + rnd(40) : bh = 70 + rnd(170)
      top = h - 30 - bh
      shade = 18 + rnd(18)
      ink rgb(shade, shade, shade + 12), 0
      box x, top, x + bw - 2, h - 30
      for wy = top + 10 to h - 48 step 16
         for wx = x + 6 to x + bw - 14 step 12
            if rnd(3) = 0
               ink rgb(250, 210 + rnd(40), 110), 0
               box wx, wy, wx + 5, wy + 8
            endif
         next wx
      next wy
      x = x + bw
   endwhile

   rem The street
   ink rgb(20, 20, 26), 0
   box 0, h - 30, w - 1, h - 1
   ink rgb(220, 200, 90), 0
   for x = 10 to w step 60
      line x, h - 15, x + 30, h - 15
   next x

   ink rgb(255, 255, 255), 0
   text 12, 10, "NIGHT TOWN - press a key for another town"
return

rem ==================================================================
rem Spirograph - an OpenDBC tutorial for the DarkBASIC Classic profile
rem Draws rolling-circle curves with short LINE segments whose colour
rem drifts through the spectrum. Click the mouse (or wait for the
rem curve to close) to start a new pattern. SPACE clears the screen.
rem Code is part of OpenDBC (MIT).
rem ==================================================================

sync on : sync rate 60
randomize timer()
w = screen width() : h = screen height()
cls
gosub new_pattern

do
   rem Forty short segments per frame make the curve grow smoothly
   for step = 1 to 40
      t# = t# + 0.5
      x# = cx + (big - small) * cos(t#) + pen * cos(t# * (big - small) / small)
      y# = cy + (big - small) * sin(t#) - pen * sin(t# * (big - small) / small)
      ink rgb(128 + sin(t# * 0.5) * 127, 128 + sin(t# * 0.5 + 120) * 127, 128 + sin(t# * 0.5 + 240) * 127), 0
      line lastx#, lasty#, x#, y#
      lastx# = x# : lasty# = y#
   next step

   if spacekey() = 1 then cls
   if mouseclick() = 1 and clicked = 0 then gosub new_pattern
   clicked = mouseclick()
   if t# > turns * 360.0 then gosub new_pattern

   ink rgb(255, 255, 255), 0
   text 10, 10, "SPIROGRAPH - click for a new pattern, SPACE clears"
   sync
loop

new_pattern:
   rem A fixed ring rolls a smaller wheel; the pen sits on the wheel's spoke
   big = 120 + rnd(80)
   small = 20 + rnd(70)
   pen = 20 + rnd(90)
   cx = w / 4 + rnd(w / 2) : cy = h / 3 + rnd(h / 3)
   rem The curve closes after small / gcd(big, small) turns
   a = big : b = small
   while b > 0
      r = a mod b : a = b : b = r
   endwhile
   turns = small / a
   if turns > 12 then turns = 12
   t# = 0.0
   lastx# = cx + (big - small) + pen : lasty# = cy
return

rem ==================================================================
rem Animation - an OpenDBC tutorial for the DarkBASIC Classic profile
rem Left: an imp whose idle and walk clips sit one after the other in a
rem single object (APPEND OBJECT), played, looped, slowed down and
rem blended with interpolation. Right: a rider animated by hand: each
rem pose is stored with SET OBJECT KEYFRAME, the keyframes are saved to
rem a file and loaded onto a second rider with APPEND OBJECT ANIMATION.
rem 1 idle, 2 walk, 3 stops, 4 shows frame 10, 5 walks once, S slows down, I toggles
rem interpolation, C clears the rider's middle keyframe.
rem Code and media are part of OpenDBC (MIT code, CC0 media).
rem ==================================================================

sync on : sync rate 60
autocam off
color backdrop rgb(50, 60, 80)
set ambient light 60
position camera 0, 6, -22
point camera 0, 3, 0

rem --- The imp: idle frames first, then the walk appended from frame 30
load object "imp_idle.x", 1
idle_end = total object frames(1)
append object "imp_walk.x", 1, 30
walk_end = total object frames(1)
scale object 1, 200, 200, 200
position object 1, -6, 0, 0
loop object 1, 30, walk_end
set object speed 1, 100

rem --- The rider: three poses of the right arm become keyframes 0, 20 and 40
load object "rider.x", 2
scale object 2, 300, 300, 300
position object 2, 5, 0, 0
for pose = 0 to 2
   rotate limb 2, 6, -150 + pose * 50, 0, 30
   set object keyframe 2, pose * 20
next pose
loop object 2, 0, 40

rem The keyframes go to a file and back onto a second rider
save object animation "wave.anim", 2
load object "rider.x", 3
append object animation "rider.x", "wave.anim", 3, 0
delete file "wave.anim"
scale object 3, 300, 300, 300
position object 3, 11, 0, 0
loop object 3, 0, 40
speed = 100

do
   key$ = lower$(inkey$())
   if key$ <> lastkey$
      select key$
         case "1" : loop object 1, 0, idle_end : endcase
         case "2" : loop object 1, 30, walk_end : endcase
         case "3" : stop object 1 : endcase
         case "5" : play object 1, 30, walk_end : endcase
         case "4" : stop object 1 : set object frame 1, 10 : endcase
         case "s"
            if speed = 100 then speed = 25 else speed = 100
            set object speed 1, speed
         endcase
         case "i"
            rem Interpolation blends smoothly into a new clip instead of jumping
            if object interpolation(1) = 0 then set object interpolation 1, 100 else set object interpolation 1, 0
         endcase
         case "c" : clear object keyframe 2, 20 : endcase
         case "x" : clear all object keyframes 2 : endcase
      endselect
   endif
   lastkey$ = key$
   yrotate object 1, 180

   ink rgb(255, 255, 255), 0
   text 10, 10, "ANIMATION - 1 idle  2 walk  3 stop  4 frame 10  S speed  I interpolation  C/X keyframes"
   text 10, 34, "IMP: FRAME " + str$(int(object frame(1))) + " of " + str$(total object frames(1)) + "  PLAYING " + str$(object playing(1)) + "  LOOPING " + str$(object looping(1))
   text 10, 54, "     SPEED " + str$(object speed(1)) + "  INTERPOLATION " + str$(object interpolation(1))
   text 10, 78, "RIDERS: frame " + str$(int(object frame(2))) + " and " + str$(int(object frame(3))) + " (the second loaded the saved keyframes)"
   sync
loop

rem ==================================================================
rem Cameras - an OpenDBC tutorial for the DarkBASIC Classic profile
rem Five ways to drive the camera, one after the other every four
rem seconds (or with keys 1 to 5): circling with POSITION and POINT
rem CAMERA, walking with MOVE, TURN, PITCH and ROLL, following a ball
rem with SET CAMERA TO FOLLOW, turning on each axis, and riding a
rem spinning object. The view is letterboxed with SET CAMERA VIEW.
rem Code and media are part of OpenDBC (MIT code, CC0 media).
rem ==================================================================

sync on : sync rate 60
rem With AUTOCAM ON, the camera moves to frame each new object
autocam on
make object sphere 1, 4
autocam off
color object 1, rgb(255, 220, 60)
load image "crystal.jpg", 1
for p = 2 to 9
   make object box p, 4, 10 + p * 2, 4
   position object p, sin(p * 45) * 30, 5 + p, cos(p * 45) * 30
   texture object p, 1
next p
make object plain 10, 120, 120
xrotate object 10, 90
color object 10, rgb(50, 60, 80)
make object cone 11, 4
position object 11, 0, 25, 0
color object 11, rgb(255, 90, 90)

set camera range 1, 500
rem Letterbox: draw the 3D only between y = 60 and y = 420
set camera view 0, 60, screen width(), screen height() - 60
dim mode$(5)
mode$(1) = "POSITION + POINT CAMERA" : mode$(2) = "MOVE, TURN, PITCH, ROLL" : mode$(3) = "SET CAMERA TO FOLLOW"
mode$(4) = "XROTATE, YROTATE, ZROTATE, ROTATE" : mode$(5) = "SET CAMERA TO OBJECT ORIENTATION"
mode = 1 : changed = timer()

do
   t = t + 1
   for k = 1 to 5
      if keystate(k + 1) = 1 and mode <> k then mode = k : changed = timer() : manual = 1 : gosub enter_mode
   next k
   if manual = 0 and timer() - changed > 4000 then mode = (mode mod 5) + 1 : changed = timer() : gosub enter_mode

   rem The ball runs a circle; the cone spins on top
   bx# = sin(t) * 20 : bz# = cos(t * 1.3) * 20
   position object 1, bx#, 2, bz#
   yrotate object 11, wrapvalue(t * 2)

   select mode
      case 1
         position camera sin(t * 0.5) * 60, 30, cos(t * 0.5) * 60
         point camera 0, 8, 0
      endcase
      case 2
         rem Walk forwards, turn, nod and lean
         move camera 0.3
         if (t / 120) mod 2 = 0 then turn camera right 0.4 else turn camera left 0.4
         if (t / 60) mod 2 = 0 then pitch camera down 0.1 else pitch camera up 0.1
         if (t / 90) mod 2 = 0 then roll camera left 0.05 else roll camera right 0.05
      endcase
      case 3
         rem SET CAMERA TO FOLLOW x, y, z, angle, distance, height, smoothing, collision
         set camera to follow bx#, 2, bz#, wrapvalue(t + 90), 25, 10, 15, 0
      endcase
      case 4
         position camera 0, 15, -50
         if (t / 120) mod 2 = 0 then set camera rotation xyz else set camera rotation zyx
         xrotate camera 10
         yrotate camera sin(t) * 30
         zrotate camera sin(t * 2) * 10
         if (t / 60) mod 4 = 3 then rotate camera 20, 0, 0
      endcase
      case 5
         position camera 0, 25, 0
         set camera to object orientation 11
         move camera -1
      endcase
   endselect

   rem SET CAMERA FOV zooms: a narrow angle magnifies
   set camera fov 60 + sin(t * 0.7) * 15
   clear camera view rgb(20, 24, 34)

   ink rgb(255, 255, 255), 0
   text 10, 8, "CAMERAS - mode " + str$(mode) + ": " + mode$(mode) + "   (keys 1-5)"
   text 10, 28, "POSITION " + str$(int(camera position x())) + ", " + str$(int(camera position y())) + ", " + str$(int(camera position z())) + "   ANGLE " + str$(int(camera angle x())) + ", " + str$(int(camera angle y())) + ", " + str$(int(camera angle z()))
   sync
loop

rem Each mode starts from a fresh camera
enter_mode:
   set camera rotation xyz
   rotate camera 0, 0, 0
   if mode = 2 then position camera 0, 6, -40
return

rem ==================================================================
rem Collisions - an OpenDBC tutorial for the DarkBASIC Classic profile
rem A ball bounces around an arena of obstacles. Each obstacle tests
rem collisions in its own way: by box, by sphere or polygon by polygon,
rem and one has a separate collision box. OBJECT COLLISION tells whether
rem the ball touches something now, OBJECT HIT only reports a new touch.
rem G switches all collisions off and on, B removes the collision box,
rem W makes the walls solid.
rem Code and media are part of OpenDBC (MIT code, CC0 media).
rem ==================================================================

sync on : sync rate 60
autocam off
randomize 3
color backdrop rgb(30, 30, 40)
position camera 0, 55, -45
point camera 0, 0, 0

rem The floor and the ball
make object box 100, 80, 1, 60
position object 100, 0, -1, 0
color object 100, rgb(60, 70, 60)
make object sphere 1, 4
color object 1, rgb(255, 220, 60)
set object collision to spheres 1

rem Obstacles 2 to 7, each with its own collision shape
dim kind$(7) : dim flash(7)
for o = 2 to 7
   select o mod 3
      case 0 : make object cube o, 8 : set object collision to boxes o : kind$(o) = "box" : endcase
      case 1 : make object sphere o, 8 : set object collision to spheres o : kind$(o) = "sphere" : endcase
      case 2 : make object cone o, 9 : set object collision to polygons o : kind$(o) = "polygon" : endcase
   endselect
   position object o, -27 + (o - 2) * 11, 3, sin(o * 70) * 15
   color object o, rgb(90, 120, 200)
next o
rem Obstacle 7 gets a collision box larger than its own shape
make object collision box 7, -7, -4, -7, 7, 8, 7, 0
kind$(7) = "collision box"
rem The arena walls do not collide: the ball turns round at the edges
for w = 8 to 9
   make object box w, 80, 4, 1
   position object w, 0, 1, (w - 8.5) * 61
   set object collision off w
next w

x# = 0 : z# = -20 : dx# = 0.35 : dz# = 0.27
do
   key$ = lower$(inkey$())
   if key$ <> lastkey$
      if key$ = "g"
         all_off = 1 - all_off
         if all_off = 1 then set global collision off else set global collision on
      endif
      if key$ = "b" then delete object collision box 7 : kind$(7) = "sphere (box removed)"
      rem W makes the walls solid: the ball then turns at them too
      if key$ = "w"
         walls = 1 - walls
         for w = 8 to 9
            if walls = 1 then set object collision on w else set object collision off w
         next w
      endif
   endif
   lastkey$ = key$

   x# = x# + dx# : z# = z# + dz#
   if abs(x#) > 38 then dx# = 0 - dx#
   if abs(z#) > 28 then dz# = 0 - dz#
   position object 1, x#, 2, z#

   rem A new hit flashes the obstacle red and sends the ball back
   hit = object hit(1, 0)
   if hit > 1 and hit < 10
      color object hit, rgb(255, 60, 60)
      flash(hit) = 30
      dx# = 0 - dx# : dz# = 0 - dz#
      x# = x# + dx# * 3 : z# = z# + dz# * 3
      lastx# = get object collision x() : lasty# = get object collision y() : lastz# = get object collision z()
   endif
   for o = 2 to 7
      if flash(o) > 0
         dec flash(o)
         if flash(o) = 0 then color object o, rgb(90, 120, 200)
      endif
   next o

   ink rgb(255, 255, 255), 0
   text 10, 10, "COLLISIONS - G switches collisions off/on, B removes the collision box"
   text 10, 30, "touching now: " + str$(object collision(1, 0)) + "   last hit: " + str$(hit) + "   all collisions off: " + str$(all_off)
   text 10, 50, "last collision adjustment: " + str$(int(lastx# * 10) / 10.0) + ", " + str$(int(lasty# * 10) / 10.0) + ", " + str$(int(lastz# * 10) / 10.0)
   for o = 2 to 7
      if object in screen(o) = 1 then center text object screen x(o), object screen y(o) + 28, kind$(o)
   next o
   sync
loop

rem ==================================================================
rem Flight - an OpenDBC tutorial for the DarkBASIC Classic profile
rem Moving and turning objects: a glider flies with MOVE OBJECT, TURN,
rem PITCH and ROLL; a chaser follows it with POINT OBJECT; a shadow
rem copies its orientation; a sign always faces the camera; and the
rem camera trails behind using NEWXVALUE, CURVEVALUE and CURVEANGLE.
rem LEFT/RIGHT turn, UP/DOWN pitch, Q/E roll, L frees the compass;
rem otherwise it flies itself.
rem Code and media are part of OpenDBC (MIT code, CC0 media).
rem ==================================================================

sync on : sync rate 60
autocam off
backdrop on
color backdrop rgb(150, 190, 230)
set camera range 1, 3000

rem The sea: a large plain laid flat
load image "sea.jpg", 1
make object plain 1, 2000, 2000
texture object 1, 1
scale object texture 1, 20, 20
xrotate object 1, 90
position object 1, 0, -20, 0

rem The glider: a cone made to point along +Z. FIX OBJECT PIVOT keeps the
rem tilt as the object's resting shape, so later turns start from it.
make object cone 2, 8
scale object 2, 100, 220, 100
xrotate object 2, 90
fix object pivot 2
color object 2, rgb(240, 90, 60)

rem The chaser, the shadow and a sign
make object sphere 4, 2
color object 4, rgb(60, 60, 200)
make object cone 5, 4
scale object 5, 60, 200, 60
xrotate object 5, 90
fix object pivot 5
color object 5, rgb(20, 40, 60)
make object plain 6, 12, 4
color object 6, rgb(255, 230, 120)
position object 6, -70, 12, 90
rem A compass needle locked to the screen, like part of a dashboard
make object cone 7, 0.6
scale object 7, 40, 120, 40
lock object on 7
position object 7, 4.2, 3.0, 10
color object 7, rgb(255, 60, 60)

rem Two cones turned by the same angles in a different order
for o = 8 to 9
   make object cone o, 3
   position object o, 40 + (o - 8.5) * 16, 5, 70
   color object o, rgb(120, 200, 120)
next o
set object rotation xyz 8
set object rotation zyx 9

position object 2, 0, 10, 0
camx# = 0 : camy# = 20 : camz# = -40 : camyaw# = 0

do
   rem Controls, or an autopilot that weaves in long curves
   if leftkey() + rightkey() + upkey() + downkey() + keystate(16) + keystate(18) > 0 then manual = 1
   if manual = 1
      if leftkey() = 1 then turn object left 2, 1.5
      if rightkey() = 1 then turn object right 2, 1.5
      if upkey() = 1 then pitch object down 2, 1
      if downkey() = 1 then pitch object up 2, 1
      if keystate(16) = 1 then roll object left 2, 2
      if keystate(18) = 1 then roll object right 2, 2
   else
      t = t + 1
      turn object right 2, sin(t * 0.7) * 0.9
      if object position y(2) > 25 then pitch object down 2, 0.3
      if object position y(2) < 5 then pitch object up 2, 0.3
   endif
   move object 2, 0.8

   rem The chaser aims a little above the glider and moves a little slower
   point object 4, object position x(2), object position y(2) + 10, object position z(2)
   move object 4, 0.7
   rem The shadow sits on the water and copies the glider's orientation
   position object 5, object position x(2), -19, object position z(2)
   set object to object orientation 5, 2
   rem The sign turns to face the camera
   set object to camera orientation 6
   rem L unlocks the compass needle from the screen and locks it again
   if lower$(inkey$()) = "l" and lheld = 0
      locked = 1 - locked
      if locked = 1 then lock object off 7 else lock object on 7
   endif
   lheld = (lower$(inkey$()) = "l")
   rem The compass needle shows the glider's heading
   zrotate object 7, 0 - object angle y(2)
   xrotate object 8, wrapvalue(t) : zrotate object 8, 40
   xrotate object 9, wrapvalue(t) : zrotate object 9, 40

   rem The camera eases towards a point behind the glider
   heading# = object angle y(2)
   wantx# = newxvalue(object position x(2), heading#, -22)
   wantz# = newzvalue(object position z(2), heading#, -22)
   wanty# = newyvalue(object position y(2), object angle x(2), -6) + 9
   camx# = curvevalue(wantx#, camx#, 8)
   camy# = curvevalue(wanty#, camy#, 8)
   camz# = curvevalue(wantz#, camz#, 8)
   camyaw# = curveangle(heading#, camyaw#, 8)
   position camera camx#, camy#, camz#
   point camera object position x(2), object position y(2), object position z(2)

   ink rgb(20, 30, 50), 0
   text 10, 10, "FLIGHT - arrows turn and pitch, Q/E roll"
   text 10, 30, "GLIDER ANGLES " + str$(int(object angle x(2))) + ", " + str$(int(object angle y(2))) + ", " + str$(int(object angle z(2))) + "   CAMERA YAW " + str$(int(camyaw#))
   rem OBJECT SCREEN X and Y place a label on the chaser when it is visible
   if object in screen(4) = 1
      text object screen x(4) + 10, object screen y(4) - 10, "chaser"
   endif
   if object in screen(8) = 1 then text object screen x(8) - 20, object screen y(8) + 20, "XYZ"
   if object in screen(9) = 1 then text object screen x(9) - 20, object screen y(9) + 20, "ZYX"
   sync
loop

rem ==================================================================
rem Landscape - an OpenDBC tutorial for the DarkBASIC Classic profile
rem A matrix is a grid of tiles whose corners can be raised and lowered:
rem the quickest way to build ground in DarkBASIC. This one never ends:
rem as the rover drives on, SHIFT MATRIX UP moves the rows along and a
rem new row of hills is made at the far edge. A second, ghosted matrix
rem is the lake. W wireframe, R random hills, F flattens, D drains,
rem G makes the lake solid.
rem Code and media are part of OpenDBC (MIT code, CC0 media).
rem ==================================================================

sync on : sync rate 60
autocam off
color backdrop rgb(160, 190, 220)
set camera range 1, 2000
if fog available() = 1 then fog on : fog color rgb(160, 190, 220) : fog distance 600

rem --- Matrix 1: 40 x 40 tiles over 800 x 800 units, textured from a 2 x 2 atlas
segments = 40 : size = 800 : cell = size / segments
make matrix 1, size, size, segments, segments
load image "terrain.jpg", 1
prepare matrix texture 1, 1, 2, 2
position matrix 1, 0 - size / 2, 0, 0 - size / 2
set matrix texture 1, 0, 1
dim row(segments)
for z = 0 to segments
   gosub make_row
next z
update matrix 1

rem --- Matrix 2: the lake, a ghosted flat grid that ripples
make matrix 2, 300, 300, 12, 12
load image "sea.jpg", 2
prepare matrix texture 2, 2, 1, 1
position matrix 2, -150, -6, 60
ghost matrix on 2
set matrix 2, 1, 0, 1, 1, 1, 1, 1

rem The rover: a box riding the ground
make object box 1, 8, 4, 12
color object 1, rgb(220, 120, 40)
travel# = 0.0 : rows_made = segments

do
   t = t + 1
   rem Drive forward; every time the rover covers a whole tile, shift a row
   travel# = travel# + 1.6
   if travel# >= cell
      travel# = travel# - cell
      shift matrix up 1
      inc rows_made
      z = segments : gosub make_row
      update matrix 1
   endif
   rem GET GROUND HEIGHT works in the matrix's own coordinates
   gy# = get ground height(1, size / 2, size / 2 - 200 + travel#)
   position object 1, 0, gy# + 2, -200 + travel#
   position camera 0, gy# + 30, -260 + travel#
   point camera 0, gy# + 5, -150 + travel#

   rem The lake ripples: every corner of matrix 2 bobs on its own wave
   for z = 0 to 12
      for x = 0 to 12
         set matrix height 2, x, z, sin(t * 3 + x * 30) * 1.5 + cos(t * 2 + z * 40) * 1.5
      next x
   next z
   update matrix 2

   key$ = lower$(inkey$())
   if key$ <> lastkey$
      if key$ = "w"
         if matrix wireframe state(1) = 1 then set matrix wireframe off 1 else set matrix wireframe on 1
      endif
      if key$ = "r" then randomize matrix 1, 60 : update matrix 1
      if key$ = "f" then fill matrix 1, 0, 1 : update matrix 1
      if key$ = "d" and matrix exist(2) = 1 then delete matrix 2
      if key$ = "g" and matrix exist(2) = 1
         clear_lake = 1 - clear_lake
         if clear_lake = 1 then ghost matrix off 2 else ghost matrix on 2
      endif
      rem Nudge the whole landscape sideways and back with the other shifts
      if key$ = "q" then shift matrix left 1 : update matrix 1
      if key$ = "e" then shift matrix right 1 : update matrix 1
      if key$ = "s" then shift matrix down 1 : update matrix 1
   endif
   lastkey$ = key$

   ink rgb(20, 30, 40), 0
   text 10, 8, "LANDSCAPE - W wireframe, R random, F flat, D drains the lake, Q/E/S shift"
   text 10, 28, "rows made " + str$(rows_made) + "   ground under the rover " + str$(int(gy#)) + "   corner height " + str$(int(get matrix height(1, 20, 20)))
   text 10, 48, "MATRIX 1 at " + str$(int(matrix position x(1))) + ", " + str$(int(matrix position y(1))) + ", " + str$(int(matrix position z(1))) + "   tiles " + str$(matrix tile count(1)) + " (" + str$(matrix tiles exist(1)) + ")   lake exists " + str$(matrix exist(2))
   sync
loop

rem Heights and tiles for row z: rolling hills that never repeat exactly
make_row:
   for x = 0 to segments
      wz = rows_made - segments + z
      h# = 25 * sin(x * 17 + wz * 11) + 15 * cos(wz * 23) + 8 * sin((x - wz) * 31)
      if abs(x - segments / 2) < 3 then h# = h# * 0.2
      set matrix height 1, x, z, h#
      rem Normals tilt with the slope so the light shades the hills
      set matrix normal 1, x, z, 0 - cos(x * 17 + wz * 11) * 0.3, 1, 0 - cos(wz * 23) * 0.2
      if x < segments and z < segments
         tile = 1
         if h# > 20 then tile = 4
         if h# < -15 then tile = 3
         if abs(x - segments / 2) < 2 then tile = 2
         set matrix tile 1, x, z, tile
      endif
   next x
return

rem ==================================================================
rem Lights - an OpenDBC tutorial for the DarkBASIC Classic profile
rem Three kinds of light on a gallery of spheres: a point light that
rem circles like a lamp, a spot light carried by a lantern object, and
rem a directional light like the sun. Light 0 is the default light;
rem lights 1 to 7 are made with MAKE LIGHT. Keys 1 to 3 hide and show
rem the lights, A changes the colour of the ambient light.
rem Code and media are part of OpenDBC (MIT code, CC0 media).
rem ==================================================================

sync on : sync rate 60
autocam off
color backdrop rgb(10, 10, 16)
position camera 0, 20, -45
point camera 0, 0, 0
set ambient light 15

load image "bricks.jpg", 1
make object box 1, 80, 1, 50
position object 1, 0, -4, 0
texture object 1, 1
scale object texture 1, 4, 3
for s = 2 to 7
   make object sphere s, 7
   position object s, -25 + (s - 2) * 10, 0, 4
next s
make object cone 8, 2
color object 8, rgb(255, 255, 160)
set object 8, 1, 0, 1, 1, 0, 1, 1

rem The default light 0 becomes a dim blue directional light from above
set directional light 0, 0.3, -1, 0.4
color light 0, rgb(40, 50, 90)

rem Light 1: a warm point light, like a bulb
make light 1
set point light 1, 0, 8, 0
color light 1, 255, 180, 90
set light range 1, 40

rem Light 2: a spot light carried by the lantern (object 8)
make light 2
set spot light 2, 20, 40
color light 2, rgb(120, 255, 160)
set light range 2, 80

rem Light 3: a red directional light turned with ROTATE LIGHT
make light 3
set directional light 3, 1, 0, 0
color light 3, rgb(180, 30, 30)

ambient = 0
do
   t = t + 1
   position light 1, sin(t) * 25, 8, cos(t) * 12 - 4
   rem The lantern swings; the spot light copies its place and direction
   position object 8, sin(t * 0.7) * 20, 15, -10
   point object 8, sin(t * 1.3) * 20, 0, 4
   set light to object position 2, 8
   set light to object orientation 2, 8
   rotate light 3, 0, wrapvalue(t), 0
   if t mod 300 = 150 then point light 3, 0, 0, 0

   key$ = lower$(inkey$())
   if key$ <> lastkey$
      for l = 1 to 3
         if key$ = str$(l)
            if light visible(l) = 1 then hide light l else show light l
         endif
      next l
      if key$ = "a" then ambient = (ambient + 1) mod 3
   endif
   lastkey$ = key$
   if ambient = 0 then color ambient light rgb(255, 255, 255)
   if ambient = 1 then color ambient light rgb(80, 120, 255)
   if ambient = 2 then color ambient light rgb(255, 120, 60)

   ink rgb(255, 255, 255), 0
   text 10, 8, "LIGHTS - keys 1-3 hide and show lights, A ambient colour"
   for l = 0 to 3
      if light exist(l) = 1
         line$ = "LIGHT " + str$(l) + ": type " + str$(light type(l)) + "  visible " + str$(light visible(l)) + "  range " + str$(int(light range(l)))
         line$ = line$ + "  at " + str$(int(light position x(l))) + "," + str$(int(light position y(l))) + "," + str$(int(light position z(l)))
         line$ = line$ + "  facing " + str$(int(light direction x(l) * 10) / 10.0) + "," + str$(int(light direction y(l) * 10) / 10.0) + "," + str$(int(light direction z(l) * 10) / 10.0)
         text 10, 30 + l * 18, line$
      endif
   next l
   if t = 600 then delete light 3
   sync
loop

rem ==================================================================
rem Limbs - an OpenDBC tutorial for the DarkBASIC Classic profile
rem A loaded model is a tree of limbs, each with its own position, angle,
rem scale, texture and visibility. The rider is glued to the scooter's
rem hull, waves an arm and turns a red helmet; the seat bounces, the
rem handlebar grows and the hull gets a scrolling striped texture. The
rem panel cycles through the rider's limbs. U unglues the rider.
rem Code and media are part of OpenDBC (MIT code, CC0 media).
rem ==================================================================

sync on : sync rate 60
autocam off
color backdrop rgb(60, 80, 110)
set ambient light 50
position camera 0, 9, -22
point camera 0, 3, 0

load object "scooter.x", 1
load object "rider.x", 2
rem The models are small: scale the scooter, and the glued rider follows
scale object 1, 300, 300, 300
rem GLUE OBJECT TO LIMB object, to object, limb: the rider rides limb 1
glue object to limb 2, 1, 1
load image "bands.jpg", 1
texture limb 1, 1, 1
scale limb texture 1, 1, 2, 2

rem The rider's limbs, listed by name
perform checklist for object limbs 2
limbs = checklist quantity()
dim limbname$(20)
for l = 1 to limbs : limbname$(l) = checklist string$(l) : next l
glued = 1

do
   t = t + 1
   yrotate object 1, wrapvalue(t * 0.5)
   rem Limb commands take the object number, then the limb number
   rotate limb 2, 6, 0 - 60 + sin(t * 6) * 50, 0, 20
   rotate limb 2, 3, 0, sin(t * 2) * 40, 0
   color limb 2, 3, rgb(220, 40, 40)
   offset limb 1, 2, 0, 0.6 + abs(sin(t * 4)) * 0.2, -0.6
   scale limb 1, 3, 100 + sin(t * 3) * 30, 100, 100
   scroll limb texture 1, 1, 0.003, 0
   rem The flag (limb 5) shows for one second in three
   if (t / 60) mod 3 = 0 then show limb 1, 5 else hide limb 1, 5

   if lower$(inkey$()) = "u" and glued = 1
      rem UNGLUE OBJECT frees the rider, who stays where the scooter left him
      unglue object 2
      position object 2, 3, 0, -2
      glued = 0
   endif

   rem The panel shows one limb of the rider at a time
   l = 1 + (t / 90) mod limbs
   ink rgb(0, 0, 0), 0
   box 0, 0, screen width(), 112
   ink rgb(255, 255, 255), 0
   text 10, 4, "LIMBS - " + str$(limbs) + " limbs in the rider; showing " + str$(l) + ": " + limbname$(l) + "   (U unglues the rider)"
   text 10, 24, "EXIST " + str$(limb exist(2, l)) + "  VISIBLE " + str$(limb visible(2, l)) + "  TEXTURE " + str$(limb texture(2, l)) + " " + file_name$(limb texture name$(2, l))
   text 10, 44, "POSITION " + str$(int(limb position x(2, l) * 10) / 10.0) + ", " + str$(int(limb position y(2, l) * 10) / 10.0) + ", " + str$(int(limb position z(2, l) * 10) / 10.0)
   text 10, 64, "OFFSET " + str$(int(limb offset x(2, l) * 10) / 10.0) + ", " + str$(int(limb offset y(2, l) * 10) / 10.0) + ", " + str$(int(limb offset z(2, l) * 10) / 10.0) + "   ANGLE " + str$(int(limb angle x(2, l))) + ", " + str$(int(limb angle y(2, l))) + ", " + str$(int(limb angle z(2, l)))
   text 10, 84, "DIRECTION " + str$(int(limb direction x(2, l))) + ", " + str$(int(limb direction y(2, l))) + ", " + str$(int(limb direction z(2, l)))
   sync
loop

rem Texture names are full paths: keep what follows the last slash
function file_name$(path$)
   for i = len(path$) to 1 step -1
      if mid$(path$, i) = "/" or mid$(path$, i) = "\" then exitfunction right$(path$, len(path$) - i)
   next i
endfunction path$

rem ==================================================================
rem Materials - an OpenDBC tutorial for the DarkBASIC Classic profile
rem Eight cubes show the ways a surface can look: a texture, a texture
rem repeated and scrolling, wireframe, black made transparent, ghosting,
rem fading, no lighting, and drawing in front of everything. SET OBJECT
rem switches wireframe, transparency, culling, filtering, light, fog and
rem ambient light in one command.
rem Code and media are part of OpenDBC (MIT code, CC0 media).
rem ==================================================================

sync on : sync rate 60
autocam off
color backdrop rgb(40, 44, 60)
set ambient light 40
position camera 0, 3, -42
point camera 0, 0, 0
set mipmap mode 2
set normalization on

load image "bricks.jpg", 1
load image "crystal.jpg", 2
load image "sea.jpg", 3

dim label$(8)
for c = 1 to 8
   make object cube c, 7
   position object c, -27 + ((c - 1) mod 4) * 18, 7 - ((c - 1) / 4) * 15, 0
   texture object c, 1
next c
label$(1) = "TEXTURE OBJECT"
rem 2: the texture repeated three times, with mirrored tiles (mode 1)
scale object texture 2, 3, 3
set object texture 2, 1, 1
label$(2) = "SCALE + SET OBJECT TEXTURE"
rem 3: a scrolling sea
texture object 3, 3
label$(3) = "SCROLL OBJECT TEXTURE"
rem 4: SET OBJECT object, wireframe 0 shows only the edges
set object 4, 0, 0, 1
label$(4) = "SET OBJECT wireframe"
rem 5: transparency 1 makes black texels invisible
texture object 5, 2
set object 5, 1, 1, 0
label$(5) = "SET OBJECT transparency"
rem 6: a ghost adds its colour to what is behind it
texture object 6, 2
ghost object on 6
label$(6) = "GHOST OBJECT ON"
rem 7: fading darkens the object towards black
label$(7) = "FADE OBJECT"
rem 8: no lighting, and drawn over everything with z-depth off
set object 8, 1, 0, 1, 1, 0, 1, 1
disable object zdepth 8
label$(8) = "light off, ZDEPTH off"
rem A slab passing in front shows which cube ignores depth
make object box 9, 70, 3, 2
color object 9, rgb(200, 80, 60)

do
   t = t + 1
   for c = 1 to 8 : yrotate object c, wrapvalue(t + c * 20) : xrotate object c, 20 : next c
   scroll object texture 3, 0.004, 0.002
   fade object 7, 50 + sin(t * 2) * 50
   position object 9, 0, sin(t) * 12, -6
   rem The ghost flickers on and off every two seconds
   if t mod 240 = 0 then ghost object off 6
   if t mod 240 = 120 then ghost object on 6
   rem Cube 8 takes turns ignoring depth and respecting it
   if t mod 360 = 180 then enable object zdepth 8
   if t mod 360 = 0 then disable object zdepth 8

   ink rgb(255, 255, 255), 0
   for c = 1 to 8
      if object in screen(c) = 1 then center text object screen x(c), object screen y(c) + 44, str$(c)
      text 10 + ((c - 1) mod 2) * 310, screen height() - 90 + ((c - 1) / 2) * 20, str$(c) + ". " + label$(c)
   next c
   text 10, 10, "MATERIALS   filtering " + str$(filtering available()) + "   alpha blending " + str$(alphablending available()) + "   3D blit " + str$(3dblit available())
   sync
loop

rem ==================================================================
rem Mesh Builder - an OpenDBC tutorial for the DarkBASIC Classic profile
rem A mesh is the shape of an object without its position or texture.
rem Meshes come from objects (MAKE MESH FROM OBJECT) or files (LOAD
rem MESH) and build new objects: MAKE OBJECT starts one, ADD LIMB stacks
rem more meshes on it, LINK LIMB chains them and CHANGE MESH swaps a
rem limb's shape. On the right, a sphere mesh is copied into a memblock,
rem its vertices pushed in and out, and turned back into a mesh.
rem Code and media are part of OpenDBC (MIT code, CC0 media).
rem ==================================================================

sync on : sync rate 60
autocam off
color backdrop rgb(30, 40, 50)
position camera 0, 8, -36
point camera 0, 4, 0

rem --- Meshes from shapes and from a file
make object sphere 1, 4 : make mesh from object 1, 1 : delete object 1
make object cube 2, 3 : make mesh from object 2, 2 : delete object 2
make object cylinder 3, 2 : make mesh from object 3, 3 : delete object 3
load mesh "buoy.x", 4

rem --- A totem built from meshes: a base and two limbs linked in a chain
make object 10, 2, 0
add limb 10, 1, 1
offset limb 10, 1, 0, 3.5, 0
add limb 10, 2, 3
rem LINK LIMB object, parent limb, child limb: limb 2 follows limb 1
link limb 10, 1, 2
offset limb 10, 2, 0, 3.5, 0
position object 10, -10, 0, 0
color object 10, rgb(220, 170, 80)

rem --- The blob: sphere mesh 1 copied into memblock 1
make object sphere 20, 8
make mesh from object 5, 20
delete object 20
make memblock from mesh 1, 5
vertices = memblock dword(1, 0)
offset = memblock dword(1, 4)
rem Keep the original vertex positions to deform from
dim vx#(vertices) : dim vy#(vertices) : dim vz#(vertices)
for v = 0 to vertices - 1
   vx#(v) = memblock float(1, offset + v * 12)
   vy#(v) = memblock float(1, offset + v * 12 + 4)
   vz#(v) = memblock float(1, offset + v * 12 + 8)
next v
make mesh from memblock 6, 1
make object 21, 6, 0
position object 21, 10, 4, 0
color object 21, rgb(120, 200, 255)

do
   t = t + 1
   rotate limb 10, 1, 0, t, 0
   rotate limb 10, 2, 0, t * 2, 0
   rem Every three seconds the top limb changes shape: cylinder or buoy
   if t mod 180 = 0 then change mesh 10, 2, 4
   if t mod 180 = 90 then change mesh 10, 2, 3

   rem Push every vertex along its own direction, then rebuild the mesh
   for v = 0 to vertices - 1
      bump# = 1.0 + 0.18 * sin(t * 4 + vy#(v) * 60) * cos(vx#(v) * 50 + t * 3)
      write memblock float 1, offset + v * 12, vx#(v) * bump#
      write memblock float 1, offset + v * 12 + 4, vy#(v) * bump#
      write memblock float 1, offset + v * 12 + 8, vz#(v) * bump#
   next v
   change mesh from memblock 6, 1
   rem The object keeps its own copy: CHANGE MESH gives it the new shape
   change mesh 21, 0, 6
   yrotate object 21, t

   ink rgb(255, 255, 255), 0
   text 10, 10, "MESH BUILDER   meshes 1-6 exist: " + str$(mesh exist(1)) + str$(mesh exist(2)) + str$(mesh exist(3)) + str$(mesh exist(4)) + str$(mesh exist(5)) + str$(mesh exist(6))
   text 10, 30, "blob: " + str$(vertices) + " vertices in a " + str$(get memblock size(1)) + "-byte memblock"
   if t = 300 then delete mesh 2
   sync
loop

rem ==================================================================
rem Scenery - an OpenDBC tutorial for the DarkBASIC Classic profile
rem The world around the objects: a textured, scrolling backdrop for the
rem sky, fog that hides the distance, and ambient light that follows a
rem day and night cycle. F switches the fog, B the backdrop, and D draws
rem the 2D panel behind or in front of the 3D scene.
rem Code and media are part of OpenDBC (MIT code, CC0 media).
rem ==================================================================

sync on : sync rate 60
autocam off
randomize 7
set camera range 1, 1500
set normalization off

rem The sky is the backdrop with a cloud texture that scrolls
load image "sky.jpg", 1
backdrop on
texture backdrop 1
color backdrop rgb(120, 160, 210)

rem Ground and a forest of cone trees on cylinder trunks
make object plain 1, 1200, 1200
xrotate object 1, 90
color object 1, rgb(70, 110, 50)
for t = 0 to 59
   x = rnd(800) - 400 : z = rnd(800) - 100
   make object cone 10 + t, 12 + rnd(8)
   position object 10 + t, x, 10, z
   color object 10 + t, rgb(30, 90 + rnd(50), 40)
   make object cylinder 100 + t, 3
   scale object 100 + t, 60, 200, 60
   position object 100 + t, x, 2, z
   color object 100 + t, rgb(90, 60, 30)
next t

fogged = 1 : behind = 0
if fog available() = 1
   fog on
   fog color rgb(170, 190, 210)
endif
position camera 0, 14, -150

do
   t# = t# + 0.3
   rem The camera walks slowly through the forest
   position camera sin(t#) * 60, 14, -150 + t# * 1.5
   point camera sin(t# + 10) * 60, 12, -100 + t# * 1.5
   if t# > 400 then t# = 0
   scroll backdrop 0.2, 0

   rem Day and night: ambient light and fog distance follow the sun
   sun# = (sin(t# * 2) + 1) / 2
   set ambient light 20 + sun# * 70
   if fog available() = 1 then fog distance 150 + sun# * 450

   key$ = lower$(inkey$())
   if key$ <> lastkey$
      if key$ = "f" and fog available() = 1
         fogged = 1 - fogged
         if fogged = 1 then fog on else fog off
      endif
      if key$ = "b"
         sky_off = 1 - sky_off
         if sky_off = 1 then backdrop off else backdrop on
      endif
      if key$ = "d"
         behind = 1 - behind
         if behind = 1 then draw to back else draw to front
      endif
   endif
   lastkey$ = key$

   rem A 2D panel: in front of the 3D by default, behind it after DRAW TO BACK
   ink rgb(30, 30, 40), 0
   box 10, 10, 330, 92
   ink rgb(255, 255, 255), 0
   text 20, 16, "SCENERY - F fog, B backdrop, D draw order"
   text 20, 36, "ambient " + str$(int(20 + sun# * 70)) + "%   fog " + str$(fogged) + " (available " + str$(fog available()) + ")"
   if behind = 1 then text 20, 56, "2D drawn behind the 3D" else text 20, 56, "2D drawn in front of the 3D"
   sync
loop

rem ==================================================================
rem Shapes - an OpenDBC tutorial for the DarkBASIC Classic profile
rem The first steps in 3D: every MAKE OBJECT shape on a turntable, each
rem turning on a different axis, with its position, angles and size read
rem back. SPACE hides and shows the cone, D deletes the triangle.
rem Code is part of OpenDBC (MIT).
rem ==================================================================

sync on : sync rate 60
autocam off
backdrop on
color backdrop rgb(30, 34, 52)
position camera 0, 9, -50
point camera 0, 3, 0

rem One of each shape, side by side
make object cube 1, 6
make object box 2, 8, 4, 3
make object sphere 3, 6
make object cylinder 4, 6
make object cone 5, 6
make object plain 6, 7, 5
make object triangle 7, 0, 4, 0, -4, -3, 0, 4, -3, 0
for o = 1 to 7
   position object o, (o - 4) * 9, 3, 0
   color object o, rgb(80 + o * 24, 220 - o * 18, 120 + (o mod 3) * 50)
next o
rem A triangle has one side only: SET OBJECT with culling 0 shows both
set object 7, 1, 0, 0
rem A floor made from a flattened box
make object box 10, 90, 1, 30
position object 10, 0, -2, 0
color object 10, rgb(60, 70, 90)

do
   a = wrapvalue(a + 1)
   rem Each command turns one axis; ROTATE OBJECT sets all three at once
   xrotate object 1, a
   yrotate object 2, a
   zrotate object 3, a
   rotate object 4, a, a / 2, 0
   yrotate object 5, a
   yrotate object 6, a
   yrotate object 7, a
   rem The sphere breathes with SCALE OBJECT (percent on each axis)
   scale object 3, 100, 70 + sin(a * 4) * 30, 100

   key$ = lower$(inkey$())
   if key$ = " " and lastkey$ <> " "
      if object visible(5) = 1 then hide object 5 else show object 5
   endif
   if key$ = "d" and lastkey$ <> "d" and object exist(7) = 1 then delete object 7
   lastkey$ = key$

   ink rgb(255, 255, 255), 0
   text 10, 10, "SHAPES - SPACE hides the cone, D deletes the triangle"
   text 10, 34, "CUBE: POSITION " + str$(object position x(1)) + ", " + str$(object position y(1)) + ", " + str$(object position z(1)) + "  ANGLE X " + str$(int(object angle x(1)))
   text 10, 54, "BOX: SIZE " + str$(int(object size(2))) + "  X " + str$(int(object size x(2))) + "  Y " + str$(int(object size y(2))) + "  Z " + str$(int(object size z(2)))
   text 10, 74, "CYLINDER: ANGLES " + str$(int(object angle x(4))) + ", " + str$(int(object angle y(4))) + ", " + str$(int(object angle z(4)))
   text 10, 94, "CONE VISIBLE " + str$(object visible(5)) + "   TRIANGLE EXISTS " + str$(object exist(7))
   sync
loop

rem ==================================================================
rem Static World - an OpenDBC tutorial for the DarkBASIC Classic profile
rem Static objects are scenery fixed in place: they draw fast and come
rem with their own collision data. Here maze walls become static, a
rem walker slides along them with GET STATIC COLLISION HIT, and a turret
rem watches it with STATIC LINE OF SIGHT. The level is saved to a file,
rem cleared and loaded back. O switches static occlusion, D the door.
rem Code and media are part of OpenDBC (MIT code, CC0 media).
rem ==================================================================

sync on : sync rate 60
autocam off
color backdrop rgb(40, 44, 56)
position camera 0, 90, -60
point camera 0, 0, 0
load image "bricks.jpg", 1
load image "rock.jpg", 2

rem --- Walls: cubes turned into static objects, then deleted
restore
for w = 1 to 9
   read x, z, sx, sz
   make object box 1, sx, 8, sz
   position object 1, x, 4, z
   texture object 1, 1
   scale object texture 1, sx / 8, 1
   make static object 1
   delete object 1
next w
rem The floor joins the static scenery with the rock texture
make object box 1, 100, 1, 80
position object 1, 0, -0.5, 0
texture object 1, 2
make static object 1
delete object 1
rem An invisible collision-only block in the open: walls you cannot see
make static collision box 10, 0, -30, 20, 8, -20

rem --- Save the level, clear it and load it back from the file
save static objects "level.dbo"
delete static objects
load static objects "level.dbo"
delete file "level.dbo"
set static objects texture 0
enable static occlusion

rem The walker and the turret
make object sphere 2, 4
color object 2, rgb(255, 220, 60)
make object cylinder 3, 4
position object 3, 35, 2, -25
color object 3, rgb(200, 60, 60)
rem A sliding door that is not static until D attaches it
make object box 4, 14, 8, 1
position object 4, -10, 4, 15
color object 4, rgb(140, 100, 60)

wx# = -40 : wz# = -30 : heading# = 45
do
   rem Move the walker; a static hit pushes it back and turns it
   oldx# = wx# : oldz# = wz#
   wx# = newxvalue(wx#, heading#, 0.6) : wz# = newzvalue(wz#, heading#, 0.6)
   if get static collision hit(oldx# - 2, 0, oldz# - 2, oldx# + 2, 4, oldz# + 2, wx# - 2, 0, wz# - 2, wx# + 2, 4, wz# + 2) = 1
      wx# = wx# - get static collision x() : wz# = wz# - get static collision z()
      push$ = str$(int(get static collision x() * 10) / 10.0) + ", " + str$(int(get static collision y() * 10) / 10.0) + ", " + str$(int(get static collision z() * 10) / 10.0)
      heading# = wrapvalue(heading# + 90 + rnd(90))
   endif
   if abs(wx#) > 48 or abs(wz#) > 38 then wx# = oldx# : wz# = oldz# : heading# = wrapvalue(heading# + 180)
   position object 2, wx#, 2, wz#

   rem The turret sees the walker when no static object is in between
   blocked = static line of sight(35, 3, -25, wx#, 3, wz#, 1, 1)
   if blocked = 0 then color object 3, rgb(255, 60, 60) else color object 3, rgb(90, 40, 40)

   key$ = lower$(inkey$())
   if key$ <> lastkey$
      if key$ = "o"
         occlusion = 1 - occlusion
         if occlusion = 1 then disable static occlusion else enable static occlusion
      endif
      if key$ = "d"
         attached = 1 - attached
         if attached = 1 then attach object to static 4 else detach object from static 4
      endif
   endif
   lastkey$ = key$

   ink rgb(255, 255, 255), 0
   text 10, 10, "STATIC WORLD - O occlusion, D attaches the door to the static world"
   if blocked = 0
      text 10, 30, "turret sees the walker"
   else
      text 10, 30, "line of sight blocked at " + str$(int(static line of sight x())) + ", " + str$(int(static line of sight y())) + ", " + str$(int(static line of sight z()))
   endif
   text 10, 50, "door static: " + str$(attached) + "   occlusion off: " + str$(occlusion) + "   last push back: " + push$
   sync
loop

rem Wall centre x and z, then length along x and along z
data -20, 0, 40, 2, 20, 10, 2, 30, 0, -20, 2, 20, -30, 20, 30, 2, 30, 25, 30, 2
data -49, 0, 2, 80, 49, 0, 2, 80, 0, 39, 100, 2, 0, -39, 100, 2

rem ==================================================================
rem Parallax - an OpenDBC tutorial for the DarkBASIC Classic profile
rem Draws two wide landscapes once into off-screen bitmaps, then scrolls
rem them at different speeds with COPY BITMAP. The far mountains move
rem slowly, the near hills quickly, which gives a sense of depth.
rem SPACE squeezes the whole panorama onto the screen, ESCAPE quits.
rem Code is part of OpenDBC (MIT).
rem ==================================================================

sync on : sync rate 60
w = screen width() : h = screen height()
band = h / 2

rem Bitmap 1: the sky and far mountains, two screens wide. The ridge
rem repeats every screen width, so any window of it can be copied.
create bitmap 1, w * 2, band
set current bitmap 1
for y = 0 to band - 1
   ink rgb(70 + y / 3, 120 + y / 3, 200 - y / 6), 0
   line 0, y, w * 2, y
next y
for x = 0 to w * 2 - 1
   a# = x * 360.0 / w
   ridge = band - 60 - sin(a# * 2) * 30 - sin(a# * 5 + 40) * 14
   ink rgb(90, 100, 130), 0
   line x, ridge, x, band
   ink rgb(235, 240, 250), 0
   if ridge < band - 80 then line x, ridge, x, ridge + 6
next x

rem Bitmap 2: the near hills with trees, also seamless across a screen width
create bitmap 2, w * 2, band
set current bitmap 2
for y = 0 to band - 1
   ink rgb(90, 100, 130), 0
   line 0, y, w * 2, y
next y
for x = 0 to w * 2 - 1
   a# = x * 360.0 / w
   hill = 50 + sin(a# * 3) * 25 + sin(a# * 7 + 90) * 8
   ink rgb(40, 110 + hill / 2, 50), 0
   line x, hill, x, band
next x
for t = 0 to 23
   tx = t * w / 12 + 10
   a# = tx * 360.0 / w
   ty = 50 + sin(a# * 3) * 25 + sin(a# * 7 + 90) * 8
   ink rgb(30, 70, 35), 0
   for k = 0 to 24
      line tx - k / 3, ty - 30 + k, tx + k / 3, ty - 30 + k
   next k
   ink rgb(80, 50, 30), 0
   box tx - 2, ty - 6, tx + 2, ty + 4
next t

rem Back to the screen. CURRENT BITMAP() reports which bitmap draws now.
set current bitmap 0
screen_bitmap = current bitmap()

do
   far = (far + 1) mod w
   near = (near + 4) mod w
   if spacekey() = 1
      rem The ten-argument form stretches: the whole panorama fits the screen
      copy bitmap 1, 0, 0, w * 2, band, 0, 0, 0, w, band
      copy bitmap 2, 0, 0, w * 2, band, 0, 0, band, w, h
   else
      copy bitmap 1, far, 0, far + w, band, 0, 0, 0, w, band
      copy bitmap 2, near, 0, near + w, band, 0, 0, band, w, h
   endif

   ink rgb(255, 255, 255), 0
   text 10, 10, "BITMAP 1: " + str$(bitmap width(1)) + " x " + str$(bitmap height(1)) + " x " + str$(bitmap depth(1)) + " bits"
   text 10, 28, "BITMAP 2 EXISTS: " + str$(bitmap exist(2)) + "   CURRENT BITMAP: " + str$(screen_bitmap)
   text 10, 46, "SPACE shows the whole panorama, ESCAPE quits"
   if escapekey() = 1 then exit
   sync
loop

delete bitmap 2
delete bitmap 1
end

rem ==================================================================
rem Picture Effects - an OpenDBC tutorial for the DarkBASIC Classic profile
rem Loads a picture into a bitmap and transforms it in place with
rem MIRROR BITMAP, FLIP BITMAP, BLUR BITMAP and FADE BITMAP. A second
rem copy of the picture restores the original between effects.
rem Keys 1 to 5 pick an effect; otherwise they cycle by themselves.
rem Code and media are part of OpenDBC (MIT code, CC0 media).
rem ==================================================================

sync on : sync rate 30
load bitmap "harbour.bmp", 1
load bitmap "harbour.bmp", 2
set current bitmap 0

effect = 0 : shown = -1
started = timer()
do
   rem Pick the effect from the keyboard, or move on every three seconds
   for k = 1 to 5
      if keystate(k + 1) = 1 then effect = k - 1 : started = timer()
   next k
   if timer() - started > 3000 then effect = (effect + 1) mod 5 : started = timer()

   if effect <> shown
      rem Restore the untouched copy, then apply the new effect once
      copy bitmap 2, 1
      if bitmap mirrored(1) = 1 then mirror bitmap 1
      if bitmap flipped(1) = 1 then flip bitmap 1
      select effect
         case 0 : name$ = "ORIGINAL (COPY BITMAP 2, 1)" : endcase
         case 1 : mirror bitmap 1 : name$ = "MIRROR BITMAP 1" : endcase
         case 2 : flip bitmap 1 : name$ = "FLIP BITMAP 1" : endcase
         case 3 : blur bitmap 1, 6 : name$ = "BLUR BITMAP 1, 6" : endcase
         case 4 : fade bitmap 1, 40 : name$ = "FADE BITMAP 1, 40" : endcase
      endselect
      shown = effect
   endif

   copy bitmap 1, 0
   ink rgb(0, 0, 0), 0
   box 0, 0, screen width(), 52
   ink rgb(255, 255, 255), 0
   text 10, 8, str$(effect + 1) + ". " + name$
   text 10, 28, "MIRRORED " + str$(bitmap mirrored(1)) + "   FLIPPED " + str$(bitmap flipped(1)) + "   keys 1-5 pick an effect"
   sync
loop

rem ==================================================================
rem Postcards - an OpenDBC tutorial for the DarkBASIC Classic profile
rem Loads a picture straight onto the screen, shrinks it into a small
rem bitmap, writes a greeting on it and saves it with SAVE BITMAP. The
rem saved file is loaded back with LOAD BITMAP and dealt out as cards.
rem The temporary file is deleted again. Press a key to deal again.
rem Code and media are part of OpenDBC (MIT code, CC0 media).
rem ==================================================================

randomize timer()
w = screen width() : h = screen height()

rem LOAD BITMAP without a number loads the picture onto the screen itself
load bitmap "harbour.bmp"
ink rgb(255, 255, 255), 0
text 10, 10, "LOAD BITMAP onto the screen"
sleep 1500

rem Shrink the screen into a half-size bitmap and decorate it there
create bitmap 1, w / 2, h / 2
copy bitmap 0, 0, 0, w, h, 1, 0, 0, w / 2, h / 2
set current bitmap 1
ink rgb(250, 245, 230), 0
for edge = 0 to 5
   box edge, edge, w / 2 - 1 - edge, edge
   box edge, h / 2 - 1 - edge, w / 2 - 1 - edge, h / 2 - 1 - edge
   box edge, edge, edge, h / 2 - 1 - edge
   box w / 2 - 1 - edge, edge, w / 2 - 1 - edge, h / 2 - 1 - edge
next edge
ink rgb(255, 255, 255), 0
text 16, h / 2 - 30, "Greetings from the lighthouse"

rem Save it, forget it, and read it back from the file
save bitmap "postcard.bmp", 1
delete bitmap 1
load bitmap "postcard.bmp", 2
delete file "postcard.bmp"
set current bitmap 0

do
   cls rgb(40, 60, 80)
   rem Each card is a stretched copy of bitmap 2 at a random place and size
   for card = 1 to 6
      cw = w / 4 + rnd(w / 5) : ch = cw * 3 / 4
      x = rnd(w - cw) : y = 40 + rnd(h - 50 - ch)
      copy bitmap 2, 0, 0, bitmap width(2), bitmap height(2), 0, x, y, x + cw, y + ch
   next card
   ink rgb(255, 255, 255), 0
   text 10, 10, "postcard.bmp was " + str$(bitmap width(2)) + " x " + str$(bitmap height(2)) + " - press a key to deal again"
   suspend for key
loop

rem ==================================================================
rem Aquarium - an OpenDBC tutorial for the DarkBASIC Classic profile
rem Bobs are blitter objects: images drawn onto the screen that put the
rem background back when they move. This program draws its fish with
rem 2D commands in an off-screen bitmap, grabs them with GET IMAGE,
rem round-trips one through SAVE IMAGE and LOAD IMAGE, then lets them
rem swim as bobs. MIRROR BOB turns a fish when it changes direction.
rem Code is part of OpenDBC (MIT).
rem ==================================================================

sync on : sync rate 60
randomize timer()
w = screen width() : h = screen height()

rem --- Draw the artwork into bitmap 1. Black is transparent for bobs.
create bitmap 1, 256, 64
set current bitmap 1
cls 0
for f = 0 to 2
   if f = 0 then body = rgb(255, 140, 30) : fin = rgb(255, 230, 200)
   if f = 1 then body = rgb(60, 170, 255) : fin = rgb(255, 230, 60)
   if f = 2 then body = rgb(220, 60, 140) : fin = rgb(255, 255, 255)
   cx = f * 64 + 36 : cy = 20
   rem Tail: a fan of lines behind the body
   ink fin, 0
   for k = -10 to 10
      line cx - 18, cy, cx - 30, cy + k
   next k
   rem Body: an ellipse filled line by line, then a darker rim
   ink body, 0
   for dy = -12 to 12
      half = 22 * sqrt(1.0 - dy * dy / 144.0)
      line cx - half, cy + dy, cx + half, cy + dy
   next dy
   ink rgb(rgbr(body) / 2, rgbg(body) / 2, rgbb(body) / 2), 0
   ellipse cx, cy, 22, 12
   ink rgb(255, 255, 255), 0 : box cx + 10, cy - 5, cx + 14, cy - 1
   ink rgb(1, 1, 1), 0 : dot cx + 12, cy - 3
   get image 1 + f, f * 64, 0, f * 64 + 64, 40
next f
rem Image 4: a bubble
cls 0
ink rgb(200, 230, 255), 0
circle 8, 8, 7
ink rgb(255, 255, 255), 0
dot 5, 5 : dot 6, 5 : dot 5, 6
get image 4, 0, 0, 17, 17

rem --- Save the third fish to a file and read it back as image 5
save image "fish.bmp", 3
load image "fish.bmp", 5
delete file "fish.bmp"
delete bitmap 1
set current bitmap 0

rem --- The tank is drawn once on the screen; bobs restore it as they move
for y = 0 to h - 1
   ink rgb(10, 60 + y / 6, 110 + y / 5), 0
   line 0, y, w, y
next y
ink rgb(194, 170, 110), 0
box 0, h - 50, w, h
for weed = 1 to 14
   wx = rnd(w)
   ink rgb(30, 120 + rnd(60), 50), 0
   for k = 0 to 90 + rnd(80)
      dot wx + sin(k * 6) * 6, h - 50 - k
      dot wx + 1 + sin(k * 6) * 6, h - 50 - k
   next k
next weed

fish = 8
dim fishx#(fish) : dim fishy(fish) : dim fishspeed#(fish)
for f = 1 to fish
   fishx#(f) = rnd(w - 64) : fishy(f) = 40 + rnd(h - 160)
   fishspeed#(f) = (1 + rnd(20) / 10.0) * (rnd(1) * 2 - 1)
   image = 1 + rnd(2) : if f = fish then image = 5
   bob f, fishx#(f), fishy(f), image
   rem The art faces right: mirror the fish that start swimming left
   if fishspeed#(f) < 0 then mirror bob f
next f
for b = 1 to 6
   bob 20 + b, rnd(w), h - 60 - rnd(h), 4
   rem SET BOB bob, backsave, transparency: both on is the default
   set bob 20 + b, 1, 1
next b

do
   for f = 1 to fish
      fishx#(f) = fishx#(f) + fishspeed#(f)
      if fishx#(f) < 0 or fishx#(f) > w - 64
         fishspeed#(f) = 0 - fishspeed#(f)
         mirror bob f
      endif
      bob f, fishx#(f), fishy(f) + sin(fishx#(f) * 2) * 4, bob image(f)
   next f
   for b = 21 to 26
      y = bob y(b) - 2
      if y < -20 then y = h - 60
      bob b, bob x(b) + sin(y * 3) * 1.2, y, 4
   next b

   ink rgb(0, 0, 0), 0
   box 0, 0, w, 22
   ink rgb(255, 255, 255), 0
   text 8, 3, "BOB 1: X " + str$(bob x(1)) + " Y " + str$(bob y(1)) + "  IMAGE " + str$(bob image(1)) + "  " + str$(bob width(1)) + " x " + str$(bob height(1)) + "  MIRRORED " + str$(bob mirrored(1)) + "  EXIST " + str$(bob exist(1))
   sync
loop

rem ==================================================================
rem Jelly Lab - an OpenDBC tutorial for the DarkBASIC Classic profile
rem Shows the bob transforms: OFFSET BOB moves the handle to the middle,
rem SCALE BOB and STRETCH BOB resize, FLIP BOB turns a bob upside down,
rem PASTE BOB stamps a lasting copy and SET BOB with backsave off leaves
rem a painted trail behind a moving bob.
rem Code is part of OpenDBC (MIT).
rem ==================================================================

sync on : sync rate 60
w = screen width() : h = screen height()

rem --- Artwork: a jellyfish (image 1) and a starfish (image 2)
create bitmap 1, 128, 64
set current bitmap 1
cls 0
for dy = -20 to 0
   half = 26 * sqrt(1.0 - dy * dy / 400.0)
   ink rgb(230, 120 + dy * 3, 230), 0
   line 32 - half, 28 + dy, 32 + half, 28 + dy
next dy
ink rgb(250, 200, 250), 0
for t = 0 to 5
   tx = 12 + t * 8
   for k = 0 to 28
      dot tx + sin(k * 25 + t * 60) * 2, 29 + k
   next k
next t
get image 1, 0, 0, 64, 60
cls 0
ink rgb(255, 150, 60), 0
for a = 0 to 359 step 2
   r# = 10 + abs(sin(a * 2.5)) * 18
   line 32, 32, 32 + cos(a) * r#, 32 + sin(a) * r#
next a
get image 2, 0, 0, 64, 64
delete bitmap 1
set current bitmap 0

rem --- Background
for y = 0 to h - 1
   ink rgb(0, 30 + y / 8, 70 + y / 6), 0
   line 0, y, w, y
next y

rem PASTE BOB draws a copy into the background itself: it stays there
bob 9, 0, 0, 2
for x = 20 to w - 64 step 90
   paste bob 9, x, h - 70
next x
delete bob 9

rem 1: centre handle and SCALE BOB, 2: STRETCH BOB, 3: FLIP BOB,
rem 4: backsave off, so the bob is never erased and paints a trail
for b = 1 to 3
   bob b, b * w / 4, 200, 1
   offset bob b, 32, 30
next b
bob 4, 40, 330, 2
set bob 4, 0, 1

do
   t = t + 1
   scale bob 1, 100 + sin(t * 3) * 40
   stretch bob 2, 100 - sin(t * 6) * 25, 100 + sin(t * 6) * 35
   if t mod 90 = 0 then flip bob 3
   bob 1, w / 4, 200 + sin(t * 2) * 30, 1
   bob 2, w / 2, 200 + sin(t * 2 + 120) * 30, 1
   bob 3, 3 * w / 4, 200 + sin(t * 2 + 240) * 30, 1
   bob 4, 40 + (t * 2) mod (w - 100), 330 + sin(t * 4) * 20, 2

   ink rgb(0, 0, 0), 0
   box 0, 0, w, 64
   ink rgb(255, 255, 255), 0
   text 8, 4, "1 OFFSET " + str$(bob offset x(1)) + "," + str$(bob offset y(1)) + "  SCALE " + str$(bob scale x(1)) + "%"
   text 8, 24, "2 STRETCH " + str$(bob scale x(2)) + "% x " + str$(bob scale y(2)) + "%    3 FLIPPED " + str$(bob flipped(3))
   text 8, 44, "4 has backsave off and paints a trail; the starfish below were PASTE BOB stamps"
   sync
loop

rem ==================================================================
rem Star Catch - an OpenDBC tutorial for the DarkBASIC Classic profile
rem A small game with bobs: move the basket with the arrow keys and
rem catch the falling stars. BOB HIT reports a new catch, DELETE BOB
rem removes the star and BOB EXIST tells when it must fall again.
rem Without a key press the basket moves by itself.
rem Code is part of OpenDBC (MIT).
rem ==================================================================

sync on : sync rate 60
randomize timer()
w = screen width() : h = screen height()

rem --- Artwork: a star (image 1) and a basket (image 2)
create bitmap 1, 128, 64
set current bitmap 1
cls 0
ink rgb(255, 230, 80), 0
for a = 0 to 359
   r# = 6 + 10 * abs(cos(a * 2.5))
   line 16, 16, 16 + sin(a) * r#, 16 - cos(a) * r#
next a
get image 1, 0, 0, 33, 33
cls 0
ink rgb(150, 90, 40), 0
box 0, 8, 79, 31
ink rgb(200, 140, 70), 0
for x = 2 to 77 step 6
   line x, 9, x + 3, 30
next x
box 0, 6, 79, 9
get image 2, 0, 0, 80, 32
delete bitmap 1
set current bitmap 0

rem --- Night sky background
for y = 0 to h - 1
   ink rgb(10, 10, 30 + y / 8), 0
   line 0, y, w, y
next y
for s = 1 to 150
   c = 80 + rnd(120)
   ink rgb(c, c, c), 0
   dot rnd(w), rnd(h)
next s

stars = 5
dim speed#(stars) : dim sy#(stars)
basketx# = w / 2 - 40
bob 1, basketx#, h - 50, 2
score = 0 : missed = 0

do
   rem A missing star is dropped again from the top
   for s = 1 to stars
      if bob exist(10 + s) = 0
         sy#(s) = -40 - rnd(300)
         speed#(s) = 1.5 + rnd(25) / 10.0
         bob 10 + s, rnd(w - 33), sy#(s), 1
      endif
   next s

   rem Arrow keys, or follow the lowest star
   move = rightkey() - leftkey()
   if move = 0
      target = 0 : lowest# = -1000
      for s = 1 to stars
         if sy#(s) > lowest# then lowest# = sy#(s) : target = s
      next s
      if target > 0
         gap = bob x(10 + target) + 16 - (basketx# + 40)
         if gap > 4 then move = 1
         if gap < -4 then move = -1
      endif
   endif
   basketx# = basketx# + move * 6
   if basketx# < 0 then basketx# = 0
   if basketx# > w - 80 then basketx# = w - 80
   bob 1, basketx#, h - 50, 2

   for s = 1 to stars
      sy#(s) = sy#(s) + speed#(s)
      bob 10 + s, bob x(10 + s), sy#(s), 1
      if sy#(s) > h then delete bob 10 + s : missed = missed + 1
   next s

   rem BOB HIT returns the bob the basket has just touched (0 for none)
   caught = bob hit(1, 0)
   if caught > 10
      delete bob caught
      score = score + 1
   endif

   ink rgb(0, 0, 0), 0
   box 0, 0, w, 22
   ink rgb(255, 255, 255), 0
   text 8, 3, "CAUGHT " + str$(score) + "   MISSED " + str$(missed) + "   BASKET TOUCHING " + str$(bob collision(1, 0))
   sync
loop

rem ==================================================================
rem Explorer - an OpenDBC tutorial for the DarkBASIC Classic profile
rem Looks around the folders: DIR and DRIVELIST print listings,
rem PERFORM CHECKLIST FOR FILES fills a list to read back, FIND FIRST
rem and FIND NEXT walk through the files one at a time, and CD moves
rem between folders. UP and DOWN select a file; E opens the selected
rem file with EXECUTE FILE, which hands it to the program your system
rem uses for it.
rem Code is part of OpenDBC (MIT).
rem ==================================================================

rem DIR and DRIVELIST print straight onto the screen, like PRINT
cls rgb(20, 24, 34)
ink rgb(220, 220, 230), 0
print "DIR of " + get dir$()
dir
print
print "DRIVELIST"
drivelist
sleep 2500

sync on : sync rate 30
home$ = get dir$()

rem The parent folder through CD, then back again
cd ".."
parent$ = get dir$()
perform checklist for files
parent_entries = checklist quantity()
cd home$

rem The files here, from FIND FIRST and FIND NEXT
dim name$(60) : dim kind(60) : dim date$(60)
count = 0
find first
while get file type() <> -1 and count < 60
   inc count
   name$(count) = get file name$() : kind(count) = get file type() : date$(count) = get file date$()
   find next
endwhile
perform checklist for drives
drives = checklist quantity()
selected = 1

do
   if downkey() = 1 and held = 0 and selected < count then inc selected
   if upkey() = 1 and held = 0 and selected > 1 then dec selected
   held = upkey() + downkey()
   key$ = lower$(inkey$())
   if key$ = "e" and lastkey$ <> "e" and kind(selected) = 0
      rem EXECUTE FILE file$, command line$, folder$
      execute file name$(selected), "", home$
   endif
   lastkey$ = key$

   cls rgb(20, 24, 34)
   ink rgb(255, 210, 120), 0
   text 16, 10, "EXPLORER - " + home$
   ink rgb(160, 160, 180), 0
   text 16, 30, "PATH EXIST(""..""): " + str$(path exist("..")) + "   parent has " + str$(parent_entries) + " entries   " + str$(drives) + " drive(s)"
   for i = 1 to count
      y = 50 + i * 20
      if y < screen height() - 30
         if i = selected
            ink rgb(60, 80, 130), 0 : box 12, y - 2, screen width() - 12, y + 17
         endif
         if kind(i) = 1 then ink rgb(120, 200, 255), 0 else ink rgb(230, 230, 230), 0
         if kind(i) = 1 then label$ = "[" + name$(i) + "]" else label$ = name$(i)
         text 20, y, label$
         ink rgb(150, 150, 170), 0
         if kind(i) = 0 then text 300, y, str$(file size(name$(i))) + " bytes"
         text 430, y, date$(i)
      endif
   next i
   ink rgb(150, 150, 170), 0
   text 16, screen height() - 24, "UP/DOWN select, E opens a file with EXECUTE FILE"
   sync
loop

rem ==================================================================
rem Notebook - an OpenDBC tutorial for the DarkBASIC Classic profile
rem Works with files in a scratch folder: writes a record of bytes,
rem words, longs, floats and strings, reads it back value by value,
rem then copies, renames, moves and deletes files. Each step is logged
rem on the screen. The scratch folder is removed at the end.
rem Code is part of OpenDBC (MIT).
rem ==================================================================

sync on : sync rate 30
dim log$(40) : lines = 0

rem --- A scratch folder next to the program, entered with SET DIR
if path exist("notebook_tmp") = 1 then gosub tidy_up
make directory "notebook_tmp"
set dir "notebook_tmp"
note$ = "MAKE DIRECTORY and SET DIR: now in ..." + right$(get dir$(), 30) : gosub add_line

rem --- Writing: each WRITE command appends one value to the open file
open to write 1, "record.dat"
write byte 1, 200
write word 1, 1999
write long 1, 123456789
write float 1, 3.25
write string 1, "lighthouse"
write file 1, -42
note$ = "FILE OPEN(1) while writing = " + str$(file open(1)) : gosub add_line
close file 1
note$ = "record.dat written: FILE EXIST = " + str$(file exist("record.dat")) + ", FILE SIZE = " + str$(file size("record.dat")) + " bytes" : gosub add_line

rem --- Reading: the values come back in the order they were written
open to read 2, "record.dat"
read byte 2, b
read word 2, wd
read long 2, l
read float 2, f#
read string 2, s$
read file 2, q
note$ = "READ BYTE " + str$(b) + "  WORD " + str$(wd) + "  LONG " + str$(l) + "  FLOAT " + str$(f#) : gosub add_line
note$ = "READ STRING """ + s$ + """  READ FILE " + str$(q) + "  FILE END = " + str$(file end(2)) : gosub add_line
close file 2
note$ = "CLOSE FILE: FILE OPEN(2) = " + str$(file open(2)) : gosub add_line

rem --- Managing files
make file "empty.txt"
note$ = "MAKE FILE empty.txt: size " + str$(file size("empty.txt")) : gosub add_line
copy file "record.dat", "backup.dat"
note$ = "COPY FILE record.dat to backup.dat: " + str$(file exist("backup.dat")) : gosub add_line
rename file "backup.dat", "old_record.dat"
note$ = "RENAME FILE to old_record.dat: backup.dat exists " + str$(file exist("backup.dat")) : gosub add_line
make directory "archive"
move file "old_record.dat", "archive/old_record.dat"
note$ = "MOVE FILE into archive: " + str$(file exist("archive/old_record.dat")) : gosub add_line
gosub tidy_up
note$ = "DELETE FILE and DELETE DIRECTORY: notebook_tmp exists " + str$(path exist("notebook_tmp")) : gosub add_line

shown = 0
do
   if shown < lines and timer() - last > 250 then inc shown : last = timer()
   cls rgb(250, 246, 232)
   ink rgb(70, 60, 50), 0
   center text screen width() / 2, 14, "NOTEBOOK - files step by step"
   for i = 1 to shown
      if i = shown then ink rgb(180, 60, 30), 0 else ink rgb(50, 50, 60), 0
      text 20, 30 + i * 22, str$(i) + ". " + log$(i)
   next i
   sync
loop

add_line:
   inc lines
   log$(lines) = note$
return

rem Leave the scratch folder and remove everything in it
tidy_up:
   if right$(get dir$(), 12) = "notebook_tmp" then set dir ".."
   if file exist("notebook_tmp/archive/old_record.dat") = 1 then delete file "notebook_tmp/archive/old_record.dat"
   if path exist("notebook_tmp/archive") = 1 then delete directory "notebook_tmp/archive"
   if file exist("notebook_tmp/record.dat") = 1 then delete file "notebook_tmp/record.dat"
   if file exist("notebook_tmp/empty.txt") = 1 then delete file "notebook_tmp/empty.txt"
   if path exist("notebook_tmp") = 1 then delete directory "notebook_tmp"
return

rem ==================================================================
rem Packer - an OpenDBC tutorial for the DarkBASIC Classic profile
rem Packs files and folders into one archive and unpacks them again:
rem WRITE FILEBLOCK and READ FILEBLOCK store a whole file, WRITE DIRBLOCK
rem and READ DIRBLOCK a whole folder, WRITE MEMBLOCK and READ MEMBLOCK a
rem memblock, and MAKE MEMBLOCK FROM FILE loads raw bytes for a hex view.
rem K copies a line to the clipboard and V reads the clipboard back.
rem Code is part of OpenDBC (MIT).
rem ==================================================================

sync on : sync rate 30
dim log$(20) : lines = 0
if path exist("packer_tmp") = 1 then gosub tidy_up
make directory "packer_tmp"
make directory "packer_tmp/photos"

rem Some files to pack: a note and two tiny "photos"
open to write 1, "packer_tmp/note.txt" : write string 1, "Pack me with the photos" : close file 1
for p = 1 to 2
   open to write 1, "packer_tmp/photos/photo" + str$(p) + ".raw"
   for b = 1 to 32 : write byte 1, p * 40 + b : next b
   close file 1
next p
make memblock 1, 16
for b = 0 to 15 : write memblock byte 1, b, b * 16 : next b

rem --- Pack: one archive file holds a file, a folder and a memblock
open to write 2, "packer_tmp/archive.pak"
write fileblock 2, "packer_tmp/note.txt"
write dirblock 2, "packer_tmp/photos"
write memblock 2, 1
close file 2
note$ = "archive.pak: " + str$(file size("packer_tmp/archive.pak")) + " bytes" : gosub add_line

rem --- Unpack into another folder
make directory "packer_tmp/out"
open to read 3, "packer_tmp/archive.pak"
read fileblock 3, "packer_tmp/out/note.txt"
read dirblock 3, "packer_tmp/out/photos"
read memblock 3, 2
close file 3
note$ = "READ FILEBLOCK: out/note.txt " + str$(file size("packer_tmp/out/note.txt")) + " bytes" : gosub add_line
note$ = "READ DIRBLOCK: out/photos/photo2.raw exists " + str$(file exist("packer_tmp/out/photos/photo2.raw")) : gosub add_line
note$ = "READ MEMBLOCK: memblock 2 has " + str$(get memblock size(2)) + " bytes, byte 15 = " + str$(memblock byte(2, 15)) : gosub add_line

rem --- Raw bytes of the archive for the hex view
open to read 4, "packer_tmp/archive.pak"
make memblock from file 3, 4
close file 4
gosub tidy_up
note$ = "Scratch folder removed: " + str$(path exist("packer_tmp")) : gosub add_line

do
   key$ = lower$(inkey$())
   if key$ = "k" and lastkey$ <> "k" then write to clipboard "Packed by OpenDBC" : note$ = "WRITE TO CLIPBOARD done" : gosub add_line
   if key$ = "v" and lastkey$ <> "v" then note$ = "GET CLIPBOARD$ = """ + left$(get clipboard$(), 40) + """" : gosub add_line
   lastkey$ = key$

   cls rgb(24, 30, 26)
   ink rgb(150, 255, 170), 0
   text 16, 10, "PACKER - the first bytes of archive.pak"
   rem Hex dump: sixteen bytes per row, then the printable characters
   for row = 0 to 7
      line$ = right$("000" + hex$(row * 16), 4) + "  "
      chars$ = ""
      for col = 0 to 15
         offset = row * 16 + col
         if offset < get memblock size(3)
            value = memblock byte(3, offset)
            line$ = line$ + right$("0" + hex$(value), 2) + " "
            if value >= 32 and value < 127 then chars$ = chars$ + chr$(value) else chars$ = chars$ + "."
         endif
      next col
      ink rgb(200, 230, 200), 0
      text 16, 40 + row * 20, line$
      text 470, 40 + row * 20, chars$
   next row
   ink rgb(230, 230, 230), 0
   for i = 1 to lines
      text 16, 220 + i * 20, log$(i)
   next i
   ink rgb(150, 170, 150), 0
   text 16, screen height() - 24, "K writes to the clipboard, V reads it back"
   sync
loop

add_line:
   rem Keep the last ten lines: drop the oldest when the log is full
   if lines = 10
      for i = 1 to 9 : log$(i) = log$(i + 1) : next i
      lines = 9
   endif
   inc lines
   log$(lines) = note$
return

tidy_up:
   for p = 1 to 2
      for folder = 0 to 1
         if folder = 0 then f$ = "packer_tmp/photos/photo" + str$(p) + ".raw" else f$ = "packer_tmp/out/photos/photo" + str$(p) + ".raw"
         if file exist(f$) = 1 then delete file f$
      next folder
   next p
   for i = 1 to 4
      if i = 1 then f$ = "packer_tmp/note.txt"
      if i = 2 then f$ = "packer_tmp/out/note.txt"
      if i = 3 then f$ = "packer_tmp/archive.pak"
      if i = 4 then f$ = ""
      if f$ <> ""
         if file exist(f$) = 1 then delete file f$
      endif
   next i
   if path exist("packer_tmp/out/photos") = 1 then delete directory "packer_tmp/out/photos"
   if path exist("packer_tmp/out") = 1 then delete directory "packer_tmp/out"
   if path exist("packer_tmp/photos") = 1 then delete directory "packer_tmp/photos"
   if path exist("packer_tmp") = 1 then delete directory "packer_tmp"
return

rem ==================================================================
rem Joystick Lab - an OpenDBC tutorial for the DarkBASIC Classic profile
rem Lists the game controllers, picks the first one with SET CONTROL
rem DEVICE and shows every axis, button, slider and hat it reports.
rem Buttons A to D play force-feedback effects on controllers that have
rem them; without a controller every reading stays at zero.
rem Code is part of OpenDBC (MIT).
rem ==================================================================

sync on : sync rate 30
w = screen width() : h = screen height()

perform checklist for control devices
devices = checklist quantity()
dim device$(8)
for d = 1 to devices
   if d <= 8 then device$(d) = checklist string$(d)
next d
if devices > 0 then set control device device$(1)
force auto center on

do
   rem Force feedback, one effect per button
   if joystick fire a() = 1 and fired = 0 then force shoot 100, 200 : fired = 1
   if joystick fire b() = 1 and fired = 0 then force impact 100, 300 : fired = 1
   if joystick fire c() = 1 and fired = 0 then force chainsaw 60, 500 : fired = 1
   if joystick fire d() = 1 and fired = 0 then force water effect 80, 800 : fired = 1
   if joystick fire a() + joystick fire b() + joystick fire c() + joystick fire d() = 0 and fired = 1
      force no effect : fired = 0
   endif
   rem The stick pushes back against the direction it is held
   if joystick left() = 1 then force right 40
   if joystick right() = 1 then force left 40
   if joystick up() = 1 then force down 40
   if joystick down() = 1 then force up 40
   if joystick x() = 0 and joystick y() = 0 and joystick fire x(4) = 1 then force angle 50, 90, 300
   rem Buttons 5 and 6 release and restore the stick's self-centring spring
   if joystick fire x(5) = 1 then force auto center off
   if joystick fire x(6) = 1 then force auto center on

   cls rgb(26, 28, 36)
   ink rgb(255, 210, 120), 0
   center text w / 2, 12, "JOYSTICK LAB"
   ink rgb(220, 220, 230), 0
   if devices = 0
      text 30, 40, "No game controller found - plug one in and run the program again."
   else
      text 30, 40, str$(devices) + " controller(s); using " + control device name$()
   endif

   rem The stick: X and Y from -1000 to 1000 move the dot inside the square
   ink rgb(60, 64, 84), 0
   box 30, 80, 230, 280
   ink rgb(255, 200, 60), 0
   cx = 130 + joystick x() / 10 : cy = 180 + joystick y() / 10
   for r = 1 to 8 : circle cx, cy, r : next r
   ink rgb(220, 220, 230), 0
   text 30, 290, "X " + str$(joystick x()) + "  Y " + str$(joystick y()) + "  Z " + str$(joystick z())
   text 30, 310, "DEVICE X " + str$(control device x()) + "  Y " + str$(control device y()) + "  Z " + str$(control device z())
   text 30, 330, "UP " + str$(joystick up()) + " DOWN " + str$(joystick down()) + " LEFT " + str$(joystick left()) + " RIGHT " + str$(joystick right())

   rem Buttons: the four named ones and the first sixteen by number
   ink rgb(220, 220, 230), 0
   text 280, 80, "FIRE A " + str$(joystick fire a()) + "  B " + str$(joystick fire b()) + "  C " + str$(joystick fire c()) + "  D " + str$(joystick fire d())
   for b = 0 to 15
      if joystick fire x(b) = 1 then ink rgb(255, 120, 60), 0 else ink rgb(60, 64, 84), 0
      box 280 + (b mod 8) * 40, 110 + (b / 8) * 40, 312 + (b mod 8) * 40, 142 + (b / 8) * 40
      ink rgb(255, 255, 255), 0
      text 286 + (b mod 8) * 40, 118 + (b / 8) * 40, str$(b)
   next b

   rem Sliders, twists and the hat
   text 280, 210, "SLIDER A " + str$(joystick slider a()) + "  B " + str$(joystick slider b())
   text 280, 230, "SLIDER C " + str$(joystick slider c()) + "  D " + str$(joystick slider d())
   text 280, 250, "TWIST X " + str$(joystick twist x()) + "  Y " + str$(joystick twist y()) + "  Z " + str$(joystick twist z())
   text 280, 270, "HAT ANGLE " + str$(joystick hat angle(0)) + " (-1 when centred)"
   ink rgb(150, 150, 170), 0
   text 30, h - 40, "Buttons A-D: shoot, impact, chainsaw and water forces; the stick pushes back"
   sync
loop

rem ==================================================================
rem Keyboard Lab - an OpenDBC tutorial for the DarkBASIC Classic profile
rem Every way of reading the keyboard: KEYSTATE for any key by scancode,
rem the named key functions, INKEY$ and SCANCODE for the key held now,
rem ENTRY$ for everything typed since the last CLEAR ENTRY BUFFER, and
rem INPUT, which stops the program until RETURN.
rem ESCAPE is disabled here so that it can be shown as a key: TAB asks
rem your name with INPUT, F10 quits.
rem Code is part of OpenDBC (MIT).
rem ==================================================================

sync on : sync rate 30
disable escapekey
w = screen width() : h = screen height()

rem Three rows of a keyboard: a label and its scancode for each key
dim label$(40) : dim code(40) : dim rowkeys(3)
keys = 0
restore
for row = 1 to 3
   read count
   rowkeys(row) = count
   for k = 1 to count
      inc keys
      read label$(keys), code(keys)
   next k
next row
name$ = "nobody yet"
clear entry buffer

do
   if keystate(68) = 1 then exit
   if keystate(15) = 1
      rem INPUT waits for RETURN; everything else stops meanwhile
      sync off
      cls rgb(20, 20, 30)
      set cursor 40, 200
      input "What is your name? ", name$
      sync on
      clear entry buffer
   endif
   if returnkey() = 1 then clear entry buffer

   cls rgb(30, 32, 44)
   rem The keyboard: each key lights up while KEYSTATE(scancode) is 1
   k = 1
   for row = 0 to 2
      for col = 0 to rowkeys(row + 1) - 1
         x = 40 + col * 56 + row * 18 : y = 90 + row * 56
         if keystate(code(k)) = 1 then ink rgb(255, 190, 60), 0 else ink rgb(70, 76, 100), 0
         box x, y, x + 48, y + 48
         ink rgb(255, 255, 255), 0
         text x + 6, y + 4, label$(k)
         ink rgb(170, 170, 190), 0
         text x + 6, y + 28, str$(code(k))
         inc k
      next col
   next row

   rem The named key functions
   y = 270
   ink rgb(230, 230, 230), 0
   text 40, y, "UPKEY " + str$(upkey()) + "  DOWNKEY " + str$(downkey()) + "  LEFTKEY " + str$(leftkey()) + "  RIGHTKEY " + str$(rightkey())
   text 40, y + 20, "SPACEKEY " + str$(spacekey()) + "  RETURNKEY " + str$(returnkey()) + "  SHIFTKEY " + str$(shiftkey()) + "  CONTROLKEY " + str$(controlkey()) + "  ESCAPEKEY " + str$(escapekey())
   text 40, y + 50, "INKEY$ = """ + inkey$() + """    SCANCODE() = " + str$(scancode())
   rem ENTRY$ collects the typing; RETURN empties it with CLEAR ENTRY BUFFER
   ink rgb(20, 20, 26), 0
   box 40, y + 80, w - 40, y + 110
   ink rgb(120, 230, 160), 0
   text 48, y + 86, entry$() + "_"
   ink rgb(170, 170, 190), 0
   text 40, y + 120, "Type anything: ENTRY$ keeps it until RETURN clears the buffer"
   text 40, y + 150, "Your name: " + name$ + "   (TAB asks with INPUT, F10 quits)"
   ink rgb(255, 210, 120), 0
   center text w / 2, 30, "KEYBOARD LAB"
   sync
loop

enable escapekey
end

rem Row: number of keys, then label and scancode pairs
data 10, "Q", 16, "W", 17, "E", 18, "R", 19, "T", 20, "Y", 21, "U", 22, "I", 23, "O", 24, "P", 25
data 9, "A", 30, "S", 31, "D", 32, "F", 33, "G", 34, "H", 35, "J", 36, "K", 37, "L", 38
data 7, "Z", 44, "X", 45, "C", 46, "V", 47, "B", 48, "N", 49, "M", 50

rem ==================================================================
rem Mouse Lab - an OpenDBC tutorial for the DarkBASIC Classic profile
rem A painting program: the left button paints, the right button paints
rem white, both together clear the canvas. MOUSEMOVEX and MOUSEMOVEY
rem tell how fast the mouse moves, and the brush grows with speed.
rem The system pointer is hidden and replaced by a drawn crosshair;
rem M shows it again, C puts it back in the centre with POSITION MOUSE.
rem Until the mouse moves, an invisible pen paints by itself.
rem Code is part of OpenDBC (MIT).
rem ==================================================================

sync on : sync rate 60
w = screen width() : h = screen height()
hide mouse
cls rgb(250, 248, 240)
lastx = -1
hue = 0

do
   mx = mousex() : my = mousey()
   dx = mousemovex() : dy = mousemovey()
   if dx <> 0 or dy <> 0 then moved = 1

   rem The pen: the mouse, or a slow figure of eight until the mouse moves
   if moved = 0
      t# = t# + 3.0
      penx = w / 2 + sin(t#) * 220 : peny = h / 2 + sin(t# * 2) * 120
      button = 1
      speed = 3
   else
      penx = mx : peny = my
      button = mouseclick()
      speed = sqrt(dx * dx + dy * dy)
   endif

   rem Button values add up: 1 left, 2 right, 3 both
   if button = 3 then cls rgb(250, 248, 240)
   if (button = 1 or button = 2) and lastx >= 0
      hue = (hue + 2) mod 360
      if button = 1
         ink rgb(128 + sin(hue) * 127, 128 + sin(hue + 120) * 127, 128 + sin(hue + 240) * 127), 0
      else
         ink rgb(250, 248, 240), 0
      endif
      size = 2 + speed / 3
      if size > 20 then size = 20
      for r = 0 to size
         line lastx, lasty + r - size / 2, penx, peny + r - size / 2
      next r
   endif
   lastx = penx : lasty = peny

   key$ = lower$(inkey$())
   if key$ = "m" and lastkey$ <> "m"
      shown = 1 - shown
      if shown = 1 then show mouse else hide mouse
   endif
   if key$ = "c" and lastkey$ <> "c" then position mouse w / 2, h / 2
   lastkey$ = key$

   rem The status bar and a crosshair drawn where the mouse is
   ink rgb(40, 40, 50), 0
   box 0, 0, w, 22
   ink rgb(255, 255, 255), 0
   text 6, 3, "MOUSEX " + str$(mx) + "  MOUSEY " + str$(my) + "  MOVE " + str$(dx) + "," + str$(dy) + "  CLICK " + str$(mouseclick()) + "   M pointer, C centre"
   if moved = 1
      ink rgb(0, 0, 0), 0
      line mx - 8, my, mx - 3, my : line mx + 3, my, mx + 8, my
      line mx, my - 8, mx, my - 3 : line mx, my + 3, mx, my + 8
   endif
   sync
loop

rem ==================================================================
rem High Scores - an OpenDBC tutorial for the DarkBASIC Classic profile
rem Keeps a table of ten scores in arrays: reads the starting table from
rem DATA, slots in a new score, saves the scores to a file, wipes them
rem and loads them back. UNDIM frees a temporary array. Formatting
rem functions come from score_helpers.dba through #INCLUDE.
rem Start it with a name on the command line
rem (opendbc run high_scores.dba --dialect dbc --command-line ADA) to
rem see that name in the table; CL$() returns it.
rem Code is part of OpenDBC (MIT).
rem ==================================================================

#include "score_helpers.dba"

sync on : sync rate 30
randomize timer()
player$ = upper$(cl$())
if player$ = "" then player$ = "YOU"

rem --- The starting table, read from DATA
dim names$(9) : dim scores(9)
for i = 0 to 9
   read names$(i), scores(i)
next i

rem --- A new score slides into place, pushing lower scores down. A copy
rem of the old table tells how many players were pushed down.
dim previous(9)
for i = 0 to 9 : previous(i) = scores(i) : next i
new_score = 4000 + rnd(5000)
place = 10
for i = 9 to 0 step -1
   if new_score > scores(i) then place = i
next i
if place < 10
   for i = 9 to place + 1 step -1
      names$(i) = names$(i - 1) : scores(i) = scores(i - 1)
   next i
   names$(place) = player$ : scores(place) = new_score
endif

pushed = 0
for i = 0 to 9
   if scores(i) <> previous(i) then inc pushed
next i
if place < 10 then dec pushed
rem The copy is no longer needed: UNDIM frees it
undim previous(0)

rem --- SAVE ARRAY writes a numeric array to a file: save the scores,
rem wipe them, and load them back
save array "scores.dat", scores(0)
for i = 0 to 9 : scores(i) = 0 : next i
load array "scores.dat", scores(0)
delete file "scores.dat"

do
   cls rgb(16, 18, 40)
   set text font "Courier New" : set text size 22
   ink rgb(255, 210, 80), 0
   center text screen width() / 2, 20, "HALL OF FAME"
   for i = 0 to 9
      if i = place and (timer() / 300) mod 2 = 0
         ink rgb(255, 255, 255), 0
      else
         ink rgb(120 + i * 12, 180, 255 - i * 10), 0
      endif
      text 120, 70 + i * 32, pad$(ordinal$(i + 1), 6) + pad$(names$(i), 10) + zeros$(scores(i), 6)
   next i
   set text font "Arial" : set text size 14
   ink rgb(160, 160, 190), 0
   if place < 10
      text 20, screen height() - 46, player$ + " scored " + str$(new_score) + ", placed " + ordinal$(place + 1) + " and pushed " + str$(pushed) + " players down"
   else
      text 20, screen height() - 46, player$ + " scored " + str$(new_score) + ", not enough for the table"
   endif
   text 20, screen height() - 26, "Table saved and reloaded on " + get date$() + " at " + get time$()
   sync
loop

data "ROSA", 9800, "MAX", 9100, "INES", 8400, "TOM", 7700, "LEA", 6900
data "OMAR", 6100, "JUNE", 5200, "KAI", 4300, "NOOR", 3500, "ELI", 2600

rem ==================================================================
rem Maze Walker - an OpenDBC tutorial for the DarkBASIC Classic profile
rem A tour of the language: the maze is stored in DATA lines and READ
rem into an array, a FUNCTION answers questions about it, SELECT CASE
rem picks a direction, FOR, WHILE, REPEAT and DO loops do the work and
rem GOSUB and GOTO move between parts of the program.
rem The walker keeps its right hand on the wall until it finds the exit.
rem Code is part of OpenDBC (MIT).
rem ==================================================================

remstart
   The maze is 21 x 15 characters: # is a wall, . a corridor, S the
   start and E the exit. Every corridor joins every other one by a
   single path, so following the right-hand wall always reaches E.
remend

sync on : sync rate 20
columns = 21 : rows = 15 : cell = 28
originx = (screen width() - columns * cell) / 2 : originy = 50
dim maze(columns - 1, rows - 1)
rem A function only sees its own variables, but arrays are shared:
rem the maze size travels to is_open() through this one
dim size(1) : size(0) = columns : size(1) = rows
rem Directions 0 to 3: up, right, down, left
dim dx(3) : dim dy(3)
dx(1) = 1 : dx(3) = -1 : dy(0) = -1 : dy(2) = 1

gosub read_maze

restart:
x = startx : y = starty : heading = 1 : steps = 0
gosub draw_maze

do
   rem Try right, ahead, left, then back, and take the first open way
   for attempt = 0 to 3
      select attempt
         case 0 : try = (heading + 1) mod 4 : endcase
         case 1 : try = heading : endcase
         case 2 : try = (heading + 3) mod 4 : endcase
         case default : try = (heading + 2) mod 4 : endcase
      endselect
      if is_open(x + dx(try), y + dy(try)) = 1 then heading = try : exit
   next attempt

   rem Repaint the cell the walker leaves with a breadcrumb, then move
   ink rgb(32, 36, 48), 0
   box originx + x * cell, originy + y * cell, originx + x * cell + cell - 1, originy + y * cell + cell - 1
   ink rgb(90, 140, 200), 0
   box originx + x * cell + 11, originy + y * cell + 11, originx + x * cell + cell - 12, originy + y * cell + cell - 12
   x = x + dx(heading) : y = y + dy(heading)
   inc steps
   ink rgb(255, 210, 60), 0
   for r = 1 to 9
      circle originx + x * cell + cell / 2, originy + y * cell + cell / 2, r
   next r

   ink rgb(0, 0, 0), 0
   box 0, 0, screen width(), 40
   ink rgb(255, 255, 255), 0
   text 10, 10, "STEPS " + str$(steps) + "   right-hand rule"

   if maze(x, y) = 3
      gosub celebrate
      rem Read the maze again from the first DATA line and start over
      restore
      gosub read_maze
      goto restart
   endif
   sync
loop

rem Subroutines share every variable with the main program, so they use
rem their own loop counters (gx, gy) and leave the walker's x and y alone
read_maze:
   gy = 0
   while gy < rows
      read row$
      for gx = 0 to columns - 1
         c$ = mid$(row$, gx + 1)
         select c$
            case "#" : maze(gx, gy) = 1 : endcase
            case "S" : maze(gx, gy) = 2 : startx = gx : starty = gy : endcase
            case "E" : maze(gx, gy) = 3 : endcase
            case default : maze(gx, gy) = 0 : endcase
         endselect
      next gx
      inc gy
   endwhile
return

draw_maze:
   cls rgb(20, 22, 30)
   for gy = 0 to rows - 1
      for gx = 0 to columns - 1
         if maze(gx, gy) = 1
            ink rgb(70, 80, 110), 0
         else
            ink rgb(32, 36, 48), 0
         endif
         if maze(gx, gy) = 3 then ink rgb(60, 200, 110), 0
         box originx + gx * cell, originy + gy * cell, originx + gx * cell + cell - 1, originy + gy * cell + cell - 1
      next gx
   next gy
return

celebrate:
   flashes = 0
   repeat
      if flashes mod 2 = 0 then ink rgb(60, 200, 110), 0 else ink rgb(255, 255, 255), 0
      center text screen width() / 2, originy + rows * cell + 8, "EXIT FOUND IN " + str$(steps) + " STEPS"
      sync
      sleep 150
      inc flashes
   until flashes = 8
return

rem 1 when the cell is inside the maze and not a wall
function is_open(cx, cy)
   if cx < 0 or cy < 0 or cx >= size(0) or cy >= size(1) then exitfunction 0
   passable = 1
   if maze(cx, cy) = 1 then passable = 0
endfunction passable

data "#####################"
data "#S#.......#.........#"
data "#.###.###.#.#.#######"
data "#...#...#...#.......#"
data "###.#.#############.#"
data "#.#.#.#...#.......#.#"
data "#.#.###.#.#.#####.#.#"
data "#.#.....#...#.....#.#"
data "#.###########.#####.#"
data "#...........#...#...#"
data "#.###.#####.###.#.#.#"
data "#...#.....#...#...#.#"
data "###.#####.#########.#"
data "#.......#..........E#"
data "#####################"