Beyond the Titanic 日本語版
Revision | c039746d502a489764cf82d37fdb6e8285714e77 (tree) |
---|---|
Zeit | 2019-01-06 21:20:25 |
Autor | maruhiro <maruhiro@brid...> |
Commiter | maruhiro |
翻訳
@@ -0,0 +1,4 @@ | ||
1 | +BEYOND.o | |
2 | +crt.o | |
3 | +crt.ppu | |
4 | +BEYOND.EXE |
@@ -148,7 +148,7 @@ procedure FindVerb (var input:Str80;var Word:Str16;var Verb:integer); | ||
148 | 148 | k:=k+1; |
149 | 149 | if v[r,k]=Word then |
150 | 150 | Verb:=r; |
151 | - until (v[r,k]=Q)or(k=5) | |
151 | + until (v[r,k]=Q)or(k=10) | |
152 | 152 | end; |
153 | 153 | |
154 | 154 | if(pos(' ',Word)<>0)and(Verb=Null)then |
@@ -161,7 +161,7 @@ procedure FindVerb (var input:Str80;var Word:Str16;var Verb:integer); | ||
161 | 161 | k:=k+1; |
162 | 162 | if v[r,k]=Word then |
163 | 163 | Verb:=r; |
164 | - until (v[r,k]=Q)or(k=5) | |
164 | + until (v[r,k]=Q)or(k=10) | |
165 | 165 | end |
166 | 166 | end; |
167 | 167 | delete(input,length(input),1); |
@@ -196,7 +196,7 @@ procedure FindNoun(var input:Str80;var Word:Str16;var Noun:integer); | ||
196 | 196 | k:=k+1; |
197 | 197 | if n[t,k]=Word then |
198 | 198 | Noun:=t; |
199 | - until (n[t,k]=Q)or(k=5) | |
199 | + until (n[t,k]=Q)or(k=10) | |
200 | 200 | end; |
201 | 201 | |
202 | 202 | if(pos(' ',Word)<>0)and(Noun=Null)then |
@@ -209,7 +209,7 @@ procedure FindNoun(var input:Str80;var Word:Str16;var Noun:integer); | ||
209 | 209 | k:=k+1; |
210 | 210 | if n[t,k]=Word then |
211 | 211 | Noun:=t; |
212 | - until (n[t,k]=Q)or(k=5) | |
212 | + until (n[t,k]=Q)or(k=10) | |
213 | 213 | end |
214 | 214 | end; |
215 | 215 | delete(input,length(input),1); |
@@ -77,8 +77,8 @@ var | ||
77 | 77 | Input, |
78 | 78 | Again, |
79 | 79 | Line : Str80; |
80 | - V{erb} : array [0..VMax,1..5] of Str16; | |
81 | - N{oun} : array [0..NMax,1..5] of Str16; | |
80 | + V{erb} : array [0..VMax,1..10] of Str16; | |
81 | + N{oun} : array [0..NMax,1..10] of Str16; | |
82 | 82 | R{oom} : array [0..NMax] of integer; |
83 | 83 | P{lace} : array [0..RMax] of PlayersObjects; |
84 | 84 | RmSh : set of 0..14; |
@@ -1720,7 +1720,7 @@ Case Prm of | ||
1720 | 1720 | |
1721 | 1721 | 0 :case verb of |
1722 | 1722 | 45 :MoveTo(1); |
1723 | - 44 :begin TextColor(m8);writeln('Casino Hall');TextColor(m2);RS(0)end; | |
1723 | + 44 :begin TextColor(m8);writeln('カジノホール');TextColor(m2);RS(0)end; | |
1724 | 1724 | 19,2 :if(noun in[53,6,64,73])then begin RL(0);DEAD;end; |
1725 | 1725 | 11 :if(noun=73)then RL(19); |
1726 | 1726 | end; |
@@ -1808,7 +1808,7 @@ function chr_p(c : byte) : char; | ||
1808 | 1808 | begin |
1809 | 1809 | {$ifdef ASCII_TERMINAL} |
1810 | 1810 | case (c) of |
1811 | - 175: chr_p := '>'; // as ツサ | |
1811 | + 175: chr_p := '>'; // as ≫ | |
1812 | 1812 | else |
1813 | 1813 | chr_p := chr(c); |
1814 | 1814 | end; |
@@ -156,7 +156,7 @@ procedure DescribeRm; | ||
156 | 156 | begin SA; |
157 | 157 | if((en('a'))and(here(29)))or not(Prm in [6..24])then begin |
158 | 158 | case Prm of |
159 | -0:s('Ship''s Fore');1:s('Ship Mid-Deck');2:s('Rear of Ship'); | |
159 | +0:s('船の前方');1:s('Ship Mid-Deck');2:s('Rear of Ship'); | |
160 | 160 | 3:s('Life Boat');4:s('Ocean Surface');5:s('Huge Cavern'); |
161 | 161 | 6:s('Cave of Pins');7:s('Ocean Bottom');8:s('Squeaky Cave'); |
162 | 162 | 9:s('Stream Bend');10:s('Waterfall');13:s('Sloppy Cave'); |
@@ -268,7 +268,7 @@ procedure SAVE; | ||
268 | 268 | for y:= 1 to 5 do |
269 | 269 | write(WordList,n[x,y]); |
270 | 270 | for x:= 0 to VMax do |
271 | - for y:= 1 to 5 do | |
271 | + for y:= 1 to 10 do | |
272 | 272 | write(WordList,v[x,y]); |
273 | 273 | close(WordList); |
274 | 274 | assign(Things,input+'.d'); |
@@ -338,7 +338,7 @@ procedure RESTORE; | ||
338 | 338 | for y:= 1 to 5 do |
339 | 339 | read(WordList,n[x,y]); |
340 | 340 | for x:= 0 to VMax do |
341 | - for y:= 1 to 5 do | |
341 | + for y:= 1 to 10 do | |
342 | 342 | read(WordList,v[x,y]); |
343 | 343 | close(WordList); |
344 | 344 | assign(Things,input+'.d'); |
@@ -526,24 +526,24 @@ procedure Initialize; | ||
526 | 526 | end; |
527 | 527 | begin |
528 | 528 | textcolor(15); |
529 | - writeln('Prepare to engage yourself in a most exciting adventure.'); | |
530 | - writeln('But first, two simple questions:'); | |
531 | - gotoxy(1,4);write('Are you using a COLOR screen (Y/N)? '); | |
529 | + writeln('冒険の世界へ飛び込む準備をしてください。'); | |
530 | + writeln('でも、その前に簡単な質問が2つあります:'); | |
531 | + gotoxy(1,4);write('ディスプレイはカラーですか (Y/N)? '); | |
532 | 532 | nosound; play(72,80,45); |
533 | 533 | flag := readkey; play(2500,2490,6); |
534 | 534 | m0:=20;m1:=14;m2:=11;m3:=4;m4:=15;m5:=28;m6:=1;m7:=4;m8:=10;m9:=10; |
535 | 535 | if upcase(flag)='N' then |
536 | 536 | begin |
537 | - writeln('No, I don''t have a color screen.'); | |
537 | + writeln('いいえ。カラーではありません。'); | |
538 | 538 | m0:=31;m1:=15;m2:=15;m3:=7;m4:=0;m5:=31;m6:=7;m7:=8;m8:=7;m9:=0; |
539 | - end else writeln('Yes, I do have a color screen.');writeln; | |
540 | - write('How many disk drives do you have (1/2)? '); | |
539 | + end else writeln('はい。カラーです。');writeln; | |
540 | + write('ディスクドライブはいくつありますか (1/2)? '); | |
541 | 541 | play(80,88,30); |
542 | 542 | flag := readkey; play(2500,2490,6); |
543 | 543 | Drive:='B:'; |
544 | 544 | if(upcase(flag)='O')or(flag='1')then |
545 | - begin Drive:='A:';writeln('I have ONE disk drive.')end else | |
546 | - writeln('I have TWO disk drives.'); | |
545 | + begin Drive:='A:';writeln('1つです。')end else | |
546 | + writeln('2つです。'); | |
547 | 547 | delay(999);clrscr;textcolor(15);gotoxy(1,5);writeln;textcolor(7); |
548 | 548 | cn('Beyond the Titanic');textcolor(6);cn('------------------');writeln; |
549 | 549 | textcolor(7); |
@@ -552,7 +552,7 @@ procedure Initialize; | ||
552 | 552 | cn('Written and Programmed by Scott Miller'); |
553 | 553 | textcolor(11); |
554 | 554 | gotoxy(32,24);textcolor(7); |
555 | - write('Press any key...');flag := readkey;clrscr; | |
555 | + write('キーを押してください');flag := readkey;clrscr; | |
556 | 556 | |
557 | 557 | { *** SHAREWARE SCREEN *** } |
558 | 558 |
@@ -583,7 +583,7 @@ procedure Initialize; | ||
583 | 583 | gotoxy(23,25); |
584 | 584 | delay(3000); |
585 | 585 | while keypressed do readkey; |
586 | - write('Press any key to start the game...'); | |
586 | + write('キーを押すとゲームが始まります'); | |
587 | 587 | readkey; |
588 | 588 | while keypressed do readkey; |
589 | 589 | clrscr; |
@@ -591,20 +591,18 @@ procedure Initialize; | ||
591 | 591 | Window(1,2,80,25); |
592 | 592 | gotoxy(1,24); |
593 | 593 | TextColor(m1); |
594 | -cn('APRIL 14, 1912 11:43 PM'); | |
595 | -cn('You never knew the black canvas of the night was so full'+ | |
596 | - ' of twinkling detail.'); | |
597 | -cn('Standing on deck of the White Star''s new super luxury liner, deep at sea,'); | |
598 | -cn('where the bright lights of San Francisco don''t fade the night, you'); | |
599 | -cn('can view thousands of stars you never realized existed.'); | |
600 | -cn('Looking out over the icy sea you can barely see small pieces of'+ | |
601 | - ' broken ice'); | |
602 | -cn('bobbing in the water. Rumor has it that icebergs the size of small'); | |
603 | -cn('mountains can be found in this region. You don''t feel'); | |
604 | -cn('too worried, though, the Titanic has been touted as'); | |
605 | -cn('"unsinkable," and every single passenger knows'); | |
606 | -cn('that White Star, the premier ship builder,'); | |
607 | -cn('knows their stuff...'); | |
594 | +cn('1912年4月14日 午後11時43分'); | |
595 | +cn(''); | |
596 | +cn('闇夜のカンバスがこれほど輝いていたとは。'); | |
597 | +cn('ホワイトスターの最新の豪華客船、深い海、'); | |
598 | +cn('サンフラインシスコのまばゆい光も届かないこの場所で'); | |
599 | +cn('幾千もの知られざる星々を見ていた。'); | |
600 | +cn(''); | |
601 | +cn('海に目をやると小さな氷の破片が漂っていた。'); | |
602 | +cn('このあたりには小さな山ほどの氷山が現れるとうわさだ。'); | |
603 | +cn(''); | |
604 | +cn('だが心配することはない。タイタニック号は「不沈」、'); | |
605 | +cn('一流の海運会社ホワイトスターとその船のことは乗客の誰もが信頼していた…'); | |
608 | 606 | for x:= 1 to 3 do writeln; |
609 | 607 | Line :=''; |
610 | 608 | LastNoun :=''; |
@@ -12,7 +12,7 @@ echo. | ||
12 | 12 | echo ------------------------------------------------------------------------------- |
13 | 13 | echo Compiling BEYOND.EXE ... |
14 | 14 | echo. |
15 | -ppc386 -Mtp -O3 -Xt BEYOND.PAS -oBEYOND.EXE | |
15 | +ppc386 -O3 -Xt -dASCII_TERMINAL BEYOND.PAS -oBEYOND.EXE | |
16 | 16 | |
17 | 17 | echo. |
18 | 18 | echo ------------------------------------------------------------------------------- |
@@ -12,7 +12,7 @@ echo. | ||
12 | 12 | echo ------------------------------------------------------------------------------- |
13 | 13 | echo Compiling BEYOND.EXE ... |
14 | 14 | echo. |
15 | -ppcrossx64 -Mtp -O3 -Xt BEYOND.PAS -oBEYOND.EXE | |
15 | +ppcrossx64 -O3 -Xt -dASCII_TERMINAL BEYOND.PAS -oBEYOND.EXE | |
16 | 16 | |
17 | 17 | echo. |
18 | 18 | echo ------------------------------------------------------------------------------- |
@@ -1,4 +1 @@ | ||
1 | ||
2 | - ? a9? Empty File...Empty File 2... Miller (this was written Sept. 14, 1984) 4206 Mayflower Dr. 缺 鰤?? 後 ?? ` ? 鯒 ?4? # { F鴒?N?? | |
3 | - ?a9?Empty File 2...Empty File 3... Miller (this was written Sept. 14, 1984) 4206 Mayflower Dr. 繞 ? 缺 @ 搴 ` ? 鯒 ?4? # { F鴒?N?? | |
4 | - ?a9?Empty File 3... You are flying above the dense, hazy clouds, which obscures your view of the ground. The clouds stretch in all directions as far as the eye can see. To the east is a massive city-like structure floating effortlessly in the air! You are flying above the dense, hazy clouds, which obscure your view of the ground. The clouds stretch in all directions as far as the eye can see. To the west is a massive city-like structure floating freely in the air! Tall You are flying quite close to the floating city now, which is about 200 yards away. From here you can see a network of roads and inclosed tubes within the city, forming an obvious transportation system. Strangely, though, you don't You are flying close to the north side of the floating city. From here you can see a large flat area within the buildings, roads and towers. You also see what looks like another vehicle sitting there, like the one you are flying.ying. To the west is the floating city, about 200 yards away. On this side you can easily see the raods that interlace the city. The tallest building is on this side, its shadow falls on your vehicle. You still don't see any signs of life.. The floating city-like structure is to your north. The massive towers block any view into the heart of the city, but a few large tubes circle around the outside, in some cases they travel through the towers! There's no visable way You are inside the damaged shuttle, wrecked from the slight collision with thejagged concrete to the north. A thin line of smoke is rising from the shuttle'scontrols. This is the large concrete bay. Your shuttle sits to the south, slightly bent up near the bottom. Huge towers, with interlacing tubeways, provide a panoramic view, except to the north, where you can see out into the You are in a small room with the walls lined with controls, machines, dials, and screens. There is no activity between any of them, however. The steps to the northwest lead back to the concrete bay. Another doorless passage leads This area is only a small section of a long corridor, heading both north and south. Passages exit both east and west, also. only a small section of a long corridor, heading both north and south. Passages exit both east and west, also. This area is only a small section of a long corridor, heading both north and south. Passages exit both east and west, also. only a small section of a long corridor, heading both north and south. Passages exit both east and west, also. This area is only a small section of a long corridor, heading both north and south. Passages exit both east and west, also. only a small section of a long corridor, heading both north and south. Passages exit both east and west, also. You are in a supply room filled with crates and containers--all labeled with some type of food! You see in the corner of the room where the door lies, mangled and twisted like the hatch you saw in the shuttle, both appearently ? This is an empty cabin, with no bed, no chairs or tables, and no way out! Thedoor to the north has been lock and chained from the outside!chairs or tables, and no way out! Thedoor to the north has been lock and chained from the outside! | |
\ No newline at end of file | ||
1 | ||
\ No newline at end of file |
@@ -33,7 +33,7 @@ | ||
33 | 33 | {VERB LIST: GROUPS ALL SYNONYMS} |
34 | 34 | procedure Assign1; |
35 | 35 | begin |
36 | -for x:= 0 to VMax do for y:= 1 to 5 do v[x,y]:=Q; | |
36 | +for x:= 0 to VMax do for y:= 1 to 10 do v[x,y]:=Q; | |
37 | 37 | v[0,1]:='attack'; v[0,2]:='kill';v[0,3]:='beat up'; |
38 | 38 | v[1,1]:='descrip';v[1,2]:='rd';v[1,3]:='r d'; |
39 | 39 | v[2,1]:='climb';v[2,2]:='climb on';v[2,3]:='climb onto';v[2,4]:='climb in'; |
@@ -71,6 +71,7 @@ v[19,1]:='jump';v[19,2]:='jump onto';v[19,3]:='jump on';v[19,4]:='jump off'; | ||
71 | 71 | v[19,5]:='jump in'; |
72 | 72 | v[20,1]:='launch';v[20,2]:='sail';v[20,3]:='row'; |
73 | 73 | v[22,1]:='look';v[22,2]:='l';v[22,3]:='look around';v[22,4]:='ex area'; |
74 | +v[22,5]:='見る';v[22,6]:='みる'; | |
74 | 75 | v[23,1]:='look above';v[23,2]:='ex on';v[23,3]:='look on'; |
75 | 76 | v[23,4]:='ex top';v[23,5]:='ex above'; |
76 | 77 | v[24,1]:='look in';v[24,2]:='ex in';v[24,3]:='look down';v[24,4]:='look up'; |
@@ -106,16 +107,26 @@ v[40,1]:='unlock'; | ||
106 | 107 | v[41,1]:='wait';v[41,2]:='z';v[41,3]:='rest'; |
107 | 108 | v[42,1]:='wear';v[42,2]:='put on'; |
108 | 109 | v[43,1]:='north';v[43,2]:='n';v[43,3]:='fore';v[43,4]:='f';v[43,5]:='across'; |
110 | + v[43,6]:='北';v[43,7]:='きた'; | |
109 | 111 | v[44,1]:='south';v[44,2]:='s';v[44,3]:='aft';v[44,4]:='a'; |
112 | + v[44,5]:='南';v[44,6]:='みなみ'; | |
110 | 113 | v[45,1]:='east';v[45,2]:='e';v[45,3]:='starboa';v[45,4]:='st'; |
114 | + v[45,5]:='東';v[45,6]:='ひがし'; | |
111 | 115 | v[46,1]:='west';v[46,2]:='w';v[46,3]:='port';v[46,4]:='p'; |
116 | + v[46,5]:='西';v[46,6]:='にし'; | |
112 | 117 | v[47,1]:='north east';v[47,2]:='ne';v[47,3]:='northea'; |
118 | + v[47,4]:='北東';v[47,5]:='ほくとう'; | |
113 | 119 | v[48,1]:='north west';v[48,2]:='nw';v[48,3]:='northwe'; |
120 | + v[48,4]:='北西';v[48,5]:='ほくせい'; | |
114 | 121 | v[49,1]:='south east';v[49,2]:='se';v[49,3]:='southea'; |
122 | + v[49,4]:='南東';v[49,5]:='なんとう'; | |
115 | 123 | v[50,1]:='south west';v[50,2]:='sw';v[50,3]:='southwe'; |
124 | + v[50,4]:='南西';v[50,5]:='なんせい'; | |
116 | 125 | v[51,1]:='up';v[51,2]:='u';v[51,3]:='climb up';v[51,4]:='climb u'; |
126 | + v[51,5]:='上';v[51,6]:='うえ'; | |
117 | 127 | v[52,1]:='down';v[52,2]:='d';v[52,3]:='climb down';v[52,4]:='climb d'; |
118 | 128 | v[52,5]:='lower'; |
129 | + v[52,6]:='下';v[52,7]:='した'; | |
119 | 130 | v[53,1]:='type';v[53,2]:='type in'; |
120 | 131 | v[54,1]:='quit';v[54,2]:='stop';v[54,3]:='give up';v[54,4]:='i quit'; |
121 | 132 | v[55,1]:='take off';v[55,2]:='remove'; |
@@ -140,7 +151,7 @@ v[65,1]:='restore';v[65,2]:='resume'; | ||
140 | 151 | |
141 | 152 | {NOUN LIST: GROUPS ALL OBJECTS} |
142 | 153 | |
143 | -for x:= 0 to NMax do for y:= 1 to 5 do n[x,y]:=Q; | |
154 | +for x:= 0 to NMax do for y:= 1 to 10 do n[x,y]:=Q; | |
144 | 155 | n[0,1]:='alien';n[0,2]:='dead alien';n[0,3]:='body';n[0,4]:='alien body'; |
145 | 156 | n[1,1]:='all';n[1,2]:='everyth';n[1,3]:='object';n[1,4]:='objects'; |
146 | 157 | n[2,1]:='banana';n[2,2]:='food'; |
@@ -0,0 +1,417 @@ | ||
1 | +{$ifdef WIN32} | |
2 | + | |
3 | +unit crt; | |
4 | + | |
5 | +interface | |
6 | + | |
7 | +type | |
8 | + tcrtcoord = 1..255; | |
9 | + | |
10 | +procedure AssignCrt(var F: Text); | |
11 | +procedure ClrEol; | |
12 | +procedure ClrScr; | |
13 | +procedure cursorbig; | |
14 | +procedure cursoroff; | |
15 | +procedure cursoron; | |
16 | +procedure Delay(MS: WORD); | |
17 | +procedure DelLine; | |
18 | +procedure GotoXY(X: tcrtcoord; Y: tcrtcoord); | |
19 | +procedure HighVideo; | |
20 | +procedure InsLine; | |
21 | +function KeyPressed: Boolean; | |
22 | +procedure LowVideo; | |
23 | +procedure NormVideo; | |
24 | +procedure NoSound; | |
25 | +function ReadKey: Char; | |
26 | +procedure Sound(Hz: Word); | |
27 | +procedure TextBackground(Color: Byte); | |
28 | +procedure TextColor(Color: Byte); | |
29 | +procedure TextMode(Mode: WORD); | |
30 | +function WhereX: tcrtcoord; | |
31 | +function WhereY: tcrtcoord; | |
32 | +procedure Window(X1: Byte; Y1: Byte; X2: Byte; Y2: Byte); | |
33 | + | |
34 | +implementation | |
35 | + | |
36 | +uses | |
37 | + Sysutils, | |
38 | + Strings, | |
39 | + Windows; | |
40 | + | |
41 | +const | |
42 | + WIDTH = 80; | |
43 | + HEIGHT = 26; | |
44 | + SPACE = ' '; | |
45 | + | |
46 | +var | |
47 | + output: Handle; | |
48 | + input: Handle; | |
49 | + wx: Longint; | |
50 | + wy: Longint; | |
51 | + fore_color: WORD; | |
52 | + back_color: WORD; | |
53 | + last_key: Char; | |
54 | + | |
55 | +procedure AssignCrt(var F: Text); | |
56 | +begin | |
57 | +end; | |
58 | + | |
59 | +procedure ClrEol; | |
60 | +var | |
61 | + info: TConsoleScreenBufferinfo; | |
62 | + n: DWORD; | |
63 | +begin | |
64 | + GetConsoleScreenBufferInfo(output, info); | |
65 | + WriteConsoleOutputCharacter(output, SPACE, WIDTH - info.dwCursorPosition.X, info.dwCursorPosition, n); | |
66 | + SetConsoleCursorPosition(output, info.dwCursorPosition); | |
67 | +end; | |
68 | + | |
69 | +procedure ClrScr; | |
70 | +var | |
71 | + info: TConsoleScreenBufferinfo; | |
72 | + written: DWORD; | |
73 | + xy: Coord; | |
74 | +begin | |
75 | + xy.x := 0; | |
76 | + xy.y := 0; | |
77 | + | |
78 | + GetConsoleScreenBufferInfo(output, info); | |
79 | + FillConsoleOutputCharacter(output, Char(' '), info.dwSize.X * info.dwSize.Y, xy, written); | |
80 | + FillConsoleOutputAttribute(output, info.wAttributes, info.dwSize.X * info.dwSize.Y, xy, written); | |
81 | + GotoXY(1, 1); | |
82 | +end; | |
83 | + | |
84 | +procedure cursorbig; | |
85 | +begin | |
86 | +end; | |
87 | + | |
88 | +procedure cursoroff; | |
89 | +var | |
90 | + info: CONSOLE_CURSOR_INFO; | |
91 | +begin | |
92 | + GetConsoleCursorInfo(output, info); | |
93 | + info.bVisible := false; | |
94 | + SetConsoleCursorInfo(output, info); | |
95 | +end; | |
96 | + | |
97 | +procedure cursoron; | |
98 | +var | |
99 | + info: CONSOLE_CURSOR_INFO; | |
100 | +begin | |
101 | + GetConsoleCursorInfo(output, info); | |
102 | + info.bVisible := true; | |
103 | + SetConsoleCursorInfo(output, info); | |
104 | +end; | |
105 | + | |
106 | +procedure Delay(MS: Word); | |
107 | +begin | |
108 | +{ | |
109 | + Sleep(MS); | |
110 | +} | |
111 | +end; | |
112 | + | |
113 | +procedure DelLine; | |
114 | +var | |
115 | + info: TConsoleScreenBufferinfo; | |
116 | + rect: SMALL_RECT; | |
117 | + clip: SMALL_RECT; | |
118 | + xy: Coord; | |
119 | + c: CHAR_INFO; | |
120 | +begin | |
121 | + GetConsoleScreenBufferInfo(output, info); | |
122 | + rect.Left := 0; | |
123 | + rect.Top := info.dwCursorPosition.Y + 1; | |
124 | + rect.Right := WIDTH - 1; | |
125 | + rect.Bottom := HEIGHT - 1; | |
126 | + clip.Left := 0; | |
127 | + clip.Top := 0; | |
128 | + clip.Right := WIDTH - 1; | |
129 | + clip.Bottom := HEIGHT - 1; | |
130 | + xy.x := 0; | |
131 | + xy.y := info.dwCursorPosition.Y; | |
132 | + c.Attributes := 0; | |
133 | + | |
134 | + ScrollConsoleScreenBuffer(output, rect, clip, xy, c); | |
135 | +end; | |
136 | + | |
137 | +procedure GotoXY(X: tcrtcoord; Y: tcrtcoord); | |
138 | +var | |
139 | + xy: Coord; | |
140 | +begin | |
141 | + xy.x := X + wx - 1; | |
142 | + xy.y := Y + wy - 1; | |
143 | + | |
144 | + SetConsoleCursorPosition(output, xy); | |
145 | +end; | |
146 | + | |
147 | +procedure HighVideo; | |
148 | +begin | |
149 | +end; | |
150 | + | |
151 | +procedure InsLine; | |
152 | +var | |
153 | + info: TConsoleScreenBufferinfo; | |
154 | + rect: SMALL_RECT; | |
155 | + clip: SMALL_RECT; | |
156 | + xy: Coord; | |
157 | + c: CHAR_INFO; | |
158 | +begin | |
159 | + GetConsoleScreenBufferInfo(output, info); | |
160 | + rect.Left := 0; | |
161 | + rect.Top := info.dwCursorPosition.Y; | |
162 | + rect.Right := WIDTH - 1; | |
163 | + rect.Bottom := HEIGHT - 1; | |
164 | + clip.Left := 0; | |
165 | + clip.Top := 0; | |
166 | + clip.Right := WIDTH - 1; | |
167 | + clip.Bottom := HEIGHT - 1; | |
168 | + xy.x := 0; | |
169 | + xy.y := info.dwCursorPosition.Y + 1; | |
170 | + c.Attributes := 0; | |
171 | + | |
172 | + ScrollConsoleScreenBuffer(output, rect, clip, xy, c); | |
173 | +end; | |
174 | + | |
175 | +function KeyPressed: Boolean; | |
176 | +begin | |
177 | + Sleep(1); | |
178 | + | |
179 | + last_key := #0; | |
180 | + | |
181 | + if((GetAsyncKeyState(VK_BACK) and $8000) <> 0) then last_key := #$08; | |
182 | + if((GetAsyncKeyState(VK_TAB) and $8000) <> 0) then last_key := #$09; | |
183 | + if((GetAsyncKeyState(VK_RETURN) and $8000) <> 0) then last_key := #$13; | |
184 | + if((GetAsyncKeyState(VK_SPACE) and $8000) <> 0) then last_key := ' '; | |
185 | + if((GetAsyncKeyState(VK_0) and $8000) <> 0) then last_key := '0'; | |
186 | + if((GetAsyncKeyState(VK_1) and $8000) <> 0) then last_key := '1'; | |
187 | + if((GetAsyncKeyState(VK_2) and $8000) <> 0) then last_key := '2'; | |
188 | + if((GetAsyncKeyState(VK_3) and $8000) <> 0) then last_key := '3'; | |
189 | + if((GetAsyncKeyState(VK_4) and $8000) <> 0) then last_key := '4'; | |
190 | + if((GetAsyncKeyState(VK_5) and $8000) <> 0) then last_key := '5'; | |
191 | + if((GetAsyncKeyState(VK_6) and $8000) <> 0) then last_key := '6'; | |
192 | + if((GetAsyncKeyState(VK_7) and $8000) <> 0) then last_key := '7'; | |
193 | + if((GetAsyncKeyState(VK_8) and $8000) <> 0) then last_key := '8'; | |
194 | + if((GetAsyncKeyState(VK_9) and $8000) <> 0) then last_key := '9'; | |
195 | + if((GetAsyncKeyState(VK_A) and $8000) <> 0) then last_key := 'A'; | |
196 | + if((GetAsyncKeyState(VK_B) and $8000) <> 0) then last_key := 'B'; | |
197 | + if((GetAsyncKeyState(VK_C) and $8000) <> 0) then last_key := 'C'; | |
198 | + if((GetAsyncKeyState(VK_D) and $8000) <> 0) then last_key := 'D'; | |
199 | + if((GetAsyncKeyState(VK_E) and $8000) <> 0) then last_key := 'E'; | |
200 | + if((GetAsyncKeyState(VK_F) and $8000) <> 0) then last_key := 'F'; | |
201 | + if((GetAsyncKeyState(VK_G) and $8000) <> 0) then last_key := 'G'; | |
202 | + if((GetAsyncKeyState(VK_H) and $8000) <> 0) then last_key := 'H'; | |
203 | + if((GetAsyncKeyState(VK_I) and $8000) <> 0) then last_key := 'I'; | |
204 | + if((GetAsyncKeyState(VK_J) and $8000) <> 0) then last_key := 'J'; | |
205 | + if((GetAsyncKeyState(VK_K) and $8000) <> 0) then last_key := 'K'; | |
206 | + if((GetAsyncKeyState(VK_L) and $8000) <> 0) then last_key := 'L'; | |
207 | + if((GetAsyncKeyState(VK_M) and $8000) <> 0) then last_key := 'M'; | |
208 | + if((GetAsyncKeyState(VK_N) and $8000) <> 0) then last_key := 'N'; | |
209 | + if((GetAsyncKeyState(VK_O) and $8000) <> 0) then last_key := 'O'; | |
210 | + if((GetAsyncKeyState(VK_P) and $8000) <> 0) then last_key := 'P'; | |
211 | + if((GetAsyncKeyState(VK_Q) and $8000) <> 0) then last_key := 'Q'; | |
212 | + if((GetAsyncKeyState(VK_R) and $8000) <> 0) then last_key := 'R'; | |
213 | + if((GetAsyncKeyState(VK_S) and $8000) <> 0) then last_key := 'S'; | |
214 | + if((GetAsyncKeyState(VK_T) and $8000) <> 0) then last_key := 'T'; | |
215 | + if((GetAsyncKeyState(VK_U) and $8000) <> 0) then last_key := 'U'; | |
216 | + if((GetAsyncKeyState(VK_V) and $8000) <> 0) then last_key := 'V'; | |
217 | + if((GetAsyncKeyState(VK_W) and $8000) <> 0) then last_key := 'W'; | |
218 | + if((GetAsyncKeyState(VK_X) and $8000) <> 0) then last_key := 'X'; | |
219 | + if((GetAsyncKeyState(VK_Y) and $8000) <> 0) then last_key := 'Y'; | |
220 | + if((GetAsyncKeyState(VK_Z) and $8000) <> 0) then last_key := 'Z'; | |
221 | + if((GetAsyncKeyState(VK_NUMPAD0) and $8000) <> 0) then last_key := '0'; | |
222 | + if((GetAsyncKeyState(VK_NUMPAD1) and $8000) <> 0) then last_key := '1'; | |
223 | + if((GetAsyncKeyState(VK_NUMPAD2) and $8000) <> 0) then last_key := '2'; | |
224 | + if((GetAsyncKeyState(VK_NUMPAD3) and $8000) <> 0) then last_key := '3'; | |
225 | + if((GetAsyncKeyState(VK_NUMPAD4) and $8000) <> 0) then last_key := '4'; | |
226 | + if((GetAsyncKeyState(VK_NUMPAD5) and $8000) <> 0) then last_key := '5'; | |
227 | + if((GetAsyncKeyState(VK_NUMPAD6) and $8000) <> 0) then last_key := '6'; | |
228 | + if((GetAsyncKeyState(VK_NUMPAD7) and $8000) <> 0) then last_key := '7'; | |
229 | + if((GetAsyncKeyState(VK_NUMPAD8) and $8000) <> 0) then last_key := '8'; | |
230 | + if((GetAsyncKeyState(VK_NUMPAD9) and $8000) <> 0) then last_key := '9'; | |
231 | + if((GetAsyncKeyState(VK_MULTIPLY) and $8000) <> 0) then last_key := '*'; | |
232 | + if((GetAsyncKeyState(VK_ADD) and $8000) <> 0) then last_key := '+'; | |
233 | + if((GetAsyncKeyState(VK_SUBTRACT) and $8000) <> 0) then last_key := '-'; | |
234 | + if((GetAsyncKeyState(VK_DECIMAL) and $8000) <> 0) then last_key := '/'; | |
235 | + if((GetAsyncKeyState(VK_DIVIDE) and $8000) <> 0) then last_key := '.'; | |
236 | + | |
237 | + keyPressed := (last_key <> #0); | |
238 | +end; | |
239 | + | |
240 | +procedure LowVideo; | |
241 | +begin | |
242 | +end; | |
243 | + | |
244 | +procedure NormVideo; | |
245 | +begin | |
246 | +end; | |
247 | + | |
248 | +procedure NoSound; | |
249 | +begin | |
250 | +end; | |
251 | + | |
252 | +function ReadKey: Char; | |
253 | +var | |
254 | + buf: Pchar; | |
255 | + n: DWORD; | |
256 | +begin | |
257 | + if (last_key <> #0) then | |
258 | + begin | |
259 | + ReadKey := last_key; | |
260 | + last_key := #0; | |
261 | + FlushConsoleInputBuffer(input); | |
262 | + exit; | |
263 | + end; | |
264 | + | |
265 | + SetConsoleMode(input, ENABLE_PROCESSED_INPUT); | |
266 | + buf := stralloc(8); | |
267 | + ReadConsole(input, buf, 1, n, nil); | |
268 | + ReadKey := String(buf)[1]; | |
269 | + strdispose(buf); | |
270 | + SetConsoleMode(input, ENABLE_PROCESSED_INPUT or ENABLE_LINE_INPUT or ENABLE_ECHO_INPUT); | |
271 | +end; | |
272 | + | |
273 | +procedure Sound(Hz: Word); | |
274 | +begin | |
275 | +end; | |
276 | + | |
277 | +procedure TextBackground(Color: Byte); | |
278 | +begin | |
279 | + case Color of | |
280 | + 0: fore_color := 0; | |
281 | + 1: fore_color := BACKGROUND_BLUE; | |
282 | + 2: fore_color := BACKGROUND_GREEN; | |
283 | + 3: fore_color := BACKGROUND_BLUE or BACKGROUND_GREEN; | |
284 | + 4: fore_color := BACKGROUND_RED; | |
285 | + 5: fore_color := BACKGROUND_RED or BACKGROUND_BLUE; | |
286 | + 6: fore_color := BACKGROUND_RED or BACKGROUND_GREEN; | |
287 | + 7: fore_color := BACKGROUND_RED or BACKGROUND_BLUE or BACKGROUND_GREEN; | |
288 | + 8: fore_color := BACKGROUND_INTENSITY; | |
289 | + 9: fore_color := BACKGROUND_INTENSITY or BACKGROUND_BLUE; | |
290 | + 10: fore_color := BACKGROUND_INTENSITY or BACKGROUND_GREEN; | |
291 | + 11: fore_color := BACKGROUND_INTENSITY or BACKGROUND_BLUE or BACKGROUND_GREEN; | |
292 | + 12: fore_color := BACKGROUND_INTENSITY or BACKGROUND_RED; | |
293 | + 13: fore_color := BACKGROUND_INTENSITY or BACKGROUND_RED or BACKGROUND_BLUE; | |
294 | + 14: fore_color := BACKGROUND_INTENSITY or BACKGROUND_RED or BACKGROUND_GREEN; | |
295 | + 15: fore_color := BACKGROUND_INTENSITY or BACKGROUND_RED or BACKGROUND_BLUE or BACKGROUND_GREEN; | |
296 | + else exit; | |
297 | + end; | |
298 | + | |
299 | + SetConsoleTextAttribute(output, fore_color or back_color); | |
300 | +end; | |
301 | + | |
302 | +procedure TextColor(Color: Byte); | |
303 | +begin | |
304 | + case Color of | |
305 | + 0: back_color := 0; | |
306 | + 1: back_color := FOREGROUND_BLUE; | |
307 | + 2: back_color := FOREGROUND_GREEN; | |
308 | + 3: back_color := FOREGROUND_BLUE or FOREGROUND_GREEN; | |
309 | + 4: back_color := FOREGROUND_RED; | |
310 | + 5: back_color := FOREGROUND_RED or FOREGROUND_BLUE; | |
311 | + 6: back_color := FOREGROUND_RED or FOREGROUND_GREEN; | |
312 | + 7: back_color := FOREGROUND_RED or FOREGROUND_BLUE or FOREGROUND_GREEN; | |
313 | + 8: back_color := FOREGROUND_INTENSITY; | |
314 | + 9: back_color := FOREGROUND_INTENSITY or FOREGROUND_BLUE; | |
315 | + 10: back_color := FOREGROUND_INTENSITY or FOREGROUND_GREEN; | |
316 | + 11: back_color := FOREGROUND_INTENSITY or FOREGROUND_BLUE or FOREGROUND_GREEN; | |
317 | + 12: back_color := FOREGROUND_INTENSITY or FOREGROUND_RED; | |
318 | + 13: back_color := FOREGROUND_INTENSITY or FOREGROUND_RED or FOREGROUND_BLUE; | |
319 | + 14: back_color := FOREGROUND_INTENSITY or FOREGROUND_RED or FOREGROUND_GREEN; | |
320 | + 15: back_color := FOREGROUND_INTENSITY or FOREGROUND_RED or FOREGROUND_BLUE or FOREGROUND_GREEN; | |
321 | + else exit; | |
322 | + end; | |
323 | + | |
324 | + SetConsoleTextAttribute(output, fore_color or back_color); | |
325 | +end; | |
326 | + | |
327 | +procedure TextMode(Mode: WORD); | |
328 | +begin | |
329 | +end; | |
330 | + | |
331 | +function WhereX: tcrtcoord; | |
332 | +var | |
333 | + info: TConsoleScreenBufferinfo; | |
334 | +begin | |
335 | + GetConsoleScreenBufferInfo(output, info); | |
336 | + WhereX := info.dwCursorPosition.X - wx + 1; | |
337 | +end; | |
338 | + | |
339 | +function WhereY: tcrtcoord; | |
340 | +var | |
341 | + info: TConsoleScreenBufferinfo; | |
342 | +begin | |
343 | + GetConsoleScreenBufferInfo(output, info); | |
344 | + WhereY := info.dwCursorPosition.Y - wy + 1; | |
345 | +end; | |
346 | + | |
347 | +procedure Window(X1: Byte; Y1: Byte; X2: Byte; Y2: Byte); | |
348 | +begin | |
349 | + wx := X1 - 1; | |
350 | + wy := Y1 - 1; | |
351 | + GotoXY(1, 1); | |
352 | +end; | |
353 | + | |
354 | +procedure init; | |
355 | +var | |
356 | + xy: Coord; | |
357 | + r: SMALL_RECT; | |
358 | +begin | |
359 | + output := GetStdHandle(STD_OUTPUT_HANDLE); | |
360 | + input := GetStdHandle(STD_INPUT_HANDLE); | |
361 | + SetConsoleMode(output, ENABLE_PROCESSED_OUTPUT or ENABLE_WRAP_AT_EOL_OUTPUT); | |
362 | + SetConsoleMode(input, ENABLE_PROCESSED_INPUT or ENABLE_LINE_INPUT or ENABLE_ECHO_INPUT); | |
363 | + | |
364 | + xy.x := WIDTH; | |
365 | + xy.y := HEIGHT; | |
366 | + SetConsoleScreenBufferSize(output, xy); | |
367 | + | |
368 | + r.Top := 0; | |
369 | + r.Left := 0; | |
370 | + r.Right := WIDTH - 1; | |
371 | + r.Bottom := HEIGHT - 1; | |
372 | + SetConsoleWindowInfo(output, true, r); | |
373 | + | |
374 | + back_color := 0; | |
375 | + fore_color := 0; | |
376 | + TextBackground(0); | |
377 | + TextColor(7); | |
378 | + | |
379 | + last_key := #0; | |
380 | +end; | |
381 | + | |
382 | +initialization | |
383 | + init; | |
384 | + | |
385 | +finalization | |
386 | + TextBackground(0); | |
387 | + TextColor(7); | |
388 | +end. | |
389 | + | |
390 | +{$endif} | |
391 | + | |
392 | +{ | |
393 | + Copyright 2019 maruhiro | |
394 | + All rights reserved. | |
395 | + | |
396 | + Redistribution and use in source and binary forms, | |
397 | + with or without modification, are permitted provided that | |
398 | + the following conditions are met: | |
399 | + | |
400 | + 1. Redistributions of source code must retain the above copyright notice, | |
401 | + this list of conditions and the following disclaimer. | |
402 | + | |
403 | + 2. Redistributions in binary form must reproduce the above copyright notice, | |
404 | + this list of conditions and the following disclaimer in the documentation | |
405 | + and/or other materials provided with the distribution. | |
406 | + | |
407 | + THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, | |
408 | + INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND | |
409 | + FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL | |
410 | + THE REGENTS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, | |
411 | + SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, | |
412 | + PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; | |
413 | + OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, | |
414 | + WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR | |
415 | + OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF | |
416 | + ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. | |
417 | +} |