{//-------------------------------------------------------------------------}\r
{/* }\r
+{Copyright (C) 2014 Jason Self <j@jxself.org> }\r
+{ }\r
+{This file is free software: you may copy, redistribute and/or modify it }\r
+{under the terms of the GNU Affero General Public License as published by }\r
+{the Free Software Foundation, either version 3 of the License, or (at your }\r
+{option) any later version. }\r
+{ }\r
+{This file is distributed in the hope that it will be useful, but WITHOUT }\r
+{ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or }\r
+{FITNESS FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License}\r
+{for more details. }\r
+{ }\r
+{You should have received a copy of the GNU Affero General Public License }\r
+{along with this program; if not, see https://gnu.org/licenses or write to: }\r
+{ Free Software Foundation, Inc. }\r
+{ 51 Franklin Street, Fifth Floor }\r
+{ Boston, MA 02110-1301 }\r
+{ USA }\r
+{ }\r
+{This file incorporates work covered by the following copyright and }\r
+{permission notice: }\r
+{ }\r
{Copyright (C) 1990, 2009 - Apogee Software, Ltd. }\r
{ }\r
{This file is part of Supernova. Supernova is free software; you can }\r
function Here(Obj:byte):Boolean;forward;\r
function Up(Word:Str130):Str1;forward;\r
\r
+{$IFDEF UNIX}\r
+procedure init_windows;\r
+ var lang:string;\r
+ begin\r
+ nEcho(false);\r
+ stdscr:=nscreen;\r
+ { Get ENV LANG and check for UTF-8 support}\r
+ lang:=upcase(GetEnvironmentVariable('LANG')); \r
+ UTF8Scr:= (Pos('.UTF-8', lang) > 0) or (Pos('.UTF8', lang) > 0);\r
+ { Check min req col & rows}\r
+ {writeln(nCols(stdscr),nRows(stdscr));}\r
+ end;\r
+\r
+procedure WritePrompt(x,y:integer);\r
+ begin\r
+ { UTF-8 print }\r
+ if UTF8Scr then\r
+ { U+00BB, ยป, C2 BB, RIGHT-POINTING DOUBLE ANGLE QUOTATION MARK.}\r
+ nFWrite(x,y,TextAttr,0,#$C2#$BB)\r
+ else \r
+ nFWrite(x,y,TextAttr,0,chr(187));\r
+ refresh;\r
+ end;\r
+\r
+{$ELSE}\r
+procedure nSetActiveWin(win:pwin);\r
+ begin\r
+ with win^ do\r
+ window(x,y,x1,y1);\r
+ end;\r
+\r
+procedure nWindow(var win : pwin; x,y,x1,y1 : integer);\r
+ begin\r
+ win^.x:=x; win^.y:=y;\r
+ win^.x1:=x1; win^.y1:=y1;\r
+ end;\r
+\r
+procedure init_windows;\r
+ begin\r
+ stdscr:=@win_arr[1];\r
+ win1:=@win_arr[2];\r
+ win2:=@win_arr[3];\r
+ nWindow(stdscr,1,1,80,25);\r
+ end;\r
+\r
+procedure WritePrompt(x,y:integer);\r
+ begin\r
+ gotoxy(x,y);\r
+ write(chr(175));\r
+ end;\r
+{$ENDIF}\r
+\r
+function square_wave(time : Real):integer;\r
+ var l:longint;\r
+ begin\r
+ l:=trunc(time);\r
+ if time-l < 0.5 then square_wave:=0 \r
+ else square_wave:=1;\r
+ end;\r
+\r
+{callback function to generate sound}\r
+procedure ProccessAudio(userdata: Pointer; stream: PUInt8; len: LongInt); cdecl;\r
+ var i,j,k,step:integer;\r
+ begin\r
+ step:=audio_STEP;\r
+ for i:=0 to trunc((len-1)/step) do begin\r
+ \r
+ if speaker_on then\r
+ if sound_i > 0 then begin\r
+ current_freq:=sound_Freqs[sound_play]/audio_freq;\r
+ if current_freq=0 then current_freq:=1;\r
+ sound_play:=sound_play+1;\r
+ if sound_play > sound_i then begin\r
+ speaker_on:=false; sound_i:=0; sound_play:=0; end;\r
+ end;\r
+\r
+ lasttime:=trunc(lasttime*lastfreq/current_freq);\r
+ \r
+ for j:=0 to step-1 do begin\r
+ k:=i*step+j;\r
+ if k<len then\r
+ if speaker_on then\r
+ stream[k]:=audio_VOLUME*square_wave(current_freq * (j+lasttime) )\r
+ else\r
+ stream[k]:=0;\r
+ end;\r
+\r
+ lasttime:=lasttime+step;\r
+ lastfreq:=current_freq; \r
+ end;\r
+ end; \r
+\r
+function InitAudio:boolean;\r
+ var Desired, Obtained: TSDL_AudioSpec;\r
+ begin\r
+ { Set up the requested settings }\r
+ Desired.freq := audio_FREQ;\r
+ Desired.format := AUDIO_U8;\r
+ Desired.channels:= 1;\r
+ Desired.samples := audio_SAMPLES;\r
+ Desired.callback:= @ProccessAudio;\r
+ Desired.userdata:= nil;\r
+\r
+ if SDL_Init(SDL_INIT_AUDIO) = 0 then\r
+ if SDL_OpenAudio(@Desired, @Obtained) = 0 then begin\r
+\r
+ speaker_on:=false;\r
+ current_freq:=1; lastfreq:=1;\r
+ sound_ticks:=1;\r
+ SDL_PauseAudio(0);\r
+ InitAudio:=true;\r
+ end \r
+ else InitAudio:=false\r
+ else\r
+ InitAudio:=false;\r
+ end;\r
+\r
+procedure InitScrKbd;\r
+ begin\r
+ buflen:=127;\r
+ CheckBreak:=false;\r
+ if initaudio then sound_supported:=true\r
+ else begin\r
+ WriteLn('SDL failed to initialize audio: ', SDL_GetError);\r
+ sound_supported:=false;\r
+ end;\r
+ UTF8Scr:=false;\r
+ init_windows;\r
+ nWindow(win1,2,2,79,4);\r
+ nWindow(win2,2,5,79,24);\r
+ nsetActiveWin(stdscr);\r
+ end;\r
+\r
+procedure DoneAudio;\r
+ begin\r
+ if sound_supported then begin\r
+ SDL_CloseAudio;\r
+ SDL_Quit;\r
+ end;\r
+ end;\r
+\r
+procedure DoneScrKbd;\r
+ begin\r
+ DoneAudio;\r
+ nSetActiveWin(stdscr);\r
+ clrscr;\r
+ end;\r
+\r
+procedure sound( Hz: Integer );\r
+ begin\r
+ if sound_supported then begin\r
+ sound_i:=0;\r
+ current_freq:=Hz/audio_Freq;\r
+ if current_freq > 0 then\r
+ speaker_on:=true\r
+ else\r
+ current_freq:=1;\r
+ end;\r
+ end;\r
+\r
+procedure nosound;\r
+ begin\r
+ if sound_supported then begin\r
+ if sound_i > 0 then begin\r
+ speaker_on:=true;\r
+ while speaker_on do;\r
+ end else\r
+ speaker_on:=false;\r
+ end;\r
+ end;\r
+\r
+procedure sounddelayed( Hz,step: Integer ); forward;\r
+\r
+procedure sounddelayed( Hz: Integer );\r
+ begin\r
+ sounddelayed( Hz, audio_STEP );\r
+ end;\r
+\r
+procedure sounddelayed( Hz,step: Integer );\r
+ begin\r
+ if sound_supported then begin\r
+ sound_ticks:=sound_ticks+1;\r
+ if sound_ticks mod step = 0 then begin\r
+ if sound_i < audio_MAXENTRIES then begin\r
+ Sound_Freqs[sound_i]:=Hz;\r
+ sound_i:=sound_i+1;\r
+ end;\r
+ end;\r
+ end;\r
+ end;\r
+\r
+procedure delay( MS: Integer);\r
+ begin\r
+ if sound_supported then\r
+ SDL_delay(MS)\r
+ else\r
+{$IFDEF UNIX}\r
+ ocrt.delay(MS);\r
+{$ELSE}\r
+ crt.delay(MS);\r
+{$ENDIF}\r
+ end;\r
+\r
+procedure ReadLine(var S:String);\r
+ var Ch: Char;\r
+ begin\r
+ Repeat\r
+ Ch:=ReadKey;\r
+ write(ch);\r
+ if (buflen>0) and (ch<>Chr(13)) then begin\r
+ S:=S+ch;\r
+ buflen:=buflen-1;\r
+ end;\r
+ Until (Ch=chr(13));\r
+ buflen:=127;\r
+ end;\r
+\r
procedure SF; begin SFlag:=True end;\r
\r
procedure Cur(Num:byte);\r
begin\r
- with Result do\r
- if Color then\r
- begin AX:=$100;\r
- case Num of\r
- 1:CX:=$707; { Underline }\r
- 2:CX:=$8; { Solid block }\r
- 3:CX:=$800; { Invisible }\r
- end;\r
- intr($10,Result);\r
- end;\r
+ case Num of \r
+{$IFDEF UNIX}\r
+ 1:ncursor(cON); { Underline }\r
+ 2:ncursor(cBIG); { Solid block }\r
+ 3:nCursor(cOFF); { Invisible }\r
+{$ELSE}\r
+ 1:cursoron; { Underline }\r
+ 2:cursorbig; { Solid block }\r
+ 3:cursoroff; { Invisible }\r
+{$ENDIF}\r
+ end;\r
end;\r
\r
procedure Col(Num1,Num2:byte);\r
\r
procedure Bor(Num1,Num2:byte);\r
begin\r
- with Result do\r
- begin AX:=$B00;if Color then BX:=Num1 else BX:=Num2 end;intr($10,Result)\r
+ {with Result do\r
+ begin AX:=$B00;if Color then BX:=Num1 else BX:=Num2 end;intr($10,Result)}\r
end;\r
\r
function En(Num:byte):boolean;\r
begin if not en(pointer)then begin Sc:=Sc+Num;Add(Pointer)end end;\r
\r
procedure Cn(s:str78);\r
- begin gotoxy(40-(length(s)div 2),wherey);writeln(s)end;\r
+ begin gotoxy(40-(length(s)div 2),wherey);write(s);gotoxy(1,wherey+1)end;\r
+\r
+procedure wCn(s:str78);\r
+ begin gotoxy(39-(length(s)div 2),wherey);writeln(s);end;\r
\r
procedure Pause;\r
begin col(15,15);write('Press any key to continue...');\r
- read(kbd,CFlag);col(11,7);writeln;\r
+ CFlag:=ReadKey;col(11,7);writeln;\r
end;\r
\r
procedure Tune(Octave,Note,Duration:integer);\r
var x:integer;\r
begin\r
if Start<=Stop then\r
- for x:=Start to Stop do begin sound(x);delay(Speed)end\r
+ for x:=Start to Stop do\r
+ if Speed>0 then begin sound(x);delay(Speed)end\r
+ else sounddelayed(x)\r
else\r
- for x:= Start downto Stop do begin sound(x);delay(Speed)end;\r
- nosound;if Region=4 then sound(20);if Region=5 then sound(60);\r
+ for x:= Start downto Stop do\r
+ if Speed>0 then begin sound(x);delay(Speed)end\r
+ else sounddelayed(x);\r
+ if Speed>0 then begin\r
+ nosound;if Region=4 then sound(20);if Region=5 then sound(60);\r
+ end;\r
end;\r
\r
procedure Explode(Duration:byte);\r
var x:integer;\r
- begin for x:=Duration*999 downto 20 do sound(random(x));nosound end;\r
+ begin for x:=Duration*999 downto 20 do sounddelayed(random(x));nosound end;\r
\r
procedure Walls(Duration:byte);\r
var x:integer;\r
- begin for x:=1 to Duration*999 do sound(random(35)+20);nosound end;\r
+ begin for x:=1 to Duration*999 do sounddelayed(random(35)+20);nosound end;\r
\r
procedure Static;\r
var x,y:integer;\r
begin\r
for x:=1 to 50 do\r
case random(2) of\r
- 0:for y:=1 to random(70)+10 do sound(random(4000)+3000);\r
+ 0:for y:=1 to random(70)+10 do sounddelayed(random(4000)+3000);\r
1:begin nosound;delay(random(29))end\r
end;nosound;if Region=5 then sound(60)\r
end;\r
procedure Dopen(Num:byte);\r
begin writeln('The door slides open...');\r
if Num<>0 then play(50,125-Num,Num)\r
- else begin for i:=3500 to 5000 do sound(random(4500)+i);nosound;end;\r
+ else begin for i:=3500 to 5000 do sounddelayed(random(4500)+i);nosound;end;\r
if Region=5 then sound(60)\r
end;\r
\r
procedure Dclose(Num:byte);\r
begin writeln('The sliding door closes.');\r
if Num<>0 then play(125-Num,50,Num)\r
- else begin for i:=5000 downto 3500 do sound(random(4500)+i);nosound;end;\r
+ else begin for i:=5000 downto 3500 do sounddelayed(random(4500)+i);nosound;end;\r
if Region=5 then sound(60)\r
end;\r
\r
if en(8)then RL(23)else begin DOpen(Num);Move(New);DClose(Num)end\r
end;\r
\r
+procedure won; forward;\r
+\r
+procedure SoundTest;\r
+ var ch:char;\r
+ begin\r
+\r
+ while true do begin\r
+ \r
+ writeln(' Sounds ');\r
+ writeln(' 1. Won ');\r
+ writeln(' 2. explode(32) ');\r
+ writeln(' 3. Walls(12) ');\r
+ writeln(' 4. Static ');\r
+ writeln(' 5. Blast ');\r
+ writeln(' 6. Dopen(10) ');\r
+ writeln(' 7. Dclose(0) ');\r
+ writeln(' Q. Quit ');\r
+\r
+ ch:=readkey;\r
+\r
+ if ch='q' then halt;\r
+\r
+ case ch of\r
+ '1' : Won;\r
+ '2' : explode(32);\r
+ '3' : Walls(12);\r
+ '4' : Static;\r
+ '5' : Blast;\r
+ '6' : Dopen(10);\r
+ '7' : DClose(0);\r
+ '8' : begin\r
+ for x:=1 to 20 do for y:=1 to x*8 do sounddelayed(x*9,trunc((168-y)/8)); nosound;\r
+ end;\r
+ end;\r
+\r
+ end;\r
+\r
+ end;\r
+\r
procedure Time1;\r
begin Tic:=Tic+1; Min(128); { <--Negates DEAD } col(13,15);\r
for x:=1 to TMax do T[x]:=T[x]-1;\r
14:RL(9);\r
5:begin Bor(4,7);RL(10)end;\r
1:begin RL(126);DEAD;end;\r
- 2..13:begin x:=random(29)+1;\r
+ 2..4,6..13:begin x:=random(29)+1;\r
if(x in Inv)and not(x in Wear)then\r
begin Van(x);R[x]:=Prm;\r
writeln('A bout of weariness causes you to loose your grip on',\r
case T[29] of { Laser Injury }\r
9:RS(214);\r
4:begin RL(507);Bor(4,7)end;\r
- 2..11:begin repeat x:=random(27)+1 until x in[1..12,16..20,22..26,28];\r
+ 2,3,5..8,10,11:begin repeat x:=random(27)+1 until x in[1..12,16..20,22..26,28];\r
if(x in Inv)and not(x in Wear)then\r
begin Van(x);R[x]:=Prm;\r
if random(2)=0 then\r
65:begin PStat:=PStat+[3];RL(208)end;\r
47:RL(209); 30:RS(73); 15:RS(74); 4:begin Bor(4,7);RS(75)end;\r
1:begin RS(76);DEAD end;\r
- 2..29:if(random(25)=0)and(Inv<>[])and not(en(125))then\r
+ 2,3,5..14,16..29:if(random(25)=0)and(Inv<>[])and not(en(125))then\r
begin RS(232);\r
for x:=1 to 29 do if(x in Inv)and not(x in Wear)then\r
begin Van(x);R[x]:=Prm end\r
if(Prm in[81..88])and(T[30]<1)and(random(4)=0)then\r
if 28 in Wear then\r
begin T[30]:=9;RS(153+Prm);\r
- for i:=999 to 2300 do sound(random(i*3)+i);\r
- for i:=3000 downto 20 do sound(random(i*4)+i*2);nosound\r
+ for i:=999 to 2300 do sounddelayed(random(i*3)+i);\r
+ for i:=3000 downto 20 do sounddelayed(random(i*4)+i*2);nosound\r
end\r
else\r
begin\r
84:write('northwest'); 85:write('north'); 86:write('northeast');\r
87:write('east'); 88:write('southeast')\r
end; writeln(' section of the corridor and flies');\r
- RS(242);RS(243);for i:=20 to 3000 do sound(random(i*3)+i);nosound;\r
+ RS(242);RS(243);for i:=20 to 3000 do sounddelayed(random(i*3)+i);nosound;\r
delay(1500);DEAD\r
end;\r
end; { Time1 }\r
\r
-overlay procedure Time2A;\r
+procedure Time2A;\r
begin col(10,7); { Pre-Jungle Planet }\r
case T[1] of\r
19:MC(1,13,13,0);\r
18:begin MC(1,8,8,1);MC(1,13,8,2)end;\r
17:if en(19) then begin RS(9);T[1]:=11;end;\r
- 11..17:if not(en(19))and(Prm=8)and(random(2)=1)then RL(0);\r
+ 11..16:if not(en(19))and(Prm=8)and(random(2)=1)then RL(0);\r
10:MC(1,8,9,3);\r
9:begin MC(1,9,0,4);T[1]:=Null;end;\r
5..7:if(en(2))and(en(3))then begin RB2(5-(T[1]-3),10);col(10,7)end;\r
if Prm=SinkRm then begin RL(85);L[Prm]:=L[Prm]+[79];end;\r
end; { Time2A }\r
\r
-overlay procedure Time2B;\r
+procedure Time2B;\r
begin col(10,7); { Jungle Planet }\r
Maze:=not(Maze);\r
if Prm in[42..49]then\r
if T[19]=1 then begin RS(128);Walls(12);DEAD;end;\r
end; { Time2B }\r
\r
-overlay procedure Time2C;\r
+procedure Time2C;\r
begin col(11,7); { Inner Planet }\r
if T[20]=1 then\r
case Prm of 73:DClose(20);66:begin RL(337);play(105,50,20)end end;\r
writeln('There''s an alarm sound coming over the radio.');\r
for x:=1 to 23 do\r
begin\r
- for i:=450 to 999 do sound(i);\r
- for i:=999 downto 450 do sound(i);\r
+ for i:=450 to 999 do sounddelayed(i);\r
+ for i:=999 downto 450 do sounddelayed(i);\r
end;nosound\r
end;\r
case random(50) of\r
end;\r
end; { Time2C }\r
\r
-overlay procedure Time2D; { Planetship }\r
+procedure Time2D; { Planetship }\r
function Warn(Message,IfTime,Said:integer):boolean;\r
begin Warn:=false;\r
if not en(Said)and(IfTime>=T[26])then\r
if(T[28]=1998)and(Prm=101)then begin RS(213);Blast;DEAD;end;\r
end; { Time2D }\r
\r
-overlay procedure Directory;\r
-type\r
- Char12arr = array [ 1..12 ] of Char;\r
- String20 = string[ 20 ];\r
+procedure Directory;\r
var\r
- Regs : Entr;\r
- DTA : array [ 1..43 ] of Byte;\r
- Mask : Char12arr;\r
- NamR : String20;\r
- Error, I : Integer;\r
SM1Found : boolean;\r
+ Info : TSearchRec;\r
begin\r
- ChDir(Drive+':');\r
+ {ChDir(Drive+':');}\r
SM1Found:=false;\r
- FillChar(DTA,SizeOf(DTA),0);\r
- FillChar(Mask,SizeOf(Mask),0);\r
- FillChar(NamR,SizeOf(NamR),0);\r
writeln;\r
- Regs.AX := $1A00;\r
- Regs.DS := Seg(DTA);\r
- Regs.DX := Ofs(DTA);\r
- MSDos(Regs);\r
- Error := 0;\r
- Mask := '????????.???';\r
- Regs.AX := $4E00;\r
- Regs.DS := Seg(Mask);\r
- Regs.DX := Ofs(Mask);\r
- Regs.CX := 22;\r
- MSDos(Regs);\r
- Error := Regs.AX and $FF;\r
- I := 1;\r
- if Error=0 then\r
+ if FindFirst ('*',faAnyFile,Info)=0 then\r
repeat\r
- NamR[I] := Chr(Mem[Seg(DTA):Ofs(DTA)+29+I]);\r
- I := I + 1;\r
- until not (NamR[I-1] in [' '..'~']) or (I>20);\r
- NamR[0] := Chr(I-1);\r
- while Error=0 do begin\r
- Error := 0;\r
- Regs.AX := $4F00;\r
- Regs.CX := 22;\r
- MSDos( Regs );\r
- Error := Regs.AX and $FF;\r
- I := 1;\r
- repeat\r
- NamR[I] := Chr(Mem[Seg(DTA):Ofs(DTA)+29+I]);\r
- I := I + 1;\r
- until not (NamR[I-1] in [' '..'~'] ) or (I > 20);\r
- NamR[0] := Chr(I-1);\r
- delete(NamR,length(NamR),2);\r
- if (Error = 0) then\r
- if length(NamR)>4 then\r
- if copy(NamR,length(NamR)-2,3)='SM1' then\r
- begin\r
- if not SM1Found then\r
- writeln('Here is a list of the SAVE/RESTORE files on the ',\r
- 'disk in drive ',up(Drive),':');\r
+ if length(Info.Name)>4 then\r
+ if copy(Info.Name,length(Info.Name)-2,3)='sm1' then\r
+ begin\r
+ if not SM1Found then\r
+ writeln('Here is a list of the SAVE/RESTORE files on the ',\r
+ 'disk in drive ',up(Drive),':');\r
SM1Found:=true;\r
- writeln(' * ',copy(NamR,1,length(NamR)-4));\r
+ writeln(' * ',copy(Info.Name,1,length(Info.Name)-4));\r
end;\r
- end; writeln;\r
- if not SM1Found then\r
- begin\r
- writeln('There are not any SAVE/RESTORE files on the disk in drive ',\r
+ until FindNext(Info)<>0;\r
+ \r
+ FindClose(Info);\r
+ writeln;\r
+ if not SM1Found then\r
+ begin\r
+ writeln('There are not any SAVE/RESTORE files on the disk in drive ',\r
up(Drive),':');writeln;\r
- end;\r
- Pause;ChDir(Log+':');\r
+ end;\r
+ Pause;{ChDir(Log+':');}\r
end; {Directory}\r
\r
-function Up;{Word:Str130):Str1}\r
+function Up(Word:Str130):Str1;\r
begin word:=word+' ';\r
if(Word[1]='l')and(Word[2]=' ')then insert('ook',Word,2);\r
if(Word[1]='e')and(Word[2]='x')and(Word[3]=' ')then insert('amine',Word,3);\r
QFormat(input);\r
end; { FindMood }\r
\r
-function FN;{(VNP:byte) : Str29; ( Finds first Noun ) }\r
+function FN(VNP:byte) : Str29; { ( Finds first Noun ) }\r
var Temp:Str29;\r
begin SF;\r
Temp:=n[VNP];\r
FN:=copy(Temp,1,pos('\',Temp)-1);\r
end; { FW }\r
\r
-function Here;{Obj:byte) : Boolean;}\r
+function Here(Obj:byte) : Boolean;\r
begin Here:=false;\r
if Obj in L[Prm] then Here:=true;\r
if(Obj=79)and(MugCon=79)and(29 in Inv)then Here:=true;\r
end;\r
end; { Dictionary }\r
\r
-procedure RL;\r
+procedure RL(Pointer:Integer);\r
begin SF;\r
if(pointer<>StoreL)then\r
begin StoreL:=pointer;\r
writeln(Text3);\r
end; { Read Line }\r
\r
-procedure RS;\r
+procedure RS(Pointer:Integer);\r
begin SF;\r
if(pointer<>StoreS)then\r
begin StoreS:=pointer;\r
writeln(Text4);\r
end; { Read Special }\r
\r
-procedure RR;\r
+procedure RR(Pointer:integer);\r
begin SF;\r
if(pointer<>StoreR)then\r
begin StoreR:=pointer;\r
read(R1,Text1);\r
read(R2,Text2);\r
end;\r
- writeln(Text1,Text2);\r
+ write(Text1);\r
+ writeln(Text2);\r
end; { Read Room }\r
\r
-procedure RB;\r
+procedure RB(Pointer,Colour:byte);\r
var Block:Str255;\r
Tstart,TStop:Str19;\r
begin SF; Col(Colour,7);\r
until Block=TStop; col(11,7);\r
end;\r
\r
-procedure RB2;\r
+procedure RB2(Pointer,Colour:byte);\r
var Block:Str255;\r
Tstart,TStop:Str19;\r
begin SF; Col(Colour,7);\r
until Block=TStop; col(11,7);\r
end;\r
\r
-overlay procedure Won;\r
+procedure Won;\r
const W=800;H=400;Q=200;T=131;\r
label JUMP;\r
begin writeln;\r
tune(3,3,h);tune(3,1,h);tune(2,12,h);tune(2,10,t);tune(2,10,t);tune(2,10,t);\r
tune(3,1,w);\r
until keypressed;\r
- JUMP: read(kbd,CFlag);\r
+ JUMP: CFlag:=ReadKey;\r
+ DoneScrKbd;\r
window(1,1,80,25);clrscr;gotoxy(2,2);Col(31,31);Bor(0,0);Cur(1);Bak(2,0);\r
writeln('Congratulations!');\r
HALT;\r
end; { Won }\r
\r
-overlay procedure PlayerInput(var LINE:Str130);\r
+procedure PlayerInput(var LINE:Str130);\r
label JUMP;\r
+ var Ch : Char;\r
+ ExtCode : integer;\r
procedure Key(k:Str19); begin Line:=Line+k;QFlag:=true;write(k)end;\r
begin\r
- with Result do begin\r
+ {with Result do begin}\r
WRITELN; { Main Space In Game }\r
if(length(Line)=0)then\r
begin\r
+ nSetActiveWin(win1);\r
bak(4,7);col(14,0);\r
- window(1,1,80,22);\r
- gotoxy(8,2);write(Tic,' ');\r
- gotoxy(35-(length(RN[Prm])div 2),2);\r
+ gotoxy(7,1);write(Tic,' ');\r
+ gotoxy(34-(length(RN[Prm])div 2),1);\r
write(' ',RN[Prm],' ');\r
- gotoxy(75,2);write(' ');gotoxy(75,2);write(Sc,' ');\r
+ gotoxy(74,1);write(' ');gotoxy(74,1);write(Sc,' ');\r
bak(7,7);\r
- col(1,0);gotoxy(22,3);\r
+ col(1,0);gotoxy(21,2);\r
if PStat=[] then write('Healthy') else write(' * ');\r
- col(15,0);gotoxy(33,3);\r
+ col(15,0);gotoxy(32,2);\r
if 2 in PStat then begin col(31,16);write('Hungry')end\r
else write(' * ');\r
- col(4,0);gotoxy(43,3);\r
+ col(4,0);gotoxy(42,2);\r
if 3 in PStat then begin col(20,16);write('Sick')end\r
else write(' * ');\r
- col(0,0);gotoxy(51,3);\r
+ col(0,0);gotoxy(50,2);\r
if 4 in PStat then begin col(16,16);write('Injured')end\r
else write(' * ');\r
- col(6,0);gotoxy(62,3);\r
+ col(6,0);gotoxy(61,2);\r
if 5 in PStat then begin col(22,16);write('Tired')end\r
else write(' * ');\r
- col(5,0);gotoxy(71,3);\r
+ col(5,0);gotoxy(70,2);\r
if 6 in PStat then begin col(21,16);write('Thirsty')end\r
else write(' * ');\r
- bak(0,0);window(2,5,79,24);\r
+ nSetActiveWin(win2);bak(0,0);\r
if en(66)then begin gotoxy(1,20);goto JUMP;end;\r
- gotoxy(1,20);col(28,31);writeln(chr(175));\r
+ gotoxy(1,20);col(28,31);writeln;\r
+ WritePrompt(1,19);\r
Cur(1);\r
col(14,7);gotoxy(3,19);\r
QFlag:=false;\r
repeat\r
- ax:=0;\r
- intr($16,result);\r
- sound(99);nosound;case Region of 4:sound(20);5:sound(60)end;\r
- case chr(Lo(ax)) of\r
+ Ch:=Readkey;\r
+ { Read Extended (Scan) Code }\r
+ if Ch = #0 then ExtCode:=Ord(Readkey);\r
+ sounddelayed(99,1);speaker_on:=true;delay(1);case Region of 4:sound(20);5:sound(60)end;\r
+ case Ch of\r
^h:begin\r
- if(wherex=1)and(wherey=20)then\r
- begin window(1,1,80,25);gotoxy(80,23)end;\r
+ if(wherex=1)and(wherey=20)then\r
+ begin gotoxy(78,wherey-1); ClrEol; end else\r
if length(Line)>0 then write(^h,' ',^h);\r
delete(Line,length(Line),2);\r
- window(2,5,79,24);\r
end;\r
^m:QFlag:=true\r
else\r
begin\r
- if(Lo(ax)>0)and(length(Line)<110)then\r
- begin write(chr(Lo(ax)));Line:=Line+chr(Lo(ax));end\r
+ if(Ord(Ch)>0)and(length(Line)<110)then\r
+ begin write(Ch);Line:=Line+Ch;end\r
else { read scan }\r
begin\r
- case hi(ax) of\r
+ case ExtCode of\r
59:key('Save'); 71:key('Northwest');\r
60:key('Restore'); 73:key('Northeast');\r
61:key('R D'); 79:key('Southwest');\r
68:begin Line:='';key('Repeat')end;\r
94,30:key('by Scott Miller');\r
95,47:key('Version A Dec 9, 85');\r
+ 31:SoundTest;\r
end;\r
if Prm in[1..7] then\r
- case hi(ax) of\r
+ case ExtCode of\r
72:key('Fore'); 75:key('Port'); 77:key('Starboard'); 80:key('Aft')\r
end\r
else\r
- case hi(ax) of\r
+ case ExtCode of\r
72:key('North'); 75:key('West'); 77:key('East'); 80:key('South')\r
end\r
end\r
end; {case}\r
until QFlag=true;\r
Cur(3);\r
- gotoxy(1,19);col(5,7);write(chr(175));col(11,7);gotoxy(1,20);\r
+ col(5,7);WritePrompt(1,19);col(11,7);gotoxy(1,20);\r
if length(Line)>76 then writeln;\r
LowerCase(Line);Spaces(Line);\r
if(pos(' r ',Line)>0)or(pos(' repeat ',Line)>0)then PreFormat(Line);\r
QFormat(input);\r
col(11,7);\r
JUMP:\r
- end; { of with statement }\r
+ {end;} { of with statement }\r
end; { PlayerInput }\r
\r
-overlay procedure Title;\r
+procedure Title;\r
+{$IFDEF UNIX}\r
+ var win:pwindow;\r
+{$ENDIF}\r
begin\r
clrscr;textcolor(7);Color:=true;\r
if ParamCount=0 then begin\r
write('Do you want ');textcolor(15);write('C');textcolor(7);\r
write('olor or ');textcolor(15);write('B');textcolor(7);\r
- write('lack and white? ');textcolor(15);read(kbd,CFlag);\r
+ write('lack and white? ');textcolor(15); CFlag:=ReadKey;\r
if(upcase(CFlag)='B')or(upcase(CFlag)='M')then\r
begin Color:=false;write('Monochrome')end\r
else write('Color');delay(300);\r
Cur(3);\r
\r
{**** Public Domain title screen ****}\r
- Col(9,9);gotoxy(1,1);\r
+ {Col(9,9);gotoxy(1,1);\r
cn('S U P E R N O V A');\r
Col(9,7);gotoxy(1,3);\r
cn('Published by');\r
cn('Thanks, enjoy the game...');\r
\r
Col(7,7);gotoxy(27,25);delay(999);\r
- write('Press any key to continue.');repeat;begin;end;until keypressed;\r
- read(kbd,CFlag);bak(1,0);clrscr;\r
+ write('Press any key to continue.');repeat;delay(1);until keypressed;\r
+ CFlag:=ReadKey;}bak(1,0);clrscr;\r
{**** Main SUPERNOVA title screen ****}\r
\r
Bor(1,0);Col(15,15);Bak(4,0);\r
+{$IFDEF UNIX}\r
+ nWindow(win,1,1,80,24);\r
+ nFrame(win);\r
+{$ELSE}\r
for x:=1 to 80 do\r
begin gotoxy(x,1);write(chr(205));gotoxy(x,24);write(chr(205))end;\r
for y:=1 to 24 do\r
begin gotoxy(1,y);write(chr(186));gotoxy(80,y);write(chr(186))end;\r
gotoxy(1,1);write(chr(201)); gotoxy(80,1);write(chr(187));\r
gotoxy(1,24);write(chr(200)); gotoxy(80,24);write(chr(188));\r
+{$ENDIF}\r
Bak(1,0);\r
Col(2,7);gotoxy(1,10);cn('Copyright 1987 Scott Miller');\r
Col(14,7);gotoxy(1,12);cn('Version B');\r
if Color then textcolor(random(16))\r
else case random(3) of 0:textcolor(0); 1:textcolor(7); 2:textcolor(15)end;\r
write('S U P E R N O V A');\r
+ delay(1);\r
until keypressed;\r
- read(kbd,CFlag);\r
+ CFlag:=ReadKey;\r
+{$IFDEF UNIX}\r
+ nSetActiveWin(stdscr);\r
+ nDelWindow(win);\r
+{$ENDIF}\r
if Color then textmode(C80)else textmode(BW80);\r
end; { Title }\r
\r
-overlay procedure Init1;\r
+procedure Init1;\r
label Abort;\r
begin ABORT:\r
Bor(0,0);bak(0,0);clrscr;nosound;\r
for x:=1 to 20 do begin sound(x*9);delay(x*2)end;nosound;\r
gotoxy(1,9);y:=0;col(14,7);Identity:='';\r
Cn('Please enter your identity code name:');col(12,15);\r
- repeat i:=random(maxint) until keypressed;\r
- repeat read(kbd,CFlag);\r
+ repeat begin i:=random(maxint); delay(1) end; until keypressed;\r
+ repeat CFlag:=ReadKey;\r
if(CFlag<>chr(13))then\r
if(CFlag<>^h)then Identity:=Identity+upcase(CFlag)\r
else delete(Identity,length(Identity),2);\r
- gotoxy(1,11);Cn(' '+Identity+' ');sound(50);delay(50);nosound;\r
+ gotoxy(1,11);Cn(' '+Identity+' ');\r
+{sound(50);delay(50);nosound;}\r
+ for x:=1 to 50 do sounddelayed(50,1); nosound;\r
until CFlag=chr(13);\r
col(10,7);gotoxy(1,7);\r
if identity<>'' then\r
reset(S1);reset(L1);reset(C1);\r
end; { Init1 }\r
\r
-overlay procedure Init2;\r
+procedure Init2;\r
begin\r
col(7,15);bak(1,7);\r
+{$IFDEF UNIX}\r
+ nFrame(stdscr);\r
+ nWriteAC(stdscr,1,4,TextAttr,nLT);\r
+ nWriteAC(stdscr,nCols(stdScr),4,TextAttr,nRT);\r
+ nrefresh(stdscr);\r
+{$ELSE}\r
for x:=1 to 80 do\r
begin gotoxy(x,1);write(chr(205));gotoxy(x,24);write(chr(205))end;\r
gotoxy(80,24);write(chr(190));gotoxy(1,24);write(chr(212));\r
gotoxy(1,4);write(chr(198));for x:=2 to 79 do\r
begin gotoxy(x,4);write(chr(205))end;write(chr(181));\r
gotoxy(1,1);write(chr(213));gotoxy(80,1);write(chr(184));\r
- bak(4,7);col(14,0);gotoxy(2,2);\r
+{$ENDIF}\r
+ nSetActiveWin(win1);\r
+ bak(4,7);col(14,0);gotoxy(1,1);\r
for x:=1 to 78 do write(' ');\r
- gotoxy(2,2);write('Move');\r
- gotoxy(68,2);write('Score');\r
- bak(7,7);gotoxy(2,3);\r
+ gotoxy(1,1);write('Move');\r
+ gotoxy(67,1);write('Score');\r
+ bak(7,7);gotoxy(1,2);\r
for x:=1 to 78 do write(' ');\r
bak(5,7);col(15,0);\r
- gotoxy(2,3);write('Player Condition:');\r
+ gotoxy(1,2);write('Player Condition:');\r
+ col(7,15);bak(1,7);\r
+{$IFDEF UNIX}\r
+ gotoxy(1,3);whLine(win1,nHL,nCols(stdScr)-2);\r
+ nRefresh(win1);\r
+{$ENDIF}\r
+ nSetActiveWin(win2);\r
bak(0,0);\r
- gotoxy(1,14);col(14,7);\r
- cn('Working 14 hours a day in the core of some dusty, smelly mine');\r
- cn('is not your idea of the perfect lifestyle.');\r
- cn('Barre-An is a dust ball in space, its only salvation being that it is');\r
- cn('rich in precious barre-an metal. Or used to be. Nowadays the mines');\r
- cn('don''t seem so generous, which is why you''re looking for a more');\r
- cn('profitable venture.');\r
- cn('A break, that''s all you ask for, maybe today you figure...');\r
+ gotoxy(1,10);col(14,7);\r
+ wcn('Working 14 hours a day in the core of some dusty, smelly mine');\r
+ wcn('is not your idea of the perfect lifestyle.');\r
+ wcn('Barre-An is a dust ball in space, its only salvation being that it is');\r
+ wcn('rich in precious barre-an metal. Or used to be. Nowadays the mines');\r
+ wcn('don''t seem so generous, which is why you''re looking for a more');\r
+ wcn('profitable venture.');\r
+ wcn('A break, that''s all you ask for, maybe today you figure...');\r
writeln;\r
end; { Init2 }\r
\r
-overlay procedure Init3;\r
+procedure Init3;\r
begin\r
Line :='';\r
Again :='z';\r
ToNounOnly :=[33,49,64,88,93];\r
ToNounMaybe :=[19,41..44,48,50,53,54,74..76,89,90,92,94];\r
{ NOTE: All other verbs would be OneNounOnly! }\r
- window(2,5,79,24);gotoxy(1,19);\r
+ nSetActiveWin(win2);gotoxy(1,19);\r
end; { Init3 }\r
\r
-overlay procedure Save;\r
+procedure Save;\r
label JUMPABORT,JUMPBACK;\r
- var DiskTest:file;\r
+ {var DiskTest:file;}\r
begin SF; JUMPBACK: nosound; for x:=1 to 20 do writeln;\r
Bor(2,7);CFlag:=Drive;Cur(2);\r
gotoxy(1,2);\r
+ { remove floppy drive selection\r
write('Which disk drive (default ',Up(Drive),':)? ');\r
- col(14,15);buflen:=1;readln(Drive);col(11,7);\r
- Drive:=upcase(Drive);if not(Drive in['A','B'])then Drive:=CFlag;\r
+ col(14,15);buflen:=1;readline(Drive);col(11,7);\r
+ Drive:=upcase(Drive);if not(Drive in['A','B'])then Drive:=CFlag;}\r
gotoxy(1,5);\r
writeln('Make sure your SAVE/RESTORE disk is in disk drive ',up(Drive),':');\r
writeln;writeln;\r
write('SAVE under what file name (''',up('/'),''' aborts SAVE)? ');\r
- buflen:=8;col(14,15);readln(input);col(11,7);\r
+ buflen:=8;col(14,15);readline(input);col(11,7);\r
Cur(3);\r
while pos(' ',input)>0 do delete(input,pos(' ',input),1);\r
while pos('.',input)>0 do delete(input,pos('.',input),1);\r
if length(input)=0 then input:='LASTSAVE';writeln;writeln;\r
writeln('The game file ',Up(Input),' is now being saved on disk drive ',\r
up(Drive),':...');\r
- input:=Drive+':'+input;\r
+ { don't put Drive\r
+ input:=Drive+':'+input;}\r
assign(Objects,input+'.sm1');\r
rewrite(Objects);\r
for x:=0 to RMax do write(Objects,L[x]);\r
writeln('Your present game location is now SAVED under the name ',\r
up(input),'.');\r
writeln; JUMPABORT: writeln;\r
+ { remove checking SUPERNOVA floppy disk\r
writeln('Please make sure the SUPERNOVA disk is in drive ',up(Log),':');\r
writeln;writeln;Pause;\r
- assign(DiskTest,'Nova.com');\r
+ assign(DiskTest,'Nova.com');}\r
{$I-}\r
- reset(DiskTest);\r
+ {reset(DiskTest);}\r
{$I+}\r
- if IOResult<>0 then\r
+ {if IOResult<>0 then\r
begin Col(15,15);close(DiskTest);write(^g);goto JUMPABORT;end;\r
- close(DiskTest);Col(11,7);\r
+ close(DiskTest);} Col(11,7);\r
Bor(0,0);Line:='l';\r
case Region of 4:sound(20);5:sound(60)end\r
end; { SAVE }\r
\r
-overlay procedure Restore;\r
+procedure Restore;\r
label JUMP,JUMPBACK;\r
- var DiskTest:file;\r
+ {var DiskTest:file;}\r
begin SF; JUMPBACK: nosound; for x:=1 to 25 do writeln;\r
Bor(6,7);CFlag:=Drive;Cur(2);\r
gotoxy(1,2);\r
+ { remove floppy disk selection\r
write('Which disk drive (default ',Up(Drive),':)? ');\r
- col(14,15);buflen:=1;readln(Drive);col(11,7);\r
- Drive:=upcase(Drive);if not(Drive in['A','B'])then Drive:=CFlag;\r
+ col(14,15);buflen:=1;readline(Drive);col(11,7);\r
+ Drive:=upcase(Drive);if not(Drive in['A','B'])then Drive:=CFlag;}\r
gotoxy(1,5);\r
writeln('Make sure your SAVE/RESTORE disk is in disk drive ',up(Drive),':');\r
writeln;writeln;\r
write('RESTORE from what file name (''',up('/'),''' aborts RESTORE)? ');\r
- buflen:=8;col(14,15);readln(input);col(11,7);\r
+ buflen:=8;col(14,15);readline(input);col(11,7);\r
Cur(3);\r
while pos(' ',input)>0 do delete(input,pos(' ',input),1);\r
while pos('.',input)>0 do delete(input,pos('.',input),1);\r
if length(input)=0 then input:='LASTSAVE';writeln;writeln;\r
writeln('The game file ',Up(Input),' is now being restored from drive ',\r
up(Drive),':...');\r
- input:=Drive+':'+input;\r
+ { Don't put Drive\r
+ input:=Drive+':'+input;}\r
assign(Objects,input+'.sm1');\r
{$I-}\r
reset(Objects);\r
if IOResult<>0 then\r
begin close(Objects);col(12,15);writeln;writeln;delete(input,1,2);\r
for x:=1 to length(input) do input[x]:=upcase(input[x]);\r
- Cn('The file '+input+' does not exist on your SAVE/RESTORE disk!');\r
+ wCn('The file '+input+' does not exist on your SAVE/RESTORE disk!');\r
writeln(^g);delay(2000);col(11,7);goto JUMPBACK;\r
end;\r
reset(Objects);\r
writeln('Your present game location is now RESTORED from the name ',\r
up(input),'.');\r
writeln; JUMP: writeln;\r
+ { remove checking SUPERNOVA floppy disk\r
writeln('Please make sure the SUPERNOVA disk is in drive ',up(Log),':');\r
writeln;writeln;Pause;\r
- assign(DiskTest,'Nova.com');\r
+ assign(DiskTest,'Nova.com');}\r
{$I-}\r
- reset(DiskTest);\r
+ {reset(DiskTest);}\r
{$I+}\r
- if IOResult<>0 then\r
+ {if IOResult<>0 then\r
begin Col(15,15);close(DiskTest);write(^g);goto JUMP;end;\r
- close(DiskTest);Col(11,7);\r
+ close(DiskTest);} Col(11,7);\r
Bor(0,0);\r
case Region of 4:sound(20);5:sound(60)end;\r
if Region>1 then\r
if((N1=58)or(58 in NounSet)or(N2=58))and Here(3) and Here(4) then\r
begin Cur(2);\r
repeat write('Which one, the R)usty or S)hiney key? ');\r
- read(kbd,CFlag);writeln(CFlag);writeln until upcase(CFlag) in ['R','S'];\r
+ CFlag:=Readkey;writeln(CFlag);writeln until upcase(CFlag) in ['R','S'];\r
case upcase(CFlag) of 'R':x:=3; 'S':x:=4 end;\r
if N1=58 then N1:=x;\r
if N2=58 then N2:=x;\r
if((N1=86)or(86 in NounSet)or(N2=86))and(Prm=8)then\r
begin Cur(2);\r
repeat write('Which one, the W)estern, M)iddle or E)astern table? ');\r
- read(kbd,CFlag);writeln(CFlag);\r
+ CFlag:=ReadKey;writeln(CFlag);\r
writeln until upcase(CFlag) in ['W','M','E'];\r
case upcase(CFlag) of 'W':x:=83; 'M':x:=84; 'E':x:=85 end;\r
if N1=86 then N1:=x;\r
if((N1=44)or(44 in NounSet)or(N2=44))and(Prm in[1,70])and(Vb<>28)then\r
begin Cur(2);\r
repeat write('Which one, the T)an, P)urple or C)yan button? ');\r
- read(kbd,CFlag);writeln(CFlag);\r
+ CFlag:=ReadKey;writeln(CFlag);\r
writeln until upcase(CFlag) in ['T','P','C'];\r
case upcase(CFlag) of 'T':x:=41; 'P':x:=43; 'C':x:=40 end;\r
if N1=44 then N1:=x;\r
end;\r
end; { Parser Syntax }\r
\r
-procedure MC;{WhichChar,WatchRoom,ToRoom:byte;MessageNum:Integer}\r
+procedure MC(WhichChar,WatchRoom,ToRoom:byte;MessageNum:Integer);\r
{ WhichChar refers to the character(s) being moved. }\r
{ WatchRoom is the room the player must be in to see the responce.}\r
{ ToRoom is the room the character(s) move to. }\r
SFlag:=false;\r
end;\r
\r
-procedure Van;\r
+procedure Van(o:byte);\r
begin\r
Inv:=Inv-[o];\r
r[o]:=Null;\r
projects / supernova.git / blobdiff