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: |
e88060e605003cbc02ce18ae4e3049ed |
| 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
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
|