diff options
| author | Igor Pashev <pashev.igor@gmail.com> | 2023-01-10 11:57:24 +0200 |
|---|---|---|
| committer | Igor Pashev <pashev.igor@gmail.com> | 2023-01-10 13:33:44 +0200 |
| commit | caa0c6b7ffd3cefe21fbb10e642fdc4bf0dacf1b (patch) | |
| tree | 62b2f3334eb8db2de88ac7c73065b453dbc212c2 | |
| download | tower-caa0c6b7ffd3cefe21fbb10e642fdc4bf0dacf1b.tar.gz | |
Оригинальная версия 1997 года
| -rw-r--r-- | tower-orig.pas | 231 |
1 files changed, 231 insertions, 0 deletions
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.
+
+
+
+
+
+
+
+
+
|