PurePunch Contest #2

Octopus · Post by **Octopus** » 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.

djes · Post by **djes** » 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.

Trond · Post by **Trond** » 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 spare

Arctic Fox · Post by **Arctic Fox** » 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

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:End

djes · Post by **djes** » Sat Jun 20, 2009 10:23 pm

Octopus · Post by **Octopus** » Sat Jun 20, 2009 11:47 pm

Arctic Fox wrote:... how the Russian Peasant Multiplication algorithm works. ...

Well, it stems from the old Sumer.

Some German language ancient math pages: http://www.chessbox.de/Wissen/matherechart1.html

Arctic Fox · Post by **Arctic Fox** » Sat Jun 20, 2009 11:58 pm

Octopus wrote:Well, it stems from the old Sumer.

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 method

dobro · Post by **dobro** » 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=16

Code: 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=16

Code: 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=16

pcfreak · Post by **pcfreak** » Sun Jun 21, 2009 1:15 pm

nice idea.. here is my part :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: 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

Psychophanta · Post by **Psychophanta** » 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)

NOTICE: after copy&paste remove space at the end of 2nd line of code.
(Ahg! Fred, please fix those problems with 'With').

djes · Post by **djes** » Sun Jun 21, 2009 11:38 pm

Doesn't work on Mac, as there's no working screenoutput() on this platform.

Psychophanta · Post by **Psychophanta** » Mon Jun 22, 2009 12:00 am

djes wrote:Doesn't work on Mac, as there's no working screenoutput() on this platform.

Fixed

rrpl · Post by **rrpl** » 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.

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

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