شاركـ ببرنامج

[pascal111]

قرأتُ في صغري في إحدى المجلات قول أحد المبرمجين المُحترفين حيث قال أنّ الطريق إلى إحتراف البرمجة يكون عن طريق برمجة البرامج القصيرة وبوفرة ،والظاهر أنّ هذه الطريقة تُكسب خبرة جيّدة في تعلم البرمجة إذ تُصادفكـ فكرة جديدة ومشكلة جديدة كلّ مرة في كل برنامج قصير بالإضافة إلى كونها وسيلة سريعة للتعلّم و الإرتقاء وهي تختلف عن برمجة البرامج الكاملة الطويلة ﻷنّ البرامج الطويلة رغم طولها إلّا أنّها قد لا تحتوي على تنوّع في المشاكل والأفكار التي تُساعد التعلّم وهذا لا يُغفِل قطعاً أهميّة برمجة البرامج الطويلة الكاملة والمشاريع ﻷنّها في النّهاية أحد أهداف البرمجة وليست بالطبع الهدف الوحيد.

من الأمور التي أُغرمت بها هو تحويل برامج لغة الـ BASIC الكلاسيكيّة إلى صورة البرمجة المرئيّة وذات المنطق ذي المستوى المرتفع مثلما في الـ Pascal وهذه الأعمال من ضمن الأعمال التي أود وأرغب مشاركة باقي الأعضاء بها وهذا الموضوع هنا مفتوح لكل الأعضاء الذين يودّون المشاركة بأي كود والغاية من ذلكـ أنّ هذه طريقة جيّدة للتعلّم ولتبادل الأفكار وباعتبار أنّني أنا شخصيّاً لستُ مُبرمجاً مُحترفاً فلا يحقّ لي أن أضع معايير مُرتفعة في الأكواد المسموح المشاركة بها هنا ولكن كلّ ما يراه أي عضو مفيداً لباقي زملائه فله مُطلق الحُريّة في مشاركتنا به ،يُمكنكـ أن تُشاركـ ولو بكود قصير حتّى يوضّح إستخدامات مُفيدة ﻷي مكون من مكونات اللغة أو أسلوب جديد أو حركة فنيّة مبدعة أو حتّى طريقة كلاسيكيّة بسيطة ولكنّكـ تراها مفيدة.

كذلكـ نُرحب جدّا بالتعليقات والإضافات من الأعضاء الآخرين لتعديل الأكواد وتطويرها للأفضل وإضافة الجديد.

[pascal111]

كود بسيط نقلته ممّا يُكافؤه من برنامج BASIC من إحدى الكتب والفكرة هي كيفيّة التأكّد من أنّ القيمة المُدخلة عدد صحيح وليس بعدد حقيقي ،الفكرة بسيطة جدّاً ولكنّها ذكيّة ونافعة في بعض المواطن ولا أدري هل لدى الـ FreePascal طريقة جاهزة من أجل هذه النقطة أم لا.

المثال كاملاً في المرفقات.

Code: Pascal  [Select][+][-]

1. procedure TForm1.Button1Click(Sender: TObject);
2.  
3. var
4.   err:integer;
5.   x:real;
6.  
7. begin
8.  
9.   val(edit1.Text,x,err);
10.  
11.   if err<>0 then
12.   begin
13.   showmessage('You entered incorrect numeric value!');
14.   exit;
15.   end;
16.  
17.   if x=trunc(x) then
18.   showmessage('You entred an integer value!')
19.   else
20.     showmessage('You entred a real value!');
21.  
22. end;                  
23.  

[pascal111]

هذا كود لفكرة بسيطة أعجبتني وهي إنتقاء الأعداد الزوجيّة من مجموعة من الأعداد عن طريق الـ operator المدعو mod.

المثال كاملاً بالمُرفقات.

Code: Pascal  [Select][+][-]

1. procedure TForm1.FormCreate(Sender: TObject);
2.  
3. var
4.   c:integer;
5.  
6. begin
7.  
8.   new(i);
9.  
10.   for c:=low(s) to high(s) do
11.   begin
12.  
13.     i^:=s[c];
14.     if (i^ mod 2 = 0) then
15.     memo1.Append(inttostr(i^));
16.  
17.   end;
18.  
19.   dispose(i);
20.  
21. end;                  
22.  

[pascal111]

هذا برنامج ساذج لجمع رقمين ولكن الجديد هنا هو استخدام المؤشرات بدلاً من المتغيرات العاديّة.

Code: Pascal  [Select][+][-]

1. procedure TForm1.Button1Click(Sender: TObject);
2.  
3. var
4.  
5.   x,y,z:^real;
6.   s:^string;
7.   err:integer;
8.  
9. begin
10.  
11.   new(x);
12.   new(y);
13.   new(z);
14.   new(s);
15.  
16.   val(edit1.text,x^,err);
17.   if err<>0 then
18.   begin
19.     showmessage('Incorrect numeric value is in 1st box!');
20.     exit;
21.   end;
22.  
23.   val(edit2.text,y^,err);
24.   if err<>0 then
25.   begin
26.     showmessage('Incorrect numeric value is in 2nd box!');
27.     exit;
28.   end;
29.  
30.   z^:=x^+y^;
31.   str(z^:6:2,s^);
32.   edit3.Text:=s^;
33.  
34.   dispose(x);
35.   dispose(y);
36.   dispose(z);
37.   dispose(s);
38. end;      
39.  

[pascal111]

هذا برنامج بسيط كنموذج لعمل برمجة مرئيّة دون حد النموذج.

Code: Pascal  [Select][+][-]

1. program project1;
2.  
3. {$mode objfpc}{$H+}
4.  
5. uses
6.   interfaces,
7.   {$IFDEF UNIX}{$IFDEF UseCThreads}
8.   cthreads,
9.   {$ENDIF}{$ENDIF}
10.   Classes, Dialogs, sysutils
11.   { you can add units after this };
12.  
13. var
14.  
15.   x:real;
16.   y:string;
17.   err:integer;
18.  
19. begin
20.  
21.  
22.   repeat
23.   y:=inputbox('Enter...','Enter correct numeric value:','');
24.   val(y,x,err);
25.   until (y<>'') and (err=0);
26.  
27.   showmessage(floattostr(x));
28.  
29. end.
30.  
31.  

[pascal111]

برنامج ظريف كنموذج للبرمجة المرئيّة لبرمجة برامج من نوع الـ command line الإعتياديّة بما يُقابلها في البرمجة المرئيّة.

Code: Pascal  [Select][+][-]

1. program project1;
2.  
3. {$mode objfpc}{$H+}
4.  
5. uses
6.   interfaces,
7.   {$IFDEF UNIX}{$IFDEF UseCThreads}
8.   cthreads,
9.   {$ENDIF}{$ENDIF}
10.   Classes, Dialogs, sysutils, forms, LCLType
11.   { you can add units after this };
12.  
13. var
14.  
15.   s:string;
16.   i:integer;
17.  
18. label
19.   again;
20.  
21. begin
22.  
23. again:
24.  
25.   s:=inputbox('Where...','Where you would like to put the cup?'+lineending+
26.   '1) On the table              2) On the air'+lineending+lineending+
27.   'Type ''1'' or ''2'':','');
28.  
29.   case s of
30.  
31.   '':
32.     begin
33.     showmessage('You canceled the game!');
34.     exit;
35.     end;
36.  
37.   '1': showmessage('The table bears the cup, it''s on the table.');
38.  
39.   '2': showmessage('The cup fell because the gravity and broken on the ground.');
40.  
41.   else
42.     begin
43.     showmessage('You entered invalid value!');
44.     goto again;
45.     end;
46.   end;
47.  
48.   i:=application.messagebox('Do you like playing again?', 'Again?',MB_YESNO+
49.   MB_ICONQUESTION);
50.  
51.   if i=idyes then goto again;
52.  
53. end.
54.  
55.  

[Handoko]

Thank you for sharing the simple text game.

Because Pascal encourages good programming practices using structured programming (https://en.wikipedia.org/wiki/Pascal_%28programming_language%29), I rewrote your code using more structural way:

Code: Pascal  [Select][+][-]

1. program project1;
2.  
3. {$mode objfpc}{$H+}
4.  
5. uses
6.   {$IFDEF UNIX}{$IFDEF UseCThreads}
7.   cthreads,
8.   {$ENDIF}{$ENDIF}
9.   Classes, Dialogs, sysutils, Forms, LCLType, Interfaces
10.   { you can add units after this };
11.  
12. procedure Play;
13. const
14.   LE = LineEnding;
15. var
16.   S: string;
17. begin
18.   repeat
19.  
20.     S := InputBox
21.     ('Where...',
22.      'Where you would like to put the cup?'       + LE +
23.      '1) On the table              2) On the air' + LE + LE +
24.      'Type ''1'' or ''2'':','');
25.  
26.     case S of
27.     '':   begin
28.           ShowMessage('You canceled the game!');
29.           Halt;
30.           end;
31.     '1':  begin
32.           ShowMessage('The table bears the cup, it''s on the table.');
33.           Exit;
34.           end;
35.     '2':  begin
36.           ShowMessage('The cup fell because the gravity and broken on the ground.');
37.           Exit;
38.           end
39.     else
40.       ShowMessage('You entered invalid value!');
41.     end;
42.  
43.   until False;
44. end;
45.  
46. var
47.   i: Integer;
48.  
49. begin
50.   repeat
51.     Play;
52.     i := Application.MessageBox
53.       ('Do you like playing again?', 'Again?', MB_YESNO + MB_ICONQUESTION);
54.   until i <> IDYES;
55. end.

Usually, it is good to avoid using label. Because using label often makes the code harder to debug. Most programmers against using it. Others allow using it but only for some extremely rare cases.

-edit-
It would be more correct to say:
Usually, it is good to avoid using GOTO. Because using GOTO often makes the code harder to debug. Most Pascal programmer against using it. Others allow using it but only for some extremely rare cases.

[pascal111]

Thank you for sharing the simple text game.

Because Pascal encourages good programming practices using structured programming (https://en.wikipedia.org/wiki/Pascal_%28programming_language%29), I rewrote your code using more structural way:

Code: Pascal  [Select][+][-]

1. program project1;
2.  
3. {$mode objfpc}{$H+}
4.  
5. uses
6.   {$IFDEF UNIX}{$IFDEF UseCThreads}
7.   cthreads,
8.   {$ENDIF}{$ENDIF}
9.   Classes, Dialogs, sysutils, Forms, LCLType, Interfaces
10.   { you can add units after this };
11.  
12. procedure Play;
13. const
14.   LE = LineEnding;
15. var
16.   S: string;
17. begin
18.   repeat
19.  
20.     S := InputBox
21.     ('Where...',
22.      'Where you would like to put the cup?'       + LE +
23.      '1) On the table              2) On the air' + LE + LE +
24.      'Type ''1'' or ''2'':','');
25.  
26.     case S of
27.     '':   begin
28.           ShowMessage('You canceled the game!');
29.           Halt;
30.           end;
31.     '1':  begin
32.           ShowMessage('The table bears the cup, it''s on the table.');
33.           Exit;
34.           end;
35.     '2':  begin
36.           ShowMessage('The cup fell because the gravity and broken on the ground.');
37.           Exit;
38.           end
39.     else
40.       ShowMessage('You entered invalid value!');
41.     end;
42.  
43.   until False;
44. end;
45.  
46. var
47.   i: Integer;
48.  
49. begin
50.   repeat
51.     Play;
52.     i := Application.MessageBox
53.       ('Do you like playing again?', 'Again?', MB_YESNO + MB_ICONQUESTION);
54.   until i <> IDYES;
55. end.

Usually, it is good to avoid using label. Because using label often makes the code harder to debug. Most programmers against using it. Others allow using it but only for some extremely rare cases.

تعديلاتكـ رائعة! لقد جعلت البرنامج فعلاً أكثر تطبيقاً لمفهوم البرمجة البنيويّة ،سأضع هذه التعديلات في الإعتبار. من الجدير بالذكر كما ذكرت عن الـ labels أنّ الباسكال منذ البدء وهي تتجه إلى البرمجة التي تمتاز بالـ goto-less أي الإستخدام الأقل لعبارة goto.

[pascal111]

هذا برنامج يسأل عن بعض المعلومات الشخصيّة ويُعلّق ببعض التعليقات الظريفة وفي النّهاية يعرض نموذجاً كصندوق حوار متقدّم لعرض ما سلف تدوينه من معلومات شخصيّة.

Code: Pascal  [Select][+][-]

1. program project1;
2.  
3. {$mode objfpc}{$H+}
4.  
5. uses
6.  
7.   {$IFDEF UNIX}{$IFDEF UseCThreads}
8.   cthreads,
9.   {$ENDIF}{$ENDIF}
10.   Classes, Dialogs, sysutils, forms, LCLType, interfaces, Unit1
11.   { you can add units after this };
12.  
13. type
14.  
15.   personal_card=record
16.     p_name:string[20];
17.     p_age:1..200;
18.     p_nationality:string[25];
19.   end;
20.  
21. var
22.  
23.   p:personal_card;
24.   s:string[20];
25.   i:real;
26.   err:integer;
27.  
28. begin
29.  
30.   repeat
31.   s:=inputbox('Name...', 'What''s your name (max 20 letters):','');
32.   if s='' then showmessage('You should enter a name!');
33.   until s<>'';
34.  
35.   p.p_name:=s;
36.  
37.   showmessage('Hi! '+p.p_name);
38.  
39.   repeat
40.   s:=inputbox('Age...', 'What''s your age (5 <= integer <= 200):','');
41.   if s='' then showmessage('You should enter an age!');
42.  
43.   val(s,i,err);
44.   if (err<>0) or (i<>trunc(i)) or (i<5) or (i>200) then
45.   begin
46.   showmessage('Invalid age value!');
47.   continue;
48.   end
49.   else
50.   break;
51.  
52.   until false;
53.  
54.   p.p_age:=trunc(i);
55.  
56.   case p.p_age of
57.  
58.   5..25: showmessage('You''re still young!');
59.  
60.   26..50: showmessage('You''re in the middle of the time''s sea!');
61.  
62.   51..200: showmessage('You lived happy golden eras!');
63.  
64.   end;
65.  
66.   repeat
67.   s:=inputbox('From...', 'Where are you from (max 25 letters):','');
68.   if s='' then showmessage('You should enter a name!');
69.   until s<>'';
70.  
71.   p.p_nationality:=s;
72.  
73.   showmessage(p.p_nationality+' is a nice place!');
74.  
75.   form1:=tform1.Create(nil);
76.  
77.   with form1 do
78.   begin
79.     with p do
80.     begin
81.  
82.       Edit1.text:=p_name;
83.       edit2.Text:=inttostr(p_age);
84.       edit3.Text:=p_nationality;
85.  
86.     end;
87.  
88.   end;
89.  
90.   form1.showmodal;
91.  
92.   FreeAndNil(form1);
93.  
94. end.
95.  
96.  

[pascal111]

برنامج غير كامل لاستخدام قيم مُعرّفة بنوع القوائم.

Code: Pascal  [Select][+][-]

1. program project1;
2.  
3. {$mode objfpc}{$H+}
4.  
5. uses
6.  
7.   {$IFDEF UNIX}{$IFDEF UseCThreads}
8.   cthreads,
9.   {$ENDIF}{$ENDIF}
10.   Classes, Dialogs, sysutils, forms, LCLType, interfaces
11.   { you can add units after this };
12.  
13. type
14.  
15.   deepness = ( depthless = 1, deep, very_deep);
16.  
17. var
18.  
19.   s, q:string;
20.  
21. begin
22.  
23.   repeat
24.  
25.  
26.   s:=inputbox('Pass', 'Choose (1 to 3 or e for exit):'+lineending+lineending+
27.   '1) Eyes  2) Glass  3) Space','');
28.  
29.   case s of
30.     '1':
31.       begin
32.       str(deepness(2),q);
33.       showmessage(q);
34.       end;
35.     '2':
36.       begin
37.       str(deepness(1),q);
38.       showmessage(q);
39.       end;
40.     '3':
41.       begin
42.       str(deepness(3),q);
43.       showmessage(q);
44.       end;
45.   end;
46.  
47.  
48.  
49.  
50.   until s='e';
51. end.
52.  
53.  

[pascal111]

للمبتدئين ،برنامج يستخدم دالة القيم العشوائيّة random.

Code: Pascal  [Select][+][-]

1. program project1;
2.  
3. {$mode objfpc}{$H+}
4.  
5. uses
6.  
7.   {$IFDEF UNIX}{$IFDEF UseCThreads}
8.   cthreads,
9.   {$ENDIF}{$ENDIF}
10.   Classes, Dialogs, sysutils, forms, LCLType, interfaces
11.   { you can add units after this };
12.  
13. type
14.  
15.   coin = (Head=1, Tail);
16.  
17.  
18. var
19.  
20.   c:coin;
21.   i:integer;
22.   s:string;
23.  
24. begin
25.  
26.   randomize;
27.  
28.   i:=random(2)+1;
29.   c:=coin(i);
30.   str(c,s);
31.  
32.   showmessage(s);
33.  
34.  
35. end.
36.  
37.  

[pascal111]

برنامج لجمع رقمين بطريقة فلسفيّة تُطبّق تناول الأخطاء.

Code: Pascal  [Select][+][-]

1. program project1;
2.  
3. {$mode objfpc}{$H+}
4.  
5. uses
6.  
7.   {$IFDEF UNIX}{$IFDEF UseCThreads}
8.   cthreads,
9.   {$ENDIF}{$ENDIF}
10.   Classes, Dialogs, sysutils, forms, LCLType, interfaces
11.   { you can add units after this };
12.  
13.  
14.  
15. var
16.  
17.   s:string;
18.   x, y:real;
19.   ok_value:(indeedOk, notOk);
20.  
21. begin
22.  
23.   repeat
24.      s:=inputbox('X value', 'Enter x value:','');
25.      ok_value:=indeedOk;
26.      try
27.  
28.        finally
29.  
30.          try
31.  
32.            x:=strtofloat(s);
33.  
34.          except
35.            on exception do
36.            begin
37.            showmessage('You entred invalid numeric value!');
38.            ok_value:=notOk;
39.            end;
40.  
41.        end;
42.  
43.      end;
44.  
45.   until ok_value=indeedOk;
46.  
47.   repeat
48.      s:=inputbox('Y value', 'Enter y value:','');
49.      ok_value:=indeedOk;
50.      try
51.  
52.        finally
53.  
54.          try
55.  
56.            y:=strtofloat(s);
57.  
58.          except
59.            on exception do
60.            begin
61.            showmessage('You entred invalid numeric value!');
62.            ok_value:=notOk;
63.            end;
64.  
65.        end;
66.  
67.      end;
68.  
69.   until ok_value=indeedOk;
70.  
71.   showmessage('x + y = '+ floattostr(x+y));
72.  
73. end.
74.  
75.  

[pascal111]

تعديل للكود السابق بحذف ما لا يلزم من تعليمات.

Code: Pascal  [Select][+][-]

1. program project1;
2.  
3. {$mode objfpc}{$H+}
4.  
5. uses
6.  
7.   {$IFDEF UNIX}{$IFDEF UseCThreads}
8.   cthreads,
9.   {$ENDIF}{$ENDIF}
10.   Classes, Dialogs, sysutils, forms, LCLType, interfaces
11.   { you can add units after this };
12.  
13.  
14.  
15. var
16.  
17.   s:string;
18.   x, y:real;
19.   ok_value:(indeedOk, notOk);
20.  
21. begin
22.  
23.   repeat
24.      s:=inputbox('X value', 'Enter x value:','');
25.      ok_value:=indeedOk;
26.  
27.         try
28.  
29.            x:=strtofloat(s);
30.  
31.          except
32.            on exception do
33.            begin
34.            showmessage('You entred invalid numeric value!');
35.            ok_value:=notOk;
36.            end;
37.  
38.        end;
39.  
40.  
41.   until ok_value=indeedOk;
42.  
43.   repeat
44.      s:=inputbox('Y value', 'Enter y value:','');
45.      ok_value:=indeedOk;
46.  
47.          try
48.  
49.            y:=strtofloat(s);
50.  
51.          except
52.            on exception do
53.            begin
54.            showmessage('You entred invalid numeric value!');
55.            ok_value:=notOk;
56.            end;
57.  
58.        end;
59.  
60.  
61.   until ok_value=indeedOk;
62.  
63.   showmessage('x + y = '+ floattostr(x+y));
64.  
65. end.
66.  
67.  

[pascal111]

تعديل الكود السابق بحسب مجهود الزميل @avk ويبدو أنّ هذه النسخة الأفضل من البرنامج.

Code: Pascal  [Select][+][-]

1.     program project1;
2.     {$mode objfpc}{$H+}
3.     uses
4.       {$IFDEF UNIX}{$IFDEF UseCThreads}
5.       cthreads,
6.       {$ENDIF}{$ENDIF}
7.       Classes, Dialogs, sysutils, forms, LCLType, interfaces
8.       { you can add units after this };
9.     var
10.       s: string;
11.       x, y: real;
12.     begin
13.       repeat
14.          s := InputBox('X value', 'Enter X value:','');
15.          try
16.            x := StrToFloat(s);
17.            break;
18.          except
19.            ShowMessage('You entered an invalid numeric value!');
20.          end;
21.       until False;
22.       repeat
23.          s := InputBox('Y value', 'Enter Y value:','');
24.          try
25.            y := StrToFloat(s);
26.            break;
27.          except
28.            ShowMessage('You entered an invalid numeric value!');
29.          end;
30.       until False;
31.       ShowMessage('x + y = ' + FloatToStr(x + y));
32.     end.
33.      
34.  

[Zaher]

لا يخطر على بالي شي حاليا
لكن كانت لدي هنالك فكرة نقل كود للغة BASIC من السي للباسكال، مهتمه تنفيذ مشاريع لغة بيسك بسيطة
الصراحة اني وجدته بسيط جدا و جميل فأحببت انت اتركه لاحدهم لكي يتعلم منه
قم بالمحاولة بتحويله
https://gist.github.com/pmachapman/661f0fff9814231fde48