Thursday, May 7, 2020

LINKECHO.P

[Table of Contents]
LINKECHO.ATR Disk Image

LINKECHO.P is a simple Linked List example program. A Linked List is an abstract data structure that can grow or shrink as needed.

Here, the Linked List data structure is created as well as few pointers to it.

Next, the user can enter some numbers with a new Linked List node or element added to the list to hold each entered number.

Once the user is done entering numbers, the list is traversed and the numbers are printed out.

In this example, the Linked List holds a integer value as its payload, but it can be easily modified to carry data for a monster, a spacecraft, dungeon room data, etc.

Source Code


(* LINKECHO.P *)

program LinkEcho(intput,output);

type
   ElementPointer = ^Element;

   Element = record
                Number : Integer;
                Next : ElementPointer;
             end;

var
   FirstElement : ElementPointer;
   CurrentElement : ElementPointer;
   Number : Integer;

(* Main Program *)
begin

   write(chr(125));

   (* Initialize the list and its pointers. *)
   new(FirstElement);
   FirstElement^.Next := Nil;
   CurrentElement := FirstElement;

   (* Fill the linked list *)
   repeat
      write('Enter number or 0 to exit:');
      read(Number);
      writeln;

      if Number > 0 then
      begin

         (* Add each number to the list, then add an element. *)
         CurrentElement^.Number := Number;
         new(CurrentElement^.Next);
         CurrentElement := CurrentElement^.Next;
         CurrentElement^.Next := Nil;

      end;
   until Number <= 0;

   (* Write the linked list back out *)
   if CurrentElement<>FirstElement then
   begin
      CurrentElement:=FirstElement;
      while CurrentElement^.Next <> Nil do
      begin
         writeln(CurrentElement^.Number);
         CurrentElement:= CurrentElement^.Next
      end (* while loop *)
   end; (* if *)
end. (* LinkEcho *)

Sample Run





Wednesday, May 6, 2020

LIFE.P

[Table of Contents]
LIFE.ATR Disk Image



LIFE.P is from the Apple Pascal Games by Douglas Hergert and Joseph T. Kalash published by Sybex. It is a Pascal implementation of John Conway's Game of Life of cellular automaton. I modify it slightly to get it working with in Kyan Pascal 2.x on the Atari 8-bit.

When entering the starting configuration, enter data as "Y[space]X". Don't use commas between the numbers as you will get a runtime error. To stop entering cells, enter something outside the range such as "-9[space]-9".

Not sure why the program was designed to enter data as Y,X instead of X,Y.

The program could be updated to change the Y,X format to X,Y. It could also be updated to give an option of generating a random or manual entry starting configuration.

It could also be updated to use one of the bit-mapped graphics modes, such as Graphics Mode 3. Note that increasing the data structure from anything more than the current 24 x 40 will likely significantly slow down the program's execution.

Press (or tap) any key to exit.

Source Code


(* LIFE.P *)
(* From the book 'Apple Pascal Games'             *)
(* Modified for Kyan Pascal 2.x on the Atari 8-bit *)

program LIFE(input,output);

const
   height = 24; (* Number of lines on screen *)
   width = 40; (* Number of columns on screen *)
   minbound = -1; (*Minimum dimension of screen bounds *)
   clearscreen = 125; (* ATASCII Clear Screen Character *)

type
   state = (Alive, Dead);

   cell = record               (* Each position has a state     *)
             LooksLikeItIs : state;
             nearby : integer; (* and a count of the number     *)
          end;                 (* of adjacent living cells      *)
   edges = record              (* The edges of a colony are the *)
              left,            (* coordinates of a square that  *)
              right,           (* would contain the pattern     *)
              top,
              bottom : integer;
           end;

var
   board : array [minbound..height] of array [minbound..width] of cell; 

   population, births, deaths : integer;
   ch : char;       (* Buffer for character that user may *)
   edge : edges;    (* type to 'interrupt' the cycle      *)

#i peekpoke.i
#i cursor.i
#i position.i

function keypress : boolean;
var
   k : integer;
begin
   keypress := false;
   k := peek(764);
   if k <> 255 then
   begin
      poke(764,255);
      keypress := true;
   end;
end;

(*
 * Initializes the edges of the pattern. This starts representing
 * a pattern which has no insides; the top is lower than the bottom,
 * the left side is to the right of the right side. This ensures
 * that the coordinates of the corner of the pattern after it
 * is entered will be correct without needing to scan the entire
 * array after the pattern is entered (a time-consuming process).
 *)

procedure ResetEdges;
begin
   edge.top := height-1;
   edge.right := minbound+1;
   edge.left := width-1;
   edge.bottom := minbound+1;
end;

procedure instructions;
var
   answer : char;
begin
   write(chr(clearscreen));
   write('Would you like instructions for Life? ');
   readln(answer);
   while not (answer in ['Y', 'N']) do
   begin
      writeln('Please answer Yes or No.');
      write('? ');
      readln(answer);
   end;
   if answer = 'Y' then
   begin
      writeln('Life simulates the growth of a colony');
      writeln('of animals on a 0..',height-1:1,' by 0..',width-1:1,' ''world''.');
      writeln('Whether a cell is born, lives, or');
      writeln('dies depends on the number of living');
      writeln('animals immediately adjacent to it.');
      writeln('If a cell is empty and has exactly 3');
      writeln('neighbors it will be born in the');
      writeln('next generation. If it is alive and');
      writeln('has either two or three neighbors it');
      writeln('will continue to live. Otherwise it');
      writeln('dies of loneliness or overcrowding.');
      writeln('   The initial pattern is entered by');
      writeln('typing the row and then the column of');
      writeln('the desired position. A cell is removed');
      writeln('by entering its position again. To');
      writeln('finish entering give a position ');
      writeln('outside of the dimensions of the screen.');
      writeln('To stop a pattern just hit any key.');

      writeln('Type <RETURN> to start: ');
      readln;
   end;
   write(chr(clearscreen));
end;

(*
 * Initialize : Resets the board to empty ( all dead and
 * with no neighbors.)
 *)

procedure initialize;
var
   down, across : integer;
begin
   
   instructions;
   for down := minbound to height do
      for across := minbound to width do
      begin
         board[down,across].LooksLikeItIs := Dead;
         board[down,across].nearby := 0;
      end;
   ResetEdges;
end; (* initialize *)

(*
 * Max (& Min) : Returns the larger (smaller) of the two
 * integer arguments
 *) 

function max(a,b:integer):integer;
begin
   if a >= b then
      max := a
   else
      max := b
end;

function min(a,b:integer):integer;
begin
   if a <= b then
      min := a
   else
      min := b
end;

(* Determine if a n how the co-ordinates passed as argument
 * change the bounds of the pattern ( the position of a box that
 * could contain the living cells), checking that it does not
 * go off one of the sides of the board.
 *)

procedure limits(x,y:integer);
begin
   with edge do
   begin
      left := min(left,x);
      right := max(right, x);
      top := min(top,y);
      bottom := max(bottom,y);
   end;
end;

(*
 * This erases the record of the neighbors
 * of all the cells, in preparation for the
 * new calculation of the nearby field
 *)

procedure clearnearby;
var
   down, across : integer;
begin
   for down := edge.top-1 to edge.bottom+1 do
      for across := edge.left-1 to edge.right+1 do
         board[down][across].nearby := 0;
end; (* clearnearby *)

(*
 * Computes the number of adjacent cells, and thus
 * which cells will survive through the next generation.
 * To speed this up, the middle cell of the 3 by 3 matrix 
 * which is being examined is included in the count, event though
 * it is not really a neighbor of itself. This off-by-one
 * discrepancy is taken into account in the board update.
 *)

procedure countneighbors;
var
   down, across : integer;
   deltadown, deltaacross : integer;
begin
   clearnearby;
   for down := edge.top-1 to edge.bottom+1 do 
      for across := edge.left-1 to edge.right+1 do
         if board[down][across].LooksLikeItIs = Alive then
            for deltadown := -1 to 1 do
               for deltaacross := -1 to 1 do
                  board[down+deltadown][across+deltaacross].nearby :=
                  board[down+deltadown][across+deltaacross].nearby + 1;
end; (* CountNeighbors *)

(*
 * Update
 * If a birth or death occurs the screen is updated.
 *)

procedure update;
var
   down, across : integer;
   localedge : edges;
begin
   births := 0;
   deaths := 0;
   localedge := edge;
   resetedges;

   for down := max(minbound + 1, localedge.top -1) to
               min(height -1, localedge.bottom + 1) do
      for across := max(minbound+1,localedge.left-1) to 
                    min(width-1,localedge.right+1) do
         with board[down][across] do
            case LooksLikeItIs of
             dead:
              if nearby = 3 then 
              begin
                 LooksLikeItIs := Alive;
                 Position(Across,Down);
                 write('*');
                 Limits(Across,Down);
                 Births := Births + 1;
              end;
             Alive:
              if (nearby=3) or (nearby=4) then
                 Limits(Across,Down)
              else
              begin
                 LooksLikeItIs := Dead;
                 Position(Across,Down);
                 Write(' ');
                 Deaths := Deaths + 1;
              end;
            end; (* Case *)
   Population := Population + Births - Deaths;
end; (* Update *)

(*
 * Get the starting positions of the cells
 *)

procedure GetPositions;
var
   down, across : integer;
   finished : boolean;

   (*
    * This is needed to reprint the top line of the pattern, which
    * is destroyed by the prompt line which asks for the cell positions
    *)

   procedure ReprintTopLine;
   var
      across : integer;
   begin
      Position(0,0);
      For across := minbound +1 to width -1 do
         if board[minbound + 1][across].LooksLikeItIs = Dead then
            write(' ')
         else
            write('*');
   end; (* ReprintTopLine *)

begin
   finished := false;
   Population := 0;
   Position(0,0);
   write('Position of cell #',Population+1:1, ' is :');
   while not Finished do
   begin
      readln(Down, Across);
      if (Down <= MinBound) or        (* Finish entering the pattern by *)
         (Down >= Height) or          (* specifying a number which is   *)
         (Across <= MinBound) or      (* not in the pattern             *)
         (Across >= Width) then
         Finished := True
      Else With Board[Down][Across] do
      begin
         Limits(Across,Down);
         Position(Across,Down);
         if LooksLikeItIs = Alive then (* Already something there *)
         begin                         (* so remove it            *)
            write(' ');
            LooksLikeItIs := Dead;
            Population := Population - 1;
         end
         else                          (* Add a new cell          *)
         begin
            write('*');
            LooksLikeItIs := Alive;
            Population := Population+1;
         end;

         Position(0,0);
         write('Position of Cell #', Population +1:1, ' is :');
      end;
   end; (* While Continuing To Read Positions *)
   ReprintTopLine;
end; (* GetPositions *)

(* Main Program *)
begin
   disable_cursor;
   initialize;
   GetPositions;
   Repeat
      CountNeighbors;
      Update;
   Until (Population = 0) or
      ((Births = 0) and (Deaths = 0)) or
      keypress = TRUE;

   Position(0,0);

   if Population = 0 then 
      Writeln('This colony has died.')
   else
      Write('The Pattern is stable');
   enable_cursor;
end. (* Life *)


Sample Run




Monday, May 4, 2020

INKEY.P

[Table of Contents]
INKEY.ATR Disk Image

INKEY.P is an example of reading user's key presses in a non-blocking fashion. This example handles (A)ttack, and (Q)uit. The keyboard code for any other pressed character will be displayed.

INKEY.P uses a PEEKPOKE.I include file to be able to POKE to and PEEK from memory locations.

INKEY.P peeks at Atari's internal hardware value for the last key pressed, (memory location 764). See page 76 of Mapping The Atari Revised Edition for more information on this memory location. Memory location 764 returns 255 if no key has been pressed or a raw keyboard matrix code if a key has been pressed. To decipher the raw keyboard matrix code, see page 50 of the Atari 400/800 Operating System User's Manual (you will need to convert from hex to decimal as well) or you can just experiment to figure out which codes go to which key press.  

This example program uses a CASE statement. Note that there is a feature (restriction) in ISO Pascal (and Kyan Pascal as a result) that you must handle every possible case in a CASE statement or you will get a runtime error for any non-handled cases. Here are a few things you can try to avoid this restriction:

  • Remove the CASE statement and use IF/THEN statements
  • Use an IF/THEN statement before the CASE statement to only allow handles cases to pass

Source Code


(* INKEY.P *)
(* KYAN PASCAL 2.X *)
(* ATARI 8-BIT *)
(* Bill Lange *)

program INKEY(INPUT,OUTPUT);
var
   CONTINUE : BOOLEAN;
   K : INTEGER;

#i PEEKPOKE.I

procedure Attack;
begin
   writeln('Attack');
end;

procedure Quit;
begin
   writeln('Quit');
   Continue := False;
end;

procedure GetCommand;
begin  
   K := PEEK(764);
   if K <> 255 then
   begin
      poke(764,255);
      write('(',k,') ');
      if (k=63) or (k=47) then
      begin
      case K of
        63 : Attack; (* a *)
        47 : Quit; (* q *)
      end;
      end;
   end;
end;

(* Main Program *)
begin

   CONTINUE := TRUE;

   while CONTINUE = TRUE do
   begin
      GetCommand;
      (* Do other stuff *)
   end;   
end.



PEEKPOKE.I

[Table of Contents]
PEEKPOKE.ATR Disk Image

Here is a PEEKPOKE.I include file that you can use in your programs. The POKE procedure and the PEEK function come from the Kyan Pascal 2.x User's Manual for the Atari 8-bit.

  • Procedure POKE(Address, Value)
  • Function PEEK(Address)

Kyan Pascal 2.x only supports up to a two-byte signed integers (-32,768 to 32,767). If the address that you want to peek or poke lies out side that range, you will need to use a Two’s Complement conversion to reach that address. For example, the address 57344:

  • Take the number: 57344
  • Convert the Decimal to Binary: 1110000000000000
  • Moving from RIGHT to LEFT, flip every bit AFTER the first 1: 0010000000000000
  • Convert the Binary to Decimal: 8192
  • Use the negated value: -8192

Source Code


(* PEEKPOKE.I *)
(* Kyan Pascal / Atari 8-bit *)

PROCEDURE Poke(Loc, Val: Integer);

Begin
#a
   LDY #7       ; Offset from _SP to Loc;
   LDA (_SP),Y  ; Get LSB of Loc;
   STA _T       ; Save LSB of loc;
   INY
   LDA (_SP),Y  ; Get MSB of Loc;
   STA _T+1     ; Save MSB of Loc;
   LDY #5       ; Offset from _SP to Val;
   LDA (_SP),Y  ; Load Val into Accumulator;
   LDY #0       ; Clear Y register;
   STA (_T),Y   ; Store the value in the accumulator
                ; in memory location _T;
#
End;

Function Peek(Loc: Integer) : Integer;
Begin
   Peek := 0;

#a
   LDY #7       ; Offset to Loc;
   LDA (_SP),Y  ; Get LSB of Loc;
   STA _T       ; Save LSB of Loc in workspace;
   INY
   LDA (_SP),Y  ; Get MSB of Loc;
   STA _T+1;    ; Save MSB of Loc in workspace;
   LDY #0;      ; Clear Y register;
   LDA (_T),Y   ; Load accumulator with the
                ; Address being Peeked;
   LDY #5       ; Offset to Function Identifier
   STA (_SP),Y  ; Store contents of the accumulator
                ; in LSB of Function Identifier
   INY
   LDA #0       ; Load Accumulator with 0 for MSB
                ; of return integer
   STA (_SP),Y  ; Store contents of accumulator;
                ; in MSB of Function Identifer;
#
End;

Sunday, May 3, 2020

LOADDEMO.P

[Table of Contents]

LOADDEMO.P is a demo program from the Kyan Pascal 2.x Utility Disk 2.


Source Code


PROGRAM LOADDEMO(INPUT,OUTPUT);
   TYPE
       PATHSTRING=ARRAY[1..20] OF CHAR;
   VAR
       FYLE:PATHSTRING;
       ADR :INTEGER;
#I LOADCSET.I
#I ACTCSET.I
   BEGIN
       WRITELN('THE NEW CHR SET HAS A REDEFINED @ KEY');
       FYLE:='SET.SET             ';
       LOAD_CHAR_SET(FYLE,ADR);
       WRITELN('LOADDED AT ',ADR);
       ACTIVATE_CHAR_SET(ADR);
END.


COPYDEMO.P

[Table of Contents]

COPYDEMO.P is a demo program from the Kyan Pascal 2.x Utilities Disk 2.

Source Code


program copydemo(input,output);
    type
       pathstring=array[1..20] of char;
    var
       from,till:pathstring;
       r:integer;
#i adddev.i
#i copy.i
    begin
       from:='source              ';
       till:='d1:dest             ';
       r:=copy(from,till);
       writeln(r);
end.

MERGED.P

[Table of Contents]

MERGED.P  is a demo program from the Kyan Pascal 2.x Utilities Disk 2.


Source Code


PROGRAM MERGE_DEMO;

(* THIS PROGRAM DEMONSTRATES
   SYSTEM UTILITIES MERGE
   ROUTINE.

   COPYRIGHT (C) 1986
   KYAN SOFTWARE, INC.  *)


TYPE
#I SRTMERGT.I

VAR
#I SRTMERGV.I
CH:CHAR;

#I MERGE.I

BEGIN
   WRITELN('*** MERGE ROUTINE DEMO ***');
   WRITELN;
   WRITELN('THE MERGE ROUTINE TAKES ORDERED FILES');
   WRITELN('AND MERGES THEM INTO 1 LARGE FILE.');
   WRITELN('ALTHOUGH IT IS PRIMARILY USED IN');
   WRITELN('CONJUNCTION WITH ESORT, YOU CAN USE');
   WRITELN('MERGE AS A STAND ALONE UTILITY...');
   WRITELN;
   WRITELN('IN ORDER TO USE THIS DEMO');
   WRITELN('CORRECTLY, IT MUST BE ABLE');
   WRITELN('TO FIND FILES "MERGE.12,"');
   WRITELN('MERGE.32 AND "MERGE.22" IN THE');
   WRITELN('CURRENT DIRECTORY.');
   WRITE('IS IT OK TO PROCEED? (Y/N)');
   READLN(CH);
   IF CH='Y' THEN
   BEGIN
      WRITELN('MERGING.....');
      MERGENAME[1]:=
   'MERGE.12            ';
   MERGENAME[2]:=
   'MERGE.22            ';
   MERGENAME[3]:=
   'MERGE.32            ';
   MERGENAME[6]:=
   'DESTFILE            ';
   MERGENAME[7]:=
   'FINALFIL.E          ';
   MERGE(MERGENAME,7,3,7,5,0,-1,ALPHA_FIELD);
   WRITELN('USE "ED" TO SEE THE RESULTS IN');
   WRITELN('FILE "FINALFIL.E".')
  END
END.