The following is my solution to the second sub-problem of the "Three Homework Problems (http://programmingpraxis.com/2015/09/18/three-homework-problems-2/)" problem posed by Programming Praxis (http://programmingpraxis.com/); I'm just trying to solve the problems posed by the aforementioned 'site whilst I try to get a job (http://london.craigslist.org/res/d/freelance-programmer-for-your-project/6912506396.html) - I was just fired in so passive a way that I'm not completely certain that I've been fired (I had - have..? - a "zero hour" job, and my employer just stopped offering me hours and responding to my emails :/ ) - and, having solved a fair few of the problems posed by the aforementioned 'site using a (kind of..?) retro Mac (an Apple Power Mac G4 (AGP Graphics) (450MHz processor, 1GB memory)), I decided to try to solve the problems posed by the aforementioned 'site using an Amstrad CPC and HiSoft Pascal for CP/M-80 and HiSoft Pascal Amstrad CPC464 to try to broaden my exposure to other platforms - particularly after I skimmed the documentation and realised that machine code could be intermixed with Pascal using arrays and the built-in ADDR function and USER procedure; but, if I'd done more than just skim the documentation, I would have realised that HiSoft Pascal Amstrad CPC464 doesn't provide any built-in functions or procedures for using files, and so I think that my using that platform - or at least that compiler - to try to solve the problems posed by the aforementioned 'site - and to try to program games - has ended almost as quickly as it began :/
(And I'm well-aware that my solutions to the problems posed by the aforementioned 'site are far from the best - but, in my defence, I don't have any traditional qualifications in computer science :/ )
PP150918.pas:
(* Programming Praxis *)
(* "Three Homework Problems" (18th of September, 2015) *)
(* [Sub-problem #2] *)
PROGRAM PP150918;
VAR
i : 1..27;
count (* (s) of letter(s) *) : ARRAY [ 1..26 ] OF 0..MAXINT;
c : CHAR;
first : BOOLEAN;
number (* of letters *) : 0..26;
were : BOOLEAN;
k : 0..26;
FUNCTION fToLowercase( p : CHAR ) : CHAR;
BEGIN
IF p IN [ 'A'..'Z' ] THEN
fToLowercase := CHR( ORD( p ) - ORD( 'A' ) + ORD( 'a' ))
ELSE
fToLowercase := p
END;
BEGIN
FOR i := 1 TO 26 DO
count[ i ] := 0;
WRITELN;
WRITE( 'Please enter a string; ' );
WRITE( 'this program will then count the number of occurences of each ' );
WRITELN( 'letter in that string.' );
WRITELN;
WRITE( 'Your input: ' );
REPEAT
READ( c );
c := fToLowercase( c );
IF c IN [ 'a'..'z' ] THEN BEGIN
i := ORD( c ) - ORD( 'a' ) + 1;
count[ i ] := count[ i ] + 1
END
UNTIL EOLN;
first := TRUE;
number := 0;
FOR i := 1 TO 26 DO
IF count[ i ] > 0 THEN BEGIN
IF first THEN BEGIN
first := FALSE;
were := count[ i ] > 1
END;
number := number + 1
END;
WRITELN;
WRITE( 'There w' );
IF ( number = 0 ) OR were THEN
WRITE( 'ere' )
ELSE
WRITE( 'as' );
WRITE( ' ' );
IF number = 0 THEN
WRITE( 'no letters' )
ELSE BEGIN
k := 0;
FOR i := 1 TO 26 DO
IF count[ i ] > 0 THEN BEGIN
k := k + 1;
IF k > 1 THEN
IF number <> 2 THEN BEGIN
WRITE( ', ' );
IF k = number THEN
WRITE( 'and ' )
END ELSE
WRITE( ' and ' );
WRITE( count[ i ]:0, ' ''', CHR( i - 1 + ORD( 'a' )), '''' );
IF count[ i ] > 1 THEN
WRITE( 's' )
END
END;
WRITELN( ' in the string that you entered.' )
END.
Hisoft Pascal 4t (or as you're calling it HiSoft Pascal Amstrad CPC464), has been designed to utilise much of the Amstrads Firmware, so for Games for example, it would be looking at simple games. Not that Simple Games can't be enjoyable, I coded 'Get the Cash' with it and towards the end of that project I felt like it was very close to pushing the limits on Hisoft Pascal 4t. I probably had some things in there I could have done better, for instance I was loading Sprite Driver/Graphics & Music. The Sprite Driver probably could have been some procedures which may have freed up some memory, I also used very descriptive names for the procedures, in Hisoft Pascal 4t only the Keywords are Tokenised, which leaves the names of procedures, variables and even variable types fully ASCII. The Hisoft Pascal 80 version would probably give more space to play with to compile programmes, it's only restriction being it only Compiles COM files for CP/M, while Hisoft Pascal 4t is pushing it's boundaries around 20k or so. It does allow like Turbo Pascal 3 to insert source code files at compile time and this does help free up space, though that was what I had to do to get my Game going.
You're correct in Hisoft Pascal for CPC464 doesn't have any standard File handling facilities. Within the Compiler is two non-standard commands called TIN(); and TOUT(); which Load and Save Files in a Character Format. They can be used to load Data into an Array or Saved from an Array, apart from that other the alternative is to write you own which involves using the Firmware.
The Firmware handling is one of Hisoft Pascal 4t strengths and can easily be accessed without any Machine Code necessary by allowing access to the Register Set through R variable. 'R' then follows on with any of the available registers the Amstrad has, so 'A','HL','DE','BC' for example. It can also use 'H','L' as single registers for example, so when single registers are used Hisoft Pascal needs to convert into Byte format which it does with the CHR(varname), this way when writing a PROCEDURE which carries out a operation a Numeric value can be passed through the PROCEDURE and then be converted where necessary. I hope that makes sense.
Nice :)
Just made me quickhack it in good ol' loco:
10 DIM a%(26)
20 PRINT"Please enter a string this program will then count the number of occurences of each letter in that string."
30 INPUT a$:a$=UPPER$(a$)
40 FOR i%=1 TO LEN(a$):m$=MID$(a$,i%,1)
50 PRINT m$
60 a%(ASC(m$)-64)=a%(ASC(m$)-64)+1
70 NEXT
80 PRINT"string was made of "
90 FOR i%=1 TO 26
100 IF a%(i%)>0 THEN PRINT a%(i%);" times ";CHR$(i%+64)
110 NEXT
@AMSDOS (http://www.cpcwiki.eu/forum/index.php?action=profile;u=330) Thank you for your reply! I think I already knew about everything that you wrote about - eg., I already knew about the built-in Rx variables, although those aren't how I've been intermixing machine code and Pascal - I've posted below a proof-of-concept of my (likely bad...) idea for intermixing machine code and Pascal using arrays and the built-in ADDR function and POKE and USER procedures; my (better, but still likely bad...) idea was for the executable to read machine code from file at run-time, thus - amongst other things - reducing the size of the source code and the size of the executable, as it isn't necessary to have line after line after... of calls to the POKE procedure; I've now put together quick-and-(very...)dirty functions for file handling (again intermixing machine code and Pascal), and I'll try to post them "soon"...
On that topic, do you know if the Z80 in the Amstrad CPC supports the IX (#DDxx) instructions? (If you don't know, I'll perform an experiment to determine if it does or doesn't.) I ask as I discovered that the Z80 in the Amstrad CPC seems not to support the bit (#CBxx) instructions. (I'm using the tables here (http://clrhome.org/table/) for reference.)
PoC.pas:
(*$C-*)
(* This program is a proof-of-concept that demonstrates using `HiSoft Pascal *)
(* Amstrad CPC464` to intermix machine code and Pascal using arrays and the *)
(* built-in `ADDR` function and `POKE` and `USER` procedures. *)
(* This program interrogates the state of joystick #0. *)
PROGRAM PoC (* "Proof-of-Concept" *) ;
CONST
kMCLength = 31;
TYPE
tJoystick = ARRAY [ 0..5 ] OF BOOLEAN;
(* Bit/index: Meaning: *)
(* 0 d-pad up *)
(* 1 d-pad down *)
(* 2 d-pad left *)
(* 3 d-pad right *)
(* 4 fire button 2 *)
(* 5 fire button 1 *)
tPositiveInteger = 1..MAXINT;
tJoystickAxisDirection = -1..1;
tJoystickButton = 1..2;
VAR
MCOffset, MCAddress : INTEGER;
MC : ARRAY [ 1..kMCLength ] OF CHAR;
joystick0 : tJoystick;
jumpAddress, callAddress : INTEGER;
first : BOOLEAN;
oldJoystick0 : tJoystick;
i : 0..6;
PROCEDURE pPokeMC( value : INTEGER; sizeOfValue (* in bytes *) :
tPositiveInteger );
BEGIN
IF MCOffset + sizeOfValue > kMCLength THEN BEGIN
WRITE( 'Sorry, an error occurred: too much machine code has already been ' );
WRITELN( '`POKE`''d (`MCOffset` + `sizeOfValue` > `kMCLength`).' );
HALT
END;
POKE( MCAddress + MCOffset, value );
MCOffset := MCOffset + sizeOfValue
END;
FUNCTION fJoystickStateChanged( a, b : tJoystick ) : BOOLEAN;
VAR
returnValue : BOOLEAN;
i : 0..6;
BEGIN
returnValue := FALSE;
i := 0;
WHILE NOT returnValue AND ( i <= 5 ) DO BEGIN
returnValue := a[ i ] <> b[ i ];
i := i + 1
END;
fJoystickStateChanged := returnValue
END;
FUNCTION fJoystickAxisDirection( joystick : tJoystick; axis : CHAR ) :
tJoystickAxisDirection;
VAR
p, n : 0..3;
returnValue : tJoystickAxisDirection;
BEGIN
IF axis IN [ 'x', 'X' ] THEN BEGIN
p := 3;
n := 2
END ELSE BEGIN
p := 0;
n := 1
END;
IF NOT joystick[ p ] AND NOT joystick[ n ] THEN
returnValue := 0
ELSE
IF joystick[ p ] AND joystick[ n ] THEN
returnValue := 0
ELSE
IF joystick[ p ] THEN
returnValue := 1
ELSE
returnValue := -1;
fJoystickAxisDirection := returnValue
END;
PROCEDURE pWriteJoystickButtonState( joystick : tJoystick; button :
tJoystickButton );
VAR
i : 4..5;
BEGIN
IF button = 1 THEN
i := 5
ELSE
i := 4;
WRITE( ' Fire button #', button:0, ': ' );
IF NOT joystick[ i ] THEN
WRITE( 'up' )
ELSE
WRITE( 'down' );
WRITELN
END;
BEGIN
MCAddress := ADDR( MC );
MCOffset := 0;
pPokeMC( #CD, 1 ); (* call ** *)
pPokeMC( #BB24, 2 ); (* address #BB24 *)
pPokeMC( #57, 1 ); (* ld d, a *)
pPokeMC( #06, 1 ); (* ld b, * *)
pPokeMC( #01, 1 ); (* value #01 *)
pPokeMC( #0E, 1 ); (* ld c, * *)
pPokeMC( #06, 1 ); (* value #06 *)
pPokeMC( #21, 1 ); (* ld hl, ** *)
pPokeMC( ADDR( joystick0 ), 2 );
jumpAddress := MCAddress + MCOffset;
pPokeMC( #36, 1 ); (* ld (hl), * *)
pPokeMC( #00, 1 ); (* value #00 *)
pPokeMC( #7A, 1 ); (* ld a, d *)
pPokeMC( #A0, 1 ); (* and b *)
pPokeMC( #C4, 1 ); (* call nz, ** *)
callAddress := MCAddress + MCOffset;
pPokeMC( #DEAD, 2 ); (* placeholder address *)
pPokeMC( #78, 1 ); (* ld a, b *)
pPokeMC( #87, 1 ); (* add a, a *)
pPokeMC( #47, 1 ); (* ld b, a *)
pPokeMC( #0D, 1 ); (* dec c *)
pPokeMC( #23, 1 ); (* inc hl *)
pPokeMC( #C2, 1 ); (* jp nz, ** *)
pPokeMC( jumpAddress, 2 );
pPokeMC( #C9, 1 ); (* ret *)
POKE( callAddress, MCAddress + MCOffset );
pPokeMC( #36, 1 ); (* ld (hl), * *)
pPokeMC( #01, 1 ); (* value #01 *)
pPokeMC( #C9, 1 ); (* ret *)
first := TRUE;
WHILE TRUE DO BEGIN
USER( MCAddress );
IF first OR fJoystickStateChanged( joystick0, oldJoystick0 ) THEN BEGIN
first := FALSE;
oldJoystick0 := joystick0;
PAGE;
WRITELN( 'Joystick #0:' );
FOR i := 0 TO 5 DO
WRITELN( ' Bit #', i:0, ': ', joystick0[ i ] );
WRITELN;
WRITE( ' y-axis: ' );
CASE fJoystickAxisDirection( joystick0, 'y' ) OF
-1:WRITE( 'down' );
0:WRITE( 'neutral' );
1:WRITE( 'up' )
END;
WRITELN;
WRITE( ' x-axis: ' );
CASE fJoystickAxisDirection( joystick0, 'x' ) OF
-1:WRITE( 'left' );
0:WRITE( 'neutral' );
1:WRITE( 'right' )
END;
WRITELN;
pWriteJoystickButtonState( joystick0, 1 );
pWriteJoystickButtonState( joystick0, 2 )
END
END
END.
Quote from: SRS on 21:17, 03 July 19
Nice :)
Just made me quickhack it in good ol' loco:
10 DIM a%(26)
20 PRINT"Please enter a string this program will then count the number of occurences of each letter in that string."
30 INPUT a$:a$=UPPER$(a$)
40 FOR i%=1 TO LEN(a$):m$=MID$(a$,i%,1)
50 PRINT m$
60 a%(ASC(m$)-64)=a%(ASC(m$)-64)+1
70 NEXT
80 PRINT"string was made of "
90 FOR i%=1 TO 26
100 IF a%(i%)>0 THEN PRINT a%(i%);" times ";CHR$(i%+64)
110 NEXT
I remember a guy trying to tutor this in YouTube and saying how such logic is really bad and instead was coming up with a faster logic that uses more memory but less iterations. I told him, he shouldn't be teaching his students that one method was bad without reason because if the goal is to conserve memory or eg: run on a CPC in BASIC, then such a solution like yours is very good. Sad when lecturers assume a single target platform when teaching algorithms.
Quote from: the graveborn on 09:14, 26 July 19
On that topic, do you know if the Z80 in the Amstrad CPC supports the IX (#DDxx) instructions? (If you don't know, I'll perform an experiment to determine if it does or doesn't.) I ask as I discovered that the Z80 in the Amstrad CPC seems not to support the bit (#CBxx) instructions. (I'm using the tables here (http://clrhome.org/table/) for reference.)
I'm not sure if I could provide a satisfactory answer, Index Registers are available through the INLINE M/C Command, Hisoft Pascal manages it a little differently compared to when used from BASIC or Assembly depending on how variables are defined (Globally, Locally or from a Procedure Statement or Function) which are outlined in one of the Appendixes of the Manual. If you're looking at the Index Registers from a Bit Instruction perspective (DDCB), then I can't help with that. :'(
The following is my solution to the "Reverse Vowels (http://programmingpraxis.com/2019/06/04/reverse-vowels/)" problem posed by Programming Praxis (http://programmingpraxis.com/), and is known to run on an emulated (using Arnold 1.7.8 ) Amstrad CPC 6128 on both CP/M Plus 1.0 (my solution compiled using HiSoft Pascal for CP/M-80) and AmsDOS (my solution compiled using HiSoft Pascal Amstrad CPC464).
Whilst solving this problem I learnt that, unlike Metrowerks CodeWarrior IDE 2.1 (Discover Programming Edition), the compiler that I'd usually use when using the Pascal programming language, HiSoft Pascal for CP/M-80 doesn't support a
SET being a
CONST - generating the compile-time error 13 ("Constant expected."); and that HiSoft' doesn't support the name of a source code file that is included using the
(*$F <Filename>.PAS*) compiler directive containing lowercase letters in the non-suffix part of the name of that file - generating the compile-time error "
No Source File: <FILENAME>.PAS" - as is illustrated by the following table:
Name of included source code file | Generates compile-time error |
<Filename>.pas | Yes |
<Filename>.PAS | Yes |
<FILENAME>.pas | No |
<FILENAME>.PAS | No |
I also learnt that Metrowerks' supports the conditional exclusion of source code using the
(*$IFNOTC DEFINED __MWERKS__*) and
(*$ENDC*) compiler directives.
(I'm just trying to solve the problems posed by the aforementioned 'site whilst I try to get a job (https://london.craigslist.org/res/7069419650.html) (and I've solved this problem in particular to investigate using dynamic memory in HiSoft' - dynamic memory in HiSoft' seems to be a lot less sophisticated than in Metrowerks', but that lack of sophistication may have its advantage, and I'll most likely try to investigate that in my solution to another problem...); I'm well-aware that my solutions are far from the best - but, in my defence, I don't have any traditional qualifications in computer science :/ )
PP190604.pas:(* Programming Praxis *)
(* "Reverse Vowels" (4th of June, 2019) *)
PROGRAM PP190604;
CONST
kMaximumNumberOfCharactersPerStringNode = 5;
TYPE
tZeroOrPositiveInteger = 0..MAXINT;
tStringNode = RECORD
mPreviousNode, mNextNode : ^tStringNode;
mLengthOfString : tZeroOrPositiveInteger;
mString : ARRAY [ 1..kMaximumNumberOfCharactersPerStringNode ] OF CHAR
END;
VAR
originalHeapState : ^tStringNode;
firstChar : BOOLEAN;
firstNode, currentNode : ^tStringNode;
c : CHAR;
headNode : ^tStringNode;
headIndex : tZeroOrPositiveInteger;
tailNode : ^tStringNode;
tailIndex : tZeroOrPositiveInteger;
vowels : SET OF CHAR;
newHeadVowel, newTailVowel : CHAR;
i : 1..MAXINT;
(*$F SETMODE2.PAS*)
(*$F OS .PAS*)
FUNCTION fEnd:BOOLEAN;
VAR
b : BOOLEAN;
BEGIN
b := FALSE;
IF headNode = NIL THEN
b := TRUE
ELSE IF tailNode = NIL THEN
b := TRUE
ELSE IF headNode = tailNode THEN
b := headIndex >= tailIndex;
fEnd := b
END;
(*$F LOWRCASE.PAS*)
PROCEDURE pIncrementHeadIndex;
BEGIN
headIndex := headIndex + 1;
IF headIndex > headNode^.mLengthOfString THEN BEGIN
headNode := headNode^.mNextNode;
headIndex := 1
END
END;
PROCEDURE pDecrementTailIndex;
BEGIN
tailIndex := tailIndex - 1;
IF tailIndex = 0 THEN BEGIN
tailNode := tailNode^.mPreviousNode;
IF tailNode <> NIL THEN
tailIndex := tailNode^.mLengthOfString
END
END;
(*$F UPPRCASE.PAS*)
BEGIN
MARK( originalHeapState );
pChangeScreenMode;
IF fOSIsCPM THEN
WRITELN;
WRITE( 'Please enter a string; this program will then reverse the vowels in' );
WRITE( ' that string,' );
WRITELN( 'maintaining the original capitalisation of the vowels.' );
WRITELN;
WRITE( 'Your input: ' );
firstChar := TRUE;
NEW( firstNode );
currentNode := firstNode;
currentNode^.mPreviousNode := NIL;
currentNode^.mNextNode := NIL;
currentNode^.mLengthOfString := 0;
REPEAT
READ( c );
IF NOT firstChar THEN BEGIN
IF currentNode^.mLengthOfString = kMaximumNumberOfCharactersPerStringNode
THEN BEGIN
NEW( currentNode^.mNextNode );
currentNode^.mNextNode^.mPreviousNode := currentNode;
currentNode := currentNode^.mNextNode;
currentNode^.mNextNode := NIL;
currentNode^.mLengthOfString := 0
END;
currentNode^.mLengthOfString := currentNode^.mLengthOfString + 1;
currentNode^.mString[ currentNode^.mLengthOfString ] := c
END;
firstChar := FALSE
UNTIL EOLN;
headNode := firstNode;
headIndex := 1;
tailNode := currentNode;
tailIndex := tailNode^.mLengthOfString;
vowels := [ 'a', 'e', 'i', 'o', 'u' ];
WHILE NOT fEnd DO BEGIN
IF NOT ( fToLowercase( headNode^.mString[ headIndex ] ) IN vowels ) THEN
pIncrementHeadIndex;
IF NOT ( fToLowercase( tailNode^.mString[ tailIndex ] ) IN vowels ) THEN
pDecrementTailIndex;
IF NOT fEnd THEN
IF ( fToLowercase( headNode^.mString[ headIndex ] ) IN vowels )
AND ( fToLowercase( tailNode^.mString[ tailIndex ] ) IN vowels ) THEN BEGIN
newHeadVowel := tailNode^.mString[ tailIndex ];
IF fIsLowercase( headNode^.mString[ headIndex ] ) THEN
newHeadVowel := fToLowercase( newHeadVowel )
ELSE
newHeadVowel := fToUppercase( newHeadVowel );
newTailVowel := headNode^.mString[ headIndex ];
IF fIsUppercase( tailNode^.mString[ tailIndex ] ) THEN
newTailVowel := fToUppercase( newTailVowel )
ELSE
newTailVowel := fToLowercase( newTailVowel );
headNode^.mString[ headIndex ] := newHeadVowel;
tailNode^.mString[ tailIndex ] := newTailVowel;
pIncrementHeadIndex;
pDecrementTailIndex
END
END;
WRITELN;
WRITE( 'This program''s output: ' );
currentNode := firstNode;
REPEAT
i := 1;
WHILE i <= currentNode^.mLengthOfString DO BEGIN
WRITE( currentNode^.mString[ i ] );
i := i + 1
END;
currentNode := currentNode^.mNextNode
UNTIL currentNode = NIL;
WRITELN;
RELEASE( originalHeapState )
END.
SetMode2.pas:
CP/M Plus 1.0:
PROCEDURE pChangeScreenMode;
BEGIN
END;
AmsDOS:
PROCEDURE pChangeScreenMode;
BEGIN
RA := CHR( 2 );
USER( #BC0E )
END;
OS.pas:
CP/M Plus 1.0:
FUNCTION fOSIsAMSDOS : BOOLEAN;
BEGIN
fOSIsAMSDOS := FALSE
END;
FUNCTION fOSIsCPM : BOOLEAN;
BEGIN
fOSIsCPM := TRUE
END;
AmsDOS:
FUNCTION fOSIsAMSDOS : BOOLEAN;
BEGIN
fOSIsAMSDOS := TRUE
END;
FUNCTION fOSIsCPM : BOOLEAN;
BEGIN
fOSIsCPM := FALSE
END;
Lowrcase.pas:
FUNCTION fIsLowercase( p : CHAR ) : BOOLEAN;
BEGIN
fIsLowercase := p IN [ 'a'..'z' ]
END;
FUNCTION fToLowercase( p : CHAR ) : CHAR;
VAR
i : INTEGER;
BEGIN
IF p IN [ 'A'..'Z' ] THEN BEGIN
i := ORD( p ) - ORD( 'A' );
i := i + ORD( 'a' );
p := CHR( i )
END;
fToLowercase := p
END;
Upprcase.pas:
FUNCTION fIsUppercase( p : CHAR ) : BOOLEAN;
BEGIN
fIsUppercase := p IN [ 'A'..'Z' ]
END;
FUNCTION fToUppercase( p : CHAR ) : CHAR;
VAR
i : INTEGER;
BEGIN
IF p IN [ 'a'..'z' ] THEN BEGIN
i := ORD( p ) - ORD( 'a' );
i := i + ORD( 'A' );
p := CHR( i )
END;
fToUppercase := p
END;
I like to QUICKHACK ;)
Eat LOCOMOTIVE, Programming Praxis
10 REM Reverse Vowels by SRS 05.03.2020
20 MODE 2
30 PRINT "Please enter a string; this program will then reverse the vowels in that string,":PRINT "maintaining the original capitalisation of the vowels."
40 PRINT
50 INPUT"Your String:",s$
60 FOR i=LEN(s$) TO 1 STEP -1:c$=MID$(s$,i,1):IF INSTR("aeiouAEIOU",c$) THEN rv$=rv$+c$
70 NEXT
80 FOR i=1 TO LEN(s$):c$=MID$(s$,i,1):IF INSTR("aeiou",c$) THEN rs$=rs$+LOWER$(LEFT$(rv$,1)):rv$=RIGHT$(rv$,LEN(rv$)-1):GOTO 110
90 IF INSTR("AEIOU",c$) THEN rs$=rs$+UPPER$((LEFT$(rv$,1))):rv$=RIGHT$(rv$,LEN(rv$)-1):GOTO 110
100 rs$=rs$+c$
110 NEXT
120 PRINT "My Output: ";rs$
The following is my solution to the "Fizzbuzz (http://programmingpraxis.com/2021/03/23/fizzbuzz/)" problem posed by Programming Praxis (http://programmingpraxis.com/), and is known to run on an emulated (using Arnold 1.7. 8) Amstrad CPC 6128 on both CP/M Plus 1.0 (my solution compiled using HiSoft Pascal for CP/M-80) and AMSDOS (my solution compiled using HiSoft Pascal Amstrad CPC464); as I often do when I try to solve problems posed by Project Euler (http://projecteuler.net/), I began by programming a prototype of my solution in the slower-to-execute(than the programming languages I typically program in)but-faster-to-program-in Python programming language - on this occassion, because I (correctly, as it transpires) suspected that the output (233,168, as it transpires) for the maximum input (1,000) would exceed the maximum value (32,767) able to be stored in an INTEGER in HiSoft' - the Python programming language's built-in "big integers" are very helpful for that kind of prototyping.
(I'm just trying to solve the problems posed by the aforementioned 'site whilst I try to get a job (https://london.craigslist.org/cps/7334068592.html) (and I've solved this problem in particular to try to program an error-tolerant sub-routine for getting integers from the user, for potential future projects...); I'm well-aware that my solutions are far from the best - but, in my defense, I don't have any traditional qualifications in computer science :/ )
investigation.py:
def check_type_is_int( p ):
if not isinstance( p, int ):
s = str( type( p ))
index_a = s.find( "'" )
index_b = s.rfind( "'" )
s = s[ index_a + 1 : index_b ]
if s[ 0 ].lower() not in "aeiou":
s = "a `" + s
else:
s = "an `" + s
raise TypeError( "`p` is " + s + "`, not an `int`" )
def check_value_is_not_lower_than_minimum( value, minimum ):
check_type_is_int( value )
check_type_is_int( minimum )
if value < minimum:
raise ValueError( "`value` (" + str( value ) + ") < `minimum` (" + str( minimum ) + ')' )
def fizzbuzz_sequence( limit ):
check_value_is_not_lower_than_minimum( limit, 1 )
print "The fizzbuzz sequence for the range [ 1, " + str( limit ) + " ] is:"
print
for i in xrange( 1, limit + 1 ):
s = '\t' + str( i ) + " - "
fizz_or_buzz = False
if i % 3 == 0:
s = s + "Fizz"
fizz_or_buzz = True
if i % 5 == 0:
s = s + "Buzz"
fizz_or_buzz = True
if not fizz_or_buzz:
s = s + str( i )
print s
def get_fizzbuzz_sum( limit ):
check_value_is_not_lower_than_minimum( limit, 2 )
result = 0
for i in xrange( 1, limit ):
if ( i % 3 == 0 ) or ( i % 5 == 0 ):
result += i
return result
def get_number_of_digits( p ):
check_type_is_int( p )
if p == 0:
result = 1
else:
if p < 0:
p *= -1
result = 0
while p > 0:
p /= 10
result += 1
return result
def fizzbuzz_sum( limit ):
result = get_fizzbuzz_sum( limit )
print "The sum of all of the multiples of 3 or 5 below " + str( limit ) + " is " + str( result ) + '.'
print
result = get_number_of_digits( result )
s1 = ""
s2 = "is"
if result != 1:
s1 = 's'
s2 = "are"
print str( result ) + " digit" + s1 + ' ' + s2 + " needed to store the sum of the multiples of 3 or 5 below " + str( limit ) + '.'
print
fizzbuzz_sequence( 25 )
print
fizzbuzz_sum( 10 )
print
fizzbuzz_sum( 1000 )
print
PP210323.pas:
(* Programming Praxis *)
(* "Fizzbuzz" (23rd of March, 2021) *)
PROGRAM PP210323;
LABEL
0;
CONST
kRIFUDebug = FALSE;
(*$F CONST .PAS*)
TYPE
(*$F TYPE .PAS*)
VAR
option : 0..2;
errorOccurred, anythingRead : BOOLEAN;
i : INTEGER;
limit : 0..kLimit;
(*$F TIMINGV .PAS*)
(*$F SETMODE2.PAS*)
(*$F OS .PAS*)
(*$F RIFU .PAS*)
PROCEDURE pReadNothingFromUser;
VAR
c : CHAR;
BEGIN
REPEAT
READ( c )
UNTIL EOLN
END;
(*$F SEQUENCE.PAS*)
(*$F TIMINGS .PAS*)
(*$F SUM .PAS*)
BEGIN
pChangeScreenMode;
IF fOSIsCPM THEN
WRITELN;
0:option := 0;
REPEAT
WRITELN( 'Please enter whether you want to...' );
WRITELN( ' 1. enumerate the fizzbuzz sequence' );
WRITELN( ' 2. sum all of the multiples of 3 or 5' );
WRITELN( '...below a given number, and press the Return key.' );
WRITELN;
WRITE( '(Or enter nothing and press the Return key to exit this program.)' );
WRITELN;
WRITELN;
WRITE( 'Your input: ' );
pReadIntegerFromUser( errorOccurred, anythingRead, i );
IF anythingRead THEN BEGIN
IF NOT errorOccurred THEN
errorOccurred := ( i < 1 ) OR ( i > 2 );
IF NOT errorOccurred THEN
option := i
ELSE BEGIN
WRITELN;
WRITELN( 'Sorry, an error occurred: your input was neither 1 nor 2.' );
WRITELN;
WRITE( 'Please press the Return key to try again.' );
pReadNothingFromUser;
WRITELN
END
END
UNTIL NOT errorOccurred;
IF option <> 0 THEN
REPEAT
WRITELN;
WRITE( 'Please enter an integer in the range ( 1, 1000 ] and press the ' );
WRITE( 'Return key; this program will then ' );
CASE option OF
1:WRITE( 'enumerate the fizzbuzz sequence' );
2:WRITE( 'sum all of the multiples of 3 or 5' )
END;
WRITELN( ' below that integer.' );
WRITELN;
WRITE( '(Or enter nothing and press the Return key to return to the ' );
WRITELN( 'previous option.)' );
WRITELN;
WRITE( 'Your input: ' );
pReadIntegerFromUser( errorOccurred, anythingRead, i );
IF anythingRead THEN BEGIN
IF NOT errorOccurred THEN
errorOccurred := ( i <= 1 ) OR ( i > 1000 );
IF NOT errorOccurred THEN
limit := i
ELSE BEGIN
WRITELN;
WRITE( 'Sorry, an error occurred: your input was not an integer in ' );
WRITELN( 'the range ( 1, ' );
WRITELN( '1000 ].' );
WRITELN;
WRITE( 'Please press the Return key to try again.' );
pReadNothingFromUser
END
END
ELSE
BEGIN
WRITELN;
GOTO 0
END
UNTIL NOT errorOccurred;
IF option <> 0 THEN BEGIN
WRITELN;
CASE option OF
1:pSequence( limit - 1 );
2:BEGIN
pStartTiming;
pSum( limit );
pStopTiming;
IF fOSIsAMSDOS THEN BEGIN
WRITELN;
WRITE( 'To sum all of the multiples of 3 or 5 below ', limit:0, ' ' );
WRITE( 'took ', fSeconds:0, ' second' );
IF fSeconds <> 1 THEN
WRITE( 's' );
WRITELN( '.' )
END
END
END
END
END.
const.pas:
kLimit = 1000;
kLimitPlusOne = 1001;
type.pas:
tLimit = 1..kLimit;
tLimitPlusOne = 1..kLimitPlusOne;
RIFU.pas:
PROCEDURE pReadIntegerFromUser( VAR pErrorOccurred, pAnythingRead : BOOLEAN;
VAR pInteger : INTEGER );
TYPE
tDigit = 0..9;
tCharSet = SET OF CHAR;
VAR
digits : ARRAY [ 1..5 ] OF tDigit;
sign : CHAR;
PROCEDURE pLeftShiftArrayOfDigits;
VAR
i : 1..5;
BEGIN
FOR i := 5 DOWNTO 2 DO
digits[ i ] := digits[ i - 1 ];
digits[ 1 ] := 0
END;
FUNCTION fOutOfRange( pSign : tCharSet; pDigitAtIndex1 : tDigit ) : BOOLEAN;
LABEL
0;
VAR
result : BOOLEAN;
range : ARRAY [ 1..5 ] OF tDigit;
i : 0..5;
BEGIN
result := FALSE;
IF sign IN pSign THEN BEGIN
range[ 5 ] := 3;
range[ 4 ] := 2;
range[ 3 ] := 7;
range[ 2 ] := 6;
range[ 1 ] := pDigitAtIndex1;
FOR i := 5 DOWNTO 1 DO
IF digits[ i ] < range[ i ] THEN
GOTO 0
ELSE
IF digits[ i ] > range[ i ] THEN BEGIN
result := TRUE;
GOTO 0
END
END;
0:fOutOfRange := result
END;
FUNCTION fTooLow : BOOLEAN;
BEGIN
fTooLow := fOutOfRange( [ '-' ], 8 )
END;
FUNCTION fTooHigh : BOOLEAN;
BEGIN
fTooHigh := fOutOfRange( [ ' ', '+' ], 7 )
END;
FUNCTION fArrayOfDigitsToInteger : INTEGER;
VAR
result : INTEGER;
multiplier : 1..10000;
i : 1..6;
intermediate : INTEGER;
BEGIN
result := 0;
multiplier := 1;
FOR i := 1 TO 5 DO BEGIN
IF i <> 1 THEN
multiplier := multiplier * 10;
intermediate := digits[ i ] * multiplier;
IF sign = '-' THEN
intermediate := intermediate * ( -1 );
result := result + intermediate
END;
fArrayOfDigitsToInteger := result
END;
PROCEDURE pInner;
LABEL
0, 1;
VAR
c : CHAR;
validChar, anyDigitEncountered : BOOLEAN;
numberOfDigits : 0..5;
i : 1..6;
endOfLine, firstChar, blankLineWritten : BOOLEAN;
FUNCTION fSign : BOOLEAN;
VAR
result : BOOLEAN;
BEGIN
result := TRUE;
IF c IN [ '+', '-' ] THEN BEGIN
validChar := TRUE;
IF sign <> ' ' THEN BEGIN
result := FALSE;
IF kRIFUDebug THEN
WRITELN( 'fSign - sign <> '' ''' )
END
ELSE
IF anyDigitEncountered THEN BEGIN
result := FALSE;
IF kRIFUDebug THEN
WRITELN( 'fSign - anyDigitEncountered = TRUE' )
END
ELSE
sign := c
END;
fSign := result
END;
FUNCTION fDigit0 : BOOLEAN;
VAR
result : BOOLEAN;
BEGIN
result := TRUE;
IF c = '0' THEN BEGIN
validChar := TRUE;
anyDigitEncountered := TRUE;
IF numberOfDigits > 0 THEN
IF numberOfDigits = 5 THEN BEGIN
result := FALSE;
IF kRIFUDebug THEN
WRITELN( 'fDigit0 - numberOfDigits > 5' )
END
ELSE
BEGIN
pLeftShiftArrayOfDigits;
digits[ 1 ] := 0;
numberOfDigits := numberOfDigits + 1
END
END;
fDigit0 := result
END;
FUNCTION fDigits1To9 : BOOLEAN;
VAR
result : BOOLEAN;
BEGIN
result := TRUE;
IF c IN [ '1'..'9' ] THEN BEGIN
validChar := TRUE;
anyDigitEncountered := TRUE;
IF numberOfDigits = 5 THEN BEGIN
result := FALSE;
IF kRIFUDebug THEN
WRITELN( 'fDigits1To9 - numberOfDigits > 5' )
END
ELSE
BEGIN
IF numberOfDigits > 0 THEN
pLeftShiftArrayOfDigits;
digits[ 1 ] := ORD( c ) - ORD( '0' );
numberOfDigits := numberOfDigits + 1
END
END;
fDigits1To9 := result
END;
BEGIN
pErrorOccurred := FALSE;
pAnythingRead := FALSE;
FOR i := 1 TO 5 DO
digits[ i ] := 0;
sign := ' ';
anyDigitEncountered := FALSE;
numberOfDigits := 0;
firstChar := TRUE;
blankLineWritten := FALSE;
REPEAT
READ( c );
endOfLine := EOLN;
IF NOT firstChar THEN BEGIN
pAnythingRead := TRUE;
IF kRIFUDebug THEN BEGIN
IF NOT blankLineWritten THEN BEGIN
WRITELN;
blankLineWritten := TRUE
END;
WRITELN( 'pInner - c = ''', c, '''' )
END;
validChar := FALSE;
IF NOT fSign THEN
GOTO 0;
IF NOT fDigit0 THEN
GOTO 0;
IF NOT fDigits1To9 THEN
GOTO 0;
IF NOT validChar THEN BEGIN
IF kRIFUDebug THEN
WRITELN( 'pInner - validChar = FALSE' );
GOTO 0
END
END;
firstChar := FALSE
UNTIL endOfLine;
IF pAnythingRead AND NOT anyDigitEncountered THEN BEGIN
IF kRIFUDebug THEN
WRITELN( 'pInner - pAnythingRead = TRUE AND anyDigitEncountered = FALSE' );
GOTO 0
END;
IF fTooLow THEN BEGIN
IF kRIFUDebug THEN
WRITELN( 'pInner - fTooLow = TRUE' );
GOTO 0
END;
IF fTooHigh THEN BEGIN
IF kRIFUDebug THEN
WRITELN( 'pInner - fTooHigh = TRUE' );
GOTO 0
END;
GOTO 1;
0:pErrorOccurred := TRUE;
IF NOT endOfLine THEN
REPEAT
READ( c );
IF kRIFUDebug THEN
WRITELN( 'pInner - (discarding) c = ''', c, '''' )
UNTIL EOLN;
1:IF NOT pErrorOccurred THEN
pInteger := fArrayOfDigitsToInteger
END;
BEGIN
pInner
END;
Sequence.pas:
PROCEDURE pSequence( limit : tLimit );
VAR
i : tLimitPlusOne;
fizzOrBuzz : BOOLEAN;
BEGIN
WRITE( 'The fizzbuzz sequence for the range [ 1, ', limit:0, ' ] is: ' );
FOR i := 1 TO limit DO BEGIN
IF i > 1 THEN
WRITE( ', ' );
fizzOrBuzz := FALSE;
IF i MOD 3 = 0 THEN BEGIN
WRITE( 'Fizz' );
fizzOrBuzz := TRUE
END;
IF i MOD 5 = 0 THEN BEGIN
WRITE( 'Buzz' );
fizzOrBuzz := TRUE
END;
IF NOT fizzOrBuzz THEN
WRITE( i:0 )
END;
WRITELN( '.' )
END;
TimingV.pas (CP/M):
TimingV.pas (AMSDOS):
seconds : 0..MAXINT;
TimingS.pas (CP/M):
PROCEDURE pStartTiming;
BEGIN
END;
FUNCTION fSeconds : INTEGER;
BEGIN
fSeconds := -1
END;
PROCEDURE pStopTiming;
BEGIN
END;
TimingS.pas (AMSDOS):
PROCEDURE pTimedMessage;
VAR
ignored : INTEGER;
BEGIN
WRITELN( 'Please wait...' );
WRITELN;
ignored := REMAIN( 2 )
END;
PROCEDURE pIncrementSeconds;
BEGIN
seconds := seconds + 1
END;
PROCEDURE pStartTiming;
BEGIN
AFTER( 5 * 50, 2, pTimedMessage );
seconds := 0;
EVERY( 50, 3, pIncrementSeconds )
END;
FUNCTION fSeconds : INTEGER;
BEGIN
fSeconds := seconds
END;
PROCEDURE pStopTiming;
VAR
ignored : INTEGER;
BEGIN
ignored := REMAIN( 2 );
ignored := REMAIN( 3 )
END;
Sum.pas:
PROCEDURE pSum( limit : tLimit );
CONST
kMaximumIndex = 6;
TYPE
tZeroOrPositiveInteger = 0..MAXINT;
tIndex = 1..6;
VAR
digits : ARRAY [ 1..6 ] OF 0..18;
i : 1..7;
k : tLimit;
digitWritten : BOOLEAN;
PROCEDURE (* Increase *) pOuter( p : tZeroOrPositiveInteger );
VAR
index : 0..kMaximumIndex;
digit : 0..9;
PROCEDURE (* Increase *) pInner( p : tIndex );
BEGIN
IF digits[ p ] >= 10 THEN BEGIN
digits[ p ] := digits[ p ] MOD 10;
digits[ p - 1 ] := digits[ p - 1 ] + 1;
pInner( p - 1 )
END
END;
BEGIN
index := kMaximumIndex;
WHILE p > 0 DO BEGIN
digit := p MOD 10;
p := p DIV 10;
digits[ index ] := digits[ index ] + digit;
pInner( index );
index := index - 1
END
END;
BEGIN
FOR i := 1 TO kMaximumIndex DO
digits[ i ] := 0;
FOR k := 1 TO limit - 1 DO
IF ( k MOD 3 = 0 ) OR ( k MOD 5 = 0 ) THEN
pOuter( k );
WRITE( 'The sum of all of the multiples of 3 or 5 below ', limit:0, ' is ' );
digitWritten := FALSE;
FOR i := 1 TO kMaximumIndex - 1 DO
IF ( digits[ i ] <> 0 ) OR digitWritten THEN BEGIN
WRITE( digits[ i ]:0 );
digitWritten := TRUE
END;
WRITELN( digits[ kMaximumIndex ]:0, '.' )
END;