Selasa, 06 Maret 2012

Algoritma Permainan Tebak Kartu

Sudah lama saya tidak menulis di blog, maka saya mencoba untuk menulis kembali di blog setelah sekian lama. Berikut ini adalah Algoritma Permainan Tebak Kartu yang diimplementasikan pada program pascal.

program tebak_kartu;
uses crt;

(* Kamus *)
var
 x : byte;
 jumlah : byte;
 ch : char;
 cc : char;

label ku;
label ul;
label ba;

(* Subprogram *)

procedure displayheader;
begin
    clrscr;
    textbackground(lightblue);
    textcolor(white);
    writeln;
    writeln('###############################################################################');
    writeln('########################## Program Tebak Angka ################################');
    writeln('###############################################################################');
    writeln('########################### Created by : Azka #################################');
    writeln('################### Copyright (C) 2011 All Rights Reserved ####################');
    writeln;
end;

procedure TampilkanKartu (kartu:byte);
var
 y : byte;
begin
 for y:=1 to 255 do
  begin
   if (y and (1 shl (kartu-1)) <> 0) then
    write(y:4,' ');
  end;
end;

(* Algoritma *)
begin
ul:
clrscr;
 displayheader;
 writeln('Selamat datang di program tebak angka ');
 writeln('Untuk bermain, silahkan ikuti petunjuk di bawah');
 writeln;
 writeln('Pikirkan suatu bilangan antara 1 sampai 255');
 writeln('Jika sudah, silahkan tekan sembarang tombol');
 ch:=readkey;
 jumlah :=0;
 for x:=1 to 8 do
  begin
   clrscr;
   displayheader;
   TampilkanKartu(x);
   ku:
   writeln;
   write('Apakah bilangan yang Anda pikirkan ada di atas (Y/T) ? ');
   readln(ch);
   if upcase(ch) = 'Y' then
    inc(jumlah, 1 shl (x-1))
   else
   if upcase(ch) = 'T' then
   else
    begin
     writeln('Masukan Huruf Salah');
     goto ku;
    end;
  end;
 clrscr;
 displayheader;
 writeln('Bilangan yang Anda pikirkan adalah ', jumlah);
 writeln;
 ba:
 write('Apakah Anda ingin kembali bermain (Y/T) ? ');
 readln(cc);
   if upcase(cc) = 'Y' then
    goto ul
   else
   if upcase(cc) = 'T' then
    exit
   else
    begin
     writeln('Masukan Huruf Salah');
     goto ba;
    end;
 end.