!//IB//
!
! Code illustrating some of the decompiler's features
!
LENGTH 100 & COMMON STATUS$
!
LENGTH 8.2 & LOCAL AMOUNT
LENGTH 8.2 & LOCAL HISTAMOUNTS(5,12)
LENGTH 5.0 & LOCAL ID
LENGTH 1.0 & LOCAL NOCLEAR  ! IF SET TO 1, DON'T ALLOW ZEROING OF AMOUNT OR HISTORICAL FIGURES
LENGTH 1.0 & LOCAL ERR
LENGTH 5   & LOCAL STRID$
LENGTH 50  & LOCAL NAME$
LENGTH 3.0 & LOCAL DIM1,DIM2
LENGTH 100 & LOCAL OLDSTATUS$
LENGTH 1.0 & LOCAL OPTION
LENGTH 1.0 & LOCAL ESCAPEKEY
LENGTH 80  & LOCAL OPDESCRIPTION$
!
1000 FORMAT (CS);(EN)
!
1100 FORMAT @(10,12);"STATUS: ";STATUS$;_
            @(10,12);(SB);"HIT ANY KEY TO EXIT"
1110 FORMAT @(10,12);"ESCAPEKEY STATUS = ";ESCAPEKEY;_
            @(10,12);(SB);"HIT ANY KEY TO EXIT ROUTINE"
!
1200 FORMAT @(10,14);(SB);"ENTER OPTION";(SF);(TP);OPTION;(TM);@(23,14)
!
1300 FORMAT @(10,16);(SB);"ENTER CUSTOMER ID";(SF);(TP);STRID$;(TM);@(28,16)
!
1400 FORMAT @(5,18);"",54
1410 FORMAT @(5,18);"",54;@(5,18);OPDESCRIPTION$
!
2000 FORMAT ID;NAME$;AMOUNT;HISTAMOUNTS(1,1),60*8;NOCLEAR
!
CLEAR
PRINT (0,1000)
IF STATUS$ NE "" THEN
   PRINT (0,1100)
   INPUT (0) ""
   OLDSTATUS$ = STATUS$
ELSE
   OLDSTATUS$ = ""
ENDIF
CLOSE (1)
OPEN (1) "CUSTOMER",DIR="DTA",EXCPSUB=9000
DO
  ESCAPETO SYSTEM
  ESCAPEKEY = 0
  PRINT (0,1200)
  INPUT (0) OPTION
  SELECT OPTION
    CASE IS EQ 1    ! CLEAR FILE
     GOSUB 1000
    CASE IS EQ 2    ! CLEAR ALL HISTORICAL FIGURES USING FOR-NEXT
     GOSUB 2000
    CASE IS EQ 3    ! CLEAR ALL HISTORICAL FIGURES USING DO-WHILE
     GOSUB 3000
    CASE IS EQ 4    ! CLEAR ALL HISTORICAL FIGURES USING DO-UNTIL
     GOSUB 4000
    CASE IS EQ 5    ! CLEAR ALL HISTORICAL FIGURES USING LOOP-WHILE
     GOSUB 5000
    CASE IS EQ 6    ! CLEAR ALL HISTORICAL FIGURES USING LOOP-UNTIL
     GOSUB 6000
    CASE IS EQ 7    ! CLEAR ALL HISTORICAL FIGURES USING COMPOUND CONDITIONAL
     GOSUB 7000
    CASE IS EQ 8    ! CLEAR AMOUNTS FOR ALL CUSTOMERS
     GOSUB 8000
    CASE IS EQ 9    ! EXIT PROGRAM 
     GOTO 9900
    CASE ELSE
     PRINT " ";(SB);"*** INVALID ENTRY *** (HIT ANY KEY TO CONTINUE)";(SF)
     INPUT (0) ""
  ENDSELECT
  PRINT (0,1400)
LOOP
!
1000 ! CLEAR FILE
OPDESCRIPTION$ = "CLEAR THE CUSTOMER FILE"
PRINT (0,1410)
CLEARFILE (1),EXCP=9100
RETURN
!
! FOR ALL ROUTINES FROM 2000 - 7000, IF THE ID DOES NOT EXIST, AN ENTRY WILL BE CREATED
!                                    IF THE AMOUNT TO BE CLEARED IS NEGATIVE, IT WILL NOT BE CLEARED
!
! CLEAR HISTORICAL AMOUNTS WITH FOR-NEXT 
!
2000
OPDESCRIPTION$ = "USING FOR-NEXT TO CLEAR HISTORICAL AMOUNTS"
GOSUB ENTERID
READ(1,2000) KEY=STRID$,EXCPSUB=9400
ESCAPETO 9200
PRINT (0,1410)
FOR DIM1 = 1 TO 5
   FOR DIM2 = 1 TO 12
       IF HISTAMOUNTS(DIM1,DIM2) < 0.00 THEN CONTINUE
       HISTAMOUNTS(DIM1,DIM2) = 0.00
       IF ESCAPEKEY = 1 OR _
          NOCLEAR = 1 THEN
          RETURN
       ENDIF
   NEXT DIM2
NEXT DIM1
RETURN       
!
! CLEAR HISTORICAL AMOUNTS WITH DO-WHILE 
!
3000
OPDESCRIPTION$ = "USING DO-WHILE TO CLEAR HISTORICAL AMOUNTS"
GOSUB ENTERID
READ(1,2000) KEY=STRID$,EXCPSUB=9400
ESCAPETO 9200
DIM1 = 1
DIM2 = 1
PRINT (0,1410)
DO WHILE DIM1 <= 5 
   DO WHILE DIM2 <= 12
      IF HISTAMOUNTS(DIM1,DIM2) < 0.00 THEN 
         DIM2 = DIM2 + 1
         CONTINUE
      ENDIF
      IF ESCAPEKEY = 1 OR _
         NOCLEAR = 1 THEN
         RETURN
      ENDIF
      HISTAMOUNTS(DIM1,DIM2) = 0.00
      DIM2 = DIM2 + 1
   LOOP
   DIM1 = DIM1 + 1
   DIM2 = 1
LOOP
WRITE(1,2000)KEY=STRID$
RETURN       
!
! CLEAR HISTORICAL AMOUNTS WITH DO-UNTIL 
!
4000
OPDESCRIPTION$ = "USING DO-UNTIL TO CLEAR HISTORICAL AMOUNTS"
GOSUB ENTERID
READ(1,2000) KEY=STRID$,EXCPSUB=9400
ESCAPETO 9200
DIM1 = 1
DIM2 = 1
PRINT (0,1410)
DO UNTIL DIM1 = 5
   DO UNTIL DIM2 = 12
       IF HISTAMOUNTS(DIM1,DIM2) < 0.00 THEN 
          DIM2 = DIM2 + 1
          CONTINUE
       ENDIF
       HISTAMOUNTS(DIM1,DIM2) = 0.00
       IF ESCAPEKEY = 1 OR _
          NOCLEAR = 1 THEN
          RETURN
       ENDIF
       DIM2 = DIM2 + 1
   LOOP 
   DIM1 = DIM1 + 1
   DIM2 = 1
LOOP
WRITE(1,2000)KEY=STRID$
RETURN       
!
! CLEAR HISTORICAL AMOUNTS WITH LOOP-WHILE
!
5000
OPDESCRIPTION$ = "USING LOOP-WHILE TO CLEAR HISTORICAL AMOUNTS"
GOSUB ENTERID
READ(1,2000) KEY=STRID$,EXCPSUB=9400
ESCAPETO 9200
DIM1 = 1
DIM2 = 1
PRINT (0,1410)
DO
   DO
       IF ESCAPEKEY = 1 OR _
          NOCLEAR = 1 THEN
          RETURN
       ENDIF
       IF HISTAMOUNTS(DIM1,DIM2) < 0.00 THEN 
          DIM2 = DIM2 + 1
          CONTINUE
       ENDIF
       HISTAMOUNTS(DIM1,DIM2) = 0.00
       DIM2 = DIM2 + 1
   LOOP WHILE DIM2 <= 12
   DIM1 = DIM1 + 1
   DIM2 = 1
LOOP WHILE DIM1 <= 5
WRITE(1,2000)KEY=STRID$
RETURN      
! 
! CLEAR HISTORICAL AMOUNTS WITH LOOP-UNTIL
!
6000
OPDESCRIPTION$ = "USING LOOP-UNTIL TO CLEAR HISTORICAL AMOUNTS"
GOSUB ENTERID
READ(1,2000) KEY=STRID$,EXCPSUB=9400
ESCAPETO 9200
DIM1 = 1
DIM2 = 1
PRINT (0,1410)
DO
   DO
       IF ESCAPEKEY = 1 OR _
          NOCLEAR = 1 THEN
          RETURN
       ENDIF
       IF HISTAMOUNTS(DIM1,DIM2) < 0.00 THEN 
          DIM2 = DIM2 + 1
          CONTINUE
       ENDIF
       HISTAMOUNTS(DIM1,DIM2) = 0.00
       DIM2 = DIM2 + 1
   LOOP UNTIL DIM2 = 12
   DIM1 = DIM1 + 1
   DIM2 = 1
LOOP UNTIL DIM1 = 5
WRITE(1,2000)KEY=STRID$
RETURN       
! 
! CLEAR HISTORICAL AMOUNTS WITH COMPOUND CONDITIONAL
!
7000
OPDESCRIPTION$ = "USING COMPOUNT CONDITIONALS TO CLEAR HISTORICAL AMOUNTS"
GOSUB ENTERID
READ(1,2000) KEY=STRID$,EXCPSUB=9400
ESCAPETO 9200
DIM1 = 1
DIM2 = 1
PRINT (0,1410)
DO
   IF DIM1 <= 12 AND _
      DIM2 <= 5 THEN
      IF ESCAPEKEY = 1 OR _
         NOCLEAR = 1 THEN
         RETURN
      ENDIF
      IF HISTAMOUNTS(DIM1,DIM2) < 0.00 THEN 
         DIM2 = DIM2 + 1
         IF DIM2 > 12 THEN
            DIM2 = 1
            DIM1 = DIM1 + 1
            IF DIM1 > 5 THEN 
               BREAK
            ENDIF
         ENDIF
         CONTINUE
      ENDIF
      HISTAMOUNTS(DIM1,DIM2) = 0.00
      DIM2 = DIM2 + 1
      IF DIM2 > 12 THEN
         DIM2 = 1
         DIM1 = DIM1 + 1
         IF DIM1 > 5 THEN 
            BREAK
         ENDIF
      ENDIF
   ENDIF 
LOOP
WRITE(1,2000)KEY=STRID$
RETURN       
! 
! CLEAR AMOUNT VALUE FOR ALL CUSTOMERS
!
8000
OPDESCRIPTION$ = "CLEAR CURRENT AMOUNTS FOR ALL CUSTOMERS"
PRINT (0,1410)
ESCAPETO 9200
STRID$ = FIRST(1,EXCP=8100)
CLOSE (2)
OPEN (2) "CUSTOMER",DIR="DTA"
DO WHILE STRID$ NE ""
   IF ESCAPEKEY = 1 OR _
      NOCLEAR = 1 THEN
      RETURN
   ENDIF
   READ(1,2000) KEY=STRID$
   IF AMOUNT > 0.00 THEN
      AMOUNT = 0.00
   ENDIF
   WRITE(1,2000)KEY=STRID$
   STRID$ = KEY(1,EXCPSUB=8200)
LOOP
!
! 8100 - CUSTOMER FILE IS EMPTY
!
8100
RETURN
!
! 8200 - NO MORE ENTRIES IN CUSTOMER FILE
!
8200
STRID$ = ""
RETURN
!
! ENTERID:- SUBROUTINE FOR ENTERING CUSTOMER ID
!
ENTERID:
PRINT (0,1300)
INPUT (0) STRID$
RETURN
!
9000
IF EXCP NE 11 THEN
   ERROR
ENDIF
CREATE "CUSTOMER",2048,K,5,DIR="DTA",EXCP=9010
AGAIN
!
9010 
OLDSTATUS$ = STATUS$
STATUS$ = "UNABLE TO CREATE CUSTOMER FILE EXCP=" + STR(EXCP)
PRINT (0,1100)
INPUT (0) ""
GOTO 9900
!
9100
OLDSTATUS$ = STATUS$
STATUS$ = "UNABLE TO CLEAR FILE EXCP=" + STR(EXCP)
PRINT (0,1100)
INPUT (0) ""
RETURN
!
9200
ESCAPEKEY = 1
PRINT (0,1110)
INPUT (0) ""
RETURN
!
9400
ID = NUM(STRID$,ERR)
NAME$ = "ID " + STRID$
AMOUNT = 0.00
RETURN
!
9900
CLOSE
SWAP(STATUS$,OLDSTATUS$)
RUN "PROGRAM"
END