slederer/Tridora-CPU
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages 3 Wiki Activity Actions

examples: removed 5cubes due to unclear licensing

Browse source
This commit is contained in:
slederer 2024-09-13 01:28:58 +02:00
parent 61699e420a
commit cd9e1708c8
1 changed files with 0 additions and 253 deletions
Download patch file Download diff file Expand all files Collapse all files

253
examples/5cubes.pas
View file

@ -1,253 +0,0 @@
program five_cubes_in_a_row;
const MAX_Y = 400;
pi = 3.1415926;
type pointtype = record x,y:integer end;
var cube:array[1..6] of record
position:array[1..5] of record x,y,z:real end;
end;
c:char;
pcos,ncos,psin,nsin:real;
procedure rotx(dir:integer);
var y1,z1:real;i,o:integer;
begin
if dir=1 then
for i:=1 to 6 do
for o:=1 to 5 do
begin
y1:=pcos*cube[i].position[o].y-psin*cube[i].position[o].z;
z1:=psin*cube[i].position[o].y+pcos*cube[i].position[o].z;
cube[i].position[o].y:=y1;
cube[i].position[o].z:=z1;
end
else
for i:=1 to 6 do
for o:=1 to 5 do
begin
y1:=ncos*cube[i].position[o].y-nsin*cube[i].position[o].z;
z1:=nsin*cube[i].position[o].y+ncos*cube[i].position[o].z;
cube[i].position[o].y:=y1;
cube[i].position[o].z:=z1
end
end;
procedure roty(dir:integer);
var x1,z1:real;i,o:integer;
begin
if dir=1 then
for i:=1 to 6 do
for o:=1 to 5 do
begin
x1:=pcos*cube[i].position[o].x-psin*cube[i].position[o].z;
z1:=psin*cube[i].position[o].x+pcos*cube[i].position[o].z;
cube[i].position[o].x:=x1;
cube[i].position[o].z:=z1;
end
else
for i:=1 to 6 do
for o:=1 to 5 do
begin
x1:=ncos*cube[i].position[o].x-nsin*cube[i].position[o].z;
z1:=nsin*cube[i].position[o].x+ncos*cube[i].position[o].z;
cube[i].position[o].x:=x1;
cube[i].position[o].z:=z1
end
end;
procedure rotz(dir:integer);
var y1,x1:real;i,o:integer;
begin
if dir=1 then
for i:=1 to 6 do
for o:=1 to 5 do
begin
y1:=pcos*cube[i].position[o].y-psin*cube[i].position[o].x;
x1:=psin*cube[i].position[o].y+pcos*cube[i].position[o].x;
cube[i].position[o].y:=y1;
cube[i].position[o].x:=x1;
end
else
for i:=1 to 6 do
for o:=1 to 5 do
begin
y1:=ncos*cube[i].position[o].y-nsin*cube[i].position[o].x;
x1:=nsin*cube[i].position[o].y+ncos*cube[i].position[o].x;
cube[i].position[o].y:=y1;
cube[i].position[o].x:=x1
end
end;
procedure display_cube(col:integer);
var i,o,a:integer;c:integer;
stran:array[1..4] of pointtype;
color:integer;
begin
for i:=1 to 6 do
if cube[i].position[5].z>0 then
with cube[i] do
begin
for a:=1 to 5 do
begin
if col>0 then c:=a else c:=0;
if((a=4)and(c>0))then color :=6 else color:= c;
for o:=1 to 4 do
begin
stran[o].x:=a*100+round(position[o].x);
stran[o].y:=MAX_Y div 2+round(position[o].y);
end;
drawline(stran[1].x,stran[1].y,stran[2].x,stran[2].y,color);
drawline(stran[2].x,stran[2].y,stran[3].x,stran[3].y,color);
drawline(stran[3].x,stran[3].y,stran[4].x,stran[4].y,color);
drawline(stran[4].x,stran[4].y,stran[1].x,stran[1].y,color);
end;
end;
end;
procedure init;
var i,gm,gd:integer;
entrance:array[1..11]of integer;
begin
entrance := [ 1,2,3,4,5,20,7,56,57,58,59 ];
InitGraphics;
ClearGraphics;
pcos:=cos(6*2*pi/360);
ncos:=cos(-6*2*pi/360);
psin:=sin(6*2*pi/360);
nsin:=sin(-6*2*pi/360);
setpalette(1,$700);
with cube[1] do
begin
position[1].x:=-25;
position[1].y:=-25;
position[1].z:=+25;
position[2].x:=+25;
position[2].y:=-25;
position[2].z:=+25;
position[3].x:=+25;
position[3].y:=+25;
position[3].z:=+25;
position[4].x:=-25;
position[4].y:=+25;
position[4].z:=+25;
position[5].x:=0;
position[5].y:=0;
position[5].z:=25;
end;
with cube[2] do
begin
position[1].x:=-25;
position[1].y:=-25;
position[1].z:=-25;
position[2].x:=+25;
position[2].y:=-25;
position[2].z:=-25;
position[3].x:=+25;
position[3].y:=-25;
position[3].z:=+25;
position[4].x:=-25;
position[4].y:=-25;
position[4].z:=+25;
position[5].x:=0;
position[5].z:=0;
position[5].y:=-25;
end;
with cube[3] do
begin
position[1].x:=-25;
position[1].y:=+25;
position[1].z:=+25;
position[2].x:=+25;
position[2].y:=+25;
position[2].z:=+25;
position[3].x:=+25;
position[3].y:=+25;
position[3].z:=-25;
position[4].x:=-25;
position[4].y:=+25;
position[4].z:=-25;
position[5].x:=0;
position[5].z:=0;
position[5].y:=25;
end;
with cube[4] do
begin
position[1].x:=-25;
position[1].y:=-25;
position[1].z:=-25;
position[2].x:=-25;
position[2].y:=-25;
position[2].z:=+25;
position[3].x:=-25;
position[3].y:=+25;
position[3].z:=+25;
position[4].x:=-25;
position[4].y:=+25;
position[4].z:=-25;
position[5].y:=0;
position[5].z:=0;
position[5].x:=-25;
end;
with cube[5] do
begin
position[1].x:=+25;
position[1].y:=-25;
position[1].z:=+25;
position[2].x:=+25;
position[2].y:=-25;
position[2].z:=-25;
position[3].x:=+25;
position[3].y:=+25;
position[3].z:=-25;
position[4].x:=+25;
position[4].y:=+25;
position[4].z:=+25;
position[5].x:=25;
position[5].y:=0;
position[5].z:=0;
end;
with cube[6] do
begin
position[1].x:=-25;
position[1].y:=+25;
position[1].z:=-25;
position[2].x:=+25;
position[2].y:=+25;
position[2].z:=-25;
position[3].x:=+25;
position[3].y:=-25;
position[3].z:=-25;
position[4].x:=-25;
position[4].y:=-25;
position[4].z:=-25;
position[5].x:=0;
position[5].y:=0;
position[5].z:=-25;
end;
end;
begin
init;
repeat
display_cube(1);
repeat
c:=conin;
until(upcase(c)in['E','Q','S','W','D','A','J','K','L','U','I','O'])or(c=#27);
display_cube(0);
case upcase(c) of
'E':rotz(0);
'Q':rotz(1);
'S':rotx(0);
'W':rotx(1);
'D':roty(0);
'A':roty(1);
'J':begin rotx(1);roty(1);rotz(1);end;
'L':begin rotx(0);roty(0);rotz(0);end;
'K':begin rotx(1);roty(0);rotz(1);end;
'I':begin rotx(0);roty(1);rotz(0);end;
'U':begin rotx(0);roty(1);rotz(1);end;
'O':begin rotx(1);roty(0);rotz(0);end;
end;
until c=#27;
end.