Check-in [e88060e605]
Not logged in

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Image recognizer
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: e88060e605003cbc02ce18ae4e3049ed33889b59
User & Date: bernd 2019-11-27 22:36:37
Context
2019-11-28
14:48
Start image/thumbnail stuff check-in: b00fe09554 user: bernd tags: trunk
2019-11-27
22:36
Image recognizer check-in: e88060e605 user: bernd tags: trunk
21:43
Fix old my-addr$ problem check-in: 52a229cf9c user: bernd tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to msg.fs.

1609
1610
1611
1612
1613
1614
1615
1616
1617
1618

1619
1620
1621
1622
1623



1624
1625
1626


1627
1628
1629
1630
1631
1632
1633
1634
	[: $, msg-url ;] rectype-name
    ELSE  2drop rectype-null  THEN ;

forward hash-in

: jpeg? ( addr u -- flag )
    dup 4 - 0 max safe/string ".jpg" str= ;
: img-rec ( addr u -- )
    2dup "img:" string-prefix? IF
	over ?flush-text 2dup + to last->in

	2dup jpeg? IF
	    2dup >thumbnail
	    ?dup-IF  over >r hash-in r> free throw  THEN
	ELSE  #0.  THEN
	2swap slurp-file over >r hash-in r> free throw



	[: type dup IF  type img-orient 1- 0 max emit  ELSE  2drop  THEN ;] $tmp
	[: tuck $, >r msg:thumbnail# msg:image# r> $20 u> select ulit,
	    msg-object ;] rectype-name


    ELSE  2drop rectype-null  THEN ;

$Variable msg-recognizer
depth >r
' text-rec ' img-rec ' http-rec ' chain-rec ' tag-rec ' pk-rec
depth r> - msg-recognizer set-stack

: parse-text ( addr u -- ) last# >r  forth-recognizer >r







|

|
>
|
|
|
|
|
>
>
>
|
|
|
>
>
|







1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
	[: $, msg-url ;] rectype-name
    ELSE  2drop rectype-null  THEN ;

forward hash-in

: jpeg? ( addr u -- flag )
    dup 4 - 0 max safe/string ".jpg" str= ;
: img-rec ( addr u -- .. token )
    2dup "img:" string-prefix? IF
	over ?flush-text
	[:  2dup + >r
	    4 /string save-mem over >r 2dup jpeg? IF
		2dup >thumbnail
		?dup-IF  over >r hash-in save-mem r> free throw  THEN
	    ELSE  #0.  THEN
	    2swap slurp-file over >r hash-in r> free throw
	    [: forth:type dup IF
		    over >r forth:type img-orient 1- 0 max forth:emit
		    r> free throw
		ELSE  2drop  THEN ;] $tmp r> free throw
	    [: dup >r $, msg:thumbnail# msg:image# r> $20 u> select ulit,
		msg-object ;]
	    r> to last->in ;]
	catch 0= IF  rectype-name  EXIT  THEN  THEN
    2drop rectype-null ;

$Variable msg-recognizer
depth >r
' text-rec ' img-rec ' http-rec ' chain-rec ' tag-rec ' pk-rec
depth r> - msg-recognizer set-stack

: parse-text ( addr u -- ) last# >r  forth-recognizer >r