That leaves pleanty of room for improvement.CSHW89 wrote:Wow, thanks all for your replies. I shrank the code from 35 to 28 lines . Link
I was going for a wooden board with transparent glass marbles and plastic pegs look.
That leaves pleanty of room for improvement.CSHW89 wrote:Wow, thanks all for your replies. I shrank the code from 35 to 28 lines . Link
30 lines.heartbone wrote:... plastic pegs look.
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 looked and saw plastic marbles.NicTheQuick wrote:30 lines.heartbone wrote:... plastic pegs look.
{snip}
I also have added some circles to my graphics demo: Superformula
I don't know why the circles were not displayed. But here is the actual state: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.
Code: Select all
old code removed
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
You mean that one without the circles?RASHAD wrote:@Nick
The super formula before the last update was much better from the art point of view
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
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
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;;;;;;;;;;;;;