A2osX/LIB/LIBGUI.S.MENU.txt
2021-02-22 18:17:37 +01:00

922 lines
14 KiB
Plaintext
Raw Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

NEW
AUTO 3,1
*--------------------------------------
* MENU.New(int X, int Y, *S.RECT parent *S.MITEM mitems)
*--------------------------------------
MENU.New ldy MENU.Stack.Top
cpy #MENU.MAX
bcc .10
jmp .90
.10 >LDYAI S.MENU
>SYSCALL2 getmem
bcs .99
>STYA ZPMENUPtr
txa hMenu
ldx MENU.Stack.Top
sta MENU.Stack,x
lda #S.OBJ.T.MENU
sta (ZPMENUPtr) S.OBJ.T
lda #0
ldy #S.MENU-1
.1 sta (ZPMENUPtr),y
dey
bne .1
>PULLA
ldy #S.MENU.MITEMS
sta (ZPMENUPtr),y
>PULLA
iny
sta (ZPMENUPtr),y
>PULLW ZPRECTPtr Parent RECT
>PULLA
ldy #S.OBJ.Y1
sta (ZPMENUPtr),y
>PULLA
iny
sta (ZPMENUPtr),y
>PULLA
ldy #S.OBJ.X1
sta (ZPMENUPtr),y
>PULLA
iny
sta (ZPMENUPtr),y
lda ZPMENUPtr
clc
adc #S.MENU.pX1
sta ZPPtr1
lda ZPMENUPtr+1
adc /S.MENU.pX1
sta ZPPtr1+1
ldy #S.RECT-1
.3 lda (ZPRECTPtr),y
sta (ZPPtr1),y
dey
bpl .3
jsr MENU.SetMenuSizePos
ldx MENU.Stack.Top
lda MENU.Stack,x
inc MENU.Stack.Top
clc
rts
.90 lda #E.OOH
sec
.99 >POP 8
MENU.New.RTS rts
*--------------------------------------
* hMENU8, ItemID8, Prop8, Value16
*--------------------------------------
MENU.SetMItemProp
ldy #4 hMENU
lda (pStack),y
>SYSCALL2 GetMemPtr
>STYA ZPMENUPtr
ldy #3 ID8
lda (pStack),y
tax
jsr MENU.FindMItemByID
bcs .9
ldy #2 Prop8
lda (pStack),y
tay
>PULLA Value16
sta (ZPPtr1),y
iny
>PULLA
sta (ZPPtr1),y
* clc
.8 >POP 3
.9 rts
*--------------------------------------
MENU.Show >SYSCALL2 GetMemPtr
>STYA ZPMENUPtr
jsr MENU.Save
bcs .9
jsr GetCBBuf
bcs .9
jsr MENU.ShowBorders
jsr MENU.GetMItems
jsr MENU.GetDYW
.6 lda (ZPPtr1)
beq .8
jsr MENU.GetDX
jsr MENU.ShowMItem
jsr MENU.NextMItem
bra .6
.8 >LDYA L.WND.Screen
jmp DrawCBBufToYA
.9 rts
*--------------------------------------
MENU.Enter jsr MENU.GetDX
jsr MENU.GetDYW
lda Counter W
clc
adc DX
sta IE IE = X2
lda Counter+1
adc DX+1
sta IE+1
jsr MENU.GetMItems
.1 lda (ZPPtr1)
beq .8
ldy #S.MITEM.F
lda (ZPPtr1),y
cmp #S.MITEM.F.SEP
beq .2
lda DY
sec
adc SYSFON.H
sta INE INE = Y2
lda DY+1
adc #0
sta INE+1
>LDYAI DX
jsr MOU.InRectYA
bcc .3
.2 jsr MENU.NextMItem
bra .1
.3 ldy #S.MENU.Selected
lda (ZPMENUPtr),y
ldy #S.MITEM.ID
cmp (ZPPtr1),y
beq .9 same a s before, nothing to do
pha old one
lda (ZPPtr1),y new one
ldy #S.MENU.Selected
sta (ZPMENUPtr),y
jsr GetCBBuf
plx
beq .4 no previous selection
jsr MENU.ShowMItemByID deselect previous...
.4 ldy #S.MENU.Selected select new one
lda (ZPMENUPtr),y
tax
jsr MENU.ShowMItemByID
ldy #S.MITEM.F
lda (ZPPtr1),y
cmp #S.MITEM.F.SUBMENU
bne .80
>LDYA L.WND.Screen
jsr DrawCBBufToYA
jmp MENU.NewSubMenu
.8 ldy #S.MENU.Selected nothing to select....
lda (ZPMENUPtr),y
beq .9 ....and nothing to deselect
pha
lda #0
sta (ZPMENUPtr),y
jsr GetCBBuf
plx
jsr MENU.ShowMItemByID
.80 >LDYA L.WND.Screen
jmp DrawCBBufToYA
.9 lda MouseData+S.MOUSE.S
bit #S.MOUSE.S.CLK
beq .90
* >DEBUG
jmp MENU.DestroyAll
.90 clc
rts
*--------------------------------------
MENU.NewSubMenu ldy #S.MENU.Selected
lda (ZPMENUPtr),y
tax
jsr MENU.FindMItemByID
jsr MENU.GetDX
lda DX
clc
adc Counter
tay
lda DX+1
adc Counter+1
>PUSHYA X1
>PUSHW DY Y1
>PUSHWI DX Parent RECT
ldy #S.MITEM.pMENU+1
lda (ZPPtr1),y
>PUSHA
dey
lda (ZPPtr1),y
>PUSHA
jsr MENU.New
jmp MENU.Show
*--------------------------------------
MENU.SetMenuSizePos
stz IY Icon Margin W
stz IE Max Text W
stz IE+1
stz INE Max Mod-Key W
lda #2 2px Borders
sta DY Menu H
stz DY+1
jsr MENU.GetMItems
.1 lda (ZPPtr1)
beq .3
jsr MENU.GetMItemW
jsr MENU.NextMItem
bra .1
.3 lda #2+MENU.LMargin+MENU.RMargin 2px Borders+5 LMARGIN (Checked) +5 RMARGIN (SubMenu)
clc
adc IY Icon W
sta DX
stz DX+1
lda DX
sec 1px sep
adc IE Max Text W
sta DX
lda DX+1
adc IE+1
sta DX+1
lda DX
sec 1px sep
adc INE Max Mod-Key W
sta DX
bcc .4
inc DX+1
.4 ldy #S.OBJ.W
sta (ZPMENUPtr),y
iny
lda DX+1
sta (ZPMENUPtr),y
iny #S.OBJ.H
lda DY
sta (ZPMENUPtr),y
iny
lda DY+1
sta (ZPMENUPtr),y
ldy #S.MENU.iW
lda IY
sta (ZPMENUPtr),y
iny #S.MENU.tW
lda IE
sta (ZPMENUPtr),y
iny
lda IE+1
sta (ZPMENUPtr),y
iny #S.MENU.kW
lda INE
sta (ZPMENUPtr),y
iny
lda INE+1
sta (ZPMENUPtr),y
ldy #S.OBJ.Y1
lda DY
clc
adc (ZPMENUPtr),y
tax
iny
lda DY+1
adc (ZPMENUPtr),y
cpx WND.Screen+S.OBJ.H
sbc WND.Screen+S.OBJ.H+1
bcc .5
ldy #S.OBJ.Y1
lda (ZPMENUPtr),y
* sec
sbc DY
sta (ZPMENUPtr),y
iny
lda (ZPMENUPtr),y
sbc DY+1
sta (ZPMENUPtr),y
.5 >LDYA ZPMENUPtr
jsr OBJ.SetX2Y2
rts
*--------------------------------------
MENU.GetMItemW ldy #S.MITEM.F
lda (ZPPtr1),y
cmp #S.MITEM.F.SEP
beq .8
ldy #S.MITEM.pICON
lda (ZPPtr1),y
iny
ora (ZPPtr1),y
beq .1
lda #17 Reserve space for Icon W + 1px SEP
sta IY
.1 jsr MENU.GetText
ldx hSYSFON
jsr FON.GetTextSize
ldx CB.Cache+S.CB.SrcW
cpx IE
lda CB.Cache+S.CB.SrcW+1
sbc IE+1
bcc .2
stx IE Set Max text W
lda CB.Cache+S.CB.SrcW+1
sta IE+1
.2 jsr MENU.GetKeyString
beq .8
ldx hSYSFON
jsr FON.GetTextSize
lda CB.Cache+S.CB.SrcW
cmp INE
bcc .8
sta INE set Max Mod-key W
.8 rts
*--------------------------------------
MENU.ShowBorders
lda #S.CB.CMD.HLINE
jsr CB.InitCacheA
lda #S.CB.OP.SET
sta CB.Cache+S.CB.OP
lda #S.CB.M.MONO
sta CB.Cache+S.CB.M
lda PREFS.BORDERCOLOR
sta CB.Cache+S.CB.COLOR
ldy #S.OBJ.X2+1
ldx #5
.1 lda (ZPMENUPtr),y
sta CB.Cache+S.CB.X1,x
dey
dex
bpl .1
lda CB.Cache+S.CB.Y1
sta CB.Cache+S.CB.Y2
lda CB.Cache+S.CB.Y1+1
sta CB.Cache+S.CB.Y2+1 top X1,Y1,X2,Y1
jsr PutCBCache2CBBuf
ldy #S.OBJ.Y2
lda (ZPMENUPtr),y
sta CB.Cache+S.CB.Y1
sta CB.Cache+S.CB.Y2
iny
lda (ZPMENUPtr),y
sta CB.Cache+S.CB.Y1+1
sta CB.Cache+S.CB.Y2+1 bottom X1,Y2,X2,Y2
jsr PutCBCache2CBBuf
lda #S.CB.CMD.VLINE
sta CB.Cache+S.CB.CMD
ldy #S.OBJ.Y1
lda (ZPMENUPtr),y
sta CB.Cache+S.CB.Y1
iny
lda (ZPMENUPtr),y
sta CB.Cache+S.CB.Y1+1
lda CB.Cache+S.CB.X1
sta CB.Cache+S.CB.X2
lda CB.Cache+S.CB.X1+1
sta CB.Cache+S.CB.X2+1 left X1,Y1,X1,Y2
jsr PutCBCache2CBBuf
ldy #S.OBJ.X2
lda (ZPMENUPtr),y
sta CB.Cache+S.CB.X1
sta CB.Cache+S.CB.X2
iny
lda (ZPMENUPtr),y
sta CB.Cache+S.CB.X1+1
sta CB.Cache+S.CB.X2+1 right X2,Y1,X2,Y2
jmp PutCBCache2CBBuf
*--------------------------------------
MENU.ShowMItemByID
jsr MENU.FindMItemByID
jsr MENU.GetDX
*--------------------------------------
MENU.ShowMItem ldy #S.MITEM.F
lda (ZPPtr1),y
cmp #S.MITEM.F.SEP
bne MENU.ShowMItem1
lda #S.CB.CMD.HLINE
jsr CB.InitCacheA
lda #S.CB.OP.SET
sta CB.Cache+S.CB.OP
lda #S.CB.M.MONO
sta CB.Cache+S.CB.M
lda PREFS.BORDERCOLOR
sta CB.Cache+S.CB.COLOR
ldx #3
.1 lda DX,x
sta CB.Cache+S.CB.X1,x
dex
bpl .1
lda DX
clc
adc Counter
sta CB.Cache+S.CB.X2
lda DX+1
adc Counter+1
sta CB.Cache+S.CB.X2+1
jmp PutCBCache2CBBuf
*--------------------------------------
MENU.ShowMItem1 lda #S.CB.CMD.FILLRECT
jsr CB.InitCacheA
lda #S.CB.OP.SET
sta CB.Cache+S.CB.OP
lda #S.CB.M.MONO
sta CB.Cache+S.CB.M
ldx PREFS.MENUCOLOR
jsr MENU.IsSelected
bcc .15
txa
eor #C.WHITE
tax
.15 stx CB.Cache+S.CB.COLOR
ldx #3
.10 lda DX,x
sta CB.Cache+S.CB.X1,x
dex
bpl .10
lda DX
clc
adc Counter
sta CB.Cache+S.CB.X2
lda DX+1
adc Counter+1
sta CB.Cache+S.CB.X2+1
lda DY
sec
adc SYSFON.H
sta CB.Cache+S.CB.Y2
lda DY+1
adc #0
sta CB.Cache+S.CB.Y2+1
jsr PutCBCache2CBBuf
inc DY
bne .12
inc DY+1
.12 lda DX
clc
adc #MENU.LMargin TODO : Checked
sta DX
bcc .11
sta DX+1
.11 jsr MENU.GetIcon
beq .2
jsr DRAW.yaBMAtDXDY
.2 lda DX
clc
ldy #S.MENU.iW
adc (ZPMENUPtr),y
sta DX
bcc .21
inc DX+1
.21 jsr MENU.GetText
jsr MENU.IsSelected
ldx hSYSFON
jsr DRAW.YATextAtDXDY
lda DX
sec
ldy #S.MENU.tW
adc (ZPMENUPtr),y
sta DX
lda DX+1
iny
adc (ZPMENUPtr),y
sta DX+1
jsr MENU.GetKeyString
beq .3
jsr MENU.IsSelected
ldx hSYSFON
jsr DRAW.YATextAtDXDY
.3 ldy #S.MITEM.F
lda (ZPPtr1),y
cmp #S.MITEM.F.SUBMENU
bne .8
lda DX
sec
ldy #S.MENU.kW
adc (ZPMENUPtr),y
sta DX
lda DX+1
iny
adc (ZPMENUPtr),y
sta DX+1
ldx #BM.ID.RIGHT
jsr DRAW.xBMAtDXDY
.8 lda DY
bne .80
dec DY+1
.80 dec DY
clc
rts
*--------------------------------------
MENU.GetIcon ldy #S.MITEM.pICON+1
lda (ZPPtr1),y
bne .1
dey
lda (ZPPtr1),y
beq .8
tax
ldy L.BMs,x
lda L.BMs+1,x NON ZERO
.8 rts
.1 pha
dey
lda (ZPPtr1),y
tay
pla NON ZERO
rts
*--------------------------------------
MENU.IsSelected phy
pha
ldy #S.MENU.Selected
lda (ZPMENUPtr),y
ldy #S.MITEM.ID
cmp (ZPPtr1),y
beq .9
clc
.9 pla
ply
rts
*--------------------------------------
MENU.GetText lda #S.MITEM.TEXT
clc
adc ZPPtr1
tay
lda ZPPtr1+1
adc #0
rts
*--------------------------------------
MENU.GetKeyString
ldy #S.MITEM.KEYSTR
lda (ZPPtr1),y
beq .8
clc
adc ZPPtr1
tay
lda ZPPtr1+1
adc #0 !0
.8 rts
*--------------------------------------
MENU.Save lda #S.CB.CMD.GETRECTBUFSIZE
jsr CB.InitCacheA
ldy #S.OBJ.X1
ldx #0
.1 lda (ZPMENUPtr),y
sta CB.Cache+S.CB.X1,x
iny
inx
cpx #8 X1,Y1,X2,Y2
bne .1
jsr GFXWrite.CB
>SYSCALL2 NewStkObj
bcs .9
stx CB.Cache+S.CB.DstPtr
txa
ldy #S.MENU.hSAVEBUF
sta (ZPMENUPtr),y
lda #S.CB.CMD.BITBLT
sta CB.Cache+S.CB.CMD
lda #S.CB.OP.SAVE
sta CB.Cache+S.CB.OP
ldy #S.OBJ.W
ldx #0
.2 lda (ZPMENUPtr),y
sta CB.Cache+S.CB.SrcW,x
iny
inx
cpx #4 W,H
bne .2
jsr GFXWrite.CB
clc
.9 rts
*--------------------------------------
MENU.DestroyAll sec
.HS 90 BCC
MENU.Destroy clc
ldx MENU.Stack.Top
beq .8
php
bit CUR.bVisible
bpl .1
jsr HideCursor.I
.1 jsr CB.ClearCache
lda #S.CB.CMD.BITBLT
jsr CB.InitCacheA
lda #S.CB.OP.RESTORE
sta CB.Cache+S.CB.OP
plp
.2 php
ldx MENU.Stack.Top
lda MENU.Stack-1,x
>SYSCALL2 GetMemPtr
>STYA ZPMENUPtr
ldy #S.OBJ.X1
ldx #0
.3 lda (ZPMENUPtr),y
sta CB.Cache+S.CB.X1,x
iny
inx
cpx #8 X1,Y1,X2,Y2
bne .3
ldy #S.OBJ.W
ldx #0
.4 lda (ZPMENUPtr),y
sta CB.Cache+S.CB.SrcW,x
iny
inx
cpx #4 W,H
bne .4
ldy #S.MENU.hSAVEBUF
lda (ZPMENUPtr),y
sta CB.Cache+S.CB.DstPtr
jsr GFXWrite.CB
lda CB.Cache+S.CB.DstPtr
>SYSCALL2 FreeStkObj
ldx MENU.Stack.Top
lda MENU.Stack-1,x
>SYSCALL2 FreeMem
plp
dec MENU.Stack.Top
bcc .7
bne .2
.7 bit CUR.bVisible
bpl .8
jmp ShowCursor.I
.8 clc
rts
*--------------------------------------
MENU.GetDX ldy #S.OBJ.X1
lda (ZPMENUPtr),y
clc
adc #1
sta DX
iny
lda (ZPMENUPtr),y
adc #0
sta DX+1
rts
*--------------------------------------
MENU.GetDYW ldy #S.OBJ.Y1
lda (ZPMENUPtr),y
clc
adc #1
sta DY
iny
lda (ZPMENUPtr),y
adc #0
sta DY+1
ldy #S.OBJ.W
lda (ZPMENUPtr),y
sec
sbc #3 2Px border + correction from W
sta Counter
iny
lda (ZPMENUPtr),y
sbc #0
sta Counter+1
rts
*--------------------------------------
MENU.FindMItemByID
jsr MENU.GetMItems
jsr MENU.GetDYW
.1 lda (ZPPtr1)
beq .9
ldy #S.MITEM.F
lda (ZPPtr1),y
cmp #S.MITEM.F.SEP
beq .7
txa
ldy #S.MITEM.ID
cmp (ZPPtr1),y
beq .8
.7 jsr MENU.NextMItem
bra .1
.8 clc
rts
.9 sec
rts
*--------------------------------------
MENU.GetMItems ldy #S.MENU.MITEMS
lda (ZPMENUPtr),y
sta ZPPtr1
iny
lda (ZPMENUPtr),y
sta ZPPtr1+1
rts
*--------------------------------------
MENU.NextMItem ldy #S.MITEM.F
lda (ZPPtr1),y
sec
eor #S.MITEM.F.SEP
beq .1
lda SYSFON.Hp2
clc
.1 adc DY
sta DY
bcc .2
inc DY+1
.2 lda (ZPPtr1)
clc
adc ZPPtr1
sta ZPPtr1
bcc .8
inc ZPPtr1+1
.8 rts
*--------------------------------------
MAN
SAVE usr/src/lib/libgui.s.menu
LOAD usr/src/lib/libgui.s
ASM