Code: Select all
InitSprite()
InitKeyboard()
DeclareModule _Illusions
Declare.i SetResolution(width.i = 1024, Height.i = 768, Title.s = "Optical illusions")
Declare.i Gradient_illusion()
Declare.i Moire_1()
Declare.i Scintillating_Grid()
Declare.i Pigeons()
Declare.i Induced_Contrast_Async()
Declare.i Monker_White()
Declare.i Hiltons_Lilac()
Declare.i Tilted_Table()
Declare.i Hering()
EndDeclareModule
Module _Illusions
Structure _MainData
Win.i
Scr.i
EndStructure
Structure _sprite
id.i
x.f
y.f
horz.i
vert.i
EndStructure
Structure Vec2D
x.i
y.i
EndStructure
Global md._MainData
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 SetResolution(width.i = 1024, Height.i = 768, Title.s = "Optical illusions")
md\Win = OpenWindow(#PB_Any, 0, 0, width, Height, Title, #PB_Window_ScreenCentered | #PB_Window_SystemMenu)
md\Scr = OpenWindowedScreen(WindowID(md\Win), 0, 0, width, Height, #False, 0, 0)
If md\Scr = 0
ProcedureReturn #False
Else
ProcedureReturn #True
EndIf
EndProcedure
Procedure.i Gradient_illusion() ;Line is grey.
Protected ev.i, Quit.i = 0, img.i, FinishedImage.i
SetWindowTitle(md\Win, "Focus at the horizontal bar...It it gradient grey?")
img = CreateImage(#PB_Any, ScreenWidth()/6, ScreenHeight())
StartDrawing(ImageOutput(img))
DrawingMode(#PB_2DDrawing_Gradient)
FrontColor($FFFFFF) : BackColor($000000)
LinearGradient(0, 0, ImageWidth(img)/2, 0)
Box(0, 0, ImageWidth(img)/2, ImageHeight(img))
FrontColor($FFFFFF) : BackColor($000000)
LinearGradient(ImageWidth(img), 0, ImageWidth(img)/2, 0)
Box(ImageWidth(img)/2, 0, ImageWidth(img)/2, ImageHeight(img))
StopDrawing()
FinishedImage = CreateImage(#PB_Any, ScreenWidth(), ScreenHeight())
StartDrawing(ImageOutput(FinishedImage))
For x = 0 To 5
DrawImage(ImageID(img), x * ImageWidth(img), 0)
Next x
Box(0, ScreenHeight()/2 - ((ScreenHeight()/30)/2), ScreenWidth(), ScreenHeight()/30, $888888)
StopDrawing()
FreeImage(img)
Repeat
ClearScreen(0)
StartDrawing(ScreenOutput())
DrawImage(ImageID(FinishedImage), 0, 0)
StopDrawing()
Repeat
ev = WindowEvent()
If ev = #PB_Event_CloseWindow
Quit = 1
EndIf
Until ev = 0
ExamineKeyboard()
If KeyboardPushed(#PB_Key_Escape)
Quit = 1
EndIf
FlipBuffers()
Until KeyboardReleased(#PB_Key_Return) Or Quit = 1
FreeImage(FinishedImage)
If Quit = 1
End
Else
ProcedureReturn #True
EndIf
EndProcedure
Procedure.i Moire_1()
Protected ev.i, Quit.i = 0, img.i, sp._sprite, x.i, Startpoint.i
SetWindowTitle(md\Win, "Moire effect. Use arrow keys")
Startpoint = ScreenHeight()/2
img = CreateImage(#PB_Any, ScreenWidth(), ScreenHeight())
StartDrawing(ImageOutput(img))
Box(0, 0, ScreenWidth(), ScreenHeight(), $FFFFFF)
For x = Startpoint To 20 Step -20
Circle(ScreenWidth()/2, ScreenHeight()/2, x, $15FF00)
Circle(ScreenWidth()/2, ScreenHeight()/2, x-10, $000000)
Next x
StopDrawing()
Startpoint-10
sp\id = CreateSprite(#PB_Any, ScreenWidth(), ScreenHeight())
StartDrawing(SpriteOutput(sp\id))
Box(0, 0, ScreenWidth(), ScreenHeight(), $000000)
For x = Startpoint To 20 Step -20
Circle(ScreenWidth()/2, ScreenHeight()/2, x, $FC4E00)
Circle(ScreenWidth()/2, ScreenHeight()/2, x-10, $000000)
Next x
StopDrawing()
TransparentSpriteColor(sp\id, 0)
sp\x = 0
sp\y = 0
Repeat
ClearScreen(0)
StartDrawing(ScreenOutput())
DrawImage(ImageID(img), 0, 0)
StopDrawing()
Repeat
ev = WindowEvent()
If ev = #PB_Event_CloseWindow
Quit = 1
EndIf
Until ev = 0
ExamineKeyboard()
If KeyboardPushed(#PB_Key_Left)
sp\x - 0.3
ElseIf KeyboardPushed(#PB_Key_Right)
sp\x + 0.3
EndIf
If KeyboardPushed(#PB_Key_Up)
sp\y - 0.3
ElseIf KeyboardPushed(#PB_Key_Down)
sp\y + 0.3
EndIf
DisplayTransparentSprite(sp\id, sp\x, sp\y)
If KeyboardPushed(#PB_Key_Escape)
Quit = 1
EndIf
FlipBuffers()
Until KeyboardReleased(#PB_Key_Return) Or Quit = 1
FreeImage(img)
FreeSprite(sp\id)
If Quit = 1
End
Else
ProcedureReturn #True
EndIf
EndProcedure
Procedure.i Scintillating_Grid() ;Ghostly black dots
Protected ev.i, Quit.i = 0
SetWindowTitle(md\Win, "Scintilla grid. Ghostly black dots")
Repeat
ClearScreen(0)
StartDrawing(ScreenOutput())
Box(0, 0, ScreenWidth(), ScreenHeight(), $AAAAAA)
For y = 0 To ScreenHeight() Step 40
For x = 0 To ScreenWidth() Step 40
Box(x+6, y+6, 30, 30, $0)
Circle(x , y , 8, $FFFFFF)
Next x
Next y
StopDrawing()
Repeat
ev = WindowEvent()
If ev = #PB_Event_CloseWindow
Quit = 1
EndIf
Until ev = 0
ExamineKeyboard()
If KeyboardPushed(#PB_Key_Escape)
Quit = 1
EndIf
FlipBuffers()
Until KeyboardReleased(#PB_Key_Return) Or Quit = 1
If Quit = 1
End
Else
ProcedureReturn #True
EndIf
EndProcedure
Procedure.i Pigeons()
Protected ev.i, Quit.i = 0, GridOn.i = 1
Protected Dim sp._sprite(5), img.i, x.i = 0
SetWindowTitle(md\Win, "Pigeons jagged movement. Press space (Turn grid on/off)")
img = CreateImage(#PB_Any, ScreenWidth(), ScreenHeight())
StartDrawing(ImageOutput(img))
Box(0,0,ScreenWidth(), ScreenHeight(), $000000)
While x < ScreenWidth()
Box(x, 0, 5, ScreenHeight(), $FFFFFF)
x + 10
Wend
StopDrawing()
sp(0)\id = CreateSprite(#PB_Any, 200, 200)
StartDrawing(SpriteOutput(sp(0)\id))
Box(160, 0, 30, 40, $444444)
Box(160, 30, 40, 10, $444444)
Box(150, 40, 30, 10, $444444)
Box(140, 50, 40, 10, $444444)
Box(130, 60, 60, 10, $444444)
Box(120, 70, 70, 10, $444444)
Box(110, 70, 90, 10, $444444)
Box(100, 80, 90, 10, $444444)
Box(110, 90, 80, 10, $444444)
Box(150, 100, 10, 30, $444444)
Box(150, 100, 20, 10, $444444)
Box(150, 130, 30, 10, $444444)
StopDrawing()
TransparentSpriteColor(sp(0)\id, 0)
For x = 1 To 4
sp(x)\id = CopySprite(sp(0)\id, #PB_Any)
sp(x)\x = Random(ScreenWidth(), 0)
sp(x)\y = Random(ScreenHeight()-100,100)
Next x
Repeat
ClearScreen(0)
If GridOn = 1
StartDrawing(ScreenOutput())
DrawImage(ImageID(img), 0, 0)
StopDrawing()
EndIf
Repeat
ev = WindowEvent()
If ev = #PB_Event_CloseWindow
Quit = 1
EndIf
Until ev = 0
ExamineKeyboard()
If KeyboardPushed(#PB_Key_Escape)
Quit = 1
EndIf
If KeyboardReleased(#PB_Key_Space)
If GridOn = 1 : GridOn = 0 : Else : GridOn = 1 : EndIf
EndIf
For x = 0 To 4
sp(x)\x + 0.5
If sp(x)\x > ScreenWidth()
sp(x)\x = -200
EndIf
DisplayTransparentSprite(sp(x)\id, sp(x)\x, sp(x)\y)
Next x
FlipBuffers()
Until KeyboardReleased(#PB_Key_Return) Or Quit = 1
If Quit = 1
End
Else
ProcedureReturn #True
EndIf
EndProcedure
Procedure.i Induced_Contrast_Async()
Protected back._sprite, Spritetime.i, Count.i = 0, x.i, t.i
Protected Dim leftside._sprite(10), Dim rightside._sprite(10)
SetWindowTitle(md\Win, "Induced contrast Async")
back\id = CreateSprite(#PB_Any, ScreenWidth(), ScreenHeight())
StartDrawing(SpriteOutput(back\id))
Box(0, 0, ScreenWidth()/2, ScreenHeight(), $000000)
Box(ScreenWidth()/2, 0, ScreenWidth()/2, ScreenHeight(), $EEEEEE)
StopDrawing()
For x = 0 To 9
With leftside(x)
\id = CreateSprite(#PB_Any, ScreenHeight()/4, ScreenHeight()/4)
StartDrawing(SpriteOutput(\id))
Circle(SpriteWidth(\id)/2, SpriteHeight(\id)/2, SpriteHeight(\id)/2, RGB(x * 25, x * 25, x * 25))
StopDrawing()
\x = ScreenWidth()/4 - SpriteWidth(\id)/2
\y = ScreenHeight()/2 - SpriteHeight(\id)/2
rightside(x)\id = CopySprite(\id, #PB_Any)
rightside(x)\x = (ScreenWidth()- ScreenWidth()/4) - SpriteWidth(\id)/2
rightside(x)\y = ScreenHeight()/2 - SpriteHeight(\id)/2
EndWith
Next x
back\vert = 1
Spritetime = ElapsedMilliseconds()
Repeat
ClearScreen(0)
StartDrawing(ScreenOutput())
Box(0, 0,ScreenWidth(), ScreenHeight(), $FFFFFF)
StopDrawing()
Repeat
ev = WindowEvent()
If ev = #PB_Event_CloseWindow
Quit = 1
EndIf
Until ev = 0
ExamineKeyboard()
If KeyboardPushed(#PB_Key_Escape)
Quit = 1
EndIf
Select back\vert
Case 0 ;up
back\y - 1
Case 1 ;down
back\y + 1
EndSelect
If back\y > ScreenHeight()
back\vert = 0
ElseIf back\y < 0
back\vert = 1
EndIf
If ElapsedMilliseconds() - Spritetime > 100
Count + 1
If count > 9
count = 0
EndIf
Spritetime = ElapsedMilliseconds()
EndIf
DisplaySprite(back\id, 0, back\y)
DisplayTransparentSprite(leftside(Count)\id, leftside(Count)\x, leftside(Count)\y)
DisplayTransparentSprite(rightside(Count)\id, rightside(Count)\x, rightside(Count)\y)
FlipBuffers()
Until KeyboardReleased(#PB_Key_Return) Or Quit = 1
For t = 0 To 9
FreeSprite(leftside(t)\id)
FreeSprite(rightside(t)\id)
Next t
FreeSprite(back\id)
If Quit = 1
End
Else
ProcedureReturn #True
EndIf
EndProcedure
Procedure.i Monker_White()
Protected back._sprite, front.i, slide.i
SetWindowTitle(md\Win, "Monker White - Color the same. Use arrow keys.")
back\id = CreateSprite(#PB_Any, ScreenWidth()/2, ScreenHeight())
StartDrawing(SpriteOutput(back\id))
For t = 0 To ScreenHeight() Step 40
Box(0, t, SpriteWidth(back\id), 20, $FFFFFF)
Next t
StopDrawing()
back\x = ScreenWidth()/2
front = CreateSprite(#PB_Any, ScreenWidth()/2, ScreenHeight())
StartDrawing(SpriteOutput(front))
Box(0, 0, SpriteWidth(front), SpriteHeight(front), $000000)
For t = 0 To ScreenHeight() Step 40
Box(0, t, SpriteWidth(front)/2, 20, $FF4E00)
Box(SpriteWidth(front)/2, t-20, SpriteWidth(front)/2, 20, $FF4E00)
Next t
StopDrawing()
TransparentSpriteColor(front, 0)
Repeat
ClearScreen(0)
StartDrawing(ScreenOutput())
Box(0, 0,ScreenWidth(), ScreenHeight(), $FFFFFF)
StopDrawing()
Repeat
ev = WindowEvent()
If ev = #PB_Event_CloseWindow
Quit = 1
EndIf
Until ev = 0
ExamineKeyboard()
If KeyboardPushed(#PB_Key_Escape)
Quit = 1
EndIf
If KeyboardPushed(#PB_Key_Left) And back\x > 0
back\x - 2
ElseIf KeyboardPushed(#PB_Key_Right) And back\x < (ScreenWidth()-SpriteWidth(back\id))
back\x + 2
EndIf
DisplaySprite(back\id, back\x, 0)
DisplayTransparentSprite(front, 0, 0)
FlipBuffers()
Until KeyboardReleased(#PB_Key_Return) Or Quit = 1
FreeSprite(front)
FreeSprite(back\id)
If Quit = 1
End
Else
ProcedureReturn #True
EndIf
EndProcedure
Procedure.i Hiltons_Lilac()
Protected cross.i, d2.Vec2D, timecount.i
Protected Dim sp.i(17), count.i = 0
SetWindowTitle(md\Win, "Hilton's lilac. Focus towards center.")
sp(0) = CreateSprite(#PB_Any, ScreenHeight() / 12, ScreenHeight() / 12)
StartDrawing(SpriteOutput(sp(0)))
Circle(SpriteWidth(sp(0))/2, SpriteHeight(sp(0))/2, SpriteHeight(sp(0))/2 - 2, $E600FD)
Circle(SpriteWidth(sp(0))/2, SpriteHeight(sp(0))/2, SpriteHeight(sp(0))/5 - 2, $000000)
StopDrawing()
TransparentSpriteColor(sp(0), 0)
For x = 1 To 16
sp(x) = CopySprite(sp(0), #PB_Any)
Next x
cross = CreateSprite(#PB_Any, 20, 20)
StartDrawing(SpriteOutput(cross))
LineXY(10, 0, 10, 20, $333333)
LineXY(0, 10, 20, 10, $333333)
StopDrawing()
TransparentSpriteColor(cross, 0)
timecount = ElapsedMilliseconds()
Repeat
ClearScreen($EBEAEB)
Repeat
ev = WindowEvent()
If ev = #PB_Event_CloseWindow
Quit = 1
EndIf
Until ev = 0
ExamineKeyboard()
If KeyboardPushed(#PB_Key_Escape)
Quit = 1
EndIf
For x = 0 To 16
OrbitCalc2D(d2, ScreenWidth()/2-SpriteWidth(sp(x))/2, ScreenHeight()/2 - SpriteHeight(sp(x))/2, x * 25.5 , 0, 200)
If x <> count
DisplayTransparentSprite(sp(x), d2\x, d2\y)
EndIf
Next x
If ElapsedMilliseconds() - timecount > 50
If count + 1 > 16
count = 0
Else
count + 1
EndIf
timecount = ElapsedMilliseconds()
EndIf
DisplayTransparentSprite(cross, ScreenWidth()/2 - 10, ScreenHeight()/2 - 10)
FlipBuffers()
Until KeyboardReleased(#PB_Key_Return) Or Quit = 1
FreeSprite(cross)
For x = 0 To 16
FreeSprite(sp(x))
Next x
If Quit = 1
End
Else
ProcedureReturn #True
EndIf
EndProcedure
Procedure.i Tilted_Table()
Protected top.i, low.i
SetWindowTitle(md\Win, "Tilted table or what?.")
top = CreateImage(#PB_Any, ScreenWidth()/2, ScreenHeight()/10)
StartDrawing(ImageOutput(top))
Box(0, 0, ImageWidth(top), ImageHeight(top), $000000)
Box(2, 2, ImageWidth(top)-4, ImageHeight(top)-4, $EBEAEB)
For x = -160 To ImageWidth(top)+160 Step 16
LineXY(x,0, x+160, ImageHeight(top), $000000)
Next x
StopDrawing()
low = CreateImage(#PB_Any, ScreenWidth()/2, ScreenHeight()/8)
StartDrawing(ImageOutput(low))
Box(0, 0, ImageWidth(low), ImageHeight(low), $000000)
Box(2, 2, ImageWidth(low)-4, ImageHeight(low)-4, $EBEAEB)
For x = ImageWidth(low)+160 To - 160 Step -16
LineXY(x,0, x-160, ImageHeight(low), $000000)
Next x
StopDrawing()
Repeat
ClearScreen($EBEAEB)
StartDrawing(ScreenOutput())
DrawImage(ImageID(top), ScreenWidth()/2 - ImageWidth(top)/2, ScreenHeight()/4)
Circle(ScreenWidth()/2, (ScreenHeight()/4 + ImageHeight(top)) + 5, 5, $FF5A00)
DrawImage(ImageID(low), ScreenWidth()/2 - ImageWidth(low)/2, (ScreenHeight()/4 + ImageHeight(top)) + 13)
StopDrawing()
Repeat
ev = WindowEvent()
If ev = #PB_Event_CloseWindow
Quit = 1
EndIf
Until ev = 0
ExamineKeyboard()
If KeyboardPushed(#PB_Key_Escape)
Quit = 1
EndIf
FlipBuffers()
Until KeyboardReleased(#PB_Key_Return) Or Quit = 1
FreeImage(top)
FreeImage(low)
If Quit = 1
End
Else
ProcedureReturn #True
EndIf
EndProcedure
Procedure.i Hering()
Protected oimg.i, nimg.i, index.i = 0
SetWindowTitle(md\Win, "The Hering illusion. Straight lines? (Space key)")
oimg = CreateImage(#PB_Any, ScreenWidth(), ScreenHeight())
StartDrawing(ImageOutput(oimg))
Box(0, 0, ScreenWidth(), ScreenHeight(), $F5F5F5)
LineXY(0, 0, ScreenWidth(), ScreenHeight(), $454545)
LineXY(0, ScreenHeight(), ScreenWidth(), 0, $454545)
LineXY(ScreenWidth()/2, 0, ScreenWidth()/2, ScreenHeight(),$454545)
LineXY(ScreenWidth()/3, 0, ScreenWidth() - ScreenWidth()/3, ScreenHeight(), $454545)
LineXY(ScreenWidth()/4, 0, ScreenWidth() - ScreenWidth()/4, ScreenHeight(), $454545)
LineXY(0, ScreenHeight()/4, ScreenWidth(), ScreenHeight() - ScreenHeight()/4, $454545)
LineXY(0, ScreenHeight()-ScreenHeight()/4, ScreenWidth(),ScreenHeight()/4, $454545)
LineXY(0, ScreenHeight()-ScreenHeight()/3, ScreenWidth(), ScreenHeight()/3, $454545)
LineXY(ScreenWidth()/3, ScreenHeight(), ScreenWidth()-ScreenWidth()/3, 0, $454545)
LineXY(0, ScreenHeight()/2 - 50, ScreenWidth(), ScreenHeight()/2 + 50, $454545)
LineXY(0, ScreenHeight()/2 + 50, ScreenWidth(), ScreenHeight()/2 - 50, $454545)
Box(0, ScreenHeight()/2 - 50, ScreenWidth(), 5, $6464EF)
Box(0, ScreenHeight()/2 + 50, ScreenWidth(), 5, $6464EF)
StopDrawing()
nimg = CreateImage(#PB_Any, ScreenWidth(), ScreenHeight())
StartDrawing(ImageOutput(nimg))
Box(0, 0, ScreenWidth(), ScreenHeight(), $F5F5F5)
Box(0, ScreenHeight()/2 - 50, ScreenWidth(), 5, $6464EF)
Box(0, ScreenHeight()/2 + 50, ScreenWidth(), 5, $6464EF)
StopDrawing()
Repeat
ClearScreen(0)
StartDrawing(ScreenOutput())
Select index
Case 0
DrawImage(ImageID(oimg), 0, 0)
Case 1
DrawImage(ImageID(nimg), 0, 0)
EndSelect
StopDrawing()
Repeat
ev = WindowEvent()
If ev = #PB_Event_CloseWindow
Quit = 1
EndIf
Until ev = 0
ExamineKeyboard()
If KeyboardPushed(#PB_Key_Escape)
Quit = 1
EndIf
If KeyboardReleased(#PB_Key_Space)
If index = 0 : index = 1 : Else : index = 0 : EndIf
EndIf
FlipBuffers()
Until KeyboardReleased(#PB_Key_Return) Or Quit = 1
FreeImage(oimg)
FreeImage(nimg)
If Quit = 1
End
Else
ProcedureReturn #True
EndIf
EndProcedure
EndModule
;--------------------------------------------
;This was something I did for fun some time ago.
;A small selection of optical illusions.
;--------------------------------------------
;Press Return key for next illusion
;Escape key quits the program
;By DK_PETER - Peter Bach
;--------------------------------------------
ret = _Illusions::SetResolution()
ret = _Illusions::Hering()
ret = _Illusions::Hiltons_Lilac()
ret = _Illusions::Induced_Contrast_Async()
ret = _Illusions::Moire_1()
ret = _Illusions::Monker_White()
ret = _Illusions::Pigeons()
ret = _Illusions::Scintillating_Grid()
ret = _Illusions::Tilted_Table()
ret = _Illusions::Gradient_illusion()