{$APPTYPE CONSOLE}{$mode objfpc}
program OpenGLFractal_OnePixelScroll;
uses
SysUtils,
GL,GLExt,Glu,Glut;
//Fast random, origin from BK-0010 (PDP-11 community)
//rework to Pascal by Gemini AI
var Seed: Integer = 1;
function Rand(v: Integer): Integer;
var
a, e: Integer;
begin
a := seed;
e := byte(a) shr 1;
a := (a and $FFFFFF00 shl 1) or (a and 1 shl 8);
e := e xor (a shr 24);
Result := a xor e;
seed := Result;
end;
exports rand;
const
TEX_WIDTH = 1024;
TEX_HEIGHT = 512;
var
TextureID: GLuint;
//All coordinates in integer
CurX: Integer = 0;
CurY: Integer = 0;
FineScroll: Integer = 0; // Shift to 0..1023
LineBuffer: array[0..8 * TEX_HEIGHT * 3 - 1] of GLubyte;
// mouse
RotX: Single = -28.0;// -34.50;
//45.0;
RotZ: Single = 90.0;
Zoom: Single = -1.2;//-2.5;
MouseX, MouseY: Integer;
MouseButton: Integer = -1;
// Write byte in vertical line
procedure BufferByte(Y, Val: Integer);
var
BitIdx, PixelOffset: Integer;
Color: integer;
begin
for BitIdx := 7 downto 0 do
begin
PixelOffset := (Y * 8 + (7 - BitIdx)) * 3;
if ((Val shr BitIdx) and 1) = 1 then
Color := 0 else Color := $FFFFFF;
LineBuffer[PixelOffset + 0] := Color; // R
LineBuffer[PixelOffset + 1] := Color shr 8; // G
LineBuffer[PixelOffset + 2] := Color shr 16;// B
end;
end;
// Visualizer (from Speccy/Orion-128)
procedure RenderLine;
var
R: Integer;
begin
R := Rand(0);
BufferByte(CurY, R);
Inc(CurY);
if CurY >= TEX_HEIGHT then // Vertical line complete
begin
CurY := 0;
glBindTexture(GL_TEXTURE_2D, TextureID);
// Drop 8-pixels block to current X coordinate CurX
glTexSubImage2D(GL_TEXTURE_2D, 0, CurX, 0, 8, TEX_HEIGHT, GL_RGB, GL_UNSIGNED_BYTE, @LineBuffer);
// Shift marker up 8 pixels
CurX := CurX + 8;
if CurX >= TEX_WIDTH then
begin
CurX := 0;
end;
end;
end;
procedure Idle; cdecl;
var
i: Integer;
begin
for i := 1 to (TEX_HEIGHT div 8) do RenderLine;
FineScroll := FineScroll + 1;
if FineScroll >= TEX_WIDTH then
FineScroll := FineScroll - TEX_WIDTH;
glutPostRedisplay;
end;
procedure Display; cdecl;
var
NormOffset: Single;
begin
glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
NormOffset := ((FineScroll + 8) / TEX_WIDTH);
glMatrixMode(GL_TEXTURE);
glLoadIdentity;
glTranslatef(NormOffset, 0.0, 0.0); // Shift one pixel
// --- ������� ������ (3D) ---
glMatrixMode(GL_MODELVIEW);
glLoadIdentity;
glTranslatef(0.0, 0.0, Zoom);
glRotatef(RotX, 1.0, 0.0, 0.0);
glRotatef(RotZ, 0.0, 0.0, 1.0);
glBindTexture(GL_TEXTURE_2D, TextureID);
glBegin(GL_QUADS);
glTexCoord2f(0.0, 0.0); glVertex3f(-1.5, -0.75, 0.0);
glTexCoord2f(1.0, 0.0); glVertex3f( 1.5, -0.75, 0.0);
glTexCoord2f(1.0, 1.0); glVertex3f( 1.5, 0.75, 0.0);
glTexCoord2f(0.0, 1.0); glVertex3f(-1.5, 0.75, 0.0);
glEnd;
Sleep(40);
glutSwapBuffers;
end;
procedure Reshape(Width, Height: Integer); cdecl;
begin
if Height = 0 then Height := 1;
glViewport(0, 0, Width, Height);
glMatrixMode(GL_PROJECTION);
glLoadIdentity;
gluPerspective(45.0, Width / Height, 0.1, 100.0);
glMatrixMode(GL_MODELVIEW);
end;
procedure Mouse(button, state, x, y: Integer); cdecl;
begin
if state = GLUT_DOWN then
begin
MouseButton := button; MouseX := x; MouseY := y;
end else MouseButton := -1;
end;
procedure Motion(x, y: Integer); cdecl;
begin
if MouseButton = GLUT_LEFT_BUTTON then
begin
RotZ := RotZ + (x - MouseX) * 0.5;
RotX := RotX + (y - MouseY) * 0.5;
MouseX := x; MouseY := y; glutPostRedisplay;
end;
if MouseButton = GLUT_RIGHT_BUTTON then
begin
Zoom := Zoom + (y - MouseY) * 0.01; MouseY := y; glutPostRedisplay;
end;
end;
procedure Init; var i:integer;
begin
glClearColor(0.0, 0.0, 0.0, 1.0);
glEnable(GL_TEXTURE_2D);
glEnable(GL_DEPTH_TEST);
glGenTextures(1, @TextureID);
glBindTexture(GL_TEXTURE_2D, TextureID);
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_REPEAT);
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE);
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR);//GL_NEAREST);
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);//GL_NEAREST);
glTexImage2D(GL_TEXTURE_2D, 0, GL_RGB, TEX_WIDTH, TEX_HEIGHT, 0, GL_RGB, GL_UNSIGNED_BYTE, nil);
for i := 1 to (TEX_WIDTH * TEX_HEIGHT) div 8 do RenderLine;
end;
begin
glutInit(@argc, argv);
glutInitDisplayMode(GLUT_DOUBLE or GLUT_RGB or GLUT_DEPTH);
glutInitWindowSize(1024, 600);
glutCreateWindow('XORSHIFT 1-Pixel Scroll');
Init;
glutReshapeFunc(@Reshape);
glutDisplayFunc(@Display);
glutIdleFunc(@Idle);
glutMouseFunc(@Mouse);
glutMotionFunc(@Motion);
glutMainLoop;
end.
