RosettaCodeData/Task/Create-a-two-dimensional-ar.../Action-/create-a-two-dimensional-ar...

109 lines
2.1 KiB
Plaintext

CARD EndProg ;required for ALLOCATE.ACT
INCLUDE "D2:ALLOCATE.ACT" ;from the Action! Tool Kit. You must type 'SET EndProg=*' from the monitor after compiling, but before running this program!
DEFINE PTR="CARD"
DEFINE INT_SIZE="2"
DEFINE CARD_SIZE="2"
TYPE IntArray2D=[BYTE rows,cols PTR p]
BYTE FUNC GetNumber(CHAR ARRAY s)
BYTE n,min=[1],max=[100]
DO
PrintF("Get number of %S (%B..%B): ",s,min,max)
n=InputB()
IF n>=min AND n<=max THEN
EXIT
FI
OD
RETURN (n)
PROC Create(IntArray2D POINTER a)
PTR ARRAY rowArray
BYTE row
IF a.p#0 THEN Break() FI
rowArray=Alloc(a.rows*CARD_SIZE)
a.p=rowArray
FOR row=0 TO a.rows-1
DO
rowArray(row)=Alloc(a.cols*INT_SIZE)
OD
RETURN
PROC Destroy(IntArray2D POINTER a)
PTR ARRAY rowArray
BYTE row
IF a.p=0 THEN Break() FI
rowArray=a.p
FOR row=0 TO a.rows-1
DO
Free(rowArray(row),a.cols*INT_SIZE)
OD
Free(a.p,a.rows*CARD_SIZE)
a.p=0
RETURN
PROC SetValue(IntArray2D POINTER a BYTE row,col INT v)
PTR ARRAY rowArray
INT ARRAY colArray
IF a.p=0 OR row>=a.rows OR col>=a.cols THEN
Break()
FI
rowArray=a.p
colArray=rowArray(row)
colArray(col)=v
RETURN
INT FUNC GetValue(IntArray2D POINTER a BYTE row,col)
PTR ARRAY rowArray
INT ARRAY colArray
IF a.p=0 OR row>=a.rows OR col>=a.cols THEN
Break()
FI
rowArray=a.p
colArray=rowArray(row)
RETURN (colArray(col))
PROC TestCreate(IntArray2D POINTER a)
PrintF("Create array of %B rows and %B cols%E",a.rows,a.cols)
Create(a)
RETURN
PROC TestDestroy(IntArray2D POINTER a)
PrintF("Destroy array of %B rows and %B cols%E",a.rows,a.cols)
Destroy(a)
RETURN
PROC TestSetValue(IntArray2D POINTER a BYTE row,col INT v)
PrintF("Write %I to row %B and col %B%E",v,row,col)
SetValue(a,row,col,v)
RETURN
PROC TestGetValue(IntArray2D POINTER a BYTE row,col)
INT v
v=GetValue(a,row,col)
PrintF("Read at row %B and col %B: %I%E",row,col,v)
RETURN
PROC Main()
IntArray2D a
Put(125) PutE() ;clear screen
AllocInit(0)
a.rows=GetNumber("rows")
a.cols=GetNumber("cols")
a.p=0
TestCreate(a)
TestSetValue(a,a.rows/2,a.cols/2,6502)
TestGetValue(a,a.rows/2,a.cols/2)
TestDestroy(a)
RETURN