XMas 2014 PurePunch Contest

[Vera]

That is fun to play majikeyric ~ thanks

[electrochrisso]

Thats it majikeyric, I am going to top yours with grand theft auto 5.

Seriously, you have done an amazing job with such a small amount of code, smooth scrolling and music too.

[Lebostein]

@majikeyric: I get an illegal memory acces in line 57

Code: Select all

s.s1\p[0]=#C:s\p[1]=0:s\p[3]=p(10):i=1:RP:Copy#U(*s,@s\b[0],64):M1(p(6),0);;;;;;

PureBasic 5.31 (Windows - x86)

[majikeyric]

Thanks everybody

@Lebostein, unfortunately I can't reproduce the problem and I don't really see where it can come from.
Have you modified something in the source? (eg. the constants at the top).

[kernadec]

Hello majikeyric
Thanks For This code
I should add that the competition is difficult against a magician like you
Best regards

[kernadec]

Hi all
Here's my contribution 2014
After a design work To obtain an ellipsoid, it has become a Spirograph
then of yarn needles, it became graphics toy For This Christmas season.

Best regards

ps:added the displacement simultaneously of 4 colors
ps:the code to manage the resolution or window
integrate a random mode on 4 colors in 64 lines of 80 characters

I just added a drawing mode stick using a Swap x 2, x 1 With the line function is fun
I use the button delete This because it is accessible all OS

MANDALAS 3D

Code: Select all

;*****************************************************************************
;*
;* XMas 2014 PurePunch contest
;* PureBasic 5.31
;* 64 lines of 80 chars of code + 78 (only!) lines of data
;*
;* Name     : Mandalas 3D 
;* Author   : Kernadec
;* Date     : 10/12/2014   v6
;* Notes    : commandes menu key to screen
;*   
;*****************************************************************************
Macro M:Macro:EndMacro:M T:Delay(100):End#M:M J:If:End#M:M Q:EndIf:End#M:M P;;;;
DrawText:EndMacro:M K:KeyboardPushed:EndMacro:Global Dim cl(7);;;;;;;;;;;;;;;;;;
Procedure Ellipse_Rotation(Axex.l,Axey.l,Xr.l,Yr.l,Zr.l,Rtx.d,Rty.d,Rtz.d,;;;;;;
Debut.l,Fin.l,Polygone.l,Col.l,Mode.l,u.l):Protected v.d,RB.d,Rx.d,Ry.d,Rz.d,;;;
X.d,Y.d,Z.d,X1.d,Y1.d,Z1.d,Psx1.l,Psy1.l,Psx2.l,Psy2.l,Cote.d,Pas.d;;;;;;;;;;;;;
J Polygone<>0:Cote=360/Polygone:Else:Cote=360:Q:Rx=Radian(Rtx):Ry=Radian(Rty);;;
Rz=Radian(Rtz):Pas=debut:Repeat:v=Radian(Pas):J Mode=0:X=Xr*Sin(v):Y=Yr*Sin(v);;
Z=Zr*Cos(v):Q:J Mode=1:X=Xr*Sin(v):Y=Yr*Sin(v/10):Z=Zr*Sin(v/1.7):Q:J Mode=2;;;;
X=Xr*Cos(v-0.5):Y=Yr*Sin(v):Z=Zr*Cos(v):Q:J Mode=3:X=Xr*Sin(v*2):Y=Yr*Cos(v/4);;
Z=Zr*Sin(v):Q:J Mode=4:X=Xr*Cos(v*-3):Y=Yr*Cos(v/-2):Z=Zr*Sin(v):Q:J Mode=5;;;;;
X=Xr*Sin(v/4):Y=Yr*Cos(v*2):Z=Zr*Sin(v/3):Q:J Mode=6:X=Xr*Sin(v*1.5):Y=Yr*Cos(v)
Z=Zr*Sin(v/1.5):Q:J Mode=7:X=Xr*Sin(v/1.5):Y=Yr*Cos(v*2.5):Z=Zr*Sin(v):Q;;;;;;;;
J Mode=8:X=Xr*Sin(v/2):Y=Yr*Cos(v*-3):Z=Zr*Sin(v*1.4):Q:J Mode=9:X=Xr*Cos(v);;;;
Y=Yr*Cos(v/3):Z=Zr*Cos(v*1.7):Q:X1=X*Cos(rz)+Y*Sin(rz):y1=Y*Cos(rz)-X*Sin(rz);;;
Z1=Z:RB=Y1*Cos(ry)-Z1*Sin(ry):z1=Y1*Sin(ry)+Z1*Cos(ry):Y1=RB:RB=X1*Cos(rx)+;;;;;
Z1*Sin(rx):z1=X1*Sin(rx)-Z1*Cos(rx):Y1=RB:Psx1=Z1+Axex:Psy1=Y1+Axey:J Psx2=0 And
Psy2=0:Psx2=Psx1:Psy2=Psy1:Q:j u=1:Swap Psy2,psy1:Q:J Pas=>0 And Pas<=90;;;;;;;;
LineXY(Psx2,Psy2,Psx1,Psy1,cl(0)):Q:J Pas=>90 And Pas<=180:LineXY(Psx2,Psy2,;;;;
Psx1,Psy1,cl(1)):Q:J Pas=>180 And Pas<=270:LineXY(Psx2,Psy2,Psx1,Psy1,cl(2)):Q;;
J Pas=>270 And Pas<=360:LineXY(Psx2,Psy2,Psx1,Psy1,cl(3)):Q:j u=1:Swap Psy2,psy1
Q:Psx2=Psx1:Psy2=Psy1:Pas+Cote:Until Pas=>Fin+1:EndProcedure:ExamineDesktops();;
InitSprite():InitKeyboard():R1=MessageRequester("SCREEN",Space(16)+;;;;;;;;;;;;;
"FULL SCREEN",#PB_MessageRequester_YesNo):a=2:b=3:c=0:d=1:cl(a)=RGB(255,0,0);;;;
cl(b)=RGB(0,0,255):cl(c)=RGB(0,255,0):zd=90:cl(d)=RGB(255,255,0);;;;;;;;;;;;;;;;
xs=DesktopWidth(0):xd=90:yd=50:ys=DesktopHeight(0):J R1=6:OpenScreen(xs,ys,32,;;
""):Else:xs=800:ys=600:OpenWindow(0,0,0,xs,ys,"MANDALAS 3D",;;;;;;;;;;;;;;;;;;;;
#PB_Window_WindowCentered|#PB_Window_ScreenCentered);;;;;;;;;;;;;;;;;;;;;;;;;;;;
OpenWindowedScreen(WindowID(0),0,0,xs,ys,0,0,0,#PB_Screen_SmartSynchronization);
Q:cl(4)=cl(a):cl(5)=cl(b):cl(6)=cl(c):cl(7)=cl(d):Axex.l=xs/2:Axey.l=ys/2;;;;;;;
Debut.l=0:Fin.l=360:inc=10:Plt.l=10:Plg.l=5:Vi.l=19:Mode.l=8:Zr.l=-1:Yr.l=-315;;
Xr.l=160:Repeat:ClearScreen(color):StartDrawing(ScreenOutput()):J Plt<0:Plt=360;
Q:zd=Mod(zd+Vi,360):For i=0 To 360:Ellipse_Rotation(Axex,Axey,Xr,Yr,Zr,xd,yd,zd+
i,Debut,Fin,Plt,0,Mode,u):i+Plg:Next i:StopDrawing():ExamineKeyboard();;;;;;;;;;
J K(#PB_Key_Tab):T:Mode+1:J Mode>9:Mode=0:Q:Q:J K(#PB_Key_LeftShift):T:J inc=1;;
inc=10:Else:inc=1:Q:Q:J K(#PB_Key_Space):T:J Lt=0:Lt=1:Else:Lt=0:Q:Q;;;;;;;;;;;;
J K(#PB_Key_Delete):J u=0:u=1:Else:u=0:Q:Q:J Plt=180:Plt+180:tmp=10:Else:tmp=inc
Q:J Plt=0:Plt=360:tmp=10:Else:tmp=inc:Q:J Plt<20:tmp=1:Else:tmp=inc:Q;;;;;;;;;;;
J K(#PB_Key_PageUp):Plt=Mod((Plt+tmp),180):Q:J K(#PB_Key_PageDown):T;;;;;;;;;;;;
Plt=Mod((Plt-tmp),180):Plt=Abs(Plt):Q:J K(#PB_Key_F1):Plt=3:Q:J K(#PB_Key_F2);;;
Plt=4:Q:J K(#PB_Key_F3):Plt=5:Q:J K(#PB_Key_F4):Plt=6:Q:J K(#PB_Key_F5):Plt=7:Q;
J K(#PB_Key_F6):Plt=8:Q:J K(#PB_Key_F7):Plt=9:Q:J K(#PB_Key_Up):yd=Mod(yd+inc,;;
360):Q:J K(#PB_Key_Down):yd=Mod(yd-inc,360):Q:J K(#PB_Key_Left):xd=Mod(xd+inc,;;
360):Q:J K(#PB_Key_Right):xd=Mod(xd-inc,360):Q:J K(#PB_Key_Home):T:Plg=Mod(Plg+;
inc,360):Q:J K(#PB_Key_End):T:Plg=Mod(Plg-inc,360):Plg=Abs(Plg):Q;;;;;;;;;;;;;;;
J K(#PB_Key_1) Or K(#PB_Key_Pad1):Zr=Mod(Zr-inc,ys):Q:J K(#PB_Key_4) Or;;;;;;;;;
K(#PB_Key_Pad4):Zr=Mod(Zr+inc,ys):Q:J K(#PB_Key_2) Or K(#PB_Key_Pad2);;;;;;;;;;;
Yr=Mod(Yr-inc,ys):Q:J K(#PB_Key_3) Or K(#PB_Key_Pad3):Yr=Mod(Yr+inc,ys):Q;;;;;;;
J K(#PB_Key_5) Or K(#PB_Key_Pad5):Xr=Mod(Xr-inc,ys):Q:J K(#PB_Key_6) Or;;;;;;;;;
K(#PB_Key_Pad6):Xr=Mod(Xr+inc,ys):Q:J K(#PB_Key_7) Or K(#PB_Key_Pad7):T;;;;;;;;;
Vi=Mod(Vi+1,180):Q:J K(#PB_Key_8) Or K(#PB_Key_Pad8):T:Vi=Mod(Vi-1,180):Q;;;;;;;
J K(#PB_Key_9) Or K(#PB_Key_Pad9):Vi=0:Q:J K(#PB_Key_0) Or K(#PB_Key_Pad0);;;;;;
a=Random(3):Repeat:b=Random(3):Until b<>a:Repeat:c=Random(3):Until c<>a And c<>b
Repeat:d=Random(3):Until d<>a And d<>b And d<>c:cl(0)=cl(4+a):cl(1)=cl(4+b);;;;;
cl(2)=cl(4+c):cl(3)=cl(4+d):Q:J Lt=0:StartDrawing(ScreenOutput()):P(10,190,"1",;
cl(0)):P(30,190,"2",cl(1)):P(50,190,"3",cl(2)):P(70,190,"4",cl(3)):P(10,10,"-K"+
"ey Shift left y/n >inc/dec< *1 or *10: "+Str(inc)):P(10,30,"-Key Space y/n me"+
"nu text"):P(10,50,"-PgU/PgD  +/- Plt:  "+Str(Plt)+"/180"):P(10,70,"-Hom/End  "+
"+/- Plg:  "+Str(Plg)+"/360"):P(10,90,"-Key 7/8 +/- Vit/Rt: "+Str(Vi)+"/180");;;
P(10,110,"-Key 9 Vit/Rt in 0"):P(10,130,"-Key 0 Move color"):P(10,150,"-Key de"+
"l y/n stick"):P(10,170,"-Tab  M : "+Str(Mode)+"/9"):P(10,ys-98,"- <-   ->    "+
"+/- : "+Str(xd)+"/360"):P(10,ys-78,"-Up/Down  +/- : "+Str(yd)+"/360"):P(10,;;;;
ys-58,"-Key 1/4 +/- Zradius: "+Str(Zr)+"/"+Str(ys)):P(10,ys-38,"-Key 2/3 +/- Y"+
"radius: "+Str(Yr)+"/"+Str(ys)):P(10,ys-18,"-Key 5/6 +/- Xradius: "+Str(Xr)+"/"+
Str(ys)):StopDrawing():Q:FlipBuffers():Until K(#PB_Key_Escape);;;;;;;;;;;;;;;;;;

[VB6_to_PBx]

kernadec ,

great Code .... tremendous number of different effects for such a short amount of Code !

[davido]

@Kernadec,
Very nice. Thank you.

Why does pressing 'Alt' key have such a strange effect! I didn't see it mentioned in the menu.

[electrochrisso]

Heres mine, some experimentation will produce good results, have fun.

Code: Select all

;*****************************************************************************
;*
;* XMas 2014 PurePunch contest
;* PureBasic 5.31
;* 63 lines of 80 or less chars of code
;*
;* Name     : Texture Maker
;* Author   : Electrochrisso
;* Date     : 12/12/2014
;*
;* Additive 120 x 120 pixel Texture Maker
;*
;* <<<Buttons>>>
;* Generate: Apply current texture settings to the image box
;* Clear:    Clears the image box to the BG Colour
;* Undo:     Revert back from the last Generate or Clear
;* Export:   Export the texture in bmp or png format
;*
;* <<<Modes>>>
;* Random Pixels:        Amount, Width, Height, FG Colour
;* Horizontal Lines:     FG Colour, Gap, Height
;* Vertical Lines:       FG Colour, Gap, Width
;* Diagonal Lines L & R: FG Colour, BG Colour, Gap, Width, Height
;* *For diagonal lines the FG and BG colours sets each side of the triangle
;*
;*****************************************************************************
Macro m_rp:If StartDrawing(ImageOutput(0)):For l=1 To at
Box(Random(120),Random(120),wh,ht,fc):Next:StopDrawing()
SetGadgetState(10,ImageID(0)):EndIf:EndMacro
Macro m_hl:If StartDrawing(ImageOutput(0)):y=0:Repeat:For l=0 To ht-1
LineXY(0,y+l,120,y+l,fc):Next:y+gp:Until y>120:StopDrawing()
SetGadgetState(10,ImageID(0)):EndIf:EndMacro
Macro m_vl:If StartDrawing(ImageOutput(0)):x=0:Repeat
For l=0 To wh-1:LineXY(x+l,0,x+l,120,fc):Next:x+gp:Until x>120
StopDrawing():SetGadgetState(10,ImageID(0)):EndIf:EndMacro
Macro m_dr:If StartDrawing(ImageOutput(0)):x=0:Repeat:For l=0 To wh-1
LineXY(x+l,0,0,x+l,fc):Next:x+gp:Until x>120:x=0:Repeat:For l=0 To ht-1
LineXY(x+l,120,120,x+l,bc):Next:x+gp:Until x>120:StopDrawing()
SetGadgetState(10,ImageID(0)):EndIf:EndMacro
Macro m_dl:If StartDrawing(ImageOutput(0)):y=120:x=0:Repeat:For l=0 To wh-1
LineXY(0,y-l,x+l,120,fc):Next:y-gp:x+gp:Until x>120:y=120:x=0:Repeat
For l=0 To ht-1:LineXY(x-l,0,120,y+l,bc):Next:y-gp:x+gp:Until x>120
StopDrawing():SetGadgetState(10,ImageID(0)):EndIf:EndMacro
UsePNGImageEncoder():cv=0:fc=$ffffff:bc=$c0c0c0:at=1000:gp=10:wh=1:ht=1
CreateImage(0,120,120):CreateImage(1,30,30):CreateImage(2,30,30)
OpenWindow(0,50,50,310,220,"Texture Maker",#PB_Window_SystemMenu)
ImageGadget(10,10,10,120,120,ImageID(0)):TextGadget(19,185,88,40,20,"Gap")
ImageGadget(13,95,140,30,30,ImageID(2),#PB_Image_Border)
ImageGadget(11,10,140,30,30,ImageID(1),#PB_Image_Border)
TextGadget(12,10,180,40,30,"FG Colour"):TextGadget(21,185,113,40,20,"Width")
TextGadget(14,95,180,40,30,"BG Colour"):ComboBoxGadget(15,145,10,155,20)
AddGadgetItem(15,-1,"Random Pixels"):AddGadgetItem(15,-1,"Horizontal Lines")
AddGadgetItem(15,-1,"Vertical Lines"):AddGadgetItem(15,-1,"Diagonal Lines R")
AddGadgetItem(15,-1,"Diagonal Lines L"):SetGadgetState(15,cv)
TrackBarGadget(16,140,55,165,20,100,9999):SetGadgetState(16,at)
TextGadget(17,140,43,170,20,"100          Pixel Amount           10K")
SpinGadget(18,145,85,35,20,1,60,#PB_Spin_Numeric):SetGadgetState(18,gp)
SpinGadget(20,145,110,35,20,1,10,#PB_Spin_Numeric):SetGadgetState(20,wh)
SpinGadget(22,225,110,35,20,1,10,#PB_Spin_Numeric):SetGadgetState(22,ht)
TextGadget(23,265,113,40,20,"Height"):ButtonGadget(27,145,165,70,20,"Undo")
ButtonGadget(25,145,190,70,20,"Clear"):ButtonGadget(26,230,190,70,20,"Export")
ButtonGadget(24,145,140,70,20,"Generate")
StartDrawing(ImageOutput(1)):Box(0,0,30,30,fc):StopDrawing()
SetGadgetState(11,ImageID(1)):StartDrawing(ImageOutput(2)):Box(0,0,30,30,bc)
StopDrawing():SetGadgetState(13,ImageID(2)):StartDrawing(ImageOutput(0))
Box(0,0,120,120,bc):StopDrawing():SetGadgetState(10,ImageID(0)):Repeat
Ev=WaitWindowEvent():Select Ev:Case #PB_Event_Gadget:Select EventGadget()
Case 11:If EventType()=#PB_EventType_LeftClick:Result=ColorRequester(fc)
If Result<>-1:fc=Result:If StartDrawing(ImageOutput(1)):Box(0,0,30,30,fc)
StopDrawing():SetGadgetState(11,ImageID(1)):EndIf:EndIf:EndIf
Case 13:If EventType()=#PB_EventType_LeftClick:Result=ColorRequester(bc)
If Result<>-1:bc=Result:If StartDrawing(ImageOutput(2)):Box(0,0,30,30,bc)
StopDrawing():SetGadgetState(13,ImageID(2)):EndIf:EndIf:EndIf:Case 24
SaveImage(0,GetTemporaryDirectory()+"tm_undo.bmp"):at=GetGadgetState(16)
gp=Val(GetGadgetText(18)):wh=Val(GetGadgetText(20)):ht=Val(GetGadgetText(22))
Select GetGadgetState(15):Case 0:m_rp:Case 1:m_hl:Case 2:m_vl:Case 3:m_dr
Case 4:m_dl:EndSelect
Case 25:SaveImage(0,GetTemporaryDirectory()+"tm_undo.bmp")
If StartDrawing(ImageOutput(0)):Box(0,0,120,120,bc):StopDrawing()
SetGadgetState(10,ImageID(0)):EndIf
Case 27:LoadImage(0,GetTemporaryDirectory()+"tm_undo.bmp")
SetGadgetState(10,ImageID(0))
Case 26:rt$=SaveFileRequester("Save",ep$,"bmp|*.bmp|png|*.png",1)
If rt$<>"":ep$=GetPathPart(rt$):If SelectedFilePattern()=0
If LCase(GetExtensionPart(rt$))<>"bmp":rt$+".bmp":EndIf
SaveImage(0,rt$,#PB_ImagePlugin_BMP):Else
If LCase(GetExtensionPart(rt$))<>"png":rt$+".png":EndIf
SaveImage(0,rt$,#PB_ImagePlugin_PNG):EndIf:EndIf
EndSelect:EndSelect:Until Ev=#PB_Event_CloseWindow:End

[kernadec]

hello VB6_to_PBx
thank for comments, in fact this code is based on rotations of ellipses in 3D as our universe


hello bavido
thank for the return of guest
This code consists of polygons in drawing "parallels" and "meridians"
the command 'ALT' OOooo! I had completely forgotten it!
It is a polygonal permanent division on the meridional plane * 10 and identical to the keyboard ' [Home/End] ", which are * 1
almost useless because substitute the general multiplier with the "shift" key [Yes/No]


hello electrochrisso
Thank you very helpful and efficient

best regards to you

[davido]

@kernadec,
Thank you for the explanation.
Tried it on the Mac - had to re-code the Windows-only colours. Looks great even though I haven't been able to use all the keyboard options.

@electrochrisso,
Very nice thank you for sharing.

[kernadec]

hello bavido
Thank for the return of guest MAC
I have no MAC sorry!, I do not know the compatibility
of constants PB between MAC and Windows.

I used the keyboard specified in the documentation commands
If they are different on the MAC, the documentation does not say!
It would be a good thing to indicate it, to make compatible codes.

However in my code the name of the constants is clear
should not encounter problems to replace.

or maybe with a link to the OS since PureBasic.com for get of documentations
who would be independent of the complete facilities of PB

Best regards

disable debugger for to the faster graphics

[es_91]

Don't know why but i somehow like electrochrisso's program...

[electrochrisso]

@ kernadec, I like yours too, and was thinking of implementing Spirograph textures too, but run out of lines.

@ es_91, Your XMASColors will make a good color selector for Texture Maker.

@ davido and all others thanks for comments, glad you like it.

[majikeyric]

And where is GTA5 electrochrisso ?!!

Nice program