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