~rabbits/left

cc206dc5f9beb9272ed392f4139f5cd5be3c9adc — Devine Lu Linvega 18 days ago 3719903
Do not go to selection if selection is small
1 files changed, 169 insertions(+), 166 deletions(-)

M src/left.tal
M src/left.tal => src/left.tal +169 -166
@@ 372,12 372,6 @@ BRK
(
@|actions )

@get-eof ( -- addr* )

	;text .textarea/length LDZ2 ADD2

JMP2r

@put-byte ( byte -- )

	DUP #04 SFT put-byte/h &h


@@ 407,18 401,6 @@ JMP2r

!draw-state

@count-lines ( -- line* )

	LITr -scroll/y LDZ2r
	.scroll/addr LDZ2
	&w
		LDAk #0a NEQ [ JMP INC2r ]
		INC2 LDAk ?&w
	POP2
	STH2r

JMP2r

@scroll-to ( line* -- )

	DUP2 .scroll/y LDZ2 EQU2 ?&skip


@@ 456,47 438,6 @@ JMP2r

JMP2r

@line-to-addr ( line* -- addr* )

	STH2
	LIT2r 0000
	;text
	&w
		EQU2kr STHr ?&end
		LDAk #0a NEQ [ JMP INC2r ]
		INC2 LDAk ?&w
	&end
	POP2r POP2r

JMP2r

@addr-to-line ( addr* -- line* )

	LIT2r 0000
	;text
	&l
		LDAk #0a NEQ [ JMP INC2r ]
		INC2 GTH2k ?&l
	POP2 POP2
	STH2r

JMP2r

@addr-to-x ( addr* -- x* )

	LIT2r 0000
	DUP2 find-line-start
	&l
		EQU2k ?&end
		get-segw STH2 ADD2r
		INC2 GTH2k ?&l
	&end
	POP2 POP2
	STH2r

JMP2r


@select-word ( addr* -- )

	find-prev-spacer INC2 DUP2 find-next-spacer


@@ 624,7 565,7 @@ JMP2r

@delete ( -- )

	get-eof .selection/from LDZ2 SUB2 ORA #01 JCN JMP2r
	get-eof .selection/from LDZ2 SUB2 ORA #01  [ JCN JMP2r ]

	.selection/length LDZ2 #0001 EQU2 ?&no-block
		erase-selection


@@ 636,23 577,6 @@ JMP2r

!draw-textarea

@is-selected ( addr* -- addr* bool )

	.selection/from LDZ2 SUB2k
	.selection/to LDZ2 ROT2 SUB2 LTH2

JMP2r

@is-rune ( addr* -- bool )

	.textarea/highlight LDZ ?&skip
	.state/c LDZ ?&skip
	INC2k LDA #21 LTH ?&skip
	LDA ;runes cndx INC2 ORA

JMP2r
	&skip POP2 #00 JMP2r

( find )

@find-line-start ( addr* -- addr* )


@@ 794,6 718,171 @@ JMP2r
!update-nav

(
@|helpers )

@scan-comment ( addr* -- addr* )

	.textarea/highlight LDZ ?&skip
	LDAk LIT "( EQU ?&true
	DUP2 #0001 SUB2 LDA LIT ") EQU ?&false
	&skip

JMP2r
	&true [ LIT2 01 -state/c ] STZ JMP2r
	&false [ LIT2 00 -state/c ] STZ JMP2r

@scan-fixed ( addr* -- addr* )

	.textarea/monospace LDZ ?&true
	.textarea/highlight LDZ ?&skip
	LDAk LIT "[ EQU ?&true
	DUP2 #0001 SUB2 LDA LIT "] EQU ?&false
	&skip

JMP2r
	&true [ LIT2 01 -state/f ] STZ JMP2r
	&false [ LIT2 00 -state/f ] STZ JMP2r

@scan-color ( addr* -- addr* color )

	.textarea/highlight LDZ ?&skip
	.state/c LDZ ?&comment
	DUP2 [ LIT2 &scope $2 ] EQU2 ?&parent
	LDAk LIT "@ EQU ?&label
	LDAk LIT "& EQU ?&label
	LDAk LIT "~ EQU ?&include
	LDAk LIT "" EQU ?&string
	&skip
	#01

JMP2r
	&comment #03 JMP2r
	&parent #09 JMP2r
	&label #02 JMP2r
	&include #06 JMP2r
	&string #0f JMP2r

@get-chr ( c -- addr* )

	DUP #09 EQU ?&tab
	#20 SUB
	DUP #5e GTH ?&unknown
	#00 SWP
	.state/f LDZ ?&fixed
	#50 SFT2 ;font/glyphs ADD2

JMP2r
	&fixed #40 SFT2 ;font-mono/glyphs ADD2 JMP2r
	&tab POP ;tab-icn JMP2r
	&unknown POP ;checkered-icn JMP2r

@get-strw ( str* -- width* )

	LIT2r 0000
	LDAk #00 EQU ?&skip
	&w
		get-segw STH2 ADD2r
		INC2 LDAk ?&w
		&skip
	POP2
	STH2r

JMP2r

@get-segw ( addr* -- addr* width* )

	DUP2 is-rune ?&special LDAk

!get-chrw
	&special #0007 JMP2r

@get-chrw ( c -- width* )

	DUP #7f GTH ?&unknown
	#0000 ROT
	.state/f LDZ ?&fixed
	;font ADD2 LDA

JMP2r
	&fixed ;font-mono ADD2 LDA JMP2r
	&unknown POP #0008 JMP2r

@is-selected ( addr* -- addr* bool )

	.selection/from LDZ2 SUB2k
	.selection/to LDZ2 ROT2 SUB2 LTH2

JMP2r

@is-rune ( addr* -- bool )

	.textarea/highlight LDZ ?&skip
	.state/c LDZ ?&skip
	INC2k LDA #21 LTH ?&skip
	LDA ;runes cndx INC2 ORA

JMP2r
	&skip POP2 #00 JMP2r

@get-eof ( -- addr* )

	;text .textarea/length LDZ2 ADD2

JMP2r

@count-lines ( -- line* )

	LITr -scroll/y LDZ2r
	.scroll/addr LDZ2
	&w
		LDAk #0a NEQ [ JMP INC2r ]
		INC2 LDAk ?&w
	POP2
	STH2r

JMP2r

@line-to-addr ( line* -- addr* )

	STH2
	LIT2r 0000
	;text
	&w
		EQU2kr STHr ?&end
		LDAk #0a NEQ [ JMP INC2r ]
		INC2 LDAk ?&w
	&end
	POP2r POP2r

JMP2r

@addr-to-line ( addr* -- line* )

	LIT2r 0000
	;text
	&l
		LDAk #0a NEQ [ JMP INC2r ]
		INC2 GTH2k ?&l
	POP2 POP2
	STH2r

JMP2r

@addr-to-x ( addr* -- x* )

	LIT2r 0000
	DUP2 find-line-start
	&l
		EQU2k ?&end
		get-segw STH2 ADD2r
		INC2 GTH2k ?&l
	&end
	POP2 POP2
	STH2r

JMP2r

(
@|drawing )

@redraw-all ( -- )


@@ 822,7 911,7 @@ JMP2r
	POP
	( setup )
	.selection/from LDZ2 get-current-marker
		get-marker ;walk-color/scope STA2
		get-marker ;scan-color/scope STA2
	#0000 .state STZ2
	( paint )
	#0010 .scroll/x LDZ2 SUB2 #0080 ADD2 .Screen/x DEO2


@@ 852,7 941,7 @@ JMP2r
		( glyph ) LDAk ;runes cndx #40 SFT2 ;rune-icns ADD2 #08 ROT ROT draw-glyph/seg
		INC2 !&w
		&no-rune
	( color ) walk-color ,&color STR
	( color ) scan-color ,&color STR
	&w
		is-selected STH
		LDAk [ LIT2 0d &color 00 ] STHr [ JMP SWP POP ] draw-glyph


@@ 871,48 960,6 @@ JMP2r

JMP2r

@scan-comment ( addr* -- addr* )

	.textarea/highlight LDZ ?&skip
	LDAk LIT "( EQU ?&true
	DUP2 #0001 SUB2 LDA LIT ") EQU ?&false
	&skip

JMP2r
	&true [ LIT2 01 -state/c ] STZ JMP2r
	&false [ LIT2 00 -state/c ] STZ JMP2r

@scan-fixed ( addr* -- addr* )

	.textarea/monospace LDZ ?&true
	.textarea/highlight LDZ ?&skip
	LDAk LIT "[ EQU ?&true
	DUP2 #0001 SUB2 LDA LIT "] EQU ?&false
	&skip

JMP2r
	&true [ LIT2 01 -state/f ] STZ JMP2r
	&false [ LIT2 00 -state/f ] STZ JMP2r

@walk-color ( addr* -- addr* color )

	.textarea/highlight LDZ ?&skip
	.state/c LDZ ?&comment
	DUP2 [ LIT2 &scope $2 ] EQU2 ?&parent
	LDAk LIT "@ EQU ?&label
	LDAk LIT "& EQU ?&label
	LDAk LIT "~ EQU ?&include
	LDAk LIT "" EQU ?&string
	&skip
	#01

JMP2r
	&comment #03 JMP2r
	&parent #09 JMP2r
	&label #02 JMP2r
	&include #06 JMP2r
	&string #0f JMP2r

@draw-glyph ( char color -- )

	;&color STA


@@ 1033,51 1080,6 @@ JMP2r

JMP2r

@get-chr ( c -- addr* )

	DUP #09 EQU ?&tab
	#20 SUB
	DUP #5e GTH ?&unknown
	#00 SWP
	.state/f LDZ ?&fixed
	#50 SFT2 ;font/glyphs ADD2

JMP2r
	&fixed #40 SFT2 ;font-mono/glyphs ADD2 JMP2r
	&tab POP ;tab-icn JMP2r
	&unknown POP ;checkered-icn JMP2r

@get-strw ( str* -- width* )

	LIT2r 0000
	LDAk #00 EQU ?&skip
	&w
		get-segw STH2 ADD2r
		INC2 LDAk ?&w
		&skip
	POP2
	STH2r

JMP2r

@get-segw ( addr* -- addr* width* )

	DUP2 is-rune ?&special LDAk

!get-chrw
	&special #0007 JMP2r

@get-chrw ( c -- width* )

	DUP #7f GTH ?&unknown
	#0000 ROT
	.state/f LDZ ?&fixed
	;font ADD2 LDA

JMP2r
	&fixed ;font-mono ADD2 LDA JMP2r
	&unknown POP #0008 JMP2r

@draw-str-right ( text* -- )

	DUP2 get-strw STH2


@@ 1183,6 1185,7 @@ JMP2r
@go-selection ( -- )

	.selection/from LDZ2 LDA2 [ LIT2 ".. ] EQU2 ?go-directory
	.selection/length LDZ2 #0002 GTH2 [ JMP JMP2r ]

	( append to path, if path is folder )
	[ LITr -filepath ]