home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Fresh Fish 8
/
FreshFishVol8-CD2.bin
/
bbs
/
dev
/
ssl-4.1.lha
/
SSL
/
SSLExamp
/
KeyRes.asm
< prev
next >
Wrap
Assembly Source File
|
1993-12-21
|
8KB
|
449 lines
; Keymap Resourcer
; (c) 1993 MJSoft System Software
; Martin Mares
; opt x+
include "ssmac.h"
tbase a4
clistart
writeln <Keymap Resourcer 1.0, (c) 1993 MJSoft System Software>
dtl <keymap.resource>,a1
call exec,OpenResource
tst.l d0
beq.s keyload
move.l d0,a0
call Forbid
lea 14(a0),a0
get.l from,a1
call FindName
call Permit
tst.l d0
bne.s keymok
keyload get.l from,d1
call dos,LoadSeg
dv.l myseg
put.l d0,myseg
bne.s segok
dtl <Unable to load %s>,a0
geta from,a1
jump ss,ExitError
segok add.l d0,d0
add.l d0,d0
addq.l #4,d0
keymok put.l d0,keymap
dv.l keymap
dbuf destname,80
move.l d0,a0
move.l 10(a0),a2 ; Keymap name
get.l to,a0
move.l a0,d0
bne.s makedest
move.l a2,a0
makedest geta destname,a1
push a1
push a2
dtl <kms>,a2
moveq #80,d0
call ss,AddExtension
geta destname,a0
move.l #1006,d0
call ss,TrackOpen ; Errors are filtered out by SSLib
put.l d0,destfh
dv.l destfh
opendest2 dtl.l <Resourcing %s to %s.>,a0
move.l sp,a1
call Printf
addq.l #8,sp
moveq #0,d7 ; Estimate number of dead keys
moveq #0,d5
get.l keymap,a0
lea 14(a0),a0
moveq #$3f,d6
bsr analyse
get.l keymap,a0
lea 30(a0),a0
moveq #$27,d6
bsr analyse
add.l d5,d7
put.l d7,maxdead
dv.l maxdead
get.l keymap,a0 ; Resource the keymap
lea keytab0(pc),a2
lea 14(a0),a0
bsr.s resource
get.l keymap,a0
lea keytab1(pc),a2
lea 30(a0),a0
bsr.s resource
rts
cleanup get.l myseg,d1
beq.s .segment
call dos,UnLoadSeg
.segment rts
; A0=keymap structure, A2=key list
resource move.l (a0)+,a1 ; A1=types
move.l (a0)+,a3 ; A3=keymap
move.l (a0)+,d2 ; D2=capsability
move.l (a0)+,d3 ; D3=repeatability
get.l destfh,d7 ; D7=dest file handle
moveq #0,d1 ; D1=bit number
reskey call ss,TestBreak
tst.b (a2)
beq resend
move.b (a1)+,d4 ; D4=key flags
sub.l a0,a0
btst d1,0(a0,d2.l)
sne d6 ; D6=is capsable
btst d1,0(a0,d3.l)
sne d5 ; D5=is repeatable
addq.b #1,d1
bclr #3,d1
beq.s resloop1
addq.l #1,d3
addq.l #1,d2
resloop1 btst #7,d4 ; Is it a NOP key ?
bne resskip
mpush d1-d3/a1/a3
dtl <DEAD >,a0 ; Key type
btst #5,d4
bne.s restype
dtl <STRING >,a0
btst #6,d4
beq.s restype1
restype bsr putsit
restype1 dtl <KEY >,a0 ; Key header
bsr putsit
move.l a2,a0
bsr putsit
btst #2,d4 ; CTRL
beq.s resctrl
dtl < CTRL>,a0
bsr putsit
resctrl btst #1,d4 ; ALT
beq.s resalt
dtl < ALT>,a0
bsr putsit
resalt btst #0,d4 ; SHIFT
beq.s resshift
dtl < SHIFT>,a0
bsr putsit
resshift tst.b d6 ; Capsability
beq.s rescaps
dtl < CAPS>,a0
bsr putsit
rescaps tst.b d5 ; Repeatability
bne.s resrep
dtl < NOREP>,a0
bsr putsit
resrep btst #4,d4 ; DownUp flag
beq.s resdoup
dtl < DOWNUP>,a0
bsr putsit
resdoup bsr newlin ; End of header
not.b d4
btst #5,d4
beq.s resdead
btst #6,d4
beq resstring
addq.l #4,a3 ; Normal key
moveq #0,d3 ; D3=counter of meanings
btst #0,d4
bne.s norm_loop
btst #1,d4
bne.s norm_loop
bset #2,d4
norm_loop move.b d3,d0
and.b d4,d0
bne.s norm_next
move.b -(a3),d2
beq.s norm_next
bsr shipattr
move.b d2,d0
bsr shipcode
bsr newlin
norm_next addq.b #1,d3
cmp.b #8,d3
bcs.s norm_loop
bra reskend
; Dead/Modified key
resdead moveq #0,d3 ; D3=counter of meanings
move.l (a3),a3
move.l a3,a0
dead_loop move.b d3,d0
and.b d4,d0
bne.s dead_next2
move.b (a0)+,d0
moveq #0,d2
move.b (a0)+,d2
push a0
btst #3,d0
bne.s dead_dead
btst #0,d0
bne.s dead_mod
tst.b d2
beq.s dead_next
bsr shipattr
move.b d2,d0
bsr shipcode
dead_line bsr newlin
dead_next pop a0
dead_next2 addq.b #1,d3
cmp.b #8,d3
bcs.s dead_loop
bra reskend
dead_dead bsr shipattr
dtl <PREFIX >,a0
bsr putsit
move.b d2,d0
and.b #$0F,d0
bsr shipcode
lsr.b #4,d2
beq.s 1$
moveq #',',d0
bsr putcit
move.b d2,d0
bsr shipcode
1$ bra.s dead_line
dead_mod bsr shipattr
dtl <MOD >,a0
bsr.s putsit
lea 0(a3,d2.w),a0
get.l maxdead,d2
bra.s dead_mod_2
dead_mod_1 move.b (a0)+,d0
push a0
bsr shipcode
moveq #',',d0
bsr.s putcit
pop a0
dead_mod_2 dbra d2,dead_mod_1
move.b (a0)+,d0
bsr shipcode
bra.s dead_line
; String key
resstring moveq #0,d3 ; D3=counter of meanings
move.l (a3),a3
move.l a3,a0
string_loop move.b d3,d0
and.b d4,d0
bne.s string_next
move.b (a0)+,d2
moveq #0,d0
move.b (a0)+,d0
tst.b d2
beq.s string_next
push a0
pea 0(a3,d0.w)
bsr.s shipattr
moveq #'"',d0
bsr.s putcit
pop a0
string_str move.b (a0)+,d0
push a0
bsr putcstr
pop a0
subq.b #1,d2
bne.s string_str
moveq #'"',d0
bsr.s putcit
bsr.s newlin
pop a0
string_next addq.b #1,d3
cmp.b #8,d3
bcs.s string_loop
reskend bsr.s newlin
mpop d1-d3/a1/a3
resskip tst.b (a2)+
bne.s resskip
addq.l #4,a3
bra reskey
resend rts
newlin dtl <',10,'>,a0
putsit move.l d7,d1
push d2
move.l a0,d2
call dos,FPuts
pop d2
rts
putcit push d2
move.l d7,d1
move.l d0,d2
call dos,FPutC
pop d2
rts
; D3=key meaning attribute
shipattr btst #2,d3
beq.s sat_ctrl
dtl <CTRL >,a0
bsr.s putsit
sat_ctrl btst #1,d3
beq.s sat_alt
dtl <ALT >,a0
bsr.s putsit
sat_alt btst #0,d3
beq.s sat_shift
dtl <SHIFT >,a0
bsr.s putsit
sat_shift rts
; D0=character code
shipcode move.w d0,-(sp)
cmp.b #32,d0
bcs.s shipcode1
cmp.b #127,d0
bcs.s shipcode2
cmp.b #160,d0
bcs.s shipcode1
shipcode2 moveq #'''',d0
bsr.s putcit
move.w (sp)+,d0
cmp.b #'''',d0
bne.s shipcode3
bsr.s putcit
moveq #'''',d0
shipcode3 bsr.s putcit
moveq #'''',d0
bra.s putcit
shipcode1 clr.b (sp)
dtl <%d>,a0
mpush d2-d3
move.l sp,d3
addq.l #8,d3
move.l d7,d1
move.l a0,d2
call dos,VFPrintf
mpop d2-d3
addq.l #2,sp
rts
putcstr cmp.b #'"',d0
beq.s putcstrq
cmp.b #'\',d0
beq.s putcstr1
cmp.b #32,d0
bcs.s putcstr3
cmp.b #127,d0
bcs.s putcstr2
cmp.b #160,d0
bcc.s putcstr2
putcstr3 move.w d0,-(sp)
moveq #'\',d0
bsr.s putcstr2
move.w (sp),d0
lsr.b #4,d0
bsr.s putnib
move.w (sp)+,d0
bra.s putnib
putcstrq bsr.s putcstrq1
moveq #'"',d0
bra.s putcstr2
putcstr1 bsr.s putcstr2
putcstrq1 moveq #'\',d0
putcstr2 bra putcit
putnib and.b #$0f,d0
cmp.b #10,d0
bcs.s 1$
addq.l #7,d0
1$ add.b #'0',d0
bra putcit
analyse move.l (a0)+,a2 ; A2=types
move.l (a0)+,a3 ; A3=data
anal1 move.b (a2)+,d4
move.l (a3)+,d0
btst #5,d4
beq.s anal2
not.b d4
moveq #0,d3
move.l d0,a0
anal3 move.b d3,d0
and.b d4,d0
bne.s anal_skip
move.b (a0)+,d0
move.b (a0)+,d1
btst #3,d0
beq.s anal_skip
move.b d1,d0
and.b #$0f,d0
cmp.b d0,d7
bcc.s 1$
move.b d0,d7
1$ lsr.b #4,d1
ext.w d0
ext.w d1
mulu d1,d0
cmp.l d0,d5
bcc.s anal_skip
move.l d0,d5
anal_skip addq.b #1,d3
cmp.b #8,d3
bcs.s anal3
anal2 subq.b #1,d6
bne.s anal1
rts
keytab0 dc.b 'TILDE',0,'ONE',0,'TWO',0,'THREE',0,'FOUR',0,'FIVE',0,'SIX',0,'SEVEN',0,'EIGHT',0 ;0
dc.b 'NINE',0,'ZERO',0,'MINUS',0,'EQUAL',0,'BACKSLASH',0,'???1',0,'K0',0 ;9
dc.b 'Q',0,'W',0,'E',0,'R',0,'T',0,'Y',0,'U',0,'I',0 ;10
dc.b 'O',0,'P',0,'LBRACK',0,'RBRACK',0,'???2',0,'K1',0,'K2',0,'K3',0 ;18
dc.b 'A',0,'S',0,'D',0,'F',0,'G',0,'H',0,'J',0,'K',0 ;20
dc.b 'L',0,'SEMICOLON',0,'APOSTROPHE',0,'HASH',0,'???3',0,'K4',0,'K5',0,'K6',0 ; 28
dc.b 'LESS',0,'Z',0,'X',0,'C',0,'V',0,'B',0,'N',0,'M',0 ;30
dc.b 'COMMA',0,'DOT',0,'SLASH',0,'???4',0,'KDOT',0,'K7',0,'K8',0,'K9',0 ;38
dc.b 0
keytab1 dc.b 'SPACE',0,'BACKSPACE',0,'TAB',0,'KENTER',0,'ENTER',0,'ESC',0,'DEL',0,'???5',0 ;40
dc.b '???6',0,'???7',0,'KMINUS',0,'???8',0,'UP',0,'DOWN',0,'RIGHT',0,'LEFT',0 ;48
dc.b 'F1',0,'F2',0,'F3',0,'F4',0,'F5',0,'F6',0,'F7',0,'F8',0 ;50
dc.b 'F9',0,'F10',0,'KLBRACK',0,'KRBRACK',0,'KSLASH',0,'KASTERISK',0,'KPLUS',0,'HELP',0 ;58
dc.b 'LSHIFT',0,'RSHIFT',0,'CAPSLOCK',0,'CONTROL',0,'LALT',0,'RALT',0,'LAMIGA',0,'RAMIGA',0 ;60
dc.b 0
tags
exitrout cleanup
template <FROM/A,TO>
dv.l from
dv.l to
finish
end