MY FIRST PROGRAM(PASCAL)

Not much of a big deal though, but for starters this is my first good pascal code that actually runs well. gosh i love dev-pascal but it "Old fashioned sha" lol. anyways. just felt like showing my viewers. just few comments will be  good.

expect more HACK and INTERESTING code from techcode.

WARNING: this code was originally written by me, do not duplicate or republish without permision

MY CODE:


//ARRAY IMPLEMENTATION OF ADT LIST
program ADT;
uses crt;
label 1;label 2;label 3;label 4;label 5;label 6;
const max = 1000;
type element_type = integer;
     position_type = integer;
     list_type = record
               element: array [1..max] of element_type;
               last: position_type;
     end;
var
   n,c,j,i: integer;
   x: element_type;
   p: position_type;
   list: list_type;
   menus, yn: char;

procedure insert(x: element_type; p: position_type; var l: list_type);
var q: position_type;
begin
  if (l.last >= max - 1) then
    writeln('Error, List is full')
  else if (p < 1) or (p > l.last + 1) then
    writeln('Error, position does not exist')
  else
    begin
      for q:= l.last to p do
        begin
          l.element[q+1] := l.element[q];
          l.element[p] := x;
          l.last := l.last + 1;
        end;
    end;
end;

procedure delete(p: position_type; var l: list_type);
var q: position_type;
begin
  if (p < 1) or (p > l.last + 1) then
    writeln('Error, position does not exist')
  else
    begin
      for q:= p to l.last do
        l.element[q] := l.element[q+1];
        l.last := l.last - 1;
    end;
end;

procedure printlist(var l: list_type);
var q: position_type;
begin
j:=500;
  if (l.last <= 0) then
      writeln('list is empty')
  else
    for q:= 1 to l.last - 1 do
    begin
      writeln(j+q,'. ',l.element[q]);
     end;
end;

function retrieve(p: position_type; l: list_type):element_type;
begin
  if (p < 1) or (p > l.last + 1) then
    begin
      writeln('Error, position does not exist');
      retrieve := l.last + 1
    end
  else
    retrieve := l.element[p];
end;

function locate(x: element_type; l: list_type): position_type;
var q: position_type;
    found: boolean;
begin
  q:= 1;
  found:= false;
  while (q <= l.last) AND (found= false) do
    begin
      if l.element[q] = x then
        begin
          found:=true;
          locate := q;
        end
      else
        begin
          q:=q+1;
          if found = false then
            locate:= l.last + 1
        end;
    end;
end;

procedure makenull(p:position_type; var l:list_type);
var q:position_type;
begin
  if(p<1 or="" p="">l.last+1)then
    writeln('ERROR POSITION DOESNT EXIST')
  else
    begin
      for q:= 1 to l.last + 2 do
        l.element[p]:= l.element[p];
        l.last:= 0;
    end
end;

begin
6:clrscr;
gotoxy(50,2);
writeln('CREATE NEW LIST');
writeln;
write('INPUT NUMBER OF ELEMENTS: '); readln(n);
if n > max then
  begin
    writeln('max exceeded');
    readln;
    goto 6;
  end;
i := 1;
p := 1;
randomize;
for i:= 1 to n do
  begin
    x := random(100);
    if x < 40 then
    begin
    x:=x+40;
    insert(x,p,list);
    end
    else
    insert(x,p,list);
    p := p + 1;
  end;

4:clrscr;
writeln('PRESENT LIST: ');
writeln;
printlist(list);
writeln;
writeln('-----------------------------------------------------------------------------------------------------------------------');
gotoxy(50,1);
writeln('MENU');
gotoxy(45,2);
writeln;
gotoxy(45,3);
writeln('CLICK: ');
gotoxy(45,4);
writeln('1. To DELETE');
gotoxy(45,5);
writeln('2. To LOCATE');
gotoxy(45,6);
write('3. To RETRIEVE');
gotoxy(45,7);
write('4. CREATE NEW LIST');
gotoxy(45,8);
write('5. To Exit');
menus:=readkey;
if menus = '1' then
  goto 1
else if menus = '2' then
  goto 2
else if menus = '3' then
  goto 3
else if menus = '4' then
  begin
    makenull(p,list);
    clrscr;
    goto 6;
  end
else if menus = '5' then
  halt
else
  goto 4;
readln;

1:clrscr;
writeln('PRESENT LIST: ');
printlist(list);
writeln;
writeln('-----------------------------------------------------------------------------------------------------------------------');
writeln;
write('INPUT POSITION TO DELETE FROM: ');
readln(p);
delete(p,list);
5:writeln('PRESENT LIST:');
printlist(list);
writeln('DELETE AGAIN? [y/n]');
yn := readkey;
if (yn = 'y') or (yn = 'Y') then
  goto 1
else if (yn = 'n') or (yn = 'n') then
  goto 4
else
  goto 5;
readln;

2:
clrscr;
writeln('PRESENT LIST: ');
printlist(list);
writeln('-----------------------------------------------------------------------------------------------------------------------');
writeln;
write('INPUT ELEMENT TO LOCATE: ');
readln(x);
c:=locate(x,list);
writeln;
write('>>>> ' ,x, ' IS AT POSITION: ');
writeln(c);
writeln('LOCATE AGAIN? [y/n]');
yn := readkey;
if (yn = 'y') or (yn = 'Y') then
  goto 2
else if (yn = 'n') or (yn = 'n') then
  goto 4
else
  goto 2;
readln;
readln;

3:clrscr;
writeln('PRESENT LIST: ');
printlist(list);
writeln('-----------------------------------------------------------------------------------------------------------------------');
writeln;
write('INPUT POSITION TO RETRIEVE: ');
readln(p);
c:=retrieve(p,list);
writeln;
write('ELEMENT AT POSITION [' ,p, '] IS: ');
writeln(c);
writeln('RETRIVE AGAIN? [y/n]');
yn := readkey;
if (yn = 'y') or (yn = 'Y') then
  goto 3
else if (yn = 'n') or (yn = 'n') then
  goto 4
else
  goto 3;
readln;
readln;
writeln;
writeln('EXIT or MENU [E/M]');
yn:=readkey;
if (yn = 'm') or (yn = 'M') then
  goto 4
else if (yn = 'e') or (yn = 'E') then
end.

No comments: