PurePunch Contest #4

Share your advanced PureBasic knowledge/code with the community.
User avatar
djes
Addict
Addict
Posts: 1806
Joined: Sat Feb 19, 2005 2:46 pm
Location: Pas-de-Calais, France

PurePunch Contest #4

Post by djes »

October 2009

The contest is over.

Here's the 4th PurePunch archive.
Thank you and congratulations to :

Martin Guttman and FreakyBytes, Games category
idle, Cruncher category
Citystate and FreakyBytes, utility category
Special mention to Kurzer for his nice but too big game!

You may now vote for the best PurePunch

Again, I hope the next contest to be more successful...

~~~~~~~~~~^^^~*o*~^^^~~~~~~~~~~~~~~

September 2009

Here it is the PurePunch Contest #4!

I decided to keep the last month rules. :)

Categories (one winner per category):
  • 1° Application/Utility/System
    2° Game
    3° Demo
    4° PurePunch Cruncher : the idea is to enhance a previous contest PurePunch, or reduce its size :)
    5° Beginner
The rules :
  • 1° The program will be created using Purebasic 4.31 without userlib.
    2° The program source will only have 20 lines of 80 characters max per line or max 50 lines, with only one instruction per line, correctly indented (comments accepted). This last option should be privileged for smallest codes.
    3° To be unique, either a complete creation, or bringing something new to an existing code.
    Must not to be harmful
    5° Possibility to add a graphic file (only one image, or sprite, or texture...), maximum size 512 pixels width by 512 pixels height, 32 bits. Post it on the forum or on another site which must be reachable during the contest length, or included in a full project archive posted in the forum.
    6° Possibility to add a sound file (and only one) maximum size 1Mb. Post it on another site which must be reachable during the contest length, or included in a full project archive posted in the forum.
    7° It will be possible to add a line (not accounted), at the beginning of the source, to alert the user of a program specificity (for example, a delay or a particular subsystem). This line must be like

    Code: Select all

    MessageRequester("Information","txt",#PB_MessageRequester_Ok)
    One month delay to create the best PurePunch!
At the end of this period (October, the 1st), a poll will be created to vote for the best code. Do your best and it'll be yours!

Post the code on this forum, after adding and completing the following header:

Code: Select all

;*****************************************************************************
;*
;* PurePunch Contest #4
;*
;* Name     :  
;* Author   : 
;* Category :
;* Date     : 
;* Notes    :
;*
;*****************************************************************************
Good luck to all competitors! :)
Last edited by djes on Fri Oct 02, 2009 6:54 pm, edited 3 times in total.
citystate
Enthusiast
Enthusiast
Posts: 638
Joined: Sun Feb 12, 2006 10:06 pm

Post by citystate »

ok, here goes nothing...
the associated image can be found HERE

Code: Select all

;*****************************************************************************
;*
;* PurePunch Contest #4
;*
;* Name     : Animated Sprites
;* Author   : Citystate
;* Category : Utility
;* Date     : 6 September 2009
;* Notes    : I've included a few extra procedures that aren't demonstrated
;*            also, as I've not used any macros, the code can easily be inserted
;*            into your own code - enjoy
;* Image    : download from here, http://forum.novaseer.net/images/A.bmp
;***************************************************************************** 
Structure a:a.l:b.l:c.l:EndStructure:Procedure CreateASpr(a,b):If IsSprite(a);;;
*d.a=AllocateMemory(12):*d\a=a:*d\b=b:EndIf:ProcedureReturn *d:EndProcedure;;;;;
Procedure DisplayASpr(*a.a,x,y):If *a:c=SpriteWidth(*a\a):f=SpriteHeight(*a\a);;
h=*a\c*f/*a\b:ClipSprite(*a\a,0,h,c,f):DisplaySprite(*a\a,x,y);;;;;;;;;;;;;;;;;;
ClipSprite(*a\a,-1,-1,-1,-1):*a\c=(*a\c+1)%*a\b:EndIf:EndProcedure;;;;;;;;;;;;;;
Procedure LoadASpr(a$,b=1):ProcedureReturn CreateASpr(LoadSprite(#PB_Any,a$),b);
EndProcedure:Procedure AddFrame(*a.a,b,s=-1):If IsSprite(b) And *a:t=*a\b;;;;;;;
If s>=0 And s<*a\b:t=s:EndIf:d=SpriteHeight(*a\a)/*a\b;;;;;;;;;;;;;;;;;;;;;;;;;;
c=CreateSprite(-1,SpriteWidth(b),d*(1+*a\b)):UseBuffer(c):*a\c=0:For e=0 To *a\b
If e=t:DisplaySprite(b,0,e*d):Else:DisplayASpr(*a,0,e*d):EndIf:Next;;;;;;;;;;;;;
UseBuffer(-1):FreeSprite(*a\a):*a\a=c:*a\b+1:EndIf:EndProcedure:n$="Anim Sprite"
Procedure FreeASpr(*a.a):FreeSprite(*a\a):*a\b=0:*a\c=0:FreeMemory(*a);;;;;;;;;;
EndProcedure:Procedure DelFrame(*a.a,s=-1):If *a:t=*a\b:s+1:If s>=0 And s<*a\b;;
t=s:EndIf:If *a\b=1:FreeASpr(*a):Else:d=SpriteHeight(*a\a)/*a\b;;;;;;;;;;;;;;;;;
c=CreateSprite(-1,SpriteWidth(b),d*(*a\b-1)):*a\c=0:For e=0 To *a\b:If e=t;;;;;;
*a\c+1:Else:DisplayASpr(*a,0,e*d):EndIf:Next:UseBuffer(-1);;;;;;;;;;;;;;;;;;;;;;
FreeSprite(*a\a):*a\a=c:*a\b+1:EndIf:EndIf:EndProcedure:InitSprite():n=13107201;
OpenWindow(0,0,0,117,117,n$,n):OpenWindowedScreen(WindowID(0),0,0,64,64,1,0,0);;
*l.a=loadASpr("A.bmp",7):Repeat:displayASpr(*l,0,0):FlipBuffers():Delay(50);;;;;
Until WindowEvent()=16;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
A bit of wasted space, I know... :oops:

Without the demo-code, it can can be easily inserted into other programs (I'll give a rundown of the procedures included even though there's no code obfuscation)
  • CreateASpr(ExistingSpriteNum, NumberOfFrames)
    Creates an Animated Sprite from an already loaded sprite and sets the Asprite height according to the number of frames specified.
  • DisplayASpr(*AnimSprite[,FrameNumber])
    If no frame_number is given, will display the current frame and then increment the current frame to the next. Providing a frame number will set the current frame to this frame number.
  • LoadASpr(FileName$[,NumberOfFrames])
    Loads an animated sprite from disk, the default number of frames is 1
  • AddFrame(*AnimSprite,SpriteNum[,Position])
    Adds an extra frame to the AnimSprite in either the designated frame position or at the end of the animation (untested)
  • DelFrame(*AnimSprite[,Position])
    Removes either the designated frame or the last in the animation (untested)
  • FreeASpr(*AnimSprite)
    Frees the memory allocated for the AnimSprite(untested)
there is no sig, only zuul (and the following disclaimer)

WARNING: may be talking out of his hat
User avatar
djes
Addict
Addict
Posts: 1806
Joined: Sat Feb 19, 2005 2:46 pm
Location: Pas-de-Calais, France

Post by djes »

Nice one citystate, could be useful :)
User avatar
Kurzer
Enthusiast
Enthusiast
Posts: 664
Joined: Sun Jun 11, 2006 12:07 am
Location: Near Hamburg

Re: PurePunch Contest #4

Post by Kurzer »

Well here is my contribution to this competition.
It is an arcade game - a space invaders like action game.

Unfortunately I am disqualified because the game exceed the limit of 20 lines.
This game need 29 lines.
I did not managed it to 20 lines without shooting down the gameplay and the fun.

However, I post it just for your enjoyment.

The game need a BMP and an OGG file, you will find it here: alien-attack.zip (900KB)

Here are some screenshots:
Image

Image

Have fun!
Kurzer

Code: Select all

;*******************************************************************************
;*
;* PurePunch Contest #4
;*
;* Name     : Alien-Invasion
;* Author   : Kurzer
;* Category : Game
;* Date     : 12. September 2009
;*
;* Notes    : At first: Sorry, I know I exceed the limit of 20 lines. This game
;*            needs 29 lines. But I don't want to remove some of the functions,
;*            because the gameplay would fall in quality.
;*
;*            So I'm disqualified for this contest, but hey... never mind!
;*            It was a big challenge for me and it was a lot of fun even it was
;*            really hard work (especially downsizing the code).
;*            And finally you can play an exciting arcade game . ;-)
;*
;*            The game was exclusively written for this contest!
;*
;* Gameplay : You are the commander of a small, fast spaceship and your order
;*            is to save the earth. :-) Enemy troops from outer space try to 
;*            attack our planet. Go and save the mankind, Warrior! ;-)
;*
;* Control  : Control your ship with your mouse. Fire your missiles with the
;*            SPACE-key. To quit the game simply press the ESC-key.
;*
;*            The aliens appears at the top of the screen. They attack you
;*            in serveral stages/waves.
;*
;*            Try to destroy as many alien ships as possible. But keep an eye
;*            on your energy. Every shoot you fire off will cost you 2 energy
;*            points. But every hit to an alien ship will credit 1 point.
;*            If you destroy a ship your energy will increase by [level] points.
;*            That means if you destroy a ship in level 14 you will get 14 points.
;*            If you collide with an alien ship this will cost 40 points in every
;*            level.
;*
;*            The goal of the game is to solve all 35 Levels and get as many energy
;*            points as possible.
;*            The game ends if your energy falls below 0 points.
;*            (you start your mission with 50 points)
;*            The game also ends if you mastered all the levels. The animation
;*            will stop then and only the backgroundmusic will play furthermore.
;*
;*            And now... good luck and much fun!  
;*
;*            Kind Regards, Kurzer.
;*
;* Ressources:
;*            You need a bitmapfile named "P.bmp" and a aoundfile named "S.ogg".
;*            Attend the link in my forum-posting.
;*
;*            Sounds: www.freesound.org
;*            Music:  www.podsafeaudio.com, Title: Proteus, Artist: George Wood
;*            Grafix: Grabbed somewhere from the internet. ;^)
;*******************************************************************************

;<-------------------------------- 80 chars ----------------------------------->
Macro M(a,b):Macro a:b:EndMacr:EndMacro:#D=600:J=20:Macro O(a,b,c):Macro a(b):c:
EndMacr:EndMacro:Dim B.f(50,3):Dim C.f(#D,2):Dim A(50,1):D=50:InitKeyboard();...
M(Z,ClipSprite)o:M(K,KeyboardPushed)o:M(S,CatchSound)o:M(R,SpriteCollision)o;...
M(P,PlaySound)o:M(V,DisplayTransparentSprite)o:O(AA,n,For n=0 To)o:M(AB,Next)o;.
M(AF,StartDrawing(ScreenOutput()))o:M(AH,DrawingMode(1))o:M(AK,Random)o:#C=650;.
M(AD,EndIf)o:M(AE,PlaySound)o:M(AG,StopDrawing())o:M(AI,DrawText)o:M(Q,If)o:I=64
InitSound():InitSprite():O(L,n,LoadSprite(n,"P.bmp"))o:OpenScreen(800,#D,16,"");
M(AJ,And)o:UseOGGSoundDecoder():H=32:InitMouse():AA(T)#D:C(T,0)=AK(799):#B=512;.
C(T,1)=AK(599):C(T,2)=0.1+(AK(10)/20):AB:S(1,?S+$2AAB,$4D38):S(2,?S+$77E3,$193E)
L(1):Z(1,0,0,H,H):L(0):Z(0,H,0,H,H):L(2):Z(2,I,0,H,H):L(3):Z(3,96,0,H,H):L(4);..
L(5):L(6):L(7):L(8):Z(4,128,0,I,H):Z(5,192,0,I,H):Z(6,256,0,I,H):Z(7,320,0,I,H);
L(9):L(10):Z(8,384,0,I,H):Z(9,256,H,210,H):S(3,?S+$9121,$3B02):Z(10,0,I,#B,448);
S(4,?S+$CC23,$84D0B):P(4,1):AA(T) 7:L(T+J):Z(T+J,T*H,H,H,H):AB:*A.WORD=?S+$9192E
S(0,?S,$2AAB):Repeat:ExamineMouse():ExamineKeyboard():X=MouseX():Y=MouseY();....
Q X>768:X=768:AD:Q Y<400:Y=400:AD:Q Y>568:Y=568:AD:MouseLocate(X,Y):G=K(57);....
Q D>=0 AJ F>-1:Q G:Q J=0:AE(0):S+1:D-2:A(S,0)=X:A(S,1)=Y:Q S=50:S=0:AD:AD:J+1:AD
Q G=0 Or J=15-O:J=0:AD:E+1:Q E>=F:F=*A\w:*A+2:W+1:Q F>0:AE(3):U=*A\w:*A+2:P=*A\w
*A+2:O=*A\w:*A+2:N=*A\w:*A+2:M=*A\w:*A+2:AA(T) M:B(T,0)=60+AK(#D):B(T,2)=U:;....
B(T,1)=AK(15*M)*-1:B(T,3)=O:AB:AD:AD:ClearScreen(0):AF:AA(T)#D:H=288:I=152;.....
Plot(C(T,0),C(T,1),$111111*Round(C(T,2)*15,0)):Q C(T,0)<797:C(T,0)+C(T,2):Else;.
C(T,0)=0:AD:AB:AG:V(10,H,I):AA(T) M:Q B(T,1)<#C:Z=Sin((B(T,1))/70)*(N+C(T,1)/15)
H=B(T,0)+Z:I=B(T,1)+Sin(H/70)*80:V(B(T,2),H,I):B(T,1)+P/2:AF:AH:#E=570:#F=$88ff;
AI(H+9,I-15,Str(B(T,3)),#F):AG:Q R(B(T,2),H,I,0,X,Y)<>0 AJ B(T,3)>0:B(T,3)=0;...
D-50:AD:AA(U) 50:Q R(B(T,2),H,B(T,1),1,A(U,0),A(U,1))<>0 AJ A(U,1)>0 AJ B(T,3)>0
B(T,1)-2:B(T,3)-1:A(U,1)=-1:D+1:AE(2):AD:AB:Q B(T,3)=0 AJ E%4=0:Q B(T,2)<20;....
AE(1):B(T,2)=20:AD:B(T,2)+1:Q B(T,2)=28:B(T,1)=#C:D+W:AD:AD:AD:AB:AA(T) 50;.....
Q A(T,1)>0:V(1,A(T,0),A(T,1)):Q A(T,1)>0:A(T,1)-15:AD:AD:AB:V(0,X,Y):V(9,#E,10);
AF:AH:AI(110,12,"Energy: "+Str(D),#F,0):AI(10,12,"Level: "+Str(W)+"/36",#F,0):AG
FlipBuffers():AD:Until K(1):DataSection:S:IncludeBinary "S.ogg":EndDataSection;.
PB 6.02 x64, OS: Win 7 Pro x64 & Win 11 x64, Desktopscaling: 125%, CPU: I7 6500, RAM: 16 GB, GPU: Intel Graphics HD 520, User age in 2023: 56y
"Happiness is a pet." | "Never run a changing system!"
User avatar
blueznl
PureBasic Expert
PureBasic Expert
Posts: 6161
Joined: Sat May 17, 2003 11:31 am
Contact:

Re: PurePunch Contest #4

Post by blueznl »

May I suggest to allow people an additional number of lines if they do not use macros?
( PB6.00 LTS Win11 x64 Asrock AB350 Pro4 Ryzen 5 3600 32GB GTX1060 6GB)
( The path to enlightenment and the PureBasic Survival Guide right here... )
User avatar
djes
Addict
Addict
Posts: 1806
Joined: Sat Feb 19, 2005 2:46 pm
Location: Pas-de-Calais, France

Re: PurePunch Contest #4

Post by djes »

Wow, what a nice game! And so nice GFX and sound, you really did a great job! :o
So bad it doesn't fit in the 20 lines; I've looked at the code and it will be difficult to reduce. Maybe someone would try?
If not, you'll be in the "out of category" (like the "wild compo" in demomakers contests), and can compete there ;)
User avatar
Kurzer
Enthusiast
Enthusiast
Posts: 664
Joined: Sun Jun 11, 2006 12:07 am
Location: Near Hamburg

Re: PurePunch Contest #4

Post by Kurzer »

djes wrote:If not, you'll be in the "out of category" (like the "wild compo" in demomakers contests), and can compete there ;)
Oh, this is a good idea. Do I have to post the source again in another topic/thread then? Or will the code join the "out of category" contest automatically?
PB 6.02 x64, OS: Win 7 Pro x64 & Win 11 x64, Desktopscaling: 125%, CPU: I7 6500, RAM: 16 GB, GPU: Intel Graphics HD 520, User age in 2023: 56y
"Happiness is a pet." | "Never run a changing system!"
User avatar
djes
Addict
Addict
Posts: 1806
Joined: Sat Feb 19, 2005 2:46 pm
Location: Pas-de-Calais, France

Re: PurePunch Contest #4

Post by djes »

kurzer wrote:
djes wrote:If not, you'll be in the "out of category" (like the "wild compo" in demomakers contests), and can compete there ;)
Oh, this is a good idea. Do I have to post the source again in another topic/thread then? Or will the code join the "out of category" contest automatically?
Automagically ;)
User avatar
STARGÅTE
Addict
Addict
Posts: 2063
Joined: Thu Jan 10, 2008 1:30 pm
Location: Germany, Glienicke
Contact:

Re: PurePunch Contest #4

Post by STARGÅTE »

Hier are my 20Lines from germany :D

Code: Select all

;*****************************************************************************
;*
;* PurePunch Contest #4
;*
;* Name     :  Snake
;* Author   :  Martin Guttmann (STARGÅTE)
;* Category :  Game
;* Date     :  9/15/2009
;* Notes    :  The famous Snake game in 20 lines. 
;*             Navigation With arrow keys. 
;*             Objective: To feed the orange squares,
;*                        While Not push against walls Or yourself. 
;*             Special feature: The snake drop sam walls.
;*
;*****************************************************************************
;
InitSprite():InitKeyboard():Macro Q(v,w):(v\x=w\x And v\y=w\y):EndMacro: a.Point
Macro EM:ElapsedMilliseconds():EndMacro:Macro LS:ListSize(S()):EndMacro:#b=#Gray
Macro B(x,y,C,u=1):Box(x*25+u,y*25+u,25-u*2,25-u*2,C):EndMacro:NewList G.Point()
OpenWindowedScreen(OpenWindow(0,0,0,800,600,"Snake",13107201),0,0,800,800,0,0,0)
Macro K(k,v,w):If KeyboardPushed(k):a\x=v:a\y=w:EndIf:EndMacro:NewList S.Point()
A:Delay(dt):Gosub Z:ClearList(S()):j.Point\x=10:j\y=9:a\x=1:a\y=0 : For i=5 To 9
AddElement(S()):S()\x=i:S()\y=9:Next : *S.Point=@S() : Repeat :ExamineKeyboard()
K(200,0,-1):K(208,0,1):K(203,-1,0):K(205,1,0) : If Em-T>200-ListSize(S()) : T=EM
AddElement(S()):S()\x=*S\x+a\x:S()\y=*S\y+a\y:*S=@S():If Q(j,S()): Repeat : OK=1
j\x=Random(29)+1:j\y=Random(20)+2:ForEach S():If Q(S(),j):OK=0:Break:EndIf: Next
ForEach G():If Q(G(),j):OK=0:Break:EndIf:Next:Until OK : Else: FirstElement(S())
If LS > ListSize(G())*5+10 : AddElement(G()) : G()\x=S()\x : G()\y=S()\y : EndIf
DeleteElement(S()):EndIf:ForEach S():ForEach G():If Q(S(),G()):Goto A:EndIf:Next
If (@S()<>*S And Q(S(),*S)) Or (*S\x<1 Or *S\y<2 Or *S\x>30 Or *S\y>22) : Goto A
EndIf:Next:EndIf: ClearScreen(0) : StartDrawing(ScreenOutput()) : DrawingMode(1)
For i = 0 To 32 : B(0,i,#b):B(31,i,#b):B(i,1,#b):B(i,23,#b) : Next : ForEach S()
LI = ListIndex(S()) : B(S()\x,S()\y,RGB(0,128-Sin(LI)*64,191-Sin(LI)*64)) : Next
B(J\x,j\y,$00A0F0):ForEach G():B(G()\x,G()\y,#b): Next : Text$="Length:"+Str(LS)
DrawText(100,5,Text$+" Speed:"+StrF(1000/(200-LS),3)+"Hz",#White): StopDrawing()
FlipBuffers():Until WindowEvent()=16:End: Z: ClearList(G()):T=EM:dt=1500: Return
Last edited by STARGÅTE on Tue Sep 15, 2009 6:50 pm, edited 1 time in total.
PB 6.01 ― Win 10, 21H2 ― Ryzen 9 3900X, 32 GB ― NVIDIA GeForce RTX 3080 ― Vivaldi 6.0 ― www.unionbytes.de
Lizard - Script language for symbolic calculations and moreTypeface - Sprite-based font include/module
User avatar
djes
Addict
Addict
Posts: 1806
Joined: Sat Feb 19, 2005 2:46 pm
Location: Pas-de-Calais, France

Re: PurePunch Contest #4

Post by djes »

Great, perfect remake! :D
User avatar
STARGÅTE
Addict
Addict
Posts: 2063
Joined: Thu Jan 10, 2008 1:30 pm
Location: Germany, Glienicke
Contact:

Re: PurePunch Contest #4

Post by STARGÅTE »

i have an error in Line 20: this line is new now! (+END after WindowEvent()=16)
PB 6.01 ― Win 10, 21H2 ― Ryzen 9 3900X, 32 GB ― NVIDIA GeForce RTX 3080 ― Vivaldi 6.0 ― www.unionbytes.de
Lizard - Script language for symbolic calculations and moreTypeface - Sprite-based font include/module
User avatar
idle
Always Here
Always Here
Posts: 5019
Joined: Fri Sep 21, 2007 5:52 am
Location: New Zealand

Re: PurePunch Contest #4

Post by idle »

Windows only
may not run on x64
please make sure you've saved your work before running (just in case)
set you recording source to waveout mix, play some music
run program
click splash screen to continue
right click for controls
esc to close and exit

if you can't be arsed to set your recording source to waveout mix and play some music
then you will only see a black screen.
right click screen to open controls and choose the normal option

Code: Select all

;*****************************************************************************
;*
;* PurePunch Contest #4
;*
;* Name     : Nova 
;* Author   : idle
;* Category : PurePunch Crunch | tricky bastard 
;* Date     : 16/9/2009
;* Notes    : READ THE NOTES BEFORE RUNNING 
;*          : Windows only may not run on x64 
;*          : Make sure you have saved your work before running
;*          : Will download image automatically, may take some time!  
;*          : Set your recording source to wave out mix and play your favourate song! 
;*          : run program, click splash screen to continue, right click for controls, esc to end 
;*          : If you haven't set your recording to wave out mix and only see a black screen 
;*          : right click the screen and choose the "normal option"    
;*          : For full instructions on Nova controls Goto http://www.idlearts.com/nova.html 
;*****************************************************************************

Macro wp(a,b,c,d,e):WriteProcessMemory_(a,b,c,d,e):EndMacro:Structure K:SN.b[8]
StructureUnion:Pha.l:Vs.l:EndStructureUnion:Va.l:Sr.l:pRd.l:ptrl.l:pln.l:nr.w
nol.w:Cs.l:EndStructure:Structure V:V.K[95]:EndStructure:Structure pinf
hP.i:hT.i:pId:i:TId.i:EndStructure:Procedure R(f,n.s):*idh.IMAGE_DOS_HEADER=f
*s.V:pi.PINF:*n.IMAGE_NT_HEADERS:si.STARTUPINFO:lBA.l:Ctx.CONTEXT:Addr.l
r.l:i.l:CreateProcess_(0,n,0,0,0,4,0,0,@si,@pi):Ctx\ContextFlags=65538
If GetThreadContext_(pi\hT,Ctx):ReadProcessMemory_(pi\hP,Ctx\Ebx+8,@Addr,4,0)
If Not ZwUnmapViewOfSection_(Pi\hP,Addr):*n=f+*idh\e_lfanew:ts=PeekL(*n+52)
tt=PeekL(*n+80):ty=PeekL(*n+84):tz=*n\OptionalHeader:tq=PeekW(*n+6)-1
lBA=VirtualAllocEx_(pi\hP,ts,tt,12288,64):WP(pi\hP,lBA,f,ty,@r):tf=PeekW(*n+20)
*s=tz+tf:For i=0 To tq:WP(pi\hP,lBA+*s\V[i]\Va,f+*s\V[i]\pRd,*s\V[i]\Sr,@r)
Next:WP(pi\hP,Ctx\Ebx+8,@lBA,4,0):te=PeekL(*n+40):Ctx\Eax=lBA+te
SetThreadContext_(pi\hT,Ctx):ResumeThread_(pi\hT):End:EndIf:EndIf:End
EndProcedure:Global *o,q,w=512,h=460,fi.s="http://www.idlearts.com/sn5.png"
If FileSize("sn5.png")=-1:InitNetwork():ReceiveHTTPFile(fi,"sn5.png"):EndIf
UsePNGImageDecoder():LoadImage(2,"sn5.png"):OpenWindow(0,0,0,w,h,"",2147483649) 
ImageGadget(1,0,0,w,h,ImageID(2)):*o=AllocateMemory(75264)
StartDrawing(ImageOutput(2)):While a<75264:tb=Point(b%512,(b/512))>>16 &$FF
PokeB(*o+a,tb):a+1:b+4:Wend:StopDrawing():Repeat:WaitWindowEvent()
ea=EventGadget():If ea=1:q=1:EndIf:Until q:If q=1:r(*o,ProgramFilename()):EndIf

manual download version

http://www.idlearts.com/sn5.png

Code: Select all

;*****************************************************************************
;*
;* PurePunch Contest #4
;*
;* Name     : Nova 
;* Author   : idle
;* Category : PurePunch Crunch | tricky bastard 
;* Date     : 16/9/2009
;* Notes    : READ THE NOTES BEFORE RUNNING 
;*            include file-------------------- http://www.idlearts.com/sn5.png  
;*          : Windows only may not run on x64 
;*          : Make sure you have saved your work before running
;*          : Set your recording source to wave out mix and play your favourate song! 
;*          : run program, click splash screen to continue, right click for controls, esc to end 
;*          : If you haven't set your recording to wave out mix and only see a black screen 
;*          : right click the screen and choose the "normal option"    
;*          : For full instructions on Nova controls Goto http://www.idlearts.com/nova.html 
;*****************************************************************************

Macro wp(a,b,c,d,e):WriteProcessMemory_(a,b,c,d,e):EndMacro:Structure K:SN.b[8]
StructureUnion:Pha.l:Vs.l:EndStructureUnion:Va.l:Sr.l:pRd.l:ptrl.l:pln.l:nr.w
nol.w:Cs.l:EndStructure:Structure V:V.K[95]:EndStructure:Structure pinf
hP.i:hT.i:pId:i:TId.i:EndStructure:Procedure R(f,n.s):*idh.IMAGE_DOS_HEADER=f
*s.V:pi.PINF:*n.IMAGE_NT_HEADERS:si.STARTUPINFO:lBA.l:Ctx.CONTEXT:Addr.l
r.l:i.l:CreateProcess_(0,n,0,0,0,4,0,0,@si,@pi):Ctx\ContextFlags=65538
If GetThreadContext_(pi\hT,Ctx):ReadProcessMemory_(pi\hP,Ctx\Ebx+8,@Addr,4,0)
If Not ZwUnmapViewOfSection_(Pi\hP,Addr):*n=f+*idh\e_lfanew:ts=PeekL(*n+52)
tt=PeekL(*n+80):ty=PeekL(*n+84):tz=*n\OptionalHeader:tq=PeekW(*n+6)-1
lBA=VirtualAllocEx_(pi\hP,ts,tt,12288,64):WP(pi\hP,lBA,f,ty,@r):tf=PeekW(*n+20)
*s=tz+tf:For i=0 To tq:WP(pi\hP,lBA+*s\V[i]\Va,f+*s\V[i]\pRd,*s\V[i]\Sr,@r)
Next:WP(pi\hP,Ctx\Ebx+8,@lBA,4,0):te=PeekL(*n+40):Ctx\Eax=lBA+te
SetThreadContext_(pi\hT,Ctx):ResumeThread_(pi\hT):End:EndIf:EndIf:End
EndProcedure:Global *o,q,w=512,h=460:UsePNGImageDecoder():CatchImage(2,?Dat)
OpenWindow(0,0,0,w,h,"",2147483649):ImageGadget(1,0,0,w,h,ImageID(2))
*o=AllocateMemory(75264):StartDrawing(ImageOutput(2)):While a<75264
tb=Point(b%512,(b/512))>>16 &$FF:PokeB(*o+a,tb):a+1:b+4:Wend:StopDrawing()
Repeat:WaitWindowEvent():ea=EventGadget():If ea=1 Or GetKeyState_(#VK_ESCAPE)
q=1:EndIf:Until q:If q=1:r(*o,ProgramFilename()):EndIf
DataSection: Dat: IncludeBinary "c:\sn5.png"  :EndDataSection 
Last edited by idle on Wed Sep 16, 2009 9:00 pm, edited 2 times in total.
User avatar
Vera
Addict
Addict
Posts: 858
Joined: Tue Aug 11, 2009 1:56 pm
Location: Essen (Germany)

Re: PurePunch Contest #4

Post by Vera »

Dear idle,

I didn't manage yet to tell you that I'm really fond of your Nova Attractor :) (I'll catch up on it later)

Here I would like to suggest to you to enable your contribution to work offline and provide a download link for the image like kurzer did above. In my case I can't connect to the internet beeing on Windows and maybe there are some more forum members who share the same situation.
And maybe forunately this could give you another empty-coding-row to be used for another tricky element :wink:

regards ~ Vera
User avatar
djes
Addict
Addict
Posts: 1806
Joined: Sat Feb 19, 2005 2:46 pm
Location: Pas-de-Calais, France

Re: PurePunch Contest #4

Post by djes »

Vera wrote:Dear idle,

I didn't manage yet to tell you that I'm really fond of your Nova Attractor :) (I'll catch up on it later)

Here I would like to suggest to you to enable your contribution to work offline and provide a download link for the image like kurzer did above. In my case I can't connect to the internet beeing on Windows and maybe there are some more forum members who share the same situation.
And maybe forunately this could give you another empty-coding-row to be used for another tricky element :wink:

regards ~ Vera
Actually I'm on the same situation. Could not test until this evening...
User avatar
idle
Always Here
Always Here
Posts: 5019
Joined: Fri Sep 21, 2007 5:52 am
Location: New Zealand

Re: PurePunch Contest #4

Post by idle »

never thought of that, edited the post.
Post Reply