
 1000  *SAVE S.CATALOG ARRANGER
 1010  *--------------------------------
 1020         .OR $803
 1030         .TF CATALOG ARRANGER
 1040  *--------------------------------
 1050  POINTER     .EQ 0
 1060  *
 1070  MON.CV      .EQ $25
 1080  PREG        .EQ $48
 1090  *
 1100  DOS.RESTART .EQ $3D0
 1110  DOS.RWTS    .EQ $3D9
 1120  *
 1130  CORNER      .EQ $7D0
 1140  *
 1150  KEYBOARD    .EQ $C000
 1160  KEYSTROBE   .EQ $C010
 1170  *
 1180  DOS.SIZEOUT .EQ $AE42
 1190  DOS.PRNTERR .EQ $A702
 1200  DOS.TYPTABL .EQ $B3A7
 1210  IOB         .EQ $B7E8
 1220  IOB.SLOT    .EQ $B7E9
 1230  IOB.DRIVE   .EQ $B7EA
 1240  IOB.VOLUME  .EQ $B7EB
 1250  IOB.TRACK   .EQ $B7EC
 1260  IOB.SECTOR  .EQ $B7ED
 1270  IOB.BUFFER  .EQ $B7F0,F1
 1280  IOB.COMMAND .EQ $B7F4
 1290  IOB.ERROR   .EQ $B7F5
 1300  IOB.OSLOT   .EQ $B7F7
 1310  IOB.ODRIVE  .EQ $B7F8
 1320  *
 1330  * MONITOR CALLS
 1340  *
 1350  MON.VTAB    .EQ $FC22
 1360  MON.CLREOP  .EQ $FC42
 1370  MON.HOME    .EQ $FC58
 1380  MON.PRBYTE  .EQ $FDDA
 1390  MON.COUT1   .EQ $FDF0
 1400  MON.SETINV  .EQ $FE80
 1410  MON.SETNORM .EQ $FE84
 1420  *
 1430  *  SYMBOLIC CONSTANTS
 1440  *
 1450  ZERO         .EQ 0
 1460  READ         .EQ 1
 1470  WRITE        .EQ 2
 1480  LINE.COUNT   .EQ 22
 1490  ENTRY.LENGTH .EQ 35
 1500  RETURN       .EQ $8D
 1510  SPACE        .EQ $A0
 1520  *--------------------------------
 1530  SETUP
 1540         LDA IOB.OSLOT     SET SLOT AND
 1550         STA SLOT          DRIVE TO WHERE
 1560         LDA IOB.ODRIVE    WE CAME FROM
 1570         STA DRIVE
 1580   
 1590         LDA #ZERO         INITIALIZE
 1600         STA VOLUME        VARIABLES
 1610         STA NUMBER.OF.ELEMENTS
 1620         STA MOVING.FLAG
 1630         LDA #$FF
 1640         STA ACTIVE.ELEMENT
 1650   
 1660         JSR BUILD.ARRAY.TABLE
 1670         JSR READ.CATALOG
 1680         JSR MON.HOME
 1690  *--------------------------------
 1700  DISPLAY.AND.READ.KEY
 1710         JSR DISPLAY.ARRAY
 1720   
 1730  .1     LDA KEYBOARD
 1740         BPL .1
 1750         STA KEYSTROBE
 1760         CMP #$95             -->
 1770         BEQ HANDLE.RIGHT.ARROW
 1780         CMP #$88             <--
 1790         BEQ HANDLE.LEFT.ARROW
 1800         CMP #$9B             ESC
 1810         BEQ HANDLE.ESC
 1820         CMP #RETURN
 1830         BEQ HANDLE.RETURN
 1840         CMP #$C2             B
 1850         BEQ HANDLE.B         BEGINNING
 1860         CMP #$C5             E
 1870         BEQ HANDLE.E         END
 1880         CMP #$D2             R
 1890         BEQ HANDLE.R         READ CATALOG
 1900         CMP #$D7             W
 1910         BEQ HANDLE.W         WRITE CATALOG
 1920         JMP .1            NONE OF THE ABOVE
 1930  *--------------------------------
 1940  HANDLE.RIGHT.ARROW
 1950  *  MOVE UP ONE ELEMENT
 1960         JSR CHECK.FOR.END.OF.ARRAY
 1970         BCS .2            DO NOTHING IF ALREADY AT END
 1980         BIT MOVING.FLAG   SKIP SWAP IF
 1990         BPL .1            NOT MOVING
 2000         JSR MOVE.ELEMENT.UP
 2010  .1     INC ACTIVE.ELEMENT  FOLLOW IT UP
 2020  .2     JMP DISPLAY.AND.READ.KEY
 2030  *--------------------------------
 2040  HANDLE.LEFT.ARROW
 2050  *  MOVE DOWN ONE ELEMENT
 2060         JSR CHECK.FOR.BEGINNING.OF.ARRAY
 2070         BCS .2            IF AT BEGINNING, DO NOTHING
 2080         BIT MOVING.FLAG   IF NOT MOVING,
 2090         BPL .1            SKIP SWAP
 2100         JSR MOVE.ELEMENT.DOWN
 2110  .1     DEC ACTIVE.ELEMENT
 2120  .2     JMP DISPLAY.AND.READ.KEY
 2130  *--------------------------------
 2140  HANDLE.B
 2150  *  MOVE CURSOR TO BEGINNING OF ARRAY
 2160  .1     JSR CHECK.FOR.BEGINNING.OF.ARRAY
 2170         BCS .3    DO NOTHING IF AT BEGINNING
 2180         BIT MOVING.FLAG
 2190         BPL .2
 2200         JSR MOVE.ELEMENT.DOWN
 2210  .2     DEC ACTIVE.ELEMENT
 2220         BPL .1
 2230  .3     JMP DISPLAY.AND.READ.KEY
 2240  *--------------------------------
 2250  HANDLE.E
 2260  *  MOVE CURSOR TO END OF ARRAY
 2270  .1     JSR CHECK.FOR.END.OF.ARRAY
 2280         BCS .3
 2290         BIT MOVING.FLAG
 2300         BPL .2
 2310         JSR MOVE.ELEMENT.UP
 2320  .2     INC ACTIVE.ELEMENT
 2330         BPL .1       ...ALWAYS
 2340  .3     JMP DISPLAY.AND.READ.KEY
 2350  *--------------------------------
 2360  HANDLE.W
 2370  *  WRITE CATALOG TO DISK
 2380         JSR WRITE.CATALOG
 2390         JMP DISPLAY.AND.READ.KEY
 2400  *--------------------------------
 2410  HANDLE.RETURN
 2420  *  TOGGLE MOVING FLAG
 2430  *  =FF IF MOVING
 2440  *  =0  IF NOT
 2450         LDA MOVING.FLAG
 2460         EOR #$FF
 2470         STA MOVING.FLAG
 2480         JMP DISPLAY.AND.READ.KEY
 2490  *--------------------------------
 2500  HANDLE.ESC
 2510  *  EXIT PROGRAM
 2520         JMP DOS.RESTART
 2530  *--------------------------------
 2540  HANDLE.R
 2550  *  READ NEW CATALOG
 2560         JMP SETUP  RESTART PROGRAM
 2570  *--------------------------------
 2580  READ.CATALOG
 2590         JSR READ.VTOC
 2600         JSR POINT.TO.FIRST.CATALOG.SECTOR
 2610  .1     JSR READ.CATALOG.SECTOR
 2620         BCS .4                  .CS. IF END OF CHAIN
 2630   
 2640  *  MOVE CATALOG SECTOR INTO ARRAY
 2650  *   X STEPS THROUGH BUFFER, $B-$FF
 2660  *   Y STEPS THROUGH ENTRY, 0-$23
 2670         LDX #$B
 2680  .2     LDA CATALOG.BUFFER,X
 2690         BEQ .4                  END OF CATALOG?
 2700         INC ACTIVE.ELEMENT      NO, WE HAVE
 2710         INC NUMBER.OF.ELEMENTS  A NEW ENTRY
 2720         LDA ACTIVE.ELEMENT
 2730         JSR POINT.TO.A          SET POINTER
 2740         LDY #ZERO
 2750  .3     LDA CATALOG.BUFFER,X
 2760         STA (POINTER),Y
 2770         INX
 2780         BEQ .1            END OF BUFFER?
 2790  *                        IF SO, READ NEW SECTOR
 2800         INY
 2810         CPY #ENTRY.LENGTH END OF ENTRY?
 2820         BCC .3            NO, KEEP GOING
 2830         BCS .2            YES, GET NEXT ONE
 2840   
 2850  .4     LDA ACTIVE.ELEMENT
 2860         CLC          GO ONE PAST
 2870         ADC #1       LAST ELEMENT
 2880         ASL          AND STORE
 2890         TAY          TWO ZEROES
 2900         LDA #ZERO
 2910         STA ARRAY.TABLE,Y
 2920         STA ARRAY.TABLE+1,Y
 2930         STA ACTIVE.ELEMENT
 2940         RTS
 2950  *--------------------------------
 2960  READ.VTOC
 2970         LDA #ZERO
 2980         STA SECTOR
 2990         LDA #$11
 3000         STA TRACK
 3010         LDA #VTOC.BUFFER
 3020         STA BUFFER
 3030         LDA /VTOC.BUFFER
 3040         STA BUFFER+1
 3050         LDA #READ
 3060         STA COMMAND
 3070         JMP RWTS.CALLER
 3080  *--------------------------------
 3090  READ.CATALOG.SECTOR
 3100         LDA CATALOG.BUFFER+1   GET NEXT TRACK
 3110         BEQ .1       END OF CATALOG CHAIN?
 3120         STA TRACK
 3130         LDA CATALOG.BUFFER+2   GET NEXT SECTOR
 3140         STA SECTOR
 3150         LDA #CATALOG.BUFFER
 3160         STA BUFFER
 3170         LDA /CATALOG.BUFFER
 3180         STA BUFFER+1
 3190         LDA #READ
 3200         STA COMMAND
 3210         JSR RWTS.CALLER
 3220         CLC
 3230         RTS
 3240   
 3250  * SET CARRY TO SHOW END-OF-CHAIN
 3260  .1     SEC
 3270         RTS
 3280  *--------------------------------
 3290  WRITE.CATALOG
 3300         LDA #$FF
 3310         STA ACTIVE.ELEMENT
 3320         JSR POINT.TO.FIRST.CATALOG.SECTOR
 3330  .1     JSR READ.CATALOG.SECTOR
 3340         LDX #$B 
 3350  .2     INC ACTIVE.ELEMENT
 3360         LDA ACTIVE.ELEMENT
 3370         JSR POINT.TO.A
 3380         BCS .5            .CS. IF AT END OF TABLE
 3390         LDY #ZERO
 3400  .3     LDA (POINTER),Y
 3410         STA CATALOG.BUFFER,X
 3420         INX
 3430         BEQ .4            END OF BUFFER?
 3440         INY
 3450         CPY #ENTRY.LENGTH END OF ENTRY?
 3460         BCC .3            NO, KEEP GOING
 3470         BCS .2            YES, GET NEXT ONE
 3480   
 3490  .4     JSR WRITE.CATALOG.SECTOR
 3500         JMP .1            AND READ THE NEXT SECTOR
 3510   
 3520  *  FILL THE REST OF THE BUFFER WITH ZEROES
 3530  .5     LDA #ZERO
 3540  .6     STA CATALOG.BUFFER,X
 3550         INX
 3560         BNE .6
 3570   
 3580         JSR WRITE.CATALOG.SECTOR
 3590         LDA #ZERO
 3600         STA ACTIVE.ELEMENT
 3610         JMP DISPLAY.AND.READ.KEY
 3620  *--------------------------------
 3630  WRITE.CATALOG.SECTOR
 3640         LDA #WRITE        WRITE THE SECTOR
 3650         STA COMMAND       BACK JUST WHERE
 3660         JMP RWTS.CALLER   IT CAME FROM
 3670  *--------------------------------
 3680  POINT.TO.FIRST.CATALOG.SECTOR
 3690  *  GET THE FIRST TRACK AND SECTOR FROM THE VTOC
 3700         LDA VTOC.BUFFER+1
 3710         STA CATALOG.BUFFER+1
 3720         LDA VTOC.BUFFER+2
 3730         STA CATALOG.BUFFER+2
 3740         RTS
 3750  *--------------------------------
 3760  DISPLAY.ARRAY
 3770         LDA #ZERO         START AT
 3780         STA MON.CV        TOP OF
 3790         JSR MON.VTAB      SCREEN
 3800         LDA ACTIVE.ELEMENT
 3810         SEC
 3820         SBC #LINE.COUNT/2
 3830         BPL .1            IF RESULT IS +, USE IT
 3840         LDA #ZERO         OTHERWISE, USE ZERO
 3850  .1     TAX               X KEEPS TRACK OF
 3860  .2     TXA               WHERE WE ARE
 3870         CMP ACTIVE.ELEMENT
 3880         BNE .3
 3890         PHA
 3900         JSR MON.SETINV    INVERT ACTIVE ELEMENT
 3910         PLA
 3920  .3     JSR POINT.TO.A    SET POINTER
 3930         BCS .5            .CS. IF AT END OF TABLE
 3940         JSR INTERPRET.ENTRY  WRITE A LINE
 3950         LDA #RETURN
 3960         JSR MON.COUT1
 3970         JSR MON.SETNORM   RESTORE NORMAL
 3980         INX
 3990         LDA MON.CV
 4000         CMP #LINE.COUNT   END OF SCREEN?
 4010         BCC .2            IF NOT, DO ANOTHER LINE
 4020  .5     JSR MON.CLREOP    CLEAR TO END OF PAGE
 4030         JSR MON.SETNORM   JUST IN CASE
 4040         BIT MOVING.FLAG
 4050         BPL .6
 4060         JSR SHOW.MOVING.FLAG  IF MOVING
 4070  .6     RTS
 4080  *--------------------------------
 4090  INTERPRET.ENTRY
 4100         LDY #ZERO
 4110         LDA (POINTER),Y   DELETED?
 4120         BPL .1            MINUS IF YES
 4130         LDA #$AD     -
 4140         BMI .3       ...ALWAYS
 4150  .1     LDY #2
 4160         LDA (POINTER),Y   LOCKED?
 4170         BPL .2            MINUS IF YES
 4180         LDA #$AA     *
 4190         BMI .3       ...ALWAYS
 4200  .2     LDA #SPACE        NEITHER DELETED NOR LOCKED
 4210  .3     JSR MON.COUT1
 4220         LDY #2
 4230         LDA (POINTER),Y   GET FILE TYPE
 4240         AND #$7F          MAKE POINTER
 4250         LDY #7            INTO DOS'S
 4260         ASL               TYPE TABLE
 4270  .4     ASL               (ROUTINE BORROWED
 4280         BCS .5            FROM DOS, $ADE8-ADF9)
 4290         DEY
 4300         BNE .4
 4310  .5     LDA DOS.TYPTABL,Y
 4320         JSR MON.COUT1     DISPLAY TYPE
 4330         LDA #SPACE
 4340         JSR MON.COUT1
 4350         LDY #$21
 4360         LDA (POINTER),Y    SET UP FOR
 4370         STA $44            ROUTINE TO
 4380         INY                DISPLAY FILE
 4390         LDA (POINTER),Y    SIZE
 4400         STA $45
 4410         JSR DOS.SIZEOUT    DO IT
 4420         LDA #SPACE
 4430         JSR MON.COUT1
 4440         LDY #3
 4450  .6     LDA (POINTER),Y    GET A CHARACTER
 4451         CMP #SPACE         CONTROL?
 4452         BCS .7             NO, GO ON
 4453         AND #$7F           YES, MAKE IT INVERSE
 4460  .7     JSR MON.COUT1      DISPLAY IT
 4470         INY
 4480         CPY #33            DONE WITH FILE NAME?
 4490         BCC .6
 4500         RTS
 4510  *--------------------------------
 4520  SHOW.MOVING.FLAG
 4530         LDY #5        PUT INVERSE
 4540  .1     LDA QMOVING,Y "MOVING" AT
 4550         STA CORNER,Y  BOTTOM OF
 4560         DEY           SCREEN
 4570         BPL .1
 4580         RTS
 4590  *--------------------------------
 4600  RWTS.CALLER
 4610         LDA SLOT     TRANSFER
 4620         STA IOB.SLOT  VALUES
 4630         LDA DRIVE      INTO
 4640         STA IOB.DRIVE   IOB
 4650         LDA VOLUME
 4660         STA IOB.VOLUME
 4670         LDA TRACK
 4680         STA IOB.TRACK
 4690         LDA SECTOR
 4700         STA IOB.SECTOR
 4710         LDA COMMAND
 4720         STA IOB.COMMAND
 4730         LDA BUFFER
 4740         STA IOB.BUFFER
 4750         LDA BUFFER+1
 4760         STA IOB.BUFFER+1
 4770         LDA #$00
 4780         STA IOB.ERROR
 4790  *
 4800         LDY #IOB     LOAD IOB
 4810         LDA /IOB     ADDRESS
 4820         JSR DOS.RWTS     CALL RWTS
 4830         LDA #$00
 4840         STA PREG    SOOTHE MONITOR
 4850         BCS ERROR.HANDLER
 4860         RTS
 4870  *--------------------------------
 4880  ERROR.HANDLER
 4890         LDA #$87     BELL
 4900         JSR MON.COUT1     RING
 4910         JSR MON.COUT1        ING
 4920         JSR MON.COUT1          ING
 4930         LDA #23
 4940         STA MON.CV        USE LINE BELOW DISPLAY
 4950         JSR MON.VTAB
 4960         LDX #8
 4970         JSR DOS.PRNTERR   DISPLAY "I/O ERROR"
 4980         JMP DOS.RESTART   EXIT PROGRAM
 4990  *--------------------------------
 5000  BUILD.ARRAY.TABLE
 5010         LDA #CATALOG.ARRAY  SET FIRST ENTRY
 5020         STA ARRAY.TABLE     TO POINT TO
 5030         LDA /CATALOG.ARRAY  START OF
 5040         STA ARRAY.TABLE+1   ARRAY
 5050         LDX #2
 5060  .1     LDA ARRAY.TABLE-2,X MAKE EACH 
 5070         CLC                 SUCCESSIVE
 5080         ADC #ENTRY.LENGTH   ENTRY $23
 5090         STA ARRAY.TABLE,X   LARGER THAN
 5100         LDA ARRAY.TABLE-1,X THE LAST
 5110         ADC #ZERO
 5120         STA ARRAY.TABLE+1,X
 5130         INX
 5140         INX
 5150         CPX #$FE            127 ENTRIES YET?
 5160         BNE .1
 5170         LDA #ZERO           END TABLE
 5180         STA ARRAY.TABLE,X   WITH TWO
 5190         STA ARRAY.TABLE+1,X ZEROES
 5200         RTS
 5210  *--------------------------------
 5220  POINT.TO.A
 5230         ASL                 MAKE (A) INTO INDEX
 5240         TAY
 5250         LDA ARRAY.TABLE,Y   CHECK FOR TWO
 5260         ORA ARRAY.TABLE+1,Y CONSECUTIVE
 5270         BEQ .1              ZERO BYTES
 5280         LDA ARRAY.TABLE,Y
 5290         STA POINTER         PUT TABLE ENTRY
 5300         LDA ARRAY.TABLE+1,Y INTO POINTER
 5310         STA POINTER+1
 5320         CLC
 5330         RTS
 5340   
 5350  .1     SEC                 END OF TABLE
 5360         RTS
 5370  *--------------------------------
 5380  CHECK.FOR.END.OF.ARRAY
 5390  *  RETURNS CARRY SET IF AT END
 5400  *     "      "   CLEAR IF NOT
 5410         LDA ACTIVE.ELEMENT
 5420         CLC
 5430         ADC #1
 5440         CMP NUMBER.OF.ELEMENTS
 5450         RTS
 5460  *--------------------------------
 5470  CHECK.FOR.BEGINNING.OF.ARRAY
 5480         LDA ACTIVE.ELEMENT
 5490         BNE .1
 5500         SEC          ACTIVE = 0, WE ARE AT BEGINNING
 5510         RTS
 5520   
 5530  .1     CLC          NONZERO, WE'RE OKAY
 5540         RTS
 5550  *--------------------------------
 5560  MOVE.ELEMENT.UP
 5570         LDA ACTIVE.ELEMENT
 5580         ASL          MAKE INDEX INTO TABLE
 5590         TAX
 5600         LDY #2       DO THIS TWICE, FIRST LO, THEN HI
 5610  .1     LDA ARRAY.TABLE,X
 5620         PHA
 5630         LDA ARRAY.TABLE+2,X
 5640         STA ARRAY.TABLE,X
 5650         PLA
 5660         STA ARRAY.TABLE+2,X
 5670         INX          NOW DO HIGH BYTES
 5680         DEY
 5690         BNE .1       DONE?
 5700         RTS
 5710  *--------------------------------
 5720  MOVE.ELEMENT.DOWN
 5730         LDA ACTIVE.ELEMENT
 5740         ASL
 5750         TAX
 5760         LDY #2
 5770  .1     LDA ARRAY.TABLE,X
 5780         PHA
 5790         LDA ARRAY.TABLE-2,X
 5800         STA ARRAY.TABLE,X
 5810         PLA
 5820         STA ARRAY.TABLE-2,X
 5830         INX
 5840         DEY
 5850         BNE .1
 5860         RTS
 5870  *--------------------------------
 5880  QMOVING
 5890  *  INVERSE "MOVING"
 5900         .HS 0D0F16090E07
 5910  *--------------------------------
 5920  SLOT    .BS 1  (USUALLY 6)
 5930  DRIVE   .BS 1  (USUALLY 1)
 5940  VOLUME  .BS 1  (0 = ANY)
 5950  TRACK   .BS 1  (USUALLY $11)
 5960  SECTOR  .BS 1  (0 TO F)
 5970  BUFFER  .BS 2  (VARIES)
 5980  COMMAND .BS 1  (1 OR 2)
 5990   
 6000  NUMBER.OF.ELEMENTS .BS 1  (1 TO N)
 6010  ACTIVE.ELEMENT     .BS 1  (0 TO N-1)
 6020  MOVING.FLAG        .BS 1  (0 OR FF)
 6030  *--------------------------------
 6040  END.OF.PROGRAM
 6050   
 6060  VTOC.BUFFER     .EQ END.OF.PROGRAM
 6070  CATALOG.BUFFER  .EQ END.OF.PROGRAM+$100
 6080  ARRAY.TABLE     .EQ END.OF.PROGRAM+$200
 6090  CATALOG.ARRAY   .EQ END.OF.PROGRAM+$300

