;
; FORMAT.ACT - Formats Action! sources
; with indented DO-OD, IF-FI pairs.
;
; by Harold Long
;
; Source should be in simple form, i.e.,
; one keyword per line, no "DO mumble OD"
; constructions, etc.
;
CHAR ARRAY SOURCE(255), ;Temporary
           DEST(255), ;String arrays
           KEYWORD ;Test word pointer
CARD ARRAY POS(6),NEG(6),RES(6),TEMP(6), LEAD(6) ;Keyword arrays
BYTE I,J,K ;Counters
BYTE CurPos=[0], ;Current character pointer
     LastPos=[0], ;Last Character position
     Spaces=[0], ;Current indent value
     NextSpace=[0], ;Next line indent value
     Indent=[2]  ;Number of spaces per indent
INT  TempSpace=[0] ;Back up this line only
;
; Setup keyword arrays with desired values
; To include additional words, add to list
; and modify Foo(0) to reflect total number
; of words in list.
;
PROC Setup()
 POS(0)=2      ;Number of words in list
 POS(1)="IF"   ;Roughly sorted by frequency
 POS(2)="DO"

 NEG(0)=3
 NEG(1)="FI"
 NEG(2)="OD"
 NEG(3)="RETURN"

 RES(0)=3
 RES(1)="MODULE"
 RES(2)="PROC"
 RES(3)="FUNC"

 TEMP(0)=2
 TEMP(1)="ELSE"
 TEMP(2)="ELSEIF"
 TEMP(3)="RETURN"

 LEAD(0)=4
 LEAD(1)="BYTE"
 LEAD(2)="CARD"
 LEAD(3)="INT"
 LEAD(4)="CHAR"

 TempSpace=-Indent
 Spaces=Indent
RETURN

;
; Strip out all leading spaces.
; Returns with stripped data in
; SOURCE
;
PROC Strip()
 FOR I=1 to SOURCE(0) ;Count spaces
 DO
  IF SOURCE(I)#32 THEN ;Exit on first non-space char
   EXIT
  FI
 OD
 IF SOURCE(I)=155 THEN
  SOURCE(0)=0
  SOURCE(1)=155
 FI
 IF SOURCE(0)#0 THEN
  ScopyS(DEST,SOURCE,I,SOURCE(0)) ;Move to delete spaces
  ScopyS(SOURCE,DEST,1,DEST(0)) ;Put back in source record
 FI
RETURN

;
; Extract substring: returns with
; start:(end-1) inclusive string in
; DEST
;
PROC SubStr(BYTE Start, BYTE End)
 IF End>Start THEN
  DEST(0)=(End-Start)
  FOR I=1 to DEST(0)
   DO
    DEST(I)=SOURCE(Start+I-1)
   OD
 ELSE
  DEST(0)=0
  DEST(1)=155
 FI
RETURN

;
; Find delimiter: returns next occurrence
; of space char in SOURCE
;
BYTE FUNC FindLim(BYTE Start, BYTE End)
 IF End>Start THEN
  FOR I=Start TO End
   DO
    IF SOURCE(I)=32 THEN
     EXIT
    FI
   OD
  ELSE
   I=0
 FI
RETURN(I)

;
; Test for lower case character
;
BYTE FUNC IsLower(BYTE c)
 IF (c>='a) AND (c<='z) THEN
  RETURN(1)
 FI
RETURN(0)

;
; Shift to upper case if lower
;
BYTE FUNC ToUpper(BYTE c)
 IF IsLower(c) THEN
  c==-$20
 FI
RETURN(c)

;
; Force substring to upper case just
; in case you forgot...
;
PROC SubUp()
 BYTE c
 FOR I=1 to DEST(0)
 DO
  c=DEST(I)
  DEST(I)=ToUpper(c)
 OD
RETURN

; Test Positive indent; examine DEST
; for match with positive keyword
;
BYTE FUNC TestPos()
 BYTE Match
 Match=0
 FOR I=1 TO POS(0)
 DO
  KEYWORD=POS(I)
  IF SCompare(DEST,KEYWORD)=0 THEN
   Match=Indent
  FI
 OD
RETURN(Match)

;
; Test Negative indent; examine DEST
; for match with negative keyword
;
BYTE FUNC TestNeg()
 BYTE Match
 Match=0
 FOR I=1 to NEG(0)
 DO
  KEYWORD=NEG(I)
  IF Scompare(DEST,KEYWORD)=0 THEN
   Match=Indent
  FI
 OD
RETURN(Match)

;
; Test for Reset; cancel any
; outstanding pos/neg indents
;
BYTE FUNC TestRes()
 BYTE Match
 Match=0
 FOR I=1 to RES(0)
 DO
  KEYWORD=RES(I)
  IF Scompare(DEST,KEYWORD)=0 THEN
   Match=Indent
  FI
 OD
RETURN(Match)

;
; Test for Temporary reset; back up
; line one space to emphasize word.
;
BYTE FUNC TestTemp()
 BYTE Match
 Match=0
 FOR I=1 to TEMP(0)
 DO
  KEYWORD=TEMP(I)
  IF Scompare(DEST,KEYWORD)=0 THEN
   Match=Indent
  FI
 OD
RETURN(Match)

;
; Test for 'leader' word, e.g., complex
; expression such that keyword may follow
;
BYTE FUNC TestLead()
 BYTE Match
 Match=0
 FOR I=1 to LEAD(0)
 DO
  KEYWORD=LEAD(I)
  IF SCompare(DEST,KEYWORD)=0 THEN
   Match=1
  FI
 OD
RETURN(Match)

;
; File handler; 
;
; Opens Foo.ACT as input and
; Foo.FCT as output. Default
; filename is "TEST".
;
PROC FOpen(BYTE ARRAY FName)
 BYTE ARRAY INAME(16)  ;Input file name
 BYTE ARRAY ONAME(16)  ;Output file
 BYTE ARRAY IEXT=".ACT"
 BYTE ARRAY OEXT=".FCT"
 IF FName(0)=0 THEN
  Scopy(Fname,"D:TEST")
 FI
 FOR I=1 TO FName(0)
  DO
   INAME(I)=FName(I)
   ONAME(I)=FName(I)
  OD
 FOR I=FName(0)+1 TO FName(0)+4
  DO
   INAME(I)=IEXT(I-FName(0))
   ONAME(I)=OEXT(I-FName(0))
  OD
 INAME(0)=FNAME(0)+4
 ONAME(0)=FNAME(0)+4
 OPEN(2,INAME,4,0)     ;Input is read only
 OPEN(3,ONAME,8,0)     ;Output is write only
RETURN

;
; Process Record; inputs a line from
; Foo.ACT, strips it, tests for leading
; keywords, adjusts indentation, and
; outputs to Foo.FCT.
PROC ProcRec()
 InputSD(2,SOURCE)     ;Get record
 Strip()               ;Delete leading spaces
 IF SOURCE(0)>0 THEN   ;Skip blank lines
  CurPos=FindLim(1,SOURCE(0)) ;Find delimiter
  SubStr(1,CurPos)      ;extract substring
  SubUp()              ;Upper case
  IF TestLead() THEN   ;Complex expression?
   LastPos=Curpos+1
   CurPos=FindLim(LastPos,Source(0)) ;Get next word
   SubStr(LastPos,Curpos) ;Extract
   SubUp()             ;Upper case
  FI
  IF TestRes()#0 OR SOURCE(1)='; THEN
   Spaces=Indent
   TempSpace=-Indent
  FI
  Spaces==-TestNeg()
  NextSpace=TestPos()
  TempSpace==-TestTemp()
  CurPos=Spaces+TempSpace+1
  FOR I=1 TO 254        ;Blank target line
   DO
    DEST(I)=32
   OD
  DEST(0)=254
  DEST(255)=155
  SAssign(DEST,SOURCE,Curpos,SOURCE(0)+CurPos)
  ScopyS(SOURCE,DEST,1,SOURCE(0)+Curpos)
  TempSpace=0
 FI
 PrintDE(3,SOURCE)      ;Write record
 Spaces==+NextSpace
RETURN

PROC Main()
BYTE ARRAY File(20)
 CLOSE(2)
 CLOSE(3)
 GRAPHICS(0)           ;CLEAR SCREEN
 POSITION(10,2)
 PRINTE("Action! Formatter")
 POSITION(2,4)
 PRINTE("Formats Action! source files with")
 POSITION(2,5)
 PRINTE("indented DO-OD, IF-FI, etc. pairs.")
 POSITION(2,7)
 PRINTE("Specify input file as Dn:mumble")
 POSITION(2,8)
 PRINTE("Input extension of .ACT is assumed.")
 POSITION(2,9)
 PRINTE("Output file will be Dn:mumble.FCT")
 Position(2,11)
 PRINT("Input: ")
 INPUTS(File)
 FOpen(File)
 Setup()
 WHILE EOF(2)=0
 DO
  ProcRec()
 OD
 CLOSE(2)
 CLOSE(3)
 POSITION(2,13)
 PRINTE("DONE!")
RETURN