initial commit

This commit is contained in:
slederer 2024-09-19 14:12:22 +02:00
commit 60db522e87
107 changed files with 36924 additions and 0 deletions

81
examples/3dcube.pas Normal file
View file

@ -0,0 +1,81 @@
program cube;
const Cw = 640;
Ch = 400;
Vw = 4;
Vh = 3;
D = 3.5;
RED = 2;
GREEN = 3;
BLUE = 4;
type point2d = record x,y:real; end;
point3d = record x,y,z:real; end;
var vAf,vBf,vCf,vDf:point3d;
vAb,vBb,vCb,vDb:point3d;
function viewportToCanvas(x,y:real):point2d;
begin
viewportToCanvas.x := x * Cw/Vw;
viewportToCanvas.y := y * Ch/Vh;
end;
function projectVertex(v:point3d):point2d;
begin
projectVertex := viewportToCanvas(v.x * D / v.z, v.y * D / v.z);
end;
procedure initPoint3d(var p:point3d;x,y,z:real);
begin
p.x := x;
p.y := y;
p.z := z;
end;
procedure DrawLine2d(p1,p2:point2d; color:integer);
begin
drawline(Cw div 2 + trunc(p1.x),Ch div 2 + trunc(p1.y),
Cw div 2 + trunc(p2.x), Ch div 2 + trunc(p2.y),
color);
end;
begin
initGraphics;
(* The four "front" vertices *)
initPoint3d(vAf,-2.0, -0.5, 5.0);
initPoint3d(vBf,-2.0, 0.5, 5.0);
initPoint3d(vCf,-1.0, 0.5, 5.0);
initPoint3d(vDf,-1.0, -0.5, 5.0);
(* The four "back" vertices *)
(*
vAb = [-2, -0.5, 6]
vBb = [-2, 0.5, 6]
vCb = [-1, 0.5, 6]
vDb = [-1, -0.5, 6] *)
initPoint3d(vAb,-2.0, -0.5, 6.0);
initPoint3d(vBb,-2.0, 0.5, 6.0);
initPoint3d(vCb,-1.0, 0.5, 6.0);
initPoint3d(vDb,-1.0, -0.5, 6.0);
(* The front face *)
DrawLine2d(ProjectVertex(vAf), ProjectVertex(vBf), BLUE);
DrawLine2d(ProjectVertex(vBf), ProjectVertex(vCf), BLUE);
DrawLine2d(ProjectVertex(vCf), ProjectVertex(vDf), BLUE);
DrawLine2d(ProjectVertex(vDf), ProjectVertex(vAf), BLUE);
(* The back face *)
DrawLine2d(ProjectVertex(vAb), ProjectVertex(vBb), RED);
DrawLine2d(ProjectVertex(vBb), ProjectVertex(vCb), RED);
DrawLine2d(ProjectVertex(vCb), ProjectVertex(vDb), RED);
DrawLine2d(ProjectVertex(vDb), ProjectVertex(vAb), RED);
(* The front-to-back edges *)
DrawLine2d(ProjectVertex(vAf), ProjectVertex(vAb), GREEN);
DrawLine2d(ProjectVertex(vBf), ProjectVertex(vBb), GREEN);
DrawLine2d(ProjectVertex(vCf), ProjectVertex(vCb), GREEN);
DrawLine2d(ProjectVertex(vDf), ProjectVertex(vDb), GREEN);
end.

10
examples/LICENSES.md Normal file
View file

@ -0,0 +1,10 @@
# rtpair.pas
originally from [https://github.com/Postrediori/Pascal-Raytracer](https://github.com/Postrediori/Pascal-Raytracer), no license specified there
# Attributions for included media files
* ara.pict: Tuxyso / Wikimedia Commons / CC-BY-SA-3.0
https://commons.wikimedia.org/wiki/File:Ara-Zoo-Muenster-2013.jpg
* snow_leopard.pict: Tambako The Jaguar, CC BY-SA 2.0 <https://creativecommons.org/licenses/by-sa/2.0>, via Wikimedia Commons
https://commons.wikimedia.org/wiki/File:Snow_leopard_portrait.jpg
* shinkansen.pict: 投稿者が撮影, CC BY-SA 3.0 <http://creativecommons.org/licenses/by-sa/3.0/>, via Wikimedia Commons
https://commons.wikimedia.org/wiki/File:0key22-86.JPG

BIN
examples/ara.pict Normal file

Binary file not shown.

116
examples/conway.pas Normal file
View file

@ -0,0 +1,116 @@
program conway;
const cellwidth = 4;
cellheight = 4;
cols = 40;
rows = 25;
WHITE = 1;
BLACK = 0;
type gridType = array [1..rows, 1..cols] of integer;
var grid:gridType;
ch:char;
procedure initGrid(var g:gridType);
var x,y:integer;
begin
randomize;
for y := 1 to rows do
for x := 1 to cols do
if (random and 1024) > 512 then
grid[y,x] := 1;
end;
procedure updateGrid;
var oldGrid:gridType;
neighbors:integer;
x,y:integer;
wasAlive:boolean;
isAlive:boolean;
gen:integer;
begin
oldGrid := grid;
for y := 1 to rows do
for x := 1 to cols do
begin
wasAlive := oldGrid[y,x] > 0;
isAlive := false;
neighbors := 0;
if y > 1 then
begin
if x > 1 then
if oldGrid[y-1,x-1] > 0 then neighbors := neighbors + 1;
if oldGrid[y-1,x] > 0 then neighbors := neighbors + 1;
if x < cols then
if oldGrid[y-1,x+1] > 0 then neighbors := neighbors + 1;
end;
if x > 1 then
if oldGrid[y,x-1] > 0 then neighbors := neighbors + 1;
if x < cols then
if oldGrid[y,x+1] > 0 then neighbors := neighbors + 1;
if y < rows then
begin
if x > 1 then
if oldGrid[y+1,x-1] > 0 then neighbors := neighbors + 1;
if oldGrid[y+1,x] > 0 then neighbors := neighbors + 1;
if x < cols then
if oldGrid[y+1,x+1] > 0 then neighbors := neighbors + 1;
end;
if wasAlive then
begin
if (neighbors = 2) or (neighbors = 3) then
isAlive := true;
end
else
if neighbors = 3 then
isAlive := true;
if isAlive then
begin
gen := grid[y,x];
if gen < 8 then gen := gen + 1;
grid[y,x] := gen;
end
else
grid[y,x] := 0;
end;
end;
procedure drawGrid;
var x,y:integer;
color:integer;
screenx,screeny:integer;
begin
for x := 1 to cols do
for y := 1 to rows do
begin
color := grid[y,x];
screenx := x * cellwidth;
screeny := y * cellheight;
putpixel(screenx,screeny,color);
putpixel(screenx+1,screeny,color);
putpixel(screenx,screeny+1,color);
putpixel(screenx+1,screeny+1,color);
end;
end;
begin
initGraphics;
initGrid(grid);
repeat
drawGrid;
updateGrid;
{ delay(100); }
until conavail;
read(ch);
end.

15
examples/hellop.pas Normal file
View file

@ -0,0 +1,15 @@
(* a simple test program to say
hello to the world *)
program hello;
begin
(* if there is an argument, use it *)
if ParamCount > 0 then
writeln('Hello ', ParamStr(1))
else
writeln('Hello World!');
end.
{ Note that the last END needs to be followed by the . character,
not by a ; character. This is because ; means that there is
another statement. It does not mark the end of the statement
like in other languages. The . marks the end of the program text. }

70
examples/lines.pas Normal file
View file

@ -0,0 +1,70 @@
PROGRAM lines;
PROCEDURE movinglines(max_x, max_y, max_col, ms:INTEGER);
VAR x1,y1:INTEGER;
VAR x2,y2:INTEGER;
VAR delta_x1, delta_y1:INTEGER;
VAR delta_x2, delta_y2:INTEGER;
VAR col:INTEGER;
BEGIN
x1 := 120;
y1 := 90;
x2 := 340;
y2 := 220;
delta_x1 := 9;
delta_y1 := 4;
delta_x2 := 3;
delta_y2 := 7;
col := 1;
WHILE NOT CONAVAIL DO
BEGIN
x1 := x1 + delta_x1;
y1 := y1 + delta_y1;
x2 := x2 + delta_x2;
y2 := y2 + delta_y2;
IF (x1 > max_x) OR (x1 < 0) THEN
BEGIN
delta_x1 := -delta_x1;
x1 := x1 + delta_x1;
END;
IF (y1 > max_y) OR (y1 < 0) THEN
BEGIN
delta_y1 := -delta_y1;
y1 := y1 + delta_y1;
END;
IF (x2 > max_x) OR (x2 < 0) THEN
BEGIN
delta_x2 := -delta_x2;
x2 := x2 + delta_x2;
END;
IF (y2 > max_y) OR (y2 < 0) THEN
BEGIN
delta_y2 := -delta_y2;
y2 := y2 + delta_y2;
END;
col := col + 1;
IF col > max_col THEN col := 1;
DRAWLINE(x1,y1,x2,y2,col);
delay(ms);
END;
END;
BEGIN
initgraphics;
movinglines(639,399,15,0);
END.

63
examples/mandelbrot.pas Normal file
View file

@ -0,0 +1,63 @@
program mandelbrot;
const width = 459; height = 405;
xstart = -2.02; xend = 0.7;
ystart = -1.2; yend = 1.2;
maxIterations = 25;
maxColors = 15;
var dx,dy:real;
col,row:integer;
cx,cy:real;
iterations:integer;
colors:array[0..15] of integer = { ($000, $020, $031, $042,
$053, $064, $075, $086,
$097, $0A8, $0B9, $0CA,
$0DB, $0EC, $0FD, $0FF); }
($000, $100, $200, $411,
$522, $633, $744, $855,
$966, $A77, $B88, $C99,
$DAA, $EBB, $FCC, $FDD);
c:integer;
function iterate(x,y:real):integer;
var zx,zy:real;
tmp:real;
count:integer;
begin
zx := 0.0; zy := 0.0; count := 0;
repeat
tmp := zx*zx - zy*zy + x;
zy := 2.0*zx*zy + cy;
zx := tmp;
count := count + 1;
until (zx*zx + zy*zy > 4.0) or (count = MaxIterations);
iterate := count;
end;
begin
initgraphics;
for c:=0 to 15 do
setpalette(c, colors[c]);
dx := (xend - xstart) / (width - 1);
dy := (yend - ystart) / (height - 1);
for col := 0 to width - 1 do
begin
cx := xstart + col * dx;
for row := 0 to height - 1 do
begin
cy := yend - row * dy;
iterations := iterate(cx, cy);
if iterations = MaxIterations then
c := 0
else
c := iterations mod MaxColors + 1;
putpixel(col, row, c);
end;
end;
end.

110
examples/rtpair.pas Normal file
View file

@ -0,0 +1,110 @@
{ Raytracer for a scene with a pair of spheres and multiple reflections }
program RtPair;
const MaxX = 639;
MaxY = 399;
HalfX = 320;
HalfY = 200;
var
gd, gm: Integer;
N, M: Integer;
X, Y, Z: Real;
U, V, W: Real;
I, E, F, P, D, T, R, G: Real;
stopReflection: Boolean;
C: Integer;
function Sign(x: Real): Real;
begin
if x>0 then
Sign := 1
else
Sign := -1;
end;
begin
InitGraphics;
SetPalette(0, $000);
SetPalette(4, $A00);
SetPalette(11, $0FF);
SetPalette(15, $FFF);
for N:=0 to MaxY do
for M:=0 to MaxX do
begin
{ Rays' origin point }
X := 0;
Y := -0.1;
Z := 3;
U := (M - 318) / HalfX;
V := (HalfY - N) / 321.34;
W := 1 / Sqrt(U*U + V*V + 1);
U := U*W;
V := V*W;
{ I is the horizontal direction of ray }
{ based on whether it is in left (U<0) or right (U>0) half of the screen }
I := Sign(U);
G := 1;
{ Start the reflection cycle. }
{ A ray may reflect between one sphere and another multiple times before hitting floor or sky. }
repeat
stopReflection := True;
E := X-I;
F := Y-I;
P := U*E + V*F - W*Z;
D := P*P - E*E - F*F - Z*Z + 1;
{ If ray reflects from a sphere one more time }
if D>0 then
begin
T := -P - Sqrt(D);
if T>0 then
begin
X := X + T*U;
Y := Y + T*V;
Z := Z - T*W;
E := X - I;
F := Y - I;
G := Z;
P := 2*(U*E + V*F - W*G);
U := U - P*E;
V := V - P*F;
W := W + P*G;
{ Invert ray's direction and continue the reflection cycle }
I := -I;
stopReflection := False;
end;
end;
until stopReflection;
{ If Y<0 (V<0) a ray hits the floor }
if V<0 then
begin
P := (Y+2)/V;
{ Select checkers floor with Black (0) and Red (4) tiles }
C := (1 And (Round(X - U*P) + Round(Z + W*P))) * 4;
end else begin
{ If Y>0 (V>0) a ray hits the sky }
{ Default sky color is Cyan (11) }
C := 11;
{ Condition for using color White (15) to create fancy Cyan-White horizon }
R := ArcTan(U/W);
R := 0.2+0.1*Cos(3*R)*Abs(Sin(5*R));
if Abs(G)<0.35 then
R := R + 1;
if V<R then
C := 15;
end;
{ Draw current pixel }
PutPixel(M, N, C);
end;
repeat until ConAvail;
end.

BIN
examples/shinkansen.pict Normal file

Binary file not shown.

BIN
examples/snow_leopard.pict Normal file

Binary file not shown.

143
examples/test.txt Normal file
View file

@ -0,0 +1,143 @@
THE ELEMENTS OF STYLE
BY
WILLIAM STRUNK, Jr.
PROFESSOR OF ENGLISH
IN
CORNELL UNIVERSITY
NEW YORK
HARCOURT, BRACE AND COMPANY
COPYRIGHT, 1918, 1919, BY
WILLIAM STRUNK, JR.
COPYRIGHT, 1920, BY
HARCOURT, BRACE AND HOWE, INC.
THE MAPLE PRESS YORK PA
CONTENTS
Page
I. Introductory 5
II. Elementary Rules of Usage 7
1. Form the possessive singular of nouns by adding _'s_ 7
2. In a series of three or more terms with a single
conjunction, use a comma after each term except the last 7
3. Enclose parenthetic expressions between commas 8
4. Place a comma before a conjunction introducing a
co-ordinate clause 10
5. Do not join independent clauses by a comma 11
6. Do not break sentences in two 12
7. A participial phrase at the beginning of a sentence must
refer to the grammatical subject 13
III. Elementary Principles of Composition 15
8. Make the paragraph the unit of composition: one paragraph
to each topic 15
9. As a rule, begin each paragraph with a topic sentence; end
it in conformity with the beginning 17
10. Use the active voice 19
11. Put statements in positive form 21
12. Use definite, specific, concrete language 22
13. Omit needless words 24
14. Avoid a succession of loose sentences 25
15. Express co-ordinate ideas in similar form 26
16. Keep related words together 28
17. In summaries, keep to one tense 29
18. Place the emphatic words of a sentence at the end 31
IV. A Few Matters of Form 33
V. Words and Expressions Commonly Misused 36
VI. Spelling 48
VII. Exercises on Chapters II and III 50
I. INTRODUCTORY
This book aims to give in brief space the principal requirements of
plain English style. It aims to lighten the task of instructor and
student by concentrating attention (in Chapters II and III) on a few
essentials, the rules of usage and principles of composition most
commonly violated. In accordance with this plan it lays down three rules
for the use of the comma, instead of a score or more, and one for the
use of the semicolon, in the belief that these four rules provide for
all the internal punctuation that is required by nineteen sentences out
of twenty. Similarly, it gives in Chapter III only those principles of
the paragraph and the sentence which are of the widest application. The
book thus covers only a small portion of the field of English style. The
experience of its writer has been that once past the essentials,
students profit most by individual instruction based on the problems of
their own work, and that each instructor has his own body of theory,
which he may prefer to that offered by any textbook.
The numbers of the sections may be used as references in correcting
manuscript.
The writer's colleagues in the Department of English in Cornell
University have greatly helped him in the preparation of his manuscript.
Mr. George McLane Wood has kindly consented to the inclusion under
Rule 10 of some material from his _Suggestions to Authors_.
The following books are recommended for reference or further study: in
connection with Chapters II and IV, F. Howard Collins, _Author and
Printer_ (Henry Frowde); Chicago University Press, _Manual of Style_;
T. L. De Vinne, _Correct Composition_ (The Century Company); Horace
Hart, _Rules for Compositors and Printers_ (Oxford University Press);
George McLane Wood, _Extracts from the Style-Book of the Government
Printing Office_ (United States Geological Survey); in connection with
Chapters III and V, _The King's English_ (Oxford University Press); Sir
Arthur Quiller-Couch, _The Art of Writing_ (Putnam), especially the
chapter, Interlude on Jargon; George McLane Wood, _Suggestions to
Authors_ (United States Geological Survey); John Lesslie Hall, _English
Usage_ (Scott, Foresman and Co.); James P. Kelley, _Workmanship in
Words_ (Little, Brown and Co.). In these will be found full discussions
of many points here briefly treated and an abundant store of
illustrations to supplement those given in this book.
It is an old observation that the best writers sometimes disregard the
rules of rhetoric. When they do so, however, the reader will usually
find in the sentence some compensating merit, attained at the cost of
the violation. Unless he is certain of doing as well, he will probably
do best to follow the rules. After he has learned, by their guidance, to
write plain English adequate for everyday uses, let him look, for the
secrets of style, to the study of the masters of literature.

44
examples/viewpict.pas Normal file
View file

@ -0,0 +1,44 @@
program viewpict;
type PictData = record
magic, mode:integer;
palette: array [0..15] of integer;
pixeldata: array [0..31999] of integer;
end;
var pic:PictData;
filename:string;
infile:file;
ch:char;
procedure loadPalette(var pic:PictData);
var i:integer;
begin
for i := 0 to 15 do
setpalette(i, pic.palette[i]);
end;
procedure loadPic(var pic:PictData);
begin
PutScreen(pic.pixeldata);
end;
begin
if ParamCount > 0 then
filename := ParamStr(1)
else
begin
write('Filename> ');
readln(filename);
end;
open(infile, filename, ModeReadonly);
read(infile, pic);
close(infile);
writeln('magic: ', pic.magic, ' mode:', pic.mode);
loadPalette(pic);
loadPic(pic);
read(ch);
end.