PureBasic Forums - English

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

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

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);;;;;;

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

Code: Select all

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

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

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

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

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

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;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;