Program Linked List di Pascal

Pagi bloggers...
kali ini saya akan berbagi sedikit pengetahuan saya. Penambahan ilmu baru buat kita semua guys..
yukk liat materi hari ini yang saya bahas yaitu tentang "Program Link List di Pascal"
Program link list ini bukan hanya ada di bahasa pemrograman pascal saja. Link liast ini bisa dilakukan di berbagai bahasa pemrograman pada umumnya.
Tapi untuk saat ini saya fokuskan di pascal.

program linkedlist2;
uses crt;
type data = record
    nama,npm,tgl : array[1..10]of string;
    alamat,link: array[1..10]of integer;
    end;
var list: array[1..10]of integer;
    asc,desc : array[1..10]of string;
    mhs : data;
    avail,i,isi,opsi,del,start,temp,temp2,ujung: integer;


procedure Ascending;
var x, y, Imax : integer;
Smax, temp3 : string;
begin
for x := 1 to 10 do
begin
Smax := asc[x];
for y := x to 10 do
begin
if (asc[y] <= Smax) then
begin
Smax := asc[y];
Imax := y;
end;
end;
temp3 := asc[x];
asc[x] := asc[Imax];
asc[Imax] := temp3;
end;
end;

 procedure Descending;
 var x, y, Imin : integer;
 Smin, temp4 : string;
 begin
 for x := 1 to 10 do
 begin
 Smin := desc[x];
 for y := x to 10 do
 begin
 if (desc[y] >= Smin) then
 begin
 Smin := desc[y];
 Imin := y;
 end;
 end;
 temp4 := desc[x];
 desc[x] := desc[Imin];
 desc[Imin] := temp4;
 end;
 end;

procedure cekavail;
var j : integer;
begin
for j:=1 to 10 do
    begin
    if mhs.link[avail]=0 then
        begin
        temp:=0;
        break;
        end
    else if mhs.link[avail]=mhs.alamat[j] then
        begin
        if mhs.nama[j]='' then
            begin
            temp:=j;
            break;
            end;
        end;
    end;
end;

procedure menu;
begin
clrscr;
writeln('           PROGRAM LINKED LIST (MENGGUNAKAN AVAIL)');
writeln('         |Alamat| Nama |  NPM  | Tgl.Lahir | Link |');
for i := 1 to 10 do
    begin
    asc[i]:=mhs.nama[i];
    desc[i]:=mhs.nama[i];
    mhs.alamat[i]:=i;
    gotoxy(10,i+2);write('|',mhs.alamat[i]);
    gotoxy(17,i+2);write('|',mhs.nama[i]);
    gotoxy(24,i+2);writeln('|',mhs.npm[i]);
    gotoxy(32,i+2);writeln('|',mhs.tgl[i]);
    gotoxy(44,i+2);writeln('| ',mhs.link[i],' |');
    end;
if isi=0 then
    begin
    avail:=3;
    start:=3;
    end
else
    begin
    avail:=temp;
    for i:=1 to isi do
        begin
        if list[i]<>0 then
            begin
            start:=list[i];
            break;
            end;
        end;
    end;
if avail<>0 then
    begin
    gotoxy(52,avail+2);write(' << AVAIL ');
    end;
gotoxy(1,start+2);write('START >> ');
list[isi+1]:=avail;
gotoxy(1,13);writeln('AVAIL : ',avail);
gotoxy(1,14);writeln('1. List ');
gotoxy(1,15);writeln('2. Insert ');
gotoxy(1,16);writeln('3. Delete ');
gotoxy(14,14);writeln('4. Ascending Sort ');
gotoxy(14,15);writeln('5. Descending Sort ');
gotoxy(14,16);writeln('6. Exit ');
write('Select your choice : ');readln(opsi);
if opsi =1 then
    begin
    if isi=0 then
        begin
        writeln('THERE IS NO DATA !');
        readln;
        menu;
        end
    else
        begin
        for i:=1 to isi do
            begin
            if list[i]<>0 then
                begin
                write('[',mhs.nama[list[i]],']');
                if i<>isi then write(' >> ');
                end;
            end;
        readln;
        menu;
        end;
    end
else if opsi =2 then
    begin
    if (avail=0) then
        begin
        writeln('ERROR : DATA OVERFLOW');
        readln;
        menu;
        end
    else
        begin
        inc(isi);
        write('Masukkan nama : ');readln(mhs.nama[avail]);
        write('Masukkan npm : ');readln(mhs.npm[avail]);
        write('Masukkan tanggal lahir : ');readln(mhs.tgl[avail]);
        temp2:=avail;
        if isi<>1 then mhs.link[list[isi-1]]:=temp2;
        cekavail;
        mhs.link[avail]:=0;
        menu;
        end;
    end
else if opsi =3 then
    begin
    if isi=0 then
        begin
        writeln('ERROR: DATA UNDERFLOW');
        readln;
        menu;
        end
    else
        begin
        write('Data pada alamat keberapa yang akan dihapus ? ');readln(del);
        mhs.nama[del]:='';mhs.npm[del]:='';mhs.tgl[del]:='';
        for i:=1 to 10 do
            begin
            if mhs.link[i]=del then
                begin
                mhs.link[i]:=mhs.link[del];
                break;
                end;
            end;
        mhs.link[del]:=0;
        mhs.link[ujung]:=del;
        ujung:=del;
        for i:=1 to 10 do
            begin
            if list[i]=del then
                begin
                list[i]:=0;
                break;
                end;
            end;
        menu;
        end;
    end
else if opsi=4 then
    begin
    ascending;
    for i:= 1 to 10 do
        begin
        if asc[i]<>'' then
            begin
            write('[',asc[i],']');
            if i<>10 then write(' >> ');
            end;
        end;
    readln;
    menu;
    end
else if opsi=5 then
    begin
    descending;
    for i:= 1 to 10 do
        begin
        if desc[i]<>'' then
            begin
            write('[',desc[i],']');
            if i<>10 then write(' >> ');
            end;
        end;
    readln;
    menu;
    end;
end;

begin {program utama}
isi:=0;
mhs.link[1]:=7;
mhs.link[2]:=4;
mhs.link[3]:=5;
mhs.link[4]:=10;
mhs.link[5]:=1;
mhs.link[6]:=8;
mhs.link[7]:=9;
mhs.link[8]:=0;
mhs.link[9]:=2;
mhs.link[10]:=6;
ujung:=8;
menu;
end.

PROGRAM LinkedList1;
CONST
  Header    ='------------ Menu Utama ------------';
  Separator ='------------------------------------';
TYPE
  DataString  = STRING[30];
  ListPointer = ^ListRecord;
  ListRecord  = RECORD
                  DataField : DataString;
                  NextField : ListPointer
                END;
VAR
  FirstPointer : ListPointer;
PROCEDURE BuildList(VAR FirstPointer : ListPointer;
                        DataItem     : DataString);
VAR
  ToolPointer : ListPointer;
BEGIN
  NEW(ToolPointer);
  ToolPointer^.DataField := DataItem;
  ToolPointer^.NextField := FirstPointer;
  FirstPointer:=ToolPointer
END;
PROCEDURE ReadList(FirstPointer : ListPointer);
VAR  CurrentPointer : ListPointer;
BEGIN
  CurrentPointer := FirstPointer;
  WHILE CurrentPointer <> NIL DO
     BEGIN
       WRITELN(CurrentPointer^.DataField);
       CurrentPointer := CurrentPointer^.NextField
     END;
  WRITELN
END;
PROCEDURE GetData(VARFirstPointer:ListPointer);
VAR  Name:DataString;
BEGIN
  WRITELN('Masukkan nama yang akan ditambahkan lalu tekan ENTER jika selesai.');
  READLN(Name);
  WHILE LENGTH(Name) <> 0 DO
  BEGIN
     BuildList(FirstPointer,Name); READLN(Name)
  END
END;
PROCEDURE DisplayInfo(FirstPointer:ListPointer);
BEGIN
   WRITELN(Separator);
   WRITELN('Isi dari daftar:');
   ReadList(FirstPointer);
   WRITE('Tekan sembarang tombol untuk lanjut...');
   READLN
END;

procedure cetak(firstpointer:listPointer);
var jejek:text;
    CurrentPointer : ListPointer;
begin
assign(jejek,'gundulmu.txt');
rewrite(jejek);
writeln(jejek,'Tertulis dengan Indah sebagai berikut :');
writeln(jejek);
Writeln(jejek,separator);
Writeln(jejek,'ISi dari daftar');
writeln(jejek);
CurrentPointer := FirstPointer;
  WHILE CurrentPointer <> NIL DO
     BEGIN
       WRITELN(jejek,CurrentPointer^.DataField);
       CurrentPointer := CurrentPointer^.NextField
     END;
writeln;
writeln('Data telah di tulis ke gundulmu.txt, tinggal di lihat saja...');
readln;
close(jejek);
end;

PROCEDURE Menu;
VAR  Option : INTEGER;
BEGIN
  WRITELN(Header);
  WRITELN('1. Simpan data pada daftar.');
  WRITELN('2. Tampilan daftar.');
  Writeln('3. Tulis data ke teks ');
  WRITELN('4. Keluar.');
  WRITELN(Separator);
  WRITE('Pilihan --> ');
  READLN(Option);
  CASE Option OF
     1 : GetData(FirstPointer);
     2 : DisplayInfo(FirstPointer);
     3 : cetak(firstpointer);
     4 : exit;
  END;
  Menu
END;
BEGIN
  FirstPointer := NIL;
  menu
END.