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 *)
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 *)
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.
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:
(* 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;
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.
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.
(* 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.
PROGRAM PARSE_DEMO; (* INPUT BUFFER PARSE ROUTINE COPYRIGHT (C) 1986 BY KYAN SOFTWARE, INC. *) TYPE #I PARSET.I VAR ARGCOUNT:INTEGER; BASE:STRPOINTER; #I PARSELN.I PROCEDURE PRINTBUFFER; VAR WALKER:STRPOINTER; BEGIN WALKER:=BASE; WHILE WALKER<>NIL DO BEGIN WRITELN(WALKER^.STRFOUND); WALKER:=WALKER^.NEXTSTR END END; FUNCTION COUNTINPUT:INTEGER; VAR WALKER:STRPOINTER; I:INTEGER; BEGIN I:=0; BASE:=PARSELINE; WALKER:=BASE; WHILE WALKER<>NIL DO BEGIN I:=I+1; WALKER:=WALKER^.NEXTSTR END; COUNTINPUT:=I END; PROCEDURE INIT; BEGIN ARGCOUNT:=COUNTINPUT; WRITELN; WRITELN; WRITELN('*** PARSE DEMO ***'); WRITELN; WRITELN('THE PARSE ROUTINE PROVIDES YOU'); WRITELN('WITH AN EASY WAY TO WRITE KIX-LIKE'); WRITELN('PASCAL PROGRAMS IN THAT YOU CAN'); WRITELN('HAVE A USER TYPE PARAMETERS'); WRITELN('DIRECTLY AFTER THE NAME OF THE'); WRITELN('PROGRAM AT THE KIX COMMAND'); WRITELN('PROMPT. FOR EXAMPLE: WHEN'); WRITELN('YOU CALLED THIS PROGRAM, YOU'); WRITELN('TYPED ',ARGCOUNT:1,' WORDS:'); PRINTBUFFER END; BEGIN INIT; WRITELN('TRY RUNNING THIS DEMO AGAIN WITH'); WRITELN('MORE PARAMETERS ON THE COMMAND'); WRITELN('LINE AFTER THE "PARSE.DEMO".'); WRITELN; WRITE('PRESS RETURN...'); READLN; WRITELN('THE PARSELINE ROUTINE CAN BE USED'); WRITELN('AT ANY TIME IN A PROGRAM TO PARSE'); WRITELN('THE CONTENTS OF THE INPUT BUFFER.'); WRITELN; WRITE('FOR EXAMPLE: '); READLN; ARGCOUNT:=COUNTINPUT; WRITELN(ARGCOUNT,' WORDS TYPED: '); PRINTBUFFER END.
PROGRAM ESORT_DEMO; (* EXTERNAL SORT ROUTINE DEMONSTRATION PROGRAM. COPYRIGHT (C) 1986 BY KYAN SOFTWARE, INC. *) TYPE #I SRTMERGT.I (* RECORD OF 100 BYTES *) BIGRECTYPE = RECORD EXTRA1 : ARRAY[1..98] OF CHAR; INFOKEY : INTEGER END; VAR #I SRTMERGV.I #I ADDDEV.I #I DELETE.I #I MERGE.I #I ESORT.I FUNCTION RND:REAL; BEGIN RND:=0; #A TXA PHA LDA #0 STA _T RAN1 INC _T JSR POLY CMP #0 BEQ RAN1 ORA #$10 LDY #5 STA (_SP),Y ; RAN2 INY JSR POLY ROL ROL ROL ROL AND #$F0 STA _T+1 JSR POLY ORA _T+1 STA (_SP),Y CPY #11 BCC RAN2 LDA _T INY STA (_SP),Y PLA TAX # END; #A POLY TYA PHA LDY #0 POLY1 INY CLC ROL POLYN ROL POLYN+1 ROL POLYN+2 ROL POLYN+3 ROL POLYN+4 ROL POLYN+5 ROL POLYN+6 ROL POLYN+7 BCC POLY3 ; LDX #0 POLY2 LDA POLYN,X EOR GEN,X STA POLYN,X INX CPX #8 BCC POLY2 SEC ; POLY3 ROL _T+2 CPY #4 BCC POLY1 ; PLA TAY LDA _T+2 AND #$0F CMP #$0A BCS POLY RTS ; GEN DB $A1 DB $A2 DB $1A DB $A2 DB $91 DB $C3 DB $93 DB $C0 ; POLYN DB $63 DB $42 DB $A1 DB $23 DB $55 DB $09 DB $03 DB $87 # PROCEDURE HOME; BEGIN WRITE(CHR(125)); END; PROCEDURE BUILD_TEST_FILE; VAR I:INTEGER; F:FILE OF BIGRECTYPE; BEGIN WRITELN('GENERATING RANDOM DATA...'); REWRITE(F,'DATAFILE'); FOR I:=1 TO 75 DO BEGIN F^.INFOKEY:=ROUND(125*RND); WRITE(F^.INFOKEY:10); PUT(F); END; WRITELN END; PROCEDURE SHOW_TEST_FILE; VAR I,J:INTEGER; F:FILE OF BIGRECTYPE; BEGIN WRITELN('PRESS RETURN TO SEE SORTED FILE...'); READLN; RESET(F,'DATAFILE'); WHILE NOT EOF(F) DO BEGIN WRITE(F^.INFOKEY:10); GET(F) END; WRITELN END; BEGIN FYLE:='DATAFILE '; HOME; WRITELN('*** ESORT DEMONSTRATION ***'); WRITELN; WRITELN('THERE WILL BE 75 RECORDS SORTED. EACH'); WRITELN('RECORD IS 100 BYTES IN LENGTH. THE KEY'); WRITELN('FIELD IS AN INTEGER....'); WRITELN('PRESS RETURN TO BEGIN...'); READLN; BUILD_TEST_FILE; ORDER:=1; RLEN:=100; OSET:=98; KLEN:=2; KTYPE:=INTEGER_FIELD; WRITELN('SORTING....'); WRITELN('<PLEASE WAIT APPROX 1 MINUTE>...'); ESORT; SHOW_TEST_FILE END.
