PureBasic Forums - English

Posted: **Mon Jul 14, 2014 5:29 pm**

CSHW89 wrote:Wow, thanks all for your replies. I shrank the code from 35 to 28 lines . Link

That leaves pleanty of room for improvement.
I was going for a wooden board with transparent glass marbles and plastic pegs look.

Posted: **Mon Jul 14, 2014 5:33 pm**

heartbone wrote:... plastic pegs look.

30 lines.

Code: Select all

;*******************************************************************************
;*
;* July-August 2014 PurePunch contest
;* PureBasic 5.22
;* 50 lines of 80 chars, 2 months delay
;*
;* Name     :   Mastermind
;* Author   :   cshw89 & NicTheQuick
;* Date     :   14/07/14
;* Notes    :   You have ten attempts to crack the code. Duplicates are
;*              allowed. Click or drag the colors to the respective positions.
;*
;*******************************************************************************
Global Dim i(3):Macro m:Macro:EndMacro:OpenWindow(0,0,0,250,480,"Mastermind",
#PB_Window_SystemMenu|#PB_Window_ScreenCentered):Global Dim r(3):CanvasGadget(0,
0,0,250,480):Global s.s="$A0A0A0$0000FF$00D000$FF0000$00D0D0$0070D0$D000D0",x,y,
l=-2,a=0:Macro p:Procedure:EndMacro:p c(n=0):If StartDrawing(CanvasOutput(0))
m u(w):Val(Mid(s,(w)*7+1,7)):EndMacro:m z(k):DrawingMode(#PB_2DDrawing_Gradient)
FrontColor(u(i(i))):BackColor($ffffff):CircularGradient(i*40+23-6*Bool(i(i)),
k*40+23-6*Bool(i(i)),15):Circle(i*40+20,k*40+20,15):EndMacro:Box(0,400*n,250,
480-400*n,$D0D0D0):For k=n*10 To 10:For i=0 To 3:z(k):Next:DrawingMode(1):Next
Box(170,405,70,30,$A0A0A0):DrawText(205-TextWidth("OK")/2,412,"OK",0):For i=0+
0 To 5:Circle(i*30+15,460,10,u(i+1)):Next:If l>0:Circle(x,y,15,u(l)):EndIf
StopDrawing():EndIf:End#p:For i=0 To 3:r(i)=Random(5)+1:Next:p a(i):If i<0:i*-1;
EndIf:p#Return i:End#p:c():m g(t):GetGadgetAttribute(0,t):End#m:Repeat:e=0+;;;;;
WaitWindowEvent():If e=#PB_Event_Gadget:t=EventType():x=g(#PB_Canvas_MouseX);;;;
y=g(#PB_Canvas_MouseY):b=-1:If y>=400:If x<160 And y<440:b=x/40:ElseIf x<180 And
y>=440:b=x/30+4:EndIf:EndIf:Select t:Case #PB_EventType_MouseMove:If f=0 And;;;;
g(#PB_Canvas_Buttons)&#PB_Canvas_LeftButton:If l=-2 And(a(x-lx)>1 Or a(y-ly)>1);
If b=-1:l=-1:ElseIf b<4:l=i(b):i(b)=0:Else:l=b-3:EndIf:EndIf:EndIf:Case 0+;;;;;;
#PB_EventType_LeftButtonUp:If l>0 And b>=0 And b<4:i(b)=l:EndIf:If l=-2:If b>-1+
0 And f=0:If b<4:i(b)=0:Else:For k=0 To 3:If i(k)=0:i(k)=b-3:Break:EndIf:Next;;;
EndIf:Else:If x>=160 And y>=400 And y<440:If f:For k=0 To 3:r(k)=Random(5)+1;;;;
i(k)=0:Next:f=0:a=0:c():Else:h=1:For k=0 To 3:If i(k)=0:h=0:EndIf:Next:If h:r=0;
w=0:For i=0 To 3:If r(i)=i(i):i(i)*-1:r(i)*-1:r+1:EndIf:Next:For i=0 To 3:m q;;;
MessageRequester("Mastermind":EndMacro:For k=0 To 3:If i(k)>0 And r(i)=i(k) And;
i<>k:i(k)*-1:w+1:Break:EndIf:Next:Next:If StartDrawing(CanvasOutput(0)):For i=0+
0 To 3:i(i)=a(i(i)):r(i)=a(r(i)):z(a):i(i)=0:Next:DrawingMode(1)
i=170:For k=1 To r:Box(i,a*40+12,16,16,0):i+20:Next:For k=1 To w:Box(i,a*40+12,;
16,16,$FFFFFF):i+20:Next:StopDrawing():EndIf:a+1:If r=4:f=1:q,"You Win!");;;;;;;
ElseIf a=10:For i=0 To 3:i(i)=r(i):Next:c(1):q,"You Lose!"):f=1:EndIf:EndIf;;;;;
EndIf:EndIf:EndIf:EndIf:l=-2:Case #PB_EventType_LeftButtonDown:If f=0:lx=x:ly=y;
EndIf:EndSelect:If y<415:y=415:EndIf:c(1):EndIf:Until e=#PB_Event_CloseWindow;;;

I also have added some circles to my graphics demo: Superformula

Posted: **Mon Jul 14, 2014 8:09 pm**

Really nice !!! I love it !

Posted: **Mon Jul 14, 2014 8:44 pm**

NicTheQuick wrote:
heartbone wrote:... plastic pegs look.
30 lines.
{snip}
I also have added some circles to my graphics demo: Superformula

I looked and saw plastic marbles.
(Just kidding, they probably are pegs on most boards. And they do look better.

)
After reconsideration... considering the application...
instead of black and white plastic pegs, I probably would have gone with an ebony and ivory look (loaded from an external file).
Perhaps on a mahogany board with teak accents.

I still like the crystal marbles, but perhaps the granite would work better in an organic sort of way.

However, the shading effect on CSHW89's marbles in only 2 added lines of code is probably more efficient than loading and managing images from an external file.

Posted: **Tue Jul 15, 2014 9:39 am**

Too Linux and Mac users : I've added a code of my punch for these OSs (tested on a linux vm).

I coudn't put it in one code because of the size of the PB constant...

Posted: **Tue Jul 15, 2014 11:43 am**

heartbone wrote:Perhaps on a mahogany board with teak accents.
I still like the crystal marbles, but perhaps the granite would work better in an organic sort of way.

I don't know why the circles were not displayed. But here is the actual state:

Code: Select all

old code removed

Edit: Now it works. See next post.

Posted: **Tue Jul 15, 2014 3:59 pm**

Finally Mastermind in Mahagoni look and in only 41 lines of code.

Code: Select all

;*******************************************************************************
;*
;* July-August 2014 PurePunch contest
;* PureBasic 5.22
;* 50 lines of 80 chars, 2 months delay
;*
;* Name     :   Mastermind
;* Author   :   cshw89 & NicTheQuick
;* Date     :   14/07/14
;* Notes    :   You have ten attempts to crack the code. Duplicates are
;*              allowed. Click or drag the colors to the respective positions.
;*
;*******************************************************************************
#s=199:Global Dim n.d(#s,#s):For x=0 To#s:For y=0 To#s:n(x,y)=Random(9999)/9999
Next:Next:Macro p(a=):Procedure#a:EndMacro:p(.d) t(e.d,f.d,s.d):r.d=0:g.d=s:
While(s>=1):t.d=e/s:u.d=f/s:i.d=t-Int(t):j.d=u-Int(u):w=Int(t)%#s:b=Int(u)%#s:
c=(w+#s-1)%#s:d=(b+#s-1)%#s:r+(i*j*n(w,b)+i*(1-j)*n(w, d)+(1-i)*(1-j)*n(c,d)+(1+
0-i)*j*n(c,b))*s:s/2:Wend:p(Return)(128*r/g):EndProcedure:p() m(x,y,_,t):c.d=0+
Pow((Red(t)/255),4):w.d=x*5/#s+y*10/#s+t(x,y,21)/50:v.d=128*Abs(Sin(w*#PI))
c=0.5*(c+1):p(Return) RGB(c*(80+v),c*(30+v),30):EndProcedure:CreateImage(0,250,
480,24,$ff):StartDrawing(ImageOutput(0)):DrawingMode(#PB_2DDrawing_Gradient):
For k=0 To 10:For i=0 To 3:CircularGradient(i*40+26,k*40+26,15):FrontColor($7f)
BackColor($ff):Circle(i*40+20,k*40+20,15):Next:Next:CustomFilterCallback(@m())
DrawingMode(#PB_2DDrawing_CustomFilter):Box(0,0,250,480):StopDrawing():#t="Mas"+
"termind":l=-2:Dim i(3):Dim r(3):Macro m:Macro:EndMacro:m u(w):
Val(Mid("$A0A0A0$0000FF$00D000$FF0000$00D0D0$0070D0$D000D0",(w)*7+1,7)):EndMacro
OpenWindow(0,0,0,250,480,#t,#PB_Window_SystemMenu|#PB_Window_ScreenCentered):
CanvasGadget(0,0,0,250,480):m z(x,y,r,c):DrawingMode(#PB_2DDrawing_Gradient):
FrontColor(u(c)):BackColor($ffffff):CircularGradient(x-3,y-3,r):If r:Circle(x,y,
r):EndIf:EndMacro:m c():If StartDrawing(CanvasOutput(0)):DrawImage(ImageID(0),0,
0):If (IsImage(1)):DrawImage(ImageID(1),0,0):EndIf:For i=0 To 3:z(i*40+20,400+
20,Bool(i(i))*15,i(i)):DrawingMode(#PB_2DDrawing_AlphaBlend):c=255-i*10:Box(170+
i,405+i,70-2*i,30-2*i,RGBA(c,c,c,99)):Next:DrawingMode(1):DrawText(193,412,"OK",
0):For i=0 To 5:z(i*30+15,460,9,i+1):Next:If l>0:z(x,y,15,l):EndIf:StopDrawing()
EndIf:EndMacro:For i=0 To 3:r(i)=Random(5)+1:Next:m q(m):MessageRequester(#t,m)
EndMacro:m g(t):GetGadgetAttribute(0,t):EndMacro:Repeat:m V:EndIf:EndMacro:e=0+
WaitWindowEvent():If e=#PB_Event_Gadget:t=EventType():x=g(#PB_Canvas_MouseX):
y=g(#PB_Canvas_MouseY):b=-1:If y>=400:If x<160 And y<440:b=x/40:ElseIf x<180+
0 And y>=440:b=x/30+4:V:V:Select t:Case #PB_EventType_MouseMove:If f=0 And g(0+
#PB_Canvas_Buttons)&#PB_Canvas_LeftButton:If l=-2 And(Abs(x-lx)>1 Or Abs(y-ly)+
0>1):If b=-1:l=-1:ElseIf b<4:l=i(b):i(b)=0:Else:l=b-3:V:V:V:Case 0+
#PB_EventType_LeftButtonUp:If l>0 And b>=0 And b<4:i(b)=l:V:If l=-2:If b>-1+
0 And f=0:If b<4:i(b)=0:Else:For k=0 To 3:If i(k)=0:i(k)=b-3:Break:V:Next:V
Else:If x>=160 And y>=400 And y<440:If f:For k=0 To 3:r(k)=Random(5)+1:i(k)=0
Next:f=0:a=0:c():Else:h=1:For k=0 To 3:If i(k)=0:h=0:V:Next:If h:r=0:w=0:
For i=0 To 3:If r(i)=i(i):i(i)*-1:r(i)*-1:r+1:V:Next:For i=0 To 3:For k=0 To 3
If i(k)>0 And r(i)=i(k) And i<>k:i(k)*-1:w+1:Break:V:Next:Next:StartDrawing(0+
CanvasOutput(0)):For i=0 To 3:i(i)=Abs(i(i)):r(i)=Abs(r(i)):z(i*40+20,a*40+20,
Bool(i(i))*15,i(i)):i(i)=0:Next:DrawingMode(1):i=170:For k=1 To r:Box(i,a*40+12,
16,16,0):i+20:Next:For k=1 To w:Box(i,a*40+12,16,16,$FFFFFF):i+20:Next:
GrabDrawingImage(1,0,0,250,400):StopDrawing():a+1:If r=4:f=1:q("You Win!")
FreeImage(1):ElseIf a=10:For i=0 To 3:i(i)=r(i):Next:c():q("You Lose!"):f=1:V:V
V:V:V:V:l=-2:Case #PB_EventType_LeftButtonDown:If f=0:lx=x:ly=y:V:EndSelect
If y<415:y=415:V:c():V:Until e=#PB_Event_CloseWindow

Posted: **Tue Jul 15, 2014 10:39 pm**

@Nick
The super formula before the last update was much better from the art point of view
I wish to re post it keeping the last one too
For your information i adapted it successfully in a M Media player
to be played with audio files
Thanks I wish you the best in the contest

Posted: **Tue Jul 15, 2014 11:14 pm**

RASHAD wrote:@Nick
The super formula before the last update was much better from the art point of view

You mean that one without the circles?

Posted: **Tue Jul 15, 2014 11:36 pm**

I did a comparison again and I still like the version which has a constant
#n=1000
I can post it if you lost yours
That one is the best so far in the contest
I wish you luck

Posted: **Tue Jul 15, 2014 11:56 pm**

Here is a new version. 14 lines and smoother transitions between changes if the symmetry has changed.

Code: Select all

;*******************************************************************************
;*
;* July-August 2014 PurePunch contest
;* PureBasic 5.22
;* 50 lines of 80 chars, 2 months delay
;*
;* Name     : Superformula
;* Author   : NicTheQuick
;* Date     : 13.07.2014
;* Notes    : Only tested on PB 5.30 b7 on Linux x64!
;*            You can also resize the window.
;*            abcdefghijklmnopqrstuvwxyz
;* Variables: ^^^^^^^^^^ ^^^^^^^ ^^^^^^
;* Macros   :                   ^      ^
;*******************************************************************************
w=600:h=600:Define.d a,b,c,d,e,n,o,p,r,t,x,y,z,q:If OpenWindow(0,0,0,w,h,"Supe"+
"rformel",#PB_Window_MaximizeGadget):CanvasGadget(0,0,0,w,h):Macro s(a):Sin(t*a)
EndMacro:l=999:Repeat:f=WindowWidth(0):g=WindowHeight(0):t=ElapsedMilliseconds()
v=WaitWindowEvent(10):If f!w|g!h:w=f:h=g:ResizeGadget(0,0,0,w,h):ElseIf t>u+20+
0 And StartDrawing(CanvasOutput(0)):If q<0:j=m:m=2+2*Random(20):q=1:EndIf:u=t
t/10000:q-0.005:c=10+9*s(2):d=9+9*s(3):a=Abs(s(7)*0.6)+0.1:b=Abs(s(11)*0.6)+0.1
e=9+9*s(5):GrabDrawingImage(0,0,0,w,h):x=150+100*s(1):y=Cos(t*9):n=w/2*(1+y)
DrawAlphaImage(ImageID(0),w*y/x,h*s(9)/x,99):DrawingMode(#PB_2DDrawing_Gradient)
o=h/2*(1+s(9)):LinearGradient(n,o,w-n,h-o):Macro k(a,b,c,d,e=127):a#Color(RGB(0+
e*(1+s(b)),e*(1+s(c)),e*(1+s(d)))):EndMacro:k(Front,2,3,5):k(Back,7,11,13)
Macro z(m):Pow(Pow(Abs(Cos(m*r/4)/a),d)+Pow(Abs(Sin(m*r/4)/b),e),1/c):EndMacro
For i=0 To l:r=i*2*#PI/l:p+s(1)/30000:z=q*z(j)+(1-q)*z(m):x=w/2*(Cos(r+p)/z+1)
y=h/2*(1+0.8*Sin(r+p)/z):If i:LineXY(n,o,x,y):EndIf:n=x:o=y:Circle(x,y,h*Bool(0+
i%(l/20)=0)/70/z):Next:StopDrawing():EndIf:Until v=#PB_Event_CloseWindow:EndIf

@RASHAD: "l" is the new "#n". Now it is 999 instead of 1000 because the line was too long.

For those who are interested in the "beautiful" code:

Code: Select all

;*******************************************************************************
;*
;* July-August 2014 PurePunch contest
;* PureBasic 5.22
;* 50 lines of 80 chars, 2 months delay
;*
;* Name     : Superformula
;* Author   : NicTheQuick
;* Date     : 13.07.2014
;* Notes    : Only tested on PB 5.30 b7 on Linux x64!
;*            You can also resize the window.
;*            abcdefghijklmnopqrstuvwxyz
;* Variables: ^^^^^^^^^^ ^^^^^^^ ^^^^^^
;* Macros   :                   ^      ^
;*******************************************************************************
EnableExplicit
Macro s(a):Sin(t*a):EndMacro
Global l=999,w=600,h=600,i,v,m,f,g,u,j:Define.d a,b,c,d,e,n,o,p,r,t,x,y,z,q
If OpenWindow(0,0,0,w,h,"Superformel",#PB_Window_MaximizeGadget)
	CanvasGadget(0,0,0,w,h)
	Repeat
		v=WaitWindowEvent(10)
		t=ElapsedMilliseconds()
		f=WindowWidth(0)
		g=WindowHeight(0)
		If f!w|g!h
			w=f:h=g
			ResizeGadget(0,0,0,w,h)
		ElseIf t>u+20 And StartDrawing(CanvasOutput(0))
			u=t
			t/10000
			If q<0
				j=m
				m=2+2*Random(20)
				q=1
			EndIf
			q-0.005
			c=10+9*s(2)
			d=9+9*s(3)
			e=9+9*s(5)
			a=Abs(s(7)*0.6)+0.1
			b=Abs(s(11)*0.6)+0.1
			GrabDrawingImage(0,0,0,w,h)
			x=150+100*s(1)
			y=Cos(t*9)
			DrawAlphaImage(ImageID(0),w*y/x,h*s(9)/x,99)
			DrawingMode(#PB_2DDrawing_Gradient)
			n=w/2*(1+y):o=h/2*(1+s(9)):LinearGradient(n,o,w-n,h-o)
			Macro k(a,b,c,d,e=127)
				a#Color(RGB(e*(1+s(b)),e*(1+s(c)),e*(1+s(d))))
			EndMacro
			k(Front,2,3,5)
			k(Back,7,11,13)
			For i=0 To l
				r=i*2*#PI/l
				p+s(1)/30000
				Macro z(m)
					Pow(Pow(Abs(Cos(m*r/4)/a),d)+Pow(Abs(Sin(m*r/4)/b),e),1/c)
				EndMacro
				z=q*z(j)+(1-q)*z(m)
				x=w/2*(1+Cos(r+p)/z)
				y=h/2*(1+Sin(r+p)/z)
				If i:LineXY(n,o,x,y):EndIf
				Circle(x,y,Bool(i%(l/20)=0)*h/70/z)
				n=x:o=y
			Next
			StopDrawing()
		EndIf
	Until v=#PB_Event_CloseWindow
EndIf

Posted: **Wed Jul 16, 2014 12:05 am**

I meant the one with no Circle

I did not follow all your modified versions

Posted: **Wed Jul 16, 2014 12:07 am**

Simply remove the Circle command.

PS.: I added the "beautiful" code in my last post.

Posted: **Wed Jul 16, 2014 12:14 am**

Circle removed

Looks much better (It is only me)

Posted: **Sat Jul 19, 2014 4:45 am**

Hi,

It's really amazing to see what can be done with so few lines of code; a testament to not only the coding skills of the participants, but also the power of PureBasic.

I'm looking forward to more great contributions.

---------------------------------------------------------------

The following sprite is needed: https://1drv.ms/i/s!ApfjGYM2v-vZlWYPn0wrm0Fg18vb

Code: Select all

;******************************************************************************
;*
;* July-August 2014 PurePunch contest
;* PureBasic 5.22
;* 50 lines of 80 chars, 2 months delay
;*
;* Name     : Console Animation
;* Author   : JHPJHP
;* Date     : July 18, 2014
;* Notes    : Windows Only / Remove Compiler-Option: Create unicode executable
;*                           (for a smoother result)
;*
;******************************************************************************
Global f:Structure e:nF.l:g.COORD:EndStructure:Procedure HR():End:EndProcedure;
Procedure yy(hI):z.e:GetCurrentConsoleFont_(f,1,@z);;;;;;;;;;;;;;;;;;;;;;;;;;;;
FS=GetConsoleFontSize_(f,z\nF):z\g\x=FS&$FFFF:z\g\y=(FS>>16)&$FFFF;;;;;;;;;;;;;
fR.d=z\g\x/z\g\y:xx.CONSOLE_SCREEN_BUFFER_INFO;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
GetConsoleScreenBufferInfo_(f,@xx):iW=xx\dwSize\x-1:Dim r.s(11):r(0)="#";;;;;;;
r(1)="@":r(2)="&":r(3)="%":r(4)="=":r(5)="+":r(6)="*":r(7)=":":r(8)="-";;;;;;;;
r(9)=".":r(10)=" ":tW=ImageWidth(hI):tH=ImageHeight(hI):sF.d=iW/tW;;;;;;;;;;;;;
iH=(tH*sF)*fR:ResizeImage(hI,iW,iH):StartDrawing(ImageOutput(hI));;;;;;;;;;;;;;
For y=0 To iH-1:For x=0 To iW-1:p=Point(x,y):gS=(Red(p)+Green(p)+Blue(p))/3;;;;
t=gS*10/255:cI.s+r(t):Next:cI+Chr(10):Next:StopDrawing();;;;;;;;;;;;;;;;;;;;;;;
WriteConsole_(f,cI,Len(cI),@q,0):SetConsoleCursorPosition_(f,0);;;;;;;;;;;;;;;;
EndProcedure:Prototype k():Global GW.k:kn=OpenLibrary(-1,"kernel32.dll");;;;;;;
GW=GetFunction(kn,"GetConsoleWindow"):AllocConsole_():f=GetStdHandle_(-11);;;;;
w.COORD:w\x=150:w\y=50:SetConsoleScreenBufferSize_(f,PeekL(w)):d=1024;;;;;;;;;;
ShowWindow_(GW(),3):SetConsoleCtrlHandler_(@HR(), 1):UsePNGImageDecoder();;;;;;
hS=LoadImage(-1,"c.png"):Repeat:For y=1 To d Step 256:For x=1 To d Step 512;;;;
hI=GrabImage(hS,-1,x,y,510,254):yy(hI):Delay(25):Next:Next:ForEver;;;;;;;;;;;;;

PureBasic Forums - English

PurePunch Contest July-August 2014

Re: PurePunch Contest July-August 2014

Re: PurePunch Contest July-August 2014

Re: PurePunch Contest July-August 2014

Re: PurePunch Contest July-August 2014

Re: PurePunch Contest July-August 2014

Re: PurePunch Contest July-August 2014

Re: PurePunch Contest July-August 2014

Re: PurePunch Contest July-August 2014

Re: PurePunch Contest July-August 2014

Re: PurePunch Contest July-August 2014

Re: PurePunch Contest July-August 2014

Re: PurePunch Contest July-August 2014

Re: PurePunch Contest July-August 2014

Re: PurePunch Contest July-August 2014

PurePunch Contest July-August 2014