Archive for the ‘pascal’ category

ImageCloud Update

December 1, 2006

My Pascal version of ImageCloud is coming along decently. I couldn’t return an StrArray for some reason (fpc kept failing to compile) so rather than figure out the problem, I used a pointer instead. Seemed simpler.

program ImageCloud( input, output, TagDB );


uses

  DOS; {to enable findfirst and findnext}

const

  MAXDBSIZE = 224; {max number of cells to the array}

type

  StrArray = Array [0..(MAXDBSIZE-1)] of String; {define type for array}

  FileTypes = (JPG, GIF, PNG);

  StrAryPtr = ^StrArray;

var

  TagDB : Text; {Declare database file for tags and filenames}



function Glob(pathname : String) : StrArray;

  var

    listing : StrArray;

    listptr : StrAryPtr;

    s : SearchRec; {variable to store the found file in}

    i : Integer; {counter variable for loops}

  begin

    i := 1; 

    listing[0] := ' '; {set the first cell of the filelist to a blank space for loop termination check}

    findfirst(pathname + '*.*', AnyFile, s); {find first file in provided directory}

    if s.name <> '' then {if the name is not blank, that is, an file was found in the provided directory}

      begin

        while (i < MAXDBSIZE) and ((pathname + s.name) <> listing[i-1]) do 

          begin

            listing[i] := pathname + s.name; {store absolute path in cell}

            i := i + 1; {Increment counter value}

            findnext(s); {find next file in directory}

          end;

        listptr := @listing;

        Glob := listptr^;

      end

    else {if no files are found...}

      begin

        writeln('No files in that directory!');

        exit;

      end;

  end;


procedure ListFiles(filelist : StrArray);

  var

    i : Integer;

  begin

    i := 1;

    while (i < MAXDBSIZE) and (filelist[i] <> '') do {while not end of array and filelist[i] not empyty}

      begin

        writeln(filelist[i]); {write filelist value to stdout}

        i := i + 1; {increment counter}

      end;

  end;



procedure PickleDB(filelist : StrArray);

  var

    i : Integer;

  begin

    i := 1;

    while (i < MAXDBSIZE) and (filelist[i] <> '') do {while not end of array and filelist[i] not empyty}

      begin

        writeln(TagDB, filelist[i]); {write filelist value to file}

        i := i + 1; {increment counter}

      end;

  end;



procedure AddFiles;

  var

    filelist : StrArray;

    pathname : String;

  begin

    writeln('What is the path to scan for the images?');

    readln(pathname);

    writeln('Globbing...');

    filelist := Glob(pathname);

    writeln('Listing...');

    ListFiles(filelist);

    writeln('PickleDB');

    PickleDB(filelist);

    writeln('Done!')

  end;



procedure BrowseFiles;

  begin

    writeln('Not yet implemented!');

    exit;

  end;

	

procedure UserInput;

  var

    inputchar : Char;

    loopcatch : Integer;

  begin

    loopcatch := 0;

    inputchar := ' ';

      repeat

        write('Do you want to [B]rowse, [A]dd, or [Q]uit? >>');

        readln(inputchar);

          case inputchar of

            'a','A': begin

                       AddFiles;

                       loopcatch := loopcatch + 1;

                     end;

            'b','B': begin

                       BrowseFiles;

                       loopcatch := loopcatch + 1;

                     end;

            'q','Q': begin

                       loopcatch := loopcatch + 1;

                       exit;

                     end;

          end;

      until loopcatch <> 0;

  end;

	  

begin {main}

  assign(TagDB, 'tags.dat'); {associate the variable TagDB with tags.dat file}

  rewrite(TagDB); {ready file for writing}

  UserInput; {call main user input subprogram}

  close(TagDB)

end. {main}

Crazy Pascal Assignment

November 8, 2006

My semester project in pascal is self assigned. I’ve written a proposal letter to the teacher to make ImageCloud in pascal. The python verison is not really even helpful in this besides being a psuedocode for the pascal. This is what I have so far. He hasn’t even green-lighted the idea yet. Here’s hoping…

program FileReader(input, output);

uses
    DOS;

const
    MAXDBSIZE = 224;
type
    StrArray = array [0..(MAXDBSIZE-1)] of String;

var
    pathname : String;
    filelist : StrArray;

procedure glob(var filelist : StrArray);
    var
	s : SearchRec;

        x : integer;
        pathname : String;
    begin

        x := 1;
        filelist[0] := ' ';

          Writeln('Please enter a directory to search in:');
	Readln(pathname);
        findfirst(pathname + '*.*', AnyFile, s);

	if s.name <> '' then
	  while (x < MAXDBSIZE) and (s.name <> filelist[x-1]) do

	    begin
	      filelist[x] := s.name;

              x := x + 1;
              findnext(s)

	    end
	else
          writeln('No files in that directory!');

        x := 1;

        while (x < MAXDBSIZE) and (s.name <> filelist[x-1]) do

          begin
            writeln(filelist[x]);
            x := x + 1;

          end;
    end;

procedure UserInput;
  var

    inputchar : char;
    foo, jello : integer;

  begin
    foo := 0;
    jello := 0;

    inputchar := ' ';
      repeat
        write('Do you want to [B]rowse, [A]dd, or [Q]uit? >>');

        readln(inputchar);
          case inputchar of
	    'a','A': begin

	      glob(filelist);
	      jello := jello + 1;

	      end;
	    'b','B': begin
	      glob(filelist);

	      jello := jello + 1;
	      end;
	    'q','Q': begin

	      glob(filelist);
	      jello := jello + 1;

	      end;
	  end;
      until jello <> foo;
  end;

begin {main}
UserInput;
end.