Sorry your browser is not supported!

sync on : sync rate 80
randomize timer()

#constant grav = 0.4

type T
    x# as float
    y# as float
    sx# as float
    sy# as float
    fade# as float
    col as integer
endtype
dim S(0) as T

`Media
box 0, 0, 4, 4, 0, 0, rgb(255, 255, 255), 0
box 0, 4, 4, 8, 0, 0, 0, rgb(255, 255, 255) 
box 4, 4, 8, 8, 0, rgb(255, 255, 255), 0, 0
box 4, 0, 8, 4, rgb(255, 255, 255), 0, 0, 0
get image 1, 0, 0, 8, 8, 1

`Start timer
t# = timer()
sp# = 20

do

    cls

    `Start particles
    if timer() - t# => sp#
    
        `reset timer
        t# = timer()

        `Makle a particle
        array insert at bottom S()
        b = array count(S())
        
        S(b).x# = mousex()
        S(b).y# = mousey()
        S(b).sx# = -5.0 + (rnd(1000)*0.01)
        S(b).sy# = -rnd(500)*0.01
        S(b).fade# = 255.0
        S(b).col = rgb(rnd(255), rnd(255), rnd(255))
        
    endif

    `Handle all particles
    if array count(S()) > 0
        for a = array count(S()) to 1 step -1
            HandleParticle(a)
        next a
        CleanUp()
    endif

    `Faster or slower particles
    sp# = 20
    if mouseclick() = 1 then sp# = 1
    if mouseclick() = 2 then sp# = 40

    sync
loop

function HandleParticle(a)
    
    `Update position
    inc S(a).sy#, grav
    inc S(a).x#, S(a).sx#
    inc S(a).y#, S(a).sy#

    `Handle fading
    dec S(a).fade#, 5
    
    `Draw particle
    sprite a, S(a).x#, S(a).y#, 1
    set sprite diffuse a, rgbr(S(a).col), rgbg(S(a).col), rgbb(S(a).col)
    set sprite alpha a, S(a).fade#
    
    `Delete particle
    if S(a).fade# <= 0
        delete sprite a
        array delete element S(), a
    endif
    
endfunction

function CleanUp()
    for i = array count(S()) + 1 to 7500
        if sprite exist(i) > 0 then delete sprite i
    next i
endfunction

set display mode 1024,768,32

sync on
autocam off
color backdrop rgb(180,180,250)
hide light 0
make light 1
set light range 1,300

sw#=screen width()
sh#=screen height()
aspectratio#=sw#/sh#

for n=1 to 100
  make object cube n,rnd(5)+1
  position object n,rnd(20)-10,rnd(20)-10,rnd(20)+20
  color object n,rnd(10000000)
next n

make object sphere 1000,1,80,80
position object 1000,0,0,1000
make light 2
set light range 2,20
position light 2,0,0,998
make camera 1
set camera range 1,0.05,10
color backdrop 1,0
position camera 1,0,0,998.9
set camera to image 1,2,128,128

hide mouse


do

create bitmap 1,128,128
paste image 2,0,0,1
get image 3,0,0,128,128,1
delete bitmap 1

if mousex()>sw#-128 then position mouse sw#-128,mousey()
if mousey()>sh#-128 then position mouse mousex(),sh#-128

get image 1,mousex(),mousey(),mousex()+128,mousey()+128/aspectratio#,1
texture object 1000,1
sprite 1,mousex(),mousey(),3
size sprite 1,128,128/aspectratio#

sync
loop

sync on : sync rate 0
hide mouse

`Some constants
#constant scrY screen height()
#constant scrX screen width()
#constant q = 20.0
#constant a = 0.5

`Make a matrix image
ink rgb(0, 0, 100), 0
for y = 1 to scrY
    line 0, a*y^2 - q*y, scrX, a*y^2 - q*y
next y
for x = 1 to scrX * 2
    line -scrX/4 + x*20, 0, -scrX + x*40, scrY
next x

get image 1, 0, 0, scrX, scrY, 1

`Some globals
global tx1 as integer
global ty1 as integer
global tx2 as integer
global ty2 as integer
global fade# as float
i# = 0.2

do

    `Background
    cls rgb(0, 0, fade#/4)
    inc fade#, i#
    if fade# => 255.0 then i# = -0.2
    if fade# <= 0.0 then i# = 0.2    
    
    `Paste background
    paste image 1, 0, 0, 1

    CalcTile(mousex(), mousey())
    DrawMouse()

    sync
loop

function CalcTile(x#, y#)

    `Get last coordinates
    tx2 = 0
    repeat

        `Increase tx2
        inc tx2
    
        `Get triangle coordinates
        fx# = -scrX/4 + (tx2*20)
        tx# = -scrX + (tx2*40)
        
        `Until the point is left of the line
        gx# = tx# + ((fx# - tx#) * (scrY - y#) / scrY)
        
    until gx# > x#
    
    y = 0
    repeat
    
        `Increase ty 2
        inc y
        
        `Get y coordinates
        gy# = a*y^2 - q*y
        
    until gy# > y#
    ty2 = y

    tx1 = tx2 - 1
    ty1 = ty2 - 1

endfunction

function DrawMouse()

    `Draw small circle
    ink rgb(255, 255, 255), 0
    circle mousex(), mousey(), 3

    `Draw white lines
    ink rgb(0, 0, 50), 0
    x11 = -scrX/4 + tx1*20
    x12 = -scrX + tx1*40
    x21 = -scrX/4 + tx2*20
    x22 = -scrX + tx2*40 
    y1# = a*ty1^2 - q*ty1
    y2# = a*ty2^2 - q*ty2

    `Draw after calculating the points
    x1# = x11 + ((x12 - x11) * y1# / scrY)
    x2# = x11 + ((x12 - x11) * y2# / scrY)
    x3# = x21 + ((x22 - x21) * y1# / scrY)
    x4# = x21 + ((x22 - x21) * y2# / scrY)


    `The box    

    `bottom face
    ink rgb(0, 0, 255), 0
    line x1#, y1#, x2#, y2#
    line x2#, y2#, x4#, y2#
    line x3#, y1#, x1#, y1#
    line x4#, y2#, x3#, y1#

    `Sides
    h# = (y2# - y1#)*0.75
    line x1#, y1#, x1#, y1# - h#
    line x2#, y2#, x2#, y2# - h#
    line x3#, y1#, x3#, y1# - h#
    line x4#, y2#, x4#, y2# - h#
    
    `Upper face
    line x1#, y1# - h#, x2#, y2# - h#
    line x2#, y2# - h#, x4#, y2# - h#
    line x3#, y1# - h#, x1#, y1# - h#
    line x4#, y2# - h#, x3#, y1# - h#

endfunction

set display mode 1024,768,32
sync on
sync rate 60
color backdrop 0
hide light 0
autocam off

sw#=screen width()
sh#=screen height()
k#=0.045
d#=0.85
g#=0.0005
m#=70.0
maxv#=2.0
s#=50

beads=22
dim x#(beads)
dim y#(beads)
dim vx#(beads)
dim vy#(beads)


create bitmap 1,sw#,sh#
make object sphere 1,10,50,50
set object diffuse 1,rgb(100,100,255)
position object 1,0,0,20
make light 1
set light range 1,30

sync
get image 2,0,0,sw#,sh#,1
delete object 1
sprite 1,0,0,2
size sprite 1,s#,s#
paste sprite 1,0,0
get image 1,0,0,s#,s#,1
delete bitmap 1
delete image 2
delete sprite 1

set camera to image 0,100,256,256
sprite 100,0,0,100
size sprite 100,sw#,sh#
set sprite 100,0,1
set sprite alpha 100,2
set sprite priority 100,1

position mouse sw#/2.0,sh#/2.0


for n=1 to beads
  x#(n)=sw#/2.0
  y#(n)=sh#/2.0
next n

st=timer()
do


t#=timer()
dtl#=t#-ot#
ot#=t#
inc dtt#,dtl#
inc l#
if l#=10 then l#=0
if l#=0 then dt#=dtt#/10.0:dtt#=0

x#(1)=mousex()
y#(1)=mousey()


for n=2 to beads

  dx1#=x#(n)-x#(n-1)
  if n<beads
    dx2#=x#(n+1)-x#(n)
  else
    dx2#=0
  endif
  dy1#=y#(n)-y#(n-1)
  if n<beads
    dy2#=y#(n+1)-y#(n)
  else
    dy2#=0
  endif
  if n=2
    dx1#=dx1#*5
    dy1#=dy1#*5
  endif
  ex#=dx2#-dx1#
  ey#=dy2#-dy1#
  fx#=k#*ex#
  fy#=(k#*ey#)+(m#*g#)
  ax#=fx#/m#
  ay#=fy#/m#
  inc vx#(n),ax#*dt#
  if vx#(n)>maxv# then vx#(n)=maxv#
  if vx#(n)<-maxv# then vx#(n)=-maxv#
  vx#(n)=vx#(n)*d#
  inc vy#(n),ay#*dt#
  if vy#(n)>maxv# then vy#(n)=maxv#
  if vy#(n)<-maxv# then vy#(n)=-maxv#
  vy#(n)=vy#(n)*d#
  if x#(n)>sw#-s# then x#(n)=sw#-s#-vx#(n)
  if x#(n)<0 then x#(n)=1+vx#(n)
  inc x#(n),vx#(n)*dt#
  if y#(n)>sh#-s# then y#(n)=sh#-s#-vy#(n)
  if y#(n)<0 then y#(n)=0
  inc y#(n),vy#(n)*dt#

  if c#<100 then y#(n)=sh#/2.0

  sprite n,x#(n),y#(n),1


next n

inc c#

sync
loop

set display mode 1024, 768, 32
hide mouse
sync on
sync rate 100
dim p(11, 20) as dword

for y=0 to 20
  for x=0 to 11
    read c
    if c=0 then p(x,y)=rgb(0,0,0)
    if c=1 then p(x,y)=rgb(0,1,0)
    if c=2 then p(x,y)=rgb(255,255,255)
  next y
next x

mag as float
d as integer
mag=5
d=0

dim m (5) as float
white as dword
white=rgb(255,255,255)
gd=1
g=200
rd=-1
r=100

do
  cls
  d=d+1
  for i=0 to 5
    m(i)=sin(d+i*4)*10
  next

  xc=mousex()
  yc=mousey()



lock pixels
  for y=0 to 20
    for x=0 to 11
       for i=0 to 5
         if p(x,y)=white
           dot (m(i)*x)+xc+rnd(10),(m(i)*y)+yc+rnd(10), rgb(r,g,i*50)
         endif
       next i
    next y
  next x
unlock pixels

  sync
if g=254 or g=1 then gd=-gd
g=g+gd

if r=254 or r=1 then rd=-rd
r=r+rd

loop

`mouse pointer
data  1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
data  1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
data  1, 2, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0
data  1, 2, 2, 1, 0, 0, 0, 0, 0, 0, 0, 0
data  1, 2, 2, 2, 1, 0, 0, 0, 0, 0, 0, 0
data  1, 2, 2, 2, 2, 1, 0, 0, 0, 0, 0, 0
data  1, 2, 2, 2, 2, 2, 1, 0, 0, 0, 0, 0
data  1, 2, 2, 2, 2, 2, 2, 1, 0, 0, 0, 0
data  1, 2, 2, 2, 2, 2, 2, 2, 1, 0, 0, 0
data  1, 2, 2, 2, 2, 2, 2, 2, 2, 1, 0, 0
data  1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 1, 0
data  1, 2, 2, 2, 2, 2, 2, 1, 1, 1, 1, 1
data  1, 2, 2, 2, 1, 2, 2, 1, 0, 0, 0, 0
data  1, 2, 2, 1, 1, 2, 2, 1, 0, 0, 0, 0
data  1, 2, 1, 0, 0, 1, 2, 2, 1, 0, 0, 0
data  1, 1, 0, 0, 0, 1, 2, 2, 1, 0, 0, 0
data  1, 0, 0, 0, 0, 0, 1, 2, 2, 1, 0, 0
data  0, 0, 0, 0, 0, 0, 1, 2, 2, 1, 0, 0
data  0, 0, 0, 0, 0, 0, 0, 1, 2, 2, 1, 0
data  0, 0, 0, 0, 0, 0, 0, 1, 2, 2, 1, 0
data  0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0

      line mousex(),mousey(),mousex()+(sin(hours*30)*(clSize/2)),mousey()-(cos(hours*30)*(clSize/2))

sync on : sync rate 0
hide mouse

`Constants
#constant nr = 1
#constant Trails = 100
#constant St = 5
#constant col = rgb(0, 128, 255)

`Arrays
type pos
    x as integer
    y as integer
endtype
dim T(1, Trails) as pos
dim S(1) as integer

do

    cls

    `Update first trail point
    T(1, 1).x = mousex()
    T(1, 1).y = mousey()

    `update trails
    UpdateTrails(1)

    sync
loop

function UpdateTrails(n)

    `If the trail has to update itself
    if timer() - S(n) > St
    
        `Reset timer
        S(n) = timer()

        `Update all trails
        for t = Trails to 2 step -1
        
            `Copy the x and y coordinates of its parent trail point
            T(1, t).x = T(1, t - 1).x
            T(1, t).y = T(1, t - 1).y
            
        next t
    endif

    `Draw all trail parts
    for t = 2 to Trails
    
        `Calculate appropriate color for the fading effect
        f# = 0.1 * Trails * 10.0 / (Trails - t)
        tcol = rgb( rgbr(col) / f#, rgbg(col) / f#, rgbb(col) / f#)
        ink tcol, 0
        
        `Connect it with its parent
        line T(1, t).x, T(1, t).y, T(1, t - 1).x, T(1, t - 1).y
    next t


endfunction

sync on : sync rate 0
hide mouse

`Constants
#constant nr = 10
#constant Trails = 30
#constant St = 5
#constant col = rgb(0, 128, 255)

`Arrays
type pos
    x as integer
    y as integer
endtype
dim T(nr, Trails) as pos
dim S(nr) as integer

dim P(nr) as pos

global angle# as float : angle# = 0.0
global radius# as float : radius# = 200.0
global speed# as float : speed# = 1.0

do

    cls

    `Update first trail point
    angle# = wrapvalue(angle# + speed#)
    
    `Calculate position
    for p = 1 to nr

        `Calculate positions
        P(p).x = mousex() + (cos(angle# + (360.0 / nr * p)) * radius#)
        P(p).y = mousey() + (sin(angle# + (360.0 / nr * p)) * radius#)

        `Update trail positions
        T(p, 1).x = curvevalue(P(p).x, T(p, 1).x, 10.0)
        T(p, 1).y = curvevalue(P(p).y, T(p, 1).y, 10.0)

    next p

    `update trails
    for a = 1 to nr
        UpdateTrails(a)
    next a

    sync
loop

function UpdateTrails(a)

    `If the trail has to update itself
    if timer() - S(a) > St
    
        `Reset timer
        S(a) = timer()

        `Update all trails
        for t = Trails to 2 step -1
        
            `Copy the x and y coordinates of its parent trail point
            T(a, t).x = T(a, t - 1).x
            T(a, t).y = T(a, t - 1).y
            
        next t
    endif

    `Draw all trail parts
    for t = 2 to Trails
    
        `Calculate appropriate color for the fading effect
        f# = 0.1 * Trails * 10.0 / (Trails - t)
        tcol = rgb( rgbr(col) / f#, rgbg(col) / f#, rgbb(col) / f#)
        ink tcol, 0
        
        `Connect it with its parent
        line T(a, t).x, T(a, t).y, T(a, t - 1).x, T(a, t - 1).y
    next t

endfunction

sync on
sync rate 0
cls
type particle_type
   color
   x as float
   y as float
   vx as float
   vy as float
   exist as boolean
   creation_time
endtype
global max_particle_amount
max_particle_amount=3000
dim particle(max_particle_amount) as particle_type
global time as float
oldtimer=timer()
global r as float
global last_tick
do
   cls
   time=(timer()-oldtimer)/1000.0
   oldtimer=timer()
   inpt()
   update_particles()
   sync
loop

function inpt()
   inc r,12
   h#=r/390.0
   while h#>1
      dec h#
   endwhile
   color=hsl(h#,1,0.5)
   add_particle(mousex(),mousey(),40.0*cos(r),40.0*sin(r),color)
endfunction

function update_particles()
   for n=1 to max_particle_amount
      if particle(n).exist
         particle(n).x=particle(n).x+particle(n).vx*time
         particle(n).y=particle(n).y+particle(n).vy*time
         particle(n).vy=particle(n).vy*1.01
         particle(n).vx=particle(n).vx*1.01
         ink particle(n).color,0
         box particle(n).x,particle(n).y,particle(n).x+2,particle(n).y+2
         if timer()>particle(n).creation_time+3000 or particle(n).x<0 or particle(n).x>screen width() or particle(n).y<0 or particle(n).y>screen height()
            particle(n).exist=0
         endif
      endif
   next n
endfunction

function add_particle(x#,y#,vx#,vy#,c)
   n=freeparticle()
   particle(n).exist=1
   particle(n).x=x#
   particle(n).y=y#
   particle(n).vx=vx#
   particle(n).vy=vy#
   particle(n).color=c
   particle(n).creation_time=timer()
endfunction

function freeparticle()
   n=1
   while particle(n).exist=1 and n<max_particle_amount
      inc n
   endwhile
endfunction n


function hsl(H#,S#,L#)

   local r
   local g
   local b
   if ( S# = 0 )                       `HSL values = 0 ÷ 1

      rR# = L# * 255                      `RGB results = 0 ÷ 255
      rG# = L# * 255
      rB# = L# * 255

   else

         if ( L# < 0.5 )
            var_2# = L# * ( 1 + S# )
         else

            var_2# = ( L# + S# ) - ( S# * L# )
         endif

         var_1# = (2 * L#) - var_2#

         R = 255.0 * Hue_2_RGB( var_1#, var_2#, H# + ( 1.0 / 3.0 ) )
         G = 255.0 * Hue_2_RGB( var_1#, var_2#, H# )
         B = 255.0 * Hue_2_RGB( var_1#, var_2#, H# - ( 1.0 / 3.0 ) )

   endif
color=rgb(r,g,b)
endfunction color

Function Hue_2_RGB( v1#, v2#, vH# )

   if ( vH# < 0 ) then vH# = vH# + 1
   if ( vH# > 1 ) then vH# = vH# - 1
   if ( ( 6 * vH# ) < 1 ) then res#=( v1# + ( v2# - v1# ) * 6.0 * vH# ): exitfunction ( res# )
   if ( ( 2 * vH# ) < 1 ) then exitfunction ( v2# )
   if ( ( 3 * vH# ) < 2 ) then res#=( v1# + ( v2# - v1# ) * ( ( 2.0 / 3.0 ) - vH# ) * 6.0 ):exitfunction ( res# )

Endfunction v1#

`Mouse Demo
`thinkdigital
sync on
sync rate 0
hide mouse
dim color(50)
for i = 1 to 50
    color(i) = rgb(255-i*15,255-i*4,i*0.8)
next i
`global a
global dist#
global size# = 10.00
create bitmap 1,screen width(),screen height()
render = 0

do
cls
    size# = 10.00
    dist# = 0
    set current bitmap 1
    for i = 1 to 50
      for a = 1 to 360 step 2
        ink color(i),0
        box mousex() + sin(a)*dist#,mousey() + cos(a)*dist#,mousex() + (sin(a)*dist#)+size#,mousey() + (cos(a)*dist#)+size#
      next a
      dist# = dist# + size#
      size# = size# + 10
    next i
    inc a,3
    copy bitmap 1,0

sync:loop

Sync On:Sync Rate 0:AutoCam Off
Hide Mouse

Make Object Cone 1,2
Make Object Cylinder 2,1
Scale Object 2,100,200,100
Make Mesh From Object 2,2
Delete Object 2
Add Limb 1,1,2
Offset Limb 1,1,0,-2,0

Pitch Object Down 1,90
Fix Object Pivot 1
Scale Object 1,25,25,25
Set Object Cull 1,0
d#=5

Do
   Pick Screen MouseX(),MouseY(),d#
   Position Object 1,Get Pick Vector X(),Get Pick Vector Y(),Get Pick Vector Z()
   d#=d#+MouseMoveZ()*.01
   If Mouseclick()=1
      o=Free_Particle()
      Make Object Plain o,.1,.1
      Color Object o,rgb(Rnd(255),Rnd(255),Rnd(255))
      Set Object Emissive o,rgb(10,10,10)
      Position Object o,Object Position x(1),Object Position y(1),Object Position Z(1)+.25
   Endif
   Set Cursor 0,0
   Print screen fps()
   Sync
Loop



Function Free_Particle()
   i=100
   Do
      If Object Exist(i)=0 Then Exit
      If i=500 Then Exit
      i=i+1
   Loop
   if i=500
      If Object Exist(100) Then Delete Object 100
      i=100
   endif
   If Object Exist(i+1) Then Delete Object i+1
Endfunction i

`screen capture adapted from code by Jukuma
SET WINDOW LAYOUT 0, 0, 0
sync on
sync rate 100
hide mouse

#CONSTANT user32 = 1
#CONSTANT gdi32  = 2

LOAD DLL "user32.dll", user32
LOAD DLL "gdi32.dll", gdi32

HIDE WINDOW

  hDsk  = CALL DLL(user32, "GetDesktopWindow")
  hDC   = CALL DLL(user32, "GetWindowDC", hDsk)
  DskW  = CALL DLL(gdi32, "GetDeviceCaps", hDC, 8)
  DskH  = CALL DLL(gdi32, "GetDeviceCaps", hDC, 10)

set display mode DskW, DskH, 32
CC as dword

create bitmap 2, 1024, 768

set current bitmap 2
lock pixels
 for y=1 to DskH
 for x=1 to DskW
   CC = CALL DLL(gdi32, "GetPixel", hDC, X, Y)
   DOT X, Y, RGB(RGBB(CC), RGBG(CC), RGBR(CC))
 next x
 next y
unlock pixels

set current bitmap 0
cls

CALL DLL user32, "ReleaseDC", hDsk, hDC

DELETE DLL user32
DELETE DLL gdi32

RESTORE WINDOW
`end screen capture


create bitmap 1, 1024, 768


#constant numdots   5000
#constant itterations 20
#constant times 12


sync on
sync rate 100

type mytype
  x as float
  y as float
  endx as integer
  endy as integer
  itt as integer
endtype

dim dots(numdots) as mytype
dim inuse(numdots) as integer
dim num(times) as integer


for d=0 to numdots
  inuse(d) =1
next d

do
  copy bitmap 1, 0
  x=mousex()
  y=mousey()

for a=1 to times
  num(a)=getfree()
  if num(a)>=0
    inuse(num(a))=1
    dots(num(a)).x=x+cos(rnd(360))*rnd(200)
    dots(num(a)).y=y+sin(rnd(360))*rnd(200)
    dots(num(a)).endx=x+rnd(20)-10
    dots(num(a)).endy=y+rnd(20)-10
    dots(num(a)).itt=1
  endif
next a

set current bitmap 1
  for d=1 to numdots
    if inuse(d)=1

      dots(d).x=curvevalue(dots(d).endx, dots(d).x, itterations)
      dots(d).y=curvevalue(dots(d).endy, dots(d).y, itterations)
      inc dots(d).itt
      if abs(dots(d).x-dots(d).endx)<.5 and abs(dots(d).y-dots(d).endy)<.5
        inuse(d)=0
      copy bitmap 2,dots(d).endx-5, dots(d).endy-5,dots(d).endx+5,dots(d).endy+5, 1, dots(d).endx-5, dots(d).endy-5,dots(d).endx+5,dots(d).endy+5

      endif
    endif
  next d

set current bitmap 0
  for d=1 to numdots
    if inuse(d)=1
      copy bitmap 2,dots(d).endx-5, dots(d).endy-5,dots(d).endx+5,dots(d).endy+5, 0, dots(d).x-5, dots(d).y-5,dots(d).x+5,dots(d).y+5

    endif
  next d

  sync
loop



function getfree()
  free=-1
    for x=0 to numdots
      if inuse(x)=0 then free=x
    next x
endfunction free

sync on
sync rate 0
cls
xcenter=screen width()/2
ycenter=screen height()/2
power#=12500
dim gridbrightness#(screen width()/10,screen height()/10)
do
   cls
   inc r#,7
   inc r2#,1+(mousemovex()^2+mousemovey()^2)/17.0^2
   inc r3#,4.26
   n=cos(r#)*90
   xcenter=mousex()
   ycenter=mousey()
   totalbrightness#=0
   for sx=0 to screen width() step 10
      for sy=0 to screen height() step 10
rem translate coordinates
         x1#=(sx-xcenter)*0.05
         y1#=(sy-ycenter)*0.05
rem rotate coordinates
         x#=cos(r2#)*x1#+sin(r2#)*y1#
         y#=sin(r2#)*x1#-cos(r2#)*y1#
rem calculate brightness
         brightness#=power#/(abs(x#^2-y#^2+n)+1.0)
         brightness#=brightness#/255.0
         if brightness#>1
            brightness#=1
         endif
rem calculate color
         inc totalbrightness#,brightness#
         if brightness#>=gridbrightness#(sx/10,sy/10)
            gridbrightness#(sx/10,sy/10)=brightness#
         else
            brightness#=gridbrightness#(sx/10,sy/10)
         endif

         color=hsl(r2#/360.0,1,0.5)
         color=rgb(rgbr(color)*brightness#,rgbg(color)*brightness#,rgbb(color)*brightness#)
         ink color,0
rem render tile
            box sx,sy,sx+9,sy+9
         gridbrightness#(sx/10,sy/10)=gridbrightness#(sx/10,sy/10)*0.87
      next sy
   next sx
rem mouseclick
   if mouseclick()=0
      m#=m#/1.2
   else
      inc m#,60
   endif
   m#=m#/1.03
   if m#<0 then m#=0

rem balance the brightness
   power#=power#+(800+m#+300.0*cos(r3#)-totalbrightness#)*0.9
   sync
loop


function hsl(H#,S#,L#)

   local r
   local g
   local b
   while h#>1
      dec h#,1
   endwhile
   while h#<0
      inc h#,1
   endwhile
   if ( S# = 0 )                       `HSL values = 0 ÷ 1

      rR# = L# * 255                      `RGB results = 0 ÷ 255
      rG# = L# * 255
      rB# = L# * 255

   else

         if ( L# < 0.5 )
            var_2# = L# * ( 1 + S# )
         else

            var_2# = ( L# + S# ) - ( S# * L# )
         endif

         var_1# = (2 * L#) - var_2#

         R = 255.0 * Hue_2_RGB( var_1#, var_2#, H# + ( 1.0 / 3.0 ) )
         G = 255.0 * Hue_2_RGB( var_1#, var_2#, H# )
         B = 255.0 * Hue_2_RGB( var_1#, var_2#, H# - ( 1.0 / 3.0 ) )

   endif
color=rgb(r,g,b)
endfunction color

Function Hue_2_RGB( v1#, v2#, vH# )

   if ( vH# < 0 ) then vH# = vH# + 1
   if ( vH# > 1 ) then vH# = vH# - 1
   if ( ( 6 * vH# ) < 1 ) then res#=( v1# + ( v2# - v1# ) * 6.0 * vH# ): exitfunction ( res# )
   if ( ( 2 * vH# ) < 1 ) then exitfunction ( v2# )
   if ( ( 3 * vH# ) < 2 ) then res#=( v1# + ( v2# - v1# ) * ( ( 2.0 / 3.0 ) - vH# ) * 6.0 ):exitfunction ( res# )

Endfunction v1#

Crit for his first entry! Beautiful, when the circles all close in it looks like an animated kids drawing, which is a nice effect. Would be perfect for an in-game menu.

Sven B for his first and fourth("version 2") entries
Lower Logic for both of his entries (spiral of hypnosis, and disco thing)
Acelepage for his targeting type entry
RiiDii for his fourth entry (magnifying glass with zoom and color adjustments) 

tron reference!

set display mode 1024, 768, 32
sync on
sync rate 100


`make bitmap 1
create bitmap 1,1024, 768
set current bitmap 1
ink rgb(255,255,255), 0
box 0,0,1024,768, RGB(255,0,0),RGB(0,255,0),RGB(0,0,255),RGB(255,255,0)
for a=1 to 15
  x=rnd(1024)
  y=rnd(768)
  text x,y, "press any key"
next a

for x=1 to 1024 step 50
  line x,1,x,768
  line 1,x,1024, x
next x


`make bitmap 2
create bitmap 2,1024, 768
set current bitmap 2
ink rgb(255,255,255), 0
box 0,0,1024,768, RGB(255,0,255),RGB(0,255,255),RGB(255,0,0),RGB(0,0,255)
for a=1 to 15
  x=rnd(1024)
  y=rnd(768)
  text x,y, "Bitmap 2"
next a


set current bitmap 0
copy bitmap 1,0
sync:sync

`main loop
do
  wait key
  curtain(1,2,1.0)
  wait key
  slide(2,1,2.0)
loop


function curtain(b1, b2, speed as float)
copy bitmap b1,0

n as float
going=1
dim ypos(1024) as float
for x=1 to 1024
  ypos(x)=0
next x
  while going=1

    copy bitmap b2,0
    going=0
    for x=1 to 1024
      n=.08*(sin(x*2.0)+20.0)

      ypos(x)=ypos(x)+(n*speed)
      if ypos(x)<768 then going=1
      `COPY BITMAP From,Left,Top,Right,Bottom,       To, Left,Top,     Right,Bottom
  `    copy bitmap  1,x,0,x+1,768-ypos(x),0,x,ypos(x),x+1,768
      copy bitmap  b1,x,ypos(x),x+1,768,0,x,0,x+1,768-ypos(x)
    next x
    text 10,10, str$(screen fps())
    sync
  endwhile
endfunction


function slide(b1, b2, speed as float)
copy bitmap b1,0

going=1
dim ypos(1024) as float
for x=1 to 1024
  ypos(x)=0
next x
  while going=1

    copy bitmap b2,0
    going=0
    for x=1 to 1024
      ypos(x)=ypos(x)+rnd(speed*4)
      if ypos(x)<768 then going=1
      copy bitmap  b1,x,0,x+1,768-ypos(x),0,x,ypos(x),x+1,768
    next x
    text 10,10, str$(screen fps())
    sync
  endwhile
endfunction

`The usual setup
hide mouse
autocam off
sync on
sync rate 0
randomize timer()
backdrop off

`Make the images
box 0,0,255,255,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,0,0,255,255,1
box 0,0,255,255,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 2,0,0,255,255,1
cls
box 0,0,screen width(),screen height(),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))
for i=1 to 20
   make object sphere i,rnd(19)+1,rnd(2)+3,rnd(2)+3
   texture object i,1
   position object i,rnd(100)-50,rnd(100)-50,rnd(100)
   ink rgb(rnd(255),rnd(255),rnd(255)),0
   text rnd(screen width()),rnd(screen height()),"First image!"
next i
sync
get image 1,0,0,screen width(),screen height(),1
delete objects 1,20
cls
box 0,0,screen width(),screen height(),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))
for i=1 to 20
   make object sphere i,rnd(19)+1,rnd(2)+3,rnd(2)+3
   texture object i,2
   position object i,rnd(100)-50,rnd(100)-50,rnd(100)
   ink rgb(rnd(255),rnd(255),rnd(255)),0
   text rnd(screen width()),rnd(screen height()),"Second image!"
next i
sync
get image 2,0,0,screen width(),screen height(),1
delete objects 1,20
cls

`necessary setup
type coord
   x as integer
   y as integer
endtype
sprite 1,0,0,1

`main loop
do
sync
if rightkey()=1
   if sprite image(1)=1
      right_slide(1,2)
   else
      right_slide(1,1)
   endif
endif
if leftkey()=1
   if sprite image(1)=1
      left_slide(1,2)
   else
      left_slide(1,1)
   endif
endif
if upkey()=1
   if sprite image(1)=1
      up_slide(1,2)
   else
      up_slide(1,1)
   endif
endif
if downkey()=1
   if sprite image(1)=1
      down_slide(1,2)
   else
      down_slide(1,1)
   endif
endif
if spacekey()=1
   if sprite image(1)=1
      random(1,2)
   else
      random(1,1)
   endif
endif
loop

`spr is sprite you want it to affect
`img is the image you want the sprite to become
function right_slide(spr,img)
make memblock from image 1,sprite image(spr)
make memblock from image 2,img
delete image img
make image from memblock img,1
set sprite image spr,img
width=memblock dword(1,0)
height=memblock dword(1,4)
for x=0 to width-1
   for y=0 to height-1
      write memblock dword 1,(y*width+x)*4+12,memblock dword(2,(y*width+x)*4+12)
   next y
   make image from memblock img,1
   sync
next x
delete memblock 1
delete memblock 2
endfunction

function left_slide(spr,img)
make memblock from image 1,sprite image(spr)
make memblock from image 2,img
delete image img
make image from memblock img,1
set sprite image spr,img
width=memblock dword(1,0)
height=memblock dword(1,4)
for x=width-1 to 0 step -1
   for y=0 to height-1
      write memblock dword 1,(y*width+x)*4+12,memblock dword(2,(y*width+x)*4+12)
   next y
   make image from memblock img,1
   sync
next x
delete memblock 1
delete memblock 2
endfunction

function up_slide(spr,img)
make memblock from image 1,sprite image(spr)
make memblock from image 2,img
delete image img
make image from memblock img,1
set sprite image spr,img
width=memblock dword(1,0)
height=memblock dword(1,4)
for y=height-1 to 0 step -1
   for x=0 to width-1
      write memblock dword 1,(y*width+x)*4+12,memblock dword(2,(y*width+x)*4+12)
   next y
   make image from memblock img,1
   sync
next x
delete memblock 1
delete memblock 2
endfunction

function down_slide(spr,img)
make memblock from image 1,sprite image(spr)
make memblock from image 2,img
delete image img
make image from memblock img,1
set sprite image spr,img
width=memblock dword(1,0)
height=memblock dword(1,4)
for y=0 to height-1
   for x=0 to width-1
      write memblock dword 1,(y*width+x)*4+12,memblock dword(2,(y*width+x)*4+12)
   next y
   make image from memblock img,1
   sync
next x
delete memblock 1
delete memblock 2
endfunction

function random(spr,img)
make memblock from image 1,sprite image(spr)
make memblock from image 2,img
delete image img
make image from memblock img,1
set sprite image spr,img
width=memblock dword(1,0)
height=memblock dword(1,4)
local dim points(width*height) as coord
l=0
for x=0 to width-1
   for y=0 to height-1
      inc l
      points(l).x=x
      points(l).y=y
   next y
next x
for l=0 to 1000000
   a=rnd(width*height)
   b=rnd(width*height)
   x1=points(a).x
   y1=points(a).y
   x2=points(b).x
   y2=points(b).y
   points(a).x=x2
   points(a).y=y2
   points(b).x=x1
   points(b).y=y1
next l
for l=0 to width*height
   x=points(l).x
   y=points(l).y
   write memblock dword 1,(y*width+x)*4+12,memblock dword(2,(y*width+x)*4+12)
   if l mod 200=0
      make image from memblock img,1
      sync
   endif
next l
delete memblock 1
delete memblock 2
endfunction

sync on

type pix

    xpo as float
    ypo as float
    xmo as float
    ymo as float
    col as dword

endtype

global w
global h

load bitmap "Bit12.bmp",1
load bitmap "Bit22.bmp",2

set current bitmap 0

copy bitmap 1,0

make memblock from bitmap 1,1

global dim pixels(screen width(),screen height()) as pix

get_pixels()

do

    move_pixels()
    sync

loop

function get_pixels()

    w = screen width()
    h = screen height()
    hw = w/2
    hh = h/2

    for y = 0 to h-1
        for x = 0 to w-1
            p = (((y*w)+x)*4)+12
            pixels(x,y).xpo = x
            pixels(x,y).ypo = y
            pixels(x,y).xmo = (x-hw)*0.04
            pixels(x,y).ymo = (((y-hh)*0.01)-2.0)+(((x-hw)*0.008)^2)
            pixels(x,y).col = rgb(memblock byte(1,p+2),memblock byte(1,p+1),memblock byte(1,p))
        next x
    next y

endfunction

function move_pixels()

    copy bitmap 2,0
`    cls 0
    lock pixels

    for y = 0 to h
        for x = 0 to w
            inc pixels(x,y).xpo,pixels(x,y).xmo
            inc pixels(x,y).ypo,pixels(x,y).ymo
            inc pixels(x,y).ymo,0.5
            pixels(x,y).col = rgb(maxm(rgbr(pixels(x,y).col)+5),maxm(rgbg(pixels(x,y).col)+5),rgbb(pixels(x,y).col))
            dot pixels(x,y).xpo,pixels(x,y).ypo,pixels(x,y).col
        next x
    next y

    unlock pixels

endfunction

function maxm(value)

    if value > 255 then value = 255

endfunction value

sync on

load image "image1.bmp",1,1
load image "image2.bmp",2,1

current_image=2
hidden_image=1

do
   paste image current_image,0,0
   sync
   if spacekey()
      fade(hidden_image,current_image)

      temp=current_image
      current_image=hidden_image
      hidden_image=temp
   endif
loop

function fade(b1,b2)
sprite 1,0,0,b1
sprite 2,0,0,b2

   for a=255 to 0 step -1
      set sprite alpha 2,a
      sync
   next a
endfunction

set display mode 1024, 768, 32
sync on
sync rate 100


`make bitmap 1
create bitmap 1,1024, 768
set current bitmap 1
ink rgb(255,255,255), 0
box 0,0,1024,768, RGB(255,0,0),RGB(0,255,0),RGB(0,0,255),RGB(255,255,0)
for a=1 to 15
  x=rnd(1024)
  y=rnd(768)
  text x,y, "press any key"
next a

for x=1 to 1024 step 50
  line x,1,x,768
  line 1,x,1024, x
next x


`make bitmap 2
create bitmap 2,1024, 768
set current bitmap 2
ink rgb(255,255,255), 0
box 0,0,1024,768, RGB(255,0,255),RGB(0,255,255),RGB(255,0,0),RGB(0,0,255)
for a=1 to 15
  x=rnd(1024)
  y=rnd(768)
  text x,y, "Bitmap 2"
next a


set current bitmap 0
copy bitmap 1,0
sync:sync


b1=1
b2=2

`main loop
do
  wait key
  randomdots(b2)
  wait key
  b1=(b1=1)+1
  b2=(b2=1)+1
  slide(b1,b2,2.0)
  wait key
  b1=(b1=1)+1
  b2=(b2=1)+1
  spin(b2)
  Wait Key
  b1=(b1=1)+1
  b2=(b2=1)+1
  curtain(b1,b2,1.0)
  b1=(b1=1)+1
  b2=(b2=1)+1
loop


function curtain(b1, b2, speed as float)
copy bitmap b1,0

n as float
going=1
dim ypos(1024) as float
for x=1 to 1024
  ypos(x)=0
next x
  while going=1

    copy bitmap b2,0
    going=0
    for x=1 to 1024
      n=.08*(sin(x*2.0)+20.0)

      ypos(x)=ypos(x)+(n*speed)
      if ypos(x)<768 then going=1
      `COPY BITMAP From,Left,Top,Right,Bottom,       To, Left,Top,     Right,Bottom
  `    copy bitmap  1,x,0,x+1,768-ypos(x),0,x,ypos(x),x+1,768
      copy bitmap  b1,x,ypos(x),x+1,768,0,x,0,x+1,768-ypos(x)
    next x
    text 10,10, str$(screen fps())
    sync
  endwhile
endfunction

function spin(b2)
   if bitmap exist(b2)=0 Then Exitfunction
   Set Current Bitmap b2
   Get Image 102,0,0,1024,768
   Set Current Bitmap 0
   Sprite 102,0,0,102
   Set Sprite 102,0,0
   r=0

   a=ATANFULL(-512,-384)

   s#=2.0
   ds#=98.0/360.0
   Do
      Scale Sprite 102,s#
      sx#=640.0*(s#/100.0)
      sy#=384.0*(s#/100.0)
      sd#=sqrt(sx#*sx#+sy#*sy#)
      x=sin(a-r)*sd#+513
      y=cos(a-r)*sd#+385
      Sprite 102,x,y,102
      Rotate Sprite 102,r
      r=r+2
      s#=s#+ds#
      if s#>100
         Exit
      endif
      Sync
   Loop

   Sprite 102,0,0,102
   Scale Sprite 102,100
   Rotate Sprite 102,0
   Paste Sprite 102,0,0
   Delete Sprite 102
   Sync
Endfunction

function slide(b1, b2, speed as float)
copy bitmap b1,0

going=1
dim ypos(1024) as float
for x=1 to 1024
  ypos(x)=0
next x
  while going=1

    copy bitmap b2,0
    going=0
    for x=1 to 1024
      ypos(x)=ypos(x)+rnd(speed*4)
      if ypos(x)<768 then going=1
      copy bitmap  b1,x,0,x+1,768-ypos(x),0,x,ypos(x),x+1,768
    next x
    text 10,10, str$(screen fps())
    sync
  endwhile
endfunction

function randomdots(b1)
   s=((Bitmap Width(b1)/50)+1)*((Bitmap Height(b1)/50)+1)
   Dim c(s) as pixels
   index=0
   for j = 0 to Bitmap Height(b1)/50
      for i = 0 to Bitmap Width(b1)/50
         c(index).x=i*50
         if c(index).x>Bitmap Width(b1)-50 then c(index).x=Bitmap Width(b1)-50
         c(index).y=j*50
         if c(index).y>Bitmap Height(b1)-50 then c(index).y=Bitmap Height(b1)-50
         index=index+1
      next i
   next j
   While Array Count(c())>-1
      For a=1 to 2
         ac=Array Count(c())
         if ac<0 Then Exit
         Set Current Bitmap b1
         i=rnd(ac)
         Get Image 110,c(i).x,c(i).y,c(i).x+50,c(i).y+50,1
         Set Current Bitmap 0
         Paste Image 110,c(i).x,c(i).y
         Array Delete Element c(),i
      Next a
      Sync
   Endwhile
   Sync
Endfunction


Type Pixels
   x as integer
   y as integer
Endtype

set display mode 1024, 768, 32
sync on
sync rate 100


`make bitmap 1
create bitmap 1,1024, 768
set current bitmap 1
ink rgb(255,255,255), 0
box 0,0,1024,768, RGB(255,0,0),RGB(0,255,0),RGB(0,0,255),RGB(255,255,0)
for a=1 to 15
  x=rnd(1024)
  y=rnd(768)
  text x,y, "press any key"
next a

for x=1 to 1024 step 50
  line x,1,x,768
  line 1,x,1024, x
next x


`make bitmap 2
create bitmap 2,1024, 768
set current bitmap 2
ink rgb(255,255,255), 0
box 0,0,1024,768, RGB(255,0,255),RGB(0,255,255),RGB(255,0,0),RGB(0,0,255)
for a=1 to 15
  x=rnd(1024)
  y=rnd(768)
  text x,y, "Bitmap 2"
next a


set current bitmap 0
copy bitmap 1,0
sync:sync


b1=1
b2=2

`main loop
do
  wait key
  fade(b2)
  wait key
  b1=(b1=1)+1
  b2=(b2=1)+1
  randomdots(b2)
  wait key
  b1=(b1=1)+1
  b2=(b2=1)+1
  slide(b1,b2,2.0)
  wait key
  b1=(b1=1)+1
  b2=(b2=1)+1
  spin(b2)
  Wait Key
  b1=(b1=1)+1
  b2=(b2=1)+1
  curtain(b1,b2,1.0)
  Wait Key
  b1=(b1=1)+1
  b2=(b2=1)+1
  fade(b2)
  b1=(b1=1)+1
  b2=(b2=1)+1
loop


function curtain(b1, b2, speed as float)
copy bitmap b1,0

n as float
going=1
dim ypos(1024) as float
for x=1 to 1024
  ypos(x)=0
next x
  while going=1

    copy bitmap b2,0
    going=0
    for x=1 to 1024
      n=.08*(sin(x*2.0)+20.0)

      ypos(x)=ypos(x)+(n*speed)
      if ypos(x)<768 then going=1
      `COPY BITMAP From,Left,Top,Right,Bottom,       To, Left,Top,     Right,Bottom
  `    copy bitmap  1,x,0,x+1,768-ypos(x),0,x,ypos(x),x+1,768
      copy bitmap  b1,x,ypos(x),x+1,768,0,x,0,x+1,768-ypos(x)
    next x
    text 10,10, str$(screen fps())
    sync
  endwhile
endfunction

function spin(b2)
   if bitmap exist(b2)=0 Then Exitfunction
   Set Current Bitmap b2
   Get Image 102,0,0,1024,768
   Set Current Bitmap 0
   Sprite 102,0,0,102
   Set Sprite 102,0,0
   r=0

   a=ATANFULL(-512,-384)

   s#=2.0
   ds#=98.0/360.0
   Do
      Scale Sprite 102,s#
      sx#=640.0*(s#/100.0)
      sy#=384.0*(s#/100.0)
      sd#=sqrt(sx#*sx#+sy#*sy#)
      x=sin(a-r)*sd#+513
      y=cos(a-r)*sd#+385
      Sprite 102,x,y,102
      Rotate Sprite 102,r
      r=r+2
      s#=s#+ds#
      if s#>100
         Exit
      endif
      Sync
   Loop

   Sprite 102,0,0,102
   Scale Sprite 102,100
   Rotate Sprite 102,0
   Paste Sprite 102,0,0
   Delete Sprite 102
   Sync
Endfunction

function slide(b1, b2, speed as float)
copy bitmap b1,0

going=1
dim ypos(1024) as float
for x=1 to 1024
  ypos(x)=0
next x
  while going=1

    copy bitmap b2,0
    going=0
    for x=1 to 1024
      ypos(x)=ypos(x)+rnd(speed*4)
      if ypos(x)<768 then going=1
      copy bitmap  b1,x,0,x+1,768-ypos(x),0,x,ypos(x),x+1,768
    next x
    text 10,10, str$(screen fps())
    sync
  endwhile
endfunction

function randomdots(b1)
   s=((Bitmap Width(b1)/50)+1)*((Bitmap Height(b1)/50)+1)
   Dim c(s) as pixels
   index=0
   for j = 0 to Bitmap Height(b1)/50
      for i = 0 to Bitmap Width(b1)/50
         c(index).x=i*50
         if c(index).x>Bitmap Width(b1)-50 then c(index).x=Bitmap Width(b1)-50
         c(index).y=j*50
         if c(index).y>Bitmap Height(b1)-50 then c(index).y=Bitmap Height(b1)-50
         index=index+1
      next i
   next j
   While Array Count(c())>-1
      For a=1 to 2
         ac=Array Count(c())
         if ac<0 Then Exit
         Set Current Bitmap b1
         i=rnd(ac)
         Get Image 110,c(i).x,c(i).y,c(i).x+50,c(i).y+50,1
         Set Current Bitmap 0
         Paste Image 110,c(i).x,c(i).y
         Array Delete Element c(),i
      Next a
      Sync
   Endwhile
   Sync
Endfunction


Type Pixels
   x as integer
   y as integer
Endtype

function fade(b2)
Get Image 1,0,0,Screen Width(),Screen Height(),1
Set Current Bitmap b2
Get Image 2,0,0,Screen Width(),Screen Height(),2
Set Current Bitmap 0
sprite 1,0,0,1
sprite 2,0,0,2
   for a=0 to 255
      set sprite alpha 2,a
      sync
   next a
Delete Sprite 1
Paste Sprite 2,0,0
Delete Sprite 2
Sync
endfunction

function make2images()

autocam off
color backdrop 0
position camera 0,0,0
for image=1 to 2
for n=1 to 500
if image=1 then make object box n,rnd(10)+1,rnd(10)+1,rnd(10)+1
if image=2 then make object sphere n,rnd(7)+1,20,20
color object n,rnd(1000000000)
position object n,rnd(100)-50,rnd(100)-50,rnd(100)+50
next n
sync
get image image,0,0,screen width(),screen height(),1
delete objects 1,500
next image

endfunction

sync on
sync rate 7

make2images()

do
  pixelize(1,2)
  wait key
  pixelize(2,1)
  wait key
loop


function pixelize(img1,img2)
  sync on
  resstep=9
  fadein=0
  fadeimage=img1
  paste image fadeimage,0,0
  sync

  while fadein<>2
    if (resstep<256) AND (resstep>8)
      if resstep=9 then resstep=8
      paste image fadeimage,0,0
      for countx=0 to 800/resstep step 1
        x=countx*resstep
        for county=0 to 600/resstep step 1

          `simple and fast
          y=county*resstep
          ink point(x+(resstep/2),y+(resstep/2)),rgb(0,0,0)
          box x,y,x+resstep,y+resstep

          `better, as it averages some pixels, but slower
          remstart
          currcolor=point(x,y)
          for countpixx=0 to (resstep/(resstep/8)) step 1
            pixx=countpixx*(resstep/8)
            for countpixy=0 to (resstep/(resstep/8)) step 1
              pixy=countpixy*(resstep/8)
              pointclr=point(x+pixx,y+pixy)
              currcolor=rgb((rgbr(pointclr)+rgbr(currcolor))/2,(rgbg(pointclr)+rgbg(currcolor))/2,(rgbb(pointclr)+rgbb(currcolor))/2)
            next pixy
          next pixx
          ink currcolor,rgb(0,0,0)
          box x,y,x+pixx,y+pixy
          remend

        next y
      next x
    select fadein
      case 0 : resstep=(resstep*2) : endcase
      case 1 : resstep=(resstep/2) : endcase
    endselect
    sync
  else
    select fadein
      case 0
        fadeimage=img2
        fadein=1
        resstep=(resstep/2)
      endcase
      case 1
        paste image fadeimage,0,0
        sync
        fadein=2
      endcase
    endselect
  endif
endwhile
endfunction

function make2images()

autocam off
color backdrop 0
position camera 0,0,0
for image=1 to 2
for n=1 to 500
if image=1 then make object box n,rnd(10)+1,rnd(10)+1,rnd(10)+1
if image=2 then make object sphere n,rnd(7)+1,20,20
color object n,rnd(1000000000)
position object n,rnd(100)-50,rnd(100)-50,rnd(100)+50
next n
sync
get image image,0,0,screen width(),screen height(),1
delete objects 1,500
next image

endfunction