Kodingan Linklist Pemograman Pascal

Kodingan Link


program linkedlist;
uses wincrt;

type
    pointer=^typedata;
    typedata=record
    nama :string;
    berikutnya: pointer;
    end;
var
    list, akhir :pointer;

procedure masuk_depan(var L :pointer; X:string);
    var baru: pointer;
        begin
            new (baru);
            baru^.nama :=X;
            baru^.berikutnya :=nil;
            if L = nil then
                begin
                    L:= baru ;
                    akhir:=baru;
                end
            else
            begin
                baru^.berikutnya :=L;
                L :=baru;
            end;
        end;

procedure sisip_tengah (var L :pointer; X, Y:string);
    var baru,bantu :pointer;
        begin
            bantu :=L;
                while bantu^.berikutnya <> nil do
            begin
                if bantu^.nama = y then
                begin
                    new (baru);
                    baru^.nama:=x;
                    baru^.berikutnya := bantu^.berikutnya;
                    bantu^.berikutnya := baru;
                end;
                bantu :=bantu^.berikutnya;
            end;
        end;

procedure masuk_belakang (var L : pointer; X : string);
    var baru,bantu : pointer;
        begin
            new (baru);
            baru^.nama:=X;
            baru^.berikutnya :=nil;
            bantu:=L;
                while bantu^.berikutnya <> nil do
            bantu := bantu^.berikutnya;
            bantu^.berikutnya :=baru;
                {akhir^.next:=baru;
                akhir:=baru;akhir^.next:=nil;}
        end;

procedure hapus_depan(var L:pointer);
    var bantu : pointer;
        begin
            bantu :=L;
                if L = nil then
                    writeln ('list kosong...')
                else
            begin
                L:= L^.berikutnya;
                dispose(bantu);
            end;
        end;

procedure hapus_tengah (var L: pointer; X:string);
    var bantu,hapus :pointer;
        begin
            bantu :=L;
                if L = nil then
                    writeln ('list kosong..')
                else
            begin
                bantu :=L;
                new(hapus);
                    while bantu^.berikutnya <> nil do
                begin
                    if bantu^.berikutnya^.nama =  X then
                        begin
                            hapus :=bantu^.berikutnya;
                            bantu^.berikutnya :=hapus^.berikutnya;
                            dispose (hapus);
                        end
                    else
                        bantu:=bantu^.berikutnya;
                end;
            end;
        end;
 
procedure hapus_belakang (var L: pointer);
    var baru,bantu : pointer;
        begin
            bantu:= L;
                if bantu = nil then
                    writeln ('list kosong...')
                else
            begin
                while bantu^.berikutnya^.berikutnya <> nil do
                    bantu :=bantu^.berikutnya;
                    new(baru);
                    baru := bantu^.berikutnya;
                    bantu^.berikutnya :=nil;
                    dispose (baru)
            end;
        end;
  
procedure cetak (L : pointer);
    var bantu: pointer;
        begin
            bantu :=L;
            while bantu <> nil do
            begin
                write (bantu^.nama, ' ');
                bantu:= bantu^.berikutnya;
            end;
        end;
   
    var
        namabaru,namasisip, namahapus :string;
        pil,n : integer;
        lagi: boolean;
            begin
                lagi:=true;
                new (list) ; list:= nil;
                while lagi do
                begin
                    clrscr;
                        writeln('1.tambah depan');
                        writeln('2.tambah belakang');
                        writeln('3.sisip nama');
                        writeln('4.cetak list');
                        writeln('5.hapus depan');
                        writeln('6.hapus tengah');
                        writeln('7.hapus belakang');
                        writeln('8.selesai');
                        writeln('pilih ++> (1-8) '); readln (pil);
                    case pil of
                        1:    begin
                                writeln('masuk depan');
                                writeln('masukan nama baru : ');readln (namabaru);
                                masuk_depan (list, namabaru);
                            end;
                        2:    begin
                                writeln('masuk belakang');
                                writeln('masukan nama baru : ');readln (namabaru);
                                masuk_belakang (list, namabaru);
                            end;
                        3:    begin
                                writeln('sisip nama');
                                write('masukan nama baru yang akan disisip : ');readln (namabaru);
                                write('disisip setelah nama  :  ') ;readln (namasisip);
                                sisip_tengah (list,namabaru,namasisip);
                            end;
                        4:    cetak(list);
                        5:    begin
                                writeln('hapus depan');
                                hapus_depan (list);
                                cetak (list);
                                writeln;
                            end;
                        6:    begin
                                writeln('hapus tengah');
                                write('masukan nama yang akan dihapus :  ');readln (namahapus);
                                hapus_tengah (list,namahapus);
                                cetak(list);
                            end;
                        7:     begin
                                writeln('hapus belakang');
                                hapus_belakang (list);
                                cetak (list);
                                    writeln;
                            end;
                        8:     begin
                                writeln ('terimakasih');
                                lagi :=false
                            end;
                end;
                readln;
            end;
end.