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.


Messages - ~Ar-S~

Pages: [1] 2
1
Purebasic / Re: PLATOO! A tiro skeet game (Demo)
« on: April 03, 2018 »
I've uploaded to purebasic official forum and everybody was so scared of an .exe... really piss me off and quit my wishes to coding for purebasic...  probably won't work on it anymore, just wanted to share and read some opinions so thanks again!
That's true..
If you haven't post a lot's of code before, they will be very paranoiac ^^ (do you post it to Annoncement ?)
But don't stop coding in PB for that. It's a good and fun language.
Cya

2
Purebasic / Re: ICS cracktro remakes
« on: April 03, 2018 »
Thanks ! :clap:
With the sources that could be much interresting  ;D

3
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

4
Purebasic / Re: [Retroremake] Amstrad CPC for fun
« on: March 03, 2018 »
Thanks padman. It working with 5.62 x86 (but invalid access mem to the callFunctionFast with x64)  :clap:

5
Purebasic / Re: [Retroremake] Amstrad CPC for fun
« on: February 12, 2018 »
Please add all libs needed in your zip...

6
Purebasic / Re: PLATOO! A tiro skeet game (Demo)
« on: February 12, 2018 »
It works fine. Fun game. A bit of lag with High Dpi Mouse to move the target (as usual in PB fulscreen with  that kind of mouse)..  :clap:

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

8
Purebasic / Re: PB 5.60 beta 2 on the place
« on: February 03, 2017 »
Beta 2 out.
Note that the 5.4x are LTS but 5.50 and more are none LTS so with new functions and with frequently updates.

Quote
who need gif Animation
It's always fun to use but the most important is the ImageFrame() lib. We can easily make an animation by adding frames to a sprite.
It's much easier than before.

9
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


10
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.

11
Purebasic / Re: intros/demos sound Vumeter
« on: August 03, 2016 »
Please Add d3dx9_43.dll to your zip

12
Purebasic / Re: White = transparent
« on: July 20, 2016 »
GuillyGuilly please share your picture.

13
Purebasic / Re: intros/demos sound Vumeter
« on: July 20, 2016 »
here is a pretty good exemple from Dobro to  make a good spectrum with Fmodex Dll.
i use it to make my (pretty good) webradio player.
http://ldvmultimedia.com/telecharger_ars_stream_radio.php

EnJoY

Code: [Select]
;***********************************************
;Titre  :*test_fmodex
;Auteur  : Dobro
;Date  :24/10/2013
;Heure  :17:22:14
;Version Purebasic :  PureBasic 5.20 LTS (Windows - x86)
; Libairies necessaire : Fmodex.pbi
;***********************************************


Enumeration
#window
#image
EndEnumeration


XIncludeFile "E:\MULTIMEDIA\PUREBASIC\5.20\_Fmodex_5_20\fmodex.pbi"


Declare    Oscillo(sound)


; **************** initialisation Sprite des 512 niveaux************
Global Dim Arr.F(512) ; tableau pour les 512 niveaux
If InitSprite() = 0
MessageRequester("Erreur", "Impossible d'ouvrir l'écran & l'environnement nécessaire aux sprites !", 0)
End
EndIf
Structure sprite
x.l
y.l
EndStructure
Global Dim sprite.sprite(512)
; creation de la fenetre d'affichage des niveau

If OpenWindow(#window, pos_x, pos_y, 300, 55, "Pure Radio", #PB_Window_SystemMenu)

If OpenWindowedScreen(WindowID(#window), 4, 4,290,50,0,0,0 )
ClearScreen(RGB($0,$0,$0))
FlipBuffers()

For i=1 To 512 Step 4
CreateSprite(i,2,32):CreateImage(#image,2,32,32)
sprite(i)\x=i
sprite(i)\y=50
StartDrawing ( ImageOutput (#image))
DrawingMode ( #PB_2DDrawing_Gradient )
;
BackColor($0000FF)
GradientColor(0.4, $00FFFF)
GradientColor(0.6, $FFFF00)
FrontColor($FF0000)
LinearGradient(0, 0, 2, 32)

Box(0, 0, 2, 32)
StopDrawing ()

StartDrawing ( SpriteOutput (i))
DrawImage(ImageID(#image),0,0)
StopDrawing()

Next i

EndIf
EndIf
; *******************************************



url$="http://50.7.98.106:8398/"

; ************init ****************************
FMOD_System_Create(@fmodsystem)
FMOD_System_Init(fmodsystem, 32, 0, 0)
; ***************************************


FMOD_System_CreateStream(fmodsystem, @url$, #FMOD_CREATESTREAM, 0, @sound)

FMOD_System_PlaySound(fmodsystem, 0, sound, 0, @channel) ; joue l'url



;str.s = OpenFileRequester("Choose a soundfile", "c:", "*.*|*.*", 0)
If str.s<>"" ; on charge le fichier
;FMOD_System_CreateStream(fmodsystem, @str, #FMOD_SOFTWARE, 0, @sound) ; creer le stream
;FMOD_Sound_GetLength(sound, @longueur, #FMOD_TIMEUNIT_MS) ; recupe la taille du son dans longueur
; FMOD_System_PlaySound(fmodsystem, 0, sound, 0, @channel) ; joue
EndIf

Repeat
Evenement.l= WaitWindowEvent(2)


FMOD_Channel_GetSpectrum(channel, Arr(), 512, 0, 0 ) ; recuperere les 512 niveaux des frequences
Oscillo(sound) ; le graph au centre ecran graphique


Select EventWindow()
;-evenement window


EndSelect

FlipBuffers()
ClearScreen(0)
Until Evenement = #PB_Event_CloseWindow

Procedure Oscillo(sound)
Static compteur.F,compteur2.F
compteur.F=compteur.F+1
compteur2.F=compteur2.F+10
largeur=290 :hauteur=50


If state=0 And play=1
For spr=1 To 512 Step 4
variation=25* Sin(compteur2*#PI/180)
sprite(spr)\x=spr
sprite(spr)\y= variation* Sin(spr*#PI/180)
DisplaySprite(spr,sprite(spr)\x+compteur.F,sprite(spr)\y)
sprite(spr)\y=50 ; remet le sprite en bas
If sprite(spr)\x+compteur.F>512
compteur.F=0
sprite(spr)\x=0
EndIf

Next spr

Else
For spr=1 To 512 Step 4
sprite(spr)\y=sprite(spr)\y-Arr(spr)*32*spr
DisplaySprite(spr,sprite(spr)\x,sprite(spr)\y)
sprite(spr)\y=50 ; remet le sprite en bas
Next spr
EndIf

EndProcedure



14
Purebasic / Re: My first intro!
« on: April 09, 2016 »
 :carrot: Very nice !  :carrot:

15
Purebasic / Re: Lexicos intro source
« on: April 09, 2016 »
 :clap:Nice and proper :)

16
Fun :)
Thanks for sharing. Nice swf trick  :cheers:

17
Purebasic / Re: PB vs The World (15'years PB contest)
« on: December 05, 2015 »
I win this contest  :updance:

18
My bad  :boxer:

19
I missed the vote, but congrats to everyone ! :clap: :clap:
I hope i'll note miss the next contest ^^

20
Space do not launch weapon.. But it's so great to see and listen this great 'n famous game.
You earn my vote  :clap:

Pages: [1] 2