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