Show Posts

This section allows you to view all posts made by this member. Note that you can only see posts made in areas you currently have access to.


Topics - ~Ar-S~

Pages: [1]
1
Here is GHOST N PUMPKIN my small contest game

Some days to make... everything.
The collision tests are a little crappy... That makes the game harder  O0

Coded with PUREBASIC for windows x86 / x64

Windows Only

Press SPACE to START
Press ARROWS to MOVE
Press SPACE to FIRE during game
Press ESCAPE to EXIT

Special thanks to Boby from the french purebasic forum

EnJoY

-----EDIT------

Zip Update.
A have change a small value witch make a few gamer go to game over directly after start the game (i meet 2 people with that prob)

2
Purebasic / Psygnosis Agony MinIntro
« on: March 17, 2018 »
This is a small intro  to pay tribute to PSYGNOSIS and the superb AGONY on AMIGA. The most difficult was to recover and divert the SPRITES.
The archive contains some of the images (sprites and mod are in datasection), the code, the images.

Use Arrows to move the Owl.

EnJoY

3
Purebasic / 2D Metaballs
« on: April 06, 2017 »
Here is a great code From Shadoko (french PB Forum)
Note : Disable Debugger before launching

EnJoY   :cheers:

Code: [Select]
; demo 2d metaballs - pf shadoko -2016

EnableExplicit

Procedure.l ColorBlend(c1.l, c2.l, m.f)
    Protected r.w,g.w,b.w,a.w
    r=  Red(c1) + (Red(c2)     - Red(c1)) * m
    g=Green(c1) + (Green(c2) - Green(c1)) * m
    b= Blue(c1) + (Blue(c2) -   Blue(c1)) * m
    a=Alpha(c1) + (Alpha(c2) - Alpha(c1)) * m
    ProcedureReturn  RGBA(r,g,b,a)
EndProcedure

Procedure.l HSLToRGB(hue, saturation, lightness, alpha=0)
    Protected.f h=hue *6/256
    Protected.f s=saturation/255
    Protected.f l=lightness/255
    Protected.f c,x,r_,v_,b_,m
    c=(1-Abs(2*l-1))*s
    x=c*(1-Abs(Mod(h, 2) -1))
    Select Int(h)
        Case 0:r_=c:v_=x
        Case 1:r_=x:v_=c
        Case 2:v_=c:b_=x
        Case 3:v_=x:b_=c
        Case 4:r_=x:b_=c
        Case 5:r_=c:b_=x
    EndSelect
    m=l-c/2
    Protected r,v,b
    r=Int((r_+m)*255)
    v=Int((v_+m)*255)
    b=Int((b_+m)*255)
    ProcedureReturn RGBA(r,v,b,alpha)
EndProcedure

Procedure.l cola(col,a=$ff)
    ProcedureReturn col|(a<<24)
EndProcedure

Macro copyimagetosprite(im,sp)
    CreateSprite(sp,ImageWidth(im),ImageHeight(im),#PB_Sprite_AlphaBlending)
    StartDrawing(SpriteOutput(sp))
    DrawingMode(#PB_2DDrawing_AllChannels)
    DrawAlphaImage(ImageID(im),0,0)
    StopDrawing()
EndMacro

Procedure min(a,b)
    If a<b:ProcedureReturn a:Else:ProcedureReturn b:EndIf
EndProcedure

Procedure max(a,b)
    If a>b:ProcedureReturn a:Else:ProcedureReturn b:EndIf
EndProcedure

;====================================================================================
Structure sballe
    x.f
    y.f
    dx.f
    dy.f
EndStructure

Global nb=15    ; nombre de balle
Global relief   ; relief (granulosité)
Global dangle.f ; vitesse rotation lumiere
Global di=500   ; largeur image
Global dj=400   ; hauteur image
Global zoom=2   ; zoom
#delais=60*3    ; delais entre changement couleur/relief (en 60eme de seconde)
#delta=64-1     ; largeur balle (+zone d'influence)
#lim=#delta/2

Global Dim b.sballe(nb)
Global Dim reflet.l(255,255)
Global Dim balle.l(#delta*2+1,#delta*2+1)
Global Dim conv.l(32767)
Global Dim angle.w(2047)
Global Dim couleur.l(2)
Global Dim acouleur.l(2)
Global Dim rnd.f(31)

InitSprite()
InitMouse()
InitKeyboard()

Procedure couleurMAJ(v.f)
    Macro lum(x,y,r,nc,a=$ff)
        c=colorblend(acouleur(nc),couleur(nc),v)
        ResetGradientColors()
        GradientColor(0.0,cola(c,a))
        GradientColor(0.2,cola(c,a*0.5))
        GradientColor(1.0,cola(c,0))
        CircularGradient(x,y,r)
        Circle(x,y,r)
    EndMacro
    Static angle.f=1:angle+dangle
    Protected i,r,l,x,y,c,agx.f,agy.f
    StartDrawing(ImageOutput(0))
    DrawingMode(#PB_2DDrawing_AllChannels)
    Box(0,0,256,256,0)
    DrawingMode(#PB_2DDrawing_Gradient|#PB_2DDrawing_AlphaBlend )
    lum(128,128,200,0)
    For i=0 To 15
        agx=angle*rnd(i+0)
        agy=angle*rnd(i+16)
        x=128+80*Sin(agx)
        y=128+80*Sin(agy)
        lum(x,y,40,i % 2+1)
    Next
    CopyMemory(DrawingBuffer(),@ reflet(0,0),256*256*4)
    StopDrawing()
EndProcedure

Procedure initparam()
    Protected i,j
    Protected.f v,d,x,y
    dangle=Random(1)*0.02
    relief=Random(2)*6
    #taille=10:#dmax=#delta/#taille
    For i=0 To #delta*2-1:For j=0 To #delta*2-1
            x=(i-#delta)/#taille
            y=(j-#delta)/#taille
            d=Sqr(1.0+x*x+y*y)
            If d<#dmax:v=0.05*Pow(#dmax*#dmax-d*d,3)+Random(relief):Else:v=0:EndIf
            balle(i,j)=v
    Next:Next
   
    For i=0 To 2:acouleur(i)=couleur(i):couleur(i)=HSLToRGB(Random($ff),$ff,63+128*Bool(i)):Next
       
    For i=0 To ArraySize(conv()):v=200.0*Log(i-1000):If v<0:v=0:EndIf:conv(i)=v:Next
   
    For i=-1024 To 1023:angle(i+1024)=ATan2(1,i/50)*256/#PI+128:Next   
   
EndProcedure

Procedure RenderFrame()
    Static cpt:cpt+1:If cpt=#delais:cpt=0:initparam():EndIf
    Protected Dim bmp.l(dj-1,di-1)
    Protected Dim t.w(di-1,dj-1)
    Protected i,j,k,x,y,t00,rx,ry
    ExamineKeyboard()
    couleurMAJ(cpt/#delais)
    For k=0 To nb
        With b(k)
            \x+\dx:If \x<#lim Or \x>di-#lim:\dx=-\dx:EndIf
            \y+\dy:If \y<#lim Or \y>dj-#lim:\dy=-\dy:EndIf
            For j=max(\y-#delta,0) To min(dj-1,\y+#delta)
                For i=max(\x-#delta,0) To min(di-1,\x+#delta)
                    x=i-\x+#delta
                    y=j-\y+#delta
                    t(i,j)+balle(x,y)
                Next
            Next
        EndWith
    Next
   
    For j=0 To dj-1
        For i=0 To di-1
            t(i,j)=conv(t(i,j))
        Next
    Next
   
    For j=0 To dj-2
        For i=0 To di-2
            t00=t(i,j)
            If t00
                rx=angle(t(i+1,j)-t00+1024)
                ry=angle(t(i,j+1)-t00+1024)
                bmp(j,i)=reflet(ry,rx)
            EndIf
        Next
    Next
    StartDrawing(SpriteOutput(0))
    CopyMemory(@bmp(0,0),DrawingBuffer(),di*dj*4)
    StopDrawing()
   
    DisplaySprite(10,0,0)
    DisplayTransparentSprite(0,0,0)
    If KeyboardReleased(#PB_Key_Escape):End:EndIf
EndProcedure

Procedure init()
    Protected i,j,x,y,r,c
   
    OpenWindow(0,0,0,di* zoom,dj* zoom,"",#PB_Window_BorderLess|#PB_Window_ScreenCentered)
    OpenWindowedScreen(WindowID(0),0,0,di,dj,1,0,0)
    CreateSprite(0,di,dj,#PB_Sprite_AlphaBlending)
    CreateImage(0,256,256,32,#PB_Image_Transparent)
    CreateImage(1,di,dj,32,#PB_Image_Transparent)
   
    ; image de fond
    StartVectorDrawing(ImageVectorOutput(1))
    VectorSourceColor(cola(Random($ffffff)))
    FillVectorOutput()
    For i=0 To di Step 20
        For j=0 To dj Step 20
            x=i+Random(20)
            y=j+Random(20)
            r=5+Random(30)
            c=Random($ffffff)
            VectorSourceCircularGradient(x, y, r)
            VectorSourceGradientColor(cola(c,128),0.0)
            VectorSourceGradientColor(cola(c,64),0.8)
            VectorSourceGradientColor(cola(c,0 ),1.0)     
            AddPathCircle(x,y,r)
            FillPath()
        Next
    Next   
    StopVectorDrawing()
    copyimagetosprite(1,10)
   
    ; position et vitesse initial des balles
    For i=0 To nb:b(i)\x=Random(di-#lim*2,#lim):b(i)\y=Random(dj-#lim*2,#lim):b(i)\dx=(Random(1000)-500)/500:b(i)\dy=(Random(1000)-500)/500:Next
   
    ; coef mouvement des lumieres
    For i=0 To 31:rnd(i)=(Random(2000)-1000)/1000:Next

    initparam()
   
    Repeat:WindowEvent():RenderFrame():FlipBuffers(): ForEver
EndProcedure

init()

4
Purebasic / PB 5.60 beta 8 on the place
« on: January 28, 2017 »
Heyheyhey,
PB 5.60 beta 2 is out..
Lot's of interresting news !

Quote
- Added: GIF decoder support
- Added: SetImageFrame(), GetImageFrame(), ImageFrameCount(), AddImageFrame(), RemoveImageFrame()
- Added: UserAgent support to ReceiveHTTPMemory(), ReceiveHTTPFile() and GetHTTPHeaders()
- Added: #PB_Http_NoRedirect support for GetHTTPHeaders()
- Added: "Joe Doe <joe.doe@domain.com>" email format support for SendMail()
- Added: HTTPProxy() for Http related commands proxy support
- Added: Compression level support for CreatePack() and CompressMemory()
- Added: Large icons and text support to ToolBar library
- Added: GetUserDirectory() to get user specific directories
- Added: more flexibility to Base64Decoder to handle non padded input
- Added: Base64Encoder() and Base64Decoder() which takes string as input/output for easier use
- Added: color constants like #Black, #Blue etc. for all OS
- Added: Event() to get the current event (mainly useful from callback)
- Added: #PB_Canvas_Container support to have a container behaviour for canvas
- Added: #PB_EventType_Resize support for PanelGadget(), ContainerGadget(), CanvasGadget() and ScrollAreaGadget()
- Added: #PB_ListIcon_ColumnCount to GetGadgetAttribute() for ListIconGadget() to get the column count
- Added: #PB_All support to RemoveGadgetColumn() to remove all the columns
- Added: (IDE) templates are now saved when created to prevent lost if the IDE is not properly closed
- Added: (IDE) jump to a procedure now automatically unfold it if it was folded
- Added: (IDE) new specific popup menu for file tab to ease source file management
- Added: (IDE) find previous (reverse find)

- Changed: ToolBar, Menu and StatusBar are now excluded from inner window area for all OS
- Changed: MenuHeight(), StatusBarHeight() and ToolBarHeight() are now deprecated (all returns 0)
- Changed: renamed Base64Encoder() to Base64EncoderBuffer()
- Changed: renamed Base64Decoder() to Base64DecoderBuffer()
- Changed: removed 'define.b' syntax to change default type as it could create hard to find bugs.

Here is an exemple to use GIF picture with "Frame" included lib

EnJoY  :||

Code: [Select]
; Ar-S // PB 5.60 beta1
; Gif viewer and animate with frame

Enumeration
  #WIN
  #GAD_IMAGE
  #T
  #IMAGEGIF
EndEnumeration

UseGIFImageDecoder()

Declare CatchImage_Net(Adr$)
Declare Count()
Declare ChangeFrame()
Declare exit()

Global Nbrframe

;LoadImage(#IMAGEGIF,"VOTREFICHIERGIF")
; OU BIEN
InitNetwork()
adr$ = "http://share.ldvmultimedia.com/boules.gif"
Image=CatchImage_Net(adr$)  ;Modifie cela par le chemin de ton image

If Image <> 0
  NbrFrame = ImageFrameCount(#IMAGEGIF)
Else
  Debug "erreur de chargement de l'image"
  End
EndIf

Procedure CatchImage_Net(Adr$)
  InitNetwork()
  Protected image
  ; By Ar-S
  *Buffer = ReceiveHTTPMemory(Adr$)
  If *Buffer
    Image = CatchImage(#IMAGEGIF, *Buffer, MemorySize(*Buffer) )
    FreeMemory(*Buffer)
    ProcedureReturn Image
  Else
    ProcedureReturn #False   
  EndIf
EndProcedure
;;; End OR


Procedure Count()
  ProcedureReturn NbrFrame
EndProcedure


Procedure ChangeFrame()
  Static Frame
  Frame + 1
  If Frame = NbrFrame
    Frame = 0
  EndIf
  Debug "Frame : " + Frame
  ; Affichage
  SetImageFrame(#IMAGEGIF, Frame)
  SetGadgetState(#GAD_IMAGE, ImageID(#IMAGEGIF))
EndProcedure


Procedure exit()
  End
EndProcedure




If OpenWindow(#WIN, 0, 0, 150, 113, "Gif...", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
 
  ImageGadget(#GAD_IMAGE,0,0,150,113,ImageID(#IMAGEGIF))
  AddWindowTimer(#WIN,3,80)
 
  BindEvent(#PB_Event_CloseWindow, @exit())
  BindEvent(#PB_Event_Timer, @ChangeFrame())
 
  Repeat : WaitWindowEvent() : ForEver
 
EndIf


5
Purebasic / [DEMO] Tiny OldSchool Demo N1
« on: October 28, 2016 »
Hello,

Here is my first PB demo.
I use to want remebering some Amiga good times :)
It's a 1min demo witch using some effects i found in DBF and others Forums
I made music with  "Rytmik Ultimate"

Compiled with PB 5.50 x86
in the 7zp CODE + DATAS + EXE

I hope you will enjoy.

6
Purebasic / PURE BASIC 5.40 LTS is out
« on: October 16, 2015 »
This is a LTS version (Long Term Support), which will be supported for bug fixes for 2 years, until october 2017. The previous LTS (5.24) is now deprecated and won't receive any new fixes.

Here is the final list of changes:
Quote
- Added: new Vector 2D library
- Added: new CGI library with standard and FastCGI support
- Added: Literal string escape support with the '~' operator (ex: a$ = ~"Hello\nWorld\n")
- Added: EscapeString()/UnescapeString() function to allow escaping operation on any strings (variables etc.)
- Added: EnumerationBinary to create bitmask enumeration automatically
- Added: database parameter binding to ease request construction
- Added: SetDatabaseBlob(), SetDatabaseFloat(), SetDatabaseDouble(), SetDatabaseLong()
- Added: SetDatabaseQuad(), SetDatabaseString(), SetDatabaseNull()
- Added: SHA2 and SHA3 (224/256/384/512-bit) support to Cipher library
- Added: StringFingerprint()
- Added: CRC32 support for StartFingerprint()
- Added: ReceiveHTTPMemory(), IsJoint()
- Added: RefreshDialog() to recalc dimension after a text change or similar
- Added: "group" XML attribute for 'option' dialog gadget, to specify explicitly a group
- Added: HTTPS and simple auth support for ReceiveHTTPFile() and GetHTTPHeaders()
- Added: Auto redirect support for ReceiveHTTPFile() and ReceiveHTTPMemory()
- Added: ASynchronous mode for ReceiveHTTPFile() and ReceiveHTTPMemory()
- Added: HTTPProgress(), AbortHTTP() and FinishHTTP() to control async mode
- Added: HTTPS/TLS support for SendMail()
- Added: FlushPreferenceBuffers()
- Added: CopyDebugOutput() to copy the debug output to the clipboard from code
- Added: 7z archive creation
- Added: tar (gz and bzip2) archive support for creation and decompression
- Added: Full path in IDE recent files menu
- Added: #PB_ProgressBar_Unknown for SetGadgetState() to indicate unknown progress
- Added: #PB_UTF8/Ascii/Unicode support to ReadCharacter() and WriteCharacter()
- Added: #PB_UTF8 support to URLEncoder() and URLDecoder (now the default mode)
- Added: Windows 8.1/10 and OS X 10.9/10/11 support to OSVersion()
- Added: #PB_Editor_xxx constants when using the 'Version' info on Windows
- Added: #PB_Program_Ascii/Unicode/UTF8 support to RunProgram()
- Added: linux/osx style flags for the commandline compiler on Windows to ease cross-platform scripts
- Added: #PB_File_SharedWrite support to ReadFile() and CreateFile()
- Added: 'IMPORTLIST' compiler interface to get all the predefined API functions
- Added: #Null$ special string constant to affect a real null value to a string (to free it completely). It can be used as well for API function which sometimes accept NULL instead of a string address.
- Added: #Empty$ constant
- Added: #PB_ByteLength support to MemoryStringLength()
- Added: #PB_Ascii, #PB_UTF8 and #PB_Unicode support to Create/Open/ReadFile() to set the default write/read mode
- Added: #PB_ByteLength flag for PeekS() and #PB_UTF8 (only)
- Added: CreateCone(), CameraCustomParameter(), ResizeCamera()
- Added: #PB_Entity_DisableContactResponse and #PB_Entity_EnableContactResponse for SetEntityAttribute()
- Added: #PB_Entity_ConeBody, #PB_Entity_PlaneBody
- Added: FreeEntityBody(), FreeTerrainBody()
- Added: ApplyEntityTorque(), ApplyEntityTorqueImpulse()
- Added: Added 'CollisionGroup' and 'CollisionMask' parameter for RayCollide()
- Added: Migration help page, to have a step by step migration guide between old on new PureBasic.
- Added: User guide in german (thanks to Andre and Vera)

- Updated: the Linux printer lib to use native GtkPrint instead of GnomePrint
- Updated: the Windows compiler to VC++ 2013 for better code generation
- Updated: SQLite to 3.8.10.2

- Fixed: Zip archive support
- Fixed: send mail and http request issues
- Fixed: 'CONSTANTLIST' compiler interface, now string constants are returned as escaped strings.

- Changed: The default GTK version is now GTK3 on Linux. A gtk2 subsystem has been added for backward compatibility.
- Changed: The default string format for RunProgram() read/writestring is not UTF8 instead of Unicode
- Changed: the Cipher lib to be modular (now UseMD5Fingerprint() and such commands needs to be used)
- Changed: ExamineFingerprint() to StartFingerprint()
- Changed: NextFingerprint() to AddFingerprintBuffer()
- Changed: EntityPhysicBody() to CreateEntityBody()
- Changed: TerrainPhysicBody() to CreateTerrainBody()
- Changed: the SendMail() 'Asynchronous' parameter has been replaced by the #PB_Mail_Asynchronous flag.
- Changed: DLLImporter has been removed and .pbl files are no more supported. New 'import library' files can be created using the '/IMPORT' switch of the pbcompiler.

- Removed: RemovePackFile()
- Removed: #PB_Packer_CompressedSize support for ZIP and 7z archives with PackerEntrySize()
- Removed: AvailableScreenMemory()

EnJoY

http://www.purebasic.com/download.php

7
Purebasic / PB vs The World (15'years PB contest)
« on: October 15, 2015 »
PB vs THE WORLD

I make this code because there is a (fun) contest to celebrate the 15th birthday of PB http://www.purebasic.fr/english/viewtopic.php?f=14&t=63307#p471729


Style : shoot em up
- I used Musik Maker jam to make the music and soundforge for the samples
- i also used a sprite from http://millionthvector.blogspot.fr (free sprites) for the ship (not the shield) andn the planet
- I used the old rules 80x80 with my code :)
- Try with succes on Windows and MacOS

EnJoY

Datas :http://pb.ldvmultimedia.com/PB_vs_THE_WORLD_by_Ar-S.zip

Code: [Select]
    ;*****************************************************************************
    ;*
    ;* Birthday Punch : PureBasic 15 years of happiness
    ;* PureBasic 5.31 x86
    ;* 192 lines of 80 chars of code or data as you want
    ;*
    ;* Name     : PB vs THE WORLD
    ;* Author   : Ar-S - Music made with Music Maker Jam - thanks to Microdevweb for shoot linkedlist() helping
    ;* Date     : Nov/Oct 2015
    ;* Notes    : Dedicated To my mom Apr 1940 - Sept 2015
    ;*
    MessageRequester("Info","Use Arrows to move, space to shoot and left ctrl to use shield"+Chr(10)+"Left Mouse Button to restart"+Chr(10)+Chr(10)+"Fleches pour se diriger, ctrl : bouclier, Espace:Feu, Bouton de gauche souris pour recommencer",#PB_MessageRequester_Ok) ; LIGNE NON PRIS EN COMPTE
         
    UseOGGSoundDecoder():Macro m:Macro:EndMacro:m dec:decoder():EndMacro
    m e:examine:EndMacro:m s(n,l,h,x,y):EndMacro:m _s:Structure:EndMacro
    InitSprite():InitKeyboard():InitMouse():UseOGGSound#dec:UsePNGImage#dec
    InitSound()
    _S BB:x.i:y.i:ID.b:End#_S:_S SP:x.i:y.i:n.i:LL.i:HH.i:v.b:r.f:End#_S
    _S St:x.i:y.i:v.b:n.b:End#_S:_S SN:D.i:F.i:End#_S:M R:random:EndMacro:M P(S)
    PlaySound(S,#PB_Sound_MultiChannel,70):EndMacro:M PP(S):PlaySound(S,1,80)
    EndMacro:m _k(k):KeyboardPushed(k):EndMacro
    M CS(n,x,y,l,h):ClipSprite(n,x,y,l,h):sp(n)\LL=l/2
    sp(n)\HH=h/2:ZoomSprite(n,l/2,h/2):v(n):EndMacro:m v(n):sp(n)\v = R(6,2)
    EndMacro:m SX(n):sp(n)\x:EndMacro:m SY(n):sp(n)\y:EndMacro:M Redo(n)
    SX(n)=820:SY(n)=R(500,100):v(n):EndMacro:m EX(n):St(n)\x:EndMacro
    m EY(n):St(n)\y:EndMacro:m EN(Z):St(Z)\n:EndMacro:m EV(n):St(n)\v
    EndMacro:m _r(n,d):SpriteQuality(1):RotateSprite(n,d,#PB_Absolute):EndMacro
    Global NewList BB.BB():Global F=LoadFont(16, "Arial", R(80,50))
    Global F1=LoadFont(17, "Arial", 24):Global.b feu,NF,ENNEMI,VIZ,ShotOn.b=#True
    Global.i x,y,xi,T:Global SCORE,LIFE:Global Dim sp.SP(16):Global Dim st.st(100)
    Global TimeElapset=ElapsedMilliseconds()
    LoadSound(20,"01.ogg"):LoadSound(21,"02.ogg"):LoadSound(22,"03.ogg")
    LoadSound(23,"04.ogg"):SCORE=0:LIFe=3:x=150:y=350:NF=9:xi=2500
    t1$="PURE BASIC VS THE WORLD !":t2$="HAPPY PURE BIRTHDAY"
    For i=0 To 100:EX(i)=R(820):EY(i)=R(600):Next:For i=0 To 20:EN(i)=13:EV(i)=3
    Next:For i=21 To 60:EN(i)=14:EV(i)=6:Next:For i=61 To 100:EN(i)=15:EV(i)=10
    Next:OpenScreen(800,600,32,"PB VS The WORLD", #PB_Screen_SmartSynchronization)
    LoadSprite(0,"im.png",8|4):For i=1 To 15:CopySprite(0,i,8|4):Next
    CS(1,7,142,232,133):CS(2,289,135,234,139):CS(3,0,1,129,128):CS(4,129,1,128,128)
    CS(5,257,0,118,130):CS(6,379,0,101,131):CS(7,478,1,115,130):CS(8,595,8,250,126)
    CS(9,533,213,53,62):ClipSprite(10,675,138,140,136):CS(11,606,231,25,43)
    CS(12,631,231,25,43):CS(13,840,266,8,8):CS(14,833,270,6,5):CS(15,824,271,3,3)
    FreeSprite(0)
    txt.s=t1$:xtx=r(500,100):ColT=RGB(R(255),R(255),R(255)):sx(10)=1500
    sy(10)=r(460,140):PS=1:Repeat:StartTime.i=ElapsedMilliseconds():ClearScreen(0)
    E#Mouse():E#Keyboard():If ElapsedMilliseconds()-TimeElapset>=350:ShotOn=#True
    TimeElapset=ElapsedMilliseconds():EndIf:If GO=0:If PS=1:PP(23):ps+1:EndIf
    For i=0 To 100:DisplayTransparentSprite(R(15,13), EX(i), EY(i),255):EX(i)-EV(i)
    If EX(i)<0:EX(i)=805:ey(i)=R(600):EndIf:Next
    DisplayTransparentSprite(10,SX(10),SY(10),255):StartDrawing(ScreenOutput())
    DrawingFont(f):DrawingMode(#PB_2DDrawing_Transparent):If xi< -2500:NT+1:If NT<2
    txt.s=t1$:ElseIf NT=2:txt.s=t2$:Else:NT=0:EndIf:xi=2500:xtx=r(500,100)
    ColT=RGB(R(255),R(255),R(255)):EndIf:DrawText(xi,xtx,txt.s,ColT,$0)
    StopDrawing():Xi-6:sx(2)=sx(1):sy(2)=sy(1):For S=3 To 8
    DisplayTransparentSprite(S, SX(S), SY(S),255):Next:If _K(#PB_Key_Up):y-5:ViZ=1
    If _K(#PB_Key_Left):x-5:ViZ=0:ElseIf _K(#PB_Key_Right):X+5:ViZ=1:EndIf
    ElseIf _K(#PB_Key_Down):y+5:ViZ=1:If _K(#PB_Key_Left):x-5:ViZ=0
    ElseIf _K(#PB_Key_Right):X+5:ViZ=1:EndIf:ElseIf _K(#PB_Key_Left):x-5:VIZ=0
    ElseIf _K(#PB_Key_Right):SX(1)=x:x+5:ViZ=1:EndIf:If y<25:y=25:ElseIf y>530
    y=530:EndIf:If x<0:x=0:ElseIf x>700:x=700:EndIf:SX(1)=x:Sy(1)=y:Sx(11)=x-10
    Sy(11)=y+23:Sx(12)=Sx(11):Sy(12)=Sy(11):If _k(#PB_Key_Space) And ShotOn
    AddElement(BB()):BB()\X=SX(1)+120:BB()\Y=SY(1)+15:BB()\ID=9:ShotOn=#False:P(20)
    EndIf:If _K(#PB_Key_LeftControl):shield=1:P(22):Else:shield=0:EndIf
    If shield=0:ship=1:Else:ship=2:EndIf:DisplayTransparentSprite(ship,x,y,255)
    RE=R(12,11):DisplayTransparentSprite(RE,sx(RE),Sy(RE),200):ForEach BB()
    BB()\X + 6:DisplayTransparentSprite(BB()\ID, BB()\X, BB()\Y,255):Next     
    For ENNEMI=3 To 8:ForEach BB()
    If SpriteCollision(9,BB()\X,BB()\Y,ENNEMI,sx(ENNEMI),sy(ENNEMI))<>0
    T=ENNEMI:SCORE+1:redo(ENNEMI):If ListSize(BB())>0:DeleteElement (BB()):EndIf
    P(21):EndIf:Next:Next:If ListSize(BB())>0 And BB()\X>810:DeleteElement (BB())
    EndIf:For i=3 To 8:SX(i)-sp(i)\v:SpriteQuality(1)
    RotateSprite(i, ROT.f,#PB_Absolute):ROT.f-0.5:If SX(i)< -100:redo(i):EndIf
    Next:For COL=3 To 8:If SpriteCollision(1,sx(1),sy(1),COL,sx(col),sy(col))<>0
    If shield=1:score-1:If Score<=0:Score=0:EndIf:ElseIf shield=0:life-1:If Life<=0
    GO=1:EndIf:EndIf:P(21):redo(col):EndIf:Next:StartDrawing(ScreenOutput())
    DrawText(0,0,"SCORE : "+Str(SCORE),$0000FF,$0)
    DrawText(150,0,"LIFE : "+Str(LIFE),$0000FF,$0)
    DrawText(650, 0, "ESCAPE to EXIT",$ffffff, $0):StopDrawing():SX(10)-1
    If sx(10) < -160:sx(10)=1500:sy(10)=r(460,140):EndIf:ElseIf GO=1:StopSound(23)
    PS=0:StartDrawing(ScreenOutput()):DrawingFont(f):TG$="GAME OVER"
    DrawText( R(400,398)-TextWidth(TG$)/2,R(280,278),tg$,$FFFFFF,$0)
    DrawingFont(f1)
    DrawText(R(250,248),R(510,508),"Press LMB to restart",$FFFFFF,$0)
    DrawText(R(290,288),R(120,118),"SCORE : "+Str(score),$FFFFFF,$0):StopDrawing()
    If MouseButton(#PB_MouseButton_Left):score=0:Life=3:x=5:sx(1)=x:PS=1:GO=0
    EndIf:EndIf:FlipBuffers():deltatime=(ElapsedMilliseconds()-StartTime)/1000
    Until KeyboardPushed(#PB_Key_Escape)

Unpunched Code :
Code: [Select]
;*****************************************************************************
;*
;* Birthday Punch : PureBasic 15 years of happiness
;* PureBasic 5.31 x86
;* 192 lines of 80 chars of code or data as you want
;*
;* Name     : PB vs THE WORLD
;* Author   : Ar-S - Music made with Music Maker Jam
;* Date     : Nov/Oct 2015
;* Notes    : Dedicated To my mom Apr 1940 - Sept 2015
;*
MessageRequester("Info","Use Arrows to move, space to shoot and left ctrl to use shield"+Chr(10)+"Left Mouse Button to restart"+Chr(10)+Chr(10)+"Fleches pour se diriger, ctrl : bouclier, Espace:Feu, Bouton de gauche souris pour recommencer",#PB_MessageRequester_Ok) ; LIGNE NON PRIS EN COMPTE
     
UseOGGSoundDecoder()

Macro m:Macro:EndMacro
m dec:decoder():EndMacro
m e:examine:EndMacro
m s(n,l,h,x,y):EndMacro
m _s:Structure:EndMacro


InitSprite():InitKeyboard():InitMouse():UseOGGSound#dec:UsePNGImage#dec
InitSound()

_S BB
x.i
y.i
ID.b
End#_S

_S SP
x.i
y.i
n.i
LL.i
HH.i
v.b
r.f
End#_S

_S St
x.i
y.i
v.b
n.b
End#_S

_S SN
D.i
F.i
End#_S

M R:random:EndMacro

M P(S)
PlaySound(S,#PB_Sound_MultiChannel,70)
EndMacro

M PP(S)
PlaySound(S,#PB_Sound_Loop,80)
EndMacro

m _k(k)
KeyboardPushed(k)
EndMacro

M G(z):Global.Z:EndMacro

M CS(n,x,y,l,h)
ClipSprite(n,x,y,l,h)
sp(n)\LL=l/2
sp(n)\HH=h/2
ZoomSprite(n,l/2,h/2)
v(n)
EndMacro

m v(n)
sp(n)\v = R(6,2)
EndMacro

m SX(n)
sp(n)\x
EndMacro

m SY(n)
sp(n)\y
EndMacro

M Redo(n)
SX(n)=820
SY(n) = R(500,100)
v(n)
EndMacro

m EX(n)
St(n)\x
EndMacro

m EY(n)
St(n)\y
EndMacro

m EN(Z)
St(Z)\n
EndMacro

m EV(n)
St(n)\v
EndMacro

m _r(n,d)
SpriteQuality(1)
RotateSprite(n,d,#PB_Absolute)
EndMacro

Global NewList BB.BB()
Global F=LoadFont(16, "Arial", R(80,50))
Global F1=LoadFont(17, "Arial", 24)

Global.b feu,NF,ENNEMI,VIZ,ShotOn.b=#True
Global.i x,y,xi,T
Global SCORE,LIFE
Global Dim sp.SP(16)
Global Dim st.st(100)
Global TimeElapset=ElapsedMilliseconds()

LoadSound(20,"01.ogg") ; laser
LoadSound(21,"02.ogg") ; impact
LoadSound(22,"03.ogg") ; shield
LoadSound(23,"04.ogg") ; shield

SCORE = 0
LIFe = 3
x= 150
y = 350
NF = 9 ; numero du sprite PB en cours
xi = 2500

t1$ = "PURE BASIC VS THE WORLD !"
t2$ = "HAPPY PURE BIRTHDAY"



; Positionnement des étoiles dans tableau
For i   = 0 To 100
  EX(i) = R(820)
  EY(i) = R(600)
Next

For i = 0 To 20
  EN(i) = 13
  EV(i) = 3
Next


For i = 21 To 60
  EN(i) = 14
  EV(i) = 6
Next

For i = 61 To 100
  EN(i) = 15
  EV(i) = 10
Next



OpenScreen(800,600,32,"", #PB_Screen_SmartSynchronization)
LoadSprite(0,"im.png",8|4)

For i = 1 To 15
  CopySprite(0,i,8|4)
Next


CS(1,7,142,232,133) ; ship D
CS(2,289,135,234,139) ; SHIELD


CS(3,0,1,129,128) ; Logo PYTHON
CS(4,129,1,128,128) ; Logo RUBY
CS(5,257,0,118,130) ; Logo C#
CS(6,379,0,101,131) ; Logo JAVA
CS(7,478,1,115,130) ; Logo JavaScript
CS(8,595,8,250,126) ; Logo VB
CS(9,533,213,53,62) ; PB LOGO
ClipSprite(10,675,138,140,136) ; PLanete
CS(11,606,231,25,43)           ; Big reac
CS(12,631,231,25,43)           ; Smal reac

CS(13,840,266,8,8) ; big etoile
CS(14,833,270,6,5) ; med etoile
CS(15,824,271,3,3) ; sm etoile

FreeSprite(0)

txt.s = t1$
xtx = r(500,100)
ColT = RGB(R(255),R(255),R(255))
sx(10) = 1500
sy(10) = r(460,140)



PS = 1

Repeat
 
  ; Chrono
  StartTime.i = ElapsedMilliseconds()
 
  ClearScreen(0)
  E#Mouse()
  E#Keyboard()
 
  ; TEMPORISATION DES TIRS --------------
  If ElapsedMilliseconds()-TimeElapset>=350
    ShotOn=#True
    TimeElapset=ElapsedMilliseconds()
  EndIf
  ; -------------------------------------
 
 
  If GO = 0
    If PS = 1
      PP(23)
      ps+1
    EndIf
   
    For i = 0 To 100
      DisplayTransparentSprite(Random(15,13), EX(i), EY(i),255)
      EX(i) - EV(i)
     
      If EX(i) < 0
        EX(i) = 805 : ey(i) = R(600)
      EndIf
    Next
   
    DisplayTransparentSprite(10, SX(10), SY(10),255)  ; Planete
   
    ; GESTION DU SCROLL TEXT
    StartDrawing(ScreenOutput())
   
    DrawingFont(f)
    DrawingMode(#PB_2DDrawing_Transparent )
   
    If xi < -2500
      NT+1
     
      If NT<2
        txt.s = t1$
      ElseIf NT = 2
        txt.s = t2$
      Else
        NT=0
      EndIf
     
      xi = 2500
      xtx = r(500,100)
      ColT = RGB(R(255),R(255),R(255))
    EndIf
   
    DrawText(xi, xtx,txt.s ,ColT, $0)
   
    StopDrawing()
    ; ////
   
   
    Xi-6
   
   
    ; Position Vaisseau et Vaisseau shield
    sx(2) = sx(1)
    sy(2) = sy(1)
   
    ; Affichage des logos ennemis
    For S = 3 To 8
      DisplayTransparentSprite(S, SX(S), SY(S),255)
    Next
   
   
    ;-----------------------------------------
   
    ; DIRECTION VAISSEAU avec diagonales
   
    ;-----------------------------------------
   
    If _K(#PB_Key_Up)
      y-5
      ViZ = 1
     
      If _K(#PB_Key_Left)
        x-5
        ViZ = 0
      ElseIf _K(#PB_Key_Right)
        X+5
        ViZ = 1
      EndIf
     
     
    ElseIf _K(#PB_Key_Down)
      y+5
      ViZ = 1
      If _K(#PB_Key_Left)
        x-5
        ViZ = 0
      ElseIf _K(#PB_Key_Right)
        X+5
        ViZ = 1
      EndIf
     
     
    ElseIf _K(#PB_Key_Left)
      x-5
      VIZ = 0
     
    ElseIf _K(#PB_Key_Right)
      SX(1)=x
      x+5
      ViZ = 1
    EndIf
   
    If y < 25
      y=25
    ElseIf y > 530
      y = 530
    EndIf
    If x < 0
      x = 0
    ElseIf x > 700
      x = 700
    EndIf
   
    ; Vaisseau
    SX(1)=x
    Sy(1)=y
    ; Reacteurs
    Sx(11)=x-10
    Sy(11)=y+23
    Sx(12)=Sx(11)
    Sy(12)=Sy(11)
   
    ;-----------------------------------------
   
    ;-----------------------------------------
    ; TIRS si ESPACE
    ;-----------------------------------------

    If _k(#PB_Key_Space) And ShotOn
     
      AddElement(BB())
      BB()\X=SX(1)+120
      BB()\Y=SY(1)+15
      BB()\ID = 9 ; logo PBbullet
      Debug "NbrBalle : " + ListSize(BB())
      ShotOn=#False
     
      ;feu = 2
      P(20)
    EndIf
   
    ;-----------------------------------------
    ; BOUCLIER si CTRL
    ;-----------------------------------------
   
    If _K(#PB_Key_LeftControl)
      shield = 1
      P(22)
    Else
      shield = 0
    EndIf
   
    If shield = 0
      ship = 1
    Else
      ship = 2
    EndIf
   
    ;-----------------------------------------
    ; AFFICHAGE
    ;-----------------------------------------
    ; Sprite vaiseau + reacteurs
    DisplayTransparentSprite(ship, x, y, 255)
    RE = R(12,11)
    DisplayTransparentSprite(RE, sx(RE), Sy(RE),200)
   
    ; Tirs logos PB et Collisions
    ;     If feu = 2
    ForEach BB()
      BB()\X + 6
      DisplayTransparentSprite(BB()\ID, BB()\X, BB()\Y,255)
    Next     
    ; TESTS DES COLLISIONS AVEC LOGO PB
    For ENNEMI = 3 To 8
      ForEach BB()       
        If SpriteCollision(9, BB()\X, BB()\Y, ENNEMI, sx(ENNEMI), sy(ENNEMI) ) <> 0
          T = ENNEMI
          SCORE+1
          redo(ENNEMI)
          If ListSize(BB()) > 0
            DeleteElement (BB())
          EndIf
          ;           feu = 0
          P(21)
        EndIf
      Next
    Next
   
   
    If ListSize(BB()) > 0 And BB()\X > 810
      DeleteElement (BB()) ;sx(9) = x+130
    EndIf
   
   
   
   
    ;     EndIf
   
   
    ; DEFILEMENT DES ENNEMIS
    For i = 3 To 8
      SX(i) - sp(i)\v
      SpriteQuality(1)
      RotateSprite(i, ROT.f,#PB_Absolute)
      ROT.f-0.5
      If SX(i)< -100
        redo(i)
      EndIf
    Next
   
    ; TESTS DES COLLISIONS AVEC ship
    For COL = 3 To 8
      If SpriteCollision(1, sx(1), sy(1), COL, sx(col), sy(col) ) <> 0
        If shield = 1
          score-1
          If Score <= 0
            Score = 0
          EndIf
         
        ElseIf shield = 0
          life-1
          If Life <= 0
            GO = 1
          EndIf
        EndIf
        P(21)
        redo(col)
       
      EndIf
    Next
   
   
   
   
   
   
   
    ;Affichage  texte
    StartDrawing(ScreenOutput())
    DrawText(0, 0, "SCORE : " + Str(SCORE),$0000FF, $0)
    DrawText(150, 0, "LIFE : " + Str(LIFE),$0000FF, $0)
    DrawText(650, 0, "ESCAPE to EXIT",$ffffff, $0)
   
    StopDrawing()
   
    SX(10) -1
    If sx(10) < -160
      sx(10) = 1500
      sy(10) = r(460,140)
    EndIf
   
   
   
  ElseIf GO = 1 ; Si GAME OVER
   
    StopSound(23)
    PS = 0
    ;Affichage Texte
    StartDrawing(ScreenOutput())
    DrawingFont(f)
    TG$ = "GAME OVER "
    DrawText( R(400,398) - TextWidth(TG$)/2 , R(280,278), tg$, $FFFFFF, $0)
    DrawingFont(f1)
    DrawText(R(250,248), R(510,508), "Press LMB to restart", $FFFFFF, $0)
    DrawText(R(290,288), R(120,118), "SCORE : "+Str(score), $FFFFFF, $0)
    StopDrawing()
   
    If MouseButton(#PB_MouseButton_Left)
      score = 0
      Life = 3
      x = 5 : sx(1) = x
      PS = 1
      GO=0
     
    EndIf
   
  EndIf
 
  FlipBuffers()
 
  deltatime = (ElapsedMilliseconds() - StartTime) / 1000
 
 
Until KeyboardPushed(#PB_Key_Escape)

Pages: [1]