Page 33 of 34

### Re: Efektit

Posted: Wed Jan 23, 2013 4:52 pm
atomimalli wrote:
Cooler wrote:Tuli mieleen tällänen metapalloa muistuttava efekti:

Code: Select all

``koodia``
Hurjan lähellä metapalloa tuo onkin!
Yhtä riviä vaan tarvii muuttaa.

Code: Select all

``lisää koodia``
Samalla idealla tehty liikkuva ASCII-"metapallo"

Code: Select all

``````nl=400
nk=300
merkki\$="@"

SCREEN nl,nk

mpX=Rand(nl/TextWidth(merkki\$))
mpY=Rand(nk/TextHeight(merkki\$))+(nk*0.022)
mpPlusX=Cos(120)
mpPlusY=Sin(120)

Repeat

For x = 0 To nl/TextWidth(merkki\$)
For y = 0 To nk/TextHeight(merkki\$)+(nk*0.022)
Color 0,0,Min(255,(nl+nk)*1.3/Distance(x,y,mpX,mpY))
If getRGB(BLUE) <> 0 Then Text x*TextWidth(merkki\$),y*TextHeight(merkki\$)-(y*3),merkki\$
Next y
Next x

mpX=mpX+mpPlusX
mpY=mpY+mpPlusY

If mpX<0 Or mpX>nl/TextWidth(merkki\$) Then mpPlusX= -mpPlusX
If mpY<0 Or mpY>nk/TextHeight(merkki\$)+(nk*0.022) Then mpPlusY= -mpPlusY

DrawScreen

Forever
``````

### Re: Efektit

Posted: Wed Jan 30, 2013 8:58 pm

Code: Select all

``````///////////////////////////////////////////
Global gSlrCurPos
Global gSlrBarCount As Integer
Dim aSlrBars#(gSlrBarCount)

// x, y       = Where to draw
// w, h       = What size (width, height)
// r, g, b    = Wanted colors

gSlrCurPos = Max(-1, Min(gSlrBarCount+1, (0.95 + Sin(Timer()/10)) * Float(gSlrBarCount/2)))

bw = w / gSlrBarCount

For i = 0 To gSlrBarCount - 1

If gSlrCurPos >= 0 And gSlrCurPos <= gSlrBarCount And gSlrCurPos = i Then
aSlrBars(i) = 0
Else
EndIf

br = Max(0, Min(255, r - aSlrBars(i)))
bg = Max(0, Min(255, g - aSlrBars(i)))
bb = Max(0, Min(255, b - aSlrBars(i)))

Color br, bg, bb

Box x + i * bw, y, bw, h

Next i

Color r, g, b
Box x, y, w, h, 0

EndFunction

// ESIMERKKIOHJELMA

Repeat

Color cbBlack
Color cbWhite

DrawScreen
Forever

``````
Mulla oli tylsää. :<

### Re: Efektit

Posted: Wed Jan 30, 2013 10:27 pm
Misthema wrote:

Code: Select all

``````///////////////////////////////////////////
Global gSlrCurPos
Global gSlrBarCount As Integer
Dim aSlrBars#(gSlrBarCount)

// x, y       = Where to draw
// w, h       = What size (width, height)
// r, g, b    = Wanted colors

gSlrCurPos = Max(-1, Min(gSlrBarCount+1, (0.95 + Sin(Timer()/10)) * Float(gSlrBarCount/2)))

bw = w / gSlrBarCount

For i = 0 To gSlrBarCount - 1

If gSlrCurPos >= 0 And gSlrCurPos <= gSlrBarCount And gSlrCurPos = i Then
aSlrBars(i) = 0
Else
EndIf

br = Max(0, Min(255, r - aSlrBars(i)))
bg = Max(0, Min(255, g - aSlrBars(i)))
bb = Max(0, Min(255, b - aSlrBars(i)))

Color br, bg, bb

Box x + i * bw, y, bw, h

Next i

Color r, g, b
Box x, y, w, h, 0

EndFunction

// ESIMERKKIOHJELMA

Repeat

Color cbBlack
Color cbWhite

DrawScreen
Forever

``````
Mulla oli tylsää. :<
Vallan komia, vaikkakin vanhanaikainen, kun nykyään latauksissa suositaan ympyrää. Mutta silti, hieno

### Re: Efektit

Posted: Fri Feb 01, 2013 1:16 am
MrMonday wrote:
Misthema wrote:

Code: Select all

``````///////////////////////////////////////////
Global gSlrCurPos
Global gSlrBarCount As Integer
Dim aSlrBars#(gSlrBarCount)

// x, y       = Where to draw
// w, h       = What size (width, height)
// r, g, b    = Wanted colors

gSlrCurPos = Max(-1, Min(gSlrBarCount+1, (0.95 + Sin(Timer()/10)) * Float(gSlrBarCount/2)))

bw = w / gSlrBarCount

For i = 0 To gSlrBarCount - 1

If gSlrCurPos >= 0 And gSlrCurPos <= gSlrBarCount And gSlrCurPos = i Then
aSlrBars(i) = 0
Else
EndIf

br = Max(0, Min(255, r - aSlrBars(i)))
bg = Max(0, Min(255, g - aSlrBars(i)))
bb = Max(0, Min(255, b - aSlrBars(i)))

Color br, bg, bb

Box x + i * bw, y, bw, h

Next i

Color r, g, b
Box x, y, w, h, 0

EndFunction

// ESIMERKKIOHJELMA

Repeat

Color cbBlack
Color cbWhite

DrawScreen
Forever

``````
Mulla oli tylsää. :<
Vallan komia, vaikkakin vanhanaikainen, kun nykyään latauksissa suositaan ympyrää. Mutta silti, hieno

Code: Select all

``````////////////////////////////////////////////
Global gSlrCurPos
Global gSlrBallCount As Integer
gSlrBallCount = 20 // Adjust this to fit the wanted amount of the balls
Dim aSlrBall#(gSlrBallCount)

// x, y       = Where to draw
// w, h       = What size (width, height)
// r, g, b    = Wanted colors

gSlrCurPos = Timer()/100 Mod gSlrBallCount

bw = w*2 / gSlrBallCount
bh = h*2 / gSlrBallCount

For i = 0 To gSlrBallCount - 1

If gSlrCurPos >= 0 And gSlrCurPos <= gSlrBallCount And gSlrCurPos = i Then
aSlrBall(i) = 0
Else
EndIf

br = Max(0, Min(255, r - aSlrBall(i)))
bg = Max(0, Min(255, g - aSlrBall(i)))
bb = Max(0, Min(255, b - aSlrBall(i)))

Color br, bg, bb

bx# = x + Cos(360 / gSlrBallCount * i) * w/2
by# = y - Sin(360 / gSlrBallCount * i) * h/2

Ellipse bx-(bw/2), by-(bh/2), bw, bh

Next i

EndFunction

// ESIMERKKIOHJELMA

Repeat

Color cbBlack
Color cbWhite

DrawScreen
Forever
``````
En jaksanut kaikkia nimiä muuttaa...

### Re: Efektit

Posted: Fri Feb 01, 2013 2:03 am
Misthema wrote:
No mutta, nyt se on sekä hävyttömän komia, ettäpä vielä nykyaikainen Tällaista voisi jo ihan oikeasti käyttää jossain projektissa

### Re: Efektit

Posted: Fri Feb 22, 2013 3:00 am
Katselin irkissä Viltzun komeaa partikkeliefektiä ja mietin että mihis se cb pystyy. Hiirellä voi vähän muuttaa perspektiiviä.

Code: Select all

``````Dim ScreenImages(255) As integer

Global ScreenEmptyImage, ScreenImageCount, ScreenImageLimit, ImageScreenInitialized

Global gScaledImage
gScaledImage = MakeImage(1, 1)

CONST BYTE_SIZE = 4

//offset of data in memoryblocks
Const MEMBLOCK_OFFSET_ScreenImageLayers = 0
Const MEMBLOCK_OFFSET_ScreenTextureWidth = 4
Const MEMBLOCK_OFFSET_ScreenTextureHeight = 8
Const MEMBLOCK_OFFSET_ScreenWidth = 12
Const MEMBLOCK_OFFSET_ScreenHeight = 16
Const MEMBLOCK_OFFSET_ScreenLayerAmount = 20
Const MEMBLOCK_OFFSET_ScreenBufferType = 24
Const MEMBLOCK_OFFSET_ScreenBuffer = 25
Const MEMBLOCK_OFFSET_ScreenRenderScaleFactor = 29
Const MEMBLOCK_SIZE_Screen = 33

CONST MEMBLOCK_OFFSET_LayerBaseImage = 0
CONST MEMBLOCK_OFFSET_LayerScaledImage = 4
CONST MEMBLOCK_OFFSET_LayerNewImageCount = 8
CONST MEMBLOCK_OFFSET_LayerNewImageList = 12
CONST MEMBLOCK_OFFSET_LayerNewImageListSize = 16
Const MEMBLOCK_SIZE_Layer = 20

Const MEMBLOCK_OFFSET_ImageIndex = 0
Const MEMBLOCK_OFFSET_ImageX = 4
Const MEMBLOCK_OFFSET_ImageY = 8
Const MEMBLOCK_SIZE_Image = 12

Const LIST_INCREASE_SIZE = 20

CONST BUFFERTYPE_MEMBLOCK = 1
CONST BUFFERTYPE_STREAMFILE = 2

Function InitializeImageScreenLibrary(limit=255)
ScreenEmptyImage = MakeImage(10,10)
ScreenImageLimit = limit
ReDim ScreenImages(limit) As integer
ScreenImageCount = 0
ImageScreenInitialized=1
End Function

Function MakeImageScreen(width=16, height=16, imageW=32, imageH=32, layerAmount=10)

mem = MakeMEMBlock(MEMBLOCK_SIZE_Screen)

width = Max(width, 1)
height = Max(height, 1)

PokeInt mem,MEMBLOCK_OFFSET_ScreenTextureWidth, imageW
PokeInt mem,MEMBLOCK_OFFSET_ScreenTextureHeight, imageH

PokeInt mem,MEMBLOCK_OFFSET_ScreenWidth, width
PokeInt mem,MEMBLOCK_OFFSET_ScreenHeight, height

PokeInt mem,MEMBLOCK_OFFSET_ScreenLayerAmount, layerAmount

PokeFloat mem, MEMBLOCK_OFFSET_ScreenRenderScaleFactor, 1.0

//use buffer only if it's small enough
if (width * height * layerAmount < 100000) Then
PokeByte mem,MEMBLOCK_OFFSET_ScreenBufferType, BUFFERTYPE_MEMBLOCK
else
PokeByte mem,MEMBLOCK_OFFSET_ScreenBufferType, BUFFERTYPE_STREAMFILE
endif

ClearImageScreen(mem)

Return mem
End Function

//Deletes Image Screen
Function DeleteImageScreen(mem)

if (mem and MEMBlockSize(mem) = MEMBLOCK_SIZE_Screen) Then

layerObjects = Peekint(mem,MEMBLOCK_OFFSET_ScreenImageLayers)

layerAmount = PeekInt(mem,MEMBLOCK_OFFSET_ScreenLayerAmount)

// delete previous layer images and memblocks if present

if (layerObjects) then

for iterator=0 to MemBlocksize(layerObjects)-1 step BYTE_SIZE

layer = PeekInt(layerObjects, iterator)

if (layer) Then

layerImage = PeekInt(layer,MEMBLOCK_OFFSET_LayerBaseImage)

if (layerImage) then DeleteImage layerImage

changeList = peekint(layer,MEMBLOCK_OFFSET_LayerNewImageList)

if (changeList) then

DeleteMEMBlock changeList

endif

DeleteMEMBlock layer

Endif

next iterator

DeleteMEMBlock layerObjects

EndIf

bufferType = PeekByte(mem,MEMBLOCK_OFFSET_ScreenBufferType)

if (bufferType = BUFFERTYPE_MEMBLOCK) then
screenBuffer = PeekInt(mem,MEMBLOCK_OFFSET_ScreenBuffer)
// remove screen buffer
if (screenBuffer) then DeleteMEMBlock screenBuffer

endif

DeleteMEMBlock mem

EndIf
End Function

//Clears all ImageScreen layerObjects
Function ClearImageScreen(mem)

If mem Then
If MEMBlockSize(mem) = MEMBLOCK_SIZE_Screen Then

width = PeekInt(mem,MEMBLOCK_OFFSET_ScreenWidth)
height = PeekInt(mem,MEMBLOCK_OFFSET_ScreenHeight)
layerAmount = PeekInt(mem,MEMBLOCK_OFFSET_ScreenLayerAmount)
bufferType = PeekByte(mem,MEMBLOCK_OFFSET_ScreenBufferType)

if (bufferType = BUFFERTYPE_MEMBLOCK) then
screenBuffer = PeekInt(mem,MEMBLOCK_OFFSET_ScreenBuffer)
// remove screen buffer
if (screenBuffer) then DeleteMEMBlock screenBuffer
// init screen buffer
PokeInt mem,MEMBLOCK_OFFSET_ScreenBuffer, MakeMEMBlock(width * height * layerAmount * BYTE_SIZE)
endif

// init new memblocks and images for layerObjects
ImageScreenInitLayers(mem)

endif

endif

end function

//(Re)creates ImageScreen layerObjects
Function ImageScreenInitLayers(mem)

If ImageScreenInitialized=0 Then MakeError "You must call ImageScreenInitialize() before calling other ImageScreen functions!"

if (mem and MEMBlockSize(mem) = MEMBLOCK_SIZE_Screen) Then

previousLayers = Peekint(mem,MEMBLOCK_OFFSET_ScreenImageLayers)

layerAmount = PeekInt(mem,MEMBLOCK_OFFSET_ScreenLayerAmount)

// delete previous layer images and memblocks if present

if (previousLayers) then

for iterator=0 to MemBlocksize(previousLayers)-1 step BYTE_SIZE

layer = PeekInt(previousLayers, iterator)

if (layer) Then

layerImage = PeekInt(layer,MEMBLOCK_OFFSET_LayerBaseImage)

if (layerImage) then DeleteImage layerImage

changeList = peekint(layer,MEMBLOCK_OFFSET_LayerNewImageList)

if (changeList) then

DeleteMEMBlock changeList

endif

DeleteMEMBlock layer

Endif

next iterator

DeleteMEMBlock previousLayers

EndIf

width = PeekInt(mem,MEMBLOCK_OFFSET_ScreenWidth)
height = PeekInt(mem,MEMBLOCK_OFFSET_ScreenHeight)

//create new layerObjects

layerObjects = MakeMemblock(BYTE_SIZE * layerAmount)

textureWidth = PeekInt(mem,MEMBLOCK_OFFSET_ScreenTextureWidth)
textureHeight = PeekInt(mem,MEMBLOCK_OFFSET_ScreenTextureHeight)

for iterator=0 to layerAmount-1

layer = MakeMemBlock(MEMBLOCK_SIZE_Layer)

PokeInt layer, MEMBLOCK_OFFSET_LayerBaseImage, MakeImage(width * textureWidth, height * textureHeight)
PokeInt layer, MEMBLOCK_OFFSET_LayerScaledImage, MakeImage(1,1)
PokeInt layer, MEMBLOCK_OFFSET_LayerNewImageCount, 0

changeListSize = LIST_INCREASE_SIZE * MEMBLOCK_SIZE_Image

PokeInt layer, MEMBLOCK_OFFSET_LayerNewImageListSize, changeListSize

PokeInt layer, MEMBLOCK_OFFSET_LayerNewImageList, MakeMEMBlock(changeListSize)

PokeInt layerObjects, iterator * BYTE_SIZE, layer

next iterator

PokeInt mem, MEMBLOCK_OFFSET_ScreenImageLayers, layerObjects

Endif

End function

//Sets value to ImageScreen
Function ImageScreenPut(mem, x, y, imageIndex=0, layer=0, fillLayer=0, fillAllLayers=0)

If (mem And layer > -1 and imageIndex >= 0 and imageIndex < ScreenImageCount) Then
If MEMBlockSize(mem) = MEMBLOCK_SIZE_Screen Then

width = PeekInt(mem,MEMBLOCK_OFFSET_ScreenWidth)
height = PeekInt(mem,MEMBLOCK_OFFSET_ScreenHeight)
layerAmount = PeekInt(mem,MEMBLOCK_OFFSET_ScreenLayerAmount)
layerObjects = PeekInt(mem,MEMBLOCK_OFFSET_ScreenImageLayers)
bufferType = PeekByte(mem,MEMBLOCK_OFFSET_ScreenBufferType)

if (bufferType = BUFFERTYPE_MEMBLOCK) then screenBuffer = PeekInt(mem,MEMBLOCK_OFFSET_ScreenBuffer)

//put value to only one cell
If (fillLayer=0 and layerObjects <> 0 ) Then

//check that coordinates are inside of screen and layer exists
If ( x => 0)( x < width )( y => 0)( y < height )( layer < layerAmount) Then

//start at last layer if clearing all layerObjects
if (fillAllLayers=1) Then layerIndex = layerAmount-1 Else layerIndex = layer

// loop through all layerObjects
while (layerIndex >= 0)

// if buffer is used check old value
if (bufferType = BUFFERTYPE_MEMBLOCK) then
// get old value
oldValue = PeekInt (screenBuffer,(x + y * width + layerIndex * width * height) * BYTE_SIZE)
writeValue = (oldValue <> imageIndex )
else
writeValue = true
endif

if (writeValue) then

//set buffer value to imageIndex
if (bufferType = BUFFERTYPE_MEMBLOCK) then PokeInt screenBuffer,(x + y * width + layerIndex * width * height) * BYTE_SIZE, imageIndex

layerObject = Peekint(layerObjects, layerIndex * BYTE_SIZE)

if (layerObject <> 0) Then

layerChangeList = PeekInt(layerObject, MEMBLOCK_OFFSET_LayerNewImageList)

if (layerChangeList <> 0) Then

layerChangedAmount = PeekInt(layerObject, MEMBLOCK_OFFSET_LayerNewImageCount)

changeListSize = PeekInt(layerObject, MEMBLOCK_OFFSET_LayerNewImageListSize)

//changelist is too small, increase size
if ( changeListSize < (layerChangedAmount+1) * MEMBLOCK_SIZE_Image) then

newSize = (layerChangedAmount + LIST_INCREASE_SIZE) * MEMBLOCK_SIZE_Image
ResizeMEMBlock layerChangeList, newSize

//resize can alter pointer so save
pokeint layerObject, MEMBLOCK_OFFSET_LayerNewImageList, layerChangeList

//store new size
PokeInt layerObject, MEMBLOCK_OFFSET_LayerNewImageListSize, newSize

endif

PokeInt layerChangeList, layerChangedAmount * MEMBLOCK_SIZE_Image + MEMBLOCK_OFFSET_ImageIndex, imageIndex
PokeInt layerChangeList, layerChangedAmount * MEMBLOCK_SIZE_Image + MEMBLOCK_OFFSET_ImageX, x
PokeInt layerChangeList, layerChangedAmount * MEMBLOCK_SIZE_Image + MEMBLOCK_OFFSET_ImageY, y

//increase changelist counter
PokeInt layerObject, MEMBLOCK_OFFSET_LayerNewImageCount, layerChangedAmount + 1

endif

Endif

EndIf

//break out if not going to clear all layerObjects
if (fillAllLayers=0) Then exit

wend

EndIf

// fill this layer
ElseIf fillLayer=1 And fillAllLayers=0 Then

// layer exists
If (layer < layerAmount) Then

layerObject = Peekint(layerObjects, layer * BYTE_SIZE)

layerChangeList = PeekInt(layerObject, MEMBLOCK_OFFSET_LayerNewImageList)
layerChangedAmount = PeekInt(layerObject, MEMBLOCK_OFFSET_LayerNewImageCount)
changeListSize = PeekInt(layerObject, MEMBLOCK_OFFSET_LayerNewImageListSize)

//loop through layer
For x=0 To width - 1
For y=0 To height - 1

// if buffer is used check old value
if (bufferType = BUFFERTYPE_MEMBLOCK) then
// get old value
oldValue = PeekInt (screenBuffer,(x + y * width + layer * width * height) * BYTE_SIZE)
writeValue = (oldValue <> imageIndex )
else
writeValue = true
endif

if (writeValue) then

//set buffer value to imageIndex
if (bufferType = BUFFERTYPE_MEMBLOCK) then PokeInt screenBuffer,(x + y * width + layer * width * height) * BYTE_SIZE, imageIndex

//changelist is too small, increase size
if ( changeListSize < (layerChangedAmount+1) * MEMBLOCK_SIZE_Image) then
newSize = (layerChangedAmount + LIST_INCREASE_SIZE) * MEMBLOCK_SIZE_Image
ResizeMEMBlock layerChangeList, newSize

//resize can alter pointer so save
pokeint layerObject, MEMBLOCK_OFFSET_LayerNewImageList, layerChangeList

//store new size
PokeInt layerObject, MEMBLOCK_OFFSET_LayerNewImageListSize, newSize

endif

PokeInt layerChangeList, layerChangedAmount * MEMBLOCK_SIZE_Image + MEMBLOCK_OFFSET_ImageIndex, imageIndex
PokeInt layerChangeList, layerChangedAmount * MEMBLOCK_SIZE_Image + MEMBLOCK_OFFSET_ImageX, x
PokeInt layerChangeList, layerChangedAmount * MEMBLOCK_SIZE_Image + MEMBLOCK_OFFSET_ImageY, y

//increase changelist counter
PokeInt layerObject, MEMBLOCK_OFFSET_LayerNewImageCount, layerChangedAmount + 1

EndIf

Next y
Next x

EndIf

// clear all -- this is expensive call, avoid if possible
ElseIf fillLayer=1 And fillAllLayers=1 Then

ClearImageScreen(mem)

EndIf

EndIf
EndIf
End Function

//Applies ImageScreen Changes
Function ImageScreenUpdate(mem)

If mem Then
If MEMBlockSize(mem) = MEMBLOCK_SIZE_Screen Then

width = PeekInt(mem,MEMBLOCK_OFFSET_ScreenWidth)
height = PeekInt(mem,MEMBLOCK_OFFSET_ScreenHeight)

textureWidth = PeekInt(mem,MEMBLOCK_OFFSET_ScreenTextureWidth)
textureHeight = PeekInt(mem,MEMBLOCK_OFFSET_ScreenTextureHeight)

layerAmount = PeekInt(mem,MEMBLOCK_OFFSET_ScreenLayerAmount)
layerObjects = PeekInt(mem, MEMBLOCK_OFFSET_ScreenImageLayers)

scaleFactor# = PeekFloat(mem, MEMBLOCK_OFFSET_ScreenRenderScaleFactor)

if ( layerObjects ) Then

for layerIndex = 0 to layerAmount-1

layerObject = Peekint(layerObjects, layerIndex * BYTE_SIZE)

if (layerObject ) Then

layerImage = PeekInt(layerObject, MEMBLOCK_OFFSET_LayerBaseImage)

if layerImage then

layerChangeList = PeekInt(layerObject, MEMBLOCK_OFFSET_LayerNewImageList)
layerChangedAmount = PeekInt(layerObject, MEMBLOCK_OFFSET_LayerNewImageCount)
changeListSize = PeekInt(layerObject, MEMBLOCK_OFFSET_LayerNewImageListSize)

if (layerChangedAmount > 0 and layerChangeList <> 0) Then

//apply changes to layer
for changeIterator = 0 to layerChangedAmount - 1

value	=	PeekInt(layerChangeList, changeIterator * MEMBLOCK_SIZE_Image + MEMBLOCK_OFFSET_ImageIndex)
x		=	PeekInt(layerChangeList, changeIterator * MEMBLOCK_SIZE_Image + MEMBLOCK_OFFSET_ImageX)
y		=	PeekInt(layerChangeList, changeIterator * MEMBLOCK_SIZE_Image + MEMBLOCK_OFFSET_ImageY)

If value >= 0 and value < ScreenImageCount Then
CopyBox 0,0,textureWidth,textureHeight,x*textureWidth,y*textureHeight,Image(ScreenImages(value)),Image(layerImage)
Else
Drawtoimage layerImage
color 0,0,0
box x*textureWidth,y*textureHeight,textureWidth,textureHeight
drawtoscreen
EndIf

next changeIterator

if (scaleFactor# <> 1.0) then

fLayerIndex# = -scaleFactor#^float( layerIndex)

scaledImage = PeekInt(layerObject, MEMBLOCK_OFFSET_LayerScaledImage)
scaledImage = ScaleImage(layerImage, scaledImage, float(textureWidth*width)*fLayerIndex#, float(height*textureHeight)*fLayerIndex#)
pokeint layerObject, MEMBLOCK_OFFSET_LayerScaledImage, scaledImage

endif

suggestedSize = (layerChangedAmount * 2 ) * MEMBLOCK_SIZE_Image

if (changeListSize > suggestedSize) then

resizememblock layerChangeList, suggestedSize
pokeint layerObject, MEMBLOCK_OFFSET_LayerNewImageList, layerChangeList
pokeint layerObject, MEMBLOCK_OFFSET_LayerNewImageListSize, suggestedSize

endif

//reset changed amount to zero
PokeInt layerObject, MEMBLOCK_OFFSET_LayerNewImageCount, 0

Endif

EndIf

EndIf

next layerIndex

Endif

EndIf
EndIf

End Function

Function ImageScreenDraw(mem,imageScreenX#=0.0,imageScreenY#=0.0,layerOffsetX#=0.0, layerOffsetY#=0.0)

If mem Then
If MEMBlockSize(mem) = MEMBLOCK_SIZE_Screen Then

layerAmount = PeekInt(mem,MEMBLOCK_OFFSET_ScreenLayerAmount)
layerObjects = PeekInt(mem, MEMBLOCK_OFFSET_ScreenImageLayers)
scaleFactor# = PeekFloat(mem,MEMBLOCK_OFFSET_ScreenRenderScaleFactor)

width = PeekInt(mem,MEMBLOCK_OFFSET_ScreenWidth)
height = PeekInt(mem,MEMBLOCK_OFFSET_ScreenHeight)

textureWidth = PeekInt(mem,MEMBLOCK_OFFSET_ScreenTextureWidth)
textureHeight = PeekInt(mem,MEMBLOCK_OFFSET_ScreenTextureHeight)

for layerIndex = 0 to layerAmount-1

layerObject = Peekint(layerObjects, layerIndex * BYTE_SIZE)
layerImage = PeekInt(layerObject, MEMBLOCK_OFFSET_LayerBaseImage)
scaledImage = PeekInt(layerObject, MEMBLOCK_OFFSET_LayerScaledImage)

if (scaleFactor# <> 1.0 ) then

fLayerIndex# = scaleFactor#^float(layerIndex)

w# = float(textureWidth*width)
widthDiff# = w#/2.0 - w#*fLayerIndex#/2.0

h# = float(textureHeight*height)
heightDiff# = h#/2.0 - h#*fLayerIndex#/2.0

DrawImage scaledImage, imageScreenX+layerOffsetX#*float(layerIndex)+widthDiff#, imageScreenY+layerOffsetY#*float(layerIndex)+heightDiff#
else

fLayerIndex# = float(layerIndex)

DrawImage layerImage, imageScreenX+layerOffsetX#*fLayerIndex#, imageScreenY+layerOffsetY#*fLayerIndex#
endif

next layerIndex

EndIf
EndIf

End Function

//Adds image to Screen images and returns index of image

If (img) Then
If (ScreenImageCount >= ScreenImageLimit) Then
ClearArray OFF
ScreenImageLimit = ScreenImageLimit + LIST_INCREASE_SIZE
ReDim ScreenImages(ScreenImageLimit) As integer
EndIf

ScreenImages(ScreenImageCount) = img
ScreenImageCount = ScreenImageCount + 1
Else
MakeError "Image is not valid to add into ImageScreen"

EndIf

imgIndex = ScreenImageCount - 1

Return imgIndex

End Function

Function DeleteScreenImages()
If ImageScreenInitialized=0 Then MakeError "You must call ImageScreenInitialize() before calling other ImageScreen functions!"

For iterator = 0 To ScreenImageLimit
If ScreenImages(ScreenImageLimit) Then DeleteImage ScreenImages(iterator)
Next iterator

End Function

Function ScaleImage(_image, _scaled, _width, _height)
//By: Marcoder
//Modification: Little optimization handling with ImageWidth() And ImageHeight().

If _width <= 0 Or _height <= 0 Then Return _scaled

DeleteImage _scaled
_scaled = MakeImage(_width, _height)

_image_width = ImageWidth(_image)
_image_height= ImageHeight(_image)

// Tehdään temppikuva johon skaalataan ensin vain leveys
lTempImage = MakeImage(_width, ImageHeight(_image))
DrawToImage lTempImage
For x = 0 To _width - 1
sx# = Float(_image_width) / Float(_width) * Float(x)
DrawImageBox _image, x, 0, sx, 0, 1, _image_height, OFF,OFF
Next x
lTempImage_width = ImageWidth(lTempImage)
DrawToScreen

// Skaalataan myös pystysuunnassa
DrawToImage _scaled
For y = 0 To _height - 1
sy# = Float(_image_height) / Float(_height) * Float(y)
DrawImageBox lTempImage, 0, y, 0, sy, lTempImage_width, 1, OFF,OFF
Next y
DrawToScreen
DeleteImage lTempImage

Return _scaled
End Function

SAFEEXIT OFF

Const LAYERS = 50
SCREEN 1024,768

Const TILE_W = 1
Const TILE_H = 1

Const MARGINX = 200
Const MARGINY = 150

SW = (ScreenWidth() - MARGINX) / TILE_W - 2
SH = (ScreenHeight() - MARGINY) / TILE_H - 2

//alustetaan kuvakirjasto
InitializeImageScreenLibrary()

//luodaan kuvaruutu
map = MakeImageScreen(SW,SH,TILE_W,TILE_H,LAYERS)

img = MakeImage(TILE_W,TILE_H)
DrawToImage img
Color 0,0,0
Box 0,0,TILE_W,TILE_H
DrawToScreen
//viedään kuva kuvataulukkoon

//luodaan kuvat etukäteen
For i=1 To 300
f# = Float(i Mod 100)
img = MakeImage(TILE_W,TILE_H)
DrawToImage img
If (i / 100 < 1) Then
Color  0,0 ,f#*(2.25+Rnd(0.2,0.3))
ElseIf (i / 100 < 2) Then
Color 0, f#*(2.25+Rnd(0.2,0.3)), 0
Else
Color f#*(2.25+Rnd(0.2,0.3)), 0, 0
EndIf

Box 0,0,TILE_W,TILE_H
DrawToScreen
//viedään kuva kuvataulukkoon
Next i

updateGoingOn = True

Type ball
Field x#
Field y#
Field z#
Field sx#
Field sy#
Field sz#
Field col
End Type

Type point
Field x
Field y
Field z
Field die
End Type

b.ball = New(ball)
b\x = Rnd(SW)
b\y = Rnd(SH)
b\z = Rnd(LAYERS)
b\sx = Rnd(3.0,10.0)
b\sy = Rnd(3.0,10.0)
b\sz = Rnd(1.0,3.0)
b\col = 0

b.ball = New(ball)
b\x = Rnd(SW)
b\y = Rnd(SH)
b\z = Rnd(LAYERS)
b\sx = Rnd(3.0,10.0)
b\sy = Rnd(3.0,10.0)
b\sz = Rnd(1.0,3.0)
b\col = 1

b.ball = New(ball)
b\x = Rnd(SW)
b\y = Rnd(SH)
b\z = Rnd(LAYERS)
b\sx = Rnd(3.0,10.0)
b\sy = Rnd(3.0,10.0)
b\sz = Rnd(1.0,3.0)
b\col = 2

Repeat

If KeyHit(cbkeyreturn) Then updateGoingOn = Not updateGoingOn

If (updateGoingOn) Then

For b.ball = Each ball

For i=0 To 150

size# = 75.0

p.point = New(point)

ang# = Rand(360.0)
d# = Rnd(0.0,size#)

p\x = Int(b\x + Cos(ang#)*d#)
p\y = Int(b\y - Sin(ang#)*d#)

p\z = Min(LAYERS,Max(0, Int(b\z + Rand(-2,2))))

p\die = Timer() + Rand(60.0 * size# / Max(2.0,Float(Abs(b\x-p\x)))) + Rand(60.0 * size# / Max(2.0,Float(Abs(b\y-p\y))))

col = b\col * 100 + Rand(50+p\z)

ImageScreenPut(map, p\x, p\y, col, p\z )
Next i

b\x = b\x + b\sx
b\y = b\y + b\sy
b\z =  LAYERS /2 + Cos(Timer()/10.0 + b\col * 120 )* Float(LAYERS /2)

If (b\x > SW) Then
b\x = SW
b\sx = - Abs(b\sx)
EndIf

If (b\x < 0) Then
b\x = 0.0
b\sx = Abs(b\sx)
EndIf

If (b\y > SH) Then
b\y = SH
b\sy = - Abs(b\sy)
EndIf

If (b\y < 0) Then
b\y = 0.0
b\sy = Abs(b\sy)
EndIf

If (b\z > LAYERS) Then
b\z = LAYERS
b\sz = - Abs(b\sz)
EndIf

If (b\z < 0) Then
b\z = 0
b\sz = Abs(b\sz)
EndIf

Next b

t = Timer()

For p.point = Each point
If (t > p\die) Then
ImageScreenPut(map, p\x, p\y, 0, p\z )
Delete p
EndIf
Next p

ImageScreenUpdate(map)

EndIf

mx# = Cos(Timer()/30.0)*(SW/200.0) + MouseWX() * 0.02
my# = -Sin(Timer()/30.0)*(SH/200.0) - MouseWY() * 0.015

ImageScreenDraw(map,MARGINX/2,MARGINY/2,mx#,my#)

SetWindow ""+FPS()

DrawScreen

Until EscapeKey()

//tyhjennetään muisti turhasta tauhkasta
DeleteImageScreen(map)
DeleteScreenImages()

End``````

### Re: Efektit

Posted: Sat Mar 02, 2013 10:05 pm
Pari viikkoa kun olen Coolbasicia täyttänyt, niin teinpä tällaisen efektin, joka piirtää sinisen sävyisen spiraalin. Turhia komentoja löytyy, koska vertailin lukittuun puskuriin tehtyjä pikselikomentoja raakoihin piirtokomentoihin. Suorituskyvyn ero oli suuri. Toivoisin myös, että kertoisitte, onko koodinpätkäni huono vai hyvä aloittelijan tekeleeksi

Code: Select all

``````SCREEN 800,600

//Kulma, etäisyys ja ajastin
angle=60
Dist#=0.0
aika=Timer()

Repeat
//Kulma ja etäisyys nousevat kokoajan
angle=angle+1
dist=dist+0.01
Lock //Lukitaan puskuri nopeita pikselikomentoja varten.
//Spiraali
PutPixel  400 + Cos(angle)*dist,300 + Sin(angle)*dist,Rand(160000)
Unlock //Vapautetaan puskuri.
//Lisää tähän alle komento Drawscreen OFF, jos haluat seurata spiraalin kasvua(Tämä hidastaa prosessia)

Until dist>500 //Kun spiraali on täyttänyt näytön, poistutaan silmukasta ja katsotaan tulos

DrawScreen

SetWindow(Str(Timer()-aika))

WaitKey ``````

### Re: Efektit

Posted: Sat Mar 02, 2013 10:28 pm
Ihan hieno on! Lisää nopeutta saa lukitsemalla puskurin jo ennen silmukkaa ja vapauttamalla sen jälkee.

### Re: Efektit

Posted: Sat Mar 02, 2013 10:43 pm
NightmareOfCoders wrote:Pari viikkoa kun olen Coolbasicia täyttänyt, niin teinpä tällaisen efektin, joka piirtää sinisen sävyisen spiraalin. Turhia komentoja löytyy, koska vertailin lukittuun puskuriin tehtyjä pikselikomentoja raakoihin piirtokomentoihin. Suorituskyvyn ero oli suuri. Toivoisin myös, että kertoisitte, onko koodinpätkäni huono vai hyvä aloittelijan tekeleeksi
Ihan hienohan tuo on! Suorituskykyä voit vielä huomattavasti parantaa, kun lukitset puskurin heti alkuunsa ja vapautat sen koko kuvan piirryttyä. Omalla koneellani tällä tavoin efektin pyöri jopa 30 fps.
EDIT:

Näin sitä koodilla värkkäillessä Sly_Jack vei viestini sisällön harkittuja alkusanoja myöten :O

### Re: Efektit

Posted: Sun Mar 03, 2013 9:24 am
Kiitoksia positiivisesta palautteesta ja neuvoista! Joo, kyllä nopeutu tuolla kikalla, itselläni suoritusaika tippui 300>30ms, miltein kymmenkertainen nopeutuminen. Ja Axu: Katsoitko siis FPS:ää vai suoritusaikaa? Sillä FPS ei anna oikeata käsitystä suorituskyvystä, kun on tällainen operaatio kyseessä. Vaan suorituskyvyn mittaa se, miten pitkään kyseinen operaatio on vienyt.

### Re: Efektit

Posted: Sun Mar 03, 2013 9:26 am
NightmareOfCoders wrote:Kiitoksia positiivisesta palautteesta ja neuvoista! Joo, kyllä nopeutu tuolla kikalla, itselläni suoritusaika tippui 300>30ms, miltein kymmenkertainen nopeutuminen. Ja Axu: Katsoitko siis FPS:ää vai suoritusaikaa? Sillä FPS ei anna oikeata käsitystä suorituskyvystä, kun on tällainen operaatio kyseessä. Vaan suorituskyvyn mittaa se, miten pitkään kyseinen operaatio on vienyt.
Katsoin suoritusaikaa efektin pyöriessä loopissa, josta laskin fps:n.
EDIT:

Siis FPS:n laskin korostaakseni sitä, että efektiä voi pyörittää jopa interaktiivisella nopeudella.

### Re: Efektit

Posted: Sun Mar 03, 2013 4:47 pm
Mikäli mittaa koko loopin aikaa, FPS ja suoritusaika ovat vain toistensa käänteislukuja. Yleisesti ottaen parempi on kuitenkin mitata aikaa, koska siten voi mitata vain jonkin kriittisen osan suoritusaikaa ja vertailla niitä eri toteutustapojen välillä - lisäksi se skaalaa lineaarisesti, eli kaksi kertaa saman efektin tekeminen vie kaksi keraa enemmän aikaa, FPS ei toimi yhtä miellyttävästi.

### Re: Efektit

Posted: Thu Mar 21, 2013 9:05 pm
Tulipa tossa hetken mielijohteesta tehtyä jonkunlainen Cellular Automata, mutta en jaksanut loppujenlopuksi miettiä kunnon sääntöjä joten siitä tuli vaan jännä efekti
Pidemmittä puheitta, koodi ilman minkäänlaista optimointia, siivoamista tai kommentteja:

Code: Select all

``````SCREEN 640, 640

Const CELL_WIDTH = 16
Const CELL_HEIGHT = 16

Const SIZE = 0

// nNeightbors <= RULE_GROW_MAX -> Neightbor cells grow
Const RULE_GROW_MAX = 3
// nNeightbors >= RULE_SHRINK_MIN -> Self shrinks
Const RULE_SHRINK_MIN = 5

Const CELL_SIZE_MAX = 9
CELL_COLOR_MODIFIER# = 255.0 / (CELL_SIZE_MAX + 1)

Const CELLS_SIZE = 39
Dim cells(CELLS_SIZE, CELLS_SIZE, 1)
For x = 0 To CELLS_SIZE
For y = 0 To CELLS_SIZE
cells(x, y, SIZE) = Rand(0, CELL_SIZE_MAX)
Next y
Next x

Repeat

For x = 0 To CELLS_SIZE
For y = 0 To CELLS_SIZE
nNeightbors = 0

// -1, -1
If x > 0 And y > 0 Then
If cells(x - 1, y - 1, SIZE) >= 5 Then nNeightbors = nNeightbors + 1
EndIf
//  0, -1
If y > 0 Then
If cells(x, y - 1, SIZE) >= 5 Then nNeightbors = nNeightbors + 1
EndIf
//  1, -1
If x < CELLS_SIZE And y > 0 Then
If cells(x + 1, y - 1, SIZE) >= 5 Then nNeightbors = nNeightbors + 1
EndIf
// -1, 0
If x > 0 Then
If cells(x - 1, y, SIZE) >= 5 Then nNeightbors = nNeightbors + 1
EndIf
//  1, 0
If x < CELLS_SIZE Then
If cells(x + 1, y, SIZE) >= 5 Then nNeightbors = nNeightbors + 1
EndIf
// -1, 1
If x > 0 And y < CELLS_SIZE Then
If cells(x - 1, y + 1, SIZE) >= 5 Then nNeightbors = nNeightbors + 1
EndIf
//  0, 1
If y < CELLS_SIZE Then
If cells(x, y + 1, SIZE) >= 5 Then nNeightbors = nNeightbors + 1
EndIf
//  1, 1
If x < CELLS_SIZE And y < CELLS_SIZE Then
If cells(x + 1, y + 1, SIZE) >= 5 Then nNeightbors = nNeightbors + 1
EndIf

If nNeightbors <= RULE_GROW_MAX Then

// -1, -1
If x > 0 And y > 0 Then
If cells(x - 1, y - 1, SIZE) <= 5 Then cells(x - 1, y - 1, SIZE_ADD) = cells(x - 1, y - 1, SIZE_ADD) + 1
EndIf
//  0, -1
If y > 0 Then
If cells(x, y - 1, SIZE) <= 5 Then cells(x, y - 1, SIZE_ADD) = cells(x, y - 1, SIZE_ADD) + 1
EndIf
//  1, -1
If x < CELLS_SIZE And y > 0 Then
If cells(x + 1, y - 1, SIZE) <= 5 Then cells(x + 1, y - 1, SIZE_ADD) = cells(x + 1, y - 1, SIZE_ADD) + 1
EndIf
// -1, 0
If x > 0 Then
If cells(x - 1, y, SIZE) <= 5 Then cells(x - 1, y, SIZE_ADD) = cells(x - 1, y, SIZE_ADD) + 1
EndIf
//  1, 0
If x < CELLS_SIZE Then
If cells(x + 1, y, SIZE) <= 5 Then cells(x + 1, y, SIZE_ADD) = cells(x + 1, y, SIZE_ADD) + 1
EndIf
// -1, 1
If x > 0 And y < CELLS_SIZE Then
If cells(x - 1, y + 1, SIZE) <= 5 Then cells(x - 1, y + 1, SIZE_ADD) = cells(x - 1, y + 1, SIZE_ADD) + 1
EndIf
//  0, 1
If y < CELLS_SIZE Then
If cells(x, y + 1, SIZE) <= 5 Then cells(x, y + 1, SIZE_ADD) = cells(x, y + 1, SIZE_ADD) + 1
EndIf
//  1, 1
If x < CELLS_SIZE And y < CELLS_SIZE Then
If cells(x + 1, y + 1, SIZE) <= 5 Then cells(x + 1, y + 1, SIZE_ADD) = cells(x + 1, y + 1, SIZE_ADD) + 1
EndIf
ElseIf nNeightbors >= RULE_SHRINK_MIN Then
EndIf
Next y
Next x

For x = 0 To CELLS_SIZE
For y = 0 To CELLS_SIZE
cells(x, y, SIZE) = Max(Min(cells(x, y, SIZE) + cells(x, y, SIZE_ADD), CELL_SIZE_MAX), 0)

Color cells(x, y, SIZE) * CELL_COLOR_MODIFIER, 255 - cells(x, y, SIZE) * CELL_COLOR_MODIFIER, 0

Box x * CELL_WIDTH, y * CELL_HEIGHT, CELL_WIDTH, CELL_HEIGHT, True

//CenterText x * CELL_WIDTH + (CELL_WIDTH / 2.0), y * CELL_HEIGHT + (CELL_HEIGHT / 2.0), "" + cells(x, y, SIZE), 2
Next y
Next x

DrawScreen

//WaitKey
SetWindow "FPS" + FPS()

Forever ``````

### Re: Efektit

Posted: Tue Mar 26, 2013 8:36 pm
NightmareOfCoders wrote:Pari viikkoa kun olen Coolbasicia täyttänyt, niin teinpä tällaisen efektin, joka piirtää sinisen sävyisen spiraalin. Turhia komentoja löytyy, koska vertailin lukittuun puskuriin tehtyjä pikselikomentoja raakoihin piirtokomentoihin. Suorituskyvyn ero oli suuri. Toivoisin myös, että kertoisitte, onko koodinpätkäni huono vai hyvä aloittelijan tekeleeksi

Minulla oli tylsää ja tekeleesi inspiroimana sitten...

Code: Select all

``````SCREEN 800,600

//Kulma, etäisyys ja ajastin
angle# = 60
dist# = 0.0
elo# = 0.0

SetFont LoadFont("Tahoma", 24, True, False, False)

// Laita tämä päälle jos musta tausta ei sovi
// ClsColor 16,24,128

While Not KeyDown(cbKeyEscape)

elo = elo - 5.0

aika=Timer()

SetWindow(Str(Timer()-aika))

DrawScreen

Wend

Function RGB(r,g,b)
Return 255 Shl 24 + r Shl 16 + g Shl 8 + b
End Function

// Jollet taas halua käyttää ClsColor:ia, käytä 2 seuraavaa riviä

//Color 16,24,128
//Circle x1 - 100, y1 - 100, 200, True

Lock
Repeat
angle#=angle+1
dist#=dist+0.01
c = angle * dist

x# = x1 + Cos(angle + elo) * dist
y# = y1 + Sin(angle + elo) * dist

If x >= 0 And x < ScreenWidth() And y >= 0 And y < ScreenHeight() Then PutPixel2 x, y, RGB(0,0,c), SCREEN()

Until dist>100.0
Unlock

Color 10,10,10
Color 255,255,255
End Function
``````

### Re: Efektit

Posted: Tue Mar 26, 2013 9:11 pm
Mistheman lataushärpäke on kyllä aivan mahtava! Tuota jaksaa katsellakkin, toisin kuin tylsää palkkia.

### Re: Efektit

Posted: Fri Apr 12, 2013 11:13 pm
Kas tässäpä pätkä joka analysoi kuvan värit ja piirtää ne kolmiulotteiseen avaruuskuutioon.

Code: Select all

``````SCREEN 800, 480
clsColor 32,32,32
clearArray OFF
imagepath\$ = "media/guy.bmp"
colorblock = find_unique_colors(img)

setWindow "done "

unique_colors = peekInt(colorblock, 0)
addText "unique colors: " + unique_colors

repeat
draw_color_cube(350, 320, colorblock)
drawScreen
forever

function draw_color_cube(cx, cy, cblock)
colors = peekInt(cblock, 0)

w = 200
ratio# = 0.25
ang# = 25.0 + timer()*0.04
color 64,64,64

line cx , cy, cx + w*cos(ang), cy + w*sin(ang) * 0.5
line cx , cy , cx + w*cos(ang+90), cy + w*sin(ang+90) * 0.5
line cx , cy , cx, cy - w
//line cx, cy, cx - w*ratio, cy + w*ratio
boxsize = 3

for i = 1 to colors-1
pix = peekInt(cblock, i*4)
color 0,0, pix

x = (getRGB(RED) / 255.0) * w
y = (getRGB(GREEN) / 255.0) * w
z = (getRGB(BLUE) / 255.0) * w

sx# = x*cos(ang) + z * cos(ang + 90)
sy# = x*sin(ang) + z * sin(ang + 90)
sy# = sy * 0.5 - y

box cx + sx, cy + sy, boxsize, boxsize, 1
next i
endFunction

function find_unique_colors(img)
colors = 0
size = 512
temp = makeMEMBlock(size*4)

pixels = imageWidth(img) * imageHeight(img)

lock(image(img))

for y=0 to imageHeight(img)-1
for x=0 to imageWidth(img)-1
pix = getPixel2(x, y, image(img))
found = false

for i = 0 to colors-1
//setWindow "" + pix + ""
//setWindow "" + peekInt(temp, i) + ""
if peekInt(temp, i*4) = pix then
found = true

exit
endif

next i

if colors >= size then
size = size*size
resizeMEMBlock temp, size*4
endif

pokeInt temp, colors*4, pix
colors = colors+1
endif

next x
setWindow "y: " + y + " : colors " + colors
next y

unlock(image(img))

colorblock = makeMEMBlock(colors*4+4)
memCopy temp, 0, colorblock, 4, colors*4
pokeInt colorblock, 0, colors
deleteMEMBlock temp

return colorblock
endFunction
``````
Edit: Pieni offset-virhe korjattu.

### Re: Efektit

Posted: Sat Apr 13, 2013 1:56 pm
CCE wrote:Kas tässäpä pätkä joka analysoi kuvan värit ja piirtää ne kolmiulotteiseen avaruuskuutioon.
Ilmeisesti nuo suorat linjat on enimmäkseen kuvassa käytettyjä liukuvärejä. Tulipa niistä mieleen että miltäköhän kuva näyttäisi jos sen pakkaisi siten että koittaisi pakata kuvan väridatan mahdollisimman pieneen määrään tuollaisia"värisuoria" ja käsittelisi värejä pisteinä kyseisillä suorilla.

media/map.bmp näyttää muuten aika jännältä analysoituna.

### Re: Efektit

Posted: Mon Jun 17, 2013 10:15 pm
Mandelbrotin sarja erittäin tehokkaasti optimoituna.

Code: Select all

``````SCREEN 800,600
minRe# = -2.0
maxRe# = 1.0
minIm# = -1.2
maxIm# = minIm+(maxRe-minRe)*ScreenHeight()/ScreenWidth()
re_factor# = (maxRe-minRe)/(ScreenWidth()-1)
im_factor# = (maxIm-minIm)/(ScreenHeight()-1)
maxIterations = 30
div2# = Float(maxIterations/2)
min1# = Float(maxIterations-1)
ti=Timer()
Lock
For y=0 To ScreenHeight()
c_im# = maxIm - y*im_factor
For x=0 To ScreenWidth()
c_re# = minRe + x*re_factor

Z_re# = c_re
Z_im# = c_im
For n=0 To maxIterations
Z_re2# = Z_re*Z_re
Z_im2# = Z_im*Z_im
If Z_re2 + Z_im2 >4 Then Exit
Z_im = 2*Z_re*Z_im + c_im
Z_re = Z_re2 - Z_im2 + c_re
Next n
If n<div2 Then
col#=n/div2
PutPixel2 x,y,Int(col*255) Shl 16 + 0 Shl 8
ElseIf n>=div2 And n<maxIterations
col#=(n-div2)/(min1-div2)
PutPixel2 x,y,Int(col*255) + 255 Shl 16 + Int(col*255) Shl 8
EndIf
Next x
Next y
Unlock
comp# = (Timer()-ti)/1000.0
Color cbWhite
Text 0,0,"complete in "+comp+" secs"
DrawScreen
WaitKey
``````

### Re: Efektit

Posted: Tue Jun 18, 2013 7:24 pm
naputtelija wrote:Mandelbrotin sarja erittäin tehokkaasti optimoituna.

Code: Select all

``````SCREEN 800,600
minRe# = -2.0
maxRe# = 1.0
minIm# = -1.2
maxIm# = minIm+(maxRe-minRe)*ScreenHeight()/ScreenWidth()
re_factor# = (maxRe-minRe)/(ScreenWidth()-1)
im_factor# = (maxIm-minIm)/(ScreenHeight()-1)
maxIterations = 30
div2# = Float(maxIterations/2)
min1# = Float(maxIterations-1)
ti=Timer()
Lock
For y=0 To ScreenHeight()
c_im# = maxIm - y*im_factor
For x=0 To ScreenWidth()
c_re# = minRe + x*re_factor

Z_re# = c_re
Z_im# = c_im
For n=0 To maxIterations
Z_re2# = Z_re*Z_re
Z_im2# = Z_im*Z_im
If Z_re2 + Z_im2 >4 Then Exit
Z_im = 2*Z_re*Z_im + c_im
Z_re = Z_re2 - Z_im2 + c_re
Next n
If n<div2 Then
col#=n/div2
PutPixel2 x,y,Int(col*255) Shl 16 + 0 Shl 8
ElseIf n>=div2 And n<maxIterations
col#=(n-div2)/(min1-div2)
PutPixel2 x,y,Int(col*255) + 255 Shl 16 + Int(col*255) Shl 8
EndIf
Next x
Next y
Unlock
comp# = (Timer()-ti)/1000.0
Color cbWhite
Text 0,0,"complete in "+comp+" secs"
DrawScreen
WaitKey
``````
Kun optimoinnista kerran on puhe niin pitihän tuota saada vielä nopeammaksi. Lopputulos ei ole aivan sama, mutta omalla koneellani noin neljä kertaa nopeampi.

Code: Select all

``````// käytetään vakioita
Const SW = 800
Const SH = 600
Const maxIterations = 30
Const shl24 = 16711680 // = 255 shl 16
SH2 = SH/2

SCREEN SW, SH

//arvot säädetty niin että keskikohta osuu kivasti peilaussaumaan
//ja muoto ei näytä venyneeltä
pos# = 1.6
maxRe# = (float(SW) / float(SH))
minIm# = -pos#
maxIm# = pos#
minRe# = minIm / maxRe# - maxIm# - maxRe#

re_factor# = (maxRe-minRe) / (Float(SW) - 1.0)
im_factor# = (maxIm-minIm) / (Float(SH) - 1.0)

ti=Timer()

Dim c_re_arr(sw,2) As Float
Dim iCol_arr(maxIterations)

For x=0 To sw
c_re_arr(x,0) = minRe + x * re_factor
//otetaan neliöt talteen
c_re_arr(x,1) = c_re_arr(x,0) * c_re_arr(x,0)
Next x

div2# = Float(maxIterations/2.0)
div3# = Float(maxIterations-1.0) - div2

For i=0 To maxIterations
If i < div2 Then
iCol_arr(i) = (i / div2) * shl24
ElseIf i >= div2 And i < maxIterations
tCol = (i-div2) / div3# * 255
iCol_arr(i) = tCol + shl24 + tCol Shl 8
EndIf
Next i

//piirretään efektistä vain puolikas kuvaan
img = MakeImage(SW,SH2)
Lock Image(img)
For y=0 To sh2-1

c_im# = maxIm - y * im_factor

// jotta iteraatiot n=0 on halpoja
c_im2# = c_im * c_im

For x=0 To SW-1

c_re# = c_re_arr(x,0)

Z_re# = c_re
Z_im# = c_im

Z_re2# = c_re_arr(x,1)
Z_im2# = c_im2#

For n=0 To maxIterations
If Z_re2 + Z_im2 > 4 Then Exit
Z_im = 2 * Z_re * Z_im + c_im
Z_re = Z_re2 - Z_im2 + c_re
Z_re2# = Z_re * Z_re
Z_im2# = Z_im * Z_im
Next n

PutPixel2 x,y, iCol_arr(n), Image(img)
Next x
Next y
Unlock Image(img)

//piirretään yläpuoli
DrawImageBox img,0,0,0,0,SW,SH2
//peilataan
ResizeImage img,SW,-SH2
//piiretään alapuoli
DrawImageBox img,0,SH2,0,0,SW,SH2

comp# = (Timer()-ti)/1000.0
Color cbWhite
Text 0,0,"complete in "+comp+" secs"
DrawScreen
WaitKey``````

### Re: Efektit

Posted: Tue Aug 13, 2013 10:52 pm
Isketääs tämä tännekin. Shadebobeja yhden ZX -demon innoittamana, renderöintinopeuksia eri pallomäärille saa ilmoitella.

Code: Select all

``````SCREEN 640, 480
Dim imgs(9)

Repeat
If im = 0 And ang = 0 Then
ball = MakeImage(50, 50)
DrawToImage ball
For i = 0 To 49
If i<10 then imgs(i) = MakeImage(640, 480)
For j = 0 To 49
If Distance(i,j,25,25)<23 Then
c# = Max(.0, .1+.45*((i-25)/24.0-(j-25)/24.0+Sqrt(1-(i-25)*(i-25)/576.0-(j-25)*(j-25)/756.0)))
Color 20+c*80, 40+c*80, 100+c*100
Else
Color 255, 0, 255
EndIf
Dot i, j
Next j
Next i
DrawToScreen

Color 255, 255, 255
im = 0
EndIf
im = (im + 1) Mod 10
DrawToImage imgs(im)
For i = 0 To balls + 1
DrawImage ball, 320+120.0*Cos(.20*(ang+im))-80*Sin(.60*(ang+im))-25, 240+120*Sin(.17*(ang+im))+80*Cos(.57*(ang+im))-25
Next i
If im = 9 Then
ang = ang + 9
count + 1
EndIf
DrawToScreen
DrawImage imgs(im), 0, 0
Text 5,5, "CB knows no boundaries (FPS():"+Str(FPS())+")"
Text 400, 460, Str(count)+" bobs by msqrt/Peisik"
DrawScreen
Forever``````