Pascal

[Ryster]

Welcome.
Would any of the honorable Forum members undertake to translate the code written in Pascal to QB64 ?. The code has about 60 lines.
Regards Ryster

[SMcNeill]

Can you share it?  It’s been a while, but I used to program in pascal ages ago.

[Pete]

Pascal is very similar to BASIC. I tried it several years go, when it looked like QB was headed to the graveyard. Fortunately QB64 got started before I spent much time in Pascal. My opinion was you can do more with '64.

Yes, share the code and what the program is supposed to do.

Pete

[TempodiBasic]

@Pete
Pascal = QB ?
in my experience (TurboPascal) this is not quite right!
1. very restrictive rules to code...  at first phase  declaration at second phase coding the algoritm (so often while I was starting to declare each variable I had already forgotten the main idea how to do something and  my fantasy was stopped very quickly!)
2. fine to have  inline assembler, calling to OS functions like interrupts (no coito interruptus censored), pointers, OOP (starting from 5.5 to up)

or do you think about https://it.wikipedia.org/wiki/COMAL COMAL?

[Pete]

It's coding statements are very similar to BASIC. The other stuff? WHOGAS!

Pete :D

[TempodiBasic]

I'm absolutely agreed with you!
(sob I don't remember who is WHOGAS! :-)  )
And I found very similar also the FORTRAN to the BASIC statements.

But how hard Pascal  is to force you to declare and then use something I find no equal in my little experience!
Good night ( at my clock) !

[Ryster]

Thank you for your interest.
Pram deals with the conversion of Julian Day (JD) to the Hebrew calendar. Input data: (JD) e.g. 2458541. Output data: day, month, year. As for JD, there is no need to use the Input function because JD will be downloaded automatically from another subprogram. Thank you very much to those who will change the code.

program J2Jewish;
{$APPTYPE CONSOLE}
uses
  SysUtils,
  math;
procedure JD2Jewish(JD:integer; var j,m,d:integer);
function c4(x1,x3:integer):integer;
function c1(x1:integer):integer;
begin
c1:=floor((235*x1+1)/19);
end;
function q(x1:integer):integer;
begin
q:=floor(c1(x1)/1095);
end;
function r(x1:integer):integer;
begin
r:=c1(x1) mod 1095;
end;
function v1(x1:integer):integer;
begin
v1:=32336*q(x1) + floor((15*q(x1)+765433*r(x1)+12084)/25920);
end;
function v2(x1:integer):integer;
begin
v2:=v1(x1) + floor(6*(v1(x1)/7)) mod 2;
end;
function L2(x1:integer):integer;
begin
L2:=v2(x1+1) - V2(x1);
end;
function c2(x1:integer):integer;
var v3,v4:integer;
begin
v3:=2*(floor((L2(x1)+19)/15) mod 2);
v4:=floor((L2(x1-1)+7)/15) mod 2;
c2:=v2(x1)+v3+v4
end;
var L,c8,c9,c3:integer;
begin
L:=c2(x1+1)-c2(x1);
c8:=floor((L+7)/2) mod 15;
c9:=-(floor((385-L)/2) mod 15);
c3:=floor((384*x3+7)/13) + c8*floor((x3+4)/12) + c9*floor((x3+3)/12);
c4:=c2(x1)+c3;
end;

var
    y4,y1p,gam1,ksi1,mi1,ksi2,mi2,c41p,q,r,dz1,gam2,ksi3,c42p,c43p,dz2,gam3,mi3,z4,c,x3,x1:integer;

begin
y4:=JD-347821;
q:=floor(y4/1447);
r:=y4 mod 1447;
y1p:=49*q+floor((23*q+25920*r+13835)/765433);
gam1:=y1p+1;
ksi1:=floor((19*gam1+17)/235);
mi1:=gam1-floor((235*ksi1+1)/19);
c41p:=c4(ksi1,mi1);
dz1:=y4-c41p;
gam2:=gam1 + floor(dz1/33);
ksi2:=floor( (19*gam2+17)/235 );
mi2:=gam2-floor( (235*ksi2+1)/19 );
c42p:=c4(ksi2,mi2);
dz2:=y4-c42p;
gam3:=gam2 + floor(dz2/33);
ksi3:=floor( (19*gam3+17)/235 );  x1:=ksi3;
mi3:=gam3-floor( (235*ksi3+1)/19 ); x3:=mi3;
c43p:=c4(ksi3,mi3);
z4:=y4-c43p;
c:=floor((12-x3)/7);
j:=x1+1-c;
m:=x3+1;
d:=z4+1;
end;
var JD:integer;
    j,m,d:integer;
begin
writeln(' np. JD=2057986');
write('JD ='); readln(JD);
//JD:=2057986;
JD2Jewish(JD,  j,m,d);
writeln(j,' ',m,' ',d);
readln;
end.

[jack]

I refactored the code to make it easier to follow and to translate to QB64

Code: QB64: [Select]

1. program J2Jewish;
2. //{$APPTYPE CONSOLE}
3. uses
4.         SysUtils,
5.         math;
6.  
7. function c1(x1:integer):integer;
8. begin
9.         c1:=floor((235*x1+1)/19);
10. end;
11.  
12. function q(x1:integer):integer;
13. begin
14.         q:=floor(c1(x1)/1095);
15. end;
16.  
17. function r(x1:integer):integer;
18. begin
19.         r:=c1(x1) mod 1095;
20. end;
21.  
22. function v1(x1:integer):integer;
23. begin
24.         v1:=32336*q(x1) + floor((15*q(x1)+765433*r(x1)+12084)/25920);
25. end;
26.  
27. function v2(x1:integer):integer;
28. begin
29.         v2:=v1(x1) + floor(6*(v1(x1)/7)) mod 2;
30. end;
31.  
32. function L2(x1:integer):integer;
33. begin
34.         L2:=v2(x1+1) - V2(x1);
35. end;
36.  
37. function c2(x1:integer):integer;
38. var v3,v4:integer;
39. begin
40.         v3:=2*(floor((L2(x1)+19)/15) mod 2);
41.         v4:=floor((L2(x1-1)+7)/15) mod 2;
42.         c2:=v2(x1)+v3+v4
43. end;
44.  
45. function c4(x1,x3:integer):integer;
46. var L,c8,c9,c3:integer;
47. begin
48.         L:=c2(x1+1)-c2(x1);
49.         c8:=floor((L+7)/2) mod 15;
50.         c9:=-(floor((385-L)/2) mod 15);
51.         c3:=floor((384*x3+7)/13) + c8*floor((x3+4)/12) + c9*floor((x3+3)/12);
52.         c4:=c2(x1)+c3;
53. end;
54.  
55. procedure JD2Jewish(JD:integer; var j,m,d:integer);
56.  
57. var
58.     y4,y1p,gam1,ksi1,mi1,ksi2,mi2,c41p,q,r,dz1,gam2,ksi3,c42p,c43p,dz2,gam3,mi3,z4,c,x3,x1:integer;
59.  
60. begin
61.         y4:=JD-347821;
62.         q:=floor(y4/1447);
63.         r:=y4 mod 1447;
64.         y1p:=49*q+floor((23*q+25920*r+13835)/765433);
65.         gam1:=y1p+1;
66.         ksi1:=floor((19*gam1+17)/235);
67.         mi1:=gam1-floor((235*ksi1+1)/19);
68.         c41p:=c4(ksi1,mi1);
69.         dz1:=y4-c41p;
70.         gam2:=gam1 + floor(dz1/33);
71.         ksi2:=floor( (19*gam2+17)/235 );
72.         mi2:=gam2-floor( (235*ksi2+1)/19 );
73.         c42p:=c4(ksi2,mi2);
74.         dz2:=y4-c42p;
75.         gam3:=gam2 + floor(dz2/33);
76.         ksi3:=floor( (19*gam3+17)/235 );  x1:=ksi3;
77.         mi3:=gam3-floor( (235*ksi3+1)/19 ); x3:=mi3;
78.         c43p:=c4(ksi3,mi3);
79.         z4:=y4-c43p;
80.         c:=floor((12-x3)/7);
81.         j:=x1+1-c;
82.         m:=x3+1;
83.         d:=z4+1;
84. end;
85.  
86. var JD:integer;
87.     j,m,d:integer;
88. begin
89.         writeln(' np. JD=2057986');
90.         write('JD ='); readln(JD);
91.         //JD:=2057986;
92.         JD2Jewish(JD,  j,m,d);
93.         writeln(j,' ',m,' ',d);
94.         readln;
95. end.
96.  

[Ryster]

Thanks, it looks nicer now.

[SMcNeill]

Most of these are pretty straightforward to translate:

function c1(x1:integer):integer;
begin
   c1:=floor((235*x1+1)/19);
end;


FUNCTION c1% (x1 AS INTEGER)
    c1% = (235 * x1 + 1) \ 19
END FUNCTION

*************

If nobody else gets around to it before me, I’ll work on translating it later tonight/tomorrow.  Today I’m booked up doing stuff with the wife, but my schedule should hopefully clear by tomorrow, I’m thinking.  (I can never be 100% certain until my wife verifies my schedule though.  After 26 years of marriage, I know my free time depends a lot more on HER schedule than it does mine.)  ;D

[jack]

there's something you should know, integer is 16-bit
so how this is supposed to work when 2057986 overflows a 16-bit integer, I don't know.

[Ryster]

SMcNeill
You're right, your wife is more important.

[SMcNeill]

there's something you should know, integer is 16-bit
so how this is supposed to work when 2057986 overflows a 16-bit integer, I don't know.

LONGs would work, if INTEGER doesn’t.  ;)

[Ryster]

For test purposes. No months names.

https://drive.google.com/file/d/1jWkbtj9RNBDShhGyS8zMjt5BWeMUZ9HD/view?usp=sharing

[jack]

I can't get QB64 to produce the right answer

Code: QB64: [Select]

1. ' program J2Jewish
2.  
3. DIM JD, j, m, d AS LONG
4.  
5. PRINT " np. JD=2057986"
6. 'NPUT "JD = "; JD
7. JD = 2057986
8. JD2Jewish JD, j, m, d
9. PRINT j; " "; m; " "; d
10.  
11.  
12. FUNCTION c1% (x1 AS LONG)
13.     c1% = INT((235 * x1 + 1) / 19)
14. END FUNCTION
15.  
16. FUNCTION q1% (x1 AS LONG)
17.     q1% = INT(c1%(x1) / 1095)
18. END FUNCTION
19.  
20. FUNCTION r1% (x1 AS LONG)
21.     r1% = c1%(x1) MOD 1095
22. END FUNCTION
23.  
24. FUNCTION v1% (x1 AS LONG)
25.     v1% = 32336 * q1%(x1) + INT((15 * q1%(x1) + 765433 * r1%(x1) + 12084) / 25920)
26. END FUNCTION
27.  
28. FUNCTION v2% (x1 AS LONG)
29.     v2% = v1%(x1) + INT(6 * (v1%(x1) / 7)) MOD 2
30. END FUNCTION
31.  
32. FUNCTION L2% (x1 AS LONG)
33.     L2% = v2%(x1 + 1) - v2(x1)
34. END FUNCTION
35.  
36. FUNCTION c2% (x1 AS LONG)
37.     DIM v3, v4 AS LONG
38.     v3 = 2 * (INT((L2%(x1) + 19) / 15) MOD 2)
39.     v4 = INT((L2%(x1 - 1) + 7) / 15) MOD 2
40.     c2 = v2%(x1) + v3 + v4
41. END FUNCTION
42.  
43. FUNCTION c4% (x1 AS LONG, x3 AS LONG)
44.     DIM L, c8, c9, c3 AS LONG
45.     L = c2%(x1 + 1) - c2%(x1)
46.     c8 = INT((L + 7) / 2) MOD 15
47.     c9 = -(INT((385 - L) / 2) MOD 15)
48.     c3 = INT((384 * x3 + 7) / 13) + c8 * INT((x3 + 4) / 12) + c9 * INT((x3 + 3) / 12)
49.     c4 = c2%(x1) + c3
50. END FUNCTION
51.  
52. SUB JD2Jewish (JD AS LONG, j AS LONG, m AS LONG, d AS LONG)
53.  
54.     DIM y4, y1p, gam1, ksi1, mi1, ksi2, mi2, c41p, q, r, dz1, gam2, ksi3, c42p, c43p, dz2, gam3, mi3, z4, c, x3, x1 AS LONG
55.  
56.     y4 = JD - 347821
57.     q = INT(y4 / 1447)
58.     r = y4 MOD 1447
59.     y1p = 49 * q + INT((23 * q + 25920 * r + 13835) / 765433)
60.     gam1 = y1p + 1
61.     ksi1 = INT((19 * gam1 + 17) / 235)
62.     mi1 = gam1 - INT((235 * ksi1 + 1) / 19)
63.     c41p = c4(ksi1, mi1)
64.     dz1 = y4 - c41p
65.     gam2 = gam1 + INT(dz1 / 33)
66.     ksi2 = INT((19 * gam2 + 17) / 235)
67.     mi2 = gam2 - INT((235 * ksi2 + 1) / 19)
68.     c42p = c4(ksi2, mi2)
69.     dz2 = y4 - c42p
70.     gam3 = gam2 + INT(dz2 / 33)
71.     ksi3 = INT((19 * gam3 + 17) / 235)
72.     x1 = ksi3
73.     mi3 = gam3 - INT((235 * ksi3 + 1) / 19)
74.     x3 = mi3
75.     c43p = c4(ksi3, mi3)
76.     z4 = y4 - c43p
77.     c = INT((12 - x3) / 7)
78.     j = x1 + 1 - c
79.     m = x3 + 1
80.     d = z4 + 1
81. END SUB
82.  

however, the following FreeBasic code gives the same answer as that of the pascal version, namely 17, 1, 28

Code: QB64: [Select]

1. ' program J2Jewish
2.  
3. function c1( byval x1 as short) as short
4.         c1=int((235*x1+1)/19)
5. end function
6.  
7. function q1(byval x1 as short) as short
8.         q1=int(c1(x1)/1095)
9. end function
10.  
11. function r1(byval x1 as short) as short
12.         r1=c1(x1) mod 1095
13. end function
14.  
15. function v1(byval x1 as short) as short
16.         v1=32336*q1(x1) + int((15.0*q1(x1)+765433.0*r1(x1)+12084)/25920)
17. end function
18.  
19. function v2(byval x1 as short) as short
20.         v2=v1(x1) + int(6.0*(v1(x1)/7)) mod 2
21. end function
22.  
23. function L2(byval x1 as short) as short
24.         L2=v2(x1+1) - V2(x1)
25. end function
26.  
27. function c2(byval x1 as short) as short
28.         dim as short v3, v4
29.         v3=2*(int((L2(x1)+19)/15) mod 2)
30.         v4=int((L2(x1-1)+7)/15) mod 2
31.         c2=v2(x1)+v3+v4
32. end function
33.  
34. function c4(byval x1  as short, x3 as short) as short
35.         dim as short L, c8, c9, c3
36.         L=c2(x1+1)-c2(x1)
37.         c8=int((L+7)/2) mod 15
38.         c9=-(int((385-L)/2) mod 15)
39.         c3=int((384.0*x3+7)/13) + c8*int((x3+4)/12) + c9*int((x3+3)/12)
40.         c4=c2(x1)+c3
41. end function
42.  
43. sub JD2Jewish(byval JD as short, byref j as short, byref m as short, byref d as short)
44.  
45.         dim as short y4,y1p,gam1,ksi1,mi1,ksi2,mi2,c41p,q,r,dz1,gam2,ksi3,c42p,c43p,dz2,gam3,mi3,z4,c,x3,x1
46.  
47.         y4=JD-347821
48.         q=int(y4/1447)
49.         r=y4 mod 1447
50.         y1p=49*q+int((23.0*q+25920.0*r+13835)/765433)
51.         gam1=y1p+1
52.         ksi1=int((19.0*gam1+17)/235)
53.         mi1=gam1-int((235.0*ksi1+1)/19)
54.         c41p=c4(ksi1,mi1)
55.         dz1=y4-c41p
56.         gam2=gam1 + int(dz1/33)
57.         ksi2=int( (19.0*gam2+17)/235 )
58.         mi2=gam2-int( (235.0*ksi2+1)/19 )
59.         c42p=c4(ksi2,mi2)
60.         dz2=y4-c42p
61.         gam3=gam2 + int(dz2/33)
62.         ksi3=int( (19.0*gam3+17)/235 )
63.         x1=ksi3
64.         mi3=gam3-int( (235.0*ksi3+1)/19 )
65.         x3=mi3
66.         c43p=c4(ksi3,mi3)
67.         z4=y4-c43p
68.         c=int((12-x3)/7)
69.         j=x1+1-c
70.         m=x3+1
71.         d=z4+1
72. end sub
73.  
74. 'main
75.         dim as short JD, j, m, d
76.  
77.         print " np. JD=2057986"
78.         'input "JD = "; JD
79.         JD=2057986
80.         JD2Jewish(JD,  j, m, d)
81.         print j;" "; m; " "; d
82.