program antrian

Uses winCrt;

Type
     Point =  ^Rec;
     Rec   =  record
                  isi : char;
                  next: Point;
              end;

     queue = record
                  Head : Point;
                  Tail : Point;
             end;

var
     Q   : queue;
     i,k : byte;        { i = tinggi_stack }


Procedure GambarPipa;
Var y  : byte;
 begin
     GotoXY(39,8);write('\       /');
     For y:=1 to 10 do
      begin
           GotoXY(40,y+8);write('³');
           GotoXY(46,y+8);write('³');
      end;
     GotoXY(40,19);write('À³   ³Ù');
     GotoXY(61,21);write('\');
     GotoXY(61,23);write('/');
 end;

Function Empty: boolean;
 begin
     if Q.Head = nil then
         Empty:= True  else
         Empty:= False;
 end;

Function Full: boolean;
 begin
     if i = 10 then
         Full:= True else
         Full:= False;
 end;

Procedure Enqueue;
VAR Now : Point;
 begin
     if Full then
      begin
           GotoXY(1,6);write('queue sudah penuh ....');
           GotoXY(1,6);ClrEol;
      end else
      begin
           New(Now);
           GotoXY(1,7);ClrEol; write('Masukkan satu huruf = ');
           Now^.isi:=ReadKey; write(Now^.isi);
           Now^.next := nil;
           For k:=1 to 20 do
            begin
                 GotoXY(k+22,7);write(' ');
                 GotoXY(k+23,7);write(Now^.isi);
            end;
           For k:= 1 to 11-i do
            begin
                 GotoXY(43,k+6);write(' ');
                 GotoXY(43,k+7);write(Now^.isi);
                             end;
           Inc(i);
           GotoXY(1,7);ClrEol;
           if Empty then
            begin
                 Q.Head := Now;
                 Q.Tail := Now;
            end else
            begin
                 Q.Tail^.next := Now;
                 Q.Tail := Now;
            end;
      end;
 end;

Procedure Dequeue;
Var u : byte;
    Now : Point;
 begin
      if Empty then
       begin
            GotoXY(1,6);write('queue Kosong ....');
            
            GotoXY(1,6);ClrEol;
       end else
       begin
            For k:=19 to 22 do
             begin
                  GotoXY(43,k-1);write(' ');
                  GotoXY(43,k);write(Q.Head^.isi);
             end;
            For k:= 43 to 63 do
             begin
                  GotoXY(k,22);write(' ');
                  GotoXY(k+1,22);write(Q.Head^.isi);
             end;
            Now:= Q.Head;
            Q.Head:= Q.Head^.next;
            Dispose(Now);
            Dec(i);
            Now:= Q.Head;
            K:=18;
            While Now <> nil do
             begin
                  GotoXY(43,k);write(Now^.isi);
                  Now:= Now^.next;
                  Dec(K);
             end;
            GotoXY(43,K);write(' ');

       end;
 end;

Procedure Create;
 begin
      Q.Head := nil;
      Q.Tail := nil;
 end;

Procedure Clear;
 begin
     While not Empty do Dequeue;
 end;

Procedure Menu;
Var jwb : char;
 begin
      i := 0;
      GotoXY(1,2);write('1. Enqueue ');
      GotoXY(1,3);write('2. Dequeue ');
      GotoXY(1,4);write('3. Quit');
      Create;
      Repeat
            GotoXY(1,5);ClrEol; write('Pilihan [1/2/3] = ');
            jwb:=ReadKey; write(jwb);
            Case jwb of
                 '1' : Enqueue;
                 '2' : Dequeue;
            end;
      Until jwb = '3';
      Clear;
 end;

{Main Program}
Begin
     ClrScr;
     GambarPipa;
     Menu;
End.

Komentar

Posting Komentar

Postingan populer dari blog ini

algoritma dan pascal

Algoritma adalah suatu urutan langkah-langkah (steps) yang disusun secara logis untuk menyelesaikan masalah dengan menggunakan komputer, dengan kreteria sebagai berikut : Setiap langkah / steps harus jelas dan pasti (definite) Diperbolehkan tanpa ada output tetapi minimal harus ada satu output. Jumlah langkah harus berhingga atau dengan kata lain harus ada stopping criteria. Penyajian Algoritma dapat disajikan dalam dua cara yaitu : (1). Secara gambar (FlowChart) dan (2) Secara Tulisan (Struktur bahasa dan Pseudo Code). disini yang  akan kita bahas adalah penyajian Algoritma secara tulisan dengan Pseudo Code Pascal. B. Algoritma dengan Pseudo Code Pascal Dalam bahasa pascal kurang lebih ada 11 statement, namun mengingat waktu yang terbatas pada kesempatan kali ini kita hanya membahas 1 sub pokok bahasan yaitu tentang struktur perulangan dalam pascal. 1. Sturktur perulangan dalam Pascal Dalam Pascal kurang lebih ada tiga struktur perulangan, yaitu : a. While-...
Baca selengkapnya

CERITA

di malam ini dibawah langit ini aq buat sebuah cerita aq buat sebuah wacana yang terisi banyak nya kata kata  yang di buat dari tetesan air mata yang terungkap tatanan kasih asmara yang hiasi indahnya purnama walau tanpa tahu apa akhirnya walau begitu, tangan ini tak mau berhenti hati ini tak mau bergetar rasa ini semakin menndalam  dan q thu tiada cerita yang buat q harus tahu keadaan ini
Baca selengkapnya

cara enkripsi dengan chiper

Enkrip kalimat berikut “Saya Senang belajar keamanan aplikasi dan data” Metode : super-enkripsi dengan kata kunci nama panggilan anda (*masing-masing) serta dengan K transposisi = jumlah huruf nama panggilan anda. Jawab Tabel Subtitusi A B C D E F G H I J K L M N O P Q R S T U V W X Y Z A R I F B C D E G H J K L M N O P Q S T U V W X Y Z Plain Text S A Y A S E N A N G B E L A J A R K E A M A N A N A P L I K A S I D A N D A T A Chiper Text S A Y A S B M A M D R B K A H A Q J B A L A M A M A O K G J A S G F A M F A T A Chiper Transposisi - K Transposisi = 4 - Text : SAYASBMAMDRBKAHAQJBALAMAMAOKGJASGFAMFATA S A Y A S B M A M D R B K A H A Q J B A L A M A M A O K G J A S G F A M F A T A - Chiper text baru : SSMKQLMGGFABDAJAAJFAYMRHBMOAATAABAAKSMA
Baca selengkapnya