Code : Tout sélectionner
; Codé par SPH(2006) sur PB4
InitSprite()
InitMouse()
InitKeyboard()
Procedure.l FPS() 
  Shared Zeit, Frames, Ausgabe 
  If GetTickCount_() < Zeit + 1000 
    Frames + 1 
  Else 
    Ausgabe = Frames 
    Frames  = 0 
    Zeit    = GetTickCount_() 
  EndIf 
  If Ausgabe > 0 
    ProcedureReturn Ausgabe 
  Else 
    ProcedureReturn 60 
  EndIf  
EndProcedure 
SetPriorityClass_ ( GetCurrentProcess_ (), #IDLE_PRIORITY_CLASS )
;- Counter vorbereiten 
Define.f HighCounter, CounterMerken, Zeit2 
Frequ.LARGE_INTEGER 
Count.LARGE_INTEGER 
MemCounter = AllocateMemory(8) 
QueryPerformanceFrequency_(MemCounter) 
CopyMemory(MemCounter, @Frequ, 8) 
CountsProSek = Frequ\lowpart 
QueryPerformanceCounter_(MemCounter) 
CopyMemory(MemCounter, @Count, 8) 
CounterMerken = Count\lowpart 
If ExamineDesktops()
	dw.w=DesktopWidth(0)
	dh.w=DesktopHeight(0)
Else
	dw.w=1024
	dh.w=768
EndIf
cmb.w=14
OpenScreen(dw,dh,32,"")
;FrontColor($FFFFFF)
;BackColor($0)
rrr.b=0
vvv.b=0
bbb.b=0
zz.l=0
x.w=0
y.w=0
Dim t1.f(cmb)
Dim t2.f(cmb)
Dim tt1.f(cmb)
Dim tt2.f(cmb)
Dim t3.f(cmb)
Dim t4.f(cmb)
Dim tt3.f(cmb)
Dim tt4.f(cmb)
Dim rr.b(cmb)
Dim vv.b(cmb)
Dim bb.b(cmb)
Dim ra1.f(cmb)
Dim ra2.f(cmb)
Dim ra3.f(cmb)
Dim ra4.f(cmb)
Dim mix(cmb)
Dim miy(cmb)
SPH:
crono.w=0
swp.b=Random(4)
mix=dw/2
miy=dh/2
mix2=mix/2-1
miy2=miy/2-1
mix_divise_par_2=mix/2
t0.f=Random(400)/1000
tt0.f=0.009+Random(500)/10000
t1.f=Random(400)/1000
tt1.f=0.009+Random(500)/10000
t2.f=Random(400)/1000
tt2.f=0.009+Random(500)/10000
t3.f=Random(400)/1000
tt3.f=0.009+Random(500)/10000
ra0.w=miy2/(8+Random(4))
Dim r.w(dw,dh)
Dim v.w(dw,dh)
Dim b.w(dw,dh)
For i=0 To cmb
	ry1=400+Random(700)
	ry2=400+Random(700)
	t1.f(i)=Random(80)/(420+Random(600))
	t2.f(i)=Random(80)/(420+Random(600))
	tt1.f(i)=(1+Random(45))/ry1
	tt2.f(i)=(1+Random(45))/ry2
	t3.f(i)=Random(80)/(420+Random(600))
	t4.f(i)=Random(80)/(420+Random(600))
	tt3.f(i)=(1+Random(45))/700
	tt4.f(i)=(1+Random(45))/700
	x=255
	y=Random(x)
	rr(i)=y
	x-y
	y=Random(x)
	vv(i)=x
	x-y
	y=Random(x)
	bb(i)=x
	If Random(1+swp)=0
		Swap rr(i),bb(i)
	Else
		If Random(1+swp)=0
			Swap vv(i),bb(i)
		EndIf
	EndIf
	
	
	ra1(i)=dh/(8.3+Random(400)/200)
	ra2(i)=dh/(8.3+Random(400)/200)
	ra3(i)=dh/(8.3+Random(400)/200)
	ra4(i)=dh/(8.3+Random(400)/200)
	mix(i)=dw/4+Random(dw/2.1)
	miy(i)=dh/4+Random(dh/2.1)
Next
dkx=dw/2.67
dky=dh/2.67
swp.b=1;Random(20)
If swp=5 Or swp=7
	crono-300
EndIf
fps_average_time.f=1
fps_time.f=1
Repeat ;############################
	For l=0 To cmb
		x1=mix(l)+Cos(t1(l))*ra1(l)-Cos(t3(l))*ra2(l)
		y1=miy(l)+Sin(t1(l))*ra1(l)-Sin(t3(l))*ra2(l)
		
		x2=mix(l)+Cos(t2(l))*ra3(l)-Cos(t4(l))*ra4(l)
		y2=miy(l)+Sin(t2(l))*ra4(l)-Sin(t4(l))*ra3(l)
		
		t1(l)+tt1(l)
		t2(l)+tt2(l)
		t3(l)+tt3(l)
		t4(l)+tt4(l)
		
		x=x2-x1
		y=y2-y1
		
		dist.l=Sqr(x*x+y*y)
		xf.f=x/dist
		yf.f=y/dist
		
		xx1.f=x1
		yy1.f=y1
		
		
		For i=0 To dist
			;x=xx1.f
			;y=yy1.f
			
			;zz.l=(dh+1)*2*y+2*(x-1)
			!xor eax,eax
			!mov ax,[v_dh]
			!inc ax
			!sal eax,1
			!cvttss2si ecx,[v_yy1] ; (conversion du flotant en entier avec troncature des décimales)
			;!mov [v_y],cx
			!mul ecx
			;!xor edx,edx
			;!mov dx,[v_y]
			;!mul edx
			
			;
			!cvttss2si ecx,[v_xx1] ; (conversion du flotant en entier avec troncature des décimales)
			;!mov [v_x],cx
			;!xor edx,edx
			;!mov dx,[v_x]
			!dec cx
			!sal ecx,1
			!add eax,ecx
			;
			!mov [v_zz],eax
			;326
			;Debug zz
			;End
			
			
			
			;********* procedure ASM antialiasing + affinage des couleurs (real 24bits rulez)
			
			;R
			!MOV      dword Ecx,[a_r]
			!add      ecx,[v_zz]
			!mov      ax,[ecx]
			
			!MOV      dword Edx,[a_rr]
			!add      dword Edx,[v_l]
			!mov      dl,[edx]
			!xor      dh,dh
			!add      ax,dx
			!mov      [ecx],ax
			
			!add      ecx,4
			!mov      ax,[ecx]
			!add      ax,dx
			!mov      [ecx],ax
			
			!sub      ecx,2
			!mov      ax,[ecx]
			!add      ax,dx
			!add      ax,dx
			!add      ax,40
			!add      ax,dx
			!mov      [ecx],ax
			
			!sub      cx,[v_dh]
			!sub      cx,[v_dh]
			!mov      ax,[ecx]
			!add      ax,dx
			!mov      [ecx],ax
			
			!mov			ax,[v_dh]
			!add      cx,ax
			!add      cx,ax
			!add      cx,ax
			!add      cx,ax
			!mov      ax,[ecx]
			!add      ax,dx
			!mov      [ecx],ax
			;********************
			;V
			!MOV      dword Ecx,[a_v]
			!add      ecx,[v_zz]
			!mov      ax,[ecx]
			
			!MOV      dword Edx,[a_vv]
			!add      dword Edx,[v_l]
			!mov      dl,[edx]
			!xor      dh,dh
			!add      ax,dx
			!mov      [ecx],ax
			
			!add      ecx,4
			!mov      ax,[ecx]
			!add      ax,dx
			!mov      [ecx],ax
			
			!sub      ecx,2
			!mov      ax,[ecx]
			!add      ax,dx
			!add      ax,dx
			!add      ax,40
			!add      ax,dx
			!mov      [ecx],ax
			
			!sub      cx,[v_dh]
			!sub      cx,[v_dh]
			!mov      ax,[ecx]
			!add      ax,dx
			!mov      [ecx],ax
			
			!mov			ax,[v_dh]
			!add      cx,ax
			!add      cx,ax
			!add      cx,ax
			!add      cx,ax
			!mov      ax,[ecx]
			!add      ax,dx
			!mov      [ecx],ax
			;********************
			;B
			!MOV      dword Ecx,[a_b]
			!add      ecx,[v_zz]
			!mov      ax,[ecx]
			
			!MOV      dword Edx,[a_bb]
			!add      dword Edx,[v_l]
			!mov      dl,[edx]
			!xor      dh,dh
			!add      ax,dx
			!mov      [ecx],ax
			
			!add      ecx,4
			!mov      ax,[ecx]
			!add      ax,dx
			!mov      [ecx],ax
			
			!sub      ecx,2
			!mov      ax,[ecx]
			!add      ax,dx
			!add      ax,dx
			!add      ax,40
			!add      ax,dx
			!mov      [ecx],ax
			
			!sub      cx,[v_dh]
			!sub      cx,[v_dh]
			!mov      ax,[ecx]
			!add      ax,dx
			!mov      [ecx],ax
			
			!mov			ax,[v_dh]
			!add      cx,ax
			!add      cx,ax
			!add      cx,ax
			!add      cx,ax
			!mov      ax,[ecx]
			!add      ax,dx
			!mov      [ecx],ax
			;******************************************** fin de ma sublime procedure ASM
			
			xx1.f+xf
			yy1.f+yf
		
		Next i
	Next l
	
	dkx2.w=dkx+Cos(t0)*ra0+Cos(t2)*ra0
	dky2.w=dky+Sin(t1)*ra0+Sin(t3)*ra0
	t0+tt0
	t1+tt1
	t2+tt2
	t3+tt3
	
	;crono+1
	!inc [v_crono]
	
	ExamineMouse()
	xmouse2=MouseDeltaX()/25
	ymouse2=MouseDeltaY()/25
	
	;*******************************************************    affichage
	StartDrawing(ScreenOutput())
	dh2=(dh+1)*2
	u3=dky2*dh2+dkx2+dkx2
	For u=0 To miy2
	
	;	zz=(dh+1)*2*(u+dky2)+2*dkx2
		zz=u3
		u3+dh2
		;Debug zz
		;!xor eax,eax
		;!mov ax,[v_dh]
		;!inc ax
		;!sal eax,1
		;
		;!xor ecx,ecx
		;!mov cx,[v_dky2]
		;!add ecx,dword[v_u]
		;!mul ecx
		;
		;!xor ecx,ecx
		;!mov cx,[v_dkx2]
		;!sal ecx,1
		;!add eax,ecx
		;!mov [v_zz],eax
		;Debug zz
		;Debug("=====")
		
		mix_moins_i_moins_1=mix-1
		miy_moins_u_moins_1=miy-u-1
		For i=0 To mix2
			;zz+2
			!add [v_zz],2
			
			!MOV      dword ecx,[a_r]
			!add      ecx,[v_zz]
			!mov      ax, [ecx]
			!mov      [v_rrr], ah
			
			!MOV      dword ecx,[a_v]
			!add      ecx,[v_zz]
			!mov      ax, [ecx]
			!mov      [v_vvv], ah
			
			!MOV      dword ecx,[a_b]
			!add      ecx,[v_zz]
			!mov      ax, [ecx]
			!mov      [v_bbb], ah
			
			If swp>8
				rvb=RGB(rrr,vvv,bbb)
				Plot (i,u,rvb)
				Plot (mix_moins_i_moins_1,u,rvb)
				Plot (i,miy_moins_u_moins_1,rvb)
				Plot (mix_moins_i_moins_1,miy_moins_u_moins_1,rvb)
			Else
			If swp=1
				rvb=RGB(rrr,vvv,bbb)
				vbr=RGB(vvv,bbb,rrr)
				Plot (i,u,rvb)
				Plot (mix_moins_i_moins_1,u,rvb)
				Plot (i,miy_moins_u_moins_1,RGB(vvv,bbb,rrr))
				Plot (mix_moins_i_moins_1,miy_moins_u_moins_1,RGB(vvv,bbb,rrr))
			Else
			If swp=2
				brv=RGB(bbb,rrr,vvv)
				Plot (i,u,rvb)
				Plot (mix_moins_i_moins_1,u,brv)
				Plot (i,miy_moins_u_moins_1,rvb)
				Plot (mix_moins_i_moins_1,miy_moins_u_moins_1,brv)
			Else
				If swp=3
					rvb=RGB(rrr,vvv,bbb)
					vbr=RGB(vvv,bbb,rrr)
					Plot (i,u,rvb)
					Plot (mix_moins_i_moins_1,u,vbr)
					Plot (i,miy_moins_u_moins_1,vbr)
					Plot (mix_moins_i_moins_1,miy_moins_u_moins_1,rvb)
				Else
					If swp=4 Or swp=5
						If Random(swp*9-36)=0
							rvr=RGB(rrr,vvv,rrr)
							Plot (i,u,rvr)
							Plot (mix_moins_i_moins_1,u,rvr)
							Plot (i,miy_moins_u_moins_1,rvr)
							Plot (mix_moins_i_moins_1,miy_moins_u_moins_1,rvr)
						Else
							If Random(9)=0
								Plot (i,u,RGB(bbb,bbb,vvv))
								Plot (mix_moins_i_moins_1,u,RGB(rrr,bbb,vvv))
								Plot (i,miy_moins_u_moins_1,RGB(vvv,bbb,rrr))
								Plot (mix_moins_i_moins_1,miy_moins_u_moins_1,RGB(vvv,rrr,bbb))
							EndIf
						EndIf
					Else
						If swp=6 Or swp=7
							If Random(swp*6-36)=0
								rbv=RGB(rrr,bbb,vvv)
								Plot (i,u,rbv)
								Plot (mix_moins_i_moins_1,u,rbv)
								Plot (i,miy_moins_u_moins_1,rbv)
								Plot (mix_moins_i_moins_1,miy_moins_u_moins_1,rbv)
							EndIf
						Else
							If swp=8
								If i+u<mix_divise_par_2
									vbr=RGB(vvv,bbb,rrr)
									Plot (i,u,vbr)
									Plot (mix_moins_i_moins_1,u,vbr)
									Plot (i,miy_moins_u_moins_1,vbr)
									Plot (mix_moins_i_moins_1,miy_moins_u_moins_1,vbr)
								Else
									rvb=RGB(rrr,vvv,bbb)
									Plot (i,u,rvb)
									Plot (mix_moins_i_moins_1,u,rvb)
									Plot (i,miy_moins_u_moins_1,rvb)
									Plot (mix_moins_i_moins_1,miy_moins_u_moins_1,rvb)
								EndIf
									Else
										Plot (i,u,RGB(rrr,vvv,bbb))
										Plot (mix_moins_i_moins_1,u,RGB(vvv,rrr,bbb))
										Plot (i,miy_moins_u_moins_1,RGB(vvv,bbb,rrr))
										Plot (mix_moins_i_moins_1,miy_moins_u_moins_1,RGB(rrr,bbb,vvv))
									EndIf
								EndIf
							EndIf
						EndIf
					EndIf
				EndIf
			EndIf
			mix_moins_i_moins_1-1
	
		Next
	Next
	
	stop:
	StopDrawing()
	GrabSprite(0,0,0,mix,miy)
	DisplaySprite(0,mix,0)
	DisplaySprite(0,0,miy)
	DisplaySprite(0,mix,miy)
	If crono>=1000
		StartDrawing(ScreenOutput())
		For i=0 To dh Step 16
			Box(0,i,dw,crono-1000,0)
		Next
		StopDrawing()
		If crono=1016
			Goto SPH
		EndIf
	EndIf
	fps=fps()
	Gosub HighCounter 
	StartDrawing(ScreenOutput())
	DrawText(100,100,StrF(1000 / fps))
	DrawText(100,120,StrF(HighCounter * 1000))
	StopDrawing()
	
	FlipBuffers(1)
	;Delay(2)
	;*******************************************************    fin affichage
	ok:
	ExamineKeyboard()
Until xmouse<>xmouse2 Or ymouse<>ymouse2 Or KeyboardPushed(#PB_Key_All)
End
HighCounter: 
  QueryPerformanceCounter_(MemCounter) 
  CopyMemory(MemCounter, @Count, 8) 
  HighCounter = (Count\lowpart - CounterMerken) / CountsProSek 
  CounterMerken = Count\lowpart 
Return