PurePunch Contest July-August 2014

[Bananenfreak]

My second entry is a timer. Made with a Module, Thread and love

Code: Select all

;*****************************************************************************
;*
;* July-August 2014 PurePunch contest
;* PureBasic 5.22
;* 50 lines of 80 chars, 2 months delay
;*
;* Name     : Timer (Not really a good name)
;* Author   : Bananenfreak
;* Date     : 29.07.2014
;* Notes    : You can add your own Timerevents in Enumeration "Timerevents". Lines 44 to 59 is how about using this Timer.
;*            event2 is used for better event1 description.
;*****************************************************************************
EnableExplicit
Define.i quit
Enumeration Timerevents
  #quit = 10000
EndEnumeration
DeclareModule Timer:Structure timeList:dur.i:start.i:event1.i:event2.i
EndStructure:Structure timeEvent:handle.i:event1.i:event2.i:EndStructure
Global NewList times.timeList():Global NewList timeEvent.timeEvent()
Global.i mutexEvent,mutexTime:Declare.i CreateTimer(para.i):Declare ClearTimer()
Declare.i DeleteTimer(handle.i):Declare.i AddTime(dur.i,start.i,event1.i,
event2.i=0):EndDeclareModule:Module Timer:Global.i init=0
Procedure.i AddTime(dur,start,event1,event2=0):LockMutex(mutexTime)
AddElement(times()):times()\dur=dur:times()\start=start:times()\event1=event1
times()\event2=event2:ProcedureReturn @times():EndProcedure
Procedure ClearTimer():LockMutex(mutexTime):ClearList(times())
UnlockMutex(mutexTime):EndProcedure:Procedure.i DeleteTimer(handle)
LockMutex(mutexTime):If Not ListSize(times())=0:PopListPosition(times())
ChangeCurrentElement(times(),handle):DeleteElement(times())
PushListPosition(times()):UnlockMutex(mutexTime):ProcedureReturn 1:Else
UnlockMutex(mutexTime):ProcedureReturn 0:EndIf:EndProcedure:Procedure Timer(par)
Protected.i time:Repeat:LockMutex(mutexTime):ForEach times()
time=ElapsedMilliseconds():If time>=(times()\start+times()\dur)
LockMutex(mutexEvent):AddElement(timeEvent()):timeEvent()\event1=times()\event1
timeEvent()\event2=times()\event2:timeEvent()\handle=@times()
UnlockMutex(mutexEvent):LockMutex(mutexTime):DeleteElement(times())
UnlockMutex(mutexTime):EndIf:Next times():UnlockMutex(mutexTime)
If TryLockMutex(mutexTime):If ListSize(times())<10:Delay(10):EndIf
UnlockMutex(mutexTime):EndIf:ForEver:EndProcedure
Procedure.i CreateTimer(para):If Not init:mutexEvent=CreateMutex()
mutexTime=CreateMutex():init=#True:ProcedureReturn CreateThread(@Timer(),
para):Else:ProcedureReturn 0:EndIf:EndProcedure:EndModule
If Timer::CreateTimer(0)
  Timer::AddTime(2000, ElapsedMilliseconds(), #quit)
  UnlockMutex(Timer::mutexTime)
  Repeat
    Debug "------------"
    If TryLockMutex(Timer::mutexEvent)
      While Not ListSize(Timer::timeEvent()) = 0
        If Timer::timeEvent()\event1 = #quit
          quit = #True
          DeleteElement(Timer::timeEvent())
        EndIf
      Wend
      UnlockMutex(Timer::mutexEvent)
    EndIf
  Until quit = #True
Else:MessageRequester("Error", "Timer is already created."):EndIf:End

[ar-s]

Here is my work : Only 50's

Hit Fonzie Face to increase score - Esc to exit
Picture : http://pb.ldvmultimedia.com/i.png
Sound : http://pb.ldvmultimedia.com/hds2.ogg
zip (code+data+exe) : http://pb.ldvmultimedia.com/PurePunch2014_only_50s.zip
EnJoY

Code: Select all

;*****************************************************************************
;*
;* July-August 2014 PurePunch contest
;* PureBasic 5.20 / 5.30
;* 50 lines of 80 chars, 2 months delay
;*
;* Name     :  Happy Days ! Only 50's
;* Author   :	Ar-S
;* Date     :	July 2014
;* Notes    :	Esc to quite - Difficulty : 33 easy - 45 normal - 78 hard - Hits fonzie Face to increase score :)
;*
;*****************************************************************************
Declare h():Macro M:Macro:EndMacro:M _EM:End:End#M:InitMouse()
M dts(id,x,y,c):DisplayTransparentSprite(id,x,y,c):_EM#M:M _P:Procedure:_EM#M
M ds(id,x,y):DisplaySprite(id,x,y):_EM#M:M G(a,b,c):For a=b To c:_EM#M
M GP:GetSoundPosition(4,1):_EM#M:M _SF(a,b):SetSoundFrequency(a,b):_EM#M
M E(id,x,y,w,z):ClipSprite(id,x,y,w,z):_EM#M:M A:And:_EM#M:M C:Case:_EM#M
M R:Random:_EM#M:M AWT:AddWindowTimer:_EM#M:M _Ei:EndIf:_EM#M:M _S:Select:_EM#M
M _Ef:ElseIf:_EM#M:M _EP:EndProcedure:_EM#M:M _ES:EndSelect:_EM#M:InitSound()
M _SD(a):StartDrawing(SpriteOutput(a)):Box(0,0,90,20,$0):_EM#M:InitSprite()
M _DT:DrawText(5,2,"Score : " + Str(sc), $FFFFFF ):StopDrawing():_EM#M
InitKeyboard():UseOGGSoundDecoder():UsePNGImageDecoder():Global TM,s,sp,l,v
Global deg.f,sf,Xd,Xo,Xof,Yd,Yo,Yof,MBx,MinX,MinY,Fy,SS,O,U:U=R(770,62):O=-65
v=5:MaxX=830:MaxY=590:MinX=-40:MinY=-40:Fy=600:SS=-1:_P Ip(f)
Shared Xd,Xo,Xof,Yd,Yo,Yof:_S f:C 1:Xd=211:Yd=222:C 2:Xo=555:Yo=265:C 3:Xd=211
Yd=222:Xo=555:Yo=265:Xof=635:Yof=380:_ES:_Ep:_P mo(f):Static qq.i:If f:Repeat
If ExamineMouse():Mx=MouseX():My=MouseY():_Ei:Delay(1):Until q:q=0:Else
If Not f:q=1:While q:Delay(1):Wend:_Ei:_Ei:_Ep:_P h():Shared v,sf:Protected x,y
x=MouseX():y=MouseY():If x>690 A x<717 A y>567 A y<593:h=12
_Ef x>722 A x<754 A y>567 A y<593:h=11:_Ef x>754 A x<786 A y>567 A y<593
h=18:_Ef x>20 A x<53 A y>567 A y<593:v=3:sf=33100
_Ef x>52 A x<85 A y>567 A y<593:v=5:sf=44100:_Ef x>85 A x<117 A y>567 A y<593
v=8:sf=78100:_Ef x>U A x<U+62 A y>O A y<O+62:h=500:Else:h=0:_Ei
ProcedureReturn h:_Ep:W=OpenWindow(0,0,0, 800,600,"Only 50's !", 1|2147483648)
Ip(3):OpenWindowedScreen(W,0,0,800,600):CreateThread(@mo(),1):SpriteQuality(1)
LoadSprite(6,"i.png",8):LoadSound(4,"hds2.ogg"):sd=SoundLength(4, 1):D=$FFFFFF
D$="b":G(i,7,19):CopySprite(6,i):Next:CreateSprite(14,80,20):E(6,0,137,376,376)
E(9,1,1,404,134):E(10,410,52,103,152):E(7,407,291,103,222):RotateSprite(7,-45,0)
E(8,407,291,103,222):E(12,481,0,32,26):E(18,449,0,32,26):E(11,417,0,32,26)
E(15,417,26,32,26):E(16,449,26,32,26):E(17,481,26,32,26):AWT(0,1,3000)
E(13,449,204,62,62):AWT(0,2,50):AWT(0,3,1000):Repeat:Repeat:ev=WindowEvent()
_S ev:C 13116:End:C 13110:_S EventTimer():C 1:If l=1:If s=1:Xo-1:_S v:C 5
deg+0.5:C 3:deg+0.3:C 8:deg+0.8:_ES:_Ei:_Ef l=0 Or s<1:Ip(3):D=$FFFFFF:_Ei
C 2:If s=1:D=RGB(R(255,0),R(255,0),R(255,0)):_Ei:C 3:If s=1:MBx=R(MaxX-62,62)
MBy=R(MaxY-92,92):If MBx<240 Or MBx>644 A MBx>0 A MBx<644 A MBy>30 A MBy<540
U=MBx:O=MBy:_Ei:_Ei:_ES:C 13112:_S h():C 12:If s=0 Or s=-1:s=1:sc=0:_Ei:C 18
If s<>0:s=0:StopSound(4):TM=2:_Ei:C 11:If s=1:s=-1:Ip(2):MBx=-100:U=MBx
_Ef s=-1:s=1:_Ei:C 500:sc+1:_ES:sd=SoundLength(4,1):_ES:Until ev=0
ExamineKeyboard():ExamineMouse():FlipBuffers():ClearScreen(D):Ds(12,690,566)
DTS(10,100,Fy,255):Ds(11,717,566):Ds(18,743,566):If s=1:Ds(15,20,566)
Ds(16,52,566):Ds(17,84,566):_Ei:Dts(6,Xd,Yd,255):RotateSprite(6,v,1):_SD(14)
_DT:DS(14,0,0):RnD=R(1,0):Bo=R(v+1,1):_S RnD:C 0:G(i,0,Bo):O-1:U+1:Next i:C 1
G(i,0,Bo):O+1:U-1:Next i:_ES:If s=1:Fy=600:SS=-1:If v=0:v=5:_Ei:sp=GP:_SF(4,sf)
If l=0:PlaySound(4,1):SetSoundPosition(4,1500,1):Ip(2):l+1:Else:ResumeSound(4)
_Ei:If sp>8000:TM=1:_Ei:If TM=1 A sp<1550:TM=2:_Ei:If TM=2:SS=0:s=0:_Ei
RotateSprite(8,deg,0):Dts(8,Xo,Yo,255):If T<50 A D$="b":T+1:Dts(9,240,T,255)
_Ef T=50 Or D$="h":D$="h":T-1:Dts(9,240,T,255):If T=0:D$="b":_Ei:_Ei
DTS(13,U,O,255):_Ef s=0:Ip(3):sp=0:l=0:deg.f=0:D=$FFFFFF:v=0
Dts(7,Xof,Yof,320):Dts(9,240,0,255):O=-100:If SS=0 A TM=2:Fy-3:If Fy<460
Fy=460:SS=1:_Ei:_Ei:sf=44100:sp=GP:If SS=1 A sp>1600:StopSound(4):TM=0:_Ei
_Ef s=-1:Ip(2):Dts(8,Xo,Yo,255):v=0:PauseSound(4):Dts(9,240,T,255):_Ei
Until KeyboardPushed(1):End

[majikeyric]

Here is : PunchAnabalt , my remake of the hit game Canabalt !



source + image file + music file here : http://majikeyric.free.fr/download.php? ... nabalt.zip

Use right-CTRL to jump !!!!!

Code: Select all

;*****************************************************************************
;*
;* July-August 2014 PurePunch contest
;* PureBasic 5.22
;* 50 lines of 80 chars, 2 months delay
;*
;* Name     : PunchAnabalt
;* Author   : Majikeyric
;* Date     : 03/08/2014
;* Notes    : Use CTRL-Right to jump.
;* Credits  :
;*       Graphics ripped from the C64 and the iOS versions of the game
;*       C64 SID Music by Mikkel Hastrup (a.k.a Encore)
;*       Level design by Majikeyric
;*
;*****************************************************************************
Macro M:Macro:EndMacro:M E:End:EndMacro:M S:Sprite:EndMacro:M P:Procedure;;;;;;;
EndMacro:M WH:While:EndMacro:M Ini:vx.f=2.0:ax.f=0.5:t.f=0.0:gr.f=0.5:px.f=-88;;
ta=1:tp=1:tb=1:tm=10:go=0:sc=0:CE(3):_=xd(Random(7)):JY=0:io=0:WH po(io)\X<_-52;
io+1:W#E:EndMacro:M Pt:Point:E#M:M R:Repeat:E#M:M SC:Screen:E#M:M U:Until:E#M;;;
M WD:Window:E#M:M K:Keyboard:E#M:M KP:K#Pushed:E#M:M SD(a):St#a#Drawing:End#M;;;
M DT:DisplayTransparent#S:End#M:M G:Global:End#M:M Z:Structure:End#M:M EI:EndIf;
EndMacro:M NT:Next:End#M:M Ot:Output:End#M:M FE:ForEach:End#M:M EL:Else:EndMacro
M RT:Return:EndMacro:#L=640:#H=480:#K=#PB_Key_RightControl:#P=#PB_Any:#R=15728;;
Z T:W.i:A.i:E#Z:Z O:X.f:Y.f:C.i:W.i:I.i:t.f:E#Z:G.f _,JY:G JE,JS,JC,JI:G Q=32;;;
G Dim MP(15,512):G Dim SP(46):G Dim TS.T(68):G Dim AN(5,Q):y$="Score:":P MO(a);;
f=0:JC-1:If JC=0:JC=AN(a,0):JS=SP(AN(a,JI)):JI+1:If AN(a,JI)=0:f=1:JI=1:EI:EI;;;
P#RT f:E#P:P CE(s):JE=s:JC=1:JI=1:E#P:P PD(x,y):n=(y+59)/Q-y/Q+1:i=y/Q:j=(x+;;;;
60)/Q:c=1:WH n>0 And c:If TS(MP(i,j))\A&8:c=0:EI:n-1:i+1:W#E:P#RT c:E#P:P DD(dm)
x=_:y=JY:d=0:c=1:WH c And d<dm:If PD(x,y):x+1:d+1:EL:c=0:EI:W#E:P#RT d:E#P;;;;;;
P PB(x,y):n=(x+59)/Q-x/Q+1:i=(y+60)/Q:j=x/Q:c=1:WH n>0 And c:If TS(MP(i,j))\A&2;
c=0:EI:n-1:j+1:W#E:P#RT c:E#P:P DB(dm):x=_:y=JY:d=0:c=1:WH c And d<dm:If PB(x,y)
y+1:d+1:EL:c=0:EI:W#E:P#RT d:E#P:P PH(x,y):n=(x+59)/Q-x/Q+1:i=(y-1)/Q:j=x/Q:c=1;
WH n>0 And c:If TS(MP(i,j))\A&1:c=0:EI:n-1:j+1:W#E:P#RT c:E#P:P DH(dm):x=_:y=JY;
d=0:c=1:WH c And d>dm:If PH(x,y):y-1:d-1:EL:c=0:EI:W#E:P#RT d:E#P:Dim xd(68);;;;
Dim po.O(16):NewList o.O():UseOGGSoundDecoder():Init#K():InitSound():Init#S();;;
Open#WD(0,0,0,#L,#H,"",#PB_Window_ScreenCentered):Open#WD#ed#SC(WD#ID(0),0,0,#L,
#H):LoadSound(0,"a.ogg"):LoadImage(0,"a.bmp"):Transparent#S#Color(#PB_Default,;;
$ff00ff):SD(art)(Image#Ot(0)):For i=0 To 14:For j=0 To 511:MP(i,j)=Pt(j,i+497);;
NT:NT:For i=0 To 4:For j=0 To 31:AN(i,j)=Pt(j,i+481):NT:NT:For i=0 To 15;;;;;;;;
po(i)\X=Pt(i,486):po(i)\Y=Pt(i,487):po(i)\W=Pt(i,488):NT:SD(op)();;;;;;;;;;;;;;;
SD(art)(SC#Ot()):DrawImage(ImageID(0),0,0):SD(op)():i=0:R:SD(art)(Image#Ot(0));;
x=Pt(i,490):y=Pt(i,491):l=Pt(i,492):h=Pt(i,493):zl=Pt(i,494):zh=Pt(i,495);;;;;;;
SD(op)():SP(i)=Grab#S(#P,x,y,l,h,#PB_#S#_PixelCollision):Zoom#S(SP(i),zl,zh):i+1
U i=46:i=0:j=0:h=0:R:SD(art)(Image#Ot(0)):TS(i)\A=Pt(i,496):xd(i)=Pt(i,489);;;;;
SD(op)():TS(i)\W=Grab#S(#P,j*Q,h*Q,Q,Q):i+1:j+1:If j=16:j=0:h+1:EI:U i=68;;;;;;;
Clear#SC(0):PlaySound(0,#PB_Sound_Loop):Ini:R:R:U WD#Event()=0:Examine#K();;;;;;
If Not go:tp-1:If tp=0:tp=450:px=800:EI:tb-1:If tb=0:tb=1000:av=2000:EI:tm-1;;;;
If tm=0:tm=10:sc+1:EI:ta-1:If ta=0:ta=25:If vx<20:vx+ax:EI:EI:d=DD(vx):If d<>vx;
vx=d:EI:Select JE:Case 0,1:d=DB(1):If d=1:CE(3):t=0:ElseIf KP(#K):CE(2):t=-10:EI
If JE=1:If MO(4):CE(0):EI:EL:If vx>10:MO(1):EL:MO(0):EI:EI:Case 2;;;;;;;;;;;;;;;
If K#Released(#K) And t<-4:t=-4:EI:t+gr:If t<0:d=DH(t):If d<>t:CE(3):EI:JY+d:EL;
CE(3):JY+t:EI:MO(2):Case 3:t+gr:d=DB(t):If d<>t:If t>10:CE(1):EL:CE(0):EI:EI:JY+
d:MO(3):E#Select:FE o():If Not o()\C:If S#PixelCollision(JS,_+vx,JY,o()\W,o()\X,
o()\Y):o()\C=1:CE(1):vx-3:If vx<1:vx=1:EI:EI:EL:o()\I=Random(255):o()\t+gr;;;;;;
o()\Y+o()\t:EI:NT:_+vx:If _>=#R:_-#R:EI:If av>-2000:dy=Random(24)-12:Clear#SC(0)
EL:dy=0:EI:EI:Display#S(SP(0),0,dy):If Not go:If av>-2000:If av>-284 And av<#L;;
DT(SP(40),av,60):EI:av-20:EI:EI:ox=_-16:x=ox/Q:dx=ox%Q:For i=0 To 14;;;;;;;;;;;;
For j=0 To 20:b=MP(i,x+j):If b:DT(TS(b)\W,j*Q-dx,i*Q+dy):EI:NT:NT:If Not go;;;;;
FE o():If o()\X<ox-36 Or o()\X>ox+#L Or o()\Y>#H:DeleteElement(o()):EL:DT(o()\W,
o()\X-ox,o()\Y+dy,o()\I):EI:NT:DT(JS,_-ox,JY+dy):If px>-88:If px<#L:DT(SP(1),px,
dy):EI:px-vx*2:EI:SD(art)(SC#Ot()):t$=Str(sc)+"m":DrawText(#L-TextWidth(t$),0,;;
t$):SD(op)():If JY>419:go=1:EI:WH po(io)\X>ox-36 And po(io)\X<ox+#L;;;;;;;;;;;;;
AddElement(o()):o()\X=po(io)\X:o()\Y=po(io)\Y:o()\W=SP(po(io)\W):o()\C=0:o()\t=0
o()\I=255:io+1:io%16:W#E:EL:DT(SP(45),125,175):SD(art)(SC#Ot()):DrawText(294,;;;
235,y$+sc):SD(op)():If KP(#K):Ini:EI:EI:FlipBuffers():U KP(#PB_Key_Escape);;;;;;

[Mr.L]

Nice, majikeyric!
It's running fine with PB 5.22LTS, but i have some graphic issues if i try to run it with PB 5.30 (Windows 7, 32Bit).

[majikeyric]

Nice, majikeyric!
It's running fine with PB 5.22LTS, but i have some graphic issues if i try to run it with PB 5.30 (Windows 7, 32Bit).

Thanks,
Yes I have noticed that there are sprites bugs with executables created with PB 5.30 and not with 5.22.
It runs well in 5.30 x64 IDE but not in 5.30 x86 IDE.

This is why I think there is a bug in PB 5.30 when there is a lot of sprites in memory....

[majikeyric]

I made a fix for PB 5.30, it seems to bug when I try to display sprites partially outside the screen.

There is still a small issue in the scrolling but I can't do anything to prevent it.

Just compile with 5.22

[Comtois]

My contribution

Code: Select all

;*******************************************************************************
;*
;* July-August 2014 PurePunch contest
;* PureBasic 5.30
;* 50 lines of 80 chars, 2 months delay
;*
;* Name     : Je Te Vois
;* Author   : Comtois
;* Date     : 05/08/14
;* Notes    : TransformSprite() ne fonctionne pas en opengl !!
;*
;*******************************************************************************
Macro M:Macro:EndMacro:M E:End:End#M:M gn:Global NewList:End#M:M R:Read.i:End#M
M st:Structure:E#M:M ts:TransformSprite:E#M:M pr:Procedure:E#M:M N:Next:E#M
M sp:Sprite:E#M:M mo:Mouse:E#M:M Rp:Repeat:E#M:M C:Continue:E#M
M Sd:StartDrawing:E#M:M So:StopDrawing:E#M:M rt:Return:E#M:M ll:ClearList:E#M
st V2:x.d:y.d:E#St:st k:p1.V2:p2.V2:E#St:st Tria:No.i:p1.V2:p2.V2:p3.V2:E#St
st it:ok.i:x.d:y.d:p.d:a.d:E#St:gn Y.k():gn LP.V2():gn Z.d():gn q.it()
gn W.Tria():M AE:AddElement:End#M:M FE:ForEach:End#M:pr Gi(*it.it,*ry.k,*h.k)
rpx.d=*ry\p1\x:rpy.d=*ry\p1\y:rdx.d=*ry\p2\x-*ry\p1\x:rdy.d=*ry\p2\y-*ry\p1\y
spx.d=*h\p1\x:spy.d=*h\p1\y:sdx.d=*h\p2\x-*h\p1\x:sdy.d=*h\p2\y-*h\p1\y
rg.d=Sqr(rdx*rdx+rdy*rdy):smg.d=Sqr(sdx*sdx+sdy*sdy):If rdx/rg=sdx/smg And
rdy/rg=sdy/smg:pr#rt 0:E#If:T2.d=(rdx*(spy-rpy)+rdy*(rpx-spx))/(sdx*rdy-sdy*rdx)
T1.d=(spx+sdx*T2-rpx)/rdx:If T1<0:pr#rt 0:E#If:If T2<0 Or T2>1:pr#rt 0:E#If
*it\x=rpx+rdx*T1:*it\y=rpy+rdy*T1:*it\p=T1:pr#rt 1:E#Pr:pr J(gx.f,gy.f):ll(LP())
FE Y():AE(LP()):LP()\x=Y()\p1\x:LP()\y=Y()\p1\y:AE(LP()):LP()\x=Y()\p2\x
LP()\y=Y()\p2\y:N:FE LP():VX.f=LP()\x:VY.f=LP()\y:PushListPosition(LP())
While N#Element(LP()):If LP()\x=VX And LP()\y=VY:DeleteElement(LP()):E#If:Wend
PopListPosition(LP()):N:ll(Z()):FE LP():a.f=ATan2(LP()\x-gx,LP()\y-gy):AE(Z())
Z()=a-0.0001:AE(Z()):Z()=a:AE(Z()):Z()=a+0.0001:N:ll(q()):FE Z():a.f=Z()
dx.d=Cos(a):dy.d=Sin(a):ry.k:ry\p1\x=gx:ry\p1\y=gy:ry\p2\x=gx+dx:ry\p2\y=gy+dy
Protected.it CI,it:CI\ok=0:FE Y():g=Gi(@it,@ry,@Y()):If g=0:C:E#If:If CI\ok=0 Or
it\p<CI\p:CI=it:CI\ok=1:E#If:N:If (CI\ok=0):C:E#If:CI\a=a:AE(q()):q()=CI:N
SortStructuredList(q(),0,OffsetOf(it\a),TypeOf(it\a)):E#pr:pr draw()
sd(ScreenOutput()):J(Mo#X(),Mo#Y()):ok=0:Protected.d x,y,x0,y0:FE w()
Free#Sp(w()\No):N:ll(w()):FirstElement(q()):x0=q()\x:y0=q()\y:FE q():If ok
AE(w()):w()\p1\x=Mo#X():w()\p1\y=Mo#Y():w()\p2\x=x:w()\p2\y=y:w()\p3\x=q()\x
w()\p3\y=q()\y:E#If:x=q()\x:y=q()\y:ok=1:N:AE(w()):w()\p1\x=Mo#X()
w()\p1\y=Mo#Y():w()\p3\x=x0:w()\p3\y=y0:w()\p2\x=q()\x:w()\p2\y=q()\y:So():E#pr
InitSprite():InitMouse():InitKeyboard():OpenWindow(0,0,0,800,600,"")
OpenWindowedScreen(WindowID(0),0,0,800,600):Mo#Locate(400,300)
Create#Sp(0,32,32):sd(Sp#Output(0)):Circle(15,15,15,RGB(255,255,0)):So():Sx=799
Sy=599:AE(Y()):Y()\p1\x=0:Y()\p1\y=0:Y()\p2\x=Sx:Y()\p2\y=0:AE(Y()):Y()\p1\x=Sx
Y()\p1\y=0:Y()\p2\x=Sx:Y()\p2\y=Sy:AE(Y()):Y()\p1\x=Sx:Y()\p1\y=Sy:Y()\p2\x=0
Y()\p2\y=Sy:AE(Y()):Y()\p1\x=0:Y()\p1\y=Sy:Y()\p2\x=0:Y()\p2\y=0:Dim S.k(3):No=1
Rp:R Nb:For i=0 To Nb-1:R S(i)\p1\x:R S(i)\p1\y:R S(i)\p2\x:R S(i)\p2\y:AE(Y())
Y()\p1\x=S(i)\p1\x:Y()\p1\y=S(i)\p1\y:Y()\p2\x=S(i)\p2\x:Y()\p2\y=S(i)\p2\y:N
Create#Sp(No,256,256):sd(Sp#Output(No)):Box(0,0,256,256,RGB(0,50,140)):So()
If Nb=4:ts(No,S(0)\p1\x,S(0)\p1\y,S(0)\p2\x,S(0)\p2\y,S(1)\p2\x,S(1)\p2\y,
S(2)\p2\x,S(2)\p2\y):Else:ts(No,S(0)\p1\x,S(0)\p1\y,S(0)\p2\x,S(0)\p2\y,
S(1)\p2\x,S(1)\p2\y,S(1)\p2\x,S(1)\p2\y):E#If:No+1:Until Nb=0:Rp:Rp
ev=WindowEvent():Until ev=0 :ClearScreen($FFFFFF):ExamineMouse()
ExamineKeyboard():Draw():FE w():w()\no=Create#Sp(-1,256,256)
sd(Sp#Output(w()\no)):Box(0,0,256,256,RGB(250,70,0)):So():ts(w()\no,w()\p1\x,
w()\p1\y,w()\p2\x,w()\p2\y,w()\p3\x,w()\p3\y,w()\p3\x,w()\p3\y)
Display#Sp(w()\no,0,0):N:For i=1 To 5:Display#Sp(i,0,0):N
DisplayTransparent#Sp(0,Mo#X()-16,Mo#Y()-16):FlipBuffers()
Until KeyboardPushed(#PB_Key_Escape):DataSection:Data.i 4,50,50,150,50,150,50,
150,150,150,150,50,150,50,150,50,50,3,450,300,550,450,550,450,350,450,350,450,
450,300,4,650,250,750,200,750,200,750,350,750,350,650,400,650,400,650,250,4,350,
80,450,80,450,80,450,220,450,220,350,220,350,220,350,80,4,120,320,170,370,170,
370,120,420,120,420,70,370,70,370,120,320,0:EndDataSection

[heartbone]

My contribution
{snip}

Your entry seems very abstract.
Perhaps it's because I'm running Linux?
Then again, perhaps not...
Je Te Vois = I See You
Cool.

[Comtois]

yes, unfortunately TransformSprite() does not work under linux. If I find another solution I will edit my code.

[Comtois]

work around done by grap100 , if it dont work, replace this :

Code: Select all

TransformSprite(sprite, _x4, _y1, _x2, (_y1)-(_y3)+(_y4), _x3, (_y1)-(_y2)+(_y4), _x1, _y4)

by this :

Code: Select all

TransformSprite(sprite, _x1, _y1, _x2, (_y1)-(_y3)+(_y4), _x3, (_y1)-(_y2)+(_y4), _x4, _y4)

Code: Select all

;*******************************************************************************
;*
;* July-August 2014 PurePunch contest
;* PureBasic 5.30
;* 50 lines of 80 chars, 2 months delay
;*
;* Name     : Je Te Vois
;* Author   : Comtois
;* Date     : 05/08/14
;* Notes    : TransformSprite() ne fonctionne pas en opengl !!
;*
;*******************************************************************************

Macro ts(sprite, _x1, _y1, _x2, _y2, _x3, _y3, _x4, _y4)
   CompilerIf #PB_Compiler_OS = #PB_OS_Windows
      TransformSprite(sprite, _x1, _y1, _x2, _y2, _x3, _y3, _x4, _y4)
   CompilerElse
      ; Linux
      TransformSprite(sprite, _x4, _y1, _x2, (_y1)-(_y3)+(_y4), _x3, (_y1)-(_y2)+(_y4), _x1, _y4)
   CompilerEndIf
EndMacro


Macro M:Macro:EndMacro:M E:End:End#M:M gn:Global NewList:End#M:M R:Read.i:End#M
M st:Structure:E#M:M ts_:TransformSprite:E#M:M pr:Procedure:E#M:M N:Next:E#M
M sp:Sprite:E#M:M mo:Mouse:E#M:M Rp:Repeat:E#M:M C:Continue:E#M
M Sd:StartDrawing:E#M:M So:StopDrawing:E#M:M rt:Return:E#M:M ll:ClearList:E#M
st V2:x.d:y.d:E#St:st k:p1.V2:p2.V2:E#St:st Tria:No.i:p1.V2:p2.V2:p3.V2:E#St
st it:ok.i:x.d:y.d:p.d:a.d:E#St:gn Y.k():gn LP.V2():gn Z.d():gn q.it()
gn W.Tria():M AE:AddElement:End#M:M FE:ForEach:End#M:pr Gi(*it.it,*ry.k,*h.k)
rpx.d=*ry\p1\x:rpy.d=*ry\p1\y:rdx.d=*ry\p2\x-*ry\p1\x:rdy.d=*ry\p2\y-*ry\p1\y
spx.d=*h\p1\x:spy.d=*h\p1\y:sdx.d=*h\p2\x-*h\p1\x:sdy.d=*h\p2\y-*h\p1\y
rg.d=Sqr(rdx*rdx+rdy*rdy):smg.d=Sqr(sdx*sdx+sdy*sdy):If rdx/rg=sdx/smg And
rdy/rg=sdy/smg:pr#rt 0:E#If:T2.d=(rdx*(spy-rpy)+rdy*(rpx-spx))/(sdx*rdy-sdy*rdx)
T1.d=(spx+sdx*T2-rpx)/rdx:If T1<0:pr#rt 0:E#If:If T2<0 Or T2>1:pr#rt 0:E#If
*it\x=rpx+rdx*T1:*it\y=rpy+rdy*T1:*it\p=T1:pr#rt 1:E#Pr:pr J(gx.f,gy.f):ll(LP())
FE Y():AE(LP()):LP()\x=Y()\p1\x:LP()\y=Y()\p1\y:AE(LP()):LP()\x=Y()\p2\x
LP()\y=Y()\p2\y:N:FE LP():VX.f=LP()\x:VY.f=LP()\y:PushListPosition(LP())
While N#Element(LP()):If LP()\x=VX And LP()\y=VY:DeleteElement(LP()):E#If:Wend
PopListPosition(LP()):N:ll(Z()):FE LP():a.f=ATan2(LP()\x-gx,LP()\y-gy):AE(Z())
Z()=a-0.0001:AE(Z()):Z()=a:AE(Z()):Z()=a+0.0001:N:ll(q()):FE Z():a.f=Z()
dx.d=Cos(a):dy.d=Sin(a):ry.k:ry\p1\x=gx:ry\p1\y=gy:ry\p2\x=gx+dx:ry\p2\y=gy+dy
Protected.it CI,it:CI\ok=0:FE Y():g=Gi(@it,@ry,@Y()):If g=0:C:E#If:If CI\ok=0 Or
it\p<CI\p:CI=it:CI\ok=1:E#If:N:If (CI\ok=0):C:E#If:CI\a=a:AE(q()):q()=CI:N
SortStructuredList(q(),0,OffsetOf(it\a),TypeOf(it\a)):E#pr:pr draw()
sd(ScreenOutput()):J(Mo#X(),Mo#Y()):ok=0:Protected.d x,y,x0,y0:FE w()
Free#Sp(w()\No):N:ll(w()):FirstElement(q()):x0=q()\x:y0=q()\y:FE q():If ok
AE(w()):w()\p1\x=Mo#X():w()\p1\y=Mo#Y():w()\p2\x=x:w()\p2\y=y:w()\p3\x=q()\x
w()\p3\y=q()\y:E#If:x=q()\x:y=q()\y:ok=1:N:AE(w()):w()\p1\x=Mo#X()
w()\p1\y=Mo#Y():w()\p3\x=x0:w()\p3\y=y0:w()\p2\x=q()\x:w()\p2\y=q()\y:So():E#pr
InitSprite():InitMouse():InitKeyboard():OpenWindow(0,0,0,800,600,"")
OpenWindowedScreen(WindowID(0),0,0,800,600):Mo#Locate(400,300)
Create#Sp(0,32,32):sd(Sp#Output(0)):Circle(15,15,15,RGB(255,255,0)):So():Sx=799
Sy=599:AE(Y()):Y()\p1\x=0:Y()\p1\y=0:Y()\p2\x=Sx:Y()\p2\y=0:AE(Y()):Y()\p1\x=Sx
Y()\p1\y=0:Y()\p2\x=Sx:Y()\p2\y=Sy:AE(Y()):Y()\p1\x=Sx:Y()\p1\y=Sy:Y()\p2\x=0
Y()\p2\y=Sy:AE(Y()):Y()\p1\x=0:Y()\p1\y=Sy:Y()\p2\x=0:Y()\p2\y=0:Dim S.k(3):No=1
Rp:R Nb:For i=0 To Nb-1:R S(i)\p1\x:R S(i)\p1\y:R S(i)\p2\x:R S(i)\p2\y:AE(Y())
Y()\p1\x=S(i)\p1\x:Y()\p1\y=S(i)\p1\y:Y()\p2\x=S(i)\p2\x:Y()\p2\y=S(i)\p2\y:N
Create#Sp(No,256,256):sd(Sp#Output(No)):Box(0,0,256,256,RGB(0,50,140)):So()
If Nb=4:ts(No,S(0)\p1\x,S(0)\p1\y,S(0)\p2\x,S(0)\p2\y,S(1)\p2\x,S(1)\p2\y,
S(2)\p2\x,S(2)\p2\y):Else:ts(No,S(0)\p1\x,S(0)\p1\y,S(0)\p2\x,S(0)\p2\y,
S(1)\p2\x,S(1)\p2\y,S(1)\p2\x,S(1)\p2\y):E#If:No+1:Until Nb=0:Rp:Rp
ev=WindowEvent():Until ev=0 :ClearScreen($FFFFFF):ExamineMouse()
ExamineKeyboard():Draw():FE w():w()\no=Create#Sp(-1,256,256)
sd(Sp#Output(w()\no)):Box(0,0,256,256,RGB(250,70,0)):So():ts(w()\no,w()\p1\x,
w()\p1\y,w()\p2\x,w()\p2\y,w()\p3\x,w()\p3\y,w()\p3\x,w()\p3\y)
Display#Sp(w()\no,0,0):N:For i=1 To 5:Display#Sp(i,0,0):N
DisplayTransparent#Sp(0,Mo#X()-16,Mo#Y()-16):FlipBuffers()
Until KeyboardPushed(#PB_Key_Escape):DataSection:Data.i 4,50,50,150,50,150,50,
150,150,150,150,50,150,50,150,50,50,3,450,300,550,450,550,450,350,450,350,450,
450,300,4,650,250,750,200,750,200,750,350,750,350,650,400,650,400,650,250,4,350,
80,450,80,450,80,450,220,450,220,350,220,350,220,350,80,4,120,320,170,370,170,
370,120,420,120,420,70,370,70,370,120,320,0:EndDataSection

[Bananenfreak]

Cool thing, comtois!

[firace]

The classic starfield... based on some old benny!'s code. I've just compacted it and added a speed parameter. It could easily be made even shorter, but well...

Code: Select all

#scrw = 640	
#scrh = 480
#centerofscrw = #scrw/2
#centerofscrh = #scrh/2
#sp = 7      ; Speed of Travel
SSum.w = 555 ; Amount of Stars
Gosub InitStarField
 InitSprite() : InitKeyboard() : InitMouse() 
 OpenScreen(#scrw,#scrh,16,"_", #PB_Screen_SmartSynchronization) 
SetFrameRate(90)
Repeat
  ClearScreen(RGB(0,0,0)) : StartDrawing(ScreenOutput())
  DrawingMode(1)
  Gosub DoStarField
  StopDrawing() : FlipBuffers() : ExamineKeyboard()
Until KeyboardPushed(#PB_Key_Escape)
End
InitStarField:
Structure _3DStar
  x.f ; X-Coordinate
  y.f ; Y-Coordinate
  z.f ; Z-Coordinate
  zv.f ; Z-Velocity
EndStructure
Dim Stars._3DStar(SSum)
For _ = 0 To SSum
  Stars(_)\x = Random(1000)-500
  Stars(_)\y = Random(1000)-500
  Stars(_)\z = 100 + Random(900)
  Stars(_)\zv = 0.5 + Random (45)/10
Next _
Return
DoStarField:
For _ = 0 To SSum
  Stars(_)\z = Stars(_)\z - Stars(_)\zv * #sp ; Star comes closer ....
  SX = Stars(_)\x / Stars(_)\z * 100 + #centerofscrw
  SY = Stars(_)\y / Stars(_)\z * 100 + #centerofscrh
  If SX >= #scrw Or SY >= #scrh Or Stars(_)\z < 1
    Stars(_)\x = Random(1000)-500
    Stars(_)\y = Random(1000)-500
    Stars(_)\z = 100 + Random(900)
    Stars(_)\zv = 0.5 + ( Random(45) / 10 )
  Else
    b = 255 - (Stars(_)\z *(255./1000.)) 
    If SX > 0 And SY > 0 And SX < #scrw And SY < #scrh
      Plot ( SX, SY, RGB ( b,b,b ) )
    EndIf
  EndIf
Next _
Return

[BasicallyPure]

Here is my entry for the contest.

Windows version

Code: Select all

;*******************************************************************************
;*
;* July-August 2014 PurePunch contest
;* PureBasic 5.22, 5.30
;* 50 lines of 80 chars, 2 months delay
;*
;* Name     : Interplanetary War
;* Author   : BasicallyPure
;* Date     : 8/26/2014
;* Notes    : Destroy the planet behind the star.
;*          : shoot = Left mouse down, pause, then release button
;*          : Right mouse button = cancel shot
;*          : Spacebar for new arrangement
;* Target OS: Windows
;.......10........20........30........40........50........60........70........80
EnableExplicit
Macro M:Macro:EndMacro:M SD:StartDrawing:End#M:#VC=$270000:#I=$FFFFFF:#H=768;###
#W=1024:#G=0.008:#X=#W/2-1:#Y=#H/2-1:M ST:StopDrawing():End#M:M RA:Random:End#M;
M XM:WindowMouseX(0):End#M:M CS:CreateSprite:End#M:M SW:SpriteWidth:End#M:M TS;#
DisplayTransparentSprite:EndMacro:Structure XT:x.f:y.f:z.f:o.i:m.i:EndStructure;
M EM:ElapsedMilliseconds():End#M:M DM:DrawingMode:End#M:#S=2000:Define tos,b,n,;
Ev,c=1,t.s="Interplanetary War":Structure PT Extends XT:u.f:v.f:w.f:EndStructure
Global.XT su,pl,pr:Define.f d,f,z,Az,el:M YM:WindowMouseY(0):End#M:M X2D(P,Z);##
#X+P/Z*#S:EndMacro:Global pj.PT,mx,my,fi,q.f:M SO:SpriteOutput:End#M:M DS(A,B);#
Sqr(Pow(A\x-B\x,2)+Pow(A\y-B\y,2)+Pow(A\z-B\z,2)):EndMacro:M DTS(n,j):TS(N,;####
X2D(j\x,j\z)-j\o,Y2D(j\y,j\z)-j\o):EndMacro:M SC:ShowCursor_(1):End#M:M Y2D(P,Z)
#Y-P/Z*#S:EndMacro:M DP(c):SD(SO(2)):DM(256):Box(0,0,SW(2),SW(2),0):BackColor(c)
FrontColor(#VC):DM(64):CircularGradient(31,31,31):GradientColor(0.85,$A0783F);##
Circle(31,31,31,c):ST:EndMacro:M HC:ShowCursor_(0):End#M:Procedure PPL();#######
su\x=0:su\y=0:su\z=#S:su\m=15000+RA(10000):su\o=SW(1)/2:fi=0:DP($5D9B3F);#######
pl\x=su\x+(100+RA(200))*(1-2*RA(1)):pl\z=su\z+(750+RA(1750)):pl\y=su\y+(100+;###
RA(150))*(1-2*RA(1)):pl\m=su\m/10:q=#S/(Ds(pr,pl)):ZoomSprite(2,64*q,64*q);#####
pl\o=SW(2)/2:SD(SO(4)):DM(256):Box(0,0,#W-1,#H-1,0):ST:EndProcedure:InitSprite()
Procedure fi():Protected.f el,Az,a,v,p=EM+150:If fi=1:ProcedureReturn:EndIf:fi=1
Repeat:If EM>p:p=EM+150:If v<4:a=v*1.5708:SD(ScreenOutput()):Line(mx,my,;#######
Sin(a)*16,Cos(a)*-16,$FF):ST:v+0.05:FlipBuffers():EndIf:EndIf:Delay(1);#########
Until WindowEvent()=514:Az=ASin((mx-#X)/#S):el=ASin((#Y-my)/#S):pj\x=0:pj\y=0;##
pj\z=8:pj\o=0:pj\u=v*Cos(el)*Sin(Az):pj\v=v*Sin(el):pj\w=v*Cos(el)*Cos(Az);#####
EndProcedure:Procedure EX():Protected n,r:DP(#I):For n=1 To 120:DisplaySprite(0,
0,0):ZoomSprite(2,r,r):pl\o=SW(2)/2:DTS(2,pl):DTS(1,su):If n <41:r+4:Else:r-2;##
EndIf:FlipBuffers():Next:MessageRequester("","Target Destroyed!"):PPL();########
EndProcedure:OpenWindow(0,0,0,#W,#H,t,$C80001):AddKeyboardShortcut(0,32,0);#####
OpenWindowedScreen(WindowID(0),0,0,#W,#H):CS(0,#W,#H):CS(1,128,128):CS(2,64,64);
CS(4,#W,#H):CS(3,64,64):SD(SO(1)):DM(256):Box(0,0,SW(1),SW(1),0):FrontColor(#VC)
BackColor($D0FFFF):DM(64):CircularGradient(63,63,63):GradientColor(0.9,$17BEF4);
Circle(63,63,63,$7FFFFF):ST:SD(SO(0)):Box(0,0,#W,#H,#VC):For n=1 To 350:b=32+;##
RA(223):Plot(RA(#W-1),RA(#H-1),RGB(b,b,b)):Next:ST:SD(SO(3)):DM(260);###########
Box(0,0,63,63,0):Circle(31,31,15,#I):LineXY(0,31,63,31,#I):With pj;#############
LineXY(31,0,31,63,#I):ST:PPL():Repeat:Repeat:Ev=WindowEvent():Select Ev;########
Case 13116:End:Case 13101:If fi=0:PPL():EndIf:Case 513:If fi=0:C=1:fi():SC:EndIf
Case 517:fi=0:SD(SO(4)):DM(256):Box(0,0,#W-1,#H-1,0):ST:EndSelect:Until Ev=0;###
DisplaySprite(0,0,0):If \z > pl\z:TS(4,0,0):DTS(2,pl):DTS(1,su):ElseIf \z>su\z;#
DTS(2,pl):TS(4,0,0):DTS(1,su):Else:DTS(2,pl):DTS(1,su):TS(4,0,0):EndIf:mx = XM;#
my=YM:If fi:f=(#G*su\m)/Pow(Ds(pj,su),3):\u+f*(su\x-\x):\v+f*(su\y-\y);#########
\w+f*(su\z-\z):f=(#G*pl\m)/Pow(Ds(pj,pl),3):\u+f*(pl\x-\x):\v+f*(pl\y-\y);######
\w+f*(pl\z-\z):\x+\u:\y+\v:\z+\w:SD(SO(4)):DM(256):Box(0,0,#W-1,#H-1,0);########
DrawText(5,5,"projectile velocity:  "+Str(Sqr(\u*\u+\v*\v+\w*\w)*#S));##########
DrawText(5,25,"distance to planet:  "+Str(Ds(pj,pl))):z=#S/(Ds(pr,pj));#########
Circle(X2D(\x,\z),Y2D(\y,\z),z+1,$FF):ST:If Ds(pl,pj)<32:fi=0:EX():EndIf:Else;##
If Not mx<0 Or Not my<0:If c:c=0:HC:EndIf:TS(3,mx-31,my-31):Az=Degree(ASin((XM+;
-#X)/#S)):el=Degree(ASin((#Y-YM)/#S)):If mx>#X:tos=-75:Else:tos=15:EndIf;#######
SD(ScreenOutput()):DM(1):DrawText(mx+tos,my-30,"Evn. "+StrF(el,2),$FF00);#######
DrawText(mx+tos,my+10,"Azm. "+StrF(Az,2),$FF00):ST:Else:If c=0:c=1:SC:EndIf;####
EndIf:EndIf:EndWith:FlipBuffers():ForEver;######################################
;.......10........20........30........40........50........60........70........80

Linux version

Code: Select all

;*******************************************************************************
;*
;* July-August 2014 PurePunch contest
;* PureBasic 5.22, 5.30
;* 50 lines of 80 chars, 2 months delay
;*
;* Name     : Interplanetary War
;* Author   : BasicallyPure
;* Date     : 8/10/2014
;* Notes    : Destroy the planet behind the star.
;*          : shoot = Left mouse click, pause, then right mouse click
;*          : Left mouse click = cancel shot
;*          : Spacebar for new arrangement
;* Target OS: Linux
;.......10........20........30........40........50........60........70........80
;EnableExplicit
Macro M:Macro:EndMacro:M E:End:End#M:Global W=1024,H=768,MdX=W/2-1,MdY= H/2-1,;#
K=2000,V=$270000,mx,my,Fi:#G=0.008:#W=$FFFFFF:#SV=0:#SS=1:#SP=2:#SA=3:#SB=4;####
Structure o:x.f:y.f:z.f:xv.f:yv.f:zv.f:o.i:m.i:EndStructure:Global .o su,pl,usr,
pr:Define.i b,n,Ev,os,t$="Interplanetary War":Define.f d,z,az,el,f:M X2(a,b);###
MdX+a/b*K:EndMacro:M Y2(a,b):MdY-a/b*K:E#M:M SD:StartDrawing:E#M:M PZ:Procedure;
EndMacro:M ST:StopDrawing():E#M:M CS:CreateSprite:E#M:M DM:DrawingMode:E#M:M DT;
DisplayTransparentSprite:EndMacro:M SO:SpriteOutput:E#M:M SW:SpriteWidth:E#M;###
M EX:ExamineMouse():ExamineKeyboard():E#M:M RN:Random:E#M:M PT:Protected:E#M;###
M EM:ElapsedMilliseconds():E#M:M DS(a,b):Sqr(Pow(a\x-b\x,2)+Pow(a\y-b\y,2)+ ;###
Pow(a\z-b\z,2)):EndMacro:M DTS(sprite,obj):DT(sprite,X2(obj\x,obj\z)-obj\o,;####
Y2(obj\y,obj\z)-obj\o):EndMacro:M DPS(c):SD(SO(#SP)):DM(256):Box(0,0,SW(#SP),;##
SW(#SP),0):FrontColor(V):BackColor(c):DM(64):CircularGradient(31,31,31);########
GradientColor(0.85,$A0783F):Circle(31,31,31,c):ST:EndMacro:M CB:SD(SO(#SB));####
DM(256):Box(0,0,W-1,H-1,0):ST:EndMacro:PZ PP():PT z.f:su\x=0:su\y=0:su\z=K:;####
su\m=15000+RN(10000):su\o=SW(#SS)/2:DPS($5D9B3F):pl\x=su\x+(100+RN(200)+;#######
0)*(1-2*RN(1)):pl\y=su\y+(100+RN(150))*(1-2*RN(1)):pl\z=su\z+(750+RN(1750));####
pl\m=su\m/10:z=K/(DS(usr,pl)):ZoomSprite(#SP,64*z,64*z):pl\o=SW(#SP)/2:Fi=0:CB;#
E#PZ:PZ Fi():PT.f el,az,a,s,p=EM+150:If Fi=1:PZ#Return:EndIf:Fi=1:Repeat;#######
While WindowEvent():Wend:EX:If KeyboardPushed(27):End:EndIf:If MouseButton(2);##
Break:EndIf:If EM>p:p=EM+150:If s<4:a=s*1.5708:SD(ScreenOutput()):Line(mx,my,;##
Sin(a)*16,Cos(a)*-16,$FF):ST:s+0.05:FlipBuffers():EndIf:EndIf:Delay(1):ForEver;#
az=ASin((mx-MdX)/K):el=ASin((MdY-my)/K):pr\x=0:pr\y=0:pr\z=8:pr\o=0:pr\xv=0+;###
s*Cos(el)*Sin(az):pr\yv=s*Sin(el):pr\zv=s*Cos(el)*Cos(az):E#PZ:PZ EP():PT n,r;##
DPS(#W):For n=1 To 120:DisplaySprite(#SV,0,0):ZoomSprite(#SP,r,r):pl\o=SW(#SP)/2
DTS(#SP,pl):DTS(#SS,su):If n<41:r+4:Else:r-2:EndIf:FlipBuffers():Next;##########
MessageRequester("","Target Destroyed!"):PP():E#PZ:OpenWindow(0,0,0,W,H,t$,64);#
InitSprite():InitKeyboard():InitMouse():AddKeyboardShortcut(0,32,0);############
OpenWindowedScreen(WindowID(0),0,0,W,H):CS(#SV,W,H):CS(#SS,128,128):CS(#SP,64,;#
64):CS(#SB,W,H):CS(#SA,64,64):SD(SO(#SS)):DM(256):Box(0,0,SW(#SS),SW(#SS),0);###
FrontColor(V):BackColor($D0FFFF):DrawingMode(64):CircularGradient(63,63,63);####
GradientColor(0.9,$17BEF4):Circle(63,63,63,$7FFFFF):StopDrawing():With pr
SD(SO(#SV)):Box(0,0,W,H,V):For n=1 To 350:b=32+RN(223):Plot(RN(W-1),RN(H-1),;
RGB(b,b,b)):Next:ST:SD(SO(#SA)):DM(260):Box(0,0,63,63,0):Circle(31,31,15,#W);###
LineXY(0,31,63,31,#W):LineXY(31,0,31,63,#W):ST:PP():Repeat:Repeat;##############
Ev=WindowEvent():Select Ev:Case 2:End:EndSelect:Until Ev=0:EX:M A:Keyboard:E#M;#
If A#Pushed(27):End:EndIf:If MouseButton(1):If Fi=0:Fi():Else:Fi=0:Delay(250);##
CB:EndIf:EndIf:If A#Released(32):If Fi=0:PP():EndIf:EndIf:DisplaySprite(#SV,0,0)
If \z>pl\z:DT(#SB,0,0):DTS(#SP,pl):DTS(#SS,su):ElseIf \z>su\z:DTS(#SP,pl);######
DT(#SB,0,0):DTS(#SS,su):Else:DTS(#SP,pl):DTS(#SS,su):DT(#SB,0,0):EndIf;#########
mx=MouseX():my=MouseY():If Fi:f=(#G*su\m)/Pow(DS(pr,su),3):\xv+f*(su\x-\x):\yv+;
f*(su\y-\y):\zv+f*(su\z-\z):f=(#G*pl\m)/Pow(DS(pr,pl),3):\xv+f*(pl\x-\x):\yv+;##
f*(pl\y-\y):\zv+f*(pl\z-\z):\x+\xv:\y+\yv:\z+\zv:SD(SO(#SB)):DM(256):Box(0,0,;##
W-1,H-1,0):DrawText(5,5,"projectile velocity:  "+Str(Sqr(\xv*pr\xv+\yv*pr\yv+;##
\zv*pr\zv)*K)):DrawText(5,25,"distance to planet:  "+Str(DS(pr,pl)));###########
z=K/(DS(usr,pr)):Circle(X2(\x,\z),Y2(\y,\z),z+1,$FF):ST:If DS(pl,pr)<32:F=0:EP()
EndIf:Else:If Not mx<0 Or Not my<0:DT(#SA,mx-31,my-31):az=Degree(ASin((MouseX()+
0-MdX)/K)):el=Degree(ASin((MdY-MouseY())/K)):If mx>MdX:os=-85:Else:os=15:EndIf;#
SD(ScreenOutput()):DM(1):DrawText(mx+os,my-30,"Evn. "+StrF(el,2),$FF00);########
DrawText(mx+os,my+10,"Azm. "+StrF(az,2),$FF00):ST:EndIf:EndIf:EndWith
FlipBuffers():ForEver
;.......10........20........30........40........50........60........70........80

[Huitbit]

Here is my entry for the contest : Back to Winterfell

The story :
After a drinking party in the pub ("The rotten pig"), two Stark go back home.
Their wifes are upset, they've closed the doors of the castle.
It's up to you to find and catch the key to find your bed!

You can hit the bats but beware of the rocks !

http://www.petit-fichier.fr/2014/08/28/punch/

or

https://www.dropbox.com/s/1mdepbk03kgvz ... h.rar?dl=0





The commands :
[UP] change side of the jumper
[SPACE] Start and sword
[LEFT] or [RIGHT] move the see-saw

The sprites are coming from konami games (except the see-saw)

Code: Select all

;*****************************************************************************
;*
;* July-August 2014 PurePunch contest
;* PureBasic 5.22
;* 50 lines of 80 chars, 2 months delay
;*
;* Name     : Retour à Winterfell
;* Author   : Huitbit
;* Date     : 28/08/2014
;* Notes    : jeu d'adresse
;*
;*****************************************************************************
;Hors punch
MessageRequester("PurePunch2014","But du jeu : trouver puis attraper la clé pour rentrer chez vous !"+Chr(13)+" [ESPACE] : démarrer et épée"+Chr(13)+" [HAUT] : changer de direction"+Chr(13)+"[GAUCHE/DROITE] : déplacer la bascule")
;fin hors punch
L=320:H=240:Define.f xA,yA,uA,vyA,vA,yAp,xB,yB,uB,vyB,vB,yBp,xr,yr,ur,vyr,n,rA,;
rB:v=0:sB=8:a=128:b=32:lba=132:c=16:pt.f=0.25:al.f=ATan2(a,b):o.f=0:m=100;;;;;;;
jba=14520:xba=96:yba=208:yCb=yba+c:xCb=xba+b:Macro cl(x,y,vx,vy):vy=vy+0.6:x=x+;
vx*0.1:y=y+vy*0.1:EndMacro:Macro rn(r,x1,y1,x2,y2):r=Sqr((x2-x1)*(x2-x1)+;;;;;;;
(y2-y1)*(y2-y1)):EndMacro:Macro s:Sprite:EndMacro:Macro d:DisplayTransparent#s#(
EndMacro:Macro u:SpriteCollision:EndMacro:Macro k:Keyboard:EndMacro:Macro t;;;;;
ElapsedMilliseconds:EndMacro:Macro p:EndIf:EndMacro:Macro z:Random:EndMacro;;;;;
Macro r:Read.l:EndMacro:Macro gj:Goto jeu:EndMacro:Init#s():Init#k():InitSound()
OpenWindow(0,0,0,640,480,"",13107200):OpenWindowedScreen(WindowID(0),0,0,L,H,1,;
0,0,2):Load#s(10,"s.bmp"):Display#s(10,0,0):For i=0 To 7:Grab#s(i,0,16*i,16,16);
Next i:Grab#s(8,0,128,128,32):Grab#s(9,0,160,128,32):jeu: :LoadMusic(0,"v.it");;;;
PlayMusic(0):v=0:sB=8:xba=96:yba=208:yCb=yba+c:xCb=xba+b:xA=xba:yA=194:xB=xba+;;
a-c:yB=yba+14:w=3:j=4:xr=32:yr=16:g=7:xg.f=160:yg.f=z(1)*48:rx=3:ct=0;;;;;;;;;;;
Dim sp.l(8):sp(8)=z(7):Repeat:If u(5,xq,yq,7,xg,yg+n):yg=H:p:Restore dp;;;;;;;;;
For i=0 To 7:r cn:r ln:If sp(i)<>-1:If u(5,xq,yq,sp(i),16*cn,16*ln):If i<>sp(8);
sp(i)=-1:Else:If ct=0:sp(i)=2:ct=1:pq=t():p:If ct=2:xq=0:MessageRequester("",""+
"Gagné!"):gj:p:p:p:p:Next i:If yr<H-60:If u(w,xA,yA+n,1,xr,yr+n):yA=YA+16:p;;;;;
If u(j,xB,yB+n,1,xr,yr+n):yB=yB+16:p:p:If yg<H-60:If u(w,xA,yA+n,7,xg,yg+n);;;;;
yA=YA+16:p:If u(j,xB,yB+n,7,xg,yg+n):yB=yB+16:p:p:If t()-cK>200:Examine#k();;;;;
If k#Pushed(203):If xba+a*0.75>0:xba=xba-4:If v<>1:xA=xA-4:p:If v<>2:xB=xB-4:p:p
p:If k#Pushed(205):If xba+a*0.25<L:xba=xba+4:If v<>1:xA=xA+4:p:If v<>2:xB=xB+4:p
p:p:If k#Pushed(200):If v<>0:If v<>1:If j=4:j=3:Else:j=4:p:p:If v<>2:If w=3:w=4;
Else:w=3:p:p:cK=t():p:p:If k#Pushed(#PB_Key_Space):If v=1:If w=3:w=11:p:If w=4;;
w=12:p:p:If v=2:If j=4:j=12:p:If j=3:j=11:p:p:If v=0:v=2:xB=xA+112:yB=yA:uB=0;;;;;;;;
vyB=-30*Cos(al):sB=9:yA=yba+14:w=3:j=4:cK=t():p:p:p:xCb=xba+64:If v=1:yAp=yA;;;;
cl(xA,yA,uA,vyA):If vyA>0:If (xA>=xba) And (xA<=xba+48):If (yA+c)>=yba And (yAp+
c)<=yba:yA=yCb-pt*(xCb-(xA+c))-18:v=2:rn(rA,(xA+8),(yA+c),xCb,yCb):rn(rB,(xB+8),
(yB+c),xCb,yCb):jt=m*(rA*rA+rB*rB)+jba:o=m*((xA+8-xCb)*vyA-(yA+c-yCb)*uA)/jt;;;;
yB=yCb-pt*(xB-xCb)-c:vB=Abs(rB*o*#E):If vB>70:vB=70:p:If vB<30:vB=30:p;;;;;;;;;;
uB=-vB*Sin(al)+0.4:vyB=-vB*Cos(al):yA=yba+14-pt*(xA-xba):sB=9:Select w:Case 3,11
w=3:Case 4,12:w=4:EndSelect:j=4:p:p:p:If yA>H:gj:p:If yA<64:n=-yA+64:Else:n=0:p;
If xA>(L-C):uA=-uA:p:p:If v=2:yBp=yB:cl(xB,yB,uB,vyB):If vyB>0:If (xB>=xba+;;;;;
72) And (xB<=xba+a):If (yB+c)>=yba And (yBp+c)<=yba:yB=yCb-pt*(xB-xCb)-18:v=1;;;
rn(rA,(xA+8),(yA+c),xCb,yCb):rn(rB,(xB+8),(yB+c),xCb,yCb):jt=m*(rA*rA+rB*rB)+jba
o=m*((xB+8-xCb)*vyB-(yB+c-yCb)*uB)/jt:yA=yba+pt*(xA+c-xba)-c:vA=Abs(rA*o*#E);;;;
If vA>70:vA=70:p:If vA<30:vA=30:p:uA=vA*Sin(al)+0.4:vyA=-vA*Cos(al):yB=yCb+;;;;;
pt*(xB+c-xCb)-18:sB=8:w=3:Select j:Case 4,12:j=4:Case 3,11:j=4:EndSelect:p:p:p;;
If yB>H:gj:p:If yB<64:n=-yB+64:Else:n=0:p:If xB<0:uB=-uB:p:p:If t()-pq>1000;;;;;
If ct=1:ct=2:p:p:If t()-cg>100:cg=t():g=g+1:If g>7:g=6:p:xg=xg+rx:yg=yg+4;;;;;;;
If yg>H:g=7:xg=160:yg=z(1)*48:rx=4*(-1+z(2)):If rx=0:rx=4:p:p:p:cl(xr,yr,ur,vyr)
If yr>H:Restore dk:For i=0 To z(2):r xr:r yr:Next i:xr=xr*16:yr=yr*16:vyr=6;;;;;
ur=-6+z(12):p:Display#s(10,-a,-240+n):Restore dp:For i=0 To 7:r cn:r ln;;;;;;;;;
If sp(i)<>-1:d#sp(i),16*cn,16*ln+n):p:Next i:d#sB,xba,yba+n):xq=0:If w=11:xq=xA+
12:yq=yA+n:w=3:p:If w=12:xq=xA-12:yq=yA+n:w=4:p:If j=11:xq=xB+12:yq=yB+n:j=3:p;;
If j=12:xq=xB-12:yq=yB+n:j=4:p:If xq<>0:d#5,xq,yq):p:d# 1,xr,yr+n):d# g,xg,yg+n)
d# w,xA,yA+n):d# j,xB,yB+n):FlipBuffers():Until WindowEvent()=13116:DataSection;
dp: :Data.l 6,7,13,7,1,4,1,7,1,10,18,5,18,8,18,11:dk:
Data.l 2,1,17,2,9,-3:EndDataSection;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

Hasta la vista !

[djes]

Last hours to post your code !