PureBasic Forums - English

Code: Select all

;*****************************************************************************
;*
;* Name   : Crazy waves
;* Author : Ollivier
;* Date   : 02/06/09
;* Notes  : Cf http://www.purebasic.fr/french/viewtopic.php?t=9437
;*
;*****************************************************************************
Q=600:Dim SX.F(Q):Dim SY.F(Q):Dim SA.F(Q):Dim SR.F(Q):#Z=4:Dim SV.F(Q)
InitSprite():#N=3:InitMouse():#B=2:ExamineDesktops():DW=DesktopWidth(0)
DH=DesktopHeight(0):OpenScreen(DW,DH,DesktopDepth(0),""):CreateSprite(0,DW,DH)
CreateSprite(1,#Z,#Z):StartDrawing(SpriteOutput(1)):Box(0, 0, #Z, #Z,#White)
StopDrawing():X.F=SX(0):Y.F=SY(0):For CA=0 To Q:SX(CA)=DW/2:SY(CA)=DH/2
SA(CA)=Random(628)/100:SV(CA)=Random(800)/100:Next CA:Repeat:Delay(1)
ExamineMouse():FlipBuffers():DisplaySprite(0,0,0):For I=0 To Q:X=SX(I):Y=SY(I)
DisplaySprite(1,X,Y):DX.F=(4999*X+DW/2)/5000:DY.F=(4999*Y+DH/2)/5000
V.F=Sqr(DX*DX+DY*DY):VS.F=SV(I)*(100/V):SX(I)=DX+(Cos(SA(I))*VS):SR(I)+0.0001
SY(I)=DY-(Sin(SA(I))*VS):SA(I)+Sin(SR(I))*(10/V):Next:Until MouseButton(2)

Code: Select all

;*****************************************************************************
;*
;* Name   : Bump-Mapping 640x480
;* Author : Cpl.Bator
;* Date   : 2/06/2009
;* Notes  : Tested on linux , program quit automatically
;*
;***************************************************************************** 
Macro R:For:EndMacro:Macro T:Next:EndMacro:S=512:W=640:H=480:W2=320:H2=240
Macro N:EndIf:EndMacro:InitSprite():OpenScreen(W,H,32,""):Dim L(S,S):g=64
R y=0 To S:R x=0 To S:Nxl.f=(x-(S/2))/(S/4):Nyl.f=(y-(S/2))/(S/4):Nzl.f:v.f
Nzl=1-Sqr((Nxl*Nxl)+(Nyl*Nyl)):If Nzl<=0:Nzl=0:N:L(x,y)=(200 * NZl):T x:T y
Dim B(1000,1000):R i = 0 To 79:R y= 0 To 63:R x= 0 To 63:C=(x*256/g)!(y*256/g)
B(x+dx,y+dy)=RGB(C,C,C):T:T:dx+g:If dx=W:dx=0:dy+g:N:T:Repeat:ClearScreen(0)
v+0.1:LX.f=W2+160*Cos(v):LY.f=H2+120*Sin(v/2):StartDrawing(ScreenOutput())
R y=1 To 479:R x=1 To 639:NX=(B(x+1,y)-B(x-1,y)):NY=(B(x,y+1)-B(x,y-1))
NLX.f=X-LX:NLY.f=Y-LY:NX=(NX+NLX)+(S/2):NY=(NY+NLY)+(S/2):NX%512:NY%512
C=L(NX,NY)<<8:Plot(x,y,C):T x:T y:StopDrawing():FlipBuffers():Until v>50

Code: Select all

;*****************************************************************************
;*
;* Name   :Punch Shrinker 
;* Author :einander
;* Date   :june 3 - 2009
;* Notes  :Concatenate lines, strip comments and validate Pure Punch files. 
;*         New file named as original + "_S.PB"
;***************************************************************************** 
F.s="Punch Shrinker":OpenWindow(0,0,0,600,400,F,$1CF0000):b.s:#R=Chr(34):T.s
F=OpenFileRequester("Load file","","PB|*.pb|All|*.*",0):SP.s=Chr(32):S2.s=SP+SP
#C=Chr(58):#M=Chr(10):If ReadFile(0,F):While Eof(0)=0:A.s=Trim(ReadString(0))
While FindString(A,S2,1):A=ReplaceString(A,S2,SP):Wend:P=FindString(A,Chr(59),1)
If P:P1=FindString(A,#R,1):If P1=0 Or P<P1 Or P>FindString(A,#R,P1+1)
A=Trim(Left(A,P-1)):EndIf:EndIf:L=Len(A):If L:If L>80 Or n>10
MessageRequester("Stop at "+Str(n),T,0):End:ElseIf Len(b+A)>80:T+b:b=#M+A:n+1
ElseIf A<>#C:If b:b+#C+A:Else:b=A:EndIf:EndIf:EndIf:Wend:CloseFile(0)
If CreateFile(0,F+"_SHRINK.PB"):If b:T+b:EndIf:WriteData(0, @T, Len(T))
MessageRequester("Saved "+F+"_SHRINK.PB-"+Str(n+1)+" Lines",T,0):EndIf:EndIf:End

Code: Select all

;*****************************************************************************
;*
;* Name   : Pure Punch Expander
;* Author : einander
;* Date   : june 3 - 2009
;* Notes  : Complementary for Pure Punch Shrinker
;*          Replace double quotes for Line feeds 
;*
;*****************************************************************************
#C=Chr(58):#L=Chr(10):OpenWindow(0,0,0,600,400,"PB Line Shrinker",$1CF0000)
F.s= OpenFileRequester("Load PB file","","PB|*.pb|All(*.*)|*.*",0)
If ReadFile(0,F):While Eof(0) = 0:A$=Trim(ReadString(0))
P=FindString(A$,Chr(59),1):If P:P1=FindString(A$,Chr(34),1)
If P1=0 Or P<P1 Or P>FindString(A$,Chr(34),P1+1):A$=Trim(Left(A$,P-1)):EndIf
EndIf:L=Len(A$):If L>80 Or n>9:MessageRequester("Stop at "+Str(n+1),T$+B$,0)
End:ElseIf Len(B$+A$)>79:T$+B$:B$=#L+A$:n+1:ElseIf L And A$<>#C:If B$:B$+#C+A$
Else:B$=A$:EndIf:EndIf:Wend:CloseFile(0):If CreateFile(0,F+"_SHRINKED.PB" )
T$+B$:WriteData(0, @T$, Len(T$)):CloseFile(0)
MessageRequester("File OK: Saved "+Str(n+1)+" Lines",T$,0):EndIf:EndIf:End