Sorry your browser is not supported!

delete file YOURFILE$
make bank 1,fast len(YOURstring$)
write bank string 1,0,YOURstring$,fast len(YOURstring$)
make file from bank YOURFILE$,1
delete bank 1

make bank from file 1,YOURFILE$
YOURstring$ = bank string$(1,0,get bank size(1))
delete bank 1

local File as string = "YourFile.txt"
local Position as integer = 0
local NextPosition as integer = 0
local S as string

map file to bank File, 1

while Position >= 0 and Position < get bank size(1)
   ` Search for linefeed/newline
   NextPosition = search bank(1, Position, chr$(10))

   if NextPosition >= 0
      S = bank string$(1, Position, NextPosition - Position)
      ` Remove any trailing carriage-return
      S = trimright$(S, chr$(13))

      print S

      inc NextPosition
   endif
   Position = NextPosition
endwhile

delete bank 1

wait key

sync off
sync sleep 1

print DIR EXE()
print DIR DBPRO TEMP()
print DIR TEMP()
print DIR WINDOWS()
print DIR APPDATA()
print DIR LOCAL APPDATA()
print DIR DOCUMENTS()
print DIR PROGRAMS()
print DIR SYSTEM()
print DIR DESKTOP()
print DIR FONTS()

wait key

set display mode 800, 600, 32

sync on

local v as float = 0.0

do
   lock pixels

   for x = 0 to 360
      for y = 0 to 100

         dot x, y      , hsv to rgb(x, y/100.0, v)
         dot x, y + 110, hsv to rgb(rgb to hsv(hsv to rgb(x, y/100.0, v)))

         dot x, y + 220, hsl to rgb(x, y/100.0, v)
         dot x, y + 330, hsl to rgb(rgb to hsl(hsl to rgb(x, y/100.0, v)))

      next
   next
   text 0, 0, "HSV TO RGB"
   text 0, 110, "HSV TO RGB TO HSV TO RGB"
   text 0, 220, "HSL TO RGB"
   text 0, 330, "HSL TO RGB TO HSL TO RGB"

   for x = 0 to 100
      for y = 0 to 100

         dot x + 400, y      , cmyk to rgb(x/100.0, y/100.0, v, v)
         dot x + 400, y + 110, cmyk to rgb(rgb to cmyk(cmyk to rgb(x/100.0, y/100.0, v, v)))

         dot x + 400, y + 220, cmy to rgb(x/100.0, y/100.0, v)
         dot x + 400, y + 330, cmy to rgb(rgb to cmy(cmy to rgb(x/100.0, y/100.0, v)))

      next
   next
   text 400, 0, "CMYK TO RGB"
   text 400, 110, "CMYK TO RGB TO CMYK TO RGB"
   text 400, 220, "CMY TO RGB"
   text 400, 330, "CMY TO RGB TO CMY TO RGB"

   for x = 0 to 31
      for y = 0 to 100
         c = x / 2
         dot x, y + 440, ansi colour(c)
         if c < 8 then dot x + 400, y + 440, old ansi colour( c )
      next
   next
   text 0, 440, "ANSI 16 colour"
   text 400, 440, "ANSI 8 colour"

   v = wrap(v + 0.1, 0.0, 1.0)

   unlock pixels

   sync
loop

#constant CSIDL_PROGRAMS     0x002
#constant CSIDL_MYDOCUMENTS  0x005
#constant CSIDL_STARTUP      0x007
#constant CSIDL_SENDTO       0x009
#constant CSIDL_STARTMENU    0x00B
#constant CSIDL_MYMUSIC      0x00D
#constant CSIDL_DESKTOP      0x010
#constant CSIDL_FONTS        0x014
#constant CSIDL_ALLPROGRAMS  0x017
#constant CSIDL_USERAPPDATA  0x01A
#constant CSIDL_ALLAPPDATA   0x023
#constant CSIDL_WINDOWS      0x024
#constant CSIDL_SYSTEM       0x025
#constant CSIDL_MYPICTURES   0x027
#constant CSIDL_PROFILE      0x028

PRINT CONSOLE [Variable and Constant list]
PRINT CONSOLE

print "Creating coroutine 1"
create coroutine 1, __fp_DoSomething()

while coroutine active(1)
   next coroutine
   print "Running coroutine "; current coroutine()
endwhile

print "Coroutine 1 has ended"
print "Restarting coroutine 1"
restart coroutine 1

while coroutine active(1)
   next coroutine
   print "Running coroutine "; current coroutine()
endwhile

print "Ended"
delete coroutine 1

wait key
end



function __fp_DoSomething()
   exitfunction get ptr to next function()
endfunction 0

function DoSomething()
   print "Coroutine "; current coroutine(); " is starting"
   for i = 1 to 3
      print "Running coroutine "; current coroutine(); " iteration "; i
      next coroutine
   next
   print "Coroutine "; current coroutine(); " is ending"
endfunction

set display mode 800, 600, screen depth()
print "Creating coroutines 1 & 2"
create coroutine 1, __fp_DoSomething()
create coroutine 2, __fp_DoSomethingElse()

print "Coroutine 2 set to 'always active'"
set coroutine end state 2, 1

while coroutine active(1)
   next coroutine
   print "Running coroutine "; current coroutine()
endwhile

print "Coroutine 1 has ended"
print "Restarting coroutine 1"
restart coroutine 1

while coroutine active(1)
   next coroutine
   print "Running coroutine "; current coroutine()
endwhile

print "Ended"
delete coroutine 2
delete coroutine 1

wait key
end



function __fp_DoSomething()
   exitfunction get ptr to next function()
endfunction 0

function DoSomething()
   print "Coroutine "; current coroutine(); " is starting"
   for i = 1 to 3
      print "Running coroutine "; current coroutine(); " iteration "; i
      next coroutine
   next
   print "Coroutine "; current coroutine(); " is ending"
endfunction

function __fp_DoSomethingElse()
   exitfunction get ptr to next function()
endfunction 0

function DoSomethingElse()
   print "Coroutine "; current coroutine(); " is starting"
   for i = 4 to 5
      print "Running coroutine "; current coroutine(); " iteration "; i
      next coroutine
   next
   print "Coroutine "; current coroutine(); " is ending"
endfunction

sync on
sync rate 0

global dim Cams() as integer

global Counter as integer = 0
global PreSyncCounter as integer = 0
global PostSyncCounter as integer = 0

SET PRESYNC CALLBACK _fp_PreSyncCallback()
SET POSTSYNC CALLBACK _fp_PostSyncCallback()
SET PRECAMERA CALLBACK _fp_CameraCallback()

make object cube 1, 1.0
autocam off

make camera 3
set camera view 3, 100, 100, 150, 150
position camera 3, camera position x(0), camera position y(0), camera position z(0)
rotate camera 3, camera angle x(0), camera angle y(0), camera angle z(0)

do
   set cursor 0, 0
   print "    Camera renders : "; Counter
   print " PreSyncs executed : "; PreSyncCounter
   print "PostSyncs executed : "; PostSyncCounter
   print "      Elapsed time : "; SYNC ELAPSED()
   print ""
   print "Cameras that were rendered"
   for i = 0 to array count( Cams() )
      print "    "; Cams(i); " (";
      print camera view left(Cams(i)); "/"; camera view top(Cams(i)); " - ";
      print camera view right(Cams(i)); "/"; camera view bottom(Cams(i)); ") ";
      print camera aspect(Cams(i)); " + "; camera fov(Cams(i))
   next
   empty array Cams()

   if spacekey() then sync mask 1
   if returnkey() then sync mask 0xffffffff

   sync
loop


function _fp_CameraCallback()
   exitfunction GET PTR TO NEXT FUNCTION()
endfunction 0

function CameraCallback(Cam as integer)
   array insert at bottom Cams()
   Cams() = Cam

   ` Hide the object if a key is pressed and not displaying camera 0
   if scancode() <> 0 and Cam <> 0
      hide object 1
   else
      show object 1
   endif

   inc Counter
endfunction


function _fp_PreSyncCallback()
   exitfunction GET PTR TO NEXT FUNCTION()
endfunction 0

function PreSyncCallback()
   inc PreSyncCounter
endfunction


function _fp_PostSyncCallback()
   exitfunction GET PTR TO NEXT FUNCTION()
endfunction 0

function PostSyncCallback()
   inc PostSyncCounter
endfunction

sync on
sync rate 0

box 0, 0, 16, 16
get image 1, 0, 0, 16, 16

set sprite view 0, 0, 110, 110
sprite 1, 100, 100, 1
set sprite 1, 0, 1

SET POSTSPRITE CALLBACK _fp_SpriteCallback()

do
   cls
   if spacekey() then set sprite view 90, 90, screen width(), screen height()
   set cursor 0, 0
   print sprite view left()
   print sprite view top()
   print sprite view bottom()
   print sprite view right()
   sync
loop



function _fp_SpriteCallback()
   exitfunction GET PTR TO NEXT FUNCTION()
endfunction 0

function SpriteCallback()
   rotate sprite 1, wrapvalue( sprite angle(1) + 1 )
endfunction

sync on
sync rate 60
autocam off
backdrop on
color backdrop rgb(0, 0, 0)

load image "UnionJack.bmp", 1

MakeObjectPlain(1, 36.0, 18.0, 36, 1)
rotate object 1, -90.0, 0.0, 0.0
fix object pivot 1
texture object 1, 1
position object 1, 0.0, 0.0, 0.0
set object cull 1, 0
rotate object 1, 0, 45, 0

position camera 18, 9, -80
point camera 18, 9, 0

global AngleOffset as integer = 0

repeat
   set cursor 0, 0
   print screen fps()
   AngleOffset = wrapvalue( AngleOffset + 6 )
   WaveTheFlag(1, 36, 1)
   sync
until spacekey()

end


function WaveTheFlag(ObjectID as integer, XSegs as integer, ZSegs as integer)
   local x as integer
   local y as float
   local z as integer

   local V as integer

   lock vertexdata for limb ObjectID, 0

   for x = 0 to XSegs - 1

      y = sin(AngleOffset+(x*20))
      select x
         case 0       : y = y*1.0 : endcase
         case 1       : y = y*1.5 : endcase
         case 2       : y = y*2.0 : endcase
         case 3       : y = y*2.5 : endcase
         case default : y = y*3.0 : endcase
      endselect

      for z = 0 to ZSegs
         V = GetPlaneVertex(x, z, C_TOP_RIGHT, XSegs, ZSegs)
         set vertexdata position V, get vertexdata position x(V), y, get vertexdata position z(V)
         V = GetPlaneVertex(x, z, C_BOT_RIGHT, XSegs, ZSegs)
         set vertexdata position V, get vertexdata position x(V), y, get vertexdata position z(V)
      next
   next x

   unlock vertexdata
endfunction




function MakeObjectPlain(ObjectID as integer, Width as float, Depth as float, XSegs as integer, ZSegs as integer)
   local XPos as float
   local ZPos as float
   local XStep as float
   local ZStep as float
   local XStart as float
   local ZStart as float

   XStep = Width / XSegs
   XStart = 0.0 - (XStep * XSegs / 2.0)
   ZStep = Depth / ZSegs
   ZStart = ZStep * ZSegs / 2.0

   MAKE OBJECT NEW ObjectID, (XSegs+1)*(ZSegs+1), 6*XSegs*ZSegs, 338
   lock vertexdata for limb ObjectID, 0

   V = 0
   ZPos = ZStart
   for z = 0 to ZSegs
      XPos = XStart
      for x = 0 to XSegs
         SetVertexData(V, XPos, 0.0, ZPos, 0.0, 1.0, 0.0, 1.0 / ((XSegs + 0.0) / x), 1.0 / ((ZSegs + 0.0) / z), 0xffffffff )
         inc V
         inc XPos, XStep
      next
      dec ZPos, ZStep
   next

   I = 0
   for z = 0 to ZSegs - 1
      for x = 0 to XSegs - 1
         set indexdata I    , GetPlaneVertex(x, z, C_TOP_LEFT, XSegs, ZSegs)
         set indexdata I + 1, GetPlaneVertex(x, z, C_TOP_RIGHT, XSegs, ZSegs)
         set indexdata I + 2, GetPlaneVertex(x, z, C_BOT_LEFT, XSegs, ZSegs)
         set indexdata I + 3, GetPlaneVertex(x, z, C_TOP_RIGHT, XSegs, ZSegs)
         set indexdata I + 4, GetPlaneVertex(x, z, C_BOT_RIGHT, XSegs, ZSegs)
         set indexdata I + 5, GetPlaneVertex(x, z, C_BOT_LEFT, XSegs, ZSegs)
         inc I, 6
      next
   next
   unlock vertexdata
endfunction

function SetVertexdata(Index as integer, x as float, y as float, z as float, nx as float, ny as float, nz as float, u as float, v as float, d as dword)
   set vertexdata position Index, x, y, z
   set vertexdata normals  Index, nx, ny, nz
   set vertexdata uv       Index, u, v
   set vertexdata diffuse  Index, d
endfunction

#constant C_TOP_LEFT  1
#constant C_TOP_RIGHT 2
#constant C_BOT_LEFT  3
#constant C_BOT_RIGHT 4

function GetPlaneVertex(X as integer, Z as integer, Corner as integer, XSegs as integer, ZSegs as integer)
   local V as integer

   V = (XSegs + 1) * Z + X
   select Corner
      case C_TOP_LEFT  :                  : endcase
      case C_TOP_RIGHT : inc V            : endcase
      case C_BOT_LEFT  : inc V, XSegs + 1 : endcase
      case C_BOT_RIGHT : inc V, XSegs + 2 : endcase
      case default     : V = -1           : endcase
   endselect
endfunction V

sync on: sync rate 5
set text size 28
set text font "Courier New"
backdrop on

do
    text 100, 200, "   HITIMER : " + str$(hitimer()) 
    text 100, 300, "     TIMER : " + str$(timer()) 
    text 100, 400, "DIFFERENCE : " + str$(hitimer() - timer()) 
    sync
loop 

sync on
sync rate 0
sync sleep 1

x as float
y as float
radius as float
xspeed as float
yspeed as float

x = screen width() / 2
y = screen height() / 2
radius = 20.0

repeat
   xspeed = rnd(20) / 5.0
   yspeed = rnd(20) / 5.0
until xspeed <> 0.0 and yspeed <> 0.0

do
   cls
   set cursor 0, 0

   circle x, y, radius
   box 100, 100, 200, 150

   Result = CircleBoxCollision_Side( x, y, radius, 100, 100, 200, 150 )
   if Result = 0 and xspeed > 0.0 then xspeed = 0.0 - xspeed
   if Result = 1 and xspeed < 0.0 then xspeed = 0.0 - xspeed
   if Result = 2 and yspeed > 0.0 then yspeed = 0.0 - yspeed
   if Result = 3 and yspeed < 0.0 then yspeed = 0.0 - yspeed

   inc x, xspeed
   inc y, yspeed

   if x < radius then xspeed = 0.0 - xspeed
   if x > screen width() - radius then xspeed = 0.0 - xspeed
   if y < radius then yspeed = 0.0 - yspeed
   if y > screen height() - radius then yspeed = 0.0 - yspeed

   sync
loop


function CircleBoxCollision(cx as integer, cy as integer, cr as integer, bx1 as integer, by1 as integer, bx2 as integer, by2 as integer)
   local Collision as integer = 0
   local nx as integer
   local ny as integer

   ` Find nearest point from centre of circle to the rectangle (works even if within rectangle)
   nx = min(max(cx, bx1), bx2)
   ny = min(max(cy, by1), by2)

   ` Check if within circle radius (pythagoras, except square roots cancel each other)
   if ( (cx - nx) ^ 2 + (cy - ny) ^ 2) <= cr ^ 2 then Collision = 1
endfunction Collision

function CircleBoxCollision_Side(cx as integer, cy as integer, cr as integer, bx1 as integer, by1 as integer, bx2 as integer, by2 as integer)
   local Collision as integer = -1

   ` Nearest point
   local nx as integer
   local ny as integer

   ` Distance to edges
   local dx as integer
   local dy as integer

   ` Which edges
   local XSide as integer
   local YSide as integer

   ` Find nearest point from centre of circle to the rectangle (works even if within rectangle)
   nx = min(max(cx, bx1), bx2)
   ny = min(max(cy, by1), by2)

   ` Check if within circle radius (pythagoras, except square roots cancel, so avoids divide-by-zero error)
   if ( (cx - nx) ^ 2 + (cy - ny) ^ 2) <= cr ^ 2
      ` Find nearest edge for x
      if cx < (bx1 + bx2) / 2
         dx = cx - bx1
         XSide = 0
      else
         dx = bx2 - cx
         XSide = 1
      endif
      ` Find nearest edge for y
      if cy < (by1 + by2) / 2
         dy = cy - by1
         YSide = 2
      else
         dy = by2 - cy
         YSide = 3
      endif
      ` Is X closer than Y
      if dx < dy
         Collision = XSide
      else
         Collision = YSide
      endif
   endif
endfunction Collision