PurePunch Contest #2

djes · Post by **djes** » Mon Jun 22, 2009 8:41 am

It's not a problem, and as they're not so much utilities, it's welcome!

Trond · Post by **Trond** » Mon Jun 22, 2009 11:22 am

rrpl wrote: I'm sure it can probably be made smaller yet, but not much smaller.

Four lines shorter:

w=600:h=150:OpenWindow(0,0,30,w,h,"Littlest Magnifier",#PB_Window_SystemMenu)
StickyWindow(0,1):M=3:ImageGadget(0,0,0,w,h,0):While WindowEvent()<>16:c.point
GetCursorPos_(c):Gosub S:n=ResizeImage(0,w,h):SetGadgetState(0,n):Delay(50)
Wend:End:S:CreateImage(0,w/M,h/M):hd=StartDrawing(ImageOutput(0)):D=GetDC_(0)
BitBlt_(hd,0,0,w/M,h/M,D,c\x,c\y,#SRCCOPY):StopDrawing():ReleaseDC_(0,D):Return

Arctic Fox · Post by **Arctic Fox** » Mon Jun 22, 2009 12:46 pm

rrpl wrote:So I put this little magnifier together.

This was actually my first idea, but I couldn't make it work

(what a funny incident)
Good job anyway

rrpl · Post by **rrpl** » Mon Jun 22, 2009 11:19 pm

Thanks Trond

Four lines shorter:

But you didn't get it down to one line like I thought you would!

Updated Magnifier with up/down arrow to increase/decrease magnification.

Code: Select all

;*****************************************************************************
;*
;* Name   : Littlest Magnifier - Mark 2
;* Author : rrpl (much help from Trond in shrinking the code)
;* Date   : 23 June 09
;* Notes  : Change magnification using up/down arrows
;*
;***************************************************************************** 
w=600:h=150:OpenWindow(0,0,30,w,h,"Littlest Magnifier",#PB_Window_SystemMenu)
StickyWindow(0,1):M=3:ImageGadget(0,0,0,w,h,0):AddKeyboardShortcut(0,38,1)
AddKeyboardShortcut(0,40,2):While a<>16:a=WindowEvent():c.point
GetCursorPos_(c):Gosub S:n=ResizeImage(0,w,h):SetGadgetState(0,n)
If a=#PB_Event_Menu:b=EventMenu():If b=1 And M<10:M=M+1:ElseIf b=2 And M>2
M=M-1:EndIf:EndIf:Delay(50):Wend:End:S:CreateImage(0,w/M,h/M)
hd=StartDrawing(ImageOutput(0)):D=GetDC_(0)
BitBlt_(hd,0,0,w/M,h/M,D,c\x,c\y,#SRCCOPY):StopDrawing():ReleaseDC_(0,D)
Return

Who knows with further help from Trond I might be able to add some special FX as well, and win this thing(illegally!-who cares bro).

va!n · Post by **va!n** » Tue Jun 23, 2009 12:03 am

Here is my 2nd contribution for this competition which works on windows only! Its not easy to have good timing results... so i hope the intro and its effects works ok on your system (not to slow nor to fast) and hope you enjoy this production. Applications auto exit! Best regards and good luck to all contributors...

Code: Select all

;*****************************************************************************
;*
;* Name   : DemoManiac - small multipart intro (Windows only!)
;* Author : Thorsten Will - aka 'Mr.Vain of Secretly!'
;* Date   : 23.06.2009
;* Notes  : Entry for the PurePunch Contest #2
;*          The rule is to code something in max 10 lines of 80 characters!
;*          I tried to code a small multipart intro with timing and music! ^^
;*          Win32 API has been used for timing, because smaller as pb commands.
;*
;*          This intro features:
;*              - blue background noise
;*              - colorful XOr pattern
;*              - fractal (flipping and zooming while transforming)
;*              - abstract moving lines (changing color)
;*              - background music (timing with fx isnt nice nor easy this way)
;*              - flashing text
;*              - auto exit
;*
;*          P L E A S E   D I S A B L E   T H E   D E B U G G E R  !!! 
;*
;***************************************************************************** 
s=timeGetTime_():InitMovie():LoadMovie(0,"c:\windows\media\onestop.mid"):b=255
InitSprite():OpenScreen(640,480,32,""):PlayMovie(0,0):Repeat:r=ScreenOutput()
StartDrawing(r):e=(timeGetTime_()-s)/100:t.f+0.05:For m=0 To 639:For n=0 To 479
g=64:Plot(m,n,(g+Random(g))<<16):d=826:w=Sin(t)*b:If e>=0 And e<152:h=Cos(t)*b
ElseIf e>152 And e<393:h=w:EndIf:q.f=(n-b)/h:p.f=(m-b)/w:x.f=0:y.f=t/21:z=100
For i=1 To 24:u.f=x*x-y*y+p:v.f=2*x*y+q:If u*u+v*v>4:Goto E:EndIf:x=u:y=v:Next
Plot(m,n,RGB(m!n,96,m*n/740)):E:o=$FF:Next:Next:If e>393 And e<665:For i=0 To b
x=Cos(l.f):y=Sin(l):m=z*-Sin(i+(x*z))+c:g=c*Sin(i+(x*c))+b+c:n=z*-Cos(i+(y*z))+c
h=c*Cos(i+(y*c))+b:c=150:LineXY(m,n,g,h,o*t*4):Next:l=t/b:ElseIf e>665 And e<d
DrawingMode(1):DrawText(b,b,"END",w):EndIf:StopDrawing():FlipBuffers():Until e>d

rsts · Post by **rsts** » Tue Jun 23, 2009 1:06 am

got a message about a missing dll but it ran fine anyway.

Took a while to end (had me a bit worried

but Very Very impressive.

cheers

rrpl · Post by **rrpl** » Tue Jun 23, 2009 2:31 am

va!n Wrote:

so i hope the intro and its effects works ok on your system (not to slow nor to fast) and hope you enjoy this production

works fine on my computer on WinXP -very impressive to get so much stuff happening with such little code. Timing seemed about right.

nase09 · Post by **nase09** » Tue Jun 23, 2009 4:30 am

nice!

va!n wrote: - background music (timing with fx isnt nice nor easy this way)

but no music if your WinDir is not named "c:\windows"

- why don't you use GetEnvironmentVariable("windir") to get the Path ?

(just kidding.. this command is sooo loooong..)

rrpl · Post by **rrpl** » Tue Jun 23, 2009 5:41 am

Just for laughs really and to keep the number of utilities up - A Pure Punch 2 Validator that validates itself into the contest. It ignores comment lines, blanks lines, and lines with only spaces, removes spaces from start and end of line, only count characters on the basis of string function Len - I hope this fits with the contest guidelines!?

A special disclaimer: this is not an official Pure Punch 2 validator!

It reports the number of lines and names the lines exceeding 80 characters.

Code: Select all

;*****************************************************************************
;*
;* Name   : Pure Punch 2 Validator
;* Author : rrpl 
;* Date   : 23 June 09
;* Notes  : Paste Code into Pure Punch 2 Validator, click on Check
;*
;***************************************************************************** 
l=10:w=500:h=400:OpenWindow(0,0,30,w,h,"PP Validator",#PB_Window_SystemMenu)
c=80:EditorGadget(0,0,0,w,h-35):SetGadgetText(0,";Paste Code Here"):r.s=#CRLF$
ButtonGadget(1,25,h-30,100,25,"Check"):u.s=r+";Total Lines =":While a<>16:
a=WindowEvent():If a=#PB_Event_Gadget:If EventGadget()=1:Gosub v:EndIf:EndIf
Delay(9):Wend:End:v:For i=0 To CountGadgetItems(0)-1:s.s=GetGadgetItemText(0,i)
s=Trim(s):If s<>"":If Left(s,1)<>";":n=n+1:If Len(s)<81:Else:t.s=t+Str(n)+";"
EndIf:EndIf:EndIf:Next:If n<11 And t="":m.s=";":For j=1 To 77:m=m+"*":Next
m=m+r:o.s="Valid for Pure Punch 2":m=m+";PP2 Validator : Above code is "
AddGadgetItem(0,-1,m+o+u+Str(n)):Else:If t<>"":q.s="; Check Line/s ":EndIf
AddGadgetItem(0,-1,m+"NOT "+o+u+Str(n)+q+t):EndIf:n=0:t="":Return
;*****************************************************************************
;PP2 Validator : Above code is Valid for Pure Punch 2
;Total Lines =10

va!n · Post by **va!n** » Tue Jun 23, 2009 9:33 am

thx for feedback

.

@nase09:
Mhhh... what windows version do you have, that the path isnt c:\Windows\ ? I agree, GetEnvVar would be nice or the constant something like #Windows\ or so would be nice to fix the prob! But using GetEnvVar does not fit in the size of source and i dont know if and how to write the constant in PB to get the windows folder back...

Btw, do you managed it to fix the path to enjoy the intro with full music? ^^
best regards

Trond · Post by **Trond** » Tue Jun 23, 2009 11:50 am

I made a program that strips unnecessary spaces and pushes lines together (as long as they don't get wider than 80 characters).
Of course, this program is small enough to fit into the contest because it was processed by itself.

Code: Select all

;***************************************************************************** 
;* 
;* Name   : PurePunchCruncher
;* Author : Trond
;* Date   : 23 June 09 
;* Notes  : Only runs in ascii mode on plain text source files
;* Notes  : Specify an existing input file before running
;* 
;*****************************************************************************

ReadFile(0,GetHomeDirectory()+"my documents\infile.pb")
CreateFile(1,"c:\out.pb"):E.s:L.c:Macro IsAlNum(L)
((UCase(Chr(L))<>LCase(Chr(L)))Or(L>='0'And L<='9')):EndMacro:While Eof(0)=0
L=ReadCharacter(0):Select L:Case#LF:Case#CR,';':If N+Len(E)+1>80
WriteString(1,#CRLF$):N=Len(E):Else:If E:N+Len(E)+1:WriteString(1,":"):EndIf
EndIf:WriteString(1,E):E="":S=0:Repeat:L=ReadCharacter(0):Until Eof(0)Or L=#LF
Case Asc("'"),'"':E+Chr(L):O=L:Repeat:L=ReadCharacter(0):E+Chr(L)
Until Eof(0)Or L=#CR Or L=O:Case' ':S=1:Default:If S=1
If IsAlNum(Asc(UCase(Right(E,1)))):If IsAlNum(L):E+" ":EndIf:EndIf:EndIf
E+Chr(L):S=0:EndSelect:Wend:RunProgram("c:\out.pb")

djes · Post by **djes** » Tue Jun 23, 2009 5:56 pm

MrVain> Yeah, you did it! That's a lot better! And I love the end!!!
rrpl> nice, and easy

dobro · Post by **dobro** » Tue Jun 23, 2009 7:16 pm

Code: Select all

;*****************************************************************************
;*
;* Name   : Taches de Martin
;* Author : Dobro
;* Date   : 23/Juin/2009
;* Notes  : -exit white mouse right button
;*
;***************************************************************************** 
xp=2:yp=2:EX=320:Ey=200:InitSprite():InitMouse():OpenScreen(320,200,32,"")
CreateImage(1,320,200,32):StartDrawing(ImageOutput(1)):For t= 1 To 5000
Circle(Random(EX-1),Random(Ey-1),5,Random (1<<12)):Next:StopDrawing():Repeat 
 StartDrawing(ImageOutput(1)):For xp=2 To EX-1:For yp=2 To Ey-1:cs1=Point(xp-1,yp-1)
 cs2=Point(xp+1,yp+1):cs3=Point(xp,yp-1):cs4=Point(xp,yp+1):cs5=Point(xp+1,yp):
 cs6=Point(xp-1,yp):cs7=Point(xp-1,yp+1):cs8=Point(xp+1,yp-1)
 Circle(xp,yp,1,(cs1+cs2+cs3+cs4+cs5+cs6+cs7+cs8)/8):ExamineMouse():
If MouseButton(2):End:EndIf:Next:Next:StopDrawing():
StartDrawing(ScreenOutput()):DrawImage(ImageID(1),0,0):StopDrawing()
FlipBuffers():ForEver

Psychophanta · Post by **Psychophanta** » Tue Jun 23, 2009 7:34 pm

OpenScreen(320,200,32,"")

Some VGAs do not allow that resolutions.

Post by **idle** » Tue Jun 23, 2009 9:04 pm

Cam Mover or the ugly Window Test!

requires web cam!
32 bit windows only.

Code: Select all

;*****************************************************************************
;*
;* Name   :Cam Mover or the ugly Window Test:
;* Author :idle - andrew ferguson
;* Date   :24/06/2009
;* Notes  :windows 32bit only
;*        :hit esc To quit 
;*        :If the webcam isn't set at 320 x 240 remove the comment on line 9
;*        :Don't set it less than 320 x 240  
;*        ;If your system can't find avicap32.dll add this string to the openlibary command  
;*        :system drive "C:\Windows\system32\avicap32.dll"  
;*****************************************************************************
OpenLibrary(1,"avicap32.dll"):*p=GetFunction(1,"capCreateCaptureWindowW")
ExamineDesktops():Global q=DesktopWidth(0),z=DesktopHeight(0),w=320,h=240,t,n,e
Macro sm(b,c,d):SendMessage_(n,b,c,d):EndMacro:Global lx.f,ly.f,dx,dy,f=z/2-h/2
Procedure FC(j,*v.long):*r.long=*v\l+3:sx.f:sy.f:a.f:While d<230400:y=d%w:x=d/w
c=*r\l:sx+x*c:sy+y*c:a+c:d+3:*r+3:Wend:If t>20:dx=(sx/a)-lx:dy=(sy/a)-ly:Else
lx=(sx/a):ly=(sy/a):t+1:EndIf:e+dx:f+dy:If e<0:e=0:ElseIf e>q-w:e=q-w:EndIf
If f<0:f=0:ElseIf f>z-h:f=z-h:EndIf:ResizeWindow(0,e,f,w,h):EndProcedure:s.s  
u=OpenWindow(0,0,0,w,h,s,$CA0001):n=CallFunctionFast(*p,s,1<<28*5,0,0,w,h,u,0)
e=q/2-w/2:Sm(1034,0,0):sm(1076,60,0):sm(1074,1,0):sm(1029,0,@FC());sm(1065,0,0)
Repeat:Until WaitWindowEvent()=16 Or GetAsyncKeyState_(#VK_ESCAPE)&$1