Author Topic: Hisoft Pascal 4T  (Read 15227 times)

0 Members and 1 Guest are viewing this topic.

Offline AMSDOS

  • Supporter
  • 6128 Plus
  • *
  • Posts: 3.626
  • Country: au
    • index.php?action=treasury
    • Programs for Turbo Pascal 3
  • Liked: 892
  • Likes Given: 1551
Re: Hisoft Pascal 4T
« Reply #75 on: 12:39, 29 May 18 »

I was surprised but this one is slower than HP4T. Summarising the runtimes for the 256 digits of 'e' runs:


Code: [Select]
Locomotive BASIC  786s
Hisoft Pascal 4T   61s
Arnor BCPL         74s


I do like BCPL though. The Arnor ROM environment is great and with that one 'word' type it's proper retro-computing. :D 


That's an interesting discovery, not sure how that's improved on, it maybe something in the Library (HP generally compiles code 7kb in size, where's BCPL is around 4-5kb), though I also noticed you've told the compiler to switch off a few checks, I usually just disable the Keyboard Check {$C-}. I found an article a while ago in ACU from 1988 which features 3 different versions of a Star Dodger game, I typed in the BASIC and a version written in BCPL which performed at a blistering pace (so I went back to the BASIC version!  :D )


Quote
Good spot on the 3D Ball program by the way. I had a quick flick through my early UK Amstrad Users but didn't find the program then in 84/85. So, your listing is definitely the earlier of the two we've found so far. I suspect that Electron User one might have been recycled from an earlier Beeb publication but I'm not going to look too hard to find it.


Not really, back in the day I collected TAU, initially I didn't have the 3D Ball program, but had the magazine with the correction in it, and was able to order from their back issues Mail Order, so I was really pleased when that magazine arrived and had a bundle of programs to type-in from it.  :)


* Using some of the hardly used Amstrad compilers :D
* I use Firmware in my Assembly code :P
* Have interpreted some BASIC 1.1 programs for BASIC 1.0. :)

Offline AMSDOS

  • Supporter
  • 6128 Plus
  • *
  • Posts: 3.626
  • Country: au
    • index.php?action=treasury
    • Programs for Turbo Pascal 3
  • Liked: 892
  • Likes Given: 1551
Re: Hisoft Pascal 4T
« Reply #76 on: 00:32, 10 June 18 »

I've been familiar with this Psychedelic Plot from that John Keneally had published back in the early days of Amstrad Action for admiring the pattern it generated, though when I ran the BASIC program it took 7 minutes to complete and the math behind the program is quite complicated, so it just seemed to be an interesting program to translate.


Initially, I tried a coding the formula to the BASIC one:


Code: [Select]
30 z=SIN(ABS(y*(1+ABS(x))/10)^3+4*x*x)

which I think looked like this:


Code: [Select]
z:=sin(abs(y*(1+abs(x))/10)*EXP(3)+4*x*x

though after many tests, the coding wasn't returning the correct value, thus ending up with a different pattern (as shown in Screenshot 1). The culprit seems to be the Exponential number component, I don't know why though. I simplified the formula by breaking it down using the initial x & y values (-10) which abs converts to 10 and after dividing 10 I had a value of 11. Using my calculator 11^3 gives me 1331. This wasn't the answer I was getting in Hisoft Pascal, all I could do was write another variable, "v1" and have:


Code: [Select]
v1:=abs(y*(1+abs(x))/10)
v1:=(v1*v1*v1)+4*x*x;
z:=SIN(v1)


Initially I had in a PROCEDURE which I didn't like, so made z a FUNCTION, my only quibble being x & y are global variables, should of made my main program a procedure with the main program area calling it instead, but what's done is done with the correct pattern.


Code: [Select]
   10 PROGRAM TwoDimensionalFunctionPlots;
   20 {$C-}
   30
   40 VAR i : integer;
   50     y : real;
   60     x : real;
   70     xscale : integer;
   80     yscale : integer;
   90     zscale : real;
  100     x1 : integer;
  110     y1 : integer;
  120
  130 {$F ROUTINES.LIB}
  140
  150 FUNCTION z(x,y : real) : real;
  160 VAR v1 : real;
  170 BEGIN
  180   v1:=abs(y*(1+abs(x))/10);
  190   v1:=(v1*v1*v1)+4*x*x;
  200   v1:=sin(v1);
  210   z:=v1
  220 END;
  230
  240 BEGIN
  250   FOR i:=0 TO 13 DO
  260     ink(i,2*i);
  270   xscale:=10;
  280   yscale:=10;
  290   zscale:=0.2;
  300   mode(0);
  310   plot(116,302,13);
  320   drawr(408,0);
  330   drawr(0,-204);
  340   drawr(-408,0);
  350   drawr(0,204);
  360   origin(320,200,120,520,300,100);
  370   x1:=-200;
  380   x:=-1*xscale;
  390   WHILE (x<1*xscale) DO
  400   BEGIN
  410     y1:=-100;
  420     y:=-1*yscale;
  430     WHILE (y<1*yscale) DO
  440     BEGIN
  450       i:=entier(z(x,y)/zscale)+7;
  460       IF i<0 THEN i:=0;
  470       IF i>13 THEN i:=13;
  480       plot(x1,y1,i);
  490       y1:=y1+2;
  500       y:=y+0.02*yscale
  510     END;
  520     x1:=x1+4;
  530     x:=x+0.02*xscale
  540   END;
  550   user(#bc02)
  560 END.

* Using some of the hardly used Amstrad compilers :D
* I use Firmware in my Assembly code :P
* Have interpreted some BASIC 1.1 programs for BASIC 1.0. :)

Online revaldinho

  • CPC664
  • ***
  • Posts: 64
  • Country: gb
  • Liked: 112
  • Likes Given: 46
Re: Hisoft Pascal 4T
« Reply #77 on: 22:17, 10 June 18 »
I'd like to compile and run this but it needs a library file


Code: [Select]
{$F ROUTINES.LIB}

...which looks like a wrapper for the firmware functions.


Is this something you could share please ? Is it actually the multiple pages of functions at the back of the Pascal 4T manual ?


R

Offline AMSDOS

  • Supporter
  • 6128 Plus
  • *
  • Posts: 3.626
  • Country: au
    • index.php?action=treasury
    • Programs for Turbo Pascal 3
  • Liked: 892
  • Likes Given: 1551
Re: Hisoft Pascal 4T
« Reply #78 on: 00:54, 11 June 18 »
I'd like to compile and run this but it needs a library file


Code: [Select]
{$F ROUTINES.LIB}

...which looks like a wrapper for the firmware functions.


Is this something you could share please ? Is it actually the multiple pages of functions at the back of the Pascal 4T manual ?


R


Sorry I was posting the program just to show the layout. The original code can be looked up on CPC-Power under Psychedelic Plot, normally I include the links, though I'm unsure if they have been creating problems for @Gryzor on here.


For the ROUTINES.LIB, (sorry I should of explained) I've added it in the 3rd Attachment along with the code shown above 2DPLOT.PAS and the compiled progam 2DPLOT.BIN called "2D Function Plots (Hisoft Pascal 4t).zip"


The other thing I forgot to mention was when AA published this, they were saying it's a good program to experiment with the formula on Line 30, so in the z function you could use:


Code: [Select]
z:=sin(x)*sin(y)
z:=sin(y)/y*sin(x)
z:=sin(x*x+y*y)


though they even suggested coming up with your own formula.  :)  I was thinking about expanding the program to include all those formula's and draw them up one after another, though I've got other programs I need to work on.  :(
* Using some of the hardly used Amstrad compilers :D
* I use Firmware in my Assembly code :P
* Have interpreted some BASIC 1.1 programs for BASIC 1.0. :)

Offline AMSDOS

  • Supporter
  • 6128 Plus
  • *
  • Posts: 3.626
  • Country: au
    • index.php?action=treasury
    • Programs for Turbo Pascal 3
  • Liked: 892
  • Likes Given: 1551
Re: Hisoft Pascal 4T
« Reply #79 on: 06:55, 22 July 18 »
I've been working on some Dragon Curve problems using Hisoft Pascal. Initially I was able to rewrite one from the ZX Spectrum BASIC for Locomotive BASIC, though it uses a series of very clever jumps which is an endless loop.


Code: [Select]

5 MODE 0
10 level=15:insize=480
20 x=320:y=150
30 iters=2^level
40 qiter=256/iters
50 s=SQR(2):qpi=PI/4
60 rotation=0:iter=0:rq=1
70 DIM r(level)
75 GOSUB 80:END
80 REM Dragon
90 WHILE level=1
100   yn=SIN(rotation)*insize+y
110   xn=COS(rotation)*insize+x
120   PLOT x,y:DRAW xn,yn
130   iter=iter+1
140   x=xn:y=yn
150   RETURN
160 WEND
200 insize=insize/s
210 rotation=rotation+rq*qpi
220 level=level-1
230 r(level)=rq:rq=1
240 GOSUB 80
250 rotation=rotation-r(level)*qpi*2
260 rq=-1
270 GOSUB 80
280 rq=r(level)
290 rotation=rotation+rq*qpi
300 level=level+1
310 insize=insize*s
320 RETURN




The tricks involve the use of GOSUB and RETURN and what the values of the variables are such as level and rq. I was able to use IF conditioning in Pascal when a situation arrises, but forced to use GOTO to arrive in those sections within the Procedure, I thought I tried breaking up the parts into other Procedures, though it didn't seem to work as they need to work with that main procedure, though I found my main problem in my Pascal example is the stack memory is filled, eventually resulting in an Out of Memory Runtime Error. I tried resolving this by use of Pointers to mark and release, but had no joy with it.
I was still able to make a small demo which draws some Sea Horse shapes onscreen.



Code: [Select]
   10 PROGRAM Seahorse;
   20
   30 CONST pi = 3.141592654;
   31
   32 TYPE elem=RECORD
   33       p : ARRAY[1..15] OF integer
   35 END;
   36 link=^elem;
   40
   50 VAR level    : integer;
   60     insize   : real;
   70     x        : real;
   80     xn       : real;
   90     y        : real;
  100     yn       : real;
  120     s        : real;
  130     qpi      : real;
  140     rotation : real;
  150     iter     : real;
  170     rq       : integer;
  180     r        : link;
  190     cycle    : integer;
  191     xarray   : ARRAY[1..4] OF real;
  192     yarray   : ARRAY[1..4] OF real;
  193     stack    : link;
  200
  210 PROCEDURE mode(num : integer);
  220 BEGIN
  230   ra:=chr(num);
  240   user(#bc0e)
  250 END;
  251
  252 PROCEDURE grapen(col : integer);
  253 BEGIN
  254   ra:=chr(col);
  255   user(#bbde)
  256 END;
  260
  270 PROCEDURE plot(x,y : integer);
  280 BEGIN
  310   rde:=x;
  320   rhl:=y;
  330   user(#bbea)
  340 END;
  350
  360 PROCEDURE draw(x,y : integer);
  370 BEGIN
  380   rde:=x;
  390   rhl:=y;
  400   user(#bbf6)
  410 END;
  420
  430 PROCEDURE locate(x,y : integer);
  440 BEGIN
  450   rh:=chr(x);
  460   rl:=chr(y);
  470   user(#bb75)
  480 END;
  481
  482 PROCEDURE endprog;
  483 BEGIN
  484   user(#bb18);
  485   halt
  486 END;
  487
  488 PROCEDURE newcycle(phase : integer); FORWARD;
  490
  500 PROCEDURE dragon(phase:integer);
  510 LABEL 1,2;
  520 BEGIN
  530   IF level=1 THEN
  540   BEGIN
  550     yn:=SIN(rotation)*insize+y;
  560     xn:=COS(rotation)*insize+x;
  565     grapen(phase);
  570     plot(entier(x),entier(y));
  580     draw(entier(xn),entier(yn));
  590     iter:=iter+1.0;
  600     cycle:=cycle+1;
  610     IF (cycle>250) AND (phase=4) THEN endprog
  611      ELSE IF (cycle>250) AND (phase<4) THEN newcycle(phase);
  620     x:=xn; y:=yn;
  630     IF rq=1 THEN GOTO 1 ELSE GOTO 2
  640   END;
  650     insize:=insize/s;
  660     rotation:=rotation+rq*qpi;
  670     level:=level-1;
  680     r^.p[level]:=rq;
  690     rq:=1;
  700     dragon(phase);
  710     1: rotation:=rotation-r^.p[level]*qpi*2;
  720        rq:=-1;
  730        dragon(phase);
  740     2: rq:=r^.p[level];
  750        rotation:=rotation+rq*qpi;
  760        level:=level+1;
  770        insize:=insize*s;
  780     IF (rq=-1) THEN GOTO 2 ELSE GOTO 1
  790 END;
  791
  792 PROCEDURE newcycle;
  793 BEGIN
  794   IF phase=0 THEN mark(stack);
  795   IF phase<>0 THEN release(stack);
  796   new(r);
  797   cycle:=0;
  798   level:=15;
  799   insize:=480;
  800   phase:=phase+1;
  801   x:=xarray[phase]; y:=yarray[phase];
  802   s:=sqrt(2); qpi:=pi/4;
  803   rotation:=0.0; iter:=0.0; rq:=1;
  804   dragon(phase)
  805 END;
  806
  810 BEGIN
  820   mode(0);
  821   xarray[1]:=320.0; yarray[1]:=150.0;
  822   xarray[2]:=420.0; yarray[2]:=200.0;
  823   xarray[3]:=100.0; yarray[3]:=150.0;
  824   xarray[4]:=220.0; yarray[4]:=200.0;
  826   newcycle(0)
  827 END.


* Using some of the hardly used Amstrad compilers :D
* I use Firmware in my Assembly code :P
* Have interpreted some BASIC 1.1 programs for BASIC 1.0. :)

Offline funkheld

  • CPC664
  • ***
  • Posts: 76
  • Liked: 2
  • Likes Given: 0
Re: Hisoft Pascal 4T
« Reply #80 on: 14:48, 10 August 18 »
........................................

« Last Edit: 22:24, 14 November 18 by funkheld »

Offline funkheld

  • CPC664
  • ***
  • Posts: 76
  • Liked: 2
  • Likes Given: 0
Re: Hisoft Pascal 4T
« Reply #81 on: 14:49, 10 August 18 »

Hi good afternoon.
I would like to reserve 16000 bytes from $ 4000 for bank switching with the cpc6128 with HISOFT-PASCAL.


How is that possible?


Thank you.
greeting


Offline AMSDOS

  • Supporter
  • 6128 Plus
  • *
  • Posts: 3.626
  • Country: au
    • index.php?action=treasury
    • Programs for Turbo Pascal 3
  • Liked: 892
  • Likes Given: 1551
Re: Hisoft Pascal 4T
« Reply #82 on: 03:15, 11 August 18 »
Not easily if at all is the short answer.

When Hisoft Pascal 4t was written there were no 6128s or 64kb upgrades, though Disk Drives were around so there's a Disk version of that at least.

The main problem that springs to mind is where that Pascal code is situated. From within the Compiler environment code is situated where you don't want it (in the &4000-&7FFF range) and there's no way of telling it where you want your program to be. However, when the program is translated into object code and made into a binary file, the start of your program is transferred &17C4. You it maybe possible to have your procedures that deal in that additional 16k at the beginning of the program, Hisoft Pascal like BASIC has support for RSXs, so when loading Hisoft Pascal, you could tell it to reserve some space for a machine code routine.

Since there's a program in AA57 type-ins which handles the Pushing and Poping of screens, I'll use that to test with and post my results. Unsure how well that will go apart from the risk of having the compiler compile code above &4000. My example will only be a simple program though, the more involved the program becomes the risk of having code where you don't want it becomes the problem.


Update

Wasn't easy initially because I discovered the AA57 Push-Pop program was really a 6128 program (using 1.1 Firmware), though I knew of a hardware workaround which works on all-CPCs, I just hadn't done it in Assembly before. Eventually with some debugging that AA57 Push-Pop program was running on my Expanded Emulated 464 and 6128.


My Pascal program is very simple, it loads 4 Screens which I made using my unreleased Block Editor in Pascal, after each screen is loaded it's stored in banks c4 to c7, once it's completed loading the 4 screens (which is quite slow because of the specific nature of the files which Hisoft Pascal creates), Arrow Keys can be used to flip between any of the 4 screens (i.e. Up, Down for Screen 1 & 2, Left, Right for Screen 3 & 4).


The code generation in this case was minimal, with the code occupying &17C4 and ending at &1A9A, the Push-Pop routine to Store the Screens and Switch between them also used minimal code ranging from &A500 to &A560.


Here's a layout of that Pascal program (which is on the attached disk image):


Code: [Select]

   10 PROGRAM MemoryTest;
   20 {$C-}
   30
   40 TYPE file = ARRAY[1..12] OF char;
   50
   60 VAR kval : char;
   70
   80 PROCEDURE load(fn : file);
   90 BEGIN
  100   tin(fn,#c000)
  110 END;
  120
  130 PROCEDURE mode(no : integer);
  140 BEGIN
  150   ra:=chr(no);
  160   user(#bc0e)
  170 END;
  180
  190 PROCEDURE getscr;
  200 BEGIN
  210   load('SCREEN01.DAT');
  220   external('push',1);
  230   load('SCREEN02.DAT');
  240   external('push',2);
  250   load('SCREEN03.DAT');
  260   external('push',3);
  270   load('SCREEN04.DAT');
  280   external('push',4)
  290 END;
  300
  310 PROCEDURE ftchscr;
  320 BEGIN
  330   kval:=inch;
  340   CASE ord(kval) OF
  350    240 : external('pop',1);
  360    241 : external('pop',2);
  370    242 : external('pop',3);
  380    243 : external('pop',4)
  390   END
  400 END;
  410
  420 BEGIN
  430   mode(0);
  440   user(#bc02);
  450   user(#bb03);
  460   tin('push-pop.dat',#a500);
  470   user(#a500);
  480   getscr;
  490   REPEAT
  500     ftchscr;
  510   UNTIL ord(kval)=252;
  520   mode(2)
  530 END.




The only thing I forgot to put in it, was a simple test to check if the computer has 128kb, it's only really a program I wrote out of curiosity.
« Last Edit: 08:50, 11 August 18 by AMSDOS »
* Using some of the hardly used Amstrad compilers :D
* I use Firmware in my Assembly code :P
* Have interpreted some BASIC 1.1 programs for BASIC 1.0. :)

Offline funkheld

  • CPC664
  • ***
  • Posts: 76
  • Liked: 2
  • Likes Given: 0
Re: Hisoft Pascal 4T
« Reply #83 on: 13:32, 11 August 18 »
thanks.

what is plaece :
460 tin('push-pop.dat',#a500);

can you for me the source-code from push-pop.dat ?

tanks you.
« Last Edit: 13:34, 11 August 18 by funkheld »

Offline AMSDOS

  • Supporter
  • 6128 Plus
  • *
  • Posts: 3.626
  • Country: au
    • index.php?action=treasury
    • Programs for Turbo Pascal 3
  • Liked: 892
  • Likes Given: 1551
Re: Hisoft Pascal 4T
« Reply #84 on: 14:31, 11 August 18 »
thanks.

what is plaece :
460 tin('push-pop.dat',#a500);

So you can download my attached zip file with enclosed dsk image, which has that "push-pop.dat" routine along with the 4 screenshots I've attached above.


tin(<filename>,<start address>); is specific Hisoft Pascal 4 code to load a file, it can load data into an array or memory. The files that tin loads are also custom made - BASIC cannot read them and I don't know what kind of Assembly routine would be involved in loading them, however the example I made definitely shows tin loading the 16kb screens slower than a conventional LOADing of a 16Kb screen in BASIC.


Along with tin is tout(<filename>,<start address>,<length>); which is used to save data using the Hisoft Pascal 4 format.

The tricky thing about those routines is the filename itself. Unlike BASIC you can load a file of any character length, with tin the <filename> has a fixed length of 12 characters, so if my file was called "1.DAT", I need to insert 7 spaces between the 1 and the extension dot '.', or all-hell would break loose, so filenames with 8 characters+4 character extension are good.

Quote
can you for me the source-code from push-pop.dat ?

tanks you.


I've put this code on the CPCWiki as it maybe useful as a standard-alone routine, what I haven't put on the demo dsk is my program to load the standard binary file to hisoft pascal dat file converter, which I've never really being able to write a dedicated program for.


Since the push-pop.dat has an origin of &A500 it's possible to tell Hisoft Pascal 4 to protect this area when it asks for the RAM-Top at load time, in this case it would be &A4FF.
« Last Edit: 14:50, 11 August 18 by AMSDOS »
* Using some of the hardly used Amstrad compilers :D
* I use Firmware in my Assembly code :P
* Have interpreted some BASIC 1.1 programs for BASIC 1.0. :)

Offline funkheld

  • CPC664
  • ***
  • Posts: 76
  • Liked: 2
  • Likes Given: 0
Re: Hisoft Pascal 4T
« Reply #85 on: 17:58, 11 August 18 »
hello thanks for your help and the software.
still have not understood completely.does the beom cpc6128 use bankswitching?

Thank you.
greeting

« Last Edit: 18:08, 11 August 18 by funkheld »

Offline AMSDOS

  • Supporter
  • 6128 Plus
  • *
  • Posts: 3.626
  • Country: au
    • index.php?action=treasury
    • Programs for Turbo Pascal 3
  • Liked: 892
  • Likes Given: 1551
Re: Hisoft Pascal 4T
« Reply #86 on: 07:49, 12 August 18 »
hello thanks for your help and the software.
still have not understood completely.does the beom cpc6128 use bankswitching?

Thank you.
greeting


The 6128 has what is referred to as KL RAM SELECT (&BD5B) in it's firmware, though on the Wiki it states it's only available for 6128, which kind of makes it totally useless, because you cannot use it on a 464 or 664 with either 64k or 128k just to test and see if they had at least 128K.
Using the hardware approach, it's compatible with all the systems and tests can be carried out to determine if a system has 128k as shown in the screenshots. If the system only has 64k, using the hardware approach to test that doesn't seem to be a problem as the other screenshot shows.
« Last Edit: 07:56, 12 August 18 by AMSDOS »
* Using some of the hardly used Amstrad compilers :D
* I use Firmware in my Assembly code :P
* Have interpreted some BASIC 1.1 programs for BASIC 1.0. :)

Offline AMSDOS

  • Supporter
  • 6128 Plus
  • *
  • Posts: 3.626
  • Country: au
    • index.php?action=treasury
    • Programs for Turbo Pascal 3
  • Liked: 892
  • Likes Given: 1551
Re: Hisoft Pascal 4T
« Reply #87 on: 09:06, 14 August 18 »
Finally got around to getting a workable Dragon Curve in Hisoft Pascal. It still fills up memory by using a complicated loop cycle which has the routine calling itself. I was able to create a more workable version by removing the GOTOs and setup additional procedures to deal in the rotation. Once the other procedures were defined, the code looked a bit clearer and I was able to use the Loop Cycle to exit the complicated Loop - thus reverting Stack from Filling up memory.


Today I managed to add some final touches to the code, by allowing some different colours for each Dragon Curve cycle.


The complete program is here if people want to compile the code, alternatively I've attached a Zipped DSK image with contains Binary and Source file.


Code: [Select]

   10 PROGRAM DragonCurve;
   20
   30 CONST pi = 3.141592654;
   40
   50 VAR level    : integer;
   60     insize   : real;
   70     x        : real;
   80     xn       : real;
   90     y        : real;
  100     yn       : real;
  110     s        : real;
  120     qpi      : real;
  130     rotation : real;
  140     iter     : real;
  150     rq       : integer;
  160     r        : ARRAY[1..15] OF integer;
  170     cycle    : integer;
  180
  190 PROCEDURE mode(num : integer);
  200 BEGIN
  210   ra:=chr(num);
  220   user(#bc0e)
  230 END;
  240
  250 PROCEDURE plot(x,y,col : integer);
  260 BEGIN
  270   ra:=chr(col);
  280   user(#bbde);
  290   rde:=x;
  300   rhl:=y;
  310   user(#bbea)
  320 END;
  330
  340 PROCEDURE draw(x,y : integer);
  350 BEGIN
  360   rde:=x;
  370   rhl:=y;
  380   user(#bbf6)
  390 END;
  400
  410 PROCEDURE dragon(col : integer); FORWARD;
  420
  430 PROCEDURE decrotate(col : integer);
  440 BEGIN
  450   rotation:=rotation-r[level]*qpi*2;
  460   rq:=-1;
  470   dragon(col)
  480 END;
  490
  500 PROCEDURE incrotate(col : integer);
  510 BEGIN
  520   rq:=r[level];
  530   rotation:=rotation+rq*qpi;
  540   level:=level+1;
  550   insize:=insize*s;
  560   IF rq=-1 THEN incrotate(col) ELSE decrotate(col)
  570 END;
  580
  590 PROCEDURE dragon;
  600 BEGIN
  610   IF (level=1) AND (cycle<500) THEN
  620   BEGIN
  630     yn:=SIN(rotation)*insize+y;
  640     xn:=COS(rotation)*insize+x;
  650     plot(entier(x),entier(y),col);
  660     draw(entier(xn),entier(yn));
  670     iter:=iter+1.0;
  680     cycle:=cycle+1;
  690     x:=xn; y:=yn;
  700     IF rq=1 THEN decrotate(col) ELSE incrotate(col)
  710   END;
  720   WHILE cycle<>500 DO
  730   BEGIN
  740     insize:=insize/s;
  750     rotation:=rotation+rq*qpi;
  760     level:=level-1;
  770     r[level]:=rq;
  780     rq:=1;
  790     dragon(col)
  800   END
  810 END;
  820
  830 BEGIN
  840   mode(0);
  850   cycle:=0;
  860   level:=15;
  870   insize:=480;
  880   x:=320.0; y:=150.0;
  890   s:=sqrt(2); qpi:=pi/4;
  900   rotation:=0.0; iter:=0.0; rq:=1;
  910   dragon(;
  920   cycle:=0;
  930   dragon(9);
  940   cycle:=0;
  950   dragon(12);
  960   cycle:=0;
  970   dragon(13)
  980 END.
* Using some of the hardly used Amstrad compilers :D
* I use Firmware in my Assembly code :P
* Have interpreted some BASIC 1.1 programs for BASIC 1.0. :)

Offline AMSDOS

  • Supporter
  • 6128 Plus
  • *
  • Posts: 3.626
  • Country: au
    • index.php?action=treasury
    • Programs for Turbo Pascal 3
  • Liked: 892
  • Likes Given: 1551
Re: Hisoft Pascal 4T
« Reply #88 on: 15:05, 25 August 18 »
Earlier when I created the Extra Memory Test routine to see how Hisoft Pascal would handle the Upper 64k. While the 4 Screens were loading it seemed as if the Alternating Colours of the Cursor were Alternating during the Data Load.
I wrote this routine to test that, though after tests between DSK and CDT versions, that's not the case. However, it's got some bits and pieces I converted from BASIC snippets and once the screen has been loaded, SCR BASE SET is used to set the screen at &4000. I wrote a warning in the source as a reminder of not run the code while in the Compiler, a Binary has been compiled and on the attached DSK image.


Code: [Select]
   10 PROGRAM AnimationTest;
   20 {$C-}
   30
   40 TYPE palette = ARRAY[1..10] OF char;
   50
   60 PROCEDURE mode(n: integer);
   70 BEGIN
   80   ra:=chr(n);
   90   user(#bc0e)
  100 END;
  110
  120 PROCEDURE border(col : integer);
  130 BEGIN
  140   rb:=chr(col);
  150   rc:=chr(col);
  160   user(#bc38)
  170 END;
  180
  190 PROCEDURE ink(p,c1,c2 : integer);
  200 BEGIN
  210   ra:=chr(p);
  220   rb:=chr(c1);
  230   rc:=chr(c2);
  240   user(#bc32)
  250 END;
  260
  270 PROCEDURE inkset(ch : palette);
  280 VAR col : integer;
  290     lp  : integer;
  300 BEGIN
  310   FOR lp:=1 TO 10 DO
  320   BEGIN
  330     col:=ord(ch[lp])-64;
  340     ra:=chr(lp-1);
  350     rb:=chr(col);
  360     rc:=chr(col);
  370     user(#bc32)
  380   END
  390 END;
  400
  410 PROCEDURE scrbase(scr : integer);
  420 { ** WARNING ** Only Use IN Compiled Programs }
  430 BEGIN
  440   ra:=chr(scr);
  450   user(#bc08)
  460 END;
  470
  480 PROCEDURE triangles(x,y,w,l,c : integer);
  490 VAR c2 : integer;
  500     c3 : integer;
  510      r : integer;
  520 BEGIN
  530   c2:=c;
  540   c3:=c2-2;
  550   r:=0;
  560   REPEAT
  570     ra:=chr(c2);
  580     user(#bbde);
  590     rde:=x;
  600     rhl:=y;
  610     user(#bbea);
  620     rde:=x+w;
  630     rhl:=y;
  640     user(#bbf6);
  650     rde:=x+w;
  660     rhl:=y+l;
  670     user(#bbf6);
  680     rde:=x;
  690     rhl:=y;
  700     user(#bbf6);
  710     c2:=c2-1;
  720     IF c2=c3 THEN c2:=c;
  730     IF c3<=0 THEN c2:=2;
  740     x:=x-4; y:=y-2; w:=w+6; l:=l+6;
  750     r:=r+1
  760   UNTIL r=3
  770 END;
  780 BEGIN
  790   mode(1);
  800   border(0);
  810   ink(3,18,18); ink(2,0,26); ink(1,15,15);
  820   triangles(320,200,50,50,3);
  830   triangles(200,100,100,100,1);
  840   triangles(400,100,20,20,1);
  850   triangles(400,300,75,75,3);
  860   triangles(50,300,30,30,3);
  870   tin('SCREEN  .DAT',#4000);
  880   inkset('@ZROFCBMLP');
  890   mode(0);
  900   scrbase(#40)
  910 END.


Initially, I created the screen using the BASIC Art program from AA73 Type-ins and use my rough Pascal program to Load the Data and Save using TOUT routine. After some conversations, I thought I'd take a look and see if I could make an Assembly routine which Loads what Pascal saved. Hisoft Pascal can use TIN and TOUT for various applications (all data based), so what I've created here simply loads the SCREEN.DAT screen. Hisoft Pascal seems to store 2 bytes at the beginning of the file which looks like an address marker, though I'm unsure what it represents as the address stored doesn't seem to have any meaning. It's for that reason why I've called CALL &BC80 twice before going into the readchar loop, once the carry flag is false, the routine exits.


Code: [Select]
   org &2000


   ;; Assembly routine to load data
   ;; as saved in Hisoft Pascal using
   ;; TOUT(<filename>,<start addr>,<length>);
   ;; This routine can be used to load a
   ;; screen.


   ld b,10
   ld hl,testfile
   ld de,buffer
   call &bc77


   call &bc80   ;; Read 1st Byte


   ld hl,addr
   ld (hl),a   ;; Put Low byte into Addr
   call &bc80   ;; Read 2nd Byte
   inc hl      ;; Increase Addr
   ld (hl),a   ;; Put High Byte into Addr


.readchar
   call &bc80
   push hl
   ld hl,(data)
   ld (hl),a
   inc hl
   ld (data),hl
   pop hl
   jr c,readchar


.eof_found
   call &bc7a
   ld hl,&c000
   ld (data),hl
   ret
.testfile
   defb "SCREEN.DAT"
.addr   defw 0
.data   defw &c000
.buffer   defs 2048
« Last Edit: 15:08, 25 August 18 by AMSDOS »
* Using some of the hardly used Amstrad compilers :D
* I use Firmware in my Assembly code :P
* Have interpreted some BASIC 1.1 programs for BASIC 1.0. :)

Offline AMSDOS

  • Supporter
  • 6128 Plus
  • *
  • Posts: 3.626
  • Country: au
    • index.php?action=treasury
    • Programs for Turbo Pascal 3
  • Liked: 892
  • Likes Given: 1551
Re: Hisoft Pascal 4T
« Reply #89 on: 13:01, 04 September 18 »
Continuing along the screens and AA Type-ins, I've created an interactive program for Loading Screens, adjusting the Ink Palette and then compressing the screen. The compression routine comes from the Squeeze program which was in AA57 Type-ins.


Upon loading SQSCR.BIN:

* L - Displays the Disk Directory, Asks for a filename (excluding extension), and Screen Mode.

* I - Displays the Ink Palette, depending on the mode your in the size of the Palette varies from 16 to 4 to 2. Cursor keys (Left or Right) allow you to select which Ink you want with Up or Down Cursor to Increase/Decrease the Colour and allowing the user to play around with Desirable Colours. Upon exiting the area the Ink Palette occupies is restored with Screen image.

* S - Upon selecting this option SQ.DAT is loaded and called, the routine itself is still in it's original format which Loads at &3F00, the routine works by gathering Screen Mode, Ink and Even Border (which I need to add to my program) and then compresses the screen. A second routine located at &4000, focuses on Drawing the Compressed Image back to the screen.
Unfortunately, when I wrote this into the program earlier, I wanted to Load SQ.DAT at the start of my program (and have it in memory), unfortunately because it resides so low in Memory I discovered other bits of Data were overwriting this and causing the program to crash. The main culprit appears to be the routine to Load the screen and perhaps specifically the External RSX I'm using to Display the Directory. Because of that I seem to be limited to loading SQ.DAT when I need to Squeeze the Screen, otherwise relocating the routine to Compress the screen and Decompress the Screen where I can protect the memory from anything writing it there is perhaps a better option.
Forgot to add that once the Screen has been Compressed, a check is carried out to determine if screen is smaller than original screen, if that's the case, then a standard Binary File is saved.


Though for now, this is what I've done and can be downloaded here:


Code: [Select]

   10 PROGRAM DrawScreen;
   20 {$C-}
   30
   40 TYPE name = ARRAY[1..12] OF char;
   50
   60 VAR ky : char;
   70     p1 : integer;
   80     ps : integer;
   90     sfile : name;
  100
  110 FUNCTION scr(x,y,seg,base : integer) : integer;
  120 BEGIN
  130   scr:=base+x+(y*#800)+seg
  140 END;
  150
  160 PROCEDURE ldir(st,dst,lgth : integer);
  170 BEGIN
  180   rhl:=st; rde:=dst; rbc:=lgth;
  190   user(#b91b)
  200 END;
  210
  220 PROCEDURE load(file : name; adress : integer);
  230 BEGIN
  240   rb:=chr(size(file));
  250   rhl:=addr(file);
  260   rde:=adress;
  270   user(#bc77);
  280   rhl:=adress;
  290   user(#bc83);
  300   user(#bc7a)
  310 END;
  320
  330 PROCEDURE mode(no : integer);
  340 BEGIN
  350   ra:=chr(no);
  360   user(#bc0e)
  370 END;
  380
  390 PROCEDURE locate(x,y : integer);
  400 BEGIN
  410   rh:=chr(x);
  420   rl:=chr(y);
  430   user(#bb75)
  440 END;
  450
  460 PROCEDURE ink(i,col : integer);
  470 BEGIN
  480   ra:=chr(i);
  490   rb:=chr(col);
  500   rc:=chr(col);
  510   user(#bc32)
  520 END;
  530
  540 FUNCTION gink(col : integer) : integer;
  550 BEGIN
  560   ra:=chr(col);
  570   user(#bc35);
  580   gink:=ord(rb)
  590 END;
  600
  610 FUNCTION gmode : integer;
  620 BEGIN
  630   user(#bc11);
  640   gmode:=ord(ra)
  650 END;
  660
  670 PROCEDURE pen(col : integer);
  680 BEGIN
  690   ra:=chr(col);
  700   user(#bb90)
  710 END;
  720
  730 PROCEDURE restorescr(bg, dst : integer);
  740 VAR loop : integer;
  750     st,st2 : integer;
  760 BEGIN
  770   st:=0; st2:=0;
  780   FOR loop:=0 TO 7 DO
  790   BEGIN
  800     ldir(bg+st2,dst+st,#004f);
  810     st:=st+#800; st2:=st2+#50
  820   END
  830 END;
  840
  850 PROCEDURE savescr(bg, dst : integer);
  860 VAR loop     : integer;
  870     st,st2   : integer;
  880 BEGIN
  890   st:=0; st2:=0;
  900   FOR loop:=0 TO 7 DO
  910   BEGIN
  920     ldir(bg+st,dst+st2,#004f);
  930     st:=st+#800; st2:=st2+#50
  940   END
  950 END;
  960
  970
  980 PROCEDURE pallete(mde : integer);
  990 VAR loop : integer;
 1000     xpos : integer;
 1010     ypos : integer;
 1020     ch   : char;
 1030     cols : ARRAY[0..15] OF integer;
 1040 BEGIN
 1050   savescr(#C000,#8000);
 1060   savescr(#C050,#8280);
 1070   FOR loop:=0 TO mde DO
 1080   BEGIN
 1090     locate(loop+1,1); pen(loop);
 1100     write(chr(143));
 1110     cols[loop]:=gink(loop)
 1120   END;
 1130   xpos:=1; ypos:=2;
 1140   locate(xpos,ypos); pen(1); write(chr(244));
 1150   WHILE ord(ch)<>13 DO
 1160   BEGIN
 1170     REPEAT ch:=inch UNTIL ch<>chr(0);
 1180     CASE ord(ch) OF
 1190      243 : IF (xpos<mde+1) THEN
 1200            BEGIN
 1210              locate(xpos,ypos);
 1220              write(' ');
 1230              xpos:=xpos+1;
 1240              locate(xpos,ypos);
 1250              write(chr(244))
 1260            END;                     
 1270      242 : IF (xpos>1) THEN
 1280            BEGIN
 1290              locate(xpos,ypos);
 1300              write(' ');
 1310              xpos:=xpos-1;
 1320              locate(xpos,ypos);
 1330              write(chr(244))
 1340            END;
 1350      240 : IF (cols[xpos-1]<26) THEN
 1360            BEGIN
 1370              cols[xpos-1]:=cols[xpos-1]+1;
 1380              ink(xpos-1,cols[xpos-1])
 1390            END;
 1400      241 : IF (cols[xpos-1]>0) THEN
 1410            BEGIN
 1420              cols[xpos-1]:=cols[xpos-1]-1;
 1430              ink(xpos-1,cols[xpos-1])
 1440            END
 1450     END
 1460   END;
 1470   restorescr(#8000,#C000);
 1480   restorescr(#8280,#C050);
 1490 END; {palette}
 1500
 1510 PROCEDURE SelectFile;
 1520 VAR file : name;
 1530     loop : integer;
 1540     mde  : integer;
 1550 BEGIN
 1560   user(#bb03);
 1570   loop:=1;
 1580   locate(1,1);
 1590   external('dir','*.SCR');
 1600   locate(1,12);
 1610   write('Enter Filename (excluding extension):');
 1620   readln; read(file);
 1630   REPEAT
 1640     WHILE (file[loop]=chr(0)) DO
 1650       file[loop]:=chr(32);
 1660     loop:=loop+1
 1670   UNTIL loop=12;
 1680   file[9]:='.'; file[10]:='S'; file[11]:='C'; file[12]:='R';
 1690   FOR loop:=1 TO 9 DO
 1700     sfile[loop]:=file[loop];
 1710   sfile[10]:='B'; sfile[11]:='I'; sfile[12]:='N';
 1720   writeln;
 1730   REPEAT
 1740     locate(1,14);
 1750     write('Enter Screen Mode (0-2):');
 1760     readln; read(mde);
 1770     locate(25,14); write('  ')
 1780   UNTIL (NOT errflg) AND ((mde>-1) AND (mde<3));
 1790   mode(mde);
 1800   load(file,#C000)
 1810 END;
 1820
 1830 PROCEDURE Squeeze;
 1840 VAR bs : char;
 1850     sz : integer;
 1860 BEGIN
 1870   tin('sq      .dat',#3f00);
 1880   user(#3f00);
 1890   bs:=peek(#4099,char);
 1900   sz:=ord(peek(#409b,char))*256+ord(peek(#409a,char))-#4000;
 1910   IF (ord(bs)<>255) AND (sz>0) OR (sz<#4000) THEN
 1920   BEGIN
 1930     rb:=chr(size(sfile));
 1940     rhl:=addr(sfile);
 1950     user(#bc8c);
 1960     rhl:=#4000;
 1970     rde:=sz;
 1980     ra:=chr(2);
 1990     user(#bc98);
 2000     user(#bc8f)
 2010   END
 2020 END;
 2030
 2040 BEGIN
 2050   mode(2); locate(1,1);
 2060   write('L = Load Screen, I = Ink Palette, S = Squeeze Screen');
 2070   user(#bb03);
 2080   WHILE ky<>chr(252) DO
 2090   BEGIN
 2100     p1:=gmode;
 2110     IF p1=0 THEN ps:=15;
 2120     IF p1=1 THEN ps:=3;
 2130     IF p1=2 THEN ps:=1;
 2140     REPEAT ky:=inch; UNTIL ky<>chr(0);
 2150     CASE ord(ky) OF
 2160      73, 105 : pallete(ps);
 2170      76, 108 : BEGIN
 2180                  mode(2);
 2190                  ink(1,26);
 2200                  Selectfile
 2210                END;
 2220      83, 115 : Squeeze
 2230     END;
 2240     user(#bb03)
 2250   END
 2260 END.


These screenshots come from a program I was working on before I got to this stage, though are essentially the same.
« Last Edit: 13:17, 04 September 18 by AMSDOS »
* Using some of the hardly used Amstrad compilers :D
* I use Firmware in my Assembly code :P
* Have interpreted some BASIC 1.1 programs for BASIC 1.0. :)

Offline AMSDOS

  • Supporter
  • 6128 Plus
  • *
  • Posts: 3.626
  • Country: au
    • index.php?action=treasury
    • Programs for Turbo Pascal 3
  • Liked: 892
  • Likes Given: 1551
Re: Hisoft Pascal 4T
« Reply #90 on: 03:48, 16 September 18 »
I've been coding away reviving some old memories from when I started collecting AA back in 1989, converting some more Type-ins using Hisoft Pascal and in the process I found a flaw in their sound procedure. However, I've only just realised it and Hisoft actually acknowledge what it is in the Manual. Hisoft refer to it as the Heap, though the problem I discovered is, when dealing in Loops, their sound procedure fills this Heap with the Sound Data, unfortunately the address (which resides at &471..&472 in compiled BIN file) doesn't remain constant and eventually the programmes which use that sound procedure will crash, which will also sadly include my Get The Cash game (though it would take quite some time as the size of the heap area is 16kb).
When the programs are compiled into a BINary file, this heap seems to point to &4000, along with the sound procedure, I've been using ENV, though there doesn't seem to be any problems with that, some data was placed at &4000 in my Test program (see below), though not in a manner where it would be continuously filling up memory with the same data, so it just seems to be happening with the sound procedure.


I wrote this program below which I hope corrects this, I didn't see any sign of memory being filled, though the sound queue is rather complicated, in my procedure a series of variables are used to gather the sound data, I've placed it within a local array and converted the 16-bit values into bytes for the appropriate sections of the array, I've setup another variable which points to the address of the array and used that to go into the HL register before initiating the sound queue (&BCAA), which seems to work.


Code: [Select]

   10 PROGRAM sndtest;
   20 {$C-}
   30
   40 TYPE sque = ARRAY[1..7] OF integer;
   50
   60 VAR ky : char;
   70
   80 PROCEDURE snd(g,k,l,h,m,j,i : integer);
   90 VAR q : ARRAY[1..9] OF char;
  100     aq: integer;
  110     cal : integer;
  120 BEGIN
  130   q[1]:=chr(g); q[2]:=chr(k); q[3]:=chr(l);
  140   q[4]:=chr(h); cal:=h DIV 256; q[5]:=chr(cal);
  150   q[6]:=chr(m); q[7]:=chr(j);
  160   q[8]:=chr(i); cal:=i DIV 256; q[9]:=chr(cal);
  170   aq:=addr(q);
  180   rhl:=aq;
  181   while rhl=aq do
  190     user(#bcaa)
  200 END;
  210
  220 BEGIN
  230   REPEAT
  240     env(1,15,-1,20); env(2,15,-1,5);
  250     env(3,7,-1,3,7,1,3,15,-1,10);
  260     snd(7,3,0,0,31,15,0);
  270     ky:=inch
  280   UNTIL ky=chr(252)
  290 END.





« Last Edit: 12:40, 16 September 18 by AMSDOS »
* Using some of the hardly used Amstrad compilers :D
* I use Firmware in my Assembly code :P
* Have interpreted some BASIC 1.1 programs for BASIC 1.0. :)

Offline AMSDOS

  • Supporter
  • 6128 Plus
  • *
  • Posts: 3.626
  • Country: au
    • index.php?action=treasury
    • Programs for Turbo Pascal 3
  • Liked: 892
  • Likes Given: 1551
Re: Hisoft Pascal 4T
« Reply #91 on: 10:12, 23 September 18 »
Followup from my previous post, I was surprised how quickly the sound command can fill up the heap to eventually crash the program, some of these BASIC programs I've converted from AA Type-ins have a high demand on the Sound Command, though was able to write my own Sound procedure which avoids tragedy.


* Train Simulator (or Steam Engine) from AA43 - this program has a lot of Sound commands in it and after successfully translating to Hisoft Pascal, the train reached the 1st station, but the system crashed before reaching the 2nd, exposing the program. After writing my own Sound Procedure & demo to replace the Hisoft one, this program wasn't correctly coordinated & sound was being lost, which was resolved once I added line 181 which simply the holds the note until HL is corrupt. The other minor change I made from that earlier program is the parameters for the sound procedure are now in the same order as BASIC!  :D


* Boggle from AA50 - no sound in this, it's a graphical animation using Colour Cycling, because everything has been compiled the Colour Cycle is a full on Boggle.  :)  My demo of this however starts at a different position because I suspect there's bugs in the original. The Main Loop commences in the Hundreds and ranges over 60,000! I tested this to see if BASIC would accept that and it flipped out - even 32,767 is too large, the author may have had it like that because it would take a very long time just to get to 1,000, however since COS and SIN work on circles - 1 to 360 seems to be the range to use. We'll never know either if Boggle was meant to do something else because in the original listing is a variable called fM. fM isn't used anywhere else, so the value defaults to 0, though if it had been something else like a defined function (def fn) called M, then perhaps the original program performed something else in the INK cycle instead of going black, sadly we won't know what that formula we be.


* Fire Works from AA50 - like the Boggle program, this program had some issues when it was published, though corrections were added to the following issue. It uses Envelopes and Sound for explosion effects, I had no problems with the Envelopes which Hisoft has defined and again replaced their Sound with my Sound procedure. On running the Explosions seem to be a little out of place with the Graphical fireworks onscreen, though this was also happened under Hisoft's Sound Procedure, I suspect the original program maybe like it as well, though given the delay factor BASIC has, maybe difficult to pickup. Otherwise this program looks better in Pascal due to the way the fireworks need to be animated speed is critical.


* Worm from AA53 - Again no sound with this program, though this tiny little BASIC program took ages to code, I simplified by sending data for the Worm Graphics into an Array which I was pointing the Matrix Table to since Pascal Sets would of taken longer to setup. Lots of other commands had to be added into this little demo as well. The final result looks good though.




In additional to those programs I made my own little Colour Cycling program. I'm unsure if one has been done before, the idea here was to draw a series of circles using Rainbow colours and then switch them around so all 7 colours rotate the 7 areas of the Circle which simulates movement. Initially I made the program in BASIC, which I still have if anyone was interested.


Code: [Select]

   10 PROGRAM RainbowWheels;
   20 {$C-}
   30
   40 TYPE colours = 0..26;
   50      palette = SET OF colours;
   60      colseq  = ARRAY[1..8] OF char;
   70 VAR cp : ARRAY[1..8] OF char;
   80
   90 PROCEDURE ink(p,c : integer);
  100 BEGIN
  110   ra:=chr(p);
  120   rb:=chr(c);
  130   rc:=chr(c);
  140   user(#bc32)
  150 END;
  160
  170 PROCEDURE border(col : integer);
  180 BEGIN
  190   rb:=chr(col);
  200   rc:=chr(col);
  210   user(#bc38)
  220 END;
  230
  240 PROCEDURE mode(no : integer);
  250 BEGIN
  260   ra:=chr(no);
  270   user(#bc0e)
  280 END;
  290
  300 PROCEDURE grapen(col : integer);
  310 BEGIN
  320   ra:=chr(col);
  330   user(#bbde)
  340 END;
  350
  360 PROCEDURE move(x,y : integer);
  370 BEGIN
  380   rde:=x;
  390   rhl:=y;
  400   user(#bbc0)
  410 END;
  420
  430 PROCEDURE draw(x,y : integer);
  440 BEGIN
  450   rde:=x;
  460   rhl:=y;
  470   user(#bbf6)
  480 END;
  490
  500 FUNCTION deg(ang : integer) : real;
  510 VAR cvrt : real;
  520 BEGIN
  530   cvrt:=3.14159/180;
  540   deg:=cvrt*ang
  550 END;
  560
  570 FUNCTION rnd(range : integer) : integer;
  580 VAR seed : integer;
  590     rslt : real;
  600 BEGIN
  610   seed:=random(0);
  620   rslt:=(range/maxint);
  630   rslt:=(seed*rslt);
  640   rnd:=trunc(rslt)
  650 END;
  660
  670 PROCEDURE setupinks(byte : palette;sqce : colseq);
  680 VAR ps, lp : integer;
  690     p,  d1 : integer;
  700     setp : ARRAY[1..8] OF char;
  710     pen1 : ARRAY[1..8] OF char;
  720 BEGIN
  730   ps:=1;
  740   FOR lp:=0 TO 26 DO
  750   BEGIN
  760     IF lp IN byte THEN
  770     BEGIN
  780       setp[ps]:=chr(lp);
  790       ps:=ps+1
  800     END
  810   END;
  820   FOR p:=1 TO ps-1 DO
  830   BEGIN
  840     d1:=ord(sqce[p])-64;
  850     pen1[p]:=setp[d1];
  860     cp[p]:=pen1[p];
  870     ink(p-1,ord(pen1[p]))
  880   END
  900 END;
  910
  920 PROCEDURE drwcirc(x,y,c : integer);
  930 VAR r : integer;
  940     s : integer;
  950 BEGIN
  960   s:=1;
  970   FOR r:=359 DOWNTO 1 DO
  980   BEGIN
  990     move(x,y); grapen(c);
 1000     draw(round(x+18*cos(deg(r))),
 1010          round(y+18*sin(deg(r))));
 1020     s:=s+1;
 1030     IF s=54 THEN BEGIN
 1040       c:=c+1;
 1050       s:=1
 1060     END;
 1070     IF c=8 THEN c:=1
 1080   END
 1090 END;
 1100
 1110 PROCEDURE stupcirc;
 1120 VAR x : integer;
 1130     y : integer;
 1140     c : integer;
 1150     n : integer;
 1160 BEGIN
 1170   FOR n:=1 TO 10 DO
 1180   BEGIN
 1190     x:=rnd(600)+18; y:=rnd(362)+18;
 1200     c:=rnd(7)+1; drwcirc(x,y,c)
 1210   END
 1220 END;
 1230
 1240 PROCEDURE rotink(p,d : integer);
 1250 VAR l : integer;
 1260 BEGIN
 1270   FOR l:=1 TO 7 DO
 1280   BEGIN
 1290     ink(p,ord(cp[d]));
 1300     p:=p+1;
 1310     IF p>7 THEN p:=1;
 1320     d:=d+1;
 1330     IF d>8 THEN d:=2
 1340   END;
 1350     user(#bd19); user(#bd19)
 1360 END;
 1370
 1380 PROCEDURE main;
 1390 VAR p, sp : integer;
 1400     d, sd : integer;
 1410     ky    : char;
 1420 BEGIN
 1430   p:=3; sp:=p; d:=2; sd:=d;
 1440   REPEAT
 1450     rotink(p,d);
 1460     sp:=sp+2;
 1470     IF sp>7 THEN sp:=1;
 1480     sd:=sd+1;
 1490     IF sd>8 THEN sd:=2;
 1500     IF sp=1 THEN
 1510     BEGIN
 1520       sp:=sp+1;
 1530       sd:=sd+1;
 1540       IF sp>7 THEN sp:=1;
 1550       IF sd>8 THEN sd:=2
 1560     END;
 1570     p:=sp; d:=sd;
 1580     ky:=inch
 1590   UNTIL ky=chr(252)
 1600 END;
 1610
 1620 BEGIN
 1630   mode(0);
 1640   user(#bc02);
 1650   setupinks([11,6,15,24,18,2,5,8],'ECFHGABD');
 1660   border(11);
 1670   stupcirc;
 1680   main;
 1690   user(#bc02)
 1700 END.

* Using some of the hardly used Amstrad compilers :D
* I use Firmware in my Assembly code :P
* Have interpreted some BASIC 1.1 programs for BASIC 1.0. :)