Author Topic: A little Pascal programming…  (Read 1343 times)

0 Members and 1 Guest are viewing this topic.

Offline the graveborn

  • CPC464
  • **
  • Posts: 16
  • Country: gb
    • the graveborn
  • Liked: 7
  • Likes Given: 10
A little Pascal programming…
« on: 19:32, 01 July 19 »
The following is my solution to the second sub-problem of the "Three Homework Problems" problem posed by Programming Praxis; I'm just trying to solve the problems posed by the aforementioned 'site whilst I try to get a job - 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:

Code: [Select]
(* 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.

Offline AMSDOS

  • Supporter
  • 6128 Plus
  • *
  • Posts: 3.939
  • Country: au
    • index.php?action=treasury
    • Programs for Turbo Pascal 3
  • Liked: 1157
  • Likes Given: 1924
Re: A little Pascal programming…
« Reply #1 on: 12:56, 02 July 19 »
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.
* Using the old Amstrad Languages :D   * with the Firmware :P
* I also like to problem solve code in BASIC :)   * And type-in Type-Ins! :D

Home Computing Weekly Programs
Popular Computing Weekly Programs
Your Computer Programs
Updated Other Program Links on Profile Page (Update April 16/15 phew!)
Programs for Turbo Pascal 3

Offline SRS

  • Supporter
  • 6128 Plus
  • *
  • Posts: 628
  • Country: de
  • Schneider CPC464 - what else ?
  • Liked: 627
  • Likes Given: 366
Re: A little Pascal programming…
« Reply #2 on: 23:17, 03 July 19 »
Nice :)
Just made me quickhack it in good ol' loco:
Code: [Select]
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

Offline the graveborn

  • CPC464
  • **
  • Posts: 16
  • Country: gb
    • the graveborn
  • Liked: 7
  • Likes Given: 10
Re: A little Pascal programming…
« Reply #3 on: 11:14, 26 July 19 »
@AMSDOS 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 for reference.)

PoC.pas:

Code: [Select]
(*$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.
« Last Edit: 11:27, 26 July 19 by the graveborn »

Offline zhulien

  • 6128 Plus
  • ******
  • Posts: 598
  • Country: au
    • 8bitology
  • Liked: 250
  • Likes Given: 213
Re: A little Pascal programming…
« Reply #4 on: 16:56, 26 July 19 »
Nice :)
Just made me quickhack it in good ol' loco:
Code: [Select]
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.

Offline AMSDOS

  • Supporter
  • 6128 Plus
  • *
  • Posts: 3.939
  • Country: au
    • index.php?action=treasury
    • Programs for Turbo Pascal 3
  • Liked: 1157
  • Likes Given: 1924
Re: A little Pascal programming…
« Reply #5 on: 01:17, 27 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 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.  :'(
* Using the old Amstrad Languages :D   * with the Firmware :P
* I also like to problem solve code in BASIC :)   * And type-in Type-Ins! :D

Home Computing Weekly Programs
Popular Computing Weekly Programs
Your Computer Programs
Updated Other Program Links on Profile Page (Update April 16/15 phew!)
Programs for Turbo Pascal 3

Offline the graveborn

  • CPC464
  • **
  • Posts: 16
  • Country: gb
    • the graveborn
  • Liked: 7
  • Likes Given: 10
Re: A little Pascal programming…
« Reply #6 on: 16:50, 05 March 20 »
The following is my solution to the "Reverse Vowels" problem posed by Programming Praxis, 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 fileGenerates compile-time error
<Filename>.pasYes
<Filename>.PASYes
<FILENAME>.pasNo
<FILENAME>.PASNo

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

Code: [Select]
(* 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:

Spoiler: ShowHide

CP/M Plus 1.0:

Code: [Select]
PROCEDURE pChangeScreenMode;
BEGIN
END;

AmsDOS:

Code: [Select]
PROCEDURE pChangeScreenMode;
BEGIN
 RA := CHR( 2 );
 USER( #BC0E )
END;


OS.pas:

Spoiler: ShowHide

CP/M Plus 1.0:

Code: [Select]
FUNCTION fOSIsAMSDOS : BOOLEAN;
BEGIN
 fOSIsAMSDOS := FALSE
END;

FUNCTION fOSIsCPM : BOOLEAN;
BEGIN
 fOSIsCPM := TRUE
END;

AmsDOS:

Code: [Select]
FUNCTION fOSIsAMSDOS : BOOLEAN;
BEGIN
 fOSIsAMSDOS := TRUE
END;

FUNCTION fOSIsCPM : BOOLEAN;
BEGIN
 fOSIsCPM := FALSE
END;


Lowrcase.pas:

Spoiler: ShowHide

Code: [Select]
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:

Spoiler: ShowHide

Code: [Select]
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;

Offline SRS

  • Supporter
  • 6128 Plus
  • *
  • Posts: 628
  • Country: de
  • Schneider CPC464 - what else ?
  • Liked: 627
  • Likes Given: 366
Re: A little Pascal programming…
« Reply #7 on: 23:21, 05 March 20 »
I like to QUICKHACK ;)
Eat LOCOMOTIVE, Programming Praxis
Code: [Select]
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$