Only for fun

Post your FreeBASIC tips and tricks here. Please don’t post your code without including an explanation.
D.J.Peters
Posts: 7852
Joined: May 28, 2005 3:28

Only for fun

Postby D.J.Peters » Nov 05, 2006 12:55

http://freespace.virgin.net/hugo.elias/graphics/x_water.htm

Code: Select all

' if defined use BASIC otherwise use 32 or 64-bit assembler
'#define NO_ASSEMBLER

#include once "crt.bi"

Sub CalcIt(Byval pDes As Ubyte Ptr, _
           Byval pSrc As Ubyte Ptr, _
           Byval size  As Integer)
 

#ifndef NO_ASSEMBLER
asm
  #ifndef __FB_64BIT__
    ' 32-bit
    mov edi,[pDes]
    mov esi,[pSrc]
    mov ebx,[size]
    mov eax,ebx
    mul ebx
    mov ecx,eax
    Sub ecx,ebx
    Sub ecx,ebx
    dec ecx
    Xor edx,edx
    Sub edx,ebx
    add edi,ebx
    add esi,ebx
    push ebp
    loopit:
      movzx ax,Byte Ptr [esi-1]
      movzx bp,Byte Ptr [esi+1]
      add ax,bp
      movzx bp,Byte Ptr [esi+edx]
      add ax,bp
      movzx bp,Byte Ptr [esi+ebx]
      add ax,bp
      Shr ax,1
      movzx bp,Byte Ptr [edi]
      Sub ax,bp
      And ah,&HFF
      jz saveit
      Xor al,al
      saveit:
      mov [edi],al
      inc esi
      inc edi
      dec ecx
    jnz loopit
    pop ebp
 
  #else
    ' 64-bit
    mov rdi,[pDes]
    mov rsi,[pSrc]
    mov rbx,[size]
    mov rax,rbx
    mul rbx
    mov rcx,rax
    Sub rcx,rbx
    Sub rcx,rbx
    dec rcx
    Xor rdx,rdx
    Sub rdx,rbx
    add rdi,rbx
    add rsi,rbx
    push rbp
    loopit:
      movzx ax,Byte Ptr [rsi-1]
      movzx bp,Byte Ptr [rsi+1]
      add ax,bp
      movzx bp,Byte Ptr [rsi+rdx]
      add ax,bp
      movzx bp,Byte Ptr [rsi+rbx]
      add ax,bp
      Shr ax,1
      movzx bp,Byte Ptr [rdi]
      Sub ax,bp
      And ah,&HFF
      jz saveit
      Xor al,al
      saveit:
      mov [rdi],al
      inc rsi
      inc rdi
      dec rcx
    jnz loopit
    pop rbp

  #endif
End asm

#else
  ' BASIC
  dim as ubyte ptr pedi=pDes
  dim as ubyte ptr pesi=pSrc
  dim as integer iebx=size
  dim as integer ieax=iebx
  ieax*=iebx
  dim as integer iecx=ieax
  iecx-=iebx
  iecx-=iebx
  iecx-=1
  dim as integer iedx
  iedx-=iebx
  pedi+=iebx
  pesi+=iebx
  dim as ushort ax16,bp16
  while iecx
    ax16=pesi[-1]
    bp16=pesi[ 1]
    ax16+=bp16
    bp16=pesi[iedx]
    ax16+=bp16
    bp16=pesi[iebx]
    ax16+=bp16
    ax16 shr=1
    bp16=*pedi
    ax16-=bp16
    if ax16 and &HFF00 then
      *pedi=0
    else
      *pedi=ax16 and &HFF
    end if
    pesi+=1
    pedi+=1
    iecx-=1
  wend
#endif   

End Sub


#define map_size 512
Dim As Ubyte Ptr pDes=allocate(map_size*map_size)
Dim As Ubyte Ptr pSrc=allocate(map_size*map_size)
dim As Integer mx,my,mb,i,x,y,frames,fps=60
dim as Double tNow,tLast

screenres map_size,map_size,8,2
screenset 1,0

For i=0 To 255
  Palette i,i,i,i
Next


Color 255
windowtitle "[ESC]=quit draw with the mouse"

tLast=Timer()
While Asc(Inkey)<>27
 
  If GetMouse(mx,my,,mb)=0 Andalso mb<>0 Then
    For i=1 To 20
      x=mx+Rnd*10-5
      y=my+Rnd*10-5
      If (x>-1 And x<map_size) And _
         (y>-1 And x<map_size) Then
        pSrc[x+y*map_size]=255
      End If
    Next
  else
    dim as integer index
    x=1+Rnd*(map_size-3)
    y=1+Rnd*(map_size-3)
     
    index=(y-1)*map_size
    pSrc[x-1+index]=255
    pSrc[x  +index]=255
    pSrc[x+1+index]=255
     
    index+=map_size
    pSrc[x-1+index]=255
    pSrc[x  +index]=255
    pSrc[x+1+index]=255
     
    index+=map_size
    pSrc[x-1+index]=255
    pSrc[x  +index]=255
    pSrc[x+1+index]=255
  End If
  CalcIt(pDes,pSrc,map_size)
  ' draw it
  memcpy(screenptr(),pDes,map_size*map_size)
  locate 1,1 : Print "FPS=" & fps & " use the mouse ..."
  flip
 
  frames+=1
  If frames mod 50=0 Then
    tNow=Timer: fps = 60/(tNow-tLast) : tLast=tNow
  End If
 
  Swap pDes,pSrc
  sleep 1
Wend

If pSrc<>0 Then deallocate(pSrc)
If pDes<>0 Then deallocate(pDes)
Last edited by D.J.Peters on Dec 21, 2018 12:47, edited 3 times in total.
jofers
Posts: 1525
Joined: May 27, 2005 17:18
Contact:

Postby jofers » Nov 05, 2006 12:58

Good ol' Hugo Elias :) You should hook up with Rel sometime...
SotSvart
Posts: 262
Joined: May 27, 2005 9:03
Location: Norway
Contact:

Postby SotSvart » Nov 05, 2006 13:07

Impressive =)
ikkejw
Posts: 258
Joined: Jan 15, 2006 15:51
Location: Fryslân, the Netherlands
Contact:

Postby ikkejw » Nov 05, 2006 13:45

Nice effect! Although I think 270fps is a bit too fast... try this:

Code: Select all

  '...
  Swap lpDes,lpSrc
  sleep 15, 1
Wend
'...
D.J.Peters
Posts: 7852
Joined: May 28, 2005 3:28

Postby D.J.Peters » Nov 05, 2006 13:52

ikkejw wrote:Nice effect! Although I think 270fps is a bit too fast... try this:

Code: Select all

  '...
  Swap lpDes,lpSrc
  sleep 15, 1
Wend
'...

Or

Code: Select all

ScreenSync '<------
screenlock:Cls
    DrawIt (lpDes,map_size)
    Print "FPS=" & fps
  screenunlock
Last edited by D.J.Peters on Nov 05, 2006 16:52, edited 1 time in total.
TheBlueKeyboard
Posts: 29
Joined: Oct 23, 2006 8:19

Postby TheBlueKeyboard » Nov 05, 2006 14:32

Very cool! :D
D.J.Peters
Posts: 7852
Joined: May 28, 2005 3:28

Postby D.J.Peters » Nov 05, 2006 18:03

Drag the mouse longer and you get oil on water :-)

Joshy

Code: Select all

sub CalcIt(byval lpDes as ubyte ptr, _
           byval lpSrc as ubyte ptr, _
           byval size  as integer)
  asm
    mov edi,[lpDes]
    mov esi,[lpSrc]
    mov ebx,[size]
    mov eax,ebx
    mul ebx
    mov ecx,eax
    sub ecx,ebx
    sub ecx,ebx
    dec ecx
    xor edx,edx
    sub edx,ebx
    add edi,ebx
    add esi,ebx
    push ebp
    loopit:
      movzx ax,byte ptr [esi-1]
      movzx bp,byte ptr [esi+1]
      add ax,bp
      movzx bp,byte ptr [esi+edx]
      add ax,bp
      movzx bp,byte ptr [esi+ebx]
      add ax,bp
      shr ax,1
      movzx bp,byte ptr [edi]
      sub ax,bp
      and ah,&HFF
      jz setit
      xor al,al
      setit:
      mov [edi],al
      inc esi
      inc edi
      dec ecx
    jnz loopit
    pop ebp
  end asm
end sub

sub DrawIt(byval lpSrc as ubyte ptr, _
           byval Size as integer)
  static as any ptr lpScreen
  dim as integer i
  lpScreen=ScreenPtr
  asm
    mov esi,[lpSrc]
    mov edi,[lpScreen]
    mov ebx,[size]
    mov eax,ebx
    mul ebx
    mov ecx,eax
    dec ecx
    shr ecx,2
    loopit2:
      mov eax,[esi]
      mov [edi],eax
      add esi,4
      add edi,4
      dec ecx
    jnz loopit2
  end asm
end sub

#define map_size 512
dim as ubyte ptr lpDes=allocate(map_size*map_size)
dim as ubyte ptr lpSrc=allocate(map_size*map_size)
static as integer mx,my,mb,i,x,y,frames,fps
static as double  t1,t2,cw,w,cwstep=6.28/256.0,r,g,b
screenres map_size,map_size
for i=1 to 254
  r=sin(cw)*0.5+0.5
  g=cos(cw*1.125)*0.5+0.5
  b=sin(cw*1.333)*0.5+0.5
  palette i,r*255,g*255,b*255
  cw=cw+cwstep
next
palette 255,255,255,255
color 255
windowtitle "[ESC]=quit draw with the mouse"
t1=timer
while asc(inkey)<>27
  GetMouse(mx,my,,mb)
  if mx>-1 and mb<>0 then
    for w=0 to 6.28 step 6.28/20.0
      x=mx+cos(w)*25
      y=my+sin(w)*25
      if (x>-1 and x<map_size) and _
         (y>-1 and y<map_size) then
        lpSrc[x+y*map_size]=254
      end if
    next
  end if
  CalcIt(lpDes,lpSrc,map_size)
  screensync
  screenlock
    DrawIt (lpDes,map_size)
    locate 1,1:print "FPS=" & fps
    for i=1 to 253
      palette get i+1,mx
      palette i,mx
    next
    r=sin(cw)*0.5+0.5
    g=cos(cw*1.125)*0.5+0.5
    b=sin(cw*1.333)*0.5+0.5
    palette 254,r*255,g*255,b*255
    cw=cw+cwstep
  screenunlock
  frames+=1
  if frames=100 then
    t2=timer
    fps=frames/(t2-t1)
    t1=t2
    frames=0
  end if
  Swap lpDes,lpSrc
wend

if lpSrc<>0 then deallocate(lpSrc)
if lpDes<>0 then deallocate(lpDes)
end

Return to “Tips and Tricks”

Who is online

Users browsing this forum: No registered users and 1 guest