Ads 468x60px

wibiya widget

Labels

Rabu, 18 Januari 2012

CORETAN STACK PASCAL

USES CRT;
CONST MAX=5;
TYPE
TYPEARRAY=ARRAY[1..MAX]OF INTEGER;
TYPEINFO=INTEGER;
TYPESTACK=RECORD
ELEMEN:TYPEARRAY;
TOP:INTEGER;
END;

VAR
STACK:TYPESTACK;

PROCEDURE BUATSTACK(VAR STACK:TYPESTACK);
BEGIN
STACK.TOP:=0;
END;

FUNCTION STACKKOSONG(STACK:TYPESTACK):BOOLEAN;
BEGIN
STACKKOSONG:=(STACK.TOP=0);
END;

FUNCTION STACKPENUH(STACK:TYPESTACK):BOOLEAN;
BEGIN
STACKPENUH:=(STACK.TOP=MAX);
END;

PROCEDURE PUSH(VAR STACK:TYPESTACK; ISI:TYPEINFO);
BEGIN
IF NOT(STACKPENUH(STACK)) THEN
BEGIN
STACK.TOP:=STACK.TOP+1;
STACK.ELEMEN[STACK.TOP]:=ISI;
END
ELSE
WRITELN('STACK PENUH');
END;

PROCEDURE POP(VAR STACK:TYPESTACK; VAR INFOPOP:INTEGER);
BEGIN
IF NOT(STACKKOSONG(STACK)) THEN
BEGIN
INFOPOP:=STACK.ELEMEN[STACK.TOP];
STACK.TOP:=STACK.TOP-1;
END
ELSE
WRITELN('STACK KOSONG');
END;

PROCEDURE TAMPILSTACK;
VAR
I:INTEGER;
BEGIN
FOR I:=STACK.TOP DOWNTO 1 DO
WRITELN(STACK.ELEMEN[I]);
END;

PROCEDURE KOSONGKAN(VAR S:TYPESTACK);
BEGIN
STACK.TOP:=0;
END;
{MAIN PROGRAM}
VAR
DATA:INTEGER;
I:BYTE;
TANYA:CHAR;
BEGIN
CLRSCR;
KOSONGKAN(STACK);
BUATSTACK(STACK);
REPEAT
CLRSCR;
WRITELN;
WRITELN('  UNTUK INPUTAN KETIK MENU 1 SECARA BERULAN  ');
WRITELN;
WRITELN('                MENU PILIHAN');
WRITELN(' ============================================');
WRITELN('             [1].PUSH (MASUK)');
WRITELN('             [2].POP  (AMBIL)');
WRITELN('             [3].TAMPIL');
WRITELN('             [4].KELUAR');
WRITELN('=============================================');
WRITELN;
WRITE('             PILIHAN ANDA : ');
READLN(TANYA);
CASE TANYA OF
'1':BEGIN
CLRSCR;
WRITELN('DATA YANG DIISIKAN : ');
WRITELN('ANGKA INTEGER');
READLN(DATA);
PUSH(STACK,DATA);
END;
'2':POP(STACK,DATA);
'3':BEGIN
CLRSCR;
WRITELN;WRITELN;WRITELN;WRITELN;
WRITELN('       DATA STACK ANDA');
WRITELN('===============================');
WRITELN;WRITELN;
TAMPILSTACK;
TEXTCOLOR(RED);
GOTOXY(25,25);
WRITELN('TEKAN ENTER UNTUK KEMBALI KE MENU UTAMA');
TEXTCOLOR(WHITE);
READLN;
END;
END;
UNTIL TANYA='4';
END.