Only for fun

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

Only for fun

Post by D.J.Peters »

Original link is dead but here are a copy: x_water.htm on web.archive.org

Code: Select all

' if NO_ASSEMBLER are defined use BASIC otherwise use x86 or x86_64 assembler

#define NO_ASSEMBLER

#include once "crt.bi"

' !!! no inline assembler on ARM devices !!!
#ifndef NO_ASSEMBLER 
 #ifdef __FB_ARM__
  #define NO_ASSEMBLER
 #endif 
#endif 

Sub CalcIt(Byval pDes As ubyte ptr, _
           Byval pSrc As ubyte ptr, _
           Byval size As integer)
 
#ifndef NO_ASSEMBLER
asm
  #ifndef __FB_64BIT__
    ' X86_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
    ' X86_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 ' power of 2
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
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 Andalso x<map_size) Andalso _
         (y>-1 Andalso y<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
  screenlock
  memcpy(screenptr(),pDes,map_size*map_size)
  locate 1,1 : Print "FPS=" & fps & " use the mouse ..."
  screenunlock
 
  frames += 1
  If frames mod 60=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 14, 2021 14:39, edited 6 times in total.
jofers
Posts: 1525
Joined: May 27, 2005 17:18

Post by jofers »

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

Post by SotSvart »

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

Post by ikkejw »

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: 8586
Joined: May 28, 2005 3:28
Contact:

Post by D.J.Peters »

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

Post by TheBlueKeyboard »

Very cool! :D
angros47
Posts: 2321
Joined: Jun 21, 2005 19:04

Re: Only for fun

Post by angros47 »

Post Reply