Tugas Kuliah - Animasi Hurup

Script progam ini masih dalam perbaikan, sampai diterbitkan masih terdapat beberapa kesalahan. Sudah lama tidak pernah menggunakan bahasa Pascal jadi lumayan harus mengingat ingat kembali.

Saya mempelajari Bahasa Pascal sekitar tahun 1999 dan baru kali ini membuka kembali lembaran ingatan masa lalu.

uses wincrt;
Const
Max=200;
type
PKar = ^RecKar;
RecKar = Record
Kar : Char;
Next : PKar;
end;
Var
Jml : byte;
Head, Tail, Now : Pkar;

Procedure Push(Ch:Char);
begin
New(Now);
if Head=Nil Then
Head:=Now
else
Tail^.Next:=Now;
Tail:=Now;
Tail^.Next:=Nil;
Now^.kar:=Ch;
end;

Procedure Pop;
Begin
Now:=Tail;
While (Tail^.next<>Now) And (Tail<>nil) do Tail:=Tail^.Next;
Dispose(Now);
Dec(Jml);
if Tail=Nil then Head:=Nil;
end;

Procedure Input;
Var
i:byte;
Kal:String[50];
begin
clrscr;
Jml:=1;
write('Masukan Karakter= ');
readln(Kal);
if Kal <>'' then
for i:= 1 to length(Kal) do
begin
Push(Kal[i]);
inc(Jml);
end
else
exit;
end;

Procedure Anim;
Var
ch:char;
x,y,i,Tx,Ty:byte;

Procedure Gerak;
begin
Repeat
if (y=1) and (x<>1) then
begin
dec(x);
gotoxy(x,y);
write(Now^.Kar);
end
else if (x<>80) and (y=24) then
begin
inc(x);
gotoxy(x,y);
write(Now^.Kar);
end
else if x=80 then
begin
dec(y);
gotoxy(x,y);
write(Now^.Kar);
end
else if x=1 then
begin
inc(y);
gotoxy(x,y);
write(Now^.Kar);
end;
inc(i);
if (Now^.Next<>Nil) then Now:=Now^.Next;
until i>=jml;
end;

Procedure Tekan;
var
Ch : Char;
begin
Ch:=ReadKey;
if (Ch<>#27) and (Jml < Max) and (Ch<>'-') then
begin
Push(Ch);
inc(Jml);
end;
if (ch='-') then
if Head<>Nil then Pop else exit;
end;

begin
x:=2;
y:=1;
Repeat
i:=1;
Now:=Head;
Tx:=x;
Ty:=y;
if Head <> nil then Gerak;
Delay(500);
clrscr;
x:=Tx;
y:=Ty;
if (x<>80) and (y=1) then inc(x) else
if (x=1) and (y=24) then dec(x) else
if (x=80) and (y<>24) then inc(y) else
if (x=1) and (y<>1) then dec(y) else
if KeyPressed then Tekan;
Until Ch=#13;
end;

Begin
Head:=Nil;
Tail:=Nil;
Input;
clrscr;
Anim;
end.