Peripheral drift illusion

From Rosetta Code
Revision as of 01:25, 28 August 2022 by Thundergnat (talk | contribs) (syntax highlighting fixup automation)
Task
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!

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

Translation of: Wren
Library: APDF
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

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

Translation of: Julia
Library: gintro

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.

See window screenshot here.

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()

Perl

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;

See offsite SVG image

Phix

Library: Phix/online

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

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,
    ]
)

See offsite SVG image

Wren

Library: DOME

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()