Peripheral drift illusion
You are encouraged to solve this task according to the task description, using any language you may know.
- Task
Generate and display a Peripheral Drift Illusion
The image appears to be moving even though it is perfectly static.
Provide a link to show the output, either by running the code online or a screenshot uploaded to a suitable image host.
- References
Action![edit]
PROC DrawTile(INT x BYTE y,flip,c1,c2)
BYTE i
Color=1
FOR i=y+2 TO y+11
DO
Plot(x+1,i) DrawTo(x+5,i)
OD
Color=c1
IF flip THEN
Plot(x,y+12) DrawTo(x,y) DrawTo(x+6,y)
ELSE
Plot(x,y) DrawTo(x+6,y) DrawTo(x+6,y+12)
FI
Plot(x+1,y+1) DrawTo(x+5,y+1)
Color=c2
IF flip THEN
Plot(x,y+13) DrawTo(x+6,y+13) DrawTo(x+6,y+1)
ELSE
Plot(x,y+1) DrawTo(x,y+13) DrawTo(x+6,y+13)
FI
Plot(x+1,y+12) DrawTo(x+5,y+12)
RETURN
PROC Draw()
INT x,y,n
BYTE flip,c1,c2
FOR y=0 TO 8
DO
FOR x=0 TO 15
DO
n=(x-y)&15
IF (n RSH 2)&1 THEN
flip=1
ELSE
flip=0
FI
IF (n RSH 3)&1 THEN
c1=3 c2=2
ELSE
c1=2 c2=3
FI
DrawTile(x*10,y*20+6,flip,c1,c2)
OD
OD
RETURN
PROC Main()
BYTE CH=$02FC ;Internal hardware value for last key pressed
BYTE PALNTSC=$D014 ;To check if PAL or NTSC system is used
Graphics(15+16)
IF PALNTSC=15 THEN
SetColor(4,14,10) ;yellow for NTSC
SetColor(0,8,4) ;blue for NTSC
ELSE
SetColor(4,13,10) ;yellow for PAL
SetColor(0,7,4) ;blue for PAL
FI
SetColor(1,0,0)
SetColor(2,0,14)
Draw()
DO UNTIL CH#$FF OD
CH=$FF
RETURN
- Output:
Screenshot from Atari 8-bit computer
Ada[edit]
with PDF_Out; use PDF_Out;
procedure Drift is
X_Distance : constant := 30.0;
Y_Distance : constant := 30.0;
X_Length : constant := 20.0;
Y_Length : constant := 20.0;
Edge_Width : constant := 1.5;
Corner : constant Point := (220.0, 140.0);
type Edge_Kind is (Top, Right, Bottom, Left);
type Square_Kind is (Left_Top, Top_Right, Right_Bottom, Bottom_Left);
-- Signifies the white edges on the blue squares
LT : constant Square_Kind := Left_Top;
TR : constant Square_Kind := Top_Right;
RB : constant Square_Kind := Right_Bottom;
BL : constant Square_Kind := Bottom_Left;
type X_Index is range 0 .. 11;
type Y_Index is range 0 .. 11;
Squares : constant array (Y_Index, X_Index) of Square_Kind :=
(11 => (LT, BL, BL, RB, RB, TR, TR, LT, LT, BL, BL, RB),
10 => (LT, LT, BL, BL, RB, RB, TR, TR, LT, LT, BL, BL),
09 => (TR, LT, LT, BL, BL, RB, RB, TR, TR, LT, LT, BL),
08 => (TR, TR, LT, LT, BL, BL, RB, RB, TR, TR, LT, LT),
07 => (RB, TR, TR, LT, LT, BL, BL, RB, RB, TR, TR, LT),
06 => (RB, RB, TR, TR, LT, LT, BL, BL, RB, RB, TR, TR),
05 => (BL, RB, RB, TR, TR, LT, LT, BL, BL, RB, RB, TR),
04 => (BL, BL, RB, RB, TR, TR, LT, LT, BL, BL, RB, RB),
03 => (LT, BL, BL, RB, RB, TR, TR, LT, LT, BL, BL, RB),
02 => (LT, LT, BL, BL, RB, RB, TR, TR, LT, LT, BL, BL),
01 => (TR, LT, LT, BL, BL, RB, RB, TR, TR, LT, LT, BL),
00 => (TR, TR, LT, LT, BL, BL, RB, RB, TR, TR, LT, LT));
-- PDF has origo in lower left corner of the paper. Reverse
-- Y_Index so the program text looks like the output.
Light_Olive : constant Color_Type := (0.827, 0.816, 0.016);
Pale_Blue : constant Color_Type := (0.196, 0.314, 1.000);
White : constant Color_Type := (1.000, 1.000, 1.000);
Colors : constant array (Square_Kind, Edge_Kind) of Color_Type :=
(Left_Top => (Top | Left => White, others => Black),
Top_Right => (Top | Right => White, others => Black),
Right_Bottom => (Right | Bottom => White, others => Black),
Bottom_Left => (Bottom | Left => White, others => Black));
PDF : PDF_Out_File;
procedure Fill_Poly (P1, P2, P3, P4 : Point; Color : Color_Type) is
begin
PDF.Color (Color);
PDF.Move (Corner + P1);
PDF.Line (Corner + P2);
PDF.Line (Corner + P3);
PDF.Line (Corner + P4);
PDF.Finish_Path (Close_Path => True,
Rendering => Fill,
Rule => Nonzero_Winding_Number);
end Fill_Poly;
procedure Draw_Square (Pos : Point; Kind : Square_Kind) is
Inner_TL : constant Point := Pos + (0.0, Y_Length);
Inner_TR : constant Point := Pos + (X_Length, Y_Length);
Inner_BR : constant Point := Pos + (X_Length, 0.0);
Inner_BL : constant Point := Pos + (0.0, 0.0);
Outer_TL : constant Point := Inner_TL + (-Edge_Width, Edge_Width);
Outer_TR : constant Point := Inner_TR + (Edge_Width, Edge_Width);
Outer_BR : constant Point := Inner_BR + (Edge_Width, -Edge_Width);
Outer_BL : constant Point := Inner_BL + (-Edge_Width, -Edge_Width);
begin
Fill_Poly (Inner_TL, Inner_TR, Inner_BR, Inner_BL, Pale_Blue);
Fill_Poly (Inner_TL, Outer_TL, Outer_TR, Inner_TR, Colors (Kind, Top));
Fill_Poly (Inner_TR, Outer_TR, Outer_BR, Inner_BR, Colors (Kind, Right));
Fill_Poly (Inner_BR, Outer_BR, Outer_BL, Inner_BL, Colors (Kind, Bottom));
Fill_Poly (Inner_BL, Outer_BL, Outer_TL, Inner_TL, Colors (Kind, Left));
end Draw_Square;
procedure Draw_Squares is
begin
for X in Squares'Range (2) loop
for Y in Squares'Range (1) loop
Draw_Square (Pos => (X => Real (X) * X_Distance,
Y => Real (Y) * Y_Distance),
Kind => Squares (Y, X));
end loop;
end loop;
end Draw_Squares;
begin
PDF.Create ("peripheral-drift-illusion.pdf");
PDF.Page_Setup (A4_Landscape);
PDF.Color (Light_Olive);
PDF.Draw ((10.0, 10.0, 820.0, 575.0), Fill);
Draw_Squares;
PDF.Close;
end Drift;
Julia[edit]
Line color tables taken from the Wren example. See the output on imgur.
using Gtk, Colors, Cairo
function CodepenApp()
# left-top, top-right, right-bottom, bottom-left
LT, TR, RB, BL = 1, 2, 3, 4
edges = [
[LT, BL, BL, RB, RB, TR, TR, LT, LT, BL, BL, RB],
[LT, LT, BL, BL, RB, RB, TR, TR, LT, LT, BL, BL],
[TR, LT, LT, BL, BL, RB, RB, TR, TR, LT, LT, BL],
[TR, TR, LT, LT, BL, BL, RB, RB, TR, TR, LT, LT],
[RB, TR, TR, LT, LT, BL, BL, RB, RB, TR, TR, LT],
[RB, RB, TR, TR, LT, LT, BL, BL, RB, RB, TR, TR],
[BL, RB, RB, TR, TR, LT, LT, BL, BL, RB, RB, TR],
[BL, BL, RB, RB, TR, TR, LT, LT, BL, BL, RB, RB],
[LT, BL, BL, RB, RB, TR, TR, LT, LT, BL, BL, RB],
[LT, LT, BL, BL, RB, RB, TR, TR, LT, LT, BL, BL],
[TR, LT, LT, BL, BL, RB, RB, TR, TR, LT, LT, BL],
[TR, TR, LT, LT, BL, BL, RB, RB, TR, TR, LT, LT]]
W, B = colorant"white", colorant"darkgray"
colors = [
[W, B, B, W],
[W, W, B, B],
[B, W, W, B],
[B, B, W, W]]
win = GtkWindow("Peripheral drift illusion", 230, 230) |> (can = GtkCanvas())
@guarded draw(can) do widget
ctx = Gtk.getgc(can)
function line(x1, y1, x2, y2, colr)
set_source(ctx, colr)
move_to(ctx, x1, y1)
line_to(ctx, x2, y2)
stroke(ctx)
end
set_source(ctx, colorant"yellow")
rectangle(ctx, 0, 0, 250, 250)
fill(ctx)
set_line_width(ctx, 2)
for x in 1:12
px = 18 + x * 14
for y in 1:12
py = 18 + y * 14
set_source(ctx, colorant"skyblue")
rectangle(ctx, px, py, 10, 10)
fill(ctx)
carray = colors[edges[y][x]]
line(px, py, px + 9, py, carray[1])
line(px + 9, py, px + 9, py + 9, carray[2])
line(px + 9, py + 9, px, py + 9, carray[3])
line(px, py + 9, px, py, carray[4])
end
end
end
showall(win)
draw(can)
condition = Condition()
endit(w) = notify(condition)
signal_connect(endit, win, :destroy)
showall(win)
wait(condition)
end
CodepenApp()
Nim[edit]
A translation using Gtk via the gintro
bindings for Nim, so the code is quite different. We chose also different sizes for the window and the grid, and colors closer to those of the codepen demo.
import gintro/[glib, gobject, gtk, gio, cairo]
const
Width = 600
Height = 460
type
Color = array[3, float]
Edge {.pure.} = enum LT, TR, RB, BL
const
Edges = [[LT, BL, BL, RB, RB, TR, TR, LT, LT, BL, BL, RB],
[LT, LT, BL, BL, RB, RB, TR, TR, LT, LT, BL, BL],
[TR, LT, LT, BL, BL, RB, RB, TR, TR, LT, LT, BL],
[TR, TR, LT, LT, BL, BL, RB, RB, TR, TR, LT, LT],
[RB, TR, TR, LT, LT, BL, BL, RB, RB, TR, TR, LT],
[RB, RB, TR, TR, LT, LT, BL, BL, RB, RB, TR, TR],
[BL, RB, RB, TR, TR, LT, LT, BL, BL, RB, RB, TR],
[BL, BL, RB, RB, TR, TR, LT, LT, BL, BL, RB, RB],
[LT, BL, BL, RB, RB, TR, TR, LT, LT, BL, BL, RB],
[LT, LT, BL, BL, RB, RB, TR, TR, LT, LT, BL, BL],
[TR, LT, LT, BL, BL, RB, RB, TR, TR, LT, LT, BL],
[TR, TR, LT, LT, BL, BL, RB, RB, TR, TR, LT, LT]]
Black: Color = [0.0, 0.0, 0.0]
Blue: Color = [0.2, 0.3, 1.0]
White: Color = [1.0, 1.0, 1.0]
Yellow: Color = [0.8, 0.8, 0.0]
Colors: array[Edge, array[4, Color]] = [[White, Black, Black, White],
[White, White, Black, Black],
[Black, White, White, Black],
[Black, Black, White, White]]
#---------------------------------------------------------------------------------------------------
proc draw(area: DrawingArea; context: Context) =
## Draw the pattern in the area.
func line(x1, y1, x2, y2: float; color: Color) =
context.setSource(color)
context.moveTo(x1, y1)
context.lineTo(x2, y2)
context.stroke
context.setSource(Yellow)
context.rectangle(0, 0, Width, Height)
context.fill()
for x in 0..11:
let px = float(86 + x * 36)
for y in 0..11:
let py = float(16 + y * 36)
context.setSource(Blue)
context.rectangle(px, py, 24, 24)
context.fill()
let carray = Colors[Edges[y][x]]
context.setLineWidth(2)
line(px, py, px + 23, py, carray[0])
line(px + 23, py, px + 23, py + 23, carray[1])
line(px + 23, py + 23, px, py + 23, carray[2])
line(px, py + 23, px, py, carray[3])
#---------------------------------------------------------------------------------------------------
proc onDraw(area: DrawingArea; context: Context; data: pointer): bool =
## Callback to draw/redraw the drawing area contents.
area.draw(context)
result = true
#---------------------------------------------------------------------------------------------------
proc activate(app: Application) =
## Activate the application.
let window = app.newApplicationWindow()
window.setSizeRequest(Width, Height)
window.setTitle("Peripheral drift illusion")
# Create the drawing area.
let area = newDrawingArea()
window.add(area)
# Connect the "draw" event to the callback to draw the pattern.
discard area.connect("draw", ondraw, pointer(nil))
window.showAll()
#———————————————————————————————————————————————————————————————————————————————————————————————————
let app = newApplication(Application, "Rosetta.Illusion")
discard app.connect("activate", activate)
discard app.run()
- Output:
Window screenshot:
Perl[edit]
use strict;
use warnings;
my $svg = <<'EOD';
<svg xmlns="http://www.w3.org/2000/svg"
xmlns:svg="http://www.w3.org/2000/svg"
xmlns:xlink="http://www.w3.org/1999/xlink" width="1200" height="825">
<rect width="100%" height="100%" fill="#d3d004" />
<defs>
<g id="block">
<polygon points="-25,-25,-25,25,25,25" fill="white" />
<polygon points="25,25,25,-25,-25,-25" fill="black" />
<rect x="-20" y="-20" width="40" height="40" fill="#3250ff" />
</g>
</defs>
EOD
for my $X (1..15) {
for my $Y (1..10) {
my $r = int(($X + $Y) / 2) % 4 * 90;
my $x = $X * 75;
my $y = $Y * 75;
my $a = $r > 0 ? "rotate($r,$x,$y) " : '';
$svg .= qq{<use xlink:href="#block" transform="$a translate($x,$y)" />\n}
}
}
$svg .= '</svg>';
open my $fh, '>', 'peripheral-drift.svg';
print $fh $svg;
close $fh;
Phix[edit]
You can run this online here.
-- -- demo\rosetta\Peripheral_Drift_Illusion.exw -- ========================================== -- -- converted from https://codepen.io/josetxu/pen/rNmXjrq -- with javascript_semantics include pGUI.e Ihandle dlg, canvas cdCanvas cdcanvas constant title = "Peripheral Drift Illusion", CD_LIGHT_OLIVE = #d3d004, CD_PALE_BLUE = #3250ff, dxy = {{45,45},{0,45},{0,0},{45,0},{45,45},{0,45}} function redraw_cb(Ihandle /*ih*/, integer /*posx*/, /*posy*/) integer {width, height} = IupGetIntInt(canvas, "DRAWSIZE") cdCanvasActivate(cdcanvas) cdCanvasSetBackground(cdcanvas, CD_LIGHT_OLIVE) cdCanvasClear(cdcanvas) integer c = 0, cy = floor(height/2)*2-81 while cy>100 do integer d = c, cx = 81 while cx<width-100 do cdCanvasSetForeground(cdcanvas, CD_WHITE) cdCanvasBox(cdcanvas, cx, cx+45, cy, cy-45) cdCanvasSetForeground(cdcanvas, CD_BLACK) cdCanvasBegin(cdcanvas, CD_FILL) for i=4 to 6 do integer {dy,dx} = dxy[i-d] cdCanvasVertex(cdcanvas, cx+dx, cy-dy) end for cdCanvasEnd(cdcanvas) cdCanvasSetForeground(cdcanvas, CD_PALE_BLUE) cdCanvasBox(cdcanvas, cx+4, cx+41, cy-4, cy-41) d = remainder(d+(odd(cx)==odd(cy)),4) cx += 63 end while c = remainder(c+4-even(cy),4) cy -= 63 end while cdCanvasFlush(cdcanvas) return IUP_DEFAULT end function function map_cb(Ihandle ih) atom res = IupGetDouble(NULL, "SCREENDPI")/25.4 IupGLMakeCurrent(canvas) if platform()=JS then cdcanvas = cdCreateCanvas(CD_IUP, canvas) else cdcanvas = cdCreateCanvas(CD_GL, "10x10 %g", {res}) end if cdCanvasSetBackground(cdcanvas, CD_PARCHMENT) return IUP_DEFAULT end function function canvas_resize_cb(Ihandle /*canvas*/) integer {cw, ch} = IupGetIntInt(canvas, "DRAWSIZE") atom res = IupGetDouble(NULL, "SCREENDPI")/25.4 cdCanvasSetAttribute(cdcanvas, "SIZE", "%dx%d %g", {cw, ch, res}) return IUP_DEFAULT end function procedure main() IupOpen() canvas = IupGLCanvas("RASTERSIZE=780x600") -- (sensible restore size) sequence cb = {"MAP_CB", Icallback("map_cb"), "ACTION", Icallback("redraw_cb"), "RESIZE_CB", Icallback("canvas_resize_cb")} IupSetCallbacks(canvas, cb) dlg = IupDialog(canvas,`TITLE="%s",PLACEMENT=MAXIMIZED`,{title}) IupShow(dlg) if platform()!=JS then IupMainLoop() IupClose() end if end procedure main()
Raku[edit]
use SVG;
my @blocks = (1..15 X 1..10).map: -> ($X, $Y) {
my $x = $X * 75;
my $y = $Y * 75;
my $a = (my $r = ($X + $Y) div 2 % 4 * 90) > 0 ?? "rotate($r,$x,$y) " !! '';
:use['xlink:href'=>'#block', 'transform'=>"{$a}translate($x,$y)"]
}
'peripheral-drift-raku.svg'.IO.spurt: SVG.serialize(
svg => [
:1200width, :825height,
:rect[:width<100%>, :height<100%>, :fill<#d3d004>],
:defs[
:g[
:id<block>,
:polygon[:points<-25,-25,-25,25,25,25>, :fill<white>],
:polygon[:points<25,25,25,-25,-25,-25>, :fill<black>],
:rect[:x<-20>, :y<-20>, :width<40>, :height<40>, :fill<#3250ff>]
]
],
|@blocks,
]
)
Wren[edit]
This reproduces the codepen image and does indeed appear to move although it's static. See the output on imgur
import "dome" for Window
import "graphics" for Canvas, Color
// signifies the white edges on the blue squares
var LT = 0
var TR = 1
var RB = 2
var BL = 3
var Edges = [
[LT, BL, BL, RB, RB, TR, TR, LT, LT, BL, BL, RB],
[LT, LT, BL, BL, RB, RB, TR, TR, LT, LT, BL, BL],
[TR, LT, LT, BL, BL, RB, RB, TR, TR, LT, LT, BL],
[TR, TR, LT, LT, BL, BL, RB, RB, TR, TR, LT, LT],
[RB, TR, TR, LT, LT, BL, BL, RB, RB, TR, TR, LT],
[RB, RB, TR, TR, LT, LT, BL, BL, RB, RB, TR, TR],
[BL, RB, RB, TR, TR, LT, LT, BL, BL, RB, RB, TR],
[BL, BL, RB, RB, TR, TR, LT, LT, BL, BL, RB, RB],
[LT, BL, BL, RB, RB, TR, TR, LT, LT, BL, BL, RB],
[LT, LT, BL, BL, RB, RB, TR, TR, LT, LT, BL, BL],
[TR, LT, LT, BL, BL, RB, RB, TR, TR, LT, LT, BL],
[TR, TR, LT, LT, BL, BL, RB, RB, TR, TR, LT, LT]
]
var Light_olive = Color.hex("#d3d004")
var Pale_blue = Color.hex("#3250ff")
var W = Color.white
var B = Color.black
var Colors = [
[W, B, B, W],
[W, W, B, B],
[B, W, W, B],
[B, B, W, W]
]
class PeripheralDrift {
construct new() {
Window.resize(1000, 1000)
Canvas.resize(1000, 1000)
Window.title = "Peripheral drift illusion"
}
init() {
Canvas.cls(Light_olive)
for (x in 0..11) {
var px = 90 + x * 70
for (y in 0..11) {
var py = 90 + y * 70
Canvas.rectfill(px, py, 50, 50, Pale_blue)
drawEdge(px, py, Edges[y][x])
}
}
}
drawEdge(px, py, edge) {
var c = Colors[edge]
Canvas.line(px, py, px + 46, py, c[0], 4)
Canvas.line(px + 46, py, px + 46, py + 46, c[1], 4)
Canvas.line(px, py + 46, px + 46, py + 46, c[2], 4)
Canvas.line(px, py + 46, px, py, c[3], 4)
}
update() {}
draw(alpha) {}
}
var Game = PeripheralDrift.new()
XPL0[edit]
The illusion is more effective when the image is displayed full-screen.
proc DrawRect(X0, Y0, W, H, Color);
int X0, Y0, W, H, Color, Y;
for Y:= Y0 to Y0+H-1 do
[Move(X0, Y); Line(X0+W-1, Y, Color)];
proc DrawEdge(PX, PY, Colors, Edge);
int PX, PY, Colors, Edge;
int C;
[C:= Colors(Edge);
Move(PX, PY);
Line(PX+11, PY, C(0));
Line(PX+11, PY+11, C(1));
Line(PX, PY+11, C(2));
Line(PX, PY, C(3));
];
def ScrW=256, ScrH=256;
def LT=0, TR=1, RB=2, BL=3; \left top, etc.
def White = $ffffff, Black = 0;
def LightOlive = $d3d004, PaleBlue = $3250ff;
int Edges, Colors, X, Y, PX, PY;
[SetFB(ScrW, ScrH, 24);
\Signifies white and black edges on the blue squares
Edges:= [
[LT, BL, BL, RB, RB, TR, TR, LT, LT, BL, BL, RB],
[LT, LT, BL, BL, RB, RB, TR, TR, LT, LT, BL, BL],
[TR, LT, LT, BL, BL, RB, RB, TR, TR, LT, LT, BL],
[TR, TR, LT, LT, BL, BL, RB, RB, TR, TR, LT, LT],
[RB, TR, TR, LT, LT, BL, BL, RB, RB, TR, TR, LT],
[RB, RB, TR, TR, LT, LT, BL, BL, RB, RB, TR, TR],
[BL, RB, RB, TR, TR, LT, LT, BL, BL, RB, RB, TR],
[BL, BL, RB, RB, TR, TR, LT, LT, BL, BL, RB, RB],
[LT, BL, BL, RB, RB, TR, TR, LT, LT, BL, BL, RB],
[LT, LT, BL, BL, RB, RB, TR, TR, LT, LT, BL, BL],
[TR, LT, LT, BL, BL, RB, RB, TR, TR, LT, LT, BL],
[TR, TR, LT, LT, BL, BL, RB, RB, TR, TR, LT, LT] ];
Colors:= [
[White, Black, Black, White],
[White, White, Black, Black],
[Black, White, White, Black],
[Black, Black, White, White] ];
DrawRect(0, 0, ScrW, ScrH, LightOlive);
for X:= 0 to 11 do
[PX:= 27 + X*17;
for Y:= 0 to 11 do
[PY:= 27 + Y*17;
DrawRect(PX, PY, 12, 12, PaleBlue);
DrawEdge(PX, PY, Colors, Edges(Y,X));
];
];
]
- Output: