Помощь - Поиск - Пользователи - Календарь
Полная версия: Программа форматирования Паскаль-программ
Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи
Галина М.
Пришла сессия.... А я за семестр Паскаль в глаза не видела.... Препод сказал если решу 1 задачу, то поставит мне зачет.
Если кто-то может, помогите.
Такая задача:

Программа предназначена для форматирования текста Паскаль-программ.
Требования к программе:
- в одной строке должен быть один оператор или описание переменных одного типа;
- ключевые слова REPEAT, BEGIN, END, THEN, ELSE должны быть размещены по одному в строке;
- ключевые слова IF, WHILE, UNTIL, CASE, FOR, WITH должны быть размещены по одному в строке с условиями;
- для групп связаных операторов и описаний должны быть сделаны отступы от начала строки;
- ключевые слова, что составляют пару должны начинаться с одной позиции, величина отступа должна задаваться оператором.

Вот и все условие. Буду очень благодарна, всем кто поможет.
volvo
Цитата
Вот и все условие


blink.gif Это задание на сдачу зачета? Я бы хотел посмотреть на дипломный проект... Где учитесь, если не секрет?
Галина М.
Кировоградский радио-кибернетический коледж
Разве это задание сложное ? Ну я не знаю языка Паскаль, но может кто-то знает... Препод сказал, что б я еще в нем разбиралась и могла его объяснить...
Что же мне теперь делать ? unsure.gif
может хоть кусочек программы кто-то сможет написать ?
Altair
Цитата
Разве это задание сложное ?

Да вообще-то наоборот для зачетной-то работы smile.gif
Здесь такое уже приносили просто с лабораторных smile.gif
Что-нибудь придумаем smile.gif
volvo
Галина М.
Проверьте вот этот код... Я думаю, это должно подойти... Если где-то не работает, пишите, исправим... rolleyes.gif

const
 s_name = 'TEST.PAS';
 d_name = 'AFTER.PAS';
var
 fin, fout: text;
 part_before, s: string;
 autoTab: integer;

const
 ToTab = 2;

 lookCount = 9;
 looking: array[1 .. lookCount] of string =
   ('var', 'const', 'do', 'repeat', 'begin', 'then', 'else', 'of', ';');

 oneStrCount = 4;
 oneStr: array[1 .. oneStrCount] of string =
   ('for', 'while', 'then', 'else');

 tabCount = 4;
 dec_tab: array[1 .. tabCount] of string =
   ('var', 'const', 'end', 'until');

 tabulator: array[1 .. lookCount] of integer =
   (2, 2, 2, 2, 2, 2, 2, 2, 0);

function UpString(s: String): String;
 var i: byte;
 begin
   for i := 1 to length(s) do
     s[i] := UpCase(s[i]);
   UpString := s
 end;
function noLeadSpace(s: string): string;
 begin
   while (s <> '') and (s[1] = ' ') do
     delete(s, 1, 1);
   noLeadSpace := s
 end;

function getString(var s: string;
        var found: integer): string;
 var
   up_str: string;
   i, p: integer;
 begin
   for i := 1 to lookCount do
     begin
       up_str := UpString(s);
       p := pos(UpString(looking[i]), up_str);
       if p > 0 then
         begin
           {inc(autoTab, tabulator[i]);}
           getString := Copy(s, 1, p+length(looking[i])-1);
           delete(s, 1, p+length(looking[i])-1);
           found := i mod LookCount; exit
         end;
     end;
   getString := s; s := ''; found := 0
 end;

var
 i, was_detected: integer;
 oneStringCounter: integer;

begin
 assign(fin, s_name);
 {$i-} reset(fin); {$i+}
 if ioresult <> 0 then
   begin
     writeln( 'cannot open source file ', s_name );
     halt(100);
   end;

 assign(fout, d_name);
 {$i-} rewrite(fout); {$i+}
 if ioresult <> 0 then
   begin
     writeln( 'cannot create destination file ', d_name );
     halt(101)
   end;

 autoTab := 0;
 oneStringCounter := -1;
 while not seekeof(fin) do
   begin
     readln(fin, s);
     while s <> '' do
       begin
         part_before := noLeadSpace( getString(s, was_detected) );

         for i := 1 to oneStrCount do
           if pos(UpString(oneStr[i]), UpString(part_before)) > 0 then
             begin
               oneStringCounter := 1; break
             end;

         for i := 1 to tabCount do
           if pos(UpString(dec_tab[i]), UpString(part_before)) > 0 then
             begin
               if autoTab >= ToTab then dec(autoTab, ToTab);
               break;
             end;
         for i := 1 to autoTab do
           part_before := ' ' + part_before;

         writeln(fout, part_before);
         if oneStringCounter = 0 then
           begin
             dec(autoTab, ToTab);
           end;
         if oneStringCounter <> -1 then dec(oneStringCounter);

         if was_detected > 0 then
           inc(autoTab, tabulator[was_detected]);
       end;
   end;

 close(fout);
 close(fin);
end.



P.S. Попробуйте протестировать на каком-нибудь простом примере (что-то типа):

for i:=1 to 10 do x := x+1;

function FromDec(n, radix:longint):string;
var s: String;
const digit: string[16]='0123456789ABCDEF';
begin
s:='';
repeat
s:=digit[(n mod radix)+1]+s;
n:=n div radix;
until n=0;
FromDec:=s;
end;

APAL
Цитата
А я за семестр Паскаль в глаза не видела...

Как в присказке: Пока гром не грянет - мужик не перекрестится...
Цитата
Препод сказал, что б я еще в нем разбиралась и могла его объяснить...

А чтобы выполнить это условие - надо было с самого начала семестра заниматься... или как в анекдоте:
Студента спрашивают - за какое он время выучит китайский язык. Его ответ: "А когда экзамен?".
Галина М.
volvo спасибо тебе большое, завтра покажу преподу. С виду программа большая, может он смилуется надо мной...
volvo
Цитата
С виду программа большая

Основной критерий lol.gif

Но можно сделать еще больше ... Тем более, что она не совсем корректно работает...
Altair
а что уже милуют по размеру?

Дык тогда надо уже не оптимизировать алгоритмы, а наоборот как можно замедлять их! smile.gif + вывод всякой графики, плюс задержки smile.gif
arsen86
Как например в Microsoft, говорят, что пустые циклы кидали раньше в приложения, чтобы типа подольше загружались, для видаи для солидности smile.gif
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.