PurePunch Contest July-August 2014

Developed or developing a new product in PureBasic? Tell the world about it.
User avatar
heartbone
Addict
Addict
Posts: 1058
Joined: Fri Apr 12, 2013 1:55 pm
Location: just outside of Ferguson

Re: PurePunch Contest July-August 2014

Post by heartbone »

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. ;)
Keep it BASIC.
User avatar
NicTheQuick
Addict
Addict
Posts: 1224
Joined: Sun Jun 22, 2003 7:43 pm
Location: Germany, Saarbrücken
Contact:

Re: PurePunch Contest July-August 2014

Post by NicTheQuick »

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
The english grammar is freeware, you can use it freely - But it's not Open Source, i.e. you can not change it or publish it in altered way.
User avatar
Fig
Enthusiast
Enthusiast
Posts: 351
Joined: Thu Apr 30, 2009 5:23 pm
Location: Côtes d'Azur, France

Re: PurePunch Contest July-August 2014

Post by Fig »

Really nice !!! I love it !
There are 2 methods to program bugless.
But only the third works fine.

Win10, Pb x64 5.71 LTS
User avatar
heartbone
Addict
Addict
Posts: 1058
Joined: Fri Apr 12, 2013 1:55 pm
Location: just outside of Ferguson

Re: PurePunch Contest July-August 2014

Post by heartbone »

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.
Keep it BASIC.
User avatar
graph100
Enthusiast
Enthusiast
Posts: 115
Joined: Tue Aug 10, 2010 3:17 pm

Re: PurePunch Contest July-August 2014

Post by graph100 »

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...
_________________________________________________
My Website : CeriseCode (Warning : perpetual changes & not completed ;))
User avatar
NicTheQuick
Addict
Addict
Posts: 1224
Joined: Sun Jun 22, 2003 7:43 pm
Location: Germany, Saarbrücken
Contact:

Re: PurePunch Contest July-August 2014

Post by NicTheQuick »

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.
Last edited by NicTheQuick on Tue Jul 15, 2014 4:17 pm, edited 1 time in total.
The english grammar is freeware, you can use it freely - But it's not Open Source, i.e. you can not change it or publish it in altered way.
User avatar
NicTheQuick
Addict
Addict
Posts: 1224
Joined: Sun Jun 22, 2003 7:43 pm
Location: Germany, Saarbrücken
Contact:

Re: PurePunch Contest July-August 2014

Post by NicTheQuick »

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

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
The english grammar is freeware, you can use it freely - But it's not Open Source, i.e. you can not change it or publish it in altered way.
RASHAD
PureBasic Expert
PureBasic Expert
Posts: 4636
Joined: Sun Apr 12, 2009 6:27 am

Re: PurePunch Contest July-August 2014

Post by RASHAD »

@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
Egypt my love
User avatar
NicTheQuick
Addict
Addict
Posts: 1224
Joined: Sun Jun 22, 2003 7:43 pm
Location: Germany, Saarbrücken
Contact:

Re: PurePunch Contest July-August 2014

Post by NicTheQuick »

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?
The english grammar is freeware, you can use it freely - But it's not Open Source, i.e. you can not change it or publish it in altered way.
RASHAD
PureBasic Expert
PureBasic Expert
Posts: 4636
Joined: Sun Apr 12, 2009 6:27 am

Re: PurePunch Contest July-August 2014

Post by RASHAD »

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
Egypt my love
User avatar
NicTheQuick
Addict
Addict
Posts: 1224
Joined: Sun Jun 22, 2003 7:43 pm
Location: Germany, Saarbrücken
Contact:

Re: PurePunch Contest July-August 2014

Post by NicTheQuick »

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. :D
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
:D
Last edited by NicTheQuick on Wed Jul 16, 2014 12:06 am, edited 1 time in total.
The english grammar is freeware, you can use it freely - But it's not Open Source, i.e. you can not change it or publish it in altered way.
RASHAD
PureBasic Expert
PureBasic Expert
Posts: 4636
Joined: Sun Apr 12, 2009 6:27 am

Re: PurePunch Contest July-August 2014

Post by RASHAD »

I meant the one with no Circle :)
I did not follow all your modified versions
Egypt my love
User avatar
NicTheQuick
Addict
Addict
Posts: 1224
Joined: Sun Jun 22, 2003 7:43 pm
Location: Germany, Saarbrücken
Contact:

Re: PurePunch Contest July-August 2014

Post by NicTheQuick »

Simply remove the Circle command. :wink:

PS.: I added the "beautiful" code in my last post.
The english grammar is freeware, you can use it freely - But it's not Open Source, i.e. you can not change it or publish it in altered way.
RASHAD
PureBasic Expert
PureBasic Expert
Posts: 4636
Joined: Sun Apr 12, 2009 6:27 am

Re: PurePunch Contest July-August 2014

Post by RASHAD »

Circle removed :P
Looks much better (It is only me)
Egypt my love
JHPJHP
Addict
Addict
Posts: 2129
Joined: Sat Oct 09, 2010 3:47 am
Contact:

PurePunch Contest July-August 2014

Post by JHPJHP »

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;;;;;;;;;;;;;
Last edited by JHPJHP on Wed Jun 21, 2017 6:51 pm, edited 10 times in total.
Post Reply