From caa0c6b7ffd3cefe21fbb10e642fdc4bf0dacf1b Mon Sep 17 00:00:00 2001 From: Igor Pashev Date: Tue, 10 Jan 2023 11:57:24 +0200 Subject: Оригинальная версия 1997 года MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- tower-orig.pas | 231 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 231 insertions(+) create mode 100644 tower-orig.pas diff --git a/tower-orig.pas b/tower-orig.pas new file mode 100644 index 0000000..42fbdb3 --- /dev/null +++ b/tower-orig.pas @@ -0,0 +1,231 @@ +PROGRAM Hanoi_Tower; {$B-} +USES Crt; +VAR n,h,flag:BYTE; + + q,mq,z,r,t:INTEGER; + allrings,k:BOOLEAN; + hp: ARRAY [1..3] OF BYTE; + rings:ARRAY [1..9] OF STRING [20]; + heaps:ARRAY [1..3,0..9] OF BYTE; +CONST m: ARRAY [3..9] OF STRING [46] = + ('.', ' !', ' !!', + ' - !', + ' , ?', + ' !! !!!', + ' !!!'); +LABEL BEGINNING_OF_MAIN_BLOC; +Procedure cancel; + begin + flag:=11; + end; +PROCEDURE Title; +BEGIN + WHILE KeyPressed DO ReadKey; + n:=3;flag:=29; + TextMode(C40); + TextBackground(lightgray);clrscr; + Window(1,1,40,25); + TextColor(lightgreen); + Write('ͻ'); + GotoXY(1,24);Write(''); + FOR z:=2 TO 23 DO + BEGIN + GotoXY(1,z);Write(''); + GotoXY(40,z);Write(''); + END; + textcolor(white); + GotoXY(12,17);Write(':.襢,11'); + GotoXY(15,18);Write('ம'); + TextBackground(black); + window (12,8,30,14);clrscr; + TextBackground(lightgray);TextColor(Magenta); + Window(11,7,29,13);ClrScr; + GotoXY(2,2);Write(' '); + GotoXY(6,6);Write (' '); + window(1,1,40,25); + TextBackground(green); + GotoXY(2,25); + Write(' - 1997- '); + REPEAT + z:=Ord(ReadKey); + CASE z OF + + 120:IF n>3 THEN Dec(n); + 105:IF n<8 THEN Inc(n); + 27: halt; + END; + UNTIL z=13; + TextMode(C80); +END; +PROCEDURE Prepare; +Procedure maxq; + begin + mq:=1; + for z:=1 to n do + mq:=mq*2; + mq:=mq-1; + end; +BEGIN + ClrScr; k:=FALSE;flag:=29; + hp[1]:=n; hp[2]:=0; hp[3]:=0; h:=1; + allrings:=FALSE; MAXQ; q:=0; + TextColor(Yellow); + WriteLN('ᨬ쭮 ᫮ ४뢠: ',mq); + Write(' ४뢠: '); + TextColor(White);Write(q); + TextColor(LightCyan); + GotoXY(1,20); + Write('', + '', + ''); + t:=17-n; + FOR z:=n DOWNTO 1 DO + BEGIN + rings[n-z+1]:=''; + FOR r:=1 TO 10-z DO + rings[n-z+1] := rings[n-z+1] + #32; + FOR r := 1 TO 2 * z DO + rings[n-z+1] := rings[n-z+1] + ''; + FOR r:=1 TO 10-z DO + rings[n-z+1] := rings[n-z+1] + #32; + END; + TextColor(White); + GotoXY(16,21);Write(''); + FOR z:=1 TO n DO + BEGIN + GotoXY(7,20-z); + Write(rings[z]); + heaps[1,z]:=z; + END; +END; +PROCEDURE Playing; + VAR h2:BYTE; + CONST spc=' ';{ 19 ஡} +Procedure LevelComplete; + begin + FOR z:=0 TO 31 DO + BEGIN + Sound(100+z*28);Delay(20);NoSound;Delay(40-z); + END; + GotoXY(1,4);Write(m[n]); + allrings:=TRUE; + GotoXY(1,5);Write(' ""'); + IF n=9 THEN flag:=1 + ELSE Inc(n); + Delay(500); + end; +PROCEDURE Go_to_heap (x:SHORTINT); +BEGIN + IF (x < 1) OR (x > 3) THEN EXIT; + GotoXY((h-1)*24+16,21);Write(#32); + h:=x; + GotoXY((h-1)*24+16,21);Write(''); +END; +PROCEDURE up; +BEGIN + IF hp[h]=0 THEN BEGIN + Write(#7); + Exit; + END; + k:=TRUE; + FOR z:=19-hp[h] DOWNTO t DO + BEGIN + GotoXY((h-1) * 24 + 7, z + 1); Write(spc); + GotoXY((h-1) * 24 + 7, z);Write(rings [heaps [h,hp [h]]]); + Delay(40); + END; + h2:=h; +END; +PROCEDURE down; +BEGIN + IF heaps[h2,hp[h2]]>heaps[h,hp[h]] THEN BEGIN + Write(#7); + Exit; + END; + IF h2<>h THEN BEGIN + Inc(hp[h2]); + heaps[h2,hp[h2]]:=heaps[h,hp[h]]; + END; + FOR z:=t TO 19-hp[h2] DO + BEGIN + GotoXY((h2-1)*24+7,z);Write(spc); + GotoXY((h2-1)*24+7,z+1);Write(rings[heaps[h,hp[h]]]); + Delay(40); + END; + Sound(100);Delay(200);NoSound; + k:=FALSE; + IF h2<>h THEN Dec(hp[h]); + IF NOT (allrings) AND (h2<>h) THEN BEGIN + Inc(q); GotoXY(25,2); Write(q); + END; +END; +PROCEDURE right; +BEGIN + IF h2=3 THEN Exit; + FOR z:=(h2-1)*24+8 TO 24*h2+7 DO + BEGIN + GotoXY(z,t);Write(rings[heaps[h,hp[h]]]); + Delay(6); + END; + Inc(h2); +END; +PROCEDURE Left; +BEGIN + IF h2=1 THEN Exit; + FOR z:=(h2-1)*24+6 DOWNTO 24*(h2-2)+7 DO + BEGIN + GotoXY(z,t); + Write(rings[heaps[h,hp[h]]]); + Delay(6); + END; + Dec(h2); +END; +BEGIN + REPEAT + CASE ReadKey OF + 'H':IF NOT k THEN Up; + 'P':IF k THEN Down; + 'M':IF k THEN Right + ELSE Go_to_heap(h + 1); + 'K':IF k THEN Left + ELSE Go_to_heap(h - 1); + #27:Cancel; + #32, #13:IF allrings THEN flag:=0; + ELSE CONTINUE; + END; + IF q>mq THEN flag:=2 ELSE IF (hp[3]=n) AND NOT allrings THEN LevelComplete; + UNTIL flag<>29; +END; +PROCEDURE BadLuck; +BEGIN + FOR z:=31 DOWNTO 0 DO + BEGIN + Sound(100+z*28); Delay(50); NoSound; Delay(80-z*2); + END; + GotoXY(30,20);Write(' ! '); + Delay(2500); +END; + BEGIN {᭮ } + + CheckBreak:=FALSE; + heaps[1,0]:=0; heaps[2,0]:=0; heaps[3,0]:=0; +BEGINNING_OF_MAIN_BLOC: + Title; + REPEAT + Prepare; + port[$3d4]:=10; + port[$3d5]:=191; + Playing; + UNTIL flag<>0; + if flag=2 then BadLuck; +GOTO BEGINNING_OF_MAIN_BLOC; +END. + + + + + + + + + -- cgit v1.2.3