📄 backgr.pas
字号:
mov bh, 0
mul bx
add di, ax
mov si, di
add cx, 0202h
mov dh, 0
mov al, $F0
seges mov dl, [di]
cmp dl, $F0
jz @_0
@3: cmp dl, $E0
jnz @@1
dec dh
stosb
dec di
@@1: add di, 320
seges mov dl, [di]
cmp dl, $F0
jnz @_1
@_0: dec dh
jmp @2
@_1: dec ch
jnz @3
@2: mov di, si
mov al, $E0
sub di, 320
seges mov dl, [di]
cmp dl, $E0
jz @5
@4: cmp dl, $F0
jnz @@2
dec dh
stosb
dec di
@@2: sub di, 320
seges mov dl, [di]
cmp dl, $E0
jz @5
dec cl
jnz @4
or dh, dh
jnz @5
pop bx
seges
mov byte ptr [bx], CheckCode
jmp @6
@5: pop bx
@6: pop si
pop di
inc di
inc bx
pop cx
dec cx
jnz @1
pop ds
pop es
end;
end;
*)
procedure BrickPalette (i: Integer);
var
j: Integer;
begin
i := i mod 20;
for j := 0 to 19 do
if (i = j) then
CopyPalette ($FE, $E0 + j)
else
if (((i + 2) mod 20) = j) then
CopyPalette ($FF, $E0 + j)
else
CopyPalette ($FD, $E0 + j);
end;
procedure LargeBrickPalette (i: Integer);
var
j: Integer;
begin
i := i mod 32;
for j := 0 to 31 do
if (i = j) or (((i + 1) mod 32) = j) then
CopyPalette ($D6, $E0 + j)
else
if (((i + 3) mod 32) = j) or (((i + 4) mod 32) = j) then
CopyPalette ($D4, $E0 + j)
else
CopyPalette ($D1, $E0 + j);
end;
procedure PillarPalette (i: Integer);
const
ShadowPos = 28;
ShadowEnd = 36;
var
j, k, l: Integer;
c1, c2, c3,
Base: Byte;
begin
Base := Options.BackGrColor1;
C1 := Palette [Base, 0] div 4;
C2 := Palette [Base, 1] div 4;
C3 := Palette [Base, 2] div 4;
i := i mod 60;
j := 0;
k := 1;
repeat
for l := j to k do
begin
OutPalette ($C0 + ((l + i) mod 60), C1 + k, C2 + k, C3 + k);
OutPalette ($C0 + ((ShadowPos + i - l) mod 60), C1 + k, C2 + k, C3 + k);
end;
j := k;
k := k + 1;
until k >= 15;
for j := ShadowPos to ShadowEnd do
begin
if C1 > 0 then Dec (C1);
if C2 > 0 then Dec (C2);
if C3 > 0 then Dec (C3);
OutPalette ($C0 + ((j + i) mod 60), C1, C2, C3);
end;
Base := Options.BackGrColor2;
C1 := Palette [Base, 0] div 4;
C2 := Palette [Base, 1] div 4;
C3 := Palette [Base, 2] div 4;
for j := ShadowEnd + 1 to 59 do
OutPalette ($C0 + ((i + j) mod 60), C1, C2, C3);
end;
procedure WindowPalette (i: Integer);
var
j: Integer;
begin
i := i mod 32;
for j := 0 to 5 do
CopyPalette (1, $E0 + ((i + j) mod 32));
for j := 6 to 31 do
CopyPalette (16, $E0 + ((i + j) mod 32));
end;
procedure DrawBackGr (FirstTime: Boolean);
var
i: Integer;
begin
case BackGround of
1 .. 3,
9..11: PutBackGr (BackGrMap, FirstTime);
end;
if Clouds <> 0 then
begin
i := XView div CloudSpeed;
PutClouds (i, XView - LastXView [CurrentPage]);
end;
end;
procedure DrawBackGrMap (Y1, Y2, Shift: Integer; C: Byte);
var
i, j: Integer;
begin
for i := 0 to 320 - 1 do
begin
for j := Y1 - BackGrMap[i + Shift] to Y2 do
if GetPixel (i, j) >= $C0 then
PutPixel (i, j, C);
end;
end;
procedure DrawPalBackGr;
var
i: Integer;
begin
i := Round (XView / BrickSpeed);
case BackGround of
4: BrickPalette (i);
5: LargeBrickPalette (i);
6: PillarPalette (i);
7: WindowPalette (i);
end;
end;
procedure ReadColorMap;
var
i: Integer;
begin
for i := 0 to NV * H - 1 do
ColorMap [i] := GetPixel (XView + Shift, i) * 256 +
GetPixel (XView + Shift + 1, i);
end;
procedure DrawBricks (X, Y, W, H: Integer);
begin
{
for i := X to X + W - 1 do
begin
Fill (i, Y, 1, H div 2, $E0 + i and $0F);
PutPixel (i, Y, $F0);
Fill (i, Y + H div 2, 1, H div 2, $E0 + (i + 8) and $0F);
PutPixel (i, Y + H div 2, $F0);
end;
}
PutImage (X, Y, W, H, @PALBRICK000^);
end;
procedure LargeBricks (X, Y, W, H: Integer);
begin
asm
push es
mov bx, 320
mov ax, Y
{ add ax, WindowY }
mul bx
add ax, X
mov di, ax
mov bl, al
and bl, 00011111b
add bl, $E0
mov ax, VGA_SEGMENT
mov es, ax
mov cx, H
mov dx, Y
push dx
add dl, 14 { Why? }
and dl, 00010000b
or dl, dl
jz @0
xor bl, 16
@0:
pop dx
jcxz @End
@1:
push cx
mov cx, W
jcxz @3
push di
mov al, $D4
and dl, 00001111b
cmp dl, 2
jz @@1
ja @Brick
mov al, $D1
cmp dl, 0
ja @@1
mov al, $D6
xor bl, 16
@@1:
mov ah, al
shr cx, 1
rep stosw
rcl cx, 1
rep stosb
jmp @LineEnd
@Brick:
mov al, bl
@2:
and al, 00011111b
add al, $E0
stosb
inc al
dec cx
jnz @2
@LineEnd:
pop di
add di, 320
@3:
pop cx
inc dx
dec cx
jnz @1
@End:
pop es
end;
end;
procedure Pillar (X, Y, W, H: Integer);
begin
case (X div W) mod 3 of
0: PutImage (X, Y, W, H, @PalPill000^);
1: PutImage (X, Y, W, H, @PalPill001^);
2: PutImage (X, Y, W, H, @PalPill002^);
end;
(* asm
push es
mov bx, 320
mov ax, Y
{ add ax, WindowY }
mul bx
add ax, X
mov di, ax
mov bl, al
or bl, $C0
mov ax, VidMemSeg
mov es, ax
mov cx, H
jcxz @End
@1:
push cx
mov cx, W
jcxz @3
push di
mov al, bl
@2: or al, 0C0h
stosb
inc al
dec cx
jnz @2
@LineEnd:
pop di
add di, 320
@3:
pop cx
inc dx
dec cx
jnz @1
@End:
pop es
end; *)
end;
procedure Windows (X, Y, W, H: Integer);
const
Y1 = 50;
Y2 = 80;
begin
asm
push es
mov bx, 320
mov ax, Y
mov si, ax
add si, 22
{ add ax, WindowY }
mul bx
add ax, X
mov di, ax
mov bl, al
or bl, $C0
mov ax, VGA_SEGMENT
mov es, ax
mov cx, H
jcxz @End
@1:
push cx
mov cx, W
jcxz @3
push di
mov al, bl
and si, 00011111b
cmp si, 00000011b
jb @4
@2: and al, 00011111b
or al, 11100000b
stosb
inc al
dec cx
jnz @2
jmp @LineEnd
@4: mov ax, 0101h
cld
shr cx, 1
rep stosw
rcl cx, 1
rep stosb
@LineEnd:
pop di
add di, 320
@3:
pop cx
inc dx
inc si
dec cx
jnz @1
@End:
pop es
end;
end;
procedure DrawBackGrBlock (X, Y, W, H: Integer);
var
i: Integer;
begin
{ Fill (X, Y, W, H, $F0); }
if Options.SkyType in [2, 5, 9, 10, 11] then
SmoothFill (X, Y, W, H)
else
case BackGround of
4: DrawBricks (X, Y, W, H);
5: LargeBricks (X, Y, W, H);
6: Pillar (X, Y, W, H);
7: Windows (X, Y, W, H);
else
for i := 0 to H - 1 do
Fill (X, Y + i, W, 1, ColorMap [Y + i]);
end;
end;
procedure SmoothFill (X, Y, W, H: Integer);
{ X mod 4 = 0, W mod 4 = 0 }
var
PageOffset: Word;
Horizon: Integer;
begin
PageOffset := GetPageOffset;
Horizon := Options.Horizon - 4; { -4 for BumpBlock }
asm
push es
mov ax, VGA_SEGMENT
mov es, ax
mov dx, Y
mov ax, VIR_SCREEN_WIDTH / 4
mul dx
mov di, X
shr di, 1
shr di, 1
add di, ax
add di, PageOffset
mov ax, Y
cmp ax, Horizon
jb @0
mov dl, $F0
jmp @3
@0: mov bl, 6
div bl
mov dl, $EF
sub dl, al
cmp dl, $E0
jnb @3
mov dl, $E0
@3: mov dh, ah
mov bx, H
cmp bx, 0
jle @End
mov cx, W
shr cx, 1
shr cx, 1
cld
@1: push di
push cx
push dx
mov ah, 0Fh
mov al, MAP_MASK
mov dx, SC_INDEX
out dx, ax
pop dx
mov al, dl
mov ah, al
shr cx, 1
rep stosw
rcl cx, 1
rep stosb
pop cx
pop di
cmp dh, 3
jb @4
cmp al, $E0
jz @2
cmp al, $F0
jz @2
sub ax, 0101h
@2: push ax
push dx
mov ah, 0101b
push cx
mov cl, dh
and cl, 1
shl ah, cl
pop cx
mov al, MAP_MASK
mov dx, SC_INDEX
out dx, ax
pop dx
pop ax
push di
push cx
shr cx, 1
rep stosw
rcl cx, 1
rep stosb
pop cx
pop di
@4: inc Y
mov ax, Y
cmp ax, Horizon
jb @9
mov dl, $F0
@9: inc dh
cmp dh, 6
jnz @5
mov dh, 0
cmp dl, $E0
jz @5
cmp dl, $F0
jz @5
dec dl
@5: add di, VIR_SCREEN_WIDTH / 4
dec bx
jnz @1
@End:
pop es
end;
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -