Well, that was fun
F1 - set stick1 (mouse port) monitoring
F2 - set mouse monitoring
(Can't be in both modes at same time)
Mouse data not currently shown, except in the "last 4 bytes" stream.
;;
;; Joystick / Keyboard Data display
;;
pea code(pc) ; Run in Supervisor
move.w #$26,-(a7)
trap #14
lea 6(a7),a7
clr.l -(a7) ; Exit to Desktop
trap #1
code movem.l $ffff8240.w,d0-7 ; save pallette
movem.l d0-7,old_pall
move.b $ffff8260.w,old_res ; save resolution
move.b $ffff8201.w,old_screen+1 ; save screen-base
move.b $ffff8203.w,old_screen+2
move.l $118.w,-(a7)
clr.b $ffff8260.w ; set low res
bsr info_init ; init text plot routine
move.b #$80,d0
bsr s_ikbd
move.b #1,d0
bsr s_ikbd ; reset IKBD to POWER ON
move.b #$14,d0
bsr s_ikbd ; enable joystick events
move.b #$8,d0
bsr s_ikbd ; enable mouse events
move.l #my_key,$118.w ; install my ACIA interupt
lea screen_memory,a0 ; allocate 32k screen memory in BSS
move.l a0,d0
clr.b d0 ; on page boundary
move.l d0,screen
move.l screen,a0 ; clear the screen
move.l a0,a1
add.l #32000,a1
.wiper clr.l (a0)+
cmp.l a0,a1
bne.s .wiper
move.b screen+1,$ffff8201.w ; set screen address
move.b screen+2,$ffff8203.w
.loop tst.w update_flag ; check if screen update required?
beq.s .nope
bsr update ; yes, so update it
.nope cmp.b #$bb,key
bne .not_f1
bsr setjoy0
.not_f1 cmp.b #$bc,key
bne .not_f2
bsr setmous
.not_f2 cmp.b #$39,key
bne.s .loop ; wait for SPACE
move.w #$2700,sr ; all stop!
move.l (a7)+,$118.w
move.l #$8080000,$ffff8800.w ; volume to zero on
move.l #$9090000,$ffff8800.w ; all 3 channels
move.l #$a0a0000,$ffff8800.w
move.b #$80,d0 ; restore ikbd
bsr s_ikbd
move.b #$1,d0 ; to power up status
bsr s_ikbd
movem.l old_pall,d0-7
movem.l d0-7,$ffff8240.w ; restore pallette
move.b old_res,$ffff8260.w ; restore resolution
move.b old_screen+1,$ffff8201.w
move.b old_screen+2,$ffff8203.w
move.w #$2300,sr ; restore interupts
rts
setjoy0 move.b #$14,d0
bsr s_ikbd ; enable joystick events
rts
setmous move.b #$8,d0
bsr s_ikbd ; enable mouse events
rts
update_flag dc.w 0 ; flip flop for screen update required
update clr.w update_flag ; we're updating!
lea keyboard_text(pc),a1
bsr info ; display last 4 bytes from ACIA
clr.w stick ; stick0 is being read
move.b stick0,d0
btst #1,d0
bne down
btst #0,d0
bne up
btst #7,d0
bne fire
btst #2,d0
bne left
btst #3,d0
bne right
lea stick0_null,a1
bsr info
test2 move.b stick1,d0 ; stick1 is being read
btst #1,d0
bne down1
btst #0,d0
bne up1
btst #7,d0
bne fire1
btst #2,d0
bne left1
btst #3,d0
bne right1
lea stick1_null,a1
bra info
down lea stick0_down,a1
bsr info
bra test2
up lea stick0_up,a1
bsr info
bra test2
left lea stick0_left,a1
bsr info
bra test2
right lea stick0_right,a1
bsr info
bra test2
fire lea stick0_fire,a1
bsr info
bra test2
down1 lea stick1_down,a1
bra info
up1 lea stick1_up,a1
bra info
left1 lea stick1_left,a1
bra info
right1 lea stick1_right,a1
bra info
fire1 lea stick1_fire,a1
bra info
my_key movem.l d0-a6,-(a7)
move.b $fffffc02.w,d1 ; get ACIA data
move.b d1,key ; and store it
bsr hashing ; covert it to ASCII
lea last4,a0
rept 6 ; shift the buffer up a byte
move.b 1(a0),(a0)+
endr
lea hexad+6,a1
move.b (a1)+,(a0)+ ; and store the last byte
move.b (a1),(a0) ; (2 ascii digits=1 byte)
move.b key,d1 ; get the current key
cmp.w #-1,stick ; was last event stick0?
beq .stick0
cmp.w #-2,stick ; was last event stick1?
beq .stick1
cmp.b #$ff,d1 ; is this event stick0?
bne .notstick0
move.w #-1,stick ; next event is data
bra .exitikbd
.notstick0
cmp.b #$fe,d1 ; is this event stick1?
bne .exitikbd
move.w #-2,stick ; next event is data
bra .exitikbd
.stick1 move.b d1,stick1 ; store stick1 data
clr.w stick ; clear stick detect flag
bra .exitikbd
.stick0 move.b d1,stick0 ; store stick1 data
clr.w stick ; clear stick detect flag
.exitikbd
move.w #1,update_flag ; ACIA data received flipflop
movem.l (a7)+,d0-a6
bclr.b #6,$fffffa11.W ; clear ACIA interupt in service
rte
key dc.l 0
stick dc.w 0
stick0 dc.w 0
stick1 dc.w 0
mouse0 dc.w 0
s_ikbd btst #1,$fffffc00.w
beq.s s_ikbd
move.b d0,$fffffc02.w
rts
keyboard_text
dc.l 010*160
dc.b "LAST 4 BYTES: "
last4 dc.b "00000000",-1
even
stick0_null
dc.l 020*160
dc.b "STICK0 NULL ",-1
even
stick0_up
dc.l 020*160
dc.b "STICK0 UP ",-1
even
stick0_down
dc.l 020*160
dc.b "STICK0 DOWN ",-1
even
stick0_left
dc.l 020*160
dc.b "STICK0 LEFT ",-1
even
stick0_right
dc.l 020*160
dc.b "STICK0 RIGHT ",-1
even
stick0_fire
dc.l 020*160
dc.b "STICK0 FIRE ",-1
even
stick1_null
dc.l 030*160
dc.b "STICK1 NULL ",-1
even
stick1_up
dc.l 030*160
dc.b "STICK1 UP ",-1
even
stick1_down
dc.l 030*160
dc.b "STICK1 DOWN ",-1
even
stick1_left
dc.l 030*160
dc.b "STICK1 LEFT ",-1
even
stick1_right
dc.l 030*160
dc.b "STICK1 RIGHT ",-1
even
stick1_fire
dc.l 030*160
dc.b "STICK1 FIRE ",-1
even
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; call with long to convert in d1
;; string placed at hexad
;;
hashing moveq #0,d0
lea .table(pc),a0
lea hexad+8(pc),a2
bsr.s .first
moveq.w #5,d3
.loop bsr.s .next
dbra d3,.loop
.next ror.l #4,d1
.first move.b d1,d0
and #$f,d0
move.b (a0,d0),-(a2)
rts
.table dc.b "0123456789ABCDEF"
hexad ds.l 2
dc.l $ffffffff
even
font_x DC.B $00,$38,$66,$00,$00,$00,$00,$18 ; the debug screen font
DC.B $1E,$78,$00,$00,$00,$00,$00,$00
DC.B $7C,$38,$7C,$FE,$1C,$FE,$7E,$FE
DC.B $7C,$7C,$00,$00,$00,$00,$00,$7C
DC.B $00,$7C,$FC,$7E,$FC,$FE,$FE,$7E
DC.B $00,$38,$EE,$00,$00,$00,$00,$18
DC.B $3E,$7C,$00,$00,$00,$00,$00,$00
DC.B $FE,$78,$FE,$FC,$3C,$FE,$FE,$FE
DC.B $FE,$FE,$00,$00,$00,$00,$00,$EE
DC.B $00,$FE,$FE,$FE,$FE,$FE,$FE,$FE
DC.B $00,$38,$CC,$00,$00,$00,$00,$30
DC.B $38,$1C,$00,$00,$00,$00,$FC,$00
DC.B $0E,$00,$00,$00,$0C,$00,$00,$00
DC.B $06,$86,$60,$30,$00,$00,$00,$0E
DC.B $00,$06,$0E,$00,$06,$00,$00,$00
DC.B $00,$38,$00,$00,$00,$00,$00,$30
DC.B $38,$1C,$00,$00,$00,$00,$FC,$00
DC.B $C6,$38,$1C,$1C,$CC,$FC,$FC,$38
DC.B $7C,$7E,$60,$30,$00,$00,$00,$1C
DC.B $00,$FE,$FC,$C0,$E6,$FC,$FC,$EE
DCB.W 4,0
DC.B $38,$1C,$00,$00,$30,$00,$00,$00
DC.B $E6,$38,$38,$0E,$FE,$0E,$EE,$70
DC.B $C6,$0E,$00,$00,$00,$00,$00,$30
DC.B $00,$FE,$C6,$C0,$E6,$E0,$E0,$E6
DC.B $00,$38,$00,$00,$00,$00,$00,$00
DC.B $3E,$7C,$00,$00,$60,$30,$00,$00
DC.B $FE,$FE,$7E,$EE,$1C,$EE,$EE,$70
DC.B $FE,$1C,$60,$30,$00,$00,$00,$00
DC.B $00,$EE,$FE,$FE,$FE,$FE,$E0,$FE
DC.B $00,$38,$00,$00,$00,$00,$00,$00
DC.B $1E,$78,$00,$00,$00,$30,$00,$00
DC.B $7C,$FE,$FE,$FC,$1C,$FC,$7C,$70
DC.B $7C,$78,$60,$60,$00,$00,$00,$30
DC.B $00,$EE,$FC,$7E,$FC,$FE,$E0,$7E
DCB.W 20,0
DC.B $EE,$7C,$0E,$EE,$E0,$EE,$C6,$7C
DC.B $FC,$7C,$FC,$7E,$FE,$EE,$EE,$C6
DC.B $C6,$EE,$FE,$00,$00,$00,$00,$00
DCB.W 8,0
DC.B $EE,$7C,$0E,$FE,$E0,$FE,$E6,$FE
DC.B $FE,$FE,$FE,$FE,$FE,$EE,$EE,$C6
DC.B $EE,$EE,$FE,$00,$00,$00,$00,$00
DCB.W 10,0
DC.B $E0,$7E,$76,$0E,$0E,$0E,$0E,$00
DC.B $00,$EE,$00,$D6,$7C,$00,$00,$00
DCB.W 10,0
DC.B $FE,$38,$0E,$FC,$E0,$BE,$BE,$EE
DC.B $FE,$EE,$FC,$7C,$38,$EE,$EE,$BE
DC.B $38,$7C,$38,$00,$00,$00,$00,$00
DCB.W 8,0
DC.B $EE,$38,$EE,$FE,$00,$D6,$DE,$EE
DC.B $FC,$EE,$FC,$0E,$38,$00,$EE,$7E
DC.B $7C,$38,$70,$00,$00,$00,$00,$00
DCB.W 8,0
DC.B $EE,$7C,$EE,$EE,$FE,$C6,$CE,$FE
DC.B $E0,$FC,$EE,$FE,$38,$FE,$7C,$FE
DC.B $EE,$38,$FE,$00,$00,$00,$00,$00
DCB.W 8,0
DC.B $EE,$7C,$7C,$E6,$FE,$C6,$C6,$7C
DC.B $E0,$7E,$EE,$FC,$38,$7E,$38,$EE
DC.B $C6,$38,$FE,$00,$00,$00,$00,$00
DCB.W 48,0
even
info_init
lea font_x(pc),a0 ; Font offsets for plotter
move.l a0,d0
move.l d0,d1
add.l #40*8,d1
lea ascii(pc),a1
move.w #39,d2
.adder move.l d0,(a1)
move.l d1,160(a1)
addq.l #1,d0
addq.l #1,d1
lea 4(a1),a1
dbra d2,.adder
rts
ascii ds.l 80
next_add dc.l 0
n1 dc.l 1
n2 dc.l 7
old_pal ds.w 16
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Text plotting routine
;;
;; call with a1 pointing at text
;;
info lea screen(pc),a0
move.l (a0),a0
add.l (a1)+,a0
lea next_add(pc),a3
move.l a0,(a3)
move.l #1,4(a3) ; n1
move.l #7,8(a3) ; n2
.loop moveq.l #0,d0
move.b (a1)+,d0
bpl.s .write
cmp.b #-1,d0
beq.s .wrap
.nextline
move.l #1,4(a3) ; n1
move.l #7,8(a3) ; n2
move.l (a3),a0
add.l #160*9,a0
move.l a0,(a3)
bra.s .loop
.wrap rts
.write cmp.b #'.',d0 ; '.' and '-' are swapped in the font. cheap hack :P
bne.s .nodot
move.b #'-',d0
bra.s .ch_ok
.nodot cmp.b #'-',d0
bne.s .ch_ok
move.b #'.',d0
.ch_ok sub.b #' ',d0
add d0,d0
add d0,d0
lea ascii(pc),a2
move.l (a2,d0),a2
bsr.s .plotit
bra .loop
.plotit
x set 0
y set 0
rept 8
move.b x(a2),y(a0)
x set x+40
y set y+160
endr
add.l 4(a3),a0
move.l 4(a3),-(a7)
move.l 8(a3),4(a3)
move.l (a7)+,8(a3)
rts
SECTION BSS
screen ds.l 1
xa07 ds.b 1
xa09 ds.b 1
xa15 ds.b 1
xa1b ds.b 1
old_res ds.w 1 ; entry resolution
old_screen ds.l 1 ; entry screen address
old_pall ds.w 16 ; entry pallette
buffer_of_crap ds.b 1024
screen_memory ds.b 32000
Pages: [1] 
Hello (Read 4417 times)
