PurePunch contest #1

[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

[djes]

yeah, really nice! For me it's a good plasma effect!
Will have a closer look later

[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...

[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 )

[Psychophanta]

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.

[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?

[djes]

Yeah! Better than a colour cycle
Like to see it in overscan

[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

[idle]

@Prod Nice

[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?

[idle]

Yes but I might have to come up with something new.

[djes]

Maybe I could make a compilation of all the old punchs, as the first competition, and organize a full new one after that?

[Psychophanta]

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.

[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...

[djes]

What do you suggest? Maybe limiting the challenge to only the 100 lines version?