Artifact
863f08400b6b0bb94238d878eedbc438c1252996
File
qrscan-base.fs
— part of check-in
[33329e9994]
at
2018-01-21 17:48:34
on branch trunk
— Separate android and generic qrscan code
(user:
bernd
size: 9030)
0000: 5c 20 73 63 61 6e 20 63 6f 6c 6f 72 20 51 52 20 \ scan color QR
0010: 63 6f 64 65 73 20 6f 6e 20 41 6e 64 72 6f 69 64 codes on Android
0020: 0a 0a 5c 20 43 6f 70 79 72 69 67 68 74 20 28 43 ..\ Copyright (C
0030: 29 20 32 30 31 36 2d 32 30 31 38 20 20 20 42 65 ) 2016-2018 Be
0040: 72 6e 64 20 50 61 79 73 61 6e 0a 0a 5c 20 54 68 rnd Paysan..\ Th
0050: 69 73 20 70 72 6f 67 72 61 6d 20 69 73 20 66 72 is program is fr
0060: 65 65 20 73 6f 66 74 77 61 72 65 3a 20 79 6f 75 ee software: you
0070: 20 63 61 6e 20 72 65 64 69 73 74 72 69 62 75 74 can redistribut
0080: 65 20 69 74 20 61 6e 64 2f 6f 72 20 6d 6f 64 69 e it and/or modi
0090: 66 79 0a 5c 20 69 74 20 75 6e 64 65 72 20 74 68 fy.\ it under th
00a0: 65 20 74 65 72 6d 73 20 6f 66 20 74 68 65 20 47 e terms of the G
00b0: 4e 55 20 41 66 66 65 72 6f 20 47 65 6e 65 72 61 NU Affero Genera
00c0: 6c 20 50 75 62 6c 69 63 20 4c 69 63 65 6e 73 65 l Public License
00d0: 20 61 73 20 70 75 62 6c 69 73 68 65 64 20 62 79 as published by
00e0: 0a 5c 20 74 68 65 20 46 72 65 65 20 53 6f 66 74 .\ the Free Soft
00f0: 77 61 72 65 20 46 6f 75 6e 64 61 74 69 6f 6e 2c ware Foundation,
0100: 20 65 69 74 68 65 72 20 76 65 72 73 69 6f 6e 20 either version
0110: 33 20 6f 66 20 74 68 65 20 4c 69 63 65 6e 73 65 3 of the License
0120: 2c 20 6f 72 0a 5c 20 28 61 74 20 79 6f 75 72 20 , or.\ (at your
0130: 6f 70 74 69 6f 6e 29 20 61 6e 79 20 6c 61 74 65 option) any late
0140: 72 20 76 65 72 73 69 6f 6e 2e 0a 0a 5c 20 54 68 r version...\ Th
0150: 69 73 20 70 72 6f 67 72 61 6d 20 69 73 20 64 69 is program is di
0160: 73 74 72 69 62 75 74 65 64 20 69 6e 20 74 68 65 stributed in the
0170: 20 68 6f 70 65 20 74 68 61 74 20 69 74 20 77 69 hope that it wi
0180: 6c 6c 20 62 65 20 75 73 65 66 75 6c 2c 0a 5c 20 ll be useful,.\
0190: 62 75 74 20 57 49 54 48 4f 55 54 20 41 4e 59 20 but WITHOUT ANY
01a0: 57 41 52 52 41 4e 54 59 3b 20 77 69 74 68 6f 75 WARRANTY; withou
01b0: 74 20 65 76 65 6e 20 74 68 65 20 69 6d 70 6c 69 t even the impli
01c0: 65 64 20 77 61 72 72 61 6e 74 79 20 6f 66 0a 5c ed warranty of.\
01d0: 20 4d 45 52 43 48 41 4e 54 41 42 49 4c 49 54 59 MERCHANTABILITY
01e0: 20 6f 72 20 46 49 54 4e 45 53 53 20 46 4f 52 20 or FITNESS FOR
01f0: 41 20 50 41 52 54 49 43 55 4c 41 52 20 50 55 52 A PARTICULAR PUR
0200: 50 4f 53 45 2e 20 20 53 65 65 20 74 68 65 0a 5c POSE. See the.\
0210: 20 47 4e 55 20 41 66 66 65 72 6f 20 47 65 6e 65 GNU Affero Gene
0220: 72 61 6c 20 50 75 62 6c 69 63 20 4c 69 63 65 6e ral Public Licen
0230: 73 65 20 66 6f 72 20 6d 6f 72 65 20 64 65 74 61 se for more deta
0240: 69 6c 73 2e 0a 0a 5c 20 59 6f 75 20 73 68 6f 75 ils...\ You shou
0250: 6c 64 20 68 61 76 65 20 72 65 63 65 69 76 65 64 ld have received
0260: 20 61 20 63 6f 70 79 20 6f 66 20 74 68 65 20 47 a copy of the G
0270: 4e 55 20 41 66 66 65 72 6f 20 47 65 6e 65 72 61 NU Affero Genera
0280: 6c 20 50 75 62 6c 69 63 20 4c 69 63 65 6e 73 65 l Public License
0290: 0a 5c 20 61 6c 6f 6e 67 20 77 69 74 68 20 74 68 .\ along with th
02a0: 69 73 20 70 72 6f 67 72 61 6d 2e 20 20 49 66 20 is program. If
02b0: 6e 6f 74 2c 20 73 65 65 20 3c 68 74 74 70 3a 2f not, see <http:/
02c0: 2f 77 77 77 2e 67 6e 75 2e 6f 72 67 2f 6c 69 63 /www.gnu.org/lic
02d0: 65 6e 73 65 73 2f 3e 2e 0a 0a 5c 20 73 63 61 6e enses/>...\ scan
02e0: 20 6d 61 74 72 69 78 20 6d 61 6e 69 70 75 6c 61 matrix manipula
02f0: 74 69 6f 6e 0a 0a 43 72 65 61 74 65 20 73 63 61 tion..Create sca
0300: 6e 2d 6d 61 74 72 69 78 0a 31 2e 30 65 20 73 66 n-matrix.1.0e sf
0310: 2c 20 30 2e 30 65 20 73 66 2c 20 30 2e 30 65 20 , 0.0e sf, 0.0e
0320: 73 66 2c 20 30 2e 30 65 20 73 66 2c 0a 30 2e 30 sf, 0.0e sf,.0.0
0330: 65 20 73 66 2c 20 31 2e 30 65 20 73 66 2c 20 30 e sf, 1.0e sf, 0
0340: 2e 30 65 20 73 66 2c 20 30 2e 30 65 20 73 66 2c .0e sf, 0.0e sf,
0350: 0a 30 2e 30 65 20 73 66 2c 20 30 2e 30 65 20 73 .0.0e sf, 0.0e s
0360: 66 2c 20 31 2e 30 65 20 73 66 2c 20 30 2e 30 65 f, 1.0e sf, 0.0e
0370: 20 73 66 2c 0a 30 2e 30 65 20 73 66 2c 20 30 2e sf,.0.0e sf, 0.
0380: 30 65 20 73 66 2c 20 30 2e 30 65 20 73 66 2c 20 0e sf, 0.0e sf,
0390: 31 2e 30 65 20 73 66 2c 0a 0a 33 32 20 73 66 6c 1.0e sf,..32 sfl
03a0: 6f 61 74 73 20 62 75 66 66 65 72 3a 20 73 63 61 oats buffer: sca
03b0: 6e 2d 69 6e 76 65 72 73 65 0a 0a 32 30 2e 30 65 n-inverse..20.0e
03c0: 20 46 56 61 6c 75 65 20 78 2d 73 63 61 6e 73 69 FValue x-scansi
03d0: 7a 65 0a 32 30 2e 37 35 65 20 46 56 61 6c 75 65 ze.20.75e FValue
03e0: 20 79 2d 73 63 61 6e 73 69 7a 65 0a 0a 30 2e 35 y-scansize..0.5
03f0: 65 20 46 56 61 6c 75 65 20 79 2d 6f 66 66 73 65 e FValue y-offse
0400: 74 0a 30 2e 30 65 20 46 56 61 6c 75 65 20 78 2d t.0.0e FValue x-
0410: 6f 66 66 73 65 74 0a 0a 5c 20 6d 61 74 72 69 78 offset..\ matrix
0420: 20 69 6e 76 65 72 73 69 6f 6e 0a 0a 27 20 64 66 inversion..' df
0430: 6c 6f 61 74 73 20 61 6c 69 61 73 20 38 2a 0a 3a loats alias 8*.:
0440: 20 2e 6d 61 74 20 7b 20 6d 61 74 20 2d 2d 20 7d .mat { mat -- }
0450: 0a 20 20 20 20 34 20 30 20 44 4f 20 20 63 72 0a . 4 0 DO cr.
0460: 09 38 20 30 20 44 4f 0a 09 20 20 20 20 6d 61 74 .8 0 DO.. mat
0470: 20 4a 20 38 2a 20 49 20 2b 20 73 66 6c 6f 61 74 J 8* I + sfloat
0480: 73 20 2b 20 73 66 40 20 66 2e 0a 09 4c 4f 4f 50 s + sf@ f...LOOP
0490: 0a 20 20 20 20 4c 4f 4f 50 20 3b 0a 3a 20 69 6e . LOOP ;.: in
04a0: 69 74 2d 73 63 61 6e 27 20 28 20 2d 2d 20 29 0a it-scan' ( -- ).
04b0: 20 20 20 20 73 63 61 6e 2d 69 6e 76 65 72 73 65 scan-inverse
04c0: 20 5b 20 33 32 20 73 66 6c 6f 61 74 73 20 5d 4c [ 32 sfloats ]L
04d0: 20 32 64 75 70 20 65 72 61 73 65 20 20 62 6f 75 2dup erase bou
04e0: 6e 64 73 20 3f 44 4f 0a 09 31 65 20 66 64 75 70 nds ?DO..1e fdup
04f0: 20 49 20 73 66 21 20 49 20 5b 20 34 20 73 66 6c I sf! I [ 4 sfl
0500: 6f 61 74 73 20 5d 4c 20 2b 20 73 66 21 0a 20 20 oats ]L + sf!.
0510: 20 20 5b 20 39 20 73 66 6c 6f 61 74 73 20 5d 4c [ 9 sfloats ]L
0520: 20 2b 4c 4f 4f 50 20 3b 0a 3a 20 73 66 61 78 2b +LOOP ;.: sfax+
0530: 79 38 20 28 20 72 61 20 61 64 64 72 31 20 61 64 y8 ( ra addr1 ad
0540: 64 72 32 20 2d 2d 20 29 0a 20 20 20 20 5b 20 38 dr2 -- ). [ 8
0550: 20 73 66 6c 6f 61 74 73 20 5d 4c 20 62 6f 75 6e sfloats ]L boun
0560: 64 73 20 3f 44 4f 0a 09 64 75 70 20 73 66 40 20 ds ?DO..dup sf@
0570: 66 6f 76 65 72 20 49 20 73 66 40 20 66 2a 20 66 fover I sf@ f* f
0580: 2b 20 64 75 70 20 73 66 21 20 73 66 6c 6f 61 74 + dup sf! sfloat
0590: 2b 0a 20 20 20 20 5b 20 31 20 73 66 6c 6f 61 74 +. [ 1 sfloat
05a0: 73 20 5d 4c 20 2b 4c 4f 4f 50 20 20 64 72 6f 70 s ]L +LOOP drop
05b0: 20 66 64 72 6f 70 20 3b 0a 3a 20 73 66 61 78 38 fdrop ;.: sfax8
05c0: 20 28 20 72 61 20 61 64 64 72 20 2d 2d 20 29 0a ( ra addr -- ).
05d0: 20 20 20 20 5b 20 38 20 73 66 6c 6f 61 74 73 20 [ 8 sfloats
05e0: 5d 4c 20 62 6f 75 6e 64 73 20 3f 44 4f 0a 09 66 ]L bounds ?DO..f
05f0: 64 75 70 20 49 20 73 66 40 20 66 2a 20 49 20 73 dup I sf@ f* I s
0600: 66 21 0a 20 20 20 20 5b 20 31 20 73 66 6c 6f 61 f!. [ 1 sfloa
0610: 74 73 20 5d 4c 20 2b 4c 4f 4f 50 20 20 66 64 72 ts ]L +LOOP fdr
0620: 6f 70 20 3b 0a 3a 20 74 69 6a 38 20 28 20 61 64 op ;.: tij8 ( ad
0630: 64 72 31 20 61 64 64 72 32 20 2d 2d 20 29 0a 20 dr1 addr2 -- ).
0640: 20 20 20 5b 20 38 20 73 66 6c 6f 61 74 73 20 5d [ 8 sfloats ]
0650: 4c 20 62 6f 75 6e 64 73 20 3f 44 4f 0a 09 64 75 L bounds ?DO..du
0660: 70 20 73 66 40 20 49 20 73 66 40 20 64 75 70 20 p sf@ I sf@ dup
0670: 73 66 21 20 49 20 73 66 21 20 73 66 6c 6f 61 74 sf! I sf! sfloat
0680: 2b 0a 20 20 20 20 5b 20 31 20 73 66 6c 6f 61 74 +. [ 1 sfloat
0690: 73 20 5d 4c 20 2b 4c 4f 4f 50 20 20 64 72 6f 70 s ]L +LOOP drop
06a0: 20 3b 0a 20 20 20 20 0a 3a 20 6d 61 74 72 69 78 ;. .: matrix
06b0: 2d 69 6e 76 65 72 74 34 20 7b 20 6d 61 74 20 2d -invert4 { mat -
06c0: 2d 20 7d 20 5c 20 73 68 6f 72 74 63 75 74 20 74 - } \ shortcut t
06d0: 6f 20 69 6e 76 65 72 74 20 74 79 70 69 63 61 6c o invert typical
06e0: 20 6d 61 74 72 69 78 0a 20 20 20 20 6d 61 74 20 matrix. mat
06f0: 73 66 40 20 66 61 62 73 20 6d 61 74 20 5b 20 38 sf@ fabs mat [ 8
0700: 20 73 66 6c 6f 61 74 73 20 5d 4c 20 2b 20 73 66 sfloats ]L + sf
0710: 40 20 66 61 62 73 20 66 3c 20 49 46 0a 09 6d 61 @ fabs f< IF..ma
0720: 74 20 64 75 70 20 5b 20 38 20 73 66 6c 6f 61 74 t dup [ 8 sfloat
0730: 73 20 5d 4c 20 2b 20 74 69 6a 38 20 5c 20 65 78 s ]L + tij8 \ ex
0740: 63 68 61 6e 67 65 20 74 77 6f 20 6c 69 6e 65 73 change two lines
0750: 0a 20 20 20 20 54 48 45 4e 0a 20 20 20 20 34 20 . THEN. 4
0760: 30 20 44 4f 0a 09 34 20 30 20 44 4f 0a 09 20 20 0 DO..4 0 DO..
0770: 20 20 6d 61 74 20 4a 20 5b 20 39 20 73 66 6c 6f mat J [ 9 sflo
0780: 61 74 73 20 5d 4c 20 2a 20 2b 20 73 66 40 20 31 ats ]L * + sf@ 1
0790: 2f 66 0a 09 20 20 20 20 49 20 4a 20 3c 3e 20 49 /f.. I J <> I
07a0: 46 0a 09 09 6d 61 74 20 49 20 38 2a 20 73 66 6c F...mat I 8* sfl
07b0: 6f 61 74 73 20 2b 0a 09 09 6d 61 74 20 4a 20 38 oats +...mat J 8
07c0: 2a 20 73 66 6c 6f 61 74 73 20 2b 0a 09 09 6f 76 * sfloats +...ov
07d0: 65 72 20 4a 20 73 66 6c 6f 61 74 73 20 2b 20 73 er J sfloats + s
07e0: 66 40 20 66 2a 20 66 6e 65 67 61 74 65 20 73 66 f@ f* fnegate sf
07f0: 61 78 2b 79 38 0a 09 20 20 20 20 45 4c 53 45 0a ax+y8.. ELSE.
0800: 09 09 6d 61 74 20 4a 20 38 2a 20 73 66 6c 6f 61 ..mat J 8* sfloa
0810: 74 73 20 2b 20 73 66 61 78 38 0a 09 20 20 20 20 ts + sfax8..
0820: 54 48 45 4e 0a 09 20 20 20 20 28 20 6d 61 74 20 THEN.. ( mat
0830: 2e 6d 61 74 20 63 72 20 29 20 5c 20 64 65 62 75 .mat cr ) \ debu
0840: 67 67 69 6e 67 20 6f 75 74 70 75 74 0a 09 4c 4f gging output..LO
0850: 4f 50 0a 20 20 20 20 4c 4f 4f 50 20 3b 0a 0a 73 OP. LOOP ;..s
0860: 63 61 6e 2d 69 6e 76 65 72 73 65 20 20 30 20 73 can-inverse 0 s
0870: 66 6c 6f 61 74 73 20 2b 20 43 6f 6e 73 74 61 6e floats + Constan
0880: 74 20 78 2d 73 63 61 6c 65 0a 73 63 61 6e 2d 69 t x-scale.scan-i
0890: 6e 76 65 72 73 65 20 20 31 20 73 66 6c 6f 61 74 nverse 1 sfloat
08a0: 73 20 2b 20 43 6f 6e 73 74 61 6e 74 20 79 2d 72 s + Constant y-r
08b0: 6f 74 73 0a 73 63 61 6e 2d 69 6e 76 65 72 73 65 ots.scan-inverse
08c0: 20 20 38 20 73 66 6c 6f 61 74 73 20 2b 20 43 6f 8 sfloats + Co
08d0: 6e 73 74 61 6e 74 20 78 2d 72 6f 74 73 0a 73 63 nstant x-rots.sc
08e0: 61 6e 2d 69 6e 76 65 72 73 65 20 20 39 20 73 66 an-inverse 9 sf
08f0: 6c 6f 61 74 73 20 2b 20 43 6f 6e 73 74 61 6e 74 loats + Constant
0900: 20 79 2d 73 63 61 6c 65 0a 73 63 61 6e 2d 69 6e y-scale.scan-in
0910: 76 65 72 73 65 20 32 34 20 73 66 6c 6f 61 74 73 verse 24 sfloats
0920: 20 2b 20 43 6f 6e 73 74 61 6e 74 20 78 2d 73 70 + Constant x-sp
0930: 6f 73 0a 73 63 61 6e 2d 69 6e 76 65 72 73 65 20 os.scan-inverse
0940: 32 35 20 73 66 6c 6f 61 74 73 20 2b 20 43 6f 6e 25 sfloats + Con
0950: 73 74 61 6e 74 20 79 2d 73 70 6f 73 0a 0a 3a 20 stant y-spos..:
0960: 3e 73 63 61 6e 2d 6d 61 74 72 69 78 20 28 20 2d >scan-matrix ( -
0970: 2d 20 29 0a 20 20 20 20 73 63 61 6e 2d 69 6e 76 - ). scan-inv
0980: 65 72 73 65 20 6d 61 74 72 69 78 2d 69 6e 76 65 erse matrix-inve
0990: 72 74 34 0a 20 20 20 20 73 63 61 6e 2d 6d 61 74 rt4. scan-mat
09a0: 72 69 78 20 5b 20 73 63 61 6e 2d 69 6e 76 65 72 rix [ scan-inver
09b0: 73 65 20 34 20 73 66 6c 6f 61 74 73 20 2b 20 5d se 4 sfloats + ]
09c0: 4c 20 5b 20 33 32 20 73 66 6c 6f 61 74 73 20 5d L [ 32 sfloats ]
09d0: 4c 20 62 6f 75 6e 64 73 20 3f 44 4f 0a 09 49 20 L bounds ?DO..I
09e0: 6f 76 65 72 20 5b 20 34 20 73 66 6c 6f 61 74 73 over [ 4 sfloats
09f0: 20 5d 4c 20 6d 6f 76 65 20 20 5b 20 34 20 73 66 ]L move [ 4 sf
0a00: 6c 6f 61 74 73 20 5d 4c 20 2b 0a 20 20 20 20 5b loats ]L +. [
0a10: 20 38 20 73 66 6c 6f 61 74 73 20 5d 4c 20 2b 4c 8 sfloats ]L +L
0a20: 4f 4f 50 20 20 64 72 6f 70 20 3b 0a 0a 24 34 30 OOP drop ;..$40
0a30: 20 56 61 6c 75 65 20 73 63 61 6e 2d 77 0a 73 63 Value scan-w.sc
0a40: 61 6e 2d 77 20 64 75 70 20 2a 20 31 2d 20 32 2f an-w dup * 1- 2/
0a50: 20 31 2b 20 43 6f 6e 73 74 61 6e 74 20 62 75 66 1+ Constant buf
0a60: 2d 6c 65 6e 0a 0a 61 6c 73 6f 20 6f 70 65 6e 67 -len..also openg
0a70: 6c 20 61 6c 73 6f 20 61 6e 64 72 6f 69 64 0a 0a l also android..
0a80: 3a 20 76 32 73 63 61 6c 65 20 28 20 78 20 79 20 : v2scale ( x y
0a90: 73 63 61 6c 65 20 2d 2d 20 29 20 66 74 75 63 6b scale -- ) ftuck
0aa0: 20 66 2a 20 66 72 6f 74 20 66 72 6f 74 20 66 2a f* frot frot f*
0ab0: 20 66 73 77 61 70 20 3b 0a 0a 3a 20 64 72 61 77 fswap ;..: draw
0ac0: 2d 73 63 61 6e 20 28 20 64 69 72 65 63 74 69 6f -scan ( directio
0ad0: 6e 20 2d 2d 20 29 0a 20 20 20 20 5c 47 20 64 72 n -- ). \G dr
0ae0: 61 77 20 61 20 73 63 61 6e 20 72 6f 74 61 74 65 aw a scan rotate
0af0: 64 20 62 79 20 72 61 6e 67 6c 65 0a 20 20 20 20 d by rangle.
0b00: 76 30 20 69 30 20 3e 76 0a 20 20 20 20 31 65 20 v0 i0 >v. 1e
0b10: 66 64 75 70 20 66 6e 65 67 61 74 65 20 7b 20 66 fdup fnegate { f
0b20: 3a 20 73 20 66 3a 20 2d 73 20 7d 0a 20 20 20 20 : s f: -s }.
0b30: 20 2d 73 20 20 73 20 3e 78 79 20 6e 3e 20 72 6f -s s >xy n> ro
0b40: 74 3e 73 74 20 20 20 24 30 30 30 30 30 30 46 46 t>st $000000FF
0b50: 20 72 67 62 61 3e 63 20 76 2b 0a 20 20 20 20 20 rgba>c v+.
0b60: 20 73 20 20 73 20 3e 78 79 20 6e 3e 20 72 6f 74 s s >xy n> rot
0b70: 3e 73 74 20 20 20 24 30 30 30 30 30 30 46 46 20 >st $000000FF
0b80: 72 67 62 61 3e 63 20 76 2b 0a 20 20 20 20 20 20 rgba>c v+.
0b90: 73 20 2d 73 20 3e 78 79 20 6e 3e 20 72 6f 74 3e s -s >xy n> rot>
0ba0: 73 74 20 20 20 24 30 30 30 30 30 30 46 46 20 72 st $000000FF r
0bb0: 67 62 61 3e 63 20 76 2b 0a 20 20 20 20 20 2d 73 gba>c v+. -s
0bc0: 20 2d 73 20 3e 78 79 20 6e 3e 20 72 6f 74 3e 73 -s >xy n> rot>s
0bd0: 74 20 20 20 24 30 30 30 30 30 30 46 46 20 72 67 t $000000FF rg
0be0: 62 61 3e 63 20 76 2b 0a 20 20 20 20 76 3e 20 64 ba>c v+. v> d
0bf0: 72 6f 70 20 30 20 69 2c 20 31 20 69 2c 20 32 20 rop 0 i, 1 i, 2
0c00: 69 2c 20 30 20 69 2c 20 32 20 69 2c 20 33 20 69 i, 0 i, 2 i, 3 i
0c10: 2c 0a 20 20 20 20 47 4c 5f 54 52 49 41 4e 47 4c ,. GL_TRIANGL
0c20: 45 53 20 64 72 61 77 2d 65 6c 65 6d 65 6e 74 73 ES draw-elements
0c30: 20 3b 0a 0a 3a 20 73 63 61 6e 2d 66 72 61 6d 65 ;..: scan-frame
0c40: 30 20 28 20 2d 2d 20 29 0a 20 20 20 20 30 65 20 0 ( -- ). 0e
0c50: 66 64 75 70 20 78 2d 70 6f 73 20 73 66 21 20 3e fdup x-pos sf! >
0c60: 79 2d 70 6f 73 0a 20 20 20 20 75 6e 69 74 2d 6d y-pos. unit-m
0c70: 61 74 72 69 78 20 4d 56 4d 61 74 72 69 78 20 73 atrix MVMatrix s
0c80: 65 74 2d 6d 61 74 72 69 78 20 30 20 64 72 61 77 et-matrix 0 draw
0c90: 2d 73 63 61 6e 20 3b 0a 0a 56 61 72 69 61 62 6c -scan ;..Variabl
0ca0: 65 20 73 63 61 6e 2d 62 75 66 30 0a 56 61 72 69 e scan-buf0.Vari
0cb0: 61 62 6c 65 20 73 63 61 6e 2d 62 75 66 31 0a 56 able scan-buf1.V
0cc0: 61 72 69 61 62 6c 65 20 72 65 64 2d 62 75 66 0a ariable red-buf.
0cd0: 56 61 72 69 61 62 6c 65 20 67 72 65 65 6e 2d 62 Variable green-b
0ce0: 75 66 0a 56 61 72 69 61 62 6c 65 20 62 6c 75 65 uf.Variable blue
0cf0: 2d 62 75 66 0a 0a 24 45 38 20 56 61 6c 75 65 20 -buf..$E8 Value
0d00: 62 6c 75 65 2d 6c 65 76 65 6c 23 0a 24 42 30 20 blue-level#.$B0
0d10: 56 61 6c 75 65 20 67 72 65 65 6e 2d 6c 65 76 65 Value green-leve
0d20: 6c 23 0a 24 42 30 20 56 61 6c 75 65 20 72 65 64 l#.$B0 Value red
0d30: 2d 6c 65 76 65 6c 23 0a 0a 3a 20 65 78 74 72 61 -level#..: extra
0d40: 63 74 2d 62 75 66 20 28 20 6f 66 66 73 65 74 20 ct-buf ( offset
0d50: 62 75 66 20 6c 65 76 65 6c 20 2d 2d 20 29 20 7b buf level -- ) {
0d60: 20 6c 65 76 65 6c 20 7d 0a 20 20 20 20 62 75 66 level }. buf
0d70: 2d 6c 65 6e 20 6f 76 65 72 20 24 21 6c 65 6e 0a -len over $!len.
0d80: 20 20 20 20 24 40 20 64 72 6f 70 20 73 77 61 70 $@ drop swap
0d90: 0a 20 20 20 20 73 63 61 6e 2d 62 75 66 31 20 24 . scan-buf1 $
0da0: 40 20 3e 72 20 2b 20 72 3e 20 62 6f 75 6e 64 73 @ >r + r> bounds
0db0: 20 3f 44 4f 20 20 30 0a 09 49 20 38 20 73 66 6c ?DO 0..I 8 sfl
0dc0: 6f 61 74 73 20 62 6f 75 6e 64 73 20 44 4f 0a 09 oats bounds DO..
0dd0: 20 20 20 20 32 2a 20 49 20 63 40 20 6c 65 76 65 2* I c@ leve
0de0: 6c 20 75 3c 20 2d 0a 09 63 65 6c 6c 20 2b 4c 4f l u< -..cell +LO
0df0: 4f 50 20 20 6f 76 65 72 20 63 21 20 31 2b 0a 20 OP over c! 1+.
0e00: 20 20 20 38 20 73 66 6c 6f 61 74 73 20 2b 4c 4f 8 sfloats +LO
0e10: 4f 50 20 20 64 72 6f 70 20 3b 0a 0a 3a 20 65 78 OP drop ;..: ex
0e20: 74 72 61 63 74 2d 72 65 64 20 20 20 28 20 2d 2d tract-red ( --
0e30: 20 29 20 20 30 20 72 65 64 2d 62 75 66 20 20 20 ) 0 red-buf
0e40: 72 65 64 2d 6c 65 76 65 6c 23 20 20 20 65 78 74 red-level# ext
0e50: 72 61 63 74 2d 62 75 66 20 3b 0a 3a 20 65 78 74 ract-buf ;.: ext
0e60: 72 61 63 74 2d 67 72 65 65 6e 20 28 20 2d 2d 20 ract-green ( --
0e70: 29 20 20 31 20 67 72 65 65 6e 2d 62 75 66 20 67 ) 1 green-buf g
0e80: 72 65 65 6e 2d 6c 65 76 65 6c 23 20 65 78 74 72 reen-level# extr
0e90: 61 63 74 2d 62 75 66 20 3b 0a 3a 20 65 78 74 72 act-buf ;.: extr
0ea0: 61 63 74 2d 62 6c 75 65 20 20 28 20 2d 2d 20 29 act-blue ( -- )
0eb0: 20 20 32 20 62 6c 75 65 2d 62 75 66 20 20 62 6c 2 blue-buf bl
0ec0: 75 65 2d 6c 65 76 65 6c 23 20 20 65 78 74 72 61 ue-level# extra
0ed0: 63 74 2d 62 75 66 20 3b 0a 0a 3a 20 2e 62 75 66 ct-buf ;..: .buf
0ee0: 20 28 20 61 64 64 72 20 2d 2d 20 29 0a 20 20 20 ( addr -- ).
0ef0: 20 5b 3a 20 30 20 73 77 61 70 20 24 40 20 62 6f [: 0 swap $@ bo
0f00: 75 6e 64 73 20 3f 44 4f 20 20 63 72 0a 09 20 20 unds ?DO cr..
0f10: 20 20 64 75 70 20 33 20 2e 72 20 73 70 61 63 65 dup 3 .r space
0f20: 20 31 2b 0a 09 20 20 20 20 49 20 73 63 61 6e 2d 1+.. I scan-
0f30: 77 20 32 20 72 73 68 69 66 74 20 62 6f 75 6e 64 w 2 rshift bound
0f40: 73 20 3f 44 4f 0a 09 09 49 20 63 40 20 30 20 3c s ?DO...I c@ 0 <
0f50: 23 20 23 20 23 20 23 3e 20 74 79 70 65 0a 09 20 # # # #> type..
0f60: 20 20 20 4c 4f 4f 50 0a 09 73 63 61 6e 2d 77 20 LOOP..scan-w
0f70: 32 20 72 73 68 69 66 74 20 2b 4c 4f 4f 50 20 64 2 rshift +LOOP d
0f80: 72 6f 70 20 3b 5d 20 24 31 30 20 62 61 73 65 2d rop ;] $10 base-
0f90: 65 78 65 63 75 74 65 20 3b 0a 0a 3a 20 2e 72 65 execute ;..: .re
0fa0: 64 20 20 20 28 20 2d 2d 20 29 20 72 65 64 2d 62 d ( -- ) red-b
0fb0: 75 66 20 20 20 2e 62 75 66 20 3b 0a 3a 20 2e 67 uf .buf ;.: .g
0fc0: 72 65 65 6e 20 28 20 2d 2d 20 29 20 67 72 65 65 reen ( -- ) gree
0fd0: 6e 2d 62 75 66 20 2e 62 75 66 20 3b 0a 3a 20 2e n-buf .buf ;.: .
0fe0: 62 6c 75 65 20 20 28 20 2d 2d 20 29 20 62 6c 75 blue ( -- ) blu
0ff0: 65 2d 62 75 66 20 20 2e 62 75 66 20 3b 0a 0a 3a e-buf .buf ;..:
1000: 20 6d 69 78 67 72 3e 33 32 20 28 20 31 36 72 65 mixgr>32 ( 16re
1010: 64 20 31 36 67 72 65 65 6e 20 2d 2d 20 33 32 72 d 16green -- 32r
1020: 65 73 75 6c 74 20 29 0a 20 20 20 20 30 20 24 31 esult ). 0 $1
1030: 30 20 30 20 44 4f 0a 09 32 2a 20 32 2a 0a 09 6f 0 0 DO..2* 2*..o
1040: 76 65 72 20 24 45 20 72 73 68 69 66 74 20 32 20 ver $E rshift 2
1050: 61 6e 64 20 6f 72 20 3e 72 0a 09 6f 76 65 72 20 and or >r..over
1060: 24 46 20 72 73 68 69 66 74 20 31 20 61 6e 64 20 $F rshift 1 and
1070: 72 3e 20 6f 72 20 3e 72 0a 09 32 2a 20 73 77 61 r> or >r..2* swa
1080: 70 20 32 2a 20 73 77 61 70 20 72 3e 0a 20 20 20 p 2* swap r>.
1090: 20 4c 4f 4f 50 20 20 6e 69 70 20 6e 69 70 20 3b LOOP nip nip ;
10a0: 0a 0a 24 35 31 20 62 75 66 66 65 72 3a 20 67 75 ..$51 buffer: gu
10b0: 65 73 73 62 75 66 0a 67 75 65 73 73 62 75 66 20 essbuf.guessbuf
10c0: 24 34 30 20 2b 20 43 6f 6e 73 74 61 6e 74 20 67 $40 + Constant g
10d0: 75 65 73 73 65 63 63 0a 67 75 65 73 73 65 63 63 uessecc.guessecc
10e0: 20 24 31 30 20 2b 20 43 6f 6e 73 74 61 6e 74 20 $10 + Constant
10f0: 67 75 65 73 73 74 61 67 0a 0a 73 63 61 6e 2d 77 guesstag..scan-w
1100: 20 32 20 72 73 68 69 66 74 20 63 6f 6e 73 74 61 2 rshift consta
1110: 6e 74 20 73 63 61 6e 2d 73 74 65 70 0a 73 63 61 nt scan-step.sca
1120: 6e 2d 73 74 65 70 20 64 75 70 20 73 63 61 6e 2d n-step dup scan-
1130: 77 20 39 20 2d 20 2a 20 73 77 61 70 20 32 2f 20 w 9 - * swap 2/
1140: 31 2d 20 2b 20 43 6f 6e 73 74 61 6e 74 20 73 63 1- + Constant sc
1150: 61 6e 2d 74 6f 70 0a 73 63 61 6e 2d 73 74 65 70 an-top.scan-step
1160: 20 64 75 70 20 73 63 61 6e 2d 77 20 37 20 2b 20 dup scan-w 7 +
1170: 2a 20 73 77 61 70 20 32 2f 20 31 2d 20 2b 20 43 * swap 2/ 1- + C
1180: 6f 6e 73 74 61 6e 74 20 73 63 61 6e 2d 62 6f 74 onstant scan-bot
1190: 0a 73 63 61 6e 2d 73 74 65 70 20 64 75 70 20 73 .scan-step dup s
11a0: 63 61 6e 2d 77 20 38 20 2b 20 2a 20 73 77 61 70 can-w 8 + * swap
11b0: 20 32 2f 20 31 2d 20 2b 20 43 6f 6e 73 74 61 6e 2/ 1- + Constan
11c0: 74 20 73 63 61 6e 2d 65 63 63 0a 0a 3a 20 65 63 t scan-ecc..: ec
11d0: 63 2d 68 6f 72 40 20 28 20 6f 66 66 20 2d 2d 20 c-hor@ ( off --
11e0: 77 31 20 77 32 20 29 20 3e 72 0a 20 20 20 20 72 w1 w2 ) >r. r
11f0: 65 64 2d 62 75 66 20 20 20 24 40 20 64 72 6f 70 ed-buf $@ drop
1200: 20 72 40 20 2b 20 62 65 2d 75 77 40 0a 20 20 20 r@ + be-uw@.
1210: 20 67 72 65 65 6e 2d 62 75 66 20 24 40 20 64 72 green-buf $@ dr
1220: 6f 70 20 72 3e 20 2b 20 62 65 2d 75 77 40 20 6d op r> + be-uw@ m
1230: 69 78 67 72 3e 33 32 20 3b 0a 3a 20 3e 67 75 65 ixgr>32 ;.: >gue
1240: 73 73 20 28 20 2d 2d 20 61 64 64 72 20 75 20 29 ss ( -- addr u )
1250: 0a 20 20 20 20 67 75 65 73 73 62 75 66 0a 20 20 . guessbuf.
1260: 20 20 73 63 61 6e 2d 74 6f 70 20 73 63 61 6e 2d scan-top scan-
1270: 62 6f 74 20 44 4f 0a 09 49 20 65 63 63 2d 68 6f bot DO..I ecc-ho
1280: 72 40 20 6f 76 65 72 20 62 65 2d 6c 21 20 34 20 r@ over be-l! 4
1290: 2b 0a 20 20 20 20 73 63 61 6e 2d 73 74 65 70 20 +. scan-step
12a0: 2d 4c 4f 4f 50 0a 20 20 20 20 64 72 6f 70 20 67 -LOOP. drop g
12b0: 75 65 73 73 62 75 66 20 24 34 30 20 3b 0a 0a 3a uessbuf $40 ;..:
12c0: 20 74 61 67 31 40 20 7b 20 61 64 64 72 20 62 69 tag1@ { addr bi
12d0: 74 20 2d 2d 20 74 61 67 20 7d 0a 20 20 20 20 61 t -- tag }. a
12e0: 64 64 72 20 72 65 64 2d 62 75 66 20 20 20 24 40 ddr red-buf $@
12f0: 20 64 72 6f 70 20 2b 20 63 40 20 62 69 74 20 72 drop + c@ bit r
1300: 73 68 69 66 74 20 31 20 61 6e 64 0a 20 20 20 20 shift 1 and.
1310: 61 64 64 72 20 67 72 65 65 6e 2d 62 75 66 20 24 addr green-buf $
1320: 40 20 64 72 6f 70 20 2b 20 63 40 20 62 69 74 20 @ drop + c@ bit
1330: 72 73 68 69 66 74 20 31 20 61 6e 64 20 32 2a 20 rshift 1 and 2*
1340: 6f 72 20 3b 0a 3a 20 65 63 63 2d 76 65 72 40 20 or ;.: ecc-ver@
1350: 7b 20 6f 66 66 20 62 69 74 20 2d 2d 20 75 6c 20 { off bit -- ul
1360: 7d 20 30 0a 20 20 20 20 73 63 61 6e 2d 74 6f 70 } 0. scan-top
1370: 20 73 63 61 6e 2d 62 6f 74 20 44 4f 0a 09 32 2a scan-bot DO..2*
1380: 20 32 2a 20 49 20 6f 66 66 20 2b 20 62 69 74 20 2* I off + bit
1390: 74 61 67 31 40 20 6f 72 0a 20 20 20 20 73 63 61 tag1@ or. sca
13a0: 6e 2d 73 74 65 70 20 2d 4c 4f 4f 50 20 3b 0a 3a n-step -LOOP ;.:
13b0: 20 74 61 67 32 40 20 28 20 61 64 64 72 20 2d 2d tag2@ ( addr --
13c0: 20 29 0a 20 20 20 20 64 75 70 20 31 2d 20 30 20 ). dup 1- 0
13d0: 74 61 67 31 40 20 32 20 6c 73 68 69 66 74 20 73 tag1@ 2 lshift s
13e0: 77 61 70 20 32 20 2b 20 37 20 74 61 67 31 40 20 wap 2 + 7 tag1@
13f0: 6f 72 20 3b 0a 3a 20 74 61 67 40 20 28 20 2d 2d or ;.: tag@ ( --
1400: 20 74 61 67 20 29 0a 20 20 20 20 73 63 61 6e 2d tag ). scan-
1410: 65 63 63 20 74 61 67 32 40 20 34 20 6c 73 68 69 ecc tag2@ 4 lshi
1420: 66 74 0a 20 20 20 20 73 63 61 6e 2d 74 6f 70 20 ft. scan-top
1430: 74 61 67 32 40 20 6f 72 20 3b 0a 0a 3a 20 3e 67 tag2@ or ;..: >g
1440: 75 65 73 73 65 63 63 20 28 20 2d 2d 20 29 0a 20 uessecc ( -- ).
1450: 20 20 20 73 63 61 6e 2d 65 63 63 20 65 63 63 2d scan-ecc ecc-
1460: 68 6f 72 40 20 67 75 65 73 73 65 63 63 20 20 20 hor@ guessecc
1470: 20 20 62 65 2d 6c 21 0a 20 20 20 20 73 63 61 6e be-l!. scan
1480: 2d 74 6f 70 20 65 63 63 2d 68 6f 72 40 20 67 75 -top ecc-hor@ gu
1490: 65 73 73 65 63 63 20 34 20 2b 20 62 65 2d 6c 21 essecc 4 + be-l!
14a0: 0a 20 20 20 20 2d 31 20 30 20 65 63 63 2d 76 65 . -1 0 ecc-ve
14b0: 72 40 20 67 75 65 73 73 65 63 63 20 38 20 2b 20 r@ guessecc 8 +
14c0: 62 65 2d 6c 21 0a 20 20 20 20 32 20 20 37 20 65 be-l!. 2 7 e
14d0: 63 63 2d 76 65 72 40 20 67 75 65 73 73 65 63 63 cc-ver@ guessecc
14e0: 20 24 43 20 2b 20 62 65 2d 6c 21 20 3b 0a 0a 3a $C + be-l! ;..:
14f0: 20 65 63 63 2d 6f 6b 3f 20 28 20 61 64 64 72 6b ecc-ok? ( addrk
1500: 65 79 20 75 31 20 61 64 64 72 65 63 63 20 75 32 ey u1 addrecc u2
1510: 20 2d 2d 20 66 6c 61 67 20 29 0a 20 20 20 20 6d -- flag ). m
1520: 73 67 28 20 2e 22 20 65 63 63 3f 20 22 20 32 6f sg( ." ecc? " 2o
1530: 76 65 72 20 78 74 79 70 65 20 73 70 61 63 65 20 ver xtype space
1540: 32 64 75 70 20 78 74 79 70 65 20 73 70 61 63 65 2dup xtype space
1550: 20 78 2d 73 63 61 6e 73 69 7a 65 20 66 2e 20 79 x-scansize f. y
1560: 2d 73 63 61 6e 73 69 7a 65 20 66 2e 20 78 2d 6f -scansize f. x-o
1570: 66 66 73 65 74 20 66 2e 20 79 2d 6f 66 66 73 65 ffset f. y-offse
1580: 74 20 66 2e 20 63 72 20 29 0a 20 20 20 20 32 64 t f. cr ). 2d
1590: 75 70 20 2b 20 63 40 20 74 61 67 68 61 73 68 3f up + c@ taghash?
15a0: 20 3b 0a 0a 3a 20 7c 6d 69 6e 7c 20 28 20 61 20 ;..: |min| ( a
15b0: 62 20 2d 2d 20 29 20 6f 76 65 72 20 61 62 73 20 b -- ) over abs
15c0: 6f 76 65 72 20 61 62 73 20 3c 20 73 65 6c 65 63 over abs < selec
15d0: 74 20 3b 0a 0a 24 38 30 30 30 20 43 6f 6e 73 74 t ;..$8000 Const
15e0: 61 6e 74 20 69 6e 69 74 2d 78 79 0a 0a 3a 20 67 ant init-xy..: g
15f0: 65 74 2d 6d 69 6e 6d 61 78 20 28 20 61 64 64 72 et-minmax ( addr
1600: 20 75 20 2d 2d 20 6d 69 6e 20 6d 61 78 20 29 0a u -- min max ).
1610: 20 20 20 20 24 46 46 20 24 30 30 20 32 73 77 61 $FF $00 2swa
1620: 70 0a 20 20 20 20 62 6f 75 6e 64 73 20 3f 44 4f p. bounds ?DO
1630: 0a 09 49 20 63 40 20 74 75 63 6b 20 75 6d 61 78 ..I c@ tuck umax
1640: 20 3e 72 20 75 6d 69 6e 20 72 3e 0a 20 20 20 20 >r umin r>.
1650: 34 20 2b 4c 4f 4f 50 20 3b 0a 3a 20 67 65 74 2d 4 +LOOP ;.: get-
1660: 6d 69 6e 6d 61 78 2d 72 67 62 20 28 20 2d 2d 20 minmax-rgb ( --
1670: 6d 69 6e 72 20 6d 61 78 72 20 6d 69 6e 67 20 6d minr maxr ming m
1680: 61 78 67 20 6d 69 6e 62 20 6d 61 78 62 20 29 0a axg minb maxb ).
1690: 20 20 20 20 73 63 61 6e 2d 62 75 66 31 20 24 40 scan-buf1 $@
16a0: 20 73 77 61 70 20 33 20 62 6f 75 6e 64 73 20 44 swap 3 bounds D
16b0: 4f 0a 09 49 20 6f 76 65 72 20 67 65 74 2d 6d 69 O..I over get-mi
16c0: 6e 6d 61 78 20 72 6f 74 0a 20 20 20 20 4c 4f 4f nmax rot. LOO
16d0: 50 20 20 64 72 6f 70 20 3b 0a 0a 3a 20 73 65 61 P drop ;..: sea
16e0: 72 63 68 2d 63 6f 72 6e 65 72 20 7b 20 6d 61 73 rch-corner { mas
16f0: 6b 20 2d 2d 20 78 20 79 20 7d 20 69 6e 69 74 2d k -- x y } init-
1700: 78 79 20 64 75 70 20 7b 20 78 20 79 20 7d 0a 20 xy dup { x y }.
1710: 20 20 20 73 63 61 6e 2d 62 75 66 30 20 24 40 20 scan-buf0 $@
1720: 64 72 6f 70 0a 20 20 20 20 73 63 61 6e 2d 77 20 drop. scan-w
1730: 64 75 70 20 6e 65 67 61 74 65 20 44 4f 0a 09 73 dup negate DO..s
1740: 63 61 6e 2d 77 20 64 75 70 20 6e 65 67 61 74 65 can-w dup negate
1750: 20 44 4f 0a 09 20 20 20 20 64 75 70 20 20 20 20 DO.. dup
1760: 20 20 63 40 20 72 65 64 2d 6c 65 76 65 6c 23 20 c@ red-level#
1770: 20 20 75 3c 20 31 20 61 6e 64 0a 09 20 20 20 20 u< 1 and..
1780: 6f 76 65 72 20 31 2b 20 20 63 40 20 67 72 65 65 over 1+ c@ gree
1790: 6e 2d 6c 65 76 65 6c 23 20 75 3c 20 32 20 61 6e n-level# u< 2 an
17a0: 64 20 6f 72 0a 09 20 20 20 20 6f 76 65 72 20 32 d or.. over 2
17b0: 20 2b 20 63 40 20 62 6c 75 65 2d 6c 65 76 65 6c + c@ blue-level
17c0: 23 20 20 75 3c 20 34 20 61 6e 64 20 6f 72 0a 09 # u< 4 and or..
17d0: 20 20 20 20 6d 61 73 6b 20 3d 20 49 46 0a 09 09 mask = IF...
17e0: 49 20 64 75 70 20 2a 20 4a 20 64 75 70 20 2a 20 I dup * J dup *
17f0: 2b 0a 09 09 78 20 64 75 70 20 2a 20 79 20 64 75 +...x dup * y du
1800: 70 20 2a 20 2b 20 75 3c 20 49 46 0a 09 09 20 20 p * + u< IF...
1810: 20 20 49 20 74 6f 20 78 20 20 4a 20 74 6f 20 79 I to x J to y
1820: 0a 09 09 54 48 45 4e 0a 09 20 20 20 20 54 48 45 ...THEN.. THE
1830: 4e 0a 09 20 20 20 20 73 66 6c 6f 61 74 2b 0a 09 N.. sfloat+..
1840: 4c 4f 4f 50 0a 20 20 20 20 4c 4f 4f 50 20 20 64 LOOP. LOOP d
1850: 72 6f 70 20 78 20 79 20 3b 0a 0a 32 56 61 72 69 rop x y ;..2Vari
1860: 61 62 6c 65 20 70 30 20 5c 20 74 6f 70 20 6c 65 able p0 \ top le
1870: 66 74 0a 32 56 61 72 69 61 62 6c 65 20 70 31 20 ft.2Variable p1
1880: 5c 20 74 6f 70 20 72 69 67 68 74 0a 32 56 61 72 \ top right.2Var
1890: 69 61 62 6c 65 20 70 32 20 5c 20 62 6f 74 74 6f iable p2 \ botto
18a0: 6d 20 6c 65 66 74 0a 32 56 61 72 69 61 62 6c 65 m left.2Variable
18b0: 20 70 33 20 5c 20 62 6f 74 74 6f 6d 20 72 69 67 p3 \ bottom rig
18c0: 68 74 0a 32 56 61 72 69 61 62 6c 65 20 70 78 20 ht.2Variable px
18d0: 28 20 63 72 6f 73 73 20 6f 66 20 74 68 65 20 74 ( cross of the t
18e0: 77 6f 20 6c 69 6e 65 73 20 29 0a 0a 3a 20 73 65 wo lines )..: se
18f0: 61 72 63 68 2d 63 6f 72 6e 65 72 73 20 28 20 2d arch-corners ( -
1900: 2d 20 29 0a 20 20 20 20 5c 20 67 65 74 2d 6d 69 - ). \ get-mi
1910: 6e 6d 61 78 2d 72 67 62 20 2e 20 2e 20 2e 20 2e nmax-rgb . . . .
1920: 20 2e 20 2e 20 63 72 0a 20 20 20 20 34 20 73 65 . . cr. 4 se
1930: 61 72 63 68 2d 63 6f 72 6e 65 72 20 70 30 20 32 arch-corner p0 2
1940: 21 20 5c 20 74 6f 70 20 6c 65 66 74 0a 20 20 20 ! \ top left.
1950: 20 35 20 73 65 61 72 63 68 2d 63 6f 72 6e 65 72 5 search-corner
1960: 20 70 31 20 32 21 20 5c 20 74 6f 70 20 72 69 67 p1 2! \ top rig
1970: 68 74 0a 20 20 20 20 36 20 73 65 61 72 63 68 2d ht. 6 search-
1980: 63 6f 72 6e 65 72 20 70 32 20 32 21 20 5c 20 62 corner p2 2! \ b
1990: 6f 74 74 6f 6d 20 6c 65 66 74 0a 20 20 20 20 37 ottom left. 7
19a0: 20 73 65 61 72 63 68 2d 63 6f 72 6e 65 72 20 70 search-corner p
19b0: 33 20 32 21 20 5c 20 62 6f 74 74 6f 6d 20 72 69 3 2! \ bottom ri
19c0: 67 68 74 0a 3b 0a 0a 3a 20 3f 6c 65 67 69 74 20 ght.;..: ?legit
19d0: 28 20 2d 2d 20 66 6c 61 67 20 29 0a 20 20 20 20 ( -- flag ).
19e0: 70 30 20 32 40 20 69 6e 69 74 2d 78 79 20 64 75 p0 2@ init-xy du
19f0: 70 20 64 3c 3e 0a 20 20 20 20 70 31 20 32 40 20 p d<>. p1 2@
1a00: 69 6e 69 74 2d 78 79 20 64 75 70 20 64 3c 3e 20 init-xy dup d<>
1a10: 61 6e 64 0a 20 20 20 20 70 32 20 32 40 20 69 6e and. p2 2@ in
1a20: 69 74 2d 78 79 20 64 75 70 20 64 3c 3e 20 61 6e it-xy dup d<> an
1a30: 64 0a 20 20 20 20 70 33 20 32 40 20 69 6e 69 74 d. p3 2@ init
1a40: 2d 78 79 20 64 75 70 20 64 3c 3e 20 61 6e 64 20 -xy dup d<> and
1a50: 3b 0a 0a 3a 20 63 6f 6d 70 75 74 65 2d 78 70 6f ;..: compute-xpo
1a60: 69 6e 74 20 28 20 2d 2d 20 72 78 20 72 79 20 29 int ( -- rx ry )
1a70: 0a 20 20 20 20 70 30 20 32 40 20 73 3e 66 20 73 . p0 2@ s>f s
1a80: 3e 66 20 7b 20 66 3a 20 79 30 20 66 3a 20 78 30 >f { f: y0 f: x0
1a90: 20 7d 0a 20 20 20 20 70 33 20 32 40 20 73 3e 66 }. p3 2@ s>f
1aa0: 20 73 3e 66 20 7b 20 66 3a 20 79 31 20 66 3a 20 s>f { f: y1 f:
1ab0: 78 31 20 7d 0a 20 20 20 20 70 31 20 32 40 20 73 x1 }. p1 2@ s
1ac0: 3e 66 20 73 3e 66 20 7b 20 66 3a 20 79 32 20 66 >f s>f { f: y2 f
1ad0: 3a 20 78 32 20 7d 0a 20 20 20 20 70 32 20 32 40 : x2 }. p2 2@
1ae0: 20 73 3e 66 20 73 3e 66 20 7b 20 66 3a 20 79 33 s>f s>f { f: y3
1af0: 20 66 3a 20 78 33 20 7d 0a 20 20 20 20 78 30 20 f: x3 }. x0
1b00: 79 31 20 66 2a 20 79 30 20 78 31 20 66 2a 20 66 y1 f* y0 x1 f* f
1b10: 2d 20 7b 20 66 3a 20 64 78 79 30 31 20 7d 0a 20 - { f: dxy01 }.
1b20: 20 20 20 78 32 20 79 33 20 66 2a 20 79 32 20 78 x2 y3 f* y2 x
1b30: 33 20 66 2a 20 66 2d 20 7b 20 66 3a 20 64 78 79 3 f* f- { f: dxy
1b40: 32 33 20 7d 0a 20 20 20 20 78 30 20 78 31 20 66 23 }. x0 x1 f
1b50: 2d 20 79 32 20 79 33 20 66 2d 20 66 2a 20 79 30 - y2 y3 f- f* y0
1b60: 20 79 31 20 66 2d 20 78 32 20 78 33 20 66 2d 20 y1 f- x2 x3 f-
1b70: 66 2a 20 66 2d 20 31 2f 66 20 7b 20 66 3a 20 64 f* f- 1/f { f: d
1b80: 65 74 31 20 7d 0a 20 20 20 20 64 78 79 30 31 20 et1 }. dxy01
1b90: 78 32 20 78 33 20 66 2d 20 66 2a 20 64 78 79 32 x2 x3 f- f* dxy2
1ba0: 33 20 78 30 20 78 31 20 66 2d 20 66 2a 20 66 2d 3 x0 x1 f- f* f-
1bb0: 20 64 65 74 31 20 66 2a 20 7b 20 66 3a 20 78 20 det1 f* { f: x
1bc0: 7d 0a 20 20 20 20 64 78 79 30 31 20 79 32 20 79 }. dxy01 y2 y
1bd0: 33 20 66 2d 20 66 2a 20 64 78 79 32 33 20 79 30 3 f- f* dxy23 y0
1be0: 20 79 31 20 66 2d 20 66 2a 20 66 2d 20 64 65 74 y1 f- f* f- det
1bf0: 31 20 66 2a 20 7b 20 66 3a 20 79 20 7d 0a 20 20 1 f* { f: y }.
1c00: 20 20 78 20 66 3e 73 20 79 20 66 3e 73 20 70 78 x f>s y f>s px
1c10: 20 32 21 20 20 78 20 79 20 3b 0a 0a 3a 20 70 2b 2! x y ;..: p+
1c20: 20 28 20 78 31 20 79 31 20 78 32 20 79 32 20 2d ( x1 y1 x2 y2 -
1c30: 2d 20 78 31 2b 78 32 20 79 31 2b 79 32 20 29 0a - x1+x2 y1+y2 ).
1c40: 20 20 20 20 72 6f 74 20 2b 20 3e 72 20 2b 20 72 rot + >r + r
1c50: 3e 20 3b 0a 3a 20 70 32 2a 20 28 20 78 31 20 79 > ;.: p2* ( x1 y
1c60: 31 20 2d 2d 20 78 32 20 79 32 20 29 0a 20 20 20 1 -- x2 y2 ).
1c70: 20 32 2a 20 73 77 61 70 20 32 2a 20 73 77 61 70 2* swap 2* swap
1c80: 20 3b 0a 3a 20 70 32 2f 20 28 20 78 31 20 79 31 ;.: p2/ ( x1 y1
1c90: 20 2d 2d 20 78 32 20 79 32 20 29 0a 20 20 20 20 -- x2 y2 ).
1ca0: 32 2f 20 73 77 61 70 20 32 2f 20 73 77 61 70 20 2/ swap 2/ swap
1cb0: 3b 0a 3a 20 70 2d 20 28 20 78 31 20 79 31 20 78 ;.: p- ( x1 y1 x
1cc0: 32 20 79 32 20 2d 2d 20 78 31 2d 78 32 20 79 31 2 y2 -- x1-x2 y1
1cd0: 2d 79 32 20 29 0a 20 20 20 20 72 6f 74 20 73 77 -y2 ). rot sw
1ce0: 61 70 20 2d 20 3e 72 20 2d 20 72 3e 20 3b 0a 0a ap - >r - r> ;..
1cf0: 3a 20 73 63 61 6e 2d 67 72 61 62 2d 62 75 66 20 : scan-grab-buf
1d00: 28 20 61 64 64 72 20 2d 2d 20 29 0a 20 20 20 20 ( addr -- ).
1d10: 3e 72 20 20 30 20 30 20 73 63 61 6e 2d 77 20 32 >r 0 0 scan-w 2
1d20: 2a 20 64 75 70 0a 20 20 20 20 32 64 75 70 20 2a * dup. 2dup *
1d30: 20 73 66 6c 6f 61 74 73 20 72 40 20 24 21 6c 65 sfloats r@ $!le
1d40: 6e 0a 20 20 20 20 47 4c 5f 52 47 42 41 20 47 4c n. GL_RGBA GL
1d50: 5f 55 4e 53 49 47 4e 45 44 5f 42 59 54 45 20 72 _UNSIGNED_BYTE r
1d60: 3e 20 24 40 20 64 72 6f 70 20 67 6c 52 65 61 64 > $@ drop glRead
1d70: 50 69 78 65 6c 73 20 3b 0a 0a 3a 20 73 63 61 6e Pixels ;..: scan
1d80: 2d 67 72 61 62 30 20 28 20 2d 2d 20 29 20 20 73 -grab0 ( -- ) s
1d90: 63 61 6e 2d 62 75 66 30 20 73 63 61 6e 2d 67 72 can-buf0 scan-gr
1da0: 61 62 2d 62 75 66 20 3b 0a 3a 20 73 63 61 6e 2d ab-buf ;.: scan-
1db0: 67 72 61 62 31 20 28 20 2d 2d 20 29 20 20 73 63 grab1 ( -- ) sc
1dc0: 61 6e 2d 62 75 66 31 20 73 63 61 6e 2d 67 72 61 an-buf1 scan-gra
1dd0: 62 2d 62 75 66 20 3b 0a 0a 3a 20 2e 78 70 6f 69 b-buf ;..: .xpoi
1de0: 6e 74 20 28 20 78 20 79 20 2d 2d 20 29 0a 20 20 nt ( x y -- ).
1df0: 20 20 70 30 20 32 40 20 73 77 61 70 20 2e 20 2e p0 2@ swap . .
1e00: 20 73 70 61 63 65 0a 20 20 20 20 70 31 20 32 40 space. p1 2@
1e10: 20 73 77 61 70 20 2e 20 2e 20 73 70 61 63 65 0a swap . . space.
1e20: 20 20 20 20 70 32 20 32 40 20 73 77 61 70 20 2e p2 2@ swap .
1e30: 20 2e 20 73 70 61 63 65 0a 20 20 20 20 70 33 20 . space. p3
1e40: 32 40 20 73 77 61 70 20 2e 20 2e 20 73 70 61 63 2@ swap . . spac
1e50: 65 0a 20 20 20 20 66 73 77 61 70 20 66 2e 20 66 e. fswap f. f
1e60: 2e 20 63 72 20 3b 0a 0a 74 65 78 3a 20 73 63 61 . cr ;..tex: sca
1e70: 6e 2d 74 65 78 0a 30 20 56 61 6c 75 65 20 73 63 n-tex.0 Value sc
1e80: 61 6e 2d 66 62 0a 0a 3a 20 6e 65 77 2d 73 63 61 an-fb..: new-sca
1e90: 6e 74 65 78 20 28 20 2d 2d 20 29 0a 20 20 20 20 ntex ( -- ).
1ea0: 73 63 61 6e 2d 74 65 78 20 20 30 65 20 30 65 20 scan-tex 0e 0e
1eb0: 30 65 20 31 65 20 67 6c 43 6c 65 61 72 43 6f 6c 0e 1e glClearCol
1ec0: 6f 72 0a 20 20 20 20 73 63 61 6e 2d 77 20 32 2a or. scan-w 2*
1ed0: 20 64 75 70 20 47 4c 5f 52 47 42 41 20 6e 65 77 dup GL_RGBA new
1ee0: 2d 74 65 78 74 62 75 66 66 65 72 20 74 6f 20 73 -textbuffer to s
1ef0: 63 61 6e 2d 66 62 20 3b 0a 3a 20 73 63 61 6c 65 can-fb ;.: scale
1f00: 2b 72 6f 74 61 74 65 20 28 20 2d 2d 20 29 0a 20 +rotate ( -- ).
1f10: 20 20 20 70 31 20 32 40 20 70 30 20 32 40 20 70 p1 2@ p0 2@ p
1f20: 2d 20 70 33 20 32 40 20 70 32 20 32 40 20 70 2d - p3 2@ p2 2@ p-
1f30: 20 70 2b 20 70 32 2f 0a 20 20 20 20 73 3e 66 20 p+ p2/. s>f
1f40: 79 2d 73 63 61 6e 73 69 7a 65 20 66 2f 20 79 2d y-scansize f/ y-
1f50: 72 6f 74 73 20 73 66 21 20 20 73 3e 66 20 78 2d rots sf! s>f x-
1f60: 73 63 61 6e 73 69 7a 65 20 66 2f 20 78 2d 73 63 scansize f/ x-sc
1f70: 61 6c 65 20 73 66 21 0a 20 20 20 20 70 30 20 32 ale sf!. p0 2
1f80: 40 20 70 32 20 32 40 20 70 2d 20 70 31 20 32 40 @ p2 2@ p- p1 2@
1f90: 20 70 33 20 32 40 20 70 2d 20 70 2b 20 70 32 2f p3 2@ p- p+ p2/
1fa0: 0a 20 20 20 20 73 3e 66 20 79 2d 73 63 61 6e 73 . s>f y-scans
1fb0: 69 7a 65 20 66 2f 20 79 2d 73 63 61 6c 65 20 73 ize f/ y-scale s
1fc0: 66 21 20 20 73 3e 66 20 78 2d 73 63 61 6e 73 69 f! s>f x-scansi
1fd0: 7a 65 20 66 2f 20 78 2d 72 6f 74 73 20 73 66 21 ze f/ x-rots sf!
1fe0: 20 3b 0a 3a 20 73 65 74 2d 73 63 61 6e 27 20 28 ;.: set-scan' (
1ff0: 20 2d 2d 20 29 0a 20 20 20 20 63 6f 6d 70 75 74 -- ). comput
2000: 65 2d 78 70 6f 69 6e 74 20 28 20 2e 2e 20 78 20 e-xpoint ( .. x
2010: 79 20 29 0a 20 20 20 20 73 63 61 6c 65 2b 72 6f y ). scale+ro
2020: 74 61 74 65 0a 20 20 20 20 79 2d 6f 66 66 73 65 tate. y-offse
2030: 74 20 66 2b 20 73 63 61 6e 2d 77 20 66 6d 2f 20 t f+ scan-w fm/
2040: 79 2d 73 70 6f 73 20 73 66 21 0a 20 20 20 20 78 y-spos sf!. x
2050: 2d 6f 66 66 73 65 74 20 66 2b 20 73 63 61 6e 2d -offset f+ scan-
2060: 77 20 66 6d 2f 20 78 2d 73 70 6f 73 20 73 66 21 w fm/ x-spos sf!
2070: 20 3b 0a 0a 3a 20 73 63 61 6e 2d 6c 65 67 69 74 ;..: scan-legit
2080: 20 28 20 2d 2d 20 29 20 5c 20 72 65 73 69 7a 65 ( -- ) \ resize
2090: 20 61 20 6c 65 67 69 74 20 51 52 20 63 6f 64 65 a legit QR code
20a0: 0a 20 20 20 20 69 6e 69 74 2d 73 63 61 6e 27 20 . init-scan'
20b0: 73 65 74 2d 73 63 61 6e 27 20 3e 73 63 61 6e 2d set-scan' >scan-
20c0: 6d 61 74 72 69 78 0a 20 20 20 20 73 63 61 6e 2d matrix. scan-
20d0: 6d 61 74 72 69 78 20 4d 56 50 4d 61 74 72 69 78 matrix MVPMatrix
20e0: 20 73 65 74 2d 6d 61 74 72 69 78 0a 20 20 20 20 set-matrix.
20f0: 73 63 61 6e 2d 6d 61 74 72 69 78 20 4d 56 4d 61 scan-matrix MVMa
2100: 74 72 69 78 20 73 65 74 2d 6d 61 74 72 69 78 20 trix set-matrix
2110: 63 6c 65 61 72 0a 20 20 20 20 30 20 64 72 61 77 clear. 0 draw
2120: 2d 73 63 61 6e 20 73 63 61 6e 2d 67 72 61 62 31 -scan scan-grab1
2130: 20 3b 0a 0a 3a 20 76 69 73 75 61 6c 2d 66 72 61 ;..: visual-fra
2140: 6d 65 20 28 20 2d 2d 20 29 0a 20 20 20 20 6f 65 me ( -- ). oe
2150: 73 2d 70 72 6f 67 72 61 6d 20 69 6e 69 74 0a 20 s-program init.
2160: 20 20 20 75 6e 69 74 2d 6d 61 74 72 69 78 20 4d unit-matrix M
2170: 56 50 4d 61 74 72 69 78 20 73 65 74 2d 6d 61 74 VPMatrix set-mat
2180: 72 69 78 0a 20 20 20 20 75 6e 69 74 2d 6d 61 74 rix. unit-mat
2190: 72 69 78 20 4d 56 4d 61 74 72 69 78 20 73 65 74 rix MVMatrix set
21a0: 2d 6d 61 74 72 69 78 0a 20 20 20 20 6d 65 64 69 -matrix. medi
21b0: 61 2d 74 65 78 20 6e 65 61 72 65 73 74 2d 6f 65 a-tex nearest-oe
21c0: 73 0a 20 20 20 20 73 63 72 65 65 6e 2d 6f 72 69 s. screen-ori
21d0: 65 6e 74 61 74 69 6f 6e 20 64 72 61 77 2d 73 63 entation draw-sc
21e0: 61 6e 20 73 79 6e 63 20 3b 0a 0a 3a 20 73 63 61 an sync ;..: sca
21f0: 6e 2d 6c 65 67 69 74 3f 20 28 20 2d 2d 20 61 64 n-legit? ( -- ad
2200: 64 72 20 75 20 66 6c 61 67 20 29 0a 20 20 20 20 dr u flag ).
2210: 73 63 61 6e 2d 6c 65 67 69 74 20 65 78 74 72 61 scan-legit extra
2220: 63 74 2d 72 65 64 20 65 78 74 72 61 63 74 2d 67 ct-red extract-g
2230: 72 65 65 6e 20 3e 67 75 65 73 73 0a 20 20 20 20 reen >guess.
2240: 3e 67 75 65 73 73 65 63 63 20 74 61 67 40 20 67 >guessecc tag@ g
2250: 75 65 73 73 74 61 67 20 63 21 0a 20 20 20 20 32 uesstag c!. 2
2260: 64 75 70 20 67 75 65 73 73 65 63 63 20 24 31 30 dup guessecc $10
2270: 20 65 63 63 2d 6f 6b 3f 20 3b 0a 3a 20 73 63 61 ecc-ok? ;.: sca
2280: 6e 2d 6c 65 67 69 74 73 3f 20 28 20 2d 2d 20 61 n-legits? ( -- a
2290: 64 64 72 20 75 20 66 6c 61 67 20 29 0a 20 20 20 ddr u flag ).
22a0: 20 35 20 30 20 44 4f 0a 09 49 20 73 3e 66 20 66 5 0 DO..I s>f f
22b0: 32 2f 20 66 32 2f 20 74 6f 20 79 2d 6f 66 66 73 2/ f2/ to y-offs
22c0: 65 74 0a 09 38 35 20 38 30 20 44 4f 20 20 49 20 et..85 80 DO I
22d0: 73 3e 66 20 66 32 2f 20 66 32 2f 20 74 6f 20 79 s>f f2/ f2/ to y
22e0: 2d 73 63 61 6e 73 69 7a 65 0a 09 20 20 20 20 73 -scansize.. s
22f0: 63 61 6e 2d 6c 65 67 69 74 3f 20 49 46 20 20 75 can-legit? IF u
2300: 6e 6c 6f 6f 70 20 75 6e 6c 6f 6f 70 20 74 72 75 nloop unloop tru
2310: 65 20 20 45 58 49 54 20 20 54 48 45 4e 0a 09 20 e EXIT THEN..
2320: 20 20 20 32 64 72 6f 70 0a 09 4c 4f 4f 50 0a 20 2drop..LOOP.
2330: 20 20 20 4c 4f 4f 50 20 20 30 20 30 20 20 66 61 LOOP 0 0 fa
2340: 6c 73 65 20 3b 0a lse ;.