Hisoft Pascal 4T

[AMSDOS]

Following on from Moving an object around the screen earlier, this incorporates Sean McManus' Easi-Sprite Driver. A number of Pascal programs are on this disk, "savedata.pas" was used to enter & save the Sprite Data "monster .dat".


"esd     .dat" was created earlier, using an integer based array, "bckupesd.pas" was created to poke esd to memory & read it (peek) into a char based array and save it as "esd2    .dat", which allowed me to delete the original "esd.dat" & rename "esd2.dat" to "esd.dat".


"monster .pas" is a trial, to load esd, the sprite and display it.


"mvmnster.pas"/"mvmnster.bin" is the main program. Arrow Keys move the Monster Character around the Screen very quickly, I've applied some Frame Flybacks in my main REPEAT...UNTIL loop to slow the thing down. 


Code is fairly comparable to earlier MoveMan Code, though because my Sprite is fairly big, I'm using Double Incrementing to move the object around the screen. Easi-Sprite Driver uses Text Based Coordinates to Display the Graphic and because Graphics are XORed simply having an old value in the variable is used here to remove the old Graphic.

Code Select Expand

   10 PROGRAM MoveMonster;
   20 {$C-}
   30
   40 VAR mx : integer;
   50     my : integer;
   60     esd : ARRAY[0..272] OF char;
   70     monster : ARRAY[0..191] OF char;
   80
   90 PROCEDURE Setup;
  100 VAR loop : integer;
  110 BEGIN
  120   tin('ESD     .DAT',ADDR(esd));
  130   FOR loop:=0 TO 272 DO
  140      poke(#9c40+loop,ord(esd[loop]));
  150   tin('MONSTER .DAT',addr(monster));
  160   FOR loop:=0 TO 191 DO
  170      poke(#9000+loop,ord(monster[loop]));
  180   user(#9c40);
  190   external('SDEF',1,#9000)
  200 END;
  210
  220 FUNCTION key(ch:char) : boolean;
  230 BEGIN
  240   inline(#DD,#7E,#02,
  250          #CD,#1E,#BB,
  260          #28,#05,
  270          #3E,#01,
  280          #DD,#77,#03)
  290 END;
  300
  310 PROCEDURE ink(ink,col1 : char);
  320 BEGIN
  330   ra:=ink;
  340   rb:=col1;
  350   rc:=col1;
  360   user(#bc32)
  370 END;
  380
  390 PROCEDURE kmreset;
  400 BEGIN
  410   user(#bb03)
  420 END;
  430
  440 PROCEDURE SetupInks;
  450 BEGIN
  460   ra:=chr(0);
  470   user(#bc0e);
  480   ink(chr(0),chr(0));
  490   ink(chr(1),chr(26));
  500   ink(chr(2),chr(11));
  510   ink(chr(3),chr(2));
  520   ink(chr(4),chr(1));
  530   ink(chr(5),chr(3));
  540   ink(chr(6),chr(6));
  550   ink(chr(7),chr(16))
  560 END;
  570
  580 PROCEDURE DrawSprite(xpos,ypos : integer);
  590 BEGIN
  600   external('SPRITE',1,xpos,ypos)
  610 END;
  620
  630 PROCEDURE MoveMonster;
  640 VAR oldx, oldy : integer;
  650 BEGIN
  660  IF key(chr(1))=true THEN
  670   BEGIN
  680     IF mx<17 THEN
  690     BEGIN
  700       oldx:=mx;
  710       oldy:=my;
  720       mx:=mx+2;
  730       DrawSprite(oldx,oldy);
  740       DrawSprite(mx,my)
  750     END;
  760   END;
  770  IF key(chr(8))=true THEN
  780   BEGIN
  790     IF mx>1 THEN
  800     BEGIN
  810       oldx:=mx;
  820       oldy:=my;
  830       mx:=mx-2;
  840       DrawSprite(oldx,oldy);
  850       DrawSprite(mx,my)
  860     END;
  870   END;
  880  IF key(chr(0))=true THEN
  890   BEGIN
  900     IF my>1 THEN
  910     BEGIN
  920       oldx:=mx;
  930       oldy:=my;
  940       my:=my-2;
  950       DrawSprite(oldx,oldy);
  960       DrawSprite(mx,my)
  970     END;
  980   END;
  990  IF key(chr(2))=true THEN
1000   BEGIN
1010     IF my<21 THEN
1020     BEGIN
1030       oldx:=mx;
1040       oldy:=my;
1050       my:=my+2;
1060       DrawSprite(oldx,oldy);
1070       DrawSprite(mx,my)
1080     END;
1090   END;
1100 END;
1110
1120 BEGIN { Main Test PROGRAM }
1130   setup;
1140   setupinks;
1150   mx:=9;
1160   my:=9;
1170   drawsprite(mx,my);
1180   REPEAT
1190     movemonster;
1200     user(#bd19);
1210     user(#bd19);
1220   UNTIL key(chr(66))=true;
1230   kmreset
1240 END.



[attachimg=1]

[Alcoholics Anonymous]

The interface to the firmware seems to be some static memory set aside for the main set of registers (ra, rb, rbc, etc) which can be assigned to in the program and then a firmware subroutine can be called with "user(firmware_address);".   Are there any other useful interfaces to the firmware that you've come across in other compilers?

[AMSDOS]

The interface to the firmware seems to be some static memory set aside for the main set of registers (ra, rb, rbc, etc) which can be assigned to in the program and then a firmware subroutine can be called with "user(firmware_address);".   Are there any other useful interfaces to the firmware that you've come across in other compilers?

There are some CP/M code examples on the Source Code page which demonstrate using a Firmware from within CP/M and before I was using this Compiler, I was producing Firmware based programs from Turbo Pascal 3. The restriction here is different CP/M versions have different ways of accessing the Firmware. CP/M 2.2 has the simplest approach, which is a CALL &BE9B followed by DEFW &xxxx "xxxx" being the Firmware address. CP/M Plus goes through some process of obtaining an address storing that address as a Jump to Firmware, the whole process in that situation makes it seem as if that address isn't fixed, though for my Bouncing Ball demo, I must of worked out an address as &FC5A and use that to make that particular Turbo Pascal program work in CP/M 2.2 & CP/M Plus, I haven't received any feedback saying that program didn't work or it damaged my computer.
But having said all that I've moved away from Turbo Pascal 3 because it's strictly a CP/M Compiler, you don't make friends using Firmware with it and will be more likely be told to use GSX instead.


An AMSDOS library (CPCIOLIB by Juergen Weber as you're probably aware), was created in conjunction with Small-C which allows you to make extensive use of the Firmware, it's similar to the approach used here in Hisoft Pascal 4T.
Hisoft C also has a way of allowing someone to use the Firmware by the means of a Library, don't know much else about it, I think someone was trying to write some stuff Firmware based Hisoft C stuff, though I'm unsure how far this progressed.
In BCPL, some of the example programs use Firmware, the Invaders game definitely has Firmware in it, but from memory (which isn't terribly great at the moment), it's using Inline M/C to access the Firmware.


As you can see from my source code above, it's using Inline M/C as well as the register pack for Firmware. The Inline M/C I made uses KM TEST KEY, and jumps if the condition is not met, otherwise the FUNCTION key holds the value of 1 (for True). Earlier when I was using this routine with other Inline M/C Functions (to increment or decrement the value of a Type Char), I was getting some Funny results, in that situation it was safer to assign a variable to the KEY function.

[Alcoholics Anonymous]

There are some CP/M code examples on the Source Code page which demonstrate using a Firmware from within CP/M and before I was using this Compiler, I was producing Firmware based programs from Turbo Pascal 3. The restriction here is different CP/M versions have different ways of accessing the Firmware. CP/M 2.2 has the simplest approach, which is a CALL &BE9B followed by DEFW &xxxx "xxxx" being the Firmware address. CP/M Plus goes through some process of obtaining an address storing that address as a Jump to Firmware, the whole process in that situation makes it seem as if that address isn't fixed, though for my Bouncing Ball demo, I must of worked out an address as &FC5A and use that to make that particular Turbo Pascal program work in CP/M 2.2 & CP/M Plus, I haven't received any feedback saying that program didn't work or it damaged my computer.

I will have to take a look at that.  It's probably a case of the entire 64k space being filled with ram and a new indirect address has to be used so that a special subroutine can page in the relevant ROM to do the work.

But having said all that I've moved away from Turbo Pascal 3 because it's strictly a CP/M Compiler, you don't make friends using Firmware with it and will be more likely be told to use GSX instead.

Yeah I can see that.  The cp/m folk want cross-platform whereas firmware is cpc specific.

An AMSDOS library (CPCIOLIB by Juergen Weber as you're probably aware), was created in conjunction with Small-C which allows you to make extensive use of the Firmware, it's similar to the approach used here in Hisoft Pascal 4T.
Hisoft C also has a way of allowing someone to use the Firmware by the means of a Library, don't know much else about it, I think someone was trying to write some stuff Firmware based Hisoft C stuff, though I'm unsure how far this progressed.
In BCPL, some of the example programs use Firmware, the Invaders game definitely has Firmware in it, but from memory (which isn't terribly great at the moment), it's using Inline M/C to access the Firmware.

Thanks for the pointers!  CPCIOLIB and FIOLIB are passing a pointer to a structure holding the register pack as opposed to your pascal programs above which are storing the register pack at a fixed static location.  CPCIOLIB and FIOLIB are also creating a JP vector at RST30 to launch the firmware call as opposed to using a "call firmware; defw fw_function".  I am not sure why yet.

CPCIOLIB is effectively restarting the system at startup by doing a KL_ROM_WALK and finding out where the available ram is.  Then it moves the stack to the end of that ram.  FIOLIB is placing the stack at a fixed location, which it probably can do because it knows what ROM is active.  All the C i/o is superficially pretending to be a standard C interface by providing a thin layer on top of firmware calls for some standard lib C functions but that's probably the only choice given small C doesn't implement stdio in a comprehensive way.  They are good examples of using firmware though.  FIOLIB also adds subroutines that look like the analagous BASIC functions that wrap firmware calls.

I spotted that you were also using "extern()" to call RSXs so that's another interface to 3rd party ROMs.  Hitech-C on CPM was quite good so I will be looking up what they did for the cpc firmware in case they found another good method.

As you can see from my source code above, it's using Inline M/C as well as the register pack for Firmware. The Inline M/C I made uses KM TEST KEY, and jumps if the condition is not met, otherwise the FUNCTION key holds the value of 1 (for True). Earlier when I was using this routine with other Inline M/C Functions (to increment or decrement the value of a Type Char), I was getting some Funny results, in that situation it was safer to assign a variable to the KEY function.

Yeah the inlining may be disturbing register values depending on where you put it.  It depends on how the compiler works.  For small C you would be pretty much safe to do anything but in something like sdcc, inlining asm is quite dangerous because program variables may be held in registers or in other stack locations than the ones you expect.

[AMSDOS]

I will have to take a look at that.  It's probably a case of the entire 64k space being filled with ram and a new indirect address has to be used so that a special subroutine can page in the relevant ROM to do the work.

Makes sense I suppose, otherwise it would of just been a routine CALL.

Yeah I can see that.  The cp/m folk want cross-platform whereas firmware is cpc specific.

The irony about that, is the CPC version of GSX is patched to the Firmware, though it is the Library to use while running CP/M for dealing in Graphical applications.

Thanks for the pointers!  CPCIOLIB and FIOLIB are passing a pointer to a structure holding the register pack as opposed to your pascal programs above which are storing the register pack at a fixed static location.  CPCIOLIB and FIOLIB are also creating a JP vector at RST30 to launch the firmware call as opposed to using a "call firmware; defw fw_function".  I am not sure why yet.

The Enter Firmware call I provided earlier is a CP/M factor, for CPC OS/AMSDOS, the firmware function is accessible direct, the Firmware Manual will explain this better than I, but for example to change the screen mode in CP/M 2.2:

Code Select Expand


ld a,1
call &be9b
defw &bc0e



CPC OS/AMSDOS doesn't need call &be9b, so it simply becomes

Code Select Expand


ld a,1
call &bc0e



Hisoft Pascal 4t simply replaces the Assembly/BASIC CALL command with USER, and like CALL, USER doesn't have to be Firmware, but it's available for that and the Register pack are handy to pass values or obtain them from certain Firmware instructions.

CPCIOLIB is effectively restarting the system at startup by doing a KL_ROM_WALK and finding out where the available ram is.  Then it moves the stack to the end of that ram.  FIOLIB is placing the stack at a fixed location, which it probably can do because it knows what ROM is active.  All the C i/o is superficially pretending to be a standard C interface by providing a thin layer on top of firmware calls for some standard lib C functions but that's probably the only choice given small C doesn't implement stdio in a comprehensive way.  They are good examples of using firmware though.  FIOLIB also adds subroutines that look like the analagous BASIC functions that wrap firmware calls.

Yep so CPCIOLIB is used for generating CPC OS/AMSDOS programs, depending on if AMSDOS is installed or not, the address stored in HIMEM differs. FIOLIB is the Library for handling Small-C programs written for FutureOS, when programs are compiled/linked, another program needs to be Executed along with your Small-C program in FutureOS to run, the other program I believe acts as a Library and I presume is the reason why it sits in a Static Location.

I spotted that you were also using "extern()" to call RSXs so that's another interface to 3rd party ROMs.  Hitech-C on CPM was quite good so I will be looking up what they did for the cpc firmware in case they found another good method.

Yes, so extern() is the RSX handler, I'm using that for the Easi-Sprite Driver, upon loading Hisoft Pascal it asks for the RAM-top, for that application ESD sits at &9C40 (is non-locatable, unless I compile it some where else), I entered &9000 at that RAM-top question and had heaps of space left over. Getting a RSX routine to Hisoft Pascal is tricky, it either involves writing a program to poke the M/C into an Array, which is what "savedata.pas" does. When entering data in HP for the purpose of saving, I've only been able to enter it as Decimal numbers (Hexadecimal doesn't appear to be supported even though HP uses the "#" for representing such numbers), so loading the file in BASIC, and PRINTing a Count number along with the Opcode beside it, seems to be the best approach when tackling it that way. I've also written a program to load standard Binary file in HP and save it, in order to get that loading program to work I had to Poke it in, as that's also a RSX. The 2 Commands HP uses for Loading and Saving Data files (TIN & TOUT) only deal with Data which has being saved via TOUT.


The other interesting thing in HP is like BASIC files, HP files which are saved through the Compiler Command (P - for Put) are tokenised, so larger files can be produced.

[AMSDOS]

I've put together the Block Routine to produce some 3D Text Demonstration in Hisoft Pascal 4t, but it's being a bit tricky to use and lots of calculations are being done.

Spoiler: ShowHide

Getting the Block Routine into this was lots of trial and error, the Index Register system works a bit differently from BASIC, so the 1-Byte CHAR type can begin at (ix+2) for the 1st and (ix+3) for the second, unlike BASIC which skips the High Register. I've had to Return a value into a Local Variable too, which I haven't done before in this language. For the Integer type it's IX-4-2 and IX-4-1, unfortunately it doesn't say which Register pair, fortunately I managed to work it out, so it seems the Low Byte uses IX-6 and the High Byte uses IX-5 in that situation, like everything though the more variables used to passing information from the Index Register varies.

Code Select Expand

   10 PROGRAM ThreeDimensionalText;
   20
   30 TYPE string = ARRAY[1..27] OF char;
   40
   50 PROCEDURE mode(no : integer);
   60 BEGIN
   70   ra:=chr(no);
   80   user(#bc0e)
   90 END;
  100
  110 PROCEDURE ink(ink, col1 : integer);
  120 BEGIN
  130   ra:=chr(ink);
  140   rb:=chr(col1);
  150   rc:=chr(col1);
  160   user(#bc32)
  170 END;
  180
  190 PROCEDURE DrawBlock(xpos,ypos,width : integer; height,col : char);
  200 VAR storey : integer;
  210 BEGIN
  220   inline(#DD,#7E,#03,
  230          #47,
  240          #DD,#7E,#02,
  250          #CD,#DE,#BB,
  260          #DD,#6E,#06,
  270          #DD,#66,#07,
  280          #DD,#74,#FB,
  290          #DD,#75,#FA,
  300          #C5,
  310          #DD,#6E,#08,
  320          #DD,#66,#09,
  330          #EB,
  340          #DD,#6E,#FA,
  350          #DD,#66,#FB,
  360          #CD,#C0,#BB,
  370          #DD,#6E,#04,
  380          #DD,#66,#05,
  390          #EB,
  400          #21,#00,#00,
  410          #CD,#F9,#BB,
  420          #C1,
  430          #DD,#6E,#FA,
  440          #DD,#66,#FB,
  450          #2B,
  460          #2B,
  470          #DD,#75,#FA,
  480          #DD,#74,#FB,
  490          #10,#D1)
  500 END;
  510
  520 PROCEDURE display(xpos,ypos,col : integer; txt : string);
  530 VAR count : integer;
  540     width : integer;
  550 BEGIN
  560   count:=1;
  570   width:=0;
  580   REPEAT
  590     IF txt[count]=chr(88) THEN
  600       drawblock(xpos+(4*width),398-(ypos*16),8,chr(8),chr(col));
  610       width:=width+2;
  620       count:=count+1;
  630   UNTIL count=27
  640 END;
  650
  660 PROCEDURE PassText(X, Y, C : integer);
  670 BEGIN
  680   display(x,y,c,   'X X XXX X    XX  X  X X XXX');
  690   display(x,y+1,c, 'X X X   X   X   X X XXX X  ');
  700   display(x,y+2,c, 'X X XX  X   X   X X X X XX ');
  710   display(x,y+3,c, 'XXX X   X   X   X X X X X  ');
  720   display(x,y+4,c, 'X X XXX XXX  XX  X  X X XXX')
  730 END;
  740
  750 BEGIN
  760   mode(0);
  770   ink(1,25);
  780   ink(2,2);
  790   PassText(0,0,3);
  800   PassText(8,0,4);
  810   PassText(250,3,5);
  820   PassText(258,3,6);
  830   PassText(350,12,7);
  840   PassText(358,12,8);
  850   PassText(32,19,9);
  860   PassText(40,19,1);
  870   PassText(110,10,2);
  880   PassText(118,10,1);
  890   user(#bb18)
  900 END.





[attachimg=1]

[AMSDOS]

In this following example, I was initially trying to find a way of Passing String Data to an Array, but had to settle writing it to a Global Array, which is what I had in my previous example, I was hoping that if I was successful I could simply point Data from the String to the relevant position of an array of my own choosing instead of using TIN & TOUT to generate the data from Files.


The good news I discovered earlier was when I started writing CHAR Arrays (instead of Integer ones) to hold data, I could use TIN to load other code straight where they belong. So in my earlier MoveMonster example which is using ESD to draw the Sprite, a Character Array for ESD isn't necessary. The reason this occurred was because I was initially using an INTEGER Array and when I used TOUT to save the code, every second byte was a Zero (effectively Doubling the Size required), so when I managed to convert ESD.DAT into a CHAR Array, all the code came together (eliminating the Zeros), so I could then use TIN to Load ESD.DAT to where it could go.


Anyway back to my example, I proceeded to write this which Passes Data to my DrawBlock routine, it seems to be the most Fiddliest things I have written, probably because I was referring back to my previous example (3DText) and using Formulas from it, when it didn't need them, I also was playing with Width ( !), there maybe some remnants of it still in the code, but again it didn't need them, so originally I was finding bits of my blocks were drawing over themselves!


Initially I was hoping to use ffmpeg to draw the sequence of the demo, a Tank Popping up from the bottom of screen, but when I downloaded it, I only had source code, and not being PC language savvy, decided to create Animated GIF with GIMP by controlling the sequence in the demo to grab screenshots. The result isn't true of the original Emulation, but gives a general idea of the program at work.

Code Select Expand



   10 PROGRAM MoveTank;
   20
   30 TYPE string = ARRAY[1..10] OF char;
   40
   50 VAR xpos : integer;
   60     ypos : integer;
   70     width : integer;
   80     obj  : ARRAY[1..10,1..14] OF char;
   90
  100 PROCEDURE mode(mo : integer);
  110 BEGIN
  120   ra:=chr(mo);
  130   user(#bc0e)
  140 END;
  150
  160 PROCEDURE ink(ink,col1 : integer);
  170 BEGIN
  180   ra:=chr(ink);
  190   rb:=chr(col1);
  200   rc:=chr(col1);
  210   user(#bc32)
  220 END;
  230
  240 PROCEDURE scrswroll(dir:char;left,right,top,bottom : integer);
  250 BEGIN
  260   rb:=dir;
  270   rh:=chr(left);
  280   rd:=chr(right);
  290   rl:=chr(top);
  300   re:=chr(bottom);
  310   ra:=chr(0);
  320   user(#bc50)
  330 END;
  340
  350 PROCEDURE DrawBlock(xpos,ypos,width : integer; height,col : char);
  360 VAR storey : integer;
  370 BEGIN
  380   inline(#DD,#7E,#03,
  390          #47,
  400          #DD,#7E,#02,
  410          #CD,#DE,#BB,
  420          #DD,#6E,#06,
  430          #DD,#66,#07,
  440          #DD,#74,#FB,
  450          #DD,#75,#FA,
  460          #C5,
  470          #DD,#6E,#08,
  480          #DD,#66,#09,
  490          #EB,
  500          #DD,#6E,#FA,
  510          #DD,#66,#FB,
  520          #CD,#C0,#BB,
  530          #DD,#6E,#04,
  540          #DD,#66,#05,
  550          #EB,
  560          #21,#00,#00,
  570          #CD,#F9,#BB,
  580          #C1,
  590          #DD,#6E,#FA,
  600          #DD,#66,#FB,
  610          #2B,
  620          #2B,
  630          #DD,#75,#FA,
  640          #DD,#74,#FB,
  650          #10,#D1)
  660 END;
  670
  680 PROCEDURE data(width,height : integer; txt : string);
  690 VAR count : integer;
  700 BEGIN
  710   count:=1;
  720   WHILE (count<=width) DO
  730   BEGIN
  740     obj[count,height]:=chr(ord(txt[count])-48);
  750     count:=count+1
  760   END;
  770 END;
  780
  790 PROCEDURE SetupObject;
  800 BEGIN
  810   data(10,1, '0000110000');
  820   data(10,2, '0000110000');
  830   data(10,3, '0000110000');
  840   data(10,4, '0000110000');
  850   data(10,5, '0177117710');
  860   data(10,6, '0077117700');
  870   data(10,7, '0177117710');
  880   data(10,8, '0077117700');
  890   data(10,9, '0171441710');
  900   data(10,10,'0071441700');
  910   data(10,11,'0177117710');
  920   data(10,12,'0077777700');
  930   data(10,13,'0177777710');
  940   data(10,14,'0000000000')
  950 END;
  960
  970 BEGIN
  980   mode(0);
  990   ink(0,0); ink(1,9); ink(4,26); ink(7,18);
1000   SetupObject;
1010   width:=0;
1020   FOR ypos:=1 TO 14 DO
1030   BEGIN
1040   FOR xpos:=1 TO 10 DO
1050   BEGIN
1060     IF obj[xpos,ypos]<>chr(0) THEN
1070       drawblock(256+xpos*16,14,12,chr(8),obj[xpos,ypos]);
1080   END;
1090   scrswroll(chr(1),9,12,5,24);
1100   width:=0
1110   END;
1120 END.




[AMSDOS]

I've taken the liberty to go through some of the programs I attached earlier and put some screenshots with them, in the process I uncovered a couple of programs I'd forgotten about.


The 1st is perhaps of less significance and when I compiled it, nothing was happening. After adding a Graphics Pen, Mode & Ink Procedures, I ended up in a Square moving out from the Centre of the screen, it was a bit flickery, so added a couple of MC FRAME FLYBACK (#BD19) to help smooth out the process, but it is what it is. Have a feel I've converted this from a BASIC example somewhere, but don't know where, looks like I might of made this around the time I was rotating squares.

Code Select Expand



   10 PROGRAM sqgrow2;
   20
   30 VAR a,b : real;
   40     loop : integer;
   50
   60 PROCEDURE mode(no : integer);
   70 BEGIN
   80   ra:=chr(no);
   90   user(#bc0e)
  100 END;
  110
  120 PROCEDURE move(x,y : integer);
  130 BEGIN
  140   rde:=x; rhl:=y;
  150   user(#bbc0)
  160 END;
  170
  180 PROCEDURE draw(x,y : integer);
  190 BEGIN
  200   rde:=x; rhl:=y;
  210   user(#bbf6)
  220 END;
  230
  240 PROCEDURE ink(no,col : integer);
  250 BEGIN
  260   ra:=chr(no);
  270   rb:=chr(col);
  280   rc:=chr(col);
  290   user(#bc32)
  300 END;
  310
  320 PROCEDURE grapen(col : integer);
  330 BEGIN
  340   ra:=chr(col);
  350   user(#bbde)
  360 END;
  370
  380 PROCEDURE scrreset;
  390 BEGIN
  400   user(#bc02)
  410 END;
  420
  430 BEGIN
  440   mode(2);
  450   scrreset;
  460   ink(1,26);
  470   a:=1.0;
  480   b:=1.1;
  490   FOR loop:=1 TO 50 DO
  500    BEGIN
  510       a:=a*b;
  520       user(#bd19);
  530       page;
  540       grapen(1);
  550       move(round(320-a),round(200-a));
  560       draw(round(320+a),round(200-a));
  570       draw(round(320+a),round(200+a));
  580       draw(round(320-a),round(200+a));
  590       draw(round(320-a),round(200-a));
  600       user(#bd19)
  610    END
  620 END.





[attachimg=2]


Saving the best til last, I found this following Pattern Generator program in a Fortran-77 book, the original program printed out (to printer), a series of text characters to create a Vortex like ASCII arty effect, unfortunately the effect was too big for the Text Screen, so what I've done with it, is convert to Graphical pixels, the Colours now represent the values the original program throws at it, I've selected down to earth like colours which gives it that Landscape look, but if you ask me the effect could pass as some Fireball with the White & Reds coming together, also because it's all being illustrated in pixels, the size of the area being draw is much larger than the original Text based program, which focused primarily on the centre circle with Island in the middle.

Code Select Expand



   10 PROGRAM RDLANDSCAPE;
   20 {$C-}
   30
   40 CONST xdelt=0.13;
   50       ydelt=0.25;
   60
   70 VAR r1, r2, z               : real;
   80     ypos, xpos              : real;
   90     yaxis, xaxis            : integer;
  100
  110 PROCEDURE mode(num : char);
  120 BEGIN
  130   ra:=num;
  140   user(#bc0e);
  150 END;
  160
  170 PROCEDURE border(col1 : char);
  180 BEGIN
  190   rb:=col1;
  200   rc:=col1;
  210   user(#bc38);
  220 END;
  230
  240 PROCEDURE ink(ink,col1 : char);
  250 BEGIN
  260   ra:=ink;
  270   rb:=col1;
  280   rc:=col1;
  290   user(#bc32);
  300 END;
  310
  320 PROCEDURE plot(x,y, col : integer);
  330 BEGIN
  340   ra:=chr(col);
  350   user(#bbde);
  360   rde:=x;
  370   rhl:=y;
  380   user(#bbea);
  390 END;
  400
  410 PROCEDURE setup;
  420 BEGIN
  430  mode(chr(0));
  440  border(chr(2));
  450  ink(chr(0),chr(2));
  460  ink(chr(1),chr(9));
  470  ink(chr(2),chr(3));
  480  ink(chr(3),chr(6));
  490  ink(chr(4),chr(26));
  500 END;
  510
  520 BEGIN
  530   setup;
  540   ypos:=25;
  550   yaxis:=398;
  560   WHILE (yaxis>0) DO BEGIN
  570     xpos:=-11;
  580     xaxis:=0;
  590     WHILE (xaxis<640) DO BEGIN
  600       r1:=sqrt(sqr(xpos-1)+sqr(ypos-1));
  610       r2:=sqrt(sqr(xpos+1)+sqr(ypos+1));
  620       z:=cos(r1)+cos(r2);
  630       IF (z>0.0) AND (z<0.5) THEN plot(xaxis,yaxis,1);
  640       IF (z>0.5) AND (z<1.0) THEN plot(xaxis,yaxis,2);
  650       IF (z>1.0) AND (z<1.5) THEN plot(xaxis,yaxis,3);
  660       IF (z>1.5) AND (z<2.0) THEN plot(xaxis,yaxis,4);
  670     xpos:=xpos+xdelt;
  680     xaxis:=xaxis+4;
  690     END;
  700    ypos:=ypos-ydelt;
  710    yaxis:=yaxis-2;
  720   END;
  730  user(#bb18);
  740 END.





[attachimg=4]

[cpcuser]

Hello, the Hisoft Pascal is slower than the Basic.


Greeting

[SRS]

@AMSDOS :

would changing

Code Select Expand


  630       IF (z>0.0) AND (z<0.5) THEN plot(xaxis,yaxis,1);
  640       IF (z>0.5) AND (z<1.0) THEN plot(xaxis,yaxis,2);
  650       IF (z>1.0) AND (z<1.5) THEN plot(xaxis,yaxis,3);
  660       IF (z>1.5) AND (z<2.0) THEN plot(xaxis,yaxis,4);
 
  to

  VAR col : CHAR;
 
  col:=0;
  IF (z>0.0) THEN col:=col+1;
  IF (z>0.5) THEN col:=col+1;
  IF (z>1.0) THEN col:=col+1;
  IF (z>1.5) THEN col:=col+1;
 
  plot(xaxis,yaxis,col);

Speed up a little bit ?
 

[attachimg=1]

Like this BASIC Example : (now with dark red, 01.01.2017)

Code Select Expand


10 MODE 0
20 BORDER 2:INK 0,2:INK 1,9:INK 2,3:INK 3,6:INK 4,26
30 xdelt=0.13:ydelt=0.25
40 yp=25:yax=398
50 WHILE (yax>0)
60 xp=-11:xax=0
70 WHILE (xax<640)
80 r1=SQR((xp-1)^2+(yp-1)^2)
90 r2=SQR((xp+1)^2+(yp+1)^2)
100 z=COS(r1)+COS(r2)
110 c=0:IF z>1.5 THEN c=4:GOTO 150
120 IF z>1 THEN c=3:GOTO 150
130 IF z>0.5 THEN c=2:GOTO 150
135 IF z>0 THEN c=1
140 IF z>2 THEN 160
150 PLOT xax,yax,c
160 xp=xp+xdelt:xax=xax+4
170 WEND
180 yp=yp-ydelt:yax=yax-2
190 WEND
200 CALL &BB18
210 END


[AMSDOS]

@AMSDOS :

would changing

Code Select Expand


  630       IF (z>0.0) AND (z<0.5) THEN plot(xaxis,yaxis,1);
  640       IF (z>0.5) AND (z<1.0) THEN plot(xaxis,yaxis,2);
  650       IF (z>1.0) AND (z<1.5) THEN plot(xaxis,yaxis,3);
  660       IF (z>1.5) AND (z<2.0) THEN plot(xaxis,yaxis,4);
 
  to

  VAR col : CHAR;
 
  col:=0;
  IF (z>0.0) THEN col:=col+1;
  IF (z>0.5) THEN col:=col+1;
  IF (z>1.0) THEN col:=col+1;
  IF (z>1.5) THEN col:=col+1;
 
  plot(xaxis,yaxis,col);

Speed up a little bit ?
 

Like this BASIC Example :

Code Select Expand


10 MODE 0
20 BORDER 2:INK 0,2:INK 1,9:INK 2,3:INK 3,6:INK 4,26
30 xdelt=0.13:ydelt=0.25
40 yp=25:yax=398
50 WHILE (yax>0)
60 xp=-11:xax=0
70 WHILE (xax<640)
80 r1=SQR((xp-1)^2+(yp-1)^2)
90 r2=SQR((xp+1)^2+(yp+1)^2)
100 z=COS(r1)+COS(r2)
110 c=0:IF z>1.5 THEN c=4:GOTO 150
120 IF z>1 THEN c=3:GOTO 150
130 IF z>0.5 THEN c=1
140 IF z>2 THEN 160
150 PLOT xax,yax,c
160 xp=xp+xdelt:xax=xax+4
170 WEND
180 yp=yp-ydelt:yax=yax-2
190 WEND
200 CALL &BB18
210 END


[attach=2]

I think I might of been initially trying this, though finding I was getting a slightly different result. I noticed your program is checking if z is greater than 2 to skip the plotting process, I'm merely skipping the process if z is over 2, though somehow your getting a different result, need to check this BASIC.


UPDATE: I've tried variations to what I posted earlier, but the result is never really quite the same. Initially too I didn't notice your BASIC program had missed Dark Red (3). I modified my Pascal program to remove all the IF statements in it, the idea being to get the result from Z, store that into another REAL variable "Z2", multiply by 2 and Round that value into variable "col". It's produced a similar result to the original, though hasn't got the roundness of the original, speed wise I don't think there's much improvement:

Code Select Expand



   10 PROGRAM RDLANDSCAPE;
   20 {$C-}
   30
   40 CONST xdelt=0.13;
   50       ydelt=0.25;
   60
   70 VAR r1, r2, z, z2           : real;
   80     ypos, xpos              : real;
   90     yaxis, xaxis            : integer;
  100     col                     : integer;
  110
  120 PROCEDURE mode(num : char);
  130 BEGIN
  140   ra:=num;
  150   user(#bc0e);
  160 END;
  170
  180 PROCEDURE border(col1 : char);
  190 BEGIN
  200   rb:=col1;
  210   rc:=col1;
  220   user(#bc38);
  230 END;
  240
  250 PROCEDURE ink(ink,col1 : char);
  260 BEGIN
  270   ra:=ink;
  280   rb:=col1;
  290   rc:=col1;
  300   user(#bc32);
  310 END;
  320
  330 PROCEDURE plot(x,y, col : integer);
  340 BEGIN
  350   ra:=chr(col);
  360   user(#bbde);
  370   rde:=x;
  380   rhl:=y;
  390   user(#bbea);
  400 END;
  410
  420 PROCEDURE setup;
  430 BEGIN
  440  mode(chr(0));
  450  border(chr(2));
  460  ink(chr(0),chr(2));
  470  ink(chr(1),chr(9));
  480  ink(chr(2),chr(3));
  490  ink(chr(3),chr(6));
  500  ink(chr(4),chr(26));
  510 END;
  520
  530 BEGIN
  540   setup;
  550   ypos:=25;
  560   yaxis:=398;
  570   WHILE (yaxis>0) DO BEGIN
  580     xpos:=-11;
  590     xaxis:=0;
  600     WHILE (xaxis<640) DO BEGIN
  610       r1:=sqrt(sqr(xpos-1)+sqr(ypos-1));
  620       r2:=sqrt(sqr(xpos+1)+sqr(ypos+1));
  630       z:=cos(r1)+cos(r2);
  640       z2:=z*2;
  650       col:=round(z2);
  660       IF (col IN [1..4]) THEN plot(xaxis,yaxis,col);
  670       xpos:=xpos+xdelt;
  680       xaxis:=xaxis+4;
  690     END;
  700    ypos:=ypos-ydelt;
  710    yaxis:=yaxis-2;
  720   END;
  730  user(#bb18);
  740  user(#bc02);
  750  mode(chr(2))
  760 END.





The result looks like this:


[attachimg=1]


I checked your BASIC version, but I just couldn't see anyway of it being faster than Pascal. I think what @cpcuser was referring to, is the Bouncing Ball program on Page 1, that was the only thing I could conclude as something which exists in here in both Pascal & BASIC format. The BASIC format of the program is faster because my program is too busy plotting/replotting the image to move it. 

[AMSDOS]

Hello, the Hisoft Pascal is slower than the Basic.


Greeting

For both my Bouncing Ball examples, yes they are. My 2nd example is an improvement, but the RSX routine I'm using is slow because I'm plotting an image (of the ball), pixel by pixel to animate it. The 1st BASIC example redefines the Ball into 2 characters, XOR mode is used to fill in the centre of the ball (to produce those 2 colours), TAG to plot those characters to a graphical position & TEST is used to determine when the Ball is colliding with the Border. If I produce that in HP then it will definitely be faster than the BASIC.


To finish off the year I've put together a Hisoft Pascal version of it:

Code Select Expand

   10 PROGRAM BouncingBall;
   20 {$C-}
   30
   40 (* Bounce a Ball using User Defined Graphics &
   50    XOR Print Mode TO display a Multicoloured
   60    Ball *)
   70
   80 VAR ball : ARRAY[0..15] OF char;
   90     bdat : ARRAY[0..1] OF char;
  100     xpos : integer;
  110     ypos : integer;
  120     xdir : integer;
  130     ydir : integer;
  140     loop : integer;
  150     ch   : char;
  160
  170 PROCEDURE mode(no : integer);
  180 BEGIN
  190   ra:=chr(no);
  200   user(#bc0e)
  210 END;
  220
  230 FUNCTION rdkey : char;
  240 BEGIN
  250   user(#bb1b);
  260   rdkey:=ra
  270 END;
  280
  290 PROCEDURE SetMatrixTable;
  300 BEGIN
  310   rde:=#FE;
  320   rhl:=addr(ball);
  330   user(#bbab)
  340 END;
  350
  360 PROCEDURE Symbol(ch : char; adr : integer);
  370 BEGIN
  380   ra:=ch;
  390   rhl:=adr;
  400   user(#bba8)
  410 END;
  420
  430 PROCEDURE ScreenAccess(mo:integer);
  440 BEGIN
  450   ra:=chr(mo);
  460   user(#bc59)
  470 END;
  480
  490 FUNCTION test(xpos,ypos : integer) : integer;
  500 BEGIN
  510   rde:=xpos;
  520   rhl:=ypos;
  530   user(#bbf0);
  540   test:=ord(ra)
  550 END;
  560
  570 PROCEDURE grapen(col : integer);
  580 BEGIN
  590   ra:=chr(col);
  600   user(#bbde)
  610 END;
  620
  630 PROCEDURE move(xpos,ypos : integer);
  640 BEGIN
  650   rde:=xpos;
  660   rhl:=ypos;
  670   user(#bbc0)
  680 END;
  690
  700 PROCEDURE draw(xpos,ypos : integer);
  710 BEGIN
  720  rde:=xpos;
  730  rhl:=ypos;
  740  user(#bbf6)
  750 END;
  760
  770 PROCEDURE grachar(ch : char);
  780 BEGIN
  790   ra:=ch;
  800   user(#bbfc)
  810 END;
  820
  830 PROCEDURE drawbox;
  840 BEGIN
  850   grapen(2);
  860   move(200,100);
  870   draw(440,100);
  880   draw(440,300);
  890   draw(200,300);
  900   draw(200,100)
  910 END;
  920
  930 PROCEDURE drawball;   
  940 BEGIN
  950   grapen(1);
  960   move(xpos,ypos);
  970   grachar(bdat[0]);
  980   grapen(3);
  990   move(xpos,ypos);
1000   grachar(bdat[1])
1010 END;
1020
1030 PROCEDURE frame;
1040 BEGIN
1050   user(#bd19)
1060 END;
1070
1080 PROCEDURE SetupBall;
1090 BEGIN
1100   ball[0]:=chr(0);
1110   ball[1]:=chr(60);
1120   ball[2]:=chr(66);
1130   ball[3]:=chr(66);
1140   ball[4]:=chr(66);
1150   ball[5]:=chr(66);
1160   ball[6]:=chr(60);
1170   ball[7]:=chr(0);
1180   ball[8]:=chr(0);
1190   ball[9]:=chr(0);
1200   ball[10]:=chr(60);
1210   ball[11]:=chr(60);
1220   ball[12]:=chr(60);
1230   ball[13]:=chr(60);
1240   ball[14]:=chr(0);
1250   ball[15]:=chr(0);
1260 END;
1270
1280 BEGIN
1290   mode(1);
1300   setmatrixtable;
1310   setupball;
1320   symbol(chr(254),addr(ball[0]));
1330   symbol(chr(255),addr(ball[8]));
1340   drawbox;
1350   screenaccess(1);
1360   bdat[0]:=chr(254);
1370   bdat[1]:=chr(255);
1380   xpos:=320; ypos:=200;
1390   xdir:=2; ydir:=2;
1400   REPEAT
1410     xpos:=xpos+xdir;
1420     ypos:=ypos+ydir;
1430     drawball;
1440     frame; frame;
1450     IF test(xpos,ypos-16)=2 THEN ydir:=2;
1460     IF test(xpos,ypos+2)=2 THEN ydir:=-2;
1470     IF test(xpos-2,ypos)=2 THEN xdir:=2;
1480     IF test(xpos+16,ypos)=2 THEN xdir:=-2;
1490     ch:=rdkey;
1500     loop:=ord(ch);
1510     drawball;
1520   UNTIL loop=252;
1530 END.




[SRS]

I checked your BASIC version, but I just couldn't see anyway of it being faster than Pascal. I think what @cpcuser was referring to, is the Bouncing Ball program on Page 1, that was the only thing I could conclude as something which exists in here in both Pascal & BASIC format. The BASIC format of the program is faster because my program is too busy plotting/replotting the image to move it. 

Even after fixing it and using fabacom on it, it's still quite slow.

That's imho due to the fact its making heavy use of floating point which is slow on Z80 without CoPro (like those x87) anyway.

Using faster plot (from cpctelera i.e.) may speed up a bit, but not significantly.

But it still looks nice and with some colorcycling ...

[AMSDOS]

Even after fixing it and using fabacom on it, it's still quite slow.

Yeah @litwr was running some speed tests on some Mandelbrots here, which showed fabacom wasn't quite as fast as Hisoft Pascal.

That's imho due to the fact its making heavy use of floating point which is slow on Z80 without CoPro (like those x87) anyway.

I would of put it down to a lot of pixel plotting and a large screen to fill. The original program I mentioned was using Text Characters " ' + % @ # " to produce an interesting patten, unfortunately it's meant to be printed as it's 100x60 in size.

Using faster plot (from cpctelera i.e.) may speed up a bit, but not significantly.


But it still looks nice and with some colorcycling ...

I've revised my version, have worked out where the centre of the vortex needs to be relative to the screen resolution, so it looks more like the Printed output from the Fortran-77 version, have added a col variable, if col=0 after all the checks have been made, the plot is skipped which I think has saved some time, but must of spent more time on the Colour cycling once the image is drawn, just to get that correct.

[attachimg=1]

Code Select Expand


   10 PROGRAM RollLandScape;
   20 {$C-}
   30
   40 CONST xdelt=0.125;
   50       ydelt=0.10;
   60
   70 VAR r1, r2, z               : real;
   80     ypos, xpos              : real;
   90     yaxis, xaxis            : integer;
  100     col                     : integer;
  110     loop                    : integer;
  120     keypressed              : char;
  130
  140 PROCEDURE mode(num : char);
  150 BEGIN
  160   ra:=num;
  170   user(#bc0e)
  180 END;
  190
  200 PROCEDURE frame;
  210 BEGIN
  220   user(#bd19)
  230 END;
  240
  250 PROCEDURE border(col1 : char);
  260 BEGIN
  270   rb:=col1;
  280   rc:=col1;
  290   user(#bc38)
  300 END;
  310
  320 PROCEDURE ink(ink,col1 : integer);
  330 BEGIN
  340   ra:=chr(ink);
  350   rb:=chr(col1);
  360   rc:=chr(col1);
  370   user(#bc32)
  380 END;
  390
  400 PROCEDURE plot(x,y, col : integer);
  410 BEGIN
  420   ra:=chr(col);
  430   user(#bbde);
  440   rde:=x;
  450   rhl:=y;
  460   user(#bbea)
  470 END;
  480
  490 FUNCTION rdkey : char;
  500 BEGIN
  510   user(#bb1b);
  520   rdkey:=ra
  530 END;
  540
  550 PROCEDURE setup;
  560 BEGIN
  570  mode(chr(0));
  580  border(chr(2));
  590  ink(0,2);
  600  ink(1,9);
  610  ink(2,3);
  620  ink(3,6);
  630  ink(4,26)
  640 END;
  650
  660 BEGIN
  670   setup;
  680   ypos:=10;
  690   yaxis:=398;
  700   WHILE (yaxis>0) DO BEGIN
  710     xpos:=-10;
  720     xaxis:=0;
  730     WHILE (xaxis<640) DO BEGIN
  740       r1:=sqrt(sqr(xpos-1)+sqr(ypos-1));
  750       r2:=sqrt(sqr(xpos+1)+sqr(ypos+1));
  760       z:=cos(r1)+cos(r2);
  770       col:=0;
  780       IF (z>0.0) AND (z<0.5) THEN col:=1;
  790       IF (z>0.5) AND (z<1.0) THEN col:=2;
  800       IF (z>1.0) AND (z<1.5) THEN col:=3;
  810       IF (z>1.5) AND (z<2.0) THEN col:=4;
  820       IF (col IN [1..4]) THEN plot(xaxis,yaxis,col);
  830       xpos:=xpos+xdelt;
  840       xaxis:=xaxis+4
  850     END;
  860     ypos:=ypos-ydelt;
  870     yaxis:=yaxis-2
  880   END;
  890   col:=4;
  900   REPEAT
  910    frame;
  920    col:=col-1;
  930    IF col=0 THEN col:=4;
  940    ink(col,26);
  950    frame;
  960    col:=col-1;
  970    IF col=0 THEN col:=4;
  980    ink(col,6);
  990    frame;
1000    col:=col-1;
1010    IF col=0 THEN col:=4;
1020    ink(col,3);
1030    frame;
1040    col:=col-1;
1050    IF col=0 THEN col:=4;
1060    ink(col,9);
1070    frame;
1080    col:=col-1;
1090    IF col=0 THEN col:=4;
1100    keypressed:=rdkey;
1110    loop:=ord(keypressed);
1120  UNTIL loop=252;
1130  user(#bc02);
1140  mode(chr(2))
1150 END.



[SRS]

How about using the power of the enormous RAM we have ?

This examples wastes 8 times 5 bytes for having maybe faster calculation storing xp^2 and 2xp

Code Select Expand

10 DIM xp2(640),x2p(640)
20 FOR i=0 TO 160:xp2(i*4)=(-10+i*0.125)^2:x2p(i*4)=2*(-10+i*0.125):NEXT
30 MODE 0
40 BORDER 2:INK 0,2:INK 1,9:INK 2,3:INK 3,6:INK 4,26
50 xdelt=0.125:ydelt=0.1
60 yp=10:yax=398
70 WHILE (yax>0)
80 yp2=yp*yp:y2p=2*yp
90 xp=-10:xax=0
100 WHILE (xax<640)
120 r1=SQR((xp2(xax)-x2p(xax)+1)+(yp2-y2p+1))
130 r2=SQR((xp2(xax)+x2p(xax)+1)+(yp2+y2p+1))
140 z=COS(r1)+COS(r2)
150 c=0:IF z>1.5 THEN c=4:GOTO 200
160 IF z>1 THEN c=3:GOTO 200
170 IF z>0.5 THEN c=2:GOTO 200
180 IF z>0 THEN c=1:GOTO 200
190 GOTO 210
200 PLOT xax,yax,c
210 xp=xp+xdelt:xax=xax+4
220 WEND
230 yp=yp-ydelt:yax=yax-2
240 WEND
250 CALL &BB18
260 END

[AMSDOS]

How about using the power of the enormous RAM we have ?

This examples wastes 8 times 5 bytes for having maybe faster calculation storing xp^2 and 2xp

Code Select Expand

20 FOR i=0 TO 160:xp2(i*4)=(-10+i*0.125)^2:x2p(i*4)=2*(-10+i*0.125):NEXT

You could possibly improve on that by removing i*4 and just use STEP 4, so it looks like this:

Code Select Expand

20 FOR i=0 TO 160 STEP 4:xp2(i)=(-10+i*0.125)^2:x2p(i)=2*(-10+i*0.125):NEXT


and increment i to 640? Oh i see thats not going to work 


Could you just save some space by not multiplying the array by 4, increment the "xax" by 1 and multiply "xax" in the plot by 4? Or is that going to bugger up the sums for "r1" & "r2"in 120 & 130?

[AMSDOS]

How about using the power of the enormous RAM we have ?

This examples wastes 8 times 5 bytes for having maybe faster calculation storing xp^2 and 2xp

Unfortunately when I tried running your program, I got a totally different result and finally Improper Argument. I tried variations without luck before giving up and playing Android One.


[attachimg=1]


Were you running this program through Fabacom? I was just using Locomotive BASIC, when the program was running I was cranking the emulator (Winape) unto 200% in Turbo Mode and I think it was still slightly slower than my Hisoft Pascal 

[AMSDOS]

I had a bit of fun this morning having a look at how Hisoft Pascal 4t handles it's source files when they are loaded and what tokens are taking place. I've loaded a simple program with a distinct program name, which I was able to easily locate in memory.


To start with the file appears to begin with a value representing a line number, this reserves 2 bytes, which holds the actual number (not a series of ASCII characters making up the number), although it seem somewhere confusing at first viewing the number in it's Hexadecimal counterpart.


A 3rd byte following the Line Numbers is used to represent the Spacing Indentation, naturally the Line Number has a space after it, if the next position has a character in it other than Space, that number is 0, if it's a Space, that line has a 1 and increments upwards 2,3,4,5 depending on how many spaces are used, which is good because it saves space while allowing programs to have indentation in them.

All the tokenised characters I found in memory appear to be only used from the list of Reserve Words, Hisoft Pascal 4t does have provision for Special Symbols & Predefined Identifiers, and on analysis those Identifiers sit in memory as ASCII, examples of Predefined Identifiers from the program I used were INTEGER, TIN, ADDR & WRITELN, the reserve words include:

Code	Keyword
&81	PROGRAM
&8A	VAR
&9C	ARRAY
&8B	OF
&98	BEGIN
&96	FOR
&8C	TO
&91	DO
&90	END

At the end of END could be a range of characters, in pascal an end may have nothing at the end of it, an semi-colon ';' (&3B) or full stop '.' (&2E), which follows the tokenised byte to END

Other characters used are &0D for Carriage Return.

[SRS]

One more pure BASIC solution : from > 4200 seconds down to 1960 seconds

Code Select Expand


10 MODE 0
20 st=TIME
30 BORDER 2:INK 0,2:INK 1,9:INK 2,3:INK 3,6:INK 4,26
40 xdelt=0.125:ydelt=0.1
50 yp=10:yax=398
60 WHILE (yax>199)
70 yp2=yp*yp
80 yy=yp+yp
90 xp=-10:xax=0
100 WHILE (xax<640)
110 xp2=xp*xp
120 xx=xp+xp
130 r1=SQR(xp2-xx+2+yp2-yy)
140 r2=SQR(xp2+xx+2+yp2+yy)
150 z=COS(r1)+COS(r2)
160 c=0
170 IF z>2 THEN 230
180 IF z>1.5 THEN c=4:GOTO 220
190 IF z>1 THEN c=3:GOTO 220
200 IF z>0.5 THEN c=2:GOTO 220
210 IF z>0 THEN c=1
220 PLOT xax,yax,c:PLOT 640-xax,398-yax,c
230 xp=xp+xdelt:xax=xax+4
240 WEND
250 yp=yp-ydelt:yax=yax-2
260 WEND
270 et=TIME
280 CALL &BB18
290 CALL &BC02:PRINT"Runtime ";(et-st)/300;" secs":END

[AMSDOS]

One more pure BASIC solution : from > 4200 seconds down to 1960 seconds

Code Select Expand


10 MODE 0
20 st=TIME
30 BORDER 2:INK 0,2:INK 1,9:INK 2,3:INK 3,6:INK 4,26
40 xdelt=0.125:ydelt=0.1
50 yp=10:yax=398
60 WHILE (yax>199)
70 yp2=yp*yp
80 yy=yp+yp
90 xp=-10:xax=0
100 WHILE (xax<640)
110 xp2=xp*xp
120 xx=xp+xp
130 r1=SQR(xp2-xx+2+yp2-yy)
140 r2=SQR(xp2+xx+2+yp2+yy)
150 z=COS(r1)+COS(r2)
160 c=0
170 IF z>2 THEN 230
180 IF z>1.5 THEN c=4:GOTO 220
190 IF z>1 THEN c=3:GOTO 220
200 IF z>0.5 THEN c=2:GOTO 220
210 IF z>0 THEN c=1
220 PLOT xax,yax,c:PLOT 640-xax,398-yax,c
230 xp=xp+xdelt:xax=xax+4
240 WEND
250 yp=yp-ydelt:yax=yax-2
260 WEND
270 et=TIME
280 CALL &BB18
290 CALL &BC02:PRINT"Runtime ";(et-st)/300;" secs":END

Looks interesting, could that be enhanced a little further in BASIC if the nested WHILE statements were replaced with something like:

Code Select Expand


240 IF xax<640 THEN GOTO 110



and:

Code Select Expand


260 IF yax<199 THEN GOTO 70



or I think even a FOR loop is faster than a WHILE loop, we know the range of the loop as well as the STEP of it. In Pascal I don't have the luxury of specifying a STEP size in a FOR loop. Specifying a STEP range in BASIC should eliminate the xax=xax+4 and yax=yax-2 in 230 & 250 respectively & should shave some of the 1960 off I think.

[revaldinho]

I"d like to just revive this thread for a minute, since this is about Hisoft Pascal 4T and plotting more circles of sorts.


Some time ago I came across this little ditty for the BBC Micro and which has been used as an informal benchmark for a few BBC related projects. I thought it was called Sphere but turns out to be Woolball and was originally written by Acornsoft. You can see the result of running on the Amstrad (actually JavaCPC for this screenshot) in the attachment.


This is the listing in BBC BASIC

Code Select Expand


10MODE 4
20S%=400
25TIME=0
30VDU29,800;512;
40MOVE 0,0
50FOR A=0.25 TO 126STEP0.25:PLOT13,S%*SINA,S%*COSA*SIN(A*.95):NEXT
60PRINT;TIME/100





And here is a more or less straight translation into Locomotive BASIC.

Code Select Expand


10 REM Sphere or Woolball demo after
20 REM Acornsoft BBC BASIC original
30 MODE 1
40 s%=160
50 start=TIME
60 ORIGIN 320,200
70 MOVE 0,0
80 FOR a=0 TO 126 STEP 0.25
90 DRAW s%*SIN(a),s%*(COS(a)*SIN(0.95*a))
100 NEXT a
110 PRINT "Runtime: ",(TIME-start)/300,"s"



And here's the code for the Hisoft Pascal 4T version:

Code Select Expand


(* Sphere or Woolball demo after Acornsoft BBC BASIC original *)
(*$C-,A-,I-,O-*)
program sphere;
const
  sc = 160; (* scale to 80% of screen height to match BBC original *)
var
  n, x, y: integer;
  i      : real;


procedure scrsetmode(mode : integer);
begin
   ra:=chr(mode);
   user(#bc0e)
end;


procedure grasetorigin(x,y : integer);
begin
   rde:=x; rhl:=y;
   user(#bbc9)
end;


procedure gramoveabs(x,y : integer );
begin
   rde:=x; rhl:=y;
   user(#bbc0)
end;


procedure gralineabs(x,y :integer );
begin
   rde:=x; rhl:=y;
   user(#bbf6)
end;


procedure graclearwindow;
begin
   user(#bbdb)
end;


begin
  scrsetmode(1);
  graclearwindow;
  grasetorigin(300,200);
  gramoveabs(0, 0);
  i:=0;
  for n := 0 to 504 do
    begin
      x := round(sc * sin(i));
      y := round(sc * cos(i) * sin(i*0.95));
      gralineabs(x,y);
      i := i + 0.25;       
    end;
end.




In fact, I've done a few versions of each to run in different but comparable modes, each sizing the 'sphere' to 80% of the available screen height.


It's a nice little demo which can be run on any machine really and provides a bit of a workout for sin() and cos() functions mainly.


So, the main question is how does HiSoft Pascal 4T shape up vs Locomotive BASIC ? But I got sidetracked a bit because I thought I should run the same test on a couple of other machines while I was at it. Here's a little table of results (in a code frame 'cos I couldn't figure out how to do tables in the forum).

Code Select Expand


Computer        Language       Lo-res          Med-res         Hi-res
-----------------------------------------------------------------------
Amstrad CPC464  BASIC          28.3            29.1             29.7(*)
Amstrad CPC464  HS Pascal 4T   11.9            12.5             13.0
BBC Model B     BBC BASIC      43.1            43.3             43.7
BBC Master 128  BBC BASIC      18.1            18.2             18.6   
Camputers Lynx  BASIC           -              81.0              -
-----------------------------------------------------------------------



(*) Yes, I know it doesn't match the JavaCPC screenshot, but that's the time from running on an actual '464.


So, those are the results. The BBC ones are interesting since the Model B and Master 128 are pretty much the same processor subsystem. The big difference here is a rewrite of the trig functions in BBC BASIC between the early model B and the much later Master. That's a major speed bump in software alone. I have to point out here though that any Beeb equipped with a Raspberry PI emulation of a second processor (Z80, 6502 ...) completely anihilates the opposition with pretty much any combination getting down to 1.5s and being limited only by the graphics and message passing between master and slave CPUS.


And just by the way, you might notice that my HP4T listings don't have line numbers. I've been writing these on a Mac using Emacs (and pascal-mode) and then translating them directly into HP4T 'tokenized' files with a python script. AMSDOS provided some of the tokens and hints on the file format earlier in this thread, and I've just used a hex editor to find the keyword and token tables in the original HP4T executable to get the rest. It seems to be working but is really a quick hack and I can't pretend it's fully tested. The source and some notes on the HP4T file format are in my github project in case anyone's interested:


https://github.com/revaldinho/cpc_pascal




R.

[AMSDOS]

That's so bizarre, as I had one of those which was published in an early issue of our Australian Magazine, The Amstrad User:

Code Select Expand



10 sizex=200
20 sizey=200
30 MODE 2
40 MOVE sizex*SIN(100)+320, sizey*COS(100)*SIN(100*0.95)+200
50 FOR a=100 TO 225.8 STEP 0.2
60 DRAW sizex*SIN(a)+320, sizey*COS(a)*SIN(a*0.95)+200
70 NEXT a



which I translated to Turbo Pascal 3, when I was using it, though it was hideously slow, so slow in fact that BASIC program was drawing it faster. I was only able to improve the TP program by setting up an array with the SIN & COS calculations in it.


The only difference between our programs is where they start drawing, this example above starts at the top of the sphere and works down before going back to the top.


I took the Turbo Pascal version I had and made a Hisoft Pascal 4t version of it, which seems to perform adequately compared to what I recall of the TP version, so I suspect HP4t is using a Lookup table for the COS() and SIN() functions.

Code Select Expand



   10 PROGRAM THREEDBALL;
   20 {$C-}
   30
   40  VAR sizex, sizey : integer;
   50      a            : real;
   60
   70 PROCEDURE draw(x,y,c : integer);
   80 BEGIN
   90   ra:=chr(c);
  100   user(#bbde);
  110   rde:=x;
  120   rhl:=y;
  130   user(#bbf6)
  140 END;
  150
  160 PROCEDURE move(x,y : integer);
  170 BEGIN
  180   rde:=x;
  190   rhl:=y;
  200   user(#bbc0)
  210 END;
  220
  230 PROCEDURE mode(n:integer);
  240 BEGIN
  250   ra:=chr(n);
  260   user(#bc0e)
  270 END;
  280
  290 BEGIN
  300   sizex:=200;
  310   sizey:=200;
  320   a:=100.0;
  330   mode(2);
  340   move (round(sizex*sin(100)+320)
  350        ,round(sizey*cos(100)*sin(100*0.95)+200));
  360   REPEAT
  370     draw(round(sizex*sin(a)+320),
  380         round(sizey*cos(a)*sin(a*0.95)+200),1);
  390     a:=a+0.20;
  400   UNTIL (a>225.8)
  410 END.





Incidentally thanks for mentioning the token system HP uses to help save space. I remember playing around with a file and translating what the bytes represented, unfortunately I'm not sure why, though with your program, it's now possible to take a text file and convert it into HP4t format. I'm using an old WinXP box with Winape, which makes it easy to simply type the program into a Text Editor and Paste it straight into the HP command line. And if I need to do more add programming in the Text Editor, I can get Winape to Output to File (rather than Printer) and use the 'Z' option in HP, to dump the program to file.


Incidentally, I've added both versions to attached DSK image (in the ZIP file).

[revaldinho]

That's so bizarre, as I had one of those which was published in an early issue of our Australian Magazine, The Amstrad User

Hmm. This one has obviously done the rounds ! I have found a copy of a very similar program in Acorn Electron User in 1987 ...but I'm not actually sure where the 'original' came from.


It's a nice short program that reasonably easy to remember for typing into unattended vintage machines. There's a whole thread on this kind of thing on stardot.


Good to hear you found the scripts useful. I like pfaffing about with the real hardware so being able to get the files easily onto my DDI-3 for compiling on the 464 is just so much better than having to use that line editor. HP4T is a marvel of programming given the limitation on having compiler, source and object code all shoehorned into available RAM. Would have been nice if they could have done a ROM instead with a better editor along the lines of the Arnor offerings.


I have typed in a couple more 'interesting' items for HP4T. One calculates digits of Pi and the other digits of 'e' (the natural number). The 'e' one is rather more successful as the maximum positive integer limit of 32767 in HP4T means that the Pi calculation starts to overflow after around 260 digits. Still, it takes a while to get there so maybe that's more than enough.


The 'e' spigot is faster per digit and I think can go to around 3000 digits before getting affected by the same overflow issue.

Code Select Expand


(* Compute digits of e using Rabinowitz & Wagon spigot algorithm *)
(* https://www.maa.org/sites/default/files/pdf/pubs/amm_supplements/Monthly_Reference_12.pdf *)
(*$C-,A-,I-,O-*)
program espigot;


const
   digits = 256;
   cols   = 258;
var
   i, j      : integer;
   n, q      : integer;
   current   : integer;
   remainder : array [0..cols] of integer;


begin
   remainder[0]:= 0;
   for i:= 1 to cols do
      remainder[i]:=1;
   
   write('2.');
   
   for j:=0 to digits-1 do
   begin
      q := 0;
      for i := cols downto 0 do
      begin
         n := q + remainder * 10;
         q := n DIV (i+1);
         remainder := n MOD (i+1)
      end;
      write(q:1);
   end;
   writeln;
end.




I've checked the code into the usual place, and also there's a BASIC version of the same algorithm. BASIC takes 786s for the first 256 digits of 'e' ; HP4T manages it in just 61s. Both these programs are integer only and I have a BCPL version somewhere, so I might dig that out and see how that compares too ...


R

[AMSDOS]

Hmm. This one has obviously done the rounds ! I have found a copy of a very similar program in Acorn Electron User in 1987 ...but I'm not actually sure where the 'original' came from.

I'm not sure from were from or what system. It was published in Issue 4 of The Amstrad User, May 1985. Occasionally the Amstrad User had Amstrad programs from the British magazines, but as far as I know, that program is original, in the sense of it only being in The Amstrad User, though as far as I know The Amstrad User wasn't marketed outside Australia and perhaps New Zealand (though NZ had their own magazines).



Some corrections were then added in Issue 6:

Code Select Expand

60 DRAW sizex*SIN(a)+320,sizey*COS(a)*SIN(a*0.95)+200

It's a nice short program that reasonably easy to remember for typing into unattended vintage machines. There's a whole thread on this kind of thing on stardot.


Good to hear you found the scripts useful. I like pfaffing about with the real hardware so being able to get the files easily onto my DDI-3 for compiling on the 464 is just so much better than having to use that line editor. HP4T is a marvel of programming given the limitation on having compiler, source and object code all shoehorned into available RAM. Would have been nice if they could have done a ROM instead with a better editor along the lines of the Arnor offerings.

I'm not sure when the 1st expansion ROMs came out, HP4t predates them though. This version of HP is pretty much a redevelopment Hisoft made to their Spectrum version (and from what I understand they made a few versions), to  make benefit what the Amstrad had to show and it was simply released as another Serious piece of Software from AMSOFT. However, Hisoft did produce Hisoft Pascal 80, which operates under CP/M and includes a program to convert Pascal Text Files into Hisoft Pascal 4t. I think when developing programs using CP/M, it's possible to write larger programs, though Hisoft Pascal 80 only compiles programs to CP/M.

I have typed in a couple more 'interesting' items for HP4T. One calculates digits of Pi and the other digits of 'e' (the natural number). The 'e' one is rather more successful as the maximum positive integer limit of 32767 in HP4T means that the Pi calculation starts to overflow after around 260 digits. Still, it takes a while to get there so maybe that's more than enough.


The 'e' spigot is faster per digit and I think can go to around 3000 digits before getting affected by the same overflow issue.

Code Select Expand


(* Compute digits of e using Rabinowitz & Wagon spigot algorithm *)
(* https://www.maa.org/sites/default/files/pdf/pubs/amm_supplements/Monthly_Reference_12.pdf *)
(*$C-,A-,I-,O-*)
program espigot;


const
   digits = 256;
   cols   = 258;
var
   i, j      : integer;
   n, q      : integer;
   current   : integer;
   remainder : array [0..cols] of integer;


begin
   remainder[0]:= 0;
   for i:= 1 to cols do
      remainder[i]:=1;
   
   write('2.');
   
   for j:=0 to digits-1 do
   begin
      q := 0;
      for i := cols downto 0 do
      begin
         n := q + remainder * 10;
         q := n DIV (i+1);
         remainder := n MOD (i+1)
      end;
      write(q:1);
   end;
   writeln;
end.




I've checked the code into the usual place, and also there's a BASIC version of the same algorithm. BASIC takes 786s for the first 256 digits of 'e' ; HP4T manages it in just 61s. Both these programs are integer only and I have a BCPL version somewhere, so I might dig that out and see how that compares too ...


R

Would be interested in the BCPL version since it's a typeless language.

[revaldinho]

Here's the BCPL version which I've just run on an actual 6128...

Code Select Expand


// Compute digits of e using Rabinowitz & Wagon spigot algorithm
// https://www.maa.org/sites/default/files/pdf/pubs/amm_supplements/Monthly_Reference_12.pdf


STATIC $( digits = 256 ; cols = 258 $)


LET start() = VALOF
$( LET i,j,n,q,current  = 1,1,1,1,1
   AND remainder = VEC 1026
   AND t = 0


   t := starttest(2)
   
   remainder!0 := 0
   FOR i = 1 TO cols-1 DO remainder!i := 1


   writes("*n2.")
   
   FOR j = 0 TO digits-1 DO $(
       q := 0
       FOR i = cols-1 TO 0 BY -1 DO $(
           n := q + (remainder!i) *10
           q := n / (i+1)
           remainder!i := n REM (i+1)           
       $)
       wrch(q+'0')
   $)
   newline()


   endtest(t)
   RESULTIS 0
$)



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

Code Select Expand


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.


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.


R.