2000 REM ...... THIS IS FILE "PACKER.BAS"
2010 
2020 !---------------------------------!
2030 !  ALPHABASIC SOURCE CODE PACKER  !
2040 !---------------------------------!
2050 
2060 !------------------------------------------------------------------------!
2070 !  THIS PROGRAM IS FOR MEMORY HOGS                                       !
2080 !     IT ACCEPTS AS INPUT THE FILE NAME OF ANY BASIC SOURCE PROGRAM      !
2090 !     (NORMALLY, A PROGRAM TOO BIG TO COMPILE IN ALPHABASIC),            !
2100 !     & CREATES A PACKED (MEMORY-SAVING) VERSION OF IT,                  !
2110 !     WHILE LEAVING THE ORIGINAL UNTOUCHED (SUITABLE FOR FRAMING !).     !
2120 !                                                                        !
2130 !  THE PACKED VERSION IS LIKE THE ORIGINAL, EXCEPT THAT                  !
2140 !    (1) BLANK LINES ARE REMOVED (IF THE USER SO SPECIFIES)              !
2150 !    (2) "REM" AND "!" STATEMENTS ARE REPLACED BY BLANK LINES            !
2160 !        (OR REMOVED ENTIRELY, IF THE USER SO SPECIFIES)                 !
2170 !    (3) BLANKS ARE DELETED, EXCEPT IN THE FOLLOWING CASES :             !
2180 !        --- WITHIN QUOTES                                               !
2190 !        --- WITHIN THE DATA AREA OF A "DATA" STATEMENT                  !
2200 !        --- ONE BLANK IS LEFT BEFORE THE FOLLOWING RESERVED WORDS :     !
2210 !                 "AND"        "OR"                                      !
2220 !                 "TO"         "STEP"                                    !
2230 !                 "ELSE"                                                 !
2240 !                 "MAX"        "MIN"                                     !
2250 !    (4) EACH "PRINT" IS CHANGED TO "?", EXCEPT WHEN USED IN LABELS      !
2260 !    (5) THE LINE "1NOEXPAND" IS ADDED TO THE PACKED FILE VERSION        !
2270 !        (NOTE : AVOID USE OF THE LABEL "PRINT" BY ITSELF)               !
2280 !    (6) THE PACKED FILE HAS EXTENSION ".PAK"                            !
2290 !                                                                        !
2300 !  THE PACKED VERSION REQUIRES LESS ROOM TO LOAD, BUT PRODUCES EXACTLY   !
2310 !  THE SAME OBJECT (".RUN") CODE.                                        !
2320 !------------------------------------------------------------------------!
2330 
2340 REM ...... STRING DEFINITIONS
2350   MAP1 IN$      ,S,6
2360   MAP1 INFNAME$ ,S,10
2370   MAP1 OUTFNAME$,S,10
2380   MAP1 CODE$    ,S,250
2390   MAP1 NCODE$   ,S,250
2400   MAP1 FIRST$   ,S,1
2410   MAP1 DELETE'EMPTY$,S,1
2420   MAP1 DELETE'REMS$ ,S,1
2430 
2440 NEW'FILE:
2450   ? "ENTER NAME OF BASIC SOURCE PROGRAM TO BE PACKED (1-6 CHARACTERS) : ";
2460   INPUT "" IN$
2470   INFNAME$=IN$+".BAS"
2480   LOOKUP INFNAME$, THERE
2490   IF(THERE < 0) THEN PRINT "ERROR---RANDOM FILE NAME !" : GO TO NEW'FILE
2500   IF(THERE = 0) THEN PRINT "ERROR---FILE DOESN'T EXIST" : GO TO NEW'FILE
2510   OPEN #1, INFNAME$, INPUT
2520   OUTFNAME$=IN$+".PAK"
2530   OPEN #2, OUTFNAME$, OUTPUT
2540 
2550 REM ...... SPECIFY OPTIONS FOR EMPTY & REMARK LINES
2560   DELETE'EMPTY$="N"
2570   INPUT "SHALL BLANK LINES BE DELETED ? ('Y' OR 'N') : ", DELETE'EMPTY$
2580   DELETE'REMS$="N"
2590   INPUT "SHALL REMARK LINES BE DELETED ? ('Y' OR 'N') : ", DELETE'REMS$
2600 
2610 REM ...... INITIAL CONDITIONS
2620   NLINE=0
2630   COMMENT=0
2640   PACKED=0
2650   UNPACKED=0
2660   BYTSRC=0
2670   PRINT #2, "1NOEXPAND"
2680   BYTOBJ=11
2690   PRINT
2700   PRINT "I AM NOW PACKING LINE NUMBER :"
2710   PRINT 
2720 
2730 
2740 
2750 READ'UNPACKED'LINE:
2760   INPUT LINE #1, CODE$
2770   IF(EOF(1)=1) THEN GO TO FINISH
2780   NLINE=NLINE+1
2790   PACK=0
2800   BYTSRC=BYTSRC+LEN(CODE$)+2
2810   NCODE$=""
2820   L=LEN(CODE$)
2830 
2840 STRIP'LINE'NUMBER:
2850   DIGIT$=LEFT$(CODE$,1)
2860   IF(DIGIT$ < "0" OR DIGIT$ > "9") THEN GO TO DISPLAY'LINE'NUMBER
2870   NCODE$=NCODE$+DIGIT$
2880   CODE$=RIGHT$(CODE$,L-1)
2890   L=L-1
2900   GO TO STRIP'LINE'NUMBER
2910 
2920 DISPLAY'LINE'NUMBER:
2930   PRINT USING "######", VAL(NCODE$);
2940   IF(NLINE/10=INT(NLINE/10)) THEN PRINT "          #"; NLINE
2950 
2960 STRIP'LEADING'BLANKS:
2970 
2980   REM ...... CHECK FOR A BLANK LINE (ONLY A LINE NUMBER)
2990   IF(L > 0) THEN GO TO NON'EMPTY'LINE
3000     IF(DELETE'EMPTY$="Y") THEN COMMENT=COMMENT+1 : GO TO READ'UNPACKED'LINE
3010     NCODE$=NCODE$+" "
3020     GO TO WRITE'PACKED'LINE
3030 
3040 NON'EMPTY'LINE:
3050   FIRST$=LEFT$(CODE$,1)
3060   IF(FIRST$ <> " ") THEN GO TO BEGIN'MAIN'TEXT
3070   CODE$=RIGHT$(CODE$,L-1)
3080   PACK=1
3090   L=L-1
3100   GO TO STRIP'LEADING'BLANKS
3110   
3120 
3130 
3140 BEGIN'MAIN'TEXT:
3150 
3160   REM ...... CHECK FOR A REMARK LINE ("REM" OR "!")
3170     IF(INSTR(1,CODE$,"REM")<>1 AND INSTR(1,CODE$,"!")<>1)THEN GO TO P'CHECK
3180     IF(DELETE'REMS$="Y") THEN COMMENT=COMMENT+1 : GO TO READ'UNPACKED'LINE
3190     NCODE$=NCODE$+" "
3200     GO TO WRITE'PACKED'LINE
3210 
3220   P'CHECK:
3230     IF(INSTR(1,CODE$,"PRINT") <> 1) THEN GO TO DATA'CHECK
3240     IF(INSTR(1,CODE$,"PRINT'") = 1) THEN GO TO DATA'CHECK
3250     NCODE$=NCODE$+"?"
3260     L=L-5
3270     CODE$=RIGHT$(CODE$,L)
3280     PACK=1
3290     GO TO REST'OF'TEXT'LOOP
3300 
3310   DATA'CHECK:
3320     IF(INSTR(1,CODE$,"DATA") <> 1) THEN GO TO REST'OF'TEXT'LOOP
3330     NCODE$=NCODE$+CODE$
3340     GO TO WRITE'PACKED'LINE
3350 
3360 
3370 
3380 REST'OF'TEXT'LOOP:
3390 
3400   REM ...... CHECK FOR DOUBLE QUOTE
3410     IF(INSTR(1,CODE$,CHR(34)) <> 1) THEN GO TO EMPTY'CHECK
3420     NCODE$=NCODE$+CHR(34) : L=L-1 : CODE$=RIGHT$(CODE$,L)
3430     REM ...... TRANSFER ALL CHARACTERS UP TO NEXT (CLOSED) DOUBLE QUOTE
3440     M=INSTR(1,CODE$,CHR(34))
3450     IF(M=0) THEN NCODE$=NCODE$+CODE$ : GO TO WRITE'PACKED'LINE
3460     NCODE$=NCODE$+CODE$[1,M]
3470     L=L-M
3480     CODE$=RIGHT$(CODE$,L)
3490 
3500   EMPTY'CHECK:
3510     IF(L=0) THEN GO TO WRITE'PACKED'LINE
3520 
3530   REM ...... CHECK FOR INTERNAL REMARKS ("REM" OR "!")
3540     IF(INSTR(1,CODE$,"REM")=1) THEN GO TO WRITE'PACKED'LINE
3550     FIRST$=LEFT$(CODE$,1)
3560     IF(FIRST$="!") THEN GO TO WRITE'PACKED'LINE
3570 
3580   REM ...... CHECK FOR BLANK
3590     IF(FIRST$ <> " ") THEN GO TO TRANSFER'NEXT'CHARACTER
3600 
3610   REM ...... CHECK FOR INTERNAL "PRINT" STATEMENT
3620     IF(INSTR(1,CODE$," PRINT") <> 1) THEN GO TO RESERVED'WORD'CHECK
3630     IF(INSTR(1,CODE$," PRINT'")=1) THEN GO TO RESERVED'WORD'CHECK
3640     NCODE$=NCODE$+"?"
3650     L=L-6
3660     CODE$=RIGHT$(CODE$,L)
3670     PACK=1
3680     GO TO REST'OF'TEXT'LOOP
3690 
3700   RESERVED'WORD'CHECK:
3710     IF(INSTR(1,CODE$," ELSE")=1) THEN GO TO TRANSFER'NEXT'CHARACTER
3720     IF(INSTR(1,CODE$," TO"  )=1) THEN GO TO TRANSFER'NEXT'CHARACTER
3730     IF(INSTR(1,CODE$," STEP")=1) THEN GO TO TRANSFER'NEXT'CHARACTER
3740     IF(INSTR(1,CODE$," AND" )=1) THEN GO TO TRANSFER'NEXT'CHARACTER
3750     IF(INSTR(1,CODE$," OR"  )=1) THEN GO TO TRANSFER'NEXT'CHARACTER
3760     IF(INSTR(1,CODE$," MAX" )=1) THEN GO TO TRANSFER'NEXT'CHARACTER
3770     IF(INSTR(1,CODE$," MIN" )=1) THEN GO TO TRANSFER'NEXT'CHARACTER
3780     PACK=1 : GO TO STRIP'NEXT'CHARACTER
3790 
3800   TRANSFER'NEXT'CHARACTER:
3810     NCODE$=NCODE$+FIRST$
3820 
3830   STRIP'NEXT'CHARACTER:
3840     L=L-1
3850     CODE$=RIGHT$(CODE$,L)
3860     GO TO REST'OF'TEXT'LOOP
3870 
3880   WRITE'PACKED'LINE:
3890     PRINT #2, NCODE$
3900     BYTOBJ=BYTOBJ+2+LEN(NCODE$)
3910     IF(PACK=0) THEN UNPACKED=UNPACKED+1   ELSE PACKED=PACKED+1
3920     GO TO READ'UNPACKED'LINE
3930 
3940 FINISH:
3950   CLOSE #1
3960   CLOSE #2
3970   PRINT
3980   PRINT
3990   PRINT "END OF PACKING ------"
4000   PRINT "  FILE "; INFNAME$; " HAS"; BYTSRC; "BYTES IN"; NLINE; "LINES"
4010   PRINT "  FILE "; OUTFNAME$; " HAS"; BYTOBJ; "BYTES IN";
4020   PRINT NLINE-COMMENT; "LINES";
4030   PRINT "  (";  (1-BYTOBJ/BYTSRC)*100;  "% SIZE REDUCTION )"
4040   PRINT "   (="; PACKED; "LINES PACKED +"; UNPACKED; "LINES UNCHANGED)"
4050   PRINT 
4060 
4070 
4080 
4090 REM ...... END
4100   END