Google Groups no longer supports new Usenet posts or subscriptions. Historical content remains viewable.
Dismiss

Programming in Pascal on HP48-49-50

251 views
Skip to first unread message

Nemo

unread,
Feb 6, 2011, 2:23:34 PM2/6/11
to
I always loved the Pascal language since the old Pascal USCD (Apple
II) to the Turbo Pascal version and Delphi. It seems that there are
only few people who knows that there is a Pascal compilateur for the
48 series by Ludovic de Jouvencel. The name of the package is "HP
PASCAL Studio" but has nothing in common with the HP Pascal from HP.

Here is the HP Pascal Studio web site (in french only) with exemple :

http://hppascal.free.fr/

I never used it in the past and I just began just test it now on my
50G. It is very interesting, not perfect of course (it is a project of
only _one_ man as far i know), with few bugs, but very fast with
graphics traitement for exemple.

The pascal 'extensions' looks very like the old Turbo Pascal versions.
For exemple you can easily insert Saturn code in Pascal procedures or
fonctions using the ASM command and exchange datas with the Pascal.

Not all the Pascal possibility are included (for exemple no pointers,
no records, no objects ...) but you can do a lot of things without
this :)

Here is my first program (breakout game) in HP Pascal. I am not sure
that my algoritms are the best way to do but it works ;)

Here a video exemple on a 50G :

http://www.dailymotion.com/video/xgwnh7_mur-de-brique-hp-pascal-hp50g_videogames

Here, the HP Pascal code for the game to see what you can do with HP
Pascal :

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

Program CasseBriques;
{ v0.1 5/2/11 - HP50G }

Uses SystemHP,CrtHPmini_49,GraphHP,GameHP,MathsHP_49,Default;

Static Mvt : Array[1..8, 1..3, 1..2] Of Integer =

1, 0, 1,-1, 1,-1 {Direction 1 -3---2- }
, 0,-1, 1,-1, 1,-1 {Direction 2 4-----1 }
, 0,-1,-1,-1,-1,-1 {Direction 3 ------- }
,-1, 0,-1,-1,-1,-1 {Direction 4 ---O--- }
,-1, 0,-1, 1,-1, 1 {Direction 5 ------- }
, 0, 1,-1, 1,-1, 1 {Direction 6 5-----8 }
, 0, 1, 1, 1, 1, 1 {Direction 7 -6---7- }
, 1, 1, 1, 0, 1, 1;{Direction 8 }

Var i, j, k, Rx, Bx, By, Bx2, By2,
Dir, Choc, b, Vies : Byte;
TapeMur, Perdu: Boolean;
Score : Integer;

Procedure DessineMur;
Begin
ClrScr;
Box(0,0,100,80); Bar(2,11,98,30);
For i:=1 To 5 Do ClearLineH(2,98,10+i*4);
For i:=1 To 14 Do ClearLineV(1+i*7,10,30);
Bar(Rx,78,Rx+9,79);
GotoXY(27,1); Write('Score:');
End;

Procedure BougeRaquette;
Var D : Char;
Begin
D:=' ';
For j:=1 To 15 Do Begin
If RightPressed Then D:='R';
If LeftPressed Then D:='L';
End;

Case D Of
'R': If Rx<89 Then
Begin
ClearLineV(Rx,78,79);
LineV(Rx+10,78,79);
Rx:=Rx+1;
End;
'L': If Rx>1 Then
Begin
ClearPixel(Rx+10,78); PutPixel(Rx,79);
ClearPixel(Rx+10,79); PutPixel(Rx,78);
Rx:=Rx-1;
End;
End;
End;

Procedure BougeBalle;
Var Mx,My : Integer;

Begin
i:=1;

Repeat
Bar(Bx,By,Bx+1,By+1);
BougeRaquette;
Bx2:=Bx+Mvt[Dir,i,1];
By2:=By+Mvt[Dir,i,2];
If Bx2>=99 Then Begin
Case Dir Of
1: Dir:=4;
2: Dir:=3;
7: Dir:=6;
8: Dir:=5;
End;
Bx2:=98;
Exit;
End;

If Bx2<=0 Then Begin
Case Dir Of
3: Dir:=2;
4: Dir:=1;
5: Dir:=8;
6: Dir:=7;
End;
Bx2:=2;
Exit;
End;

If By2<=0 Then Begin
Case Dir Of
1: Dir:=8;
2: Dir:=7;
3: Dir:=6;
4: Dir:=5;
End;
By2:=4;
Exit;
End;

BougeRaquette;

If By2=77 Then Begin
If ((Bx-Rx) in [0..9]) Then Begin
Case (Bx-Rx) Of
0 : Dir:=4;
1,2 : Case Dir Of 5,6: Dir:=4; 7,8: Dir:=3; End;
3..5: Dir:=9-Dir;
6,7 : Case Dir Of 5,6: Dir:=1; 7,8: Dir:=2; End;
8,9 : Dir:=1;
End;
End Else Begin
Perdu:=True; ClearBar(Bx,By,Bx+1,By+1);
End;
Exit;
End;

If By2<32 Then Begin
Choc:=0; TapeMur:=False;
ClearBar(Bx,By,Bx+1,By+1);
If Point(Bx2,By2) Then Choc:=1;
If Point(Bx2+1,By2) Then Choc:=Choc+2;
If Point(Bx2+1,By2+1) Then Choc:=Choc+4;
If Point(Bx2,By2+1) Then Choc:=Choc+8;
Bar(Bx,By,Bx+1,By+1);

Case Dir Of
1,2: Case Choc Of
1,3: Begin TapeMur:=True; Dir:=9-Dir; End;
2 : Begin TapeMur:=True; Dir:=Dir+4; End;
6,4: Begin TapeMur:=True; Dir:=Dir+2; End;
End;

3,4: Case Choc Of
2,3: Begin TapeMur:=True; Dir:=Dir+2; End;
1 : Begin TapeMur:=True; Dir:=Dir+4; End;
9,8: Begin TapeMur:=True; Dir:=5-Dir; End;
End;

5,6: Case Choc Of
4,12: Begin TapeMur:=True; Dir:=9-Dir; End;
8 : Begin TapeMur:=True; Dir:=Dir-4; End;
1,9 : Begin TapeMur:=True; Dir:=Dir+2; End;
End;

7,8: Case Choc Of
8,12: Begin TapeMur:=True; Dir:=9-Dir; End;
4 : Begin TapeMur:=True; Dir:=Dir-4; End;
2,6 : Begin TapeMur:=True; Dir:=Dir-2; End;
End;
End;

If TapeMur Then Begin
Mx:=((Bx2-1) Div 7)*7 + 1;
My:=((By2-10)Div 4)*4 + 10;
ClearBar(Mx,My,Mx+7,My+4);
Score:=Score+5; GotoXY(27,2); Write(Score);i:=3;
End;
End;
i:=i+1;
If By2<77 Then Begin
ClearBar(Bx,By,Bx+1,By+1);
Bar(Bx2,By2,Bx2+1,By2+1);
End;
Bx:=Bx2; By:=By2;
Until i=4;
End;

Begin

Score:=0; Vies:=10;
Rx:=35;
DessineMur;
Repeat
By:=75; Bx:=Rx+5; Dir:=Random(3)+1;
GotoXY(27,4); Write('Vies:');Write(Vies-1);
Perdu:=False;
Repeat Until EnterPressed;
DisableInterrupt;
Repeat
BougeBalle;
Until ExitPressed or Score=350 or Perdu;
ClearBar(Bx,By,Bx+1,By+1);
Vies:=Vies-1;
Until Vies=0 Or ExitPressed;

EnableInterrupt;
Repeat Until EnterPressed Or ExitPressed;

End.

Nemo

unread,
Feb 6, 2011, 6:16:16 PM2/6/11
to
If there is some interest note that you can create the Tetris program
for the HP50G with little changes in the Pascal Source. Juste change :

USES GameHp_49, MathsHp_49, SystemHp, CrtHp_49;

And of course choose 'HP49' for target

I also have change the MathsHP unit to work with 49-50. It use
unsupported entry (like the MathsHP for 48 do) in the 49-50 ROM but
works fine. I don't knows a lot about Saturn but try to understand
what do the Unit and debug with Jazz and change the entries. I'm not
sure it's very clean :O


Note that the ABS integer function don't works on my HP50. I dont
understand why...

UNIT MathsHP_49;

function Abs (x: integer): integer;
begin
asm
A=R1
D1=A
D1=D1+ 5
A=DAT1 A
D1=D1- 5
LC(5) #7FFFF
?A<C A
GOYES NoNeg
A=-A A
:NoNeg
DAT1=A
end;
end;

function Abs (x: real): real;
begin
asm
A=R1
D1=A
D1=D1+ 16
A=DAT1 W
D1=D1- 16
A=0 S
DAT1=A W
end;
end;

function Cos (x: real): real;
begin
asm
c=r1
d1=c
dat0=c a
d0=d0+ 5
c=r2
dat0=c a
d0=d0+ 5
c=r3
dat0=c a
d0=d0+ 5
c=r4
dat0=c a
cd0ex
rstk=c
d1=d1+ 16
a=dat1 w
gosbvl #31131 *SPLITA pour 49G et suivantes
HS=0 3
gosbvl #308e1 *GETANGMODE pour 49 etc.
gosbvl #310ba *COSF
gosbvl #2f47d *PACKSB
P== 0
SETHEX
c=rstk
d0=c
c=dat0 a
r4=c
d0=d0- 5
c=dat0 a
r3=c
d0=d0- 5
c=dat0 a
r2=c
d0=d0- 5
c=dat0 a
r1=c
d1=c
dat1=a w
end;
end;

function Sin (x: real): real;
begin
asm
c=r1
d1=c
dat0=c a
d0=d0+ 5
c=r2
dat0=c a
d0=d0+ 5
c=r3
dat0=c a
d0=d0+ 5
c=r4
dat0=c a
cd0ex
rstk=c
d1=d1+ 16
a=dat1 w
gosbvl #31131 *SPLITA pour 49G et suivantes
HS=0 3
gosbvl #308e1 *GETANGMODE pour 49 etc.
gosbvl #310B3 *SINF
gosbvl #2f47d *PACKSB
P== 0
SETHEX
c=rstk
d0=c
c=dat0 a
r4=c
d0=d0- 5
c=dat0 a
r3=c
d0=d0- 5
c=dat0 a
r2=c
d0=d0- 5
c=dat0 a
r1=c
d1=c
dat1=a w
end;
end;

function Tan (x: real): real;
begin
asm
c=r1
d1=c
dat0=c a
d0=d0+ 5
c=r2
dat0=c a
d0=d0+ 5
c=r3
dat0=c a
d0=d0+ 5
c=r4
dat0=c a
cd0ex
rstk=c
d1=d1+ 16
a=dat1 w

gosbvl #31131 *SPLITA pour 49G et suivantes
HS=0 3
gosbvl #308e1 *GETANGMODE pour 49 etc.
gosbvl #310C1 *TANF
gosbvl #2f47d *PACKSB

P== 0
SETHEX
c=rstk
d0=c
c=dat0 a
r4=c
d0=d0- 5
c=dat0 a
r3=c
d0=d0- 5
c=dat0 a
r2=c
d0=d0- 5
c=dat0 a
r1=c
d1=c
dat1=a w
end;
end;


function ASin (x: real): real;
begin
asm
c=r1
d1=c
dat0=c a
d0=d0+ 5
c=r2
dat0=c a
d0=d0+ 5
c=r3
dat0=c a
d0=d0+ 5
c=r4
dat0=c a
cd0ex
rstk=c
d1=d1+ 16
a=dat1 w
gosbvl #31131 *SPLITA pour 49G et suivantes
HS=0 3
gosbvl #308e1 *GETANGMODE pour 49 etc.
gosbvl #310CF *ASINF
gosbvl #2f47d *PACKSB
P== 0
SETHEX
c=rstk
d0=c
c=dat0 a
r4=c
d0=d0- 5
c=dat0 a
r3=c
d0=d0- 5
c=dat0 a
r2=c
d0=d0- 5
c=dat0 a
r1=c
d1=c
dat1=a w
end;
end;

function ACos (x: real): real;
begin
asm
c=r1
d1=c
dat0=c a
d0=d0+ 5
c=r2
dat0=c a
d0=d0+ 5
c=r3
dat0=c a
d0=d0+ 5
c=r4
dat0=c a
cd0ex
rstk=c
d1=d1+ 16
a=dat1 w
gosbvl #31131 *SPLITA pour 49G et suivantes
HS=0 3
gosbvl #308e1 *GETANGMODE pour 49 etc.
gosbvl #310D6 *ACOSF
gosbvl #2f47d *PACKSB
P== 0
SETHEX
c=rstk
d0=c
c=dat0 a
r4=c
d0=d0- 5
c=dat0 a
r3=c
d0=d0- 5
c=dat0 a
r2=c
d0=d0- 5
c=dat0 a
r1=c
d1=c
dat1=a w
end;
end;

function ATan (x: real): real;
begin
asm
c=r1
d1=c
dat0=c a
d0=d0+ 5
c=r2
dat0=c a
d0=d0+ 5
c=r3
dat0=c a
d0=d0+ 5
c=r4
dat0=c a
cd0ex
rstk=c
d1=d1+ 16
a=dat1 w
gosbvl #31131 *SPLITA pour 49G et suivantes
HS=0 3
gosbvl #308e1 *GETANGMODE pour 49 etc.
gosbvl #310C8 *ATANF
gosbvl #2f47d *PACKSB
P== 0
SETHEX
c=rstk
d0=c
c=dat0 a
r4=c
d0=d0- 5
c=dat0 a
r3=c
d0=d0- 5
c=dat0 a
r2=c
d0=d0- 5
c=dat0 a
r1=c
d1=c
dat1=a w
end;
end;

function Random (z: integer): integer;
var k:integer;
begin
asm
la(5) #104
D1=A
c=dat1 a
la(5) #FFF
c=c&a a
a=r1
d1=a
d1=d1+ #A
dat1=c a
end;
result := k*z div 4096;
end;


function Sqr (x: real): real;
begin
asm
c=r1
d1=c
dat0=c a
d0=d0+ 5
c=r2
dat0=c a
d0=d0+ 5
c=r3
dat0=c a
d0=d0+ 5
c=r4
dat0=c a
cd0ex
rstk=c
d1=d1+ 16
a=dat1 w


gosbvl #31131 *SPLITA pour 49G et suivantes
HS=0 3
gosbvl #317D2 *SQRT
gosbvl #2f47d *PACKSB

P== 0
SETHEX
c=rstk
d0=c
c=dat0 a
r4=c
d0=d0- 5
c=dat0 a
r3=c
d0=d0- 5
c=dat0 a
r2=c
d0=d0- 5
c=dat0 a
r1=c
d1=c
dat1=a w
end;
end;


function Ln (x: real): real;
begin
asm
c=r1
d1=c
dat0=c a
d0=d0+ 5
c=r2
dat0=c a
d0=d0+ 5
c=r3
dat0=c a
d0=d0+ 5
c=r4
dat0=c a
cd0ex
rstk=c
d1=d1+ 16
a=dat1 w

gosbvl #31131 *SPLITA pour 49G et suivantes
HS=0 3
gosbvl #3107B *LN
gosbvl #2f47d *PACKSB

P== 0
SETHEX
c=rstk
d0=c
c=dat0 a
r4=c
d0=d0- 5
c=dat0 a
r3=c
d0=d0- 5
c=dat0 a
r2=c
d0=d0- 5
c=dat0 a
r1=c
d1=c
dat1=a w
end;
end;

function Log (x: real): real;
begin
asm
c=r1
d1=c
dat0=c a
d0=d0+ 5
c=r2
dat0=c a
d0=d0+ 5
c=r3
dat0=c a
d0=d0+ 5
c=r4
dat0=c a
cd0ex
rstk=c
d1=d1+ 16
a=dat1 w

gosbvl #31131 *SPLITA pour 49G et suivantes
HS=0 3
gosbvl #31082 *LOG
gosbvl #2f47d *PACKSB

P== 0
SETHEX
c=rstk
d0=c
c=dat0 a
r4=c
d0=d0- 5
c=dat0 a
r3=c
d0=d0- 5
c=dat0 a
r2=c
d0=d0- 5
c=dat0 a
r1=c
d1=c
dat1=a w
end;
end;

Serguei TARASSOV

unread,
Mar 6, 2011, 6:40:35 PM3/6/11
to
Good job, thank for you example!
I prefer pascal-like languages too.
0 new messages