contoh toko buku linkedlist pemograman PASCAL

program linkedresponsi;
uses wincrt;
const max=15;
type
    pointer=^databuku;
    databuku=record
    judul:string;
    harga:longint;
    posisi:byte;
    next:pointer;
    end;
type
    pointer1=^datapembeli;
    datapembeli=record
    posisi1:byte;
    next1:pointer1;
    end;
type
    pointer2=^datajual;
    datajual=record
    judul2:string;
    harga2:longint;
    next2:pointer2;
    end;

var baru:pointer;
    baru1:pointer1;
    baru2:pointer2;
    pos,nocari:byte;
    pendapatan:real;
    j_judul:string;
    j_harga:longint;
    ketemu:boolean;

function penuh(posisi:byte):boolean;
begin
penuh:=((pos+posisi)>max);
end;

function kosong(posisi:byte):boolean;
begin
kosong:=(pos=0);
end;


procedure push(var L:pointer;dt1:string;dt2:longint);
var bantu:pointer;
    dt3:byte;
begin
bantu:=L;
dt3:=0;
inc(dt3);
if penuh(dt3) then
begin
writeln;
writeln('tumpukan sudah penuh..!');
writeln;
write('tekan enter untuk melanjutkan');
end
else
begin
new(bantu);
bantu^.judul:=dt1;
bantu^.harga:=dt2;
bantu^.posisi:=dt3;
bantu^.next:=baru;
baru:=bantu;
end;
end;

procedure arrayjual(var N:pointer2;j_judul:string;j_harga:longint);
var bantu:pointer2;
begin
bantu:=N;
new(bantu);
bantu^.judul2:=j_judul;
bantu^.harga2:=j_harga;
bantu^.next2:=baru2;
baru2:=bantu;
end;

procedure cetakpenjualan(var N:pointer2);
var bantu:pointer2;
begin
new(bantu);
bantu:=N;
bantu:=baru2;
writeln('Daftar Penjualan');
while (bantu<>nil) do
begin

writeln('Judul Buku : ',bantu^.judul2);
writeln('Harga      : ',bantu^.harga2);
writeln;
bantu:=bantu^.next2;
end;
writeln;
write('tekan enter untuk melanjutkan');
end;


procedure cetakantri(var M:pointer1);
var bantu:pointer1;
begin
bantu:=M;
bantu:=baru1;
writeln('Daftar Pengantri');
while (bantu<>nil) do
begin
writeln('Pengantri ke-',bantu^.posisi1);
writeln;
bantu:=bantu^.next1;
end;
writeln;
write('tekan enter untuk melanjutkan');
end;


procedure pushq(var M:pointer1;dt1:byte);
var bantu:pointer1;
begin
bantu:=M;
new(bantu);
bantu^.posisi1:=dt1;
bantu^.next1:=baru1;
baru1:=bantu;
end;





procedure pop(var L:pointer);
var bantu:pointer;
   
begin
bantu:=L;
bantu:=baru;
baru:=bantu^.next;
writeln;
writeln('buku yang diambil adalah :');
writeln;
writeln('Judul Buku : ',bantu^.judul);
writeln('Harga      : ',bantu^.harga);
writeln('posisi ke-',bantu^.posisi);
writeln;
pendapatan:=pendapatan+bantu^.harga;
j_judul:=bantu^.judul;
j_harga:=bantu^.harga;
dispose(bantu);
write('tekan enter untuk melanjutkan');
end;


procedure popq(var M:pointer1);
var bantu:pointer1;
   
begin
bantu:=M;
bantu:=baru1;
baru1:=bantu^.next1;
writeln;
writeln('lalu pengantrinya ke-',bantu^.posisi1);

dispose(bantu);
write('tekan enter untuk melanjutkan');
end;



procedure cetakbuku(var L:pointer);
var bantu:pointer;
begin
bantu:=L;
bantu:=baru;
writeln('Daftar Buku Perpustakaan');
while (bantu<>nil) do
begin
writeln('Judul Buku : ',bantu^.judul);
writeln('Harga      : ',bantu^.harga);
writeln;
bantu:=bantu^.next;
end;
writeln;
write('tekan enter untuk melanjutkan');
end;


procedure caribuku(var L:pointer;dt1:string);
var bantu:pointer;
begin
bantu:=L;
bantu:=baru;nocari:=0;ketemu:=false;
while (bantu<>nil) and (ketemu=false) do
begin
inc(nocari);
if bantu^.judul=dt1 then ketemu:=true;
bantu:=bantu^.next;
end;
end;



{procedure utama}
var cacah,pil:integer;
    a,ab:string;
    b:longint;
    c,d,e:byte;
   

begin
new(baru);new(baru1);new(baru2);
baru:=nil;baru1:=nil;baru2:=nil;
repeat
begin
     clrscr;
     writeln('Menu Perpustakaan');
     writeln('1. Menambah Buku');
     writeln('2, Menambah Pengantre');
     writeln('3. Penjualan');
     writeln('4. Tampil Buku');
     writeln('5. Tampil Antrean');
     writeln('6. Tampil Penjualan');
     writeln('7. Tampil Rekap');
     writeln('8. Cari Buku');
     writeln('9. Selesai');
     write('Pilihan anda : ');readln(pil);
     case pil of
     1: begin
        writeln('Menambah Tumpukan');
        write('Judul Buku : ');readln(a);
        write('Harga Buku : ');readln(b);
        push(baru,a,b);
        end;
     2: begin
        writeln('menambah antrian');
        write('tambah antrian : ');readln(d);
        pushq(baru1,d);
        end;
     3: begin
        pop(baru);
        popq(baru1);
        inc(cacah);
        end;
     4: begin
        if baru<> nil then
        begin
        cetakbuku(baru);
        end
        else
        writeln('List masih kosong');
        end;
     5: begin
        if baru1<> nil then
        begin
        cetakantri(baru1);
        end
        else
        writeln('List masih kosong');
        end;
     6: begin  
        cetakpenjualan(baru2);
        end;
     7: begin
        writeln('buku yang terjual sebanyak ',cacah,' buah');
        writeln('pendapatan sebanyak Rp ',pendapatan:8:2);
        end;
     8: begin
        write('masukkan nama yang dicari : ');readln(ab);
        if baru<>nil then
        begin
        caribuku(baru,ab);
        if ketemu then
        writeln('Nama ditemukan pada nomor : ',nocari)
        else writeln('Nama Tidak Ketemu');
        end
        else
        writeln('List Kosong');
        end;
     9: writeln('Terima Kasih');
     end;
     readln;
     end
     until (pil=9);
end.