program pascal linked list

Program Pascal Linked List

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.

sumber:http://komputok.blogspot.com/2010/01/linked-list-dengan-pascal.html