HiRes adapter code (was Re: [Coco] [Color Computer] What's this?)

theother_bob theother_bob at yahoo.com
Sun Aug 27 20:37:28 EDT 2006


> I could go digging but could someone post (to the list) the swath of
> 6809 assembly code to read the Hi-Res Joystick Adapter? Besides
> educating the list, if it's in the list archives it should get indexed
> by Google eventually...

---------------------------------------------------------------------------------------------------
This is from Robert Gault's website:
 
10 ' DEMO ROUTINE BY ROBERT GAULT TO INDICATE HOW HIGH RES ADAPTOR WORKS
20 LOADM"HRES",&H7000:' USE WHATEVER NAME YOU SAVED THE ML ROUTINE UNDER
30 RGB:' OR CMP OR SET PALETTE AS DESIRED BUT MAKE COLORS 0-3 DIFFERENT
40 HSCREEN4:' ALSO TRY HSCREEN 1 OR 2; FOR 3 CHANGE ARROW COLOR
50 HBUFF1,80:HBUFF2,80:' LARGE ENOUGH FOR HSCREEN2 USE
60 H$="NM+11,+4":' PART OF DRAW STRING CALLED SEVERAL TIMES
70 BF=1:GOSUB200:GOSUB230:BF=2:GOSUB200:GOSUB210:' BF SELECTS BUFFER #
80 JS=&H7004:XVAL=&H7000:YVAL=&H7002
90 DEF FNA(X)=PEEK(X)*256+PEEK(X+1):' CONVERTS A 2 BYTE NUMBER TO BASIC
INTEGER
100 FORX=0TO640STEP80:HLINE(X,0)-(X,191),PSET:NEXT:' DRAW GRID LINES
110 FORY=0TO192STEP32:HLINE(0,Y)-(639,Y),PSET:NEXT
120 X=1000:Y=X:' SETUP INITIAL CONDITIONS
130 '
140 FORT=0TO1STEP0:EXEC JS:' INFINITE LOOP: READ JOYSTICK
150 A=FNA(XVAL):B=.3*FNA(YVAL):' RECOVER X & Y VALUES
160 IFX>A-.5 AND X<A+.5 AND Y>B-.5 AND Y<B+.5 THEN 140:' TEST FOR NO
CHANGE
170 IF Z<>0 THEN GOSUB210 ELSE Z=1:' DON'T RESTORE SCREEN ON FIRST PASS
180 X=A:Y=B:BF=1:GOSUB200:GOSUB220:NEXT T
190 '
200 HGET(X,Y)-(X+16,Y+7),BF:RETURN:' USED FOR BOTH BUFFER 1 & 2
210 HPUT(X,Y)-(X+16,Y+7),1:RETURN:' ORIGINAL SCREEN VALUES
220 HPUT(X,Y)-(X+16,Y+7),2,OR:RETURN:' ARROW ICON
230 HDRAW"C2;BM
0,0;NR7;D1;NR5;D1;NR3;D1;NR1;BM+2,-1;XH$;BM+0,-1;XH$;BM+2,+0;XH$;C1":RETURN:'
CREATE ARROW ICON
240 '
250 This program simulates the cursor action present in OS-9 MultiVue. In
260 most cases, frequent calls to a cursor update subroutine should be OK
270 for BASIC programs. If greater speed is required, minor modifications
280 to the ml. program could incorporate the routine into the IRQ vector.
290 This would make joystick polling independent of the BASIC program.
300 For the gain to be significant, the ml. routine would also have to draw
310 the arrow icon; not that easy a task in the context of an RSDOS system.
 
 
00010 * TANDY HIGH RESOLUTION JOYSTICK ROUTINE
00020 * (c) NOV. 1992 BY ROBERT GAULT
00030
00040 * READS RIGHT JOYSTICK AND STORES X & Y VALUES AT OFFSET
00050 * 0 & 2; ROUTINE STARTS AT 4
00060
00070 * COCO3 FAST MODE ONLY; COMPENSATES FOR 320/640 FORMAT
00080 * SHOULD BE OFFSET LOADED TO DESIRED ADDRESS, PIC CODE
00090
00100   ORG     0
00110 XVAL      RMB     2
00120 YVAL      RMB     2
00130 START     PSHS    CC,DP
00140   SYNC            HELPS KEEP JITTER OUT OF RESULTS
00150   ORCC    #$50    TURN OF INTERRUPTS
00160   LDA     #$FF    SET DIRECT PAGE TO $FF00
00170   TFR     A,DP
00180   SETDP   $FF     TELL THE ASSEMBLER
00190   LDA     $10F    SAVE ORIGINAL AND THE RESET FIRQ
00200   STA     FRQHLD,PCR
00210   LDX     $110
00220   STX     FRQHLD+1,PCR
00230   LDA     #$7E
00240   LEAX    FIRQ,PCR
00250   STA     $10F
00260   STX     $110
00270   LDD     #$205C  SETUP GIME FOR FIRQ TIMER MODE
00280   STA     $FF93
00290   STB     $FF90
00300   LDA     $FF23   SOUND CONTROL; SAVE AND TURN OFF
00310   STA     SOUND,PCR
00320   ANDA    #.NOT.8
00330   STA     $FF23
00340   LDA     $FF01   MUX VALUES; SAVE AND SET FOR X JSTICK
00350   STA     PIA0A,PCR
00360   ANDA    #.NOT.8
00370   STA     $FF01
00380   LDA     $FF03
00390   STA     PIA0B,PCR
00400   ANDA    #.NOT.8
00410   STA     $FF03
00420   BSR     READJS  READ JOY STICK VALUE; X
00430   STX     XVAL,PCR        SAVE THE RAW ANSWER
00440   LDA     $FF01   SET MUX FOR Y JSTICK
00450   ORA     #8
00460   STA     $FF01
00470   BSR     READJS  READ JOYSTICK; Y
00480   STX     YVAL,PCR        SAVE ANSWER
00490   LDD     PIA0A,PCR       RESTORE ORIGINAL MUX VALUES
00500   STA     $FF01
00510   STB     $FF03
00520   LDA     SOUND,PCR       RESTORE ORIGINAL SOUND VALUES
00530   STA     $FF23
00540   LDD     #$4C00  RESTORE "ORIGINAL" GIME VALUES; KILL TIMER
00550   STA     $FF90
00560   STB     $FF93   IF YOUR PROGRAM HAS OTHER FIRQ, CHANGE REG.B
00570   TST     $FF93   CLEAR RESIDUAL INTERRUPT FLAG JUST IN CASE
00580   LDA     FRQHLD,PCR      RESTORE FIRQ POINTER
00590   LDX     FRQHLD+1,PCR
00600   STA     $10F
00610   STX     $110
00620   LDA     $E6     HRES GRAPHICS MODE INDICATOR
00630   CMPA    #3      HAVE WE A 320 OR 640 SCREEN
00640   BHS     E0
00650   LDD     XVAL,PCR        IF 320; DIVIDE X VALUE BY 2
00660   LSRA
00670   RORB
00680   STD     XVAL,PCR
00690 E0        PULS    CC,DP,PC        RETURN TO CALLING PROGRAM
00700
00710 SOUND     RMB     1
00720 PIA0A     RMB     1
00730 PIA0B     RMB     1
00740 FRQHLD    RMB     3
00750
00760 READJS    LDX     #0              CLEAR COUNTER
00770   LDD     #$FE8C          REG.A=DAC; REG.B=DISCHARGE COUNT
00780   STA     $FF20           TURN OFF RAMP IF ON
00790 A0        DECB                    WAIT FOR FULL DISCHARGE
00800   BNE     A0
00810   LDD     #$256           REG.A=DAC; REG.B=TIMER VALUE
00820   TST     $FF93           CLEAR STRAY FIRQ
00830   ANDCC   #$BF            START CPU FIRQ
00840   STB     $FF95           START TIMER
00850   CLR     $FF94              "
00860   STA     $FF20           START RAMP
00870 B0        LEAX    1,X             COUNT
00880   LDA     $FF00           TEST DAC FOR MATCH
00890   BPL     B0              LOOP IF NO MATCH
00900 C0        ORCC    #$50            KILL INTERRUPTS
00910   LDD     #$FE
00920   STB     $FF20           STOP RAMP
00930   CLRB
00940   STD     $FF94           CLEAR TIMER VALUE
00950   TST     $FF93           CLEAR FIRQ FLAG
00960   TFR     X,D             OFFSET JS VALUE TO CORRECT RANGE
00970   SUBD    #180            OFFSET MIN. RAMP VALUES
00980   BCC     D0
00990   LDD     #0              PREVENT NEGATIVE VALUES
01000 D0        TFR     D,X             RETURN FROM SUBROUTINE WITH VAL IN X
01010   RTS
01020
01030 FIRQ      LDA     $FF93   COPY FIRQ FLAGS; ALSO CLEAR THEM
01040   CMPA    #$20    IS IT A TIMER FIRQ
01050   BNE     F0      NO, THEN EXIT BACK TO COUNT LOOP
01060   LEAY    C0,PCR  RESET RETURN ADDRESS PAST COUNT LOOP
01070   STY     1,S     MODIFY STACK VALUE
01080 F0        RTI             FINISHED WITH INTERRUPT
01090
01100
01110
01120   END     START



More information about the Coco mailing list