
 1000  *--------------------------------
 1010  * MODIFIED BY MIKE LAUMER
 1020  * TO INCLUDE RIGHT ARROW
 1030  *--------------------------------
 1040  *  Patches for S-C Macro Assembler V1.0
 1050  *        for Videx Videoterm Card
 1060  *
 1070  * Date: 7/10/82
 1080  *
 1090  * Don Taylor
 1100  * infoTool corporation
 1110  * Drawer 809, Poulsbo, WA  98370
 1120  *
 1130  * To assemble this file:
 1140  *
 1150  *      1.  Set SLOTNUM to slot number of videx card
 1160  *
 1170  *      2.  Set LCVERSION flag for
 1180  *            .EQ 1 for Language card version ($D000)
 1190  *            .EQ 0 for Standard version ($1000)
 1200  *
 1210  *      3.  Assemble as usual
 1220  *
 1230  *      4.  Use VAL LENGTH to get length in hex
 1240  *
 1250  *      5.  BSAVE SCM80, A$4000, L$LENGTH
 1260  *
 1270  *--------------------------------
 1280  *
 1290  SLOTNUM             .EQ 3    VIDEX slot
 1300  LCVERSION           .EQ 1    SCM80 version
 1310  PATCH.AREA          .EQ $3200
 1320  LC.PATCH.AREA       .EQ $F400
 1330  *
 1340  *--------------------------------
 1350         .DO LCVERSION
 1360  SCM.BASE   .EQ $D000
 1370         .ELSE
 1380  SCM.BASE   .EQ $1000
 1390         .FIN
 1400  *--------------------------------
 1410  *  Program Constants
 1420  *--------------------------------
 1430  MON.CSW             .EQ $36
 1440  MON.KSW             .EQ $38
 1450  MON.A1L             .EQ $3C
 1460  MON.A2L             .EQ $3E
 1470  MON.A4L             .EQ $42
 1480  SCM.POINTER         .EQ $58
 1490  SCM.CURR.CHAR       .EQ $61
 1500  SCM.ED.BEGLIN       .EQ $80
 1510  NEW.CH              .EQ $98
 1520  NEW.CV              .EQ $99
 1530  SCM.WBUF            .EQ $200
 1540  DOS.COLD.ENTRY      .EQ $3D3
 1550  DOS.IOHOOK          .EQ $3EA
 1560  FLAGS               .EQ $7F8  VIDEX Flag Byte
 1570  KEYBOARD            .EQ $C000
 1580  KEYSTROBE           .EQ $C010
 1590  SCM.WARM.ENTRY      .EQ SCM.BASE+$003
 1600  SCM.SHIFT.FLAG      .EQ SCM.BASE+$016
 1610  SCM.SYM.TABLE       .EQ SCM.BASE+$01D
 1620  SCM.TEST.DOS        .EQ SCM.BASE+$31E
 1630  SCM.RDL.EOL         .EQ SCM.BASE+$35E
 1640  SCM.RDL3            .EQ SCM.BASE+$3C3
 1650  SCM.ESC.TABLE       .EQ SCM.BASE+$467
 1660  SCM.ESC.L           .EQ SCM.BASE+$483
 1670  SCM.RDKEY.NO.CASE   .EQ SCM.BASE+$520
 1680  SCM.RDKEY.WITH.CASE .EQ SCM.BASE+$4CA
 1690  SCM.SPC             .EQ SCM.BASE+$D92
 1700  MON.MOVE            .EQ $FE2C
 1710  MON.OUTPORT         .EQ $FE95
 1720  MON.COUT            .EQ $FDED
 1730  MON.RTS             .EQ $FF58
 1740  *--------------------------------
 1750         .OR $4000
 1760  START1     .EQ *
 1770  *--------------------------------
 1780  MOVE.CODE
 1790         LDA #HERE
 1800         STA MON.A1L
 1810         LDA /HERE
 1820         STA MON.A1L+1
 1830         LDA #THERE
 1840         STA MON.A2L
 1850         LDA /THERE
 1860         STA MON.A2L+1
 1870  *--------------------------------
 1880         .DO LCVERSION
 1890         BIT $C083    Unprotect language card RAM
 1900         BIT $C083
 1910         LDA #LC.PATCH.AREA
 1920         STA MON.A4L
 1930         LDA /LC.PATCH.AREA
 1940         STA MON.A4L+1
 1950         .ELSE
 1960         LDA #$33     Modify symbol table address
 1970         STA SCM.SYM.TABLE
 1980         LDA #PATCH.AREA
 1990         STA MON.A4L
 2000         LDA /PATCH.AREA
 2010         STA MON.A4L+1
 2020         .FIN
 2030  *--------------------------------
 2040         LDY #0
 2050         JSR MON.MOVE
 2060  INSTALL.PATCHES
 2070         LDA #$EA     "NOP-OUT" unused code:
 2080         STA SCM.BASE+$343
 2090         STA SCM.BASE+$344
 2100         STA SCM.BASE+$028
 2110         STA SCM.BASE+$029
 2120         STA SCM.BASE+$02A
 2130         LDX #9
 2140  .1     STA SCM.BASE+$298,X
 2150         DEX
 2160         BPL .1
 2170         LDX #14
 2180  .2     STA SCM.BASE+$4DE,X
 2190         DEX
 2200         BPL .2
 2210         LDX #48
 2220  .3     STA SCM.BASE+$B35,X
 2230         DEX
 2240         BPL .3
 2250         LDA #$20              Install Videx during a
 2260         STA SCM.BASE+$295     cold start
 2270         LDA #INSTALL.VECTORS
 2280         STA SCM.BASE+$296
 2290         LDA /INSTALL.VECTORS
 2300         STA SCM.BASE+$297
 2310         LDA #HOME    Patch clear screen routine
 2320         STA SCM.BASE+$2A6
 2330         LDA /HOME
 2340         STA SCM.BASE+$2A7
 2350         LDA #NEW.WARM.ENTRY   Set up warm start so
 2360         STA SCM.BASE+$309     VIDEX card stays in..
 2370         LDA /NEW.WARM.ENTRY
 2380         STA SCM.BASE+$30A
 2390         LDA #$10     Patch Escape Routine
 2400         STA SCM.BASE+$486
 2410         LDY #27
 2420  .4     LDA NEW.ESC.TABLE,Y
 2430         STA SCM.ESC.TABLE,Y
 2440         DEY
 2450         BPL .4
 2460         LDA #$18     Modify MON.RDKEY jump addr
 2470         STA SCM.BASE+$4D9
 2480         LDA #$4C     Patch jump to new DISP LINE
 2490         STA SCM.BASE+$B32
 2500         LDA #NEW.E.DISP.LINE
 2510         STA SCM.BASE+$B33
 2520         LDA /NEW.E.DISP.LINE
 2530         STA SCM.BASE+$B34
 2540         LDA #80      Patch E.INPUT Routine
 2550         STA SCM.BASE+$CA8
 2560         STA SCM.BASE+$CAC
 2570         LDA #NEW.CH
 2580         STA SCM.BASE+$CB1
 2590         LDA #NEW.CV
 2600         STA SCM.BASE+$CB3
 2610         LDA #VTAB
 2620         STA SCM.BASE+$CB5
 2630         LDA /VTAB
 2640         STA SCM.BASE+$CB6
 2650         LDA #SLOTNUM     Install VIDEX in hook
 2660         JSR MON.OUTPORT
 2670         JSR DOS.IOHOOK
 2680         LDA #$8D         Send CR to get VIDEX warm
 2690         JSR MON.COUT     entry point in DOS hook,
 2700         LDY #8           then find warm entry address
 2710         JSR SCM.TEST.DOS
 2720         LDY #1
 2730         LDA (SCM.POINTER),Y
 2740         STA FAKE.COUT+1   Save warm entry as normal
 2750         INY               VIDEX COUT entry
 2760         LDA (SCM.POINTER),Y
 2770         STA FAKE.COUT+2
 2780         LDA #COUT         Hook in new I/O routines
 2790         STA MON.CSW
 2800         LDA /COUT
 2810         STA MON.CSW+1
 2820         LDA #RDKEY
 2830         STA MON.KSW
 2840         LDA /RDKEY
 2850         STA MON.KSW+1
 2860         JSR DOS.IOHOOK
 2870  *--------------------------------
 2880         .DO LCVERSION
 2890         BIT $C080    Write protect RAM
 2900         JMP DOS.COLD.ENTRY
 2910         .ELSE
 2920         RTS
 2930         .FIN
 2940  *--------------------------------
 2950  *
 2960  NEW.ESC.TABLE
 2970         .DA HOME-1
 2980         .DA ADVNCE-1
 2990         .DA BS-1
 3000         .DA LF-1
 3010         .DA UP-1
 3020         .DA CLREOL-1
 3030         .DA CLREOP-1
 3040         .DA MON.RTS-1
 3050         .DA MON.RTS-1
 3060         .DA UP-1
 3070         .DA BS-1
 3080         .DA ADVNCE-1
 3090         .DA SCM.ESC.L-1
 3100         .DA LF-1
 3110  *--------------------------------
 3120  *  New routines to bind into the
 3130  *  S-C Macro assembler
 3140  *--------------------------------
 3150  LENGTH1             .EQ *-START1
 3160  HERE                .EQ *
 3170         .DO LCVERSION
 3180         .OR $F400
 3190         .ELSE
 3200         .OR $3200
 3210         .FIN
 3220         .TA HERE
 3230  START2              .EQ *
 3240  *--------------------------------
 3250  NEW.WARM.ENTRY
 3260         JSR INSTALL.VECTORS
 3270         JMP SCM.WARM.ENTRY
 3280  *
 3290  INSTALL.VECTORS
 3300         LDA #COUT
 3310         STA MON.CSW
 3320         LDA /COUT
 3330         STA MON.CSW+1
 3340         LDA #RDKEY
 3350         STA MON.KSW
 3360         LDA /RDKEY
 3370         STA MON.KSW+1
 3380         JSR DOS.IOHOOK
 3390         RTS
 3400  *
 3410  NEW.E.DISP.LINE
 3420         LDA SCM.ED.BEGLIN
 3430         STA NEW.CV
 3440         LDA #0
 3450         STA NEW.CH
 3460         JSR VTAB
 3470         JSR SCM.SPC
 3480         INC NEW.CH
 3490         INC NEW.CH
 3500         LDX #0
 3510  .1     LDA SCM.WBUF,X
 3520         BEQ .5
 3530         ORA #$80
 3540         CMP #$A0     Control char?
 3550         BCS .2       No..
 3560         AND #$7F     Flag it as inverse
 3570  .2     LDY NEW.CH
 3580         CPY #80      End of screen line?
 3590         BCC .4       No..
 3600         LDY #0       Set CH to beg of line
 3610         STY NEW.CH
 3620         LDY NEW.CV
 3630         CPY #23
 3640         BCS .3
 3650         INC NEW.CV   No..
 3660         BNE .4       ..Always
 3670  .3     DEC SCM.ED.BEGLIN
 3680  .4     JSR MON.COUT
 3690         INC NEW.CH
 3700         INX
 3710         BNE .1       ..Always
 3720  .5     JMP CLREOP
 3730  *
 3740  NEW.E.ZAP
 3750         LDA #0       EOL mark
 3760         STA SCM.WBUF,X
 3770         JSR CLREOL
 3780         RTS
 3790  *--------------------------------
 3800  *  Monitor Replacement Routines
 3810  *--------------------------------
 3820  *
 3830  HOME   LDA #$8C     Send Form Feed Char
 3840         JMP MON.COUT
 3850  *
 3860  CLREOL LDA #$9D     Send CLEAREOL char
 3870         JMP MON.COUT
 3880  *
 3890  CLREOP LDA #$8B     Send CLEAREOS char
 3900         JMP MON.COUT
 3910  *
 3920  ADVNCE LDA #$9C     Non-destructive space
 3930         JMP MON.COUT
 3940  *
 3950  BS     LDA #$88     Backspace
 3960         JMP MON.COUT
 3970  *
 3980  LF     LDA #$8A     Linefeed
 3990         JMP MON.COUT
 4000  *
 4010  UP     LDA #$9F     Reverse Linefeed
 4020         JMP MON.COUT
 4030  *--------------------------------
 4040  V.BASEL .EQ $478+SLOTNUM
 4050  V.BASEH .EQ $4F8+SLOTNUM
 4060  V.CHORZ .EQ $578+SLOTNUM
 4070  V.XSAV1 .EQ $402
 4080  V.OLDCHAR .EQ $678
 4090  *
 4100  V.DEV0  .EQ SLOTNUM*16+$C080
 4110  V.DISP0 .EQ $CC00
 4120  V.DISP1 .EQ $CD00
 4130  *--------------------------------
 4140  *
 4150  RDKEY  LDA KEYBOARD
 4160         BPL RDKEY
 4170         STA KEYSTROBE
 4180         ORA #$80
 4190         CMP #$81     Shift lock?
 4200         BNE .1
 4210         .DO LCVERSION
 4220         JSR UNPROTECT.LC.RAM
 4230         .FIN
 4240         LSR SCM.SHIFT.FLAG
 4250         BPL .2       Return with errant key
 4260  .1     CMP #$9A     Shift unlock?
 4270         BNE CTRLU    No, return with key
 4280         .DO LCVERSION
 4290         JSR UNPROTECT.LC.RAM
 4300         .FIN
 4310         SEC
 4320         ROR SCM.SHIFT.FLAG
 4330  .2     LDA #$96     Return with errant key
 4340         .DO LCVERSION
 4350         BIT $C080    Reprotect LC RAM
 4360         RTS
 4370  *
 4380  UNPROTECT.LC.RAM
 4390         BIT $C083    Enable Bank 2
 4400         BIT $C083
 4410         .FIN
 4420         RTS
 4430  *
 4440  CTRLU  CMP #$95     CTRL-U COPY KEY
 4450         BNE .3
 4460         STX $400
 4470         STY $401
 4480         LDA V.CHORZ
 4490         JSR PSNCALC
 4500         BCS .1
 4510         LDA V.DISP0,X
 4520         BCC .2
 4530  .1     LDA V.DISP1,X
 4540  .2     ORA #$80
 4550         STA V.OLDCHAR
 4560         LDX $400
 4570         LDY $401
 4580  .3     RTS
 4590  *
 4600  PSNCALC CLC
 4610         ADC V.BASEL
 4620         STA V.XSAV1
 4630         LDA #0
 4640         ADC V.BASEH
 4650         LSR
 4660         PHP
 4670         AND #3
 4680         ASL
 4690         ASL
 4700         TAY
 4710         LDA V.DEV0,Y
 4720         PLP
 4730         LDX V.XSAV1
 4740         RTS
 4750  *--------------------------------
 4760  *
 4770  VTAB   LDA #$9E     Send GOTOXY char
 4780         JSR MON.COUT
 4790         CLC          Create ASCII x-posn
 4800         LDA NEW.CH
 4810         ADC #160
 4820         JSR MON.COUT
 4830         CLC          Create ASCII y-posn
 4840         LDA NEW.CV
 4850         ADC #160
 4860         JMP MON.COUT
 4870  *
 4880  COUT
 4890         PHA            Test for inverse
 4900         PLA
 4910         BMI FAKE.COUT  Not inverse: Take as is
 4920         ORA #$80       Restore to "Normal" Apple ASCII
 4930         CMP #$A0       Control char?
 4940         BCS .1         No..
 4950         ORA #$40       Yes: Make it printable
 4960  .1     TAY            Save char
 4970         LDA FLAGS+SLOTNUM
 4980         PHA            Save flag byte
 4990         ORA #1         Switch in alt char set
 5000         STA FLAGS+SLOTNUM
 5010         TYA            Get char back
 5020         JSR FAKE.COUT
 5030         PLA            Restore flag byte
 5040         STA FLAGS+SLOTNUM
 5050         RTS
 5060  FAKE.COUT
 5070         JMP $FFFF      Address will be fixed later..
 5080  *--------------------------------
 5090  LENGTH2             .EQ *-START2
 5100  THERE               .EQ HERE+LENGTH2-1
 5110  LENGTH              .EQ LENGTH1+LENGTH2
 5120  *--------------------------------
 5130         .EN

