net2o: Hex Artifact Content

Artifact 6712675abfd729ab29281ff5783f67b7f30221a7:

File qr.fs — part of check-in [295cbe28ec] at 2019-10-03 14:35:43 on branch trunk — HOSTPREFIX env variable (user: bernd size: 5596)
0000: 5c 20 6e 65 74 32 6f 20 51 52 20 63 6f 64 65 0a  \ net2o QR code.
0010: 0a 5c 20 43 6f 70 79 72 69 67 68 74 20 c2 a9 20  .\ Copyright © 
0020: 32 30 31 35 20 20 20 42 65 72 6e 64 20 50 61 79  2015   Bernd Pay
0030: 73 61 6e 0a 0a 5c 20 54 68 69 73 20 70 72 6f 67  san..\ This prog
0040: 72 61 6d 20 69 73 20 66 72 65 65 20 73 6f 66 74  ram is free soft
0050: 77 61 72 65 3a 20 79 6f 75 20 63 61 6e 20 72 65  ware: you can re
0060: 64 69 73 74 72 69 62 75 74 65 20 69 74 20 61 6e  distribute it an
0070: 64 2f 6f 72 20 6d 6f 64 69 66 79 0a 5c 20 69 74  d/or modify.\ it
0080: 20 75 6e 64 65 72 20 74 68 65 20 74 65 72 6d 73   under the terms
0090: 20 6f 66 20 74 68 65 20 47 4e 55 20 41 66 66 65   of the GNU Affe
00a0: 72 6f 20 47 65 6e 65 72 61 6c 20 50 75 62 6c 69  ro General Publi
00b0: 63 20 4c 69 63 65 6e 73 65 20 61 73 20 70 75 62  c License as pub
00c0: 6c 69 73 68 65 64 20 62 79 0a 5c 20 74 68 65 20  lished by.\ the 
00d0: 46 72 65 65 20 53 6f 66 74 77 61 72 65 20 46 6f  Free Software Fo
00e0: 75 6e 64 61 74 69 6f 6e 2c 20 65 69 74 68 65 72  undation, either
00f0: 20 76 65 72 73 69 6f 6e 20 33 20 6f 66 20 74 68   version 3 of th
0100: 65 20 4c 69 63 65 6e 73 65 2c 20 6f 72 0a 5c 20  e License, or.\ 
0110: 28 61 74 20 79 6f 75 72 20 6f 70 74 69 6f 6e 29  (at your option)
0120: 20 61 6e 79 20 6c 61 74 65 72 20 76 65 72 73 69   any later versi
0130: 6f 6e 2e 0a 0a 5c 20 54 68 69 73 20 70 72 6f 67  on...\ This prog
0140: 72 61 6d 20 69 73 20 64 69 73 74 72 69 62 75 74  ram is distribut
0150: 65 64 20 69 6e 20 74 68 65 20 68 6f 70 65 20 74  ed in the hope t
0160: 68 61 74 20 69 74 20 77 69 6c 6c 20 62 65 20 75  hat it will be u
0170: 73 65 66 75 6c 2c 0a 5c 20 62 75 74 20 57 49 54  seful,.\ but WIT
0180: 48 4f 55 54 20 41 4e 59 20 57 41 52 52 41 4e 54  HOUT ANY WARRANT
0190: 59 3b 20 77 69 74 68 6f 75 74 20 65 76 65 6e 20  Y; without even 
01a0: 74 68 65 20 69 6d 70 6c 69 65 64 20 77 61 72 72  the implied warr
01b0: 61 6e 74 79 20 6f 66 0a 5c 20 4d 45 52 43 48 41  anty of.\ MERCHA
01c0: 4e 54 41 42 49 4c 49 54 59 20 6f 72 20 46 49 54  NTABILITY or FIT
01d0: 4e 45 53 53 20 46 4f 52 20 41 20 50 41 52 54 49  NESS FOR A PARTI
01e0: 43 55 4c 41 52 20 50 55 52 50 4f 53 45 2e 20 20  CULAR PURPOSE.  
01f0: 53 65 65 20 74 68 65 0a 5c 20 47 4e 55 20 41 66  See the.\ GNU Af
0200: 66 65 72 6f 20 47 65 6e 65 72 61 6c 20 50 75 62  fero General Pub
0210: 6c 69 63 20 4c 69 63 65 6e 73 65 20 66 6f 72 20  lic License for 
0220: 6d 6f 72 65 20 64 65 74 61 69 6c 73 2e 0a 0a 5c  more details...\
0230: 20 59 6f 75 20 73 68 6f 75 6c 64 20 68 61 76 65   You should have
0240: 20 72 65 63 65 69 76 65 64 20 61 20 63 6f 70 79   received a copy
0250: 20 6f 66 20 74 68 65 20 47 4e 55 20 41 66 66 65   of the GNU Affe
0260: 72 6f 20 47 65 6e 65 72 61 6c 20 50 75 62 6c 69  ro General Publi
0270: 63 20 4c 69 63 65 6e 73 65 0a 5c 20 61 6c 6f 6e  c License.\ alon
0280: 67 20 77 69 74 68 20 74 68 69 73 20 70 72 6f 67  g with this prog
0290: 72 61 6d 2e 20 20 49 66 20 6e 6f 74 2c 20 73 65  ram.  If not, se
02a0: 65 20 3c 68 74 74 70 3a 2f 2f 77 77 77 2e 67 6e  e <http://www.gn
02b0: 75 2e 6f 72 67 2f 6c 69 63 65 6e 73 65 73 2f 3e  u.org/licenses/>
02c0: 2e 0a 0a 72 65 71 75 69 72 65 20 74 6f 6f 6c 73  ...require tools
02d0: 2e 66 73 0a 0a 5c 20 75 6e 69 63 6f 64 65 20 63  .fs..\ unicode c
02e0: 68 61 72 61 63 74 65 72 73 20 74 6f 20 64 69 73  haracters to dis
02f0: 70 6c 61 79 20 61 20 63 6f 6c 6f 72 20 6d 61 74  play a color mat
0300: 72 69 78 0a 0a 65 3f 20 6d 61 78 2d 78 63 68 61  rix..e? max-xcha
0310: 72 20 24 31 30 30 20 3c 20 5b 49 46 5d 20 27 5e  r $100 < [IF] '^
0320: 27 20 5b 45 4c 53 45 5d 20 27 e2 96 80 27 20 5b  ' [ELSE] '▀' [
0330: 54 48 45 4e 5d 20 43 6f 6e 73 74 61 6e 74 20 75  THEN] Constant u
0340: 70 70 65 72 2d 68 61 6c 66 2d 62 6c 6f 63 6b 0a  pper-half-block.
0350: 5c 20 27 e2 96 84 27 20 43 6f 6e 73 74 61 6e 74  \ '▄' Constant
0360: 20 6c 6f 77 65 72 2d 68 61 6c 66 2d 62 6c 6f 63   lower-half-bloc
0370: 6b 0a 5c 20 27 e2 96 88 27 20 43 6f 6e 73 74 61  k.\ '█' Consta
0380: 6e 74 20 73 6f 6c 69 64 2d 62 6c 6f 63 6b 0a 0a  nt solid-block..
0390: 5c 20 63 6f 6e 73 74 61 6e 74 73 0a 0a 32 34 20  \ constants..24 
03a0: 43 6f 6e 73 74 61 6e 74 20 6b 65 79 71 72 23 20  Constant keyqr# 
03b0: 5c 20 6b 65 79 20 71 72 20 63 6f 64 65 73 20 61  \ key qr codes a
03c0: 72 65 20 32 34 78 32 34 20 62 6c 6f 63 6b 73 0a  re 24x24 blocks.
03d0: 6b 65 79 71 72 23 20 64 75 70 20 2a 20 43 6f 6e  keyqr# dup * Con
03e0: 73 74 61 6e 74 20 6b 65 79 71 72 23 c2 b2 20 5c  stant keyqr#² \
03f0: 20 63 6f 64 65 20 62 6c 6f 63 6b 20 73 69 7a 65   code block size
0400: 0a 24 34 30 20 43 6f 6e 73 74 61 6e 74 20 6b 65  .$40 Constant ke
0410: 79 6d 61 78 23 0a 34 20 43 6f 6e 73 74 61 6e 74  ymax#.4 Constant
0420: 20 6b 65 79 6c 69 6e 65 23 0a 38 20 43 6f 6e 73   keyline#.8 Cons
0430: 74 61 6e 74 20 6b 65 79 6c 69 6e 65 73 6b 70 23  tant keylineskp#
0440: 0a 0a 6b 65 79 71 72 23 c2 b2 20 62 75 66 66 65  ..keyqr#² buffe
0450: 72 3a 20 6b 65 79 71 72 20 5c 20 63 6f 64 65 20  r: keyqr \ code 
0460: 62 6c 6f 63 6b 20 62 75 66 66 65 72 0a 6b 65 79  block buffer.key
0470: 71 72 23 c2 b2 20 73 66 6c 6f 61 74 73 20 62 75  qr#² sfloats bu
0480: 66 66 65 72 3a 20 6b 65 79 71 72 2d 72 67 62 61  ffer: keyqr-rgba
0490: 20 5c 20 63 6f 64 65 20 62 6c 6f 63 6b 20 69 6e   \ code block in
04a0: 20 52 47 42 41 0a 24 31 30 20 62 75 66 66 65 72   RGBA.$10 buffer
04b0: 3a 20 71 72 65 63 63 0a 0a 44 65 66 65 72 20 3c  : qrecc..Defer <
04c0: 72 65 73 74 3e 20 20 27 20 3c 77 68 69 74 65 3e  rest>  ' <white>
04d0: 20 69 73 20 3c 72 65 73 74 3e 0a 24 38 20 56 61   is <rest>.$8 Va
04e0: 6c 75 65 20 32 62 3e 63 6f 6c 0a 0a 3a 20 77 68  lue 2b>col..: wh
04f0: 69 74 65 2d 71 72 20 28 20 2d 2d 20 29 0a 20 20  ite-qr ( -- ).  
0500: 20 20 5b 27 5d 20 3c 77 68 69 74 65 3e 20 69 73    ['] <white> is
0510: 20 3c 72 65 73 74 3e 0a 20 20 20 20 24 38 20 74   <rest>.    $8 t
0520: 6f 20 32 62 3e 63 6f 6c 20 3b 0a 3a 20 62 6c 61  o 2b>col ;.: bla
0530: 63 6b 2d 71 72 20 28 20 2d 2d 20 29 0a 20 20 20  ck-qr ( -- ).   
0540: 20 5b 27 5d 20 3c 62 6c 61 63 6b 3e 20 69 73 20   ['] <black> is 
0550: 3c 72 65 73 74 3e 0a 20 20 20 20 24 46 20 74 6f  <rest>.    $F to
0560: 20 32 62 3e 63 6f 6c 20 3b 0a 0a 5c 20 3a 20 68   2b>col ;..\ : h
0570: 61 6c 66 2d 62 6c 6f 63 6b 73 20 28 20 6e 20 2d  alf-blocks ( n -
0580: 2d 20 29 20 30 20 3f 44 4f 20 20 75 70 70 65 72  - ) 0 ?DO  upper
0590: 2d 68 61 6c 66 2d 62 6c 6f 63 6b 20 78 65 6d 69  -half-block xemi
05a0: 74 20 20 4c 4f 4f 50 20 3b 0a 5c 20 3a 20 62 6c  t  LOOP ;.\ : bl
05b0: 6f 63 6b 73 20 28 20 6e 20 2d 2d 20 29 20 30 20  ocks ( n -- ) 0 
05c0: 55 2b 44 4f 20 73 6f 6c 69 64 2d 62 6c 6f 63 6b  U+DO solid-block
05d0: 20 78 65 6d 69 74 20 4c 4f 4f 50 20 3b 0a 3a 20   xemit LOOP ;.: 
05e0: 2e 70 72 65 6c 69 6e 65 73 20 28 20 2d 2d 20 29  .prelines ( -- )
05f0: 0a 20 20 20 20 72 6f 77 73 20 6b 65 79 71 72 23  .    rows keyqr#
0600: 20 32 2f 20 2d 20 32 2f 20 30 20 3f 44 4f 0a 09   2/ - 2/ 0 ?DO..
0610: 5c 20 5b 20 72 65 64 20 3e 66 67 20 67 72 65 65  \ [ red >fg gree
0620: 6e 20 3e 62 67 20 6f 72 20 5d 4c 20 61 74 74 72  n >bg or ]L attr
0630: 21 0a 09 3c 72 65 73 74 3e 20 63 6f 6c 73 20 73  !..<rest> cols s
0640: 70 61 63 65 73 20 3c 64 65 66 61 75 6c 74 3e 20  paces <default> 
0650: 63 72 20 20 4c 4f 4f 50 20 3b 0a 3a 20 2e 70 72  cr  LOOP ;.: .pr
0660: 65 6c 69 6e 65 20 28 20 2d 2d 20 29 0a 20 20 20  eline ( -- ).   
0670: 20 5c 20 5b 20 72 65 64 20 3e 66 67 20 67 72 65   \ [ red >fg gre
0680: 65 6e 20 3e 62 67 20 6f 72 20 5d 4c 20 61 74 74  en >bg or ]L att
0690: 72 21 0a 20 20 20 20 3c 72 65 73 74 3e 20 63 6f  r!.    <rest> co
06a0: 6c 73 20 6b 65 79 71 72 23 20 2d 20 32 2f 20 73  ls keyqr# - 2/ s
06b0: 70 61 63 65 73 20 3b 0a 3a 20 71 72 2e 32 6c 69  paces ;.: qr.2li
06c0: 6e 65 73 20 28 20 61 64 64 72 20 75 20 2d 2d 20  nes ( addr u -- 
06d0: 29 20 2e 70 72 65 6c 69 6e 65 0a 20 20 20 20 74  ) .preline.    t
06e0: 75 63 6b 20 62 6f 75 6e 64 73 20 3f 44 4f 0a 09  uck bounds ?DO..
06f0: 49 20 63 40 20 6f 76 65 72 20 49 20 2b 20 63 40  I c@ over I + c@
0700: 20 32 62 3e 63 6f 6c 20 78 6f 72 20 3e 62 67 20   2b>col xor >bg 
0710: 73 77 61 70 20 32 62 3e 63 6f 6c 20 78 6f 72 20  swap 2b>col xor 
0720: 3e 66 67 20 6f 72 20 61 74 74 72 21 0a 09 75 70  >fg or attr!..up
0730: 70 65 72 2d 68 61 6c 66 2d 62 6c 6f 63 6b 20 78  per-half-block x
0740: 65 6d 69 74 0a 20 20 20 20 4c 4f 4f 50 20 20 64  emit.    LOOP  d
0750: 72 6f 70 20 2e 70 72 65 6c 69 6e 65 20 3b 0a 3a  rop .preline ;.:
0760: 20 71 72 2e 62 6c 6f 63 6b 20 28 20 61 64 64 72   qr.block ( addr
0770: 20 75 20 2d 2d 20 29 20 2e 70 72 65 6c 69 6e 65   u -- ) .preline
0780: 73 0a 20 20 20 20 74 75 63 6b 20 64 75 70 20 2a  s.    tuck dup *
0790: 20 62 6f 75 6e 64 73 20 3f 44 4f 0a 09 49 20 6f   bounds ?DO..I o
07a0: 76 65 72 20 71 72 2e 32 6c 69 6e 65 73 20 3c 64  ver qr.2lines <d
07b0: 65 66 61 75 6c 74 3e 20 63 72 0a 20 20 20 20 64  efault> cr.    d
07c0: 75 70 20 32 2a 20 2b 4c 4f 4f 50 20 20 64 72 6f  up 2* +LOOP  dro
07d0: 70 20 2e 70 72 65 6c 69 6e 65 73 20 3b 0a 0a 3a  p .prelines ;..:
07e0: 20 34 78 63 21 20 28 20 63 20 61 64 64 72 20 2d   4xc! ( c addr -
07f0: 2d 20 29 0a 20 20 20 20 32 64 75 70 20 63 21 20  - ).    2dup c! 
0800: 32 64 75 70 20 31 2b 20 63 21 20 20 6b 65 79 71  2dup 1+ c!  keyq
0810: 72 23 20 2b 0a 20 20 20 20 32 64 75 70 20 63 21  r# +.    2dup c!
0820: 20 31 2b 20 63 21 20 3b 0a 0a 3a 20 3e 6b 65 79   1+ c! ;..: >key
0830: 66 72 61 6d 65 20 28 20 2d 2d 20 29 20 20 6b 65  frame ( -- )  ke
0840: 79 71 72 20 6b 65 79 71 72 23 c2 b2 20 65 72 61  yqr keyqr#² era
0850: 73 65 0a 20 20 20 20 24 30 34 20 5b 20 6b 65 79  se.    $04 [ key
0860: 71 72 20 20 20 20 20 20 20 20 20 20 20 20 20 20  qr              
0870: 20 20 20 20 20 20 20 20 20 20 5d 4c 20 34 78 63            ]L 4xc
0880: 21 0a 20 20 20 20 24 30 35 20 5b 20 6b 65 79 71  !.    $05 [ keyq
0890: 72 20 6b 65 79 71 72 23 20 2b 20 32 20 2d 20 20  r keyqr# + 2 -  
08a0: 20 20 20 20 20 20 20 20 20 5d 4c 20 34 78 63 21           ]L 4xc!
08b0: 0a 20 20 20 20 24 30 36 20 5b 20 6b 65 79 71 72  .    $06 [ keyqr
08c0: 20 6b 65 79 71 72 23 c2 b2 20 2b 20 6b 65 79 71   keyqr#² + keyq
08d0: 72 23 20 32 2a 20 2d 20 20 5d 4c 20 34 78 63 21  r# 2* -  ]L 4xc!
08e0: 0a 20 20 20 20 24 30 37 20 5b 20 6b 65 79 71 72  .    $07 [ keyqr
08f0: 20 6b 65 79 71 72 23 c2 b2 20 2b 20 6b 65 79 71   keyqr#² + keyq
0900: 72 23 20 2d 20 32 20 2d 20 5d 4c 20 34 78 63 21  r# - 2 - ]L 4xc!
0910: 20 3b 0a 3a 20 62 79 74 65 3e 70 69 78 65 6c 20   ;.: byte>pixel 
0920: 28 20 62 79 74 65 20 61 64 64 72 20 64 69 73 74  ( byte addr dist
0930: 20 2d 2d 20 29 0a 20 20 20 20 5c 20 61 20 62 79   -- ).    \ a by
0940: 74 65 20 69 73 20 63 6f 6e 76 65 72 74 65 64 20  te is converted 
0950: 69 6e 74 6f 20 66 6f 75 72 20 70 69 78 65 6c 73  into four pixels
0960: 3a 0a 20 20 20 20 5c 20 4d 53 42 20 67 72 65 65  :.    \ MSB gree
0970: 6e 20 72 65 64 20 7c 20 67 72 65 65 6e 20 72 65  n red | green re
0980: 64 20 7c 20 67 72 65 65 6e 20 72 65 64 20 7c 20  d | green red | 
0990: 67 72 65 65 6e 20 72 65 64 20 4c 53 42 0a 20 20  green red LSB.  
09a0: 20 20 3e 72 0a 20 20 20 20 6f 76 65 72 20 36 20    >r.    over 6 
09b0: 72 73 68 69 66 74 20 20 20 20 20 20 20 6f 76 65  rshift       ove
09c0: 72 20 63 21 20 72 40 20 2b 0a 20 20 20 20 6f 76  r c! r@ +.    ov
09d0: 65 72 20 34 20 72 73 68 69 66 74 20 33 20 61 6e  er 4 rshift 3 an
09e0: 64 20 6f 76 65 72 20 63 21 20 72 40 20 2b 0a 20  d over c! r@ +. 
09f0: 20 20 20 6f 76 65 72 20 32 20 72 73 68 69 66 74     over 2 rshift
0a00: 20 33 20 61 6e 64 20 6f 76 65 72 20 63 21 20 72   3 and over c! r
0a10: 3e 20 2b 0a 20 20 20 20 73 77 61 70 20 20 20 20  > +.    swap    
0a20: 20 20 20 20 20 20 33 20 61 6e 64 20 73 77 61 70        3 and swap
0a30: 20 63 21 20 3b 0a 3a 20 62 79 74 65 3e 68 70 69   c! ;.: byte>hpi
0a40: 78 65 6c 20 28 20 62 79 74 65 20 61 64 64 72 20  xel ( byte addr 
0a50: 2d 2d 20 29 0a 20 20 20 20 5c 20 61 20 62 79 74  -- ).    \ a byt
0a60: 65 20 69 73 20 63 6f 6e 76 65 72 74 65 64 20 69  e is converted i
0a70: 6e 74 6f 20 66 6f 75 72 20 70 69 78 65 6c 73 3a  nto four pixels:
0a80: 0a 20 20 20 20 5c 20 4d 53 42 20 67 72 65 65 6e  .    \ MSB green
0a90: 20 72 65 64 20 7c 20 67 72 65 65 6e 20 72 65 64   red | green red
0aa0: 20 7c 20 67 72 65 65 6e 20 72 65 64 20 7c 20 67   | green red | g
0ab0: 72 65 65 6e 20 72 65 64 20 4c 53 42 0a 20 20 20  reen red LSB.   
0ac0: 20 31 20 62 79 74 65 3e 70 69 78 65 6c 20 3b 0a   1 byte>pixel ;.
0ad0: 3a 20 62 79 74 65 3e 76 70 69 78 65 6c 20 28 20  : byte>vpixel ( 
0ae0: 62 79 74 65 20 61 64 64 72 20 2d 2d 20 29 0a 20  byte addr -- ). 
0af0: 20 20 20 5c 20 61 20 62 79 74 65 20 69 73 20 63     \ a byte is c
0b00: 6f 6e 76 65 72 74 65 64 20 69 6e 74 6f 20 66 6f  onverted into fo
0b10: 75 72 20 70 69 78 65 6c 73 3a 0a 20 20 20 20 5c  ur pixels:.    \
0b20: 20 4d 53 42 20 67 72 65 65 6e 20 72 65 64 20 7c   MSB green red |
0b30: 20 67 72 65 65 6e 20 72 65 64 20 7c 20 67 72 65   green red | gre
0b40: 65 6e 20 72 65 64 20 7c 20 67 72 65 65 6e 20 72  en red | green r
0b50: 65 64 20 4c 53 42 0a 20 20 20 20 6b 65 79 71 72  ed LSB.    keyqr
0b60: 23 20 62 79 74 65 3e 70 69 78 65 6c 20 3b 0a 0a  # byte>pixel ;..
0b70: 3a 20 3e 6b 65 79 68 6c 69 6e 65 20 28 20 64 65  : >keyhline ( de
0b80: 73 74 61 64 64 72 20 73 72 63 61 64 64 72 20 2d  staddr srcaddr -
0b90: 2d 20 64 65 73 74 61 64 64 72 27 20 29 0a 20 20  - destaddr' ).  
0ba0: 20 20 6b 65 79 6c 69 6e 65 23 20 62 6f 75 6e 64    keyline# bound
0bb0: 73 20 3f 44 4f 20 20 49 20 63 40 20 6f 76 65 72  s ?DO  I c@ over
0bc0: 20 62 79 74 65 3e 68 70 69 78 65 6c 20 34 20 2b   byte>hpixel 4 +
0bd0: 20 20 4c 4f 4f 50 20 3b 0a 3a 20 3e 6b 65 79 76    LOOP ;.: >keyv
0be0: 6c 69 6e 65 20 28 20 64 65 73 74 61 64 64 72 20  line ( destaddr 
0bf0: 73 72 63 61 64 64 72 20 2d 2d 20 64 65 73 74 61  srcaddr -- desta
0c00: 64 64 72 27 20 29 0a 20 20 20 20 6b 65 79 6c 69  ddr' ).    keyli
0c10: 6e 65 23 20 62 6f 75 6e 64 73 20 3f 44 4f 20 20  ne# bounds ?DO  
0c20: 49 20 63 40 20 6f 76 65 72 20 62 79 74 65 3e 76  I c@ over byte>v
0c30: 70 69 78 65 6c 20 5b 20 6b 65 79 71 72 23 20 34  pixel [ keyqr# 4
0c40: 20 2a 20 5d 4c 20 2b 20 20 4c 4f 4f 50 20 3b 0a   * ]L +  LOOP ;.
0c50: 3a 20 3e 6b 65 79 6c 69 6e 65 73 20 28 20 61 64  : >keylines ( ad
0c60: 64 72 20 75 20 2d 2d 20 29 0a 20 20 20 20 6b 65  dr u -- ).    ke
0c70: 79 71 72 20 5b 20 6b 65 79 71 72 23 20 31 2b 20  yqr [ keyqr# 1+ 
0c80: 32 2a 20 32 2a 20 5d 4c 20 2b 20 2d 72 6f 74 20  2* 2* ]L + -rot 
0c90: 6b 65 79 6d 61 78 23 20 75 6d 69 6e 20 62 6f 75  keymax# umin bou
0ca0: 6e 64 73 20 3f 44 4f 0a 09 49 20 3e 6b 65 79 68  nds ?DO..I >keyh
0cb0: 6c 69 6e 65 20 20 6b 65 79 6c 69 6e 65 73 6b 70  line  keylineskp
0cc0: 23 20 2b 0a 20 20 20 20 6b 65 79 6c 69 6e 65 23  # +.    keyline#
0cd0: 20 2b 4c 4f 4f 50 20 20 64 72 6f 70 20 3b 0a 0a   +LOOP  drop ;..
0ce0: 5c 20 71 72 20 74 6f 20 52 47 42 41 0a 0a 43 72  \ qr to RGBA..Cr
0cf0: 65 61 74 65 20 3e 72 67 62 61 0a 24 30 30 30 30  eate >rgba.$0000
0d00: 30 30 30 30 20 2c 0a 24 46 46 30 30 30 30 30 30  0000 ,.$FF000000
0d10: 20 2c 0a 24 30 30 46 46 30 30 30 30 20 2c 0a 24   ,.$00FF0000 ,.$
0d20: 46 46 46 46 30 30 30 30 20 2c 0a 24 30 30 30 30  FFFF0000 ,.$0000
0d30: 46 46 30 30 20 2c 0a 24 46 46 30 30 46 46 30 30  FF00 ,.$FF00FF00
0d40: 20 2c 0a 24 30 30 46 46 46 46 30 30 20 2c 0a 24   ,.$00FFFF00 ,.$
0d50: 46 46 46 46 46 46 30 30 20 2c 0a 24 30 30 30 30  FFFFFF00 ,.$0000
0d60: 30 30 46 46 20 2c 0a 24 46 46 30 30 30 30 46 46  00FF ,.$FF0000FF
0d70: 20 2c 0a 24 30 30 46 46 30 30 46 46 20 2c 0a 24   ,.$00FF00FF ,.$
0d80: 46 46 46 46 30 30 46 46 20 2c 0a 24 30 30 30 30  FFFF00FF ,.$0000
0d90: 46 46 46 46 20 2c 0a 24 46 46 30 30 46 46 46 46  FFFF ,.$FF00FFFF
0da0: 20 2c 0a 24 30 30 46 46 46 46 46 46 20 2c 0a 24   ,.$00FFFFFF ,.$
0db0: 46 46 46 46 46 46 46 46 20 2c 0a 0a 3a 20 71 72  FFFFFFFF ,..: qr
0dc0: 3e 72 67 62 61 20 28 20 2d 2d 20 29 0a 20 20 20  >rgba ( -- ).   
0dd0: 20 6b 65 79 71 72 2d 72 67 62 61 20 6b 65 79 71   keyqr-rgba keyq
0de0: 72 20 6b 65 79 71 72 23 c2 b2 20 62 6f 75 6e 64  r keyqr#² bound
0df0: 73 20 44 4f 0a 09 49 20 63 40 20 32 62 3e 63 6f  s DO..I c@ 2b>co
0e00: 6c 20 78 6f 72 20 37 20 78 6f 72 20 63 65 6c 6c  l xor 7 xor cell
0e10: 73 20 3e 72 67 62 61 20 2b 20 40 20 6f 76 65 72  s >rgba + @ over
0e20: 20 62 65 2d 6c 21 20 73 66 6c 6f 61 74 2b 0a 20   be-l! sfloat+. 
0e30: 20 20 20 4c 4f 4f 50 20 64 72 6f 70 20 3b 0a 0a     LOOP drop ;..
0e40: 5c 20 67 65 6e 65 72 61 74 65 20 63 68 65 63 6b  \ generate check
0e50: 73 75 6d 20 61 6e 64 20 74 61 67 20 62 69 74 73  sum and tag bits
0e60: 0a 0a 3a 20 3e 71 72 2d 6b 65 79 20 28 20 61 64  ..: >qr-key ( ad
0e70: 64 72 20 75 20 2d 2d 20 29 20 71 72 2d 6b 65 79  dr u -- ) qr-key
0e80: 20 6b 65 79 73 69 7a 65 20 6d 6f 76 65 2d 72 65   keysize move-re
0e90: 70 20 3b 0a 3a 20 72 6e 67 3e 71 72 2d 6b 65 79  p ;.: rng>qr-key
0ea0: 20 28 20 2d 2d 20 29 20 20 24 38 20 72 6e 67 24   ( -- )  $8 rng$
0eb0: 20 3e 71 72 2d 6b 65 79 20 3b 0a 3a 20 64 61 74   >qr-key ;.: dat
0ec0: 65 3e 71 72 2d 6b 65 79 20 28 20 2d 2d 20 29 20  e>qr-key ( -- ) 
0ed0: 20 73 69 67 64 61 74 65 20 24 38 20 3e 71 72 2d   sigdate $8 >qr-
0ee0: 6b 65 79 20 3b 0a 3a 20 74 61 67 68 61 73 68 2d  key ;.: taghash-
0ef0: 72 65 73 74 20 28 20 61 64 64 72 31 20 75 31 20  rest ( addr1 u1 
0f00: 61 64 64 72 63 68 61 6c 6c 65 6e 67 65 20 75 32  addrchallenge u2
0f10: 20 74 61 67 20 2d 2d 20 74 61 67 20 29 20 20 3e   tag -- tag )  >
0f20: 72 0a 20 20 20 20 63 3a 30 6b 65 79 20 24 38 20  r.    c:0key $8 
0f30: 75 6d 69 6e 20 71 72 65 63 63 20 24 38 20 73 6d  umin qrecc $8 sm
0f40: 6f 76 65 20 72 40 20 71 72 65 63 63 20 24 38 20  ove r@ qrecc $8 
0f50: 2b 20 63 21 0a 20 20 20 20 71 72 65 63 63 20 24  + c!.    qrecc $
0f60: 39 20 63 3a 73 68 6f 72 74 68 61 73 68 20 63 3a  9 c:shorthash c:
0f70: 73 68 6f 72 74 68 61 73 68 20 71 72 65 63 63 20  shorthash qrecc 
0f80: 24 38 20 2b 20 24 38 20 63 3a 68 61 73 68 40 20  $8 + $8 c:hash@ 
0f90: 72 3e 0a 20 20 20 20 6d 73 67 28 20 2e 22 20 65  r>.    msg( ." e
0fa0: 63 63 3d 20 22 20 71 72 65 63 63 20 24 31 30 20  cc= " qrecc $10 
0fb0: 78 74 79 70 65 20 73 70 61 63 65 20 64 75 70 20  xtype space dup 
0fc0: 68 65 78 2e 20 63 72 20 29 20 3b 0a 3a 20 3e 74  hex. cr ) ;.: >t
0fd0: 61 67 68 61 73 68 20 28 20 61 64 64 72 20 75 20  aghash ( addr u 
0fe0: 74 61 67 20 2d 2d 20 74 61 67 20 29 0a 20 20 20  tag -- tag ).   
0ff0: 20 71 72 2d 6b 65 79 20 24 38 20 72 6f 74 20 74   qr-key $8 rot t
1000: 61 67 68 61 73 68 2d 72 65 73 74 20 3b 0a 3a 20  aghash-rest ;.: 
1010: 74 61 67 68 61 73 68 3f 20 28 20 61 64 64 72 20  taghash? ( addr 
1020: 75 31 20 65 63 63 20 75 32 20 74 61 67 20 2d 2d  u1 ecc u2 tag --
1030: 20 66 6c 61 67 20 29 0a 20 20 20 20 3e 72 20 32   flag ).    >r 2
1040: 74 75 63 6b 20 6f 76 65 72 20 24 38 20 3e 71 72  tuck over $8 >qr
1050: 2d 6b 65 79 0a 20 20 20 20 72 3e 20 74 61 67 68  -key.    r> tagh
1060: 61 73 68 2d 72 65 73 74 20 64 72 6f 70 20 38 20  ash-rest drop 8 
1070: 2f 73 74 72 69 6e 67 20 71 72 65 63 63 20 38 20  /string qrecc 8 
1080: 2b 20 38 20 73 74 72 3d 20 3b 0a 3a 20 3e 65 63  + 8 str= ;.: >ec
1090: 63 20 28 20 61 64 64 72 20 75 20 74 61 67 20 2d  c ( addr u tag -
10a0: 2d 20 29 20 3e 74 61 67 68 61 73 68 0a 20 20 20  - ) >taghash.   
10b0: 20 71 72 28 20 2e 22 20 65 63 63 3a 20 22 20 71   qr( ." ecc: " q
10c0: 72 65 63 63 20 24 31 30 20 78 74 79 70 65 20 63  recc $10 xtype c
10d0: 72 20 29 0a 20 20 20 20 6b 65 79 71 72 20 5b 20  r ).    keyqr [ 
10e0: 6b 65 79 71 72 23 20 23 30 33 20 2a 20 20 23 34  keyqr# #03 *  #4
10f0: 20 2b 20 5d 4c 20 2b 20 20 71 72 65 63 63 20 20   + ]L +  qrecc  
1100: 20 20 20 20 3e 6b 65 79 68 6c 69 6e 65 20 64 72      >keyhline dr
1110: 6f 70 0a 20 20 20 20 6b 65 79 71 72 20 5b 20 6b  op.    keyqr [ k
1120: 65 79 71 72 23 20 23 32 30 20 2a 20 20 23 34 20  eyqr# #20 *  #4 
1130: 2b 20 5d 4c 20 2b 20 20 71 72 65 63 63 20 24 34  + ]L +  qrecc $4
1140: 20 2b 20 3e 6b 65 79 68 6c 69 6e 65 20 64 72 6f   + >keyhline dro
1150: 70 0a 20 20 20 20 6b 65 79 71 72 20 5b 20 6b 65  p.    keyqr [ ke
1160: 79 71 72 23 20 23 30 34 20 2a 20 20 23 33 20 2b  yqr# #04 *  #3 +
1170: 20 5d 4c 20 2b 20 20 71 72 65 63 63 20 24 38 20   ]L +  qrecc $8 
1180: 2b 20 3e 6b 65 79 76 6c 69 6e 65 20 64 72 6f 70  + >keyvline drop
1190: 0a 20 20 20 20 6b 65 79 71 72 20 5b 20 6b 65 79  .    keyqr [ key
11a0: 71 72 23 20 23 30 34 20 2a 20 23 32 30 20 2b 20  qr# #04 * #20 + 
11b0: 5d 4c 20 2b 20 20 71 72 65 63 63 20 24 43 20 2b  ]L +  qrecc $C +
11c0: 20 3e 6b 65 79 76 6c 69 6e 65 20 64 72 6f 70 0a   >keyvline drop.
11d0: 20 20 20 20 64 75 70 20 36 20 72 73 68 69 66 74      dup 6 rshift
11e0: 20 20 20 20 20 20 20 6b 65 79 71 72 20 5b 20 6b         keyqr [ k
11f0: 65 79 71 72 23 20 20 23 33 20 2a 20 20 23 33 20  eyqr#  #3 *  #3 
1200: 2b 20 5d 4c 20 2b 20 63 21 0a 20 20 20 20 64 75  + ]L + c!.    du
1210: 70 20 34 20 72 73 68 69 66 74 20 33 20 61 6e 64  p 4 rshift 3 and
1220: 20 6b 65 79 71 72 20 5b 20 6b 65 79 71 72 23 20   keyqr [ keyqr# 
1230: 20 23 33 20 2a 20 23 32 30 20 2b 20 5d 4c 20 2b   #3 * #20 + ]L +
1240: 20 63 21 0a 20 20 20 20 64 75 70 20 32 20 72 73   c!.    dup 2 rs
1250: 68 69 66 74 20 33 20 61 6e 64 20 6b 65 79 71 72  hift 3 and keyqr
1260: 20 5b 20 6b 65 79 71 72 23 20 23 32 30 20 2a 20   [ keyqr# #20 * 
1270: 20 23 33 20 2b 20 5d 4c 20 2b 20 63 21 0a 20 20   #3 + ]L + c!.  
1280: 20 20 28 20 29 20 20 20 20 20 20 20 20 20 20 33    ( )          3
1290: 20 61 6e 64 20 6b 65 79 71 72 20 5b 20 6b 65 79   and keyqr [ key
12a0: 71 72 23 20 23 32 30 20 2a 20 23 32 30 20 2b 20  qr# #20 * #20 + 
12b0: 5d 4c 20 2b 20 63 21 20 3b 0a 0a 3a 20 2e 71 72  ]L + c! ;..: .qr
12c0: 2d 72 65 73 74 20 28 20 61 64 64 72 20 75 20 74  -rest ( addr u t
12d0: 61 67 20 2d 2d 20 29 0a 20 20 20 20 3e 72 20 3e  ag -- ).    >r >
12e0: 6b 65 79 66 72 61 6d 65 20 32 64 75 70 20 3e 6b  keyframe 2dup >k
12f0: 65 79 6c 69 6e 65 73 20 72 3e 20 3e 65 63 63 0a  eylines r> >ecc.
1300: 20 20 20 20 6b 65 79 71 72 20 6b 65 79 71 72 23      keyqr keyqr#
1310: 20 71 72 2e 62 6c 6f 63 6b 20 3b 0a 0a 3a 20 2e   qr.block ;..: .
1320: 6b 65 79 71 72 20 28 20 61 64 64 72 20 75 20 74  keyqr ( addr u t
1330: 61 67 20 2d 2d 20 29 20 5c 20 36 34 20 62 79 74  ag -- ) \ 64 byt
1340: 65 73 0a 20 20 20 20 71 72 28 20 3e 72 20 32 64  es.    qr( >r 2d
1350: 75 70 20 62 6f 75 6e 64 73 20 55 2b 44 4f 20 2e  up bounds U+DO .
1360: 22 20 71 72 20 3a 20 22 20 49 20 24 31 30 20 78  " qr : " I $10 x
1370: 74 79 70 65 20 63 72 20 24 31 30 20 2b 4c 4f 4f  type cr $10 +LOO
1380: 50 0a 20 20 20 20 72 3e 20 2e 22 20 74 61 67 3a  P.    r> ." tag:
1390: 20 22 20 64 75 70 20 68 65 78 2e 20 63 72 20 29   " dup hex. cr )
13a0: 0a 20 20 20 20 72 6e 67 3e 71 72 2d 6b 65 79 20  .    rng>qr-key 
13b0: 2e 71 72 2d 72 65 73 74 20 3b 0a 0a 3a 20 2e 73  .qr-rest ;..: .s
13c0: 69 67 71 72 20 28 20 61 64 64 72 20 75 20 2d 2d  igqr ( addr u --
13d0: 20 29 20 5c 20 61 6e 79 20 73 74 72 69 6e 67 0a   ) \ any string.
13e0: 20 20 20 20 63 3a 30 6b 65 79 20 63 3a 68 61 73      c:0key c:has
13f0: 68 20 6e 6f 77 3e 6e 65 76 65 72 20 73 69 67 64  h now>never sigd
1400: 61 74 65 20 2b 64 61 74 65 0a 20 20 20 20 73 69  ate +date.    si
1410: 67 2d 70 61 72 61 6d 73 20 65 64 2d 73 69 67 6e  g-params ed-sign
1420: 0a 20 20 20 20 64 61 74 65 3e 71 72 2d 6b 65 79  .    date>qr-key
1430: 20 71 72 3a 6b 65 79 73 69 67 23 20 2e 71 72 2d   qr:keysig# .qr-
1440: 72 65 73 74 20 3b 0a 0a 5c 5c 5c 0a 4c 6f 63 61  rest ;..\\\.Loca
1450: 6c 20 56 61 72 69 61 62 6c 65 73 3a 0a 66 6f 72  l Variables:.for
1460: 74 68 2d 6c 6f 63 61 6c 2d 77 6f 72 64 73 3a 0a  th-local-words:.
1470: 20 20 20 20 28 0a 20 20 20 20 20 28 28 22 6e 65      (.     (("ne
1480: 74 32 6f 3a 22 20 22 2b 6e 65 74 32 6f 3a 22 29  t2o:" "+net2o:")
1490: 20 64 65 66 69 6e 69 74 69 6f 6e 2d 73 74 61 72   definition-star
14a0: 74 65 72 20 28 66 6f 6e 74 2d 6c 6f 63 6b 2d 6b  ter (font-lock-k
14b0: 65 79 77 6f 72 64 2d 66 61 63 65 20 2e 20 31 29  eyword-face . 1)
14c0: 0a 20 20 20 20 20 20 22 5b 20 5c 74 5c 6e 5d 22  .      "[ \t\n]"
14d0: 20 74 20 6e 61 6d 65 20 28 66 6f 6e 74 2d 6c 6f   t name (font-lo
14e0: 63 6b 2d 66 75 6e 63 74 69 6f 6e 2d 6e 61 6d 65  ck-function-name
14f0: 2d 66 61 63 65 20 2e 20 33 29 29 0a 20 20 20 20  -face . 3)).    
1500: 20 28 22 5b 61 2d 7a 30 2d 39 5d 2b 28 22 20 69   ("[a-z0-9]+(" i
1510: 6d 6d 65 64 69 61 74 65 20 28 66 6f 6e 74 2d 6c  mmediate (font-l
1520: 6f 63 6b 2d 63 6f 6d 6d 65 6e 74 2d 66 61 63 65  ock-comment-face
1530: 20 2e 20 31 29 0a 20 20 20 20 20 20 22 29 22 20   . 1).      ")" 
1540: 6e 69 6c 20 63 6f 6d 6d 65 6e 74 20 28 66 6f 6e  nil comment (fon
1550: 74 2d 6c 6f 63 6b 2d 63 6f 6d 6d 65 6e 74 2d 66  t-lock-comment-f
1560: 61 63 65 20 2e 20 31 29 29 0a 20 20 20 20 29 0a  ace . 1)).    ).
1570: 66 6f 72 74 68 2d 6c 6f 63 61 6c 2d 69 6e 64 65  forth-local-inde
1580: 6e 74 2d 77 6f 72 64 73 3a 0a 20 20 20 20 28 0a  nt-words:.    (.
1590: 20 20 20 20 20 28 28 22 6e 65 74 32 6f 3a 22 20       (("net2o:" 
15a0: 22 2b 6e 65 74 32 6f 3a 22 29 20 28 30 20 2e 20  "+net2o:") (0 . 
15b0: 32 29 20 28 30 20 2e 20 32 29 20 6e 6f 6e 2d 69  2) (0 . 2) non-i
15c0: 6d 6d 65 64 69 61 74 65 29 0a 20 20 20 20 29 0a  mmediate).    ).
15d0: 45 6e 64 3a 0a 5b 54 48 45 4e 5d 0a              End:.[THEN].