Sorry your browser is not supported!

alpha = 128
col as DOWRD
col = rgb(255,0,0) && (0x00FFFFFF || (alpha << 24))

col = rgb(255,0,0) + (alpha << 24)

79.5%|8%
-----+-----
 8%  |4.5%

 8%  | 4.5%
-----+------
 77% | 8%
-----+------
 8%  | 4.5%

lol as dword
lol = 0x800000FF

lolly = 128
lol = rgb(255,0,0) && (0x000000FF || (lolly << 24))

make memblock 1,156
size as dword
depth as dword
size=6 : depth=32
write memblock dwrod 1,1,size
write memblock dword 1,2,size
write memblock dword 1,3,depth

   lol as dword
   lol = 0x8000FFFF

for i=1 to 36
   write memblock 1,i+3,lol
next i

make image from memblock 1,1
delete memblock 1

paste image 1,50,50,1
paste image 1,52,52,1
sync:sync

wait key

`width = memblock dword(1,0)
`height = memblock dword(1,4)

make memblock 1,156
size as dword
depth as dword
size=6 : depth=32
write memblock dword 1,1,size
write memblock dword 1,2,size
write memblock dword 1,3,depth

   lol as dword
   lol = 0x8000FFFF

for i=1 to 36
   write memblock 1,i+3,lol
next i

make image from memblock 1,1
delete memblock 1

paste image 1,50,50,1
paste image 1,52,52,1
sync:sync

wait key

set window on : set window position 100,60
randomize timer()

make memblock 1,592
size as dword
depth as dword
size=12 : depth=32
write memblock dword 1,0,size
write memblock dword 1,4,size
write memblock dword 1,8,depth

for i=3 to 147
   read lol
   write memblock dword 1,(4*i),lol
next i

make image from memblock 1,1
delete memblock 1

for i=0 to 1000
   paste image 1,rnd(screen width()),rnd(screen height()),1
next i

sync:sync

wait key

#constant ColBlk 0000000000
#constant ColWhi 2164260863
#constant Ltblue 2147549183
#constant ColBlu 2147483903

data ColBlk,ColBlk,ColBlk,ColBlk,ColBlk,ColWhi,ColWhi,ColBlk,ColBlk,ColBlk,ColBlk,ColBlk
data ColBlk,ColBlk,ColWhi,ColWhi,ColWhi,Ltblue,Ltblue,ColWhi,ColWhi,ColWhi,ColBlk,ColBlk
data ColBlk,ColWhi,Ltblue,Ltblue,Ltblue,Ltblue,Ltblue,Ltblue,Ltblue,Ltblue,ColWhi,ColBlk
data ColBlk,ColWhi,Ltblue,Ltblue,ColBlu,Ltblue,Ltblue,ColBlu,Ltblue,Ltblue,ColWhi,ColBlk
data ColBlk,ColWhi,Ltblue,Ltblue,ColBlu,Ltblue,Ltblue,ColBlu,Ltblue,Ltblue,ColWhi,ColBlk
data ColWhi,Ltblue,Ltblue,Ltblue,Ltblue,Ltblue,Ltblue,Ltblue,Ltblue,Ltblue,Ltblue,ColWhi
data ColWhi,Ltblue,Ltblue,ColBlu,Ltblue,Ltblue,Ltblue,Ltblue,ColBlu,Ltblue,Ltblue,ColWhi
data ColBlk,ColWhi,Ltblue,ColBlu,Ltblue,Ltblue,Ltblue,Ltblue,ColBlu,Ltblue,ColWhi,ColBlk
data ColBlk,ColWhi,Ltblue,Ltblue,ColBlu,ColBlu,ColBlu,ColBlu,Ltblue,Ltblue,ColWhi,ColBlk
data ColBlk,ColWhi,Ltblue,Ltblue,Ltblue,Ltblue,Ltblue,Ltblue,Ltblue,Ltblue,ColWhi,ColBlk
data ColBlk,ColBlk,ColWhi,ColWhi,ColWhi,Ltblue,Ltblue,ColWhi,ColWhi,ColWhi,ColBlk,ColBlk
data ColBlk,ColBlk,ColBlk,ColBlk,ColBlk,ColWhi,ColWhi,ColBlk,ColBlk,ColBlk,ColBlk,ColBlk

sync on : sync rate 0
hide mouse

make memblock 1,156
write memblock dword 1,0,338
write memblock dword 1,4,36
write memblock dword 1,8,4

type Vertex
   XPos As float
   YPos As float
   ZPos As float
   XNor As float
   YNor As float
   ZNor As float
   Diff As dword
   UCor As float
   VCor As float
endtype

global dim VertexData(4) As Vertex

` Set the vertex data
setVertex(0,0,10,0,0,10.1,0,4294901760,15,0)
setVertex(1,-15,-10,-15,-15.1,-10.1,-15.1,4294901760,0,10)
setVertex(2,15,-10,-15,15.1,-10.1,-15.1,4294901760,30,10)
setVertex(3,0,-10,15,0,-10.1,15.1,4294901760,15,20)

   write memblock float 1,12,VertexData(0).XPos
   write memblock float 1,16,VertexData(0).YPos
   write memblock float 1,20,VertexData(0).ZPos
   write memblock float 1,24,VertexData(0).XNor
   write memblock float 1,28,VertexData(0).YNor
   write memblock float 1,32,VertexData(0).ZNor
   write memblock dword 1,36,VertexData(0).Diff
   write memblock float 1,40,VertexData(0).UCor
   write memblock float 1,44,VertexData(0).VCor

   write memblock float 1,48,VertexData(1).XPos
   write memblock float 1,52,VertexData(1).YPos
   write memblock float 1,56,VertexData(1).ZPos
   write memblock float 1,60,VertexData(1).XNor
   write memblock float 1,64,VertexData(1).YNor
   write memblock float 1,68,VertexData(1).ZNor
   write memblock dword 1,72,VertexData(1).Diff
   write memblock float 1,76,VertexData(1).UCor
   write memblock float 1,80,VertexData(1).VCor

   write memblock float 1,84,VertexData(2).XPos
   write memblock float 1,88,VertexData(2).YPos
   write memblock float 1,92,VertexData(2).ZPos
   write memblock float 1,96,VertexData(2).XNor
   write memblock float 1,102,VertexData(2).YNor
   write memblock float 1,104,VertexData(2).ZNor
   write memblock dword 1,108,VertexData(2).Diff
   write memblock float 1,112,VertexData(2).UCor
   write memblock float 1,116,VertexData(2).VCor

   write memblock float 1,120,VertexData(3).XPos
   write memblock float 1,124,VertexData(3).YPos
   write memblock float 1,128,VertexData(3).ZPos
   write memblock float 1,132,VertexData(3).XNor
   write memblock float 1,136,VertexData(3).YNor
   write memblock float 1,140,VertexData(3).ZNor
   write memblock dword 1,144,VertexData(3).Diff
   write memblock float 1,148,VertexData(3).UCor
   write memblock float 1,152,VertexData(3).VCor

make mesh from memblock 1,1
save mesh "lol.x",1
delete memblock 1
delete mesh 1
load object "lol.x",1
set object cull 1,0
show object bounds 1,1

position camera 0,20,-45
point camera 0,0,0

Framerate=timer()
repeat
   A$ = inkey$()
   if timer()-Framerate >= 15
      yrotate object 1,object angle y(1)+2
      `zrotate object 1,object angle y(1)+3
      sync
   endif
until A$<>""
delete object 1
delete file "lol.x"

function setVertex(index as integer,xp as float,yp as float,zp as float,xn as float,yn as float,zn as float,dif as dword,uc as float,vc as float)
   VertexData(index).XPos = xp
   VertexData(index).YPos = yp
   VertexData(index).ZPos = zp
   VertexData(index).XNor = xn
   VertexData(index).YNor = yn
   VertexData(index).ZNor = zn
   VertexData(index).Diff = dif
   VertexData(index).UCor = uc
   VertexData(index).VCor = vc
endfunction

sync on : sync rate 0

cls rgb(255,255,255)
m$ = "Hello everyone!"
ink 0,0
text 0,0,m$
get image 1,0,0,text width(m$), text height(m$), 1
make memblock from image 1,1

BlurImage(1, 2)
BlurImage(2, 3)
BlurImage(3, 2)
BlurImage(2, 1)
make image from memblock 1, 1

do

   cls
   paste image 1,0,0

   sync
loop

function BlurImage(mem, retmem)

   `Get data
   width = memblock dword(mem, 0)
   height = memblock dword(mem, 4)

   `Create returned memblock
   if memblock exist(retmem) = 0 then make memblock retmem, get memblock size(mem)
   write memblock dword retmem, 0, width
   write memblock dword retmem, 4, height
   write memblock dword retmem, 8, 32

   `Write data
   `No edges:
   for y = 2 to height - 1
      for x = 2 to width - 1

         `Get position
         pos = 12 + ((y-1)*width*4) + ((x-1)*4)

         `Initialize values
         blue# = memblock byte(mem, pos) * 0.5
         green# = memblock byte(mem, pos+1) * 0.5
         red# = memblock byte(mem, pos+2) * 0.5

         `Get surrounding data
         `Left
         npos = pos - 4
         blue# = blue# + (memblock byte(mem, npos)*0.08)
         green# = green# + (memblock byte(mem, npos+1)*0.08)
         red# = red# + (memblock byte(mem, npos+2)*0.08)

         `+-> Top Left
         npos = npos - (width*4)
         blue# = blue# + (memblock byte(mem, npos)*0.045)
         green# = green# + (memblock byte(mem, npos+1)*0.045)
         red# = red# + (memblock byte(mem, npos+2)*0.045)

         `Right
         npos = pos + 4
         blue# = blue# + (memblock byte(mem, npos)*0.08)
         green# = green# + (memblock byte(mem, npos+1)*0.08)
         red# = red# + (memblock byte(mem, npos+2)*0.08)

         `+-> Bottom right
         npos = npos + (width*4)
         blue# = blue# + (memblock byte(mem, npos)*0.045)
         green# = green# + (memblock byte(mem, npos+1)*0.045)
         red# = red# + (memblock byte(mem, npos+2)*0.045)

         `Top
         npos = pos - (width*4)
         blue# = blue# + (memblock byte(mem, npos)*0.08)
         green# = green# + (memblock byte(mem, npos+1)*0.08)
         red# = red# + (memblock byte(mem, npos+2)*0.08)

         `+-> top right
         npos = npos + 4
         blue# = blue# + (memblock byte(mem, npos)*0.045)
         green# = green# + (memblock byte(mem, npos+1)*0.045)
         red# = red# + (memblock byte(mem, npos+2)*0.045)

         `Bottom
         npos = pos + (width*4)
         blue# = blue# + (memblock byte(mem, npos)*0.08)
         green# = green# + (memblock byte(mem, npos+1)*0.08)
         red# = red# + (memblock byte(mem, npos+2)*0.08)

         `+-> Bottom left
         npos = npos - 4
         blue# = blue# + (memblock byte(mem, npos)*0.045)
         green# = green# + (memblock byte(mem, npos+1)*0.045)
         red# = red# + (memblock byte(mem, npos+2)*0.045)

         `Write away data
         write memblock byte retmem, pos, int(blue#+0.5)
         write memblock byte retmem, pos+1, int(green#+0.5)
         write memblock byte retmem, pos+2, int(red#+0.5)
         write memblock byte retmem, pos+3, 255

      next x
   next y

   `Edges
   for y = 1 to height step (height-1)
      for x = 1 to width

         `Get position
         pos = 12 + ((y-1)*width*4) + ((x-1)*4)

         `Initialize colors
         if x = 1 or x = width
            blue# = memblock byte(mem, pos) * 0.795
            green# = memblock byte(mem, pos+1) * 0.795
            red# = memblock byte(mem, pos+2) * 0.795
         else
            blue# = memblock byte(mem, pos) * 0.67
            green# = memblock byte(mem, pos+1) * 0.67
            red# = memblock byte(mem, pos+2) * 0.67
         endif

         `Get other colors
         if x > 1
            npos = pos - 4
            blue# = blue# + memblock byte(mem, npos) * 0.08
            green# = green# + memblock byte(mem, npos+1) * 0.08
            red# = red# + memblock byte(mem, npos+2) * 0.08
         endif
         if x < width
            npos = pos + 4
            blue# = blue# + memblock byte(mem, npos) * 0.08
            green# = green# + memblock byte(mem, npos+1) * 0.08
            red# = red# + memblock byte(mem, npos+2) * 0.08
         endif

         if y > 1 then npos = pos - (width*4) else npos = pos + (width*4)
         blue# = blue# + memblock byte(mem, npos) * 0.08
         green# = green# + memblock byte(mem, npos+1) * 0.08
         red# = red# + memblock byte(mem, npos+2) * 0.08

         if x > 1
            mpos = npos - 4
            blue# = blue# + memblock byte(mem, mpos) * 0.045
            green# = green# + memblock byte(mem, mpos+1) * 0.045
            red# = red# + memblock byte(mem, mpos+2) * 0.045
         endif
         if x < width
            mpos = npos + 4
            blue# = blue# + memblock byte(mem, mpos) * 0.045
            green# = green# + memblock byte(mem, mpos+1) * 0.045
            red# = red# + memblock byte(mem, mpos+2) * 0.045
         endif

         `Write away data
         write memblock byte retmem, pos, int(blue#+0.5)
         write memblock byte retmem, pos+1, int(green#+0.5)
         write memblock byte retmem, pos+2, int(red#+0.5)
         write memblock byte retmem, pos+3, 255

      next x
   next y

   `Left and right edges (no corners anymore)
   for x = 1 to width step (width-1)
      for y = 2 to height - 1

         `Get position
         pos = 12 + ((y-1)*width*4) + ((x-1)*4)

         `Initialize colors
         blue# = memblock byte(mem, pos) * 0.67
         green# = memblock byte(mem, pos+1) * 0.67
         red# = memblock byte(mem, pos+2) * 0.67

         `Get surrounding data
         npos = pos - (width*4)
         blue# = blue# + memblock byte(mem, npos) * 0.08
         green# = green# + memblock byte(mem, npos+1) * 0.08
         red# = red# + memblock byte(mem, npos+2) * 0.08

         npos = pos + (width*4)
         blue# = blue# + memblock byte(mem, npos) * 0.08
         green# = green# + memblock byte(mem, npos+1) * 0.08
         red# = red# + memblock byte(mem, npos+2) * 0.08

         if x > 1 then npos = pos - 4 else npos = pos + 4
         blue# = blue# + memblock byte(mem, npos) * 0.08
         green# = green# + memblock byte(mem, npos+1) * 0.08
         red# = red# + memblock byte(mem, npos+2) * 0.08

         mpos = npos - (width*4)
         blue# = blue# + memblock byte(mem, mpos) * 0.045
         green# = green# + memblock byte(mem, mpos+1) * 0.045
         red# = red# + memblock byte(mem, mpos+2) * 0.045
         mpos = npos + (width*4)
         blue# = blue# + memblock byte(mem, mpos) * 0.045
         green# = green# + memblock byte(mem, mpos+1) * 0.045
         red# = red# + memblock byte(mem, mpos+2) * 0.045

         `Write away data
         write memblock byte retmem, pos, int(blue#+0.5)
         write memblock byte retmem, pos+1, int(green#+0.5)
         write memblock byte retmem, pos+2, int(red#+0.5)
         write memblock byte retmem, pos+3, 255

      next y
   next x

endfunction

sync on : sync rate 0
hide mouse : disable escapekey

make memblock 1,444
write memblock dword 1,0,338
write memblock dword 1,4,36
write memblock dword 1,8,12

type Vertex
   XPos As float
   YPos As float
   ZPos As float
   XNor As float
   YNor As float
   ZNor As float
   Diff As dword
   UCor As float
   VCor As float
endtype

global dim VertexData(12) As Vertex

` Set the vertex data
setVertex(0,0,10,0,0,10.1,0,4294901760,15,0)
setVertex(1,15,-10,-15,15.1,-10.1,-15.1,4294901760,30,10)
setVertex(2,-15,-10,-15,-15.1,-10.1,-15.1,4294901760,0,10)
setVertex(3,0,-10,15,0,-10.1,15.1,4294901760,15,20)
setVertex(4,0,10,0,0,10.1,0,4294901760,15,0)
setVertex(5,-15,-10,-15,-15.1,-10.1,-15.1,4294901760,0,10)
setVertex(6,0,-10,15,0,-10.1,15.1,4294901760,15,20)
setVertex(7,15,-10,-15,15.1,-10.1,-15.1,4294901760,30,10)
setVertex(8,0,10,0,0,10.1,0,4294901760,15,0)
setVertex(9,0,-10,15,0,-10.1,15.1,4294901760,15,20)
setVertex(10,-15,-10,-15,-15.1,-10.1,-15.1,4294901760,0,10)
setVertex(11,15,-10,-15,15.1,-10.1,-15.1,4294901760,30,10)

for i=0 to 11
   write memblock float 1,(12+(36*i)),VertexData(i).XPos
   write memblock float 1,(16+(36*i)),VertexData(i).YPos
   write memblock float 1,(20+(36*i)),VertexData(i).ZPos
   write memblock float 1,(24+(36*i)),VertexData(i).XNor
   write memblock float 1,(28+(36*i)),VertexData(i).YNor
   write memblock float 1,(32+(36*i)),VertexData(i).ZNor
   write memblock dword 1,(36+(36*i)),VertexData(i).Diff
   write memblock float 1,(40+(36*i)),VertexData(i).UCor
   write memblock float 1,(44+(36*i)),VertexData(i).VCor
next i

make mesh from memblock 1,1
save mesh "lol.x",1
delete memblock 1
delete mesh 1
load object "lol.x",1
xrotate object 1,289.6

position camera 0,20,-45
point camera 0,0,0

Framerate=timer()
repeat
   A$ = inkey$()
   if timer()-Framerate >= 15
      yrotate object 1,object angle y(1)+2
      sync
   endif
until A$<>"" or escapekey()=1
delete object 1
delete file "lol.x"

function setVertex(index as integer,xp as float,yp as float,zp as float,xn as float,yn as float,zn as float,dif as dword,uc as float,vc as float)
   VertexData(index).XPos = xp
   VertexData(index).YPos = yp
   VertexData(index).ZPos = zp
   VertexData(index).XNor = xn
   VertexData(index).YNor = yn
   VertexData(index).ZNor = zn
   VertexData(index).Diff = dif
   VertexData(index).UCor = uc
   VertexData(index).VCor = vc
endfunction

repeat
   A$ = inkey$()
   if timer()-Framerate >= 15
      yrotate object 1,object angle y(1)+2
      zrotate object 1,object angle y(1)+3
      sync
   endif
until A$<>"" or escapekey()=1

sync on : sync rate 0
hide mouse : disable escapekey

make memblock 1,552
write memblock dword 1,0,338
write memblock dword 1,4,36
write memblock dword 1,8,15

type Vertex
   Xpoz as float
   Ypoz as float
   Zpoz as float
   Xnor as float
   Ynor as float
   Znor as float
   Diff as dword
   Ucor as float
   Vcor as float
endtype

global dim Vertices(72) as Vertex

` Set model vertex data
sVertex(0,1,6,0,0,0,-1,4294934528,200,0)
sVertex(1,-1,0,0,0,0,-1,4294934528,0,600)
sVertex(2,-1,4,0,0,0,-1,4294934528,0,200)

sVertex(3,1,6,0,0,0,-1,4294934528,200,0)
sVertex(4,1,0,0,0,0,-1,4294934528,200,600)
sVertex(5,-1,0,0,0,0,-1,4294934528,0,600)

sVertex(6,1,6,0,1,0,0,4294934528,200,0)
sVertex(7,1,6,2,1,0,0,4294934528,400,0)
sVertex(8,1,0,0,1,0,0,4294934528,0,600)

sVertex(9,1,6,2,1,0,0,4294934528,400,0)
sVertex(10,1,-1.5,2,1,0,0,4294934528,400,600)
sVertex(11,1,0,0,1,0,0,4294934528,200,600)

sVertex(12,-1,0,0,-1,0,0,4294934528,0,600)
sVertex(13,-1,4,2,-1,0,0,4294934528,0,200)
sVertex(14,-1,4,0,-1,0,0,4294934528,0,200)

for i=0 to 14
   write memblock float 1,(12+(36*i)),Vertices(i).Xpoz
   write memblock float 1,(16+(36*i)),Vertices(i).Ypoz
   write memblock float 1,(20+(36*i)),Vertices(i).Zpoz
   write memblock float 1,(24+(36*i)),Vertices(i).Xnor
   write memblock float 1,(28+(36*i)),Vertices(i).Ynor
   write memblock float 1,(32+(36*i)),Vertices(i).Znor
   write memblock dword 1,(36+(36*i)),Vertices(i).Diff
   write memblock float 1,(40+(36*i)),Vertices(i).Ucor
   write memblock float 1,(44+(36*i)),Vertices(i).Vcor
next i

make mesh from memblock 1,1
save mesh "hulkarmr.x",1
delete mesh 1
delete memblock 1
load object "hulkarmr.x",1

Framerate=timer()
repeat
   A$=inkey$()
   if timer()-Framerate >= 15
      yrotate object 1,object angle y(1)+2
      sync
   endif
until A$<>"" or escapekey()=1
delete object 1
delete file "hulkarmr.x"

function sVertex(index as integer,xp,yp,zp,xn,yn,zn,dif as dword,uc,vc)
   Vertices(index).Xpoz = xp
   Vertices(index).Ypoz = yp
   Vertices(index).Zpoz = zp
   Vertices(index).Xnor = xn
   Vertices(index).Ynor = yn
   Vertices(index).Znor = zn
   Vertices(index).Diff = dif
   Vertices(index).Ucor = uc
   Vertices(index).Vcor = vc
endfunction

sync on : sync rate 0

`Color array
dim col(8)
col(1) = rgb(255,0,0) : col(2) = rgb(0,255,0) : col(3) = rgb(0,0,255)
col(4) = rgb(255,255,0) : col(5) = rgb(0,255,255) : col(6) = rgb(255,0,255)
col(5) = rgb(255,255,255) : col(8) = 0

`Create objects
CreateColorBox(1, 5.0, col(1), col(2), col(3), col(4), col(5), col(6), col(7), col(8))
CreateColorBox(2, 10.0, col(8), col(7), col(6), col(5), col(4), col(3), col(2), col(1))
make object 1,1,0 : set object cull 1, 0 : set object light 1, 0
make object 2,2,0 : set object cull 2, 0 : set object light 2, 0
ghost object on 1

do

   `Reposition objects
   position object 1,0,0,0
   position object 2,0,0,0

   `Rotate objects
   rotate object 1, wrapvalue(object angle x(1) + 0.2), wrapvalue(object angle y(1) + 0.333), wrapvalue( object angle z(1) - 0.77)
   rotate object 2, wrapvalue(object angle x(2) + 0.4), wrapvalue(object angle y(1) + 0.8), wrapvalue( object angle z(1) + 0.2 )

   `reposition camera
   position camera 0,0,0

   sync
loop

function CreateColorBox(id, size#, col1, col2, col3, col4, col5, col6, col7, col8)

   `A cube has 6 sides. 1 side = 2 triangles and 1 triangle = 3 verteces. --> 6*2*3 = 36 verteces for the cube
   Verts = 36
   s# = size# / 2

   `Create the memblock
   make memblock id, 12 + (Verts*36)
   write memblock dword id, 0, 338
   write memblock dword id, 4, 36
   write memblock dword id, 8, Verts

   `Write verteces

   `Top face
   WriteVertPos(id, 1, s#,s#,s#) : WriteVertNormal(id, 1, s#, s#+0.1, s#)
   WriteVertPos(id, 2, s#,s#,-s#) : WriteVertNormal(id, 2, s#, s#+0.1, -s#)
   WriteVertPos(id, 3, -s#,s#,-s#) : WriteVertNormal(id, 3, -s#, s#+0.1, -s#)

   WriteVertPos(id, 4, -s#,s#,-s#) : WriteVertNormal(id, 4, -s#, s#+0.1,-s#)
   WriteVertPos(id, 5, -s#,s#,s#) : WriteVertNormal(id, 5, -s#, s#+0.1, s#)
   WriteVertPos(id, 6, s#,s#,s#) : WriteVertNormal(id, 6, s#, s#+0.1, s#)

   `Bottom face
   WriteVertPos(id, 9, s#,-s#,s#) : WriteVertNormal(id, 9, s#, -s#-0.1, s#)
   WriteVertPos(id, 8, s#,-s#,-s#) : WriteVertNormal(id, 8, s#, -s#-0.1, -s#)
   WriteVertPos(id, 7, -s#,-s#,-s#) : WriteVertNormal(id, 7, -s#, -s#-0.1, -s#)

   WriteVertPos(id, 12, -s#,-s#,-s#) : WriteVertNormal(id, 12, -s#, -s#-0.1,-s#)
   WriteVertPos(id, 11, -s#,-s#,s#) : WriteVertNormal(id, 11, -s#, -s#-0.1, s#)
   WriteVertPos(id, 10, s#,-s#,s#) : WriteVertNormal(id, 10, s#, -s#-0.1, s#)

   `Front face
   WriteVertPos(id, 13, -s#,s#,-s#) : WriteVertNormal(id, 13, -s#,s#,-s#-0.1)
   WriteVertPos(id, 14, s#,s#,-s#) : WriteVertNormal(id, 14, s#,s#,-s#-0.1)
   WriteVertPos(id, 15, s#,-s#,-s#) : WriteVertNormal(id, 15, s#,-s#,-s#-0.1)

   WriteVertPos(id, 16, s#,-s#,-s#) : WriteVertNormal(id, 16, s#,-s#,-s#-0.1)
   WriteVertPos(id, 17, -s#,-s#,-s#) : WriteVertNormal(id, 17, -s#,-s#,-s#-0.1)
   WriteVertPos(id, 18, -s#,s#,-s#) : WriteVertNormal(id, 18, -s#,s#,-s#-0.1)

   `Back face
   WriteVertPos(id, 21, -s#,s#,s#) : WriteVertNormal(id, 21, -s#,s#,s#+0.1)
   WriteVertPos(id, 20, s#,s#,s#) : WriteVertNormal(id, 20, s#,s#,s#+0.1)
   WriteVertPos(id, 19, s#,-s#,s#) : WriteVertNormal(id, 19, s#,-s#,s#+0.1)

   WriteVertPos(id, 24, s#,-s#,s#) : WriteVertNormal(id, 24, s#,-s#,s#+0.1)
   WriteVertPos(id, 23, -s#,-s#,s#) : WriteVertNormal(id, 23, -s#,-s#,s#+0.1)
   WriteVertPos(id, 22, -s#,s#,s#) : WriteVertNormal(id, 22, -s#,s#,s#+0.1)

   `Left face
   WriteVertPos(id, 25, -s#,s#,s#) : WriteVertNormal(id, 25, -s#-0.1,s#,s#)
   WriteVertPos(id, 26, -s#,s#,-s#) : WriteVertNormal(id, 26, -s#-0.1,s#,-s#)
   WriteVertPos(id, 27, -s#,-s#,-s#) : WriteVertNormal(id, 27, -s#-0.1,-s#,-s#)

   WriteVertPos(id, 28, -s#,-s#,-s#) : WriteVertNormal(id, 28, -s#-0.1,-s#,-s#)
   WriteVertPos(id, 29, -s#,-s#,s#) : WriteVertNormal(id, 29, -s#-0.1,-s#,s#)
   WriteVertPos(id, 30, -s#,s#,s#) : WriteVertNormal(id, 30, -s#-0.1,s#,s#)

   `Right face
   WriteVertPos(id, 33, s#,s#,s#) : WriteVertNormal(id, 33, s#+0.1,s#,s#)
   WriteVertPos(id, 32, s#,s#,-s#) : WriteVertNormal(id, 32, s#+0.1,s#,-s#)
   WriteVertPos(id, 31, s#,-s#,-s#) : WriteVertNormal(id, 31, s#+0.1,-s#,-s#)

   WriteVertPos(id, 36, s#,-s#,-s#) : WriteVertNormal(id, 36, s#+0.1,-s#,-s#)
   WriteVertPos(id, 35, s#,-s#,s#) : WriteVertNormal(id, 35, s#+0.1,-s#,s#)
   WriteVertPos(id, 34, s#,s#,s#) : WriteVertNormal(id, 34, s#+0.1,s#,s#)

   `Write colors
   `First color
   `s#, s#, s#
   WriteVertAlpha(id, 1, col1) : WriteVertAlpha(id, 6, col1)
   WriteVertAlpha(id, 20, col1) : WriteVertAlpha(id, 33, col1)
   WriteVertAlpha(id, 34, col1)

   `s#,s#,-s#
   WriteVertAlpha(id, 2, col2) : WriteVertAlpha(id, 14, col2)
   WriteVertAlpha(id, 32, col2)

   `-s#,s#,-s#
   WriteVertAlpha(id, 3, col3) : WriteVertAlpha(id, 4, col3)
   WriteVertAlpha(id, 13, col3) : WriteVertAlpha(id, 18, col3)
   WriteVertAlpha(id, 26, col3)

   `-s#,s#,s#
   WriteVertAlpha(id, 5, col4) : WriteVertAlpha(id, 21, col4)
   WriteVertAlpha(id, 22, col4) : WriteVertAlpha(id, 25, col4)
   WriteVertAlpha(id, 30, col4)

   `s#,-s#,s#
   WriteVertAlpha(id, 9, col5) : WriteVertAlpha(id, 10, col5)
   WriteVertAlpha(id, 19, col5) : WriteVertAlpha(id, 24, col5)
   WriteVertAlpha(id, 35, col5)

   `-s#,-s#,-s#
   WriteVertAlpha(id, 7, col6) : WriteVertAlpha(id, 12, col6)
   WriteVertAlpha(id, 17, col6) : WriteVertAlpha(id, 27, col6)
   WriteVertAlpha(id, 28, col6)

   `s#,-s#,-s#
   WriteVertAlpha(id, 8, col7) : WriteVertAlpha(id, 15, col7)
   WriteVertAlpha(id, 16, col7) : WriteVertAlpha(id, 31, col7)
   WriteVertAlpha(id, 36, col7)

   `-s#,-s#,s#
   WriteVertAlpha(id, 11, col8) : WriteVertAlpha(id, 23, col8)
   WriteVertAlpha(id, 29, col8)

   make mesh from memblock id, id

endfunction

function WriteVertPos(id, VertNr, x#, y#, z#)

   `calc position
   pos = 12 + ((VertNr-1)*36)

   `write
   write memblock float id, pos, x#
   write memblock float id, pos+4, y#
   write memblock float id, pos+8, z#

endfunction

function WriteVertNormal(id, VertNr, x#, y#, z#)

   `Calc potition
   pos = 24 + ((VertNr-1)*36)

   `Write
   write memblock float id, pos, x#
   write memblock float id, pos+4, y#
   write memblock float id, pos+8, z#

endfunction

function WriteVertAlpha(id, VertNr, color)

   `Calc position
   pos = 36 + ((VertNr-1)*36)

   `Write
   write memblock dword id, pos, color

endfunction

function WriteVertUV(id, VertNr, uvx#, uvy#)

   `Calc positon
   pos = 48 + ((VertNr-1)*36)

   `Write
   write memblock float id, pos, uvx#
   write memblock float id, pos+4, uvy#

endfunction

sync on : sync rate 0
hide mouse : disable escapekey

make memblock 1,2640
write memblock dword 1,0,338
write memblock dword 1,4,36
write memblock dword 1,8,72

type Vertex
   Xpoz as float
   Ypoz as float
   Zpoz as float
   Xnor as float
   Ynor as float
   Znor as float
   Diff as dword
   Ucor as float
   Vcor as float
endtype

global dim Vertices(72) as Vertex

` Set model vertex data
gosub make_limb_arm_right

make mesh from memblock 1,1
save mesh "hulkarmr.x",1
delete mesh 1
delete memblock 1
load object "hulkarmr.x",1

Framerate=timer()
repeat
   A$=inkey$()
   if timer()-Framerate >= 15
      yrotate object 1,object angle y(1)+2
      sync
   endif
until A$<>"" or escapekey()=1
delete object 1
delete file "hulkarmr.x"
end

function sVertex(index as integer,xp,yp#,zp,xn,yn,zn,dif as dword,uc,vc)
   Vertices(index).Xpoz = xp
   Vertices(index).Ypoz = yp#
   Vertices(index).Zpoz = zp
   Vertices(index).Xnor = xn
   Vertices(index).Ynor = yn
   Vertices(index).Znor = zn
   Vertices(index).Diff = dif
   Vertices(index).Ucor = uc
   Vertices(index).Vcor = vc
endfunction

make_limb_arm_right:
   sVertex(0,1,3.5,0,0,0,-1,4294934528,200,0)
   sVertex(1,-1,0,0,0,0,-1,4294934528,0,600)
   sVertex(2,-1,2.5,0,0,0,-1,4294934528,0,200)
   sVertex(3,1,3.5,0,0,0,-1,4294934528,200,0)
   sVertex(4,1,0,0,0,0,-1,4294934528,200,600)
   sVertex(5,-1,0,0,0,0,-1,4294934528,0,600)
   sVertex(6,1,3.5,0,1,0,0,4294934528,200,0)
   sVertex(7,1,3.5,2,1,0,0,4294934528,400,0)
   sVertex(8,1,0,0,1,0,0,4294934528,0,600)
   sVertex(9,1,3.5,2,1,0,0,4294934528,400,0)
   sVertex(10,1,-1,2,1,0,0,4294934528,400,600)
   sVertex(11,1,0,0,1,0,0,4294934528,200,600)
   sVertex(12,-1,0,0,-1,0,0,4294934528,0,600)
   sVertex(13,-1,2.5,2,-1,0,0,4294934528,0,200)
   sVertex(14,-1,2.5,0,-1,0,0,4294934528,0,200)
   sVertex(15,-1,2.5,2,-1,0,0,4294934528,0,200)
   sVertex(16,-1,0,0,-1,0,0,4294934528,0,600)
   sVertex(17,-1,-1,2,-1,0,0,4294934528,0,600)
   sVertex(18,1,3.5,2,-1,1,0,4294934528,400,0)
   sVertex(19,-1,2.5,0,-1,1,0,4294934528,0,200)
   sVertex(20,-1,2.5,2,-1,1,0,4294934528,0,200)
   sVertex(21,1,3.5,0,-1,1,0,4294934528,200,0)
   sVertex(22,-1,2.5,0,-1,1,0,4294934528,0,200)
   sVertex(23,1,3.5,2,-1,1,0,4294934528,400,0)
   sVertex(24,1,3.5,2,0,0,1,4294934528,400,0)
   sVertex(25,-1,2.5,2,0,0,1,4294934528,0,200)
   sVertex(26,1,-1,2,0,0,1,4294934528,0,600)
   sVertex(27,-1,2.5,2,0,0,1,4294934528,0,200)
   sVertex(28,-1,-1,2,0,0,1,4294934528,400,600)
   sVertex(29,1,-1,2,0,0,1,4294934528,0,600)
   sVertex(30,1,-1,2,0,0,1,4294934528,0,600)
   sVertex(31,-1,-1,2,0,0,1,4294934528,400,600)
   sVertex(32,0,-1.8,2,0,0,1,4294934528,200,1000)
   sVertex(33,-1,-1,2,-1,0,0,4294934528,0,600)
   sVertex(34,-1,0,0,-1,0,0,4294934528,0,600)
   sVertex(35,-1,0,-3,-1,0,0,4294934528,300,400)
   sVertex(36,-1,-1,2,-1,0,0,4294934528,0,600)
   sVertex(37,-1,0,-3,-1,0,0,4294934528,300,400)
   sVertex(38,-1,-1,-3,-1,0,0,4294934528,600,400)
   sVertex(39,1,-1,2,1,0,0,4294934528,0,600)
   sVertex(40,1,0,-3,1,0,0,4294934528,300,400)
   sVertex(41,1,0,0,1,0,0,4294934528,0,600)
   sVertex(42,1,-1,2,1,0,0,4294934528,0,600)
   sVertex(43,1,-1,-3,1,0,0,4294934528,600,400)
   sVertex(44,1,0,-3,1,0,0,4294934528,300,400)
   sVertex(45,-1,0,0,0,1,0,4294934528,0,600)
   sVertex(46,1,0,0,0,1,0,4294934528,0,600)
   sVertex(47,-1,0,-3,0,1,0,4294934528,300,400)
   sVertex(48,1,0,0,0,1,0,4294934528,0,600)
   sVertex(49,1,0,-3,0,1,0,4294934528,300,400)
   sVertex(50,-1,0,-3,0,1,0,4294934528,300,400)
   sVertex(51,-1,0,-3,0,0,-1,4294934528,300,400)
   sVertex(52,1,0,-3,0,0,-1,4294934528,300,400)
   sVertex(53,-1,-1,-3,0,0,-1,4294934528,600,400)
   sVertex(54,-1,-1,-3,0,0,-1,4294934528,600,400)
   sVertex(55,1,0,-3,0,0,-1,4294934528,300,400)
   sVertex(56,1,-1,-3,0,0,-1,4294934528,600,400)
   sVertex(57,-1,-1,-3,0,0,-1,4294934528,600,400)
   sVertex(58,1,-1,-3,0,0,-1,4294934528,600,400)
   sVertex(59,0,-2,-3,0,0,-1,4294934528,300,400)
   sVertex(60,-1,-1,2,-1,-1,0,4294934528,0,600)
   sVertex(61,-1,-1,-3,-1,-1,0,4294934528,400,600)
   sVertex(62,0,-1.8,2,-1,-1,0,4294934528,300,400)
   sVertex(63,0,-1.8,2,-1,-1,0,4294934528,300,400)
   sVertex(64,-1,-1,-3,-1,-1,0,4294934528,400,600)
   sVertex(65,0,-2,-3,-1,-1,0,4294934528,300,400)
   sVertex(66,1,-1,2,1,-1,0,4294934528,0,600)
   sVertex(67,0,-1.8,2,1,-1,0,4294934528,300,400)
   sVertex(68,1,-1,-3,1,-1,0,4294934528,400,600)
   sVertex(69,0,-1.8,2,1,-1,0,4294934528,300,400)
   sVertex(70,0,-2,-3,1,-1,0,4294934528,300,400)
   sVertex(71,1,-1,-3,1,-1,0,4294934528,400,600)
   for i=0 to 71
      write memblock float 1,(12+(36*i)),Vertices(i).Xpoz
      write memblock float 1,(16+(36*i)),Vertices(i).Ypoz
      write memblock float 1,(20+(36*i)),Vertices(i).Zpoz
      write memblock float 1,(24+(36*i)),Vertices(i).Xnor
      write memblock float 1,(28+(36*i)),Vertices(i).Ynor
      write memblock float 1,(32+(36*i)),Vertices(i).Znor
      write memblock dword 1,(36+(36*i)),Vertices(i).Diff
      write memblock float 1,(40+(36*i)),Vertices(i).Ucor
      write memblock float 1,(44+(36*i)),Vertices(i).Vcor
   next i
   return

randomize timer()
sync on
`sync rate 100
autocam off
hide mouse

REM INCLUDE THIS AT START OF YOUR PROGRAM
REM internal matrix data used by matrix functions
type matriks
   ix as integer
   iy as integer
   xsegs as integer
   zsegs as integer
   width as float
   depth as float
   mem_numb as integer
   obj as integer
   image as integer
   mesh as integer
   prepared as boolean
   x as float
   y as float
   z as float
   cull as integer
   light as integer
   specular as integer
endtype

REM INCLUDE THIS AT START OF YOUR PROGRAM
REM dim array size by maximum number of matrices you'll have
dim matrix(1) as matriks
mx = 128
mz = 128
sizex# = 4000
sizez# = 4000
REM must be called before you can create a matrix
prepare_matrix_data(1,1,1,1)
REM Make a new matrix
create_matrix(1,sizex#, sizez#,mx,mz)
REM prepare a texture for use with the matrix
`prepare_matrix_texture(1,1,1,1)

`load image "heightmap_01.bmp", 2

`set_matrix_from_heightmap(1,2,800.0)

`set_matrix_from_colormap(1,3)

randomize_matrix_faultformation(1, 15, 60, 40)
`randomize_matrix(1,200)

smooth_matrix(1,5)

`set_matrix_from_alphamap(1,4)

configure_matrix_normals(1)

set_matrix_light(1,1)

`set_matrix_specular(1,1)

`scale_matrix_texture(1,4,4)

REM update the matrix
update_matrix(1)

`set alpha mapping on 1, 100


set camera range 1, 65000


DO



   gosub camera_stuff


   text 2,2,str$(screen fps())

   if spacekey() and flag=0
      flag = 1
      if file exist("heightmap_01.bmp") then delete file "heightmap_01.bmp"
      save_heightmap(50, "heightmap_01.bmp", 1)
      `texture object 5,50
   endif

   if spacekey()=0 then flag=0




   sync
LOOP


REM ==========================================================================
REM Parameters:
REM image number
REM file name to save as
REM matrix number
function save_heightmap(img as integer, filename as string, mat as integer)
   highpt# = 0
   lowpt# = 0
   for x=0 to matrix(mat).xsegs
      for z=0 to matrix(mat).zsegs
         h# = get_matrix_height(mat,x,z)
         if h# > highpt# then highpt# = h#
         if h# < lowpt# then lowpt# = h#
      next z
   next x

   lowpt# = abs(lowpt#)

   mem = 200
   width = matrix(mat).xsegs+1
   height = matrix(mat).zsegs+1
   size = width*height*4 + 12
   make memblock mem, size
   write memblock dword mem, 0, width
   write memblock dword mem, 4, height
   write memblock dword mem, 8, 32

   for x=0 to matrix(mat).xsegs
      for z=0 to matrix(mat).zsegs
         h# = get_matrix_height(mat,x,z) + lowpt#
         color = (h# * 255) / highpt#
         location = (z*width + x)*4 + 12
         write memblock dword mem, location, rgb(color, color, color)
      next z
   next x

   make image from memblock img, mem
   save image filename, img

   delete memblock mem

endfunction


REM ==========================================================================
REM Parameters:
REM matrix number
REM object used to create matrix
REM memblock number used to create matrix
REM mesh number used to create object from memblock
function prepare_matrix_data(number as integer, object as integer, mb as integer, mesh as integer)
   matrix(number).obj = object
   matrix(number).mem_numb = mb
   matrix(number).mesh = mesh
endfunction


REM ==========================================================================
REM Parameters:
REM matrix number
REM number of image tiles across
REM number of image tiles down
function scale_matrix_texture(number as integer, across as integer, down as integer)
   matrix(number).ix = across
   matrix(number).iy = down
   matrix(number).prepared = 1

   tile = 1
   ln = 0
   for z = matrix(number).zsegs to 1 step -1
      for x = 1 to matrix(number).xsegs
         tl = ln*across + tile
         set_matrix_tile(number, x, z, tl)
         inc tile, 1
         if tile > across then tile = 1
      next x
      inc ln, 1
      if ln > down-1 then ln = 0
   next z
endfunction


REM ==========================================================================
REM Parameters:
REM matrix number
REM image number
REM number of image tiles across
REM number of image tiles down
function prepare_matrix_texture(number as integer, image as integer, across as integer, down as integer)
   matrix(number).ix = across
   matrix(number).iy = down
   matrix(number).image = image
   matrix(number).prepared = 1
   `texture object matrix(number).obj, matrix(number).image

   for z = 1 to matrix(number).zsegs
      for x = 1 to matrix(number).xsegs
         set_matrix_tile(number, x, z, 1)
      next x
   next z

endfunction


REM ==========================================================================
REM Parameters:
REM matrix number
REM width of matrix
REM depth of matrix
REM number of X segments
REM number of Z segments
function create_matrix(number as integer, width as float, depth as float, xsegs as integer, zsegs as integer)
   fvf = 338
   size = 36
   matrix(number).width = width
   matrix(number).depth = depth
   matrix(number).xsegs = xsegs
   matrix(number).zsegs = zsegs
   numb_verts = matrix(number).xsegs * matrix(number).zsegs * 6
   total_size = numb_verts*size + 12
   tile_size_x# = width/matrix(number).xsegs
   tile_size_z# = depth/matrix(number).zsegs
   mem_numb = matrix(number).mem_numb

   make memblock mem_numb, total_size
   write memblock dword mem_numb, 0, fvf
   write memblock dword mem_numb, 4, size
   write memblock dword mem_numb, 8, numb_verts

   tile = 0
   for z = 1 to zsegs
      for x = 1 to xsegs
         location = tile*size*6 + 12

         x1# = tile_size_x# * (x-1)
         y1# = 0
         z1# = tile_size_z# * (z-1)

         x2# = tile_size_x# * (x-1)
         y2# = 0
         z2# = tile_size_z# * z

         x3# = tile_size_x# * x
         y3# = 0
         z3# = tile_size_z# * z

         x4# = x1#
         y4# = y1#
         z4# = z1#

         x5# = x3#
         y5# = y3#
         z5# = z3#

         x6# = x3#
         y6# = 0
         z6# = z1#

         rem vert 1 - x,y,z, normals x,y,z, diffuse color
         write memblock float mem_numb, location, x1#
         write memblock float mem_numb, location+4, y1#
         write memblock float mem_numb, location+8, z1#
         write memblock float mem_numb, location+12, 0
         write memblock float mem_numb, location+16, 1
         write memblock float mem_numb, location+20, 0
         write memblock dword mem_numb, location+24, rgb(255,255,255)

         rem vert 2 - x,y,z
         temp_size = size
         write memblock float mem_numb, location+temp_size, x2#
         write memblock float mem_numb, location+temp_size+4, y2#
         write memblock float mem_numb, location+temp_size+8, z2#
         write memblock float mem_numb, location+temp_size+12, 0
         write memblock float mem_numb, location+temp_size+16, 1
         write memblock float mem_numb, location+temp_size+20, 0
         write memblock dword mem_numb, location+temp_size+24, rgb(255,255,255)

         rem vert 3 - x,y,z
         temp_size = size*2
         write memblock float mem_numb, location+temp_size, x3#
         write memblock float mem_numb, location+temp_size+4, y3#
         write memblock float mem_numb, location+temp_size+8, z3#
         write memblock float mem_numb, location+temp_size+12, 0
         write memblock float mem_numb, location+temp_size+16, 1
         write memblock float mem_numb, location+temp_size+20, 0
         write memblock dword mem_numb, location+temp_size+24, rgb(255,255,255)

         rem vert 4 - x,y,z
         temp_size = size*3
         write memblock float mem_numb, location+temp_size, x4#
         write memblock float mem_numb, location+temp_size+4, y4#
         write memblock float mem_numb, location+temp_size+8, z4#
         write memblock float mem_numb, location+temp_size+12, 0
         write memblock float mem_numb, location+temp_size+16, 1
         write memblock float mem_numb, location+temp_size+20, 0
         write memblock dword mem_numb, location+temp_size+24, rgb(255,255,255)

         rem vert 5 - x,y,z
         temp_size = size*4
         write memblock float mem_numb, location+temp_size, x5#
         write memblock float mem_numb, location+temp_size+4, y5#
         write memblock float mem_numb, location+temp_size+8, z5#
         write memblock float mem_numb, location+temp_size+12, 0
         write memblock float mem_numb, location+temp_size+16, 1
         write memblock float mem_numb, location+temp_size+20, 0
         write memblock dword mem_numb, location+temp_size+24, rgb(255,255,255)

         rem vert 6 - x,y,z
         temp_size = size*5
         write memblock float mem_numb, location+temp_size, x6#
         write memblock float mem_numb, location+temp_size+4, y6#
         write memblock float mem_numb, location+temp_size+8, z6#
         write memblock float mem_numb, location+temp_size+12, 0
         write memblock float mem_numb, location+temp_size+16, 1
         write memblock float mem_numb, location+temp_size+20, 0
         write memblock dword mem_numb, location+temp_size+24, rgb(255,255,255)

         inc tile, 1

      next x
   next z

   make mesh from memblock  1, mem_numb
   make object matrix(number).obj,1,0

endfunction


REM ==========================================================================
REM Parameters:
REM matrix number
REM tile X (grid-based coordinate)
REM tile Z (grid-based coordinate)
REM tile is an image tile number (from prepare_matrix_texture())
function set_matrix_tile(number as integer, tileX as integer, tileZ as integer, tile as integer)

   if tileX < 0 OR tileX > matrix(number).xsegs OR tileX < 0 OR tileZ > matrix(number).zsegs OR matrix(number).prepared = 0
      exitfunction
   endif

   if matrix(number).ix = 0 then matrix(number).ix = 1
   if matrix(number).iy = 0 then matrix(number).iy = 1


   mem_numb = matrix(number).mem_numb
   size = 36
   boffset = size*6

   location = 12 + ((tileZ-1)*matrix(number).xsegs*boffset + (tileX-1)*boffset)

   x_temp = wrap(tile, matrix(number).ix)

   mix# = matrix(number).ix
   x_max# = x_temp/mix#
   x_min# = (x_temp-1)/mix#

   y_temp = int((tile - x_temp) / mix#) + 1.0

   miy# = matrix(number).iy
   y_max# = y_temp/miy#
   y_min# = (y_temp-1)/miy#


   if y_min# > 0 then y_min# = y_min# + 0.01
   if x_min# > 0 then x_min# = x_min# + 0.01


   rem vert 1 - UV coordinates
   write memblock float mem_numb, location+28, x_min#
   write memblock float mem_numb, location+32, y_max#

   rem vert 2
   write memblock float mem_numb, location+64, x_min#
   write memblock float mem_numb, location+68, y_min#

   rem vert 3
   write memblock float mem_numb, location+100, x_max#
   write memblock float mem_numb, location+104, y_min#

   rem vert 4
   write memblock float mem_numb, location+136, x_min#
   write memblock float mem_numb, location+140, y_max#

   rem vert 5
   write memblock float mem_numb, location+172, x_max#
   write memblock float mem_numb, location+176, y_min#

   rem vert 6
   write memblock float mem_numb, location+208, x_max#
   write memblock float mem_numb, location+212, y_max#

endfunction


REM ==========================================================================
REM Parameters:
REM matrix number
REM tile X (grid-based coordinate)
REM tile Z (grid-based coordinate)
REM diffuse color

function set_matrix_diffuse(number as integer, tile_x as integer, tile_z as integer, color as dword)

   if tile_x < 0 OR tile_x > matrix(number).xsegs OR tile_z < 0 OR tile_z > matrix(number).zsegs
      exitfunction
   endif
   size = 36
   boffset = size*6
   numb_verts = matrix(number).xsegs * matrix(number).zsegs * 6
   total_size = numb_verts*size + 12
   tile_size_x# = width/matrix(number).xsegs
   tile_size_z# = height/matrix(number).zsegs
   mem_numb = matrix(number).mem_numb
   lensize = matrix(number).xsegs*boffset

   REM verts 3 and 5
   if tile_x > 0 and tile_z > 0
      gx = tile_x - 1
      gz = tile_z - 1
      location = gz*lensize + gx*boffset + 12
      write memblock dword mem_numb, location+96, color
      write memblock dword mem_numb, location+168, color
   endif

   REM vert 2
   if tile_z > 0 and tile_x < matrix(number).xsegs
      gx = tile_x
      gz = tile_z - 1
      location = gz*lensize + gx*boffset + 12
      write memblock dword mem_numb, location+60, color
   endif

   rem vert 6
   if tile_x > 0 and tile_z < matrix(number).zsegs
     gx = tile_x - 1
     gz = tile_z
     location = gz*lensize + gx*boffset + 12
     write memblock dword mem_numb, location+204, color
   endif

   rem verts 1 and 4
   if tile_x < matrix(number).xsegs and tile_z < matrix(number).zsegs
      gx = tile_x
      gz = tile_z
      location = gz*lensize + gx*boffset + 12
      write memblock dword mem_numb, location+24, color
      write memblock dword mem_numb, location+132, color
   endif

endfunction


REM ==========================================================================
REM Parameters:
REM matrix number
REM tile X (grid-based coordinate)
REM tile Z (grid-based coordinate)
REM alpha value
function set_matrix_alpha(number as integer, tile_x as integer, tile_z as integer, alpha as integer)

   if tile_x < 0 OR tile_x > matrix(number).xsegs OR tile_z < 0 OR tile_z > matrix(number).zsegs
      exitfunction
   endif
   size = 36
   boffset = size*6
   numb_verts = matrix(number).xsegs * matrix(number).zsegs * 6
   total_size = numb_verts*size + 12
   tile_size_x# = width/matrix(number).xsegs
   tile_size_z# = height/matrix(number).zsegs
   mem_numb = matrix(number).mem_numb
   lensize = matrix(number).xsegs*boffset

   REM verts 3 and 5
   if tile_x > 0 and tile_z > 0
      gx = tile_x - 1
      gz = tile_z - 1
      location = gz*lensize + gx*boffset + 12
      write memblock dword mem_numb, location+99, alpha
      write memblock dword mem_numb, location+171, alpha
   endif

   REM vert 2
   if tile_z > 0 and tile_x < matrix(number).xsegs
      gx = tile_x
      gz = tile_z - 1
      location = gz*lensize + gx*boffset + 12
      write memblock dword mem_numb, location+63, alpha
   endif

   rem vert 6
   if tile_x > 0 and tile_z < matrix(number).zsegs
     gx = tile_x - 1
     gz = tile_z
     location = gz*lensize + gx*boffset + 12
     write memblock dword mem_numb, location+207, alpha
   endif

   rem verts 1 and 4
   if tile_x < matrix(number).xsegs and tile_z < matrix(number).zsegs
      gx = tile_x
      gz = tile_z
      location = gz*lensize + gx*boffset + 12
      write memblock dword mem_numb, location+27, alpha
      write memblock dword mem_numb, location+135, alpha
   endif
endfunction


REM ==========================================================================
REM Parameters:
REM matrix number
REM tile X (grid-based coordinate)
REM tile Z (grid-based coordinate)
REM height (height of tile you're setting)

function set_matrix_height(number as integer, tile_x as integer, tile_z as integer, height# as float)

   if tile_x < 0 OR tile_x > matrix(number).xsegs OR tile_z < 0 OR tile_z > matrix(number).zsegs
      exitfunction
   endif

   size = 36
   boffset = size*6
   numb_verts = matrix(number).xsegs * matrix(number).zsegs * 6
   total_size = numb_verts*size + 12
   tile_size_x# = width/matrix(number).xsegs
   tile_size_z# = height/matrix(number).zsegs
   mem_numb = matrix(number).mem_numb
   lensize = matrix(number).xsegs*boffset

   REM verts 3 and 5
   if tile_x > 0 and tile_z > 0
      gx = tile_x - 1
      gz = tile_z - 1
      location = gz*lensize + gx*boffset + 12
      write memblock float mem_numb, location+76, height#
      write memblock float mem_numb, location+148, height#
   endif

   REM vert 2
   if tile_z > 0 and tile_x < matrix(number).xsegs
      gx = tile_x
      gz = tile_z - 1
      location = gz*lensize + gx*boffset + 12
      write memblock float mem_numb, location+40, height#
   endif

   rem vert 6
   if tile_x > 0 and tile_z < matrix(number).zsegs
   `and tile_z < matrix(number).zsegs
     gx = tile_x - 1
     gz = tile_z
     location = gz*lensize + gx*boffset + 12
     write memblock float mem_numb, location+184, height#
   endif

   rem verts 1 and 4
   if tile_x < matrix(number).xsegs and tile_z < matrix(number).zsegs
      gx = tile_x
      gz = tile_z
      location = gz*lensize + gx*boffset + 12
      write memblock float mem_numb, location+4, height#
      write memblock float mem_numb, location+112, height#
   endif

endfunction


REM ==========================================================================
REM Parameters:
REM matrix number
REM tile X (grid-based coordinate)
REM tile Z (grid-based coordinate)
REM nx,ny,nz - normal
function set_matrix_normal(number as integer, tile_x as integer, tile_z as integer, nx as float, ny as float, nz as float)

   if tile_x < 0 OR tile_x > matrix(number).xsegs OR tile_z < 0 OR tile_z > matrix(number).zsegs
      exitfunction
   endif
   size = 36
   boffset = size*6
   numb_verts = matrix(number).xsegs * matrix(number).zsegs * 6
   total_size = numb_verts*size + 12
   tile_size_x# = width/matrix(number).xsegs
   tile_size_z# = height/matrix(number).zsegs
   mem_numb = matrix(number).mem_numb
   lensize = matrix(number).xsegs*boffset

   REM verts 3 and 5
   if tile_x > 0 and tile_z > 0
      gx = tile_x - 1
      gz = tile_z - 1
      location = gz*lensize + gx*boffset + 12
      write memblock float mem_numb, location+84, nx
      write memblock float mem_numb, location+88, ny
      write memblock float mem_numb, location+92, nz

      write memblock float mem_numb, location+156, nx
      write memblock float mem_numb, location+160, ny
      write memblock float mem_numb, location+164, nz
   endif

   REM vert 2
   if tile_z > 0 and tile_x < matrix(number).xsegs
      gx = tile_x
      gz = tile_z - 1
      location = gz*lensize + gx*boffset + 12
      write memblock float mem_numb, location+48, nx
      write memblock float mem_numb, location+52, ny
      write memblock float mem_numb, location+56, nz
   endif

   rem vert 6
   if tile_x > 0 and tile_z < matrix(number).zsegs
      gx = tile_x - 1
      gz = tile_z
      location = gz*lensize + gx*boffset + 12
      write memblock float mem_numb, location+192, nx
      write memblock float mem_numb, location+196, ny
      write memblock float mem_numb, location+200, nz
   endif

   rem verts 1 and 4
   if tile_x < matrix(number).xsegs and tile_z < matrix(number).zsegs
      gx = tile_x
      gz = tile_z
      location = gz*lensize + gx*boffset + 12
      write memblock float mem_numb, location+12, nx
      write memblock float mem_numb, location+16, ny
      write memblock float mem_numb, location+20, nz

      write memblock float mem_numb, location+120, nx
      write memblock float mem_numb, location+124, ny
      write memblock float mem_numb, location+128, nz
   endif
endfunction


REM ==========================================================================
REM Parameters:
REM matrix number
REM X coordinate
REM Z coordinate
function get_ground_height(number as integer, x#, z#)

  `h# = intersect object(matrix(number).obj,x#,0,z#,x#,10000,z#)
  `exitfunction h#

  tileSizeX# = matrix(number).width / matrix(number).xsegs
  tileSizeZ# = matrix(number).depth / matrix(number).zsegs

  row = z# / tileSizeZ#
  column = x# / tileSizeX#

  if row < 0 OR row >= matrix(number).xsegs OR column < 0 or column >= matrix(number).zsegs
      exitfunction 0.0
  endif

  tile=row*matrix(number).xsegs+column
  znorm#=z#-row*tileSizeZ#
  xnorm#=x#-column*tileSizeX#

  rem get the right triangle
  if tileSizeZ#*xnorm#>=tileSizeX#*znorm#
    location=12+tile*216+112
    y1#=memblock float(matrix(number).mem_numb,location)
    y2#=memblock float(matrix(number).mem_numb,location+36)
    y3#=memblock float(matrix(number).mem_numb,location+72)
    y#=y1#+(znorm#/tileSizeZ#)*(y2#-y3#)+(xnorm#/tileSizeX#)*(y3#-y1#)
  else
    location=12+tile*216+4
    y1#=memblock float(matrix(number).mem_numb,location)
    y2#=memblock float(matrix(number).mem_numb,location+36)
    y3#=memblock float(matrix(number).mem_numb,location+72)
    y#=y1#+(znorm#/tileSizeZ#)*(y2#-y1#)+(xnorm#/tileSizeX#)*(y3#-y2#)
  endif

endfunction y#




REM ==========================================================================
REM Parameters:
REM matrix number
REM tile X (grid-based coordinate)
REM tile Z (grid-based coordinate)
function get_matrix_height(number as integer, tile_x as integer, tile_z as integer)
   if tile_x < 0 OR tile_x > matrix(number).xsegs OR tile_z < 0 OR tile_z > matrix(number).zsegs
      exitfunction
   endif

   size = 36
   boffset = size*6
   numb_verts = matrix(number).xsegs * matrix(number).zsegs * 6
   total_size = numb_verts*size + 12
   tile_size_x# = width/matrix(number).xsegs
   tile_size_z# = height/matrix(number).zsegs
   mem_numb = matrix(number).mem_numb
   lensize = matrix(number).xsegs*boffset

   if tile_x < matrix(number).xsegs and tile_z < matrix(number).zsegs
      location = tile_z*lensize + tile_x*boffset + 12
      yheight# = memblock float (mem_numb, location+4)
   else
      if tile_x = matrix(number).xsegs
         if tile_z = matrix(number).zsegs
            location = (tile_z-1)*lensize + (tile_x-1)*boffset + 12
            yheight# = memblock float (mem_numb, location+76)
         else
            location = (tile_z)*lensize + (tile_x-1)*boffset + 12
            yheight# = memblock float (mem_numb, location+184)
         endif
      else
         location = (tile_z-1)*lensize + (tile_x)*boffset + 12
         yheight# = memblock float (mem_numb, location+40)
      endif
   endif

endfunction yheight#



REM ==========================================================================
REM Parameters:
REM matrix number
REM image number
REM maximum height
function set_matrix_from_heightmap(number as integer, img as integer, max as float)
   make memblock from image 256, img
   width# = memblock dword(256, 0)
   height# = memblock dword(256, 4)

   ox# = width#/(matrix(number).xsegs+1)
   oz# = height#/(matrix(number).zsegs+1)

   for z = 0 to matrix(number).zsegs
      for x = 0 to matrix(number).xsegs
         location = (int(z*oz#)*width# + int(x*ox#))*4 + 12
         c = memblock byte(256, location)
         rem convert color value into height value
         h# = (c*max)/255.0
         set_matrix_height(number,x,z,h#)
      next x
   next z

   delete memblock 256
endfunction


REM ==========================================================================
REM Parameters:
REM matrix number
REM image number
function set_matrix_from_colormap(number as integer, img as integer)
   make memblock from image 256, img
   width# = memblock dword(256, 0)
   height# = memblock dword(256, 4)

   ox# = width#/(matrix(number).xsegs+1)
   oz# = height#/(matrix(number).zsegs+1)

   for z = 0 to matrix(number).zsegs
      for x = 0 to matrix(number).xsegs
         location = (int(z*oz#)*width# + int(x*ox#))*4 + 12
         b = memblock byte(256, location)
         g = memblock byte(256, location+1)
         r = memblock byte(256, location+2)
         c = rgb(r,g,b)
         set_matrix_diffuse(number,x,z,c)
      next x
   next z

   delete memblock 256
endfunction


REM ==========================================================================
REM Parameters:
REM matrix number
REM image number
function set_matrix_from_alphamap(number as integer, img as integer)
   make memblock from image 256, img
   width# = memblock dword(256, 0)
   height# = memblock dword(256, 4)

   ox# = width#/(matrix(number).xsegs+1)
   oz# = height#/(matrix(number).zsegs+1)

   for z = 0 to matrix(number).zsegs
      for x = 0 to matrix(number).xsegs
         location = (int(z*oz#)*width# + int(x*ox#))*4 + 12
         a = memblock byte(256, location+3)
         set_matrix_alpha(number,x,z,a)
      next x
   next z

   delete memblock 256
endfunction


REM ==========================================================================
REM Parameters:
REM X,Y,Z coordinates
function position_matrix(number as integer, x as float, y as float, z as float)
   matrix(number).x = x
   matrix(number).y = y
   matrix(number).z = z
   position object matrix(number).obj, x, y, z
endfunction


REM ==========================================================================
REM Parameters:
REM matrix number
function update_matrix(number as integer)
   change mesh from memblock matrix(number).mesh, matrix(number).mem_numb
   delete object matrix(number).obj
   make object matrix(number).obj, matrix(number).mesh, matrix(number).image
   set object cull matrix(number).obj, matrix(number).cull
   set object light matrix(number).obj, matrix(number).light
   set object specular matrix(number).obj, matrix(number).specular
   position object matrix(number).obj, matrix(number).x, matrix(number).y, matrix(number).z
   if matrix(number).prepared = 0
      set object wireframe matrix(number).obj, 1
   endif
endfunction


REM ==========================================================================
REM Parameters:
REM matrix number
REM flag, on or off
function set_matrix_cull(number as integer, flag as integer)
   matrix(number).cull = flag
   set object cull matrix(number).obj, flag
endfunction


REM ==========================================================================
REM Parameters:
REM matrix number
REM flag, on or off
function set_matrix_light(number as integer, flag as integer)
   matrix(number).light = flag
   set object light matrix(number).obj, flag
endfunction


REM ==========================================================================
REM Parameters:
REM matrix number
REM flag, on or off
function set_matrix_specular(number as integer, flag as integer)
   matrix(number).specular = flag
   set object specular matrix(number).obj, flag
endfunction



remstart
REM ==========================================================================
REM Coded by Dr. DB himself, Lee Bamber
REM Parameters:
REM matrix number
function configure_matrix_normals(number as integer)
   for z=1 to matrix(number).zsegs-1
      for x=1 to matrix(number).xsegs-1

         rem Get matrix heights
         h8#=get_matrix_height(number,x,z-1)
         h4#=get_matrix_height(number,x-1,z)
         h#=get_matrix_height(number,x,z)
         h2#=get_matrix_height(number,x,z)

         rem Calculate projected angle X using heights
         x1#=(x-1)*25.0 : y1#=h#
         x2#=(x+0)*25.0 : y2#=h4#
         dx#=x2#-x1#
         dy#=y2#-y1#
         ax#=atanfull(dx#,dy#)
         ax#=wrapvalue(90-ax#)

         rem Calculate projected angle Z using heights
         z1#=(z-1)*25.0 : y1#=h2#
         z2#=(z+0)*25.0 : y2#=h8#
         dz#=z2#-z1#
         dy#=y2#-y1#
         az#=atanfull(dz#,dy#)
         az#=wrapvalue(90-az#)

         rem Make normal from projected angle
         nx#=sin(ax#)
         ny#=cos(ax#)
         nz#=sin(az#)

         rem Setting matrix normal for smoothness
         set_matrix_normal(number,x,z,nx#,ny#,nz#)
      next x
   next z
endfunction
remend



function configure_matrix_normals(number as integer)
   size = 36
   boffset = size*6
   mem = matrix(number).mem_numb
   lensize = matrix(number).xsegs*boffset

   p1 = 1
   p2 = 2
   p3 = 3
   p4 = 4
   p5 = 5
   p6 = 6
   av1 = 7
   bv1 = 8
   av2 = 9
   bv2 = 10
   n1 = 11
   n2 = 12

   null = make vector3(p1)
   null = make vector3(p2)
   null = make vector3(p3)
   null = make vector3(p4)
   null = make vector3(p5)
   null = make vector3(p6)
   null = make vector3(av1)
   null = make vector3(bv1)
   null = make vector3(av2)
   null = make vector3(bv2)
   null = make vector3(n1)
   null = make vector3(n2)


   for z=0 to matrix(number).zsegs-1
      for x=0 to matrix(number).xsegs-1
         location = z*lensize + x*boffset + 12
         set vector3 p1,memblock float(mem,location),memblock float(mem,location+4),memblock float(mem,location+8)
         set vector3 p2,memblock float(mem,location+36),memblock float(mem,location+40),memblock float(mem,location+44)
         set vector3 p3,memblock float(mem,location+72),memblock float(mem,location+76),memblock float(mem,location+80)
         set vector3 p4,memblock float(mem,location+108),memblock float(mem,location+112),memblock float(mem,location+116)
         set vector3 p5,memblock float(mem,location+144),memblock float(mem,location+148),memblock float(mem,location+152)
         set vector3 p6,memblock float(mem,location+180),memblock float(mem,location+184),memblock float(mem,location+188)

         subtract vector3 av1,p2,p1
         subtract vector3 bv1,p3,p2
         subtract vector3 av2,p5,p4
         subtract vector3 bv2,p6,p5

         cross product vector3 n1,av1,bv1
         cross product vector3 n2,av2,bv2

         normalize vector3 n1,n1
         normalize vector3 n2,n2

         rem vert 1
         write memblock float mem, location+12, x vector3(n1)
         write memblock float mem, location+16, y vector3(n1)
         write memblock float mem, location+20, z vector3(n1)
         rem vert 2
         write memblock float mem, location+48, x vector3(n1)
         write memblock float mem, location+52, y vector3(n1)
         write memblock float mem, location+56, z vector3(n1)
         rem vert 3
         write memblock float mem, location+84, x vector3(n1)
         write memblock float mem, location+88, y vector3(n1)
         write memblock float mem, location+92, z vector3(n1)
         rem vert 4
         write memblock float mem, location+120, x vector3(n2)
         write memblock float mem, location+124, y vector3(n2)
         write memblock float mem, location+128, z vector3(n2)
         rem vert 5
         write memblock float mem, location+156, x vector3(n2)
         write memblock float mem, location+160, y vector3(n2)
         write memblock float mem, location+164, z vector3(n2)
         rem vert 6
         write memblock float mem, location+192, x vector3(n2)
         write memblock float mem, location+196, y vector3(n2)
         write memblock float mem, location+200, z vector3(n2)
      next x
   next z

endfunction





REM ==========================================================================
REM Parameters:
REM matrix number
REM number of iterations
REM add amount
REM subtract amount
function randomize_matrix_faultformation(number as integer, iter as integer, h1# as float, h2# as float)

   tsx# = matrix(number).width / matrix(number).xsegs
   tsz# = matrix(number).depth / matrix(number).zsegs
   for t = 1 to iter
      rx1# = rnd(matrix(number).width)
      rz1# = rnd(matrix(number).depth)
      rx2# = rnd(matrix(number).width)
      rz2# = rnd(matrix(number).depth)


      for z = 0 to matrix(number).zsegs
         for x = 0 to matrix(number).xsegs

            px# = x * tsx#
            pz# = z * tsz#

            h# = get_matrix_height(number,x,z)

            if point_line(px#,pz#,rx1#,rz1#,rx2#,rz2#) >= 0
               set_matrix_height(number,x,z,h#+h1#)
            else
               set_matrix_height(number,x,z,h#-h2#)
            endif
         next x
      next z

   next t

endfunction



REM ==========================================================================
REM Parameters:
REM matrix number
REM number of iterations
function smooth_matrix(number as integer, iter as integer)

   dim heights#(matrix(number).xsegs,matrix(number).zsegs)



   for t = 1 to iter
      rem store original heights
      for z = 0 to matrix(number).zsegs
         for x = 0 to matrix(number).xsegs
            heights#(x,z) = get_matrix_height(number,x,z)
         next x
      next z

      for z = 0 to matrix(number).zsegs
         for x = 0 to matrix(number).xsegs
            count = 0
            h1# = 0
            h2# = 0
            h3# = 0
            h4# = 0
            h5# = 0
            h6# = 0
            h7# = 0
            h8# = 0

           if z < matrix(number).zsegs
               if x > 0 then h1# = heights#(x-1,z+1) : inc count
               h2# = heights#(x,z+1) : inc count
               if x < matrix(number).xsegs then h3# = heights#(x+1,z+1) : inc count
            endif

            if x > 0 then h4# = heights#(x-1,z) : inc count
            if x < matrix(number).xsegs then h5# = heights#(x+1,z) : inc count

            if z > 0
               if x > 0 then h6# = heights#(x-1,z-1) : inc count
               h7# = heights#(x,z-1) : inc count
               if x < matrix(number).xsegs then h8# = heights#(x+1,z-1) : inc count
            endif

            avg# = (h1#+h2#+h3#+h4#+h5#+h6#+h7#+h8#) / count

            set_matrix_height(number,x,z,avg#)

         next x
      next z
   next t

   rem delete array
   undim heights#()

endfunction



REM ==========================================================================
REM Parameters:
REM matrix number
REM max height
function randomize_matrix(number as integer, height as float)
   for z = 0 to matrix(number).zsegs
      for x = 0 to matrix(number).xsegs
         set_matrix_height(number, x, z, rnd(height*100.0)/100.0)
      next x
   next z
endfunction


REM ==========================================================================
REM Parameters:
REM matrix number
REM X,Y screen coordinates
REM vector number to store results in
function pick_matrix(number as integer, x as integer, y as integer, vector as integer)
   if matrix(number).obj = 0 then exitfunction

   t = pick object(x,y,matrix(number).obj,matrix(number).obj)
   vx# = camera position X()+get pick vector x()
   vy# = camera position y()+get pick vector y()
   vz# = camera position z()+get pick vector z()
   set vector3 vector, vx#, vy#, vz#
endfunction


REM wrapvalue function
REM Wraps n1# to n2#
function wrap(n1#,n2#)

   while (n1# > n2#)
      n1# = n1# - n2#
   endwhile

endfunction n1#



REM if point(px,py) is right or left of line segment (x1,y1),(x2,y2)
REM return negative if left, positive if right, 0 if on
function point_line(px#,py#, x1#,y1#,x2#,y2#)
   dp# = (x2# - x1#) * (py# - y1#) - (px# - x1#) * (y2# - y1#)
endfunction dp#



camera_stuff:
  oldcx#=cx#
  oldcz#=cz#
  speed# = 5

  if shiftkey() then speed# = 10
  if upkey()=1
    cx#=newxvalue(cx#,a#,speed#)
    cz#=newzvalue(cz#,a#,speed#)
  endif
  if downkey()=1
    cx#=newxvalue(cx#,a#,-speed#)
    cz#=newzvalue(cz#,a#,-speed#)
  endif
  if leftkey()=1
    cx#=newxvalue(cx#,wrapvalue(a#-90.0),speed#)
    cz#=newzvalue(cz#,wrapvalue(a#-90.0),speed#)
  endif
  if rightkey()=1
    cx#=newxvalue(cx#,wrapvalue(a#+90.0),speed#)
    cz#=newzvalue(cz#,wrapvalue(a#+90.0),speed#)
  endif

   `if shiftkey() then inc cy#, 2
   `if controlkey() then dec cy#, 2

  a#=wrapvalue(a#+(mousemovex()/3.0))
  cxa#=cxa#+(mousemovey()/3.0)
  if cxa#<-90.0 then cxa#=-90.0
  if cxa#>90.0 then cxa#=90.0
  cy# = get_ground_height(1,cx#,cz#)
  position camera cx#,cy#+50,cz#
  rotate camera wrapvalue(cxa#),a#,0
RETURN

screenwidth = 800
screenheight = 600

set display mode screenwidth,screenheight,32

for x = 1 to 128
   for y = 1 to 128
      ink rgb(rnd(255),rnd(255),rnd(255)),0
      dot x, y
   next y
next x

get image 1,1,1,128,128,1

cls

c = 255
for x = 1 to 128
   ink rgb(c,c,c),0
   circle 64,64,x/2
   dec c, 2
   if c < 0 then c = 0
next x

get image 2,1,1,128,128,1


make memblock from image 1,1
make memblock from image 2,2
make memblock from image 3,1

width = memblock dword(1, 0)
height = memblock dword(1, 4)
width2 = memblock dword(2, 0)
height2 = memblock dword(2, 4)

sync on
sync rate 60
autocam off
backdrop on

position camera 0,0,0

for x=1 to width
   for y=1 to height
      location = ((y-1)*width + x - 1) * 4 + 12
      write memblock dword 3, location, rgb(0,0,0)
   next y
next x

sx = 100
sy = 100
ax = 1
ay = 1
do

   inc sx,ax
   inc sy,ay

   if sx > screenwidth-width or sx < 0 then ax=-ax
   if sy > screenheight-height or sy < 0 then ay=-ay



   fx = mousex()
   fy = mousey()

   w = width2/-2
   h = height2/-2

   for x = 1 to width2
      for y = 1 to height2
         x2 = fx + w + x
         y2 = fy + h + y
         if x2 > sx and x2 <= sx+width and y2 > sy and y2 <= sy+height
            location = ((y-1)*width2 + x - 1) * 4 + 12
            b = memblock byte(2,location)
            g = memblock byte(2,location+1)
            r = memblock byte(2,location+2)
            location = ((y2-(sy+1))*width + (x2-sx) - 1) * 4 + 12
            b = (memblock byte(1, location) * b) / 255
            g = (memblock byte(1, location+1) * g) / 255
            r = (memblock byte(1, location+2) * r) / 255
            write memblock dword 3, location, rgb(r,g,b)
         endif
      next y
   next x
   make image from memblock 3, 3

   sprite 1,sx,sy,3


   set cursor 0,0
   print screen fps()

   sync
loop



function create_shadowed_image(texture as integer, light as integer, destination as integer )
   make memblock from image 255, texture
   make memblock from image 256, light
   make memblock from image 257, light
   width as dword
   height as dword
   width = memblock dword(255, 0)
   height = memblock dword(255, 4)

   for x = 1 to width
      for y = 1 to height
         location = ((y-1)*width + x - 1)*4 + 12
         b = (memblock byte(255,location) * memblock byte(256,location)) / 255
         g = (memblock byte(255,location+1) * memblock byte(256,location+1)) / 255
         r = (memblock byte(255,location+2) * memblock byte(256,location+2)) / 255
         write memblock dword 257, location, rgb(r,g,b)
      next y
   next x

   rem image number, memblock number
   make image from memblock destination, 257

   delete memblock 255
   delete memblock 256
   delete memblock 257

endfunction

get image 1,1,1,128,128,1

cls

rem image to overlay
for x = 1 to 16
   ink rgb(rnd(155)+100,100,100),0
   circle 8,8,x/2
next x

get image 5,1,1,16,16,1


make memblock from image 2, 5

make memblock from image 1, 1

width as dword
height as dword
depth as dword
GLOBAL width
width = memblock dword(1,0)
height = memblock dword(1,4)
depth = memblock dword(1,8)

size = get memblock size(1)



width2 as dword
height2 as dword
depth2 as dword
GLOBAL width2
width2 = memblock dword(2,0)
height2 = memblock dword(2,4)
depth2 = memblock dword(2,8)
size2 = get memblock size(2)

make image from memblock 2, 1

sync on
autocam off
backdrop on

position camera 0,0,0

make object plain 1, 128,128
position object 1, -50,0,400
texture object 1, 1


make object plain 2, 128,128
position object 2, 100,0,400
texture object 2,1


DO

   if mouseclick()=1 and click = 0
      click = 1
      fx = mousex()/(screenwidth/width) + 1
      fy = mousey()/(screenheight/height) + 1

      location = gridToSingle(fx, fy)* 4 + 12
      w = width2/2
      for x = 1 to width2
         for y = 1 to height2
            location = gridToSingle2(x,y)*4 + 12
            b = memblock byte(2,location)
            g = memblock byte(2,location+1)
            r = memblock byte(2,location+2)

            if fx-(x-w) >= 1 and fx-(x-w) <= width and fy-(y-w) >= 1 and fy-(y-w) <= height
               if r<>0 and g<>0 and b<>0
                  location = gridToSingle(fx-(x-w), fy-(y-w))*4 + 12
                  write memblock dword 1, location, rgb(r,g,b)
               endif
            endif
         next y
      next x

      make image from memblock 1,1

   endif

   if mouseclick()=0 then click = 0



   if mouseclick()=2
      fx = mousex()/8 + 1
      fy = mousey()/6 + 1
      location = gridToSingle(fx, fy)* 4 + 12

      write memblock dword 1, location, rgb(125,150,0)
      make image from memblock 1, 1
   endif



   if spacekey() and key = 0
      key = 1
      inc blue

      for x = 1 to 200
         for y = 1 to 200
            location = gridToSingle(x,y)*4 + 12
            b = memblock byte(1,location)*1.1
            g = memblock byte(1,location+1)*1.1
            r = memblock byte(1,location+2)*1.1

            if b > 255 then b = 255
            if g > 255 then g = 255
            if r > 255 then r = 255



            `write memblock byte 1, location, blue
            write memblock dword 1, location, rgb(r,g,b)

         next y
      next x
      make image from memblock 1, 1
   endif

   if spacekey()=0 then key = 0


   if shiftkey() and key2 = 0
      key2 = 1
      for x = 1 to 200
         for y = 1 to 200
            location = gridToSingle(x,y)*4 + 12
            b = memblock byte(1,location)*0.9
            g = memblock byte(1,location+1)*0.9
            r = memblock byte(1,location+2)*0.9

            if b < 0 then b = 0
            if g < 0 then g = 0
            if r < 0 then r = 0

            write memblock dword 1, location, rgb(r,g,b)

         next y
      next x
      make image from memblock 1, 1
   endif

   if shiftkey()=0 then key2 = 0



   a# = wrapvalue(a#+0.1)
   zrotate object 2, a#


   set cursor 0,0
   print "FPS: ",screen fps()


sync
LOOP


function gridToSingle(x as integer, y as integer)
   thing = (y-1)*width + x - 1
endfunction thing

function gridToSingle2(x as integer, y as integer)
   thing = (y-1)*width2 + x - 1
endfunction thing

screenwidth = 800
screenheight = 600

set display mode screenwidth,screenheight,32

box 1,1,128,128,rgb(rnd(255),rnd(255),rnd(255)),rgb(rnd(255),rnd(255),rnd(255)),rgb(rnd(255),rnd(255),rnd(255)),rgb(rnd(255),rnd(255),rnd(255))

get image 1,1,1,128,128,1


make memblock from image 1, 1

width as dword
height as dword
depth as dword
GLOBAL width
width = memblock dword(1,0)
height = memblock dword(1,4)
depth = memblock dword(1,8)

size = get memblock size(1)

make image from memblock 2, 1

sync on
autocam off
backdrop on

position camera 0,0,0

make object plain 1, 100,100
position object 1, -50,0,400
texture object 1, 1

make image from memblock 2, 1

make object plain 2, 100,100
position object 2, 100,0,400
texture object 2,2

set object 1,1,1,0


make object cube 5,50
position object 5,-50,0,450




DO

   if mouseclick()=1
      fx = mousex()/(screenwidth/width) + 1
      fy = mousey()/(screenheight/height) + 1
      for x = -3 to 3
         ifx = fx + x
         for y = -3 to 3
            ify = fy + y
            if ifx >= 1 and ifx <= width and ify >= 1 and ify <= height
               location = gridToSingle(ifx, ify)* 4 + 12
               `write memblock dword 1, location, rgb(0,255,0)
               write memblock byte 1, location+3,0
               make image from memblock 1, 1
            endif
         next y
      next x
   endif

   if mouseclick()=2
      fx = mousex()/(screenwidth/width) + 1
      fy = mousey()/(screenheight/height) + 1
      for x = -3 to 3
         ifx = fx + x
         for y = -3 to 3
            ify = fy + y
            if ifx >= 1 and ifx <= width and ify >= 1 and ify <= height
               location = gridToSingle(ifx, ify)* 4 + 12
               write memblock dword 1, location, rgb(0,255,0)
               `write memblock byte 1, location+3,0
               make image from memblock 1, 1
            endif
         next y
      next x
   endif


   a# = wrapvalue(a#+0.5)
   rotate object 5,a#,a#,a#

   set cursor 0,0
   print screen fps()

   sync
LOOP




function gridToSingle(x as integer, y as integer)
   thing = (y-1)*width + x - 1
endfunction thing

` DBPro Image Altering Example/Functions - kenmo, 05.21.2004

yourimage$="c:\your_image.jpg"
cls : hide mouse : sync on : sync : load image yourimage$,1,1
text 0,0,"DBC Image Altering Library by Toukatly (kenmo)" : sync : wait key
cls : paste image 1,0,0 : text 0,0, "Normal Image" : sync : wait key
cls : flip_image(1,2) : paste image 2,0,0 : text 0,0,"Flipped" : sync : wait key
cls : mirror_image(1,2) : paste image 2,0,0 : text 0,0,"Mirrored" : sync : wait key
cls : invert_image(1,2) : paste image 2,0,0 : text 0,0,"Inverted" : sync : wait key
cls : brighten_image(1,2,200) : paste image 2,0,0 : text 0,0,"200% brightness" : sync : wait key
cls : brighten_image(1,2,25) : paste image 2,0,0 : text 0,0,"25% brightness" : sync : wait key
cls : greyscale_image(1,2,100) : paste image 2,0,0 : text 0,0,"100% greyscale" : sync : wait key
cls : colorize_image(1,2,rgb(255,128,0),75) : paste image 2,0,0 : text 0,0,"75% colorized orange" : sync : wait key
cls : text 0,0,"THE END!" : sync : wait key
delete image 1 : delete image 2 : end

` DBC Image Altering Function Library, by Toukatly (kenmo)
` Simply copy these functions into your program (or save and include this file)
` and the rest is pretty obvious.
` Function return values:
` 1: Function was successful
` 0: Function hit the end (should never occur)
` -1: Source image does not exist
` -2: No free memblock(s)
` -3: Width or Height or Depth is 0 (??? should not occur)
` If you use these, feel free to give me credit, though none is needed.
` Toukatly (kenmo) 05.20-21.2004

function colorize_image(source_image,destination_image,color,percent)
   if image exist(source_image)=0 : exitfunction -1 : endif
   tmp=1 : while tmp<128 and memblock exist(tmp)=1 : tmp=tmp+1 : endwhile
   if tmp=128 : exitfunction -2 : endif : sm=tmp
   tmp=tmp+1 : while tmp<128 and memblock exist(tmp)=1 : tmp=tmp+1 : endwhile
   if tmp=128 : exitfunction -2 : endif : dm=tmp
   make memblock from image sm,source_image : make memblock from image dm,source_image
   colorr=rgbr(color) : colorg=rgbg(color) : colorb=rgbb(color)
   if percent>100 then percent=100
   if percent<=0 then make image from memblock destination_image,sm : delete memblock sm : delete memblock dm : exitfunction 1
   width=memblock dword(sm,0) : height=memblock dword(sm,4) : depth=memblock dword(sm,8)
   if width=0 or height=0 or depth=0 : delete memblock sm : delete memblock dm : exitfunction -3 : endif
   if depth=2 or depth=16
      for tmpy=0 to height-1 : for tmpx=0 to width-1
         slot=12+(tmpy*width+tmpx)*2 : tmp=memblock word(sm,slot)
         tmpr=((tmp/2048)&&31)*8
         tmpg=((tmp/32)&&63)*4
         tmpb=(tmp&&31)*8
         final=tmpr*0.3+tmpg*0.59+tmpb*.11
         final=rgb(((final*colorr/255.0)*percent+tmpr*(100-percent))/100,((final*colorg/255.0)*percent+tmpg*(100-percent))/100,((final*colorb/255.0)*percent+tmpb*(100-percent))/100)
         final=((RGBR(final)&&248)*256)+((RGBG(final)&&252)*8)+((RGBB(final)/8))
         write memblock word dm,slot,final
      next tmpx : next tmpy
   endif
   if depth=3 or depth=24
      for tmpy=0 to height-1 : for tmpx=0 to width-1
         slot=(tmpy*width+tmpx)*3 : tmpr=memblock byte(sm,12+slot) : tmpg=memblock byte(sm,13+slot) : tmpb=memblock byte(sm,14+slot)
         final=tmpr*0.3+tmpg*0.59+tmpb*0.11
         r=((final*colorr/255.0)*percent+tmpr*(100-percent))/100
         g=((final*colorg/255.0)*percent+tmpg*(100-percent))/100
         b=((final*colorb/255.0)*percent+tmpb*(100-percent))/100
         write memblock byte dm,12+slot,r : write memblock byte dm,13+slot,g : write memblock byte dm,14+slot,b
      next tmpx : next tmpy
   endif
   if depth=4 or depth=32
      for tmpy=0 to height-1 : for tmpx=0 to width-1
         slot=12+(tmpy*width+tmpx)*4 : tmprgb=memblock dword(sm,slot)
         tmpr=rgbr(tmprgb) : tmpg=rgbg(tmprgb) : tmpb=rgbb(tmprgb)
         final=tmpr*0.3+tmpg*0.59+tmpb*0.11
         final=rgb(((final*colorr/255.0)*percent+tmpr*(100-percent))/100,((final*colorg/255.0)*percent+tmpg*(100-percent))/100,((final*colorb/255.0)*percent+tmpb*(100-percent))/100)
         write memblock dword dm,slot,final
      next tmpx : next tmpy
   endif
   make image from memblock destination_image,dm : delete memblock sm : delete memblock dm : exitfunction 1
endfunction 0

function flip_image(source_image,destination_image)
   if image exist(source_image)=0 : exitfunction -1 : endif
   tmp=1 : while tmp<128 and memblock exist(tmp)=1 : tmp=tmp+1 : endwhile
   if tmp=128 : exitfunction -2 : endif : sm=tmp
   tmp=tmp+1 : while tmp<128 and memblock exist(tmp)=1 : tmp=tmp+1 : endwhile
   if tmp=128 : exitfunction -2 : endif : dm=tmp
   make memblock from image sm,source_image : make memblock from image dm,source_image
   width=memblock dword(sm,0) : height=memblock dword(sm,4) : depth=memblock dword(sm,8)
   if width=0 or height=0 or depth=0 : delete memblock sm : delete memblock dm : exitfunction -3 : endif
   if depth=2 or depth=16
      for tmpy=0 to height-1 : for tmpx=0 to width-1
         old=12+(tmpy*width+tmpx)*2 : new=12+((height-1-tmpy)*width+tmpx)*2
         write memblock word dm,new,memblock word(sm,old)
      next tmpx : next tmpy
   endif
   if depth=3 or depth=24
         for tmpy=0 to height-1 : for tmpx=0 to width-1
         old=(tmpy*width+tmpx)*3 : new=((height-1-tmpy)*width+tmpx)*2
         for tmp=12 to 14 : write memblock byte dm,tmp+new,memblock byte(sm,tmp+old) : next tmp
      next tmpx : next tmpy
   endif
   if depth=4 or depth=32
      for tmpy=0 to height-1 : for tmpx=0 to width-1
         old=12+(tmpy*width+tmpx)*4 : new=12+((height-1-tmpy)*width+tmpx)*4
         write memblock dword dm,new,memblock dword(sm,old)
      next tmpx : next tmpy
   endif
   make image from memblock destination_image,dm : delete memblock sm : delete memblock dm : exitfunction 1
endfunction 0

function mirror_image(source_image,destination_image)
   if image exist(source_image)=0 : exitfunction -1 : endif
   tmp=1 : while tmp<128 and memblock exist(tmp)=1 : tmp=tmp+1 : endwhile
   if tmp=128 : exitfunction -2 : endif : sm=tmp
   tmp=tmp+1 : while tmp<128 and memblock exist(tmp)=1 : tmp=tmp+1 : endwhile
   if tmp=128 : exitfunction -2 : endif : dm=tmp
   make memblock from image sm,source_image : make memblock from image dm,source_image
   width=memblock dword(sm,0) : height=memblock dword(sm,4) : depth=memblock dword(sm,8)
   if width=0 or height=0 or depth=0 : delete memblock sm : delete memblock dm : exitfunction -3 : endif
   if depth=2 or depth=16
      for tmpy=0 to height-1 : for tmpx=0 to width-1
         old=12+(tmpy*width+tmpx)*2 : new=12+(tmpy*width+(width-1-tmpx))*2
         write memblock word dm,new,memblock word(sm,old)
      next tmpx : next tmpy
   endif
   if depth=3 or depth=24
         for tmpy=0 to height-1 : for tmpx=0 to width-1
         old=(tmpy*width+tmpx)*3 : new=(tmpy*width+(width-1-tmpx))*2
         for tmp=12 to 14 : write memblock byte dm,tmp+new,memblock byte(sm,tmp+old) : next tmp
      next tmpx : next tmpy
   endif
   if depth=4 or depth=32
      for tmpy=0 to height-1 : for tmpx=0 to width-1
         old=12+(tmpy*width+tmpx)*4 : new=12+(tmpy*width+(width-1-tmpx))*4
         write memblock dword dm,new,memblock dword(sm,old)
      next tmpx : next tmpy
   endif
   make image from memblock destination_image,dm : delete memblock sm : delete memblock dm : exitfunction 1
endfunction 0

function greyscale_image(source_image,destination_image,percent)
   if image exist(source_image)=0 : exitfunction -1 : endif
   tmp=1 : while tmp<128 and memblock exist(tmp)=1 : tmp=tmp+1 : endwhile
   if tmp=128 : exitfunction -2 : endif : sm=tmp
   tmp=tmp+1 : while tmp<128 and memblock exist(tmp)=1 : tmp=tmp+1 : endwhile
   if tmp=128 : exitfunction -2 : endif : dm=tmp
   make memblock from image sm,source_image : make memblock from image dm,source_image
   if percent>100 then percent=100
   if percent<=0 then make image from memblock destination_image,sm : delete memblock sm : delete memblock dm : exitfunction 1
   width=memblock dword(sm,0) : height=memblock dword(sm,4) : depth=memblock dword(sm,8)
   if width=0 or height=0 or depth=0 : delete memblock sm : delete memblock dm : exitfunction -3 : endif
   if depth=2 or depth=16
      for tmpy=0 to height-1 : for tmpx=0 to width-1
         slot=12+(tmpy*width+tmpx)*2 : tmp=memblock word(sm,slot)
         tmpr=((tmp/2048)&&31)*8
         tmpg=((tmp/32)&&63)*4
         tmpb=(tmp&&31)*8
         final=tmpr*0.3+tmpg*0.59+tmpb*.11
         final=rgb((final*percent+tmpr*(100-percent))/100,(final*percent+tmpg*(100-percent))/100,(final*percent+tmpb*(100-percent))/100)
         final=((RGBR(final)&&248)*256)+((RGBG(final)&&252)*8)+((RGBB(final)/8))
         write memblock word dm,slot,final
      next tmpx : next tmpy
   endif
   if depth=3 or depth=24
      for tmpy=0 to height-1 : for tmpx=0 to width-1
         slot=(tmpy*width+tmpx)*3 : tmpr=memblock byte(sm,12+slot) : tmpg=memblock byte(sm,13+slot) : tmpb=memblock byte(sm,14+slot)
         final=tmpr*0.3+tmpg*0.59+tmpb*0.11
         r=(final*percent+tmpr*(100-percent))/100
         g=(final*percent+tmpg*(100-percent))/100
         b=(final*percent+tmpb*(100-percent))/100
         write memblock byte dm,12+slot,r : write memblock byte dm,13+slot,g : write memblock byte dm,14+slot,b
      next tmpx : next tmpy
   endif
   if depth=4 or depth=32
      for tmpy=0 to height-1 : for tmpx=0 to width-1
         slot=12+(tmpy*width+tmpx)*4
         tmprgb=memblock dword(sm,slot)
         tmpr=rgbr(tmprgb) : tmpg=rgbg(tmprgb) : tmpb=rgbb(tmprgb)
         final=tmpr*0.3+tmpg*0.59+tmpb*0.11
         final=rgb((final*percent+tmpr*(100-percent))/100,(final*percent+tmpg*(100-percent))/100,(final*percent+tmpb*(100-percent))/100)
         write memblock dword dm,slot,final
      next tmpx : next tmpy
   endif
   make image from memblock destination_image,dm : delete memblock sm : delete memblock dm : exitfunction 1
endfunction 0

function invert_image(source_image,destination_image)
   if image exist(source_image)=0 : exitfunction -1 : endif
   tmp=1 : while tmp<128 and memblock exist(tmp)=1 : tmp=tmp+1 : endwhile
   if tmp=128 : exitfunction -2 : endif : sm=tmp
   tmp=tmp+1 : while tmp<128 and memblock exist(tmp)=1 : tmp=tmp+1 : endwhile
   if tmp=128 : exitfunction -2 : endif : dm=tmp
   make memblock from image sm,source_image : make memblock from image dm,source_image
   width=memblock dword(sm,0) : height=memblock dword(sm,4) : depth=memblock dword(sm,8)
   if width=0 or height=0 or depth=0 : delete memblock sm : delete memblock dm : exitfunction -3 : endif
   if depth=2 or depth=16
      for tmpy=0 to height-1 : for tmpx=0 to width-1
         slot=12+(tmpy*width+tmpx)*2 : tmp=memblock word(sm,slot)
         tmpr=((tmp/2048)&&31)*8
         tmpg=((tmp/32)&&63)*4
         tmpb=(tmp&&31)*8
         r=255-tmpr : g=255-tmpg : b=255-tmpb
         final=rgb(r,g,b) : final=((RGBR(final)&&248)*256)+((RGBG(final)&&252)*8)+((RGBB(final)/8))
         write memblock word dm,slot,final
      next tmpx : next tmpy
   endif
   if depth=3 or depth=24
      for tmpy=0 to height-1 : for tmpx=0 to width-1
         slot=(tmpy*width+tmpx)*3 : tmpr=memblock byte(sm,12+slot) : tmpg=memblock byte(sm,13+slot) : tmpb=memblock byte(sm,14+slot)
         r=255-tmpr : g=255-tmpg : b=255-tmpb
         write memblock byte dm,12+slot,r : write memblock byte dm,13+slot,g : write memblock byte dm,14+slot,b
      next tmpx : next tmpy
   endif
   if depth=4 or depth=32
      for tmpy=0 to height-1 : for tmpx=0 to width-1
         slot=12+(tmpy*width+tmpx)*4
         tmprgb=memblock dword(sm,slot)
         tmpr=rgbr(tmprgb) : tmpg=rgbg(tmprgb) : tmpb=rgbb(tmprgb) : max=1
         r=255-tmpr : g=255-tmpg : b=255-tmpb
         final=rgb(r,g,b)
         write memblock dword dm,slot,final
      next tmpx : next tmpy
   endif
   make image from memblock destination_image,dm : delete memblock sm : delete memblock dm : exitfunction 1
endfunction 0

function brighten_image(source_image,destination_image,percent)
   if image exist(source_image)=0 : exitfunction -1 : endif
   tmp=1 : while tmp<128 and memblock exist(tmp)=1 : tmp=tmp+1 : endwhile
   if tmp=128 : exitfunction -2 : endif : sm=tmp
   tmp=tmp+1 : while tmp<128 and memblock exist(tmp)=1 : tmp=tmp+1 : endwhile
   if tmp=128 : exitfunction -2 : endif : dm=tmp
   make memblock from image sm,source_image : make memblock from image dm,source_image
   if percent=100 then make image from memblock destination_image,sm : delete memblock sm : delete memblock dm : exitfunction 1
   width=memblock dword(sm,0) : height=memblock dword(sm,4) : depth=memblock dword(sm,8)
   if width=0 or height=0 or depth=0 : delete memblock sm : delete memblock dm : exitfunction -3 : endif
   if depth=2 or depth=16
      for tmpy=0 to height-1 : for tmpx=0 to width-1
         slot=12+(tmpy*width+tmpx)*2 : tmp=memblock word(sm,slot)
         r=((tmp/2048)&&31)*8
         g=((tmp/32)&&63)*4
         b=(tmp&&31)*8
         r=r*percent/100.0 : if r>255 then r=255
         g=g*percent/100.0 : if g>255 then g=255
         b=b*percent/100.0 : if b>255 then b=255
         final=rgb(r,g,b) : final=((RGBR(final)&&248)*256)+((RGBG(final)&&252)*8)+((RGBB(final)/8)) : write memblock word dm,slot,final
      next tmpx : next tmpy
   endif
   if depth=3 or depth=24
      for tmpy=0 to height-1 : for tmpx=0 to width-1
         slot=(tmpy*width+tmpx)*3 : r=memblock byte(sm,12+slot) : g=memblock byte(sm,13+slot) : b=memblock byte(sm,14+slot)
         r=r*percent/100.0 : if r>255 then r=255
         g=g*percent/100.0 : if g>255 then g=255
         b=b*percent/100.0 : if b>255 then b=255
         write memblock byte dm,12+slot,r : write memblock byte dm,13+slot,g : write memblock byte dm,14+slot,b
      next tmpx : next tmpy
   endif
   if depth=4 or depth=32
      for tmpy=0 to height-1 : for tmpx=0 to width-1
         slot=12+(tmpy*width+tmpx)*4 : tmp=memblock dword(sm,slot)
         r=rgbr(tmp) : g=rgbg(tmp) : b=rgbb(tmp)
         r=r*percent/100.0 : if r>255 then r=255
         g=g*percent/100.0 : if g>255 then g=255
         b=b*percent/100.0 : if b>255 then b=255
         final=rgb(r,g,b) : write memblock dword dm,slot,final
      next tmpx : next tmpy
   endif
   make image from memblock destination_image,dm : delete memblock sm : delete memblock dm : exitfunction 1
endfunction 0

sync on : sync rate 0

`Fire colors
dim Color(2)
Color(1) = RGB(0,0,0) : Color(2) = RGB(255,79,0)

`Create memblock images
cls
get image 1,0,0,128,128, 1
make memblock from image 1, 1
make memblock from image 2, 1
make memblock from image 5, 1

`Create overlayer to fade flames slowly
box 0, 0, 128, 64, rgb(0, 0, 0), rgb(255, 255, 255), rgb(0,0,0), rgb(255,255,255)
get image 3, 0, 0, 128, 128, 1
make memblock from image 3, 3

`init
fimg = 2

cls
paste image 1, 0, 0

do

   `Draw fire
   for i = 0 to 127
      col = 1 + rnd(1)
      ink Color(col), 0
      box i, 127, i + 1, 128
   next i

   `Get image, blur it and position it one unit higher
   get image 1, 0, 0, 128, 128, 1
   make memblock from image 1, 1
   BlurImage(1, 4)
   BlendMapImageMemblocks(4, 5, 2, 3)
   make image from memblock 2, 2
   paste image 2, 0, -1

   sync
loop

function BlurImage(mem, retmem)

   `Get data
   width = memblock dword(mem, 0)
   height = memblock dword(mem, 4)

   `Create returned memblock
   if memblock exist(retmem) = 0 then make memblock retmem, get memblock size(mem)
   write memblock dword retmem, 0, width
   write memblock dword retmem, 4, height
   write memblock dword retmem, 8, 32

   `Write data
   `No edges:
   for y = 2 to height - 1
      for x = 2 to width - 1

         `Get position
         pos = 12 + ((y-1)*width*4) + ((x-1)*4)

         `Initialize values
         blue# = memblock byte(mem, pos) * 0.5
         green# = memblock byte(mem, pos+1) * 0.5
         red# = memblock byte(mem, pos+2) * 0.5

         `Get surrounding data
         `Left
         npos = pos - 4
         blue# = blue# + (memblock byte(mem, npos)*0.08)
         green# = green# + (memblock byte(mem, npos+1)*0.08)
         red# = red# + (memblock byte(mem, npos+2)*0.08)

         `+-> Top Left
         npos = npos - (width*4)
         blue# = blue# + (memblock byte(mem, npos)*0.045)
         green# = green# + (memblock byte(mem, npos+1)*0.045)
         red# = red# + (memblock byte(mem, npos+2)*0.045)

         `Right
         npos = pos + 4
         blue# = blue# + (memblock byte(mem, npos)*0.08)
         green# = green# + (memblock byte(mem, npos+1)*0.08)
         red# = red# + (memblock byte(mem, npos+2)*0.08)

         `+-> Bottom right
         npos = npos + (width*4)
         blue# = blue# + (memblock byte(mem, npos)*0.045)
         green# = green# + (memblock byte(mem, npos+1)*0.045)
         red# = red# + (memblock byte(mem, npos+2)*0.045)

         `Top
         npos = pos - (width*4)
         blue# = blue# + (memblock byte(mem, npos)*0.08)
         green# = green# + (memblock byte(mem, npos+1)*0.08)
         red# = red# + (memblock byte(mem, npos+2)*0.08)

         `+-> top right
         npos = npos + 4
         blue# = blue# + (memblock byte(mem, npos)*0.045)
         green# = green# + (memblock byte(mem, npos+1)*0.045)
         red# = red# + (memblock byte(mem, npos+2)*0.045)

         `Bottom
         npos = pos + (width*4)
         blue# = blue# + (memblock byte(mem, npos)*0.08)
         green# = green# + (memblock byte(mem, npos+1)*0.08)
         red# = red# + (memblock byte(mem, npos+2)*0.08)

         `+-> Bottom left
         npos = npos - 4
         blue# = blue# + (memblock byte(mem, npos)*0.045)
         green# = green# + (memblock byte(mem, npos+1)*0.045)
         red# = red# + (memblock byte(mem, npos+2)*0.045)

         `Write away data
         write memblock byte retmem, pos, int(blue#+0.5)
         write memblock byte retmem, pos+1, int(green#+0.5)
         write memblock byte retmem, pos+2, int(red#+0.5)
         write memblock byte retmem, pos+3, 255

      next x
   next y

   `Edges
   for y = 1 to height step (height-1)
      for x = 1 to width

         `Get position
         pos = 12 + ((y-1)*width*4) + ((x-1)*4)

         `Initialize colors
         if x = 1 or x = width
            blue# = memblock byte(mem, pos) * 0.795
            green# = memblock byte(mem, pos+1) * 0.795
            red# = memblock byte(mem, pos+2) * 0.795
         else
            blue# = memblock byte(mem, pos) * 0.67
            green# = memblock byte(mem, pos+1) * 0.67
            red# = memblock byte(mem, pos+2) * 0.67
         endif

         `Get other colors
         if x > 1
            npos = pos - 4
            blue# = blue# + memblock byte(mem, npos) * 0.08
            green# = green# + memblock byte(mem, npos+1) * 0.08
            red# = red# + memblock byte(mem, npos+2) * 0.08
         endif
         if x < width
            npos = pos + 4
            blue# = blue# + memblock byte(mem, npos) * 0.08
            green# = green# + memblock byte(mem, npos+1) * 0.08
            red# = red# + memblock byte(mem, npos+2) * 0.08
         endif

         if y > 1 then npos = pos - (width*4) else npos = pos + (width*4)
         blue# = blue# + memblock byte(mem, npos) * 0.08
         green# = green# + memblock byte(mem, npos+1) * 0.08
         red# = red# + memblock byte(mem, npos+2) * 0.08

         if x > 1
            mpos = npos - 4
            blue# = blue# + memblock byte(mem, mpos) * 0.045
            green# = green# + memblock byte(mem, mpos+1) * 0.045
            red# = red# + memblock byte(mem, mpos+2) * 0.045
         endif
         if x < width
            mpos = npos + 4
            blue# = blue# + memblock byte(mem, mpos) * 0.045
            green# = green# + memblock byte(mem, mpos+1) * 0.045
            red# = red# + memblock byte(mem, mpos+2) * 0.045
         endif

         `Write away data
         write memblock byte retmem, pos, int(blue#+0.5)
         write memblock byte retmem, pos+1, int(green#+0.5)
         write memblock byte retmem, pos+2, int(red#+0.5)
         write memblock byte retmem, pos+3, 255

      next x
   next y

   `Left and right edges (no corners anymore)
   for x = 1 to width step (width-1)
      for y = 2 to height - 1

         `Get position
         pos = 12 + ((y-1)*width*4) + ((x-1)*4)

         `Initialize colors
         blue# = memblock byte(mem, pos) * 0.67
         green# = memblock byte(mem, pos+1) * 0.67
         red# = memblock byte(mem, pos+2) * 0.67

         `Get surrounding data
         npos = pos - (width*4)
         blue# = blue# + memblock byte(mem, npos) * 0.08
         green# = green# + memblock byte(mem, npos+1) * 0.08
         red# = red# + memblock byte(mem, npos+2) * 0.08

         npos = pos + (width*4)
         blue# = blue# + memblock byte(mem, npos) * 0.08
         green# = green# + memblock byte(mem, npos+1) * 0.08
         red# = red# + memblock byte(mem, npos+2) * 0.08

         if x > 1 then npos = pos - 4 else npos = pos + 4
         blue# = blue# + memblock byte(mem, npos) * 0.08
         green# = green# + memblock byte(mem, npos+1) * 0.08
         red# = red# + memblock byte(mem, npos+2) * 0.08

         mpos = npos - (width*4)
         blue# = blue# + memblock byte(mem, mpos) * 0.045
         green# = green# + memblock byte(mem, mpos+1) * 0.045
         red# = red# + memblock byte(mem, mpos+2) * 0.045
         mpos = npos + (width*4)
         blue# = blue# + memblock byte(mem, mpos) * 0.045
         green# = green# + memblock byte(mem, mpos+1) * 0.045
         red# = red# + memblock byte(mem, mpos+2) * 0.045

         `Write away data
         write memblock byte retmem, pos, int(blue#+0.5)
         write memblock byte retmem, pos+1, int(green#+0.5)
         write memblock byte retmem, pos+2, int(red#+0.5)
         write memblock byte retmem, pos+3, 255

      next y
   next x

endfunction

function BlendMapImageMemblocks(Mem1, Mem2, RetMem, Map)

   `Get data
   Width = memblock dword(Mem1, 0)
   Height = memblock dword(Mem1, 4)

   `setup teh returned memblock
   if memblock exist(RetMem)=0 then make memblock RetMem, 12 + (Width*Height*4)
   write memblock dword RetMem, 0, Width
   write memblock dword RetMem, 4, Height
   write memblock dword RetMem, 8, 32

   `blend
   for y = 1 to Height
      for x = 1 to Width
         pos = 12 + ((y-1)*Width*4) + ((x-1)*4)
         difblue#  = (memblock byte(Mem2, pos)   - memblock byte(Mem1, pos))
         difgreen# = (memblock byte(Mem2, pos+1) - memblock byte(Mem1, pos+1))
         difred#   = (memblock byte(Mem2, pos+2) - memblock byte(Mem1, pos+2))
         blue  = memblock byte(Mem1, pos)   + int(difblue# / 255.0 * memblock byte(Map, pos))
         green = memblock byte(Mem1, pos+1) + int(difgreen#/ 255.0 * memblock byte(Map, pos+1))
         red   = memblock byte(Mem1, pos+2) + int(difred#  / 255.0 * memblock byte(Map, pos+2))
         write memblock byte RetMem, pos, blue
         write memblock byte RetMem, pos+1, green
         write memblock byte RetMem, pos+2, red
         write memblock byte RetMem, pos+3, 255
      next x
   next y

endfunction

type Constants
   ScreenWidth as word
   ScreenHeight as word
endtype

Global System as Constants
System.ScreenWidth = 320
System.ScreenHeight = 120

Global flame as float
flame = 4.02

sync on
backdrop on
color backdrop 0

make memblock 1, System.ScreenWidth*System.ScreenHeight*4 + 12
write memblock dword 1,0,System.ScreenWidth
write memblock dword 1,4,System.ScreenHeight
write memblock dword 1,8,32



REM get the image's width and height
width = memblock dword(1,0)
height = memblock dword(1,4)

REM create a new image from the memblock data
make image from memblock 3, 1

REM display the new image
repeat


   for y = 1 to System.Screenheight
      for x = 1 to System.ScreenWidth
         if y < System.ScreenHeight
            changePixel(x,y,newValue(x,y))
         else
            r = rnd(255)
            g = rnd(255)
            if g>r then g = r
            changePixel(x,System.ScreenHeight,rgb(r,g,0))
         endif
      next x
   next y

   make image from memblock 3, 1



   sprite 2,mousex(), mousey(), 3

   set cursor 0,0
   print screen fps()

   fastsync
until spacekey()




function getColor(x as integer, y as integer)
   if x < 1 or x > System.ScreenWidth or y < 1 or y > System.ScreenHeight then exitfunction rgb(0,0,0)
   mem = 1
   pos = ((y-1)*System.ScreenWidth + x - 1)*4 + 12
   c as dword
   c = memblock dword(mem, pos)
endfunction c



function changePixel(x as integer, y as integer, color as dword)
   if x > 0 and x <= System.ScreenWidth and y > 0 and y <= System.Screenheight
      mem = 1
      pos = ((y-1)*System.ScreenWidth + x - 1)*4 + 12
      write memblock dword mem, pos, color
   endif
endfunction



function newValue(x as integer, y as integer)
   local c as dword
   local r as integer
   local g as integer
   local b as integer

   c = getColor(x,y+1)
   r = rgbr(c)
   g = rgbg(c)
   b = rgbb(c)
   c = getColor(x-1,y+1)
   r = r + rgbr(c)
   g = g + rgbg(c)
   b = b + rgbb(c)
   c = getColor(x+1,y+1)
   r = r + rgbr(c)
   g = g + rgbg(c)
   b = b + rgbb(c)
   c = getColor(x,y+2)
   r = r + rgbr(c)
   g = g + rgbg(c)
   b = b + rgbb(c)

   r = r/flame
   g = g/flame
   b = b/flame

   c = rgb(r,g,b)
endfunction c

sync on : sync rate 0
randomize timer()

`Create first image
cls
get image 1, 0, 0, 100, 100, 1
make memblock from image 1, 1

`Setup
#constant flies = 10
type F
   px as integer
   py as integer
   xs as integer
   ys as integer
   col as dword
endtype
dim Fly(flies) as F

`init
for i = 1 to flies
   d = 1 + rnd(2)
   Fly(i).px = 5 + rnd(90)
   Fly(i).py = 5 + rnd(90)
   Fly(i).xs = (1 + rnd(2))
   Fly(i).ys = (1 + rnd(2))
   select d
      case 1 : Fly(i).xs = Fly(i).xs * -1 : endcase
      case 2 : Fly(i).ys = Fly(i).ys * -1 : endcase
      case 3 : Fly(i).xs = Fly(i).xs * -1 : Fly(i).ys = Fly(i).ys * -1 : endcase
   endselect
   Fly(i).col = rgb(128 + rnd(127), 128 + rnd(127), 128 + rnd(127))
next i

do

   `Draw flies
   for i = 1 to flies
      `Update position
      Fly(i).px = Fly(i).px + Fly(i).xs
      Fly(i).py = Fly(i).py + Fly(i).ys

      `Check boundries
      if Fly(i).px <= 4 or Fly(i).px >= 96 then Fly(i).xs = Fly(i).xs * -1
      if Fly(i).py <= 4 or Fly(i).py >= 96 then Fly(i).ys = Fly(i).ys * -1

      `Draw fly
      ink Fly(i).col, 0
      box Fly(i).px-1, Fly(i).py-1, Fly(i).px+1, Fly(i).py+1

   next i

   `Blur output
   get image 1, 0, 0, 100, 100, 1
   make memblock from image 1, 1
   BlurImage(1, 2)
   make image from memblock 2, 2
   paste image 2, 0, 0

   sync
loop

function BlurImage(mem, retmem)

   `Get data
   width = memblock dword(mem, 0)
   height = memblock dword(mem, 4)

   `Create returned memblock
   if memblock exist(retmem) = 0 then make memblock retmem, get memblock size(mem)
   write memblock dword retmem, 0, width
   write memblock dword retmem, 4, height
   write memblock dword retmem, 8, 32

   `Write data
   `No edges:
   for y = 2 to height - 1
      for x = 2 to width - 1

         `Get position
         pos = 12 + ((y-1)*width*4) + ((x-1)*4)

         `Initialize values
         blue# = memblock byte(mem, pos) * 0.45
         green# = memblock byte(mem, pos+1) * 0.45
         red# = memblock byte(mem, pos+2) * 0.45

         `Get surrounding data
         `Left
         npos = pos - 4
         blue# = blue# + (memblock byte(mem, npos)*0.08)
         green# = green# + (memblock byte(mem, npos+1)*0.08)
         red# = red# + (memblock byte(mem, npos+2)*0.08)

         `+-> Top Left
         npos = npos - (width*4)
         blue# = blue# + (memblock byte(mem, npos)*0.045)
         green# = green# + (memblock byte(mem, npos+1)*0.045)
         red# = red# + (memblock byte(mem, npos+2)*0.045)

         `Right
         npos = pos + 4
         blue# = blue# + (memblock byte(mem, npos)*0.08)
         green# = green# + (memblock byte(mem, npos+1)*0.08)
         red# = red# + (memblock byte(mem, npos+2)*0.08)

         `+-> Bottom right
         npos = npos + (width*4)
         blue# = blue# + (memblock byte(mem, npos)*0.045)
         green# = green# + (memblock byte(mem, npos+1)*0.045)
         red# = red# + (memblock byte(mem, npos+2)*0.045)

         `Top
         npos = pos - (width*4)
         blue# = blue# + (memblock byte(mem, npos)*0.08)
         green# = green# + (memblock byte(mem, npos+1)*0.08)
         red# = red# + (memblock byte(mem, npos+2)*0.08)

         `+-> top right
         npos = npos + 4
         blue# = blue# + (memblock byte(mem, npos)*0.045)
         green# = green# + (memblock byte(mem, npos+1)*0.045)
         red# = red# + (memblock byte(mem, npos+2)*0.045)

         `Bottom
         npos = pos + (width*4)
         blue# = blue# + (memblock byte(mem, npos)*0.08)
         green# = green# + (memblock byte(mem, npos+1)*0.08)
         red# = red# + (memblock byte(mem, npos+2)*0.08)

         `+-> Bottom left
         npos = npos - 4
         blue# = blue# + (memblock byte(mem, npos)*0.045)
         green# = green# + (memblock byte(mem, npos+1)*0.045)
         red# = red# + (memblock byte(mem, npos+2)*0.045)

         `Write away data
         write memblock byte retmem, pos, int(blue#+0.5)
         write memblock byte retmem, pos+1, int(green#+0.5)
         write memblock byte retmem, pos+2, int(red#+0.5)
         write memblock byte retmem, pos+3, 255

      next x
   next y

   `Edges
   for y = 1 to height step (height-1)
      for x = 1 to width

         `Get position
         pos = 12 + ((y-1)*width*4) + ((x-1)*4)

         `Initialize colors
         if x = 1 or x = width
            blue# = memblock byte(mem, pos) * 0.6
            green# = memblock byte(mem, pos+1) * 0.6
            red# = memblock byte(mem, pos+2) * 0.6
         else
            blue# = memblock byte(mem, pos) * 0.5
            green# = memblock byte(mem, pos+1) * 0.5
            red# = memblock byte(mem, pos+2) * 0.5
         endif

         `Get other colors
         if x > 1
            npos = pos - 4
            blue# = blue# + memblock byte(mem, npos) * 0.08
            green# = green# + memblock byte(mem, npos+1) * 0.08
            red# = red# + memblock byte(mem, npos+2) * 0.08
         endif
         if x < width
            npos = pos + 4
            blue# = blue# + memblock byte(mem, npos) * 0.08
            green# = green# + memblock byte(mem, npos+1) * 0.08
            red# = red# + memblock byte(mem, npos+2) * 0.08
         endif

         if y > 1 then npos = pos - (width*4) else npos = pos + (width*4)
         blue# = blue# + memblock byte(mem, npos) * 0.08
         green# = green# + memblock byte(mem, npos+1) * 0.08
         red# = red# + memblock byte(mem, npos+2) * 0.08

         if x > 1
            mpos = npos - 4
            blue# = blue# + memblock byte(mem, mpos) * 0.045
            green# = green# + memblock byte(mem, mpos+1) * 0.045
            red# = red# + memblock byte(mem, mpos+2) * 0.045
         endif
         if x < width
            mpos = npos + 4
            blue# = blue# + memblock byte(mem, mpos) * 0.045
            green# = green# + memblock byte(mem, mpos+1) * 0.045
            red# = red# + memblock byte(mem, mpos+2) * 0.045
         endif

         `Write away data
         write memblock byte retmem, pos, int(blue#+0.5)
         write memblock byte retmem, pos+1, int(green#+0.5)
         write memblock byte retmem, pos+2, int(red#+0.5)
         write memblock byte retmem, pos+3, 255

      next x
   next y

   `Left and right edges (no corners anymore)
   for x = 1 to width step (width-1)
      for y = 2 to height - 1

         `Get position
         pos = 12 + ((y-1)*width*4) + ((x-1)*4)

         `Initialize colors
         blue# = memblock byte(mem, pos) * 0.5
         green# = memblock byte(mem, pos+1) * 0.5
         red# = memblock byte(mem, pos+2) * 0.5

         `Get surrounding data
         npos = pos - (width*4)
         blue# = blue# + memblock byte(mem, npos) * 0.08
         green# = green# + memblock byte(mem, npos+1) * 0.08
         red# = red# + memblock byte(mem, npos+2) * 0.08

         npos = pos + (width*4)
         blue# = blue# + memblock byte(mem, npos) * 0.08
         green# = green# + memblock byte(mem, npos+1) * 0.08
         red# = red# + memblock byte(mem, npos+2) * 0.08

         if x > 1 then npos = pos - 4 else npos = pos + 4
         blue# = blue# + memblock byte(mem, npos) * 0.08
         green# = green# + memblock byte(mem, npos+1) * 0.08
         red# = red# + memblock byte(mem, npos+2) * 0.08

         mpos = npos - (width*4)
         blue# = blue# + memblock byte(mem, mpos) * 0.045
         green# = green# + memblock byte(mem, mpos+1) * 0.045
         red# = red# + memblock byte(mem, mpos+2) * 0.045
         mpos = npos + (width*4)
         blue# = blue# + memblock byte(mem, mpos) * 0.045
         green# = green# + memblock byte(mem, mpos+1) * 0.045
         red# = red# + memblock byte(mem, mpos+2) * 0.045

         `Write away data
         write memblock byte retmem, pos, int(blue#+0.5)
         write memblock byte retmem, pos+1, int(green#+0.5)
         write memblock byte retmem, pos+2, int(red#+0.5)
         write memblock byte retmem, pos+3, 255

      next y
   next x

endfunction

REM Project: Bitmap manipulation
REM Created: 1/28/2005 11:57:55 PM
REM
REM By CodingFodder
REM ***** Main Source File *****
REM
sync on:sync rate 0
set display mode 1280,1024,16

load bitmap "YourFavoriteBitmap.bmp",1

Save_Bitmap_For_Editing(1,0,1,0)
make_black_and_white(1)
`bitmap_brightness(1,50)
`resize_bitmap(1,100,100)
`clear_bitmap_from_editing(1)
set current bitmap 0
copy bitmap 1,0
angle=1
do
   i=wrapvalue(i+1)
   rotate_bitmap(1,i)
   make_black_and_white(1)
   bitmap_brightness(1,200)
   copy bitmap 1,0
sync
loop

function save_bitmap_for_editing(number,copy,block1,block2)
   if number=1
      create bitmap number+100,bitmap width(number),bitmap height(number)
      copy bitmap number,number+100
   else
      if bitmap exist(number+100) then delete bitmap number+100
   endif
   if memblock exist(100+number) then delete memblock 100+number
   if memblock exist(200+number) then delete memblock 200+number
   if block1=1 then make memblock from bitmap 100+number,number
   if block2=1 then make memblock from bitmap 200+number,number
endfunction

function Clear_bitmap_from_editing(number)
   if bitmap exist(number+100) then delete bitmap number+100
   if memblock exist(100+number) then delete memblock 100+number
   if memblock exist(200+number) then delete memblock 200+number
endfunction

function restore_bitmap(number)
   if bitmap exist(number+100)
      copy bitmap number+100,number
   else
      if memblock exist(100+number)
         delete bitmap number
         make bitmap from memblock number,100+number
      endif
   endif
endfunction

Function resize_bitmap(num,width,height)
   mem=num+100
   if memblock exist(mem)=0
      make memblock from bitmap mem,num
      none_set=1
   endif
   O_width=bitmap width(num)-1
   O_height=bitmap height(num)-1
   delete bitmap num
   create bitmap num,width,height
   set current bitmap num
   lock pixels
   for i=0 to bitmap width(num)-1
      for j=0 to bitmap height(num)-1
         color=get_memblock_pixel(mem,i*O_width/(bitmap width(num)-1),j*O_height/(bitmap height(num)-1))
         set_locked_pixel(i,j,color)
      next j
   next i
   unlock pixels
   set current bitmap 0
   if none_set=1 then delete memblock mem
endfunction

function scale_colors(num,red,green,blue)
set current bitmap num
   red2#=red/100.0
   green2#=green/100.0
   blue2#=blue/100.0
   lock pixels
   start=get pixels pointer()
   repeat_number=get pixels pitch()
   bits_per_pixel=bitmap depth(num)/8
   for i=0 to bitmap height(num)-1
      pointy=start+i*repeat_number
      for j=0 to bitmap width(num)-1
         pointer=pointy+j*bits_per_pixel
         color=*pointer
         red=rgbr(color)*red2#
         green=rgbg(color)*green2#
         blue=rgbb(color)*blue2#
         if red>255 then red=255
         if green>255 then green=255
         if blue>255 then blue=255
         *pointer=rgb(red,green,blue)
      next j
   next i
   unlock pixels
endfunction

function bitmap_brightness(num,value)
set current bitmap num
   value2#=value/100.0
   lock pixels
   start=get pixels pointer()
   repeat_number=get pixels pitch()
   bits_per_pixel=bitmap depth(num)/8
   for i=0 to bitmap height(num)-1
      pointy=start+i*repeat_number
      for j=0 to bitmap width(num)-1
         pointer=pointy+j*bits_per_pixel
         color=*pointer
         red=rgbr(color)*value2#
         green=rgbg(color)*value2#
         blue=rgbb(color)*value2#
         if red>255 then red=255
         if green>255 then green=255
         if blue>255 then blue=255
         *pointer=rgb(red,green,blue)
      next j
   next i
   unlock pixels
endfunction

function shift_bitmap(bitmap_number,amountx,amounty)
   if bitmap exist(bitmap_number+100)=0
      create bitmap bitmap_number+100,bitmap width(bitmap_number),bitmap height(bitmap_number)
      copy bitmap bitmap_number,bitmap_number+100

      if amountx>=0 and amounty>=0
         copy bitmap bitmap_number+100,0,0,bitmap width(bitmap_number)-amountx,bitmap height(bitmap_number),bitmap_number,amountx,0,bitmap width(bitmap_number),bitmap height(bitmap_number)
         copy bitmap bitmap_number+100,bitmap width(bitmap_number)-amountx,0,bitmap width(bitmap_number),bitmap height(bitmap_number),bitmap_number,0,0,amountx,bitmap height(bitmap_number)
         copy bitmap bitmap_number,bitmap_number+100
         copy bitmap bitmap_number+100,0,0,bitmap width(bitmap_number),bitmap height(bitmap_number)-amounty,bitmap_number,0,amounty,bitmap width(bitmap_number),bitmap height(bitmap_number)
         copy bitmap bitmap_number+100,0,bitmap height(bitmap_number)-amounty,bitmap width(bitmap_number),bitmap height(bitmap_number),bitmap_number,0,0,bitmap width(bitmap_number),bitmap height(bitmap_number)
      endif
      delete bitmap bitmap_number+100
   else
      if amountx>=0 and amounty>=0
         copy bitmap bitmap_number+100,0,0,bitmap width(bitmap_number)-amountx,bitmap height(bitmap_number)-amounty,bitmap_number,amountx,amounty,bitmap width(bitmap_number),bitmap height(bitmap_number)
         copy bitmap bitmap_number+100,bitmap width(bitmap_number)-amountx,bitmap height(bitmap_number)-amounty,bitmap width(bitmap_number),bitmap height(bitmap_number),bitmap_number,0,0,amountx,amounty
         copy bitmap bitmap_number+100,bitmap width(bitmap_number)-amountx,0,bitmap width(bitmap_number),bitmap height(bitmap_number)-amounty,bitmap_number,0,amounty,amountx,bitmap height(bitmap_number)
         copy bitmap bitmap_number+100,0,bitmap height(bitmap_number)-amounty,bitmap width(bitmap_number)-amountx,bitmap height(bitmap_number),bitmap_number,amountx,0,bitmap width(bitmap_number),amounty
      endif
   endif
endfunction

function Make_black_and_white(num)
   set current bitmap num
   lock pixels
   start=get pixels pointer()
   repeat_number=get pixels pitch()
   bits_per_pixel=bitmap depth(num)/8
   for i=0 to bitmap height(num)-1
      for j=0 to bitmap width(num)-1
         pointer=start+i*repeat_number+j*bits_per_pixel
         color_num=*pointer
         value=(rgbr(color_num)+rgbg(color_num)+rgbb(color_num))/3
         *pointer=rgb(value,value,value)
      next j
   next i
   unlock pixels
endfunction

function rotate_bitmap(num,degrees#)
   set current bitmap num
   mem=num+100
   if memblock exist(mem)=0
      make memblock from bitmap mem,num
      none_set=1
   endif
   width=memblock dword(mem,0)
   height=memblock dword(mem,4)
   depth=memblock dword(mem,8)
   lock pixels
   start=get pixels pointer()
   repeat_number=get pixels pitch()
   bits_per_pixel=bitmap depth(num)/8
   basis1x#=cos(degrees#)
   basis2x#=cos(degrees#+90.0)
   basis1y#=sin(degrees#)
   basis2y#=sin(degrees#+90.0)
   for i=0 to bitmap height(num)-1
      for j=0 to bitmap width(num)-1
         x#=(j-(bitmap width(num)/2.0))*basis1x#+(i-(bitmap height(num)/2.0))*basis2x#+bitmap width(num)/2.0
         y#=(j-(bitmap width(num)/2.0))*basis1y#+(i-(bitmap height(num)/2.0))*basis2y#+bitmap height(num)/2.0
         if x#>0 and y#>0 and x#<width and y#<height

            color_value=interpolate_memblock_pixel(mem,x#,y#)
         else
            color_value=100
         endif
         pointer=start+i*repeat_number+j*bits_per_pixel
         *pointer=color_value
      next j
   next i
   unlock pixels
   if none_set=1 then delete memblock mem
endfunction


function get_memblock_pixel(memblock,x,y)
   width=memblock dword(memblock,0)
   height=memblock dword(memblock,4)
   depth=memblock dword(memblock,8)
   if x>0 and y>0 and x<width and y<height
      pointer=y*width*depth/8+x*depth/8+12
      value=memblock dword(memblock,pointer)
   endif
endfunction value

function set_memblock_pixel(memblock,x,y,color)
   width=memblock dword(memblock,0)
   height=memblock dword(memblock,4)
   depth=memblock dword(memblock,8)
   if x>0 and y>0 and x<width and y<height
      pointer=y*width*depth/8+x*depth/8+12
      write memblock dword memblock,pointer,color
   endif
endfunction

function get_locked_pixel(x,y)
   start=get pixels pointer()
   repeat_number=get pixels pitch()
   bits_per_pixel=bitmap depth(num)/8
   pointer=start+y*repeat_number+x*bits_per_pixel
   result=*pointer
endfunction result

function set_locked_pixel(x,y,color_value)
   start=get pixels pointer()
   repeat_number=get pixels pitch()
   bits_per_pixel=bitmap depth(num)/8
   pointer=start+y*repeat_number+x*bits_per_pixel
   *pointer=color_value
endfunction

Function Interpolate_memblock_pixel(MemBlock as integer,x as float, y as float)
   width=memblock dword(memblock,0)
   height=memblock dword(memblock,4)
   depth=memblock dword(memblock,8)
   Rvalue=0
   if x>0 and y>0 and x<width-1 and y<height-1
      y2#=y-int(y)
      x2#=x-int(x)
      iy#=1.0-y2#
      ix#=1.0-x2#
      val1=memblock dword(memblock,int(y)*width*depth/8+int(x)*depth/8+12)
      val2=memblock dword(memblock,int(y)*width*depth/8+int(x+1)*depth/8+12)
      val3=memblock dword(memblock,int(y+1)*width*depth/8+int(x+1)*depth/8+12)
      val4=memblock dword(memblock,int(y+1)*width*depth/8+int(x)*depth/8+12)

      Rvalue=rgb(int(iy#*(ix#*rgbr(val1)+x2#*rgbr(val2))+y2#*(ix#*rgbr(val4)+x2#*rgbr(val3))),int(iy#*(ix#*rgbg(val1)+x2#*rgbg(val2))+y2#*(ix#*rgbg(val4)+x2#*rgbg(val3))),int(iy#*(ix#*rgbb(val1)+x2#*rgbb(val2))+y2#*(ix#*rgbb(val4)+x2#*rgbb(val3))))
   endif
EndFunction Rvalue