Posted: Thu Jun 18, 2009 3:46 pm
PureBasic Forums - English
http://www.purebasic.com
https://www.purebasic.fr/english/
PurePunch Contest #2
Page 6 of 9
Posted: Thu Jun 18, 2009 3:49 pm
Posted: Thu Jun 18, 2009 5:37 pm
Are those programs intended to run on Windows/Linux/Mac OS X? If so, then there might be some problems using them via pB on Mac OS X, beginning with cut and paste into a new program source window.
Posted: Thu Jun 18, 2009 5:59 pm
Most of them are designed for Windows. Some are working on other platforms but you're right, it should be noted somewhere in the header.
Posted: Thu Jun 18, 2009 8:01 pm
Code: Select all
;*******************************************************************************
;*
;* Name : Recursive trees
;* Author : Trond
;* Date : 18.06.2009
;* Notes : Opens at desktop resolution, press any key to quit, v-synced
;*
;*******************************************************************************
Define.d:Global a=0.2*#PI,t=3,c=$FFFF:InitKeyboard():InitSprite()
ExamineDesktops():w=DesktopWidth(0):h=DesktopHeight(0):OpenScreen(w, h, 32, "")
CreateSprite(0, w, h):Procedure R(X,Y,d,e,s,n):z=X+s*d:q=Y+s*e:LineXY(X,Y,z,q,c)
If n:s/t:f=Cos(a)*d+Sin(a)*e:g=-Sin(a)*d+Cos(a)*e:r(z,q,f,g,s,n+1):
f=Cos(-a)*d+Sin(-a)*e:g=-Sin(-a)*d+Cos(-a)*e:r(z,q,f,g,s,n+1):EndIf:EndProcedure
StartDrawing(SpriteOutput(0)):Box(0, 0, w, h, $281400):StopDrawing():Repeat
If Int(ct/255)&1:c+256:Else:c-256:EndIf:ct+1:StartDrawing(SpriteOutput(0))
r(w/2,h-1,0,-1,h/2.3,-8):StopDrawing():DisplaySprite(0,0,0):FlipBuffers()
ExamineKeyboard():a+0.01:t-0.001:If t<0.86:t=3:EndIf:Until KeyboardInkey()
; One line to sparePosted: Sat Jun 20, 2009 9:51 pm
Sorry I am late 
This is an example which demonstrates how the Russian Peasant Multiplication algorithm works.
It chooses two random numbers (of course you can change those
), which will be multiplied together.
The first number (on the left) is doubled while the second number is halved (remainders from odd numbers are discarded - integer numbers only).
All even numbers on the right are removed along with their opposite number on the left.
The sum of the remaining numbers on the left is the result of the multiplication
This is an example which demonstrates how the Russian Peasant Multiplication algorithm works.
It chooses two random numbers (of course you can change those
), which will be multiplied together.The first number (on the left) is doubled while the second number is halved (remainders from odd numbers are discarded - integer numbers only).
All even numbers on the right are removed along with their opposite number on the left.
The sum of the remaining numbers on the left is the result of the multiplication
Code: Select all
;*****************************************************************************
;*
;* Name : Russian Peasant Multiplication
;* Author : Arctic Fox
;* Date : 20/06/2009
;* Notes : Read about the algorithm here: http://mathforum.org/dr.math/faq/faq.peasant.html
;* Should run on all platforms, but only tested on Windows
;*
;*****************************************************************************
OpenWindow(0,0,0,300,300,"Russian Peasant Multiplication",$C80001):n=15:Dim n(n)
Dim s(n):n(0)=Random(999):s(0)=Random(999):StartDrawing(WindowOutput(0)):Macro Z
Str:EndMacro:DrawingMode(1):c=#White:FillArea(0,0,-1,c):a$=Z(n(0))+" × "+Z(s(0))
a$+" = "+Z(n(0)*s(0)):DrawText(5,5,a$):Line(5,25,290,0):While s(a)>0:n$=Z(n(a))
s$=Z(s(a)):n(a+1)=n(a)*2:DrawText(5,a*20+30,n$):DrawText(105,a*20+30,s$)
s(a+1)=Int(s(a)/2):a+1:Delay(250):Wend:n=a:Delay(1000):For x=0 To n
If Right(Bin(s(x)),1)="0":Delay(400):Box(5,x*20+30,300,20,c):EndIf:Next
a$="= " + Z(n(0)*s(0)):DrawText(5,n*20+40,a$):Line(5,n*20+35,290,0)
a=TextWidth(a$):Line(5,n*20+60,a,0):Line(5,n*20+62,a,0):StopDrawing():Repeat
Until WaitWindowEvent()=16:EndPosted: Sat Jun 20, 2009 10:23 pm
Posted: Sat Jun 20, 2009 11:47 pm
Well, it stems from the old Sumer.Arctic Fox wrote:... how the Russian Peasant Multiplication algorithm works. ...
Some German language ancient math pages: http://www.chessbox.de/Wissen/matherechart1.html
Posted: Sat Jun 20, 2009 11:58 pm
The ancient Egyptians used a similar method (not exactly the same) which they invented thousands of years earlier than the Russian Peasant Multiplication (according to http://mathforum.org/dr.math/faq/faq.peasant.html). I guess Russian Peasant Multiplication is just a popular name of this methodOctopus wrote:Well, it stems from the old Sumer.
Posted: Sun Jun 21, 2009 9:59 am
Code: Select all
;*****************************************************************************
;*
;* Name : Star field
;* Author : Dobro (il reste plus grand chose de mon code LOL)
;* Date : 20/Juin/2009
;* Notes : optimisé par Tonton
;*
;*****************************************************************************
k=255:x=k*4:InitSprite():D=OpenWindow(1,0,0,x,x,"",$80C80001):n=5*x:Dim f(n)
Dim g(n):u=10*x:k=u/2:w=2*x:l=10:p=-l:g=x/2:OpenWindowedScreen(D,0,0,x,x,1,1,1)
Dim h(n):Macro z:f(i)=Random(u)-k:g(i)=Random(u)-k:EndMacro:For i=0 To n:M=60
h(i)=Random(w):z:Next:Repeat:StartDrawing(ScreenOutput()):Box(0,0,x,x)
For i=0 To n:h(i)+p:If h(i)<l:h(i)=w:EndIf:c=(f(i)*M)/h(i)+g:D=(-g(i)*M)/h(i)+g
Circle(c,D,1,Random(1<<24)):Next:StopDrawing():FlipBuffers():Until WindowEvent()=16 Code: Select all
;*****************************************************************************
;*
;* Name : text effect
;* Author : Dobro
;* Date : 20/Juin/2009
;* Notes : -
;*
;*****************************************************************************
LoadFont(1,"arial",50,512):InitSprite():AM=2:Ts.s="Pure Basic":
WD=OpenWindow(1,50,50,640,200,"",13238272)
OpenWindowedScreen(WD,0,0,640,200,1,0,0):CreateImage(100,640,100)
StartDrawing( ImageOutput(100)):FrontColor($FFFF00):BackColor(0)
DrawingFont(FontID(1)):DrawingMode(1):DrawText(0,0,Ts.s):StopDrawing()
For t=0 To 100:GrabImage(100,t,0,t,640,1):Next:Repeat
StartDrawing(ScreenOutput()):DrawingMode(1):For Y= 0 To 100
DrawingFont(FontID(1)):FrontColor($BA2595):DrawText(40,0,Ts.s):a+1:If a=360*10
a=0 :EndIf:x+(Sin(a*2*3.1415926/50)*AM):DrawImage(ImageID(Y),x+Y,Y+50,640,1)
Next:StopDrawing():FlipBuffers():EV=WindowEvent():Until EV=16Code: Select all
;*****************************************************************************
;*
;* Name : text effect 2
;* Author : Dobro
;* Date : 20/Juin/2009
;* Notes : -
;*
;*****************************************************************************
LoadFont(1,"arial",50,512):InitSprite():AM=5:Ts.s="Pure Basic"
WD=OpenWindow(1,50,50,640,200,"",13238272):
OpenWindowedScreen(WD,0,0,640,200,1,0,0):CreateImage(100,640,100):
StartDrawing(ImageOutput(100)):FrontColor($FFFF00):BackColor(0)
DrawingFont(FontID(1)):DrawingMode(1):DrawText(0,0,Ts.s):StopDrawing()
For t=0 To 100:GrabImage(100,t,0,t,640,1):Next:Repeat:
StartDrawing(ScreenOutput()):For Y= 0 To 100:a+1:If a=360*10:a=0:EndIf
x=1+( Sin (a*2*3.1415926/50)*AM):DrawImage(ImageID(Y),x+40,Y+20*x/25+50,640,1)
DP+1:If DP>640:DP=-100:EndIf:Next:StopDrawing():FlipBuffers():EV=WindowEvent()
Until EV=16Code: Select all
;*****************************************************************************
;*
;* Name : text effect 3
;* Author : Dobro
;* Date : 20/Juin/2009
;* Notes : -
;*
;*****************************************************************************
LoadFont(1,"arial",50,512):InitSprite():AM=50:Ts.s="Pure Basic"
WD=OpenWindow(1,50,50,640,200,"",13238272):
OpenWindowedScreen(WD,0,0,640,200,1,0,0):CreateImage(100,640,100):
StartDrawing(ImageOutput(100)):FrontColor($FFFF00):BackColor(0)
DrawingFont(FontID(1)):DrawingMode(1):DrawText(0,0,Ts.s):StopDrawing()
For t=0 To 100:GrabImage(100,t,0,t,640,1):Next:Repeat:
StartDrawing(ScreenOutput()):For Y=0 To 100:a+1:If a=360*10:a=0 :EndIf
x=1+(1*Cos(a*2*3.1415926/100)*AM)+40:x1=1+(1*Sin(a*2*3.1415926/100)*AM)+40
DrawImage( ImageID(Y),x+40,x1+Y,640,1):dep+1:If dep>640:dep=-100:EndIf:Next
StopDrawing():FlipBuffers():ClearScreen(0):EV=WindowEvent():Until EV=16Posted: Sun Jun 21, 2009 1:15 pm
nice idea.. here is my part :P
Edit: removed a : at the beginning of one line and set a window title
Edit: changed r back to 10 from 20 ;)
Edit: fixed a float error, changed starting position to the middle, removed some more characters :P
Edit: i don't like endless games, so here a version were you can't eat yourself (much more free space now ;)
Edit: changed segment size to make them look more "connected"
PS: hope i can stop modifying this code ;P
Code: Select all
;******************************************************************************
;*
;* Name : MiniSnake
;* Author : pcfreak
;* Date : 2009-06-21
;* Notes : Up: 5
;* Down: 2
;* Left: 1
;* Right: 3
;* Quit: 0
;*
;******************************************************************************
w=64:h=48:r=10:NewList s.POINT():Macro r(l):Random(l-3)+1:EndMacro:InitSprite()
Macro z:s():EndMacro:Macro e(v):v#element(z):EndMacro:x=r(w):InitKeyboard()
OpenWindowedScreen(OpenWindow(0,0,0,w*r,h*r,"mSnake"),0,0,w*r,h*r,0,0,0):y=r(h)
e(add):z\x=w/2:z\y=h/2:Repeat:ExamineKeyboard():k.s=KeyboardInkey():e(first)
If k="1":d=3:EndIf:If k="5" Or k="2":d=Val(k):EndIf:If k="3":d=0:EndIf:n=z\x
m=z\y:While e(Next):Swap z\x,n:Swap z\y,m:Wend:e(first):z\x+Cos(d):z\y+Sin(d)
StartDrawing(ScreenOutput()):n=z\x:m=z\y:While e(Next):If z\x=n And z\y=m:End
EndIf:Wend:If n=x And m=y:e(add):z\x=n:x=r(w):y=r(h):z\y=m:EndIf
Box(0,0,w*r,h*r,$C000):ForEach z:Circle(z\x*r,z\y*r,r/2+1,$2D72D2):Next
Circle(x*r,y*r,r/2+1,$FFFFFF):StopDrawing():FlipBuffers():Delay(50):Until k="0"Edit: changed r back to 10 from 20 ;)
Edit: fixed a float error, changed starting position to the middle, removed some more characters :P
Edit: i don't like endless games, so here a version were you can't eat yourself (much more free space now ;)
Edit: changed segment size to make them look more "connected"
PS: hope i can stop modifying this code ;P
Posted: Sun Jun 21, 2009 10:57 pm
Code: Select all
;*****************************************************************************
;*
;* Name : Estelar fireworking
;* Author : Psychophanta
;* Date : 21 June 2009
;* Notes : Should work on Windows
;*
;*****************************************************************************
InitSprite():InitKeyboard():OpenScreen(1024,768,32,""):Structure j:a.f:x.l:y.l
i.l:e.l:n.l:d.l:f.f:c.l:u.f:v.f:w.f:g.f:EndStructure:Dim m.j(22):With m(z)
Macro r(r):Random(r):EndMacro:Macro L(_,g=\)
LineXY(g#x+g#i*Cos(_),g#y+g#i*Sin(_),g#x+g#e*Cos(g#w),g#y+g#e*Sin(g#w),g#c)
EndMacro:For z=0 To 22:\i=r(400):Next:Repeat:ClearScreen(0):ExamineKeyboard()
StartDrawing(ScreenOutput()):For z=0 To 22:If \i>r(500)+50:\x=r(1023):\y=r(767)
\i=r(10):\e=r(30):\d=(r(1E3)-5E2)/10:\c=r($EEEEEE)+$111111:\n=r(26)+4
\g=(r(1E3)-5E2)/1E4:EndIf:\a=2*#PI/\n:For t=1 To \n:\u=(t-1)*\a+\f:\v=t*\a+\f
\w=(t+\d/20-0.5)*\a+\f:L(\u):L(\v):Next:\i+2:\e-\i/6:\f+\g:Next:StopDrawing()
FlipBuffers():Delay(16):Until KeyboardPushed(#PB_Key_Escape)
(Ahg! Fred, please fix those problems with 'With').
Posted: Sun Jun 21, 2009 11:38 pm
Doesn't work on Mac, as there's no working screenoutput() on this platform.
Posted: Mon Jun 22, 2009 12:00 am
Fixeddjes wrote:Doesn't work on Mac, as there's no working screenoutput() on this platform.
Posted: Mon Jun 22, 2009 3:45 am
Wow, everyones been making such wonderful stuff here. Thought I might contribute also. Noticed not much in the way of utilities, mainly Fx and games so far. So I put this little magnifier together. Nothing too original, but it fits the criteria I think. It will only work on Windows, hope thats not a problem.
I'm sure it can probably be made smaller yet, but not much smaller.
Code: Select all
;*****************************************************************************
;*
;* Name : Littlest Magnifier
;* Author : rrpl
;* Date : 22 June 09
;* Notes : Changing the value of M changes the magnification
;*
;*****************************************************************************
Procedure S(I,x,y,w,h): hI = CreateImage(I,w,h)
hd = StartDrawing(ImageOutput(I)): D = GetDC_(GetDesktopWindow_())
BitBlt_(hd,0,0,w,h,D,x,y,#SRCCOPY): StopDrawing()
ReleaseDC_(GetDesktopWindow_(),D ):ProcedureReturn hI:EndProcedure
OpenWindow(0,0,0,600,150,"Littlest Magnifier",#PB_Window_SystemMenu)
StickyWindow(0,1):M=3:ImageGadget(0,0,0,600,150,1)
While WindowEvent()<>16:GetCursorPos_(c.point)
I=S(1,c\x,c\y,600/M,150/M):New=ResizeImage(1, WindowWidth(0),WindowHeight(0))
SetGadgetState(0,New):Delay(50):Wend