Saturday 15 May 2010

PROGRAM Quene(program antrian)

sumber: :http://pascalsourcecode.co.cc/

=======================================================================
program antrian_SPMB;

 uses  wincrt;

type  antrian = ^node;

    node = record

  isi : string[10];

  next : antrian;

         end;

           

var    dpn, blk : antrian;

        pointer  : string;

        x        : string;

        cr       : string;

        pil      :char;

{============================================================}

{Procedure identitas: untuk menampilkan identitas kita}

 procedure identitas;

   begin

        writeln('+-----------------------------------+');

        writeln('+    Nama : FARHAN                  +');

        writeln('+    NIM  : 41090812                +');

        writeln('+  Program Antrian Pendaftaran SPMB +');

        writeln('+-----------------------------------+');

   end;

{============================================================}

{procedure baru digunakan untuk inisialisasi awal list}

 Procedure baru(x: string; var tunjuk: antrian) ;

   begin

 new(tunjuk);

 tunjuk^.isi := x;

 tunjuk^.next := nil;

   end;

{============================================================}

{function isempty digunakan untu mengecek apakah suatu list kosong atau tidak}

function isempty(depan,belakang:antrian):boolean;

   begin

        isempty:= (depan=nil) and (belakang=nil)=true

   end;

{============================================================}

{Fucntion cari digunakan untuk mencari mengecek apakah seseorang ada pada antrian atau tidak}

Function cari(x: string; depan:antrian) : boolean;

var tunjuk : antrian;

    ada,kosong: boolean;        

   begin

        ada := false; tunjuk := depan;

        kosong:= isempty(dpn,blk);

           if kosong=false then begin

       while (tunjuk <> nil) and (ada=false) do

                  if tunjuk^.isi = x then

                     ada := true

                  else

                     tunjuk := tunjuk^.next;                  

              end;

         cari:=ada;

   end;

{============================================================}

{procedure tambahantri digunakan untuk menambakan jumlah orang dalam antrian}

procedure tambahantri(var belakang:antrian);                  

var x:string;

    tunjuk:antrian;

   begin

        write('Masukan nama orang yang mau masuk antrian : ');

        readln(x);

        baru(x,tunjuk);

        belakang^.next:=tunjuk;

        belakang:=tunjuk;

   end;

{============================================================}

{prosedure hapusdpn diguakan untuk menghapus list dalam antrian}

procedure hapusdpn(var depan,belakang:antrian);

var bantu:antrian;          

   begin

        if isempty(depan,belakang) then

           writeln('Antrian Kosong')

        else if depan=belakang then

           begin

                depan:=nil;belakang:=nil

           end

        else

           begin

                bantu:=depan^.next;

                depan:=bantu;

           end;

   end;

{============================================================}

 {prosedure slesaiantri digunakan untuk mengambil orang yang telah selesai antri}

 procedure slesaiantri(var depan,belakang:antrian;var

 x:string);

   begin   

        if dpn=nil then

          x:='Antrian Kosong'

        else

            begin

                 x:=dpn^.isi;

                 hapusdpn(depan,belakang);

            end;

 end;

{============================================================}

{procedure hapusx digunakan utk mengambil seseorang dari antrian}

{sebagai contoh ketika seseorang ingin ketoilet atau capek setelah lama mengantri

maka iya meninggalkan antrian}

 procedure hapusx(var depan,belakang:antrian);

 var bantu,hapus:antrian;

     ada:boolean;

     y:string;

   begin

        write('Masukan nama orang yang mau meninggalkan   antrian : ');

        readln(y);

        if isempty(depan,belakang) then

            writeln('Antrian Kosong')

        else if depan=belakang then

            begin

                 depan:=nil;belakang:=nil

            end

        else

            begin

                 bantu:=depan;

                 hapus:=depan;

                 ada:=false;

                   while (bantu<>nil) do begin

                 if bantu^.isi=y then

                     if bantu=depan then

                         depan:=bantu^.next

                        else

                            hapus^.next:=bantu^.next;

                 hapus:=bantu;

                 bantu:=bantu^.next;

                  end;

            end;

 end;



{============================================================}

{ Procedure BuatAntrian untuk membangun antrian dengan input data secara interaktif}

 procedure buatantrian (var depan,belakang: antrian);

 Var c : char; tunjuk : antrian;i:integer;

    begin

         i:=0;                        

  depan := nil; belakang := nil;

  repeat          

           i:=i+1;

    write('masukan nama ke-',i,'            =');readln(x);

    baru(x,tunjuk);

    if  isempty(depan,belakang) then

             begin

              depan := tunjuk ;

              belakang := tunjuk;

             end

    else begin

              belakang^.next := tunjuk;

       belakang :=tunjuk;

                end; 

      repeat

  write('tambah data yang antri [Y/T] = ');

  readln(c);

             until c in ['T','t','y','Y'];

      until c in ['T','t'];

    end;

{============================================================}

{procedure sisiptengah digunakan untuk memasukkan seseorang yang menyerobot antrian}

procedure sisiptengah(var depan,belakang: antrian);

var  baru,bantu : antrian;

     x,y : string;

    begin

     write('Masukan nama orang yang menyerobot : ');readln(y);   

     write('menyerobot dibelakang ( masukan salah satu nama yang telah antri) : ');readln(x);

     bantu:=depan;

     while bantu^.next <> nil do

     begin

       if bantu^.isi= x then

       begin

        new(baru);

        baru^.isi := y;

        baru^.next:=bantu^.next;

        bantu^.next:=baru;

       end;

     bantu:=bantu^.next;

     end;

     end;

{============================================================}   

{Procedure Cetak untuk mencetak isi Antrian,pintu keluar antrian disebelah kanan dan

pintu masu antrian disebelah kiri}

procedure cetak(depan:antrian;var output:string);

          var bantu:antrian;y:string;

                                       

          begin

               bantu:=depan;

               output:='  Loket Pendaftaran';

              if isempty(dpn,blk) then output:='Antrian Kosong'

               else begin

                         while bantu<>nil do

                         begin

                               y:=bantu^.isi;

                               output:=y+'->>'+output;

                               bantu:=bantu^.next;

                         end;

                     output:='pintu masuk antrian  ->>'+output;

               end;                                     

          end;

{============================================================}

begin

screensize.y:=300;

identitas;

writeln;

writeln('=====================================');

writeln('     Antrian Awal Pendaftar SPMB     ');

writeln('Masukan data orang yang telah antri: ');

writeln('=====================================');

writeln;

buatantrian(dpn,blk);

repeat

      repeat

      {menu utama}

      writeln;

      writeln;

      writeln('            Simulasi:              ');

      writeln('     ANTRIAN PENDAFTARAN SPMB      ');

      writeln('-----------------------------------');

      writeln('[1] Buat Antrian Baru              ');

      writeln('[2] Cetak Antrian                  ');

      writeln('[3] Tambah Antrian Pendaftar       ');

      writeln('[4] Ambil Orang yang selesai daftar');

      writeln('[5] Cari Seseorang dalam Antrian   ');

      writeln('[6] Seseorang meninggalkan antrian ');

      writeln('[7] Seseorang menyerobot antrian   ');

      writeln('[8] Loket Pendaftaran ditutup      ');

      writeln('-----------------------------------');

      write('Pilihan anda : ');pil:=readkey;writeln(pil);

      writeln;

      until (pil>='1') and (pil<='8');

      {case pil of mengacu pada menu pilihan yang akan mengaktifkan salah satu procedure 

       yang dipilih}

      case pil of

      '1' :begin

               buatantrian(dpn,blk);

               writeln;

               writeln;

               writeln;

           end;

      '2' :begin

               cetak(dpn,pointer);

               writeln(pointer);

               writeln;

               writeln;

               writeln;         

           end;               

      '3'  :begin           

               tambahantri(blk);

               writeln;  

               writeln('setelah ditambah antrian menjadi : ');           

               cetak(dpn,pointer);

               writeln(pointer);

               writeln;

               writeln;

               writeln;

            end;

      '4'  :begin

               slesaiantri(dpn,blk,x);         

               writeln('',x,' Telah selesai mendaftar,maka ia keluar dari antrian');

               writeln;

               writeln('Antrian menjadi :');           

               cetak(dpn,pointer);

               writeln(pointer);

               writeln;

               writeln;

               writeln;

                                   

        

            end;

      '5'  :begin

                write('Masukan nama orang  yang di cari : ');readln(cr);

                     if cari(cr,dpn)=true then

                        writeln('',cr,' ada dalam antrian')

                     else

                        writeln('',cr,' tidak ada dalam antrian');

                 writeln;

                 writeln;

                 writeln;

            end;

      '6'  :begin

                if not isempty(dpn,blk) then

                    begin

                      writeln('antrian awal');

                      cetak(dpn,pointer);

                      writeln(pointer);

                   

                      hapusx(dpn,blk);

                      writeln('Antrian Menjadi : ');

                      cetak(dpn,pointer);

                      writeln(pointer);

                      writeln;

                      writeln;

                      writeln;

                    end

                 else

                     writeln('Antrian Kosong');

            end;

      '7'  :begin

                writeln('Angtrian sebelum ada yang menyerobot');  

                cetak(dpn,pointer);

                writeln(pointer);

                writeln;

                sisiptengah(dpn,blk);

                writeln;

                writeln('Setelah ada yang menyerobot antrian menjadi :');  

                cetak(dpn,pointer);

                writeln(pointer);

                writeln;

                writeln;

                writeln;

            end;

      '8'  :begin

                  writeln('       Loket telah ditutup         ');

                  writeln('Antrian dilanjutkan hari berikutnya');

                  exit;

            end;

   

      end;

until (pil='8');

end.

end.

1 comment:

  1. Gan, pas mau milih dia ga jalan...var dari char utk pilihnya msalah bukan gan?

    ReplyDelete

Silahkan Komentar Anda..
Mohon Gunakan Bahasa yang baik dan sopan, OK. ^^