Showing posts with label Poke. Show all posts
Showing posts with label Poke. Show all posts

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, April 12, 2020

CHNGCOLR.P

[Table of Contents]
CHNGCOLR.P Disk Image

Notes


CHNGCOLR.P is from the Pointers / Using Special Memory Locations section of the Kyan Pascal 2.x User's Manual.

As written, the program runs so fast you can just about see the screen flicker. You could put in a second loop to slow it down.

I fixed a bug in the second to the last line, changing Color^:= Orig to Color^:=Orig^.

I changed the pointers from Integers pointers to Char pointers so that it would work with single byte variables rather than two byte variables.

If you want to display the value in the memory location, you can use the Ord() function, for example, Writeln(Ord(Color^)).

What's on the disk?


The disk image includes the various Atari DOS 2.5 files, Kyan Pascal Include files (none of which are used in this program), Kyan Pascal Run-time library, and ...

CHNGCOLR.P - Source code file
P.OUT - Kyan Pascal intermediate file
CHNGCOLOR - Executable file

Source Code


(* CHNGCOLR.P *)
(* Kyan Pascal 2.x / Atari 8-bit *)

Program CHNGCOLR(Input, Output);
(* Cycle through screen background colors *)

Var
   Color, Orig : ^Char;

Procedure Cycle;
Var
   Loop : Char;

Begin
   For Loop := 0 To 255 Do
      Color^ := Loop
End;

Begin
   Color := Pointer(710);
   Orig^ := Color^;
   Cycle;
   Color^ := Orig^;
End

Sample Run

Screen colors briefly flicker.