CPCWiki forum

I've been having a look at this other Pascal Compiler which works under AMSDOS:

Hisoft Pascal 4T - CPCWiki (http://www.cpcwiki.eu/index.php/Hisoft_Pascal_4T)


and have generated a couple of small programs (nothing ground breaking), which handle Data Input/Output.


I had some other small BASIC files on this disk too, cause I was testing out How the data from the file generated could be managed in Hisoft Pascal 4T, though none of my attempts from those files (which were binary and ASCII based) would work in that environment.


LOADAT.BIN is the executable (7k) file I created using this compiler, though when I used the compiler to generate this program, it named it after my program file, fortunately the Source Code was stored as a Backup, though it just meant renaming everything back to what it was. (EDIT:  I think this is due to the fact this compiler was written to work on Tape on a 464, though will work on a 6128 and Disc Basic Systems).


Unfortunately to view the Pascal Source Code you will need that Compiler (I think), loading it from that compiler is no big deal:


G,,<filename.ext> or G,,loadat.pas


Listing the program from the compiler is merely 'L' followed by [ENTER] at the prompt.


The other program I made is "savedata.pas", which simply asks for some numbers (I think they can be letters or words though), 10 in all and then it stores them into the "DATA.DAT" file.


Unfortunately due to the nature of the way this Pascal Compiler handles the file I had to use it's built-in Loading and Saving facilities for me to load and Display the output, which has resulted in a file which is a bit of an unknown. My first impression was it was a Binary File cause their routines "TIN" & "TOUT" asks for a Start Origin for the file and TOUT asks for the Length of the file.
The Good News it works so the corresponding sections of the Array I setup reflect the values which are supposed to be in them.


The reason I had to setup these programs is because it won't let me do conventional Constant Arrays with Data in them, there maybe another way apart from going through every array position and giving it a value, though this seems to have worked even though I'm loading another file.


The Generated file "LOADAT.BIN" is a bit of a oddity, it's an executable file which begins @ &40h & seems to comprise of a bit of the terminal, so when the program is about to exit it will ask if you want to run it again, prompting anything but 'Y' will reset the computer.


People will probably noticed that I've got some other Pascal program on the attached disk image which is what I'm slowly working towards, it's a bit of a test though cause I'm converting this from my Turbo Pascal BOUNCY.PAS program.

Well it hasn't taken all that long for me to sort out that other program, there were a few horrible bugs in it though (horrible meaning obvious). It's slightly different from the one on my website, though the result appears the same (apart from the exit approach), it still exits on [ESC] there was a poke somewhere which could disable that.


It appears to run at the same pace as the Turbo Pascal version, though I haven't looked at it in ages.

This my latest update from the last program, I've revised my routine which plots an 8x8 image to the screen and made it an RSX  , which I can access from my Pascal program. Seems to have worked well, I'm grateful someone has put the Manual on CPCWiki cause I would of been stumped without it.  :D  Oh and yeah, the program with my revisions put in place, has doubled the speed of the program.  ;D


[attachimg=2]

So, just asking, what do these programs do?

Quote from: Gryzor on 12:42, 13 September 12
So, just asking, what do these programs do?

Oh I didn't want to bore you with the details about the first routine





The second program is more interesting, though still only a simple Graphical Bouncing Ball Bouncing around a Window Box. This program is on my Turbo Pascal website, though have modified it to work with Hisoft Pascal.





The Third program I made addresses the issues with the second program, but in this case I've incorporated a Machine Code RSX which draws up the Ball Sprite. From Hisoft Pascal I can use an External procedure which allows you to call that RSX and from that benefit more from the Machine Code.





On the Disk Images there should be some Binary Files which are around 7k or 8k, which are the compiled programs which can run from BASIC, the reason why their so large is it appears a large library file is there to be able to run the program.

Quote from: Gryzor on 12:42, 13 September 12
So, just asking, what do these programs do?

RUN"BOUNCY2" and watch ;)

Simple BASIC listing:
10 MODE 1
20 PRINT CHR$(23);CHR$(0)
30 PLOT 200,100,2:DRAW 440,100:DRAW 440,300:DRAW 200,300:DRAW 200,100
40 PRINT CHR$(23);CHR$(1)
50 SYMBOL 250,&X0,&X111100,&X1000010,&X1000010,&X1000010,&X1000010,&X111100
60 SYMBOL 251,0,0,&X111100,&X111100,&X111100,&X111100
70 TAG:x=320:y=200
80 xs=2:ys=2
90 x=x+xs:y=y+ys:GOSUB 150:CALL &BD19:GOSUB 150
100 IF TEST(x,y-16)=2 THEN ys=2
110 IF TEST(x,y+2)=2 THEN ys=-2
120 IF TEST(x-2,y)=2 THEN xs=2
130 IF TEST(x+16,y)=2 THEN xs=-2
140 GOTO 90
150 PLOT -5,-5,1:MOVE x,y:PRINT CHR$(250);:PLOT -5,-5,3:MOVE x,y:PRINT CHR$(251);:RETURN


Is there a way to do the same in BASIC without flickering? ;)

Quote from: Devilmarkus on 14:11, 13 September 12
Simple BASIC listing:

Code Select Expand

10 MODE 1
20 PRINT CHR$(23);CHR$(0)
30 PLOT 200,100,2:DRAW 440,100:DRAW 440,300:DRAW 200,300:DRAW 200,100
40 PRINT CHR$(23);CHR$(1)
50 SYMBOL 250,&X0,&X111100,&X1000010,&X1000010,&X1000010,&X1000010,&X111100
60 SYMBOL 251,0,0,&X111100,&X111100,&X111100,&X111100
70 TAG:x=320:y=200
80 xs=2:ys=2
90 x=x+xs:y=y+ys:GOSUB 150:CALL &BD19:GOSUB 150
100 IF TEST(x,y-16)=2 THEN ys=2
110 IF TEST(x,y+2)=2 THEN ys=-2
120 IF TEST(x-2,y)=2 THEN xs=2
130 IF TEST(x+16,y)=2 THEN xs=-2
140 GOTO 90
150 PLOT -5,-5,1:MOVE x,y:PRINT CHR$(250);:PLOT -5,-5,3:MOVE x,y:PRINT CHR$(251);:RETURN


Is there a way to do the same in BASIC without flickering? ;)

Having more CALL &BD19's will slow the flicker rate down a little bit, though it will start to slow things down a bit. Nice idea though defining the Ball as two defined symbols and using XOR Mode to combine the two. I think part of the problem is the XOR Mode unfortunately, because anything which uses it has to be constantly refreshed before it gets moved.  :(  Applying something like that from Assembly and using Firmware would accelerate the progress, the flicker would still be evident, though less obvious or distracting.


I kind of wonder how the flicker would be though if you had the CALL &BD19 before GOSUB 150 in line 90 and having another line between 130 & 140 which "CALL &BD19" & "GOSUB 150" to remove the XORed image.
Also you haven't defined any of your variables - "x,y, xs or ys" are all Integer, though BASIC will just assume their Real numbers, "defint a-z" fixes that or "%" after your variables - "x%=320","y%=200"," xs%=2" or "ys%=2"  might help.

Quote from: Devilmarkus on 14:11, 13 September 12
Is there a way to do the same in BASIC without flickering? ;)

Wasn't sure if you had an answer for that flickering problem. I just remembered over in my other thread I had a small BASIC program which was moving a Square around using "ORIGIN", this also had some flickering associated with it though.


The only thing I've seen bounce around in BASIC which Nich typed in was this Blitter program:
Amstrad Action July 1986 Type-Ins - CPCWiki (http://www.cpcwiki.eu/index.php/Amstrad_Action_July_1986_Type-Ins)
In that situation the program is using the illiusion of making the background look still with the Ball moving around and is using some OUT statements for the effect.  :o


I've had a couple of ideas studying your BASIC code (with the TEST checks) and some other stuff from another BASIC game and I thought it would be interesting to test the "EVERY" instruction which is available in Hisoft Pascal.

Yeah I know the Blitter-demo.
They move the screen-ram by using OUT functions.
So everything moves: Background, ball, everything ;)

But is it possible to animate small sprites in BASIC without flickering?

OT: CP/M User, you have solved a mystery that i had since my childhood. This "blitter" program was published in the spanish "Amstrad User", but i always have known that was copied from other place, because in 1986 the number of Amiga users in Spain was practically 0 :)

Quote from: Devilmarkus on 11:29, 09 October 12
So everything moves: Background, ball, everything ;)

Yep, except it's setup in such a way that it looks like the Ball only moves.  ;D

Quote
But is it possible to animate small sprites in BASIC without flickering?

Haven't been able to demonstrate it, though I have define a 6x6 shape and move it around the screen without flicker, so perhaps it's possible to rig up something like what you've done, unsure what would happen if you tried to make the image larger, more flicker perhaps?

Quote from: SyX on 14:35, 09 October 12
OT: CP/M User, you have solved a mystery that i had since my childhood. This "blitter" program was published in the spanish "Amstrad User", but i always have known that was copied from other place, because in 1986 the number of Amiga users in Spain was practically 0 :)

I recently notice the same sort of thing happening in our own Australian Amstrad Magazine which had some Type-ins from Amstrad 464 User for example and later on they had cheats (from Amstrad Action), I think it was all legitimate though and Type-ins were acknowledged to their respected authors.

This is my effort which is blinking in the middle.  ;D


10 MODE 1

20 SYMBOL 255,0,60,66,66,66,66,60,0
30 SYMBOL 254,0,0,60,60,60,60,0,0
40 x=0:xdir=2:y=100:ydir=2
50 WHILE 1
60 x=x+xdir:y=y+ydir:PRINT CHR$(23);CHR$(0);:TAG:PLOT -2,-2,1:MOVE x,y:CALL &BD19:PRINT CHR$(255);:TAGOFF
70 PRINT CHR$(23);CHR$(1);:TAG:PLOT -2,-2,3:MOVE x,y:CALL &BD19:PRINT CHR$(254);:TAGOFF
80 IF x=100 THEN xdir=-2
90 IF x=0 THEN xdir=2
100 IF y=300 THEN ydir=-2
110 IF y=16 THEN ydir=2
120 WEND

my two attempts... I think it's not possible in BASIC without flickering at all...


10 MODE 1
20 ORIGIN 0,0
30 DEFINT a-z
40 transoff$=CHR$(23)+CHR$(0)
50 transon$=CHR$(23)+CHR$(1)
60 GRAPHICS PEN 2:MOVE 200,100:DRAW 440,100:DRAW 440,300:DRAW 200,300:DRAW 200,100
70 PRINT transon$
80 SYMBOL 250,&X0,&X111100,&X1000010,&X1000010,&X1000010,&X1000010,&X111100
90 SYMBOL 251,0,0,&X111100,&X111100,&X111100,&X111100
95 s1$=CHR$(250)
96 s2$=CHR$(251)
100 TAG:x=320:y=200:dxp=2:dyp=2:dxn=-2:dyn=-2:yo=300:yu=114:xl=200:xr=426
130 dy=dyp:dx=dxp
135 GRAPHICS PEN 1
140 WHILE 1
150 MOVE x,y:PRINT s1$;:MOVE x,y:GRAPHICS PEN 3:CALL &BD19:PRINT s2$;
160 IF y>=yo THEN dy=dyn
170 IF y<=yu THEN dy=dyp
180 IF x<=xl THEN dx=dxp
190 IF x>=xr THEN dx=dxn
200 x=x+dx:y=y+dy
210 MOVE x-dx,y-dy:CALL &BD19:PRINT s2$;:MOVE x-dx,y-dy:GRAPHICS PEN 1:PRINT s1$;
220 WEND


here with a changing of screen base address and out commands

5 MEMORY &3FFF
10 MODE 1
20 ORIGIN 0,0
30 DEFINT a-z
40 transoff$=CHR$(23)+CHR$(0)
50 transon$=CHR$(23)+CHR$(1)
65 WINDOW 12,28,6,19
70 PRINT transon$
80 SYMBOL 250,&X0,&X111100,&X1000010,&X1000010,&X1000010,&X1000010,&X111100
90 SYMBOL 251,0,0,&X111100,&X111100,&X111100,&X111100
95 s1$=CHR$(250)
96 s2$=CHR$(251)
100 TAG:x=320:y=200:dxp=2:dyp=2:dxn=-2:dyn=-2:yo=300:yu=114:xl=200:xr=426
105 bs=&B7C6:b=&40:p1=&BCFF:p2=&BDFF
130 dy=dyp:dx=dxp
140 WHILE 1
145 b=&100-b:POKE bs,b:CLS
150 MOVE x,y:GRAPHICS PEN 1:PRINT s1$;:MOVE x,y:GRAPHICS PEN 3:PRINT s2$;
160 IF y>=yo THEN dy=dyn
170 IF y<=yu THEN dy=dyp
180 IF x<=xl THEN dx=dxp
190 IF x>=xr THEN dx=dxn
200 x=x+dx:y=y+dy
210 OUT p1,12:OUT p2,b\4
220 WEND


I'm intrigued with that second example, though I'm not totally sure how it works even though I can see the final result on a 6128. I tried altering the program to work on a 464, though I couldn't get the same result, I even changed "bs=&B7C6" to read "bs=&B1CB", but had no luck cause it looks like it works slightly differently on a 464.  :o

Okay I understand that 2nd program better now, this will work on a 464:




10 MEMORY &3FFF
20 MODE 1
30 ORIGIN 0,0
40 DEFINT a-z
50 transoff$=CHR$(23)+CHR$(0)
60 transon$=CHR$(23)+CHR$(1)
70 WINDOW 12,28,6,19
80 PRINT transon$
90 SYMBOL 250,0,60,66,66,66,60
100 SYMBOL 251,0,0,60,60,60,0
110 x=320:y=200:dxp=2:dyp=2:dxn=-2:dyn=-2:yo=300:yu=114:xl=200:xr=426
120 bs=&B1CB:b=&40:p1=&BCFF:p2=&BDFF
130 dy=dyp:dx=dxp
140 WHILE 1
150 b=&100-b:POKE bs,b:CLS
160 TAG:PLOT -2,-2,1:MOVE x,y:PRINT CHR$(250);:PLOT -2,-2,3:MOVE x,y:PRINT CHR$(251);:TAGOFF
170 IF y>=yo THEN dy=dyn
180 IF y<=yu THEN dy=dyp
190 IF x<=xl THEN dx=dxp
200 IF x>=xr THEN dx=dxn
210 x=x+dx:y=y+dy
220 OUT p1,12:OUT p2,b\4
230 WEND



"tag" seems to work a little bit differently on a 464 cause the formatted control codes (for XOR I think) was returning unwanted rubbish and messing up the screen. Simply restricting "tag"/"tagoff" to that line resolves that problem.

Normally it's a semicolons task (after a print command) to surpress printing control codes while tag is switched on. Never had programed on BASIC 1.0 so far ...interesting.

Quote from: HAL 6128 on 19:44, 12 October 12
Normally it's a semicolons task (after a print command) to surpress printing control codes while tag is switched on. Never had programed on BASIC 1.0 so far ...interesting.

Yep the semicolons are working fine, the culprit in this case is "CLS". In BASIC 1.0 if "TAG" is enabled and "CLS" is carried out, it will return the control code for Clear Screen -> "PRINT CHR$(12);"
In BASIC 1.1, even if "TAG" is enabled and Clear Screen is applied, then the Screen will be cleared. In an odd way BASIC 1.0 is sort of correct because "CLS" is applying "PRINT CHR$(12);".

Wasn't sure what was happening with the Wiki at the moment, but if this looks interesting I'll stick this on it. Let me know.


In this example I will be using my own little Assembly routine which plots an image to screen:




   org &8000


;; Conditions of Entry Usage - |PLOTIMAGE,<xpos>,<ypos>,<address of image>
;;                         e.g |PLOTIMAGE,100,200,&80A5


   ld hl,workspace
   ld bc,table
   call &bcd1
   ret
.table   defw table2
   jp beginplot


.workspace
   defb 0,0,0,0
.table2
   defb 'PLOTIMAG'
   defb 'E'+&80
   defb 0   
   
.beginplot
   ld l,(ix+00)            ;; Address of Data Colour
   ld h,(ix+01)
   ld (addrcolour),hl         ;; Place this into Address Colour


   ld l,(ix+04)
   ld h,(ix+05)
   ld (xpos),hl            ;; Place co-ordinates of Image into Xpos
   ld (resxpos),hl


   ld l,(ix+02)
   ld h,(ix+03)
   ld (ypos),hl            ;; Place co-ordinates of Images into Ypos
   
.plotimg   
   ld hl,(addrcolour)         ;; Place Contents of Address Colour into HL
   ld a,(hl)            ;; Put Contents of HL into A
   call do_colour   


   ld de,(xpos)            ;; XPOS data into DE
   ld hl,(ypos)            ;; YPOS data into HL
   call &bbea            ;; GRA ABSOLUTE PLOT


   ld hl,(xpos)            ;; Obtain Contents of XPOS
   inc hl               ;; Is 16bit Value so Increment 
   inc hl               ;; Twice
   ld (xpos),hl            ;; Place next value into XPOS
   
   ld a,(fcount)            ;; First Counter Position into A
   inc a               ;; Increment this     
   ld (fcount),a            ;; Put New Value into First Count Position
   ld b,a               ;; Put this value into B


   ld a,(xlcount)            ;; Place First Counter Marker into A


   cp b               ;; Has value of B reached A value
   jr nz,plotimg            ;; If No Loop back, otherwise continue


   ld a,(fcount)            ;; At this stage fcount equals 8
   xor a               ;; This will make it 0 again
   ld (fcount),a            ;; And put that value into fcount


   ld hl,(ypos)            ;; YPOS of data can now be Incremented
   dec hl               ;; Again 16bit Value means Incrementing
   dec hl               ;; it Twice
   ld (ypos),hl            ;; And put that value into YPOS.


   ld hl,(resxpos)            ;; Need to restore the value of XPOS.
   ld (xpos),hl            ;; New Value goes into XPOS.
   
   ld a,(scount)            ;; Second counter goes into A
   inc a               ;; Increase it.
   ld (scount),a            ;; Place back into Second Counter
   ld b,a               ;; Put value of Second counter into B


   ld a,(ylcount)            ;; Place Y-counting position into A


   cp b               ;; Compare A to value of B
   jr nz,plotimg            ;; If reached exit, otherwise return
   
   ld a,0               ;; \
   ld hl,fcount            ;; \\
   ld (hl),a            ;; Returns loop values back to 0 (important)
   ld hl,scount            ;; //
   ld (hl),a            ;; /
   
   ret               ;; Program exits here.


.do_colour
     call &bbde            ;; GRA SET PEN - A = Pen Colour
     ld hl,(addrcolour)         ;; Take address of address colour
     inc hl               ;; Increment it by 1
     ld (addrcolour),hl         ;; Put this value into Address Colour
     ret               ;; Return to Main Loop Routine.
   
.fcount defb 0
.scount defb 0
.xlcount   
   defb 8               ;; Number of times to loop across.
.ylcount
   defb 8               ;; Number of times to loop down
.xpos   defw 0               ;; Left Position the image
.ypos   defw 0               ;; Bottom Position of the image.
.resxpos
   defw 0               ;; This is used to Restore Xpos.
.data_colour
    defb 0,0,0,0,0,0,0,0
    defb 0,0,1,1,1,1,0,0
    defb 0,1,3,3,3,3,1,0
    defb 0,1,3,3,3,3,1,0
    defb 0,1,3,3,3,3,1,0
    defb 0,1,3,3,3,3,1,0
    defb 0,0,1,1,1,1,0,0
    defb 0,0,0,0,0,0,0,0


.addrcolour
    defw 0               ;; This points to the address position
                  ;; within the data colour.



It's not the fastest thing around, and certainly other proper Sprite Routines could be used, to show how to Incorporate other RSX routines into Hisoft Pascal. :)


I've been using Winape and for the Assembly Examples I've been using Winape Assembler, though my routines should work with Maxam too.


Once it's been Assembled into Memory the next phase is to disassemble it in BASIC. Because I'm using Winape, I can print the code to printer file:



for num=0 to 231:print#8,num;"    ";peek(32768+num):next num



Unfortunately, I have to do this to get the code into a file that Hisoft Pascal 4T can read, though in the source, I have numbered the values for reference, so it makes it easier to key in each opcode.


It should produce something like this (as long as the program is in memory):




0    33
1    15
2    128
3    1
4    10
5    128
6    205
7    209
8    188
9    201
10    19
11    128
12    195
13    29
14    128
15    0
16    0
17    0
18    0
19    80
20    76
21    79
22    84
23    73
24    77
25    65
26    71
27    197
28    0
29    221
30    110
31    0
32    221
33    102
34    1
35    34
36    229
37    128
38    221
39    110
40    4
41    221
42    102
43    5
44    34
45    159
46    128
47    34
48    163
49    128
50    221
51    110
52    2
53    221
54    102
55    3
56    34
57    161
58    128
59    42
60    229
61    128
62    126
63    205
64    144
65    128
66    237
67    91
68    159
69    128
70    42
71    161
72    128
73    205
74    234
75    187
76    42
77    159
78    128
79    35
80    35
81    34
82    159
83    128
84    58
85    155
86    128
87    60
88    50
89    155
90    128
91    71
92    58
93    157
94    128
95    184
96    32
97    217
98    58
99    155
100    128
101    175
102    50
103    155
104    128
105    42
106    161
107    128
108    43
109    43
110    34
111    161
112    128
113    42
114    163
115    128
116    34
117    159
118    128
119    58
120    156
121    128
122    60
123    50
124    156
125    128
126    71
127    58
128    158
129    128
130    184
131    32
132    182
133    62
134    0
135    33
136    155
137    128
138    119
139    33
140    156
141    128
142    119
143    201
144    205
145    222
146    187
147    42
148    229
149    128
150    35
151    34
152    229
153    128
154    201
155    0
156    0
157    8
158    8
159    0
160    0
161    0
162    0
163    0
164    0
165    0
166    0
167    0
168    0
169    0
170    0
171    0
172    0
173    0
174    0
175    1
176    1
177    1
178    1
179    0
180    0
181    0
182    1
183    3
184    3
185    3
186    3
187    1
188    0
189    0
190    1
191    3
192    3
193    3
194    3
195    1
196    0
197    0
198    1
199    3
200    3
201    3
202    3
203    1
204    0
205    0
206    1
207    3
208    3
209    3
210    3
211    1
212    0
213    0
214    0
215    1
216    1
217    1
218    1
219    0
220    0
221    0
222    0
223    0
224    0
225    0
226    0
227    0
228    0
229    0
230    0
231    0



For this example and for it to work in the following program which was written in Hisoft Pascal, the code has to be in decimal.




   10 PROGRAM SaveData2;
   20
   30 VAR
   40   data : ARRAY[0..231] OF INTEGER;
   50   count : integer;
   60
   70 BEGIN
   80 WRITELN('Enter Data:');
   90 FOR count:=0 TO 231 DO
  100 BEGIN
  110   WRITE(count);
  120   write(' : ');
  130   read(data[count]);
  140 END;
  150
  160 writeln('Entering Complete Saving Data.');
  170 TOUT('SPREBALL.DAT',ADDR(data),SIZE(data));
  180 END.



In order to use other routines, modifications would have to be made to the size of the array which is 232 bytes for my example along with adjustments to the size of the loop which has been custom made for handling my routine. Running this program in Hisoft Pascal it will display a counter along with a spot to enter the appropriate value, once it's reach the end with all the values entered it will save the file using it's own TOUT command with the address pointing to where the  data array is and the size of it.


And now the final program with Demo. When running Hisoft Pascal, it will prompt you where to set the RAM Top, in this example I say &7FFF because that's where my routine will be going. I've thrown in a number of procedures which is what Hisoft Pascal 4T encourages which was done to help minimise the size of the code.




   10 PROGRAM BOUNCY;
   20 { *** Written IN Hisoft Pascal 4T *** }
   30 { ***        Public Domain        *** }
   40 { *** Save PROGRAM BEFORE Running *** }
   50 { *** Now Using External M/C FOR  *** }
   60 { ***       Sprite Routine!       *** }
   70 
   80 VAR
   90   Prog : ARRAY [0..231] OF integer;
  100   Xpos, Xdir, Ypos, Ydir,
  110   Width, Length : integer;
  120   Loop : Boolean;
  130 
  140 PROCEDURE LoadSprite;
  150  VAR
  160    loop : integer;
  170
  180  BEGIN
  190    tin('spreball.dat',addr(Prog));
  200    FOR loop:=0 TO 231 DO
  210      poke(#8000+loop,prog[loop]);
  220    user(#8000);
  230  END;
  240
  250 Procedure mode(mo:integer);
  260  begin
  270    RA:=chr(mo);
  280    USER(#BC0E);
  290  end;
  300
  310 PROCEDURE Ink(no,col : integer);
  320  BEGIN
  330   RA:=chr(no);
  340   RBC:=col;
  350   USER(#BC32);
  360  END;
  370
  380 Procedure Draw(Xpos, Ypos : Integer);
  390  begin
  400    RDE:=Xpos;
  410    RHL:=Ypos;
  420    USER(#BBF6);
  430  end;
  440 
  450 Procedure Move(Xpos, Ypos : Integer);
  460  begin
  470    RDE:=Xpos;
  480    RHL:=Ypos;
  490    USER(#BBC0);
  500  end;
  510
  520 Procedure resetcolor;
  530  begin
  540    USER(#BC02);
  550  end;
  560
  570 Procedure grapen(col:integer);
  580  begin
  590    RA:=chr(col);
  600    USER(#BBDE);
  610  end;
  620
  630 Procedure PlotPoint(xpos,ypos:integer);
  640  begin
  650    RDE:=xpos;
  660    RHL:=ypos;
  670    USER(#BBEA);
  680  end;
  690
  700 Procedure Frame;
  710  begin
  720    USER(#BD19);
  730  end;
  740
  750 { Main Procedures }
  760
  770 PROCEDURE PlotImage(Xpos, Ypos, Adr : integer);
  780 BEGIN
  790   external('plotimage',xpos,ypos,adr);
  800 END;
  810
  820 Procedure DrawBox;
  830  Begin
  840   Grapen(2);
  850   Move(200,300);
  860   Draw(470,300);
  870   Draw(470,100);
  880   Draw(200,100);
  890   Draw(200,300);
  900  End;
  910
  920 begin { Main Routine }
  930  ResetColor;
  940   LoadSprite;
  950  Mode(1);
  960  ink(0,#0000);
  970  ink(1,#0202);
  980  ink(3,#0b0b);
  990  DrawBox;
1000   Loop:=True;
1010   Xpos:=205;
1020   Ypos:=281;
1030   Xdir:=1;
1040   Ydir:=-1;
1050  REPEAT
1060    Xpos:=Xpos+Xdir;
1070    Ypos:=Ypos+Ydir;
1080    Frame;
1090    Frame;
1100    PlotImage(Xpos,Ypos,#80A5);
1110   Case Xpos of
1120    454 : Xdir:=-1;
1130    202 : Xdir:=1
1140   end;
1150   Case Ypos of
1160    298 : Ydir:=-1;
1170    118 : Ydir:=1
1180   end;
1190  UNTIL Loop=False;
1200 { This is an Infinate Loop }
1210 END.



In relation to the M/C I've produced, I'm using the LoadSprite procedure to load the code using TIN. Because I was using a Tape Version of Hisoft Pascal 4T <- presumibly 4T means 4 Tape :) if the filename was less than 8 Characters then spaces need to be inserted, though because my filename is 8 characters along with the 4 for the extension they aren't shown. A shorter filename would have spaces to bring it upto the 8 characters and then followed by the ".EXT" bit.
In this example you'll noticed I've called the data array from the last program -> "prog" instead though still with the same size. What TIN does is load the contents into the Array - prog, but then I need to Poke those contents into Memory for where it should go, which is what the loop after that is doing and then it does a USER(#8000) which is a "CALL &8000" in BASIC to activate the RSX and from there I can use that RSX in my own program.


In my example what's happened is I've setup a routine which plots a specific image, the RSX has parameters associated with it which ask what the XPOS, YPOS and the address of the Image.
The address of the Image in my case is where I setup ".data_colour" in my Assembly code, so I've got that address from when I assembled the code.


In my final code these lines:




770 PROCEDURE PlotImage(Xpos, Ypos, Adr : integer);
  780 BEGIN
  790   external('plotimage',xpos,ypos,adr);
  800 END;



deal with the setting up that Procedure which I've called in line 1100 to display the correct image. The important thing to note in Hisoft Pascal is Hexadecimal numbers being with the hash "#" otherwise the compiler it spits the dummy.


Well after all that I hope this encourages those not to do it! :D

I've been trying to create some routines which generate some random numbers though the random function seems to be nearly useless. :( For instance to get a random number out of the thing - "num:=random(0)" has to be used which generates a number between 0..32767, but all I want is a number between 0 & 20, so then I have to produce something which gets me something between those values.




   10 PROGRAM RanNumbers;
   20
   30 VAR num : integer;
   40     num2 : integer;
   50     count : integer;
   60
   70 BEGIN
   80 num:=random(0);
   90 num:=trunc(num/7/7/7);
  100 IF num>50 THEN num:=trunc(num/7);
  110 IF num>20 THEN num:=trunc(num/num);
  120 writeln(num);
  130 END.


This was my first routine which is really a rough routine - 7 seemed to be the best number to use given nothing goes into it, though if the number falls between 21 & 50, then it gets divided by itself to give you 1 - bizarre.






   10 PROGRAM RanNumbers2;
   20
   30 VAR num : integer;
   40     num2 : integer;
   50     count : integer;
   60
   70 BEGIN
   71 page;
   80 num:=random(0);
   90 writeln('First Number');
  100 writeln(num);
  110 num2:=random(0);
  120 writeln;
  130 writeln('Second Number');
  140 writeln(num2);
  150 writeln;
  160 IF num2>num THEN num:=num2-num ELSE num:=num-num2;
  170 writeln('Equals');
  180 writeln(num);
  190 writeln;
  200 IF num>1000 THEN num:=trunc(num/7);
  210 IF num>500 THEN num:=trunc(num/7);
  220 IF num>140 THEN num:=trunc(num/7);
  230 IF num>20 THEN num:=trunc(num/7);
  240 writeln('Final Result');
  250 writeln(num);
  260 END.


This second program is perhaps a bit better, though it has to do more to get to a final result. Two Random number seeds are setup, line 160 works out which number is larger and subtracts the larger number from the smaller number. After that if the number is still over 1000 is gets divided by 7 and so on if the number is larger than 500, 140 & 20. The trouble with this routine is you cannot get anything smaller than 3 - maybe I should divide more than 7 - have it divide by 13 perhaps?


I might be better if I use an assembly routine to generate a random number, any thoughts? It's just annoying that something effective can be done in BASIC with n=(rnd*20) to get a number within a certain range.

Anyone who remembers the ol' Amstrad Manual will probably know the Circle program where the manual gives you the opportunity to play around with the different drawing aspects of it, etc.


Well I've taken the original and made it for this Pascal:


10 PROGRAM circle;

   20 (*$c-*)
   30
   40 VAR loop : integer;
   50
   60 PROCEDURE move(x,y : integer);
   70 BEGIN
   80   rde:=x;
   90   rhl:=y;
  100   user(#bbc0);
  110 END;
  120
  130 PROCEDURE draw(x,y : integer);
  140 BEGIN
  150   rde:=x;
  160   rhl:=y;
  170   user(#bbf6);
  180 END;
  190
  200 PROCEDURE mode(a : char);
  210 BEGIN
  220   ra:=a;
  230   user(#bc0e);
  240 END;
  250
  260 FUNCTION degtorad(val : integer) : real;
  270 VAR num1 : real;
  280 BEGIN
  290   num1:=3.14159/180;
  300   degtorad:=num1*val;
  310 END;
  320
  330 BEGIN
  340   mode(chr(1));
  350   loop:=0;
  360   REPEAT
  370     move(320,200);
  380 draw(round(320+190*cos(degtorad(loop))),round(200+190*sin(degtorad(loop))));
  390     loop:=loop+1;
  400   UNTIL loop=361;
  410 END.


The program blows out a bit because I need to setup MODE, MOVE & DRAW (things which BASIC takes for granted), just to use them for this routine. The other thing the original program does is calculate everything in DEGrees. You can draw it in RADians, though the output is obviously different (if output of the original program is critical), and yes there is Firmware which allows you to change from RADians to DEGrees and visa-versa, which works in BASIC, however this is part of the Maths Firmware which is a part of where Addresses begin to change between 464 & 664/6128, plus on top of that the Pascal routines COS() & SIN() for which the Degrees normally takes effect in, doesn't work if the machine is setup in DEGrees, meaning the result will always be in RADians. So the only other way I know how to get the result looking like DEGrees is to convert it to a result in RADians, but when a COS() or SIN() is applied the result there will be similar to something which is in Degrees.


[attachimg=2]

Further to the Random Number stuff I had earlier, I've been plugging along to get some external M/C 8bit Random number routines working. After a lot of mucking about, and realising I need to load my External File into the Internal Array and then poke it to memory and then call it at Runtime so they work correctly, I've managed to get something which Produces a Random Seed (0-255) & a hundred or so random numbers between 0 & 19. Because Hisoft Pascal is kind of like traditional Pascal, it doesn't recognise the "Byte" type, so I'm being a rebel here and am using "Char" type, which is more or less the same, except in some circumstances it needs chr() & ord() in order to pass a value as a character or return an ordinal value. Not sure if it's a good thing since chr() & ord() use memory, the alternative is to make it an integer which uses 2 bytes instead of 1, my M/C Routines though are only using 1 byte to return a Seed & a Random Result, but in this example I've used peek to return the value back to the variable.


Earlier I tried to make an internal routine using Inline M/C, though I'm not sure what's wrong with my Random routine, the advantage of that would be I wouldn't need to worry about loading a RSX based Library all the time, and I could just throw in the appropriate bit of code rather than having to compile different RSX libraries all the time.


[attachimg=2]

Quote from: SyX on 14:35, 09 October 12
This "blitter" program ... the number of Amiga users in Spain was practically 0 :)

Although the Amiga made the term blitter popular, it was actually in common use before that coming from at least Xerox in 1975.

In Amiga circles, it always accepted that it comes from "block image transfer", but was originally known as BITBLT for "bitwise block transfer" before morphing into "bit blit" and then just "blit". The original term BLT came from the PDP-10 from the 60s which had an instruction BLT for block transfers.

There's a bit more info here: blit (http://www.catb.org/jargon/html/B/blit.html)

Yes, of course, i learnt that kung-fu during the 90s :)

But if finding an amiga user in Spain in that year was impossible, getting somebody with knowledge about the Xerox Alto was an utopia, jejejeje.

Although i said more for the "boing" demo than the blitter term, another curiosity about this, it's the occurrences of the "boing" demo in other platforms, for example in the pause mode in the zx spectrum "Fat Worm blows a sparky" (http://www.worldofspectrum.org/infoseekid.cgi?id=0001736) :)

Well I'm not really a mathematical person, but I've worked out a Function which will work out a range and generate random based Integer numbers within a specified range, which pretty much makes my earlier Pascal based Random Number examples redundant.  :(


The Good news is I've tested this function to the extent it seems to work, but I don't expect it to work if the range is set to 0 because you simply don't divide by 0:




   10 PROGRAM integernd;
   20
   30 VAR num1, loop : integer;
   40
   50 FUNCTION intrnd(range : integer) : integer;
   60 VAR seed, result : integer;
   70 BEGIN
   80   seed:=random(0);
   90   result:=round(maxint/range);
  100   intrnd:=round(seed/result);
  110 END;
  120
  130 BEGIN
  140   FOR loop:=0 TO 100 DO
  150   BEGIN
  160    num1:=intrnd(30);
  170    write(num1);
  180   END;
  190 END.



So the idea I had was if you took the largest Integer based number which is 32767 in this case, divide it by a range specified, it will work out how many times how many times that will go into 32767 to which that gets stored into result. The next part is getting a random number, which I've done by storing a random number into seed, the seed is then divided with the result to produce a number within the specified range specified. In my example line 160 uses the function which specifies a range between 0-30 and the output from line 170 will certainly correspond to that.


[attachimg=2]

Quote from: AMSDOS on 05:56, 19 May 13
So the idea I had was if you took the largest Integer based number which is 32767 in this case, divide it by a range specified, it will work out how many times how many times that will go into 32767 to which that gets stored into result. The next part is getting a random number, which I've done by storing a random number into seed, the seed is then divided with the result to produce a number within the specified range specified. In my example line 160 uses the function which specifies a range between 0-30 and the output from line 170 will certainly correspond to that.

This will produce skewed distributions, and also wrong results in some cases, even in your example case.

Consider a range of 30000. Result will be 1, so integers will be returned 0..32767.
Consider a range of 20000. Result will be 2, so integers will be returned 0..16383.
Consider a range of 30. Result will be 1092, so integers will be returned 0..30 (0..29 will be returned with p=1092/32768, 30 will be returned with p=7/32768).

There's a much better way of doing it, although I'm not sure how easy it is to achieve in pascal. But it's essentially based on the original random number being evenly distributed over 0..32767 (i.e. 0..2^15-1)

So, in C, it'd be:

uint16_t randrange(uint16_t range)
{
uint16_t seed = random(0);
uint32_t scale = seed * range;
uint16_t result = (uint16_t) (scale>>15);
return result;
}

This has the advantage that you've only got a shift and a multiply instead of 2 divides.

The shift right by 15 is also effectively a shift left by 2 and discarding the lower bytes. In assembler, say for example DE:HL holds the 32 bit number, that's just:

ADD HL,HL
EX DE,HL
ADC HL,HL

leaving the result in HL. So, it's just the multiply that needs to be done, but hopefully there's something in the pascal library to do that for you...

Thanks for picking that up, unfortunately the code I posted earlier went through a series of changes, before I realised I had some other problems which wasn't giving me the correct results and as you picked up larger numbers are getting through or are limited in nature.


So I don't know if this following will meet with your approval, these old 8bit Pascal compilers don't have the luxury of long integers, true they do support "reals" which are larger again, though I think their main function is to be used as Decimal Based numbers:


   10 PROGRAM integernd;
   20
   30 VAR num1, loop : integer;
   40
   50 FUNCTION intrnd(range : integer) : integer;
   60 VAR seed   : integer;
   70     result : real;
   80 BEGIN
   90   seed:=random(0);
  100   result:=(maxint/range);
  110   result:=(seed/result);
  120   intrnd:=round(result);
  130 END;
  140
  150 BEGIN
  160   FOR loop:=0 TO 100 DO
  170   BEGIN
  180    num1:=intrnd(30000);
  190    write(num1);
  200   END;
  210 END.



So in this case I've reverted result as a real type because I really need the decimal accuracy to determine the true range, I guess if it's bad to Divide twice I could alter these lines:




  100   result:=(range/maxint);
  110   result:=(seed*result);



With line 120, I found if my range was 1, I was just getting 0's, so rounding the number up at that stage should be fine. I'll have to try some more numbers, though I haven't noticed any larger numbers out of their range. Unfortunately I'm unsure on how to do an alternative using Pascal, though I can certainly check out Assembly alternatives which I have already done with the 8bit random number generator. I was trying to do something like this just to see if I could apply some kind of range process in the same manner as BASIC returning a random number in range by using something like this:


? rnd*15

I've had a go at converting this BASIC Star Field program (http://www.cpcwiki.eu/forum/programming/interesting-type-ins/msg54531/#msg54531), so it works to a point in Hisoft Pascal. I say to a point because I've been comparing the two programs, my Hisoft Pascal programs works and execution timing makes it interesting to compare with the Original program.  ;D 
Though in my program, the stars seem to wobble around, which I quite like, though the original program doesn't really show any wobbling stars moving around the screen, because BASIC has this ingenious way of taking Decimal based numbers and get it to work with Integer based numbers (and in this case there's also Arrays).

Another one I've got on my Turbo Pascal website, to get it running in Hisoft Pascal 4T, some behind the scenes coding was required to get this one working, which relates to setting up a character matrix and pointing it to the address of the array where I wanted to put my redefined character.

Quote from: ralferoo on 09:10, 19 May 13


So, in C, it'd be:

Code Select Expand


uint16_t randrange(uint16_t range)
{
uint16_t seed = random(0);
uint32_t scale = seed * range;
uint16_t result = (uint16_t) (scale>>15);
return result;
}

This has the advantage that you've only got a shift and a multiply instead of 2 divides.

The shift right by 15 is also effectively a shift left by 2 and discarding the lower bytes.

Ok, I think I understand your example now after playing around with the Shift Instructions.  :D  So what I did was say my seed is 32767 and I want a range of 200, using my Base-N Calculator (in Decimal), I get a value of 6553400, so if I divide that value by 2 15 times (which is a shift Right), my result is 199. Nice.  :D

Working from the BASIC routine I made to plot a series of points onscreen from this thread (http://www.cpcwiki.eu/forum/index.php?topic=7110.msg65996#msg65996), I can easily reconstruct that routine to work in Hisoft Pascal and take advantage of the speed.


[attachimg=2]

Finally got around to making a little rotating square demonstration, the following program is very involved and I setup up a data file for the square data, which I made using a modified SaveData program which I posted earlier. The Data Array consists of all the start positions for each square (6 in all), followed by the points. With all that data in the data array, I've setup 2 more arrays which holds the data for the X & Y information. Once all that information is in place I can use the Loop Procedure to draw those squares,  "num1" deals with the position of the array and "col" for the graphics colour.

In addition to the rotating squares, I'm using the every time routine to execute a little border routine, initially I wanted it to count through the different border colours (0-26), though I wasn't allowed to pass variable data though the every event, so is randomly selecting colours as everything moves through.

   10 PROGRAM movsquare;
   20 {$C-}
   30
   40 VAR
   50   data : ARRAY[0..59] OF integer;
   60   xdta : ARRAY[0..29] OF integer;
   70   ydta : ARRAY[0..29] OF integer;
   80   count, num, num2, value : integer;
   90   col : integer;
  100   ch1 : char;
  110
  120 PROCEDURE setup;
  130  BEGIN
  140    tin('square  .dat',addr(data));
  150    FOR count:=0 TO 29 DO
  160      xdta[count]:=data[count];
  170    num:=30;
  180    FOR count:=0 TO 29 DO
  190      BEGIN
  200        ydta[count]:=data[num];
  210        num:=num+1;
  220      END;
  230  END; { Setup }
  240
  250 PROCEDURE move(x,y : integer);
  260 BEGIN
  270   rde:=x; rhl:=y;
  280   user(#bbc0);
  290 END;
  300
  310 PROCEDURE mode(no : integer);
  320 BEGIN
  330  ra:=chr(no);
  340  user(#bc0e);
  350 END;
  360
  370 PROCEDURE border(col : integer);
  380 BEGIN
  390   rb:=chr(col); rc:=chr(col);
  400   user(#bc38);
  410 END;
  420
  430 PROCEDURE drawr(x,y : integer);
  440 BEGIN
  450   rde:=x; rhl:=y;
  460   user(#bbf9);
  470 END;
  480
  490 FUNCTION rdkey : char;
  500 BEGIN
  510  user(#bb1b);
  520  rdkey:=ra;
  530 END;
  540
  550 PROCEDURE kmreset;
  560 BEGIN
  570  user(#bb03);
  580 END;
  590
  600 PROCEDURE grapen(no : integer);
  610 BEGIN
  620   ra:=chr(no);
  630   user(#bbde);
  640 END;
  650
  660 PROCEDURE loop(num1, col : integer);
  670 VAR num : integer;
  680 BEGIN
  690   num:=num1;
  700   grapen(col);
  710   move(xdta[num],ydta[num]);
  720   num:=num+1;
  730   drawr(xdta[num],ydta[num]);
  740   num:=num+1;
  750   drawr(xdta[num],ydta[num]);
  760   num:=num+1;
  770   drawr(xdta[num],ydta[num]);
  780   num:=num+1;
  790   drawr(xdta[num],ydta[num]);
  800 END;
  810
  820 FUNCTION intrnd(range : integer) : integer;
  830 VAR seed : integer;
  840     result : real;
  850 BEGIN
  860   seed:=random(0);
  870   result:=(range/maxint);
  880   result:=(seed*result);
  890   intrnd:=trunc(result);
  900 END;
  910
  920 PROCEDURE bordloop;
  930 VAR num : integer;
  940 BEGIN
  950   num:=intrnd(26);
  960   border(num);
  970 END;
  980
  990 PROCEDURE frame;
1000 BEGIN
1010  user(#bd19);
1020 END;
1030
1040 BEGIN { Main }
1050  kmreset;
1060  setup;
1070  mode(0);
1080   every(10,1,bordloop);
1090  num:=0;
1100  REPEAT
1110    col:=col+1;
1120    IF col=27 THEN col:=0;
1130    loop(num,1);
1140    frame; frame;
1150    num2:=num;
1160    num:=num+5;
1170    IF num2=30 THEN num2:=0;
1180    IF num=30 THEN num:=0;
1190    loop(num2,0);
1200    ch1:=rdkey;
1210    value:=ord(ch1);
1220  UNTIL value=252;
1230  mode(2);
1240 END. { Main }


This little interesting Graphics Demonstration originally published in AA makes good use of decimal numbers in incrementing colour change & the curvature, I thought it would be interesting to compare the results in Pascal with the original BASIC program (http://www.cpcwiki.eu/forum/programming/interesting-type-ins/msg91860/#msg91860). The results look good when compared to the original, though in Pascal when it deals with Decimal numbers, they have to be converted into Integers otherwise Errors result if trying to pass a Decimal number to an Integer Type.


So a relatively small BASIC program (10 Lines or so), becomes a Lengthy Pascal program and the produced Binary is 8Kb, most of that is Library though due to the Compiler of it's day (1984).  :)




   10 PROGRAM Graphics;
   20 {$C-}
   30
   40 VAR mnloop, loop : integer;
   50     x, xa, y, ya : real;
   60     xx, yy, c    : real;
   70     a, b         : integer;
   80     ch           : char; 
   90
  100 PROCEDURE mode(no : integer);
  110 BEGIN
  120   ra:=chr(no);
  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 border(col : integer);
  250 BEGIN
  260   rb:=chr(col);
  270   rc:=chr(col);
  280   user(#bc38);
  290 END;
  300
  310 PROCEDURE plot(x,y : integer);
  320 BEGIN
  330   rde:=x;
  340   rhl:=y;
  350   user(#bbea);
  360 END;
  370
  380 PROCEDURE grapen(col : integer);
  390 BEGIN
  400   ra:=chr(col);
  410   user(#bbde);
  420 END;
  430
  440 PROCEDURE move(x,y : integer);
  450 BEGIN
  460   rde:=x;
  470   rhl:=y;
  480   user(#bbc0);
  490 END;
  500
  510 PROCEDURE draw(x,y : integer);
  520 BEGIN
  530   rde:=x;
  540   rhl:=y;
  550   user(#bbf6);
  560 END;
  570
  580 FUNCTION rdkey : char;
  590 BEGIN
  600   user(#bb1b);
  610   rdkey:=ra;
  620 END;
  630
  640 BEGIN
  650   mode(0);
  660   border(0);
  670   ink(0,0);
  680   FOR loop:=1 TO 15 DO
  690     ink(loop,loop+11);
  700   grapen(1);
  710   c:=1;
  720   a:=160;
  730   b:=100;
  740   x:=1;
  750   y:=1;
  760   xx:=0;
  770   yy:=0;
  780   move(round(x),round(y));
  790   REPEAT
  800    xa:=x; ya:=y;
  810    IF x<a THEN xx:=xx+0.025
  820     ELSE IF x>a THEN xx:=xx-0.025;
  830    IF y<b THEN yy:=yy+0.025
  840     ELSE IF y>b THEN yy:=yy-0.025;
  850    x:=x+xx; y:=y+yy;
  860    grapen(round(c));
  870    plot(round(xa),1);
  880    draw(round(x),round(y));
  890    plot(640-round(xa),1);
  900    draw(640-round(x),round(y));
  910    plot(round(xa),400);
  920    draw(round(x),400-round(y));
  930    plot(640-round(xa),400);
  940    draw(640-round(x),400-round(y));
  950    c:=c+0.0625;
  960    IF c=15.5 THEN c:=1;
  970   ch:=rdkey;
  980   mnloop:=ord(ch);
  990   UNTIL mnloop=252;
1000  ink(1,26);
1010  mode(2);
1020 END.


[attachimg=2]

Hey, much faster than BASIC!

Quote from: Gryzor on 18:43, 06 January 15
Hey, much faster than BASIC!

It's great when they can easily be translated from one language to another relatively easy.


This innocent little program in this thread (http://www.cpcwiki.eu/forum/programming/basic-programming-tips/msg26089/#msg26089) is anything but and is a nightmare. This didn't seem to be a problem in the Graphic program above, but that Serpent program is somehow skewing results (though not at first), but the longer the program runs, the more lines appear onscreen, the difference appears to be "round(num)". Both BASIC & Pascal have it, but in Pascal if a number is negative and lands on a value .5, the number gets rounded down, so a value of -6.5 becomes -6, however if it was -6.51 Pascal rounds it to -7. In BASIC a value of -6.5 is rounded to -7 and I think it is there where Pascal is missing the drawn Lines. Positive Numbers seem to work the same in BASIC & Pascal and the program works mostly with the Negative as long as it doesn't fall on .5 of a number itself. Though I'm unsure fully if that is whats happening, but I don't know what else it could be.
The solution to that is start collecting values from the BASIC program and put it into an Array for the Pascal Program to lookup, though I'm unsure how big it might be.

This is the workaround I have come up with the Serpent program.




   10 PROGRAM Serpent;
   20 {$C-}
   30
   40 VAR mnloop, loop : integer;
   50     num, num2    : integer;
   60     a            : real;
   70     ch           : char; 
   80     x1val : ARRAY[0..20] OF integer;
   90     x2val : ARRAY[0..20] OF integer;
  100     y1val : ARRAY[0..20] OF integer;
  110     y2val : ARRAY[0..20] OF integer;
  120
  130 PROCEDURE mode(no : integer);
  140 BEGIN
  150   ra:=chr(no);
  160   user(#bc0e);
  170 END;
  180
  190 PROCEDURE grapen(ink:integer);
  200 BEGIN
  210   ra:=chr(ink);
  220   user(#bbde)
  230 END;
  240
  250 PROCEDURE origin(x,y : integer);
  260 BEGIN
  270   rde:=x;
  280   rhl:=y;
  290   user(#bbc9);
  300 END;
  310 
  320 PROCEDURE move(x,y : integer);
  330 BEGIN
  340   rde:=x;
  350   rhl:=y;
  360   user(#bbc0);
  370 END;
  380
  390 PROCEDURE draw(x,y : integer);
  400 BEGIN
  410   rde:=x;
  420   rhl:=y;
  430   user(#bbf6);
  440 END;
  450
  460 PROCEDURE scraccess(mo : integer);
  470 BEGIN
  480   ra:=chr(mo);
  490   user(#bc59);
  500 END;
  510
  520 FUNCTION rdkey : char;
  530
  540 BEGIN
  550   user(#bb1b);
  560   rdkey:=ra;
  570 END;
  580
  590 PROCEDURE drawroutine(value : integer);
  600 BEGIN
  610   move(x1val[value],y1val[value]);
  620   grapen(1);
  630   draw(x2val[value],y2val[value]);
  640 END;
  650
  660 PROCEDURE removeline;
  670 BEGIN
  680   IF num2>20 THEN num2:=0;
  690   drawroutine(num2);
  700   num2:=num2+1;
  710 END;
  720
  730 BEGIN
  740   mode(1);
  750   origin(320,200);
  760   scraccess(1);
  770   a:=0.0;
  780   num:=0; num2:=0;
  790   REPEAT
  800   x1val[num]:=round(220*sin(a/2));
  810   y1val[num]:=round(98*cos(a));
  820   x2val[num]:=round(200*cos(a/2));
  830   y2val[num]:=round(198*sin(a));
  840   drawroutine(num);
  850   a:=a-2.0;
  860   IF a>-0.1 THEN removeline;
  870   num:=num+1;
  880   IF num>20 THEN num:=0;
  890   a:=a+2.1;
  900   ch:=rdkey;
  910   mnloop:=ord(ch);
  920   UNTIL mnloop=252;
  930  mode(2);
  940 END.


It still does the maths, but I'm storing the values into 4 Arrays and use num & num2 variables to offset the effect.


[attachimg=2]

I've come up with another graphical demo by Laurence Rapaccioli (from the ACU 10-Liner Days) of an Alien Landscape and reworked it so it would work in Hisoft Pascal, but as you will see the program blew out over 200 Lines of Code, but on top of that code is a RSX Library I've generated to deal with a lot of the graphical aspects from the program along with a FILL routine, so this program now works on all CPCs.


Much of the original program made good use of DEG & RAD which is where a lot of the Pascal has blown out, though a lot of "FOR" Loops were also involved in the original program which were replaced with WHILE...DO loops in order to control the STEPs for the value of the Loop and probably the other blow out was replacing GOTOs and relying on more Procedural Structure, but the good news is the reworked has the same feel as the original where by once the Landscape is completely drawn, Press <Space> to see a Shooting Meteorite across the Horizon.  :D


I'm just surprised how involved it became, the coding of it could probably be improved, the Generated Binary takes up 11k, probably around 12k with the RSX, which required some overhead in this main program in order to utilise.


   10 PROGRAM Alien;
   20 {$C-}
   30
   40 VAR loopa, loopn, loopm : integer;
   50     b, c, d, f, g, h, i : integer;
   60     ch1 : char;
   70     value : integer;
   80     routine : ARRAY[0..475] OF char;
   90
  100 FUNCTION rnd(range : integer) : integer;
  110 VAR seed : integer;
  120     result : real;
  130 BEGIN
  140   seed:=random(0);
  150   result:=(range/maxint);
  160   result:=(seed*result);
  170   rnd:=trunc(result);
  180 END;
  190
  200 FUNCTION deg(val : integer) : real;
  210 VAR num1 : real;
  220 BEGIN
  230   num1:=3.14159/180;
  240   deg:=num1*val;
  250 END;
  260
  270 FUNCTION rdkey : char;
  280 BEGIN
  290   user(#bb1b);
  300   rdkey:=ra;
  310 END;
  320
  330 FUNCTION test(x,y : integer) : integer;
  340 BEGIN
  350   rde:=x; rhl:=y;
  360   user(#bbf0);
  370   test:=ord(ra);
  380 END;
  390
  400 PROCEDURE kmreset;
  410 BEGIN
  420   user(#bb03);
  430 END;
  440
  450
  460 PROCEDURE setupgralib;
  470  VAR loop : integer;
  480  BEGIN
  490    tin('gralib  .dat',addr(routine));
  500    FOR loop:=0 TO 475 DO
  510      poke(#9000+loop,routine[loop]);
  520    user(#9000);
  530 END;
  540
  550 PROCEDURE setup;
  560 BEGIN
  570   external('mode',1);
  580   external('ink',0,0);
  590   external('ink',1,5);
  600   external('ink',2,22);
  610   external('ink',3,15);
  620 END;
  630
  640 PROCEDURE screen;
  650 VAR x1, y1 : integer;
  660     x2, y2 : integer;
  670 BEGIN
  680 b:=300; c:=40; d:=15;
  690 FOR loopn:=0 TO 6 DO
  700  BEGIN
  710    external('grapen',1);
  720    external('plot',320+b+100,200);
  730    loopa:=0;
  740    WHILE (loopa<370) DO BEGIN
  750      x1:=round(320+(b+100)*cos(deg(loopa)));
  760      y1:=round(200+b*sin(deg(loopa)));
  770      external('draw',x1,y1);
  780      x2:=round(c*sin(deg(loopa)));
  790      y2:=round(d*cos(deg(loopa)));
  800      external('drawr',x2,y2);
  810      IF c=40 THEN c:=-41 ELSE c:=40;
  820      IF d<>15 THEN d:=-16 ELSE d:=15;
  830      IF d=15 THEN d:=-16 ELSE d:=15;
  840      loopa:=loopa+10;
  850    END;
  860    b:=b-20;
  870  END;
  880 external('grapen',1); external('plot',40,202); external('draw',600,202);
  890 external('fill',272,200,3); external('fill',44,184,3);
  900 external('fill',76,124,3); external('fill',140,72,3);
  910 external('fill',220,36,3);
  920 loopn:=200;
  930 WHILE (loopn>15) DO BEGIN
  940   loopm:=40;
  950   WHILE (loopm<600) DO BEGIN
  960    IF test(loopm,loopn)=3 THEN BEGIN
  970     external('draw',loopm+rnd(6),loopn+rnd(12));
  980     external('draw',loopm+5,loopn);
  990     END;
1000     loopm:=loopm+rnd(7)+7;
1010    END;
1020   loopn:=loopn-5;
1030 END;
1040 END;
1050
1060 PROCEDURE degdraw;
1070 BEGIN
1080   loopn:=1;
1090   WHILE (loopn<360) DO BEGIN
1100     external('grapen',f);
1110     external('move',round(g+i*sin(deg(340))),round(h+i*cos(deg(loopn))));
1120     external('draw',round(g+i*sin(deg(loopn))),round(h+i*cos(deg(200))));
1130     loopn:=loopn+7;
1140   END;
1150 END;
1160
1170 PROCEDURE radraw;
1180 BEGIN
1190   loopn:=1;
1200   WHILE (loopn<360) DO BEGIN
1210     external('grapen',f);
1220     external('move',round(g+i*sin(340)),round(h+i*cos(loopn)));
1230     external('draw',round(g+i*sin(loopn)),round(h+i*cos(200)));
1240     loopn:=loopn+7;
1250   END;
1260 END;
1270
1280 PROCEDURE scenery;
1290 BEGIN
1300   f:=1; g:=385; h:=226; i:=25;
1310   degdraw;
1320   f:=2; g:=350; h:=252; i:=50;
1330   degdraw;
1340   f:=2; g:=300; h:=222; i:=20;
1350   degdraw;
1360   f:=1; g:=200; h:=242; i:=40;
1370   radraw;
1380   f:=2; g:=130; h:=226; i:=25;
1390   radraw;
1400 END;
1410
1420 PROCEDURE planets;
1430 VAR x1, x2, y1, y2 : integer;
1440 BEGIN
1450   loopa:=90;
1460   WHILE (loopa<450) DO BEGIN
1470     external('grapen',1); external('plot',505,300);
1480     x1:=round(505+10*cos(deg(loopa)));
1490     y1:=round(300+10*sin(deg(loopa)));
1500     external('draw',x1,y1);
1510     x2:=round(485+20*cos(deg(loopa)));
1520     y2:=round(300+20*sin(deg(loopa)));
1530     external('grapen',3); external('plot',485,300);
1540     external('draw',x2,y2);
1550     loopa:=loopa+3;
1560   END;
1570 END;
1580
1590 PROCEDURE drmeteor;
1600 VAR x1, y1 : integer;
1610 BEGIN
1620   x1:=round(300+220*cos(deg(loopn)));
1630   y1:=round(200+120*sin(deg(loopn)));
1640   external('grapen',2);
1650   external('plot',x1,y1);
1660   x1:=round(300+220*cos(deg(loopn+3)));
1670   y1:=round(200+120*sin(deg(loopn+3)));
1680   external('draw',x1,y1);
1690   x1:=round(300+220*cos(deg(loopn+3)));
1700   y1:=round(200+120*sin(deg(loopn)));
1710   external('draw',x1,y1);
1720   x1:=round(300+220*cos(deg(loopn)));
1730   y1:=round(200+120*sin(deg(loopn+3)));
1740   external('draw',x1,y1);
1750 END;
1760
1770 PROCEDURE delmeteor;
1780 VAR x1,y1 : integer;
1790 BEGIN
1800   external('grapen',0);
1810   x1:=round(300+220*cos(deg(loopn-20)));
1820   y1:=round(200+120*sin(deg(loopn-20)));
1830   external('plot',x1,y1);
1840   x1:=round(300+220*cos(deg(loopn-17)));
1850   y1:=round(200+120*sin(deg(loopn-17)));
1860   external('draw',x1,y1);
1870   x1:=round(300+220*cos(deg(loopn-17)));
1880   y1:=round(200+120*sin(deg(loopn-20)));
1890   external('draw',x1,y1);
1900   x1:=round(300+220*cos(deg(loopn-20)));
1910   y1:=round(200+120*sin(deg(loopn-17)));
1920   external('draw',x1,y1);
1930 END;
1940
1950 PROCEDURE launch;
1960 BEGIN
1970   loopn:=0;
1980   WHILE (loopn<198) DO BEGIN
1990     IF loopn<168 THEN drmeteor;
2000     IF loopn>19 THEN delmeteor;
2010     sound(3,0,0,round(loopn/25),round(loopn/15),3,30);
2020     loopn:=loopn+4;
2030   END;
2040 END;
2050
2060 BEGIN
2070   setupgralib;
2080   setup;
2090   screen;
2100   scenery;
2110   planets;
2120   REPEAT
2130    IF value=32 then kmreset;
2140    ch1:=rdkey;
2150    value:=ord(ch1);
2160    IF value=32 THEN launch;
2170   UNTIL value=252;
2180 END.


[attachimg=2]

I was going hyper over that hypno BASIC program from AA45 type-ins, so I've knocked it up with this. The result isn't quite right because I haven't figured out how to evaluate this loop:-



for x=-f to a step f



in Pascal.


f is a constant that equals 1000, so -f = -1000 & a is also a constant that equals 639. 


So in Pascal I've done



xpos:=-1000;
while (xpos<639) do begin
xpos:=xpos+1000;
...



I've also tried variations by placing xpos:=xpos+1000; at the end of the while loop. So instead it looks like one of those Colour Rolling Effects you get on an Atari 2600 Logo.


[attachimg=3]


Update: Turned out it had nothing to do with the loop, loop was working just fine. But the BASIC program was checking:



if c>15 then c=1:d=d+1



My earlier program did this:



if col>15 then c:=1
depth:=depth+1



which was producing the extra colour. In Pascal it should look like this:



if col>15 then begin
  c:=1;
  depth:=depth+1;
end;



So depth only increments when col is greater than 15.


Oops.  :o


So my program now looks like this:




   10 PROGRAM HypnoStrobe;
   20 {$C-}
   30 (* Original Hypno Strobe/Colour Fader by Nigel Myers
   40    & Published IN Amstrad Action June 1989
   50    Fx & Ypos variable can be modified FOR different effect *)
   60
   70 VAR fx, mnloop                : integer;
   80     col, depth, entry         : integer;
   90     xpos, ypos                : integer;
  100     ch1                       : char;
  110
  120 { Procedures FOR Main PROGRAM }
  130
  140 PROCEDURE mode(no : char);
  150 BEGIN
  160   ra:=no;
  170   user(#bc0e);
  180 END;
  190
  200 FUNCTION rdkey : char;
  210 BEGIN
  220   user(#bb1b);
  230   rdkey:=ra;
  240 END;
  250
  260 PROCEDURE ink(ink,col1 : integer);
  270 BEGIN
  280   ra:=chr(ink);
  290   rb:=chr(col1);
  300   rc:=chr(col1);
  310   user(#bc32);
  320 END;
  330
  340 PROCEDURE border(col1 : char);
  350 BEGIN
  360   rb:=col1;
  370   rc:=col1;
  380   user(#bc38);
  390 END;
  400
  410 PROCEDURE move(x,y : integer);
  420 BEGIN
  430   rde:=x; rhl:=y;
  440   user(#bbc0);
  450 END;
  460
  470 PROCEDURE drawr(x,y, col : integer);
  480 BEGIN
  490   ra:=chr(col);
  500   user(#bbde);
  510   rde:=x;
  520   rhl:=y;
  530   user(#bbf9);
  540 END;
  550
  560 BEGIN
  570   ink(0,0); border(chr(0)); mode(chr(0));
  580   ch1:=CHR(0);
  590   col:=1;
  600   depth:=1;
  610   entry:=1;
  620   ypos:=0;
  630   REPEAT
  640      xpos:=-1000;
  650      WHILE (xpos<639) DO BEGIN
  660        xpos:=xpos+1000;
  670        move(xpos,ypos);
  680        drawr(639-xpos*2,0,col);
  690        move(xpos,399-ypos);
  700        drawr(639-xpos*2,0,col);
  710        move(639-xpos*2,ypos);
  720        drawr(0,399-ypos*2,col);
  730        move(xpos*2,ypos);
  740        drawr(0,399-ypos*2,col);
  750        ypos:=ypos+2;
  760        IF ypos>399 THEN ypos:=1;
  770        ink(col,depth);
  780        col:=col+1;
  790        IF col>15 THEN BEGIN
  800         col:=1;
  810         depth:=depth+1;
  820        END;
  830        IF depth>entry THEN depth:=entry-1;
  840      END;
  850   entry:=entry+1;
  860   IF entry>26 THEN entry:=1;
  870   ch1:=rdkey;
  880   mnloop:=ord(ch1);
  890   UNTIL mnloop=252;
  900 user(#bc02);
  910 mode(chr(2));
  920
  930 END.


I've also attached an updated file.


[attachimg=4]

I made a small program to patch in a routine to increment a char type.


[attachimg=1]


I'm incrementing a Char type because there's no Byte Type in HP4T, the example I've used can be written in HP4T like this:


FOR num:=chr(32) to chr(255) do ...etc


but from time to time, you may get a variable with Byte attributes, but don't know where it's heading.

Finally manage to write a function which uses KM TEST KEY to determine if a key is pressed. If a key has been pressed function returns as true, otherwise is false.




[attachimg=1]


The output as follows:


[attachimg=2]

I can now move a character around the screen at a blistering pace with Test Key Function in place.


   10 PROGRAM MoveMan;
   20 {$C-}
   30
   40 VAR mx : integer;
   50     my : integer;
   60
   70 FUNCTION key(ch:char) : boolean;
   80 BEGIN
   90   inline(#DD,#7E,#02,
  100          #CD,#1E,#BB,
  110          #28,#05,
  120          #3E,#01,
  130          #DD,#77,#03);
  140 END;
  150
  160 PROCEDURE GOTOXY(x,y : INTEGER);
  170 BEGIN
  180   RH:=CHR(x);
  190   RL:=CHR(y);
  200   USER(#bb75);
  210 END;
  220
  230 PROCEDURE MoveMan;
  240 BEGIN
  250  IF key(chr(1))=true THEN
  260   BEGIN
  270     IF mx<80 THEN mx:=mx+1;
  280     Gotoxy(mx,my);
  290     write(chr(250));
  300     gotoxy(mx-1,my);
  310     write(' ');
  320   END;
  330  IF key(chr(8))=true THEN
  340   BEGIN
  350     IF mx>1 THEN mx:=mx-1;
  360     gotoxy(mx,my);
  370     write(chr(251));
  380     gotoxy(mx+1,my);
  390     write(' ');
  400   END;
  410  IF key(chr(0))=true THEN
  420   BEGIN
  430     IF my>1 THEN my:=my-1;
  440     gotoxy(mx,my);
  450     write(chr(248));
  460     gotoxy(mx,my+1);
  470     write(' ');
  480   END;
  490  IF key(chr(2))=true THEN
  500   BEGIN
  510     IF my<25 THEN my:=my+1;
  520     gotoxy(mx,my);
  530     write(chr(248));
  540     gotoxy(mx,my-1);
  550     write(' ');
  560   END;
  570 END;
  580
  590 BEGIN { Main Test PROGRAM }
  600 page;
  610 my:=12;
  620 mx:=40;
  630 gotoxy(mx,my);
  640 write(chr(249));
  650  REPEAT
  660   moveman;
  670  UNTIL key(chr(66))=true;
  680 END.




I prepared some more routines as followup to the Routine which Increments Char Type in HP4T.




   10 PROGRAM count;
   20
   30 VAR num : char;
   40
   50 FUNCTION minusone(num : char) : char;
   60 BEGIN
   70   inline(#DD,#35,#2);
   80   minusone:=num;
   90 END;
  100
  110 FUNCTION dec(val, step : char) : char;
  120 BEGIN
  130   REPEAT
  140     inline(#DD,#35,#3);
  150     step:=minusone(step);
  160     dec:=val;
  170   UNTIL step=chr(0);
  180 END;
  190
  200 FUNCTION inc(val, step : char) : char;
  210 BEGIN
  220  REPEAT
  230   inline(#DD,#34,#3);
  240   step:=minusone(step);
  250   inc:=val;
  260  UNTIL step=chr(0);
  270 END;
  280
  290 BEGIN
  300  num:=chr(255);
  310   REPEAT
  320    num:=dec(num,chr(4));
  330    writeln(ord(num));
  340   UNTIL num<chr(5);
  350  user(#bb18);
  360  REPEAT
  370    num:=inc(num,chr(2));
  380    writeln(ord(num));
  390  UNTIL num>chr(250);
  400 END.


I've added 3 functions, minusone is used to reduce the step in the other 2 Functions inc & dec.  Those functions take 2 parameters now, "val" holds the start value & "step" how much it steps by, allowing "num:=num+step" in this environment for the 1 byte Char type.

I've updated my routine to move the man character around the screen using GRA WR CHAR.



   10 PROGRAM gramoveman;
   20 {$C-}
   30
   40 VAR mx : integer;
   50     my : integer;
   60     storechar : char;
   70
   80 FUNCTION key(ch:char) : boolean;
   90 BEGIN
  100   inline(#DD,#7E,#02,
  110          #CD,#1E,#BB,
  120          #28,#05,
  130          #3E,#01,
  140          #DD,#77,#03);
  150 END;
  160
  170 PROCEDURE move(x,y : integer);
  180 BEGIN
  190   RDE:=x;
  200   RHL:=y;
  210   user(#bbc0);
  220 END;
  230
  240 PROCEDURE grawrchar(c, mde : char);
  250 BEGIN
  260   write(chr(23)); write(mde);
  270   ra:=c;
  280   user(#bbfc);
  290 END;
  300
  310 PROCEDURE MoveMan;
  320 BEGIN
  330  IF key(chr(1))=true THEN
  340   BEGIN
  350     IF mx<600 THEN mx:=mx+1;
  360     move(mx,my);
  370     grawrchar(chr(250),chr(1));
  380     move(mx-1,my);
  390     grawrchar(storechar,chr(1));
  400     storechar:=chr(250);
  410   END;
  420  IF key(chr(8))=true THEN
  430   BEGIN
  440     IF mx>2 THEN mx:=mx-1;
  450     move(mx,my);
  460     grawrchar(chr(251),chr(1));
  470     move(mx+1,my);
  480     grawrchar(storechar,chr(1));
  490     storechar:=chr(251);
  500   END;
  510  IF key(chr(0))=true THEN
  520   BEGIN
  530     IF my<390 THEN my:=my+2;
  540     move(mx,my);
  550     grawrchar(chr(248),chr(1));
  560     move(mx,my-2);
  570     grawrchar(storechar,chr(1));
  580     storechar:=chr(248);
  590   END;
  600  IF key(chr(2))=true THEN
  610   BEGIN
  620     IF my>16 THEN my:=my-2;
  630     move(mx,my);
  640     grawrchar(chr(248),chr(1));
  650     move(mx,my+2);
  660     grawrchar(storechar,chr(1));
  670     storechar:=chr(248);
  680   END;
  690 END;
  700
  710 BEGIN { Main Test PROGRAM }
  720 page;
  730 my:=200;
  740 mx:=320;
  750 move(mx,my);
  760 grawrchar(chr(249),chr(1));
  770 storechar:=chr(249);
  780  REPEAT
  790   moveman;
  800  UNTIL key(chr(66))=true;
  810 END.


I've made this error before where I'm getting to the edge of the area and when move that character, the xor effect of them leaves a partial image of them onscreen which looks quite funny. To get it working most of the time (draw/delete) I've created a variable to store it's character number and when I press another key the character changes to face that direction (apart from Up/Down which use the same char). I think the fault might be in not using variables with old values in them when I drawing out the old position, though this code may need further dividing instead of it being all together in the "moveman" procedure.


[attachimg=1]

I was having some problems when I was trying to use my new char increment along with the test key routine. Somehow the conditioning from the key routine was returning True forcing the program to exit.


In this example I came up with, I've created a new variable type boolean and point the key routine to that,prior to carrying out a char increment. The only odd result here is when I press ESC, the program exits, the compiled version simply resets the computer back to basic, though in my REPEAT..UNTIL loop I've also got the program exiting once the character number reaches 255 and in that case the program returns the the RUN prompt.


   10 PROGRAM ExitOnKeyPress;
   20 {$C-}
   30 (* This PROGRAM uses the Firmware Test key AND exits when condition
   40    is true, though it also increments a char TYPE. UNTIL now
   50    the PROGRAM was exiting unexpectably when an increment OF char
   60    TYPE was taking place, though IF I place the check IN boolean
   70    TYPE "ch" AND check this before incrementing the char TYPE "num"
   80    PROGRAM functions AND will exit when ESC is pressed *)
   90
  100 VAR num : char;
  110     ch : boolean;
  120
  130 FUNCTION inc(num : char) : char;
  140 BEGIN
  150   inline(#DD,#34,#2);
  160   inc:=num;
  170 END;
  180
  190 FUNCTION key(ch:char) : boolean;
  200 BEGIN
  210   inline(#DD,#7E,#02,
  220          #CD,#1E,#BB,
  230          #28,#05,
  240          #3E,#01,
  250          #DD,#77,#03);
  260 END;
  270
  280 BEGIN
  290 num:=chr(0);
  300 REPEAT
  310   ch:=key(chr(66));
  320   num:=inc(num);
  330   writeln(ord(num));
  340 UNTIL (ch=true) OR (num=chr(255))
  350 END.

All good now, the keypress routine from above was forcing the Compiler "Run (Y/N)" Option to make it believe I didn't want to run it anymore, hence the Reset. I've resolve it with a KMRESET (&BB03) to flush the keyboard buffer as the program exits.


So today I've rewritten another BASIC Demo which produces an amazing Mosiac Pattern in Mode 1, it looked great from BASIC, though the transition as a result of compiling it is stunning.




   10 PROGRAM Mosiac;
   20 (* Written IN BASIC by Nigel Myers, Published IN AA45 TYPE-ins *)
   30 {$C-}
   40
   50 VAR xpos : integer;
   60     ypos : integer;
   70     col1 : char;
   80     col2 : char;
   90     ch   : boolean;
  100
  110 FUNCTION inc(num : char) : char;
  120 BEGIN
  130   inline(#DD,#34,#02);
  140   inc:=num
  150 END;
  160
  170 FUNCTION key(ch:char) : boolean;
  180 BEGIN
  190   inline(#DD,#7E,#02,
  200          #CD,#1E,#BB,
  210          #28,#05,
  220          #3E,#01,
  230          #DD,#77,#03)
  240 END;
  250
  260 PROCEDURE kmreset;
  270 BEGIN
  280   user(#bb03)
  290 END;
  300
  310 PROCEDURE mode(num : char);
  320 BEGIN
  330   ra:=num;
  340   user(#bc0e)
  350 END;
  360
  370 PROCEDURE ink(ink,col : char);
  380 BEGIN
  390   ra:=ink;
  400   rb:=col;
  410   rc:=col;
  420   user(#bc32)
  430 END;
  440
  450 PROCEDURE border(col : char);
  460 BEGIN
  470   rb:=col;
  480   rc:=col;
  490   user(#bc38)
  500 END;
  510
  520 PROCEDURE move(x,y : integer);
  530 BEGIN
  540   rde:=x; rhl:=y;
  550   user(#bbc0)
  560 END;
  570
  580 PROCEDURE drawr(x,y : integer;col : char);
  590 BEGIN
  600   ra:=col;
  610   user(#bbde);
  620   rde:=x;
  630   rhl:=y;
  640   user(#bbf9)
  650 END;
  660
  670 FUNCTION rnd(range : integer) : integer;
  680 VAR seed   : integer;
  690     result : real;
  700 BEGIN
  710   seed:=random(0);
  720   result:=(range/maxint);
  730   result:=(seed*result);
  740   rnd:=trunc(result)
  750 END;
  760
  770 BEGIN
  780   mode(chr(1));
  790   ink(chr(0),chr(0));
  800   ink(chr(1),chr(6));
  810   ink(chr(2),chr(18));
  820   ink(chr(3),chr(11));
  830   border(chr(0));
  840   write(chr(23));
  850   write(chr(1));
  860   col1:=chr(1);
  870   col2:=chr(0);
  880   xpos:=1;
  890   ypos:=1;
  900   REPEAT
  910     ch:=key(chr(66));
  920     move(xpos,ypos);
  930     drawr(639-xpos*2,0,col1);
  940     move(xpos,399-ypos);
  950     drawr(639-xpos*2,0,col1);
  960     move(xpos,ypos);
  970     drawr(0,399-ypos*2,col2);
  980     move(639-xpos,ypos);
  990     drawr(0,399-ypos*2,col2);
1000     ypos:=ypos+2;
1010     IF ypos>399 THEN BEGIN
1020        ypos:=1;
1030        col2:=chr(rnd(4))
1040     END;
1050     xpos:=xpos+4;
1060     IF xpos>639 THEN BEGIN
1070        xpos:=1;
1080        col1:=inc(col1)
1090     END;
1100     IF col1>chr(3) THEN col1:=chr(1);
1110   UNTIL ch=true;
1120   kmreset
1130 END.



[attachimg=1]

Until now I hadn't played around with Windows using this language. I had a program demonstrating this in Turbo Pascal 3 and when I had a look at it, appeared to be more involved than what I remembered.


My version here simply addresses the Firmware Direct, to setup each Window, a Stream is first selected and then a Window is defined. When I want to write to that window, I can then Select the stream, apply some attributes to it (Paper, Pen & ClearWindow effect), and write to that using standard write command.

When I first started using this language, my program was loading a data file by using the TIN(); TOUT(); Procedures to Load & Save a Data file with a set filename assigned to it. I haven't written a Program which asks for a Filename and sets out to load it, but I've defined a Procedure called load and the filename from the character array gets passed to TIN();, which works.


[attachimg=1]

This is what I came up with which asks for a filename for a DAT file and displays some of the contents of it.




   10 PROGRAM LoadInDataFile;
   20
   30 TYPE file = ARRAY[1..12] OF char;
   40
   50 VAR
   60   data : ARRAY[0..9] OF INTEGER;
   70   name : ARRAY[1..12] OF char;
   80   count : integer;
   90
  100 PROCEDURE load(fn : file);
  110 BEGIN
  120   tin(fn,addr(data))
  130 END;
  140
  150 BEGIN
  160 write('Please Enter a Filename :');
  170 readln;
  180 read(name);
  190 count:=1;
  200 REPEAT
  210   WHILE (name[count]=chr(0)) DO
  220     name[count]:=chr(32);
  230   count:=count+1;
  240 UNTIL count=12;
  250 name[9]:='.';
  260 name[10]:='D';
  270 name[11]:='A';
  280 name[12]:='T';
  290 load(name);
  300 FOR count:=0 TO 9 DO
  310   write(data[count]);
  320   write(' ');
  330 END.





Due to the complexity of the TIN procedure, the length of the filename must be 12 Characters in Length. In order to make it work, the user enters the name of the file which gets stored in the name array, but TIN won't work unless the Length is 12 Characters Long. For the extension Positions 9 to 12 of the name array are used, but if the name is less than 8 characters, a Bad Command is returned, which is where the REPEAT & WHILE Loops are used, which simply looks for any Zeros in the Array and changes them to Spaces, which is what TIN requires if a filename doesn't equal 8 characters. The Repeat Until Loop simply Increments the count so the next position of the array can be check for any Zero and change it accordingly in the While.

I put together this small program which demonstrates passing values from one Array to another, up to now all I've done is setup two or more arrays or have an Procedure focusing on a Globally defined Array, and thought it would be good to be able to make a Procedure which could tackle any array assigned to it.



   10 PROGRAM PassArray;
   20
   30 VAR myarry : ARRAY[1..10] OF char;
   40     num1   : integer;
   50
   60 PROCEDURE starry(num,na : char);
   70 VAR arry : ARRAY[1..10] OF char;
   80     loop : char;
   90 BEGIN
  100    arry[ord(na)]:=num;
  110    writeln(ord(arry[ord(na)]))
  120 END;
  130
  140 PROCEDURE setupmyarry;
  150 BEGIN
  160   myarry[1]:=chr(1);
  170   myarry[2]:=chr(26);
  180   myarry[3]:=chr(15);
  190   myarry[4]:=chr(2);
  200   myarry[5]:=chr(6);
  210   myarry[6]:=chr(3);
  220   myarry[7]:=chr(25);
  230   myarry[8]:=chr(9);
  240   myarry[9]:=chr(13);
  250   myarry[10]:=chr(11);
  260 END;
  270
  280 BEGIN
  290   setupmyarry;
  300   num1:=1;
  310   WHILE (num1<=10) DO
  320   BEGIN
  330     starry(myarry[num1],chr(num1));
  340     num1:=num1+1
  350   END;
  360 END.


Will need to revise program above, not that the program above has no use, but Passing values from an Array through a Procedure could simply be a set of Variables (not an array), which could then carry out an operation. As my program above shows, a loop needs to be carried out to go through all the values in myarry, the local arry will then just take the value from myarry one at a time and print that in the Procedure I made. So the "starry" procedure could be changed to:



Procedure starry(num : char);
begin
  written(ord(num));
end;



And would give the same result as long as line 330 looked like this:



      starry(myarry[num1]);


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.  :D


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.


   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]

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?

Quote from: Alcoholics Anonymous on 07:03, 21 May 16
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 (http://www.cpcwiki.eu/index.php/Source_Codes#CP.2FM) 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 (http://turpas3.angelfire.com/bouncy.pas), 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.

Quote from: AMSDOS on 09:25, 21 May 16

There are some CP/M code examples (http://www.cpcwiki.eu/index.php/Source_Codes#CP.2FM) 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 (http://turpas3.angelfire.com/bouncy.pas), 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.

Quote
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.

Quote
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.

Quote
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.

Quote from: Alcoholics Anonymous on 16:36, 21 May 16I 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.

QuoteYeah 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.

QuoteThanks 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:



ld a,1
call &be9b
defw &bc0e



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



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.

QuoteCPCIOLIB 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.

QuoteI 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.

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.





   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]

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.




   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.




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.




   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.




   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]

Hello, the Hisoft Pascal is slower than the Basic.


Greeting

@AMSDOS (http://www.cpcwiki.eu/forum/index.php?action=profile;u=330) :

would changing


  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)

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


Quote from: SRS on 19:20, 30 December 16
@AMSDOS (http://www.cpcwiki.eu/forum/index.php?action=profile;u=330) :

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:




   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 (http://www.cpcwiki.eu/forum/index.php?action=profile;u=1682) 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.  :D

Quote from: cpcuser on 17:36, 30 December 16
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:


   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.




Quote from: AMSDOS on 21:49, 30 December 16
I checked your BASIC version, but I just couldn't see anyway of it being faster than Pascal. I think what @cpcuser (http://www.cpcwiki.eu/forum/index.php?action=profile;u=1682) 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.  :D

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 ...

Quote from: SRS on 16:34, 01 January 17
Even after fixing it and using fabacom on it, it's still quite slow.

Yeah @litwr (http://www.cpcwiki.eu/forum/index.php?action=profile;u=1057) was running some speed tests on some Mandelbrots here (http://www.cpcwiki.eu/forum/demos/mandelbrot-with-amstrad/msg138096/#msg138096), which showed fabacom wasn't quite as fast as Hisoft Pascal.

QuoteThat'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.

QuoteUsing 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]



   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.



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

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

Quote from: SRS on 21:55, 02 January 17
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:


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?

Quote from: SRS on 21:55, 02 January 17
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  :o

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.

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


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

Quote from: SRS on 21:55, 18 January 17
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:



240 IF xax<640 THEN GOTO 110



and:



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.

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



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.



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:



(* 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).



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 (https://github.com/hoglet67/PiTubeDirect/wiki) (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 (https://github.com/revaldinho/cpc_pascal)




R.

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




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.




   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).

QuoteThat'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. (http://www.stardot.org.uk/forums/viewtopic.php?f=2&t=14919)


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.



(* 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 (https://github.com/revaldinho/cpc_pascal), 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

Quote from: revaldinho on 12:54, 20 May 18

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).

(http://www.cpcwiki.eu/imgs/e/e2/TAU_04Page18.jpeg)

Some corrections were then added in Issue 6:


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

QuoteIt'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. (http://www.stardot.org.uk/forums/viewtopic.php?f=2&t=14919)


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.

QuoteI 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 (https://github.com/revaldinho/cpc_pascal), 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.

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



// 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:



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


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.

Quote from: revaldinho on 22:42, 26 May 18

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. :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 (http://www.cpc-power.com/index.php?page=detail&num=14973) which performed at a blistering pace (so I went back to the BASIC version!  :D )

QuoteGood 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.  :)

I've been familiar with this Psychedelic Plot (http://www.cpcwiki.eu/index.php/Amstrad_Action_March_1986_Type-Ins) 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:


30 z=SIN(ABS(y*(1+ABS(x))/10)^3+4*x*x)


which I think looked like this:


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:



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.



   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.


I'd like to compile and run this but it needs a library file


{$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

Quote from: revaldinho on 20:17, 10 June 18
I'd like to compile and run this but it needs a library file

Code Select Expand

{$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 (http://www.cpcwiki.eu/forum/index.php?action=profile;u=1) 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:



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.  :(

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.




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.



   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.


........................................

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

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):




   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.

thanks.

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

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

tanks you.

Quote from: funkheld on 11:32, 11 August 18
thanks.

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

So you can download my attached zip file (http://www.cpcwiki.eu/forum/programming/hisoft-pascal-4t/?action=dlattach;attach=26097) 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.

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

tanks you.

I've put this code on the CPCWiki (http://www.cpcwiki.eu/index.php/Programming:Storing_and_Retrieving_Screens_from_the_extra_64kb) 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.

hello thanks for your help and the software.
still have not understood completely.does the beom cpc6128 use bankswitching?

Thank you.
greeting

Quote from: funkheld on 15: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

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.

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 (http://www.cpcwiki.eu/forum/programming/hisoft-pascal-4t/?action=dlattach;attach=26132) image with contains Binary and Source file.




   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.


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 (http://www.cpcwiki.eu/forum/programming/hisoft-pascal-4t/?action=dlattach;attach=26228).



   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.



   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

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 (http://www.cpcwiki.eu/index.php/Amstrad_Action_June_1990_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 (http://www.cpcwiki.eu/forum/programming/hisoft-pascal-4t/?action=dlattach;attach=26290):




   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.

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.




   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.




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 (http://www.cpcwiki.eu/index.php/Amstrad_Action_April_1989_Type-Ins) (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 (http://www.cpcwiki.eu/index.php/Amstrad_Action_November_1989_Type-Ins) 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 (http://www.cpcwiki.eu/index.php/Amstrad_Action_November_1989_Type-Ins) 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  (http://www.cpcwiki.eu/index.php/Amstrad_Action_February_1990_Type-Ins)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.




   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.


Hi good afternoon.
I have the program as text.
I play with the javacpc.
if I started "hisoft pascal 4t", how can I pass this test.txt to "hisoft pascal 4t" without me typing it in myself?


Thank you.
Greeting


this programm as test.txt :

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.


Quote from: funkheld on 18:16, 01 September 19

Hi good afternoon.
I have the program as text.
I play with the javacpc.
if I started "hisoft pascal 4t", how can I pass this test.txt to "hisoft pascal 4t" without me typing it in myself?


Thank you.
Greeting

For that particular program, I made a DSK image (http://www.cpcwiki.eu/forum/programming/hisoft-pascal-4t/?action=dlattach;attach=25531) of it, so there's no need to type in or convert text.
The Listing of that demo uses a Second file called ROUTINES.LIB to store PROCEDUREs to handle INK, MODE, PLOT, DRAWR and ORIGIN as they don't come as standard with HP4T.


If you still need to convert ASCII to Tokanised Format @revaldinho (http://www.cpcwiki.eu/forum/index.php?action=profile;u=1776) made some utilities (https://github.com/revaldinho/cpc_pascal/tree/master/utils) for converting the formats, these were coded using Python (I'm not sure which version though).
Myself I use Winape which can Paste the ASCII into the Line Editor of HP4T (which saves me from using it), and to get it into Text Format from HP4T I can use the 'Z' Command to dump the Text, originally this would have been to the Printer, but in this case I can direct output to a File with Winape of a specified Filename. If JavaCPC has a 'Paste' facility as well as a 'Dump Text to File', that would go a long way getting the code to and from the editor.


If you're still having troubles, you can download the Hisoft Pascal 80 Face B Side  (https://www.cpc-power.com/index.php?page=detail&onglet=dumps&num=4671#) on CPC-POWER which includes 2 COM files TOAMS.COM and FROMAMS.COM that you can use in CP/M Plus. "TOAMS.COM" will convert ASCII to HP4T format and FROMAMS.COM to convert HP4T format to ASCII.


Hope this helps.

Thanks for your help.


How can I save a bin please?


first c to create a bin? and then?


Thank you.
greeting


ps: how is the pascal 80?

Quote from: funkheld on 08:08, 02 September 19
Thanks for your help.




How can I save a bin please?




first c to create a bin? and then?

No need to 'C' to Compile. Type 'T,,filename.bin', compilation begins with code at &17C4, if error free on completion 'Ok?' message appears, press 'Y' Binary File is Saved and Computer Resets to BASIC (this is normal), press 'N' or any other Key code is aborted and returns to the HP4T prompt. The double Comma ',,' between t & the filename is important, if none is specified or no filename is specified HP4T will actually Save the Binary file with .PAS extension. Fortunately AMSDOS replaces the .PAS source code file as a Backup File '.BAK'.

QuoteThank you.
greeting




ps: how is the pascal 80?

I haven't used it, but the manual for it is very good covering a wide range of things which can be used. It operates in CP/M though, but one of advantages it would have is larger space to compile the code under CP/M Plus. It doesn't have Tokanised coding format through, so the Source Code is in ASCII, unfortunately it only Compiles CP/M ".COM" files, originally I thought the "TOAMS.COM" file might of been used to Convert a generated .COM file into a BIN file to use under AMSDOS, but discovered it was written to Convert Source Code for Hisoft Pascal 4T to compile.


p.s. Apart from the CP/M COM file limitation, I think Hisoft Pascal 80 is another good compiler perhaps better than Borland's Turbo Pascal 3, back in the day it was relatively cheap compiler but still very good for what you paid for, the manual extends itself to include details of incorporating Graphical Library through GSX, which Borland couldn't be bothered with as part of their Turbo Pascal 3 Manual, which more or less focused on the other 16bit Operating Systems of the time (MS-DOS, PC-DOS, CP/M-86) as well as CP/M-80, but not a lot of scope, which is why I think Borland decided to make something else called Graphix Toolbox for Turbo Pascal. If you don't mind coding in CP/M it maybe useful at coding Graphical adventures and Applications. If you're like me and like to see what can be done using the Firmware then HP4T is better at handling those things, coding using the Firmware isn't favourable either because CP/M Plus and CP/M v2.2 have different ways of accessing it, plus you're producing .COM files for a system which hosts a broader community that perfer to see compatability which is why they prefer the use of GSX. Unfortunately it just means being limited to 64k under HP4T while writing the code, unlike Pascal 80 which can be used under CP/M Plus and generate larger COM files. HP4T has a more quick and dirty, it originally appeared for the Spectrum I think where Hisoft made numerous updates to improve it and when the Amstrad CPCs came out in 1984, Hisoft had a fairly decent compiler and were able to make some adjustments to it to take advantage of the CPCs Firmware and around Sept 1984 the Compiler was Distributed through AMSOFT, early ACU issues were nice enough to run some articles on the Compiler which I popped into the Hisoft Pascal 4T page on the Wiki (https://www.cpcwiki.eu/index.php/Hisoft_Pascal_4T). Hisoft Pascal 80 seems to have been written to produce a more standard Pascal compiler, it doesn't have close connections to the Firmware like 4T has which, in a sense makes it the Pascal equivalent of Mallard BASIC is as is to Locomotive BASIC. Pascal 80 maybe usable in PCW systems (I'm guess at that though), which would indeed warrant for such a language. I think shortly after Pascal 80 came out though, Hisoft also produced their own K&R C, which could be used under CP/M or AMSDOS.

hello, thanks.


greeting

Hi good afternoon.
on the dsk I have test1.pas and test2.pas
when I enter g ,, test1.pas it works.
if I then continue to enter g ,, test2.pas, test1.pas is still in memory. how do I please test1.pas from the memory, or how can I delete test1.pas in memory?


Thank you.
greeting

Hi good afternoon.
I have converted a rsx-file : testrsx in asm to a binfile: test.bin with 150 byte.
I would like to invite to & 8000.


Can one make it like this :
-----------------------------------
VAR
  Prog : ARRAY [0..151] OF integer;


PROCEDURE LoadSprite;
VAR
  loop : integer;


  BEGIN
  tin('test.bin',addr(Prog));
  FOR loop:=0 TO 150 DO
  poke(#8000+loop,prog[loop]);
  user(#8000);
  END;
------------------------------------   


Can one make it like this?
------------------------------------
PROCEDURE test();
  BEGIN
    external('testrsx');
  END;
------------------------------------


greeting

Hi good afternoon.


with which you converted please all text files here in PAS?


Thank you.
Greeting

Quote from: funkheld on 13:20, 02 September 19
Hi good afternoon.
on the dsk I have test1.pas and test2.pas
when I enter g ,, test1.pas it works.
if I then continue to enter g ,, test2.pas, test1.pas is still in memory. how do I please test1.pas from the memory, or how can I delete test1.pas in memory?




Thank you.
greeting

Yes so test1.pas needs to be deleted, at the prompt '>' type d<n,e> with 'n' being the first line number and 'e' the last line number, then 'g,,test2.pas'.

Quote from: funkheld on 16:14, 02 September 19
Hi good afternoon.
I have converted a rsx-file : testrsx in asm to a binfile: test.bin with 150 byte.
I would like to invite to & 8000.




Can one make it like this :
-----------------------------------
VAR
  Prog : ARRAY [0..151] OF integer;




PROCEDURE LoadSprite;
VAR
  loop : integer;




  BEGIN
  tin('test.bin',addr(Prog));
  FOR loop:=0 TO 150 DO
  poke(#8000+loop,prog[loop]);
  user(#8000);
  END;
------------------------------------   




Can one make it like this?
------------------------------------
PROCEDURE test();
  BEGIN
    external('testrsx');
  END;
------------------------------------




greeting

No unfortunately, because TIN is its own format Hisoft wrote in conjunction with TOUT to create files. To make matters worse it has formatting which makes it appear that it writes as a true BINary file, as it can be used to Load or Save Data. I did write a small Assembly routine here (http://www.cpcwiki.eu/forum/programming/hisoft-pascal-4t/msg164080/#msg164080) to demonstrate how the routine works though which loads a SCREEN of a certain name to the Screen Memory from BASIC.


It is possible to load a standard BINary file in Hisoft Pascal with a routine like this:




   40 TYPE name = ARRAY[1..12] OF char;

  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;



Just alter the line numbers so it fits in your source code.


To use it, set RAM-TOP Question at the Hisoft Pascal loading screen to &7FFF, change the LoadSprite Procedure to:



PROCEDURE LoadSprite;
BEGIN
   load('test    .bin',#8000);
   user(#8000)
END;



making sure test.bin is exactly 12 characters long (by filling up any space after the name with spaces, followed by the .bin). user(#8000) then activates the RSXs.


The Test PROCEDURE should work, but it doesn't need brackets after its name, brackets are only necessary if information from variables is being passed as shown with the load PROCEDURE.

Quote from: funkheld on 17:42, 02 September 19
Hi good afternoon.


with which you converted please all text files here in PAS?


Thank you.
Greeting

Unfortunately I haven't got JavaCPC, so you'll need to go into that Emulators Settings to see if it allows Printer Dumps to File. If it does, Great because that will allow you to specify a Filename to Dump the Source Code to, by using the 'Z' Print Text option at the Hisoft Pascal Command Prompt '>'. If JavaCPC hasn't got that, then unfortunately you will have to use something like FROMAMS.COM on the Pascal 80 Disk to convert the format back to ASCII, which unfortunately still won't get the file off the DSK. In Winape is an option which allows Files to be copied from DSK outside of it, which is very useful for taking ASCII Files off the DSK. Somehow I would be shocked if JavaCPC didn't have any of that because it's one of the main emulators in use.

hello, thanks for the help.


greeting.

hello, good day.

is ok.

tanks.

screen 1 loop  this demo ok.


this demo no loop ,jump back to basic :
Colour Animation & screen load2


have one CPC6128.

greeting

Quote from: funkheld on 10:22, 03 September 19
screen 1 loop  this demo ok.


this demo no loop ,jump back to basic :
Colour Animation & screen load2


have one CPC6128.

greeting

Colour Animation & Screen Load or AnimationTest as I called it, draws the Triangles to Screen doing some Colour Animation, it doesn't do what I was curious about, which was INK rotation during the loading of the Second Screen, but decided to publish the code on here anyway. That particular Demo won't work on any system while Hisoft Pascal is running in the background because it draws the Triangles on the main screen @ &C000, while loading the picture into the other @ &4000. So the code needs to be Translated to BINary file and executed like that, which makes this an example of how to write code in Hisoft Pascal that uses 2 Screens and using SCR SET BASE (#BC08) to do the switch.

I took your original bin and started with: ANMTIN.BIN and SCREEN.DAT.


RUN"ANMTIN.BIN"


greeting

I have your original bin and started with: ANMTIN.BIN and SCREEN.DAT.

RUN"ANMTIN.BIN"

this program not ok.

greeting.

Hi good afternoon.


do you have a solution please?


greeting

Hi good afternoon.
i want to write in addr $ 4000.
then switch from $ c000 to $ 4000 so I can see the graph.
how is that possible?


Thank you.
greeting


PROGRAM LOADBASE;
{$C-}
{$L-}
   
TYPE NAME = ARRAY[1..12] OF CHAR;   


PROCEDURE LOAD(FILE : NAME; ADRESS : INTEGER);
BEGIN
   RB:=CHR(SIZE(FILE));
   RHL:=ADDR(FILE);
   RDE:=ADRESS;
   USER(#BC77);
   RHL:=ADRESS;
   USER(#BC83);
   USER(#BC7A)
END;


PROCEDURE LOADBIN;
BEGIN
   LOAD('DATEN   .BIN',#4000);
END;


PROCEDURE SCRBASE(SCR : INTEGER);
BEGIN
   RA:=CHR(SCR);
   USER(#BC08)
END;


PROCEDURE SCRWRITE(SCR : INTEGER);
BEGIN
  POKE(#B7C6,CHR(SCR))
END;


BEGIN
  SCRWRITE(#40);
   LOADBIN;
   SCRBASE(#40)
END.


Quote from: funkheld on 18:35, 03 September 19
I have your original bin and started with: ANMTIN.BIN and SCREEN.DAT.


RUN"ANMTIN.BIN"


this program not ok.


greeting.

Quote from: funkheld on 21:39, 03 September 19
Hi good afternoon.




do you have a solution please?




greeting

What I created seems to be working fine in 464 and 6128 settings. Though my example is using TIN, which only works from Drive A: if a Disk is present in Drive A: and this is executed TIN will try finding SCREEN.DAT from Drive A: and if it's not present exit back to BASIC, if Disk was only present in Drive B: a Disk Missing error occurs with Retry, Ignore and Cancel option. This occurs because Hisoft Pascal Library resets at it's Initialisation stage (before program starts), nothing much I can do about that except load from Drive A:


All that code is, is some Triangles Blinking Away while SCREEN.DAT is loading, once loaded switches to the Second Screen and the program is complete with "Run (Y/N)?". If anything other than 'Y' is pressed the Computer Resets to BASIC, pressing 'Y' will run it from the Beginning (at the Flashing Triangles and load SCREEN.DAT again).

Quote from: funkheld on 08:17, 04 September 19

Hi good afternoon.
i want to write in addr $ 4000.
then switch from $ c000 to $ 4000 so I can see the graph.
how is that possible?


Thank you.
greeting

Code Select Expand



PROGRAM LOADBASE;
{$C-}
{$L-}
   
TYPE NAME = ARRAY[1..12] OF CHAR;   


PROCEDURE LOAD(FILE : NAME; ADRESS : INTEGER);
BEGIN
   RB:=CHR(SIZE(FILE));
   RHL:=ADDR(FILE);
   RDE:=ADRESS;
   USER(#BC77);
   RHL:=ADRESS;
   USER(#BC83);
   USER(#BC7A)
END;


PROCEDURE LOADBIN;
BEGIN
   LOAD('DATEN   .BIN',#4000);
END;


PROCEDURE SCRBASE(SCR : INTEGER);
BEGIN
   RA:=CHR(SCR);
   USER(#BC08)
END;


PROCEDURE SCRWRITE(SCR : INTEGER);
BEGIN
  POKE(#B7C6,CHR(SCR))
END;


BEGIN
  SCRWRITE(#40);
   LOADBIN;
   SCRBASE(#40)
END.


In your case you don't need SCRWRITE();
#B7C6 is a 6128 only address used to tell the Amstrad to write to #4000 using Conventional Printing, but your LoadBIN is already loading a Screen to #4000, so you don't need SCRWRITE(#40);
It's always good to have a MODE procedure when dealing with Screens (and INKs if you want other colours), and your example will have to be Translated straight to File in order for the program to work.


Mode Procedure Looks like this:



PROCEDURE Mode(n : integer);
BEGIN
   ra:=chr(n);
   user(#bc0e)
END;


How is this going to be changed for Pascal?
Thank you.
greeting

------------------------------------------------
PROCEDURE scrwrite(n : integer);
begin
  ld hl,#b7c6
  ld (hl),CHR(n)
END;
---------------------------------------------------------

Quote from: funkheld on 11:07, 04 September 19

How is this going to be changed for Pascal?
Thank you.
greeting

------------------------------------------------
PROCEDURE scrwrite(n : integer);
begin
  ld hl,#b7c6
  ld (hl),CHR(n)
END;
---------------------------------------------------------

Delete the SCRWRITE Procedure and SCRWRITE(#40); within the Main Code and replace with the Mode Procedure and Mode(<screen mode>); in the Main Code.

it should be visible to the screen $C000 and wants to invisibly write in $4000. then I want to switch from $C000 to $ 4000.

Thank you.
greeting

how does the symbol and symbolafter in pascal work?

Thank you.
greeting

hello, can you translate that into ASM source code?
Thank you.
greeting


  190 PROCEDURE DrawBlock(xpos,ypos,width : integer; height,col : char);
  200 VAR storey : integer;
  210 BEGIN
  220   inline(#DD,#7E,#03);
  230   inline(#47);
  240   inline(#DD,#7E,#02);
  250   inline(#CD,#DE,#BB);
  260   inline(#DD,#6E,#06);
  270   inline(#DD,#66,#07);
  280   inline(#DD,#74,#FB);
  290   inline(#DD,#75,#FA);
  300   inline(#C5);
  310   inline(#DD,#6E,#08);
  320   inline(#DD,#66,#09);
  330   inline(#EB);
  340   inline(#DD,#6E,#FA);
  350   inline(#DD,#66,#FB);
  360   inline(#CD,#C0,#BB);
  370   inline(#DD,#6E,#04);
  380   inline(#DD,#66,#05);
  390   inline(#EB);
  400   inline(#21,#00,#00);
  410   inline(#CD,#F9,#BB);
  420   inline(#C1);
  430   inline(#DD,#6E,#FA);
  440   inline(#DD,#66,#FB);
  450   inline(#2B);
  460   inline(#2B);
  470   inline(#DD,#75,#FA);
  480   inline(#DD,#74,#FB);
  490   inline(#10,#D1);
  500 END;


symbol and symbolafter in pascal work wonderbar.
is ok.

greeting

hello can you please create me the sourcocde for it.
Thank you.
greeting



220   inline(#DD,#7E,#03);
  230   inline(#47);
  240   inline(#DD,#7E,#02);
  250   inline(#CD,#DE,#BB);
  260   inline(#DD,#6E,#06);
  270   inline(#DD,#66,#07);
  280   inline(#DD,#74,#FB);
  290   inline(#DD,#75,#FA);
  300   inline(#C5);
  310   inline(#DD,#6E,#08);
  320   inline(#DD,#66,#09);
  330   inline(#EB);
  340   inline(#DD,#6E,#FA);
  350   inline(#DD,#66,#FB);
  360   inline(#CD,#C0,#BB);
  370   inline(#DD,#6E,#04);
  380   inline(#DD,#66,#05);
  390   inline(#EB);
  400   inline(#21,#00,#00);
  410   inline(#CD,#F9,#BB);
  420   inline(#C1);
  430   inline(#DD,#6E,#FA);
  440   inline(#DD,#66,#FB);
  450   inline(#2B);
  460   inline(#2B);
  470   inline(#DD,#75,#FA);
  480   inline(#DD,#74,#FB);
  490   inline(#10,#D1);

Asking several times will actually make people ignore your request.


Now, for the next time you need something like this, follow these steps:


1) Open a hex editor like HxD on Windows or 0xED on Mac and create a new file.
2) Type all the values so you create a binary file and save it.
3) Run a Z80 disassembler (like Unidasm, or any other you fancy) on the resulting file.


And here is the code:
00: dd 7e 03  ld   a,(ix+$03)
03: 47        ld   b,a
04: dd 7e 02  ld   a,(ix+$02)
07: cd de bb  call $BBDE
0a: dd 6e 06  ld   l,(ix+$06)
0d: dd 66 07  ld   h,(ix+$07)
10: dd 74 fb  ld   (ix-$05),h
13: dd 75 fa  ld   (ix-$06),l
16: c5        push bc
17: dd 6e 08  ld   l,(ix+$08)
1a: dd 66 09  ld   h,(ix+$09)
1d: eb        ex   de,hl
1e: dd 6e fa  ld   l,(ix-$06)
21: dd 66 fb  ld   h,(ix-$05)
24: cd c0 bb  call $BBC0
27: dd 6e 04  ld   l,(ix+$04)
2a: dd 66 05  ld   h,(ix+$05)
2d: eb        ex   de,hl
2e: 21 00 00  ld   hl,$0000
31: cd f9 bb  call $BBF9
34: c1        pop  bc
35: dd 6e fa  ld   l,(ix-$06)
38: dd 66 fb  ld   h,(ix-$05)
3b: 2b        dec  hl
3c: 2b        dec  hl
3d: dd 75 fa  ld   (ix-$06),l
40: dd 74 fb  ld   (ix-$05),h
43: 10 d1     djnz $0016

hello thanks.


greeting
:) :) :)

Hi good afternoon.

I load and save with amsdos-load-save.
working wonderfully, can ascii and am data load-saven.

Thank you
greeting

load:

PROGRAM LOAD;
{$C-}
{$L-}


TYPE NAME = ARRAY[1..12] OF CHAR;   


VAR j    : integer;
    Loop : Boolean;


PROCEDURE LOAD(FILE : NAME; ADRESS : INTEGER);
BEGIN
   RB:=CHR(SIZE(FILE));
   RHL:=ADDR(FILE);
   RDE:=ADRESS;
   USER(#BC77);
   RHL:=ADRESS;
   USER(#BC83);
   USER(#BC7A)
END;


BEGIN
   LOAD('DATEN   .BIN',#C000)
END.


save:

PROGRAM save;
{$C-}
{$L-}


TYPE NAME = ARRAY[1..12] OF CHAR;   


VAR j     : integer;
    Loop  : Boolean;
      loopo : integer;


PROCEDURE SAVE(FILE : NAME; ADRESS , LANG , BIN : INTEGER);
BEGIN
   RB:=CHR(SIZE(FILE));
   RHL:=ADDR(FILE);
   RDE:=ADRESS;
   USER(#BC8C);
   RHL:=ADRESS;
   RDE:=LANG;
   RBC:=#0000;
   RA:=CHR(BIN);
   USER(#BC98);
   USER(#BC8F)
END;


PROCEDURE move(x,y : integer);
BEGIN
   rde:=x;
   rhl:=y;
   user(#bbc0);
END;


PROCEDURE draw(x,y : integer);
BEGIN
   rde:=x;
   rhl:=y;
   user(#bbf6);
END;


PROCEDURE mode(a : char);
BEGIN
   ra:=a;
   user(#bc0e);
END;


FUNCTION degtorad(val : integer) : real;
VAR num1 : real;
BEGIN
   num1:=3.14159/180;
   degtorad:=num1*val;
END;


BEGIN
   mode(chr(1));
   loopo:=0;
   REPEAT
      move(320,200);
      draw(round(320+190*cos(degtorad(loopo))),round(200+190*sin(degtorad(loopo))));
      loopo:=loopo+1;
   UNTIL loopo=361;
   SAVE('DATEN   .BIN',#C000,#4000,#0002)
END.


Hi good afternoon.
I understood that with the inline now as well.
I did not know how the data would be recorded.
Thank you. I wrote a program in purebasic which makes an asm an inline.

Thank you
greeting

for mi little demo plot.asm:

ld l,(ix+$02)
ld h,(ix+$03)
ld e,(ix+$04)
ld d,(ix+$05)
call $BBEA
     


PROGRAM plot;
{$C-}
{$L-}


PROCEDURE plot(x,y : integer);
BEGIN
  inline( #DD ,#6E ,#2 ,#DD ,#66 ,#3 ,#DD ,#5E ,#4 ,#DD);
  inline( #56 ,#5 ,#CD ,#EA ,#BB  );
END;


PROCEDURE mode(a : char);
BEGIN
   ra:=a;
   user(#bc0e);
END;


PROCEDURE grapen(col : integer);
BEGIN
   ra:=chr(col);
   user(#bbde);
END;


BEGIN
  mode(chr(2));
   grapen(1);
   plot(620,350)
END.


Hi good afternoon.

how can you please prevent this after saving a file:
t,, test.bin
the compiler will not leave?

Thank you.
greeting

Hi good afternoon.

when I compile your program:

PROGRAM MemoryTest;

then the error message comes:
No more Text


gruss

Hi good afternoon.


you load the 4 pictures after $4000 and push them with OUT... in the upper memory area. then you bring the pictures with OUT....to $4000 and then copy them to $c000. why is this program at $a500 and not in your main program?

Thank you.
greeting

Hi good afternoon.
Now I have finally understood this with the RSX.
have in the RSX 2 plot to practice.
The hisoft pascal 4t is a great thing.

Thank you.
greeting


Pascal-RSX :

PROGRAM RSX;
{$C-}
{$L-}


TYPE NAME = ARRAY[1..12] OF CHAR;   


VAR x,y : integer;
   
PROCEDURE LOAD(FILE : NAME; ADRESS : INTEGER);
BEGIN
   RB:=CHR(SIZE(FILE));
   RHL:=ADDR(FILE);
   RDE:=ADRESS;
   USER(#BC77);
   RHL:=ADRESS;
   USER(#BC83);
   USER(#BC7A)
END;


PROCEDURE mode(a : char);
BEGIN
   ra:=a;
   user(#bc0e);
END;


PROCEDURE grapen(col : integer);
BEGIN
   ra:=chr(col);
   user(#bbde);
END;


BEGIN
   LOAD('RSPLOT  .BIN',#8000);
   USER(#8000);
   mode(chr(2));
   grapen(1);
   x:=100;
   y:=100;
   external('PLOT1',x,y);
   x:=200;
   y:=200;
   external('PLOT2',x,y)
END.



create a bin : rsx:

         nolist
        org #8000


        LD      HL,BufferRsx
        LD      BC,PtrRsx
        JP      #BCD1


PtrRsx:
        DW      RSX_TABLE
        JP      plot1
        JP      plot2


RSX_TABLE:
        DB      "PLOT","1"+#80
        DB      "PLOT","2"+#80


plot1:
        ld l,(ix+$04)
ld h,(ix+$05)
        ld e,(ix+$02)
ld d,(ix+$03)
call #BBEA
        RET


plot2:
        ld l,(ix+$04)
ld h,(ix+$05)
        ld e,(ix+$02)
ld d,(ix+$03)
call #BBEA
        RET
       
BufferRsx:
        DS      4



Push screen into the higher memory?

Hi good afternoon.
I can not push the screen into the listening memory and bring it back.

What is there for a mistake in it?

Thank you.
greeting




PROGRAM MEMOBI;
{$C-}
{$L-}
   
TYPE NAME = ARRAY[1..12] OF CHAR;   


VAR
  N, X, Y : INTEGER;
   KVAL : CHAR;


PROCEDURE LOAD(FILE : NAME; ADRESS : INTEGER);
BEGIN
   RB:=CHR(SIZE(FILE));
   RHL:=ADDR(FILE);
   RDE:=ADRESS;
   USER(#BC77);
   RHL:=ADRESS;
   USER(#BC83);
   USER(#BC7A)
END;


PROCEDURE WARTE;
BEGIN
   FOR N:=0 TO 1000 DO
      BEGIN
         X:=23
     END
END;


PROCEDURE MODE(N : INTEGER);
BEGIN
  RA:=CHR(N);
  USER(#BC0E)
END;


PROCEDURE COPY40C0;
BEGIN
  INLINE( #11 ,#0 ,#C0 ,#21 ,#0 ,#40 ,#1 ,#0 ,#40 ,#ED);
  INLINE( #B0 ,#C9  );
END;


PROCEDURE COPYC040;
BEGIN
  INLINE( #11 ,#0 ,#40 ,#21 ,#0 ,#C0 ,#1 ,#0 ,#40 ,#ED);
  INLINE( #B0 ,#C9  );
END;


PROCEDURE GETSCR;
BEGIN
   LOAD('SCREEN01.DAT',#C000);
   OUT(#7F00,CHR(#C4));
   COPYC040;
   OUT(#7F00,CHR(#C0));
   LOAD('SCREEN02.DAT',#C000);
   OUT(#7F00,CHR(#C5));
   COPYC040;
   OUT(#7F00,CHR(#C0));
   LOAD('SCREEN03.DAT',#C000);
   OUT(#7F00,CHR(#C6));
   COPYC040;
   OUT(#7F00,CHR(#C0));
   LOAD('SCREEN04.DAT',#C000);
   OUT(#7F00,CHR(#C7));
   COPYC040;
   OUT(#7F00,CHR(#C0))
END;


PROCEDURE SCRGET1;
BEGIN
   OUT(#7F00,CHR(#C4));
   COPY40C0;
   OUT(#7F00,CHR(#C0))
END;


PROCEDURE SCRGET2;
BEGIN
  OUT(#7F00,CHR(#C5));
   COPY40C0;
   OUT(#7F00,CHR(#C0))
END;


PROCEDURE SCRGET3;
BEGIN
   OUT(#7F00,CHR(#C6));
   COPY40C0;
   OUT(#7F00,CHR(#C0))
END;


PROCEDURE SCRGET4;
BEGIN
   OUT(#7F00,CHR(#C7));
   COPY40C0;
   OUT(#7F00,CHR(#C0))
END;


PROCEDURE FTCHSCR;
BEGIN
  KVAL:=INCH;
  CASE ORD(KVAL) OF
      240 : SCRGET1;
      241 : SCRGET2;
      242 : SCRGET3;
      243 : SCRGET4
  END
END;


BEGIN
    MODE(0);
    GETSCR;
    REPEAT
    FTCHSCR;
   UNTIL ORD(KVAL)=252;
   MODE(2)
END.