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