Apple-2-SW/tb1
1
0
Fork 0
mirror of https://github.com/deater/tb1.git synced 2024-06-17 23:29:27 +00:00
Code Issues Projects Releases Wiki Activity

Version 2.4a DOS release

Browse Source
This commit is contained in:
Vince Weaver 1996-08-26 21:02:00 -04:00
parent f99adb44a8
commit cc7023b536
68 changed files with 17153 additions and 2296 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
cc.tb1 Normal file
View File

Binary file not shown.

5
config.tb1 Normal file
View File

@ -0,0 +1,5 @@
1
1
544
7
1

79
detect.pas Normal file
View File

@ -0,0 +1,79 @@
{ SMIX is Copyright 1995 by Ethan Brodsky. All rights reserved. }
unit Detect;
interface
function GetSettings
(
var BaseIO : word;
var IRQ : byte;
var DMA : byte;
var DMA16 : byte
): boolean;
{Gets sound card settings from BLASTER environment variable }
{Parameters: }
{ BaseIO: Sound card base IO address }
{ IRQ: Sound card IRQ }
{ DMA: Sound card 8-bit DMA channel }
{ DMA16: Sound card 16-bit DMA channel (0 if none) }
{Returns: }
{ TRUE: Sound card settings found successfully }
{ FALSE: Sound card settings could not be found }
implementation
uses
DOS;
function UpcaseStr(Str: string): string;
var
i: byte;
Temp: string;
begin
Temp[0] := Str[0];
for i := 1 to Length(Str) do
Temp[i] := Upcase(Str[i]);
UpcaseStr := Temp;
end;
function GetSetting(Str: string; ID: char; Hex: boolean): word;
var
Temp : string;
Num : word;
Code : integer;
begin
Temp := Str;
if Pos(ID, Temp) <> 0
then
begin
Delete(Temp, 1, Pos(ID, Temp));
Delete(Temp, Pos(' ', Temp), 255);
if Hex then Insert('$', Temp, 1);
Val(Temp, Num, Code);
if Code = 0
then GetSetting := Num
else GetSetting := $FF;
end
else
GetSetting := $FF;
end;
function GetSettings
(
var BaseIO: word;
var IRQ: byte;
var DMA: byte;
var DMA16: byte
): boolean;
var
BLASTER: string;
begin
BLASTER := UpcaseStr(GetEnv('BLASTER'));
BaseIO := GetSetting(BLASTER, 'A', true); {Hex}
IRQ := GetSetting(BLASTER, 'I', false); {Decimal}
DMA := GetSetting(BLASTER, 'D', false); {Decimal}
DMA16 := GetSetting(BLASTER, 'H', false); {Decimal}
GetSettings := true;
if BLASTER = '' then GetSettings := false;
if BaseIO = $FF then GetSettings := false;
if IRQ = $FF then GetSettings := false;
if DMA = $FF then GetSettings := false;
{We can survive if there isn't a DMA16 channel}
end;
end.

12
file_id.diz Normal file
View File

@ -0,0 +1,12 @@
TOM BOMBEM 2.4a: Invasion Of The Inanimate Objects
Outer Space action game full of galactic intrigue!
Blow up incoming inanimate objects!
Fly low over a hostile spacecraft!
Beat the game! What fun!
By Vince Weaver
Internet: vmweaver@wam.umd.edu
Hate Mail: askbill@microsoft.com

20
hiscore.tb1 Normal file
View File

@ -0,0 +1,20 @@
Tom Bombem
VINCE
Vince
STEVE
aViince
HAIROLD
vinc
1500
1300
1120
1000
930
890
810
800
760
740

BIN
kapow.tb1 Normal file
View File

Binary file not shown.

1753
level2.pas Normal file
View File

File diff suppressed because it is too large Load Diff

202
level2.tb1 Normal file
View File

@ -0,0 +1,202 @@
31 31 31 31 31 31 31 31 31 31 31 31
5 7 5 5 5 5 5 5 5 5 7 5
5 5 3 5 30 30 30 30 5 3 5 5
5 5 5 5 4 4 4 4 5 5 5 5
15 15 15 15 31 31 31 31 15 15 15 15
17 17 17 17 16 16 16 16 17 17 17 17
9 9 9 9 9 9 9 9 9 9 9 9
9 9 9 9 9 9 9 9 9 9 9 9
9 9 9 9 9 9 9 9 9 9 9 9
9 9 9 9 9 9 9 9 9 9 9 9
9 9 9 9 9 9 9 9 9 9 9 9
9 9 9 9 9 9 9 9 9 9 9 9
7 9 9 9 9 9 9 9 9 9 9 7
9 9 9 9 9 9 9 9 9 9 9 9
9 9 9 9 9 9 9 9 9 9 9 9
12 9 9 9 12 9 9 12 9 9 9 12
9 9 9 9 9 9 9 9 9 9 9 9
9 9 9 9 9 9 9 9 9 9 9 9
30 30 30 30 30 30 30 30 30 30 30 30
0 0 0 0 0 0 0 0 0 0 0 0
2 2 18 19 0 0 0 0 19 18 2 2
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 19 0 0 0 0
0 0 0 0 18 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 10 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 11 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 13 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 12 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
15 15 15 15 15 15 15 15 15 15 15 15
0 0 0 0 0 0 0 0 0 0 0 0
0 4 4 4 4 4 4 4 4 4 4 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 13 0 0 0 0 0 0 13 0 0
0 0 0 13 0 0 0 0 13 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
14 0 0 0 14 0 0 14 0 0 0 14
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
11 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 11 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 11 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 11 0 14 14 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
31 31 31 31 31 31 31 31 31 31 31 31
5 5 5 5 5 5 5 5 5 5 5 5
5 5 5 5 5 5 5 5 5 5 5 5
10 10 10 10 10 10 10 10 10 10 10 10
5 5 5 5 5 5 5 5 5 5 5 5
5 5 5 5 5 5 5 5 5 5 5 5
30 30 30 30 30 30 30 30 30 30 30 30
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 11 11 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
12 0 0 0 0 0 0 0 0 0 0 12
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
14 13 0 0 18 18 18 18 0 0 13 14
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
19 19 0 0 0 0 0 0 0 0 19 19
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 13 0 0 0 0 0 0 0 0 13 0
31 31 31 31 31 31 31 31 31 31 31 31
5 5 5 5 5 5 5 5 5 5 5 5
8 7 8 3 8 8 8 8 3 8 7 8
5 5 5 5 5 5 5 5 5 5 5 5
5 5 5 5 5 5 5 5 5 5 5 5
5 5 5 5 5 5 5 5 5 5 5 5
9 13 9 9 9 9 9 9 9 9 13 9
9 9 13 9 9 9 9 9 9 13 9 9
9 9 9 9 9 9 9 9 9 9 9 9
9 9 9 9 9 9 9 9 9 9 9 9
9 9 9 9 9 9 9 9 9 9 9 9
9 9 9 14 9 9 9 9 14 9 9 9
9 9 9 9 14 9 9 14 9 9 9 9
9 9 9 9 9 9 9 9 9 9 9 9
9 9 9 9 9 9 9 9 9 9 9 9
9 9 9 9 9 9 9 9 9 9 9 9
30 30 30 30 30 30 30 30 30 30 30 30
0 0 0 0 0 0 0 0 0 0 0 0
15 15 15 15 15 15 15 15 15 15 15 15
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
19 0 0 0 0 0 0 0 0 0 0 19
0 0 0 19 0 11 11 0 19 0 0 0
0 12 0 0 0 0 0 0 0 0 12 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
14 0 0 0 14 0 0 0 14 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 14 0 0 0 14 0 0 0 14 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
13 0 13 0 0 0 0 13 0 13 0 13
0 0 0 0 13 0 0 13 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
14 0 0 0 14 0 0 14 0 0 0 14
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
17 17 0 0 0 17 17 0 0 0 17 17
0 0 0 14 0 10 0 0 14 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 14 0 0 0 0 0 0 0 0 14 0
0 0 0 0 0 0 0 0 13 0 0 0
0 0 0 0 0 0 0 0 0 0 10 0
0 0 0 0 0 0 10 0 0 0 0 0
11 0 0 0 0 0 0 0 0 0 0 11
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
16 13 16 16 16 16 16 16 16 16 13 16
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
15 5 5 5 5 5 5 5 5 5 5 15
15 10 0 0 0 0 0 0 0 0 10 15
15 0 0 10 3 3 3 3 10 0 0 15
15 0 0 0 10 10 10 10 0 0 0 15
15 0 10 0 10 4 4 10 0 10 0 15
30 30 30 30 30 30 30 30 30 30 30 30
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0

2214
level3.pas Normal file
View File

File diff suppressed because it is too large Load Diff

202
level4.tb1 Normal file
View File

@ -0,0 +1,202 @@
31 31 31 31 31 31 31 31 31 31 31 31
5 7 5 5 5 5 5 5 5 5 7 5
5 5 3 5 30 30 30 30 5 3 5 5
5 5 5 5 4 4 4 4 5 5 5 5
15 15 15 15 31 31 31 31 15 15 15 15
17 17 17 17 16 16 16 16 17 17 17 17
9 9 9 9 9 9 9 9 9 9 9 9
9 9 9 9 9 9 9 9 9 9 9 9
9 9 9 9 9 9 9 9 9 9 9 9
9 9 9 9 9 9 9 9 9 9 9 9
9 9 9 9 9 9 9 9 9 9 9 9
9 9 9 9 9 9 9 9 9 9 9 9
7 9 9 9 9 9 9 9 9 9 9 7
9 9 9 9 9 9 9 9 9 9 9 9
9 9 9 9 9 9 9 9 9 9 9 9
12 9 9 9 12 9 9 12 9 9 9 12
9 9 9 9 9 9 9 9 9 9 9 9
9 9 9 9 9 9 9 9 9 9 9 9
30 30 30 30 30 30 30 30 30 30 30 30
0 0 0 0 0 0 0 0 0 0 0 0
2 2 18 19 0 0 0 0 19 18 2 2
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 19 0 0 0 0
0 0 0 0 18 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 10 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 11 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 13 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 12 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
15 15 15 15 15 15 15 15 15 15 15 15
0 0 0 0 0 0 0 0 0 0 0 0
0 4 4 4 4 4 4 4 4 4 4 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 13 0 0 0 0 0 0 13 0 0
0 0 0 13 0 0 0 0 13 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
14 0 0 0 14 0 0 14 0 0 0 14
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
11 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 11 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 11 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 11 0 14 14 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
31 31 31 31 31 31 31 31 31 31 31 31
5 5 5 5 5 5 5 5 5 5 5 5
5 5 5 5 5 5 5 5 5 5 5 5
10 10 10 10 10 10 10 10 10 10 10 10
5 5 5 5 5 5 5 5 5 5 5 5
5 5 5 5 5 5 5 5 5 5 5 5
30 30 30 30 30 30 30 30 30 30 30 30
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 11 11 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
12 0 0 0 0 0 0 0 0 0 0 12
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
14 13 0 0 18 18 18 18 0 0 13 14
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
19 19 0 0 0 0 0 0 0 0 19 19
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 13 0 0 0 0 0 0 0 0 13 0
31 31 31 31 31 31 31 31 31 31 31 31
5 5 5 5 5 5 5 5 5 5 5 5
8 7 8 3 8 8 8 8 3 8 7 8
5 5 5 5 5 5 5 5 5 5 5 5
5 5 5 5 5 5 5 5 5 5 5 5
5 5 5 5 5 5 5 5 5 5 5 5
9 13 9 9 9 9 9 9 9 9 13 9
9 9 13 9 9 9 9 9 9 13 9 9
9 9 9 9 9 9 9 9 9 9 9 9
9 9 9 9 9 9 9 9 9 9 9 9
9 9 9 9 9 9 9 9 9 9 9 9
9 9 9 14 9 9 9 9 14 9 9 9
9 9 9 9 14 9 9 14 9 9 9 9
9 9 9 9 9 9 9 9 9 9 9 9
9 9 9 9 9 9 9 9 9 9 9 9
9 9 9 9 9 9 9 9 9 9 9 9
30 30 30 30 30 30 30 30 30 30 30 30
0 0 0 0 0 0 0 0 0 0 0 0
15 15 15 15 15 15 15 15 15 15 15 15
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
19 0 0 0 0 0 0 0 0 0 0 19
0 0 0 19 0 11 11 0 19 0 0 0
0 12 0 0 0 0 0 0 0 0 12 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
14 0 0 0 14 0 0 0 14 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 14 0 0 0 14 0 0 0 14 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
13 0 13 0 0 0 0 13 0 13 0 13
0 0 0 0 13 0 0 13 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
14 0 0 0 14 0 0 14 0 0 0 14
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
17 17 0 0 0 17 17 0 0 0 17 17
0 0 0 14 0 10 0 0 14 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 14 0 0 0 0 0 0 0 0 14 0
0 0 0 0 0 0 0 0 13 0 0 0
0 0 0 0 0 0 0 0 0 0 10 0
0 0 0 0 0 0 10 0 0 0 0 0
11 0 0 0 0 0 0 0 0 0 0 11
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
16 13 16 16 16 16 16 16 16 16 13 16
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
15 5 5 5 5 5 5 5 5 5 5 15
15 10 0 0 0 0 0 0 0 0 10 15
15 0 10 10 3 3 3 3 10 10 0 15
15 0 0 0 10 10 10 10 0 0 0 15
15 0 10 0 10 4 4 10 0 10 0 15
30 30 30 30 30 30 30 30 30 30 30 30
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0

396
levelone.pas Normal file
View File

@ -0,0 +1,396 @@
Procedure levelone;
VAR loop1,loop2:integer;
ch,ch2:char;
shieldcol:integer;
saucersout:integer;
bullet1x,bullet1y,bullet2x,bullet2y,i,wave:integer;
bullet1out,bullet2out:boolean;
whichone,temp,temp2,whichwave:integer;
tempst:string;
what:byte;
itemp,jtemp:byte;
procedure waveincrease;
begin
inc(wave);
dec(saucersout);
if saucersout<0 then saucersout:=0;
if wave<6 then whichwave:=4;
if (wave>=6) and (wave<=12) then whichwave:=4; {1}
if (wave>12) and (wave<=20) then whichwave:=4; {2}
if (wave>20) and (wave<=30) then whichwave:=4; {3}
if (wave>30) and (wave<=36) then whichwave:=4; {2}
if (wave>36) and (wave<=45) then whichwave:=3;
if (wave>45) and (wave<=50) then whichwave:=1;
if (wave>50) and (wave<=60) then whichwave:=3;
if (wave>60) and (wave<=70) then whichwave:=2;
if (wave>70) and (wave<=75) then whichwave:=1;
if (wave>75) and (wave<=85) then whichwave:=3;
if (wave>85) and (wave<=95) then whichwave:=2;
if (wave>95) and (wave<=100) then whichwave:=1;
if (wave>100) then whichwave:=4;
end;
BEGIN
wave:=0;
whichwave:=0;
pal(254,0,0,0);
shieldcol:=0;
shipx:=36;
shipadd:=0;
shipframe:=1;
shipspeed:=5;
ch:=#1; ch2:=#1;
for i:=0 to 4 do begin
enemy[i].exploding:=false;
enemy[i].out:=false;
end;
bullet1out:=false; bullet2out:=false;
bullet1x:=0; bullet1y:=0;
bullet2x:=0; bullet2y:=0;
saucersout:=0;
flip(vaddr2,vaddr);
str(level,tempst);
fillblock(251,52,314,59,0,vaddr);
outtextxy(tempst,307,51,12,0,vaddr,false);
cls(0,vaddr2);
for i:=0 to 50 do
putshape240(shapearray[12],
vaddr2,18,17,random(238),random(260));
for i:=0 to 50 do
putshape240(shapearray[13],
vaddr2,18,17,random(238),random(260));
{putshape240(shapearray[11],
vaddr2,18,17,10,20);}
pal(254,shields*4,0,0);
howmuchscroll:=65;
{**** GAME LOOP ****}
{*******************}
Repeat
ch2:=#1;
ch:=#1;
dec(howmuchscroll);
if howmuchscroll<1 then begin
flip65(vaddr2,2925,vaddr3,0);
flip65(vaddr2,1950,vaddr2,2925);
flip65(vaddr2,975,vaddr2,1950);
flip65(vaddr2,0,vaddr2,975);
flip65(vaddr3,0,vaddr2,0);
howmuchscroll:=65;
end;
flip240(howmuchscroll);
{***Collsion Check***}
for i:=0 to 4 do begin
if (enemy[i].out=true) then begin
if (bullet1out) then begin
if collision(bullet1x+3,bullet1y,bullet1x+17,bullet1y+13,
enemy[i].x,enemy[i].y,enemy[i].x+20,
enemy[i].y+20) then begin
{StartSound(Sound[1], 0, false);}
dec(enemy[i].hitsneeded);
if enemy[i].hitsneeded=0 then enemy[i].dead:=true
else enemy[i].dead:=false;
enemy[i].exploding:=true;
enemy[i].explodprogress:=0;
bullet1out:=false;
inc(score,10);
changescore;
end;
end;
if (bullet2out) then begin
if collision(bullet2x+3,bullet2y,bullet2x+17,bullet2y+13,
enemy[i].x,enemy[i].y,enemy[i].x+20,
enemy[i].y+20) then begin
{StartSound(Sound[1], 0, false);}
dec(enemy[i].hitsneeded);
if enemy[i].hitsneeded=0 then enemy[i].dead:=true
else enemy[i].dead:=false;
enemy[i].exploding:=true;
enemy[i].explodprogress:=0;
bullet2out:=false;
inc(score,10);
changescore;
end;
end;
end;
end;
{***DO EXPLOSIONS***}
for i:=0 to 4 do begin
if enemy[i].exploding=true then begin
inc(enemy[i].explodprogress);
if enemy[i].explodprogress<=5 then
putshape(shapearray[enemy[i].explodprogress+15],
vaddr,18,17,enemy[i].x,enemy[i].y)
else
if enemy[i].dead then begin
enemy[i].out:=false;
enemy[i].exploding:=false;
waveincrease;
end
else enemy[i].exploding:=false;
end;
end;
{***MOVE BULLET***}
if bullet1out then begin
dec(bullet1y,5);
if bullet1y<5 then bullet1out:=false;
if bullet1out then putshape(shape1off,vaddr,18,17,bullet1x,bullet1y);
end;
if bullet2out then begin
dec(bullet2y,5);
if bullet2y<5 then bullet2out:=false;
if bullet2out then putshape(shape1off,vaddr,18,17,bullet2x,bullet2y);
end;
{***MOVE ENEMIES***}
for i:=0 to 4 do begin
if (enemy[i].out=true) and (enemy[i].dead=false) then begin
putshape(shapearray[enemy[i].kind],vaddr,18,17,enemy[i].x,enemy[i].y);
enemy[i].x:=enemy[i].x+enemy[i].xspeed;
{*Check Position*}
if enemy[i].boundarycheck=false then inc(enemy[i].y,enemy[i].yspeed);
if (enemy[i].x<=enemy[i].minx) or (enemy[i].x>=enemy[i].maxx) then begin
enemy[i].xspeed:=-enemy[i].xspeed;
enemy[i].x:=enemy[i].x+enemy[i].xspeed;
inc(enemy[i].y,enemy[i].yspeed);
end;
{*Too Low*}
if enemy[i].y>179 then begin
enemy[i].out:=false;
end;
if enemy[i].y>140 then begin
if collision(shipx,165,
shipx+48,194,
enemy[i].x,enemy[i].y,
enemy[i].x+17,enemy[i].y+15)
then begin
enemy[i].exploding:=true;
enemy[i].explodprogress:=0;
dec(shields);
fillblock(250,71,314,79,0,vaddr);
if shields>0 then begin
pal(254,shields*4,0,0);
for itemp:=0 to shields do
for jtemp:=71 to 78 do
horizontalline(250+(itemp*4),
254+(itemp*4),jtemp,
47-itemp,vaddr);
end;
end;
end;
end;
end;
{***START NEW WAVE***}
{**STANDARD**}
if (saucersout=0) and (whichwave=0) then begin
saucersout:=5;
what:=random(8)+3;
for temp:=0 to 4 do begin
enemy[temp].kind:=what;
enemy[temp].x:=0;
enemy[temp].y:=0;
enemy[temp].xspeed:=5;
enemy[temp].x:=temp*20;
enemy[temp].minx:=(temp*20);
enemy[temp].maxx:=(temp*20)+120;
enemy[temp].boundarycheck:=true;
enemy[temp].yspeed:=10;
enemy[temp].out:=true;
enemy[temp].exploding:=false;
enemy[temp].hitsneeded:=1;
enemy[temp].dead:=false;
end;
end;
{**FALLING STRAIGHT**}
if whichwave=3 then begin
for temp:=0 to 4 do
if enemy[temp].out=false then begin
enemy[temp].kind:=random(8)+3;
enemy[temp].x:=random(200)+1;
enemy[temp].y:=0;
enemy[temp].xspeed:=0;
enemy[temp].minx:=enemy[temp].x;
enemy[temp].maxx:=enemy[temp].x;
enemy[temp].boundarycheck:=true;
enemy[temp].yspeed:=5;
enemy[temp].out:=true;
enemy[temp].exploding:=false;
enemy[temp].hitsneeded:=1;
enemy[temp].dead:=false;
end;
end;
{**FALLING GRADUALLY SIDEWAYS**}
if whichwave=2 then begin
for temp:=0 to 4 do
if enemy[temp].out=false then begin
enemy[temp].kind:=random(8)+3;
enemy[temp].y:=0;
enemy[temp].xspeed:=5;
enemy[temp].minx:=random(100);
enemy[temp].maxx:=random(100)+120;
enemy[temp].x:=enemy[temp].minx;
enemy[temp].boundarycheck:=false;
enemy[temp].yspeed:=1;
enemy[temp].out:=true;
enemy[temp].exploding:=false;
enemy[temp].hitsneeded:=1;
enemy[temp].dead:=false;
end;
end;
{**ZIG-ZAG**}
if (whichwave=1) and (saucersout=0) then begin
saucersout:=5;
whichone:=random(8)+3;
for temp:=0 to 4 do
if enemy[temp].out=false then begin
enemy[temp].kind:=whichone;
enemy[temp].y:=temp*10;
enemy[temp].xspeed:=5;
enemy[temp].minx:=0;
enemy[temp].maxx:=220;
enemy[temp].x:=temp*20;
enemy[temp].boundarycheck:=false;
enemy[temp].yspeed:=1;
enemy[temp].out:=true;
enemy[temp].exploding:=false;
enemy[temp].hitsneeded:=1;
enemy[temp].dead:=false;
end;
end;
if (whichwave=4) then begin
if saucersout=0 then begin
enemy[0].kind:=15;
enemy[1].kind:=15;
enemy[2].kind:=14;
for temp:=0 to 2 do begin
enemy[temp].x:=temp*20;
enemy[temp].y:=0;
enemy[temp].xspeed:=5;
enemy[temp].minx:=0;
enemy[temp].maxx:=220;
enemy[temp].boundarycheck:=true;
enemy[temp].yspeed:=0;
enemy[temp].out:=true;
enemy[temp].exploding:=false;
enemy[temp].hitsneeded:=3;
enemy[temp].dead:=false;
end;
saucersout:=5;
end;
if enemy[i].kind=15 then
for temp:=3 to 4 do begin
saucersout:=5;
if (enemy[temp].out=false)
and (enemy[temp-3].out=true) then begin
enemy[temp].kind:=random(8)+3;
enemy[temp].x:=enemy[temp-3].x;
enemy[temp].y:=20;
enemy[temp].xspeed:=0;
enemy[temp].minx:=enemy[temp].x;
enemy[temp].maxx:=enemy[temp].x;
enemy[temp].boundarycheck:=false;
enemy[temp].yspeed:=7;
enemy[temp].out:=true;
enemy[temp].exploding:=false;
enemy[temp].hitsneeded:=1;
enemy[temp].dead:=false;
end;
end;
end;
{***READ KEYBOARD***}
if keypressed then BEGIN
ch:=readkey;
if ch=chr(0) then ch2:=readkey;
if ch2='M' then
if shipadd>=0 then inc(shipadd,3) else shipadd:=0;
if ch2='K' then
if shipadd<=0 then dec(shipadd,3) else shipadd:=0;
if ch2=';' then help;
if ch2='<' then begin
cls(0,vga);
coolbox(0,0,319,199,false,vga);
outtextxy('SAVE GAME',124,10,4,0,vga,false);
outtextxy('THIS WILL ONLY SAVE HOW YOU WERE',10,20,4,0,vga,false);
outtextxy('AT THE BEGINNING OF THE LEVEL!!!',10,30,4,0,vga,false);
findfirst('SG?.TB1',ANYFILE,filestuff);
ondisk:='ALREADY SAVED GAMES:';
while doserror=0 do with filestuff do
begin
ondisk:=concat(ondisk,name[3]);
findnext(filestuff);
end;
if ondisk='' then ondisk:=concat(ondisk,'NONE');
outtextxy(ondisk,10,50,4,0,vga,false);
outtextxy('SAVE WHICH GAME?',10,60,4,0,vga,false);
repeat until keypressed;
tempch:=readkey;
if (tempch>='0') and (tempch<='9') then begin
{$I-}
ondisk:=concat('SG',tempch,'.TB1');
assign(savegamef,ondisk);
rewrite(savegamef);
{$I+}
If IOResult=0 then begin
writeln(savegamef,beginscore);
writeln(savegamef,level);
writeln(savegamef,beginshields);
close(savegamef);
outtextxy('GAME SAVED',120,150,15,0,vga,false);
end
else outtextxy('ERROR! GAME NOT SAVED!',102,150,15,0,vga,false);
outtextxy('PRESS ANY KEY...',96,180,4,0,vga,false);
repeat; until keypressed; tempch:=readkey;
end;
end;
end;
if (ch=' ') then begin
if (bullet1out=false) then begin
{if sbsound then StartSound(Sound[0], 0, false);}
bullet1out:=true;
bullet1x:=shipx+15;
bullet1y:=165;
putshape(shape1off,vaddr,18,17,bullet1x,bullet1y);
end
else
if (bullet2out=false) then begin
{if sbsound then StartSound(Sound[0], 0, false);}
bullet2out:=true;
bullet2x:=shipx+15;
bullet2y:=165;
putshape(shape1off,vaddr,18,17,bullet2x,bullet2y);
end;
end;
{***MOVE SHIP***}
shipx:=shipx+shipadd;
if (shipx<1) then shipx:=1;
if (shipx>190) then shipx:=190;
CASE shipframe of
1 : putshape (bigship1off,vaddr,48,29,shipx,165);
3 : putshape (bigship3off,vaddr,48,29,shipx,165);
2,4 : putshape (bigship2off,vaddr,48,29,shipx,165);
END;
inc(shipframe);;
if shipframe=5 then shipframe:=1;
waitretrace;
flip (vaddr,vga);
waitretrace;
until (ch=#27) or (shields<0);
END;

BIN
moon2.tb1 Normal file
View File

Binary file not shown.

1072
nvmwgrap.pas Normal file
View File

File diff suppressed because it is too large Load Diff

768
pal.tb1 Normal file
View File

@ -0,0 +1,768 @@
0
0
0
0
0
42
0
42
0
0
42
42
42
0
0
42
0
42
42
21
0
42
42
42
21
21
21
21
21
63
21
63
21
21
63
63
63
21
21
63
21
63
63
63
21
63
63
63
59
59
59
55
55
55
52
52
52
48
48
48
45
45
45
42
42
42
38
38
38
35
35
35
31
31
31
28
28
28
25
25
25
21
21
21
18
18
18
14
14
14
11
11
11
8
8
8
63
0
0
59
0
0
56
0
0
53
0
0
50
0
0
47
0
0
44
0
0
41
0
0
38
0
0
34
0
0
31
0
0
28
0
0
25
0
0
22
0
0
19
0
0
16
0
0
63
54
54
63
46
46
63
39
39
63
31
31
63
23
23
63
16
16
63
8
8
63
0
0
63
42
23
63
38
16
63
34
8
63
30
0
57
27
0
51
24
0
45
21
0
39
19
0
63
63
54
63
63
46
63
63
39
63
63
31
63
62
23
63
61
16
63
61
8
63
61
0
57
54
0
51
49
0
45
43
0
39
39
0
33
33
0
28
27
0
22
21
0
16
16
0
52
63
23
49
63
16
45
63
8
40
63
0
36
57
0
32
51
0
29
45
0
24
39
0
54
63
54
47
63
46
39
63
39
32
63
31
24
63
23
16
63
16
8
63
8
0
63
0
0
63
0
0
59
0
0
56
0
0
53
0
1
50
0
1
47
0
1
44
0
1
41
0
1
38
0
1
34
0
1
31
0
1
28
0
1
25
0
1
22
0
1
19
0
1
16
0
54
63
63
46
63
63
39
63
63
31
63
62
23
63
63
16
63
63
8
63
63
0
63
63
0
57
57
0
51
51
0
45
45
0
39
39
0
33
33
0
28
28
0
22
22
0
16
16
23
47
63
16
44
63
8
42
63
0
39
63
0
35
57
0
31
51
0
27
45
0
23
39
54
54
63
46
47
63
39
39
63
31
32
63
23
24
63
16
16
63
8
9
63
0
1
63
0
0
63
0
0
59
0
0
56
0
0
53
0
0
50
0
0
47
0
0
44
0
0
41
0
0
38
0
0
34
0
0
31
0
0
28
0
0
25
0
0
22
0
0
19
0
0
16
60
54
63
57
46
63
54
39
63
52
31
63
50
23
63
47
16
63
45
8
63
42
0
63
38
0
57
32
0
51
29
0
45
24
0
39
20
0
33
17
0
28
13
0
22
10
0
16
63
54
63
63
46
63
63
39
63
63
31
63
63
23
63
63
16
63
63
8
63
63
0
63
56
0
57
50
0
51
45
0
45
39
0
39
33
0
33
27
0
28
22
0
22
16
0
16
63
58
55
63
56
52
63
54
49
63
53
47
63
51
44
63
49
41
63
47
39
63
46
36
63
44
32
63
41
28
63
39
24
60
37
23
58
35
22
55
34
21
52
32
20
50
31
19
47
30
18
45
28
17
42
26
16
40
25
15
39
24
14
36
23
13
34
22
12
32
20
11
29
19
10
27
18
9
23
16
8
21
15
7
18
14
6
16
12
6
14
11
5
10
8
3
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
49
10
10
49
19
10
49
29
10
49
39
10
49
49
10
39
49
10
29
49
10
19
49
10
10
49
12
10
49
23
10
49
34
10
49
45
10
42
49
10
31
49
10
20
49
11
10
49
22
10
49
33
10
49
44
10
49
49
10
43
49
10
32
49
10
21
49
10
10
63
63
63

BIN
register.tb1 Normal file
View File

Binary file not shown.

4
sg1.tb1 Normal file
View File

@ -0,0 +1,4 @@
200
1
5

3
sg2.tb1 Normal file
View File

@ -0,0 +1,3 @@
1140
2
7

3
sg3.tb1 Normal file
View File

@ -0,0 +1,3 @@
1140
3
7

3
sg4.tb1 Normal file
View File

@ -0,0 +1,3 @@
1140
4
7

3
sg5.tb1 Normal file
View File

@ -0,0 +1,3 @@
500
2
10

3
sg6.tb1 Normal file
View File

@ -0,0 +1,3 @@
0
1
10

3
sg8.tb1 Normal file
View File

@ -0,0 +1,3 @@
200
1
5

3
sg9.tb1 Normal file
View File

@ -0,0 +1,3 @@
1180
2
8

BIN
ships.tb1 Normal file
View File

Binary file not shown.

BIN
ships1.tb1 Normal file
View File

Binary file not shown.

996
smix.pas Normal file
View File

@ -0,0 +1,996 @@
{ SMIX is Copyright 1995 by Ethan Brodsky. All rights reserved. }
unit SMix; {Version 1.27}
{$X+} {$G+} {$R-}
interface
const
BlockLength = 512; {Size of digitized sound block }
LoadChunkSize = 2048; {Chunk size used for loading sounds from disk}
Voices = 8; {Number of available voices }
SamplingRate = 22025; {Sampling rate for output }
var
test8086:byte;
type
PSound = ^TSound;
TSound =
record
XMSHandle: word;
StartOfs: LongInt;
SoundSize: LongInt;
end;
function InitSB(BaseIO: word; IRQ: byte; DMA, DMA16: byte): boolean;
{Initializes control parameters, resets DSP, and installs int. handler }
{ Parameters: (Can be found using GetSettings procedure in Detect) }
{ BaseIO: Sound card base IO address }
{ IRQ: Sound card IRQ setting }
{ DMA: Sound card 8-bit DMA channel }
{ DMA16: Sound card 16-bit DMA channel (0 if not supported) }
{ Returns: }
{ TRUE: Sound card successfully initialized (Maybe) }
{ FALSE: Sound card could not be initialized }
procedure ShutdownSB5;
{Removes interrupt handler and resets DSP }
procedure InitMixing;
{Allocates internal buffers and starts digitized sound output }
procedure ShutdownMixing;
{Deallocates internal buffers and stops digitized sound output }
function InitXMS: boolean;
{Attempts to intialize extended memory }
{ Returns: }
{ TRUE: Extended memory successfully initialized }
{ FALSE: Extended memory could not be initialized }
function GetFreeXMS: word;
{Returns amount of free XMS memory (In kilobytes) }
procedure InitSharing;
{Allocates an EMB that all sounds are stored in. This preserves EMB }
{handles, which are a scarce resource. Call this on initialization and}
{all sounds will automatically be stored in one EMB. Call LoadSound as}
{usual to allocate a sound, but FreeSound only deallocates the sound }
{data structure. Call ShutdownSharing before program termination to }
{free allocated extended memory. }
procedure ShutdownSharing;
{Shuts down EMB sharing and frees all allocated extended memory }
procedure OpenSoundResourceFile(FileName: string);
{Call this to open a resource file for loading sounds. After this has }
{been called, the Key parameter in the LoadSound function is used as a }
{resource key to locate the sound data in this file. }
{ Parameters: }
{ FileName: File name of resource file }
procedure CloseSoundResourceFile;
{Close sound resource file. If you have called this, the Key parameter}
{will act as a filename instead of a resource key. }
procedure LoadSound(var Sound: PSound; Key: string);
{Allocates an extended memory block and loads a sound from a file }
{ Parameters: }
{ Sound: Unallocated pointer to sound data structure }
{ Key: If a resource file has been opened then key is a resource }
{ identifier. Use the same ID as you used for SNDLIB. }
{ If a resource file has not been opened, then key is the }
{ filename to load the sound data from. }
procedure FreeSound(var Sound: PSound);
{Deallocates extended memory and destroys sound data structure }
{ Parameters: }
{ Sound: Unallocated pointer to sound data structure }
procedure StartSound(Sound: PSound; Index: byte; Loop: boolean);
{Starts playing a sound }
{ Parameters: }
{ Sound: Pointer to sound data structure }
{ Index: A number to keep track of the sound with (Used to stop it)}
{ Loop: Indicates whether the sound should be continuously looped }
procedure StopSound(Index: byte);
{Stops playing sound }
{ Parameters: }
{ Index: Index of sound to stop (All with given index are stopped) }
function SoundPlaying(Index: byte): boolean;
{Checks if a sound is still playing }
{ Parameters: }
{ Index: Index used when the sound was started }
{ Returns: }
{ TRUE At least oen sound with the specified index is playing }
{ FALSE No sounds with the specified index are playing }
var
IntCount : LongInt; {Number of sound interrupts that have occured }
DSPVersion : real; {Contains the version of the installed DSP chip }
AutoInit : boolean; {Tells Auto-initialized DMA transfers are in use}
SixteenBit : boolean; {Tells whether 16-bit sound output is occuring }
VoiceCount : byte; {Number of voices currently in use }
implementation
uses
CRT,
DOS,
XMS;
const
BufferLength = BlockLength * 2;
var
ResetPort : word;
ReadPort : word;
WritePort : word;
PollPort : word;
AckPort : word;
PICRotatePort : word;
PICMaskPort : word;
DMAMaskPort : word;
DMAClrPtrPort : word;
DMAModePort : word;
DMABaseAddrPort : word;
DMACountPort : word;
DMAPagePort : word;
IRQStartMask : byte;
IRQStopMask : byte;
IRQIntVector : byte;
DMAStartMask : byte;
DMAStopMask : byte;
DMAMode : byte;
DMALength : word;
OldIntVector : pointer;
OldExitProc : pointer;
HandlerInstalled : boolean;
procedure WriteDSP(Value: byte);
begin
repeat until (Port[WritePort] and $80) = 0;
Port[WritePort] := Value;
end;
function ReadDSP: byte;
begin
repeat until (Port[PollPort] and $80) <> 0;
ReadDSP := Port[ReadPort];
end;
function ResetDSP: boolean;
var
i: byte;
begin
Port[ResetPort] := 1;
Delay(1); {One millisecond}
Port[ResetPort] := 0;
i := 100;
while (ReadDSP <> $AA) and (i > 0) do Dec(i);
if i > 0
then ResetDSP := true
else ResetDSP := false;
end;
procedure InstallHandler; forward;
procedure UninstallHandler; forward;
procedure MixExitProc; far; forward;
function InitSB(BaseIO: word; IRQ: byte; DMA, DMA16: byte): boolean;
begin
{Sound card IO ports}
ResetPort := BaseIO + $6;
ReadPort := BaseIO + $A;
WritePort := BaseIO + $C;
PollPort := BaseIO + $E;
{Reset DSP, get version, and pick output mode}
if not(ResetDSP)
then
begin
InitSB := false;
Exit;
end;
WriteDSP($E1); {Get DSP version number}
DSPVersion := ReadDSP; DSPVersion := DSPVersion + ReadDSP/100;
AutoInit := DSPVersion > 2.0;
SixteenBit := (DSPVersion > 4.0) and (DMA16 <> $FF) and (DMA16 > 3);
{Compute interrupt ports and parameters}
if IRQ <= 7
then
begin
IRQIntVector := $08+IRQ;
PICMaskPort := $21;
end
else
begin
IRQIntVector := $70+IRQ-8;
PICMaskPort := $A1;
end;
IRQStopMask := 1 shl (IRQ mod 8);
IRQStartMask := not(IRQStopMask);
{Compute DMA ports and parameters}
if SixteenBit
then {Sixteen bit}
begin
DMAMaskPort := $D4;
DMAClrPtrPort := $D8;
DMAModePort := $D6;
DMABaseAddrPort := $C0 + 4*(DMA16-4);
DMACountPort := $C2 + 4*(DMA16-4);
case DMA16
of
5: DMAPagePort := $8B;
6: DMAPagePort := $89;
7: DMAPagePort := $8A;
end;
DMAStopMask := DMA16-4 + $04; {000001xx}
DMAStartMask := DMA16-4 + $00; {000000xx}
DMAMode := DMA16-4 + $58; {010110xx}
AckPort := BaseIO + $F;
end
else {Eight bit}
begin
DMAMaskPort := $0A;
DMAClrPtrPort := $0C;
DMAModePort := $0B;
DMABaseAddrPort := $00 + 2*DMA;
DMACountPort := $01 + 2*DMA;
case DMA
of
0: DMAPagePort := $87;
1: DMAPagePort := $83;
2: DMAPagePort := $81;
3: DMAPagePort := $82;
end;
DMAStopMask := DMA + $04; {000001xx}
DMAStartMask := DMA + $00; {000000xx}
if AutoInit
then DMAMode := DMA + $58 {010110xx}
else DMAMode := DMA + $48; {010010xx}
AckPort := BaseIO + $E;
end;
if AutoInit
then DMALength := BufferLength
else DMALength := BlockLength;
InstallHandler;
OldExitProc := ExitProc;
ExitProc := @MixExitProc;
InitSB := true;
end;
procedure ShutdownSB5;
begin
if HandlerInstalled
then UninstallHandler;
ResetDSP;
end;
function InitXMS: boolean;
begin
InitXMS := true;
if not(XMSInstalled)
then InitXMS := false
else XMSInit;
end;
function GetFreeXMS: word;
begin
GetFreeXMS := XMSGetFreeMem;
end;
{Voice control}
type
PVoice = ^TVoice;
TVoice =
record
Sound: PSound;
Index: byte;
CurPos: LongInt;
Loop: boolean;
end;
var
VoiceInUse: array[0..Voices-1] of boolean;
Voice: array[0..Voices-1] of TVoice;
CurBlock: byte;
{Sound buffer}
var
SoundBlock: array[1..BlockLength+1] of ShortInt;
{The length of XMS copies under HIMEM.SYS must be a mutiple }
{of two. If the sound data ends in mid-block, it may not be }
{possible to round up without corrupting memory. Therefore, }
{the copy buffer has been extended by one byte to eliminate }
{this problem. }
{Mixing buffers}
type
PMixingBlock = ^TMixingBlock;
TMixingBlock = array[1..BlockLength] of integer;
var
MixingBlock : TMixingBlock;
{Output buffers}
type {8-bit}
POut8Block = ^TOut8Block;
TOut8Block = array[1..BlockLength] of byte;
POut8Buffer = ^TOut8Buffer;
TOut8Buffer = array[1..2] of TOut8Block;
type {16-bit}
POut16Block = ^TOut16Block;
TOut16Block = array[1..BlockLength] of integer;
POut16Buffer = ^TOut16Buffer;
TOut16Buffer = array[1..2] of TOut16Block;
var
OutMemArea : pointer;
Out8Buffer : POut8Buffer;
Out16Buffer : POut16Buffer;
var
BlockPtr : array[1..2] of pointer;
CurBlockPtr : pointer;
var
{For auto-initialized transfers (Whole buffer)}
BufferAddr : LongInt;
BufferPage : byte;
BufferOfs : word;
{For single-cycle transfers (One block at a time)}
BlockAddr : array[1..2] of LongInt;
BlockPage : array[1..2] of byte;
BlockOfs : array[1..2] of word;
{Clipping for 8-bit output}
var
Clip8 : array[-128*Voices..128*Voices] of byte;
function TimeConstant(Rate: word): byte;
begin
TimeConstant := 256 - (1000000 div Rate);
end;
procedure StartDAC;
begin
Port[DMAMaskPort] := DMAStopMask;
Port[DMAClrPtrPort] := $00;
Port[DMAModePort] := DMAMode;
Port[DMABaseAddrPort] := Lo(BufferOfs);
Port[DMABaseAddrPort] := Hi(BufferOfs);
Port[DMACountPort] := Lo(DMALength-1);
Port[DMACountPort] := Hi(DMALength-1);
Port[DMAPagePort] := BufferPage;
Port[DMAMaskPort] := DMAStartMask;
if SixteenBit
then {Sixteen bit: SB16 and up (DSP 4.xx)}
begin
WriteDSP($41); {Set digitized sound output sampling rate}
WriteDSP(Hi(SamplingRate));
WriteDSP(Lo(SamplingRate));
WriteDSP($B6); {16-bit DMA command: D/A, Auto-Init, FIFO}
WriteDSP($10); {16-bit DMA mode: Signed Mono }
WriteDSP(Lo(BlockLength - 1));
WriteDSP(Hi(BlockLength - 1));
end
else {Eight bit}
begin
WriteDSP($D1); {Turn on speaker }
WriteDSP($40); {Set digitized sound time constant }
WriteDSP(TimeConstant(SamplingRate));
if AutoInit
then {Eight bit auto-initialized: SBPro and up (DSP 2.00+)}
begin
WriteDSP($48); {Set DSP block transfer size }
WriteDSP(Lo(BlockLength - 1));
WriteDSP(Hi(BlockLength - 1));
WriteDSP($1C); {8-bit auto-init DMA mono sound output }
end
else {Eight bit single-cycle: Sound Blaster (DSP 1.xx+)}
begin
WriteDSP($14); {8-bit single-cycle DMA sound output }
WriteDSP(Lo(BlockLength - 1));
WriteDSP(Hi(BlockLength - 1));
end;
end;
end;
procedure StopDAC;
begin
if SixteenBit
then {Sixteen bit}
begin
WriteDSP($D5); {Pause 16-bit DMA sound I/O }
end
else {Eight bit}
begin
WriteDSP($D0); {Pause 8-bit DMA mode sound I/O }
WriteDSP($D3); {Turn off speaker }
end;
Port[DMAMaskPort] := DMAStopMask;
end;
{Setup for storing all sounds in one extended memory block (Saves handles)}
var
SharedEMB : boolean;
SharedHandle : word;
SharedSize : LongInt;
procedure InitSharing;
begin
SharedEMB := true;
SharedSize := 0;
XMSAllocate(SharedHandle, SharedSize);
end;
procedure ShutdownSharing;
begin
if SharedEMB then XMSFree(SharedHandle);
SharedEMB := false;
end;
{Setup for sound resource files}
var
ResourceFile : boolean;
ResourceFilename : string;
procedure OpenSoundResourceFile(FileName: string);
begin
ResourceFile := true;
ResourceFilename := FileName;
end;
procedure CloseSoundResourceFile;
begin
ResourceFile := false;
ResourceFilename := '';
end;
type
TKey = array[1..8] of char;
var
SoundFile : file;
SoundSize : LongInt;
function MatchingKeys(a, b: TKey): boolean;
var
i: integer;
begin
MatchingKeys := true;
for i := 1 to 8 do
if a <> b
then
MatchingKeys := false;
end;
procedure GetSoundFile(Key: string);
type
Resource =
record
Key: TKey;
Start: LongInt;
Size: LongInt;
end;
var
NumSounds: integer;
ResKey: TKey;
ResHeader: Resource;
Index: integer;
i: integer;
Found: boolean;
begin
if ResourceFile
then
begin
for i := 1 to 8 do
if i <= Length(Key)
then ResKey[i] := Key[i]
else ResKey[i] := #0;
Assign(SoundFile, ResourceFilename); Reset(SoundFile, 1);
BlockRead(SoundFile, NumSounds, SizeOf(NumSounds));
Found := false;
Index := 0;
while not(Found) and (Index < NumSounds) do
begin
Index := Index + 1;
BlockRead(SoundFile, ResHeader, SizeOf(ResHeader));
if MatchingKeys(ResHeader.Key, ResKey)
then
Found := true;
end;
if Found
then
begin
Seek(SoundFile, ResHeader.Start);
SoundSize := ResHeader.Size;
end
else
Halt(255);
end
else
begin
Assign(SoundFile, Key); Reset(SoundFile, 1);
SoundSize := FileSize(SoundFile);
end;
end;
function Min(a, b: LongInt): LongInt;
begin
if a < b
then Min := a
else Min := b;
end;
{Loading and freeing sounds}
var
MoveParams: TMoveParams; {The XMS driver doesn't like this on the stack}
procedure LoadSound(var Sound: PSound; Key: string);
var
Size: LongInt;
InBuffer: array[1..LoadChunkSize] of byte;
Remaining: LongInt;
begin
GetSoundFile(Key);
New(Sound);
Sound^.SoundSize := SoundSize;
if not(SharedEMB)
then
begin
Sound^.StartOfs := 0;
XMSAllocate(Sound^.XMSHandle, (SoundSize + 1023) div 1024);
end
else
begin
Sound^.StartOfs := SharedSize;
Sound^.XMSHandle := SharedHandle;
SharedSize := SharedSize + SoundSize;
XMSReallocate(SharedHandle, (SharedSize + 1023) div 1024);
end;
MoveParams.SourceHandle := 0;
MoveParams.SourceOffset := LongInt(Addr(InBuffer));
MoveParams.DestHandle := Sound^.XMSHandle;
MoveParams.DestOffset := Sound^.StartOfs;
Remaining := Sound^.SoundSize;
repeat
MoveParams.Length := Min(Remaining, LoadChunkSize);
BlockRead(SoundFile, InBuffer, MoveParams.Length);
MoveParams.Length := ((MoveParams.Length+1) div 2) * 2;
{XMS copy lengths must be a multiple of two}
XMSMove(@MoveParams);
Inc(MoveParams.DestOffset, MoveParams.Length);
Dec(Remaining, MoveParams.Length);
until not(Remaining > 0);
Close(SoundFile);
end;
procedure FreeSound(var Sound: PSound);
begin
if not(SharedEMB) then XMSFree(Sound^.XMSHandle);
Dispose(Sound); Sound := nil;
end;
{Voice maintainance}
procedure DeallocateVoice(VoiceNum: byte);
begin
VoiceInUse[VoiceNum] := false;
with Voice[VoiceNum] do
begin
Sound := nil;
Index := 0;
CurPos := 0;
Loop := false;
end;
end;
procedure StartSound(Sound: PSound; Index: byte; Loop: boolean);
var
i, Slot: byte;
begin
Slot := $FF; i := 0;
repeat
if not(VoiceInUse[i])
then Slot := i;
Inc(i);
until ((Slot <> $FF) or (i=Voices));
if Slot <> $FF
then
begin
Inc(VoiceCount);
Voice[Slot].Sound := Sound;
Voice[Slot].Index := Index;
Voice[Slot].CurPos := 0;
Voice[Slot].Loop := Loop;
VoiceInUse[Slot] := true;
end;
end;
procedure StopSound(Index: byte);
var
i: byte;
begin
for i := 0 to Voices-1 do
if Voice[i].Index = Index
then
begin
DeallocateVoice(i);
Dec(VoiceCount);
end;
end;
function SoundPlaying(Index: byte): boolean;
var
i: byte;
begin
SoundPlaying := False;
for i := 0 to Voices-1 do
if Voice[i].Index = Index
then SoundPlaying := True;
end;
procedure UpdateVoices;
var
VoiceNum: byte;
begin
for VoiceNum := 0 to Voices-1 do
begin
if VoiceInUse[VoiceNum]
then
if Voice[VoiceNum].CurPos >= Voice[VoiceNum].Sound^.SoundSize
then
begin
DeallocateVoice(VoiceNum);
Dec(VoiceCount);
end;
end;
end;
{Utility functions}
procedure SetCurBlock(BlockNum: byte);
begin
CurBlock := BlockNum;
CurBlockPtr := pointer(BlockPtr[BlockNum]);
end;
procedure ToggleBlock;
begin
if CurBlock = 1
then SetCurBlock(2)
else SetCurBlock(1);
end;
procedure SilenceBlock;
begin
FillChar(MixingBlock, BlockLength*2, 0); {FillChar uses REP STOSW}
end;
function GetLinearAddr(Ptr: pointer): LongInt;
begin
GetLinearAddr := LongInt(Seg(Ptr^))*16 + LongInt(Ofs(Ptr^));
end;
function NormalizePtr(p: pointer): pointer;
var
LinearAddr: LongInt;
begin
LinearAddr := GetLinearAddr(p);
NormalizePtr := Ptr(LinearAddr div 16, LinearAddr mod 16);
end;
procedure InitClip8;
var
i, Value: integer;
begin
for i := -128*Voices to 128*Voices do
begin
Value := i;
if (Value < -128) then Value := -128;
if (Value > +127) then Value := +127;
Clip8[i] := Value + 128;
end;
end;
procedure InitMixing;
var
i: integer;
begin
for i := 0 to Voices-1 do DeallocateVoice(i);
VoiceCount := 0;
if SixteenBit
then
begin
{Find a block of memory that does not cross a page boundary}
GetMem(OutMemArea, 4*BufferLength);
if ((GetLinearAddr(OutMemArea) div 2) mod 65536)+BufferLength < 65536
then Out16Buffer := OutMemArea
else Out16Buffer := NormalizePtr(Ptr(Seg(OutMemArea^), Ofs(OutMemArea^)+2*BufferLength));
for i := 1 to 2 do
BlockPtr[i] := NormalizePtr(Addr(Out16Buffer^[i]));
{DMA parameters}
BufferAddr := GetLinearAddr(pointer(Out16Buffer));
BufferPage := BufferAddr div 65536;
BufferOfs := (BufferAddr div 2) mod 65536;
for i := 1 to 2 do
BlockAddr[i] := GetLinearAddr(pointer(BlockPtr[i]));
for i := 1 to 2 do
BlockPage[i] := BlockAddr[i] div 65536;
for i := 1 to 2 do
BlockOfs[i] := (BlockAddr[i] div 2) mod 65536;
FillChar(Out16Buffer^, BufferLength*2, $00); {Signed 16-bit}
end
else
begin
{Find a block of memory that does not cross a page boundary}
GetMem(OutMemArea, 2*BufferLength);
if (GetLinearAddr(OutMemArea) mod 65536)+BufferLength < 65536
then Out8Buffer := OutMemArea
else Out8Buffer := NormalizePtr(Ptr(Seg(OutMemArea^), Ofs(OutMemArea^)+BufferLength));
for i := 1 to 2 do
BlockPtr[i] := NormalizePtr(Addr(Out8Buffer^[i]));
{DMA parameters}
BufferAddr := GetLinearAddr(pointer(Out8Buffer));
BufferPage := BufferAddr div 65536;
BufferOfs := BufferAddr mod 65536;
for i := 1 to 2 do
BlockAddr[i] := GetLinearAddr(pointer(BlockPtr[i]));
for i := 1 to 2 do
BlockPage[i] := BlockAddr[i] div 65536;
for i := 1 to 2 do
BlockOfs[i] := BlockAddr[i] mod 65536;
FillChar(Out8Buffer^, BufferLength, $80); {Unsigned 8-bit}
InitClip8;
end;
FillChar(MixingBlock, BlockLength*2, $00);
SetCurBlock(1);
IntCount := 0;
StartDAC;
end;
procedure ShutdownMixing;
begin
StopDAC;
if SixteenBit
then FreeMem(OutMemArea, 4*BufferLength)
else FreeMem(OutMemArea, 2*BufferLength);
end;
var {The XMS driver doesn't like parameter blocks in the stack}
IntMoveParams: TMoveParams; {In case LoadSound is interrupted}
procedure CopySound(Sound: PSound; var CurPos: LongInt; CopyLength: word; Loop: boolean);
var
SoundSize: LongInt;
DestPtr: pointer;
begin
SoundSize := Sound^.SoundSize;
DestPtr := pointer(@SoundBlock);
IntMoveParams.SourceHandle := Sound^.XMSHandle;
IntMoveParams.DestHandle := 0;
while CopyLength > 0 do
begin
{Compute max transfer size}
if CopyLength < SoundSize-CurPos
then IntMoveParams.Length := CopyLength
else IntMoveParams.Length := SoundSize-CurPos;
{Compute starting dest. offset and update offset for next block}
IntMoveParams.SourceOffset := Sound^.StartOfs + CurPos;
CurPos := CurPos + IntMoveParams.Length;
if Loop then CurPos := CurPos mod SoundSize;
{Compute starting source offset and update offset for next block}
IntMoveParams.DestOffset := LongInt(DestPtr);
DestPtr := NormalizePtr(Ptr(Seg(DestPtr^), Ofs(DestPtr^)+IntMoveParams.Length));
{Update remaining count for next iteration}
CopyLength := CopyLength - IntMoveParams.Length;
{Move block}
IntMoveParams.Length := ((IntMoveParams.Length+1) div 2) * 2;
{XMS copy lengths must be a multiple of two}
XMSMove(@IntMoveParams); {Luckily, the XMS driver is re-entrant}
end;
end;
procedure MixVoice(VoiceNum: byte);
var
MixLength: word;
begin
with Voice[VoiceNum] do
if Loop
then
MixLength := BlockLength
else
if BlockLength < Sound^.SoundSize-CurPos
then MixLength := BlockLength
else MixLength := Sound^.SoundSize-CurPos;
CopySound(Voice[VoiceNum].Sound, Voice[VoiceNum].CurPos, MixLength, Voice[VoiceNum].Loop);
asm
lea si, SoundBlock {DS:SI -> Sound data (Source) }
mov ax, ds {ES:DI -> Mixing block (Destination) }
mov es, ax
lea di, MixingBlock
mov cx, MixLength {CX = Number of samples to copy }
@MixSample:
mov al, [si] {Load a sample from the sound block }
inc si { increment pointer }
cbw {Convert it to a 16-bit signed sample }
add es:[di], ax {Add it into the mixing buffer }
add di, 2 {Next word in mixing buffer }
dec cx {Loop for next sample }
jnz @MixSample
end;
end;
procedure MixVoices;
var
i: word;
begin
SilenceBlock;
for i := 0 to Voices-1 do
if VoiceInUse[i]
then
MixVoice(i);
end;
procedure CopyData16; assembler;
asm
lea si, MixingBlock {DS:SI -> 16-bit input block }
les di, [CurBlockPtr] {ES:DI -> 16-bit output block }
mov cx, BlockLength {CX = Number of samples to copy }
@CopySample:
mov ax, [si] {Load a sample from the mixing block }
add di, 2 {Increment destination pointer }
sal ax, 5 {Shift sample left to fill 16-bit range}
add si, 2 {Increment source pointer }
mov es:[di-2], ax {Store sample in output block }
dec cx {Process the next sample }
jnz @CopySample
end;
procedure CopyData8; assembler;
asm
push bp
mov dx, ss {Preserve SS in DX }
pushf
cli {Disable interrupts }
mov ax, ds {Using SS for data }
mov ss, ax
lea si, Clip8 {DS:SI -> 8-bit clipping buffer }
add si, 128*Voices {DS:SI -> Center of clipping buffer }
lea bp, MixingBlock {SS:BP -> 16-bit input block }
les di, [CurBlockPtr] {ES:DI -> 8-bit output block }
mov cx, BlockLength {CX = Number of samples to copy }
@CopySample:
mov bx, [bp] {BX = Sample from mixing block }
inc di {Increment destination pointer (DI) }
add bp, 2 {Increment source pointer (BP) }
mov al, [si+bx] {AL = Clipped sample }
mov es:[di-1], al {Store sample in output block }
dec cx {Process the next sample }
jnz @CopySample
mov ss, dx {Restore SS }
popf {Restore flags }
pop bp
end;
procedure CopyData;
begin
if SixteenBit
then CopyData16
else CopyData8;
end;
procedure StartBlock_SC; {Starts a single-cycle DMA transfer}
begin
Port[DMAMaskPort] := DMAStopMask;
Port[DMAClrPtrPort] := $00;
Port[DMAModePort] := DMAMode;
Port[DMABaseAddrPort] := Lo(BlockOfs[CurBlock]);
Port[DMABaseAddrPort] := Hi(BlockOfs[CurBlock]);
Port[DMACountPort] := Lo(DMALength-1);
Port[DMACountPort] := Hi(DMALength-1);
Port[DMAPagePort] := BlockPage[CurBlock];
Port[DMAMaskPort] := DMAStartMask;
WriteDSP($14); {8-bit single-cycle DMA sound output }
WriteDSP(Lo(BlockLength - 1));
WriteDSP(Hi(BlockLength - 1));
end;
var Save_Test8086: byte; {CPU type flag}
procedure IntHandler; interrupt;
var
Temp: byte;
begin
{On a 386 or higher, Turbo Pascal uses 32-bit registers for LongInt }
{math. Unfortunately, it doesn't preserve these registers when }
{generating code to handle interrupts, so they are occasionally }
{corrupted. This can cause a problem with LongInt math in your }
{program or in TSRs. The below code disables 32-bit instructions for }
{the interrupt to prevent 32-bit register corruption. }
Save_Test8086 := Test8086;
Test8086 := 0;
Inc(IntCount);
if not(AutoInit) {Start next block first if not using auto-init DMA}
then
begin
StartBlock_SC;
CopyData;
ToggleBlock;
end;
UpdateVoices;
MixVoices;
if (AutoInit)
then
begin
CopyData;
ToggleBlock;
end;
Test8086 := Save_Test8086;
Temp := Port[AckPort];
Port[$A0] := $20;
Port[$20] := $20;
end;
procedure EnableInterrupts; InLine($FB); {STI}
procedure DisableInterrupts; InLine($FA); {CLI}
procedure InstallHandler;
begin
DisableInterrupts;
Port[PICMaskPort] := Port[PICMaskPort] or IRQStopMask;
GetIntVec(IRQIntVector, OldIntVector);
SetIntVec(IRQIntVector, @IntHandler);
Port[PICMaskPort] := Port[PICMaskPort] and IRQStartMask;
EnableInterrupts;
HandlerInstalled := true;
end;
procedure UninstallHandler;
begin
DisableInterrupts;
Port[PICMaskPort] := Port[PICMaskPort] or IRQStopMask;
SetIntVec(IRQIntVector, OldIntVector);
EnableInterrupts;
HandlerInstalled := false;
end;
procedure MixExitProc; {Called automatically on program termination}
begin
ExitProc := OldExitProc;
StopDAC;
ShutdownSB5;
end;
begin
HandlerInstalled := false;
SharedEMB := false;
ResourceFile := false;
end.

BIN
sounds.tb1 Normal file
View File

Binary file not shown.

661
story.pas Normal file
View File

@ -0,0 +1,661 @@
program story_from_tom_bombem;
uses nvmwgraph,crt;
{$G+}
const
{Shape Table Values For Story}
bargeoff = 0;
bigflame1off = 290;
bigflame2off = 780;
sflame2off = 1270;
sflame1off = 1290;
truck1off = 1310;
truck2off = 1370;
explo1off = 1430;
explo2off = 1730;
rent1off = 2030;
{Shape Table Values for Game}
shape1off = 8000;
shape2off = 8400;
shape3off = 8800;
shape4off = 9200;
shape5off = 9600;
shape6off = 10000;
shape7off = 10400;
shape8off = 10800;
shape9off = 11200;
shape10off = 11600;
shape11off = 12000;
shape12off = 12400;
shape13off = 12800;
shape14off = 13200;
shape15off = 13600;
shape16off = 14000;
shape17off = 14400;
shape18off = 14800;
shape19off = 15200;
shape20off = 15600;
bigship1off = 0;
bigship2off = 1600;
bigship3off = 3200;
shapearray :
array [1..20] of word =(8000,8400,8800,9200,
9600,10000,10400,10800,
11200,11600,12000,12400,
12800,13200,13600,14000,
14400,14800,15200,15600);
type ScreenType = array [0..3999] of byte; {For Ansi Loading}
ShipInfo = Record
x,y:integer;
speed,frame:integer;
active:boolean;
END;
EnemyInfo = record
x,y,oldx,oldy:integer;
kind:byte;
out,exploding:boolean;
explodprogress:byte;
minx,maxx,xspeed,yspeed:integer;
end;
Virtual = Array [1..64000] of byte; { The size of our Virtual Screen }
VirtPtr = ^Virtual; { Pointer to the virtual screen }
ShapeTable = Array [0..16000] of byte;
ShapePtr = ^ShapeTable;
var ho,mi,se,s100:word;
tempsec:integer;
flames:boolean;
error:byte;
dev,mix,stat,pro,loop : integer;
md : string;
VAR Virscr : VirtPtr; { Our first Virtual screen }
ShapeTable1:ShapePtr;
num:byte;
VirScr2 : VirtPtr; { Our second Virtual screen }
Vaddr : word; { The segment of our virtual screen}
Vaddr2 : Word; { The segment of our 2nd virt. screen}
ShapeAddr:word; { The segment of the shape table}
ShapeOfs:word;
ourpal : Array [0..255,1..3] of byte; { A virtual pallette }
shipv : Array [1..1] of shipinfo; { The toaster info }
enemy:array[0..5] of enemyinfo;
Soundp : Pointer;
Check : BOOLEAN;
hiscore,level,lives,energy:integer;
score:longint;
axel_und_carmen:boolean;
tempi,tempj:integer;
scorest:string[8];
musicon:boolean;
lowscore:integer;
it,hiname:string[10];
var grapherror:byte;
temp:array[1..3] of byte;
i,j:byte;
x,y,barpos:integer;
screen:screentype absolute $B800:0000;
ch:char;
Procedure SetUpVirtual;
{ This sets up the memory needed for the virtual screen }
BEGIN
GetMem (VirScr,64000);
vaddr := seg (virscr^);
GetMem (VirScr2,64000);
vaddr2 := seg (virscr2^);
GetMem (ShapeTable1,16000);
shapeaddr:= seg (ShapeTable1^);
shapeofs:=ofs (ShapeTable1^);
END;
procedure putshape(shapeoffset,towhere,xacross,yacross,xx,yy:word);
label bob,bob4,bob2,bob3;
begin
asm
{saves registers}
push ds
mov ax,[yy] {multiplies y value by 320}
shl ax,5
mov cx,ax
shl ax,1
shl cx,3
add ax,cx
add ax,[xx] {adds the x-value to get offset}
mov di,ax
mov bx,320
sub bx,[xacross] {xacross?}
push bx
mov bx,[yacross]
xor dx,dx
mov ax,[shapeaddr] {moves segment of array}
mov ds,ax
mov ax,[shapeoffset] {moves offsett if array}
{add ax,[shapeofs]}
mov si,ax
mov ax,[towhere] {loads place to move it}
mov es,ax
xor ax,ax
xor cx,cx
xor dx,dx
bob:
mov cx,[xacross] {how long to loop across (the x-size of array)}
bob4:
xor ah,ah
lodsb
cmp ax,0 {If zero skip, if not, store value}
jz bob2
stosb
dec di
bob2: {Adds when x-value must be increased}
inc di
loop bob4
cmp dx,bx
jz bob3
xor cx,cx
pop ax
add di,ax
push ax
inc dx
jmp bob
bob3:
pop bx {restore variables}
pop ds
end;
end;
procedure putshapeline(fromwhereo,towhere,xacross,yacross,xx,yy,line:word);
var int,color:integer;
{draws just one line of a shape with same syntax as putshape}
begin
for int:=0 to xacross do begin
{does not work. stack overflow}
(*asm
push ax
push bx
push cx
mov ax,[line] {multiplies y value by 320}
mul [xacross]
add ax,[int]
mov bx,ax
mov ax,[ShapeAddr] {moves segment of array}
mov ds,ax
{mov ax,[ShapeOfs]} {moves offset of array}
mov ax,[fromwhereo]
add ax,bx
mov si,ax
xor ax,ax
lodsb
mov [color],ax
pop cx
pop bx
pop ax
end;*)
color:=ShapeTable1^[fromwhereo+((xacross*line)+int)];
if color<>0 then putpixel(xx+int,yy+line,color,towhere);
end;
end;
procedure putshapeover(fromwhereo,towhere,xacross,yacross,xx,yy:word);
label bbob,bbob4,bbob2,bbob3;
begin
asm
{saves registers}
push ds
mov ax,[yy] {multiplies y value by 320}
shl ax,5
mov cx,ax
shl ax,1
shl cx,3
add ax,cx
add ax,[xx] {adds the x-value to get offset}
mov di,ax
mov bx,320
sub bx,[xacross] {xacross?}
push bx
mov bx,[yacross]
xor dx,dx
mov ax,[shapeaddr] {moves segment of array}
mov ds,ax
(*add ax,[shapeofs] *) {moves offsett if array}
mov ax,[fromwhereo]
mov si,ax
mov ax,[towhere] {loads place to move it}
mov es,ax
xor ax,ax
xor cx,cx
xor dx,dx
bbob:
mov cx,[xacross] {how long to loop across (the x-size of array)}
bbob4:
rep movsb {copies, overwriting}
bbob2: {Adds when x-value must be increased}
cmp dx,bx
jz bbob3
xor cx,cx
pop ax
add di,ax
push ax
inc dx
jmp bbob
bbob3:
pop bx {restore variables}
pop ds
end;
end;
Procedure blockmove(x1,y1,x2,y2,p1,x3,y3,p2:word);
{ This is a small procedure to copy block x1,y1,x2,y2,
from page 1 to x3,y3 on page 2}
BEGIN
asm
push ds
push es
mov ax,p1
mov ds,ax
mov ax,p2
mov es,ax
mov bx,[X1]
mov dx,[Y1]
push bx {; and this again for later}
mov bx, dx {; bx = dx}
mov dh, dl {; dx = dx * 256}
xor dl, dl
shl bx, 6 {; bx = bx * 64}
add dx, bx {; dx = dx + bx (ie y*320)}
pop bx {; get back our x}
add bx, dx {; finalise location}
mov si, bx {; es:di = where to go}
mov bx,[X3]
mov dx,[Y3]
push bx {; and this again for later}
mov bx, dx {; bx = dx}
mov dh, dl {; dx = dx * 256}
xor dl, dl
shl bx, 6 {; bx = bx * 64}
add dx, bx {; dx = dx + bx (ie y*320)}
pop bx {; get back our x}
add bx, dx {; finalise location}
mov di, bx {; es:di = where to go}
mov ax,[y2]
sub ax,[y1]
mov dx,[x2]
sub dx,[x1]
mov bx,320
sub bx,dx
@@1 :
mov cx, dx { Width of block to copy divided by 2 }
rep movsb
add di,bx { 320 - 48 = 272 .. or 110 in hex }
add si,bx
dec ax
jnz @@1
pop es
pop ds
end;
{ I wrote this procedure late last night, so it may not be in it's
most optimised state. Sorry :-)}
END;
{************
*************
************
************}
procedure story;
var error:byte;
xtemp,ytemp:integer;
thrustcol:integer;
thrust:real;
tempch:char;
alienchar:byte;
cycles:byte;
procedure doflames;
begin
if flames=true then begin
putshape(bigflame1off,vaddr,27,17,213,100);
putshapeover(sflame2off,vaddr,4,4,105,90);
putshapeover(sflame1off,vaddr,4,4,151,71);
putshapeover(sflame2off,vaddr,4,4,218,72);
end
else
begin
putshape(bigflame2off,vaddr,27,17,213,100);
putshapeover(sflame1off,vaddr,4,4,105,90);
putshapeover(sflame2off,vaddr,4,4,151,71);
putshapeover(sflame1off,vaddr,4,4,218,72);
outtextxy(chr(alienchar),10,10,12,0,vaddr,true);
inc(alienchar);
if alienchar>44 then alienchar:=34;
end;
flip(vaddr,vga);
vdelay(5);
flames:=not(flames);
end;
procedure puttruck(xp,yp,frame:integer;where:word);
var xtemp,into,ytemp:integer;
col:byte;
begin
for into:=0 to 7 do begin
if(into+yp>=172) then
if frame=0 then putshapeline(truck1off,where,6,8,xp,yp,into)
else putshapeline(truck2off,where,6,8,xp,yp,into);
end;
end;
procedure pauseawhile(howlong:word);
var i:word;
begin
i:=0;
repeat
waitretrace;
inc(i);
if i>howlong then exit;
until keypressed;
end;
begin
fade;
error:=loadpicsuperpacked(0,0,vaddr,false,true,'tbsobj.tb1');
for ytemp:=0 to 18 do
for xtemp:=0 to 26 do begin
ShapeTable1^[((ytemp*27)+xtemp)+bigflame1off]:=getpixel(xtemp,ytemp+2,vaddr);
ShapeTable1^[((ytemp*27)+xtemp)+bigflame2off]:=getpixel(xtemp,ytemp+21,vaddr);
end;
for ytemp:=0 to 18 do
for xtemp:=0 to 15 do begin
ShapeTable1^[((ytemp*16)+xtemp)+explo1off]:=getpixel(127+xtemp,ytemp+100,vaddr);
ShapeTable1^[((ytemp*16)+xtemp)+explo2off]:=getpixel(148+xtemp,ytemp+100,vaddr);
end;
for ytemp:=0 to 6 do
for xtemp:=0 to 15 do
ShapeTable1^[((ytemp*16)+xtemp)+rent1off]:=getpixel(168+xtemp,ytemp+100,vaddr);
for ytemp:=0 to 4 do
for xtemp:=0 to 3 do begin
ShapeTable1^[((ytemp*4)+xtemp)+sflame1off]:=getpixel(xtemp,ytemp+43,vaddr);
ShapeTable1^[((ytemp*4)+xtemp)+sflame2off]:=getpixel(xtemp,ytemp+47,vaddr);
end;
for ytemp:=0 to 18 do
for xtemp:=0 to 15 do
ShapeTable1^[((ytemp*16)+xtemp)+bargeoff]:=getpixel(xtemp+65,ytemp+100,vaddr);
for ytemp:=0 to 8 do
for xtemp:=0 to 5 do begin
ShapeTable1^[((ytemp*6)+xtemp)+truck1off]:=getpixel(xtemp+85,ytemp+100,vaddr);
ShapeTable1^[((ytemp*6)+xtemp)+truck2off]:=getpixel(xtemp+95,ytemp+100,vaddr);
end;
{******FIRST MESSAGE*******}
cls(0,vga);
outtextxy('THE STORY SO FAR...',20,20,4,0,vga,false);
unfade;
pauseawhile(300); if keypressed then if readkey=#27 then exit;
fade;
cls(0,vga);
error:=loadpicsuperpacked(0,0,vaddr2,false,true,'tbcobj.tb1');
blockmove(129,56,178,188,vaddr2,10,10,vga);
outtextxy('YOU ARE TOM BOMBEM, A STRANGE',80,10,1,0,vga,false);
outtextxy(' BUT EFFICIENT MEMBER OF',80,20,1,0,vga,false);
outtextxy(' THE LUNAR SPACE FORCE.',80,30,1,0,vga,false);
outtextxy('YOU NEVER SAY MUCH AND YOU ARE',80,50,4,0,vga,false);
outtextxy(' RARELY SEEN OUTSIDE OF ',80,60,4,0,vga,false);
outtextxy(' YOUR BLUE SPACESUIT.',80,70,4,0,vga,false);
outtextxy('YOU OFTEN GET YOURSELF IN ',80,90,2,0,vga,false);
outtextxy(' TROUBLE BY SCRATCHING',80,100,2,0,vga,false);
outtextxy(' YOUR HEAD AT INAPPROPRIATE',80,110,2,0,vga,false);
outtextxy(' TIMES.',80,120,2,0,vga,false);
outtextxy('PRESS ANY KEY....',96,185,15,0,vga,false);
unfade;
pauseawhile(900); if keypressed then if readkey=#27 then exit;
fade;
cls(0,vga);
blockmove(129,56,178,188,vaddr2,260,10,vga);
blockmove(99,104,128,185,vaddr2,287,13,vga);
outtextxy('IT IS THE YEAR 2028.',10,10,1,0,vga,false);
outtextxy('YOU HAVE BEEN SUMMONED BY',10,30,3,0,vga,false);
outtextxy(' LUNAR DICTATOR-IN-CHIEF',10,40,3,0,vga,false);
outtextxy(' VINCENT WEAVER ABOUT A',10,50,3,0,vga,false);
outtextxy(' TOP SECRET THREAT TO ',10,60,3,0,vga,false);
outtextxy(' INTERPLANETARY SECURITY.',10,70,3,0,vga,false);
outtextxy('YOU ATTEND THE BRIEFING WITH',10,90,5,0,vga,false);
outtextxy(' YOUR USUAL CONFUSED',10,100,5,0,vga,false);
outtextxy(' QUIETNESS. YOU STILL DO',10,110,5,0,vga,false);
outtextxy(' NOT UNDERSTAND YOUR OWN',10,120,5,0,vga,false);
outtextxy(' SUCCESSFULNESS.',10,130,5,0,vga,false);
outtextxy('PRESS ANY KEY....',96,185,15,0,vga,false);
unfade;
pauseawhile(900); if keypressed then if readkey=#27 then exit;
fade;
error:=loadpicsuperpacked(0,0,vga,false,true,'tbchief.tb1');
unfade;
blockmove(115,55,206,114,vga,115,55,vaddr);
blockmove(188,14,279,73,vaddr2,115,55,vga);
pauseawhile(600); if keypressed then if readkey=#27 then exit;
blockmove(115,55,206,114,vaddr,115,55,vga);
outtextxy('Ahhh.... Mr. Bombem.... ',1,1,15,0,vga,true);
pauseawhile(400); if keypressed then if readkey=#27 then exit;
outtextxy('I''ll be brief. ',1,1,15,0,vga,true);
pauseawhile(400); if keypressed then if readkey=#27 then exit;
outtextxy('Do you know how this base was founded?',1,1,15,0,vga,true);
pauseawhile(600); if keypressed then if readkey=#27 then exit;
outtextxy('No? Well watch the screen. ',1,1,15,0,vga,true);
pauseawhile(400); if keypressed then if readkey=#27 then exit;
blockmove(210,75,295,134,vaddr2,210,136,vga);
pauseawhile(300); if keypressed then if readkey=#27 then exit;
pal(250,0,0,0);
fade;
{******BARGE TAKING OFF**********}
error:=loadpicsuperpacked(0,0,vaddr2,false,true,'tbma1.tb1');
outsmalltextxy('MY WIFE AND I FOUNDED',212,3,14,0,vaddr2,false);
outsmalltextxy('THIS BASE IN 2008.',212,9,14,0,vaddr2,false);
outsmalltextxy('THE ONLY WAY TO ',212,16,13,0,vaddr2,false);
outsmalltextxy('FINANCE IT WAS TO',212,22,13,0,vaddr2,false);
outsmalltextxy('ENGAGE IN A DUBIOUS',212,28,13,0,vaddr2,false);
outsmalltextxy('BUSINESS.',212,34,13,0,vaddr2,false);
outsmalltextxy('WE LAUNCHED EARTH''S',212,41,12,0,vaddr2,false);
outsmalltextxy('TRASH INTO SPACE',212,47,12,0,vaddr2,false);
outsmalltextxy('FOR A PROFIT.',212,53,12,0,vaddr2,false);
outsmalltextxy('HERE IS FOOTAGE FROM',212,60,11,0,vaddr2,false);
outsmalltextxy('THE FINAL LAUNCH FIVE',212,66,11,0,vaddr2,false);
outsmalltextxy('YEARS AGO.',212,72,11,0,vaddr2,false);
flip(vaddr2,vaddr);
putshape(bargeoff,vaddr,16,18,141,157);
flip(vaddr,vga);
unfade;
pauseawhile(700); if keypressed then if readkey=#27 then exit;
for ytemp:=191 downto 164 do begin
if ytemp>=172 then blockmove(145,ytemp,152,ytemp+10,vaddr2,145,ytemp,vaddr)
else blockmove(145,172,152,182,vaddr2,145,172,vaddr);
puttruck(145,ytemp,ytemp mod 2,vaddr);
pauseawhile(7);
if keypressed then if readkey=#27 then exit;
flip(vaddr,vga);
end;
pauseawhile(20);
flip(vaddr2,vaddr);
putshape(bargeoff,vaddr,16,18,141,157);
thrustcol:=0;
ytemp:=157;
thrust:=0;
while ytemp>-25 do begin
thrust:=thrust+0.05;
if thrustcol<63 then inc(thrustcol);
blockmove(141,ytemp,171,ytemp+30,vaddr2,141,ytemp,vaddr);
for i:=1 to 17 do
if ytemp+i>=0 then
putshapeline(bargeoff,vaddr,16,18,141,ytemp,i);
pauseawhile(5);
if keypressed then if readkey=#27 then exit;
pal(250,thrustcol,0,0);
flip(vaddr,vga);
ytemp:=ytemp-round(thrust);
end;
pauseawhile(100);
if keypressed then if readkey=#27 then exit;
fade;
{****SECOND CHIEF*******}
error:=loadpicsuperpacked(0,0,vaddr2,false,true,'tbcobj.tb1');
error:=loadpicsuperpacked(0,0,vga,false,true,'tbchief.tb1');
blockmove(7,104,97,125,vaddr2,6,174,vga);
unfade;
outtextxy('You might wonder why this is important.',1,1,15,0,vga,true);
pauseawhile(600); if keypressed then if readkey=#27 then exit;
outtextxy('Last week we received a message. ',1,1,15,0,vga,true);
pauseawhile(600); if keypressed then if readkey=#27 then exit;
outtextxy('It is of extra-terrestrial origin. ',1,1,15,0,vga,true);
pauseawhile(600); if keypressed then if readkey=#27 then exit;
outtextxy('Watch the screen. ',1,1,15,0,vga,true);
blockmove(210,136,295,195,vaddr2,210,136,vga);
pauseawhile(300); if keypressed then if readkey=#27 then exit;
fade;
{******ALIEN DELEGATION*****}
error:=loadpicsuperpacked(0,0,vaddr2,false,true,'tbcrash.tb1');
alienchar:=34;
flip(vaddr2,vaddr);
flip(vaddr,vga);
putshape(bargeoff,vaddr,16,18,97,180);
unfade;
xtemp:=97;
ytemp:=181;
flames:=true;
while ytemp>118 do begin
blockmove(xtemp,ytemp,xtemp+20,ytemp+20,vaddr2,xtemp,ytemp,vaddr);
putshape(bargeoff,vaddr,16,18,xtemp,ytemp);
doflames;
dec(ytemp);
inc(xtemp);
pauseawhile(1);
if keypressed then if readkey=#27 then exit;
end;
blockmove(xtemp,ytemp,xtemp+30,ytemp+30,vaddr2,xtemp,ytemp,vaddr);
pal(0,63,63,63);
putshape(explo1off,vga,16,18,160,118);
pauseawhile(5);
if keypressed then if readkey=#27 then exit;
pal(0,0,0,0);
for xtemp:=0 to 10 do begin
putshapeover(explo2off,vaddr,16,18,160,118);
doflames;
putshapeover(explo1off,vaddr,16,18,160,118);
doflames;
end;
blockmove(159,114,189,144,vaddr2,159,114,vaddr);
putshapeover(rent1off,vaddr,16,6,160,115);
flip(vaddr,vga);
cycles:=0;
repeat
doflames;
inc(cycles);
until ((keypressed) or (cycles>60));
if keypressed then if readkey=#27 then exit;
{****ALIEN MESSAGE*****}
fade;
error:=loadpicsuperpacked(0,0,vga,false,true,'tbgorg.tb1');
unfade;
outtextxy('GREETINGS EARTHLINGS.',0,162,12,0,vga,false);
outtextxy('I AM GORGONZOLA THE REPULSIVE.',0,171,12,0,vga,false);
outtextxy('YOU HAVE MADE A BIG MISTAKE.',0,180,12,0,vga,false);
pauseawhile(600);
if keypressed then if readkey=#27 then exit;
outtextxy('YOUR SHIP FULL OF REFUSE HAS',0,162,12,0,vga,true);
outtextxy('DAMAGED OUR OFFICIAL PEACE ',0,171,12,0,vga,true);
outtextxy('ENVOY. IT WAS ON ITS WAY TO ',0,180,12,0,vga,true);
outtextxy('YOUR PLANET. ',0,189,12,0,vga,true);
pauseawhile(600);
if keypressed then if readkey=#27 then exit;
outtextxy('IN AN IRONIC FORM OF RETALLIATION',0,162,12,0,vga,true);
outtextxy('WE HAVE MADE YOUR TRASH EVIL AND',0,171,12,0,vga,true);
outtextxy('TURNED IT AGAINST YOU. ',0,180,12,0,vga,true);
outtextxy(' DIE EARTH SCUM! ',0,189,12,0,vga,true);
pauseawhile(600);
if keypressed then if readkey=#27 then exit;
fade;
{****** THIRD CHIEF *******}
error:=loadpicsuperpacked(0,0,vaddr2,false,true,'tbcobj.tb1');
error:=loadpicsuperpacked(0,0,vga,false,true,'tbchief.tb1');
blockmove(7,127,97,148,vaddr2,6,174,vga);
unfade;
outtextxy('Tom, our radar detects approaching ',1,1,15,0,vga,true);
pauseawhile(500); if keypressed then if readkey=#27 then exit;
outtextxy('objects. They are inside the ',1,1,15,0,vga,true);
pauseawhile(500); if keypressed then if readkey=#27 then exit;
outtextxy('orbit of Jupiter. ',1,1,15,0,vga,true);
pauseawhile(500); if keypressed then if readkey=#27 then exit;
outtextxy('You are our only hope! ',1,1,15,0,vga,true);
pauseawhile(500); if keypressed then if readkey=#27 then exit;
outtextxy('Will you fly our only spaceship ',1,1,15,0,vga,true);
pauseawhile(500); if keypressed then if readkey=#27 then exit;
outtextxy('and save the human race? ',1,1,15,0,vga,true);
pauseawhile(500); if keypressed then if readkey=#27 then exit;
blockmove(5,16,44,98,vaddr2,146,59,vga);
pauseawhile(10);
blockmove(46,16,85,98,vaddr2,146,59,vga);
pauseawhile(10);
blockmove(87,16,126,98,vaddr2,146,59,vga);
outtextxy('Scratch. Scratch. <Ow that itches>',1,1,9,0,vga,true);
pauseawhile(300); if keypressed then if readkey=#27 then exit;
outtextxy('I knew you''d do it. Good Luck! ',1,1,15,0,vga,true);
pauseawhile(600); if keypressed then if readkey=#27 then exit;
outtextxy('<Huh?> ',1,1,9,0,vga,true);
pauseawhile(600); if keypressed then if readkey=#27 then exit;
end;
begin
setmcga;
setuptb1;
setupvirtual;
error:=loadpicsuperpacked(0,0,vga,true,false,'tbma1.tb1');
story;
unfade;
settext;
end.

1366
svmwgrap.pas Normal file
View File

File diff suppressed because it is too large Load Diff

BIN
t2tract.tb1 Normal file
View File

Binary file not shown.

316
tb1.doc Normal file
View File

@ -0,0 +1,316 @@
°°°°°² °°°°°² °² °² °°°°² °°°°°² °² °² °°°°² °°°°°² °² °²
°² °² °² °°²°°² °² °² °² °² °°²°°² °² °² °² °°²°°²
°² °² °² °²°²°² °°°°² °² °² °²°²°² °°°°² °°°°² °²°²°²
°² °² °² °² °² °² °² °² °² °² °² °² °² °² °² °²
°² °°°°°² °² °² °°°°² °°°°°² °² °² °°°°² °°°°°² °² °²
AND THE INVASION OF THE INANIMATE OBJECTS
by
Vince Weaver
Version 2.4a
---------------------------------------------------------------------
Contents
--------
1.0 SYSTEM REQUIREMENTS
2.0 STARTING THE GAME
3.0 THE STORY
4.0 GAME PLAY
5.0 SAVING/LOADING GAMES
6.0 TROUBLESHOOTING
7.0 REGISTERING
8.0 ACKNOWLEDGEMENTS
9.0 CURRENT BUGS (FEATURES)
10.0 PRAISE/ACCOMPLISHMENTS
1.0 SYSTEM REQUIREMENTS
---------------------------------------------------------------------
Bare Minimum:
286/ 400K RAM/ 500K disk space
To run at a reasonable speed:
386 33Mhz or better
For Digitized Sound:
XMS RAM, Sound Blaster or Compatible sound card
(I have been developing this on a 386 33Mhz and it runs
passibly. It runs so much smoother on a 486. I'll try
to optimize the code some more...)
2.0 STARTING THE GAME
---------------------------------------------------------------------
Make sure all the files are in the same directory (list below)
[if any are missing, you will get a run-time error]
Run the TBSETUP configuration utility. Pick the appropriate
options.
Type TB1 to run the game. See "TROUBLESHOOTING" if you encounter
any errors.
To run Tom Bombem off of a CD-ROM:
Either type "tb1 -cdrom" to start the program in read-only
mode, or say "y" when prompted if you want read-only mode.
In this mode there are no saved games and the high score
list will not change.
Files Needed:
TB1.EXE - Main executable
TBSETUP.EXE - Setup Program
CONFIG.TB1 - Config File Created by Setup Program
TBSOUND.EXE - Cool sound tester
MOON2.TB1 ¿
REGISTER.TB1 ³
TBGORG.TB1 ³
TBCRASH.TB1 ³
TBSOBJ.TB1 ³
SHIPS.TB1 Ã Graphics files in PAINTPRO 5.0 format
TBOMB1.TB1 ³
TBMA1.TB1 ³
VIEWSCR.TB1 ³
TBSHAPES.TB1 ³
TBCOBJ.TB1 ³
TBCHIEF.TB1 ³
TBASHIP.TB1 ³
TBL2SHIP.TB1 ³
TBLEV3.TB1 ³
TBL3INTR.TB1 ³
TBEERM.TB1 ³
TBCONSOL.TB1 ³
TBPIT.TB1 ³
TBASH.TB1 ³
TBCOBJ.TB1 ³
TBTRACT.TB1 Ù
LEVEL2.TB1 - Level Two Database
LEVEL4.TB1 - Level Four Database
FILE_ID.DIZ - Info file for BBS's
TBFONT.TB1 - Fonts for the game (a standard VGA font)
HISCORE.TB1 - The High Score List
TB1.DOC - The file you're reading
SOUNDS.TB1 - Sound effects
SGx.TB1 - Where x is a number... these are saved games
3.0 THE STORY
---------------------------------------------------------------------
To understand the game, pick the "Story" option off of the
main menu. This part of the game took a lot of time in
itself, and is fun to read.
The "Audio Error!" is not a real error. I just saved myself
the trouble of recording a voice-track for the game. As many
friends have said, "That's cheating!" but anyway unless I had
a lot of time and a CD-ROM, it is not practical.
Anyway in the story, any key will speed up most scenes, and
escape will quit the whole thing.
4.0 GAME PLAY
--------------------------------------------------------------------
To begin the game, select "NEW GAME" at the main menu.
A little humorous movie will show; press <esc> to skip.
The game itself is pretty simplistic as of yet. Basically
shoot the things coming at you. The arrow keys manuever...
the manuevering takes a little bit of practice to master.
Space shoots. You can shoot up to two missiles at once.
"S" toggles sound. "P" pauses. If the game play is too fast,
try the "+" and "-" keys to adjust. Sorry, if it runs too
slow at the onset, then your computer is too slow.
The first level culminates with a "boss" character. Read the
story and see what happens. The dialog will clue you into
what's happening.
The second level is now totally finished. Be sure to save
your games whenever you start a new level!
Levels three and four are currently under development. In
level three, use the arrow keys to "walk" around. The space
bar will fire a weapon if you've picked one up. To activate/
pick up things, walk into them.
Level four is similar to level two. (Actually they are based
on the same game engine). They will be finished by version 2.5.
An undocumented featue: when your score reaches a multiple of
400 your shields are increased by one.
Basic Summary of Keyboard Commands:
ARROWS Manuever
SPACE Fires
<ESC> Exits
P Pauses
S Toggles sound on/off
+ Slows down game speed
- Increases game speed
F1 Shows help message
F2 Saves the Game (see "SAVING/LOADING GAMES")
5.0 SAVING/ LOADING GAMES
---------------------------------------------------------------------
You can save games. However the only part that is saved is
how you begin the level. Therefore there is no real purpose
to saving your game until you reach level two.
This might seem annoying, but at this point it is the only
practical way to implement saved games.
6.0 TROUBLESHOOTING
---------------------------------------------------------------------
This program usually runs fine on most computers. Occasionally
it will lock up on my brother for some inexplicable reason.
If it locks up frequently, try playing without sound blaster
sounds.
Possible Problems:
RUNTIME ERRORS: (Characterized by a "Rumtime Error at 4454:3434"
message.) Either a genuine bug or else one of
the ".TB1" graphics files is missing.
LOCKING UP : If you have a sound blaster, try configuring
without SOUND, using the "TBSETUP" utility.
MEMORY ERRORS : If you want soundblaster sound, HIMEM.SYS must
be loaded. Check DOS documentation.
SOUND ERRORS : If you have a sound blaster and you are not
getting sound, be sure your "SET BLASTER"
command in your autoexec.bat is set properly.
HARSH GRATING SOUND: This has happened occassionally at a
certain point on level two. I've tried to
fix it. If it's annoying, turn the sound
off.
MISC ERRORS : Contact me at vmweaver@wam.umd.edu
7.0 REGISTERING
---------------------------------------------------------------------
My game is freeware. There is no copy protection. Hopefully
if you like it you will let me know, by mail or by e-mail.
A donation is not required, but if you want to you can send
me one.
I will be attending college soon (Fall of 1996) so my e-mail
address, has changed from what it was earlier to:
vmweaver@wam.umd.edu
You can get Tom Bombem at its web site,
http://www.wam.umd.edu/~vmweaver/tb1/
Also, a college education is expensive, so any donations would
be a big help.
Vince Weaver vmweaver@wam.umd.edu
[real home]
326 Foster Knoll Dr.
Joppa, MD 21085-4706
8.0 ACKNOWLEDGEMENTS
---------------------------------------------------------------------
I would like to thank many people who helped on this project.
Ethan Brodsky for his excelent sound blaster routines.
Get them at http://www.pobox.com/~ebrodsky/smix/smix.html
There would be no sound blaster sound without them.
The authors of PCGPE. This program started out as a
"flying toaster" demonstration from the Asphixia
VGA tutorials. I gradually replaced most of their code,
but I still use their putpixel, waitretrace, setmcga and
settext routines.
I would also like to thank all my friends who have supported
me, especially Gus Thompson, because she went to Spain and
gave me time to work on this. Also Marie Prosser for
inspiration, and she also went away for three weeks
allowing me to work on this. Thanks to Nick Attanasio
who actually plays this game a lot, and whose comments
have hastened work on level 3.
FUTURE ENHANCEMENTS:
I am going to learn how to use Mode X vga programming.
Supposedly this will speed up the code. Unless you
have a 386 like me, you probably won't notice.
I'm also going to try to get some music in the
background, and of course add more levels.
Also watch for a SGI gl port and possibly some
sort of Linux port. The only problem is that
they'll have to be in C. ( :-( )
9.0 CURRENT BUGS (FEATURES)
-------------------------------------------------------------------
Level One: No Known Ones
Level Two: Locks up for no reason near end sometimes?
Level Three: Many. This level still is under development.
Sometimes doors will not activate, sometimes
they send you to the wrong room.
Laser doesn't work, nor do enemies or
radioactive flooring. It is possible to
beat it though.
Level Four:Not done. Right now is level two with different
shape table.
LOOK FOR NEWER RELEASES TO HAVE FEWER BUGS.
If you find a unique bug, e-mail me describing it.
10.0 PRAISE/ACCOMPLISHMENTS OF TOM BOMBEM
___________________________________________________________________
Supposedly it will be on one of Pacific Hi-Tech's
"Gamehead" CD's. We'll see.
A German book company has offered to put it in a CD included
with a Shareware Games book.
Now Praise:
"I just like it when it says 'Ahhh... Mr. Bombem.'"
----Greg Grabowski, Bel Air, MD
"It's simplicity reminded me of the early computer
shooters... Kind of nostalgic... But the nice
side [is] the very clever cinematic text."
---->> Delance <<
"The game is well designed but does not fit
our current product line."
----Apogee Software Productions
Remember: Watch for the newest version of Tom Bombem... and have fun.
Vince Weaver 14 July 1996 18:12:59 EDT

4349
tb1.pas
View File

File diff suppressed because it is too large Load Diff

614
tb12.pas
View File

@ -1,614 +0,0 @@
program TOM_BOMB_EM_AND_INVASION_OF_INANIMATE_OBJECTS;
{by Vincent Weaver....21085-4706}
uses vmwgraph,crt;
{$I c:\pascal\tb1ans.pas}
type screentype = array [0..3999] of byte;
Type Toastinfo = Record { This is format of of each of our }
x,y:integer; { records for the flying toasters }
speed,frame:integer;
active:boolean;
END;
icon = Array [1..30*48] of byte; { This is the size of our pictures }
Virtual = Array [1..64000] of byte; { The size of our Virtual Screen }
VirtPtr = ^Virtual; { Pointer to the virtual screen }
CONST frame1 : icon = (
00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,01,01,01,
01,01,01,01,01,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,
00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,02,02,02,
02,02,02,02,02,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,
00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,03,03,03,
03,03,03,03,03,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,
00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,04,04,04,
04,04,04,04,04,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,
00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,05,05,05,
05,05,05,05,05,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,
00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,06,06,06,
06,06,06,06,06,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,
00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,05,05,05,
05,05,05,05,05,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,
00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,05,05,05,
05,05,05,05,05,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,
00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,07,07,07,
7,07,07,07,07,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,
00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,07,07,07,07,
7,07,07,07,07,07,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,
00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,07,08,07,07,07,
7,07,07,07,07,08,07,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,
00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,07,08,09,07,07,07,
7,07,07,07,07,09,08,07,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,
00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,07,08,09,09,07,07,07,
7,07,07,07,07,09,09,08,07,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,
00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,07,08,09,09,09,07,07,07,
7,07,07,07,07,09,09,09,08,07,00,00,00,00,00,00,00,00,00,00,00,00,00,00,
00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,07,08,09,09,09,09,07,07,07,
7,07,07,07,07,09,09,09,09,08,07,00,00,00,00,00,00,00,00,00,00,00,00,00,
00,00,00,00,00,00,00,00,00,00,00,00,00,00,07,08,09,09,09,09,09,07,07,07,
7,07,07,07,07,09,09,09,09,09,08,07,00,00,00,00,00,00,00,00,00,00,00,00,
00,00,00,00,00,00,00,00,00,00,00,00,00,07,08,09,09,09,09,09,09,07,07,07,
7,07,07,07,07,09,09,09,09,09,09,08,07,00,00,00,00,00,00,00,00,00,00,00,
00,00,00,00,00,00,00,00,00,00,00,00,07,08,09,09,09,09,09,09,09,07,07,07,
09,09,07,07,07,09,09,09,09,09,09,09,08,07,00,00,00,00,00,00,00,00,00,00,
00,00,00,00,00,00,00,00,00,00,00,07,08,13,14,15,14,15,09,09,09,07,07,07,
08,08,07,07,07,09,09,09,13,14,15,14,15,08,07,00,00,00,00,00,00,00,00,00,
00,00,00,00,00,00,00,00,00,00,07,08,09,13,14,15,14,15,09,09,09,07,07,07,
7,07,07,07,07,09,09,09,13,14,15,14,15,09,08,07,00,00,00,00,00,00,00,00,
00,00,00,00,00,00,00,00,00,07,08,09,09,09,09,09,09,09,09,09,09,07,07,07,
10,10,07,07,07,09,09,09,09,09,09,09,09,09,09,08,07,00,00,00,00,00,00,00,
00,00,00,00,00,00,00,00,07,08,08,08,08,08,08,08,08,08,08,08,08,07,07,07,
11,11,07,07,07,08,08,08,08,08,08,08,08,08,08,08,08,07,00,00,00,00,00,00,
00,00,00,00,00,00,00,07,07,07,07,07,07,07,07,07,07,07,07,07,07,07,07,07,
12,12,07,07,07,07,07,07,07,07,07,07,07,07,07,07,07,07,07,00,00,00,00,00,
00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,18,
17,17,18,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,
00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,18,19,
20,20,19,18,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,
00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,25,24,
21,21,24,25,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,
00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,27,26,25,
22,22,25,27,00,26,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,
00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,27,24,
23,23,24,26,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,
00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,26,27,
24,27,27,27,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,
00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,26,25,26,
26,26,27,25,26,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00);
frame2 : icon = (
00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,01,01,01,
01,01,01,01,01,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,
00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,02,02,02,
02,02,02,02,02,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,
00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,03,03,03,
03,03,03,03,03,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,
00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,04,04,04,
04,04,04,04,04,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,
00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,05,05,05,
05,05,05,05,05,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,
00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,06,06,06,
06,06,06,06,06,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,
00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,05,05,05,
05,05,05,05,05,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,
00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,05,05,05,
05,05,05,05,05,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,
00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,07,07,07,
07,07,07,07,07,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,
00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,07,07,07,07,
07,07,07,07,07,07,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,
00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,07,08,07,07,07,
07,07,07,07,07,08,07,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,
00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,07,08,09,07,07,07,
07,07,07,07,07,09,08,07,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,
00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,07,08,09,09,07,07,07,
07,07,07,07,07,09,09,08,07,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,
00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,07,08,09,09,09,07,07,07,
07,07,07,07,07,09,09,09,08,07,00,00,00,00,00,00,00,00,00,00,00,00,00,00,
00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,07,08,09,09,09,09,07,07,07,
07,07,07,07,07,09,09,09,09,08,07,00,00,00,00,00,00,00,00,00,00,00,00,00,
00,00,00,00,00,00,00,00,00,00,00,00,00,00,07,08,09,09,09,09,09,07,07,07,
07,07,07,07,07,09,09,09,09,09,08,07,00,00,00,00,00,00,00,00,00,00,00,00,
00,00,00,00,00,00,00,00,00,00,00,00,00,07,08,09,09,09,09,09,09,07,07,07,
07,07,07,07,07,09,09,09,09,09,09,08,07,00,00,00,00,00,00,00,00,00,00,00,
00,00,00,00,00,00,00,00,00,00,00,00,07,08,09,09,09,09,09,09,09,07,07,07,
09,09,07,07,07,09,09,09,09,09,09,09,08,07,00,00,00,00,00,00,00,00,00,00,
00,00,00,00,00,00,00,00,00,00,00,07,08,13,14,15,14,15,09,09,09,07,07,07,
08,08,07,07,07,09,09,09,13,14,15,14,15,08,07,00,00,00,00,00,00,00,00,00,
00,00,00,00,00,00,00,00,00,00,07,08,09,13,14,15,14,15,09,09,09,07,07,07,
07,07,07,07,07,09,09,09,13,14,15,14,15,09,08,07,00,00,00,00,00,00,00,00,
00,00,00,00,00,00,00,00,00,07,08,09,09,09,09,09,09,09,09,09,09,07,07,07,
10,10,07,07,07,09,09,09,09,09,09,09,09,09,09,08,07,00,00,00,00,00,00,00,
00,00,00,00,00,00,00,00,07,08,08,08,08,08,08,08,08,08,08,08,08,07,07,07,
11,11,07,07,07,08,08,08,08,08,08,08,08,08,08,08,08,07,00,00,00,00,00,00,
00,00,00,00,00,00,00,07,07,07,07,07,07,07,07,07,07,07,07,07,07,07,07,07,
12,12,07,07,07,07,07,07,07,07,07,07,07,07,07,07,07,07,07,00,00,00,00,00,
00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,18,
17,17,18,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,
00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,18,19,
20,20,19,18,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,
00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,25,24,
21,21,25,25,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,
00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,27,26,25,
22,22,27,27,00,26,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,
00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,27,24,
24,23,23,27,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,
00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,26,27,
24,27,27,27,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,
00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,26,25,26,
26,26,27,25,26,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00);
frame3 : icon = (
00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,01,01,01,
01,01,01,01,01,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,
00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,02,02,02,
02,02,02,02,02,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,
00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,03,03,03,
03,03,03,03,03,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,
00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,04,04,04,
04,04,04,04,04,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,
00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,05,05,05,
05,05,05,05,05,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,
00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,06,06,06,
06,06,06,06,06,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,
00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,05,05,05,
05,05,05,05,05,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,
00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,05,05,05,
05,05,05,05,05,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,
00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,07,07,07,
07,07,07,07,07,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,
00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,07,07,07,07,
07,07,07,07,07,07,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,
00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,07,08,07,07,07,
07,07,07,07,07,08,07,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,
00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,07,08,09,07,07,07,
07,07,07,07,07,09,08,07,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,
00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,07,08,09,09,07,07,07,
07,07,07,07,07,09,09,08,07,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,
00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,07,08,09,09,09,07,07,07,
07,07,07,07,07,09,09,09,08,07,00,00,00,00,00,00,00,00,00,00,00,00,00,00,
00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,07,08,09,09,09,09,07,07,07,
07,07,07,07,07,09,09,09,09,08,07,00,00,00,00,00,00,00,00,00,00,00,00,00,
00,00,00,00,00,00,00,00,00,00,00,00,00,00,07,08,09,09,09,09,09,07,07,07,
07,07,07,07,07,09,09,09,09,09,08,07,00,00,00,00,00,00,00,00,00,00,00,00,
00,00,00,00,00,00,00,00,00,00,00,00,00,07,08,09,09,09,09,09,09,07,07,07,
07,07,07,07,07,09,09,09,09,09,09,08,07,00,00,00,00,00,00,00,00,00,00,00,
00,00,00,00,00,00,00,00,00,00,00,00,07,08,09,09,09,09,09,09,09,07,07,07,
09,09,07,07,07,09,09,09,09,09,09,09,08,07,00,00,00,00,00,00,00,00,00,00,
00,00,00,00,00,00,00,00,00,00,00,07,08,13,14,15,14,15,09,09,09,07,07,07,
08,08,07,07,07,09,09,09,13,14,15,14,15,08,07,00,00,00,00,00,00,00,00,00,
00,00,00,00,00,00,00,00,00,00,07,08,09,13,14,15,14,15,09,09,09,07,07,07,
07,07,07,07,07,09,09,09,13,14,15,14,15,09,08,07,00,00,00,00,00,00,00,00,
00,00,00,00,00,00,00,00,00,07,08,09,09,09,09,09,09,09,09,09,09,07,07,07,
10,10,07,07,07,09,09,09,09,09,09,09,09,09,09,08,07,00,00,00,00,00,00,00,
00,00,00,00,00,00,00,00,07,08,08,08,08,08,08,08,08,08,08,08,08,07,07,07,
11,11,07,07,07,08,08,08,08,08,08,08,08,08,08,08,08,07,00,00,00,00,00,00,
00,00,00,00,00,00,00,07,07,07,07,07,07,07,07,07,07,07,07,07,07,07,07,07,
12,12,07,07,07,07,07,07,07,07,07,07,07,07,07,07,07,07,07,00,00,00,00,00,
00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,18,
17,17,18,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,
00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,18,19,
20,20,19,18,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,
00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,25,24,
21,21,24,25,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,
00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,27,26,25,
22,22,25,27,00,26,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,
00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,27,24,
23,23,24,26,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,
00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,26,27,
24,27,27,27,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,
00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,26,25,26,
26,26,27,25,26,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00
);
VAR Virscr : VirtPtr; { Our first Virtual screen }
VirScr2 : VirtPtr; { Our second Virtual screen }
Vaddr : word; { The segment of our virtual screen}
Vaddr2 : Word; { The segment of our 2nd virt. screen}
ourpal : Array [0..255,1..3] of byte; { A virtual pallette }
toaster : Array [1..1] of toastinfo; { The toaster info }
Sound : Pointer;
Check : BOOLEAN;
var grapherror:byte;
temp:array[1..3] of byte;
palf:text;
i,j:byte;
x,y,barpos:integer;
screen:screentype absolute $B800:0000;
ch:char;
function menuread:char;
var chtemp,ch2:char;
begin
repeat until keypressed;
ch2:=#0;
chtemp:=readkey;
if chtemp=chr(0) then ch2:=readkey;
chtemp:=upcase(chtemp);
if (ord(chtemp)<10) and (ord(chtemp)<128) then begin
if ch2='H' then chtemp:='ß';
if ch2='M' then chtemp:='Þ';
if ch2='P' then chtemp:='Ü';
if ch2='K' then chtemp:='Ý';
end;
menuread:=chtemp;
end;
procedure coolbox(x1,y1,x2,y2:integer);
begin
for i:=0 to 5 do box(x1+i,y1+i,x2-i,y2-i,31-i,vga);
for i:=y1+5 to y2-5 do line(x1+5,i,x2-5,i,7,vga);
end;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
Procedure ShutDown;
{ This frees the memory used by the virtual screen }
BEGIN
FreeMem (VirScr,64000);
FreeMem (VirScr2,64000);
END;
procedure QUIT;
label menu2;
begin
coolbox(90,75,230,125);
barpos:=0;
outtextxy('QUIT??? ARE YOU',97,82,9,7,vga,false);
outtextxy('ABSOLUTELY SURE?',97,90,9,7,vga,false);
repeat
if barpos=0 then outtextxy('YES-RIGHT NOW!',97,98,150,0,vga,true)
else outtextxy('YES-RIGHT NOW!',97,98,150,7,vga,true);
if barpos=1 then outtextxy('NO--NOT YET.',97,106,150,0,vga,true)
else outtextxy('NO--NOT YET.',97,106,150,7,vga,true);
ch:=menuread;
if (ord(ch)>219) and (ord(ch)<224) then inc(barpos);
if ch='Y' then barpos:=0;
if ch='N' then barpos:=1;
if barpos=2 then barpos:=0;
until ch=#13;
if barpos=1 then goto menu2;
settext;
shutdown;
move(imagedata,screen,4000);
gotoxy(1,23);
halt;
menu2:
end;
Procedure SetUpVirtual;
{ This sets up the memory needed for the virtual screen }
BEGIN
GetMem (VirScr,64000);
vaddr := seg (virscr^);
GetMem (VirScr2,64000);
vaddr2 := seg (virscr2^);
END;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
Procedure putico(X,Y:Word;VAR sprt : icon;Where:Word); ASSEMBLER;
{ This puts an icon, EXCEPT it's color 0 (black) pixels, onto the screen
"where", at position X,Y }
label
_Redraw, _DrawLoop, _Exit, _LineLoop, _NextLine, _Store, _NoPaint;
asm
push ds
push es
lds si,Sprt
mov ax,X { ax = x }
mov bx,Y { bx = y }
_Redraw:
push ax
mov ax,[where]
mov es,ax
mov ax, bx {; ax = bx x = y}
mov bh, bl {; y = y * 256 bx = bx * 256}
xor bl, bl
shl ax, 1
shl ax, 1
shl ax, 1
shl ax, 1
shl ax, 1
shl ax, 1 {; y = y * 64 ax = ax * 64}
add bx, ax {; y = (y*256) + (Y*64) bx = bx + ax (ie y*320)}
pop ax {; get back our x}
add ax, bx {; finalise location}
mov di, ax
mov dl,30 { dl = height of sprite }
xor ch,ch
mov cl,48 { cx = width of sprite }
cld
push ax
mov ax,cx
_DrawLoop:
push di { store y adr. for later }
mov cx,ax { store width }
_LineLoop:
mov bl,byte ptr [si]
or bl,bl
jnz _Store
_NoPaint:
inc si
inc di
loop _LineLoop
jmp _NextLine
_Store:
movsb
loop _LineLoop
_NextLine:
pop di
dec dl
jz _Exit
add di,320 { di = next line of sprite }
jmp _DrawLoop
_Exit:
pop ax
pop es
pop ds
end;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
Procedure SetUpScreen;
{ This procedure sets up the static background to be used in the program }
CONST circ : Array [1..5,1..5] of byte =
((00,00,10,00,00),
(00,00,09,00,00),
(10,09,8,09,10),
(00,00,09,00,00),
(00,00,10,00,00));
VAR x,y:integer;
loop1,loop2,loop3:integer;
BEGIN
For loop1:=1 to 200 do BEGIN
x:=random (315);
y:=random (195);
For loop2:=1 to 5 do
For loop3:=1 to 5 do
if circ [loop2,loop3]<>0 then
putpixel (x+loop2,y+loop3,circ [loop2,loop3],vaddr);
END;
flip (vaddr,vga); { Copy the entire screen at vaddr, our virtual screen }
{ on which we have done all our graphics, onto the }
{ screen you see, VGA }
flip (vaddr,vaddr2);
END;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
Procedure ScreenTrans (x,y:word);
{ This is a small procedure to copy a 30x30 pixel block from coordinates
x,y on the virtual screen to coordinates x,y on the true vga screen }
BEGIN
asm
push ds
push es
mov ax,vaddr
mov es,ax
mov ax,vaddr2
mov ds,ax
mov bx,[X]
mov dx,[Y]
push bx {; and this again for later}
mov bx, dx {; bx = dx}
mov dh, dl {; dx = dx * 256}
xor dl, dl
shl bx, 1
shl bx, 1
shl bx, 1
shl bx, 1
shl bx, 1
shl bx, 1 {; bx = bx * 64}
add dx, bx {; dx = dx + bx (ie y*320)}
pop bx {; get back our x}
add bx, dx {; finalise location}
mov di, bx {; es:di = where to go}
mov si, di
mov al,60
mov bx, 30 { Hight of block to copy }
@@1 :
mov cx, 24 { Width of block to copy divided by 2 }
rep movsw
add di,110h { 320 - 48 = 272 .. or 110 in hex }
add si,110h
dec bx
jnz @@1
pop es
pop ds
end;
{ I wrote this procedure late last night, so it may not be in it's
most optimised state. Sorry :-)}
END;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
Procedure NewToaster;
{ This adds a new toaster to the screen }
VAR loop1:integer;
BEGIN
loop1:=0;
repeat
inc (loop1);
if not (toaster[loop1].active) then BEGIN
toaster[loop1].x:=36;
toaster[loop1].y:=165;
toaster[loop1].active:=true;
toaster[loop1].frame:=1;
toaster[loop1].speed:=5;
loop1:=10;
END;
until loop1=10;
END;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
Procedure Fly;
{ This is the procedure where we move and put the toasters }
VAR loop1,loop2:integer;
ch:char;
BEGIN
For loop1:=1 to 10 do
toaster[loop1].active:=FALSE;
ch:=#0;
NewToaster;
Repeat
if keypressed then BEGIN
ch:=readkey;
if ch='+' then inc(toaster[1].x,5);
if ch='-' then dec(toaster[1].x,5); { If '+' is pressed, add a toaster }
end;
for loop1:=1 to 10 do
if toaster[loop1].active then BEGIN
screentrans (toaster[loop1].x,toaster[loop1].y);
{ Restore the backgrond the toaster was over }
{ Move the toaster }
if (toaster[loop1].x<1) or (toaster[loop1].y>170) then BEGIN
toaster[loop1].active:=FALSE;
NewToaster;
END;
{ When toaster reaches the edge of the screen, render it inactive
and bring a new one into existance. }
END;
for loop1:=1 to 10 do
if toaster[loop1].active then BEGIN
CASE toaster [loop1].frame of
1 : putico (toaster[loop1].x,toaster[loop1].y,frame1,vaddr);
3 : putico (toaster[loop1].x,toaster[loop1].y,frame2,vaddr);
2,4 : putico (toaster[loop1].x,toaster[loop1].y,frame3,vaddr);
END;
toaster[loop1].frame:=toaster[loop1].frame+1;
if toaster [loop1].frame=5 then toaster[loop1].frame:=1;
{ Draw all the toasters on the VGA screen }
END;
waitretrace;
flip (vaddr,vga);
until ch=#27;
END;
procedure playthegame;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
begin
cls(0,vaddr);
SetupScreen; { Draw the background screen to VADDR, then flip it to
the VGA screen }
Fly; { Make the toasters fly around the screen }
{ Free the memory taken up by virtual page }
end;
label picloader,menu;
begin
randomize;
setupvirtual;
fade;
setmcga;
for x:=0 to 40 do begin
pal(100+x,x+20,0,0);
pal(141+x,0,0,x+20);
pal(182+x,0,x+20,0);
end;
fade;
for x:=0 to 40 do begin
line(x+40,45,x+40,45+(2*x),100+x,vga);
line(x+120,45,x+120,45+(2*x),141+x,vga);
line(x+200,45,x+200,45+(2*x),141+x,vga);
line(x+80,125,x+80,125-(2*x),182+x,vga);
line(x+160,125,x+160,125-(2*x),182+x,vga);
end;
for x:=40 downto 0 do begin
line(x+80,45,x+80,125-(2*x),140-x,vga);
line(x+160,45,x+160,125-(2*x),181-x,vga);
line(x+240,45,x+240,125-(2*x),181-x,vga);
line(x+120,125,x+120,45+(2*x),222-x,vga);
line(x+200,125,x+200,45+(2*x),222-x,vga);
end;
unfade;
outtextxy('A VMW SOFTWARE PRODUCTION',60,140,15,15,VGA,false);
y:=0;
repeat until keypressed;
ch:=readkey;
fade;
cls(0,vga);
assign(palf,'pal.tb1');
reset(palf);
for i:=0 to 255 do begin
for j:=1 to 3 do readln(palf,temp[j]);
pal(i,temp[1],temp[2],temp[3]);
end;
close(palf);
fade;
PICLOADER:
grapherror:=loadpicsuperpacked(0,0,vaddr,'tbomb1.tb1');
MENU:
flip(vaddr,vga);
unfade;
repeat until keypressed;
ch:=readkey;
barpos:=0;
outtextxy('F1 HELP',0,190,9,7,vga,false);
coolbox(117,61,199,140);
repeat
if barpos=0 then outtextxy('NEW GAME',123,67,32,0,vga,true)
else outtextxy('NEW GAME',123,67,32,7,vga,true);
if barpos=1 then outtextxy('OPTIONS',123,77,32,0,vga,true)
else outtextxy('OPTIONS',123,77,32,7,vga,true);
if barpos=2 then outtextxy('REGISTER',123,87,32,0,vga,true)
else outtextxy('REGISTER',123,87,32,7,vga,true);
if barpos=3 then outtextxy('LOAD GAME',123,97,32,0,vga,true)
else outtextxy('LOAD GAME',123,97,32,7,vga,true);
if barpos=4 then outtextxy('STORY',123,107,32,0,vga,true)
else outtextxy('STORY',123,107,32,7,vga,true);
if barpos=5 then outtextxy('CREDITS',123,117,32,0,vga,true)
else outtextxy('CREDITS',123,117,32,7,vga,true);
if barpos=6 then outtextxy('QUIT',123,127,32,0,vga,true)
else outtextxy('QUIT',123,127,32,7,vga,true);
ch:=menuread;
if (ord(ch)=222) or (ord(ch)=220) then inc(barpos);
if (ord(ch)=223) or (ord(ch)=221) then dec(barpos);
if ch='N' then barpos:=0;
if ch='O' then barpos:=1;
if ch='R' then barpos:=2;
if ch='L' then barpos:=3;
if ch='S' then barpos:=4;
if ch='C' then barpos:=5;
if ch='Q' then barpos:=6;
if ch=#27 then begin
barpos:=6;
ch:=#13;
end;
if barpos=7 then barpos:=0;
if barpos=-1 then barpos:=6;
until ch=#13;
if barpos=6 then quit;
if barpos=0 then playthegame;
if barpos=0 then goto picloader;
goto menu;
end.

292
tb1abs.pas Normal file
View File

@ -0,0 +1,292 @@
{ TheDraw Pascal Screen Image. Date: 07/14/96 }
const
IMAGEDATA_WIDTH=80;
IMAGEDATA_DEPTH=25;
IMAGEDATA_LENGTH=4000;
IMAGEDATA : array [1..4000] of Char = (
'°', #4, '°', #4, '°', #4, '°', #4, '°', #4, ' ', #4, '°', #4,
'°', #4, '°', #4, '°', #4, '°', #4, ' ', #4, '°', #4, ' ', #4,
' ', #4, ' ', #4, '°', #4, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, '°', #4, '°', #4, '°', #4, '°', #4, ' ', #4,
' ', #4, '°', #4, '°', #4, '°', #4, '°', #4, '°', #4, ' ', #4,
'°', #4, ' ', #4, ' ', #4, ' ', #4, '°', #4, ' ', #4, '°', #4,
'°', #4, '°', #4, '°', #4, ' ', #4, ' ', #4, '°', #4, '°', #4,
'°', #4, '°', #4, '°', #4, ' ', #4, '°', #4, ' ', #4, ' ', #4,
' ', #4, '°', #4, ' ', #4, ' ', #4, ' ', #4, '°', #2, 'V', #4,
'e', #4, 'r', #4, 's', #4, 'i', #4, 'o', #4, 'n', #4, ' ', #4,
'2', #4, '.', #4, '4', #4, 'a', #4, '!', #4, '!', #4, '°', #2,
'°', #2, '°', #2, '°', #2, ' ', #2, '±', #4, '±', #4, '±', #4,
'±', #4, '±', #4, '°', #4, '±', #4, '±', #4, '±', #4, '±', #4,
'±', #4, '°', #4, '±', #4, ' ', #4, '°', #4, '°', #4, '±', #4,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, '°', #4, '±', #4,
'±', #4, '±', #4, '±', #4, ' ', #4, '°', #4, '±', #4, '±', #4,
'±', #4, '±', #4, '±', #4, '°', #4, '±', #4, ' ', #4, '°', #4,
'°', #4, '±', #4, '°', #4, '±', #4, '±', #4, '±', #4, '±', #4,
' ', #4, '°', #4, '±', #4, '±', #4, '±', #4, '±', #4, '±', #4,
'°', #4, '±', #4, ' ', #4, '°', #4, '°', #4, '±', #4, ' ', #4,
' ', #4, '°', #2, '0', #4, '7', #4, '/', #4, '1', #4, '4', #4,
'/', #4, '9', #4, '6', #4, '°', #2, '°', #2, '°', #2, '°', #2,
'°', #2, '°', #2, '°', #2, '°', #2, '°', #2, '°', #2, ' ', #2,
' ', #2, '²', #12, '²', #12, '²', #12, '²', #12, '²', #12, '±', #4,
'²', #12, '²', #12, '²', #12, '²', #12, '²', #12, '±', #4, '²', #12,
' ', #12, '±', #4, '±', #4, '²', #12, ' ', #12, ' ', #12, ' ', #12,
' ', #12, '°', #4, '±', #4, '²', #12, '²', #12, '²', #12, '²', #12,
'°', #4, '±', #4, '²', #12, '²', #12, '²', #12, '²', #12, '²', #12,
'±', #4, '²', #12, ' ', #12, '±', #4, '±', #4, '²', #12, '±', #4,
'²', #12, '²', #12, '²', #12, '²', #12, '°', #4, '±', #4, '²', #12,
'²', #12, '²', #12, '²', #12, '²', #12, '±', #4, '²', #12, ' ', #12,
'±', #4, '±', #4, '²', #12, ' ', #12, '°', #2, '°', #2, '°', #2,
'°', #2, '°', #2, '°', #2, '°', #2, '°', #2, '°', #2, '°', #2,
'°', #2, '°', #2, '°', #2, '°', #2, '°', #2, '°', #2, '°', #2,
'°', #2, '°', #2, ' ', #2, ' ', #2, '°', #4, '±', #4, '²', #12,
' ', #12, '°', #4, '±', #4, '²', #12, ' ', #12, '°', #4, '±', #4,
'²', #12, '±', #4, '²', #12, '²', #12, '°', #4, '²', #12, '²', #12,
' ', #12, ' ', #12, ' ', #12, ' ', #12, '°', #4, '±', #4, '²', #12,
'±', #4, '±', #4, ' ', #4, '²', #12, '±', #4, '²', #12, ' ', #12,
'°', #4, '±', #4, '²', #12, '±', #4, '²', #12, '²', #12, '°', #4,
'²', #12, '²', #12, '±', #4, '²', #12, '±', #4, '±', #4, ' ', #4,
'²', #12, '±', #4, '²', #12, '±', #4, '±', #4, '±', #4, '°', #4,
'±', #4, '²', #12, '²', #12, '°', #4, '²', #12, '²', #12, ' ', #12,
'°', #2, 'D', #79, 'O', #79, 'W', #79, 'N', #79, 'L', #79, 'O', #79,
'A', #79, 'D', #79, ' ', #79, 'N', #79, 'O', #79, 'W', #79, '!', #79,
'°', #2, '°', #2, '°', #2, '°', #2, '°', #2, ' ', #2, ' ', #2,
'°', #4, '±', #4, '²', #12, ' ', #12, '°', #4, '±', #4, '²', #12,
'°', #4, '°', #4, '±', #4, '²', #12, '±', #4, '²', #12, ' ', #12,
'²', #12, '±', #4, '²', #12, ' ', #12, ' ', #12, ' ', #12, ' ', #12,
'°', #4, '±', #4, '²', #12, '²', #12, '²', #12, '²', #12, '°', #4,
'±', #4, '²', #12, '°', #4, '°', #4, '±', #4, '²', #12, '±', #4,
'²', #12, ' ', #12, '²', #12, '±', #4, '²', #12, '±', #4, '²', #12,
'²', #12, '²', #12, '²', #12, '°', #4, '±', #4, '²', #12, '²', #12,
'²', #12, '²', #12, '²', #12, '±', #4, '²', #12, ' ', #12, '²', #12,
'±', #4, '²', #12, ' ', #12, '°', #2, '°', #2, ' ', #15, ' ', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, '°', #2, '°', #2, '°', #2,
'°', #2, ' ', #2, ' ', #2, ' ', #2, '±', #4, '²', #12, ' ', #12,
' ', #12, '±', #4, '²', #12, '±', #4, '±', #4, '±', #4, '²', #12,
'±', #4, '²', #12, ' ', #12, ' ', #12, '±', #4, '²', #12, ' ', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, '±', #4, '²', #12, '±', #4,
'±', #4, '±', #4, '²', #12, '±', #4, '²', #12, '±', #4, '±', #4,
'±', #4, '²', #12, '±', #4, '²', #12, ' ', #12, ' ', #12, '±', #4,
'²', #12, '±', #4, '²', #12, '±', #4, '±', #4, '±', #4, '²', #12,
'±', #4, '²', #12, '±', #4, '±', #4, '±', #4, ' ', #4, '±', #4,
'²', #12, ' ', #12, ' ', #12, '±', #4, '²', #12, ' ', #12, '°', #2,
'N', #47, 'E', #47, 'W', #47, 'E', #47, 'S', #47, 'T', #47, ' ', #47,
'G', #47, 'A', #47, 'M', #47, 'E', #47, ' ', #47, ' ', #47, ' ', #47,
' ', #47, ' ', #47, ' ', #47, '°', #2, ' ', #2, ' ', #2, ' ', #2,
' ', #2, '²', #12, ' ', #12, ' ', #12, ' ', #12, '²', #12, '²', #12,
'²', #12, '²', #12, '²', #12, ' ', #12, '²', #12, ' ', #12, ' ', #12,
' ', #12, '²', #12, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, '²', #12, '²', #12, '²', #12, '²', #12, '²', #12, ' ', #12,
'²', #12, '²', #12, '²', #12, '²', #12, '²', #12, ' ', #12, '²', #12,
' ', #12, ' ', #12, ' ', #12, '²', #12, ' ', #12, '²', #12, '²', #12,
'²', #12, '²', #12, '²', #12, ' ', #12, '²', #12, '²', #12, '²', #12,
'²', #12, '²', #12, ' ', #12, '²', #12, ' ', #12, ' ', #12, ' ', #12,
'²', #12, ' ', #12, '°', #2, 'F', #47, 'R', #47, 'O', #47, 'M', #47,
' ', #47, 'V', #47, 'M', #47, 'W', #47, ' ', #47, 'S', #47, 'O', #47,
'F', #47, 'T', #47, 'W', #47, 'A', #47, 'R', #47, 'E', #47, ' ', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, '°', #2, '°', #2,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, '.', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, '.', #8, ' ', #8, ' ', #8,
' ', #8, ' ', #8, '.', #7, ' ', #7, ' ', #7, 'I', #1, ' ', #1,
'N', #1, ' ', #1, 'V', #1, ' ', #1, 'A', #1, ' ', #1, 'S', #1,
' ', #1, 'I', #1, ' ', #1, 'O', #1, ' ', #1, 'N', #1, ' ', #1,
' ', #1, ' ', #1, '.', #7, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, '.', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, '°', #2, 'W', #31, 'R', #31, 'I', #31, 'T', #31, 'T', #31,
'E', #31, 'N', #31, ' ', #31, 'B', #31, 'Y', #31, ' ', #31, 'M', #31,
'E', #31, '°', #2, '°', #2, '°', #2, '°', #2, '°', #2, ' ', #2,
' ', #2, ' ', #2, ' ', #2, '.', #7, ' ', #7, '.', #8, ' ', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, ' ', #15, 'O', #9, ' ', #9, 'F', #9, ' ', #9,
' ', #9, ' ', #9, 'T', #9, ' ', #9, 'H', #9, ' ', #9, 'E', #9,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, ' ', #15, '.', #8, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, '°', #2, '<', #31, '<', #31,
'<', #31, 'D', #31, 'E', #31, 'A', #31, 'T', #31, 'E', #31, 'R', #31,
'>', #31, '>', #31, '>', #31, ' ', #31, ' ', #15, '°', #2, '°', #2,
'°', #2, '°', #2, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, 'I', #12, ' ', #12, 'N', #12, ' ', #12, 'A', #12,
' ', #12, 'N', #12, ' ', #12, 'I', #12, ' ', #12, 'M', #12, ' ', #12,
'A', #12, ' ', #12, 'T', #12, ' ', #12, 'E', #12, ' ', #12, ' ', #12,
' ', #12, 'O', #12, ' ', #12, 'B', #12, ' ', #12, 'J', #12, ' ', #12,
'E', #12, ' ', #12, 'C', #12, ' ', #12, 'T', #12, ' ', #12, 'S', #12,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
'°', #2, '°', #2, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, '°', #2, '°', #2, '°', #2, '°', #2, ' ', #15, ' ', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, '.', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, '.', #8, ' ', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, '.', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, ' ', #15, '°', #2, 'O', #95, 'b', #95, 't', #95,
'a', #95, 'i', #95, 'n', #95, ' ', #95, 'a', #95, 't', #95, ':', #95,
' ', #95, ' ', #95, ' ', #95, '°', #2, '°', #2, '°', #2, '°', #2,
'°', #2, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, '.', #8,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, ' ', #15, '.', #7, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, 'Ú', #6,
'Ä', #6, '¿', #6, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, '°', #2,
'h', #94, 't', #94, 't', #94, 'p', #94, ':', #94, '/', #94, '/', #94,
'w', #94, 'w', #94, 'w', #94, '.', #94, ' ', #95, ' ', #95, ' ', #15,
'°', #2, '°', #2, '°', #2, '°', #2, ' ', #2, ' ', #2, ' ', #2,
'.', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, '.', #7, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
'Ü', #12, 'Û', #12, 'Û', #12, 'Û', #12, 'Û', #12, 'Û', #12, 'Û', #12,
'Û', #12, 'Û', #12, 'Û', #12, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
'±', #1, '±', #2, '°', #1, ' ', #1, 'À', #6, '¿', #6, ' ', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, '°', #2, 'w', #94, 'a', #94, 'm', #94, '.', #94,
'u', #94, 'm', #94, 'd', #94, '.', #94, 'e', #94, 'd', #94, 'u', #94,
'/', #94, ' ', #82, ' ', #15, '°', #2, '°', #2, '°', #2, '°', #2,
' ', #2, ' ', #2, ' ', #2, ' ', #2, '.', #7, ' ', #15, ' ', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, 'Ü', #4, 'ß', #76, 'ß', #76, 'ß', #76, 'ß', #76, 'ß', #76,
'ß', #76, 'ß', #76, 'Û', #76, 'Û', #12, 'Û', #12, 'ß', #12, ' ', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, '²', #1, '²', #1, '±', #2, '±', #2, '°', #1,
' ', #1, '³', #6, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, '°', #2, '~', #94,
'v', #94, 'm', #94, 'w', #94, 'e', #94, 'a', #94, 'v', #94, 'e', #94,
'r', #94, '/', #94, 't', #94, 'b', #94, '1', #94, ' ', #15, '°', #2,
'°', #2, '°', #2, '°', #2, '°', #15, '°', #15, '°', #15, '°', #15,
'°', #15, '°', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, ' ', #15, '.', #8, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, '°', #7, '°', #7,
'°', #7, '°', #7, '°', #7, '°', #7, '°', #7, 'Û', #4, 'ß', #12,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, '.', #8, ' ', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, '±', #1,
'±', #1, '°', #2, ' ', #2, 'Ú', #6, 'Ù', #6, ' ', #6, ' ', #6,
' ', #6, '.', #8, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, '°', #2, '°', #2, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, '°', #2, '°', #2, '°', #2, '°', #2, '²', #1,
'²', #1, '±', #1, '±', #1, '±', #1, '±', #1, '°', #1, '°', #1,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
'Û', #14, 'ß', #4, 'ß', #4, 'ß', #4, 'ß', #4, 'ß', #4, 'ß', #4,
'ß', #4, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, ' ', #15, 'À', #6, 'Â', #6, 'Ä', #6, 'Ù', #6,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, '°', #2, 'V', #79, 'i', #79,
'n', #79, 'c', #79, 'e', #79, ' ', #79, 'W', #79, 'e', #79, 'a', #79,
'v', #79, 'e', #79, 'r', #79, ' ', #79, ' ', #79, ' ', #79, ' ', #79,
'°', #2, '°', #2, '±', #2, '±', #2, 'Û', #1, '²', #1, '²', #1,
'±', #2, '±', #2, '±', #1, '°', #1, '°', #1, ' ', #15, ' ', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, '±', #14, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
'.', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, '°', #6, '±', #6,
'²', #6, 'Û', #6, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
'°', #2, '3', #79, '2', #79, '6', #79, ' ', #79, 'F', #79, 'o', #79,
's', #79, 't', #79, 'e', #79, 'r', #79, ' ', #79, 'K', #79, 'n', #79,
'o', #79, 'l', #79, 'l', #79, ' ', #15, '°', #2, 'Û', #1, 'Û', #1,
'Û', #1, '²', #2, '²', #2, '²', #1, '²', #1, '±', #2, '±', #1,
'±', #1, '°', #1, ' ', #1, ' ', #1, ' ', #1, ' ', #1, 'Û', #14,
' ', #14, ' ', #14, ' ', #14, ' ', #14, '±', #14, ' ', #14, '.', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, '-', #8, '°', #13, '²', #14,
'²', #14, '²', #14, '²', #14, '²', #14, '²', #14, '²', #14, 'Ý', #59,
'Ý', #59, 'Û', #13, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, ' ', #15, '°', #2, 'J', #79, 'o', #79, 'p', #79,
'p', #79, 'a', #79, ',', #79, ' ', #79, 'M', #79, 'D', #79, ' ', #79,
'2', #79, '1', #79, '0', #79, '8', #79, '5', #79, ' ', #79, ' ', #15,
'°', #2, '²', #2, '²', #2, '²', #2, '²', #2, '²', #2, '²', #2,
'Û', #1, '²', #1, '²', #1, '±', #1, '±', #1, '°', #1, ' ', #1,
' ', #1, '²', #14, ' ', #14, ' ', #14, ' ', #14, ' ', #14, '±', #14,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, '.', #7, ' ', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, '°', #2,
'°', #2, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, ' ', #15, '°', #2, '²', #2, '²', #2, '²', #2,
'²', #2, '²', #2, 'Û', #1, 'Û', #1, 'Û', #1, '²', #1, '²', #1,
'±', #1, '±', #1, '°', #1, ' ', #1, '±', #14, ' ', #14, ' ', #14,
' ', #14, '°', #14, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, '.', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
'.', #8, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, '.', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, '°', #2, 'C', #47, 'U', #47, 'R', #47, 'R', #47,
'E', #47, 'N', #47, 'T', #47, 'L', #47, 'Y', #47, ' ', #47, '3', #47,
'0', #47, '0', #47, '+', #47, 'K', #47, ' ', #47, '°', #2, '°', #2,
'²', #2, '²', #2, '²', #2, 'Û', #1, '²', #2, 'Û', #1, 'Û', #1,
'Û', #1, 'Û', #1, '²', #1, '²', #1, '±', #1, '±', #1, '°', #14,
'°', #14, '°', #14, '°', #14, '°', #14, ' ', #14, ' ', #14, ' ', #14,
' ', #14, '.', #8, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, '.', #7, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, '°', #2, 'O', #47,
'F', #47, ' ', #47, '.', #47, 'P', #47, 'P', #47, 'P', #47, ' ', #47,
'G', #47, 'R', #47, 'A', #47, 'P', #47, 'H', #47, 'I', #47, 'C', #47,
'S', #47, ' ', #15, '°', #2, 'Û', #1, '²', #2, '²', #2, 'Û', #1,
'Û', #1, 'Û', #1, 'Û', #1, 'Û', #1, 'Û', #1, '²', #1, '²', #1,
'±', #1, '±', #1, '°', #1, ' ', #1, ' ', #1, '±', #14, ' ', #14,
'±', #14, '±', #14, '±', #14, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, '°', #2, '°', #2, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, '°', #2, ' ', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15);

34
tb1ans.pas
View File

@ -1,4 +1,4 @@
{ TheDraw Pascal Screen Image. Date: 03/23/95 }
{ TheDraw Pascal Screen Image. Date: 07/14/96 }
const
IMAGEDATA_WIDTH=80;
IMAGEDATA_DEPTH=25;
@ -14,7 +14,7 @@ const
'°', #4, '°', #4, '°', #4, ' ', #4, '°', #4, ' ', #4, ' ', #4,
' ', #4, '°', #4, ' ', #4, ' ', #4, ' ', #4, '°', #2, 'V', #4,
'e', #4, 'r', #4, 's', #4, 'i', #4, 'o', #4, 'n', #4, ' ', #4,
'1', #4, '.', #4, '0', #4, '1', #4, '!', #4, '!', #4, '°', #2,
'2', #4, '.', #4, '4', #4, 'a', #4, '!', #4, '!', #4, '°', #2,
'°', #2, '°', #2, '°', #2, ' ', #2, '±', #4, '±', #4, '±', #4,
'±', #4, '±', #4, '°', #4, '±', #4, '±', #4, '±', #4, '±', #4,
'±', #4, '°', #4, '±', #4, ' ', #4, '°', #4, '°', #4, '±', #4,
@ -24,8 +24,8 @@ const
'°', #4, '±', #4, '°', #4, '±', #4, '±', #4, '±', #4, '±', #4,
' ', #4, '°', #4, '±', #4, '±', #4, '±', #4, '±', #4, '±', #4,
'°', #4, '±', #4, ' ', #4, '°', #4, '°', #4, '±', #4, ' ', #4,
' ', #4, '°', #2, '0', #4, '3', #4, '/', #4, '2', #4, '5', #4,
'/', #4, '9', #4, '5', #4, '°', #2, '°', #2, '°', #2, '°', #2,
' ', #4, '°', #2, '0', #4, '7', #4, '/', #4, '1', #4, '4', #4,
'/', #4, '9', #4, '6', #4, '°', #2, '°', #2, '°', #2, '°', #2,
'°', #2, '°', #2, '°', #2, '°', #2, '°', #2, '°', #2, ' ', #2,
' ', #2, '²', #12, '²', #12, '²', #12, '²', #12, '²', #12, '±', #4,
'²', #12, '²', #12, '²', #12, '²', #12, '²', #12, '±', #4, '²', #12,
@ -138,9 +138,9 @@ const
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, '.', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, ' ', #15, '°', #2, 'D', #95, 'O', #95, 'W', #95,
'N', #95, 'L', #95, 'O', #95, 'A', #95, 'D', #95, ' ', #95, 'A', #95,
'T', #95, ':', #95, ' ', #95, '°', #2, '°', #2, '°', #2, '°', #2,
' ', #15, ' ', #15, ' ', #15, '°', #2, 'O', #95, 'b', #95, 't', #95,
'a', #95, 'i', #95, 'n', #95, ' ', #95, 'a', #95, 't', #95, ':', #95,
' ', #95, ' ', #95, ' ', #95, '°', #2, '°', #2, '°', #2, '°', #2,
'°', #2, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, '.', #8,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
@ -150,8 +150,8 @@ const
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, 'Ú', #6,
'Ä', #6, '¿', #6, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, '°', #2,
'U', #95, 'T', #95, 'O', #95, 'P', #95, 'I', #95, 'A', #95, ' ', #95,
'B', #95, 'B', #95, 'S', #95, ' ', #95, ' ', #95, ' ', #95, ' ', #15,
'h', #95, 't', #95, 't', #95, 'p', #95, ':', #95, '/', #95, '/', #95,
'w', #95, 'w', #95, 'w', #95, '.', #95, ' ', #94, ' ', #94, ' ', #15,
'°', #2, '°', #2, '°', #2, '°', #2, ' ', #2, ' ', #2, ' ', #2,
'.', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, '.', #7, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
@ -161,9 +161,9 @@ const
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
'±', #1, '±', #2, '°', #1, ' ', #1, 'À', #6, '¿', #6, ' ', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, '°', #2, '4', #95, '1', #95, '0', #95, '-', #95,
'5', #95, '5', #95, '7', #95, '-', #95, '0', #95, '8', #95, '6', #95,
'8', #95, ' ', #95, ' ', #15, '°', #2, '°', #2, '°', #2, '°', #2,
' ', #15, ' ', #15, '°', #2, 'w', #95, 'a', #95, 'm', #95, '.', #95,
'u', #95, 'm', #95, 'd', #95, '.', #95, 'e', #95, 'd', #95, 'u', #95,
'/', #95, ' ', #94, ' ', #15, '°', #2, '°', #2, '°', #2, '°', #2,
' ', #2, ' ', #2, ' ', #2, ' ', #2, '.', #7, ' ', #15, ' ', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
@ -172,9 +172,9 @@ const
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, '²', #1, '²', #1, '±', #2, '±', #2, '°', #1,
' ', #1, '³', #6, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, '°', #2, 'I', #95,
' ', #95, 'A', #95, 'M', #95, ' ', #95, '#', #95, '2', #95, '3', #95,
' ', #95, ' ', #95, ' ', #95, ' ', #95, ' ', #95, ' ', #15, '°', #2,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, '°', #2, '~', #95,
'v', #95, 'm', #95, 'w', #95, 'e', #95, 'a', #95, 'v', #95, 'e', #95,
'r', #95, '/', #95, 't', #95, 'b', #95, '1', #95, ' ', #15, '°', #2,
'°', #2, '°', #2, '°', #2, '°', #15, '°', #15, '°', #15, '°', #15,
'°', #15, '°', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, ' ', #15, '.', #8, ' ', #15, ' ', #15, ' ', #15,
@ -242,8 +242,8 @@ const
'.', #8, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, '.', #15,
' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15, ' ', #15,
' ', #15, ' ', #15, '°', #2, 'C', #47, 'U', #47, 'R', #47, 'R', #47,
'E', #47, 'N', #47, 'T', #47, 'L', #47, 'Y', #47, ' ', #47, '1', #47,
'0', #47, '5', #47, 'K', #47, ' ', #47, ' ', #47, '°', #2, '°', #2,
'E', #47, 'N', #47, 'T', #47, 'L', #47, 'Y', #47, ' ', #47, '3', #47,
'0', #47, '0', #47, '+', #47, 'K', #47, ' ', #47, '°', #2, '°', #2,
'²', #2, '²', #2, '²', #2, 'Û', #1, '²', #2, 'Û', #1, 'Û', #1,
'Û', #1, 'Û', #1, '²', #1, '²', #1, '±', #1, '±', #1, '°', #14,
'°', #14, '°', #14, '°', #14, '°', #14, ' ', #14, ' ', #14, ' ', #14,

BIN
tb1objs.tb1 Normal file
View File

Binary file not shown.

949
tb1sb.pas
View File

@ -1,949 +0,0 @@
program TOM_BOMB_EM_AND_INVASION_OF_INANIMATE_OBJECTS;
{by Vincent Weaver....21085-4706}
uses vmwgraph,crt;
{$I c:\vmw\pascal\programs\tb1ans.pas}
{$M $4000,0,$20000} {16k stack, no heap - adjust as needed }
{$L MOD-obj.OBJ} { Link in Object file }
{$F+} { force calls to be 'far'}
procedure modvolume(v1,v2,v3,v4:integer); external ; {Can do while playing}
procedure moddevice(var device:integer); external ;
procedure modsetup(var status:integer;device,mixspeed,pro,loop:integer;var str:string); external ;
procedure modstop; external ;
procedure modinit; external;
{$F-}
type screentype = array [0..3999] of byte;
Type Shipinfo = Record { This is format of of each of our }
x,y:integer; { records for the flying toasters }
speed,frame:integer;
active:boolean;
END;
Virtual = Array [1..64000] of byte; { The size of our Virtual Screen }
VirtPtr = ^Virtual; { Pointer to the virtual screen }
var
dev,mix,stat,pro,loop : integer;
md : string;
VAR Virscr : VirtPtr; { Our first Virtual screen }
VirScr2 : VirtPtr; { Our second Virtual screen }
Vaddr : word; { The segment of our virtual screen}
Vaddr2 : Word; { The segment of our 2nd virt. screen}
ourpal : Array [0..255,1..3] of byte; { A virtual pallette }
shipv : Array [1..1] of shipinfo; { The toaster info }
Sound : Pointer;
Check : BOOLEAN;
frame:array[0..2,0..47,0..29] of byte;
bigflame:array[0..1,0..26,0..18] of byte;
smallflame:array[0..1,0..3,0..4] of byte;
barge:array[0..15,0..18] of byte;
truck:array[0..1,0..5,0..8] of byte;
score,level,lives,energy:integer;
axel_und_carmen:boolean;
tempi,tempj:integer;
scorest:string[8];
var grapherror:byte;
temp:array[1..3] of byte;
palf:text;
i,j:byte;
x,y,barpos:integer;
screen:screentype absolute $B800:0000;
ch:char;
function menuread:char;
var chtemp,ch2:char;
begin
repeat until keypressed;
ch2:=#0;
chtemp:=readkey;
if chtemp=chr(0) then ch2:=readkey;
chtemp:=upcase(chtemp);
if (ord(chtemp)<10) and (ord(chtemp)<128) then begin
if ch2='H' then chtemp:='ß'; {up}
if ch2='M' then chtemp:='Þ'; {right}
if ch2='P' then chtemp:='Ü'; {down}
if ch2='K' then chtemp:='Ý'; {left}
if ch2=';' then chtemp:='¨'; {f1}
if ch2='I' then chtemp:='ô'; {pgup}
if ch2='Q' then chtemp:='õ'; {pgdown}
end;
menuread:=chtemp;
end;
procedure coolbox(x1,y1,x2,y2:integer;fill:boolean;page:word);
begin
for i:=0 to 5 do box(x1+i,y1+i,x2-i,y2-i,31-i,page);
if fill then for i:=y1+5 to y2-5 do line(x1+5,i,x2-5,i,7,page);
end;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
Procedure ShutDown;
{ This frees the memory used by the virtual screen }
BEGIN
FreeMem (VirScr,64000);
FreeMem (VirScr2,64000);
END;
procedure QUIT;
label menu2;
begin
coolbox(90,75,230,125,true,vga);
barpos:=0;
outtextxy('QUIT??? ARE YOU',97,82,15,9,7,vga,false);
outtextxy('ABSOLUTELY SURE?',97,90,15,9,7,vga,false);
repeat
if barpos=0 then outtextxy('YES-RIGHT NOW!',97,98,15,150,0,vga,true)
else outtextxy('YES-RIGHT NOW!',97,98,15,150,7,vga,true);
if barpos=1 then outtextxy('NO--NOT YET.',97,106,15,150,0,vga,true)
else outtextxy('NO--NOT YET.',97,106,15,150,7,vga,true);
ch:=menuread;
if (ord(ch)>219) and (ord(ch)<224) then inc(barpos);
if ch='Y' then barpos:=0;
if ch='N' then barpos:=1;
if barpos=2 then barpos:=0;
until ch=#13;
if barpos=1 then goto menu2;
settext;
move(imagedata,screen,4000);
gotoxy(1,23);
halt;
menu2:
barpos:=6;
end;
Procedure SetUpVirtual;
{ This sets up the memory needed for the virtual screen }
BEGIN
GetMem (VirScr,64000);
vaddr := seg (virscr^);
GetMem (VirScr2,64000);
vaddr2 := seg (virscr2^);
END;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
Procedure drawstars(menu:boolean);
{ This procedure sets up the static background to be used in the program }
CONST circ : Array [1..5,1..5] of byte =
((00,00,30,00,00),
(00,00,26,00,00),
(30,26,18,26,30),
(00,00,26,00,00),
(00,00,30,00,00));
VAR i,x,y:integer;
loop1,loop2,loop3:integer;
tempaddr:word;
procedure makehole(y:integer);
var i:integer;
begin
for i:=10 to 75 do line(239+i,y,239+i,y+9,0,tempaddr);
line(249,y,314,y,24,tempaddr);
line(249,y+10,313,y+10,18,tempaddr);
line(249,y,249,y+9,24,tempaddr);
line(314,y+1,314,y+10,18,tempaddr);
end;
BEGIN
tempaddr:=vaddr;
For loop1:=1 to 200 do BEGIN
x:=random (315);
y:=random (195);
For loop2:=1 to 5 do
For loop3:=1 to 5 do
if circ [loop2,loop3]<>0 then
putpixel (x+loop2,y+loop3,circ [loop2,loop3],tempaddr);
END;
if menu=false then begin
for i:=240 to 319 do line(i,0,i,199,19,tempaddr);
line(240,0,240,199,18,tempaddr);
line(240,0,319,0,18,tempaddr);
line(319,0,319,199,24,tempaddr);
line(241,199,319,199,24,tempaddr);
outtextxy('SCORE',241,1,15,127,0,tempaddr,false);
outtextxy('SCORE',242,2,15,143,0,tempaddr,false);
makehole(10);
outtextxy(' 0',250,12,15,12,0,tempaddr,false);
outtextxy('HI-SCORE',241,21,15,127,0,tempaddr,false);
outtextxy('HI-SCORE',242,22,15,143,0,tempaddr,false);
makehole(30);
outtextxy(' 0',250,32,15,12,0,tempaddr,false);
outtextxy('LEVEL',241,41,15,127,0,tempaddr,false);
outtextxy('LEVEL',242,42,15,143,0,tempaddr,false);
makehole(50);
outtextxy('12345675',251,52,15,12,0,tempaddr,false);
outtextxy('SHIELDS',241,61,15,127,0,tempaddr,false);
outtextxy('SHIELDS',242,62,15,143,0,tempaddr,false);
makehole(70);
for i:=0 to 63 do line(250+i,71,250+i,79,((i div 4)+32),tempaddr);
outtextxy('WEAPONS',241,81,15,127,0,tempaddr,false);
outtextxy('WEAPONS',242,82,15,143,0,tempaddr,false);
makehole(90);
for i:=0 to 65 do line(249+i,111,249+i,189,0,tempaddr);
line(249,111,249,189,24,tempaddr);
line(315,111,315,189,18,tempaddr);
line(249,111,315,111,24,tempaddr);
line(249,189,315,189,18,tempaddr);
outtextxy(' VMW ',251,114,15,15,0,tempaddr,false);
outtextxy('F1-HELP ',251,124,15,15,0,tempaddr,false);
outtextxy('ESC-QUIT',251,135,15,15,0,tempaddr,false);
outtextxy('F2-SAVE ',251,145,15,15,0,tempaddr,false);
end;
if not(menu) then begin
flip (vaddr,vga); { Copy the entire screen at vaddr, our virtual screen }
{ on which we have done all our graphics, onto the }
{ screen you see, VGA }
flip (vaddr,vaddr2);
end;
END;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
Procedure ScreenTrans (x,y,p1,p2:word);
{ This is a small procedure to copy a 30x30 pixel block from coordinates
x,y on the virtual screen to coordinates x,y on the true vga screen }
BEGIN
asm
push ds
push es
mov ax,p1
mov es,ax
mov ax,p2
mov ds,ax
mov bx,[X]
mov dx,[Y]
push bx {; and this again for later}
mov bx, dx {; bx = dx}
mov dh, dl {; dx = dx * 256}
xor dl, dl
shl bx, 1
shl bx, 1
shl bx, 1
shl bx, 1
shl bx, 1
shl bx, 1 {; bx = bx * 64}
add dx, bx {; dx = dx + bx (ie y*320)}
pop bx {; get back our x}
add bx, dx {; finalise location}
mov di, bx {; es:di = where to go}
mov si, di
mov al,60
mov bx, 30 { Hight of block to copy }
@@1 :
mov cx, 24 { Width of block to copy divided by 2 }
rep movsw
add di,110h { 320 - 48 = 272 .. or 110 in hex }
add si,110h
dec bx
jnz @@1
pop es
pop ds
end;
{ I wrote this procedure late last night, so it may not be in it's
most optimised state. Sorry :-)}
END;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
Procedure newship;
{ This adds a new toaster to the screen }
VAR loop1:integer;
BEGIN
loop1:=1;
if not (shipv[1].active) then BEGIN
shipv[1].x:=36;
shipv[1].y:=165;
shipv[1].active:=true;
shipv[1].frame:=1;
shipv[1].speed:=5;
loop1:=10;
END;
END;
procedure putico(x,y,fra:byte;where:word);
var i,j,col:integer;
begin
for i:=0 to 47 do
for j:=0 to 29 do begin
col:=frame[fra,i,j];
if col<>0 then putpixel(i+x,y+j,col,where);
end;
end;
procedure putwave(x,y,fra:byte;where:word);
var i,j,col:integer;
begin
for i:=10 to 30 do
for j:=0 to 5 do begin
col:=frame[fra,i,j];
if col<>0 then putpixel((i+x)-10,y+j,col,where);
end;
end;
procedure changescore;
begin
str(score:8,scorest);
outtextxy(scorest,250,12,15,12,0,vaddr,true);
end;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
Procedure shiproutine;
VAR loop1,loop2:integer;
ch,ch2:char;
shieldcol:integer;
wave1:array[0..5] of boolean;
bulletx,bullety,oldwavex,oldwavey,wavex,wavey,i,waveadd:integer;
bulletout:boolean;
BEGIN
pal(254,0,0,0);
shieldcol:=0;
shipv[1].active:=false;
newship;
ch:=#1; ch2:=#1;
wavex:=0; wavey:=0; waveadd:=5;
oldwavex:=0; oldwavey:=0;
bulletout:=false; bulletx:=0; bullety:=0;
for i:=0 to 4 do wave1[i]:=true;
Repeat
ch2:=#1;
if (bulletout) and (bulletx>wavex) and (bulletx<wavex+100) and
(bullety>wavey) and (bullety<wavey+10) then begin
bulletout:=false;
inc(score,10);
changescore;
wave1[(bulletx-wavex) div 20]:=false;
end;
if bulletout then begin
screentrans(bulletx,bullety,vaddr,vaddr2);
dec(bullety,5);
if bullety<5 then bulletout:=false;
if bulletout then putwave(bulletx,bullety,1,vaddr);
end;
for i:=0 to 5 do
screentrans((oldwavex+20*i),oldwavey,vaddr,vaddr2);
for i:=0 to 5 do
if wave1[i] then putwave(wavex+20*i,wavey,1,vaddr);
oldwavex:=wavex; oldwavey:=wavey;
wavex:=wavex+waveadd;
if (wavex>100) or (wavex<5) then begin
inc(wavey,5);
waveadd:=-waveadd;
end;
if wavey>150 then begin
wavey:=0;
for i:=0 to 5 do if wave1[i]=false then wave1[i]:=true;
end;
if keypressed then BEGIN
ch:=readkey;
if ch=chr(0) then ch2:=readkey;
if ch2='M' then inc(shipv[1].x,5);
if ch2='K' then dec(shipv[1].x,5);
if ch=' ' then begin
bulletout:=true;
bulletx:=shipv[1].x+10;
bullety:=shipv[1].y;
putwave(bulletx,bullety,1,vaddr);
end;
if ch='+' then begin inc(shieldcol,3); pal(254,shieldcol,0,0);
if shieldcol>58 then shieldcol:=59;
end;
if ch='-' then begin dec(shieldcol,3); pal(254,shieldcol,0,0);
if shieldcol<5 then shieldcol:=3;
end;
end;
if shipv[1].active then BEGIN
screentrans (shipv[1].x,shipv[1].y,vaddr,vaddr2);
{ Restore the backgrond the toaster was over }
{ Move the toaster }
if (shipv[1].x<1) then shipv[1].x:=1;
if (shipv[1].x>255) then shipv[1].x:=255;
{ When toaster reaches the edge of the screen, render it inactive
and bring a new one into existance. }
END;
if shipv[1].active then BEGIN
CASE shipv [1].frame of
1 : putico (shipv[1].x,shipv[1].y,0,vaddr);
3 : putico (shipv[1].x,shipv[1].y,1,vaddr);
2,4 : putico (shipv[1].x,shipv[1].y,2,vaddr);
END;
shipv[1].frame:=shipv[1].frame+1;
if shipv[1].frame=5 then shipv[1].frame:=1;
{ Draw all the toasters on the VGA screen }
end;
waitretrace;
flip (vaddr,vga);
until ch=#27;
fade
END;
procedure playthegame(lev:integer);
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
var palloop,paldir:integer;
begin
cls(0,vaddr);
grapherror:=loadpicsuperpacked(0,0,vga,'tbma1.tb1');
outtextxy('MOONBASE ALPHA: EARTH''S LAST CHANCE!',5,5,15,1,0,vga,false);
pal(255,0,0,0);
palloop:=0;
paldir:=1;
repeat
pal(255,palloop,0,0);
if paldir=1 then inc(palloop)
else dec(palloop);
if palloop>62 then paldir:=-1;
if palloop<1 then paldir:=1;
delay(50);
until keypressed;
ch:=readkey;
drawstars(false);
shiproutine;
end;
procedure dographics;
var i,j:integer;
begin
grapherror:=loadpicsuperpacked(0,0,vaddr,'ships.tb1');
for i:=0 to 47 do
for j:=0 to 29 do
frame[0,i,j]:=getpixel(i,j,vaddr);
for i:=0 to 47 do
for j:=0 to 29 do
frame[1,i,j]:=getpixel(i,j+32,vaddr);
for i:=0 to 47 do
for j:=0 to 29 do
frame[2,i,j]:=getpixel(i,j+64,vaddr);
end;
procedure background;
begin
cls(0,vaddr);
drawstars(true);
coolbox(0,0,319,199,false,vaddr);
end;
procedure options;
begin
background;
flip(vaddr,vga);
outtextxy('AS OF YET THERE ARE NO OPTIONS!',10,10,15,9,0,vga,false);
repeat until keypressed;
ch:=readkey;
end;
procedure loadgame;
begin
coolbox(90,75,230,125,true,vga);
outtextxy('LOAD WHICH GAME',97,82,15,9,7,vga,false);
outtextxy(' (0-9) ',97,90,15,9,7,vga,false);
repeat until keypressed;
level:=0;
end;
procedure help;
begin
background;
flip(vaddr,vga);
outtextxy('HELP',10,10,15,9,0,vga,false);
outtextxy('Press ESC to exit most stuff.',10,20,15,9,0,vga,false);
outtextxy('Use the arrows to manuever.',10,30,15,9,0,vga,false);
repeat until keypressed;
ch:=readkey;
end;
procedure story;
var error:byte;
xtemp,ytemp:integer;
thrustcol:integer;
thrust:real;
tempch:char;
procedure putbigflame(xp,yp,frame:integer);
var xtemp,ytemp:integer;
begin
for xtemp:=0 to 26 do
for ytemp:=0 to 18 do
putpixel(xtemp+xp,ytemp+yp,bigflame[frame,xtemp,ytemp],vaddr);
end;
procedure putsmallflame(xp,yp,frame:integer);
var xtemp,ytemp:integer;
begin
for xtemp:=0 to 3 do
for ytemp:=0 to 4 do
putpixel(xtemp+xp,ytemp+yp,smallflame[frame,xtemp,ytemp],vaddr);
end;
procedure putbarge(xp,yp:integer;where:word);
var xtemp,ytemp:integer;
col:byte;
begin
for xtemp:=0 to 15 do
for ytemp:=0 to 18 do begin
if (ytemp+yp>=0) then begin
col:=barge[xtemp,ytemp];
if col<>0 then putpixel(xtemp+xp,ytemp+yp,col,where);
end;
end;
end;
procedure puttruck(xp,yp,frame:integer;where:word);
var xtemp,ytemp:integer;
col:byte;
begin
for xtemp:=0 to 5 do
for ytemp:=0 to 8 do begin
col:=truck[frame,xtemp,ytemp];
if (ytemp+yp>=173) then begin
if col<>0 then putpixel(xtemp+xp,ytemp+yp,col,where);
end;
end;
end;
begin
fade;
error:=loadpicsuperpacked(0,0,vaddr,'tbsobj.tb1');
for xtemp:=0 to 26 do
for ytemp:=0 to 18 do begin
bigflame[0,xtemp,ytemp]:=getpixel(xtemp,ytemp+2,vaddr);
bigflame[1,xtemp,ytemp]:=getpixel(xtemp,ytemp+21,vaddr);
end;
for xtemp:=0 to 3 do
for ytemp:=0 to 4 do begin
smallflame[0,xtemp,ytemp]:=getpixel(xtemp,ytemp+43,vaddr);
smallflame[1,xtemp,ytemp]:=getpixel(xtemp,ytemp+47,vaddr);
end;
for xtemp:=0 to 15 do
for ytemp:=0 to 18 do
barge[xtemp,ytemp]:=getpixel(xtemp+65,ytemp+100,vaddr);
for xtemp:=0 to 5 do
for ytemp:=0 to 8 do begin
truck[0,xtemp,ytemp]:=getpixel(xtemp+85,ytemp+100,vaddr);
truck[1,xtemp,ytemp]:=getpixel(xtemp+95,ytemp+100,vaddr);
end;
{******FIRST MESSAGE*******}
cls(0,vga);
outtextxy('MOON BASE ALPHA:',5,5,15,9,0,vga,false);
outtextxy(' THE FIRST PRIVATELY FINANCED SPACE ',5,15,15,9,0,vga,false);
outtextxy(' VENTURE. FOUNDED IN 2004 BY PIONEER',5,25,15,9,0,vga,false);
outtextxy(' VINCE WEAVER. IN ORDER TO SUPPORT',5,35,15,9,0,vga,false);
outtextxy(' ITSELF, IT DISPOSED OF GARBAGE AND',5,45,15,9,0,vga,false);
outtextxy(' NUCLEAR WASTE FROM EARTH BY LAUNCHING',5,55,15,9,0,vga,false);
outtextxy(' IT INTO DEEP SPACE WITH BARGES. ',5,65,15,9,0,vga,false);
outtextxy('NOW IT IS 2018, AND THE LAST BARGE IS',5,75,15,9,0,vga,false);
outtextxy(' TO BE LAUNCHED. NOW ALL WORK THERE',5,85,15,9,0,vga,false);
outtextxy(' WILL BE CONCENTRATED ON BUILDING A',5,95,15,9,0,vga,false);
outtextxy(' TERRAN SPACE FLEET.',5,105,15,9,0,vga,false);
unfade;
repeat until keypressed; tempch:=readkey;
pal(250,0,0,0);
fade;
{******BARGE TAKING OFF**********}
error:=loadpicsuperpacked(0,0,vaddr2,'tbma1.tb1');
putbarge(141,157,vaddr2);
flip(vaddr2,vaddr);
flip(vaddr,vga);
unfade;
for ytemp:=191 downto 165 do begin
screentrans(145,ytemp,vaddr,vaddr2);
puttruck(145,ytemp,ytemp mod 2,vaddr);
vdelay(7);
flip(vaddr,vga);
end;
error:=loadpicsuperpacked(0,0,vaddr2,'tbma1.tb1');
vdelay(20);
flip(vaddr2,vaddr);
putbarge(141,157,vaddr);
thrustcol:=0;
ytemp:=157;
thrust:=0;
while ytemp>-25 do begin
thrust:=thrust+0.05;
if thrustcol<63 then inc(thrustcol);
screentrans(141,ytemp,vaddr,vaddr2);
putbarge(141,ytemp,vaddr);
vdelay(7);
pal(250,thrustcol,0,0);
flip(vaddr,vga);
ytemp:=ytemp-round(thrust);
end;
vdelay(100);
fade;
{******SECOND MESSAGE*******}
cls(0,vga);
outtextxy('5 YEARS LATER, 1 LIGHT YEAR DISTANT',5,5,15,9,0,vga,false);
outtextxy(' CATASTROPHE STRIKES!! ',5,15,15,9,0,vga,false);
unfade;
vdelay(100);
repeat until keypressed; tempch:=readkey;
fade;
{******ALIEN DELEGATION*****}
error:=loadpicsuperpacked(0,0,vaddr2,'tbcrash.tb1');
flip(vaddr2,vaddr);
unfade;
repeat
putbigflame(213,100,0);
putsmallflame(105,90,1);
putsmallflame(151,71,0);
putsmallflame(218,72,1);
putbarge(160,180,vaddr);
flip(vaddr,vga);
vdelay(5);
putbigflame(213,100,1);
putsmallflame(105,90,0);
putsmallflame(151,71,1);
putsmallflame(218,72,0);
flip(vaddr,vga);
vdelay(5);
until keypressed;
ch:=readkey;
{****ALIEN MESSAGE*****}
fade;
error:=loadpicsuperpacked(0,0,vga,'tbgorg.tb1');
unfade;
outtextxy('GREETINGS EARTHLINGS.',0,162,15,12,0,vga,false);
outtextxy('I AM GORGONZOLA THE REPULSIVE.',0,171,15,12,0,vga,false);
outtextxy('YOU HAVE MADE A BIG MISTAKE.',0,180,15,12,0,vga,false);
readln;
end;
procedure credits;
var j:integer;
sp:integer;
procedure rotate(stri:string;col:integer);
var j1:integer;
begin
if sp=1 then begin
for j1:=0 to 7 do begin
outtextxy(stri,0,198,j1,col,0,vga,false);
Move (mem[vga:320],mem[vga:0],63680);
if keypressed then begin inc(sp); cls(0,vga); end;
end;
end;
if sp<>1 then begin
outtextxy(stri,0,180,15,col,0,vga,true);
Move (mem[vga:3200],mem[vga:0],60800);
end;
end;
procedure skip; begin rotate(' ',0); end;
begin
sp:=1;
cls(0,vaddr);
flip(vaddr,vga);
j:=0;
if keypressed then ch:=readkey;
rotate(' TOM BOMBEM',4);
rotate(' INVASION OF THE INANIMATE OBJECTS',4);
skip; rotate(' PROGRAMMING',9);
skip; rotate(' VINCENT M WEAVER',9);
skip; skip; rotate(' GRAPHICS',10);
skip; rotate(' VINCENT M WEAVER',10);
skip; skip; rotate(' SOUND',11);
skip; rotate(' VINCENT M WEAVER',11);
skip; skip; rotate(' GRAPHICS INSPIRATION',12);
skip; rotate(' JEFF WARWICK',12);
skip; skip; rotate(' UTOPIA BBS 410-557-0868',13);
skip; rotate(' JOHN CLEMENS',13);
skip; rotate(' JASON GRIMM',13);
skip; skip; rotate(' PCGPE AUTHORS, esp',14);
skip; rotate(' GRANT SMITH',14);
skip; skip; rotate(' SOUND BLASTER INFO',15);
skip; rotate(' AXEL STOLZ',15);
skip; skip; rotate(' INSPIRATION',9);
skip; rotate(' DOUGLAS ADAMS',9);
skip; rotate(' GENE RODENBERRY',9);
skip; rotate(' CLIFF STOLL',9);
skip; rotate(' ARTHUR C CLARKE',9);
skip; rotate(' ISAAC ASIMOV',9);
skip; rotate(' GORDON KORMAN',9);
skip; skip; rotate(' THANKS TO ALL THE AGENTS',10);
skip; rotate(' B,D,JL,L,N,P,S,W,PM,E',10);
skip; rotate(' AND ESPECIALLY AGENT G',10);
i:=0;
repeat
move(mem[vaddr2:(i*320)],mem[vga:63680],320);
Move (mem[vga:320],mem[vga:0],63680);
inc(i);
until (keypressed) or (i=299);
if keypressed then ch:=readkey;
end;
procedure shadowrite(st:string;x5,y5,forecol,backcol:integer);
begin
outtextxy(st,x5+1,y5+1,15,backcol,0,vga,false);
outtextxy(st,x5,y5,15,forecol,0,vga,false);
end;
procedure register;
var pagenum,oldpagenum,numpages:integer;
pagest:string;
numst:string[2];
procedure page1;
begin
flip(vaddr,vga);
shadowrite(' TO REGISTER',10,10,9,1);
shadowrite('THIS GAME WAS WRITTEN BY A 16 YEAR OLD',10,30,9,1);
shadowrite(' ENTIRELY IN HIS FREE TIME.',10,40,9,1);
shadowrite('HOPEFULLY YOU FEEL HIS FREE TIME IS',10,50,9,1);
shadowrite(' WORTH SOMETHING.',10,60,9,1);
shadowrite('WARNING:',10,80,12,4);
shadowrite(' VMW SOFTWARE IS NOT AN INCORPORATED',10,90,12,4);
shadowrite(' COMPANY, NOR DOES IT HAVE ANY INCOME',10,100,12,4);
shadowrite(' EXCEPT DONATIONS. NONE OF ITS',10,110,12,4);
shadowrite(' SYMBOLS ARE TRADEMARKED EITHER. (BUT',10,120,12,4);
shadowrite(' I DOUBT YOU''LL NAME A COMPANY AFTER',10,130,12,4);
shadowrite(' MY ININTIALS)',10,140,12,4);
end;
procedure page2;
begin
flip(vaddr,vga);
shadowrite('PLEASE SEND ANY DONATIONS TO:',10,10,10,2);
shadowrite(' VINCENT WEAVER',10,20,10,2);
shadowrite(' 326 FOSTER KNOLL DR.',10,30,10,2);
shadowrite(' JOPPA, MD 21085-4706, USA, ETC.',10,40,10,2);
shadowrite('ANY DONATION OF $5 OR MORE GETS THE',10,60,13,5);
shadowrite(' NEWEST VERSION OF THE GAME, PLUS',10,70,13,5);
shadowrite(' ANY OTHER COOL PROGRAMS I HAVE AT',10,80,13,5);
shadowrite(' THE TIME.',10,90,13,5);
shadowrite('ALSO IF YOU SEND ME A SELF ADDRESSED',10,110,11,3);
shadowrite(' STAMPED ENVELOPE WITH SUFFICIENT',10,120,11,3);
shadowrite(' POSTAGE AND A 3 1/2 INCH DISK IN',10,130,11,3);
shadowrite(' IT, I WILL COPY THE NEWEST VERSION',10,140,11,3);
shadowrite(' OF THE GAME ONTO IT.',10,150,11,3);
end;
procedure page3;
begin
flip(vaddr,vga);
shadowrite('OTHER VMW SOFTWARE PRODUCTIONS:',10,10,15,7);
shadowrite(' PAINTPRO:',10,30,13,5);
shadowrite(' LOAD AND SAVE GRAPHICS PICTURES',10,40,13,5);
shadowrite(' INTO C, PASCAL, BASIC, ETC.',10,50,13,5);
shadowrite(' WITH SCREEN CAPTURE UTILITY.',10,60,13,5);
shadowrite(' SPACEWAR III:',10,70,11,3);
shadowrite(' ALMOST COMPLETE GAME WITH WORKING',10,80,11,3);
shadowrite(' SPACESHIPS. SORT OF COOL.',10,90,11,3);
shadowrite(' AITAS: (ADVENTURES IN TIME AND SPACE)',10,100,12,4);
shadowrite(' THIS GAME WILL BE FINISHED SOMEDAY.',10,110,12,4);
shadowrite(' IT HAS BEEN UNDER WAY FOR 3 YEARS.',10,120,12,4);
shadowrite(' MISC PASCAL/BASIC PROGRAMS:',10,130,9,1);
shadowrite(' OVER 500 PROGRAMS WRITTEN OR TYPED',10,140,9,1);
shadowrite(' IN BY ME....FUN TO LOOK AT.',10,150,9,1);
end;
procedure page4;
begin
flip(vaddr,vga);
shadowrite('DISCLAIMERS:',10,10,12,14);
shadowrite('** THE ABOVE PROGRAMS HAVE NEVER DONE**',5,30,12,4);
shadowrite('** ANYTHING BAD TO MY COMPUTER THAT **',5,40,12,4);
shadowrite('** CTRL-ALT-DEL WOULDN''T FIX. I AM **',5,50,12,4);
shadowrite('** NOT RESPONSIBLE FOR HARD DISK **',5,60,12,4);
shadowrite('** DISSAPPEARANCES, MISSING MODEMS **',5,70,12,4);
shadowrite('** MOUSE BREAKDOWNS, MELTING MONITORS**',5,80,12,4);
SHADOWRITE('** OR ANYTHING ELSE. **',5,90,12,4);
shadowrite('%% ALL VMW SOFTWARE PRODUCTIONS ARE %%',5,110,11,3);
shadowrite('%% CERTIFIED VIRUS FREE!!!!!!!!!!!! %%',5,120,11,3);
end;
begin
background;
pagenum:=1;
oldpagenum:=1;
numpages:=4;
page1;
shadowrite('PAGE 1 of 4: ESC QUITS',50,180,15,7);
repeat
ch:=menuread;
if (ch=' ') or (ch=#13) then inc(pagenum);
if (ch='õ') or (ch='Þ') or (ch='Ü') then inc(pagenum);
if (ch='ô') or (ch='Ý') or (ch='ß') then dec(pagenum);
if pagenum>4 then pagenum:=1;
if pagenum<1 then pagenum:=4;
if oldpagenum<>pagenum then begin
if pagenum=1 then page1;
if pagenum=2 then page2;
if pagenum=3 then page3;
if pagenum=4 then page4;
str(pagenum:2,numst);
pagest:=concat('PAGE ',numst);
str(numpages:2,numst);
pagest:=concat(pagest,' of ',numst,': ESC QUITS');
shadowrite(pagest,50,180,15,7);
oldpagenum:=pagenum;
end;
until ch=#27;
end;
label picloader,menu;
begin
axel_und_carmen:=true; {as_of_9-22-94} {change_back_10-6-94}
randomize;
setupvirtual;
fade;
setmcga;
dographics;
energy:=15;
lives:=2;
score:=0;
level:=0;
for x:=0 to 40 do begin
pal(100+x,x+20,0,0);
pal(141+x,0,0,x+20);
pal(182+x,0,x+20,0);
end;
fade;
modinit;
dev:=7;
md:='vmwfan.tb1';
mix := 10000; {use 10000 normally }
pro := 0; {Leave at 0}
loop :=0; {4 means mod will play forever}
modvolume (255,255,255,255); { Full volume }
modsetup ( stat, dev, mix, pro, loop, md );
case stat of
1: writeln('Not a mod');
2: writeln('Already playing');
4: writeln('Out of memory');
end;
for x:=0 to 40 do begin
line(x+40,45,x+40,45+(2*x),100+x,vga);
line(x+120,45,x+120,45+(2*x),141+x,vga);
line(x+200,45,x+200,45+(2*x),141+x,vga);
line(x+80,125,x+80,125-(2*x),182+x,vga);
line(x+160,125,x+160,125-(2*x),182+x,vga);
end;
for x:=40 downto 0 do begin
line(x+80,45,x+80,125-(2*x),140-x,vga);
line(x+160,45,x+160,125-(2*x),181-x,vga);
line(x+240,45,x+240,125-(2*x),181-x,vga);
line(x+120,125,x+120,45+(2*x),222-x,vga);
line(x+200,125,x+200,45+(2*x),222-x,vga);
end;
unfade;
outtextxy('A VMW SOFTWARE PRODUCTION',60,140,15,15,15,VGA,false);
y:=0;
repeat until keypressed;
ch:=readkey;
modstop;
fade;
cls(0,vga);
assign(palf,'pal.tb1');
reset(palf);
for i:=0 to 255 do begin
for j:=1 to 3 do readln(palf,temp[j]);
pal(i,temp[1],temp[2],temp[3]);
end;
close(palf);
fade;
PICLOADER:
grapherror:=loadpicsuperpacked(0,0,vaddr2,'tbomb1.tb1');
if not(axel_und_carmen) then begin
for tempi:=193 to 199 do
for tempj:=290 to 319 do
putpixel(tempj,tempi,0,vaddr2);
end;
MENU:
modinit;
dev:=7;
md:='weave1.tb1';
mix := 10000; {use 10000 normally }
pro := 0; {Leave at 0}
loop :=0; {4 means mod will play forever}
modvolume (255,255,255,255); { Full volume }
modsetup ( stat, dev, mix, pro, loop, md );
case stat of
1: writeln('Not a mod');
2: writeln('Already playing');
4: writeln('Out of memory');
end;
flip(vaddr2,vga);
unfade;
repeat until keypressed;
ch:=readkey;
barpos:=0;
outtextxy('F1 HELP',0,190,15,9,7,vga,false);
coolbox(117,61,199,140,true,vga);
repeat
if barpos=0 then outtextxy('NEW GAME',123,67,15,32,0,vga,true)
else outtextxy('NEW GAME',123,67,15,32,7,vga,true);
if barpos=1 then outtextxy('OPTIONS',123,77,15,32,0,vga,true)
else outtextxy('OPTIONS',123,77,15,32,7,vga,true);
if barpos=2 then outtextxy('REGISTER',123,87,15,32,0,vga,true)
else outtextxy('REGISTER',123,87,15,32,7,vga,true);
if barpos=3 then outtextxy('LOAD GAME',123,97,15,32,0,vga,true)
else outtextxy('LOAD GAME',123,97,15,32,7,vga,true);
if barpos=4 then outtextxy('STORY',123,107,15,32,0,vga,true)
else outtextxy('STORY',123,107,15,32,7,vga,true);
if barpos=5 then outtextxy('CREDITS',123,117,15,32,0,vga,true)
else outtextxy('CREDITS',123,117,15,32,7,vga,true);
if barpos=6 then outtextxy('QUIT',123,127,15,32,0,vga,true)
else outtextxy('QUIT',123,127,15,32,7,vga,true);
ch:=menuread;
if (ord(ch)=222) or (ord(ch)=220) then inc(barpos);
if (ord(ch)=223) or (ord(ch)=221) then dec(barpos);
if (ord(ch)=168) then begin barpos:=10; ch:=#13; end;
if ch='N' then barpos:=0;
if ch='O' then barpos:=1;
if ch='R' then barpos:=2;
if ch='L' then barpos:=3;
if ch='S' then barpos:=4;
if ch='C' then barpos:=5;
if ch='Q' then barpos:=6;
if ch='A' then axel_und_carmen:=not(axel_und_carmen);
if ch=#27 then begin
barpos:=6;
ch:=#13;
end;
if barpos=7 then barpos:=0;
if barpos=-1 then barpos:=6;
until ch=#13;
modstop;
if barpos=6 then quit;
if barpos=1 then options;
if barpos=2 then register;
if barpos=3 then loadgame;
if barpos=4 then story;
if barpos=5 then credits;
if barpos=10 then help;
if barpos=0 then playthegame(0);
if barpos=0 then goto picloader;
if barpos=4 then goto picloader;
goto menu;
end.

BIN
tbash.tb1 Normal file
View File

Binary file not shown.

BIN
tbaship.tb1 Normal file
View File

Binary file not shown.

BIN
tbchief.tb1 Normal file
View File

Binary file not shown.

BIN
tbcobj.tb1 Normal file
View File

Binary file not shown.

BIN
tbconsol.tb1 Normal file
View File

Binary file not shown.

BIN
tbcrash.tb1 Normal file
View File

Binary file not shown.

BIN
tbeerm.tb1 Normal file
View File

Binary file not shown.

22
tbetter.pas
View File

@ -1,22 +0,0 @@
program maketb1better;
uses vmwgraph;
var palf:text;
x,y,i,j:integer;
temp:array[1..3] of byte;
grapherror:byte;
begin
setmcga;
cls(0,vga);
assign(palf,'pal.tb1');
reset(palf);
for i:=0 to 255 do begin
for j:=1 to 3 do readln(palf,temp[j]);
pal(i,temp[1],temp[2],temp[3]);
end;
close(palf);
grapherror:=loadpicsuperpacked(0,0,vga,'tbomb1.tb1');
readln;
settext;
end.

BIN
tbfont.tb1 Normal file
View File

Binary file not shown.

BIN
tbgorg.pcx Normal file
View File

Binary file not shown.

BIN
tbgorg.tb1 Normal file
View File

Binary file not shown.

BIN
tbl2ship.tb1 Normal file
View File

Binary file not shown.

BIN
tbl3intr.tb1 Normal file
View File

Binary file not shown.

BIN
tblev3.tb1 Normal file
View File

Binary file not shown.

BIN
tbma1.tb1 Normal file
View File

Binary file not shown.

BIN
tbomb1.tb1 Normal file
View File

Binary file not shown.

BIN
tbpit.tb1 Normal file
View File

Binary file not shown.

1752
tbs1.pas Normal file
View File

File diff suppressed because it is too large Load Diff

BIN
tbsauc.tb1 Normal file
View File

Binary file not shown.

226
tbsetup.pas Normal file
View File

@ -0,0 +1,226 @@
program TOM_BOMBEM_SETUP;
uses dos,crt,detect;
{$I tbs1.pas}
type screentype = array[0..3999] of byte;
var screen: screentype absolute $B800:0000;
ch:char;
i:byte;
getsettings,redo:boolean;
BLASTER: string;
BASEIO,DMA,IRQ,DMA16:word;
sbsound,soundeffects:byte;
ii:integer;
ff:text;
bobb:word;
label bob,skipper;
function gets(x,y,z,a:integer;hex:boolean):word;
var tempst:string;
tempw:word;
codei:integer;
begin
codei:=0;
gotoxy(x,y);
readln(tempst);
if hex then begin val(tempst,bobb,codei); insert('$',tempst,1); end;
val(tempst,tempw,codei);
if (tempw>=a) or (tempw<=z) then tempw:=255;
if codei<>0 then tempw:=255;
gets:=tempw;
end;
function UpcaseStr(Str: string): string;
var i: byte;
Temp: string;
begin
Temp[0] := Str[0];
for i := 1 to Length(Str) do Temp[i] := Upcase(Str[i]);
UpcaseStr := Temp;
end;
function getsetting(str:string;id:char;hex:boolean):word;
var Temp : string;
Num : word;
Code : integer;
begin
Temp := Str;
if Pos(ID, Temp) <> 0 then begin
Delete(Temp, 1, Pos(ID, Temp));
Delete(Temp, Pos(' ', Temp), 255);
if Hex then begin val(temp, bobb, code); Insert('$', Temp, 1); end;
Val(Temp, Num, Code);
if Code = 0 then GetSetting := Num
else GetSetting := $FF;
end
else GetSetting := $FF;
end;
procedure quit;
begin
halt(0);
end;
begin
{OPENING}
clrscr;
move(imagedata1,screen,4000);
bob:
redo:=false;
{REQUIREMENTS}
clrscr;
move(imagedata2,screen,4000);
repeat
repeat until keypressed;
ch:=readkey;
if upcase(ch)='Q' then quit;
until ch=#13;
{Ask About SoundBlaster Sound}
clrscr;
sbsound:=0;
move(imagedata4,screen,4000);
for i:=11 to 20 do begin
gotoxy(4,i);
writeln(' ');
end;
textcolor(13);
gotoxy(4,12); write('Do You Want To Have Sound Effects?');
gotoxy(6,13); write('(y/n)---->');
gotoxy(17,13);
textcolor(3);
repeat
repeat until keypressed;
ch:=readkey;
if (upcase(ch)='Y') or (upcase(ch)='N') then begin
if upcase(ch)='Y' then soundeffects:=1;
if upcase(ch)='N' then soundeffects:=0;
write(ch);
gotoxy(17,13);
end;
if upcase(ch)='Q' then quit;
until ch=#13;
if soundeffects=0 then goto skipper;
{check if want soundbalster}
textcolor(13);
gotoxy(4,16); write('Do You Have A Soundblaster Card?');
gotoxy(6,17); write('(y/n)---->');
gotoxy(17,17);
textcolor(3);
repeat
repeat until keypressed;
ch:=readkey;
if (upcase(ch)='Y') or (upcase(ch)='N') then begin
if upcase(ch)='Y' then sbsound:=1;
if upcase(ch)='N' then sbsound:=0;
write(ch);
gotoxy(17,17);
end;
if upcase(ch)='Q' then quit;
until ch=#13;
{If Soundblaster, then configure it}
if (sbsound=1) then begin
clrscr;
move(imagedata4,screen,4000);
BLASTER := UpcaseStr(GetEnv('BLASTER'));
BaseIO := GetSetting(BLASTER, 'A', true); {Hex}
IRQ := GetSetting(BLASTER, 'I', false); {Decimal}
DMA := GetSetting(BLASTER, 'D', false); {Decimal}
DMA16 := GetSetting(BLASTER, 'H', false); {Decimal}
ii:=-1;
repeat
ii:=ii+22;
textcolor(3);
gotoxy(ii,14); write(bobb);
gotoxy(ii,15); write(irq);
gotoxy(ii,16); write(dma);
gotoxy(ii,17); write(dma16);
if BaseIO = $FF then begin gotoxy(ii,14); write('---'); end;
if IRQ = $FF then begin gotoxy(ii,15); write('---'); end;
if DMA = $FF then begin gotoxy(ii,16); write('---'); end;
if DMA16 = $FF then begin gotoxy(ii,17); write('---'); end;
until ii>=43;
gotoxy(14,20);
repeat
gotoxy(14,20);
repeat until keypressed;
ch:=readkey;
if (ch>'0') and (ch<'5') then begin
case ch of
'1':begin gotoxy(43,14); writeln(' ');
baseio:=gets(43,14,100,400,true);
gotoxy(43,14); writeln(' ');
gotoxy(43,14); write(bobb);
end;
'2':begin gotoxy(43,15); writeln(' ');
irq:=gets(43,15,2,12,false);
gotoxy(43,15); writeln(' ');
gotoxy(43,15); write(irq);
end;
'3':begin gotoxy(43,16); writeln(' ');
dma:=gets(43,16,0,100,false);
gotoxy(43,16); writeln(' ');
gotoxy(43,16); write(dma);
end;
'4':begin gotoxy(43,17); writeln(' ');
dma16:=gets(43,17,0,100,false);
gotoxy(43,17); writeln(' ');
gotoxy(43,17); write(dma16);
end;
end;
end;
if upcase(ch)='Q' then quit;
until ch=#13;
end;
{Check for mistakes}
skipper:
clrscr;
move(imagedata5,screen,4000);
gotoxy(16,12);
textcolor(3);
if soundeffects=1 then begin
write('Sound Effects : ');
if sbsound=1 then writeln('Sound Blaster')
else writeln('No Soundblaster');
end
else writeln('No Sound Effects');
if (sbsound=1) then begin
gotoxy(16,14);
writeln('BaseIo:',bobb);
gotoxy(16,15);
writeln('IRQ: ',irq);
gotoxy(16,16);
writeln('DMA: ',dma);
end;
repeat
repeat until keypressed;
ch:=readkey;
if upcase(ch)='R' then begin redo:=true; ch:=#13; end;
if upcase(ch)='Q' then quit;
until ch=#13;
if redo then goto bob;
assign(ff,'config.tb1');
rewrite(ff);
writeln(ff,soundeffects);
writeln(ff,sbsound);
writeln(ff,baseio);
writeln(ff,irq);
writeln(ff,dma);
close(ff);
clrscr;
move(imagedata6,screen,4000);
gotoxy(1,24);
end.

BIN
tbshapes.tb1 Normal file
View File

Binary file not shown.

61
tbside.pas
View File

@ -1,61 +0,0 @@
uses crt,vmwgraph;
var i,j:integer;
palf:text;
temp:array[0..3] of byte;
procedure makehole(y:integer);
begin
for i:=10 to 75 do line(239+i,y,239+i,y+9,0,vga);
line(249,y,314,y,24,vga);
line(249,y+10,313,y+10,18,vga);
line(249,y,249,y+9,24,vga);
line(314,y+1,314,y+10,18,vga);
end;
begin
setmcga;
assign(palf,'pal.tb1');
reset(palf);
for i:=0 to 255 do begin
for j:=1 to 3 do readln(palf,temp[j]);
pal(i,temp[1],temp[2],temp[3]);
end;
close(palf);
for i:=240 to 319 do line(i,0,i,199,19,vga);
line(240,0,240,199,18,vga);
line(240,0,319,0,18,vga);
line(319,0,319,199,24,vga);
line(241,199,319,199,24,vga);
outtextxy('SCORE',241,1,127,0,vga,false);
outtextxy('SCORE',242,2,143,0,vga,false);
makehole(10);
outtextxy('00001233',251,12,12,0,vga,false);
outtextxy('HI-SCORE',241,21,127,0,vga,false);
outtextxy('HI-SCORE',242,22,143,0,vga,false);
makehole(30);
outtextxy('12345672',251,32,12,0,vga,false);
outtextxy('LEVEL',241,41,127,0,vga,false);
outtextxy('LEVEL',242,42,143,0,vga,false);
makehole(50);
outtextxy('12345675',251,52,12,0,vga,false);
outtextxy('SHIELDS',241,61,127,0,vga,false);
outtextxy('SHIELDS',242,62,143,0,vga,false);
makehole(70);
for i:=0 to 63 do line(250+i,71,250+i,79,((i div 4)+32),vga);
outtextxy('WEAPONS',241,81,127,0,vga,false);
outtextxy('WEAPONS',242,82,143,0,vga,false);
makehole(90);
for i:=0 to 65 do line(249+i,111,249+i,189,0,vga);
line(249,111,249,189,24,vga);
line(315,111,315,189,18,vga);
line(249,111,315,111,24,vga);
line(249,189,315,189,18,vga);
outtextxy(' VMW ',251,114,15,0,vga,false);
outtextxy('F1-HELP ',251,124,15,0,vga,false);
outtextxy('ESC-QUIT',251,135,15,0,vga,false);
outtextxy('F2-SAVE ',251,145,15,0,vga,false);
readln;
settext;
end.

BIN
tbsobj.tb1 Normal file
View File

Binary file not shown.

204
tbsound.pas Normal file
View File

@ -0,0 +1,204 @@
{ SMIX is Copyright 1995 by Ethan Brodsky. All rights reserved. }
program MixTest;
uses
CRT,
Detect,
SMix;
const
XMSRequired = 190; {XMS memory required to load the sounds (KBytes) }
SharedEMB = true;
{TRUE: All sounds will be stored in a shared EMB}
{FALSE: Each sound will be stored in a separate EMB}
NumSounds = 8;
var
BaseIO: word; IRQ, DMA, DMA16: byte;
Sound: array[0..NumSounds-1] of PSound;
i: byte;
Counter: LongInt;
InKey: char;
Stop: boolean;
Num: byte;
Temp: integer;
OldExitProc: pointer;
function HexW(W: word): string; {Word}
const
HexChars: array [0..$F] of Char = '0123456789ABCDEF';
begin
HexW :=
HexChars[(W and $F000) shr 12] +
HexChars[(W and $0F00) shr 8] +
HexChars[(W and $00F0) shr 4] +
HexChars[(W and $000F)];
end;
procedure OurExitProc; far;
{If the program terminates with a runtime error before the extended memory}
{is deallocated, then the memory will still be allocated, and will be lost}
{until the next reboot. This exit procedure is ALWAYS called upon program}
{termination and will deallocate extended memory if necessary. }
var
i: byte;
begin
for i := 0 to NumSounds-1 do
if Sound[i] <> nil then FreeSound(Sound[i]);
if SharedEMB then ShutdownSharing;
ExitProc := OldExitProc; {Chain to next exit procedure}
end;
procedure Init;
begin
Randomize;
writeln;
writeln('-------------------------------------------');
writeln('Sound Mixing Library v1.27 by Ethan Brodsky');
if not(GetSettings(BaseIO, IRQ, DMA, DMA16))
then
begin
writeln('Error initializing: Invalid or non-existant BLASTER environment variable');
Halt(1); {BLASTER environment variable invalid or non-existant}
end
else
begin
if not(InitSB(BaseIO, IRQ, DMA, DMA16))
then
begin
writeln('Error initializing sound card');
writeln('Incorrect base IO address, sound card not installed, or broken');
Halt(2); {Sound card could not be initialized}
end;
if SixteenBit
then writeln('BaseIO=', HexW(BaseIO), 'h IRQ', IRQ, ' DMA8=', DMA, ' DMA16=', DMA16)
else writeln('BaseIO=', HexW(BaseIO), 'h IRQ', IRQ, ' DMA8=', DMA);
end;
write('DSP version ', DSPVersion:0:2, ': ');
if SixteenBit
then write('16-bit, ')
else write('8-bit, ');
if AutoInit
then writeln('Auto-initialized')
else writeln('Single-cycle');
if not(InitXMS)
then
begin
writeln('Error initializing extended memory');
writeln('HIMEM.SYS must be installed');
Halt(3); {XMS driver not installed}
end
else
begin
writeln('Extended memory succesfully initialized');
write('Free XMS memory: ', GetFreeXMS, 'k ');
if GetFreeXMS < XMSRequired
then
begin
writeln('Insufficient free XMS');
writeln('You are probably running MIXTEST from the protected mode IDE');
writeln('Run it from the command line or read the documentation');
Halt(4); {Insufficient XMS memory}
end
else
begin
writeln('Loading sounds');
if SharedEMB then InitSharing;
OpenSoundResourceFile('sounds.tb1');
LoadSound(Sound[0], 'CLICK');
LoadSound(Sound[1], 'AHH');
LoadSound(Sound[2], 'ZOOP');
LoadSound(Sound[3], 'KAPOW');
LoadSound(Sound[4], 'CC');
LoadSound(Sound[5], 'BONK');
LoadSound(sound[6], 'OW');
LoadSound(sound[7], 'SCREAM');
CloseSoundResourceFile;
{OpenSoundResourceFile('MIXTEST.SND');
LoadSound(Sound[0], 'JET');
LoadSound(Sound[1], 'GUN');
LoadSound(Sound[2], 'CRASH');
LoadSound(Sound[3], 'CANNON');
LoadSound(Sound[4], 'LASER');
LoadSound(Sound[5], 'GLASS');
LoadSOund(Sound
CloseSoundResourceFile;}
OldExitProc := ExitProc;
ExitProc := @OurExitProc;
end
end;
InitMixing;
writeln;
end;
procedure Shutdown;
begin
ShutdownMixing;
ShutdownSB5;
for i := 0 to NumSounds-1 do
FreeSound(Sound[i]);
if SharedEMB then ShutdownSharing;
writeln;
end;
begin
Init;
writeln('Press:');
writeln(' 0) Click');
writeln(' 1) Ahh... Mr. Bombem');
writeln(' 2) Zhhip');
writeln(' 3) Explosion');
writeln(' 4) Cachoo');
writeln(' 5) Bonk');
writeln(' 6) Ow');
writeln(' 7) ARRRGH!!!');
writeln(' Q) Quit');
Stop := false;
Counter := 0;
repeat
{Display counters}
Inc(Counter);
write(Counter:8, IntCount:8, VoiceCount:4);
GotoXY(1, WhereY);
{Maybe start a random sound}
{if Random(64000) = 0
then
begin
Num := Random(NumSounds-1)+1;
StartSound(Sound[Num], Num, false);
end;}
{Start a sound if a key is pressed}
if KeyPressed
then
begin
InKey := ReadKey;
case InKey
of
'0'..'9':
begin
Val(InKey, Num, Temp);
if Num < NumSounds
then
StartSound(Sound[Num], Num, false);
end;
else
Stop := true;
end;
end;
until Stop;
writeln;
Shutdown;
end.

BIN
tbtract.tb1 Normal file
View File

Binary file not shown.

BIN
tviewscr.tb1 Normal file
View File

Binary file not shown.

BIN
viewscr.tb1 Normal file
View File

Binary file not shown.

BIN
vmwfan.tb1 Normal file
View File

Binary file not shown.

744
vmwgraph.pas Normal file
View File

@ -0,0 +1,744 @@
unit VMWgraph;
{$X+} {$G+}
INTERFACE
const charset:array[0..255,0..7] of byte=
((0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),
(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),
(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),
(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),
(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),
(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),
(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),
(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),
{32' '}(0,0,0,0,0,0,0,0),($78,$78,$78,$30,$30,$00,$30,$00),($34,$34,$00,$00,$00,$00,$00,$00),
{35'#'}($28,$7C,$28,$28,$7C,$28,$28,$00),($10,$7C,$50,$7C,$14,$7C,$10,$00),
{37'$'}($00,$62,$64,$08,$10,$26,$46,$00),($00,$38,$40,$20,$54,$48,$34,$00),
{39'''}($30,$30,$10,$00,$00,$00,$00,$00),($08,$10,$20,$20,$20,$10,$08,$00),
{41')'}($20,$10,$08,$08,$08,$10,$20,$00),($92,$54,$38,$FE,$38,$54,$92,$00),
{43'+'}($00,$10,$10,$7C,$10,$10,$00,$00),($00,$00,$00,$00,$00,$10,$10,$20),
{45'-'}($00,$00,$00,$7C,$00,$00,$00,$00),($00,$00,$00,$00,$00,$30,$30,$00),
{47'/'}($02,$06,$0C,$18,$30,$E0,$C0,$00),($FE,$C6,$CE,$DA,$F2,$E2,$FE,$00),
{49'1'}($30,$70,$B0,$30,$30,$30,$FC,$00),($78,$84,$08,$10,$20,$40,$FC,$00),
{51'3'}($78,$84,$04,$3C,$04,$84,$78,$00),($C4,$C4,$C4,$FC,$04,$04,$04,$00),
{53'5'}($FC,$C0,$C0,$F8,$04,$04,$F8,$00),($7C,$C4,$C0,$F8,$C4,$C4,$F8,$00),
{55'7'}($FC,$84,$08,$10,$10,$20,$20,$00),($78,$C4,$C4,$78,$C4,$C4,$78,$00),
{57'9'}($7C,$C4,$C4,$7C,$04,$04,$04,$00),($00,$00,$30,$30,$00,$30,$30,$00),
{59';'}($00,$00,$30,$30,$00,$10,$10,$20),($18,$30,$60,$C0,$60,$30,$18,$00),
{61'='}($00,$00,$7C,$00,$7C,$00,$00,$00),($C0,$60,$30,$18,$30,$60,$C0,$00),
{63'?'}($78,$CC,$98,$30,$30,$00,$30,$00),($FC,$84,$BC,$A4,$BC,$80,$FC,$00),
{65'A'}($FE,$C2,$C2,$FE,$C2,$C2,$C2,$00),($F8,$C8,$C8,$FC,$C2,$C2,$FC,$00),
{67'C'}($FE,$C2,$C0,$C0,$C0,$C0,$FE,$00),($F8,$C4,$C2,$C2,$C2,$C2,$FC,$00),
{69'E'}($FE,$C0,$C0,$FE,$C0,$C0,$FE,$00),($FE,$C0,$C0,$FE,$C0,$C0,$C0,$00),
{71'G'}($FE,$C2,$C0,$CE,$C2,$C2,$FE,$00),($C2,$C2,$C2,$FE,$C2,$C2,$C2,$00),
{73'I'}($FE,$30,$30,$30,$30,$30,$FE,$00),($0E,$02,$02,$02,$C2,$64,$38,$00),
{75'K'}($C2,$C2,$CC,$F0,$CC,$C2,$C2,$00),($C0,$C0,$C0,$C0,$C0,$C0,$FE,$00),
{77'M'}($C2,$E6,$EE,$DA,$D2,$C2,$C2,$00),($C2,$E2,$F2,$DA,$CA,$C6,$C6,$00),
{79'O'}($FE,$C2,$C2,$C2,$C2,$C2,$FE,$00),($FE,$C2,$C2,$FE,$C0,$C0,$C0,$00),
{81'Q'}($FE,$C2,$C2,$C2,$CA,$C6,$FE,$00),($FE,$C2,$C2,$FE,$C8,$C4,$C2,$00),
{83'S'}($FE,$C0,$C0,$FE,$02,$82,$FE,$00),($FE,$30,$30,$30,$30,$30,$30,$00),
{85'U'}($C2,$C2,$C2,$C2,$C2,$C2,$FE,$00),($C2,$C2,$C4,$64,$68,$38,$30,$00),
{87'W'}($C2,$C2,$C2,$D2,$F2,$FA,$C6,$00),($C2,$C6,$3C,$18,$3C,$C6,$C2,$00),
{89'Y'}($C2,$C2,$64,$68,$30,$30,$30,$00),($FE,$04,$08,$30,$60,$C0,$FE,$00),
{91'['}($F8,$C0,$C0,$C0,$C0,$C0,$F8,$00),($C0,$E0,$30,$18,$0C,$06,$02,$00),
{93']'}($1E,$02,$02,$02,$02,$02,$1E,$00),($10,$28,$44,$00,$00,$00,$00,$00),
{95'_'}($00,$00,$00,$00,$00,$00,$FF,$00),($08,$04,$02,$00,$00,$00,$00,$00),
{97'a'}($00,$00,$7C,$04,$7C,$44,$7E,$00),($C0,$40,$40,$7C,$44,$44,$FC,$00),
{99'c'}($00,$00,$00,$7C,$40,$40,$7C,$00),($06,$04,$04,$7C,$44,$44,$7E,$00),
{101e'}($00,$00,$7C,$44,$7C,$40,$7C,$00),($10,$28,$20,$70,$20,$20,$70,$00),
{103g'}($00,$00,$04,$7C,$44,$7C,$04,$7C),($E0,$40,$40,$7C,$44,$44,$EE,$00),
{105i'}($00,$10,$00,$30,$10,$10,$78,$00),($00,$04,$00,$0C,$04,$04,$44,$3C),
{107k'}($C0,$40,$40,$58,$60,$50,$48,$00),($30,$10,$10,$10,$10,$10,$78,$00),
{109m'}($00,$00,$00,$E8,$54,$54,$54,$00),($00,$00,$00,$F0,$48,$48,$48,$00),
{111o'}($00,$00,$00,$7C,$44,$44,$7C,$00),($00,$00,$00,$FC,$44,$7C,$40,$E0),
{113q'}($00,$00,$00,$7E,$44,$7C,$04,$0E),($00,$00,$00,$28,$34,$20,$70,$00),
{115s'}($00,$00,$7C,$40,$7C,$04,$7C,$00),($00,$20,$70,$20,$20,$28,$38,$00),
{117u'}($00,$00,$00,$C8,$48,$48,$7C,$00),($00,$00,$00,$44,$44,$28,$10,$00),
{119w'}($00,$00,$00,$42,$42,$5A,$66,$00),($00,$00,$66,$34,$18,$34,$66,$00),
{121y'}($00,$00,$00,$44,$44,$7C,$04,$7C),($00,$00,$7C,$08,$10,$20,$7C,$00),
{123|'}($30,$20,$20,$40,$20,$20,$30,$00),($10,$10,$10,$00,$10,$10,$10,$00),
{125~'}($18,$08,$08,$04,$08,$08,$18,$00),($3A,$6C,$00,$00,$00,$00,$00,$00),
{127''}($00,$54,$2A,$54,$2A,$54,$2A,$00),
(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),
(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),
(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),
(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),
(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),
(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),
(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),
(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),
(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),
(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),
(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),
(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),
(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),
(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),
(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),
(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),
(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),
(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),
(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),
(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),
(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),
(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),
(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),
(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),
(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),
(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),
(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),
(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),
(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),
(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),
(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),
(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0));
CONST VGA = $a000;
var unfadered:array[0..255] of byte;
unfadeblue:array[0..255] of byte;
unfadegreen:array[0..255] of byte;
Procedure SetMCGA;
Procedure SetText; { This procedure returns you to text mode. }
Procedure Cls (Col : Byte; Where:word);
Procedure Putpixel (X,Y : Integer; Col : Byte; where:word);
function getpixel(x,y,where:word):byte;
Procedure Pal(Col,R,G,B : Byte);
Procedure GetPal(Col : Byte; Var R,G,B : Byte);
procedure egaputpix(x,y,col,where:word);
procedure WaitRetrace;
procedure flip(source,dest:Word);
procedure outtext(x,y,rowochar,col,background:integer;num:byte;where:word;overwrite:boolean);
procedure egaouttext(x,y,col:integer;num:byte;where:word;overwrite:boolean);
procedure outtextxy(st:string;x,y,rowochar,col,background:integer;where:word;overwrite:boolean);
procedure egaouttextxy(st:string;x,y,col:integer;where:word;overwrite:boolean);
function sgn(a:real):integer;
procedure line(a,b,c,d,col:integer;where:word);
procedure fade;
procedure unfade;
procedure SavePicSuperPacked(x1,y1,x2,y2,maxcolors:integer;filename:string);
function loadpicsuperpacked(x1,y1:integer;where:word;fil:string):byte;
procedure box(x1,y1,x2,y2,col:integer;where:word);
procedure vdelay(howlong:integer);
IMPLEMENTATION
Procedure SetMCGA; { This procedure gets you into 320x200x256 mode. }
BEGIN
asm
mov ax,0013h
int 10h
end;
END;
Procedure SetText; { This procedure returns you to text mode. }
BEGIN
asm
mov ax,0003h
int 10h
end;
END;
Procedure Cls (Col : Byte; Where:word);
{ This clears the screen to the specified color }
BEGIN
asm
push es
mov cx, 32000;
mov es,[where]
xor di,di
mov al,[col]
mov ah,al
rep stosw
pop es
End;
END;
Procedure Putpixel (X,Y : Integer; Col : Byte; where:word);
{ This puts a pixel on the screen by writing directly to memory. }
BEGIN
Asm
push ds
push es
mov ax,[where]
mov es,ax
mov bx,[X]
mov dx,[Y]
push bx {; and this again for later}
mov bx, dx {; bx = dx}
mov dh, dl {; dx = dx * 256}
xor dl, dl
shl bx, 1
shl bx, 1
shl bx, 1
shl bx, 1
shl bx, 1
shl bx, 1 {; bx = bx * 64}
add dx, bx {; dx = dx + bx (ie y*320)}
pop bx {; get back our x}
add bx, dx {; finalise location}
mov di, bx
{; es:di = where to go}
xor al,al
mov ah, [Col]
mov es:[di],ah
pop es
pop ds
End;
END;
function getpixel(x,y,where:word):byte;
begin
getpixel:=mem[where:x+(y*320)];
end;
Procedure Pal(Col,R,G,B : Byte);
{ This sets the Red, Green and Blue values of a certain color }
Begin
asm
mov dx,3c8h
mov al,[col]
out dx,al
inc dx
mov al,[r]
out dx,al
mov al,[g]
out dx,al
mov al,[b]
out dx,al
end;
End;
procedure WaitRetrace; assembler;
{ This waits for a vertical retrace to reduce snow on the screen }
label
l1, l2;
asm
mov dx,3DAh
l1:
in al,dx
and al,08h
jnz l1
l2:
in al,dx
and al,08h
jz l2
end;
Procedure GetPal(Col : Byte; Var R,G,B : Byte);
{ This gets the Red, Green and Blue values of a certain color }
Var
rr,gg,bb : Byte;
Begin
asm
mov dx,3c7h
mov al,col
out dx,al
add dx,2
in al,dx
mov [rr],al
in al,dx
mov [gg],al
in al,dx
mov [bb],al
end;
r := rr;
g := gg;
b := bb;
end;
procedure egaputpix(x,y,col,where:word);
VAR red,blue,green,inte,P1,P2:byte;
col2:word;
procedure semiput(x,y:word;col,p1,p2:byte;where:word);
var temp:word;
q3:word;
old,q1,q2,qz:byte;
label looper,loop2,loop3,looper2;
begin
asm
mov ax,where {Set Where screen is}
mov es,ax
mov ax,y {The following is 80*y}
mov dx,y {which makes (640*y)/8 uneccessary}
shl ax,6
shl dx,4
add ax,dx
mov temp,ax {saves temporary address}
mov bx,x {gets X DIV 8 and adds it to temp}
shl bx,5
mov dl,bh
mov dh,00
sub bh,bh
shr bx,5
mov q2,bl {gets X MOD 8 for actual pixel}
mov ax,temp
add ax,dx
mov temp,ax
{inegaports}
mov dx,$3Ce {Sets us bitplane for input}
mov al,4
out dx,al
mov dx,$3Cf
mov al,p1
out dx,al
{old} {Gets old pixel values}
mov di,temp
mov al,es:[di]
mov ah,00
mov cl,q2
mov ch,00
JCXZ loop2
looper:
shl ax,1
loop looper
loop2:
mov dh,ah
mov ah,00
shl ax,1
mov ah,col
shr ax,1
mov ah,dh
mov cl,q2
mov ch,00
jcxz loop3
looper2:
shr ax,1
loop looper2
loop3:
mov qz,al
{Logically gets old and new}
{out}
mov dx,$3C4
mov al,2
out dx,al
mov dx,$3C5
mov al,p2
out dx,al {rewrites pixel}
{mem}
mov di,temp
mov al,qz
mov es:[di],al
end;
end;
begin
asm
mov bx,col
shl bx,4
shl bx,1
mov inte,bh
sub bh,bh
shl bx,1
mov red,bh
sub bh,bh
shl bx,1
mov green,bh
sub bh,bh
shl bx,1
mov blue,bh
end;
p1:=0; p2:=1; col2:=0;
if blue= 1 then col2:=1;
semiput(x,y,col2,p1,p2,vga);
p1:=1; p2:=2; col2:=0;
if green=1 then col2:=1;
semiput(x,y,col2,p1,p2,vga);
p1:=2; p2:=4; col2:=0;
if red=1 then col2:=1;
semiput(x,y,col2,p1,p2,vga);
p1:=3; p2:=8; col2:=0;
if inte=1 then col2:=1;
semiput(x,y,col2,p1,p2,vga);
end;
procedure flip(source,dest:Word);
{ This copies the entire screen at "source" to destination }
begin
asm
push ds
mov ax, [Dest]
mov es, ax
mov ax, [Source]
mov ds, ax
xor si, si
xor di, di
mov cx, 32000
rep movsw
pop ds
end;
end;
procedure outtext(x,y,rowochar,col,background:integer;num:byte;where:word;overwrite:boolean);
label l0105; {^-15=all, 0-7= that row}
var n,k,l,o,min,max,qwerty:byte;
begin
if rowochar=15 then begin min:=0; max:=7; end
else begin min:=rowochar; max:=rowochar; end;
qwerty:=0;
for n:=min to max do begin {Loop through charachter}
if rowochar=15 then qwerty:=n;
o:=charset[num,n]; {array in Hex}
for l:=0 to 7 do begin
asm {Hex to binary decoder}
mov bl,o {mov hex into o}
mov dl,00
rcl bl,1 {Rotate O left into carry}
adc dl,00h {Add the carry into dl}
mov o,bl {Save O}
mov k,dl {Copy Dl (if carry) into k}
end;
if k=1 then putpixel(x+l,y+qwerty,col,where)
else if overwrite then putpixel(x+l,y+qwerty,background,where);
end;
end;
end;
procedure egaouttext(x,y,col:integer;num:byte;where:word;overwrite:boolean);
label l0105;
var n,k,l,o:byte;
begin
for n:=0 to 7 do begin {Loop through charachter}
o:=charset[num,n]; {array in Hex}
for l:=0 to 7 do begin
asm {Hex to binary decoder}
mov bl,o {mov hex into o}
mov dl,00
rcl bl,1 {Rotate O left into carry}
adc dl,00h {Add the carry into dl}
mov o,bl {Save O}
mov k,dl {Copy Dl (if carry) into k}
end;
if k=1 then egaputpix(x+l,y+n,col,where)
else if overwrite then egaputpix(x+l,y+n,0,where);
end;
end;
end;
procedure outtextxy(st:string;x,y,rowochar,col,background:integer;where:word;overwrite:boolean);
var l,len,i,xadd,yadd:integer;
begin
xadd:=0; yadd:=y;
len:=length(St);
l:=1;
repeat
outtext(x+xadd,yadd,rowochar,col,background,ord(st[l]),where,overwrite);
inc(xadd,8);
inc(l,1);
if (xadd>311) then begin xadd:=0; inc(yadd,8) end;
if (ord(st[l]))=13 then begin xadd:=0; inc(yadd,8); inc(l,1); end;
until l>=(len+1);
end;
procedure egaouttextxy(st:string;x,y,col:integer;where:word;overwrite:boolean);
var l,len,i,xadd,yadd:integer;
begin
xadd:=0; yadd:=y;
len:=length(St);
l:=1;
repeat
egaouttext(x+xadd,yadd,col,ord(st[l]),where,overwrite);
inc(xadd,8);
inc(l,1);
if (xadd>311) then begin xadd:=0; inc(yadd,8) end;
if (ord(st[l]))=13 then begin xadd:=0; inc(yadd,8); inc(l,1); end;
until l=(len+1);
end;
function sgn(a:real):integer;
begin
if a>0 then sgn:=+1;
if a<0 then sgn:=-1;
if a=0 then sgn:=0;
end;
procedure line(a,b,c,d,col:integer;where:word);
var u,s,v,d1x,d1y,d2x,d2y,m,n:real;
i:integer;
begin
u:= c - a;
v:= d - b;
d1x:= SGN(u);
d1y:= SGN(v);
d2x:= SGN(u);
d2y:= 0;
m:= ABS(u);
n := ABS(v);
IF NOT (M>N) then
BEGIN
d2x := 0 ;
d2y := SGN(v);
m := ABS(v);
n := ABS(u);
END;
s := INT(m / 2);
FOR i := 0 TO round(m) DO
BEGIN
putpixel(a,b,col,where);
s := s + n;
IF not (s<m) THEN
BEGIN
s := s - m;
a:= a +round(d1x);
b := b + round(d1y);
END
ELSE
BEGIN
a := a + round(d2x);
b := b + round(d2y);
END;
end;
END;
procedure fade;
var i,j:integer;
r,g,b:byte;
begin
for i:=0 to 255 do begin
getpal(i,r,g,b);
unfadered[i]:=r;
unfadeblue[i]:=b;
unfadegreen[i]:=g;
end;
for i:=0 to 63 do begin
for j:=0 to 255 do begin
getpal(j,r,g,b);
if r>0 then dec(r);
if g>0 then dec(g);
if b>0 then dec(b);
pal(j,r,g,b);
end;
end;
end;
procedure unfade;
var i,j:integer;
r,g,b:byte;
begin
for i:=0 to 63 do begin
for j:=0 to 255 do begin
getpal(j,r,g,b);
if r<unfadered[j] then inc(r);
if g<unfadegreen[j] then inc(g);
if b<unfadeblue[j] then inc(b);
pal(j,r,g,b);
end;
end;
end;
procedure SavePicSuperPacked(x1,y1,x2,y2,maxcolors:integer;filename:string);
var buffer:array[0..255] of byte;
f:file;
col,x,y,xsize,ysize,buffpointer,i,oldcol,numacross:integer;
header:string;
byte1,byte2,byte3,temp:byte;
procedure integer23bytes(inter1,inter2:integer);
var temp1,temp2,temp3,temp:byte;
begin
asm
mov ax,inter1
shl ax,1
shl ax,1
shl ax,1
shl ax,1
mov temp1,ah
sub ah,ah
shr ax,1
shr ax,1
shr ax,1
shr ax,1
mov temp,al
mov ax,inter2
mov temp3,al
shr ax,1
shr ax,1
shr ax,1
shr ax,1
mov ah,temp
shl ax,1
shl ax,1
shl ax,1
shl ax,1
mov temp2,ah
end;
byte1:=temp1;
byte2:=temp2;
byte3:=temp3;
end;
procedure writebuff2disk;
begin
blockwrite(f,buffer,1);
buffpointer:=0;
end;
procedure writetemps2buffer;
begin
if buffpointer>=253 then writebuff2disk;
buffer[buffpointer]:=byte1;
buffer[buffpointer+1]:=byte2;
buffer[buffpointer+2]:=byte3;
inc(buffpointer,3);
end;
begin
header:='PAINTPROV4.00';
assign(f,filename);
rewrite(f,256);
buffpointer:=0;
for i:=1 to 13 do buffer[i-1]:=ord(header[i]);
buffpointer:=13;
xsize:=abs(x2-x1);
ysize:=abs(y2-y1);
integer23bytes(xsize,ysize);
writetemps2buffer;
integer23bytes(maxcolors,0);
writetemps2buffer;
for y:=y1 to y2 do begin
oldcol:=getpixel(x1,y,vga); numacross:=1;
for x:=(x1+1) to x2 do begin
col:=getpixel(x,y,vga);
if col=oldcol then inc(numacross)
else begin
integer23bytes(oldcol,numacross);
writetemps2buffer;
numacross:=1;
end;
oldcol:=col;
end;
integer23bytes(col,numacross);
writetemps2buffer;
end;
for x:=buffpointer to 254 do buffer[x]:=255;
buffer[255]:=90;
writebuff2disk;
close(f);
end;
function loadpicsuperpacked(x1,y1:integer;where:word;fil:string):byte;
var buffer:array[0..255] of byte;
f:file;
col,x,y,xsize,ysize,buffpointer,i,oldcol,
tempint1,tempint2,numacross:integer;
header:string;
lastread,done:boolean;
temp7:string;
procedure readbuffer;
begin
blockread(f,buffer,1);
if buffer[255]=90 then lastread:=true;
end;
procedure sixbytes2twoint;
var temp1,temp2,temp3:byte;
int1,int2:integer;
begin
if buffpointer>=253 then begin
readbuffer;
buffpointer:=0;
end;
if not done then begin
temp1:=buffer[buffpointer];
temp2:=buffer[buffpointer+1];
temp3:=buffer[buffpointer+2];
if (temp1=255) and (temp2=255) and (temp3=255) then
done:=true;
inc(buffpointer,3);
asm
mov ah,temp1
mov al,temp2
shr ax,1
shr ax,1
shr ax,1
shr ax,1
mov int1,ax
mov ah,temp2
mov al,temp3
shl ah,1
shl ah,1
shl ah,1
shl ah,1
shr ah,1
shr ah,1
shr ah,1
shr ah,1
mov int2,ax
end;
tempint1:=int1;
tempint2:=int2;
end;
end;
label ender;
begin
done:=false;
header:='PAINTPROV4.00';
assign(f,fil);
reset(f,256);
readbuffer;
buffpointer:=0;
temp7:=header;
for i:=1 to 13 do temp7[i]:=chr(buffer[i-1]);
if temp7<>header then begin
loadpicsuperpacked:=01;
exit;
end;
buffpointer:=13;
sixbytes2twoint;
xsize:=tempint1;
ysize:=tempint2;
sixbytes2twoint;
x:=x1;
y:=y1;
repeat
sixbytes2twoint;
if done then goto ender;
col:=tempint1;
numacross:=tempint2;
for i:=x to (x+numacross) do putpixel(i,y,col,where);
if (x+numacross)>xsize+x1 then begin
inc(y);
x:=x1;
numacross:=0;
end;
x:=x+numacross;
ender:
until done=true;
close(f);
end;
procedure box(x1,y1,x2,y2,col:integer;where:word);
begin
line(x1,y1,x1,y2,col,where);
line(x1,y2,x2,y2,col,where);
line(x2,y2,x2,y1,col,where);
line(x2,y1,x1,y1,col,where);
end;
procedure vdelay(howlong:integer);
var i:integer;
begin
for i:=1 to howlong do waitretrace;
end;
begin
end.

BIN
weave1.tb1 Normal file
View File

Binary file not shown.

115
xms.pas Normal file
View File

@ -0,0 +1,115 @@
{ SMIX is Copyright 1995 by Ethan Brodsky. All rights reserved. }
unit XMS;
interface
{Initialization}
function XMSInstalled: boolean;
procedure XMSInit;
{Informational}
function XMSGetVersion: word;
function XMSGetFreeMem: word;
{Allocation and deallocation}
function XMSAllocate(var Handle: word; Size: word): boolean;
function XMSReallocate(Handle: word; NewSize: word): boolean;
function XMSFree(Handle: word): boolean;
{Memory moves}
type
PMoveParams = ^TMoveParams;
TMoveParams =
record
Length : LongInt; {Length must be a multiple of two}
SourceHandle : word;
SourceOffset : LongInt;
DestHandle : word;
DestOffset : LongInt;
end;
function XMSMove(Params: PMoveParams): boolean;
implementation {ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ}
var
XMSDriver: pointer;
{ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ}
function XMSInstalled: boolean; assembler;
asm
mov ax, 4300h
int 2Fh
cmp al, 80h
jne @NoXMSDriver
mov al, TRUE
jmp @Done
@NoXMSDriver:
mov al, FALSE
@Done:
end;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
procedure XMSInit; assembler;
asm
mov ax, 4310h
int 2Fh
mov word ptr [XMSDriver], bx
mov word ptr [XMSDriver+2], es
end;
{ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ}
function XMSGetVersion: word; assembler;
asm
mov ah, 00h
call XMSDriver
end;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
function XMSGetFreeMem: word; assembler;
asm
mov ah, 08h
call XMSDriver
mov ax, dx
end;
{ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ}
function XMSAllocate(var Handle: word; Size: word): boolean; assembler;
asm
mov ah, 09h
mov dx, Size
call XMSDriver
les di, Handle
mov es:[di], dx
end;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
function XMSReallocate(Handle: word; NewSize: word): boolean; assembler;
asm
mov ah, 0Fh
mov bx, NewSize
mov dx, Handle
call XMSDriver
end;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
function XMSFree(Handle: word): boolean; assembler;
asm
mov ah, 0Ah
mov dx, Handle
call XMSDriver
end;
{ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ}
function XMSMove(Params: PMoveParams): boolean; assembler;
asm
push ds
mov ah, 0Bh
lds si, Params
call XMSDriver
pop ds
end;
end. {ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ}