Page 7 of 9
Posted: Mon Jun 22, 2009 8:41 am
by djes
It's not a problem, and as they're not so much utilities, it's welcome!
Posted: Mon Jun 22, 2009 11:22 am
by Trond
rrpl wrote:
I'm sure it can probably be made smaller yet, but not much smaller.
Four lines shorter:
Code: Select all
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
Posted: Mon Jun 22, 2009 12:46 pm
by Arctic Fox
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
Posted: Mon Jun 22, 2009 11:19 pm
by rrpl
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).
Posted: Tue Jun 23, 2009 12:03 am
by va!n
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
Posted: Tue Jun 23, 2009 1:06 am
by rsts
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
Posted: Tue Jun 23, 2009 2:31 am
by rrpl
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.
Posted: Tue Jun 23, 2009 4:30 am
by nase09
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..)
Posted: Tue Jun 23, 2009 5:41 am
by rrpl
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
Posted: Tue Jun 23, 2009 9:33 am
by va!n
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
Posted: Tue Jun 23, 2009 11:50 am
by Trond
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")
Posted: Tue Jun 23, 2009 5:56 pm
by djes
MrVain> Yeah, you did it! That's a lot better! And I love the end!!!
rrpl> nice, and easy
Posted: Tue Jun 23, 2009 7:16 pm
by dobro
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
Posted: Tue Jun 23, 2009 7:34 pm
by Psychophanta
OpenScreen(320,200,32,"")
Some VGAs do not allow that resolutions.
Posted: Tue Jun 23, 2009 9:04 pm
by idle
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