📄 figures.pas
字号:
unit Figures;
interface
uses
Buffers,
Palettes,
VGA256,
BackGr;
const
N1 = 3;
N2 = 13;
var
FigList: Array [1 .. N1, 1 .. N2] of ImageBuffer;
Bricks: Array [0 .. 3] of ImageBuffer;
var
Sky: Byte;
procedure ReColor (P1, P2: Pointer; C: Byte);
procedure ReColor2 (P1, P2: Pointer; C1, C2: Byte);
procedure Replace (P1, P2: Pointer; N1, N2: Byte);
procedure Mirror (P1, P2: Pointer);
procedure Rotate (P1, P2: Pointer);
procedure InitSky (NewSky: Byte);
procedure InitPipes (NewColor: Byte);
procedure InitWalls (W1, W2, W3: Byte);
procedure DrawSky (X, Y, W, H: Integer);
procedure SetSkyPalette;
procedure Redraw (X, Y: Integer);
procedure BuildWorld;
implementation
{$I Green.$00} {$I Green.$01} {$I Green.$02}
{$I Green.$03} {$I Green.$04}
{$I Ground.$00} {$I Ground.$01} {$I Ground.$02}
{$I Ground.$03} {$I Ground.$04}
{$I Sand.$00} {$I Sand.$01} {$I Sand.$02}
{$I Sand.$03} {$I Sand.$04}
{$I Brown.$00} {$I Brown.$01} {$I Brown.$02}
{$I Brown.$03} {$I Brown.$04}
{$I Grass.$00} {$I Grass.$01} {$I Grass.$02}
{$I Grass.$03} {$I Grass.$04}
{$I Des.$00} {$I Des.$01} {$I Des.$02}
{$I Des.$03} {$I Des.$04}
{$I Grass1.$00} {$I Grass2.$00} {$I Grass3.$00}
{$I Grass1.$01} {$I Grass2.$01} {$I Grass3.$01}
{$I Grass1.$02} {$I Grass2.$02} {$I Grass3.$02}
{$I Pipe.$00} {$I Pipe.$01} {$I Pipe.$02} {$I Pipe.$03}
{$I Block.$00} {$I Block.$01}
{$I Quest.$00} {$I Quest.$01}
{$I WPalm.$00}
{$I Palm0.$00} {$I Palm1.$00} {$I Palm2.$00} {$I Palm3.$00}
{$I Palm0.$01} {$I Palm1.$01} {$I Palm2.$01} {$I Palm3.$01}
{$I Palm0.$02} {$I Palm1.$02} {$I Palm2.$02} {$I Palm3.$02}
{$I Fence.$00} {$I Fence.$01}
{$I Pin.$00}
{$I Fall.$00} {$I Fall.$01}
{$I Lava.$00} {$I Lava.$01}
{$I Lava2.$01} {$I Lava2.$02} {$I Lava2.$03} {$I Lava2.$04} {$I Lava2.$05}
{$I Tree.$00} {$I Tree.$01} {$I Tree.$02} {$I Tree.$03}
{$I Brick0.$00} {$I Brick0.$01} {$I Brick0.$02}
{$I Brick1.$00} {$I Brick1.$01} {$I Brick1.$02}
{$I Brick2.$00} {$I Brick2.$01} {$I Brick2.$02}
{$I Exit.$00} {$I Exit.$01}
{$I Wood.$00}
{$I Coin.$00}
{$I Note.$00}
{$I Window.$00} {$I Window.$01}
{$I SmTree.$00} {$I SmTree.$01}
{$I XBlock.$00}
procedure ConvertGrass (P0, P1, P2: ImageBufferPtr);
var
i, j: Integer;
C0, C1, C2: Byte;
procedure Convert;
begin
C0 := C1;
if C1 = C2 then Exit;
if C1 = 2 then
begin
C0 := 153;
if C2 = 0 then Exit;
C0 := 155;
end
else
if C1 = 3 then
begin
C0 := 154;
if C2 = 0 then Exit;
C0 := 156;
end
else { C1 = 0 }
if C2 = 2 then
C0 := 157
else
C0 := 155;
end;
begin
for i := 1 to H do
for j := 1 to W do
begin
C1 := Ord (P1^ [i, j]);
C2 := Ord (P2^ [i, j]);
Convert;
P0^ [i, j] := Chr (C0);
end;
end;
procedure ReColor (P1, P2: Pointer; C: Byte);
begin
asm
push ds
push es
lds si, P1
les di, P2
cld
mov cx, H
@1: push cx
mov cx, W
@2: lodsb
cmp al, $10
jbe @3
and al, 07h
add al, C
@3: stosb
loop @2
pop cx
loop @1
pop es
pop ds
end;
end;
procedure ReColor2 (P1, P2: Pointer; C1, C2: Byte);
begin
asm
push ds
push es
lds si, P1
les di, P2
cld
mov cx, H
@1: push cx
mov cx, W
@2: lodsb
cmp al, $10
jbe @3
and al, 0Fh
cmp al, 8
jb @UseC1
and al, 7
add al, C2
jmp @3
@UseC1:
add al, C1
@3: stosb
loop @2
pop cx
loop @1
pop es
pop ds
end;
end;
procedure Replace (P1, P2: Pointer; N1, N2: Byte);
begin
asm
push ds
push es
lds si, P1
les di, P2
cld
mov cx, H
@1: push cx
mov cx, W
@2: lodsb
cmp al, N1
jnz @3
mov al, N2
@3: stosb
loop @2
pop cx
loop @1
pop es
pop ds
end;
end;
procedure Mirror (P1, P2: Pointer);
type
PlaneBuffer = array[0..H - 1, 0..W div 4 - 1] of Byte;
PlaneBufferArray = array[0..3] of PlaneBuffer;
PlaneBufferArrayPtr = ^PlaneBufferArray;
var
Source, Dest: PlaneBufferArrayPtr;
procedure Swap (Plane1, Plane2: Byte);
var
i, j: Byte;
begin
for j := 0 to H - 1 do
for i := 0 to W div 4 - 1 do
begin
Dest^[Plane2, j, i] := Source^[Plane1, j, W div 4 - 1 - i];
Dest^[Plane1, j, i] := Source^[Plane2, j, W div 4 - 1 - i];
end;
end;
begin
Source := P1;
Dest := P2;
Swap (0, 3);
Swap (1, 2);
end;
procedure Rotate (P1, P2: Pointer);
begin
asm
push ds
push es
lds si, P1
les di, P2
cld
add si, W * H
dec si
mov cx, H
@1: push cx
mov cx, W
@2: std
lodsb
cld
stosb
loop @2
pop cx
loop @1
pop es
pop ds
end;
end;
procedure InitSky (NewSky: Byte);
begin
Sky := NewSky;
end;
procedure InitPipes (NewColor: Byte);
begin
ReColor (@Pipe000, @Pipe000, NewColor);
ReColor (@Pipe001, @Pipe001, NewColor);
ReColor (@Pipe002, @Pipe002, NewColor);
ReColor (@Pipe003, @Pipe003, NewColor);
end;
procedure InitWalls (W1, W2, W3: Byte);
procedure InitWall (N, WallType: Byte);
var
i, j: Integer;
begin
case WallType of
0: begin
Move (@Green000^, FigList [N, 1], SizeOf (FigList [N, 1]));
Move (@Green001^, FigList [N, 2], SizeOf (FigList [N, 2]));
Move (@Green002^, FigList [N, 4], SizeOf (FigList [N, 4]));
Move (@Green003^, FigList [N, 5], SizeOf (FigList [N, 5]));
Move (@Green004^, FigList [N, 10], SizeOf (FigList [N, 10]));
end;
1: begin
Move (@Sand000^, FigList [N, 1], SizeOf (FigList [N, 1]));
Move (@Sand001^, FigList [N, 2], SizeOf (FigList [N, 2]));
Move (@Sand002^, FigList [N, 4], SizeOf (FigList [N, 4]));
Move (@Sand003^, FigList [N, 5], SizeOf (FigList [N, 5]));
Move (@Sand004^, FigList [N, 10], SizeOf (FigList [N, 10]));
end;
2: begin
i := Options. GroundColor1;
j := Options. GroundColor2;
Recolor2 (@Green000, @FigList [N, 1], i, j);
Recolor2 (@Green001, @FigList [N, 2], i, j);
Recolor2 (@Green002, @FigList [N, 4], i, j);
Recolor2 (@Green003, @FigList [N, 5], i, j);
Recolor2 (@Green004, @FigList [N, 10], i, j);
end;
3: begin
Move (@Brown000^, FigList [N, 1], SizeOf (FigList [N, 1]));
Move (@Brown001^, FigList [N, 2], SizeOf (FigList [N, 2]));
Move (@Brown002^, FigList [N, 4], SizeOf (FigList [N, 4]));
Move (@Brown003^, FigList [N, 5], SizeOf (FigList [N, 5]));
Move (@Brown004^, FigList [N, 10], SizeOf (FigList [N, 10]));
end;
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -