Page 4 of 5
Posted: Mon Dec 15, 2008 12:46 pm
by Psychophanta
Nice djes!
Well, even this is not a good plasma, at least it can be used as a screensaver coz it does not get almost any CPU resources.
It uses DDraw.
I hope this time this works without problems for anyone.
Code: Select all
Global *TI.IDirectDrawSurface,SS.RECT,TS.RECT,DDrawBase,dwSize=100
TS\right=1024:TS\bottom=768:InitSprite():InitKeyboard():OpenScreen(TS\right,TS\bottom,32,"")
SS\right=TS\right:SS\bottom=TS\bottom
!extrn _PB_DDrawBase
!extrn _PB_DirectX_PrimaryBuffer
!extrn _PB_DirectX_BackBuffer
!DDBLT_WAIT equ $1000000
!mov eax,dword[_PB_DirectX_PrimaryBuffer]
!test eax,eax
!jz @f
!mov dword[p_TI],eax
!jmp _start
!@@:
!push v_DDrawBase
!mov eax,dword[_PB_DirectX_BackBuffer]
!push eax
!mov eax,dword[eax]
!call dword[eax+144]
!push p_TI
!mov eax,dword[v_DDrawBase]
!push eax
!mov eax,dword[eax]
!call dword[eax+56]
!mov eax,dword[p_TI]
!_start:
Procedure b2()
Protected r.l=0.,g.l=0.,b.l=0.
Protected rs.l=1,gs.l=1,bs.l=1
Protected i.l,j.l
StartDrawing(ScreenOutput())
For j=0 To SS\bottom-1
For i=0 To SS\right-1
Plot(i,j,RGB(255*Cos(r*#PI/512),255*Cos(g*#PI/512),255*Cos(b*#PI/512)))
r+rs:If r<0 Or r>255:rs=-rs:r+rs:EndIf
; g+gs:If g<0 Or g>255:gs=-gs:g+gs:EndIf
b+bs:If b<0 Or b>255:bs=-bs:b+bs:EndIf
Next
r+rs:If r<0 Or r>255:rs=-rs:r+rs:EndIf
g+gs:If g<0 Or g>255:gs=-gs:g+gs:EndIf
; b+bs:If b<0 Or b>255:bs=-bs:b+bs:EndIf
Next
StopDrawing()
EndProcedure
b2()
Repeat
ExamineKeyboard()
SS\left=TS\right/2+240*Cos(alfa.f):SS\top=TS\bottom/2+192*Sin(alfa.f)
SS\right=SS\left+256:SS\bottom=SS\top+192
!mov eax,dword[_PB_DirectX_PrimaryBuffer]
!push dword v_dwSize dword DDBLT_WAIT dword v_SS dword[_PB_DirectX_BackBuffer] dword v_TS eax
!mov eax,dword[eax]
!call dword[eax+20]
alfa+0.01:If alfa>=2*#PI:alfa=0:EndIf
Delay(16)
Until KeyboardPushed(#PB_Key_Escape)
By the way you can play changing b2() procedure with some other, for example:
Code: Select all
Procedure b1()
Protected r.l=0,g.l=0,b.l=0.
Protected rs.l=2,gs.l=2,bs.l=2
Protected i.l,j.l
StartDrawing(ScreenOutput())
For j=0 To SS\bottom-1
For i=0 To SS\right-1
Plot(i,j,RGB(255*Cos(r*#PI/512),255*Cos(g*#PI/512),255*Cos(b*#PI/512)))
r+rs:If r<0 Or r>255:rs=-rs:r+rs:EndIf
; g+gs:If g<0 Or g>255:gs=-gs:g+gs:EndIf
; b+bs:If b<0 Or b>255:bs=-bs:b+bs:EndIf
Next
r+rs:If r<0 Or r>255:rs=-rs:r+rs:EndIf
g+gs:If g<0 Or g>255:gs=-gs:g+gs:EndIf
b+bs:If b<0 Or b>255:bs=-bs:b+bs:EndIf
Next
StopDrawing()
EndProcedure
or
Code: Select all
Procedure b3()
Protected r.l=0.,g.l=0.,b.l=0.
Protected rs.l=2,gs.l=1,bs.l=2
Protected i.l,j.l
StartDrawing(ScreenOutput())
For j=0 To SS\bottom-1
For i=0 To SS\right-1
Plot(i,j,RGB(255*Cos(r*#PI/512),255*Cos(g*#PI/512),255*Cos(b*#PI/512)))
; r+rs:If r<0 Or r>255:rs=-rs:r+rs:EndIf
; g+gs:If g<0 Or g>255:gs=-gs:g+gs:EndIf
b+bs:If b<0 Or b>255:bs=-bs:b+bs:EndIf
Next
r+rs:If r<0 Or r>255:rs=-rs:r+rs:EndIf
g+gs:If g<0 Or g>255:gs=-gs:g+gs:EndIf
b+bs:If b<0 Or b>255:bs=-bs:b+bs:EndIf
Next
StopDrawing()
EndProcedure
Posted: Mon Dec 15, 2008 5:32 pm
by djes
yeah, really nice! For me it's a good plasma effect!
Will have a closer look later
Posted: Mon Dec 15, 2008 8:14 pm
by blueznl
Here's my PurePunch contribution...
Code: Select all
; PPV v0.01 blueznl
;
; PurePunch Validator
;
title.s = "PurePunch Validator v0.01 by BluezNL"
;
category_1 = #True ; set to false if it is more than 10 lines or a line has more than 256 chars
category_2 = #True ; set to false if it's more than 100 lines or a line contains multiple statements
category_3 = #True ; set to false if the total number of chars is more than 2560
;
; note: all lines are trimmed, and empty lines and comment only lines are ignored
;
line_nr = 0
line_qualifying_nr = 0
line_l_max = 0
line_l_max_nr = 0
char_nr = 0
;
; f.s = ProgramParameter()
; f.s = "d:\purebasic\_projects\test.pb"
; f.s = "d:\purebasic\_projects\x_lib\x_lib.pb"
; f.s = "d:\purebasic\_projects\ppv.pb"
; f.s = "d:\purebasic\_projects\test.pb"
;
If f.s = ""
f = OpenFileRequester(title,"","PureBasic|*.pb|All files|*.*",0)
EndIf
If FileSize(f) > 1
ReadFile(1,f)
While (category_1 Or category_2 Or category_3) And (Not Eof(1))
y.s = Trim(ReadString(1,#PB_UTF8))
line_nr = line_nr+1
If y = ""
ElseIf Left(y,1)=";"
Else
line_qualifying_nr = line_qualifying_nr+1
line_l = Len(y)
If line_l > line_max
line_l_max = line_l
line_l_max_nr = line_nr
EndIf
;
; category no.1: 256 characters or less
;
If line_l > 256
category_1 = #False
EndIf
;
; category no. 1: not too many lines? 10 or less
;
If line_qualifying_nr > 10
category_1 = #False
EndIf
;
; category no.2: not too many lines? 100 or less
;
If line_qualifying_nr > 100
category_2 = false
EndIf
;
; category no.2: single statement test
;
p_n = CountString(y,#DQUOTE$)
If p_n > 0
x.s = ""
p = 1
While p <= p_n+1
x = x+StringField(y,p,#DQUOTE$)
p = p+2
Wend
y = x
EndIf
p_n = CountString(y,"'")
If p_n > 0
x = ""
p = 1
While p <= p_n+1
x = x+StringField(y,p,"'")
p = p+2
Wend
y = x
EndIf
p_n = CountString(y,";")
If p_n > 0
x = ""
p = 1
While p <= p_n+1
x = x+StringField(y,p,";")
p = p+2
Wend
y = x
EndIf
If CountString(y,":") > 0
category_2 = #False
EndIf
;
; category no.3: Not too large?
;
char_nr = char_nr + line_l
If char_nr > 2560
category_3 = false
EndIf
EndIf
Wend
CloseFile(1)
;
x = f+Chr(13)+Chr(13)
y = Chr(13)+Chr(13)+"Lines: "+Str(line_nr)+Chr(13)
y = y+"Qualifying lines: "+Str(line_qualifying_nr)+Chr(13)
y = y+"Longest line: "+Str(line_l_max_nr)+" ("+Str(line_l_max)+" characters)"+Chr(13)
y = y+"Length: "+Str(char_nr)+" characters"+Chr(13)+Chr(13)
;
If category_1
MessageRequester(title,x+"PASSED - CATEGORY I."+y+"Max 10 lines of max 256 characters.",#PB_MessageRequester_Ok)
ElseIf category_2
MessageRequester(title,x+"PASSED - CATEGORY II."+y+"Max 100 qualifying lines with each one statement.",#PB_MessageRequester_Ok)
ElseIf category_3
MessageRequester(title,x+"PASSED - CATEGORY III."+y+"Max 2560 characters.",#PB_MessageRequester_Ok)
Else
MessageRequester(title,x+"FAILED ALL CATEGORIES."+y+"File did Not pass PurePunch validation.",#PB_MessageRequester_Ok|#MB_ICONHAND)
EndIf
;
EndIf
And yes, it qualifies
I just hope it doesn't contain any bugs
Note that category III makes category I superfluous...
Posted: Tue Dec 16, 2008 9:47 am
by djes
Excellent, and... useful!
Yes, but we must keep the first category for "historical reasons"
Psychophanta> You raised the level! I love this kind of hack
(maybe I should not
)
Posted: Tue Dec 16, 2008 5:06 pm
by Psychophanta
djes wrote:Psychophanta> You raised the level! I love this kind of hack
(maybe I should not
)
It is just a call to the IDirectDrawSurface\Blt() method, i.e. the DirectDraw blitter.
Perhaps there would be good thing to write a small ASM DDraw tutorial in the Game Programming section, coz imo, there is easier to manage DDraw with ASM than with any other.
Posted: Thu Dec 18, 2008 11:51 am
by Psychophanta
I had a TVnoise out there, and i have adapted it for Pure Punch
Code: Select all
;TVnoise (July 2005), by Psychophanta, adapted for Pure Punch:
Global *TargetInterface.IDirectDrawSurface,SourceSurface.RECT,TargetSurface.RECT
With TargetSurface
\right=1024:\bottom=768:w.l=256:h.l=360:maxw.l=\right-w:maxh.l=\bottom-h
InitSprite():InitKeyboard()
OpenScreen(\right,\bottom,32,"TVnoise")
!extrn _PB_DDrawBase
!extrn _PB_DirectX_PrimaryBuffer
!extrn _PB_DirectX_BackBuffer
!DDBLT_WAIT equ $1000000
SourceSurface\right=\right:SourceSurface\bottom=\bottom
Procedure TargetInterfaceInit()
!mov eax,dword[_PB_DirectX_PrimaryBuffer]
!test eax,eax
!jz @f
!mov dword[p_TargetInterface],eax
ProcedureReturn
!@@:
!;TargetInterfaceInit:
!push DDrawBase
!mov eax,dword[_PB_DirectX_BackBuffer]
!push eax
!mov eax,dword[eax]
!call dword[eax+144]
!push p_TargetInterface
!mov eax,dword[DDrawBase]
!push eax
!mov eax,dword[eax]
!call dword[eax+56]
!mov eax,dword[p_TargetInterface]
!;EndTargetInterfaceInit
EndProcedure
DataSection
!DDrawBase:dd 0
!dwSize:dd 100
EndDataSection
TargetInterfaceInit()
bn.l=$010101
StartDrawing(ScreenOutput())
For j.l=0 To SourceSurface\bottom-1
For i.l=0 To SourceSurface\right-1
Plot(i.l,j.l,Random($FF)*bn.l)
Next
Next
StopDrawing()
Repeat
ExamineKeyboard()
SourceSurface\left=Random(maxw):SourceSurface\top=Random(maxh)
SourceSurface\right=SourceSurface\left+w:SourceSurface\bottom=SourceSurface\top+h
!mov eax,dword[_PB_DirectX_PrimaryBuffer]
!push dword dwSize dword DDBLT_WAIT dword v_SourceSurface dword[_PB_DirectX_BackBuffer] dword v_TargetSurface eax
!mov eax,dword[eax]
!call dword[eax+20]
Delay(16)
Until KeyboardPushed(#PB_Key_Escape)
ClearScreen(0):FlipBuffers(0):ClearScreen(0):CloseScreen()
Who dares to make it with less CPU consumption?
Posted: Thu Dec 18, 2008 3:40 pm
by djes
Yeah! Better than a colour cycle
Like to see it in overscan
Posted: Sun May 24, 2009 3:22 am
by Prod
This be the micro version of my proper screensaver (ready soon, yeah, really). :roll:
Comes properly formatted, and even if counting comment, indents (in tabs), spaces, double chars for linefeeds, and ofcourse the cute and pointless 'End' at the end, it counts for only 2556 bytes.
Needs a fixedwidth font, Courier was the only one I could find, dunno if it works on other than Windows, plz tell me if you find out.
Let it run a while to fully comprehend the effect. Any key to quit, but you might need to press it a wee bit longer than usual coz of the slow framerate. Enjoy.
Code: Select all
; Matrix Blanker Light v1.0 by Prod
InitKeyboard() : InitSprite() : InitSprite3D() : Sprite3DQuality(1)
ExamineDesktops() : sw=DesktopWidth(0) : sh=DesktopHeight(0)
OpenScreen(sw,sh,DesktopDepth(0),"")
If sh=>1200
a=256
EndIf
f=FontID(LoadFont(-1,"Courier",sh/75,a))
StartDrawing(ScreenOutput())
DrawingFont(f) : cw=TextWidth(".")+2 : ch=TextHeight(".")+2
StopDrawing()
mw=sw/cw : mh=sh/ch : ox=(sw-(cw*mw))/2 : oy=(sh-(ch*mh))/2 : ct=mh*2
Global Dim cm.i(2,2,2)
Global Dim cmm.i(2,2,2)
Global Dim rc.i(2)
Global Dim lny.i(mw*4)
Global Dim yl.i(mw)
For a=0 To mw*4
lny(a)=(a&3)*mh/4
Next
For y=0 To 2
For x=0 To 2
For a=0 To 2
cm(x,y,a)=Random(223)+32 : b=Random(9)-5 : cmm(x,y,a)=b-(~b>>3)
Next
Next
Next
b=cw-1 : c=ch-1
For a=0 To 1
CreateSprite(a,16,16,4) : CreateSprite3D(a,a) : TransformSprite3D(a,0,0,b,0,b,c,0,c) : b=sw-1 : c=sh-1
Next
CreateSprite(2,sw,sh) : TransparentSpriteColor(2,1)
StartDrawing(SpriteOutput(0))
Box(0,0,16,16,#White)
StopDrawing()
Repeat
t=ElapsedMilliseconds() : ExamineKeyboard()
StartDrawing(SpriteOutput(2))
DrawingFont(f)
For x=0 To mw-1
yl(x)=yl(x)+1
For a=x*4 To (x*4)+3
y=lny(a)+1
If y=>0
If y<mh
b=48+Random(35) : DrawText((x*cw)+ox+1,(y*ch)+oy+1,Chr(b+(b/58*7)),a&1,0)
Else
y=yl(x)-(Random(mh))-(mh/8)
If y>0
y=0
EndIf
yl(x)=y
EndIf
EndIf
lny(a)=y
Next
Next
StopDrawing()
If ct=0
For y=0 To 2
For x=0 To 2
b=cmm(x,y,cc) : a=cm(x,y,cc)+b
If a<32 Or a>255
c=(a>>8) : a=(c*223)+32 : b=(Random(4)+1)*(1-(c*2))
EndIf
cm(x,y,cc)=a : cmm(x,y,cc)=b
Next
Next
StartDrawing(SpriteOutput(1))
For b=0 To 1
For a=0 To 1
For y=0 To 7
For x=0 To 7
For c=0 To 2
rc(c)=((cm(a,b,c)*(8-x)*(8-y))+(cm(a+1,b,c)*x*(8-y))+(cm(a,b+1,c)*(8-x)*y)+(cm(a+1,b+1,c)*x*y))/64
Next
Plot((a*8)+x,(b*8)+y,RGB(rc(0),rc(1),rc(2)))
Next
Next
Next
Next
StopDrawing()
Start3D()
DisplaySprite3D(1,0,0)
For x=0 To mw-1
For a=0 To 1
y=lny((x*4)+(a*2)+1)
If y=>0 And y<=mh
For b=0 To 1
DisplaySprite3D(0,(x*cw)+ox,((y-b)*ch)+oy,(2-b)*96)
Next
EndIf
Next
Next
Stop3D()
DisplayTransparentSprite(2,0,0) : FlipBuffers() : cc=(((cc*3)+2)/2)&3 : a=65-(ElapsedMilliseconds()-t)
If a<0
a=0
EndIf
Delay(a)
Else
ct=ct-1
EndIf
Until KeyboardPushed(-1) Or IsScreenActive()=0
End
Posted: Sun May 24, 2009 7:24 am
by idle
@Prod Nice
Posted: Sun May 24, 2009 11:52 am
by djes
Good one!
Are you guys ready for some competition? Let's take a month to do the best punch! What do you think of this idea?
Posted: Sun May 24, 2009 12:15 pm
by idle
Yes but I might have to come up with something new.
Posted: Sun May 24, 2009 12:18 pm
by djes
Maybe I could make a compilation of all the old punchs, as the first competition, and organize a full new one after that?
Posted: Sun May 24, 2009 2:29 pm
by Psychophanta
djes wrote:Maybe I could make a compilation of all the old punchs, as the first competition, and organize a full new one after that?
May be, but anyway this thread should be more famous and participative, because it is a challenge for program writers, and moreover everyone can learn from small pieces of codes because there is not place to be scared to see hundreds of lines.
Posted: Sun May 24, 2009 2:40 pm
by blueznl
I'd like to suggest a new class then, for smaller programs, single statement per line, commented, with fewer lines. Current rules still allow quite large programs I think...
Posted: Sun May 24, 2009 6:34 pm
by djes
What do you suggest? Maybe limiting the challenge to only the 100 lines version?