Source code in the action! programming language

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