Code: Select all
;Optical illusions Part deux
;By DK_PETER
;---------------------------
If InitSprite() = 0 Or InitKeyboard() = 0
MessageRequester("Sprite or keyboard error", "Can't initialize sprite or keyboard")
End
EndIf
DeclareModule _Optilu
Declare.i Begin()
Declare.i Kanizsa_Triangle()
Declare.i Titchener_Circles()
Declare.i Cant_See_All()
Declare.i Grey_vs_Blue_Stripes()
Declare.i Pattern()
Declare.i The_Flag()
EndDeclareModule
Module _Optilu
Structure Vec2D
x.i
y.i
EndStructure
Structure _Sprite
id.i
x.i
y.i
EndStructure
Global NewList s._Sprite()
Declare OrbitCalc2D(*ReturnVec.Vec2D, CenterX.f, CenterY.f, AngleX.f, AngleY.f, Radius.i)
Procedure OrbitCalc2D(*ReturnVec.Vec2D, CenterX.f, CenterY.f, AngleX.f, AngleY.f, Radius.i)
*ReturnVec\X = CenterX + Radius*Cos(AngleY)*Cos(AngleX)
*ReturnVec\Y = CenterY + Radius*Sin(AngleX)
EndProcedure
Procedure.i Begin()
ExamineDesktops()
OpenWindow(0, 0, 0, DesktopWidth(0), DesktopHeight(0), "Optical Illusions Part Deux (Escape key to exit - Return key for next)", #PB_Window_ScreenCentered)
OpenWindowedScreen(WindowID(0), 0, 0, WindowWidth(0), WindowHeight(0))
ProcedureReturn #True
EndProcedure
;The Kanizsa Triangle was named after the psychologist Gaetano Kanizsa who first described its effect.
;When you look at the image your brain creates contours (outlines) of a triangle although none exist.
;In reality it is an illusion created by the the wedges and the angles.
Procedure.i Kanizsa_Triangle()
Protected sp.i, sz.i, im.i
If ScreenWidth() > ScreenHeight() : sz = ScreenHeight() : Else : sz = ScreenWidth() : EndIf
sp = CreateSprite(#PB_Any, sz, sz)
im = CreateImage(#PB_Any, sz, sz, 32, #PB_Image_Transparent)
StartDrawing(ImageOutput(im))
DrawingMode(#PB_2DDrawing_AllChannels)
LineXY(OutputWidth()/2, OutputHeight() - OutputHeight()/5, OutputWidth()/5, OutputHeight()/5, $FF010000)
LineXY(OutputWidth()/5, OutputHeight()/5, OutputWidth()-OutputWidth()/5, OutputHeight()/5, $FF010000)
LineXY(OutputWidth()-OutputWidth()/5, OutputHeight()/5, OutputWidth()/2, OutputHeight() - OutputHeight()/5, $FF010000)
FillArea(OutputWidth()/2, OutputHeight()/2, $FF010000, $FF000000)
StopDrawing()
StartDrawing(SpriteOutput(sp))
Circle(OutputWidth()/2, OutputHeight() - OutputHeight()/5, OutputHeight()/10, $FFFFFF)
Circle(OutputWidth()/5, OutputHeight()/5, OutputHeight()/10, $FFFFFF)
Circle(OutputWidth()-OutputWidth()/5, OutputHeight()/5, OutputHeight()/10, $FFFFFF)
LineXY(OutputWidth()/2, OutputHeight()/8, OutputWidth()-OutputWidth()/8, OutputHeight()-OutputHeight()/3, $FFFFFF)
LineXY(OutputWidth()/8, OutputHeight()-OutputHeight()/3, OutputWidth()-OutputWidth()/8, OutputHeight()-OutputHeight()/3, $FFFFFF)
LineXY(OutputWidth()/2, OutputHeight()/8, OutputWidth()/8, OutputHeight()-OutputHeight()/3, $FFFFFF)
FillArea(OutputWidth()/2, OutputHeight()/2, $FFFFFF, $FFFFFF)
LineXY(OutputWidth()/2, OutputHeight()/8+6, (OutputWidth()-OutputWidth()/8)-8, (OutputHeight()-OutputHeight()/3)-6, $0)
LineXY(OutputWidth()/8+8, (OutputHeight()-OutputHeight()/3)-6, (OutputWidth()-OutputWidth()/8)-8, (OutputHeight()-OutputHeight()/3)-6, $0)
LineXY(OutputWidth()/2, OutputHeight()/8+8, OutputWidth()/8+8, (OutputHeight()-OutputHeight()/3)-6, $0)
FillArea(OutputWidth()/2, OutputHeight()/2, $0, $0)
DrawAlphaImage(ImageID(im), 0, 0)
StopDrawing()
Repeat
ClearScreen(0)
Repeat : Until WindowEvent() = 0
DisplaySprite(sp, ScreenWidth()/2 - SpriteWidth(sp)/2, ScreenHeight()/2 - SpriteHeight(sp)/2)
FlipBuffers()
ExamineKeyboard()
If KeyboardPushed(#PB_Key_Escape) : End : EndIf
Until KeyboardReleased(#PB_Key_Return)
FreeImage(im) : FreeSprite(sp)
ProcedureReturn #True
EndProcedure
;Also known as the Ebbinghaus Illusion, there is still a debate in psychological circles as to
;the exact mechanism and implication of this effect. Essentially, the orange circle on the left appears to
;be smaller than the one on the right although in reality they are the same size.
Procedure.i Titchener_Circles()
Protected rad.f, v.Vec2D
Protected sp.i = CreateSprite(#PB_Any, ScreenWidth(), ScreenHeight())
StartDrawing(SpriteOutput(sp))
Box(0, 0, OutputWidth(), OutputHeight(), $FFFFFF)
Circle(OutputWidth()/4, OutputHeight()/2, OutputHeight()/16, $0EC5FF)
Circle(OutputWidth()-OutputWidth()/5, OutputHeight()/2, OutputHeight()/16, $0EC5FF)
rad = 0.0
While rad < 330
OrbitCalc2D(v, OutputWidth()/4, OutputHeight()/2, rad, 0, OutputHeight()/4)
Circle(v\x, v\y, OutputHeight()/8, $D1C9AF)
rad + 57.60
Wend
rad = 0.0
While rad < 320
OrbitCalc2D(v, OutputWidth()-OutputWidth()/5, OutputHeight()/2, rad, 0, OutputHeight()/8)
Circle(v\x, v\y, OutputHeight()/26, $D1C9AF)
rad + 44.75
Wend
StopDrawing()
Repeat
ClearScreen(0)
Repeat : Until WindowEvent() = 0
DisplaySprite(sp, 0, 0)
FlipBuffers()
ExamineKeyboard()
If KeyboardPushed(#PB_Key_Escape) : End : EndIf
Until KeyboardReleased(#PB_Key_Return)
FreeSprite(sp)
ProcedureReturn #True
EndProcedure
;This one is mesmerizing. it's impossible to see all dots at the same time.
;Only a fraction of the dots can be observed simultaneously.
Procedure.i Cant_See_All()
Protected x.i, y.i, bx.i, by.i, sp.i, sz.i, num.i
If ScreenWidth() < ScreenHeight() : sz = ScreenWidth() : Else : sz = ScreenHeight() : EndIf
sp = CreateSprite(#PB_Any, sz, sz)
num = sz / 12
StartDrawing(SpriteOutput(sp))
DrawingMode(#PB_2DDrawing_AllChannels)
Box(0, 0, OutputWidth(), OutputHeight(), $FFFFFFFF)
While x <= sz
Box(x-3, 0, 6, sz, $FFA2A2A2)
Box(0, x-3, sz, 6, $FFA2A2A2)
x + num
Wend
x = num
While x <= (sz*2)
LineXY(x, 0, 0, x , $FFA2A2A2)
LineXY(x, sz, x-sz, 0 , $FFA2A2A2)
x + num
Wend
x = 0 : y = 0
While y < sz-1
If Mod(y, num) = 0
While x < sz
If Mod(x, num) = 0
Circle(x, y, 5, $FFBDBDBD)
Circle(x, y, 3, $FF000000)
EndIf
x + (num*2)
Wend
x = 0
EndIf
y + (num*2)
Wend
StopDrawing()
Repeat
ClearScreen(0)
Repeat : Until WindowEvent() = 0
DisplaySprite(sp, ScreenWidth()/2 - SpriteWidth(sp)/2, ScreenHeight()/2-SpriteHeight(sp)/2)
FlipBuffers()
ExamineKeyboard()
If KeyboardPushed(#PB_Key_Escape) : End : EndIf
Until KeyboardReleased(#PB_Key_Return)
FreeSprite(sp)
ProcedureReturn #True
EndProcedure
;Focus on the black dot only...The grey moving beam will turn blueish.
Procedure.i Grey_vs_Blue_Stripes()
Protected sp.i, bar._Sprite, basey.i, barwidth.i, barheight.i, el.i, count.i = 0
If ScreenWidth() > ScreenHeight() : sz = ScreenHeight()/2 : Else : sz = ScreenWidth()/2 : EndIf
sp = CreateSprite(#PB_Any, sz, sz)
StartDrawing(SpriteOutput(sp))
Box(0, 0, OutputWidth(), OutputHeight(), $8D8D8D)
RoundBox(0, 0, OutputWidth()/3, OutputHeight()/3, 5, 5, $0)
Box(0, 0, (OutputWidth()/3)-10, (OutputHeight()/3)-10, $2E9EF3)
Circle(OutputWidth() - OutputWidth()/3, OutputHeight()/3.0, 6, $0) ;black dot..
StopDrawing()
bar\x = ScreenWidth()/2 - SpriteWidth(sp)/2
basey = ScreenHeight()/2 - SpriteHeight(sp)/2
bar\y = 0
barwidth = (sz/3)-10 : barheight = (sz/3) / 8
bar\id = CreateSprite(#PB_Any, barwidth, barheight)
StartDrawing(SpriteOutput(bar\id))
Box(0, 0, OutputWidth(), OutputHeight(), $8D8D8D)
StopDrawing()
el = ElapsedMilliseconds()
Repeat
ClearScreen(0)
Repeat : Until WindowEvent() = 0
StartDrawing(ScreenOutput())
DrawText(0, (TextHeight("T")*2), "Focus on the dot!", $FFFFFF)
StopDrawing()
DisplaySprite(sp, ScreenWidth()/2 - SpriteWidth(sp)/2, ScreenHeight()/2-SpriteHeight(sp)/2)
DisplaySprite(bar\id, bar\x, bar\y)
If ElapsedMilliseconds() - el > 100
If count + 1 > 7
count = Random(4,0)
Else
count + 1
EndIf
bar\y = (count * SpriteHeight(bar\id)) + basey
el = ElapsedMilliseconds()
EndIf
FlipBuffers()
ExamineKeyboard()
If KeyboardPushed(#PB_Key_Escape) : End : EndIf
Until KeyboardReleased(#PB_Key_Return)
FreeSprite(sp)
FreeSprite(bar\id)
ProcedureReturn #True
EndProcedure
;Straightness is a matter of perception
Procedure.i Pattern()
Protected x.i, y.i, sp.i, sz.i, b.b = #True, white.b = #True
If ScreenWidth() < ScreenHeight() : sz = ScreenWidth() : Else : sz = ScreenHeight() : EndIf
sp = CreateSprite(#PB_Any, sz, sz)
StartDrawing(SpriteOutput(sp))
For y = 0 To sz Step 50
If b = #True
For x = 0 To sz Step 50
Select white
Case #True
Box(x, y, 50, 50, $FFFFFF)
Default
Box(x, y, 50, 50, $0)
EndSelect
If white = #True : white = #False : Else : white = #True : EndIf
Next x
b = #False
Else
For x = 0 To sz Step 50
Select white
Case #True
Box(x+10, y, 50, 50, $FFFFFF)
Default
Box(x+10, y, 50, 50, $0)
EndSelect
If white = #True : white = #False : Else : white = #True : EndIf
Next x
b = #True
EndIf
LineXY(0, y, sz, y, $777777)
Next y
StopDrawing()
Repeat
ClearScreen(0)
Repeat : Until WindowEvent() = 0
DisplaySprite(sp, ScreenWidth()/2 - SpriteWidth(sp)/2, ScreenHeight()/2-SpriteHeight(sp)/2)
FlipBuffers()
ExamineKeyboard()
If KeyboardPushed(#PB_Key_Escape) : End : EndIf
Until KeyboardReleased(#PB_Key_Return)
FreeSprite(sp)
ProcedureReturn #True
EndProcedure
;Stare at the center of the flag..20 secs later the screen blanks to white - See the red white a blue flag?
Procedure.i The_Flag()
Protected x.i, y.i, sp.i, sz.i, interval.i, el.i, switch.i = #False
If ScreenWidth() < ScreenHeight() : sz = ScreenWidth() : Else : sz = ScreenHeight() : EndIf
interval = sz / 20
sp = CreateSprite(#PB_Any, sz, sz)
StartDrawing(SpriteOutput(sp))
Box(0, 0, sz, sz, $0)
While y < sz
Box(0, y, sz, interval, $A9C800)
y + (interval*2)
Wend
RoundBox(0, 0, OutputWidth()/2.5, interval*10, 2, 2, $00D9FF)
StopDrawing()
el = ElapsedMilliseconds()
Repeat
If switch = #False : ClearScreen(0) : Else : ClearScreen($FFFFFF) : EndIf
StartDrawing(ScreenOutput())
DrawText(0, (TextHeight("T")*2), "Focus on the center of the flag!", $FFFFFF)
StopDrawing()
Repeat : Until WindowEvent() = 0
If ElapsedMilliseconds() - el < 20000
DisplaySprite(sp, ScreenWidth()/2 - SpriteWidth(sp)/2, ScreenHeight()/2-SpriteHeight(sp)/2)
Else
switch = #True
EndIf
FlipBuffers()
ExamineKeyboard()
If KeyboardPushed(#PB_Key_Escape) : End : EndIf
Until KeyboardReleased(#PB_Key_Return)
FreeSprite(sp)
ProcedureReturn #True
EndProcedure
EndModule
ret = _Optilu::Begin()
ret = _Optilu::Kanizsa_Triangle()
ret = _Optilu::Titchener_Circles()
ret = _Optilu::Cant_See_All()
ret = _Optilu::Grey_vs_Blue_Stripes()
ret = _Optilu::Pattern()
ret = _Optilu::The_Flag()
https://www.youtube.com/watch?v=1ZCo-ZXB16g
